lord+@andrew.cmu.edu (Tom Lord) (10/04/87)
hmm...... seems that mailers are choking. I'll try this in three parts.
(this reposting contains the two small fixes posted earlier)
monkey.el, part 1
;
; 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: <markfield><typefield> <filename>. 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.
& execute a background 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 <RET> 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))))