lord+@andrew.cmu.edu (Tom Lord) (10/04/87)
mailers are choking, hence this split repost.
;
; actions on marked files
;
;
(defun monkey-shove ()
"Put the names of the marked file into a scratch buffer."
(interactive)
(let ((list-buffer (get-buffer-create "*File List*")))
(save-excursion
(set-buffer list-buffer)
(erase-buffer))
(monkey-map-marked
'(lambda ()
(let ((name (monkey-filename)))
(save-excursion
(set-buffer list-buffer)
(goto-char (point-max))
(insert name "\n")))))
(switch-to-buffer-other-window list-buffer)))
(defun monkey-mung-marked-subdirectories ()
"Expand or collapse marked subdirectories. Prefix makes a difference as
to which happens."
(interactive)
(save-excursion
(monkey-map-marked
(if current-prefix-arg
'monkey-unexpand-subdirectory
'monkey-expand-subdirectory)))
(nice-monkey))
(defun monkey-mung-this-subdirectory ()
"Expand or collapse a subdirectory. Prefix determines which."
(interactive)
(save-excursion
(if current-prefix-arg
(monkey-unexpand-subdirectory)
(monkey-expand-subdirectory)))
(nice-monkey))
(defun monkey-hide-marked ()
"Hide all marked files. With a prefix, unhide near marked lines."
(interactive)
(monkey-map-marked
(if current-prefix-arg
'monkey-unhide-line
'monkey-hide-line)
nil t))
(defun monkey-hide-this ()
"Hide this file. With a prefix, unhide near this line."
(interactive)
(if current-prefix-arg
(monkey-unhide-line)
(monkey-hide-line))
(monkey-next-line))
(defun monkey-unhide-all ()
"Unhide all files."
(interactive)
(let ((buffer-read-only nil))
(save-excursion
(unwind-protect ;redisplay does not happen correctly if this
isn't here
(progn (subst-char-in-region (point-min) (point-max) ?\r ?\n t)
(goto-char (point-min))
(replace-string "\n\n" "\n")
(goto-char (point-min))
(and (= (following-char) ?\n)
(delete-char 1))))))
(nice-monkey))
(defun monkey-list-long ()
"Show the output of ls -l'ing the marked files."
(interactive)
(with-output-to-temp-buffer "*monkey-ls-output*"
(monkey-map-marked
'(lambda ()
(call-process "ls" nil "*monkey-ls-output*" t "-ld"
(monkey-filename))))))
(defun monkey-list-this-long ()
"Show the output of ls -l'ing the marked files."
(interactive)
(save-window-excursion
(with-output-to-temp-buffer "*monkey-short-ls-output*"
(call-process "ls" nil "*monkey-short-ls-output*" t "-ld"
(monkey-filename)))
(set-buffer "*monkey-short-ls-output*")
(goto-char (point-min))
(message (buffer-substring (bol-point) (eol-point)))))
(defun monkey-confirm-deletions (deletion-list)
"Make sure that DELETION-LIST meets with the users approval."
(if (= (length deletion-list) 1)
(y-or-n-p (format "Delete %s ?" (car deletion-list)))
(save-excursion
(with-output-to-temp-buffer "*Deletions*"
(set-buffer "*Deletions*")
(while deletion-list
(insert (car deletion-list) "\n")
(setq deletion-list (cdr deletion-list)))
(display-buffer "*Deletions*")
(yes-or-no-p "Delete these files?")))))
(defun monkey-delete-marked ()
"Delete all the marked files."
(interactive)
(save-window-excursion
(let (deletion-list)
(monkey-map-marked
'(lambda ()
(setq deletion-list
(cons (monkey-filename t)
deletion-list)))
t)
(if (not (monkey-confirm-deletions deletion-list))
(message "Nothing Deleted.")
(monkey-map-marked
'(lambda ()
(delete-file-properly (monkey-filename t) 1)
(monkey-delete-line)))))))
(defun monkey-delete-this ()
"Delete all the current file."
(interactive)
(save-window-excursion
(let ((deletion-list (list (monkey-filename t))))
(if (not (monkey-confirm-deletions deletion-list))
(message "Nothing Deleted.")
(delete-file-properly (car deletion-list))
(monkey-delete-line)
(monkey-next-line 1)))))
(defun monkey-copy-file (destination &optional unhidden)
"Copy the current file to DESTINATION."
(monkey-sorted-insert-filename
(copy-file-properly (monkey-filename t) destination 1) unhidden))
(defun monkey-copy-this (destination)
"Copy the current file to DESTINATION."
(interactive "FCopy to: ")
(monkey-copy-file destination)
(nice-monkey))
(defun monkey-copy-marked (destination)
"Copy the marked files to DESTINATION."
(interactive "FCopy to: ")
(monkey-temp-unhide)
(unwind-protect
(monkey-map-marked
'(lambda () (monkey-copy-file destination t)))
(monkey-un-temp-unhide)))
(defun monkey-rename-file (destination &optional unhidden)
"Rename the current file to DESTINATION."
(save-excursion
(monkey-sorted-insert-filename
(rename-file-properly (monkey-filename t) destination 1) unhidden))
(monkey-delete-line))
(defun monkey-rename-this (destination)
"Rename the current file to DESTINATION."
(interactive "FRename to: ")
(monkey-rename-file destination)
(nice-monkey))
(defun monkey-rename-marked (destination)
"Rename the marked files to DESTINATION."
(interactive "FRename to: ")
(monkey-temp-unhide)
(unwind-protect
(monkey-map-marked
'(lambda ()
(monkey-rename-file destination t)))
(monkey-un-temp-unhide)))
;
; various ways of editting marked files
;
(defun monkey-edit-file ()
"If the current file is a directory, create a monkey-buffer for it.
Otherwise, find-file it, but don't switch to the new buffer. Someday, this
should offer to execute executables. Returns the new buffer, if any."
(save-excursion
(let ((name (monkey-filename t)))
(if (file-directory-p name)
(monkey-directory (file-name-as-directory name))
(find-file name))
(current-buffer))))
(defun monkey-edit-marked ()
"Edit all the marked files. Switch to the edit buffer for the first one
in the list."
(interactive)
(let ((destination-buffer nil))
(monkey-map-marked
'(lambda ()
(message "finding %s..." (monkey-filename))
(let ((x (monkey-edit-file)))
(setq destination-buffer (if destination-buffer 'dont-switch x)))))
(message "done.")
(or (eq destination-buffer 'dont-switch)
(switch-to-buffer destination-buffer))))
(defun monkey-edit-this ()
"Edit this file."
(interactive)
(switch-to-buffer (monkey-edit-file)))
(defun monkey-edit-marked-other-window ()
"Edit all the marked files. Switch to the edit buffer for the first
one in the other window."
(interactive)
(let ((destination-buffer nil))
(monkey-map-marked
'(lambda ()
(message "finding %s..." (monkey-filename))
(let ((x (monkey-edit-file)))
(setq destination-buffer (or destination-buffer x)))))
(switch-to-buffer-other-window destination-buffer)))
(defun monkey-edit-this-other-window ()
"Edit this file in the other window."
(interactive)
(switch-to-buffer-other-window (monkey-edit-file)))
(defun monkey-edit-marked-and-trash-this-buffer ()
"Edit all the marked files and trash this buffer."
(interactive)
(save-excursion
(monkey-edit-marked))
(kill-buffer (current-buffer)))
(defun monkey-edit-this-and-trash-this-buffer ()
"Edit all the marked files and trash this buffer."
(interactive)
(save-excursion
(monkey-edit-this))
(kill-buffer (current-buffer)))
;
; the fancy copy and rename by regexp commands
;
;
(defun monkey-copy-by-regexp (copy-by-regexp-target) ;i hate dynamic scoping
(sometimes)
"Using the regexp used last for monkey-mark-by-regexp, match each marked
filename, then copy it."
;
; the following piece of crap could be eliminated if version 19 includes the
function
; rewrite-regexp. Rewrite-regexp should take arguments SOURCE-REGEXP,
SOURCE, TARGET.
; it should match SOURCE against SOURCE-REGEXP and then rewrite TARGET in the
fasion
; of replace-match. An optional parameter should control the behaviour of
the function
; in the case that SOURCE-REGEXP and SOURCE can not be matched.
(interactive "sCopy to: ")
(if (null monkey-last-mark-regexp)
(error "You must mark files using a regexp first."))
(monkey-temp-unhide)
(unwind-protect
(monkey-map-marked
'(lambda ()
(goto-char (monkey-filename-beginning))
(if (not (looking-at monkey-last-mark-regexp))
(error "%s does not match the source regexp."
(monkey-filename)))
(let ((old-name (monkey-filename))
(buffer-read-only))
(re-search-forward monkey-last-mark-regexp nil nil)
(replace-match copy-by-regexp-target nil nil)
(let ((new-name (monkey-filename)))
(delete-region
(monkey-filename-beginning)
(monkey-filename-end))
(insert old-name)
(monkey-copy-file new-name t)))))
(monkey-un-temp-unhide)))
(defun monkey-rename-by-regexp (rename-by-regexp-target)
"Using the regexp used last for monkey-mark-by-regexp, match each marked
filename, then rename it."
(interactive "sRename to: ")
(or monkey-last-mark-regexp
(error "You must mark files using a regexp first."))
(monkey-temp-unhide)
(unwind-protect
(monkey-map-marked
'(lambda ()
(goto-char (monkey-filename-beginning))
(if (not (looking-at monkey-last-mark-regexp))
(error "%s does not match the source regexp."
(monkey-filename)))
(let ((old-name (monkey-filename))
(buffer-read-only nil))
(re-search-forward monkey-last-mark-regexp nil nil)
(replace-match rename-by-regexp-target nil nil)
(let ((new-name (monkey-filename)))
(delete-region
(monkey-filename-beginning)
(monkey-filename-end))
(insert old-name)
(monkey-rename-file new-name t)))))
(monkey-un-temp-unhide)))
;
; misc. monkey functions
;
;
(defun monkey-gee ()
"Empty the buffer, and re-list the directory. Start from
scratch."
(interactive)
(let ((buffer-read-only nil))
(erase-buffer)
(monkey-list-directory)
(goto-char (point-min)))
(nice-monkey))
(defun monkey-parent ()
"Edit the directory `..'."
(interactive)
(monkey-directory ".."))
(defun monkey-summary ()
"Give the luser a summary of monkey commands."
(interactive)
(message
(substitute-command-keys
"\\[monkey-mark-this] mark, \\[monkey-unmark-this] unmark,
\\[monkey-delete-marked] delete, many many more...M-x describe-mode")))
;
; invoking monkey
;
;
(defun monkey-directory-noselect (directory)
"Make a buffer for DIRECTORY, but don't select it.
The buffer is returned."
(let* ((name (file-name-as-directory (expand-file-name directory)))
(buffer (get-buffer-create name)))
(save-excursion
(set-buffer buffer)
(and (eq (buffer-size) 0)
(progn (setq buffer-read-only t)
(setq default-directory name)
(set-buffer-modified-p nil)
(monkey-list-directory)
(goto-char (point-min))
(goto-char (or (monkey-filename-beginning) (point)))
(monkey-mode)))
buffer)))
(defun monkey-directory (directory)
"Make a buffer for directory and monkey around with it."
(interactive "DDirectory: ")
(switch-to-buffer (monkey-directory-noselect directory)))
(defun minkey (directory)
"A nice alias for monkey-directory."
(interactive "DDirectory: ")
(monkey-directory directory))
(defvar monkey-state-stack nil
"Used for pushing and popping monkey states.")
;
; these make good replacements for
; find-file, find-alternate-file, and find-file-other-window
(defun monkey-file (file)
(interactive "FFile: ")
(if (file-directory-p file)
(monkey-directory file)
(find-file file)))
(defun monkey-alternate-file (file)
(interactive "FAlternate file: ")
(kill-buffer (current-buffer))
(monkey-file file))
(defun monkey-file-other-window (file)
(interactive "FFile other window: ")
(if (not (file-directory-p file))
(find-file-other-window file)
(let ((pop-up-windows t))
(pop-to-buffer (monkey-directory-noselect file)))))
(defun monkey-toggle-quietness ()
"Turn file stating on or off"
(interactive)
(if (setq monkey-be-fast (not monkey-be-fast))
(message "monkey: file stating turned off")
(message "monkey: file stating turned on")))
(defun monkey-copy-this-file-name ()
"Copy the current file name into the kill ring"
(interactive)
(copy-region-as-kill (monkey-filename-beginning) (monkey-filename-end)))
(defun monkey-copy-marked-file-names (&optional flag)
"Copy all of the marked file names into the kill ring
seperated by a space. Prefix arg causes filenames to be
sperated by a newline."
(interactive "P")
(let ((list-buffer (get-buffer-create "*Cut File List*"))
(sep (if flag "\n" " ")))
(save-excursion
(set-buffer list-buffer)
(erase-buffer))
(monkey-map-marked
'(lambda ()
(let ((name (monkey-filename)))
(save-excursion
(set-buffer list-buffer)
(goto-char (point-max))
(insert name sep)))))
(set-buffer list-buffer)
(copy-region-as-kill (point-min) (point-max))))
(defun monkey-shell-command ()
"Prompt for a shell command using the marked filenames as
a default command string."
(interactive)
(monkey-copy-marked-file-names)
(shell-command-on-region (point) (point)
(read-string "Shell command: "
(car kill-ring)) nil))
;
;
; added extra bonus courtesy of Joe Keane
;
;
(defun monkey-background ()
"Invoke a background process on the marked files."
(interactive)
(monkey-copy-marked-file-names)
(background (read-string "& " (car kill-ring))))
;;; Fun with background jobs
(defun background (command)
(interactive "s& ")
(cond ((= (string-to-char command) ?&) (switch-to-buffer command))
((string-match "^kill &" command) (interrupt-process (substring
command 5)))
(t (let ((job-name "&1"))
(let ((job-number 1))
(while (process-status job-name)
(setq job-number (1+ job-number))
(setq job-name (concat "&" job-number)))
(let ((process
(start-process
job-name job-name shell-file-name "-c"
(if (= (aref command 0) ?&)
(substring command 1)
(concat "exec " command)))))
(message "[%d] %d" job-number (process-id process))
(set-process-sentinel process 'background-sentinel)))
(let ((directory default-directory))
(set-buffer job-name)
(setq default-directory directory))
(erase-buffer)
(with-output-to-temp-buffer job-name
(insert "& cd " default-directory "\n& " command ?\n)))
(setq mode-name "Background")
;; Make mode line show process state
(setq mode-line-process '(": %s")))))
;; Called when background process changes state.
(defun background-sentinel (process msg)
(cond ((null (buffer-name (process-buffer process)))
;; buffer killed
(set-process-buffer process nil))
((memq (process-status process) '(signal exit))
(let* ((obuf (current-buffer))
(omax (point-max))
(opoint (point)))
;; save-excursion isn't the right thing if
;; process-buffer is current-buffer
(unwind-protect
(setq msg
(cond ((string-match "^finished$" msg) "Done")
((string-match "^exited" msg) (concat "Exit "
(substring msg 28 -1)))
(t (concat (upcase (substring msg 0 1)) (substring
msg 1 -1)))))
(message "[%s] %s %s"
(substring (process-name process) 1)
msg
(let ((command (nth 2 (process-command process))))
(if (string-match "^exec" command)
(substring command 5)
command)))
;; Write something in the buffer and hack its mode line,
(set-buffer (process-buffer process))
(goto-char (point-max))
(insert "\n*** " msg ? (substring (current-time-string) 0 -5)
?\n))
;; If buffer and mode line will show that the process
;; is dead, we can delete it now. Otherwise it
;; will stay around until M-x list-processes.
(set-buffer-modified-p nil)
;; Force mode line redisplay soon
(if (< opoint omax)
(goto-char opoint))
(set-buffer obuf)
(delete-process process)))))