diff options
| author | Karoly Lorentey | 2004-08-07 15:05:02 +0000 |
|---|---|---|
| committer | Karoly Lorentey | 2004-08-07 15:05:02 +0000 |
| commit | 18ad87544445be2584163436bd3c5d6366afa122 (patch) | |
| tree | 5b724841af27d9cf79c42f09e0c1079203b68107 | |
| parent | d03a8fe4dee75f545e50891247367a167fc980d7 (diff) | |
| parent | de10c1149c818f8cee4cc5af7408655945a339d3 (diff) | |
| download | emacs-18ad87544445be2584163436bd3c5d6366afa122.tar.gz emacs-18ad87544445be2584163436bd3c5d6366afa122.zip | |
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
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | Makefile.in | 6 | ||||
| -rw-r--r-- | leim/ChangeLog | 4 | ||||
| -rw-r--r-- | leim/Makefile.in | 1 | ||||
| -rw-r--r-- | lisp/ChangeLog | 24 | ||||
| -rw-r--r-- | lisp/international/encoded-kb.el | 337 | ||||
| -rw-r--r-- | lisp/mail/mail-extr.el | 724 | ||||
| -rw-r--r-- | man/ChangeLog | 6 | ||||
| -rw-r--r-- | man/widget.texi | 22 | ||||
| -rw-r--r-- | src/ChangeLog | 5 | ||||
| -rw-r--r-- | src/coding.c | 5 | ||||
| -rw-r--r-- | src/indent.c | 6 |
12 files changed, 581 insertions, 563 deletions
| @@ -1,3 +1,7 @@ | |||
| 1 | 2004-08-06 Andreas Schwab <schwab@suse.de> | ||
| 2 | |||
| 3 | * Makefile.in (install-arch-indep, uninstall): Add flymake. | ||
| 4 | |||
| 1 | 2004-07-31 Eli Zaretskii <eliz@gnu.org> | 5 | 2004-07-31 Eli Zaretskii <eliz@gnu.org> |
| 2 | 6 | ||
| 3 | * config.bat: Update URLs in the comments. | 7 | * config.bat: Update URLs in the comments. |
diff --git a/Makefile.in b/Makefile.in index 35cc2798e32..05d7b556256 100644 --- a/Makefile.in +++ b/Makefile.in | |||
| @@ -475,7 +475,7 @@ install-arch-indep: mkdir info | |||
| 475 | chmod a+r ${infodir}/dir); \ | 475 | chmod a+r ${infodir}/dir); \ |
| 476 | fi; \ | 476 | fi; \ |
| 477 | cd ${srcdir}/info ; \ | 477 | cd ${srcdir}/info ; \ |
| 478 | 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 \ | 478 | 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 \ |
| 479 | (cd $${thisdir}; \ | 479 | (cd $${thisdir}; \ |
| 480 | ${INSTALL_DATA} ${srcdir}/info/$$f ${infodir}/$$f; \ | 480 | ${INSTALL_DATA} ${srcdir}/info/$$f ${infodir}/$$f; \ |
| 481 | chmod a+r ${infodir}/$$f); \ | 481 | chmod a+r ${infodir}/$$f); \ |
| @@ -485,7 +485,7 @@ install-arch-indep: mkdir info | |||
| 485 | thisdir=`/bin/pwd`; \ | 485 | thisdir=`/bin/pwd`; \ |
| 486 | if [ `(cd ${srcdir}/info && /bin/pwd)` != `(cd ${infodir} && /bin/pwd)` ]; \ | 486 | if [ `(cd ${srcdir}/info && /bin/pwd)` != `(cd ${infodir} && /bin/pwd)` ]; \ |
| 487 | then \ | 487 | then \ |
| 488 | 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 \ | 488 | 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 \ |
| 489 | (cd $${thisdir}; \ | 489 | (cd $${thisdir}; \ |
| 490 | ${INSTALL_INFO} --info-dir=${infodir} ${infodir}/$$f); \ | 490 | ${INSTALL_INFO} --info-dir=${infodir} ${infodir}/$$f); \ |
| 491 | done; \ | 491 | done; \ |
| @@ -551,7 +551,7 @@ uninstall: | |||
| 551 | done | 551 | done |
| 552 | (cd ${archlibdir} && rm -f fns-*) | 552 | (cd ${archlibdir} && rm -f fns-*) |
| 553 | -rm -rf ${libexecdir}/emacs/${version} | 553 | -rm -rf ${libexecdir}/emacs/${version} |
| 554 | (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*) | 554 | (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*) |
| 555 | (cd ${man1dir} && rm -f emacs${manext} emacsclient${manext} etags${manext} ctags${manext}) | 555 | (cd ${man1dir} && rm -f emacs${manext} emacsclient${manext} etags${manext} ctags${manext}) |
| 556 | (cd ${bindir} && rm -f $(EMACSFULL) $(EMACS)) | 556 | (cd ${bindir} && rm -f $(EMACSFULL) $(EMACS)) |
| 557 | 557 | ||
diff --git a/leim/ChangeLog b/leim/ChangeLog index 146bc897098..c30c488c0b7 100644 --- a/leim/ChangeLog +++ b/leim/ChangeLog | |||
| @@ -1,3 +1,7 @@ | |||
| 1 | 2004-08-06 Andreas Schwab <schwab@suse.de> | ||
| 2 | |||
| 3 | * Makefile.in (install): Remove .arch-inventory files. | ||
| 4 | |||
| 1 | 2004-07-01 David Kastrup <dak@gnu.org> | 5 | 2004-07-01 David Kastrup <dak@gnu.org> |
| 2 | 6 | ||
| 3 | * quail/greek.el ("((") ("))"): add quotation mark shorthands. | 7 | * quail/greek.el ("((") ("))"): add quotation mark shorthands. |
diff --git a/leim/Makefile.in b/leim/Makefile.in index 7f3c13dbe36..acffcc7f7b5 100644 --- a/leim/Makefile.in +++ b/leim/Makefile.in | |||
| @@ -232,6 +232,7 @@ install: all | |||
| 232 | fi; \ | 232 | fi; \ |
| 233 | rm -rf ${INSTALLDIR}/CVS ${INSTALLDIR}/*/CVS; \ | 233 | rm -rf ${INSTALLDIR}/CVS ${INSTALLDIR}/*/CVS; \ |
| 234 | rm -f ${INSTALLDIR}/.cvsignore ${INSTALLDIR}/*/.cvsignore; \ | 234 | rm -f ${INSTALLDIR}/.cvsignore ${INSTALLDIR}/*/.cvsignore; \ |
| 235 | rm -f ${INSTALLDIR}/.arch-inventory ${INSTALLDIR}/*/.arch-inventory; \ | ||
| 235 | rm -f ${INSTALLDIR}/\#* ${INSTALLDIR}/*/\#* ; \ | 236 | rm -f ${INSTALLDIR}/\#* ${INSTALLDIR}/*/\#* ; \ |
| 236 | rm -f ${INSTALLDIR}/.\#* ${INSTALLDIR}/*/.\#* ; \ | 237 | rm -f ${INSTALLDIR}/.\#* ${INSTALLDIR}/*/.\#* ; \ |
| 237 | rm -f ${INSTALLDIR}/*~ ${INSTALLDIR}/*/*~ ; \ | 238 | rm -f ${INSTALLDIR}/*~ ${INSTALLDIR}/*/*~ ; \ |
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b5134b2647f..e12449df8e4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,27 @@ | |||
| 1 | 2004-08-04 Kenichi Handa <handa@m17n.org> | ||
| 2 | |||
| 3 | * international/encoded-kb.el (encoded-kbd-setup-keymap): Fix | ||
| 4 | previous change. | ||
| 5 | |||
| 6 | 2004-08-03 Kenichi Handa <handa@m17n.org> | ||
| 7 | |||
| 8 | * international/encoded-kb.el: The following changes are to | ||
| 9 | utilize key-translation-map instead of minor mode map. | ||
| 10 | (encoded-kbd-iso2022-non-ascii-map): Delete it. | ||
| 11 | (encoded-kbd-coding, encoded-kbd-handle-8bit): Delete them. | ||
| 12 | (encoded-kbd-last-key): New function. | ||
| 13 | (encoded-kbd-iso2022-single-shift): New function. | ||
| 14 | (encoded-kbd-iso2022-designation) | ||
| 15 | (encoded-kbd-self-insert-iso2022-7bit) | ||
| 16 | (encoded-kbd-self-insert-iso2022-8bit) | ||
| 17 | (encoded-kbd-self-insert-sjis, encoded-kbd-self-insert-big5) | ||
| 18 | (encoded-kbd-self-insert-ccl): Make them suitable for bindings in | ||
| 19 | key-translation-map. | ||
| 20 | (encoded-kbd-setup-keymap): Setup key-translation-map. | ||
| 21 | (saved-key-translation-map): New variable. | ||
| 22 | (encoded-kbd-mode): Save/restore key-translation-map. Adjusted | ||
| 23 | for the change of encoded-kbd-setup-keymap. | ||
| 24 | |||
| 1 | 2004-08-02 Kim F. Storm <storm@cua.dk> | 25 | 2004-08-02 Kim F. Storm <storm@cua.dk> |
| 2 | 26 | ||
| 3 | * avoid.el (mouse-avoidance-point-position): Use window-inside-edges | 27 | * avoid.el (mouse-avoidance-point-position): Use window-inside-edges |
diff --git a/lisp/international/encoded-kb.el b/lisp/international/encoded-kb.el index 6eae1011c40..cba2f0e45b9 100644 --- a/lisp/international/encoded-kb.el +++ b/lisp/international/encoded-kb.el | |||
| @@ -24,6 +24,10 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | ;; Usually this map is empty (even if Encoded-kbd mode is on), but if | ||
| 28 | ;; the keyboard coding system is iso-2022-based, it defines dummy key | ||
| 29 | ;; bindings for ESC $ ..., etc. so that those bindings in | ||
| 30 | ;; key-translation-map take effect. | ||
| 27 | (defconst encoded-kbd-mode-map (make-sparse-keymap) | 31 | (defconst encoded-kbd-mode-map (make-sparse-keymap) |
| 28 | "Keymap for Encoded-kbd minor mode.") | 32 | "Keymap for Encoded-kbd minor mode.") |
| 29 | 33 | ||
| @@ -69,25 +73,6 @@ | |||
| 69 | (fset 'encoded-kbd-iso2022-designation-prefix | 73 | (fset 'encoded-kbd-iso2022-designation-prefix |
| 70 | encoded-kbd-iso2022-designation-map) | 74 | encoded-kbd-iso2022-designation-map) |
| 71 | 75 | ||
| 72 | (defvar encoded-kbd-iso2022-non-ascii-map | ||
| 73 | (let ((map (make-keymap)) | ||
| 74 | (i 32)) | ||
| 75 | (while (< i 128) | ||
| 76 | (define-key map (char-to-string i) 'encoded-kbd-self-insert-iso2022-7bit) | ||
| 77 | (setq i (1+ i))) | ||
| 78 | (define-key map "\e" 'encoded-kbd-iso2022-esc-prefix) | ||
| 79 | (setq i 160) | ||
| 80 | (while (< i 256) | ||
| 81 | (define-key map (vector i) 'encoded-kbd-handle-8bit) | ||
| 82 | (setq i (1+ i))) | ||
| 83 | map) | ||
| 84 | "Keymap for handling non-ASCII character set in Encoded-kbd mode.") | ||
| 85 | |||
| 86 | ;; One of the symbols `sjis', `iso2022-7', `iso2022-8', or `big5' to | ||
| 87 | ;; denote what kind of coding-system we are now handling in | ||
| 88 | ;; Encoded-kbd mode. | ||
| 89 | (defvar encoded-kbd-coding nil) | ||
| 90 | |||
| 91 | ;; Keep information of designation state of ISO2022 encoding. When | 76 | ;; Keep information of designation state of ISO2022 encoding. When |
| 92 | ;; Encoded-kbd mode is on, this is set to a vector of length 4, the | 77 | ;; Encoded-kbd mode is on, this is set to a vector of length 4, the |
| 93 | ;; elements are character sets currently designated to graphic | 78 | ;; elements are character sets currently designated to graphic |
| @@ -104,11 +89,14 @@ | |||
| 104 | (defvar encoded-kbd-iso2022-invocations nil) | 89 | (defvar encoded-kbd-iso2022-invocations nil) |
| 105 | (put 'encoded-kbd-iso2022-invocations 'permanent-local t) | 90 | (put 'encoded-kbd-iso2022-invocations 'permanent-local t) |
| 106 | 91 | ||
| 107 | (defun encoded-kbd-iso2022-designation () | 92 | (defsubst encoded-kbd-last-key () |
| 93 | (let ((keys (this-single-command-keys))) | ||
| 94 | (aref keys (1- (length keys))))) | ||
| 95 | |||
| 96 | (defun encoded-kbd-iso2022-designation (ignore) | ||
| 108 | "Do ISO2022 designation according to the current key in Encoded-kbd mode. | 97 | "Do ISO2022 designation according to the current key in Encoded-kbd mode. |
| 109 | The following key sequence may cause multilingual text insertion." | 98 | The following key sequence may cause multilingual text insertion." |
| 110 | (interactive) | 99 | (let ((key-seq (this-single-command-keys)) |
| 111 | (let ((key-seq (this-command-keys)) | ||
| 112 | (prev-g0-charset (aref encoded-kbd-iso2022-designations | 100 | (prev-g0-charset (aref encoded-kbd-iso2022-designations |
| 113 | (aref encoded-kbd-iso2022-invocations 0))) | 101 | (aref encoded-kbd-iso2022-invocations 0))) |
| 114 | intermediate-char final-char | 102 | intermediate-char final-char |
| @@ -132,143 +120,122 @@ The following key sequence may cause multilingual text insertion." | |||
| 132 | chars (if (< intermediate-char ?,) 94 96) | 120 | chars (if (< intermediate-char ?,) 94 96) |
| 133 | final-char (aref key-seq 2) | 121 | final-char (aref key-seq 2) |
| 134 | reg (mod intermediate-char 4)))) | 122 | reg (mod intermediate-char 4)))) |
| 135 | (if (setq charset (iso-charset dimension chars final-char)) | 123 | (aset encoded-kbd-iso2022-designations reg |
| 136 | (aset encoded-kbd-iso2022-designations reg charset) | 124 | (iso-charset dimension chars final-char))) |
| 137 | (error "Character set of DIMENSION %s, CHARS %s, FINAL-CHAR `%c' is not supported" | 125 | "") |
| 138 | dimension chars final-char)) | 126 | |
| 139 | 127 | (defun encoded-kbd-iso2022-single-shift (ignore) | |
| 140 | (if (memq (aref encoded-kbd-iso2022-designations | 128 | (let ((char (encoded-kbd-last-key))) |
| 141 | (aref encoded-kbd-iso2022-invocations 0)) | 129 | (aset encoded-kbd-iso2022-invocations 2 |
| 142 | '(ascii latin-jisx0201)) | 130 | (aref encoded-kbd-iso2022-designations |
| 143 | ;; Graphic plane 0 (0x20..0x7f) is for ASCII. We don't have | 131 | (if (= char ?\216) 2 3)))) |
| 144 | ;; to handle characters in this range specially. | 132 | "") |
| 145 | (if (not (memq prev-g0-charset '(ascii latin-jisx0201))) | 133 | |
| 146 | ;; We must exit recursive edit now. | 134 | (defun encoded-kbd-self-insert-iso2022-7bit (ignore) |
| 147 | (throw 'exit nil)) | 135 | (let ((char (encoded-kbd-last-key)) |
| 148 | ;; Graphic plane 0 is for non-ASCII. | 136 | (charset (aref encoded-kbd-iso2022-designations |
| 149 | (if (memq prev-g0-charset '(ascii latin-jisx0201)) | 137 | (or (aref encoded-kbd-iso2022-invocations 2) |
| 150 | ;; We must handle keys specially. | 138 | (aref encoded-kbd-iso2022-invocations 0))))) |
| 151 | (let ((overriding-local-map encoded-kbd-iso2022-non-ascii-map)) | ||
| 152 | (recursive-edit)))))) | ||
| 153 | |||
| 154 | (defun encoded-kbd-handle-8bit () | ||
| 155 | "Handle an 8-bit character entered in Encoded-kbd mode." | ||
| 156 | (interactive) | ||
| 157 | (cond ((eq encoded-kbd-coding 'iso2022-7) | ||
| 158 | (error "Can't handle the character code %d" last-command-char)) | ||
| 159 | |||
| 160 | ((eq encoded-kbd-coding 'iso2022-8) | ||
| 161 | (cond ((= last-command-char ?\216) | ||
| 162 | (aset encoded-kbd-iso2022-invocations 2 2)) | ||
| 163 | |||
| 164 | ((= last-command-char ?\217) | ||
| 165 | (aset encoded-kbd-iso2022-invocations 2 3)) | ||
| 166 | |||
| 167 | ((>= last-command-char ?\240) | ||
| 168 | (encoded-kbd-self-insert-iso2022-8bit)) | ||
| 169 | |||
| 170 | (t | ||
| 171 | (error "Can't handle the character code %d" | ||
| 172 | last-command-char)))) | ||
| 173 | |||
| 174 | ((eq encoded-kbd-coding 'sjis) | ||
| 175 | (encoded-kbd-self-insert-sjis)) | ||
| 176 | |||
| 177 | (t | ||
| 178 | (encoded-kbd-self-insert-big5)))) | ||
| 179 | |||
| 180 | (defun encoded-kbd-self-insert-iso2022-7bit () | ||
| 181 | (interactive) | ||
| 182 | (let* ((charset (aref encoded-kbd-iso2022-designations | ||
| 183 | (or (aref encoded-kbd-iso2022-invocations 2) | ||
| 184 | (aref encoded-kbd-iso2022-invocations 0)))) | ||
| 185 | (char (if (= (charset-dimension charset) 1) | ||
| 186 | (make-char charset last-command-char) | ||
| 187 | (make-char charset last-command-char (read-char-exclusive))))) | ||
| 188 | (aset encoded-kbd-iso2022-invocations 2 nil) | 139 | (aset encoded-kbd-iso2022-invocations 2 nil) |
| 189 | (setq unread-command-events (cons char unread-command-events)))) | 140 | (vector (if (= (charset-dimension charset) 1) |
| 190 | 141 | (make-char charset char) | |
| 191 | (defun encoded-kbd-self-insert-iso2022-8bit () | 142 | (make-char charset char (read-char-exclusive)))))) |
| 192 | (interactive) | 143 | |
| 193 | (cond | 144 | (defun encoded-kbd-self-insert-iso2022-8bit (ignore) |
| 194 | ((= last-command-char ?\216) ; SS2 (Single Shift 2) | 145 | (let ((char (encoded-kbd-last-key)) |
| 195 | (aset encoded-kbd-iso2022-invocations 2 2)) | 146 | (charset (aref encoded-kbd-iso2022-designations |
| 196 | ((= last-command-char ?\217) ; SS3 (Single Shift 3) | 147 | (or (aref encoded-kbd-iso2022-invocations 2) |
| 197 | (aset encoded-kbd-iso2022-invocations 2 3)) | 148 | (aref encoded-kbd-iso2022-invocations 1))))) |
| 198 | (t | 149 | (aset encoded-kbd-iso2022-invocations 2 nil) |
| 199 | (let* ((charset (aref encoded-kbd-iso2022-designations | 150 | (vector (if (= (charset-dimension charset) 1) |
| 200 | (or (aref encoded-kbd-iso2022-invocations 2) | 151 | (make-char charset char) |
| 201 | (aref encoded-kbd-iso2022-invocations 1)))) | 152 | (make-char charset char (read-char-exclusive)))))) |
| 202 | (char (if (= (charset-dimension charset) 1) | 153 | |
| 203 | (make-char charset last-command-char) | 154 | (defun encoded-kbd-self-insert-sjis (ignore) |
| 204 | (make-char charset last-command-char | 155 | (let ((char (encoded-kbd-last-key))) |
| 205 | (read-char-exclusive))))) | 156 | (vector |
| 206 | (aset encoded-kbd-iso2022-invocations 2 nil) | 157 | (if (or (< char ?\xA0) (>= char ?\xE0)) |
| 207 | (setq unread-command-events (cons char unread-command-events)))))) | 158 | (decode-sjis-char (+ (ash char 8) (read-char-exclusive))) |
| 208 | 159 | (make-char 'katakana-jisx0201 char))))) | |
| 209 | (defun encoded-kbd-self-insert-sjis () | 160 | |
| 210 | (interactive) | 161 | (defun encoded-kbd-self-insert-big5 (ignore) |
| 211 | (let ((char (if (or (< last-command-char ?\xA0) (>= last-command-char ?\xE0)) | 162 | (let ((char (encoded-kbd-last-key))) |
| 212 | (decode-sjis-char (+ (ash last-command-char 8) | 163 | (vector |
| 213 | (read-char-exclusive))) | 164 | (decode-big5-char (+ (ash char 8) (read-char-exclusive)))))) |
| 214 | (make-char 'katakana-jisx0201 last-command-char)))) | 165 | |
| 215 | (setq unread-command-events (cons char unread-command-events)))) | 166 | (defun encoded-kbd-self-insert-ccl (ignore) |
| 216 | 167 | (let ((str (char-to-string (encoded-kbd-last-key))) | |
| 217 | (defun encoded-kbd-self-insert-big5 () | ||
| 218 | (interactive) | ||
| 219 | (let ((char (decode-big5-char (+ (ash last-command-char 8) | ||
| 220 | (read-char-exclusive))))) | ||
| 221 | (setq unread-command-events (cons char unread-command-events)))) | ||
| 222 | |||
| 223 | (defun encoded-kbd-self-insert-ccl () | ||
| 224 | (interactive) | ||
| 225 | (let ((str (char-to-string last-command-char)) | ||
| 226 | (ccl (car (aref (coding-system-spec (keyboard-coding-system)) 4))) | 168 | (ccl (car (aref (coding-system-spec (keyboard-coding-system)) 4))) |
| 227 | (vec [nil nil nil nil nil nil nil nil nil]) | 169 | (vec [nil nil nil nil nil nil nil nil nil]) |
| 228 | result) | 170 | result) |
| 229 | (while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0) | 171 | (while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0) |
| 230 | (dotimes (i 9) (aset vec i nil)) | 172 | (dotimes (i 9) (aset vec i nil)) |
| 231 | (setq str (format "%s%c" str (read-char-exclusive)))) | 173 | (setq str (format "%s%c" str (read-char-exclusive)))) |
| 232 | (setq unread-command-events | 174 | (vector (aref result 0)))) |
| 233 | (append result unread-command-events)))) | ||
| 234 | 175 | ||
| 235 | (defun encoded-kbd-setup-keymap (coding) | 176 | (defun encoded-kbd-setup-keymap (coding) |
| 236 | ;; At first, reset the keymap. | 177 | ;; At first, reset the keymap. |
| 237 | (setcdr encoded-kbd-mode-map nil) | 178 | (define-key encoded-kbd-mode-map "\e" nil) |
| 238 | ;; Then setup the keymap according to the keyboard coding system. | 179 | ;; Then setup the keymap according to the keyboard coding system. |
| 239 | (cond | 180 | (cond |
| 240 | ((eq encoded-kbd-coding 'sjis) | 181 | ((eq (coding-system-type coding) 1) ; SJIS |
| 241 | (let ((i 128)) | 182 | (let ((i 128)) |
| 242 | (while (< i 256) | 183 | (while (< i 256) |
| 243 | (define-key encoded-kbd-mode-map | 184 | (define-key key-translation-map |
| 244 | (vector i) 'encoded-kbd-self-insert-sjis) | 185 | (vector i) 'encoded-kbd-self-insert-sjis) |
| 245 | (setq i (1+ i))))) | 186 | (setq i (1+ i)))) |
| 187 | 8) | ||
| 246 | 188 | ||
| 247 | ((eq encoded-kbd-coding 'big5) | 189 | ((eq (coding-system-type coding) 3) ; Big5 |
| 248 | (let ((i 161)) | 190 | (let ((i 161)) |
| 249 | (while (< i 255) | 191 | (while (< i 255) |
| 250 | (define-key encoded-kbd-mode-map | 192 | (define-key key-translation-map |
| 251 | (vector i) 'encoded-kbd-self-insert-big5) | 193 | (vector i) 'encoded-kbd-self-insert-big5) |
| 252 | (setq i (1+ i))))) | 194 | (setq i (1+ i)))) |
| 253 | 195 | 8) | |
| 254 | ((eq encoded-kbd-coding 'iso2022-7) | 196 | |
| 255 | (define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix)) | 197 | ((eq (coding-system-type coding) 2) ; ISO-2022 |
| 256 | 198 | (let ((flags (coding-system-flags coding)) | |
| 257 | ((eq encoded-kbd-coding 'iso2022-8) | 199 | use-designation) |
| 258 | (define-key encoded-kbd-mode-map | 200 | (if (aref flags 8) |
| 259 | (vector ?\216) 'encoded-kbd-self-insert-iso2022-8bit) | 201 | nil ; Don't support locking-shift. |
| 260 | (define-key encoded-kbd-mode-map | 202 | (setq encoded-kbd-iso2022-designations (make-vector 4 nil) |
| 261 | (vector ?\217) 'encoded-kbd-self-insert-iso2022-8bit) | 203 | encoded-kbd-iso2022-invocations (make-vector 3 nil)) |
| 262 | (let ((i 160)) | 204 | (dotimes (i 4) |
| 263 | (while (< i 256) | 205 | (if (aref flags i) |
| 264 | (define-key encoded-kbd-mode-map | 206 | (if (charsetp (aref flags i)) |
| 265 | (vector i) 'encoded-kbd-self-insert-iso2022-8bit) | 207 | (aset encoded-kbd-iso2022-designations |
| 266 | (setq i (1+ i))))) | 208 | i (aref flags i)) |
| 267 | 209 | (setq use-designation t) | |
| 268 | ((eq encoded-kbd-coding 'ccl) | 210 | (if (charsetp (car-safe (aref flags i))) |
| 211 | (aset encoded-kbd-iso2022-designations | ||
| 212 | i (car (aref flags i))))))) | ||
| 213 | (aset encoded-kbd-iso2022-invocations 0 0) | ||
| 214 | (if (aref encoded-kbd-iso2022-designations 1) | ||
| 215 | (aset encoded-kbd-iso2022-invocations 1 1)) | ||
| 216 | (when use-designation | ||
| 217 | (define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix) | ||
| 218 | (define-key key-translation-map "\e" 'encoded-kbd-iso2022-esc-prefix)) | ||
| 219 | (when (or (aref flags 2) (aref flags 3)) | ||
| 220 | (define-key key-translation-map | ||
| 221 | [?\216] 'encoded-kbd-iso2022-single-shift) | ||
| 222 | (define-key key-translation-map | ||
| 223 | [?\217] 'encoded-kbd-iso2022-single-shift)) | ||
| 224 | (or (eq (aref flags 0) 'ascii) | ||
| 225 | (dotimes (i 96) | ||
| 226 | (define-key key-translation-map | ||
| 227 | (vector (+ 32 i)) 'encoded-kbd-self-insert-iso2022-7bit))) | ||
| 228 | (if (aref flags 7) | ||
| 229 | t | ||
| 230 | (dotimes (i 96) | ||
| 231 | (define-key key-translation-map | ||
| 232 | (vector (+ 160 i)) 'encoded-kbd-self-insert-iso2022-8bit)) | ||
| 233 | 8)))) | ||
| 234 | |||
| 235 | ((eq (coding-system-type coding) 4) ; CCL-base | ||
| 269 | (let ((valid-codes (or (coding-system-get coding 'valid-codes) | 236 | (let ((valid-codes (or (coding-system-get coding 'valid-codes) |
| 270 | '((128 . 255)))) | 237 | '((128 . 255)))) |
| 271 | elt from to) | 238 | elt from to valid) |
| 272 | (while valid-codes | 239 | (while valid-codes |
| 273 | (setq elt (car valid-codes) valid-codes (cdr valid-codes)) | 240 | (setq elt (car valid-codes) valid-codes (cdr valid-codes)) |
| 274 | (if (consp elt) | 241 | (if (consp elt) |
| @@ -276,13 +243,17 @@ The following key sequence may cause multilingual text insertion." | |||
| 276 | (setq from (setq to elt))) | 243 | (setq from (setq to elt))) |
| 277 | (while (<= from to) | 244 | (while (<= from to) |
| 278 | (if (>= from 128) | 245 | (if (>= from 128) |
| 279 | (define-key encoded-kbd-mode-map | 246 | (define-key key-translation-map |
| 280 | (vector from) 'encoded-kbd-self-insert-ccl)) | 247 | (vector from) 'encoded-kbd-self-insert-ccl)) |
| 281 | (setq from (1+ from)))))) | 248 | (setq from (1+ from)))) |
| 249 | 8)) | ||
| 282 | 250 | ||
| 283 | (t | 251 | (t |
| 284 | (error "Invalid value in encoded-kbd-coding: %s" encoded-kbd-coding)))) | 252 | nil))) |
| 285 | 253 | ||
| 254 | ;; key-translation-map at the time Encoded-kbd mode is turned on is | ||
| 255 | ;; saved here. | ||
| 256 | (defvar saved-key-translation-map nil) | ||
| 286 | 257 | ||
| 287 | ;; Input mode at the time Encoded-kbd mode is turned on is saved here. | 258 | ;; Input mode at the time Encoded-kbd mode is turned on is saved here. |
| 288 | (defvar saved-input-mode nil) | 259 | (defvar saved-input-mode nil) |
| @@ -301,60 +272,38 @@ In Encoded-kbd mode, a text sent from keyboard is accepted | |||
| 301 | as a multilingual text encoded in a coding system set by | 272 | as a multilingual text encoded in a coding system set by |
| 302 | \\[set-keyboard-coding-system]." | 273 | \\[set-keyboard-coding-system]." |
| 303 | :global t | 274 | :global t |
| 304 | ;; We must at first reset input-mode to the original. | 275 | |
| 305 | (if saved-input-mode (apply 'set-input-mode saved-input-mode)) | ||
| 306 | (if encoded-kbd-mode | 276 | (if encoded-kbd-mode |
| 307 | (let ((coding (keyboard-coding-system))) | 277 | ;; We are turning on Encoded-kbd mode. |
| 308 | (setq saved-input-mode (current-input-mode)) | 278 | (let ((coding (keyboard-coding-system)) |
| 309 | (cond ((null coding) | 279 | result) |
| 310 | (setq encoded-kbd-mode nil) | 280 | (or saved-key-translation-map |
| 311 | (error "No coding system for keyboard input is set")) | 281 | (if (keymapp key-translation-map) |
| 312 | 282 | (setq saved-key-translation-map | |
| 313 | ((= (coding-system-type coding) 1) ; SJIS | 283 | (copy-keymap key-translation-map)) |
| 314 | (set-input-mode | 284 | (setq key-translation-map (make-sparse-keymap)))) |
| 315 | (nth 0 saved-input-mode) (nth 1 saved-input-mode) | 285 | (or saved-input-mode |
| 316 | 'use-8th-bit (nth 3 saved-input-mode)) | 286 | (setq saved-input-mode |
| 317 | (setq encoded-kbd-coding 'sjis)) | 287 | (current-input-mode))) |
| 318 | 288 | (setq result (and coding (encoded-kbd-setup-keymap coding))) | |
| 319 | ((= (coding-system-type coding) 2) ; ISO2022 | 289 | (if result |
| 320 | (if (aref (coding-system-flags coding) 7) ; 7-bit only | 290 | (if (eq result 8) |
| 321 | (setq encoded-kbd-coding 'iso2022-7) | 291 | (set-input-mode |
| 322 | (set-input-mode | 292 | (nth 0 saved-input-mode) |
| 323 | (nth 0 saved-input-mode) (nth 1 saved-input-mode) | 293 | (nth 1 saved-input-mode) |
| 324 | 'use-8th-bit (nth 3 saved-input-mode)) | 294 | 'use-8th-bit |
| 325 | (setq encoded-kbd-coding 'iso2022-8)) | 295 | (nth 3 saved-input-mode))) |
| 326 | (setq encoded-kbd-iso2022-designations (make-vector 4 nil)) | 296 | (setq encoded-kbd-mode nil |
| 327 | (let ((flags (coding-system-flags coding)) | 297 | saved-key-translation-map nil |
| 328 | (i 0)) | 298 | saved-input-mode nil) |
| 329 | (while (< i 4) | 299 | (error "Unsupported coding system in Encoded-kbd mode: %S" |
| 330 | (if (charsetp (aref flags i)) | 300 | coding))) |
| 331 | (aset encoded-kbd-iso2022-designations i | 301 | |
| 332 | (aref flags i)) | 302 | ;; We are turning off Encoded-kbd mode. |
| 333 | (if (charsetp (car-safe (aref flags i))) | 303 | (setq key-translation-map saved-key-translation-map |
| 334 | (aset encoded-kbd-iso2022-designations i | 304 | saved-key-translation-map nil) |
| 335 | (car (aref flags i))))) | 305 | (apply 'set-input-mode saved-input-mode) |
| 336 | (setq i (1+ i)))) | 306 | (setq saved-input-mode nil))) |
| 337 | (setq encoded-kbd-iso2022-invocations (make-vector 3 nil)) | ||
| 338 | (aset encoded-kbd-iso2022-invocations 0 0) | ||
| 339 | (aset encoded-kbd-iso2022-invocations 1 1)) | ||
| 340 | |||
| 341 | ((= (coding-system-type coding) 3) ; BIG5 | ||
| 342 | (set-input-mode | ||
| 343 | (nth 0 saved-input-mode) (nth 1 saved-input-mode) | ||
| 344 | 'use-8th-bit (nth 3 saved-input-mode)) | ||
| 345 | (setq encoded-kbd-coding 'big5)) | ||
| 346 | |||
| 347 | ((= (coding-system-type coding) 4) ; CCL based coding | ||
| 348 | (set-input-mode | ||
| 349 | (nth 0 saved-input-mode) (nth 1 saved-input-mode) | ||
| 350 | 'use-8th-bit (nth 3 saved-input-mode)) | ||
| 351 | (setq encoded-kbd-coding 'ccl)) | ||
| 352 | |||
| 353 | (t | ||
| 354 | (setq encoded-kbd-mode nil) | ||
| 355 | (error "Coding-system `%s' is not supported in Encoded-kbd mode" | ||
| 356 | (keyboard-coding-system)))) | ||
| 357 | (encoded-kbd-setup-keymap coding)))) | ||
| 358 | 307 | ||
| 359 | (provide 'encoded-kb) | 308 | (provide 'encoded-kb) |
| 360 | 309 | ||
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index faa7ca1bb74..7f2e6fef6b6 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el | |||
| @@ -1434,374 +1434,388 @@ consing a string.)" | |||
| 1434 | (if all (nreverse value-list) (car value-list)) | 1434 | (if all (nreverse value-list) (car value-list)) |
| 1435 | )) | 1435 | )) |
| 1436 | 1436 | ||
| 1437 | (defcustom mail-extr-disable-voodoo "\\cj" | ||
| 1438 | "*If it is a regexp, names matching it will never be modified. | ||
| 1439 | If it is neither nil nor a string, modifying of names will never take | ||
| 1440 | place. It affects how `mail-extract-address-components' works." | ||
| 1441 | :type '(choice (regexp :size 0) | ||
| 1442 | (const :tag "Always enabled" nil) | ||
| 1443 | (const :tag "Always disabled" t)) | ||
| 1444 | :group 'mail-extr) | ||
| 1445 | |||
| 1437 | (defun mail-extr-voodoo (mbox-beg mbox-end canonicalization-buffer) | 1446 | (defun mail-extr-voodoo (mbox-beg mbox-end canonicalization-buffer) |
| 1438 | (let ((word-count 0) | 1447 | (unless (and mail-extr-disable-voodoo |
| 1439 | (case-fold-search nil) | 1448 | (or (not (stringp mail-extr-disable-voodoo)) |
| 1440 | mixed-case-flag lower-case-flag ;;upper-case-flag | 1449 | (progn |
| 1441 | suffix-flag last-name-comma-flag | 1450 | (goto-char (point-min)) |
| 1442 | ;;cbeg cend | 1451 | (re-search-forward mail-extr-disable-voodoo nil t)))) |
| 1443 | initial | 1452 | (let ((word-count 0) |
| 1444 | begin-again-flag | 1453 | (case-fold-search nil) |
| 1445 | drop-this-word-if-trailing-flag | 1454 | mixed-case-flag lower-case-flag ;;upper-case-flag |
| 1446 | drop-last-word-if-trailing-flag | 1455 | suffix-flag last-name-comma-flag |
| 1447 | word-found-flag | 1456 | ;;cbeg cend |
| 1448 | this-word-beg last-word-beg | 1457 | initial |
| 1449 | name-beg name-end | 1458 | begin-again-flag |
| 1450 | name-done-flag | 1459 | drop-this-word-if-trailing-flag |
| 1451 | ) | 1460 | drop-last-word-if-trailing-flag |
| 1452 | (save-excursion | 1461 | word-found-flag |
| 1453 | (set-syntax-table mail-extr-address-text-syntax-table) | 1462 | this-word-beg last-word-beg |
| 1454 | 1463 | name-beg name-end | |
| 1455 | ;; Get rid of comments. | 1464 | name-done-flag |
| 1456 | (goto-char (point-min)) | 1465 | ) |
| 1457 | (while (not (eobp)) | 1466 | (save-excursion |
| 1458 | ;; Initialize for this iteration of the loop. | 1467 | (set-syntax-table mail-extr-address-text-syntax-table) |
| 1459 | (skip-chars-forward "^({[\"'`") | 1468 | |
| 1460 | (let ((cbeg (point))) | 1469 | ;; Get rid of comments. |
| 1461 | (set-syntax-table mail-extr-address-text-comment-syntax-table) | ||
| 1462 | (if (memq (following-char) '(?\' ?\`)) | ||
| 1463 | (search-forward "'" nil 'move | ||
| 1464 | (if (eq ?\' (following-char)) 2 1)) | ||
| 1465 | (or (mail-extr-safe-move-sexp 1) | ||
| 1466 | (goto-char (point-max)))) | ||
| 1467 | (set-syntax-table mail-extr-address-text-syntax-table) | ||
| 1468 | (when (eq (char-after cbeg) ?\() | ||
| 1469 | ;; Delete the comment itself. | ||
| 1470 | (delete-region cbeg (point)) | ||
| 1471 | ;; Canonicalize whitespace where the comment was. | ||
| 1472 | (skip-chars-backward " \t") | ||
| 1473 | (if (looking-at "\\([ \t]+$\\|[ \t]+,\\)") | ||
| 1474 | (replace-match "") | ||
| 1475 | (setq cbeg (point)) | ||
| 1476 | (skip-chars-forward " \t") | ||
| 1477 | (if (bobp) | ||
| 1478 | (delete-region (point) cbeg) | ||
| 1479 | (just-one-space)))))) | ||
| 1480 | |||
| 1481 | ;; This was moved above. | ||
| 1482 | ;; Fix . used as space | ||
| 1483 | ;; But it belongs here because it occurs not only as | ||
| 1484 | ;; rypens@reks.uia.ac.be (Piet.Rypens) | ||
| 1485 | ;; but also as | ||
| 1486 | ;; "Piet.Rypens" <rypens@reks.uia.ac.be> | ||
| 1487 | ;;(goto-char (point-min)) | ||
| 1488 | ;;(while (re-search-forward mail-extr-bad-dot-pattern nil t) | ||
| 1489 | ;; (replace-match "\\1 \\2" t)) | ||
| 1490 | |||
| 1491 | (unless (search-forward " " nil t) | ||
| 1492 | (goto-char (point-min)) | 1470 | (goto-char (point-min)) |
| 1493 | (cond ((search-forward "_" nil t) | 1471 | (while (not (eobp)) |
| 1494 | ;; Handle the *idiotic* use of underlines as spaces. | 1472 | ;; Initialize for this iteration of the loop. |
| 1495 | ;; Example: fml@foo.bar.dom (First_M._Last) | 1473 | (skip-chars-forward "^({[\"'`") |
| 1496 | (goto-char (point-min)) | 1474 | (let ((cbeg (point))) |
| 1497 | (while (search-forward "_" nil t) | 1475 | (set-syntax-table mail-extr-address-text-comment-syntax-table) |
| 1498 | (replace-match " " t))) | 1476 | (if (memq (following-char) '(?\' ?\`)) |
| 1499 | ((search-forward "." nil t) | 1477 | (search-forward "'" nil 'move |
| 1500 | ;; Fix . used as space | 1478 | (if (eq ?\' (following-char)) 2 1)) |
| 1501 | ;; Example: danj1@cb.att.com (daniel.jacobson) | 1479 | (or (mail-extr-safe-move-sexp 1) |
| 1502 | (goto-char (point-min)) | 1480 | (goto-char (point-max)))) |
| 1503 | (while (re-search-forward mail-extr-bad-dot-pattern nil t) | 1481 | (set-syntax-table mail-extr-address-text-syntax-table) |
| 1504 | (replace-match "\\1 \\2" t))))) | 1482 | (when (eq (char-after cbeg) ?\() |
| 1505 | 1483 | ;; Delete the comment itself. | |
| 1506 | ;; Loop over the words (and other junk) in the name. | 1484 | (delete-region cbeg (point)) |
| 1507 | (goto-char (point-min)) | 1485 | ;; Canonicalize whitespace where the comment was. |
| 1508 | (while (not name-done-flag) | 1486 | (skip-chars-backward " \t") |
| 1509 | 1487 | (if (looking-at "\\([ \t]+$\\|[ \t]+,\\)") | |
| 1510 | (when word-found-flag | 1488 | (replace-match "") |
| 1511 | ;; Last time through this loop we skipped over a word. | 1489 | (setq cbeg (point)) |
| 1512 | (setq last-word-beg this-word-beg) | 1490 | (skip-chars-forward " \t") |
| 1513 | (setq drop-last-word-if-trailing-flag | 1491 | (if (bobp) |
| 1514 | drop-this-word-if-trailing-flag) | 1492 | (delete-region (point) cbeg) |
| 1515 | (setq word-found-flag nil)) | 1493 | (just-one-space)))))) |
| 1516 | 1494 | ||
| 1517 | (when begin-again-flag | 1495 | ;; This was moved above. |
| 1518 | ;; Last time through the loop we found something that | 1496 | ;; Fix . used as space |
| 1519 | ;; indicates we should pretend we are beginning again from | 1497 | ;; But it belongs here because it occurs not only as |
| 1520 | ;; the start. | 1498 | ;; rypens@reks.uia.ac.be (Piet.Rypens) |
| 1521 | (setq word-count 0) | 1499 | ;; but also as |
| 1522 | (setq last-word-beg nil) | 1500 | ;; "Piet.Rypens" <rypens@reks.uia.ac.be> |
| 1523 | (setq drop-last-word-if-trailing-flag nil) | 1501 | ;;(goto-char (point-min)) |
| 1524 | (setq mixed-case-flag nil) | 1502 | ;;(while (re-search-forward mail-extr-bad-dot-pattern nil t) |
| 1525 | (setq lower-case-flag nil) | 1503 | ;; (replace-match "\\1 \\2" t)) |
| 1526 | ;; (setq upper-case-flag nil) | 1504 | |
| 1527 | (setq begin-again-flag nil)) | 1505 | (unless (search-forward " " nil t) |
| 1528 | 1506 | (goto-char (point-min)) | |
| 1529 | ;; Initialize for this iteration of the loop. | 1507 | (cond ((search-forward "_" nil t) |
| 1530 | (mail-extr-skip-whitespace-forward) | 1508 | ;; Handle the *idiotic* use of underlines as spaces. |
| 1531 | (if (eq word-count 0) (narrow-to-region (point) (point-max))) | 1509 | ;; Example: fml@foo.bar.dom (First_M._Last) |
| 1532 | (setq this-word-beg (point)) | 1510 | (goto-char (point-min)) |
| 1533 | (setq drop-this-word-if-trailing-flag nil) | 1511 | (while (search-forward "_" nil t) |
| 1534 | 1512 | (replace-match " " t))) | |
| 1535 | ;; Decide what to do based on what we are looking at. | 1513 | ((search-forward "." nil t) |
| 1536 | (cond | 1514 | ;; Fix . used as space |
| 1537 | 1515 | ;; Example: danj1@cb.att.com (daniel.jacobson) | |
| 1538 | ;; Delete title | 1516 | (goto-char (point-min)) |
| 1539 | ((and (eq word-count 0) | 1517 | (while (re-search-forward mail-extr-bad-dot-pattern nil t) |
| 1540 | (looking-at mail-extr-full-name-prefixes)) | 1518 | (replace-match "\\1 \\2" t))))) |
| 1541 | (goto-char (match-end 0)) | ||
| 1542 | (narrow-to-region (point) (point-max))) | ||
| 1543 | 1519 | ||
| 1544 | ;; Stop after name suffix | 1520 | ;; Loop over the words (and other junk) in the name. |
| 1545 | ((and (>= word-count 2) | 1521 | (goto-char (point-min)) |
| 1546 | (looking-at mail-extr-full-name-suffix-pattern)) | 1522 | (while (not name-done-flag) |
| 1547 | (mail-extr-skip-whitespace-backward) | 1523 | |
| 1548 | (setq suffix-flag (point)) | 1524 | (when word-found-flag |
| 1549 | (if (eq ?, (following-char)) | 1525 | ;; Last time through this loop we skipped over a word. |
| 1550 | (forward-char 1) | 1526 | (setq last-word-beg this-word-beg) |
| 1551 | (insert ?,)) | 1527 | (setq drop-last-word-if-trailing-flag |
| 1552 | ;; Enforce at least one space after comma | 1528 | drop-this-word-if-trailing-flag) |
| 1553 | (or (eq ?\ (following-char)) | 1529 | (setq word-found-flag nil)) |
| 1554 | (insert ?\ )) | 1530 | |
| 1531 | (when begin-again-flag | ||
| 1532 | ;; Last time through the loop we found something that | ||
| 1533 | ;; indicates we should pretend we are beginning again from | ||
| 1534 | ;; the start. | ||
| 1535 | (setq word-count 0) | ||
| 1536 | (setq last-word-beg nil) | ||
| 1537 | (setq drop-last-word-if-trailing-flag nil) | ||
| 1538 | (setq mixed-case-flag nil) | ||
| 1539 | (setq lower-case-flag nil) | ||
| 1540 | ;; (setq upper-case-flag nil) | ||
| 1541 | (setq begin-again-flag nil)) | ||
| 1542 | |||
| 1543 | ;; Initialize for this iteration of the loop. | ||
| 1555 | (mail-extr-skip-whitespace-forward) | 1544 | (mail-extr-skip-whitespace-forward) |
| 1556 | (cond ((memq (following-char) '(?j ?J ?s ?S)) | 1545 | (if (eq word-count 0) (narrow-to-region (point) (point-max))) |
| 1557 | (capitalize-word 1) | 1546 | (setq this-word-beg (point)) |
| 1558 | (if (eq (following-char) ?.) | 1547 | (setq drop-this-word-if-trailing-flag nil) |
| 1559 | (forward-char 1) | 1548 | |
| 1560 | (insert ?.))) | 1549 | ;; Decide what to do based on what we are looking at. |
| 1561 | (t | ||
| 1562 | (upcase-word 1))) | ||
| 1563 | (setq word-found-flag t) | ||
| 1564 | (setq name-done-flag t)) | ||
| 1565 | |||
| 1566 | ;; Handle SCA names | ||
| 1567 | ((looking-at "MKA \\(.+\\)") ; "Mundanely Known As" | ||
| 1568 | (goto-char (match-beginning 1)) | ||
| 1569 | (narrow-to-region (point) (point-max)) | ||
| 1570 | (setq begin-again-flag t)) | ||
| 1571 | |||
| 1572 | ;; Check for initial last name followed by comma | ||
| 1573 | ((and (eq ?, (following-char)) | ||
| 1574 | (eq word-count 1)) | ||
| 1575 | (forward-char 1) | ||
| 1576 | (setq last-name-comma-flag t) | ||
| 1577 | (or (eq ?\ (following-char)) | ||
| 1578 | (insert ?\ ))) | ||
| 1579 | |||
| 1580 | ;; Stop before trailing comma-separated comment | ||
| 1581 | ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. | ||
| 1582 | ;; *** This case is redundant??? | ||
| 1583 | ;;((eq ?, (following-char)) | ||
| 1584 | ;; (setq name-done-flag t)) | ||
| 1585 | |||
| 1586 | ;; Delete parenthesized/quoted comment/nickname | ||
| 1587 | ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`)) | ||
| 1588 | (setq cbeg (point)) | ||
| 1589 | (set-syntax-table mail-extr-address-text-comment-syntax-table) | ||
| 1590 | (cond ((memq (following-char) '(?\' ?\`)) | ||
| 1591 | (or (search-forward "'" nil t | ||
| 1592 | (if (eq ?\' (following-char)) 2 1)) | ||
| 1593 | (delete-char 1))) | ||
| 1594 | (t | ||
| 1595 | (or (mail-extr-safe-move-sexp 1) | ||
| 1596 | (goto-char (point-max))))) | ||
| 1597 | (set-syntax-table mail-extr-address-text-syntax-table) | ||
| 1598 | (setq cend (point)) | ||
| 1599 | (cond | 1550 | (cond |
| 1600 | ;; Handle case of entire name being quoted | 1551 | |
| 1552 | ;; Delete title | ||
| 1601 | ((and (eq word-count 0) | 1553 | ((and (eq word-count 0) |
| 1602 | (looking-at " *\\'") | 1554 | (looking-at mail-extr-full-name-prefixes)) |
| 1603 | (>= (- cend cbeg) 2)) | 1555 | (goto-char (match-end 0)) |
| 1604 | (narrow-to-region (1+ cbeg) (1- cend)) | 1556 | (narrow-to-region (point) (point-max))) |
| 1605 | (goto-char (point-min))) | ||
| 1606 | (t | ||
| 1607 | ;; Handle case of quoted initial | ||
| 1608 | (if (and (or (= 3 (- cend cbeg)) | ||
| 1609 | (and (= 4 (- cend cbeg)) | ||
| 1610 | (eq ?. (char-after (+ 2 cbeg))))) | ||
| 1611 | (not (looking-at " *\\'"))) | ||
| 1612 | (setq initial (char-after (1+ cbeg))) | ||
| 1613 | (setq initial nil)) | ||
| 1614 | (delete-region cbeg cend) | ||
| 1615 | (if initial | ||
| 1616 | (insert initial ". "))))) | ||
| 1617 | |||
| 1618 | ;; Handle *Stupid* VMS date stamps | ||
| 1619 | ((looking-at mail-extr-stupid-vms-date-stamp-pattern) | ||
| 1620 | (replace-match "" t)) | ||
| 1621 | |||
| 1622 | ;; Handle Chinese characters. | ||
| 1623 | ((looking-at mail-extr-hz-embedded-gb-encoded-chinese-pattern) | ||
| 1624 | (goto-char (match-end 0)) | ||
| 1625 | (setq word-found-flag t)) | ||
| 1626 | |||
| 1627 | ;; Skip initial garbage characters. | ||
| 1628 | ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. | ||
| 1629 | ((and (eq word-count 0) | ||
| 1630 | (looking-at mail-extr-leading-garbage)) | ||
| 1631 | (goto-char (match-end 0)) | ||
| 1632 | ;; *** Skip backward over these??? | ||
| 1633 | ;; (skip-chars-backward "& \"") | ||
| 1634 | (narrow-to-region (point) (point-max))) | ||
| 1635 | 1557 | ||
| 1636 | ;; Various stopping points | 1558 | ;; Stop after name suffix |
| 1637 | ((or | 1559 | ((and (>= word-count 2) |
| 1638 | 1560 | (looking-at mail-extr-full-name-suffix-pattern)) | |
| 1639 | ;; Stop before ALL CAPS acronyms, if preceded by mixed-case | 1561 | (mail-extr-skip-whitespace-backward) |
| 1640 | ;; words. Example: XT-DEM. | 1562 | (setq suffix-flag (point)) |
| 1641 | (and (>= word-count 2) | 1563 | (if (eq ?, (following-char)) |
| 1642 | mixed-case-flag | 1564 | (forward-char 1) |
| 1643 | (looking-at mail-extr-weird-acronym-pattern) | 1565 | (insert ?,)) |
| 1644 | (not (looking-at mail-extr-roman-numeral-pattern))) | 1566 | ;; Enforce at least one space after comma |
| 1645 | 1567 | (or (eq ?\ (following-char)) | |
| 1646 | ;; Stop before trailing alternative address | 1568 | (insert ?\ )) |
| 1647 | (looking-at mail-extr-alternative-address-pattern) | 1569 | (mail-extr-skip-whitespace-forward) |
| 1648 | 1570 | (cond ((memq (following-char) '(?j ?J ?s ?S)) | |
| 1649 | ;; Stop before trailing comment not introduced by comma | 1571 | (capitalize-word 1) |
| 1650 | ;; THIS CASE MUST BE AFTER AN EARLIER CASE. | 1572 | (if (eq (following-char) ?.) |
| 1651 | (looking-at mail-extr-trailing-comment-start-pattern) | 1573 | (forward-char 1) |
| 1652 | 1574 | (insert ?.))) | |
| 1653 | ;; Stop before telephone numbers | 1575 | (t |
| 1654 | (and (>= word-count 1) | 1576 | (upcase-word 1))) |
| 1655 | (looking-at mail-extr-telephone-extension-pattern))) | 1577 | (setq word-found-flag t) |
| 1656 | (setq name-done-flag t)) | 1578 | (setq name-done-flag t)) |
| 1657 | 1579 | ||
| 1658 | ;; Delete ham radio call signs | 1580 | ;; Handle SCA names |
| 1659 | ((looking-at mail-extr-ham-call-sign-pattern) | 1581 | ((looking-at "MKA \\(.+\\)") ; "Mundanely Known As" |
| 1660 | (delete-region (match-beginning 0) (match-end 0))) | 1582 | (goto-char (match-beginning 1)) |
| 1661 | 1583 | (narrow-to-region (point) (point-max)) | |
| 1662 | ;; Fixup initials | 1584 | (setq begin-again-flag t)) |
| 1663 | ((looking-at mail-extr-initial-pattern) | 1585 | |
| 1664 | (or (eq (following-char) (upcase (following-char))) | 1586 | ;; Check for initial last name followed by comma |
| 1665 | (setq lower-case-flag t)) | 1587 | ((and (eq ?, (following-char)) |
| 1666 | (forward-char 1) | 1588 | (eq word-count 1)) |
| 1667 | (if (eq ?. (following-char)) | 1589 | (forward-char 1) |
| 1668 | (forward-char 1) | 1590 | (setq last-name-comma-flag t) |
| 1669 | (insert ?.)) | 1591 | (or (eq ?\ (following-char)) |
| 1670 | (or (eq ?\ (following-char)) | 1592 | (insert ?\ ))) |
| 1671 | (insert ?\ )) | 1593 | |
| 1672 | (setq word-found-flag t)) | 1594 | ;; Stop before trailing comma-separated comment |
| 1673 | 1595 | ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. | |
| 1674 | ;; Handle BITNET LISTSERV list names. | 1596 | ;; *** This case is redundant??? |
| 1675 | ((and (eq word-count 0) | 1597 | ;;((eq ?, (following-char)) |
| 1676 | (looking-at mail-extr-listserv-list-name-pattern)) | 1598 | ;; (setq name-done-flag t)) |
| 1677 | (narrow-to-region (match-beginning 1) (match-end 1)) | 1599 | |
| 1678 | (setq word-found-flag t) | 1600 | ;; Delete parenthesized/quoted comment/nickname |
| 1679 | (setq name-done-flag t)) | 1601 | ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`)) |
| 1680 | 1602 | (setq cbeg (point)) | |
| 1681 | ;; Handle & substitution, when & is last and is not first. | 1603 | (set-syntax-table mail-extr-address-text-comment-syntax-table) |
| 1682 | ((and (> word-count 0) | 1604 | (cond ((memq (following-char) '(?\' ?\`)) |
| 1683 | (eq ?\ (preceding-char)) | 1605 | (or (search-forward "'" nil t |
| 1684 | (eq (following-char) ?&) | 1606 | (if (eq ?\' (following-char)) 2 1)) |
| 1685 | (eq (1+ (point)) (point-max))) | 1607 | (delete-char 1))) |
| 1686 | (delete-char 1) | 1608 | (t |
| 1687 | (capitalize-region | 1609 | (or (mail-extr-safe-move-sexp 1) |
| 1688 | (point) | 1610 | (goto-char (point-max))))) |
| 1689 | (progn | 1611 | (set-syntax-table mail-extr-address-text-syntax-table) |
| 1690 | (insert-buffer-substring canonicalization-buffer | 1612 | (setq cend (point)) |
| 1691 | mbox-beg mbox-end) | 1613 | (cond |
| 1692 | (point))) | 1614 | ;; Handle case of entire name being quoted |
| 1693 | (setq disable-initial-guessing-flag t) | 1615 | ((and (eq word-count 0) |
| 1694 | (setq word-found-flag t)) | 1616 | (looking-at " *\\'") |
| 1695 | 1617 | (>= (- cend cbeg) 2)) | |
| 1696 | ;; Handle & between names, as in "Bob & Susie". | 1618 | (narrow-to-region (1+ cbeg) (1- cend)) |
| 1697 | ((and (> word-count 0) (eq (following-char) ?\&)) | 1619 | (goto-char (point-min))) |
| 1698 | (setq name-beg (point)) | 1620 | (t |
| 1699 | (setq name-end (1+ name-beg)) | 1621 | ;; Handle case of quoted initial |
| 1700 | (setq word-found-flag t) | 1622 | (if (and (or (= 3 (- cend cbeg)) |
| 1701 | (goto-char name-end)) | 1623 | (and (= 4 (- cend cbeg)) |
| 1702 | 1624 | (eq ?. (char-after (+ 2 cbeg))))) | |
| 1703 | ;; Regular name words | 1625 | (not (looking-at " *\\'"))) |
| 1704 | ((looking-at mail-extr-name-pattern) | 1626 | (setq initial (char-after (1+ cbeg))) |
| 1705 | (setq name-beg (point)) | 1627 | (setq initial nil)) |
| 1706 | (setq name-end (match-end 0)) | 1628 | (delete-region cbeg cend) |
| 1707 | 1629 | (if initial | |
| 1708 | ;; Certain words will be dropped if they are at the end. | 1630 | (insert initial ". "))))) |
| 1709 | (and (>= word-count 2) | 1631 | |
| 1710 | (not lower-case-flag) | 1632 | ;; Handle *Stupid* VMS date stamps |
| 1711 | (or | 1633 | ((looking-at mail-extr-stupid-vms-date-stamp-pattern) |
| 1712 | ;; Trailing 4-or-more letter lowercase words preceded by | 1634 | (replace-match "" t)) |
| 1713 | ;; mixed case or uppercase words will be dropped. | 1635 | |
| 1714 | (looking-at "[[:lower:]]\\{4,\\}[ \t]*\\'") | 1636 | ;; Handle Chinese characters. |
| 1715 | ;; Drop a trailing word which is terminated with a period. | 1637 | ((looking-at mail-extr-hz-embedded-gb-encoded-chinese-pattern) |
| 1716 | (eq ?. (char-after (1- name-end)))) | 1638 | (goto-char (match-end 0)) |
| 1717 | (setq drop-this-word-if-trailing-flag t)) | 1639 | (setq word-found-flag t)) |
| 1718 | 1640 | ||
| 1719 | ;; Set the flags that indicate whether we have seen a lowercase | 1641 | ;; Skip initial garbage characters. |
| 1720 | ;; word, a mixed case word, and an uppercase word. | 1642 | ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. |
| 1721 | (if (re-search-forward "[[:lower:]]" name-end t) | 1643 | ((and (eq word-count 0) |
| 1722 | (if (progn | 1644 | (looking-at mail-extr-leading-garbage)) |
| 1723 | (goto-char name-beg) | 1645 | (goto-char (match-end 0)) |
| 1724 | (re-search-forward "[[:upper:]]" name-end t)) | 1646 | ;; *** Skip backward over these??? |
| 1725 | (setq mixed-case-flag t) | 1647 | ;; (skip-chars-backward "& \"") |
| 1648 | (narrow-to-region (point) (point-max))) | ||
| 1649 | |||
| 1650 | ;; Various stopping points | ||
| 1651 | ((or | ||
| 1652 | |||
| 1653 | ;; Stop before ALL CAPS acronyms, if preceded by mixed-case | ||
| 1654 | ;; words. Example: XT-DEM. | ||
| 1655 | (and (>= word-count 2) | ||
| 1656 | mixed-case-flag | ||
| 1657 | (looking-at mail-extr-weird-acronym-pattern) | ||
| 1658 | (not (looking-at mail-extr-roman-numeral-pattern))) | ||
| 1659 | |||
| 1660 | ;; Stop before trailing alternative address | ||
| 1661 | (looking-at mail-extr-alternative-address-pattern) | ||
| 1662 | |||
| 1663 | ;; Stop before trailing comment not introduced by comma | ||
| 1664 | ;; THIS CASE MUST BE AFTER AN EARLIER CASE. | ||
| 1665 | (looking-at mail-extr-trailing-comment-start-pattern) | ||
| 1666 | |||
| 1667 | ;; Stop before telephone numbers | ||
| 1668 | (and (>= word-count 1) | ||
| 1669 | (looking-at mail-extr-telephone-extension-pattern))) | ||
| 1670 | (setq name-done-flag t)) | ||
| 1671 | |||
| 1672 | ;; Delete ham radio call signs | ||
| 1673 | ((looking-at mail-extr-ham-call-sign-pattern) | ||
| 1674 | (delete-region (match-beginning 0) (match-end 0))) | ||
| 1675 | |||
| 1676 | ;; Fixup initials | ||
| 1677 | ((looking-at mail-extr-initial-pattern) | ||
| 1678 | (or (eq (following-char) (upcase (following-char))) | ||
| 1726 | (setq lower-case-flag t)) | 1679 | (setq lower-case-flag t)) |
| 1727 | ;; (setq upper-case-flag t) | 1680 | (forward-char 1) |
| 1728 | ) | 1681 | (if (eq ?. (following-char)) |
| 1682 | (forward-char 1) | ||
| 1683 | (insert ?.)) | ||
| 1684 | (or (eq ?\ (following-char)) | ||
| 1685 | (insert ?\ )) | ||
| 1686 | (setq word-found-flag t)) | ||
| 1687 | |||
| 1688 | ;; Handle BITNET LISTSERV list names. | ||
| 1689 | ((and (eq word-count 0) | ||
| 1690 | (looking-at mail-extr-listserv-list-name-pattern)) | ||
| 1691 | (narrow-to-region (match-beginning 1) (match-end 1)) | ||
| 1692 | (setq word-found-flag t) | ||
| 1693 | (setq name-done-flag t)) | ||
| 1694 | |||
| 1695 | ;; Handle & substitution, when & is last and is not first. | ||
| 1696 | ((and (> word-count 0) | ||
| 1697 | (eq ?\ (preceding-char)) | ||
| 1698 | (eq (following-char) ?&) | ||
| 1699 | (eq (1+ (point)) (point-max))) | ||
| 1700 | (delete-char 1) | ||
| 1701 | (capitalize-region | ||
| 1702 | (point) | ||
| 1703 | (progn | ||
| 1704 | (insert-buffer-substring canonicalization-buffer | ||
| 1705 | mbox-beg mbox-end) | ||
| 1706 | (point))) | ||
| 1707 | (setq disable-initial-guessing-flag t) | ||
| 1708 | (setq word-found-flag t)) | ||
| 1709 | |||
| 1710 | ;; Handle & between names, as in "Bob & Susie". | ||
| 1711 | ((and (> word-count 0) (eq (following-char) ?\&)) | ||
| 1712 | (setq name-beg (point)) | ||
| 1713 | (setq name-end (1+ name-beg)) | ||
| 1714 | (setq word-found-flag t) | ||
| 1715 | (goto-char name-end)) | ||
| 1716 | |||
| 1717 | ;; Regular name words | ||
| 1718 | ((looking-at mail-extr-name-pattern) | ||
| 1719 | (setq name-beg (point)) | ||
| 1720 | (setq name-end (match-end 0)) | ||
| 1721 | |||
| 1722 | ;; Certain words will be dropped if they are at the end. | ||
| 1723 | (and (>= word-count 2) | ||
| 1724 | (not lower-case-flag) | ||
| 1725 | (or | ||
| 1726 | ;; Trailing 4-or-more letter lowercase words preceded by | ||
| 1727 | ;; mixed case or uppercase words will be dropped. | ||
| 1728 | (looking-at "[[:lower:]]\\{4,\\}[ \t]*\\'") | ||
| 1729 | ;; Drop a trailing word which is terminated with a period. | ||
| 1730 | (eq ?. (char-after (1- name-end)))) | ||
| 1731 | (setq drop-this-word-if-trailing-flag t)) | ||
| 1732 | |||
| 1733 | ;; Set the flags that indicate whether we have seen a lowercase | ||
| 1734 | ;; word, a mixed case word, and an uppercase word. | ||
| 1735 | (if (re-search-forward "[[:lower:]]" name-end t) | ||
| 1736 | (if (progn | ||
| 1737 | (goto-char name-beg) | ||
| 1738 | (re-search-forward "[[:upper:]]" name-end t)) | ||
| 1739 | (setq mixed-case-flag t) | ||
| 1740 | (setq lower-case-flag t)) | ||
| 1741 | ;; (setq upper-case-flag t) | ||
| 1742 | ) | ||
| 1729 | 1743 | ||
| 1730 | (goto-char name-end) | 1744 | (goto-char name-end) |
| 1731 | (setq word-found-flag t)) | 1745 | (setq word-found-flag t)) |
| 1732 | 1746 | ||
| 1733 | ;; Allow a number as a word, if it doesn't mean anything else. | 1747 | ;; Allow a number as a word, if it doesn't mean anything else. |
| 1734 | ((looking-at "[0-9]+\\>") | 1748 | ((looking-at "[0-9]+\\>") |
| 1735 | (setq name-beg (point)) | 1749 | (setq name-beg (point)) |
| 1736 | (setq name-end (match-end 0)) | 1750 | (setq name-end (match-end 0)) |
| 1751 | (goto-char name-end) | ||
| 1752 | (setq word-found-flag t)) | ||
| 1753 | |||
| 1754 | (t | ||
| 1755 | (setq name-done-flag t) | ||
| 1756 | )) | ||
| 1757 | |||
| 1758 | ;; Count any word that we skipped over. | ||
| 1759 | (if word-found-flag | ||
| 1760 | (setq word-count (1+ word-count)))) | ||
| 1761 | |||
| 1762 | ;; If the last thing in the name is 2 or more periods, or one or more | ||
| 1763 | ;; other sentence terminators (but not a single period) then keep them | ||
| 1764 | ;; and the preceding word. This is for the benefit of whole sentences | ||
| 1765 | ;; in the name field: it's better behavior than dropping the last word | ||
| 1766 | ;; of the sentence... | ||
| 1767 | (if (and (not suffix-flag) | ||
| 1768 | (looking-at "\\(\\.+\\|[?!;:.][?!;:.]+\\|[?!;:][?!;:.]*\\)\\'")) | ||
| 1769 | (goto-char (setq suffix-flag (point-max)))) | ||
| 1770 | |||
| 1771 | ;; Drop everything after point and certain trailing words. | ||
| 1772 | (narrow-to-region (point-min) | ||
| 1773 | (or (and drop-last-word-if-trailing-flag | ||
| 1774 | last-word-beg) | ||
| 1775 | (point))) | ||
| 1776 | |||
| 1777 | ;; Xerox's mailers SUCK!!!!!! | ||
| 1778 | ;; We simply refuse to believe that any last name is PARC or ADOC. | ||
| 1779 | ;; If it looks like that is the last name, that there is no meaningful | ||
| 1780 | ;; here at all. Actually I guess it would be best to map patterns | ||
| 1781 | ;; like foo.hoser@xerox.com into foo@hoser.xerox.com, but I don't | ||
| 1782 | ;; actually know that that is what's going on. | ||
| 1783 | (unless suffix-flag | ||
| 1784 | (goto-char (point-min)) | ||
| 1785 | (let ((case-fold-search t)) | ||
| 1786 | (if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'") | ||
| 1787 | (erase-buffer)))) | ||
| 1788 | |||
| 1789 | ;; If last name first put it at end (but before suffix) | ||
| 1790 | (when last-name-comma-flag | ||
| 1791 | (goto-char (point-min)) | ||
| 1792 | (search-forward ",") | ||
| 1793 | (setq name-end (1- (point))) | ||
| 1794 | (goto-char (or suffix-flag (point-max))) | ||
| 1795 | (or (eq ?\ (preceding-char)) | ||
| 1796 | (insert ?\ )) | ||
| 1797 | (insert-buffer-substring (current-buffer) (point-min) name-end) | ||
| 1737 | (goto-char name-end) | 1798 | (goto-char name-end) |
| 1738 | (setq word-found-flag t)) | 1799 | (skip-chars-forward "\t ,") |
| 1739 | 1800 | (narrow-to-region (point) (point-max))) | |
| 1740 | (t | ||
| 1741 | (setq name-done-flag t) | ||
| 1742 | )) | ||
| 1743 | |||
| 1744 | ;; Count any word that we skipped over. | ||
| 1745 | (if word-found-flag | ||
| 1746 | (setq word-count (1+ word-count)))) | ||
| 1747 | |||
| 1748 | ;; If the last thing in the name is 2 or more periods, or one or more | ||
| 1749 | ;; other sentence terminators (but not a single period) then keep them | ||
| 1750 | ;; and the preceding word. This is for the benefit of whole sentences | ||
| 1751 | ;; in the name field: it's better behavior than dropping the last word | ||
| 1752 | ;; of the sentence... | ||
| 1753 | (if (and (not suffix-flag) | ||
| 1754 | (looking-at "\\(\\.+\\|[?!;:.][?!;:.]+\\|[?!;:][?!;:.]*\\)\\'")) | ||
| 1755 | (goto-char (setq suffix-flag (point-max)))) | ||
| 1756 | |||
| 1757 | ;; Drop everything after point and certain trailing words. | ||
| 1758 | (narrow-to-region (point-min) | ||
| 1759 | (or (and drop-last-word-if-trailing-flag | ||
| 1760 | last-word-beg) | ||
| 1761 | (point))) | ||
| 1762 | |||
| 1763 | ;; Xerox's mailers SUCK!!!!!! | ||
| 1764 | ;; We simply refuse to believe that any last name is PARC or ADOC. | ||
| 1765 | ;; If it looks like that is the last name, that there is no meaningful | ||
| 1766 | ;; here at all. Actually I guess it would be best to map patterns | ||
| 1767 | ;; like foo.hoser@xerox.com into foo@hoser.xerox.com, but I don't | ||
| 1768 | ;; actually know that that is what's going on. | ||
| 1769 | (unless suffix-flag | ||
| 1770 | (goto-char (point-min)) | ||
| 1771 | (let ((case-fold-search t)) | ||
| 1772 | (if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'") | ||
| 1773 | (erase-buffer)))) | ||
| 1774 | 1801 | ||
| 1775 | ;; If last name first put it at end (but before suffix) | 1802 | ;; Delete leading and trailing junk characters. |
| 1776 | (when last-name-comma-flag | 1803 | ;; *** This is probably completely unneeded now. |
| 1804 | ;;(goto-char (point-max)) | ||
| 1805 | ;;(skip-chars-backward mail-extr-non-end-name-chars) | ||
| 1806 | ;;(if (eq ?. (following-char)) | ||
| 1807 | ;; (forward-char 1)) | ||
| 1808 | ;;(narrow-to-region (point) | ||
| 1809 | ;; (progn | ||
| 1810 | ;; (goto-char (point-min)) | ||
| 1811 | ;; (skip-chars-forward mail-extr-non-begin-name-chars) | ||
| 1812 | ;; (point))) | ||
| 1813 | |||
| 1814 | ;; Compress whitespace | ||
| 1777 | (goto-char (point-min)) | 1815 | (goto-char (point-min)) |
| 1778 | (search-forward ",") | 1816 | (while (re-search-forward "[ \t\n]+" nil t) |
| 1779 | (setq name-end (1- (point))) | 1817 | (replace-match (if (eobp) "" " ") t)) |
| 1780 | (goto-char (or suffix-flag (point-max))) | 1818 | )))) |
| 1781 | (or (eq ?\ (preceding-char)) | ||
| 1782 | (insert ?\ )) | ||
| 1783 | (insert-buffer-substring (current-buffer) (point-min) name-end) | ||
| 1784 | (goto-char name-end) | ||
| 1785 | (skip-chars-forward "\t ,") | ||
| 1786 | (narrow-to-region (point) (point-max))) | ||
| 1787 | |||
| 1788 | ;; Delete leading and trailing junk characters. | ||
| 1789 | ;; *** This is probably completely unneeded now. | ||
| 1790 | ;;(goto-char (point-max)) | ||
| 1791 | ;;(skip-chars-backward mail-extr-non-end-name-chars) | ||
| 1792 | ;;(if (eq ?. (following-char)) | ||
| 1793 | ;; (forward-char 1)) | ||
| 1794 | ;;(narrow-to-region (point) | ||
| 1795 | ;; (progn | ||
| 1796 | ;; (goto-char (point-min)) | ||
| 1797 | ;; (skip-chars-forward mail-extr-non-begin-name-chars) | ||
| 1798 | ;; (point))) | ||
| 1799 | |||
| 1800 | ;; Compress whitespace | ||
| 1801 | (goto-char (point-min)) | ||
| 1802 | (while (re-search-forward "[ \t\n]+" nil t) | ||
| 1803 | (replace-match (if (eobp) "" " ") t)) | ||
| 1804 | ))) | ||
| 1805 | 1819 | ||
| 1806 | 1820 | ||
| 1807 | 1821 | ||
diff --git a/man/ChangeLog b/man/ChangeLog index a36b0c75fe4..4f2ce160de6 100644 --- a/man/ChangeLog +++ b/man/ChangeLog | |||
| @@ -1,3 +1,9 @@ | |||
| 1 | 2004-08-05 Lars Hansen <larsh@math.ku.dk> | ||
| 2 | |||
| 3 | * widget.texi (User Interface): Update how to separate the | ||
| 4 | editable field of an editable-field widget from other widgets. | ||
| 5 | (Programming Example): Add text after field. | ||
| 6 | |||
| 1 | 2004-07-24 Richard M. Stallman <rms@gnu.org> | 7 | 2004-07-24 Richard M. Stallman <rms@gnu.org> |
| 2 | 8 | ||
| 3 | * text.texi (Paragraphs): Update how paragraphs are separated | 9 | * text.texi (Paragraphs): Update how paragraphs are separated |
diff --git a/man/widget.texi b/man/widget.texi index 457af8a07bb..7e1d920cc62 100644 --- a/man/widget.texi +++ b/man/widget.texi | |||
| @@ -213,14 +213,19 @@ middle of another field is prohibited. | |||
| 213 | 213 | ||
| 214 | Editable text fields are created by the @code{editable-field} widget. | 214 | Editable text fields are created by the @code{editable-field} widget. |
| 215 | 215 | ||
| 216 | An editable field must be surrounded by static text on both sides, that | 216 | @strong{Warning:} In an @code{editable-field} widget, the editable |
| 217 | is, text that does not change in the lifetime of the widget. If the | 217 | field must not be adjacent to another widget---that won't work. |
| 218 | field extends to the end of the line, the terminating line-feed character | 218 | You must put some text in between. Either make this text part of |
| 219 | will count as the necessary static text on that end, but you will have | 219 | the @code{editable-field} widget itself, or insert it with |
| 220 | to provide the static text before the field yourself. The | 220 | @code{widget-insert}. |
| 221 | @code{:format} keyword is useful for generating the static text; for | 221 | |
| 222 | instance, if you give it a value of @code{"Name: %v"}, the "Name: " part | 222 | The @code{:format} keyword is useful for generating the necessary |
| 223 | will count as the static text. | 223 | text; for instance, if you give it a value of @code{"Name: %v "}, |
| 224 | the @samp{Name: } part will provide the necessary separating text | ||
| 225 | before the field and the trailing space will provide the | ||
| 226 | separating text after the field. If you don't include the | ||
| 227 | @code{:size} keyword, the field will extend to the end of the | ||
| 228 | line, and the terminating newline will provide separation after. | ||
| 224 | 229 | ||
| 225 | The editing text fields are highlighted with the | 230 | The editing text fields are highlighted with the |
| 226 | @code{widget-field-face} face, making them easy to find. | 231 | @code{widget-field-face} face, making them easy to find. |
| @@ -345,6 +350,7 @@ Interface}). | |||
| 345 | (widget-insert "Here is some documentation.\n\nName: ") | 350 | (widget-insert "Here is some documentation.\n\nName: ") |
| 346 | (widget-create 'editable-field | 351 | (widget-create 'editable-field |
| 347 | :size 13 | 352 | :size 13 |
| 353 | :format "%v " ; Text after the field! | ||
| 348 | "My Name") | 354 | "My Name") |
| 349 | (widget-create 'menu-choice | 355 | (widget-create 'menu-choice |
| 350 | :tag "Choose" | 356 | :tag "Choose" |
diff --git a/src/ChangeLog b/src/ChangeLog index 0194c4b8c6f..2b0c47862d4 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2004-08-03 Kenichi Handa <handa@m17n.org> | ||
| 2 | |||
| 3 | * coding.c (decode_coding_string): Adjust coding->consumed, and | ||
| 4 | etc. with shrinked_bytes. | ||
| 5 | |||
| 1 | 2004-08-03 Kim F. Storm <storm@cua.dk> | 6 | 2004-08-03 Kim F. Storm <storm@cua.dk> |
| 2 | 7 | ||
| 3 | * indent.c (compute_motion): Fix check for full width window | 8 | * indent.c (compute_motion): Fix check for full width window |
diff --git a/src/coding.c b/src/coding.c index b36f7fbfbff..1257771d3ed 100644 --- a/src/coding.c +++ b/src/coding.c | |||
| @@ -6234,6 +6234,11 @@ decode_coding_string (str, coding, nocopy) | |||
| 6234 | shrinked_bytes - from); | 6234 | shrinked_bytes - from); |
| 6235 | free_conversion_buffer (&buf); | 6235 | free_conversion_buffer (&buf); |
| 6236 | 6236 | ||
| 6237 | coding->consumed += shrinked_bytes; | ||
| 6238 | coding->consumed_char += shrinked_bytes; | ||
| 6239 | coding->produced += shrinked_bytes; | ||
| 6240 | coding->produced_char += shrinked_bytes; | ||
| 6241 | |||
| 6237 | if (coding->cmp_data && coding->cmp_data->used) | 6242 | if (coding->cmp_data && coding->cmp_data->used) |
| 6238 | coding_restore_composition (coding, newstr); | 6243 | coding_restore_composition (coding, newstr); |
| 6239 | coding_free_composition_data (coding); | 6244 | coding_free_composition_data (coding); |
diff --git a/src/indent.c b/src/indent.c index d6fea34f5f5..ffde428c12f 100644 --- a/src/indent.c +++ b/src/indent.c | |||
| @@ -1262,10 +1262,10 @@ compute_motion (from, fromvpos, fromhpos, did_motion, to, tovpos, tohpos, width, | |||
| 1262 | width -= 1; | 1262 | width -= 1; |
| 1263 | } | 1263 | } |
| 1264 | 1264 | ||
| 1265 | continuation_glyph_width = 0; | 1265 | continuation_glyph_width = 1; |
| 1266 | #ifdef HAVE_WINDOW_SYSTEM | 1266 | #ifdef HAVE_WINDOW_SYSTEM |
| 1267 | if (!FRAME_WINDOW_P (XFRAME (win->frame))) | 1267 | if (FRAME_WINDOW_P (XFRAME (win->frame))) |
| 1268 | continuation_glyph_width = 1; | 1268 | continuation_glyph_width = 0; /* In the fringe. */ |
| 1269 | #endif | 1269 | #endif |
| 1270 | 1270 | ||
| 1271 | immediate_quit = 1; | 1271 | immediate_quit = 1; |