;; 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
;; 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
;; (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
;; 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
;; 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.
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."
;; 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)
;; 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))
;;; (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)
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))))
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)
(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)
(concat auxdir1 elt) nil nil))
common))
))
-
+
;; If file groups selected by patterns will ever be implemented, this
;; comparison function might become useful.
(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
;; 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
;; 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)
(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
;; 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, ?*
(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"))
----------------------------------------------
")
-
+
;; discard info on directories and regexp
(setq meta-list (cdr meta-list)
tmp-list meta-list)
(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.
(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))
(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)
(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
;;; (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."
(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)
(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
))
(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."
;; 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)
(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
"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 ()
((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 ()
((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 ()
((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 ()
(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))
))
(if (ediff-window-display-p)
(progn
- (setq frame
+ (setq frame
(window-frame
(ediff-get-visible-buffer-window ediff-registry-buffer)))
(raise-frame frame)
(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"
'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)
(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
;; 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))
(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)
(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)
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))
(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)))
(insert (format "map-single r%d r%d map(%S)\n" RRR rrr id))))
\f
-;; CCL emulation staffs
+;; CCL emulation staffs
;; Not yet implemented.
\f
;; (REG <8= ARG) is the same as:
;; ((REG <<= 8)
;; (REG |= ARG))
- | <8=
+ | <8=
;; (REG >8= ARG) is the same as:
;; ((r7 = (REG & 255))
;; 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.)
;; 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:
;; * 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
;; * 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.
;; 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.
(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)))
;; 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
;; 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.]"))
;; 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
;; 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 '~}'
(widen)
(erase-buffer)
(setq case-fold-search nil)
-
+
;; Insert extra space at beginning to allow later replacement with <
;; without having to move markers.
(insert ?\ )
(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))
;; 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)
(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
;; 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)
(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))
(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))
(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))
(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)
;; *** 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)))
(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))
((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)
;; 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)
(setq lower-case-flag t))
;; (setq upper-case-flag t)
)
-
+
(goto-char name-end)
(setq word-found-flag t))
(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
(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
(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))
;; (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)
\f
;(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))
;; 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
(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))
(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)
(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))))
(let (formats)
(while (and (null formats)
(> n 0))
- (setq formats
+ (setq formats
(delq nil
(mapcar '(lambda (format)
(if (= n
;;}}}
-;;{{{ Menus an keymaps
+;;{{{ Menus and keymaps
(require 'easymenu)
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
(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.
HCoop / bpt / emacs.git / commitdiff