Fix typo in comment.
This commit is contained in:
parent
3d8c35d3b0
commit
6c83d99f87
6 changed files with 143 additions and 143 deletions
|
@ -27,7 +27,7 @@
|
|||
;; The present file contains all the infrastructure needed for that.
|
||||
;;
|
||||
;; Generally, to implement a new multisession capability within Ediff,
|
||||
;; you need to tell it
|
||||
;; you need to tell it
|
||||
;;
|
||||
;; 1. How to display the session group buffer.
|
||||
;; This function must indicate which Ediff sessions are active (+) and
|
||||
|
@ -53,8 +53,8 @@
|
|||
;; HEADER must be a list of SIX elements (nil or string):
|
||||
;; (regexp metaobj1 metaobj2 metaobj3 merge-save-buffer
|
||||
;; comparison-function)
|
||||
;; The function ediff-redraw-registry-buffer displays the
|
||||
;; 1st - 4th of these in the registry buffer.
|
||||
;; The function ediff-redraw-registry-buffer displays the
|
||||
;; 1st - 4th of these in the registry buffer.
|
||||
;; For some jobs some of the members of the header might be nil.
|
||||
;; The meaning of metaobj1, metaobj2, and metaobj3 depend on the job.
|
||||
;; Typically these are directories where the files to be compared are
|
||||
|
@ -80,7 +80,7 @@
|
|||
;; (whose name is obj1).
|
||||
;; The nil's are placeholders, which are used internally by ediff.
|
||||
;; 4. Write a function that makes a call to ediff-prepare-meta-buffer
|
||||
;; passing all this info.
|
||||
;; passing all this info.
|
||||
;; You may be able to use ediff-directories-internal as a template.
|
||||
;; 5. If you intend to add several related pieces of functionality,
|
||||
;; you may want to keep the function in 4 as an internal version
|
||||
|
@ -88,7 +88,7 @@
|
|||
;; with different parameters.
|
||||
;; See how ediff-directories, ediff-merge-directories, and
|
||||
;; ediff-merge-directories-with-ancestor all use
|
||||
;; ediff-directories-internal.
|
||||
;; ediff-directories-internal.
|
||||
;;
|
||||
;; A useful addition here could be session groups selected by patterns
|
||||
;; (which are different in each directory). For instance, one may want to
|
||||
|
@ -96,7 +96,7 @@
|
|||
;; which may be in the same or different directories. Or, one may want to
|
||||
;; compare all files of the form {something} to files of the form {something}~.
|
||||
;;
|
||||
;; Implementing this requires writing an collating function, which should pair
|
||||
;; Implementing this requires writing a collating function, which should pair
|
||||
;; up appropriate files. It will also require a generalization of the
|
||||
;; functions that do the layout of the meta- and differences buffers and of
|
||||
;; ediff-filegroup-action.
|
||||
|
@ -207,7 +207,7 @@ It is used by commands such as ediff-directories.
|
|||
This hook can be used to save the previous window config, which can be restored
|
||||
on ediff-quit, ediff-suspend, or ediff-quit-session-group-hook."
|
||||
:type 'hook
|
||||
:group 'ediff-hook)
|
||||
:group 'ediff-hook)
|
||||
(defcustom ediff-after-session-group-setup-hook nil
|
||||
"*Hooks run just after a meta-buffer controlling a session group, such as
|
||||
ediff-directories, is run."
|
||||
|
@ -322,7 +322,7 @@ buffers."
|
|||
;; OBJA, OBJB, OBJC are usually directories involved, but can be different for
|
||||
;; different jobs. For instance, multifile patch has only OBJA, which is the
|
||||
;; patch buffer.
|
||||
(defun ediff-make-new-meta-list-header (regexp
|
||||
(defun ediff-make-new-meta-list-header (regexp
|
||||
objA objB objC
|
||||
merge-auto-store-dir
|
||||
comparison-func)
|
||||
|
@ -340,7 +340,7 @@ buffers."
|
|||
;; checks if the session is a meta session
|
||||
(defun ediff-meta-session-p (session-info)
|
||||
(and (stringp (ediff-get-session-objA-name session-info))
|
||||
(file-directory-p (ediff-get-session-objA-name session-info))
|
||||
(file-directory-p (ediff-get-session-objA-name session-info))
|
||||
(stringp (ediff-get-session-objB-name session-info))
|
||||
(file-directory-p (ediff-get-session-objB-name session-info))
|
||||
(if (stringp (ediff-get-session-objC-name session-info))
|
||||
|
@ -468,7 +468,7 @@ Moves in circular fashion. With numeric prefix arg, skip this many items."
|
|||
;;; (while (ediff-get-session-status
|
||||
;;; (ediff-get-meta-info (current-buffer) pos 'noerror))
|
||||
;;; (setq pos (ediff-previous-meta-overlay-start pos)))
|
||||
|
||||
|
||||
(if pos (goto-char pos))
|
||||
(if (eq ediff-metajob-name 'ediff-registry)
|
||||
(if (and (ediff-get-meta-info (current-buffer) pos 'noerror)
|
||||
|
@ -545,19 +545,19 @@ behavior."
|
|||
lis1 (directory-files auxdir1 nil regexp)
|
||||
lis1 (delete "." lis1)
|
||||
lis1 (delete ".." lis1)
|
||||
lis1 (mapcar
|
||||
lis1 (mapcar
|
||||
(lambda (elt)
|
||||
(ediff-add-slash-if-directory auxdir1 elt))
|
||||
lis1)
|
||||
auxdir2 (file-name-as-directory dir2)
|
||||
lis2 (mapcar
|
||||
lis2 (mapcar
|
||||
(lambda (elt)
|
||||
(ediff-add-slash-if-directory auxdir2 elt))
|
||||
(directory-files auxdir2 nil regexp)))
|
||||
|
||||
(if (stringp dir3)
|
||||
(setq auxdir3 (file-name-as-directory dir3)
|
||||
lis3 (mapcar
|
||||
lis3 (mapcar
|
||||
(lambda (elt)
|
||||
(ediff-add-slash-if-directory auxdir3 elt))
|
||||
(directory-files auxdir3 nil regexp))))
|
||||
|
@ -614,16 +614,16 @@ behavior."
|
|||
merge-autostore-dir
|
||||
comparison-func)
|
||||
difflist))
|
||||
|
||||
|
||||
(setq common-part
|
||||
(cons
|
||||
(cons
|
||||
;; metalist header
|
||||
(ediff-make-new-meta-list-header regexp
|
||||
auxdir1 auxdir2 auxdir3
|
||||
merge-autostore-dir
|
||||
comparison-func)
|
||||
(mapcar
|
||||
(lambda (elt)
|
||||
(lambda (elt)
|
||||
(ediff-make-new-meta-list-element
|
||||
(concat auxdir1 elt)
|
||||
(concat auxdir2 elt)
|
||||
|
@ -686,9 +686,9 @@ behavior."
|
|||
(setq common (sort (ediff-copy-list common) 'string-lessp))
|
||||
|
||||
;; return result
|
||||
(cons
|
||||
(cons
|
||||
;; header -- has 6 elements. Meta buffer is prepended later by
|
||||
;; ediff-prepare-meta-buffer
|
||||
;; ediff-prepare-meta-buffer
|
||||
(ediff-make-new-meta-list-header regexp
|
||||
auxdir1 nil nil
|
||||
merge-autostore-dir nil)
|
||||
|
@ -696,7 +696,7 @@ behavior."
|
|||
(concat auxdir1 elt) nil nil))
|
||||
common))
|
||||
))
|
||||
|
||||
|
||||
|
||||
;; If file groups selected by patterns will ever be implemented, this
|
||||
;; comparison function might become useful.
|
||||
|
@ -733,7 +733,7 @@ behavior."
|
|||
(defun ediff-prepare-meta-buffer (action-func meta-list
|
||||
meta-buffer-name redraw-function
|
||||
jobname &optional startup-hooks)
|
||||
(let* ((meta-buffer-name
|
||||
(let* ((meta-buffer-name
|
||||
(ediff-unique-buffer-name meta-buffer-name "*"))
|
||||
(meta-buffer (get-buffer-create meta-buffer-name)))
|
||||
(ediff-with-current-buffer meta-buffer
|
||||
|
@ -748,7 +748,7 @@ behavior."
|
|||
|
||||
;; comes after ediff-meta-action-function is set
|
||||
(ediff-setup-meta-map)
|
||||
|
||||
|
||||
(if (eq ediff-metajob-name 'ediff-registry)
|
||||
(progn
|
||||
(setq ediff-registry-buffer meta-buffer
|
||||
|
@ -762,14 +762,14 @@ behavior."
|
|||
;; add meta-buffer to the list header
|
||||
(cons (cons meta-buffer (car meta-list))
|
||||
(cdr meta-list))))
|
||||
|
||||
|
||||
(or (eq meta-buffer ediff-registry-buffer)
|
||||
(setq ediff-session-registry
|
||||
(cons meta-buffer ediff-session-registry)))
|
||||
|
||||
|
||||
;; redraw-function uses ediff-meta-list
|
||||
(funcall redraw-function ediff-meta-list)
|
||||
|
||||
|
||||
;; set read-only/non-modified
|
||||
(setq buffer-read-only t)
|
||||
(set-buffer-modified-p nil)
|
||||
|
@ -788,15 +788,15 @@ behavior."
|
|||
|
||||
(or (ediff-one-filegroup-metajob jobname)
|
||||
(ediff-draw-dir-diffs ediff-dir-difference-list))
|
||||
(define-key
|
||||
(define-key
|
||||
ediff-meta-buffer-map "h" 'ediff-mark-for-hiding-at-pos)
|
||||
(define-key ediff-meta-buffer-map "x" 'ediff-hide-marked-sessions)
|
||||
(define-key
|
||||
(define-key
|
||||
ediff-meta-buffer-map "m" 'ediff-mark-for-operation-at-pos)
|
||||
(define-key ediff-meta-buffer-map "u" nil)
|
||||
(define-key
|
||||
ediff-meta-buffer-map "um" 'ediff-unmark-all-for-operation)
|
||||
(define-key
|
||||
(define-key
|
||||
ediff-meta-buffer-map "uh" 'ediff-unmark-all-for-hiding)
|
||||
(cond ((ediff-collect-diffs-metajob jobname)
|
||||
(define-key
|
||||
|
@ -826,7 +826,7 @@ behavior."
|
|||
;; Insert session status at point. Status is either ?H (marked for hiding), or
|
||||
;; ?I (hidden or invalid), or ?* (meaning marked for an operation; currently,
|
||||
;; such op can only be checking for equality)), or SPC (meaning neither marked
|
||||
;; nor invalid)
|
||||
;; nor invalid)
|
||||
(defun ediff-insert-session-status-in-meta-buffer (session)
|
||||
(insert
|
||||
(cond ((ediff-get-session-status session)) ; session has status: ?H, ?I, ?*
|
||||
|
@ -900,14 +900,14 @@ behavior."
|
|||
(map-extents 'delete-extent) ; xemacs
|
||||
(mapcar 'delete-overlay (overlays-in 1 1)) ; emacs
|
||||
)
|
||||
|
||||
|
||||
(insert (format ediff-meta-buffer-message
|
||||
(ediff-abbrev-jobname ediff-metajob-name)))
|
||||
|
||||
(setq regexp (ediff-get-group-regexp meta-list)
|
||||
merge-autostore-dir
|
||||
(ediff-get-group-merge-autostore-dir meta-list))
|
||||
|
||||
|
||||
(cond ((ediff-collect-diffs-metajob)
|
||||
(insert
|
||||
" P:\tcollect custom diffs of all marked sessions\n"))
|
||||
|
@ -938,7 +938,7 @@ behavior."
|
|||
----------------------------------------------
|
||||
|
||||
")
|
||||
|
||||
|
||||
;; discard info on directories and regexp
|
||||
(setq meta-list (cdr meta-list)
|
||||
tmp-list meta-list)
|
||||
|
@ -951,7 +951,7 @@ behavior."
|
|||
(if empty
|
||||
(insert
|
||||
" ****** ****** This session group has no members\n"))
|
||||
|
||||
|
||||
;; now organize file names like this:
|
||||
;; use-mark sizeA dateA sizeB dateB filename
|
||||
;; make sure directories are displayed with a trailing slash.
|
||||
|
@ -1213,7 +1213,7 @@ Useful commands:
|
|||
(if (stringp dir3)
|
||||
(if (= (mod membership-code ediff-membership-code3) 0) ; dir3
|
||||
(let ((beg (point)))
|
||||
(insert (format " %-25s"
|
||||
(insert (format " %-25s"
|
||||
(ediff-truncate-string-left
|
||||
(ediff-abbreviate-file-name
|
||||
(if (file-directory-p (concat dir3 file))
|
||||
|
@ -1327,7 +1327,7 @@ Useful commands:
|
|||
(ediff-show-meta-buffer
|
||||
ediff-parent-meta-buffer ediff-meta-session-number)
|
||||
(error "This session group has no parent")))
|
||||
|
||||
|
||||
|
||||
;; argument is ignored
|
||||
(defun ediff-redraw-registry-buffer (&optional ignore)
|
||||
|
@ -1373,7 +1373,7 @@ Useful commands:
|
|||
(while registry-list
|
||||
(setq elt (car registry-list)
|
||||
registry-list (cdr registry-list))
|
||||
|
||||
|
||||
(if (ediff-buffer-live-p elt)
|
||||
(if (ediff-with-current-buffer elt
|
||||
(setq job-name ediff-metajob-name
|
||||
|
@ -1479,7 +1479,7 @@ Useful commands:
|
|||
;;; (error "Can't hide active session, %s" (buffer-name session-buf)))
|
||||
(t (ediff-set-session-status info ?H))))
|
||||
unmark)
|
||||
|
||||
|
||||
|
||||
(defun ediff-mark-for-operation-at-pos (unmark)
|
||||
"Mark session for a group operation. With prefix arg, unmark."
|
||||
|
@ -1562,11 +1562,11 @@ Useful commands:
|
|||
(funcall operation elt sessionNum)))
|
||||
;; The following goes into a session represented by a subdirectory
|
||||
;; and applies operation to marked sessions there
|
||||
((and (ediff-meta-session-p elt)
|
||||
(ediff-buffer-live-p
|
||||
((and (ediff-meta-session-p elt)
|
||||
(ediff-buffer-live-p
|
||||
(setq session-buf (ediff-get-session-buffer elt))))
|
||||
(setq numMarked
|
||||
(+ numMarked
|
||||
(+ numMarked
|
||||
(ediff-with-current-buffer session-buf
|
||||
;; pass meta-diff along
|
||||
(setq ediff-meta-diff-buffer diff-buffer)
|
||||
|
@ -1602,7 +1602,7 @@ Useful commands:
|
|||
(insert-buffer custom-diff-buf)
|
||||
(insert "\n")))
|
||||
;; if ediff session is not live, run diff directly on the files
|
||||
((memq metajob '(ediff-directories
|
||||
((memq metajob '(ediff-directories
|
||||
ediff-merge-directories
|
||||
ediff-merge-directories-with-ancestor))
|
||||
;; get diffs by calling shell command on ediff-custom-diff-program
|
||||
|
@ -1671,7 +1671,7 @@ all marked sessions must be active."
|
|||
))
|
||||
(error "The patch buffer wasn't found"))))
|
||||
|
||||
|
||||
|
||||
;; This function executes in meta buffer. It knows where event happened.
|
||||
(defun ediff-filegroup-action ()
|
||||
"Execute appropriate action for a selected session."
|
||||
|
@ -1710,14 +1710,14 @@ all marked sessions must be active."
|
|||
;; do ediff/ediff-merge on subdirectories
|
||||
(if (ediff-buffer-live-p session-buf)
|
||||
(ediff-show-meta-buffer session-buf)
|
||||
(setq regexp (read-string "Filter through regular expression: "
|
||||
(setq regexp (read-string "Filter through regular expression: "
|
||||
nil 'ediff-filtering-regexp-history))
|
||||
(ediff-directories-internal
|
||||
file1 file2 file3 regexp
|
||||
ediff-session-action-function
|
||||
ediff-metajob-name
|
||||
ediff-metajob-name
|
||||
;; make it update (car info) after startup
|
||||
`(list (lambda ()
|
||||
`(list (lambda ()
|
||||
;; child session group should know its parent
|
||||
(setq ediff-parent-meta-buffer
|
||||
(quote ,ediff-meta-buffer)
|
||||
|
@ -1732,13 +1732,13 @@ all marked sessions must be active."
|
|||
(file-directory-p file1))
|
||||
(if (ediff-buffer-live-p session-buf)
|
||||
(ediff-show-meta-buffer session-buf)
|
||||
(setq regexp (read-string "Filter through regular expression: "
|
||||
(setq regexp (read-string "Filter through regular expression: "
|
||||
nil 'ediff-filtering-regexp-history))
|
||||
(ediff-directory-revisions-internal
|
||||
file1 regexp
|
||||
ediff-session-action-function ediff-metajob-name
|
||||
;; make it update (car info) after startup
|
||||
`(list (lambda ()
|
||||
`(list (lambda ()
|
||||
;; child session group should know its parent and
|
||||
;; its number
|
||||
(setq ediff-parent-meta-buffer
|
||||
|
@ -1762,8 +1762,8 @@ all marked sessions must be active."
|
|||
"This session has no ancestor. Merge without the ancestor? ")
|
||||
(ediff-merge-files
|
||||
file1 file2
|
||||
;; provide startup hooks
|
||||
`(list (lambda ()
|
||||
;; provide startup hooks
|
||||
`(list (lambda ()
|
||||
(add-hook
|
||||
'ediff-after-quit-hook-internal
|
||||
(lambda ()
|
||||
|
@ -1791,8 +1791,8 @@ all marked sessions must be active."
|
|||
((ediff-one-filegroup-metajob) ; needs 1 file arg
|
||||
(funcall ediff-session-action-function
|
||||
file1
|
||||
;; provide startup hooks
|
||||
`(list (lambda ()
|
||||
;; provide startup hooks
|
||||
`(list (lambda ()
|
||||
(add-hook
|
||||
'ediff-after-quit-hook-internal
|
||||
(lambda ()
|
||||
|
@ -1820,8 +1820,8 @@ all marked sessions must be active."
|
|||
((not (ediff-metajob3)) ; need 2 file args
|
||||
(funcall ediff-session-action-function
|
||||
file1 file2
|
||||
;; provide startup hooks
|
||||
`(list (lambda ()
|
||||
;; provide startup hooks
|
||||
`(list (lambda ()
|
||||
(add-hook
|
||||
'ediff-after-quit-hook-internal
|
||||
(lambda ()
|
||||
|
@ -1849,8 +1849,8 @@ all marked sessions must be active."
|
|||
((ediff-metajob3) ; need 3 file args
|
||||
(funcall ediff-session-action-function
|
||||
file1 file2 file3
|
||||
;; arrange startup hooks
|
||||
`(list (lambda ()
|
||||
;; arrange startup hooks
|
||||
`(list (lambda ()
|
||||
(add-hook
|
||||
'ediff-after-quit-hook-internal
|
||||
(lambda ()
|
||||
|
@ -1956,7 +1956,7 @@ all marked sessions must be active."
|
|||
(set-window-buffer (selected-window) meta-buf)))
|
||||
))
|
||||
(if (and (ediff-window-display-p)
|
||||
(window-live-p
|
||||
(window-live-p
|
||||
(setq wind (ediff-get-visible-buffer-window meta-buf))))
|
||||
(progn
|
||||
(setq frame (window-frame wind))
|
||||
|
@ -2018,7 +2018,7 @@ all marked sessions must be active."
|
|||
))
|
||||
(if (ediff-window-display-p)
|
||||
(progn
|
||||
(setq frame
|
||||
(setq frame
|
||||
(window-frame
|
||||
(ediff-get-visible-buffer-window ediff-registry-buffer)))
|
||||
(raise-frame frame)
|
||||
|
@ -2058,7 +2058,7 @@ all marked sessions must be active."
|
|||
(ediff-with-current-buffer (current-buffer)
|
||||
(if (ediff-buffer-live-p ediff-registry-buffer)
|
||||
(ediff-redraw-registry-buffer)
|
||||
(ediff-prepare-meta-buffer
|
||||
(ediff-prepare-meta-buffer
|
||||
'ediff-registry-action
|
||||
ediff-session-registry
|
||||
"*Ediff Registry"
|
||||
|
@ -2066,7 +2066,7 @@ all marked sessions must be active."
|
|||
'ediff-registry))
|
||||
))
|
||||
|
||||
;; If meta-buf exists, it is redrawn along with parent.
|
||||
;; If meta-buf exists, it is redrawn along with parent.
|
||||
;; Otherwise, nothing happens.
|
||||
(defun ediff-cleanup-meta-buffer (meta-buffer)
|
||||
(if (ediff-buffer-live-p meta-buffer)
|
||||
|
@ -2134,7 +2134,7 @@ If this is a session registry buffer then just bury it."
|
|||
(if (ediff-buffer-live-p ediff-dir-diffs-buffer)
|
||||
(kill-buffer ediff-dir-diffs-buffer)))
|
||||
(kill-buffer buf))
|
||||
|
||||
|
||||
|
||||
;; Obtain information on a meta record where the user clicked or typed
|
||||
;; BUF is the buffer where this happened and POINT is the position
|
||||
|
|
|
@ -237,7 +237,7 @@
|
|||
|
||||
;; If REG is a CCL register symbol (e.g. r0, r1...), the register
|
||||
;; number is embedded. If OP is one of unconditional jumps, DATA is
|
||||
;; changed to an relative jump address.
|
||||
;; changed to a relative jump address.
|
||||
|
||||
(defun ccl-embed-code (op reg data &optional reg2)
|
||||
(if (and (> data 0) (get op 'jump-flag))
|
||||
|
@ -509,7 +509,7 @@
|
|||
(ccl-embed-data op)
|
||||
(ccl-embed-data arg))
|
||||
(ccl-check-register arg cmd)
|
||||
(ccl-embed-code (if read-flag 'read-jump-cond-expr-register
|
||||
(ccl-embed-code (if read-flag 'read-jump-cond-expr-register
|
||||
'jump-cond-expr-register)
|
||||
rrr 0)
|
||||
(ccl-embed-data op)
|
||||
|
@ -707,7 +707,7 @@
|
|||
(error "CCL: Invalid argument %s: %s" arg cmd)))
|
||||
(ccl-embed-code 'read-jump rrr ccl-loop-head))
|
||||
t)
|
||||
|
||||
|
||||
;; Compile READ statement.
|
||||
(defun ccl-compile-read (cmd)
|
||||
(if (< (length cmd) 2)
|
||||
|
@ -899,7 +899,7 @@
|
|||
add 1))
|
||||
(setq arg (cdr arg)
|
||||
len (+ len add)))
|
||||
(if mp
|
||||
(if mp
|
||||
(cons (- len) result)
|
||||
result))))
|
||||
(setq arg (append (list (nth 0 cmd) (nth 1 cmd) (nth 2 cmd))
|
||||
|
@ -990,7 +990,7 @@
|
|||
(rrr (ash (logand code 255) -5))
|
||||
(cc (ash code -8)))
|
||||
(insert (format "%5d:[%s] " (1- ccl-current-ic) cmd))
|
||||
(funcall (get cmd 'ccl-dump-function) rrr cc)))
|
||||
(funcall (get cmd 'ccl-dump-function) rrr cc)))
|
||||
|
||||
(defun ccl-dump-set-register (rrr cc)
|
||||
(insert (format "r%d = r%d\n" rrr cc)))
|
||||
|
@ -1273,7 +1273,7 @@
|
|||
(insert (format "map-single r%d r%d map(%S)\n" RRR rrr id))))
|
||||
|
||||
|
||||
;; CCL emulation staffs
|
||||
;; CCL emulation staffs
|
||||
|
||||
;; Not yet implemented.
|
||||
|
||||
|
@ -1472,7 +1472,7 @@ ASSIGNMENT_OPERATOR :=
|
|||
;; (REG <8= ARG) is the same as:
|
||||
;; ((REG <<= 8)
|
||||
;; (REG |= ARG))
|
||||
| <8=
|
||||
| <8=
|
||||
|
||||
;; (REG >8= ARG) is the same as:
|
||||
;; ((r7 = (REG & 255))
|
||||
|
|
|
@ -29,11 +29,11 @@
|
|||
;; The entry point of this code is
|
||||
;;
|
||||
;; mail-extract-address-components: (address &optional all)
|
||||
;;
|
||||
;;
|
||||
;; Given an RFC-822 ADDRESS, extract full name and canonical address.
|
||||
;; Returns a list of the form (FULL-NAME CANONICAL-ADDRESS).
|
||||
;; If no name can be extracted, FULL-NAME will be nil.
|
||||
;; ADDRESS may be a string or a buffer. If it is a buffer, the visible
|
||||
;; ADDRESS may be a string or a buffer. If it is a buffer, the visible
|
||||
;; (narrowed) portion of the buffer will be interpreted as the address.
|
||||
;; (This feature exists so that the clever caller might be able to avoid
|
||||
;; consing a string.)
|
||||
|
@ -61,10 +61,10 @@
|
|||
;; make sure you're not breaking functionality. The test cases aren't included
|
||||
;; because they are over 100K.
|
||||
;;
|
||||
;; If you find an address that mail-extr fails on, please send it to the
|
||||
;; If you find an address that mail-extr fails on, please send it to the
|
||||
;; maintainer along with what you think the correct results should be. We do
|
||||
;; not consider it a bug if mail-extr mangles a comment that does not
|
||||
;; correspond to a real human full name, although we would prefer that
|
||||
;; correspond to a real human full name, although we would prefer that
|
||||
;; mail-extr would return the comment as-is.
|
||||
;;
|
||||
;; Features:
|
||||
|
@ -121,8 +121,8 @@
|
|||
;; * insert documentation strings!
|
||||
;; * handle X.400-gatewayed addresses according to RFC 1148.
|
||||
|
||||
;;; Change Log:
|
||||
;;
|
||||
;;; Change Log:
|
||||
;;
|
||||
;; Thu Feb 17 17:57:33 1994 Jamie Zawinski (jwz@lucid.com)
|
||||
;;
|
||||
;; * merged with jbw's latest version
|
||||
|
@ -140,26 +140,26 @@
|
|||
;; * some more cleanup, doc, added provide
|
||||
;;
|
||||
;; Tue Mar 23 21:23:18 1993 Joe Wells (jbw at csd.bu.edu)
|
||||
;;
|
||||
;;
|
||||
;; * Made mail-full-name-prefixes a user-customizable variable.
|
||||
;; Allow passing the address as a buffer as well as a string.
|
||||
;; Allow [ and ] as name characters (Finnish character set).
|
||||
;;
|
||||
;;
|
||||
;; Mon Mar 22 21:20:56 1993 Joe Wells (jbw at bigbird.bu.edu)
|
||||
;;
|
||||
;;
|
||||
;; * Handle "null" addresses. Handle = used for spacing in mailbox
|
||||
;; name. Fix bug in handling of ROUTE-ADDR-type addresses that are
|
||||
;; missing their brackets. Handle uppercase "JR". Extract full
|
||||
;; names from X.400 addresses encoded in RFC-822. Fix bug in
|
||||
;; handling of multiple addresses where first has trailing comment.
|
||||
;; Handle more kinds of telephone extension lead-ins.
|
||||
;;
|
||||
;;
|
||||
;; Mon Mar 22 20:16:57 1993 Joe Wells (jbw at bigbird.bu.edu)
|
||||
;;
|
||||
;;
|
||||
;; * Handle HZ encoding for embedding GB encoded chinese characters.
|
||||
;;
|
||||
;;
|
||||
;; Mon Mar 22 00:46:12 1993 Joe Wells (jbw at bigbird.bu.edu)
|
||||
;;
|
||||
;;
|
||||
;; * Fixed too broad matching of ham radio call signs. Fixed bug in
|
||||
;; handling an unmatched ' in a name string. Enhanced recognition
|
||||
;; of when . in the mailbox name terminates the name portion.
|
||||
|
@ -169,40 +169,40 @@
|
|||
;; introduced in switching last name order. Fixed bug in handling
|
||||
;; address with ! and % but no @. Narrowed the cases in which
|
||||
;; certain trailing words are discarded.
|
||||
;;
|
||||
;;
|
||||
;; Sun Mar 21 21:41:06 1993 Joe Wells (jbw at bigbird.bu.edu)
|
||||
;;
|
||||
;;
|
||||
;; * Fixed bugs in handling GROUP addresses. Certain words in the
|
||||
;; middle of a name no longer terminate it. Handle LISTSERV list
|
||||
;; names. Ignore comment field containing mailbox name.
|
||||
;;
|
||||
;;
|
||||
;; Sun Mar 21 14:39:38 1993 Joe Wells (jbw at bigbird.bu.edu)
|
||||
;;
|
||||
;;
|
||||
;; * Moved variant-method code back into main function. Handle
|
||||
;; underscores as spaces in comments. Handle leading nickname. Add
|
||||
;; flag to ignore single-word names. Other changes.
|
||||
;;
|
||||
;;
|
||||
;; Mon Feb 1 22:23:31 1993 Joe Wells (jbw at bigbird.bu.edu)
|
||||
;;
|
||||
;;
|
||||
;; * Added in changes by Rod Whitby and Jamie Zawinski. This
|
||||
;; includes the flag mail-extr-guess-middle-initial and the fix for
|
||||
;; handling multiple addresses correctly. (Whitby just changed
|
||||
;; a > to a <.)
|
||||
;;
|
||||
;;
|
||||
;; Mon Apr 6 23:59:09 1992 Joe Wells (jbw at bigbird.bu.edu)
|
||||
;;
|
||||
;;
|
||||
;; * Cleaned up some more. Release version 1.0 to world.
|
||||
;;
|
||||
;;
|
||||
;; Sun Apr 5 19:39:08 1992 Joe Wells (jbw at bigbird.bu.edu)
|
||||
;;
|
||||
;;
|
||||
;; * Cleaned up full name extraction extensively.
|
||||
;;
|
||||
;;
|
||||
;; Sun Feb 2 14:45:24 1992 Joe Wells (jbw at bigbird.bu.edu)
|
||||
;;
|
||||
;;
|
||||
;; * Total rewrite. Integrated mail-canonicalize-address into
|
||||
;; mail-extract-address-components. Now handles GROUP addresses more
|
||||
;; or less correctly. Better handling of lots of different cases.
|
||||
;;
|
||||
;;
|
||||
;; Fri Jun 14 19:39:50 1991
|
||||
;; * Created.
|
||||
|
||||
|
@ -318,16 +318,16 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
|
|||
|
||||
(defconst mail-extr-leading-garbage "\\W+")
|
||||
|
||||
;; (defconst mail-extr-non-name-chars
|
||||
;; (defconst mail-extr-non-name-chars
|
||||
;; (purecopy (concat "^" mail-extr-all-letters ".")))
|
||||
;; (defconst mail-extr-non-begin-name-chars
|
||||
;; (purecopy (concat "^" mail-extr-first-letters)))
|
||||
;; (defconst mail-extr-non-end-name-chars
|
||||
;; (purecopy (concat "^" mail-extr-last-letters)))
|
||||
|
||||
;; Matches an initial not followed by both a period and a space.
|
||||
;; Matches an initial not followed by both a period and a space.
|
||||
;; (defconst mail-extr-bad-initials-pattern
|
||||
;; (purecopy
|
||||
;; (purecopy
|
||||
;; (format "\\(\\([^%s]\\|\\`\\)[%s]\\)\\(\\.\\([^ ]\\)\\| \\|\\([^%s .]\\)\\|\\'\\)"
|
||||
;; mail-extr-all-letters mail-extr-first-letters mail-extr-all-letters)))
|
||||
|
||||
|
@ -363,7 +363,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
|
|||
;; Must not match a trailing uppercase last name or trailing initial
|
||||
(defconst mail-extr-weird-acronym-pattern
|
||||
(purecopy "\\([A-Z]+[-_/]\\|[A-Z][A-Z][A-Z]?\\b\\)"))
|
||||
|
||||
|
||||
;; Matches a mixed-case or lowercase name (not an initial).
|
||||
;; #### Match Latin1 lower case letters here too?
|
||||
;; (defconst mail-extr-mixed-case-name-pattern
|
||||
|
@ -376,7 +376,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
|
|||
|
||||
;; Matches a trailing alternative address.
|
||||
;; #### Match Latin1 letters here too?
|
||||
;; #### Match _ before @ here too?
|
||||
;; #### Match _ before @ here too?
|
||||
(defconst mail-extr-alternative-address-pattern
|
||||
(purecopy "\\(aka *\\)?[a-zA-Z.]+[!@][a-zA-Z.]"))
|
||||
|
||||
|
@ -435,7 +435,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
|
|||
;; Matches a single word name.
|
||||
;; (defconst mail-extr-one-name-pattern
|
||||
;; (purecopy (concat "\\`" mail-extr-normal-name-pattern "\\'")))
|
||||
|
||||
|
||||
;; Matches normal two names with missing middle initial
|
||||
;; The first name is not allowed to have a hyphen because this can cause
|
||||
;; false matches where the "middle initial" is actually the first letter
|
||||
|
@ -459,12 +459,12 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
|
|||
;; encountered. The character '~' is an escape character. By convention, it
|
||||
;; must be immediately followed ONLY by '~', '{' or '\n' (<LF>), with the
|
||||
;; following special meaning.
|
||||
;;
|
||||
;;
|
||||
;; o The escape sequence '~~' is interpreted as a '~'.
|
||||
;; o The escape-to-GB sequence '~{' switches the mode from ASCII to GB.
|
||||
;; o The escape sequence '~\n' is a line-continuation marker to be consumed
|
||||
;; with no output produced.
|
||||
;;
|
||||
;;
|
||||
;; In GB mode, characters are interpreted two bytes at a time as (pure) GB
|
||||
;; codes until the escape-from-GB code '~}' is read. This code switches the
|
||||
;; mode from GB back to ASCII. (Note that the escape-from-GB code '~}'
|
||||
|
@ -734,7 +734,7 @@ consing a string.)"
|
|||
(widen)
|
||||
(erase-buffer)
|
||||
(setq case-fold-search nil)
|
||||
|
||||
|
||||
;; Insert extra space at beginning to allow later replacement with <
|
||||
;; without having to move markers.
|
||||
(insert ?\ )
|
||||
|
@ -754,12 +754,12 @@ consing a string.)"
|
|||
(buffer-disable-undo canonicalization-buffer)
|
||||
(setq case-fold-search nil))
|
||||
|
||||
|
||||
|
||||
;; Unfold multiple lines.
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\\([^\\]\\(\\\\\\\\\\)*\\)\n[ \t]" nil t)
|
||||
(replace-match "\\1 " t))
|
||||
|
||||
|
||||
;; Loop over addresses until we have as many as we want.
|
||||
(while (and (or all (null value-list))
|
||||
(progn (goto-char (point-min))
|
||||
|
@ -1012,7 +1012,7 @@ consing a string.)"
|
|||
|
||||
;; Any commas must be between < and : of ROUTE-ADDR. Nuke any
|
||||
;; others.
|
||||
;; Hell, go ahead an nuke all of the commas.
|
||||
;; Hell, go ahead and nuke all of the commas.
|
||||
;; **** This will cause problems when we start handling commas in
|
||||
;; the PHRASE part .... no it won't ... yes it will ... ?????
|
||||
(mail-extr-nuke-outside-range comma-pos 1 1)
|
||||
|
@ -1495,7 +1495,7 @@ consing a string.)"
|
|||
(if (bobp)
|
||||
(delete-region (point) cbeg)
|
||||
(just-one-space))))))
|
||||
|
||||
|
||||
;; This was moved above.
|
||||
;; Fix . used as space
|
||||
;; But it belongs here because it occurs not only as
|
||||
|
@ -1524,7 +1524,7 @@ consing a string.)"
|
|||
;; Loop over the words (and other junk) in the name.
|
||||
(goto-char (point-min))
|
||||
(while (not name-done-flag)
|
||||
|
||||
|
||||
(when word-found-flag
|
||||
;; Last time through this loop we skipped over a word.
|
||||
(setq last-word-beg this-word-beg)
|
||||
|
@ -1543,22 +1543,22 @@ consing a string.)"
|
|||
(setq lower-case-flag nil)
|
||||
;; (setq upper-case-flag nil)
|
||||
(setq begin-again-flag nil))
|
||||
|
||||
|
||||
;; Initialize for this iteration of the loop.
|
||||
(mail-extr-skip-whitespace-forward)
|
||||
(if (eq word-count 0) (narrow-to-region (point) (point-max)))
|
||||
(setq this-word-beg (point))
|
||||
(setq drop-this-word-if-trailing-flag nil)
|
||||
|
||||
|
||||
;; Decide what to do based on what we are looking at.
|
||||
(cond
|
||||
|
||||
|
||||
;; Delete title
|
||||
((and (eq word-count 0)
|
||||
(looking-at mail-extr-full-name-prefixes))
|
||||
(goto-char (match-end 0))
|
||||
(narrow-to-region (point) (point-max)))
|
||||
|
||||
|
||||
;; Stop after name suffix
|
||||
((and (>= word-count 2)
|
||||
(looking-at mail-extr-full-name-suffix-pattern))
|
||||
|
@ -1580,13 +1580,13 @@ consing a string.)"
|
|||
(upcase-word 1)))
|
||||
(setq word-found-flag t)
|
||||
(setq name-done-flag t))
|
||||
|
||||
|
||||
;; Handle SCA names
|
||||
((looking-at "MKA \\(.+\\)") ; "Mundanely Known As"
|
||||
(goto-char (match-beginning 1))
|
||||
(narrow-to-region (point) (point-max))
|
||||
(setq begin-again-flag t))
|
||||
|
||||
|
||||
;; Check for initial last name followed by comma
|
||||
((and (eq ?, (following-char))
|
||||
(eq word-count 1))
|
||||
|
@ -1594,13 +1594,13 @@ consing a string.)"
|
|||
(setq last-name-comma-flag t)
|
||||
(or (eq ?\ (following-char))
|
||||
(insert ?\ )))
|
||||
|
||||
|
||||
;; Stop before trailing comma-separated comment
|
||||
;; THIS CASE MUST BE AFTER THE PRECEDING CASES.
|
||||
;; *** This case is redundant???
|
||||
;;((eq ?, (following-char))
|
||||
;; (setq name-done-flag t))
|
||||
|
||||
|
||||
;; Delete parenthesized/quoted comment/nickname
|
||||
((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`))
|
||||
(setq cbeg (point))
|
||||
|
@ -1632,16 +1632,16 @@ consing a string.)"
|
|||
(delete-region cbeg cend)
|
||||
(if initial
|
||||
(insert initial ". ")))))
|
||||
|
||||
|
||||
;; Handle *Stupid* VMS date stamps
|
||||
((looking-at mail-extr-stupid-vms-date-stamp-pattern)
|
||||
(replace-match "" t))
|
||||
|
||||
|
||||
;; Handle Chinese characters.
|
||||
((looking-at mail-extr-hz-embedded-gb-encoded-chinese-pattern)
|
||||
(goto-char (match-end 0))
|
||||
(setq word-found-flag t))
|
||||
|
||||
|
||||
;; Skip initial garbage characters.
|
||||
;; THIS CASE MUST BE AFTER THE PRECEDING CASES.
|
||||
((and (eq word-count 0)
|
||||
|
@ -1650,33 +1650,33 @@ consing a string.)"
|
|||
;; *** Skip backward over these???
|
||||
;; (skip-chars-backward "& \"")
|
||||
(narrow-to-region (point) (point-max)))
|
||||
|
||||
|
||||
;; Various stopping points
|
||||
((or
|
||||
|
||||
|
||||
;; Stop before ALL CAPS acronyms, if preceded by mixed-case
|
||||
;; words. Example: XT-DEM.
|
||||
(and (>= word-count 2)
|
||||
mixed-case-flag
|
||||
(looking-at mail-extr-weird-acronym-pattern)
|
||||
(not (looking-at mail-extr-roman-numeral-pattern)))
|
||||
|
||||
|
||||
;; Stop before trailing alternative address
|
||||
(looking-at mail-extr-alternative-address-pattern)
|
||||
|
||||
|
||||
;; Stop before trailing comment not introduced by comma
|
||||
;; THIS CASE MUST BE AFTER AN EARLIER CASE.
|
||||
(looking-at mail-extr-trailing-comment-start-pattern)
|
||||
|
||||
|
||||
;; Stop before telephone numbers
|
||||
(and (>= word-count 1)
|
||||
(looking-at mail-extr-telephone-extension-pattern)))
|
||||
(setq name-done-flag t))
|
||||
|
||||
|
||||
;; Delete ham radio call signs
|
||||
((looking-at mail-extr-ham-call-sign-pattern)
|
||||
(delete-region (match-beginning 0) (match-end 0)))
|
||||
|
||||
|
||||
;; Fixup initials
|
||||
((looking-at mail-extr-initial-pattern)
|
||||
(or (eq (following-char) (upcase (following-char)))
|
||||
|
@ -1688,14 +1688,14 @@ consing a string.)"
|
|||
(or (eq ?\ (following-char))
|
||||
(insert ?\ ))
|
||||
(setq word-found-flag t))
|
||||
|
||||
|
||||
;; Handle BITNET LISTSERV list names.
|
||||
((and (eq word-count 0)
|
||||
(looking-at mail-extr-listserv-list-name-pattern))
|
||||
(narrow-to-region (match-beginning 1) (match-end 1))
|
||||
(setq word-found-flag t)
|
||||
(setq name-done-flag t))
|
||||
|
||||
|
||||
;; Handle & substitution, when & is last and is not first.
|
||||
((and (> word-count 0)
|
||||
(eq ?\ (preceding-char))
|
||||
|
@ -1722,7 +1722,7 @@ consing a string.)"
|
|||
((looking-at mail-extr-name-pattern)
|
||||
(setq name-beg (point))
|
||||
(setq name-end (match-end 0))
|
||||
|
||||
|
||||
;; Certain words will be dropped if they are at the end.
|
||||
(and (>= word-count 2)
|
||||
(not lower-case-flag)
|
||||
|
@ -1733,7 +1733,7 @@ consing a string.)"
|
|||
;; Drop a trailing word which is terminated with a period.
|
||||
(eq ?. (char-after (1- name-end))))
|
||||
(setq drop-this-word-if-trailing-flag t))
|
||||
|
||||
|
||||
;; Set the flags that indicate whether we have seen a lowercase
|
||||
;; word, a mixed case word, and an uppercase word.
|
||||
(if (re-search-forward "[a-z]" name-end t)
|
||||
|
@ -1744,7 +1744,7 @@ consing a string.)"
|
|||
(setq lower-case-flag t))
|
||||
;; (setq upper-case-flag t)
|
||||
)
|
||||
|
||||
|
||||
(goto-char name-end)
|
||||
(setq word-found-flag t))
|
||||
|
||||
|
@ -1758,11 +1758,11 @@ consing a string.)"
|
|||
(t
|
||||
(setq name-done-flag t)
|
||||
))
|
||||
|
||||
|
||||
;; Count any word that we skipped over.
|
||||
(if word-found-flag
|
||||
(setq word-count (1+ word-count))))
|
||||
|
||||
|
||||
;; If the last thing in the name is 2 or more periods, or one or more
|
||||
;; other sentence terminators (but not a single period) then keep them
|
||||
;; and the preceding word. This is for the benefit of whole sentences
|
||||
|
@ -1777,7 +1777,7 @@ consing a string.)"
|
|||
(or (and drop-last-word-if-trailing-flag
|
||||
last-word-beg)
|
||||
(point)))
|
||||
|
||||
|
||||
;; Xerox's mailers SUCK!!!!!!
|
||||
;; We simply refuse to believe that any last name is PARC or ADOC.
|
||||
;; If it looks like that is the last name, that there is no meaningful
|
||||
|
@ -1802,7 +1802,7 @@ consing a string.)"
|
|||
(goto-char name-end)
|
||||
(skip-chars-forward "\t ,")
|
||||
(narrow-to-region (point) (point-max)))
|
||||
|
||||
|
||||
;; Delete leading and trailing junk characters.
|
||||
;; *** This is probably completely unneeded now.
|
||||
;;(goto-char (point-max))
|
||||
|
@ -1814,7 +1814,7 @@ consing a string.)"
|
|||
;; (goto-char (point-min))
|
||||
;; (skip-chars-forward mail-extr-non-begin-name-chars)
|
||||
;; (point)))
|
||||
|
||||
|
||||
;; Compress whitespace
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "[ \t\n]+" nil t)
|
||||
|
@ -2132,7 +2132,7 @@ consing a string.)"
|
|||
|
||||
;(let ((all nil))
|
||||
; (mapatoms #'(lambda (x)
|
||||
; (if (and (boundp x)
|
||||
; (if (and (boundp x)
|
||||
; (string-match "^mail-extr-" (symbol-name x)))
|
||||
; (setq all (cons x all)))))
|
||||
; (setq all (sort all #'string-lessp))
|
||||
|
|
|
@ -38,7 +38,7 @@
|
|||
;; The main entry points of EUDC are:
|
||||
;; `eudc-query-form': Query a directory server from a query form
|
||||
;; `eudc-expand-inline': Query a directory server for the e-mail address
|
||||
;; of the name before cursor and insert it in the
|
||||
;; of the name before cursor and insert it in the
|
||||
;; buffer
|
||||
;; `eudc-get-phone': Get a phone number from a directory server
|
||||
;; `eudc-get-email': Get an e-mail address from a directory server
|
||||
|
@ -207,7 +207,7 @@ Value is the new string."
|
|||
(defun eudc-default-set (var val)
|
||||
"Set the EUDC default value of VAR to VAL.
|
||||
The current binding of VAR is not changed."
|
||||
(put var 'eudc-locals
|
||||
(put var 'eudc-locals
|
||||
(plist-put (get var 'eudc-locals) 'default val))
|
||||
(add-to-list 'eudc-local-vars var))
|
||||
|
||||
|
@ -221,7 +221,7 @@ The current binding of VAR is changed only if PROTOCOL is omitted."
|
|||
(protocol-locals (eudc-plist-get eudc-locals 'protocol)))
|
||||
(setq protocol-locals (plist-put protocol-locals (or protocol
|
||||
eudc-protocol) val))
|
||||
(setq eudc-locals
|
||||
(setq eudc-locals
|
||||
(plist-put eudc-locals 'protocol protocol-locals))
|
||||
(put var 'eudc-locals eudc-locals)
|
||||
(add-to-list 'eudc-local-vars var)
|
||||
|
@ -293,7 +293,7 @@ SERVER defaults to `eudc-server'"
|
|||
(eudc-plist-member eudc-locals 'server)))
|
||||
'unbound
|
||||
(setq server-locals (eudc-plist-get eudc-locals 'server))
|
||||
(eudc-lax-plist-get server-locals
|
||||
(eudc-lax-plist-get server-locals
|
||||
(or server
|
||||
eudc-server) 'unbound))))
|
||||
|
||||
|
@ -789,7 +789,7 @@ If none try N - 1 and so forth."
|
|||
(let (formats)
|
||||
(while (and (null formats)
|
||||
(> n 0))
|
||||
(setq formats
|
||||
(setq formats
|
||||
(delq nil
|
||||
(mapcar '(lambda (format)
|
||||
(if (= n
|
||||
|
@ -1103,7 +1103,7 @@ queries the server for the existing fields and displays a corresponding form."
|
|||
|
||||
;;}}}
|
||||
|
||||
;;{{{ Menus an keymaps
|
||||
;;{{{ Menus and keymaps
|
||||
|
||||
(require 'easymenu)
|
||||
|
||||
|
|
|
@ -366,7 +366,7 @@ COMMA-DELIM is non-nil then ',' is treated likewise."
|
|||
c-maybe-labelp nil))))
|
||||
|
||||
;; Step to next sexp, but not if we crossed a boundary, since
|
||||
;; that doesn't consume an sexp.
|
||||
;; that doesn't consume a sexp.
|
||||
(if (eq sym 'boundary)
|
||||
(setq ret 'previous)
|
||||
(while
|
||||
|
|
|
@ -1183,7 +1183,7 @@ otherwise."
|
|||
(beginning-of-line)
|
||||
(looking-at "^\\s-*\\s<+\\s-*$"))))
|
||||
;; This is a nonempty comment line which does not extend
|
||||
;; past the fill column. If it is followed by an nonempty
|
||||
;; past the fill column. If it is followed by a nonempty
|
||||
;; comment line with the same comment prefix, try to
|
||||
;; combine them, and repeat this until either we reach the
|
||||
;; fill-column or there is nothing more to combine.
|
||||
|
|
Loading…
Add table
Reference in a new issue