procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

*** empty log message ***

Browse source
This commit is contained in:
Jim Blandy 1991-12-21 09:14:03 +00:00
parent 0231f2dce8
commit aa228418e9
12 changed files with 351 additions and 230 deletions
Download patch file Download diff file Expand all files Collapse all files

86
lisp/diff.el
View file

@ -29,12 +29,22 @@
;; containing 0 or more arguments which are passed on to `diff'. ;; 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.") ;; 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 (defvar diff-switches nil
"*A list of switches to pass to the diff program.") "*A list of switches to pass to the diff program.")
(defvar diff-search-pattern "^\\([0-9]\\|\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\)" (defvar diff-search-pattern "^\\([0-9]\\|\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\)"
"Regular expression that delineates difference regions in diffs.") "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 ;; Initialize the keymap if it isn't already
(if (boundp 'diff-mode-map) (if (boundp 'diff-mode-map)
nil nil
@ -75,22 +85,78 @@ and what appears to be it's backup for OLD."
(message "Comparing files %s %s..." new old) (message "Comparing files %s %s..." new old)
(setq new (expand-file-name new) (setq new (expand-file-name new)
old (expand-file-name old)) old (expand-file-name old))
(let ((buffer-read-only nil) (diff-internal-diff "diff" (append diff-switches (list new old)) nil))
(sw diff-switches))
(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*" (with-output-to-temp-buffer "*Diff Output*"
(buffer-disable-undo standard-output) (buffer-disable-undo standard-output)
(save-excursion (save-excursion
(set-buffer standard-output) (set-buffer standard-output)
(erase-buffer) (erase-buffer)
(apply 'call-process "diff" nil t nil (apply 'call-process diff-command nil t nil sw)))
(append diff-switches (list old new)))))
(set-buffer "*Diff Output*") (set-buffer "*Diff Output*")
(goto-char (point-min)) (goto-char (point-min))
(while sw (while sw
(if (string= (car sw) "-c") (if (string= (car sw) "-c")
;; strip leading filenames from context diffs ;; strip leading filenames from context diffs
(progn (forward-line 2) (delete-region (point-min) (point)))) (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) (diff-mode)
(if (string= "0" diff-total-differences) (if (string= "0" diff-total-differences)
(let ((buffer-read-only nil)) (let ((buffer-read-only nil))
@ -129,8 +195,8 @@ All normal editing commands are turned off. Instead, these are available:
(int-to-string (diff-count-differences)))) (int-to-string (diff-count-differences))))
(defun diff-next-difference (n) (defun diff-next-difference (n)
"In diff mode, go to the beginning of the next difference as delimited "Go to the beginning of the next difference.
by `diff-search-pattern'." Differences are delimited by `diff-search-pattern'."
(interactive "p") (interactive "p")
(if (< n 0) (diff-previous-difference (- n)) (if (< n 0) (diff-previous-difference (- n))
(if (zerop n) () (if (zerop n) ()
@ -153,8 +219,8 @@ by `diff-search-pattern'."
(goto-char (point-min))))) (goto-char (point-min)))))
(defun diff-previous-difference (n) (defun diff-previous-difference (n)
"In diff mode, go the the beginning of the previous difference as delimited "Go the the beginning of the previous difference.
by `diff-search-pattern'." Differences are delimited by `diff-search-pattern'."
(interactive "p") (interactive "p")
(if (< n 0) (diff-next-difference (- n)) (if (< n 0) (diff-next-difference (- n))
(if (zerop n) () (if (zerop n) ()
@ -172,7 +238,7 @@ by `diff-search-pattern'."
(goto-char (point-min))))) (goto-char (point-min)))))
(defun diff-show-difference (n) (defun diff-show-difference (n)
"Show difference number N (prefix arg)." "Show difference number N (prefix argument)."
(interactive "p") (interactive "p")
(let ((cur (string-to-int diff-current-difference))) (let ((cur (string-to-int diff-current-difference)))
(cond ((or (= n cur) (cond ((or (= n cur)

175
lisp/find-dired.el
View file

@ -1,7 +1,8 @@
;;; 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 ;;; 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 ;;; 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 ;;; 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 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
;;; 02139, USA. ;;; 02139, USA.
;;; ;;;
;;; Send bug reports to roland@gnu.ai.mit.edu. ;; 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 $|
;;; To use this file, byte-compile it, install it somewhere ;; INSTALLATION ======================================================
;;; in your load-path, and put:
;;; (autoload 'find-dired "find-dired" nil t) ;; To use this file, byte-compile it, install it somewhere in your
;;; (autoload 'lookfor-dired "find-dired" nil t) ;; load-path, and put:
;;; in your .emacs, or site-init.el, etc.
;;; To bind it to a key, put, e.g.: ;; (autoload 'find-dired "find-dired" nil t)
;;; (global-set-key "\C-cf" 'find-dired) ;; (autoload 'find-name-dired "find-dired" nil t)
;;; (global-set-key "\C-cl" 'lookfor-dired) ;; (autoload 'find-grep-dired "find-dired" nil t)
;;; in your .emacs.
;; 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) (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.")
;;;###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 (defvar find-args nil
"Last arguments given to `find' by \\[find-dired].") "Last arguments given to `find' by \\[find-dired].")
(defvar find-ls-option (if (eq system-type 'berkeley-unix) "-ls"
"-exec ls -ldi {} \\;")
"Option to `find' to produce an `ls -l'-type listing.")
;;;###autoload ;;;###autoload
(defun find-dired (dir args) (defun find-dired (dir args)
"Run `find' and go into dired-mode on a buffer of the output. "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) (interactive (list (read-file-name "Run find in directory: " nil "" t)
(if (featurep 'gmhist) (if (featurep 'gmhist)
(read-with-history-in 'find-args-history (read-with-history-in 'find-args-history
"Run find (with args): ") "Run find (with args): ")
(read-string "Run find (with args): " find-args)))) (read-string "Run find (with args): " find-args))))
(if (equal dir "") ;; Expand DIR ("" means default-directory), and make sure it has a
(setq dir default-directory)) ;; trailing slash.
;; Expand DIR, and make sure it has a trailing slash.
(setq dir (file-name-as-directory (expand-file-name dir))) (setq dir (file-name-as-directory (expand-file-name dir)))
;; Check that it's really a directory. ;; Check that it's really a directory.
(or (file-directory-p dir) (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*")) (switch-to-buffer (get-buffer-create "*Find*"))
(widen) (widen)
(kill-all-local-variables) (kill-all-local-variables)
@ -64,25 +89,63 @@ The command run is \"find . \\( ARGS \\) -ls\" (after changing into DIR)."
find-args args find-args args
args (concat "find . " (if (string= args "") "" args (concat "find . " (if (string= args "") ""
(concat "\\( " args " \\) ")) find-ls-option)) (concat "\\( " args " \\) ")) find-ls-option))
(insert " " args "\n" (dired-mode dir "-gils");; find(1)'s -ls corresponds to `ls -gilds'
" " dir ":\n") ;; (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" (set-process-filter (start-process-shell-command "find"
(current-buffer) args) (current-buffer) args)
'find-dired-filter) (function find-dired-filter))
(set-process-sentinel (get-buffer-process (current-buffer)) (set-process-sentinel (get-buffer-process (current-buffer))
'find-dired-sentinel) (function find-dired-sentinel))
(dired-mode)
(setq mode-line-process '(": %s"))) (setq mode-line-process '(": %s")))
;;;###autoload ;;;###autoload
(defun find-name-dired (dir pattern) (defun find-name-dired (dir pattern)
"Search DIR recursively for files matching the globbing pattern PATTERN, "Search DIR recursively for files matching the globbing pattern PATTERN,
and run dired on those files." and run dired on those files.
(interactive "DSearch directory: \nsSearch directory %s for: ") 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 "'"))) (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) (defun find-dired-filter (proc string)
;; Filter for \\[find-dired] processes. ;; Filter for \\[find-dired] processes.
(dired-log "``%s''\n" string)
(let ((buf (process-buffer proc))) (let ((buf (process-buffer proc)))
(if (buffer-name buf) ; not killed? (if (buffer-name buf) ; not killed?
(save-excursion (save-excursion
@ -99,7 +162,13 @@ and run dired on those files."
(forward-line 1)) (forward-line 1))
(while (looking-at "^") (while (looking-at "^")
(insert " ") (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. ;; The buffer has been killed.
(delete-process proc)))) (delete-process proc))))
@ -129,51 +198,5 @@ Wildcards and redirection are handle as usual in the shell."
(if (eq system-type 'vax-vms) (if (eq system-type 'vax-vms)
(apply 'start-process name buffer args) (apply 'start-process name buffer args)
(start-process name buffer shell-file-name "-c" (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)

3
lisp/mail/emacsbug.el
View file

@ -27,8 +27,9 @@
(defvar bug-gnu-emacs "bug-gnu-emacs@prep.ai.mit.edu" (defvar bug-gnu-emacs "bug-gnu-emacs@prep.ai.mit.edu"
"Address of site maintaining mailing list for GNU Emacs bugs.") "Address of site maintaining mailing list for GNU Emacs bugs.")
;;;###autoload
(defun report-emacs-bug (topic) (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." Prompts for bug subject. Leaves you in a mail buffer."
(interactive "sBug Subject: ") (interactive "sBug Subject: ")
(mail nil bug-gnu-emacs topic) (mail nil bug-gnu-emacs topic)

29
lisp/mail/mailabbrev.el
View file

@ -120,11 +120,12 @@
;; originally defined in sendmail.el - used to be an alist, now is a table. ;; originally defined in sendmail.el - used to be an alist, now is a table.
(defvar mail-aliases nil (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 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 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.)") no aliases, which is represented by this being a table with no entries.)")
;;;###autoload
(defun mail-aliases-setup () (defun mail-aliases-setup ()
(if (and (not (vectorp mail-aliases)) (if (and (not (vectorp mail-aliases))
(file-exists-p (mail-abbrev-mailrc-file))) (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 ;; originally defined in mailalias.el ; build-mail-aliases calls this with
;; stuff parsed from the .mailrc file. ;; stuff parsed from the .mailrc file.
;; ;;
;;;###autoload
(defun define-mail-alias (name definition &optional from-mailrc-file) (defun define-mail-alias (name definition &optional from-mailrc-file)
"Define NAME as a mail-alias that translates to DEFINITION. "Define NAME as a mail-alias that translates to DEFINITION.
If DEFINITION contains multiple addresses, seperate them with commas." 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 () (defun mail-abbrev-expand-hook ()
"For use as the fourth arg to define-abbrev. "For use as the fourth arg to `define-abbrev'.
After expanding a mail-abbrev, if fill-mode is on and we're past the 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 fill column, break the line at the previous comma, and indent the next line."
line."
(save-excursion (save-excursion
(let ((p (point)) (let ((p (point))
bol) bol)
@ -337,7 +338,7 @@ This should be set to match those mail fields in which you want abbreviations
turned on.") turned on.")
(defvar mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table) (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 (defvar mail-mode-header-syntax-table
(let ((tab (copy-syntax-table text-mode-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. "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.") 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 () (defun sendmail-pre-abbrev-expand-hook ()
(if mail-abbrev-aliases-need-to-be-resolved (if mail-abbrev-aliases-need-to-be-resolved
(mail-resolve-all-aliases)) (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) (setq mail-aliases nil)
(build-mail-aliases file)) (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) (provide 'mail-abbrevs)

32
lisp/mail/mailalias.el
View file

@ -142,17 +142,27 @@ DEFINITION can be one or more mail addresses separated by commas."
(setq mail-aliases nil) (setq mail-aliases nil)
(if (file-exists-p "~/.mailrc") (if (file-exists-p "~/.mailrc")
(build-mail-aliases)))) (build-mail-aliases))))
(let (tem) ;; Strip leading and trailing blanks.
;; ~/.mailrc contains addresses separated by spaces. (if (string-match "^[ \t]+" definition)
;; mailers should expect addresses separated by commas. (setq definition (substring definition (match-end 0))))
(while (setq tem (string-match "[^ \t,][ \t,]+" definition tem)) (if (string-match "[ \t]+$" definition)
(if (= (match-end 0) (length definition)) (setq definition (substring definition 0 (match-beginning 0))))
(setq definition (substring definition 0 (1+ tem))) (let ((first (aref definition 0))
(setq definition (concat (substring definition (last (aref definition (1- (length definition))))
0 (1+ tem)) tem)
", " (if (and (= first last) (memq first '(?\' ?\")))
(substring definition (match-end 0)))) ;; Strip quotation marks.
(setq tem (+ 3 tem)))) (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)) (setq tem (assoc name mail-aliases))
(if tem (if tem
(rplacd tem definition) (rplacd tem definition)

6
lisp/mail/rmail.el
View file

@ -1,5 +1,5 @@
;; "RMAIL" mail reader for Emacs. ;; "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. ;; 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 "^[\^_]?\\(" (concat "^[\^_]?\\("
"From [^ \n]*\\(\\|\".*\"[^ \n]*\\) ?[^ \n]* [^ \n]* *" "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 "[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 "\\|" mmdf-delim1 "\\|"
"^BABYL OPTIONS:\\|" "^BABYL OPTIONS:\\|"
"\^L\n[01],\\)") nil t) "\^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)) (goto-char start))
(let ((case-fold-search nil)) (let ((case-fold-search nil))
(if (re-search-forward (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 (replace-match
(concat (concat
"Mail-from: \\&" "Mail-from: \\&"

22
lisp/mail/sendmail.el
View file

@ -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. *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.") 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 (defvar mail-default-reply-to nil
"*Address to insert as default Reply-to field of outgoing messages.") "*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)) (setq mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table))
(modify-syntax-entry ?% ". " mail-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) (defun mail-setup (to subject in-reply-to cc replybuffer actions)
(setq mail-send-actions actions) (setq mail-send-actions actions)
(if (eq mail-aliases t) (mail-aliases-setup)
(progn
(setq mail-aliases nil)
(if (file-exists-p "~/.mailrc")
(build-mail-aliases))))
(setq mail-reply-buffer replybuffer) (setq mail-reply-buffer replybuffer)
(goto-char (point-min)) (goto-char (point-min))
(insert "To: ") (insert "To: ")
@ -258,8 +240,6 @@ the user from the mailer."
(replace-match "\n") (replace-match "\n")
(backward-char 1) (backward-char 1)
(setq delimline (point-marker)) (setq delimline (point-marker))
(if mail-aliases
(expand-mail-aliases (point-min) delimline))
(goto-char (point-min)) (goto-char (point-min))
;; ignore any blank lines in the header ;; ignore any blank lines in the header
(while (and (re-search-forward "\n\n\n*" delimline t) (while (and (re-search-forward "\n\n\n*" delimline t)

10
lisp/man.el
View file

@ -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) (while (re-search-forward "\e[789]" nil t)
(replace-match "")) (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 ;; Crunch blank lines
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "\n\n\n\n*" nil t) (while (re-search-forward "\n\n\n\n*" nil t)

44
lisp/map-ynp.el
View file

@ -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. current object and then exit; or \\[help-command] to get help.
Returns the number of actions taken." Returns the number of actions taken."
(let ((old-help-form help-form) (let* ((old-help-form help-form)
(help-form (cons 'map-y-or-n-p-help (help-form (cons 'map-y-or-n-p-help
(or help '("object" "objects" "act on")))) (or help '("object" "objects" "act on"))))
(actions 0) (actions 0)
prompt prompt
char char
elt elt
(next (if (or (symbolp list) (next (if (or (symbolp list)
(subrp list) (subrp list)
(compiled-function-p list) (compiled-function-p list)
(and (consp list) (and (consp list)
(eq (car list) 'lambda))) (eq (car list) 'lambda)))
(function (lambda () (function (lambda ()
(setq elt (funcall list)))) (setq elt (funcall list))))
(function (lambda () (function (lambda ()
(if list (if list
(progn (progn
(setq elt (car list) (setq elt (car list)
list (cdr list)) list (cdr list))
t) t)
nil)))))) nil))))))
(if (stringp prompter) (if (stringp prompter)
(setq prompter (` (lambda (object) (setq prompter (` (lambda (object)
(format (, prompter) object))))) (format (, prompter) object)))))
@ -122,7 +122,7 @@ Returns the number of actions taken."
(progn (progn
(funcall actor elt) (funcall actor elt)
(setq actions (1+ actions)))) (setq actions (1+ actions))))
(while (setq elt (funcall next)) (while (funcall next)
(if (eval (funcall prompter elt)) (if (eval (funcall prompter elt))
(progn (progn
(funcall actor elt) (funcall actor elt)

13
lisp/progmodes/compile.el
View file

@ -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 `compilation-error-list' to a list with an element for each error message
found. See that variable for more info.") found. See that variable for more info.")
;;;###autoload
(defvar compilation-buffer-name-function nil (defvar compilation-buffer-name-function nil
"Function to call with one argument, the name of the major mode of the "*Function to call with one argument, the name of the major mode of the
compilation buffer, to give the buffer a name. It should return a string. compilation buffer, to give the buffer a name. It should return a string.
If nil, the name \"*compilation*\" is used for compilation buffers, If nil, the name \"*compilation*\" is used for compilation buffers,
and the name \"*grep*\" is used for grep buffers. and the name \"*grep*\" is used for grep buffers.
\(Actually, the name (concat "*" (downcase major-mode) "*") is used.)") \(Actually, the name (concat \"*\" (downcase major-mode) \"*\") is used.)")
;;;###autoload
(defvar compilation-finish-function nil (defvar compilation-finish-function nil
"Function to call when a compilation process finishes. "*Function to call when a compilation process finishes.
It is called with two arguments: the compilation buffer, and a string It is called with two arguments: the compilation buffer, and a string
describing how the process finished.") describing how the process finished.")
@ -279,8 +281,9 @@ means the default). The defaults for these variables are the global values of
(window-height)))) (window-height))))
(select-window w)))) (select-window w))))
;; Start the compilation. ;; Start the compilation.
(start-process-shell-command (downcase mode-name) outbuf command) (set-process-sentinel (start-process-shell-command (downcase mode-name)
(set-process-sentinel (get-buffer-process outbuf) outbuf
command)
'compilation-sentinel)) 'compilation-sentinel))
;; Make it so the next C-x ` will use this buffer. ;; Make it so the next C-x ` will use this buffer.
(setq compilation-last-buffer outbuf))) (setq compilation-last-buffer outbuf)))

102
lisp/progmodes/etags.el
View file

@ -136,49 +136,67 @@ File names returned are absolute."
default default
spec)))) spec))))
(defun tags-tag-match (tagname exact)
"Search for a match to the given tagname."
(if (not exact)
(search-forward tagname nil t)
(not (error-occurred
(while
(progn
(search-forward tagname)
(let ((before (char-syntax (char-after (1- (match-beginning 1)))))
(after (char-syntax (char-after (match-end 1)))))
(not (or (= before ?w) (= before ?_))
(= after ?w) (= after ?_)))
))))
)
)
(defun find-tag-noselect (tagname exact &optional next) (defun find-tag-noselect (tagname exact &optional next)
"Find a tag and return its buffer, but don't select or display it." "Find a tag and return its buffer, but don't select or display it."
(let (buffer file linebeg startpos) (let (buffer file linebeg startpos (obuf (current-buffer)))
(save-excursion ;; save-excursion will do the wrong thing if the buffer containing the
(visit-tags-table-buffer) ;; tag being searched for is current-buffer
(if (not next) (unwind-protect
(goto-char (point-min)) (progn
(setq tagname last-tag)) (visit-tags-table-buffer)
(setq last-tag tagname) (if (not next)
(while (progn (goto-char (point-min))
(if (not (if exact (setq tagname last-tag))
(re-search-forward (concat "\\W" tagname "\\W") nil t) (setq last-tag tagname)
(search-forward tagname nil t))) (while (progn
(error "No %sentries containing %s" (if (not (tags-tag-match tagname exact))
(if next "more " "") tagname)) (error "No %sentries matching %s"
(not (looking-at "[^\n\177]*\177")))) (if next "more " "") tagname))
(search-forward "\177") (not (looking-at "[^\n\177]*\177"))))
(setq file (expand-file-name (file-of-tag) (search-forward "\177")
(file-name-directory tags-file-name))) (setq file (expand-file-name (file-of-tag)
(setq linebeg (file-name-directory tags-file-name)))
(buffer-substring (1- (point)) (setq linebeg
(save-excursion (beginning-of-line) (point)))) (buffer-substring (1- (point))
(search-forward ",") (save-excursion (beginning-of-line) (point))))
(setq startpos (read (current-buffer))) (search-forward ",")
(prog1 (setq startpos (read (current-buffer)))
(set-buffer (find-file-noselect file)) (prog1
(widen) (set-buffer (find-file-noselect file))
(push-mark) (widen)
(let ((offset 1000) (push-mark)
found (let ((offset 1000)
(pat (concat "^" (regexp-quote linebeg)))) found
(or startpos (setq startpos (point-min))) (pat (concat "^" (regexp-quote linebeg))))
(while (and (not found) (or startpos (setq startpos (point-min)))
(progn (while (and (not found)
(goto-char (- startpos offset)) (progn
(not (bobp)))) (goto-char (- startpos offset))
(setq found (not (bobp))))
(re-search-forward pat (startpos offset) t)) (setq found
(setq offset (* 3 offset))) (re-search-forward pat (+ startpos offset) t))
(or found (setq offset (* 3 offset)))
(re-search-forward pat nil t) (or found
(error "%s not found in %s" pat file))) (re-search-forward pat nil t)
(beginning-of-line))) (error "%s not found in %s" pat file)))
(beginning-of-line)))
(set-buffer obuf))
)) ))
;;;###autoload ;;;###autoload
@ -334,3 +352,5 @@ unless it has one in the tag table."
(point)))) (point))))
(terpri) (terpri)
(forward-line 1))))) (forward-line 1)))))
;; etags.el ends here

