lord+@andrew.cmu.edu (Tom Lord) (10/04/87)
mailers are choking, hence this split repost.
;
; 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)
(and (monkey-expanded-p)
(throw 'found nil)))
(error "No more directories."))
(setq count (1- count)))
(point))))
(nice-monkey))
(defun monkey-previous-directory (&optional count)
"Move backward to the previous directory."
(interactive "p")
(monkey-next-directory (- (or count 1))))
(defun monkey-directory-heading (count)
"Move to the line containing the directory name for the current
subdirectory."
(interactive "p")
(let ((count (abs (or count 1))))
(while (> count 0)
(let ((target-name (file-name-directory (monkey-filename))))
(or target-name (error "You are not in a subdirectory."))
(goto-char (point-min))
(re-search-forward (concat (regexp-quote target-name)
"\\(\r.*\\)?$")))
(beginning-of-line)
(setq count (1- count))))
(nice-monkey))
(defun monkey-past-subdirectory (count)
"Move past one extreme of the current subdirectory. This is of questionable
worth if
the buffer is not sorted alphabetically."
(interactive "p")
(let ((count (abs (or count 1)))
(direction (signum (or count 1))))
(while (> count 0)
(and (not (monkey-expanded-p))
(monkey-directory-heading 1))
(let ((dirname (concat (monkey-filename t) "/")))
(while (if (> direction 0)
(search-forward dirname nil t)
(search-backward dirname nil t))
(+ 1 1)) ;dumbass while exits if the BODY is empty!
(forward-line direction))
(setq count (1- count))))
(nice-monkey))
(defun monkey-before-subdirectory (count)
"Move before the current subdirectory."
(interactive "p")
(monkey-past-subdirectory (- count)))
(defun monkey-depth ()
"Return an integer describing the level of subdirectory nesting.
This integer is NOT the level of subdirectory nesting, but can be used
to decide which of two files is nested deeper."
(- (monkey-filename-beginning t) (bol-point)))
(defun monkey-next-same-level (&optional count)
"Move to the next line which is at the same depth of subdirectoriness."
(interactive "p")
(let ((depth (monkey-depth))
(count (abs (or count 1)))
(direction (signum (or count 1))))
(while (> count 0)
(forward-line direction)
(while (not (or (bobp) (eobp) (<= (monkey-depth) depth)))
(forward-line direction))
(setq count (1- count))))
(nice-monkey))
(defun monkey-previous-same-level (&optional count)
"Move to the previous line which is at the same depth of subdirectoriness."
(interactive "p")
(monkey-next-same-level (- (or count 1))))
;
; marking and unmarking
;
(defun monkey-action-and-move (function &optional count move-first)
"Provide the apply-and-move semantics of the -this functions.
FUNCTION is the function to apply to each line, COUNT is a repitition count
(may be nil) and the optional MOVE-FIRST, if non-nil, means move before
applying the function."
(let ((direction (signum (or count 1)))
(count (abs (or count 1))))
(while (> count 0)
(if move-first
(forward-line direction))
(apply function ())
(if (not move-first)
(forward-line direction))
(setq count (1- count)))
(nice-monkey)))
(defun monkey-mark-this (&optional count)
"Mark and move to the next line."
(interactive "p")
(monkey-action-and-move 'monkey-mark count))
(defun monkey-unmark-this (&optional count)
"Unmark and move to the next line."
(interactive "p")
(monkey-action-and-move 'monkey-unmark count))
(defun monkey-toggle-this (&optional count)
"Unmark and move to the next line."
(interactive "p")
(monkey-action-and-move 'monkey-toggle count))
(defun monkey-mark-this-back (&optional count)
"Mark this line and move backwards one line."
(interactive "p")
(monkey-action-and-move 'monkey-mark (- (or count 1)) t))
(defun monkey-unmark-this-back (&optional count)
"Unmark this line and move backwards one line."
(interactive "p")
(monkey-action-and-move 'monkey-unmark (- (or count 1)) t))
(defun monkey-toggle-this-back (&optional count)
"Unmark this line and move backwards one line."
(interactive "p")
(monkey-action-and-move 'monkey-toggle (- (or count 1))))
(defun monkey-mark-all ()
"Mark all files. With a prefix arg, unmarks all files."
(interactive)
(monkey-map-file
(if current-prefix-arg
'monkey-unmark
'monkey-mark)))
(defun monkey-unmark-all ()
"Unmark all files. With a prefix arg, marks all files."
(interactive)
(monkey-map-file
(if current-prefix-arg
'monkey-mark
'monkey-unmark)))
(defun monkey-toggleall ()
"Exchange the set of marked files with the set of unmarked files."
(interactive)
(monkey-map-file 'monkey-toggle))
(defvar monkey-last-mark-regexp nil
"The last regexp used to mark files in a monkey buffer.")
(make-variable-buffer-local 'monkey-last-mark-regexp)
(defun monkey-mark-by-regexp (regexp)
"Mark all files matching REGEXP. Unmarks with a prefix arg."
(interactive "sRegexp: ")
(save-excursion
(monkey-map-matches
(if current-prefix-arg
'monkey-unmark
'monkey-mark)
regexp)
(setq monkey-last-mark-regexp regexp)))
(defun monkey-unmark-by-regexp (regexp)
"Unmark all files matching REGEXP. Marks with a prefix arg."
(interactive "sRegexp: ")
(save-excursion
(monkey-map-matches
(if current-prefix-arg
'monkey-mark
'monkey-unmark)
regexp)
(setq monkey-last-mark-regexp regexp)))
(defun monkey-toggle-marked-by-regexp (regexp)
"Exchange the set of marked files that match REGEXP with the set of
unmarked files that match."
(interactive "sRegexp: ")
(monkey-map-matches 'monkey-toggle regexp))
(defun monkey-mark-auto-save-files ()
"Mark all the autosave files. Unmarks them with a prefix."
(interactive)
(monkey-mark-by-regexp "#.*#"))
(defun monkey-mark-backup-files ()
"Mark all the backup files. Unmarks them with a prefix."
(interactive)
(monkey-mark-by-regexp ".*~"))
(defun monkey-mark-dotfiles ()
"Mark all files beginning with a `.'."
(interactive)
(monkey-mark-by-regexp "\\..*"))
(defun monkey-mark-by-type (type)
"Mark all the files of type TYPE. What a loose."
(interactive "cType: ")
(monkey-map-type
(if current-prefix-arg
'monkey-unmark
'monkey-mark)
type))
(defun monkey-mark-directories ()
"Mark all the directories."
(interactive)
(monkey-mark-by-type ?/))
(defun monkey-mark-links ()
"Mark all the symbolic links."
(interactive)
(monkey-mark-by-type ?@))
(defun monkey-mark-executables ()
"Mark all the executable files."
(interactive)
(monkey-mark-by-type ?*))
(defun monkey-mark-subdirectory ()
"Mark the current subdirectory."
(interactive)
(save-excursion
(or (monkey-expanded-p)
(monkey-directory-heading 1))
(let ((dirname (monkey-filename)))
(monkey-map-matches
(if current-prefix-arg
'monkey-unmark
'monkey-mark)
(concat (regexp-quote (concat dirname "/")) ".+")))))
(defun monkey-mark-by-extension (regexp)
"Mark all files that end with .REGEXP"
(interactive "sRegexp for extension: ")
(monkey-mark-by-regexp (concat ".*\\." regexp)))