aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaroly Lorentey2004-08-07 15:05:02 +0000
committerKaroly Lorentey2004-08-07 15:05:02 +0000
commit18ad87544445be2584163436bd3c5d6366afa122 (patch)
tree5b724841af27d9cf79c42f09e0c1079203b68107
parentd03a8fe4dee75f545e50891247367a167fc980d7 (diff)
parentde10c1149c818f8cee4cc5af7408655945a339d3 (diff)
downloademacs-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--ChangeLog4
-rw-r--r--Makefile.in6
-rw-r--r--leim/ChangeLog4
-rw-r--r--leim/Makefile.in1
-rw-r--r--lisp/ChangeLog24
-rw-r--r--lisp/international/encoded-kb.el337
-rw-r--r--lisp/mail/mail-extr.el724
-rw-r--r--man/ChangeLog6
-rw-r--r--man/widget.texi22
-rw-r--r--src/ChangeLog5
-rw-r--r--src/coding.c5
-rw-r--r--src/indent.c6
12 files changed, 581 insertions, 563 deletions
diff --git a/ChangeLog b/ChangeLog
index 60fbc7e8723..223d75fdf07 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
12004-08-06 Andreas Schwab <schwab@suse.de>
2
3 * Makefile.in (install-arch-indep, uninstall): Add flymake.
4
12004-07-31 Eli Zaretskii <eliz@gnu.org> 52004-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 @@
12004-08-06 Andreas Schwab <schwab@suse.de>
2
3 * Makefile.in (install): Remove .arch-inventory files.
4
12004-07-01 David Kastrup <dak@gnu.org> 52004-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 @@
12004-08-04 Kenichi Handa <handa@m17n.org>
2
3 * international/encoded-kb.el (encoded-kbd-setup-keymap): Fix
4 previous change.
5
62004-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
12004-08-02 Kim F. Storm <storm@cua.dk> 252004-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.
109The following key sequence may cause multilingual text insertion." 98The 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
301as a multilingual text encoded in a coding system set by 272as 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.
1439If it is neither nil nor a string, modifying of names will never take
1440place. 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 @@
12004-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
12004-07-24 Richard M. Stallman <rms@gnu.org> 72004-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
214Editable text fields are created by the @code{editable-field} widget. 214Editable text fields are created by the @code{editable-field} widget.
215 215
216An editable field must be surrounded by static text on both sides, that 216@strong{Warning:} In an @code{editable-field} widget, the editable
217is, text that does not change in the lifetime of the widget. If the 217field must not be adjacent to another widget---that won't work.
218field extends to the end of the line, the terminating line-feed character 218You must put some text in between. Either make this text part of
219will count as the necessary static text on that end, but you will have 219the @code{editable-field} widget itself, or insert it with
220to 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
222instance, if you give it a value of @code{"Name: %v"}, the "Name: " part 222The @code{:format} keyword is useful for generating the necessary
223will count as the static text. 223text; for instance, if you give it a value of @code{"Name: %v "},
224the @samp{Name: } part will provide the necessary separating text
225before the field and the trailing space will provide the
226separating text after the field. If you don't include the
227@code{:size} keyword, the field will extend to the end of the
228line, and the terminating newline will provide separation after.
224 229
225The editing text fields are highlighted with the 230The 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 @@
12004-08-03 Kenichi Handa <handa@m17n.org>
2
3 * coding.c (decode_coding_string): Adjust coding->consumed, and
4 etc. with shrinked_bytes.
5
12004-08-03 Kim F. Storm <storm@cua.dk> 62004-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;