57
lisp/textmodes/fill.el
View file

@ -224,23 +224,40 @@ Optional third and fourth arguments JUSTIFY-FLAG and MAIL-FLAG:
JUSTIFY-FLAG to justify paragraphs (prefix arg), JUSTIFY-FLAG to justify paragraphs (prefix arg),
MAIL-FLAG for a mail message, i. e. don't fill header lines." MAIL-FLAG for a mail message, i. e. don't fill header lines."
(interactive "r\nP") (interactive "r\nP")
(let (fill-prefix) (save-restriction
(save-restriction (save-excursion
(save-excursion (goto-char min)
(goto-char min) (beginning-of-line)
(if mailp (if mailp
(while (looking-at "[^ \t\n]*:") (while (looking-at "[^ \t\n]*:")
(forward-line 1))) (forward-line 1)))
(narrow-to-region (point) max) (narrow-to-region (point) max)
(while (progn ;; Loop over paragraphs.
(skip-chars-forward " \t\n") (while (progn (skip-chars-forward " \t\n") (not (eobp)))
(not (eobp))) (beginning-of-line)
(setq fill-prefix (let ((start (point))
(buffer-substring (point) (progn (beginning-of-line) (point)))) fill-prefix fill-prefix-regexp)
(let ((fin (save-excursion (forward-paragraph) (point))) ;; Find end of paragraph, and compute the smallest fill-prefix
(start (point))) ;; that fits all the lines in this paragraph.
(fill-region-as-paragraph (point) fin justifyp) (while (progn
(goto-char start) ;; Update the fill-prefix on the first line
(forward-paragraph))))))) ;; and whenever the prefix good so far is too long.
(if (not (and fill-prefix
(looking-at fill-prefix-regexp)))
(setq fill-prefix
(buffer-substring (point)
(save-excursion (skip-chars-forward " \t") (point)))
fill-prefix-regexp
(regexp-quote fill-prefix)))
(forward-line 1)
;; Now stop the loop if end of paragraph.
(and (not (eobp))
(not (looking-at paragraph-separate))
(save-excursion
(not (and (looking-at fill-prefix-regexp)
(progn (forward-char (length fill-prefix))
(looking-at paragraph-separate))))))))
;; Fill this paragraph, but don't add a newline at the end.
(let ((had-newline (bolp)))
(fill-region-as-paragraph start (point) justifyp)
(or had-newline (delete-char -1))))))))