Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Path: utzoo!utgpu!water!watmath!clyde!rutgers!rochester!PT!andrew.cmu.edu!lord+ From: lord+@andrew.cmu.edu.UUCP Newsgroups: comp.emacs Subject: monkey mode Message-ID: Date: Sat, 3-Oct-87 16:50:37 EDT Article-I.D.: andrew.gVNKARy00UjHysU0k8 Posted: Sat Oct 3 16:50:37 1987 Date-Received: Sun, 4-Oct-87 06:36:13 EDT Organization: Carnegie Mellon University Lines: 897 Two things happened in responce to my offer of monkey mode. 1) I got lots of requests for the code. 2) A friend (Joe Keane (jk3k+@andrew.cmu.edu)) who had taken a very early version of monkey and made his own improvements, offered to merge our two versions. Enclosed then is the new and improved monkey.el. A few more functions are on the way, but the editor is quite useful as it stands. I would recommend adding the following lines to your .emacs file: (let (( monkey-source "monkey.el")) (autoload 'background monkey-source) (autoload 'monkey-file monkey-source) (autoload 'monkey-file-other-window monkey-source) (autoload 'monkey-alternate-file monkey-source) (autoload 'minkey monkey-source)) (global-set-key "\C-X\C-F" 'monkey-file) (global-set-key "\C-X\C-V" 'monkey-alternate-file) (global-set-key "\C-X4F" 'monkey-file-other-window) (global-set-key "\C-x4\C-f" 'monkey-file-other-window) (global-set-key "\C-x4f" 'monkey-file-other-window) (global-set-key "\M-&" 'background) Here is monkey.el: ; ; monkey.el, derivations therefrom, and extensions thereof, are free to all. ; ; ; monkey mode. a mode good at bopping around on (directory) trees. ; monkey is a good replacement for dired. ; ; monkey mode will loose badly on filenames that begin with a space, or contain a new line or carriage return. ; (defvar monkey-be-fast nil "Controls whether files displayed are stated") (defvar monkey-mode-map nil "Local keymap for monkey-mode buffers.") (setq monkey-mode-map (make-keymap)) (suppress-keymap monkey-mode-map) (define-key monkey-mode-map "\C-c\C-m" 'monkey-mark-by-regexp) (define-key monkey-mode-map "\C-c+" 'monkey-mark-by-regexp) (define-key monkey-mode-map "\C-c=" 'monkey-mark-by-regexp) (define-key monkey-mode-map "\C-cm" 'monkey-mark-by-regexp) (define-key monkey-mode-map "\C-m" 'monkey-mark-this) (define-key monkey-mode-map "\M-m" 'monkey-mark-all) (define-key monkey-mode-map "\M-+" 'monkey-mark-all) (define-key monkey-mode-map "\M-=" 'monkey-mark-all) (define-key monkey-mode-map "\M-\C-m" 'monkey-mark-all) (define-key monkey-mode-map "+" 'monkey-mark-this) (define-key monkey-mode-map "=" 'monkey-mark-this) (define-key monkey-mode-map "\C-c\C-u" 'monkey-unmark-by-regexp) (define-key monkey-mode-map "\C-c\C-c" 'monkey-unmark-all) (define-key monkey-mode-map "\C-cu" 'monkey-unmark-by-regexp) (define-key monkey-mode-map "\M-u" 'monkey-unmark-all) (define-key monkey-mode-map "u" 'monkey-unmark-this) (define-key monkey-mode-map "\C-?" 'monkey-unmark-this-back) (define-key monkey-mode-map "t" 'monkey-toggle-this) (define-key monkey-mode-map "\C-ct" 'monkey-toggle-marked-by-regexp) (define-key monkey-mode-map "\C-c\C-t" 'monkey-toggle-marked-by-regexp) (define-key monkey-mode-map "\M-t" 'monkey-toggleall) (define-key monkey-mode-map "\C-n" 'monkey-next-line) (define-key monkey-mode-map "\C-p" 'monkey-previous-line) (define-key monkey-mode-map " " 'monkey-next-line) (define-key monkey-mode-map "n" 'monkey-next-line) (define-key monkey-mode-map "p" 'monkey-previous-line) (define-key monkey-mode-map "\M-n" 'monkey-next-directory) (define-key monkey-mode-map "\M-p" 'monkey-previous-directory) (define-key monkey-mode-map "\C-c\C-n" 'monkey-next-same-level) (define-key monkey-mode-map "\C-c\C-p" 'monkey-previous-same-level) (define-key monkey-mode-map "\M-<" 'monkey-beginning-of-buffer) (define-key monkey-mode-map "\M->" 'monkey-end-of-buffer) (define-key monkey-mode-map "\M-v" 'monkey-scroll-down) (define-key monkey-mode-map "\C-v" 'monkey-scroll-up) (define-key monkey-mode-map "\C-cn" 'monkey-next-same-level) (define-key monkey-mode-map "\C-cp" 'monkey-previous-same-level) (define-key monkey-mode-map "\C-c\C-f" 'monkey-past-subdirectory) (define-key monkey-mode-map "\C-c\C-b" 'monkey-directory-heading) (define-key monkey-mode-map "\C-c\C-s" 'monkey-mark-subdirectory) (define-key monkey-mode-map "\C-cs" 'monkey-mark-subdirectory) (define-key monkey-mode-map "\C-c^" 'monkey-directory-heading) (define-key monkey-mode-map "\C-cc" 'monkey-copy-by-regexp) (define-key monkey-mode-map "\C-cr" 'monkey-rename-by-regexp) (define-key monkey-mode-map "\M-h" 'monkey-unhide-all) (define-key monkey-mode-map "#" 'monkey-mark-auto-save-files) (define-key monkey-mode-map "*" 'monkey-mark-executables) (define-key monkey-mode-map "." 'monkey-mark-dotfiles) (define-key monkey-mode-map "/" 'monkey-mark-directories) (define-key monkey-mode-map "?" 'monkey-summary) (define-key monkey-mode-map "@" 'monkey-mark-links) (define-key monkey-mode-map "A" 'monkey-gee) ;(define-key monkey-mode-map "G" 'monkey-change-group) ;(define-key monkey-mode-map "M" 'monkey-change-mode) ;(define-key monkey-mode-map "W" 'monkey-change-owner) (define-key monkey-mode-map "^" 'monkey-parent) (define-key monkey-mode-map "`" 'monkey-parent) (define-key monkey-mode-map "\\" 'monkey-parent) (define-key monkey-mode-map "!" 'monkey-shell-command) (define-key monkey-mode-map "&" 'monkey-background) (define-key monkey-mode-map "C" 'monkey-copy-marked) (define-key monkey-mode-map "c" 'monkey-copy-this) (define-key monkey-mode-map "D" 'monkey-delete-marked) (define-key monkey-mode-map "d" 'monkey-delete-this) (define-key monkey-mode-map "E" 'monkey-edit-marked) (define-key monkey-mode-map "e" 'monkey-edit-this) (define-key monkey-mode-map "F" 'monkey-edit-marked) (define-key monkey-mode-map "f" 'monkey-edit-this) (define-key monkey-mode-map "g" 'monkey-gee) (define-key monkey-mode-map "h" 'monkey-hide-this) (define-key monkey-mode-map "H" 'monkey-hide-marked) (define-key monkey-mode-map "j" 'monkey-edit-this-and-trash-this-buffer) (define-key monkey-mode-map "k" 'monkey-mark-by-type) (define-key monkey-mode-map "l" 'monkey-list-this-long) (define-key monkey-mode-map "L" 'monkey-list-long) (define-key monkey-mode-map "m" 'monkey-mark-this) (define-key monkey-mode-map "o" 'monkey-edit-this-other-window) (define-key monkey-mode-map "O" 'monkey-edit-marked-other-window) (define-key monkey-mode-map "q" 'monkey-toggle-quietness) (define-key monkey-mode-map "r" 'monkey-rename-this) (define-key monkey-mode-map "R" 'monkey-rename-marked) (define-key monkey-mode-map "s" 'monkey-mung-this-subdirectory) (define-key monkey-mode-map "S" 'monkey-mung-marked-subdirectories) (define-key monkey-mode-map "V" 'monkey-edit-marked-and-trash-this-buffer) (define-key monkey-mode-map "v" 'monkey-edit-this-and-trash-this-buffer) (define-key monkey-mode-map "w" 'monkey-copy-this-file-name) (define-key monkey-mode-map "W" 'monkey-copy-marked-file-names) (define-key monkey-mode-map "x" 'monkey-mark-by-extension) (define-key monkey-mode-map "~" 'monkey-mark-backup-files) (define-key monkey-mode-map "]" 'monkey-shove) ;; Monkey mode is suitable only for specially formatted data. (put 'monkey-mode 'mode-class 'special) (defun monkey-mode () "Mode for \"editing\" directory listings. In monkey, you are \"editing\" a list of the files in a directory. You can move using the usual cursor motion commands. Letters no longer insert themselves. In monkey, you may operate on any number of files at a time. You do this by `marking' those files you are interested in. If you do not mark any files, then the file on the line containing the point is considered `marked'. Many commands come in pairs, one version that affects the file on the line with the point, and one version that affects the marked files. In the default bindings, these pairs are bound to the lower and uppercase of some character. The format of lines in a monkey buffer is important. It consists of three fields: . The markfield is empty for unmarked files, and is a `+' for marked files. The typefield contains a character describing the type of the file: `/' for directories, `@' for symbolic links, `*' for executables, `,' for character devies, and `$' for block devices. For example, a marked directory named `foo' would look like +/ foo while an unmarked text file named `bar' would look like: bar The monkey-mode commands are summarized below. There are many intuitive aliases for the more common commands (for example, `+' is an alias for `m' to mark the current file). These aliases are not summarized below. Basic movement commands: n move down one line. SPACE move down one line. p move up one line. Note: with a prefix arg, all movement commands iterate. Basic marking commands: Note: with a prefix arg, all marking commands become unmarking commands, and vice versa. Also, ESC is a general prefix meaning `do this to everything'. RET mark this file. u unmark this file. DEL unmark and move backwards. t toggle this mark. ESC m mark everything ESC u unmark everything ESC t toggle all marks ~ mark all backup files. # mark all check point files. . mark all `dot' files. @ mark all symbolic links. * mark all executables. / mark all directories. k mark files by typefield. (e.g. k/ is an alias for /) Basic Operations. e edit this file. E edit marked files. v edit this file and trash this buffer. V edit maked files and trash this buffer. o edit this file in the other window. O edit this file in the other windows l show a long directory listing for the current file. L show a long directory listing for the marked files. c copy (this can take a dir as destination). C copy marked files. r rename. R rename marked files. d delete. D delete named files. w copy the current filename to the kill ring. W copy the marked filenames to the kill ring. ] shove the marked filenames into a scratch buffer (especially useful with shell-comman-on-region). ! execute a shell command on the marked files. Subdirectory commands: s expand in-situ the current subdirectory. S expand in-situ the marked subdirectories. With a prefix arg, s and S unexpand subdirectories. C-cC-s mark this subdirectory. C-uC-cC-s unmark this subdirectory. (remember the rule about marking commands and prefix args?) C-cC-f move past this subdirectory. C-cC-b move before this subdirectory. C-cC-n move forward skipping subdirectories. C-cC-p move backward skipping subdirectories. ESC n move to the next directory. ESC p move to the previous directory. C-c^ move to the directory line for this subdir. Hiding commands: h hide this file. H hide marked files. With a prefix arg, unhide rather than hide. ESC h unhide at this line. ESC H unhide all hidden files. Regexp commands: C-cC-m mark files matching a regexp. C-cu unmark files matching a regexp. C-cc copy by regexp (see below). C-cr rename by regexp. x mark files matching .*\\.REGEXP. REGEXP is prompted for. (i.e. x o marks all object files) Copying and renaming by regexp is an unusual feature. It is useful for operating on groups of files, when the name changes are regular. For example, suppose that in some directory, I have a groop of files with names like m-sun.h, m-ibmrt.h etc., and I wish to move them all to a directory called `machines', stripping them of the `m-' affix in the process. Then I would 1) Mark them using `C-cm m-\\(.*\\) RET' 2) Rename them using `C-cr machines/\\1 RET' Pretty cool, huh? Misc commands: q turn off file stating. When file stating is off, monkey is very fast, but all type fields show up as '?'. g use this when you find yourself saying `Gee, that can't be right!' ^ edit the parent of this directory." (kill-all-local-variables) (setq major-mode 'monkey-mode) (setq mode-name "Monkey") (setq mode-line-buffer-identification '("Monkey: %17b")) (setq case-fold-search nil) (setq buffer-read-only t) (setq selective-display t) (use-local-map monkey-mode-map) (setq markive-display t) (run-hooks 'monkey-mode-hook) (message "Does your minkey have a license?")) ; ; generally useful functions that I wish came with emacs. ; (defun tail (string1 string2) "Strip string1 from string2 if it is present." (let ((n (length string1)) (y (length string2))) (if (and (>= y n) (string= string1 (substring string2 0 n))) (substring string2 n y) string2))) (defun abs (x) (cond ((< x 0) (- x)) (t x))) (defun signum (x) (if (< x 0) -1 1)) (defun delete-directory (file) "This little loose of a function should be in C. And should do error checking." (call-process "rmdir" nil nil nil file)) (defun delete-file-properly (file &optional ok-if-directory) "Delete FILE. If FILE is a nonempty directory, signal an error. If FILE is an empty directory, the course of action depends on the optional parameter OK-IF-DIRECTORY. If nil, an error is raised, if numeric, the user is asked for permission to delete it, otherwise, the file is silently deleted." (interactive "fDelete File: \np") (cond ((not (file-attributes file)) (error "You don't have access to %s." file)) ((not (eq t (car (file-attributes file)))) (delete-file file)) ((not ok-if-directory) (error "%s is a directory." file)) ((not (eq (length (directory-files file)) 2)) (error "%s is not an empty directory." file)) ((or (not (numberp ok-if-directory)) (y-or-n-p (format "Delete directory %s? " file))) (delete-directory file)) (t (error "%s not deleted.")))) (defun copy-file-properly (file destination &optional ok-if-already-exists) "Copy FILE to DESTINATION. If DESTINATION is a directory, then copy FILE into DESTINATION." (interactive "fCopy file: \nfCopy to: \np") (let ((real-destination (if (and (not (file-directory-p file)) (file-directory-p destination)) (concat (file-name-as-directory destination) (file-name-nondirectory file)) destination))) (copy-file file real-destination ok-if-already-exists) real-destination)) (defun rename-file-properly (file newname &optional ok-if-already-exists) "Rename FILE as NEWNAME. If NEWNAME is the name of a directory, then move FILE to that directory. See rename-file for more." (interactive "fRename File: \nFRename to: \np") (let ((real-destination (if (file-directory-p destination) (concat (file-name-as-directory destination) (file-name-nondirectory file)) destination))) (rename-file file real-destination ok-if-already-exists) real-destination)) (defun eol-point (&optional count) "Return the point at the end of the current line." (save-excursion (end-of-line count) (point))) (defun bol-point (&optional count) "Return the point at the beginning of the current line." (save-excursion (beginning-of-line count) (point))) ; ; monkey-buffer format munging. ; see the comment in monkey-mode for a description of ; monkey-buffers. ; ; (setq monkey-status-fields-regexp "[ +&]. *") ; it is hoped that the above will be faster than ; the `true' regexp which is: "[ +][ \\$\\*\\?@/,] *" (setq monkey-filename-regexp (concat monkey-status-fields-regexp "\\(\\([^\n\r/]\\|\\(/[^\n\r]\\)\\)*\\)")) (setq monkey-marked-file-regexp (concat "^\\+. *" "\\(\\([^\n\r/]\\|\\(/[^\n\r]\\)\\)*\\)")) (defvar monkey-always-hide-regexp nil "*Regexp matching those files which should be hidden after a directory is listed in a minkey buffer.") (defun monkey-filetype () "Return the file type of the current file. This assumes there is a filename on this line." (save-excursion (beginning-of-line) (char-after (1+ (point))))) (defun monkey-filename-beginning (&optional important) "Return the point position of the first char of the filename on the current monkeybuffer line. If the optional parameter IMPORTANT is non-nil, then signal an error if there is no filename on this line. Otherwise, returns nil if no file is found." (save-excursion (beginning-of-line) (cond ((looking-at monkey-filename-regexp) (match-beginning 1)) (important (error "There is no file on this line.")) (t nil)))) (defun monkey-filename-end (&optional important) "Return the point position of the end of the filename on the current monkeybuffer line. If the optional parameter IMPORTANT is non-nil, then signal an error if there is no filename on this line. Otherwise, returns nil if no file is found." (save-excursion (beginning-of-line) (cond ((looking-at monkey-filename-regexp) (match-end 1)) (important (error "There is no file on this line.")) (t nil)))) (defun monkey-filename (&optional important) "Return the filename on the current line. If the optional parameter IMPORTANT is nil, then signal an error. Otherwise, return nil if no file is found." (save-excursion (beginning-of-line) (cond ((looking-at monkey-filename-regexp) (buffer-substring (match-beginning 1) (match-end 1))) (important (error "There is no file on this line.")) (t nil)))) (defconst monkey-insert-distance 2 "*Number of spaces to indent for each level of subdirectoriness. This can be any number greater than 0.") (defun occurences (char string) "Return the number of occurences of CHAR in STRING." (let ((len (length string)) (x 0) (total 0)) (while (< x len) (if (eq char (aref string x)) (setq total (1+ total))) (setq x (1+ x))) total)) (defun monkey-insert-filename (name &optional top-level) "Insert a line for NAME in the current buffer. Name should be a path specification relative to the current directory." (let* ((buffer-read-only nil) (name (if top-level name (tail default-directory (if (eq ?~ (string-to-char name)) (expand-file-name name) name)))) (indent-spaces (if (or top-level (eq ?/ (string-to-char name))) 1 (1+ (* monkey-insert-distance (occurences ?/ name)))))) ;(monkey-move-to-insertion-point name) (end-of-line) (or (bobp) (insert ?\n)) (insert " " (cond (monkey-be-fast ??) ((file-directory-p name) ?/) ((file-symlink-p name) ?@) ((file-readable-p name) " ") (t ??))) (insert-char 32 indent-spaces) (insert " " name))) ; (t (let* ((mode (nth 8 attr)) ; (char (string-to-char mode))) ; (cond ((eq char ?b) ?$) ; ((eq char ?c) ?,) ; ((and (eq char ?-) (string-match "x" mode)) ?*) ; (t " "))))) (defun monkey-sorted-insert-filename (name &optional no-unhide) "Move to the alphabetically correct place, and insert NAME. Optional NO-UNHIDE prevents dealing with hidden files." (let* ((buffer-read-only nil) (name (tail default-directory (if (eq ?~ (string-to-char name)) (expand-file-name name) name)))) (or no-unhide (monkey-temp-unhide)) (save-excursion (goto-char (catch 'FOUND-POS (monkey-map-file '(lambda () (if (not (string-lessp (monkey-filename) name)) (throw 'FOUND-POS (point))))))) (if (not (eq (bol-point) (point-min))) (forward-line -1) (goto-char (point-min)) (insert "\n") (goto-char (point-min))) (monkey-insert-filename name)) (or no-unhide (monkey-un-temp-unhide)))) (defun monkey-delete-line () "Remove the current file line from a monkey buffer." (let ((buffer-read-only nil)) (beginning-of-line) (or (bobp) (backward-delete-char 1)) (while (not (or (eobp) (let ((char (char-after (point)))) (or (eq char ?\n) (eq char ?\r))))) (delete-char 1)) (and (bobp) (delete-char 1)))) (defun monkey-expanded-p () "Returns *t* if the current filename is that of an expanded subdir" (eq ?/ (char-after (monkey-filename-end t)))) (defun monkey-hide-line () "Hide the current file line. If the file is the name of an expanded subdir, then hide the entire subdir." (let* ((buffer-read-only nil) (expanded (monkey-expanded-p)) (name (and expanded (monkey-filename)))) (save-excursion (monkey-unmark) (beginning-of-line) (or (bobp) (backward-delete-char 1)) (insert ?\r) (and expanded (monkey-map-matches 'monkey-hide-line (concat (regexp-quote (concat name "/")) ".*")))))) (defun monkey-temp-unhide () "Unhide all hidden lines temporarily." (let ((buffer-read-only nil)) (save-excursion (goto-char (point-min)) (replace-string "\r " "\n&")))) (defun monkey-un-temp-unhide () "c.f. monkey-temp-unhide" (let ((buffer-read-only nil)) (save-excursion (goto-char (point-min)) (replace-string "\n&" "\r ")))) (defun bounded-replace-string (from to start end) (save-excursion (goto-char start) (while (search-forward from end t) (replace-match to t nil)))) (defun monkey-unhide-line (&optional fail-silently mark-unhidden-lines) "Unhide files hidden on this line." (let ((buffer-read-only nil)) (unwind-protect ; for some reason, this doesn't work without ; an unwind-protect. redisplay doesn't happen ; correctly. go figure. (save-excursion (beginning-of-line) (or (search-forward "\r" (eol-point) t) fail-silently (error "Nothing is hidden here!")) (beginning-of-line) (if mark-unhidden-lines (bounded-replace-string "\r " "\n+" (point) (eol-point)) (subst-char-in-region (point) (eol-point) ?\r ?\n t)) (beginning-of-line) (while (eq ?\n (char-after (point))) (delete-char 1)))))) (defun monkey-list-directory (&optional directory) "Insert a directory listing of the default directory or optionally of DIRECTORY." (let ((dir (or directory default-directory)) (top-level (not directory))) (mapcar '(lambda (x) (monkey-insert-filename x top-level)) (directory-files dir directory nil)) (if monkey-always-hide-regexp (monkey-map-matches 'monkey-hide-line monkey-always-hide-regexp)))) ; ; inserting and removing subdirectories in situ ; (defun monkey-expand-subdirectory () "Expand in-situ the contents of a subdirectory." (let* ((name (monkey-filename t)) (base-name (file-name-nondirectory name)) (buffer-read-only nil)) (if (not (file-directory-p name)) (error "%s is not a directory." name)) (if (or (string= "." base-name) (string= ".." base-name)) (error "Why would you expand `%s'?" name)) (goto-char (monkey-filename-end)) (if (eq (char-after (point)) ?/) (error "%s has already been expanded." name)) (insert ?/) (save-excursion (monkey-list-directory name)))) (defun monkey-delete-matching-lines (regexp) "Delete all the lines that match regexp. This effects hidden as well as visible lines." (save-excursion (goto-char (point-min)) (replace-regexp (concat "^" monkey-status-fields-regexp regexp "\\([/\n\r]\\|$\\)") "") (goto-char (point-min)) (replace-regexp (concat "\r" monkey-status-fields-regexp regexp "\\([/\n\r]\\|$\\)") "") (goto-char (point-min)) (replace-regexp "\n\n" "\n") (goto-char (point-min)) (replace-regexp "\n$" ""))) (defun monkey-unexpand-subdirectory () "Unexpand in-situ the contents of a subdirectory." (or (monkey-expanded-p) (monkey-directory-heading 1)) (let* ((name (monkey-filename t)) (buffer-read-only nil) (subdir-regexp (concat (regexp-quote (concat name "/")) ".*"))) (goto-char (monkey-filename-end)) (delete-char 1) (save-excursion (monkey-map-matches '(lambda () (monkey-unhide-line t)) subdir-regexp)) (monkey-delete-matching-lines subdir-regexp))) ; ; mark status munging ; (defun monkey-mark () "Mark the current file line." (monkey-filename t) (save-excursion (let ((buffer-read-only nil)) (beginning-of-line) (delete-char 1) (insert ?+)))) (defun monkey-unmark () "Unmark the current file line." (monkey-filename t) (save-excursion (let ((buffer-read-only nil)) (beginning-of-line) (delete-char 1) (insert " ")))) (defun monkey-marked-p () "True if the current file line is marked." (save-excursion (beginning-of-line) (eq (char-after (point)) ?+))) (defun monkey-toggle () "Change the mark status of the current line." (if (monkey-marked-p) (monkey-unmark) (monkey-mark))) ; ; mapping functions. these exist to make the interactive functions easier to write ; ; ; (defun nice-monkey () "Make everything look nice." (and (save-excursion (re-search-backward "\r" (save-excursion (beginning-of-line) (point)) t)) (forward-line)) (goto-char (or (monkey-filename-beginning) (point)))) (defun monkey-map-file (fun) "Apply FUNCTION to each fileline in the buffer." (save-excursion (goto-char (point-min)) (while (not (eobp)) (and (monkey-filename) (apply fun ())) (forward-line))) (nice-monkey)) ; it will be faster to use direct searching on the buffer ;(defun monkey-map-matches (function regexp) ; "Apply FUNCTION to each file line matching REGEXP. ;The REGEXP must match the entire file name." ; (monkey-map-file ; '(lambda () ; (let ((name (monkey-filename))) ; (and (string-match regexp name) ; (eq (match-beginning 0) 0) ; (eq (match-end 0) (length name)) ; (apply function ())))))) (defun monkey-map-matches (function regexp) "Apply FUNCTION to each file line matching REGEXP. The REGEXP must match the entire file name." (save-excursion (goto-char (point-min)) (while (re-search-forward (concat monkey-status-fields-regexp regexp "\\([\n\r]\\|$\\)") nil t) (forward-char -1) (let ((end (monkey-filename-end))) (if (eq (char-after end) ?/) (setq end (1+ end))) (and end (= (point) end) (apply function ()))))) (nice-monkey)) (defun monkey-map-type (function typefield) "Apply FUNCTION to each file that has TYPEFIELD in its type field." (monkey-map-file '(lambda () (and (eq (monkey-filetype) typefield) (apply function ()))))) ;(defun monkey-map-marked (function &optional dont-unmark call-on-any-line) ; "Apply FUNCTION to each file line which is marked. ;Optional DONT-UNMARK, if non-nil, means don't unmark marked lines. ;Optional CALL-ON-ANY-LINE means apply this function even if no files are ;marked and there is no mark on the current line." ; ; using searches will be faster than this. ; (let ((were-any nil)) ; (save-excursion ; (monkey-map-file ; '(lambda () ; (and (monkey-marked-p) ; (progn ; (setq were-any t) ; (or dont-unmark (monkey-unmark)) ; (apply function ())))))) ; (or were-any ; (and (not call-on-any-line) ; (not (monkey-filename t))) ; (progn ; (apply function ()) ; (nice-monkey)))) ; (nice-monkey)) (defun monkey-map-marked (function &optional dont-unmark call-on-any-line) "Apply FUNCTION to each file line which is marked. Optional DONT-UNMARK if non-nil, means don't unmark marked lines. Optional CALL-ON-ANY-LINE means apply this function even if no files are marked and there is no mark on the current line." (let ((were-any nil)) (save-excursion (goto-char (point-min)) (while (re-search-forward monkey-marked-file-regexp nil t) (setq were-any t) (or dont-unmark (monkey-unmark)) (apply function ()))) (or were-any (and (not call-on-any-line) (not (monkey-filename t))) (apply function ())) (nice-monkey))) ; ; ; interactive functions ; ; ; ; ; ; cursor motion ; (defun monkey-next-line (&optional prefix) "Move to the next line of a monkey buffer." (interactive "p") (forward-line prefix) (nice-monkey)) (defun monkey-previous-line (&optional prefix) "Move to the previous line of a monkey buffer." (interactive "p") (monkey-next-line (- (or prefix 1)))) (defun monkey-beginning-of-buffer () "Move to the beginning of a monkey buffer." (interactive) (goto-char (point-min)) (nice-monkey)) (defun monkey-end-of-buffer () "Move to the bottom of a monkey buffer." (interactive) (goto-char (point-max)) (nice-monkey)) (defun monkey-scroll-up (&optional prefix) "Scroll up nicely in a monkey-buffer" (interactive "p") (scroll-up (and current-prefix-arg prefix)) (nice-monkey)) (defun monkey-scroll-down (&optional prefix) "Scroll down nicely in a monkey-buffer" (interactive "p") (scroll-down (and current-prefix-arg prefix)) (nice-monkey)) (defun monkey-next-directory (&optional count) "Move forward to the next directory." (interactive "p") (let ((count (abs (or count 1))) (direction (signum (or count 1)))) (goto-char (save-excursion (while (> count 0) (catch 'found (while (not (eobp)) (forward-line direction)