# HG changeset patch # User Karoly Lorentey # Date 1091891102 0 # Node ID 4a196c3bd2d8800dcf72bae05fe28bc39f1048fd # Parent 1adf7aed36490beb18d927093c3c21b2bdcdbdfb# Parent 9a317339d66ac63bc010bbf39fe327155140a2d2 Merged in changes from CVS trunk. Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-479 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-480 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-481 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-227 diff -r 1adf7aed3649 -r 4a196c3bd2d8 ChangeLog --- a/ChangeLog Thu Aug 05 14:54:57 2004 +0000 +++ b/ChangeLog Sat Aug 07 15:05:02 2004 +0000 @@ -1,3 +1,7 @@ +2004-08-06 Andreas Schwab + + * Makefile.in (install-arch-indep, uninstall): Add flymake. + 2004-07-31 Eli Zaretskii * config.bat: Update URLs in the comments. diff -r 1adf7aed3649 -r 4a196c3bd2d8 Makefile.in --- a/Makefile.in Thu Aug 05 14:54:57 2004 +0000 +++ b/Makefile.in Sat Aug 07 15:05:02 2004 +0000 @@ -475,7 +475,7 @@ chmod a+r ${infodir}/dir); \ fi; \ cd ${srcdir}/info ; \ - for f in ada-mode* autotype* calc* ccmode* cl* dired-x* ebrowse* ediff* efaq* eintr* elisp* emacs* emacs-xtra* eshell* eudc* forms* gnus* idlwave* info* message* mh-e* pcl-cvs* reftex* sc* ses* speedbar* tramp* vip* widget* woman* smtpmail*; do \ + for f in ada-mode* autotype* calc* ccmode* cl* dired-x* ebrowse* ediff* efaq* eintr* elisp* emacs* emacs-xtra* eshell* eudc* flymake* forms* gnus* idlwave* info* message* mh-e* pcl-cvs* reftex* sc* ses* speedbar* tramp* vip* widget* woman* smtpmail*; do \ (cd $${thisdir}; \ ${INSTALL_DATA} ${srcdir}/info/$$f ${infodir}/$$f; \ chmod a+r ${infodir}/$$f); \ @@ -485,7 +485,7 @@ thisdir=`/bin/pwd`; \ if [ `(cd ${srcdir}/info && /bin/pwd)` != `(cd ${infodir} && /bin/pwd)` ]; \ then \ - for f in ada-mode autotype calc ccmode cl dired-x ebrowse ediff efaq elisp eintr emacs emacs-mime emacs-xtra eshell eudc forms gnus idlwave info message mh-e pcl-cvs reftex sc ses speedbar tramp vip viper widget woman smtpmail; do \ + for f in ada-mode autotype calc ccmode cl dired-x ebrowse ediff efaq elisp eintr emacs emacs-mime emacs-xtra eshell eudc flymake forms gnus idlwave info message mh-e pcl-cvs reftex sc ses speedbar tramp vip viper widget woman smtpmail; do \ (cd $${thisdir}; \ ${INSTALL_INFO} --info-dir=${infodir} ${infodir}/$$f); \ done; \ @@ -551,7 +551,7 @@ done (cd ${archlibdir} && rm -f fns-*) -rm -rf ${libexecdir}/emacs/${version} - (cd ${infodir} && rm -f cl* ada-mode* autotype* calc* ccmode* ebrowse* efaq* eintr elisp* eshell* eudc* idlwave* message* pcl-cvs* reftex* speedbar* tramp* widget* woman* dired-x* ediff* emacs* emacs-xtra* forms* gnus* info* mh-e* sc* ses* vip* smtpmail*) + (cd ${infodir} && rm -f cl* ada-mode* autotype* calc* ccmode* ebrowse* efaq* eintr elisp* eshell* eudc* idlwave* message* pcl-cvs* reftex* speedbar* tramp* widget* woman* dired-x* ediff* emacs* emacs-xtra* flymake* forms* gnus* info* mh-e* sc* ses* vip* smtpmail*) (cd ${man1dir} && rm -f emacs${manext} emacsclient${manext} etags${manext} ctags${manext}) (cd ${bindir} && rm -f $(EMACSFULL) $(EMACS)) diff -r 1adf7aed3649 -r 4a196c3bd2d8 leim/ChangeLog --- a/leim/ChangeLog Thu Aug 05 14:54:57 2004 +0000 +++ b/leim/ChangeLog Sat Aug 07 15:05:02 2004 +0000 @@ -1,3 +1,7 @@ +2004-08-06 Andreas Schwab + + * Makefile.in (install): Remove .arch-inventory files. + 2004-07-01 David Kastrup * quail/greek.el ("((") ("))"): add quotation mark shorthands. diff -r 1adf7aed3649 -r 4a196c3bd2d8 leim/Makefile.in --- a/leim/Makefile.in Thu Aug 05 14:54:57 2004 +0000 +++ b/leim/Makefile.in Sat Aug 07 15:05:02 2004 +0000 @@ -232,6 +232,7 @@ fi; \ rm -rf ${INSTALLDIR}/CVS ${INSTALLDIR}/*/CVS; \ rm -f ${INSTALLDIR}/.cvsignore ${INSTALLDIR}/*/.cvsignore; \ + rm -f ${INSTALLDIR}/.arch-inventory ${INSTALLDIR}/*/.arch-inventory; \ rm -f ${INSTALLDIR}/\#* ${INSTALLDIR}/*/\#* ; \ rm -f ${INSTALLDIR}/.\#* ${INSTALLDIR}/*/.\#* ; \ rm -f ${INSTALLDIR}/*~ ${INSTALLDIR}/*/*~ ; \ diff -r 1adf7aed3649 -r 4a196c3bd2d8 lisp/ChangeLog --- a/lisp/ChangeLog Thu Aug 05 14:54:57 2004 +0000 +++ b/lisp/ChangeLog Sat Aug 07 15:05:02 2004 +0000 @@ -1,3 +1,27 @@ +2004-08-04 Kenichi Handa + + * international/encoded-kb.el (encoded-kbd-setup-keymap): Fix + previous change. + +2004-08-03 Kenichi Handa + + * international/encoded-kb.el: The following changes are to + utilize key-translation-map instead of minor mode map. + (encoded-kbd-iso2022-non-ascii-map): Delete it. + (encoded-kbd-coding, encoded-kbd-handle-8bit): Delete them. + (encoded-kbd-last-key): New function. + (encoded-kbd-iso2022-single-shift): New function. + (encoded-kbd-iso2022-designation) + (encoded-kbd-self-insert-iso2022-7bit) + (encoded-kbd-self-insert-iso2022-8bit) + (encoded-kbd-self-insert-sjis, encoded-kbd-self-insert-big5) + (encoded-kbd-self-insert-ccl): Make them suitable for bindings in + key-translation-map. + (encoded-kbd-setup-keymap): Setup key-translation-map. + (saved-key-translation-map): New variable. + (encoded-kbd-mode): Save/restore key-translation-map. Adjusted + for the change of encoded-kbd-setup-keymap. + 2004-08-02 Kim F. Storm * avoid.el (mouse-avoidance-point-position): Use window-inside-edges diff -r 1adf7aed3649 -r 4a196c3bd2d8 lisp/international/encoded-kb.el --- a/lisp/international/encoded-kb.el Thu Aug 05 14:54:57 2004 +0000 +++ b/lisp/international/encoded-kb.el Sat Aug 07 15:05:02 2004 +0000 @@ -24,6 +24,10 @@ ;;; Code: +;; Usually this map is empty (even if Encoded-kbd mode is on), but if +;; the keyboard coding system is iso-2022-based, it defines dummy key +;; bindings for ESC $ ..., etc. so that those bindings in +;; key-translation-map take effect. (defconst encoded-kbd-mode-map (make-sparse-keymap) "Keymap for Encoded-kbd minor mode.") @@ -69,25 +73,6 @@ (fset 'encoded-kbd-iso2022-designation-prefix encoded-kbd-iso2022-designation-map) -(defvar encoded-kbd-iso2022-non-ascii-map - (let ((map (make-keymap)) - (i 32)) - (while (< i 128) - (define-key map (char-to-string i) 'encoded-kbd-self-insert-iso2022-7bit) - (setq i (1+ i))) - (define-key map "\e" 'encoded-kbd-iso2022-esc-prefix) - (setq i 160) - (while (< i 256) - (define-key map (vector i) 'encoded-kbd-handle-8bit) - (setq i (1+ i))) - map) - "Keymap for handling non-ASCII character set in Encoded-kbd mode.") - -;; One of the symbols `sjis', `iso2022-7', `iso2022-8', or `big5' to -;; denote what kind of coding-system we are now handling in -;; Encoded-kbd mode. -(defvar encoded-kbd-coding nil) - ;; Keep information of designation state of ISO2022 encoding. When ;; Encoded-kbd mode is on, this is set to a vector of length 4, the ;; elements are character sets currently designated to graphic @@ -104,11 +89,14 @@ (defvar encoded-kbd-iso2022-invocations nil) (put 'encoded-kbd-iso2022-invocations 'permanent-local t) -(defun encoded-kbd-iso2022-designation () +(defsubst encoded-kbd-last-key () + (let ((keys (this-single-command-keys))) + (aref keys (1- (length keys))))) + +(defun encoded-kbd-iso2022-designation (ignore) "Do ISO2022 designation according to the current key in Encoded-kbd mode. The following key sequence may cause multilingual text insertion." - (interactive) - (let ((key-seq (this-command-keys)) + (let ((key-seq (this-single-command-keys)) (prev-g0-charset (aref encoded-kbd-iso2022-designations (aref encoded-kbd-iso2022-invocations 0))) intermediate-char final-char @@ -132,143 +120,122 @@ chars (if (< intermediate-char ?,) 94 96) final-char (aref key-seq 2) reg (mod intermediate-char 4)))) - (if (setq charset (iso-charset dimension chars final-char)) - (aset encoded-kbd-iso2022-designations reg charset) - (error "Character set of DIMENSION %s, CHARS %s, FINAL-CHAR `%c' is not supported" - dimension chars final-char)) - - (if (memq (aref encoded-kbd-iso2022-designations - (aref encoded-kbd-iso2022-invocations 0)) - '(ascii latin-jisx0201)) - ;; Graphic plane 0 (0x20..0x7f) is for ASCII. We don't have - ;; to handle characters in this range specially. - (if (not (memq prev-g0-charset '(ascii latin-jisx0201))) - ;; We must exit recursive edit now. - (throw 'exit nil)) - ;; Graphic plane 0 is for non-ASCII. - (if (memq prev-g0-charset '(ascii latin-jisx0201)) - ;; We must handle keys specially. - (let ((overriding-local-map encoded-kbd-iso2022-non-ascii-map)) - (recursive-edit)))))) + (aset encoded-kbd-iso2022-designations reg + (iso-charset dimension chars final-char))) + "") -(defun encoded-kbd-handle-8bit () - "Handle an 8-bit character entered in Encoded-kbd mode." - (interactive) - (cond ((eq encoded-kbd-coding 'iso2022-7) - (error "Can't handle the character code %d" last-command-char)) - - ((eq encoded-kbd-coding 'iso2022-8) - (cond ((= last-command-char ?\216) - (aset encoded-kbd-iso2022-invocations 2 2)) - - ((= last-command-char ?\217) - (aset encoded-kbd-iso2022-invocations 2 3)) +(defun encoded-kbd-iso2022-single-shift (ignore) + (let ((char (encoded-kbd-last-key))) + (aset encoded-kbd-iso2022-invocations 2 + (aref encoded-kbd-iso2022-designations + (if (= char ?\216) 2 3)))) + "") - ((>= last-command-char ?\240) - (encoded-kbd-self-insert-iso2022-8bit)) - - (t - (error "Can't handle the character code %d" - last-command-char)))) - - ((eq encoded-kbd-coding 'sjis) - (encoded-kbd-self-insert-sjis)) - - (t - (encoded-kbd-self-insert-big5)))) +(defun encoded-kbd-self-insert-iso2022-7bit (ignore) + (let ((char (encoded-kbd-last-key)) + (charset (aref encoded-kbd-iso2022-designations + (or (aref encoded-kbd-iso2022-invocations 2) + (aref encoded-kbd-iso2022-invocations 0))))) + (aset encoded-kbd-iso2022-invocations 2 nil) + (vector (if (= (charset-dimension charset) 1) + (make-char charset char) + (make-char charset char (read-char-exclusive)))))) -(defun encoded-kbd-self-insert-iso2022-7bit () - (interactive) - (let* ((charset (aref encoded-kbd-iso2022-designations - (or (aref encoded-kbd-iso2022-invocations 2) - (aref encoded-kbd-iso2022-invocations 0)))) - (char (if (= (charset-dimension charset) 1) - (make-char charset last-command-char) - (make-char charset last-command-char (read-char-exclusive))))) +(defun encoded-kbd-self-insert-iso2022-8bit (ignore) + (let ((char (encoded-kbd-last-key)) + (charset (aref encoded-kbd-iso2022-designations + (or (aref encoded-kbd-iso2022-invocations 2) + (aref encoded-kbd-iso2022-invocations 1))))) (aset encoded-kbd-iso2022-invocations 2 nil) - (setq unread-command-events (cons char unread-command-events)))) + (vector (if (= (charset-dimension charset) 1) + (make-char charset char) + (make-char charset char (read-char-exclusive)))))) -(defun encoded-kbd-self-insert-iso2022-8bit () - (interactive) - (cond - ((= last-command-char ?\216) ; SS2 (Single Shift 2) - (aset encoded-kbd-iso2022-invocations 2 2)) - ((= last-command-char ?\217) ; SS3 (Single Shift 3) - (aset encoded-kbd-iso2022-invocations 2 3)) - (t - (let* ((charset (aref encoded-kbd-iso2022-designations - (or (aref encoded-kbd-iso2022-invocations 2) - (aref encoded-kbd-iso2022-invocations 1)))) - (char (if (= (charset-dimension charset) 1) - (make-char charset last-command-char) - (make-char charset last-command-char - (read-char-exclusive))))) - (aset encoded-kbd-iso2022-invocations 2 nil) - (setq unread-command-events (cons char unread-command-events)))))) +(defun encoded-kbd-self-insert-sjis (ignore) + (let ((char (encoded-kbd-last-key))) + (vector + (if (or (< char ?\xA0) (>= char ?\xE0)) + (decode-sjis-char (+ (ash char 8) (read-char-exclusive))) + (make-char 'katakana-jisx0201 char))))) -(defun encoded-kbd-self-insert-sjis () - (interactive) - (let ((char (if (or (< last-command-char ?\xA0) (>= last-command-char ?\xE0)) - (decode-sjis-char (+ (ash last-command-char 8) - (read-char-exclusive))) - (make-char 'katakana-jisx0201 last-command-char)))) - (setq unread-command-events (cons char unread-command-events)))) +(defun encoded-kbd-self-insert-big5 (ignore) + (let ((char (encoded-kbd-last-key))) + (vector + (decode-big5-char (+ (ash char 8) (read-char-exclusive)))))) -(defun encoded-kbd-self-insert-big5 () - (interactive) - (let ((char (decode-big5-char (+ (ash last-command-char 8) - (read-char-exclusive))))) - (setq unread-command-events (cons char unread-command-events)))) - -(defun encoded-kbd-self-insert-ccl () - (interactive) - (let ((str (char-to-string last-command-char)) +(defun encoded-kbd-self-insert-ccl (ignore) + (let ((str (char-to-string (encoded-kbd-last-key))) (ccl (car (aref (coding-system-spec (keyboard-coding-system)) 4))) (vec [nil nil nil nil nil nil nil nil nil]) result) (while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0) (dotimes (i 9) (aset vec i nil)) (setq str (format "%s%c" str (read-char-exclusive)))) - (setq unread-command-events - (append result unread-command-events)))) + (vector (aref result 0)))) (defun encoded-kbd-setup-keymap (coding) ;; At first, reset the keymap. - (setcdr encoded-kbd-mode-map nil) + (define-key encoded-kbd-mode-map "\e" nil) ;; Then setup the keymap according to the keyboard coding system. (cond - ((eq encoded-kbd-coding 'sjis) + ((eq (coding-system-type coding) 1) ; SJIS (let ((i 128)) (while (< i 256) - (define-key encoded-kbd-mode-map + (define-key key-translation-map (vector i) 'encoded-kbd-self-insert-sjis) - (setq i (1+ i))))) + (setq i (1+ i)))) + 8) - ((eq encoded-kbd-coding 'big5) + ((eq (coding-system-type coding) 3) ; Big5 (let ((i 161)) (while (< i 255) - (define-key encoded-kbd-mode-map + (define-key key-translation-map (vector i) 'encoded-kbd-self-insert-big5) - (setq i (1+ i))))) - - ((eq encoded-kbd-coding 'iso2022-7) - (define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix)) + (setq i (1+ i)))) + 8) - ((eq encoded-kbd-coding 'iso2022-8) - (define-key encoded-kbd-mode-map - (vector ?\216) 'encoded-kbd-self-insert-iso2022-8bit) - (define-key encoded-kbd-mode-map - (vector ?\217) 'encoded-kbd-self-insert-iso2022-8bit) - (let ((i 160)) - (while (< i 256) - (define-key encoded-kbd-mode-map - (vector i) 'encoded-kbd-self-insert-iso2022-8bit) - (setq i (1+ i))))) + ((eq (coding-system-type coding) 2) ; ISO-2022 + (let ((flags (coding-system-flags coding)) + use-designation) + (if (aref flags 8) + nil ; Don't support locking-shift. + (setq encoded-kbd-iso2022-designations (make-vector 4 nil) + encoded-kbd-iso2022-invocations (make-vector 3 nil)) + (dotimes (i 4) + (if (aref flags i) + (if (charsetp (aref flags i)) + (aset encoded-kbd-iso2022-designations + i (aref flags i)) + (setq use-designation t) + (if (charsetp (car-safe (aref flags i))) + (aset encoded-kbd-iso2022-designations + i (car (aref flags i))))))) + (aset encoded-kbd-iso2022-invocations 0 0) + (if (aref encoded-kbd-iso2022-designations 1) + (aset encoded-kbd-iso2022-invocations 1 1)) + (when use-designation + (define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix) + (define-key key-translation-map "\e" 'encoded-kbd-iso2022-esc-prefix)) + (when (or (aref flags 2) (aref flags 3)) + (define-key key-translation-map + [?\216] 'encoded-kbd-iso2022-single-shift) + (define-key key-translation-map + [?\217] 'encoded-kbd-iso2022-single-shift)) + (or (eq (aref flags 0) 'ascii) + (dotimes (i 96) + (define-key key-translation-map + (vector (+ 32 i)) 'encoded-kbd-self-insert-iso2022-7bit))) + (if (aref flags 7) + t + (dotimes (i 96) + (define-key key-translation-map + (vector (+ 160 i)) 'encoded-kbd-self-insert-iso2022-8bit)) + 8)))) - ((eq encoded-kbd-coding 'ccl) + ((eq (coding-system-type coding) 4) ; CCL-base (let ((valid-codes (or (coding-system-get coding 'valid-codes) '((128 . 255)))) - elt from to) + elt from to valid) (while valid-codes (setq elt (car valid-codes) valid-codes (cdr valid-codes)) (if (consp elt) @@ -276,13 +243,17 @@ (setq from (setq to elt))) (while (<= from to) (if (>= from 128) - (define-key encoded-kbd-mode-map + (define-key key-translation-map (vector from) 'encoded-kbd-self-insert-ccl)) - (setq from (1+ from)))))) + (setq from (1+ from)))) + 8)) (t - (error "Invalid value in encoded-kbd-coding: %s" encoded-kbd-coding)))) + nil))) +;; key-translation-map at the time Encoded-kbd mode is turned on is +;; saved here. +(defvar saved-key-translation-map nil) ;; Input mode at the time Encoded-kbd mode is turned on is saved here. (defvar saved-input-mode nil) @@ -301,60 +272,38 @@ as a multilingual text encoded in a coding system set by \\[set-keyboard-coding-system]." :global t - ;; We must at first reset input-mode to the original. - (if saved-input-mode (apply 'set-input-mode saved-input-mode)) - (if encoded-kbd-mode - (let ((coding (keyboard-coding-system))) - (setq saved-input-mode (current-input-mode)) - (cond ((null coding) - (setq encoded-kbd-mode nil) - (error "No coding system for keyboard input is set")) - - ((= (coding-system-type coding) 1) ; SJIS - (set-input-mode - (nth 0 saved-input-mode) (nth 1 saved-input-mode) - 'use-8th-bit (nth 3 saved-input-mode)) - (setq encoded-kbd-coding 'sjis)) - ((= (coding-system-type coding) 2) ; ISO2022 - (if (aref (coding-system-flags coding) 7) ; 7-bit only - (setq encoded-kbd-coding 'iso2022-7) - (set-input-mode - (nth 0 saved-input-mode) (nth 1 saved-input-mode) - 'use-8th-bit (nth 3 saved-input-mode)) - (setq encoded-kbd-coding 'iso2022-8)) - (setq encoded-kbd-iso2022-designations (make-vector 4 nil)) - (let ((flags (coding-system-flags coding)) - (i 0)) - (while (< i 4) - (if (charsetp (aref flags i)) - (aset encoded-kbd-iso2022-designations i - (aref flags i)) - (if (charsetp (car-safe (aref flags i))) - (aset encoded-kbd-iso2022-designations i - (car (aref flags i))))) - (setq i (1+ i)))) - (setq encoded-kbd-iso2022-invocations (make-vector 3 nil)) - (aset encoded-kbd-iso2022-invocations 0 0) - (aset encoded-kbd-iso2022-invocations 1 1)) + (if encoded-kbd-mode + ;; We are turning on Encoded-kbd mode. + (let ((coding (keyboard-coding-system)) + result) + (or saved-key-translation-map + (if (keymapp key-translation-map) + (setq saved-key-translation-map + (copy-keymap key-translation-map)) + (setq key-translation-map (make-sparse-keymap)))) + (or saved-input-mode + (setq saved-input-mode + (current-input-mode))) + (setq result (and coding (encoded-kbd-setup-keymap coding))) + (if result + (if (eq result 8) + (set-input-mode + (nth 0 saved-input-mode) + (nth 1 saved-input-mode) + 'use-8th-bit + (nth 3 saved-input-mode))) + (setq encoded-kbd-mode nil + saved-key-translation-map nil + saved-input-mode nil) + (error "Unsupported coding system in Encoded-kbd mode: %S" + coding))) - ((= (coding-system-type coding) 3) ; BIG5 - (set-input-mode - (nth 0 saved-input-mode) (nth 1 saved-input-mode) - 'use-8th-bit (nth 3 saved-input-mode)) - (setq encoded-kbd-coding 'big5)) - - ((= (coding-system-type coding) 4) ; CCL based coding - (set-input-mode - (nth 0 saved-input-mode) (nth 1 saved-input-mode) - 'use-8th-bit (nth 3 saved-input-mode)) - (setq encoded-kbd-coding 'ccl)) - - (t - (setq encoded-kbd-mode nil) - (error "Coding-system `%s' is not supported in Encoded-kbd mode" - (keyboard-coding-system)))) - (encoded-kbd-setup-keymap coding)))) + ;; We are turning off Encoded-kbd mode. + (setq key-translation-map saved-key-translation-map + saved-key-translation-map nil) + (apply 'set-input-mode saved-input-mode) + (setq saved-input-mode nil))) (provide 'encoded-kb) diff -r 1adf7aed3649 -r 4a196c3bd2d8 lisp/mail/mail-extr.el --- a/lisp/mail/mail-extr.el Thu Aug 05 14:54:57 2004 +0000 +++ b/lisp/mail/mail-extr.el Sat Aug 07 15:05:02 2004 +0000 @@ -1434,374 +1434,388 @@ (if all (nreverse value-list) (car value-list)) )) +(defcustom mail-extr-disable-voodoo "\\cj" + "*If it is a regexp, names matching it will never be modified. +If it is neither nil nor a string, modifying of names will never take +place. It affects how `mail-extract-address-components' works." + :type '(choice (regexp :size 0) + (const :tag "Always enabled" nil) + (const :tag "Always disabled" t)) + :group 'mail-extr) + (defun mail-extr-voodoo (mbox-beg mbox-end canonicalization-buffer) - (let ((word-count 0) - (case-fold-search nil) - mixed-case-flag lower-case-flag ;;upper-case-flag - suffix-flag last-name-comma-flag - ;;cbeg cend - initial - begin-again-flag - drop-this-word-if-trailing-flag - drop-last-word-if-trailing-flag - word-found-flag - this-word-beg last-word-beg - name-beg name-end - name-done-flag - ) - (save-excursion - (set-syntax-table mail-extr-address-text-syntax-table) + (unless (and mail-extr-disable-voodoo + (or (not (stringp mail-extr-disable-voodoo)) + (progn + (goto-char (point-min)) + (re-search-forward mail-extr-disable-voodoo nil t)))) + (let ((word-count 0) + (case-fold-search nil) + mixed-case-flag lower-case-flag ;;upper-case-flag + suffix-flag last-name-comma-flag + ;;cbeg cend + initial + begin-again-flag + drop-this-word-if-trailing-flag + drop-last-word-if-trailing-flag + word-found-flag + this-word-beg last-word-beg + name-beg name-end + name-done-flag + ) + (save-excursion + (set-syntax-table mail-extr-address-text-syntax-table) + + ;; Get rid of comments. + (goto-char (point-min)) + (while (not (eobp)) + ;; Initialize for this iteration of the loop. + (skip-chars-forward "^({[\"'`") + (let ((cbeg (point))) + (set-syntax-table mail-extr-address-text-comment-syntax-table) + (if (memq (following-char) '(?\' ?\`)) + (search-forward "'" nil 'move + (if (eq ?\' (following-char)) 2 1)) + (or (mail-extr-safe-move-sexp 1) + (goto-char (point-max)))) + (set-syntax-table mail-extr-address-text-syntax-table) + (when (eq (char-after cbeg) ?\() + ;; Delete the comment itself. + (delete-region cbeg (point)) + ;; Canonicalize whitespace where the comment was. + (skip-chars-backward " \t") + (if (looking-at "\\([ \t]+$\\|[ \t]+,\\)") + (replace-match "") + (setq cbeg (point)) + (skip-chars-forward " \t") + (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 + ;; rypens@reks.uia.ac.be (Piet.Rypens) + ;; but also as + ;; "Piet.Rypens" + ;;(goto-char (point-min)) + ;;(while (re-search-forward mail-extr-bad-dot-pattern nil t) + ;; (replace-match "\\1 \\2" t)) - ;; Get rid of comments. - (goto-char (point-min)) - (while (not (eobp)) - ;; Initialize for this iteration of the loop. - (skip-chars-forward "^({[\"'`") - (let ((cbeg (point))) - (set-syntax-table mail-extr-address-text-comment-syntax-table) - (if (memq (following-char) '(?\' ?\`)) - (search-forward "'" nil 'move - (if (eq ?\' (following-char)) 2 1)) - (or (mail-extr-safe-move-sexp 1) - (goto-char (point-max)))) - (set-syntax-table mail-extr-address-text-syntax-table) - (when (eq (char-after cbeg) ?\() - ;; Delete the comment itself. - (delete-region cbeg (point)) - ;; Canonicalize whitespace where the comment was. - (skip-chars-backward " \t") - (if (looking-at "\\([ \t]+$\\|[ \t]+,\\)") - (replace-match "") - (setq cbeg (point)) - (skip-chars-forward " \t") - (if (bobp) - (delete-region (point) cbeg) - (just-one-space)))))) + (unless (search-forward " " nil t) + (goto-char (point-min)) + (cond ((search-forward "_" nil t) + ;; Handle the *idiotic* use of underlines as spaces. + ;; Example: fml@foo.bar.dom (First_M._Last) + (goto-char (point-min)) + (while (search-forward "_" nil t) + (replace-match " " t))) + ((search-forward "." nil t) + ;; Fix . used as space + ;; Example: danj1@cb.att.com (daniel.jacobson) + (goto-char (point-min)) + (while (re-search-forward mail-extr-bad-dot-pattern nil t) + (replace-match "\\1 \\2" t))))) + + ;; 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 drop-last-word-if-trailing-flag + drop-this-word-if-trailing-flag) + (setq word-found-flag nil)) + + (when begin-again-flag + ;; Last time through the loop we found something that + ;; indicates we should pretend we are beginning again from + ;; the start. + (setq word-count 0) + (setq last-word-beg nil) + (setq drop-last-word-if-trailing-flag nil) + (setq mixed-case-flag nil) + (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)) + (mail-extr-skip-whitespace-backward) + (setq suffix-flag (point)) + (if (eq ?, (following-char)) + (forward-char 1) + (insert ?,)) + ;; Enforce at least one space after comma + (or (eq ?\ (following-char)) + (insert ?\ )) + (mail-extr-skip-whitespace-forward) + (cond ((memq (following-char) '(?j ?J ?s ?S)) + (capitalize-word 1) + (if (eq (following-char) ?.) + (forward-char 1) + (insert ?.))) + (t + (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)) + (forward-char 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)) - ;; This was moved above. - ;; Fix . used as space - ;; But it belongs here because it occurs not only as - ;; rypens@reks.uia.ac.be (Piet.Rypens) - ;; but also as - ;; "Piet.Rypens" - ;;(goto-char (point-min)) - ;;(while (re-search-forward mail-extr-bad-dot-pattern nil t) - ;; (replace-match "\\1 \\2" t)) + ;; Delete parenthesized/quoted comment/nickname + ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`)) + (setq cbeg (point)) + (set-syntax-table mail-extr-address-text-comment-syntax-table) + (cond ((memq (following-char) '(?\' ?\`)) + (or (search-forward "'" nil t + (if (eq ?\' (following-char)) 2 1)) + (delete-char 1))) + (t + (or (mail-extr-safe-move-sexp 1) + (goto-char (point-max))))) + (set-syntax-table mail-extr-address-text-syntax-table) + (setq cend (point)) + (cond + ;; Handle case of entire name being quoted + ((and (eq word-count 0) + (looking-at " *\\'") + (>= (- cend cbeg) 2)) + (narrow-to-region (1+ cbeg) (1- cend)) + (goto-char (point-min))) + (t + ;; Handle case of quoted initial + (if (and (or (= 3 (- cend cbeg)) + (and (= 4 (- cend cbeg)) + (eq ?. (char-after (+ 2 cbeg))))) + (not (looking-at " *\\'"))) + (setq initial (char-after (1+ cbeg))) + (setq initial nil)) + (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)) - (unless (search-forward " " nil t) - (goto-char (point-min)) - (cond ((search-forward "_" nil t) - ;; Handle the *idiotic* use of underlines as spaces. - ;; Example: fml@foo.bar.dom (First_M._Last) - (goto-char (point-min)) - (while (search-forward "_" nil t) - (replace-match " " t))) - ((search-forward "." nil t) - ;; Fix . used as space - ;; Example: danj1@cb.att.com (daniel.jacobson) - (goto-char (point-min)) - (while (re-search-forward mail-extr-bad-dot-pattern nil t) - (replace-match "\\1 \\2" t))))) + ;; Skip initial garbage characters. + ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. + ((and (eq word-count 0) + (looking-at mail-extr-leading-garbage)) + (goto-char (match-end 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) - ;; Loop over the words (and other junk) in the name. - (goto-char (point-min)) - (while (not name-done-flag) + ;; 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))) + (setq lower-case-flag t)) + (forward-char 1) + (if (eq ?. (following-char)) + (forward-char 1) + (insert ?.)) + (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)) - (when word-found-flag - ;; Last time through this loop we skipped over a word. - (setq last-word-beg this-word-beg) - (setq drop-last-word-if-trailing-flag - drop-this-word-if-trailing-flag) - (setq word-found-flag nil)) + ;; Handle & substitution, when & is last and is not first. + ((and (> word-count 0) + (eq ?\ (preceding-char)) + (eq (following-char) ?&) + (eq (1+ (point)) (point-max))) + (delete-char 1) + (capitalize-region + (point) + (progn + (insert-buffer-substring canonicalization-buffer + mbox-beg mbox-end) + (point))) + (setq disable-initial-guessing-flag t) + (setq word-found-flag t)) + + ;; Handle & between names, as in "Bob & Susie". + ((and (> word-count 0) (eq (following-char) ?\&)) + (setq name-beg (point)) + (setq name-end (1+ name-beg)) + (setq word-found-flag t) + (goto-char name-end)) + + ;; Regular name words + ((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) + (or + ;; Trailing 4-or-more letter lowercase words preceded by + ;; mixed case or uppercase words will be dropped. + (looking-at "[[:lower:]]\\{4,\\}[ \t]*\\'") + ;; 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 "[[:lower:]]" name-end t) + (if (progn + (goto-char name-beg) + (re-search-forward "[[:upper:]]" name-end t)) + (setq mixed-case-flag t) + (setq lower-case-flag t)) + ;; (setq upper-case-flag t) + ) + + (goto-char name-end) + (setq word-found-flag t)) - (when begin-again-flag - ;; Last time through the loop we found something that - ;; indicates we should pretend we are beginning again from - ;; the start. - (setq word-count 0) - (setq last-word-beg nil) - (setq drop-last-word-if-trailing-flag nil) - (setq mixed-case-flag nil) - (setq lower-case-flag nil) - ;; (setq upper-case-flag nil) - (setq begin-again-flag nil)) + ;; Allow a number as a word, if it doesn't mean anything else. + ((looking-at "[0-9]+\\>") + (setq name-beg (point)) + (setq name-end (match-end 0)) + (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 + ;; in the name field: it's better behavior than dropping the last word + ;; of the sentence... + (if (and (not suffix-flag) + (looking-at "\\(\\.+\\|[?!;:.][?!;:.]+\\|[?!;:][?!;:.]*\\)\\'")) + (goto-char (setq suffix-flag (point-max)))) - ;; 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) + ;; Drop everything after point and certain trailing words. + (narrow-to-region (point-min) + (or (and drop-last-word-if-trailing-flag + last-word-beg) + (point))) - ;; Decide what to do based on what we are looking at. - (cond + ;; 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 + ;; here at all. Actually I guess it would be best to map patterns + ;; like foo.hoser@xerox.com into foo@hoser.xerox.com, but I don't + ;; actually know that that is what's going on. + (unless suffix-flag + (goto-char (point-min)) + (let ((case-fold-search t)) + (if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'") + (erase-buffer)))) - ;; Delete title - ((and (eq word-count 0) - (looking-at mail-extr-full-name-prefixes)) - (goto-char (match-end 0)) + ;; If last name first put it at end (but before suffix) + (when last-name-comma-flag + (goto-char (point-min)) + (search-forward ",") + (setq name-end (1- (point))) + (goto-char (or suffix-flag (point-max))) + (or (eq ?\ (preceding-char)) + (insert ?\ )) + (insert-buffer-substring (current-buffer) (point-min) name-end) + (goto-char name-end) + (skip-chars-forward "\t ,") (narrow-to-region (point) (point-max))) - ;; Stop after name suffix - ((and (>= word-count 2) - (looking-at mail-extr-full-name-suffix-pattern)) - (mail-extr-skip-whitespace-backward) - (setq suffix-flag (point)) - (if (eq ?, (following-char)) - (forward-char 1) - (insert ?,)) - ;; Enforce at least one space after comma - (or (eq ?\ (following-char)) - (insert ?\ )) - (mail-extr-skip-whitespace-forward) - (cond ((memq (following-char) '(?j ?J ?s ?S)) - (capitalize-word 1) - (if (eq (following-char) ?.) - (forward-char 1) - (insert ?.))) - (t - (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)) - (forward-char 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)) - (set-syntax-table mail-extr-address-text-comment-syntax-table) - (cond ((memq (following-char) '(?\' ?\`)) - (or (search-forward "'" nil t - (if (eq ?\' (following-char)) 2 1)) - (delete-char 1))) - (t - (or (mail-extr-safe-move-sexp 1) - (goto-char (point-max))))) - (set-syntax-table mail-extr-address-text-syntax-table) - (setq cend (point)) - (cond - ;; Handle case of entire name being quoted - ((and (eq word-count 0) - (looking-at " *\\'") - (>= (- cend cbeg) 2)) - (narrow-to-region (1+ cbeg) (1- cend)) - (goto-char (point-min))) - (t - ;; Handle case of quoted initial - (if (and (or (= 3 (- cend cbeg)) - (and (= 4 (- cend cbeg)) - (eq ?. (char-after (+ 2 cbeg))))) - (not (looking-at " *\\'"))) - (setq initial (char-after (1+ cbeg))) - (setq initial nil)) - (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) - (looking-at mail-extr-leading-garbage)) - (goto-char (match-end 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))) - (setq lower-case-flag t)) - (forward-char 1) - (if (eq ?. (following-char)) - (forward-char 1) - (insert ?.)) - (or (eq ?\ (following-char)) - (insert ?\ )) - (setq word-found-flag t)) + ;; Delete leading and trailing junk characters. + ;; *** This is probably completely unneeded now. + ;;(goto-char (point-max)) + ;;(skip-chars-backward mail-extr-non-end-name-chars) + ;;(if (eq ?. (following-char)) + ;; (forward-char 1)) + ;;(narrow-to-region (point) + ;; (progn + ;; (goto-char (point-min)) + ;; (skip-chars-forward mail-extr-non-begin-name-chars) + ;; (point))) - ;; 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)) - (eq (following-char) ?&) - (eq (1+ (point)) (point-max))) - (delete-char 1) - (capitalize-region - (point) - (progn - (insert-buffer-substring canonicalization-buffer - mbox-beg mbox-end) - (point))) - (setq disable-initial-guessing-flag t) - (setq word-found-flag t)) - - ;; Handle & between names, as in "Bob & Susie". - ((and (> word-count 0) (eq (following-char) ?\&)) - (setq name-beg (point)) - (setq name-end (1+ name-beg)) - (setq word-found-flag t) - (goto-char name-end)) - - ;; Regular name words - ((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) - (or - ;; Trailing 4-or-more letter lowercase words preceded by - ;; mixed case or uppercase words will be dropped. - (looking-at "[[:lower:]]\\{4,\\}[ \t]*\\'") - ;; 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 "[[:lower:]]" name-end t) - (if (progn - (goto-char name-beg) - (re-search-forward "[[:upper:]]" name-end t)) - (setq mixed-case-flag t) - (setq lower-case-flag t)) -;; (setq upper-case-flag t) - ) - - (goto-char name-end) - (setq word-found-flag t)) - - ;; Allow a number as a word, if it doesn't mean anything else. - ((looking-at "[0-9]+\\>") - (setq name-beg (point)) - (setq name-end (match-end 0)) - (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 - ;; in the name field: it's better behavior than dropping the last word - ;; of the sentence... - (if (and (not suffix-flag) - (looking-at "\\(\\.+\\|[?!;:.][?!;:.]+\\|[?!;:][?!;:.]*\\)\\'")) - (goto-char (setq suffix-flag (point-max)))) - - ;; Drop everything after point and certain trailing words. - (narrow-to-region (point-min) - (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 - ;; here at all. Actually I guess it would be best to map patterns - ;; like foo.hoser@xerox.com into foo@hoser.xerox.com, but I don't - ;; actually know that that is what's going on. - (unless suffix-flag + ;; Compress whitespace (goto-char (point-min)) - (let ((case-fold-search t)) - (if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'") - (erase-buffer)))) - - ;; If last name first put it at end (but before suffix) - (when last-name-comma-flag - (goto-char (point-min)) - (search-forward ",") - (setq name-end (1- (point))) - (goto-char (or suffix-flag (point-max))) - (or (eq ?\ (preceding-char)) - (insert ?\ )) - (insert-buffer-substring (current-buffer) (point-min) name-end) - (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)) - ;;(skip-chars-backward mail-extr-non-end-name-chars) - ;;(if (eq ?. (following-char)) - ;; (forward-char 1)) - ;;(narrow-to-region (point) - ;; (progn - ;; (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) - (replace-match (if (eobp) "" " ") t)) - ))) + (while (re-search-forward "[ \t\n]+" nil t) + (replace-match (if (eobp) "" " ") t)) + )))) diff -r 1adf7aed3649 -r 4a196c3bd2d8 man/ChangeLog --- a/man/ChangeLog Thu Aug 05 14:54:57 2004 +0000 +++ b/man/ChangeLog Sat Aug 07 15:05:02 2004 +0000 @@ -1,3 +1,9 @@ +2004-08-05 Lars Hansen + + * widget.texi (User Interface): Update how to separate the + editable field of an editable-field widget from other widgets. + (Programming Example): Add text after field. + 2004-07-24 Richard M. Stallman * text.texi (Paragraphs): Update how paragraphs are separated diff -r 1adf7aed3649 -r 4a196c3bd2d8 man/widget.texi --- a/man/widget.texi Thu Aug 05 14:54:57 2004 +0000 +++ b/man/widget.texi Sat Aug 07 15:05:02 2004 +0000 @@ -213,14 +213,19 @@ Editable text fields are created by the @code{editable-field} widget. -An editable field must be surrounded by static text on both sides, that -is, text that does not change in the lifetime of the widget. If the -field extends to the end of the line, the terminating line-feed character -will count as the necessary static text on that end, but you will have -to provide the static text before the field yourself. The -@code{:format} keyword is useful for generating the static text; for -instance, if you give it a value of @code{"Name: %v"}, the "Name: " part -will count as the static text. +@strong{Warning:} In an @code{editable-field} widget, the editable +field must not be adjacent to another widget---that won't work. +You must put some text in between. Either make this text part of +the @code{editable-field} widget itself, or insert it with +@code{widget-insert}. + +The @code{:format} keyword is useful for generating the necessary +text; for instance, if you give it a value of @code{"Name: %v "}, +the @samp{Name: } part will provide the necessary separating text +before the field and the trailing space will provide the +separating text after the field. If you don't include the +@code{:size} keyword, the field will extend to the end of the +line, and the terminating newline will provide separation after. The editing text fields are highlighted with the @code{widget-field-face} face, making them easy to find. @@ -345,6 +350,7 @@ (widget-insert "Here is some documentation.\n\nName: ") (widget-create 'editable-field :size 13 + :format "%v " ; Text after the field! "My Name") (widget-create 'menu-choice :tag "Choose" diff -r 1adf7aed3649 -r 4a196c3bd2d8 src/ChangeLog --- a/src/ChangeLog Thu Aug 05 14:54:57 2004 +0000 +++ b/src/ChangeLog Sat Aug 07 15:05:02 2004 +0000 @@ -1,3 +1,8 @@ +2004-08-03 Kenichi Handa + + * coding.c (decode_coding_string): Adjust coding->consumed, and + etc. with shrinked_bytes. + 2004-08-03 Kim F. Storm * indent.c (compute_motion): Fix check for full width window diff -r 1adf7aed3649 -r 4a196c3bd2d8 src/coding.c --- a/src/coding.c Thu Aug 05 14:54:57 2004 +0000 +++ b/src/coding.c Sat Aug 07 15:05:02 2004 +0000 @@ -6234,6 +6234,11 @@ shrinked_bytes - from); free_conversion_buffer (&buf); + coding->consumed += shrinked_bytes; + coding->consumed_char += shrinked_bytes; + coding->produced += shrinked_bytes; + coding->produced_char += shrinked_bytes; + if (coding->cmp_data && coding->cmp_data->used) coding_restore_composition (coding, newstr); coding_free_composition_data (coding); diff -r 1adf7aed3649 -r 4a196c3bd2d8 src/indent.c --- a/src/indent.c Thu Aug 05 14:54:57 2004 +0000 +++ b/src/indent.c Sat Aug 07 15:05:02 2004 +0000 @@ -1262,10 +1262,10 @@ width -= 1; } - continuation_glyph_width = 0; + continuation_glyph_width = 1; #ifdef HAVE_WINDOW_SYSTEM - if (!FRAME_WINDOW_P (XFRAME (win->frame))) - continuation_glyph_width = 1; + if (FRAME_WINDOW_P (XFRAME (win->frame))) + continuation_glyph_width = 0; /* In the fringe. */ #endif immediate_quit = 1;