Skip to content

GitLab

emacs
emacs
Commit aa228418 authored by Jim Blandy's avatar Jim Blandy
Browse files
Options

*** empty log message ***

parent 0231f2dc
Hide whitespace changes
Inline Side-by-side
Showing with 352 additions and 231 deletions
lisp/diff.el
View file @ aa228418
......@@ -29,12 +29,22 @@
;; containing 0 or more arguments which are passed on to `diff'.
;; NOTE: This is not an ordinary hook; it may not be a list of functions.")
;; - fpb@ittc.wec.com - Sep 25, 1990
;; Added code to support sccs diffing.
;; also fixed one minor glitch in the
;; search for the pattern. If you only 1 addition you won't find the end
;; of the pattern (minor)
;;
(defvar diff-switches nil
"*A list of switches to pass to the diff program.")
(defvar diff-search-pattern "^\\([0-9]\\|\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\)"
"Regular expression that delineates difference regions in diffs.")
(defvar diff-rcs-extension ",v"
"*Extension to find RCS file, some systems do not use ,v")
;; Initialize the keymap if it isn't already
(if (boundp 'diff-mode-map)
nil
......@@ -75,22 +85,78 @@ and what appears to be it's backup for OLD."
(message "Comparing files %s %s..." new old)
(setq new (expand-file-name new)
old (expand-file-name old))
(let ((buffer-read-only nil)
(sw diff-switches))
(diff-internal-diff "diff" (append diff-switches (list new old)) nil))
(defun diff-sccs (new)
"Find and display the differences between OLD and SCCS files."
(interactive
(let (newf)
(list
(setq newf (buffer-file-name)
newf (if (and newf (file-exists-p newf))
(read-file-name
(concat "Diff new file: ("
(file-name-nondirectory newf) ") ")
nil newf t)
(read-file-name "Diff new file: " nil nil t))))))
(message "Comparing SCCS file %s..." new)
(setq new (expand-file-name new))
(if (file-exists-p (concat
(file-name-directory new)
"SCCS/s."
(file-name-nondirectory new)))
(diff-internal-diff "sccs"
(append '("diffs") diff-switches (list new))
2)
(error "%s does not exist"
(concat (file-name-directory new) "SCCS/s."
(file-name-nondirectory new)))))
(defun diff-rcs (new)
"Find and display the differences between OLD and RCS files."
(interactive
(let (newf)
(list
(setq newf (buffer-file-name)
newf (if (and newf (file-exists-p newf))
(read-file-name
(concat "Diff new file: ("
(file-name-nondirectory newf) ") ")
nil newf t)
(read-file-name "Diff new file: " nil nil t))))))
(message "Comparing RCS file %s..." new)
(let* ((fullname (expand-file-name new))
(rcsfile (concat (file-name-directory fullname)
"RCS/"
(file-name-nondirectory fullname)
diff-rcs-extension)))
(if (file-exists-p rcsfile)
(diff-internal-diff "rcsdiff" (append diff-switches (list fullname)) 4)
(error "%s does not exist" rcsfile))))
(defun diff-internal-diff (diff-command sw strip)
(let ((buffer-read-only nil))
(with-output-to-temp-buffer "*Diff Output*"
(buffer-disable-undo standard-output)
(save-excursion
(set-buffer standard-output)
(erase-buffer)
(apply 'call-process "diff" nil t nil
(append diff-switches (list old new)))))
(apply 'call-process diff-command nil t nil sw)))
(set-buffer "*Diff Output*")
(goto-char (point-min))
(while sw
(if (string= (car sw) "-c")
;; strip leading filenames from context diffs
(progn (forward-line 2) (delete-region (point-min) (point))))
(setq sw (cdr sw))))
(if (and (string= (car sw) "-C") (string= "sccs" diff-command))
;; strip stuff from SCCS context diffs
(progn (forward-line 2) (delete-region (point-min) (point))))
(setq sw (cdr sw)))
(if strip
;; strip stuff from SCCS context diffs
(progn (forward-line strip) (delete-region (point-min) (point)))))
(diff-mode)
(if (string= "0" diff-total-differences)
(let ((buffer-read-only nil))
......@@ -103,7 +169,7 @@ and what appears to be it's backup for OLD."
(goto-char (point-max)))))
(setq diff-current-difference "1")))
;; Take a buffer full of Unix diff output and go into a mode to easily
;; Take a buffer full of Unix diff output and go into a mode to easily
;; see the next and previous difference
(defun diff-mode ()
"Diff Mode is used by \\[diff] for perusing the output from the diff program.
......@@ -129,8 +195,8 @@ All normal editing commands are turned off. Instead, these are available:
(int-to-string (diff-count-differences))))
(defun diff-next-difference (n)
"In diff mode, go to the beginning of the next difference as delimited
by `diff-search-pattern'."
"Go to the beginning of the next difference.
Differences are delimited by `diff-search-pattern'."
(interactive "p")
(if (< n 0) (diff-previous-difference (- n))
(if (zerop n) ()
......@@ -153,8 +219,8 @@ by `diff-search-pattern'."
(goto-char (point-min)))))
(defun diff-previous-difference (n)
"In diff mode, go the the beginning of the previous difference as delimited
by `diff-search-pattern'."
"Go the the beginning of the previous difference.
Differences are delimited by `diff-search-pattern'."
(interactive "p")
(if (< n 0) (diff-next-difference (- n))
(if (zerop n) ()
......@@ -172,7 +238,7 @@ by `diff-search-pattern'."
(goto-char (point-min)))))
(defun diff-show-difference (n)
"Show difference number N (prefix arg)."
"Show difference number N (prefix argument)."
(interactive "p")
(let ((cur (string-to-int diff-current-difference)))
(cond ((or (= n cur)
......
lisp/find-dired.el
View file @ aa228418
;;; find-dired.el -- Run a `find' command and dired the result.
;;; find-dired.el -- Run a `find' command and dired the output
;;; Copyright (C) 1991 Roland McGrath
(defconst find-dired-version "$Id: find-dired.el,v 1.7 1991/06/20 08:50:20 sk RelBeta $")
(defconst find-dired-version (substring "$Revision: 1.9 $" 11 -2)
"$Id: find-dired.el,v 1.9 1991/11/11 13:24:31 sk Exp $")
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
......@@ -18,43 +19,67 @@
;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
;;; 02139, USA.
;;;
;;; Send bug reports to roland@gnu.ai.mit.edu.
;;; To use this file, byte-compile it, install it somewhere
;;; in your load-path, and put:
;;; (autoload 'find-dired "find-dired" nil t)
;;; (autoload 'lookfor-dired "find-dired" nil t)
;;; in your .emacs, or site-init.el, etc.
;;; To bind it to a key, put, e.g.:
;;; (global-set-key "\C-cf" 'find-dired)
;;; (global-set-key "\C-cl" 'lookfor-dired)
;;; in your .emacs.
;; LISPDIR ENTRY for the Elisp Archive ===============================
;; LCD Archive Entry:
;; find-dired|Roland McGrath, Sebastian Kremer
;; |roland@gnu.ai.mit.edu, sk@thp.uni-koeln.de
;; |Run a `find' command and dired the output
;; |$Date: 1991/11/11 13:24:31 $|$Revision: 1.9 $|
(require 'dired)
;; INSTALLATION ======================================================
(defvar find-args nil
"Last arguments given to `find' by \\[find-dired].")
;; To use this file, byte-compile it, install it somewhere in your
;; load-path, and put:
;; (autoload 'find-dired "find-dired" nil t)
;; (autoload 'find-name-dired "find-dired" nil t)
;; (autoload 'find-grep-dired "find-dired" nil t)
;; in your ~/.emacs, or site-init.el, etc.
;; To bind it to a key, put, e.g.:
;;
;; (global-set-key "\C-cf" 'find-dired)
;; (global-set-key "\C-cn" 'find-name-dired)
;; (global-set-key "\C-cl" 'find-grep-dired)
;;
;; in your ~/.emacs.
(require 'dired)
(provide 'find-dired)
;;;###autoload
(defvar find-ls-option (if (eq system-type 'berkeley-unix) "-ls"
"-exec ls -ldi {} \\;")
"Option to `find' to produce an `ls -l'-type listing.")
"*Option to `find' to produce an `ls -l'-type listing.")
;;;###autoload
(defvar find-grep-options (if (eq system-type 'berkeley-unix) "-s" "-l")
"*Option to grep to be as silent as possible.
On Berkeley systems, this is `-s', for others it seems impossible to
suppress all output, so `-l' is used to print nothing more than the
file name.")
(defvar find-args nil
"Last arguments given to `find' by \\[find-dired].")
;;;###autoload
(defun find-dired (dir args)
"Run `find' and go into dired-mode on a buffer of the output.
The command run is \"find . \\( ARGS \\) -ls\" (after changing into DIR)."
The command run (after changing into DIR) is
find . \\( ARGS \\) -ls"
(interactive (list (read-file-name "Run find in directory: " nil "" t)
(if (featurep 'gmhist)
(read-with-history-in 'find-args-history
"Run find (with args): ")
(read-string "Run find (with args): " find-args))))
(if (equal dir "")
(setq dir default-directory))
;; Expand DIR, and make sure it has a trailing slash.
;; Expand DIR ("" means default-directory), and make sure it has a
;; trailing slash.
(setq dir (file-name-as-directory (expand-file-name dir)))
;; Check that it's really a directory.
(or (file-directory-p dir)
(error "%s is not a directory!" dir))
(error "find-dired needs a directory: %s" dir))
(switch-to-buffer (get-buffer-create "*Find*"))
(widen)
(kill-all-local-variables)
......@@ -64,25 +89,63 @@ The command run is \"find . \\( ARGS \\) -ls\" (after changing into DIR)."
find-args args
args (concat "find . " (if (string= args "") ""
(concat "\\( " args " \\) ")) find-ls-option))
(insert " " args "\n"
" " dir ":\n")
(dired-mode dir "-gils");; find(1)'s -ls corresponds to `ls -gilds'
;; (but we don't want -d, of course)
;; Set subdir-alist so that Tree Dired will work (but STILL NOT with
;; dired-nstd.el):
(set (make-local-variable 'dired-subdir-alist)
(list (cons default-directory (point-marker)))) ; we are at point-min
(setq buffer-read-only nil)
;; Subdir headlerline must come first because the first marker in
;; subdir-alist points there.
(insert " " dir ":\n")
;; Make second line a ``find'' line in analogy to the ``total'' or
;; ``wildcard'' line.
(insert " " args "\n")
;; Start the find process
(set-process-filter (start-process-shell-command "find"
(current-buffer) args)
'find-dired-filter)
(function find-dired-filter))
(set-process-sentinel (get-buffer-process (current-buffer))
'find-dired-sentinel)
(dired-mode)
(function find-dired-sentinel))
(setq mode-line-process '(": %s")))
;;;###autoload
(defun find-name-dired (dir pattern)
"Search DIR recursively for files matching the globbing pattern PATTERN,
and run dired on those files."
(interactive "DSearch directory: \nsSearch directory %s for: ")
and run dired on those files.
PATTERN is a shell wildcard (not an Emacs regexp) and need not be quoted.
The command run (after changing into DIR) is
find . -name 'PATTERN' -ls"
(interactive
"DFind-name (directory): \nsFind-name (filename wildcard): ")
(find-dired dir (concat "-name '" pattern "'")))
;; This functionality suggested by
;; From: oblanc@watcgl.waterloo.edu (Olivier Blanc)
;; Subject: find-dired, lookfor-dired
;; Date: 10 May 91 17:50:00 GMT
;; Organization: University of Waterloo
(fset 'lookfor-dired 'find-grep-dired)
;;;###autoload
(defun find-grep-dired (dir args)
"Find files in DIR containing a regexp ARG and start Dired on output.
The command run (after changing into DIR) is
find . -exec grep -s ARG {} \\\; -ls
Thus ARG can also contain additional grep options."
(interactive "DFind-grep (directory): \nsFind-grep (grep args): ")
;; find -exec doesn't allow shell i/o redirections in the command,
;; or we could use `grep -l >/dev/null'
(find-dired dir
(concat "-exec grep " find-grep-options " " args " {} \\\; ")))
(defun find-dired-filter (proc string)
;; Filter for \\[find-dired] processes.
(dired-log "``%s''\n" string)
(let ((buf (process-buffer proc)))
(if (buffer-name buf) ; not killed?
(save-excursion
......@@ -99,7 +162,13 @@ and run dired on those files."
(forward-line 1))
(while (looking-at "^")
(insert " ")
(forward-line 1))))))
(forward-line 1))
;; Convert ` ./FILE' to ` FILE'
;; This would lose if the current chunk of output
;; starts or ends within the ` ./', so backup up a bit:
(goto-char (- end 3)) ; no error if < 0
(while (search-forward " ./" nil t)
(delete-region (point) (- (point) 2)))))))
;; The buffer has been killed.
(delete-process proc))))
......@@ -129,51 +198,5 @@ Wildcards and redirection are handle as usual in the shell."
(if (eq system-type 'vax-vms)
(apply 'start-process name buffer args)
(start-process name buffer shell-file-name "-c"
(concat "exec " (mapconcat 'identity args " ")))))
)
(concat "exec " (mapconcat 'identity args " "))))))
;; From: oblanc@watcgl.waterloo.edu (Olivier Blanc)
;; Subject: find-dired, lookfor-dired
;; Date: 10 May 91 17:50:00 GMT
;; Organization: University of Waterloo
;; I added a functiopn to the find-dired.el file:
;; The function is a lookfor-dired and is used to search a string
;; a subtree:
;;;###autoload
(defun lookfor-dired (dir args)
"Find files in DIR containing a regexp ARG and go into dired-mode on the output.
The command run is
\"find . -exec grep -l ARG {} \\\; -ls\"
\(after changing into DIR)."
(interactive (list (read-file-name "Run find in directory: " nil "" t)
(read-string "Run find (with args): " find-args)))
(if (equal dir "")
(setq dir default-directory))
;; Expand DIR, and make sure it has a trailing slash.
(setq dir (file-name-as-directory (expand-file-name dir)))
;; Check that it's really a directory.
(or (file-directory-p dir)
(error "%s is not a directory!" dir))
(switch-to-buffer (get-buffer-create "*Find*"))
(widen)
(kill-all-local-variables)
(setq buffer-read-only nil)
(erase-buffer)
(setq default-directory dir
find-args args
args (concat "find . -exec grep -l " args " {} \\\; -ls"))
(insert " " args "\n"
" " dir ":\n")
(set-process-filter (start-process-shell-command "find"
(current-buffer) args)
'find-dired-filter)
(set-process-sentinel (get-buffer-process (current-buffer))
'find-dired-sentinel)
(dired-mode)
(setq mode-line-process '(": %s")))
(provide 'find-dired)
lisp/mail/emacsbug.el
View file @ aa228418
......@@ -27,8 +27,9 @@
(defvar bug-gnu-emacs "bug-gnu-emacs@prep.ai.mit.edu"
"Address of site maintaining mailing list for GNU Emacs bugs.")
;;;###autoload
(defun report-emacs-bug (topic)
"Report a bug in Gnu emacs.
"Report a bug in GNU Emacs.
Prompts for bug subject. Leaves you in a mail buffer."
(interactive "sBug Subject: ")
(mail nil bug-gnu-emacs topic)
......
lisp/mail/mailabbrev.el
View file @ aa228418
......@@ -120,11 +120,12 @@
;; originally defined in sendmail.el - used to be an alist, now is a table.
(defvar mail-aliases nil
"Word-abbrev table of mail address aliases.
"Abbrev table of mail address aliases.
If this is nil, it means the aliases have not yet been initialized and
should be read from the .mailrc file. (This is distinct from there being
no aliases, which is represented by this being a table with no entries.)")
;;;###autoload
(defun mail-aliases-setup ()
(if (and (not (vectorp mail-aliases))
(file-exists-p (mail-abbrev-mailrc-file)))
......@@ -217,6 +218,7 @@ also want something like \",\\n \" to get each address on its own line.")
;; originally defined in mailalias.el ; build-mail-aliases calls this with
;; stuff parsed from the .mailrc file.
;;
;;;###autoload
(defun define-mail-alias (name definition &optional from-mailrc-file)
"Define NAME as a mail-alias that translates to DEFINITION.
If DEFINITION contains multiple addresses, seperate them with commas."
......@@ -295,10 +297,9 @@ If DEFINITION contains multiple addresses, seperate them with commas."
(defun mail-abbrev-expand-hook ()
"For use as the fourth arg to define-abbrev.
After expanding a mail-abbrev, if fill-mode is on and we're past the
fill-column, break the line at the previous comma, and indent the next
line."
"For use as the fourth arg to `define-abbrev'.
After expanding a mail alias, if Auto Fill mode is on and we're past the
fill column, break the line at the previous comma, and indent the next line."
(save-excursion
(let ((p (point))
bol)
......@@ -337,7 +338,7 @@ This should be set to match those mail fields in which you want abbreviations
turned on.")
(defvar mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table)
"The syntax table which is current in send-mail mode.")
"The syntax table which is current in mail mode.")
(defvar mail-mode-header-syntax-table
(let ((tab (copy-syntax-table text-mode-syntax-table)))
......@@ -362,7 +363,9 @@ turned on.")
"The syntax table used when the cursor is in a mail-address header.
mail-mode-syntax-table is used when the cursor is not in an address header.")
;; This hook is run before trying to expand an abbrev in a mail buffer.
;; It determines whether point is in the header, and chooses which
;; abbrev table accordingly.
(defun sendmail-pre-abbrev-expand-hook ()
(if mail-abbrev-aliases-need-to-be-resolved
(mail-resolve-all-aliases))
......@@ -425,17 +428,5 @@ mail-mode-syntax-table is used when the cursor is not in an address header.")
(setq mail-aliases nil)
(build-mail-aliases file))
;;; Patching it in:
;;; Remove the entire file mailalias.el
;;; Remove the definition of mail-aliases from sendmail.el
;;; Add a call to mail-aliases-setup to mail-setup in sendmail.el
;;; Remove the call to expand-mail-aliases from sendmail-send-it in sendmail.el
;;; Remove the autoload of expand-mail-aliases from sendmail.el
;;; Remove the autoload of build-mail-aliases from sendmail.el
;;; Add an autoload of define-mail-alias
(fmakunbound 'expand-mail-aliases)
(provide 'mail-abbrevs)
lisp/mail/mailalias.el
View file @ aa228418
......@@ -142,17 +142,27 @@ DEFINITION can be one or more mail addresses separated by commas."
(setq mail-aliases nil)
(if (file-exists-p "~/.mailrc")
(build-mail-aliases))))
(let (tem)
;; ~/.mailrc contains addresses separated by spaces.
;; mailers should expect addresses separated by commas.
(while (setq tem (string-match "[^ \t,][ \t,]+" definition tem))
(if (= (match-end 0) (length definition))
(setq definition (substring definition 0 (1+ tem)))
(setq definition (concat (substring definition
0 (1+ tem))
", "
(substring definition (match-end 0))))
(setq tem (+ 3 tem))))
;; Strip leading and trailing blanks.
(if (string-match "^[ \t]+" definition)
(setq definition (substring definition (match-end 0))))
(if (string-match "[ \t]+$" definition)
(setq definition (substring definition 0 (match-beginning 0))))
(let ((first (aref definition 0))
(last (aref definition (1- (length definition))))
tem)
(if (and (= first last) (memq first '(?\' ?\")))
;; Strip quotation marks.
(setq definition (substring definition 1 (1- (length definition))))
;; ~/.mailrc contains addresses separated by spaces.
;; mailers should expect addresses separated by commas.
(while (setq tem (string-match "[^ \t,][ \t,]+" definition tem))
(if (= (match-end 0) (length definition))
(setq definition (substring definition 0 (1+ tem)))
(setq definition (concat (substring definition
0 (1+ tem))
", "
(substring definition (match-end 0))))
(setq tem (+ 3 tem)))))
(setq tem (assoc name mail-aliases))
(if tem
(rplacd tem definition)
......
lisp/mail/rmail.el
View file @ aa228418
;; "RMAIL" mail reader for Emacs.
;; Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc.
;; Copyright (C) 1985, 1986, 1987, 1988, 1991 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
......@@ -638,7 +638,7 @@ argument causes us to read a file name and use that file as the inbox."
(concat "^[\^_]?\\("
"From [^ \n]*\\(\\|\".*\"[^ \n]*\\) ?[^ \n]* [^ \n]* *"
"[0-9]* [0-9:]*\\( ?[A-Z]?[A-Z][A-Z]T\\| ?[-+]?[0-9][0-9][0-9][0-9]\\|\\) " ; EDT, -0500
"19[0-9]* *\\(remote from [^\n]*\\)?$\\|"
"[0-9]+ *\\(remote from [^\n]*\\)?$\\|"
mmdf-delim1 "\\|"
"^BABYL OPTIONS:\\|"
"\^L\n[01],\\)") nil t)
......@@ -684,7 +684,7 @@ argument causes us to read a file name and use that file as the inbox."
(goto-char start))
(let ((case-fold-search nil))
(if (re-search-forward
"^From \\([^ ]*\\(\\|\".*\"[^ ]*\\)\\) ?\\([^ ]*\\) \\([^ ]*\\) *\\([0-9]*\\) \\([0-9:]*\\)\\( ?[A-Z]?[A-Z][A-Z]T\\| ?[-+]?[0-9][0-9][0-9][0-9]\\|\\) 19\\([0-9]*\\) *\\(remote from [^\n]*\\)?\n" nil t)
"^From \\([^ ]*\\(\\|\".*\"[^ ]*\\)\\) ?\\([^ ]*\\) \\([^ ]*\\) *\\([0-9]*\\) \\([0-9:]*\\)\\( ?[A-Z]?[A-Z][A-Z]T\\| ?[-+]?[0-9][0-9][0-9][0-9]\\|\\) [0-9][0-9]\\([0-9]*\\) *\\(remote from [^\n]*\\)?\n" nil t)
(replace-match
(concat
"Mail-from: \\&"
......
lisp/mail/sendmail.el
View file @ aa228418
......@@ -50,11 +50,6 @@ The headers are be delimited by a line which is mail-header-separator.")
*Name of file to write all outgoing messages in, or nil for none.
Do not use an rmail file here! Instead, use its inbox file.")
;;;###autoload
(defvar mail-aliases t "\
Alias of mail address aliases,
or t meaning should be initialized from .mailrc.")
(defvar mail-default-reply-to nil
"*Address to insert as default Reply-to field of outgoing messages.")
......@@ -92,22 +87,9 @@ so you can edit or delete these lines.")
(setq mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table))
(modify-syntax-entry ?% ". " mail-mode-syntax-table)))
(autoload 'build-mail-aliases "mailalias"
"Read mail aliases from ~/.mailrc and set mail-aliases."
nil)
(autoload 'expand-mail-aliases "mailalias"
"Expand all mail aliases in suitable header fields found between BEG and END.
Suitable header fields are To, CC and BCC."
nil)
(defun mail-setup (to subject in-reply-to cc replybuffer actions)
(setq mail-send-actions actions)
(if (eq mail-aliases t)
(progn
(setq mail-aliases nil)
(if (file-exists-p "~/.mailrc")
(build-mail-aliases))))
(mail-aliases-setup)
(setq mail-reply-buffer replybuffer)
(goto-char (point-min))
(insert "To: ")
......@@ -258,8 +240,6 @@ the user from the mailer."
(replace-match "\n")
(backward-char 1)
(setq delimline (point-marker))
(if mail-aliases
(expand-mail-aliases (point-min) delimline))
(goto-char (point-min))
;; ignore any blank lines in the header
(while (and (re-search-forward "\n\n\n*" delimline t)
......
lisp/man.el
View file @ aa228418
......@@ -136,6 +136,16 @@ where SECTION is the desired section of the manual, as in \"tty(4)\"."
(while (re-search-forward "\e[789]" nil t)
(replace-match ""))
;; Convert o^H+ into o.
(goto-char (point-min))
(while (re-search-forward "o\010\\+" nil t)
(replace-match "o"))
;; Nuke the dumb reformatting message
(goto-char (point-min))
(while (re-search-forward "Reformatting page. Wait... done\n\n" nil t)
(replace-match ""))
;; Crunch blank lines
(goto-char (point-min))
(while (re-search-forward "\n\n\n\n*" nil t)
......
lisp/map-ynp.el
View file @ aa228418
......@@ -63,27 +63,27 @@ ESC or q to exit (skip all following objects); . (period) to act on the
current object and then exit; or \\[help-command] to get help.
Returns the number of actions taken."
(let ((old-help-form help-form)
(help-form (cons 'map-y-or-n-p-help
(or help '("object" "objects" "act on"))))
(actions 0)
prompt
char
elt
(next (if (or (symbolp list)
(subrp list)
(compiled-function-p list)
(and (consp list)
(eq (car list) 'lambda)))
(function (lambda ()
(setq elt (funcall list))))
(function (lambda ()
(if list
(progn
(setq elt (car list)
list (cdr list))
t)
nil))))))
(let* ((old-help-form help-form)
(help-form (cons 'map-y-or-n-p-help
(or help '("object" "objects" "act on"))))
(actions 0)
prompt
char
elt
(next (if (or (symbolp list)
(subrp list)
(compiled-function-p list)
(and (consp list)
(eq (car list) 'lambda)))
(function (lambda ()
(setq elt (funcall list))))
(function (lambda ()
(if list
(progn
(setq elt (car list)
list (cdr list))
t)
nil))))))
(if (stringp prompter)
(setq prompter (` (lambda (object)
(format (, prompter) object)))))
......@@ -122,7 +122,7 @@ Returns the number of actions taken."
(progn
(funcall actor elt)
(setq actions (1+ actions))))
(while (setq elt (funcall next))
(while (funcall next)
(if (eval (funcall prompter elt))
(progn
(funcall actor elt)
......
lisp/progmodes/compile.el
View file @ aa228418
......@@ -45,15 +45,17 @@ It should read in the source files which have errors and set
`compilation-error-list' to a list with an element for each error message
found. See that variable for more info.")