Mercurial > emacs
changeset 89961:3fd4a5c21153
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-29
Merge from lorentey@elte.hu--2004/emacs--multi-tty--0, emacs--cvs-trunk--0
Patches applied:
* lorentey@elte.hu--2004/emacs--multi-tty--0--patch-224
Added sorted-doc to backup regex in lib-src.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-479
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-482
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-483
Build-in-place tweak
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-484
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-485
Update from CVS
author | Miles Bader <miles@gnu.org> |
---|---|
date | Tue, 10 Aug 2004 07:46:40 +0000 |
parents | d79ab6afded5 (current diff) 3df9006c09e2 (diff) |
children | 77df4a7f419a |
files | ChangeLog Makefile.in etc/NEWS leim/ChangeLog leim/Makefile.in lisp/ChangeLog lisp/emacs-lisp/re-builder.el lisp/help.el lisp/ibuffer.el lisp/international/encoded-kb.el lisp/mail/mail-extr.el lisp/novice.el lisp/simple.el lisp/subr.el lisp/wid-edit.el lispref/ChangeLog lispref/commands.texi lispref/frames.texi lispref/hooks.texi lispref/minibuf.texi lispref/objects.texi lispref/os.texi man/ChangeLog man/widget.texi src/ChangeLog src/fileio.c src/indent.c src/keyboard.c src/keymap.c src/window.c |
diffstat | 31 files changed, 866 insertions(+), 623 deletions(-) [+] |
line wrap: on
line diff
--- a/ChangeLog Wed Aug 04 06:04:39 2004 +0000 +++ b/ChangeLog Tue Aug 10 07:46:40 2004 +0000 @@ -1,3 +1,7 @@ +2004-08-06 Andreas Schwab <schwab@suse.de> + + * Makefile.in (install-arch-indep, uninstall): Add flymake. + 2004-07-31 Eli Zaretskii <eliz@gnu.org> * config.bat: Update URLs in the comments.
--- a/Makefile.in Wed Aug 04 06:04:39 2004 +0000 +++ b/Makefile.in Tue Aug 10 07:46:40 2004 +0000 @@ -475,7 +475,7 @@ chmod a+r ${infodir}/dir); \ fi; \ cd ${srcdir}/info ; \ - for f in ada-mode* autotype* calc* ccmode* cl* dired-x* ebrowse* ediff* efaq* eintr* elisp* emacs* emacs-xtra* eshell* eudc* forms* gnus* idlwave* info* message* mh-e* pcl-cvs* reftex* sc* ses* speedbar* tramp* vip* widget* woman* smtpmail*; do \ + for f in ada-mode* autotype* calc* ccmode* cl* dired-x* ebrowse* ediff* efaq* eintr* elisp* emacs* emacs-xtra* eshell* eudc* flymake* forms* gnus* idlwave* info* message* mh-e* pcl-cvs* reftex* sc* ses* speedbar* tramp* vip* widget* woman* smtpmail*; do \ (cd $${thisdir}; \ ${INSTALL_DATA} ${srcdir}/info/$$f ${infodir}/$$f; \ chmod a+r ${infodir}/$$f); \ @@ -485,7 +485,7 @@ thisdir=`/bin/pwd`; \ if [ `(cd ${srcdir}/info && /bin/pwd)` != `(cd ${infodir} && /bin/pwd)` ]; \ then \ - for f in ada-mode autotype calc ccmode cl dired-x ebrowse ediff efaq elisp eintr emacs emacs-mime emacs-xtra eshell eudc forms gnus idlwave info message mh-e pcl-cvs reftex sc ses speedbar tramp vip viper widget woman smtpmail; do \ + for f in ada-mode autotype calc ccmode cl dired-x ebrowse ediff efaq elisp eintr emacs emacs-mime emacs-xtra eshell eudc flymake forms gnus idlwave info message mh-e pcl-cvs reftex sc ses speedbar tramp vip viper widget woman smtpmail; do \ (cd $${thisdir}; \ ${INSTALL_INFO} --info-dir=${infodir} ${infodir}/$$f); \ done; \ @@ -551,7 +551,7 @@ done (cd ${archlibdir} && rm -f fns-*) -rm -rf ${libexecdir}/emacs/${version} - (cd ${infodir} && rm -f cl* ada-mode* autotype* calc* ccmode* ebrowse* efaq* eintr elisp* eshell* eudc* idlwave* message* pcl-cvs* reftex* speedbar* tramp* widget* woman* dired-x* ediff* emacs* emacs-xtra* forms* gnus* info* mh-e* sc* ses* vip* smtpmail*) + (cd ${infodir} && rm -f cl* ada-mode* autotype* calc* ccmode* ebrowse* efaq* eintr elisp* eshell* eudc* idlwave* message* pcl-cvs* reftex* speedbar* tramp* widget* woman* dired-x* ediff* emacs* emacs-xtra* flymake* forms* gnus* info* mh-e* sc* ses* vip* smtpmail*) (cd ${man1dir} && rm -f emacs${manext} emacsclient${manext} etags${manext} ctags${manext}) (cd ${bindir} && rm -f $(EMACSFULL) $(EMACS))
--- a/etc/NEWS Wed Aug 04 06:04:39 2004 +0000 +++ b/etc/NEWS Tue Aug 10 07:46:40 2004 +0000 @@ -2262,6 +2262,11 @@ * Lisp Changes in Emacs 21.4 ++++ +** Both the variable and the function `disabled-command-hook' have +been renamed to `disabled-command-function'. The variable +`disabled-command-hook' has been kept as an obsolete alias. + ** Function `compute-motion' now calculates the usable window width if the WIDTH argument is nil. If the TOPOS argument is nil, the usable window height and width is used.
--- a/leim/ChangeLog Wed Aug 04 06:04:39 2004 +0000 +++ b/leim/ChangeLog Tue Aug 10 07:46:40 2004 +0000 @@ -1,3 +1,7 @@ +2004-08-06 Andreas Schwab <schwab@suse.de> + + * Makefile.in (install): Remove .arch-inventory files. + 2004-07-01 David Kastrup <dak@gnu.org> * quail/greek.el ("((") ("))"): add quotation mark shorthands.
--- a/leim/Makefile.in Wed Aug 04 06:04:39 2004 +0000 +++ b/leim/Makefile.in Tue Aug 10 07:46:40 2004 +0000 @@ -232,6 +232,7 @@ fi; \ rm -rf ${INSTALLDIR}/CVS ${INSTALLDIR}/*/CVS; \ rm -f ${INSTALLDIR}/.cvsignore ${INSTALLDIR}/*/.cvsignore; \ + rm -f ${INSTALLDIR}/.arch-inventory ${INSTALLDIR}/*/.arch-inventory; \ rm -f ${INSTALLDIR}/\#* ${INSTALLDIR}/*/\#* ; \ rm -f ${INSTALLDIR}/.\#* ${INSTALLDIR}/*/.\#* ; \ rm -f ${INSTALLDIR}/*~ ${INSTALLDIR}/*/*~ ; \
--- a/lib-src/.arch-inventory Wed Aug 04 06:04:39 2004 +0000 +++ b/lib-src/.arch-inventory Tue Aug 10 07:46:40 2004 +0000 @@ -1,5 +1,5 @@ # Ignore binaries -backup ^(test-distrib|make-docfile|profile|digest-doc|movemail|cvtmail|fakemail|yow|emacsserver|hexl|update-game-score|etags|ctags|emacsclient|b2m|ebrowse)$ +backup ^(test-distrib|make-docfile|profile|digest-doc|movemail|cvtmail|fakemail|yow|emacsserver|hexl|update-game-score|etags|ctags|emacsclient|b2m|ebrowse|sorted-doc)$ # Building actually makes a copy/link of the source file precious ^(ctags\.c)$
--- a/lisp/ChangeLog Wed Aug 04 06:04:39 2004 +0000 +++ b/lisp/ChangeLog Tue Aug 10 07:46:40 2004 +0000 @@ -1,3 +1,67 @@ +2004-08-09 Luc Teirlinck <teirllm@auburn.edu> + + * help.el (describe-bindings): Doc fix. + + * subr.el (kbd): Doc fix. + +2004-08-08 John Paul Wallington <jpw@gnu.org> + + * ibuffer.el (define-ibuffer-column size): Use `string-to-number' + instead of `string-to-int'. + (define-ibuffer-column mode): Fix indentation. + +2004-08-08 Lars Hansen <larsh@math.ku.dk> + + * wid-edit.el (widget-sexp-validate): Allow whitespace after + expression. + +2004-08-08 Luc Teirlinck <teirllm@auburn.edu> + + * subr.el (global-unset-key, local-unset-key): Doc fixes. + + * novice.el (disabled-command-function): New variable renamed from + `disabled-command-hook'. + (disabled-command-hook): Keep the _variable_ as alias for + `disabled-command-function' and make obsolete. + (disabled-command-function): Function renamed from + `disabled-command-hook'. Adapt code to name change of the variable. + +2004-08-07 Satyaki Das <satyaki@theforce.stanford.edu> (tiny change) + + * simple.el (completion-root-regexp): New defvar. + (completion-setup-function): Use it instead of a literal string. + +2004-08-07 John Paul Wallington <jpw@gnu.org> + + * emacs-lisp/re-builder.el (reb-re-syntax): Add `rx' syntax. + (reb-lisp-mode): Require `rx' feature when `re-reb-syntax' is `rx'. + (reb-lisp-syntax-p, reb-change-syntax): `rx' is a Lisp syntax. + (reb-cook-regexp): Call `rx-to-string' when `re-reb-syntax' is `rx'. + +2004-08-04 Kenichi Handa <handa@m17n.org> + + * international/encoded-kb.el (encoded-kbd-setup-keymap): Fix + previous change. + +2004-08-03 Kenichi Handa <handa@m17n.org> + + * international/encoded-kb.el: The following changes are to + utilize key-translation-map instead of minor mode map. + (encoded-kbd-iso2022-non-ascii-map): Delete it. + (encoded-kbd-coding, encoded-kbd-handle-8bit): Delete them. + (encoded-kbd-last-key): New function. + (encoded-kbd-iso2022-single-shift): New function. + (encoded-kbd-iso2022-designation) + (encoded-kbd-self-insert-iso2022-7bit) + (encoded-kbd-self-insert-iso2022-8bit) + (encoded-kbd-self-insert-sjis, encoded-kbd-self-insert-big5) + (encoded-kbd-self-insert-ccl): Make them suitable for bindings in + key-translation-map. + (encoded-kbd-setup-keymap): Setup key-translation-map. + (saved-key-translation-map): New variable. + (encoded-kbd-mode): Save/restore key-translation-map. Adjusted + for the change of encoded-kbd-setup-keymap. + 2004-08-02 Kim F. Storm <storm@cua.dk> * avoid.el (mouse-avoidance-point-position): Use window-inside-edges
--- a/lisp/emacs-lisp/re-builder.el Wed Aug 04 06:04:39 2004 +0000 +++ b/lisp/emacs-lisp/re-builder.el Tue Aug 10 07:46:40 2004 +0000 @@ -135,6 +135,7 @@ (const :tag "String syntax" string) (const :tag "`sregex' syntax" sregex) (const :tag "`lisp-re' syntax" lisp-re) + (const :tag "`rx' syntax" rx) (value: string))) (defcustom reb-auto-match-limit 200 @@ -261,7 +262,9 @@ (cond ((eq reb-re-syntax 'lisp-re) ; Pull in packages (require 'lisp-re)) ; as needed ((eq reb-re-syntax 'sregex) ; sregex is not autoloaded - (require 'sregex))) ; right now.. + (require 'sregex)) ; right now.. + ((eq reb-re-syntax 'rx) ; rx-to-string is autoloaded + (require 'rx))) ; require rx anyway (reb-mode-common)) ;; Use the same "\C-c" keymap as `reb-mode' and use font-locking from @@ -320,7 +323,7 @@ (defsubst reb-lisp-syntax-p () "Return non-nil if RE Builder uses a Lisp syntax." - (memq reb-re-syntax '(lisp-re sregex))) + (memq reb-re-syntax '(lisp-re sregex rx))) (defmacro reb-target-binding (symbol) "Return binding for SYMBOL in the RE Builder target buffer." @@ -466,10 +469,10 @@ (list (intern (completing-read "Select syntax: " (mapcar (lambda (el) (cons (symbol-name el) 1)) - '(read string lisp-re sregex)) + '(read string lisp-re sregex rx)) nil t (symbol-name reb-re-syntax))))) - (if (memq syntax '(read string lisp-re sregex)) + (if (memq syntax '(read string lisp-re sregex rx)) (let ((buffer (get-buffer reb-buffer))) (setq reb-re-syntax syntax) (if buffer @@ -604,6 +607,8 @@ (lre-compile-string (eval (car (read-from-string re))))) ((eq reb-re-syntax 'sregex) (apply 'sregex (eval (car (read-from-string re))))) + ((eq reb-re-syntax 'rx) + (rx-to-string (eval (car (read-from-string re))))) (t re))) (defun reb-update-regexp () @@ -670,7 +675,7 @@ (overlay-put overlay 'priority i))) (setq i (1+ i)))))) (let ((count (if subexp submatches matches))) - (message"%s %smatch%s%s" + (message "%s %smatch%s%s" (if (= 0 count) "No" (int-to-string count)) (if subexp "subexpression " "") (if (= 1 count) "" "es")
--- a/lisp/help.el Wed Aug 04 06:04:39 2004 +0000 +++ b/lisp/help.el Tue Aug 10 07:46:40 2004 +0000 @@ -428,7 +428,8 @@ The optional argument PREFIX, if non-nil, should be a key sequence; then we display only bindings that start with that prefix. The optional argument BUFFER specifies which buffer's bindings -to display (default, the current buffer)." +to display (default, the current buffer). BUFFER can be a buffer +or a buffer name." (interactive) (or buffer (setq buffer (current-buffer))) (help-setup-xref (list #'describe-bindings prefix buffer) (interactive-p))
--- a/lisp/ibuffer.el Wed Aug 04 06:04:39 2004 +0000 +++ b/lisp/ibuffer.el Tue Aug 10 07:46:40 2004 +0000 @@ -1644,16 +1644,17 @@ (dolist (string column-strings) (setq total ;; like, ewww ... - (+ (float (string-to-int string)) + (+ (float (string-to-number string)) total))) (format "%.0f" total)))) (format "%s" (buffer-size))) -(define-ibuffer-column mode (:inline t - :props - ('mouse-face 'highlight - 'keymap ibuffer-mode-name-map - 'help-echo "mouse-2: filter by this mode")) +(define-ibuffer-column mode + (:inline t + :props + ('mouse-face 'highlight + 'keymap ibuffer-mode-name-map + 'help-echo "mouse-2: filter by this mode")) (format "%s" mode-name)) (define-ibuffer-column process @@ -2198,7 +2199,7 @@ `ibuffer-restore-window-config-on-quit' is non-nil." (interactive) (if ibuffer-restore-window-config-on-quit - (progn + (progn (bury-buffer) (unless (= (count-windows) 1) (set-window-configuration ibuffer-prev-window-config)))
--- a/lisp/international/encoded-kb.el Wed Aug 04 06:04:39 2004 +0000 +++ b/lisp/international/encoded-kb.el Tue Aug 10 07:46:40 2004 +0000 @@ -28,6 +28,10 @@ ;;; Code: +;; Usually this map is empty (even if Encoded-kbd mode is on), but if +;; the keyboard coding system is iso-2022-based, it defines dummy key +;; bindings for ESC $ ..., etc. so that those bindings in +;; key-translation-map take effect. (defconst encoded-kbd-mode-map (make-sparse-keymap) "Keymap for Encoded-kbd minor mode.") @@ -73,25 +77,6 @@ (fset 'encoded-kbd-iso2022-designation-prefix encoded-kbd-iso2022-designation-map) -(defvar encoded-kbd-iso2022-non-ascii-map - (let ((map (make-keymap)) - (i 32)) - (while (< i 128) - (define-key map (char-to-string i) 'encoded-kbd-self-insert-iso2022-7bit) - (setq i (1+ i))) - (define-key map "\e" 'encoded-kbd-iso2022-esc-prefix) - (setq i 160) - (while (< i 256) - (define-key map (vector i) 'encoded-kbd-handle-8bit) - (setq i (1+ i))) - map) - "Keymap for handling non-ASCII character set in Encoded-kbd mode.") - -;; One of the symbols `sjis', `iso2022-7', `iso2022-8', `big5', or -;; `utf-8' to denote what kind of coding-system we are now handling in -;; Encoded-kbd mode. -(defvar encoded-kbd-coding nil) - ;; Keep information of designation state of ISO2022 encoding. When ;; Encoded-kbd mode is on, this is set to a vector of length 4, the ;; elements are character sets currently designated to graphic @@ -108,11 +93,14 @@ (defvar encoded-kbd-iso2022-invocations nil) (put 'encoded-kbd-iso2022-invocations 'permanent-local t) -(defun encoded-kbd-iso2022-designation () +(defsubst encoded-kbd-last-key () + (let ((keys (this-single-command-keys))) + (aref keys (1- (length keys))))) + +(defun encoded-kbd-iso2022-designation (ignore) "Do ISO2022 designation according to the current key in Encoded-kbd mode. The following key sequence may cause multilingual text insertion." - (interactive) - (let ((key-seq (this-command-keys)) + (let ((key-seq (this-single-command-keys)) (prev-g0-charset (aref encoded-kbd-iso2022-designations (aref encoded-kbd-iso2022-invocations 0))) intermediate-char final-char @@ -136,109 +124,58 @@ chars (if (< intermediate-char ?,) 94 96) final-char (aref key-seq 2) reg (mod intermediate-char 4)))) - (if (setq charset (iso-charset dimension chars final-char)) - (aset encoded-kbd-iso2022-designations reg charset) - (error "Character set of DIMENSION %s, CHARS %s, FINAL-CHAR `%c' is not supported" - dimension chars final-char)) - - (if (memq (aref encoded-kbd-iso2022-designations - (aref encoded-kbd-iso2022-invocations 0)) - '(ascii latin-jisx0201)) - ;; Graphic plane 0 (0x20..0x7f) is for ASCII. We don't have - ;; to handle characters in this range specially. - (if (not (memq prev-g0-charset '(ascii latin-jisx0201))) - ;; We must exit recursive edit now. - (throw 'exit nil)) - ;; Graphic plane 0 is for non-ASCII. - (if (memq prev-g0-charset '(ascii latin-jisx0201)) - ;; We must handle keys specially. - (let ((overriding-local-map encoded-kbd-iso2022-non-ascii-map)) - (recursive-edit)))))) + (aset encoded-kbd-iso2022-designations reg + (iso-charset dimension chars final-char))) + "") -(defun encoded-kbd-handle-8bit () - "Handle an 8-bit character entered in Encoded-kbd mode." - (interactive) - (cond ((eq encoded-kbd-coding 'iso2022-7) - (error "Can't handle the character code %d" last-command-char)) - - ((eq encoded-kbd-coding 'iso2022-8) - (cond ((= last-command-char ?\216) - (aset encoded-kbd-iso2022-invocations 2 2)) - - ((= last-command-char ?\217) - (aset encoded-kbd-iso2022-invocations 2 3)) +(defun encoded-kbd-iso2022-single-shift (ignore) + (let ((char (encoded-kbd-last-key))) + (aset encoded-kbd-iso2022-invocations 2 + (aref encoded-kbd-iso2022-designations + (if (= char ?\216) 2 3)))) + "") - ((>= last-command-char ?\240) - (encoded-kbd-self-insert-iso2022-8bit 1)) - - (t - (error "Can't handle the character code %d" - last-command-char)))) - - ((eq encoded-kbd-coding 'sjis) - (encoded-kbd-self-insert-sjis)) - - (t - (encoded-kbd-self-insert-big5)))) +(defun encoded-kbd-self-insert-iso2022-7bit (ignore) + (let ((char (encoded-kbd-last-key)) + (charset (aref encoded-kbd-iso2022-designations + (or (aref encoded-kbd-iso2022-invocations 2) + (aref encoded-kbd-iso2022-invocations 0))))) + (aset encoded-kbd-iso2022-invocations 2 nil) + (vector (if (= (charset-dimension charset) 1) + (make-char charset char) + (make-char charset char (read-char-exclusive)))))) -(defun encoded-kbd-self-insert-iso2022-7bit () - (interactive) - (let* ((charset (aref encoded-kbd-iso2022-designations - (or (aref encoded-kbd-iso2022-invocations 2) - (aref encoded-kbd-iso2022-invocations 0)))) - (char (if (= (charset-dimension charset) 1) - (make-char charset last-command-char) - (make-char charset last-command-char (read-char-exclusive))))) +(defun encoded-kbd-self-insert-iso2022-8bit (ignore) + (let ((char (encoded-kbd-last-key)) + (charset (aref encoded-kbd-iso2022-designations + (or (aref encoded-kbd-iso2022-invocations 2) + (aref encoded-kbd-iso2022-invocations 1))))) (aset encoded-kbd-iso2022-invocations 2 nil) - (setq unread-command-events (cons char unread-command-events)))) + (vector (if (= (charset-dimension charset) 1) + (make-char charset char) + (make-char charset char (read-char-exclusive)))))) -(defun encoded-kbd-self-insert-iso2022-8bit (arg) - (interactive "p") - (cond - ((= last-command-char ?\216) ; SS2 (Single Shift 2) - (aset encoded-kbd-iso2022-invocations 2 2)) - ((= last-command-char ?\217) ; SS3 (Single Shift 3) - (aset encoded-kbd-iso2022-invocations 2 3)) - (t - (let* ((charset (aref encoded-kbd-iso2022-designations - (or (aref encoded-kbd-iso2022-invocations 2) - (aref encoded-kbd-iso2022-invocations 1)))) - (char (if (= (charset-dimension charset) 1) - (make-char charset last-command-char) - (make-char charset last-command-char - (read-char-exclusive))))) - (aset encoded-kbd-iso2022-invocations 2 nil) - ;; As simply setting unread-command-events may result in - ;; infinite-loop for characters 160..255, this is a temporary - ;; workaround until we found a better solution. - (let ((last-command-char char)) - (self-insert-command arg)))))) +(defun encoded-kbd-self-insert-sjis (ignore) + (let ((char (encoded-kbd-last-key))) + (vector + (if (or (< char ?\xA0) (>= char ?\xE0)) + (decode-sjis-char (+ (ash char 8) (read-char-exclusive))) + (make-char 'katakana-jisx0201 char))))) -(defun encoded-kbd-self-insert-sjis () - (interactive) - (let ((char (if (or (< last-command-char ?\xA0) (>= last-command-char ?\xE0)) - (decode-sjis-char (+ (ash last-command-char 8) - (read-char-exclusive))) - (make-char 'katakana-jisx0201 last-command-char)))) - (setq unread-command-events (cons char unread-command-events)))) +(defun encoded-kbd-self-insert-big5 (ignore) + (let ((char (encoded-kbd-last-key))) + (vector + (decode-big5-char (+ (ash char 8) (read-char-exclusive)))))) -(defun encoded-kbd-self-insert-big5 () - (interactive) - (let ((char (decode-big5-char (+ (ash last-command-char 8) - (read-char-exclusive))))) - (setq unread-command-events (cons char unread-command-events)))) - -(defun encoded-kbd-self-insert-ccl () - (interactive) - (let ((str (char-to-string last-command-char)) +(defun encoded-kbd-self-insert-ccl (ignore) + (let ((str (char-to-string (encoded-kbd-last-key))) (ccl (coding-system-get (keyboard-coding-system) :ccl-decoder)) (vec [nil nil nil nil nil nil nil nil nil]) result) (while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0) (dotimes (i 9) (aset vec i nil)) (setq str (format "%s%c" str (read-char-exclusive)))) - (setq unread-command-events - (append result unread-command-events)))) + (vector (aref result 0)))) (defun encoded-kbd-self-insert-charset (arg) (interactive "p") @@ -276,7 +213,7 @@ (defun encoded-kbd-setup-keymap (coding) ;; At first, reset the keymap. - (setcdr encoded-kbd-mode-map nil) + (define-key encoded-kbd-mode-map "\e" nil) ;; Then setup the keymap according to the keyboard coding system. (cond ((eq encoded-kbd-coding 'charset) @@ -289,38 +226,64 @@ (vector from) 'encoded-kbd-self-insert-charset) (setq from (1+ from))))) - ((eq encoded-kbd-coding 'sjis) + ((eq (coding-system-type coding) 1) ; SJIS (let ((i 128)) (while (< i 256) - (define-key encoded-kbd-mode-map + (define-key key-translation-map (vector i) 'encoded-kbd-self-insert-sjis) - (setq i (1+ i))))) + (setq i (1+ i)))) + 8) - ((eq encoded-kbd-coding 'big5) + ((eq (coding-system-type coding) 3) ; Big5 (let ((i 161)) (while (< i 255) - (define-key encoded-kbd-mode-map + (define-key key-translation-map (vector i) 'encoded-kbd-self-insert-big5) - (setq i (1+ i))))) - - ((eq encoded-kbd-coding 'iso2022-7) - (define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix)) + (setq i (1+ i)))) + 8) - ((eq encoded-kbd-coding 'iso2022-8) - (define-key encoded-kbd-mode-map - (vector ?\216) 'encoded-kbd-self-insert-iso2022-8bit) - (define-key encoded-kbd-mode-map - (vector ?\217) 'encoded-kbd-self-insert-iso2022-8bit) - (let ((i 160)) - (while (< i 256) - (define-key encoded-kbd-mode-map - (vector i) 'encoded-kbd-self-insert-iso2022-8bit) - (setq i (1+ i))))) + ((eq (coding-system-type coding) 2) ; ISO-2022 + (let ((flags (coding-system-flags coding)) + use-designation) + (if (aref flags 8) + nil ; Don't support locking-shift. + (setq encoded-kbd-iso2022-designations (make-vector 4 nil) + encoded-kbd-iso2022-invocations (make-vector 3 nil)) + (dotimes (i 4) + (if (aref flags i) + (if (charsetp (aref flags i)) + (aset encoded-kbd-iso2022-designations + i (aref flags i)) + (setq use-designation t) + (if (charsetp (car-safe (aref flags i))) + (aset encoded-kbd-iso2022-designations + i (car (aref flags i))))))) + (aset encoded-kbd-iso2022-invocations 0 0) + (if (aref encoded-kbd-iso2022-designations 1) + (aset encoded-kbd-iso2022-invocations 1 1)) + (when use-designation + (define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix) + (define-key key-translation-map "\e" 'encoded-kbd-iso2022-esc-prefix)) + (when (or (aref flags 2) (aref flags 3)) + (define-key key-translation-map + [?\216] 'encoded-kbd-iso2022-single-shift) + (define-key key-translation-map + [?\217] 'encoded-kbd-iso2022-single-shift)) + (or (eq (aref flags 0) 'ascii) + (dotimes (i 96) + (define-key key-translation-map + (vector (+ 32 i)) 'encoded-kbd-self-insert-iso2022-7bit))) + (if (aref flags 7) + t + (dotimes (i 96) + (define-key key-translation-map + (vector (+ 160 i)) 'encoded-kbd-self-insert-iso2022-8bit)) + 8)))) - ((eq encoded-kbd-coding 'ccl) + ((eq (coding-system-type coding) 4) ; CCL-base (let ((valid-codes (or (coding-system-get coding :valid) '((128 . 255)))) - elt from to) + elt from to valid) (while valid-codes (setq elt (car valid-codes) valid-codes (cdr valid-codes)) (if (consp elt) @@ -328,9 +291,10 @@ (setq from (setq to elt))) (while (<= from to) (if (>= from 128) - (define-key encoded-kbd-mode-map + (define-key key-translation-map (vector from) 'encoded-kbd-self-insert-ccl)) - (setq from (1+ from)))))) + (setq from (1+ from)))) + 8)) ((eq encoded-kbd-coding 'utf-8) (let ((i #xC0)) @@ -340,8 +304,11 @@ (setq i (1+ i))))) (t - (error "Invalid value in encoded-kbd-coding: %s" encoded-kbd-coding)))) + nil))) +;; key-translation-map at the time Encoded-kbd mode is turned on is +;; saved here. +(defvar saved-key-translation-map nil) ;; Input mode at the time Encoded-kbd mode is turned on is saved here. (defvar saved-input-mode nil)
--- a/lisp/mail/mail-extr.el Wed Aug 04 06:04:39 2004 +0000 +++ b/lisp/mail/mail-extr.el Tue Aug 10 07:46:40 2004 +0000 @@ -1434,374 +1434,388 @@ (if all (nreverse value-list) (car value-list)) )) +(defcustom mail-extr-disable-voodoo "\\cj" + "*If it is a regexp, names matching it will never be modified. +If it is neither nil nor a string, modifying of names will never take +place. It affects how `mail-extract-address-components' works." + :type '(choice (regexp :size 0) + (const :tag "Always enabled" nil) + (const :tag "Always disabled" t)) + :group 'mail-extr) + (defun mail-extr-voodoo (mbox-beg mbox-end canonicalization-buffer) - (let ((word-count 0) - (case-fold-search nil) - mixed-case-flag lower-case-flag ;;upper-case-flag - suffix-flag last-name-comma-flag - ;;cbeg cend - initial - begin-again-flag - drop-this-word-if-trailing-flag - drop-last-word-if-trailing-flag - word-found-flag - this-word-beg last-word-beg - name-beg name-end - name-done-flag - ) - (save-excursion - (set-syntax-table mail-extr-address-text-syntax-table) + (unless (and mail-extr-disable-voodoo + (or (not (stringp mail-extr-disable-voodoo)) + (progn + (goto-char (point-min)) + (re-search-forward mail-extr-disable-voodoo nil t)))) + (let ((word-count 0) + (case-fold-search nil) + mixed-case-flag lower-case-flag ;;upper-case-flag + suffix-flag last-name-comma-flag + ;;cbeg cend + initial + begin-again-flag + drop-this-word-if-trailing-flag + drop-last-word-if-trailing-flag + word-found-flag + this-word-beg last-word-beg + name-beg name-end + name-done-flag + ) + (save-excursion + (set-syntax-table mail-extr-address-text-syntax-table) + + ;; Get rid of comments. + (goto-char (point-min)) + (while (not (eobp)) + ;; Initialize for this iteration of the loop. + (skip-chars-forward "^({[\"'`") + (let ((cbeg (point))) + (set-syntax-table mail-extr-address-text-comment-syntax-table) + (if (memq (following-char) '(?\' ?\`)) + (search-forward "'" nil 'move + (if (eq ?\' (following-char)) 2 1)) + (or (mail-extr-safe-move-sexp 1) + (goto-char (point-max)))) + (set-syntax-table mail-extr-address-text-syntax-table) + (when (eq (char-after cbeg) ?\() + ;; Delete the comment itself. + (delete-region cbeg (point)) + ;; Canonicalize whitespace where the comment was. + (skip-chars-backward " \t") + (if (looking-at "\\([ \t]+$\\|[ \t]+,\\)") + (replace-match "") + (setq cbeg (point)) + (skip-chars-forward " \t") + (if (bobp) + (delete-region (point) cbeg) + (just-one-space)))))) + + ;; This was moved above. + ;; Fix . used as space + ;; But it belongs here because it occurs not only as + ;; rypens@reks.uia.ac.be (Piet.Rypens) + ;; but also as + ;; "Piet.Rypens" <rypens@reks.uia.ac.be> + ;;(goto-char (point-min)) + ;;(while (re-search-forward mail-extr-bad-dot-pattern nil t) + ;; (replace-match "\\1 \\2" t)) - ;; Get rid of comments. - (goto-char (point-min)) - (while (not (eobp)) - ;; Initialize for this iteration of the loop. - (skip-chars-forward "^({[\"'`") - (let ((cbeg (point))) - (set-syntax-table mail-extr-address-text-comment-syntax-table) - (if (memq (following-char) '(?\' ?\`)) - (search-forward "'" nil 'move - (if (eq ?\' (following-char)) 2 1)) - (or (mail-extr-safe-move-sexp 1) - (goto-char (point-max)))) - (set-syntax-table mail-extr-address-text-syntax-table) - (when (eq (char-after cbeg) ?\() - ;; Delete the comment itself. - (delete-region cbeg (point)) - ;; Canonicalize whitespace where the comment was. - (skip-chars-backward " \t") - (if (looking-at "\\([ \t]+$\\|[ \t]+,\\)") - (replace-match "") - (setq cbeg (point)) - (skip-chars-forward " \t") - (if (bobp) - (delete-region (point) cbeg) - (just-one-space)))))) + (unless (search-forward " " nil t) + (goto-char (point-min)) + (cond ((search-forward "_" nil t) + ;; Handle the *idiotic* use of underlines as spaces. + ;; Example: fml@foo.bar.dom (First_M._Last) + (goto-char (point-min)) + (while (search-forward "_" nil t) + (replace-match " " t))) + ((search-forward "." nil t) + ;; Fix . used as space + ;; Example: danj1@cb.att.com (daniel.jacobson) + (goto-char (point-min)) + (while (re-search-forward mail-extr-bad-dot-pattern nil t) + (replace-match "\\1 \\2" t))))) + + ;; Loop over the words (and other junk) in the name. + (goto-char (point-min)) + (while (not name-done-flag) + + (when word-found-flag + ;; Last time through this loop we skipped over a word. + (setq last-word-beg this-word-beg) + (setq drop-last-word-if-trailing-flag + drop-this-word-if-trailing-flag) + (setq word-found-flag nil)) + + (when begin-again-flag + ;; Last time through the loop we found something that + ;; indicates we should pretend we are beginning again from + ;; the start. + (setq word-count 0) + (setq last-word-beg nil) + (setq drop-last-word-if-trailing-flag nil) + (setq mixed-case-flag nil) + (setq lower-case-flag nil) + ;; (setq upper-case-flag nil) + (setq begin-again-flag nil)) + + ;; Initialize for this iteration of the loop. + (mail-extr-skip-whitespace-forward) + (if (eq word-count 0) (narrow-to-region (point) (point-max))) + (setq this-word-beg (point)) + (setq drop-this-word-if-trailing-flag nil) + + ;; Decide what to do based on what we are looking at. + (cond + + ;; Delete title + ((and (eq word-count 0) + (looking-at mail-extr-full-name-prefixes)) + (goto-char (match-end 0)) + (narrow-to-region (point) (point-max))) + + ;; Stop after name suffix + ((and (>= word-count 2) + (looking-at mail-extr-full-name-suffix-pattern)) + (mail-extr-skip-whitespace-backward) + (setq suffix-flag (point)) + (if (eq ?, (following-char)) + (forward-char 1) + (insert ?,)) + ;; Enforce at least one space after comma + (or (eq ?\ (following-char)) + (insert ?\ )) + (mail-extr-skip-whitespace-forward) + (cond ((memq (following-char) '(?j ?J ?s ?S)) + (capitalize-word 1) + (if (eq (following-char) ?.) + (forward-char 1) + (insert ?.))) + (t + (upcase-word 1))) + (setq word-found-flag t) + (setq name-done-flag t)) + + ;; Handle SCA names + ((looking-at "MKA \\(.+\\)") ; "Mundanely Known As" + (goto-char (match-beginning 1)) + (narrow-to-region (point) (point-max)) + (setq begin-again-flag t)) + + ;; Check for initial last name followed by comma + ((and (eq ?, (following-char)) + (eq word-count 1)) + (forward-char 1) + (setq last-name-comma-flag t) + (or (eq ?\ (following-char)) + (insert ?\ ))) + + ;; Stop before trailing comma-separated comment + ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. + ;; *** This case is redundant??? + ;;((eq ?, (following-char)) + ;; (setq name-done-flag t)) - ;; This was moved above. - ;; Fix . used as space - ;; But it belongs here because it occurs not only as - ;; rypens@reks.uia.ac.be (Piet.Rypens) - ;; but also as - ;; "Piet.Rypens" <rypens@reks.uia.ac.be> - ;;(goto-char (point-min)) - ;;(while (re-search-forward mail-extr-bad-dot-pattern nil t) - ;; (replace-match "\\1 \\2" t)) + ;; Delete parenthesized/quoted comment/nickname + ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`)) + (setq cbeg (point)) + (set-syntax-table mail-extr-address-text-comment-syntax-table) + (cond ((memq (following-char) '(?\' ?\`)) + (or (search-forward "'" nil t + (if (eq ?\' (following-char)) 2 1)) + (delete-char 1))) + (t + (or (mail-extr-safe-move-sexp 1) + (goto-char (point-max))))) + (set-syntax-table mail-extr-address-text-syntax-table) + (setq cend (point)) + (cond + ;; Handle case of entire name being quoted + ((and (eq word-count 0) + (looking-at " *\\'") + (>= (- cend cbeg) 2)) + (narrow-to-region (1+ cbeg) (1- cend)) + (goto-char (point-min))) + (t + ;; Handle case of quoted initial + (if (and (or (= 3 (- cend cbeg)) + (and (= 4 (- cend cbeg)) + (eq ?. (char-after (+ 2 cbeg))))) + (not (looking-at " *\\'"))) + (setq initial (char-after (1+ cbeg))) + (setq initial nil)) + (delete-region cbeg cend) + (if initial + (insert initial ". "))))) + + ;; Handle *Stupid* VMS date stamps + ((looking-at mail-extr-stupid-vms-date-stamp-pattern) + (replace-match "" t)) + + ;; Handle Chinese characters. + ((looking-at mail-extr-hz-embedded-gb-encoded-chinese-pattern) + (goto-char (match-end 0)) + (setq word-found-flag t)) - (unless (search-forward " " nil t) - (goto-char (point-min)) - (cond ((search-forward "_" nil t) - ;; Handle the *idiotic* use of underlines as spaces. - ;; Example: fml@foo.bar.dom (First_M._Last) - (goto-char (point-min)) - (while (search-forward "_" nil t) - (replace-match " " t))) - ((search-forward "." nil t) - ;; Fix . used as space - ;; Example: danj1@cb.att.com (daniel.jacobson) - (goto-char (point-min)) - (while (re-search-forward mail-extr-bad-dot-pattern nil t) - (replace-match "\\1 \\2" t))))) + ;; Skip initial garbage characters. + ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. + ((and (eq word-count 0) + (looking-at mail-extr-leading-garbage)) + (goto-char (match-end 0)) + ;; *** Skip backward over these??? + ;; (skip-chars-backward "& \"") + (narrow-to-region (point) (point-max))) + + ;; Various stopping points + ((or + + ;; Stop before ALL CAPS acronyms, if preceded by mixed-case + ;; words. Example: XT-DEM. + (and (>= word-count 2) + mixed-case-flag + (looking-at mail-extr-weird-acronym-pattern) + (not (looking-at mail-extr-roman-numeral-pattern))) + + ;; Stop before trailing alternative address + (looking-at mail-extr-alternative-address-pattern) + + ;; Stop before trailing comment not introduced by comma + ;; THIS CASE MUST BE AFTER AN EARLIER CASE. + (looking-at mail-extr-trailing-comment-start-pattern) - ;; Loop over the words (and other junk) in the name. - (goto-char (point-min)) - (while (not name-done-flag) + ;; Stop before telephone numbers + (and (>= word-count 1) + (looking-at mail-extr-telephone-extension-pattern))) + (setq name-done-flag t)) + + ;; Delete ham radio call signs + ((looking-at mail-extr-ham-call-sign-pattern) + (delete-region (match-beginning 0) (match-end 0))) + + ;; Fixup initials + ((looking-at mail-extr-initial-pattern) + (or (eq (following-char) (upcase (following-char))) + (setq lower-case-flag t)) + (forward-char 1) + (if (eq ?. (following-char)) + (forward-char 1) + (insert ?.)) + (or (eq ?\ (following-char)) + (insert ?\ )) + (setq word-found-flag t)) + + ;; Handle BITNET LISTSERV list names. + ((and (eq word-count 0) + (looking-at mail-extr-listserv-list-name-pattern)) + (narrow-to-region (match-beginning 1) (match-end 1)) + (setq word-found-flag t) + (setq name-done-flag t)) - (when word-found-flag - ;; Last time through this loop we skipped over a word. - (setq last-word-beg this-word-beg) - (setq drop-last-word-if-trailing-flag - drop-this-word-if-trailing-flag) - (setq word-found-flag nil)) + ;; Handle & substitution, when & is last and is not first. + ((and (> word-count 0) + (eq ?\ (preceding-char)) + (eq (following-char) ?&) + (eq (1+ (point)) (point-max))) + (delete-char 1) + (capitalize-region + (point) + (progn + (insert-buffer-substring canonicalization-buffer + mbox-beg mbox-end) + (point))) + (setq disable-initial-guessing-flag t) + (setq word-found-flag t)) + + ;; Handle & between names, as in "Bob & Susie". + ((and (> word-count 0) (eq (following-char) ?\&)) + (setq name-beg (point)) + (setq name-end (1+ name-beg)) + (setq word-found-flag t) + (goto-char name-end)) + + ;; Regular name words + ((looking-at mail-extr-name-pattern) + (setq name-beg (point)) + (setq name-end (match-end 0)) + + ;; Certain words will be dropped if they are at the end. + (and (>= word-count 2) + (not lower-case-flag) + (or + ;; Trailing 4-or-more letter lowercase words preceded by + ;; mixed case or uppercase words will be dropped. + (looking-at "[[:lower:]]\\{4,\\}[ \t]*\\'") + ;; Drop a trailing word which is terminated with a period. + (eq ?. (char-after (1- name-end)))) + (setq drop-this-word-if-trailing-flag t)) + + ;; Set the flags that indicate whether we have seen a lowercase + ;; word, a mixed case word, and an uppercase word. + (if (re-search-forward "[[:lower:]]" name-end t) + (if (progn + (goto-char name-beg) + (re-search-forward "[[:upper:]]" name-end t)) + (setq mixed-case-flag t) + (setq lower-case-flag t)) + ;; (setq upper-case-flag t) + ) + + (goto-char name-end) + (setq word-found-flag t)) - (when begin-again-flag - ;; Last time through the loop we found something that - ;; indicates we should pretend we are beginning again from - ;; the start. - (setq word-count 0) - (setq last-word-beg nil) - (setq drop-last-word-if-trailing-flag nil) - (setq mixed-case-flag nil) - (setq lower-case-flag nil) - ;; (setq upper-case-flag nil) - (setq begin-again-flag nil)) + ;; Allow a number as a word, if it doesn't mean anything else. + ((looking-at "[0-9]+\\>") + (setq name-beg (point)) + (setq name-end (match-end 0)) + (goto-char name-end) + (setq word-found-flag t)) + + (t + (setq name-done-flag t) + )) + + ;; Count any word that we skipped over. + (if word-found-flag + (setq word-count (1+ word-count)))) + + ;; If the last thing in the name is 2 or more periods, or one or more + ;; other sentence terminators (but not a single period) then keep them + ;; and the preceding word. This is for the benefit of whole sentences + ;; in the name field: it's better behavior than dropping the last word + ;; of the sentence... + (if (and (not suffix-flag) + (looking-at "\\(\\.+\\|[?!;:.][?!;:.]+\\|[?!;:][?!;:.]*\\)\\'")) + (goto-char (setq suffix-flag (point-max)))) - ;; Initialize for this iteration of the loop. - (mail-extr-skip-whitespace-forward) - (if (eq word-count 0) (narrow-to-region (point) (point-max))) - (setq this-word-beg (point)) - (setq drop-this-word-if-trailing-flag nil) + ;; Drop everything after point and certain trailing words. + (narrow-to-region (point-min) + (or (and drop-last-word-if-trailing-flag + last-word-beg) + (point))) - ;; Decide what to do based on what we are looking at. - (cond + ;; Xerox's mailers SUCK!!!!!! + ;; We simply refuse to believe that any last name is PARC or ADOC. + ;; If it looks like that is the last name, that there is no meaningful + ;; here at all. Actually I guess it would be best to map patterns + ;; like foo.hoser@xerox.com into foo@hoser.xerox.com, but I don't + ;; actually know that that is what's going on. + (unless suffix-flag + (goto-char (point-min)) + (let ((case-fold-search t)) + (if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'") + (erase-buffer)))) - ;; Delete title - ((and (eq word-count 0) - (looking-at mail-extr-full-name-prefixes)) - (goto-char (match-end 0)) + ;; If last name first put it at end (but before suffix) + (when last-name-comma-flag + (goto-char (point-min)) + (search-forward ",") + (setq name-end (1- (point))) + (goto-char (or suffix-flag (point-max))) + (or (eq ?\ (preceding-char)) + (insert ?\ )) + (insert-buffer-substring (current-buffer) (point-min) name-end) + (goto-char name-end) + (skip-chars-forward "\t ,") (narrow-to-region (point) (point-max))) - ;; Stop after name suffix - ((and (>= word-count 2) - (looking-at mail-extr-full-name-suffix-pattern)) - (mail-extr-skip-whitespace-backward) - (setq suffix-flag (point)) - (if (eq ?, (following-char)) - (forward-char 1) - (insert ?,)) - ;; Enforce at least one space after comma - (or (eq ?\ (following-char)) - (insert ?\ )) - (mail-extr-skip-whitespace-forward) - (cond ((memq (following-char) '(?j ?J ?s ?S)) - (capitalize-word 1) - (if (eq (following-char) ?.) - (forward-char 1) - (insert ?.))) - (t - (upcase-word 1))) - (setq word-found-flag t) - (setq name-done-flag t)) - - ;; Handle SCA names - ((looking-at "MKA \\(.+\\)") ; "Mundanely Known As" - (goto-char (match-beginning 1)) - (narrow-to-region (point) (point-max)) - (setq begin-again-flag t)) - - ;; Check for initial last name followed by comma - ((and (eq ?, (following-char)) - (eq word-count 1)) - (forward-char 1) - (setq last-name-comma-flag t) - (or (eq ?\ (following-char)) - (insert ?\ ))) - - ;; Stop before trailing comma-separated comment - ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. - ;; *** This case is redundant??? - ;;((eq ?, (following-char)) - ;; (setq name-done-flag t)) - - ;; Delete parenthesized/quoted comment/nickname - ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`)) - (setq cbeg (point)) - (set-syntax-table mail-extr-address-text-comment-syntax-table) - (cond ((memq (following-char) '(?\' ?\`)) - (or (search-forward "'" nil t - (if (eq ?\' (following-char)) 2 1)) - (delete-char 1))) - (t - (or (mail-extr-safe-move-sexp 1) - (goto-char (point-max))))) - (set-syntax-table mail-extr-address-text-syntax-table) - (setq cend (point)) - (cond - ;; Handle case of entire name being quoted - ((and (eq word-count 0) - (looking-at " *\\'") - (>= (- cend cbeg) 2)) - (narrow-to-region (1+ cbeg) (1- cend)) - (goto-char (point-min))) - (t - ;; Handle case of quoted initial - (if (and (or (= 3 (- cend cbeg)) - (and (= 4 (- cend cbeg)) - (eq ?. (char-after (+ 2 cbeg))))) - (not (looking-at " *\\'"))) - (setq initial (char-after (1+ cbeg))) - (setq initial nil)) - (delete-region cbeg cend) - (if initial - (insert initial ". "))))) - - ;; Handle *Stupid* VMS date stamps - ((looking-at mail-extr-stupid-vms-date-stamp-pattern) - (replace-match "" t)) - - ;; Handle Chinese characters. - ((looking-at mail-extr-hz-embedded-gb-encoded-chinese-pattern) - (goto-char (match-end 0)) - (setq word-found-flag t)) - - ;; Skip initial garbage characters. - ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. - ((and (eq word-count 0) - (looking-at mail-extr-leading-garbage)) - (goto-char (match-end 0)) - ;; *** Skip backward over these??? - ;; (skip-chars-backward "& \"") - (narrow-to-region (point) (point-max))) - - ;; Various stopping points - ((or - - ;; Stop before ALL CAPS acronyms, if preceded by mixed-case - ;; words. Example: XT-DEM. - (and (>= word-count 2) - mixed-case-flag - (looking-at mail-extr-weird-acronym-pattern) - (not (looking-at mail-extr-roman-numeral-pattern))) - - ;; Stop before trailing alternative address - (looking-at mail-extr-alternative-address-pattern) - - ;; Stop before trailing comment not introduced by comma - ;; THIS CASE MUST BE AFTER AN EARLIER CASE. - (looking-at mail-extr-trailing-comment-start-pattern) - - ;; Stop before telephone numbers - (and (>= word-count 1) - (looking-at mail-extr-telephone-extension-pattern))) - (setq name-done-flag t)) - - ;; Delete ham radio call signs - ((looking-at mail-extr-ham-call-sign-pattern) - (delete-region (match-beginning 0) (match-end 0))) - - ;; Fixup initials - ((looking-at mail-extr-initial-pattern) - (or (eq (following-char) (upcase (following-char))) - (setq lower-case-flag t)) - (forward-char 1) - (if (eq ?. (following-char)) - (forward-char 1) - (insert ?.)) - (or (eq ?\ (following-char)) - (insert ?\ )) - (setq word-found-flag t)) + ;; Delete leading and trailing junk characters. + ;; *** This is probably completely unneeded now. + ;;(goto-char (point-max)) + ;;(skip-chars-backward mail-extr-non-end-name-chars) + ;;(if (eq ?. (following-char)) + ;; (forward-char 1)) + ;;(narrow-to-region (point) + ;; (progn + ;; (goto-char (point-min)) + ;; (skip-chars-forward mail-extr-non-begin-name-chars) + ;; (point))) - ;; Handle BITNET LISTSERV list names. - ((and (eq word-count 0) - (looking-at mail-extr-listserv-list-name-pattern)) - (narrow-to-region (match-beginning 1) (match-end 1)) - (setq word-found-flag t) - (setq name-done-flag t)) - - ;; Handle & substitution, when & is last and is not first. - ((and (> word-count 0) - (eq ?\ (preceding-char)) - (eq (following-char) ?&) - (eq (1+ (point)) (point-max))) - (delete-char 1) - (capitalize-region - (point) - (progn - (insert-buffer-substring canonicalization-buffer - mbox-beg mbox-end) - (point))) - (setq disable-initial-guessing-flag t) - (setq word-found-flag t)) - - ;; Handle & between names, as in "Bob & Susie". - ((and (> word-count 0) (eq (following-char) ?\&)) - (setq name-beg (point)) - (setq name-end (1+ name-beg)) - (setq word-found-flag t) - (goto-char name-end)) - - ;; Regular name words - ((looking-at mail-extr-name-pattern) - (setq name-beg (point)) - (setq name-end (match-end 0)) - - ;; Certain words will be dropped if they are at the end. - (and (>= word-count 2) - (not lower-case-flag) - (or - ;; Trailing 4-or-more letter lowercase words preceded by - ;; mixed case or uppercase words will be dropped. - (looking-at "[[:lower:]]\\{4,\\}[ \t]*\\'") - ;; Drop a trailing word which is terminated with a period. - (eq ?. (char-after (1- name-end)))) - (setq drop-this-word-if-trailing-flag t)) - - ;; Set the flags that indicate whether we have seen a lowercase - ;; word, a mixed case word, and an uppercase word. - (if (re-search-forward "[[:lower:]]" name-end t) - (if (progn - (goto-char name-beg) - (re-search-forward "[[:upper:]]" name-end t)) - (setq mixed-case-flag t) - (setq lower-case-flag t)) -;; (setq upper-case-flag t) - ) - - (goto-char name-end) - (setq word-found-flag t)) - - ;; Allow a number as a word, if it doesn't mean anything else. - ((looking-at "[0-9]+\\>") - (setq name-beg (point)) - (setq name-end (match-end 0)) - (goto-char name-end) - (setq word-found-flag t)) - - (t - (setq name-done-flag t) - )) - - ;; Count any word that we skipped over. - (if word-found-flag - (setq word-count (1+ word-count)))) - - ;; If the last thing in the name is 2 or more periods, or one or more - ;; other sentence terminators (but not a single period) then keep them - ;; and the preceding word. This is for the benefit of whole sentences - ;; in the name field: it's better behavior than dropping the last word - ;; of the sentence... - (if (and (not suffix-flag) - (looking-at "\\(\\.+\\|[?!;:.][?!;:.]+\\|[?!;:][?!;:.]*\\)\\'")) - (goto-char (setq suffix-flag (point-max)))) - - ;; Drop everything after point and certain trailing words. - (narrow-to-region (point-min) - (or (and drop-last-word-if-trailing-flag - last-word-beg) - (point))) - - ;; Xerox's mailers SUCK!!!!!! - ;; We simply refuse to believe that any last name is PARC or ADOC. - ;; If it looks like that is the last name, that there is no meaningful - ;; here at all. Actually I guess it would be best to map patterns - ;; like foo.hoser@xerox.com into foo@hoser.xerox.com, but I don't - ;; actually know that that is what's going on. - (unless suffix-flag + ;; Compress whitespace (goto-char (point-min)) - (let ((case-fold-search t)) - (if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'") - (erase-buffer)))) - - ;; If last name first put it at end (but before suffix) - (when last-name-comma-flag - (goto-char (point-min)) - (search-forward ",") - (setq name-end (1- (point))) - (goto-char (or suffix-flag (point-max))) - (or (eq ?\ (preceding-char)) - (insert ?\ )) - (insert-buffer-substring (current-buffer) (point-min) name-end) - (goto-char name-end) - (skip-chars-forward "\t ,") - (narrow-to-region (point) (point-max))) - - ;; Delete leading and trailing junk characters. - ;; *** This is probably completely unneeded now. - ;;(goto-char (point-max)) - ;;(skip-chars-backward mail-extr-non-end-name-chars) - ;;(if (eq ?. (following-char)) - ;; (forward-char 1)) - ;;(narrow-to-region (point) - ;; (progn - ;; (goto-char (point-min)) - ;; (skip-chars-forward mail-extr-non-begin-name-chars) - ;; (point))) - - ;; Compress whitespace - (goto-char (point-min)) - (while (re-search-forward "[ \t\n]+" nil t) - (replace-match (if (eobp) "" " ") t)) - ))) + (while (re-search-forward "[ \t\n]+" nil t) + (replace-match (if (eobp) "" " ") t)) + ))))
--- a/lisp/novice.el Wed Aug 04 06:04:39 2004 +0000 +++ b/lisp/novice.el Tue Aug 10 07:46:40 2004 +0000 @@ -1,6 +1,7 @@ ;;; novice.el --- handling of disabled commands ("novice mode") for Emacs -;; Copyright (C) 1985, 1986, 1987, 1994, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1994, 2002, 2004 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal, help @@ -36,12 +37,17 @@ ;; and the keys are returned by (this-command-keys). ;;;###autoload -(defvar disabled-command-hook 'disabled-command-hook +(defvar disabled-command-function 'disabled-command-function "Function to call to handle disabled commands. If nil, the feature is disabled, i.e., all commands work normally.") +(defvaralias 'disabled-command-hook 'disabled-command-function) +(make-obsolete-variable + 'disabled-command-hook + "use the variable `disabled-command-function' instead." "21.4") + ;;;###autoload -(defun disabled-command-hook (&rest ignore) +(defun disabled-command-function (&rest ignore) (let (char) (save-window-excursion (with-output-to-temp-buffer "*Help*" @@ -91,7 +97,7 @@ (ding) (message "Please type y, n, ! or SPC (the space bar): ")))) (if (= char ?!) - (setq disabled-command-hook nil)) + (setq disabled-command-function nil)) (if (= char ?y) (if (and user-init-file (not (string= "" user-init-file))
--- a/lisp/simple.el Wed Aug 04 06:04:39 2004 +0000 +++ b/lisp/simple.el Tue Aug 10 07:46:40 2004 +0000 @@ -4304,6 +4304,12 @@ of the differing parts is, by contrast, slightly highlighted." :group 'completion) +;; This is for packages that need to bind it to a non-default regexp +;; in order to make the first-differing character highlight work +;; to their liking +(defvar completion-root-regexp "^/" + "Regexp to use in `completion-setup-function' to find the root directory.") + (defun completion-setup-function () (let ((mainbuf (current-buffer)) (mbuf-contents (minibuffer-contents))) @@ -4332,7 +4338,7 @@ (with-current-buffer mainbuf (save-excursion (goto-char (point-max)) - (skip-chars-backward "^/") + (skip-chars-backward completion-root-regexp) (- (point) (minibuffer-prompt-end))))) ;; Otherwise, in minibuffer, the whole input is being completed. (if (minibufferp mainbuf)
--- a/lisp/subr.el Wed Aug 04 06:04:39 2004 +0000 +++ b/lisp/subr.el Tue Aug 10 07:46:40 2004 +0000 @@ -566,7 +566,7 @@ (defmacro kbd (keys) "Convert KEYS to the internal Emacs key representation. KEYS should be a string constant in the format used for -saving keyboard macros (see `insert-kbd-macro')." +saving keyboard macros (see `edmacro-mode')." (read-kbd-macro keys)) (put 'keyboard-translate-table 'char-table-extra-slots 0) @@ -2304,13 +2304,13 @@ (defun global-unset-key (key) "Remove global binding of KEY. -KEY is a string representing a sequence of keystrokes." +KEY is a string or vector representing a sequence of keystrokes." (interactive "kUnset key globally: ") (global-set-key key nil)) (defun local-unset-key (key) "Remove local binding of KEY. -KEY is a string representing a sequence of keystrokes." +KEY is a string or vector representing a sequence of keystrokes." (interactive "kUnset key locally: ") (if (current-local-map) (local-set-key key nil))
--- a/lisp/wid-edit.el Wed Aug 04 06:04:39 2004 +0000 +++ b/lisp/wid-edit.el Tue Aug 10 07:46:40 2004 +0000 @@ -3187,6 +3187,8 @@ (setq err "Empty sexp -- use `nil'?") (unless (widget-apply widget :match (read (current-buffer))) (setq err (widget-get widget :type-error)))) + ;; Allow whitespace after expression. + (skip-syntax-forward "\\s-") (if (and (not (eobp)) (not err)) (setq err (format "Junk at end of expression: %s"
--- a/lispref/ChangeLog Wed Aug 04 06:04:39 2004 +0000 +++ b/lispref/ChangeLog Tue Aug 10 07:46:40 2004 +0000 @@ -1,3 +1,48 @@ +2004-08-08 Luc Teirlinck <teirllm@auburn.edu> + + * objects.texi (Character Type): Reposition `@anchor' to prevent + double space inside sentence in Info. + + * hooks.texi (Standard Hooks): `disabled-command-hook' has been + renamed to `disabled-command-function'. + * commands.texi (Key Sequence Input): Remove unnecessary anchor, + (Command Loop Info): Replace reference to it. + (Disabling Commands): `disabled-command-hook' has been renamed to + `disabled-command-function'. + +2004-08-07 Luc Teirlinck <teirllm@auburn.edu> + + * os.texi (Translating Input): Only non-prefix bindings in + `key-translation-map' override actual key bindings. Warn about + possible indirect effect of actual key bindings on non-prefix + bindings in `key-translation-map'. + +2004-08-06 Luc Teirlinck <teirllm@auburn.edu> + + * minibuf.texi (High-Level Completion): Add anchor for definition + of `read-variable'. + + * commands.texi: Various changes in addition to: + (Using Interactive): Clarify description of `interactive-form'. + (Interactive Call): Mention default for KEYS argument to + `call-interactively'. + (Command Loop Info): Clarify description of `this-command-keys'. + Mention KEEP-RECORD argument to `clear-this-command-keys'. + Value of `last-event-frame' can be `macro'. + (Repeat Events): `double-click-fuzz' is also used to distinguish + clicks and drags. + (Classifying Events): Clarify descriptions of `event-modifiers' + `event-basic-type' and `event-convert-list'. + (Accessing Events): `posn-timestamp' takes POSITION argument. + (Quoted Character Input): Clarify description of + `read-quoted-char' and fix example. + (Quitting): Add `with-local-quit'. + (Disabling Commands): Correct and clarify descriptions of + `enable-command' and `disable-command'. + Mention what happens if `disabled-command-hook' is nil. + (Keyboard Macros): Mention LOOPFUNC arg to `execute-kbd-macro'. + Describe `executing-kbd-macro' instead of obsolete `executing-macro'. + 2004-07-24 Luc Teirlinck <teirllm@auburn.edu> * frames.texi: Various changes in addition to:
--- a/lispref/commands.texi Wed Aug 04 06:04:39 2004 +0000 +++ b/lispref/commands.texi Tue Aug 10 07:46:40 2004 +0000 @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999 +@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2004 @c Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @setfilename ../info/commands @@ -119,7 +119,7 @@ This section describes how to write the @code{interactive} form that makes a Lisp function an interactively-callable command, and how to -examine a commands's @code{interactive} form. +examine a command's @code{interactive} form. @defspec interactive arg-descriptor @cindex argument descriptors @@ -235,12 +235,13 @@ @cindex examining the @code{interactive} form @defun interactive-form function -This function returns the @code{interactive} form of @var{function}. If -@var{function} is a command (@pxref{Interactive Call}), the value is a -list of the form @code{(interactive @var{spec})}, where @var{spec} is -the descriptor specification used by the command's @code{interactive} -form to compute the function's arguments. If @var{function} is not a -command, @code{interactive-form} returns @code{nil}. +This function returns the @code{interactive} form of @var{function}. +If @var{function} is an interactively callable function +(@pxref{Interactive Call}), the value is the command's +@code{interactive} form @code{(interactive @var{spec})}, which +specifies how to compute its arguments. Otherwise, the value is +@code{nil}. If @var{function} is a symbol, its function definition is +used. @end defun @node Interactive Codes @@ -416,8 +417,9 @@ parentheses and brackets) do not do so here. Prompt. @item v -A variable declared to be a user option (i.e., satisfying the predicate -@code{user-variable-p}). @xref{High-Level Completion}. Existing, +A variable declared to be a user option (i.e., satisfying the +predicate @code{user-variable-p}). This reads the variable using +@code{read-variable}. @xref{Definition of read-variable}. Existing, Completion, Prompt. @item x @@ -528,10 +530,12 @@ @defun call-interactively command &optional record-flag keys This function calls the interactively callable function @var{command}, reading arguments according to its interactive calling specifications. -An error is signaled if @var{command} is not a function or if it cannot -be called interactively (i.e., is not a command). Note that keyboard -macros (strings and vectors) are not accepted, even though they are -considered commands, because they are not functions. +It returns whatever @var{command} returns. An error is signaled if +@var{command} is not a function or if it cannot be called +interactively (i.e., is not a command). Note that keyboard macros +(strings and vectors) are not accepted, even though they are +considered commands, because they are not functions. If @var{command} +is a symbol, then @code{call-interactively} uses its function definition. @cindex record command history If @var{record-flag} is non-@code{nil}, then this command and its @@ -541,6 +545,8 @@ The argument @var{keys}, if given, specifies the sequence of events to supply if the command inquires which events were used to invoke it. +If @var{keys} is omitted or @code{nil}, the return value of +@code{this-command-keys} is used. @xref{Definition of this-command-keys}. @end defun @defun command-execute command &optional record-flag keys special @@ -551,7 +557,8 @@ A string or vector as @var{command} is executed with @code{execute-kbd-macro}. A function is passed to -@code{call-interactively}, along with the optional @var{record-flag}. +@code{call-interactively}, along with the optional @var{record-flag} +and @var{keys}. A symbol is handled by using its function definition in its place. A symbol with an @code{autoload} definition counts as a command if it was @@ -559,9 +566,6 @@ definition is handled by loading the specified library and then rechecking the definition of the symbol. -The argument @var{keys}, if given, specifies the sequence of events to -supply if the command inquires which events were used to invoke it. - The argument @var{special}, if given, means to ignore the prefix argument and not clear it. This is used for executing special events (@pxref{Special Events}). @@ -741,10 +745,14 @@ @end defvar @defun this-command-keys +@anchor{Definition of this-command-keys} This function returns a string or vector containing the key sequence that invoked the present command, plus any previous commands that -generated the prefix argument for this command. The value is a string -if all those events were characters. @xref{Input Events}. +generated the prefix argument for this command. However, if the +command has called @code{read-key-sequence}, it returns the last read +key sequence. @xref{Key Sequence Input}. The value is a string if +all events in the sequence were characters that fit in a string. +@xref{Input Events}. @example @group @@ -762,13 +770,13 @@ @end defun @tindex clear-this-command-keys -@defun clear-this-command-keys +@defun clear-this-command-keys &optional keep-record This function empties out the table of events for -@code{this-command-keys} to return, and also empties the records that -the function @code{recent-keys} (@pxref{Recording Input}) will -subsequently return. This is useful after reading a password, to -prevent the password from echoing inadvertently as part of the next -command in certain cases. +@code{this-command-keys} to return. Unless @var{keep-record} is +non-@code{nil}, it also empties the records that the function +@code{recent-keys} (@pxref{Recording Input}) will subsequently return. +This is useful after reading a password, to prevent the password from +echoing inadvertently as part of the next command in certain cases. @end defun @defvar last-nonmenu-event @@ -809,6 +817,8 @@ generated, but if that frame has redirected input focus to another frame, the value is the frame to which the event was redirected. @xref{Input Focus}. + +If the last event came from a keyboard macro, the value is @code{macro}. @end defvar @node Adjusting Point @@ -1155,7 +1165,7 @@ @example (@var{window} @var{pos-or-area} (@var{x} . @var{y}) @var{timestamp} - @var{object} @var{text-pos} (@var{col} . @var{row}) + @var{object} @var{text-pos} (@var{col} . @var{row}) @var{image} (@var{dx} . @var{dy}) (@var{width} . @var{height})) @end example @@ -1387,22 +1397,25 @@ (not a repeat event), the value is 1. @end defun -@defvar double-click-fuzz +@defopt double-click-fuzz To generate repeat events, successive mouse button presses must be at approximately the same screen position. The value of @code{double-click-fuzz} specifies the maximum number of pixels the -mouse may be moved between two successive clicks to make a -double-click. -@end defvar - -@defvar double-click-time +mouse may be moved (horizontally or vertically) between two successive +clicks to make a double-click. + +This variable is also the threshold for motion of the mouse to count +as a drag. +@end defopt + +@defopt double-click-time To generate repeat events, the number of milliseconds between successive button presses must be less than the value of @code{double-click-time}. Setting @code{double-click-time} to @code{nil} disables multi-click detection entirely. Setting it to @code{t} removes the time limit; Emacs then detects multi-clicks by position only. -@end defvar +@end defopt @node Motion Events @subsection Motion Events @@ -1593,16 +1606,22 @@ modifiers are symbols; they include @code{shift}, @code{control}, @code{meta}, @code{alt}, @code{hyper} and @code{super}. In addition, the modifiers list of a mouse event symbol always contains one of -@code{click}, @code{drag}, and @code{down}. - -The argument @var{event} may be an entire event object, or just an event -type. +@code{click}, @code{drag}, and @code{down}. For double or triple +events, it also contains @code{double} or @code{triple}. + +The argument @var{event} may be an entire event object, or just an +event type. If @var{event} is a symbol that has never been used in an +event that has been read as input in the current Emacs session, then +@code{event-modifiers} can return @code{nil}, even when @var{event} +actually has modifiers. Here are some examples: @example (event-modifiers ?a) @result{} nil +(event-modifiers ?A) + @result{} (shift) (event-modifiers ?\C-a) @result{} (control) (event-modifiers ?\C-%) @@ -1627,7 +1646,8 @@ @defun event-basic-type event This function returns the key or mouse button that @var{event} -describes, with all modifiers removed. For example: +describes, with all modifiers removed. The @var{event} argument is as +in @code{event-modifiers}. For example: @example (event-basic-type ?a) @@ -1656,7 +1676,8 @@ @defun event-convert-list list This function converts a list of modifier names and a basic event type -to an event type which specifies all of them. For example, +to an event type which specifies all of them. The basic event type +must be the last element of the list. For example, @example (event-convert-list '(control ?a)) @@ -1788,7 +1809,7 @@ @cindex mouse event, timestamp @cindex timestamp of a mouse event -@defun posn-timestamp +@defun posn-timestamp position Return the timestamp in @var{position}. This is the time at which the event occurred, in milliseconds. @end defun @@ -2001,7 +2022,9 @@ This function reads a key sequence and returns it as a string or vector. It keeps reading events until it has accumulated a complete key sequence; that is, enough to specify a non-prefix command using the -currently active keymaps. +currently active keymaps. (Remember that a key sequence that starts +with a mouse event is read using the keymaps of the buffer in the +window that the mouse was in, not the current buffer.) If the events are all characters and all can fit in a string, then @code{read-key-sequence} returns a string (@pxref{Strings of Events}). @@ -2101,6 +2124,8 @@ The lowest level functions for command input are those that read a single event. +None of the three functions below suppresses quitting. + @defun read-event &optional prompt inherit-input-method This function reads and returns the next event of command input, waiting if necessary until an event is available. Events can come directly from @@ -2122,8 +2147,8 @@ moves the cursor temporarily to the echo area, to the end of any message displayed there. Otherwise @code{read-event} does not move the cursor. -If @code{read-event} gets an event that is defined as a help character, in -some cases @code{read-event} processes the event directly without +If @code{read-event} gets an event that is defined as a help character, +then in some cases @code{read-event} processes the event directly without returning. @xref{Help Functions}. Certain other events, called @dfn{special events}, are also processed directly within @code{read-event} (@pxref{Special Events}). @@ -2235,7 +2260,10 @@ This function is like @code{read-char}, except that if the first character read is an octal digit (0-7), it reads any number of octal digits (but stopping if a non-octal digit is found), and returns the -character represented by that numeric character code. +character represented by that numeric character code. If the +character that terminates the sequence of octal digits is @key{RET}, +it is discarded. Any other terminating character is used as input +after this function returns. Quitting is suppressed when the first character is read, so that the user can enter a @kbd{C-g}. @xref{Quitting}. @@ -2252,7 +2280,7 @@ @group ---------- Echo Area ---------- -What character-@kbd{177} +What character @kbd{1 7 7}- ---------- Echo Area ---------- @result{} 127 @@ -2370,7 +2398,8 @@ @cindex special events Special events are handled at a very low level---as soon as they are read. The @code{read-event} function processes these events itself, and -never returns them. +never returns them. Instead, it keeps waiting for the first event +that is not special and returns that one. Events that are handled in this way do not echo, they are never grouped into key sequences, and they never appear in the value of @@ -2544,6 +2573,28 @@ non-@code{nil}, then @code{quit-flag} has no special effect. @end defvar +@defmac with-local-quit forms@dots{} +This macro executes @var{forms} in sequence, but allows quitting, at +least locally, within @var{body} even if @code{inhibit-quit} was +non-@code{nil} outside this construct. It returns the value of the +last form in @var{forms}. + +If @code{inhibit-quit} is @code{nil} on entry to @code{with-local-quit}, +it only executes the @var{forms}, and setting @code{quit-flag} causes +a normal quit. However, if @code{inhibit-quit} is non-@code{nil} so +that ordinary quitting is delayed, a non-@code{nil} @code{quit-flag} +triggers a special kind of local quit. This ends the execution of +@var{forms} and exits the @code{with-local-quit} form with +@code{quit-flag} still non-@code{nil}, so that another (ordinary) quit +will happen as soon as that is allowed. If @code{quit-flag} is +already non-@code{nil} at the beginning of @var{forms}, the local quit +happens immediately and they don't execute at all. + +This macro is mainly useful in functions that can be called from +timers, @code{pre-command-hook}, @code{post-command-hook} and other +places where @code{inhibit-quit} is normally bound to @code{t}. +@end defmac + @deffn Command keyboard-quit This function signals the @code{quit} condition with @code{(signal 'quit nil)}. This is the same thing that quitting does. (See @code{signal} @@ -2844,25 +2895,28 @@ programs. @deffn Command enable-command command -Allow @var{command} to be executed without special confirmation from now -on, and (if the user confirms) alter the user's init file (@pxref{Init +Allow @var{command} (a symbol) to be executed without special +confirmation from now on, and alter the user's init file (@pxref{Init File}) so that this will apply to future sessions. @end deffn @deffn Command disable-command command Require special confirmation to execute @var{command} from now on, and -(if the user confirms) alter the user's init file so that this -will apply to future sessions. +alter the user's init file so that this will apply to future sessions. @end deffn -@defvar disabled-command-hook -When the user invokes a disabled command interactively, this normal hook -is run instead of the disabled command. The hook functions can use -@code{this-command-keys} to determine what the user typed to run the -command, and thus find the command itself. @xref{Hooks}. - -By default, @code{disabled-command-hook} contains a function that asks -the user whether to proceed. +@defvar disabled-command-function +The value of this variable should be a function. When the user +invokes a disabled command interactively, this function is called +instead of the disabled command. It can use @code{this-command-keys} +to determine what the user typed to run the command, and thus find the +command itself. + +The value may also be @code{nil}. Then all commands work normally, +even disabled ones. + +By default, the value is a function that asks the user whether to +proceed. @end defvar @node Command History @@ -2918,7 +2972,7 @@ events. Don't confuse keyboard macros with Lisp macros (@pxref{Macros}). -@defun execute-kbd-macro kbdmacro &optional count +@defun execute-kbd-macro kbdmacro &optional count loopfunc This function executes @var{kbdmacro} as a sequence of events. If @var{kbdmacro} is a string or vector, then the events in it are executed exactly as if they had been input by the user. The sequence is @@ -2935,10 +2989,14 @@ executed once. If it is 0, @var{kbdmacro} is executed over and over until it encounters an error or a failing search. +If @var{loopfunc} is non-@code{nil}, it is a function that is called, +without arguments, prior to each iteration of the macro. If +@var{loopfunc} returns @code{nil}, then this stops execution of the macro. + @xref{Reading One Event}, for an example of using @code{execute-kbd-macro}. @end defun -@defvar executing-macro +@defvar executing-kbd-macro This variable contains the string or vector that defines the keyboard macro that is currently executing. It is @code{nil} if no macro is currently executing. A command can test this variable so as to behave @@ -2947,10 +3005,11 @@ @end defvar @defvar defining-kbd-macro -This variable indicates whether a keyboard macro is being defined. A -command can test this variable so as to behave differently while a macro -is being defined. The commands @code{start-kbd-macro} and -@code{end-kbd-macro} set this variable---do not set it yourself. +This variable is non-@code{nil} if and only if a keyboard macro is +being defined. A command can test this variable so as to behave +differently while a macro is being defined. The commands +@code{start-kbd-macro} and @code{end-kbd-macro} set this variable---do +not set it yourself. The variable is always local to the current terminal and cannot be buffer-local. @xref{Multiple Displays}.
--- a/lispref/frames.texi Wed Aug 04 06:04:39 2004 +0000 +++ b/lispref/frames.texi Tue Aug 10 07:46:40 2004 +0000 @@ -563,9 +563,9 @@ menu bar line; they treat larger values as 1.) @item tool-bar-lines -The number of lines to use for the toolbar. A value of @code{nil} means -don't display a tool bar. (GTK allows at most one tool bar line; it -treats larger values as 1.) +The number of lines to use for the tool bar. A value of @code{nil} +means don't display a tool bar. (GTK allows at most one tool bar line; +it treats larger values as 1.) @item screen-gamma @cindex gamma correction
--- a/lispref/hooks.texi Wed Aug 04 06:04:39 2004 +0000 +++ b/lispref/hooks.texi Tue Aug 10 07:46:40 2004 +0000 @@ -64,7 +64,7 @@ @item diary-display-hook @item diary-hook @item dired-mode-hook -@item disabled-command-hook +@item disabled-command-function @item echo-area-clear-hook @item edit-picture-hook @item electric-buffer-menu-mode-hook
--- a/lispref/minibuf.texi Wed Aug 04 06:04:39 2004 +0000 +++ b/lispref/minibuf.texi Tue Aug 10 07:46:40 2004 +0000 @@ -1118,6 +1118,7 @@ @end defun @defun read-variable prompt &optional default +@anchor{Definition of read-variable} This function reads the name of a user variable and returns it as a symbol.
--- a/lispref/objects.texi Wed Aug 04 06:04:39 2004 +0000 +++ b/lispref/objects.texi Tue Aug 10 07:46:40 2004 +0000 @@ -411,8 +411,8 @@ @cindex hyper characters @cindex super characters @cindex alt characters - The X Window System defines three other @anchor{modifier bits} -modifier bits that can be set + The X Window System defines three other +@anchor{modifier bits}modifier bits that can be set in a character: @dfn{hyper}, @dfn{super} and @dfn{alt}. The syntaxes for these bits are @samp{\H-}, @samp{\s-} and @samp{\A-}. (Case is significant in these prefixes.) Thus, @samp{?\H-\M-\A-x} represents
--- a/lispref/os.texi Wed Aug 04 06:04:39 2004 +0000 +++ b/lispref/os.texi Tue Aug 10 07:46:40 2004 +0000 @@ -1686,12 +1686,18 @@ @code{function-key-map}. @item -@code{key-translation-map} overrides actual key bindings. For example, -if @kbd{C-x f} has a binding in @code{key-translation-map}, that -translation takes effect even though @kbd{C-x f} also has a key binding -in the global map. +Non-prefix bindings in @code{key-translation-map} override actual key +bindings. For example, if @kbd{C-x f} has a non-prefix binding in +@code{key-translation-map}, that translation takes effect even though +@kbd{C-x f} also has a key binding in the global map. @end itemize +Note however that actual key bindings can have an effect on +@code{key-translation-map}, even though they are overridden by it. +Indeed, actual key bindings override @code{function-key-map} and thus +may alter the key sequence that @code{key-translation-map} receives. +Clearly, it is better to avoid to avoid this type of situation. + The intent of @code{key-translation-map} is for users to map one character set to another, including ordinary characters normally bound to @code{self-insert-command}.
--- a/man/ChangeLog Wed Aug 04 06:04:39 2004 +0000 +++ b/man/ChangeLog Tue Aug 10 07:46:40 2004 +0000 @@ -1,3 +1,9 @@ +2004-08-05 Lars Hansen <larsh@math.ku.dk> + + * widget.texi (User Interface): Update how to separate the + editable field of an editable-field widget from other widgets. + (Programming Example): Add text after field. + 2004-07-24 Richard M. Stallman <rms@gnu.org> * text.texi (Paragraphs): Update how paragraphs are separated
--- a/man/widget.texi Wed Aug 04 06:04:39 2004 +0000 +++ b/man/widget.texi Tue Aug 10 07:46:40 2004 +0000 @@ -213,14 +213,19 @@ Editable text fields are created by the @code{editable-field} widget. -An editable field must be surrounded by static text on both sides, that -is, text that does not change in the lifetime of the widget. If the -field extends to the end of the line, the terminating line-feed character -will count as the necessary static text on that end, but you will have -to provide the static text before the field yourself. The -@code{:format} keyword is useful for generating the static text; for -instance, if you give it a value of @code{"Name: %v"}, the "Name: " part -will count as the static text. +@strong{Warning:} In an @code{editable-field} widget, the editable +field must not be adjacent to another widget---that won't work. +You must put some text in between. Either make this text part of +the @code{editable-field} widget itself, or insert it with +@code{widget-insert}. + +The @code{:format} keyword is useful for generating the necessary +text; for instance, if you give it a value of @code{"Name: %v "}, +the @samp{Name: } part will provide the necessary separating text +before the field and the trailing space will provide the +separating text after the field. If you don't include the +@code{:size} keyword, the field will extend to the end of the +line, and the terminating newline will provide separation after. The editing text fields are highlighted with the @code{widget-field-face} face, making them easy to find. @@ -345,6 +350,7 @@ (widget-insert "Here is some documentation.\n\nName: ") (widget-create 'editable-field :size 13 + :format "%v " ; Text after the field! "My Name") (widget-create 'menu-choice :tag "Choose"
--- a/src/ChangeLog Wed Aug 04 06:04:39 2004 +0000 +++ b/src/ChangeLog Tue Aug 10 07:46:40 2004 +0000 @@ -1,3 +1,36 @@ +2004-08-09 Luc Teirlinck <teirllm@auburn.edu> + + * keymap.c (Fmake_keymap, Fmap_keymap, Fwhere_is_internal): Doc fixes. + +2004-08-08 Luc Teirlinck <teirllm@auburn.edu> + + * keyboard.c: Declare Qdisabled_command_function instead of + Qdisabled_command_hook. + (Fcommand_execute): Use Qdisabled_command_function instead of + Qdisabled_command_hook. + (syms_of_keyboard): Ditto. + +2004-08-07 Luc Teirlinck <teirllm@auburn.edu> + + * keymap.c (Flocal_key_binding, Fglobal_key_binding) + (syms_of_keymap) <key-translation-map>: Doc fixes. + +2004-08-07 Stefan Monnier <monnier@iro.umontreal.ca> + + * window.c (window_list_1): YAILOM. + + * fileio.c (make_temp_name): Handle multibyte prefixes. + +2004-08-06 Luc Teirlinck <teirllm@auburn.edu> + + * keyboard.c (syms_of_keyboard) <overriding-terminal-local-map>: + Doc fix. + +2004-08-03 Kenichi Handa <handa@m17n.org> + + * coding.c (decode_coding_string): Adjust coding->consumed, and + etc. with shrinked_bytes. + 2004-08-03 Kim F. Storm <storm@cua.dk> * indent.c (compute_motion): Fix check for full width window
--- a/src/fileio.c Wed Aug 04 06:04:39 2004 +0000 +++ b/src/fileio.c Tue Aug 10 07:46:40 2004 +0000 @@ -887,7 +887,7 @@ int base64_p; { Lisp_Object val; - int len; + int len, clen; int pid; unsigned char *p, *data; char pidbuf[20]; @@ -922,8 +922,10 @@ #endif } - len = SCHARS (prefix); - val = make_uninit_string (len + 3 + pidlen); + len = SBYTES (prefix); clen = SCHARS (prefix); + val = make_uninit_multibyte_string (clen + 3 + pidlen, len + 3 + pidlen); + if (!STRING_MULTIBYTE (prefix)) + STRING_SET_UNIBYTE (val); data = SDATA (val); bcopy(SDATA (prefix), data, len); p = data + len;
--- a/src/indent.c Wed Aug 04 06:04:39 2004 +0000 +++ b/src/indent.c Tue Aug 10 07:46:40 2004 +0000 @@ -1260,10 +1260,10 @@ width -= 1; } - continuation_glyph_width = 0; + continuation_glyph_width = 1; #ifdef HAVE_WINDOW_SYSTEM - if (!FRAME_WINDOW_P (XFRAME (win->frame))) - continuation_glyph_width = 1; + if (FRAME_WINDOW_P (XFRAME (win->frame))) + continuation_glyph_width = 0; /* In the fringe. */ #endif immediate_quit = 1;
--- a/src/keyboard.c Wed Aug 04 06:04:39 2004 +0000 +++ b/src/keyboard.c Tue Aug 10 07:46:40 2004 +0000 @@ -131,8 +131,8 @@ #endif /* Non-nil disable property on a command means - do not execute it; call disabled-command-hook's value instead. */ -Lisp_Object Qdisabled, Qdisabled_command_hook; + do not execute it; call disabled-command-function's value instead. */ +Lisp_Object Qdisabled, Qdisabled_command_function; #define NUM_RECENT_KEYS (100) int recent_keys_index; /* Index for storing next element into recent_keys */ @@ -9663,9 +9663,9 @@ tem = Fget (cmd, Qdisabled); if (!NILP (tem) && !NILP (Vrun_hooks)) { - tem = Fsymbol_value (Qdisabled_command_hook); + tem = Fsymbol_value (Qdisabled_command_function); if (!NILP (tem)) - return call1 (Vrun_hooks, Qdisabled_command_hook); + return call1 (Vrun_hooks, Qdisabled_command_function); } } @@ -10780,8 +10780,8 @@ Qtimer_event_handler = intern ("timer-event-handler"); staticpro (&Qtimer_event_handler); - Qdisabled_command_hook = intern ("disabled-command-hook"); - staticpro (&Qdisabled_command_hook); + Qdisabled_command_function = intern ("disabled-command-function"); + staticpro (&Qdisabled_command_function); Qself_insert_command = intern ("self-insert-command"); staticpro (&Qself_insert_command); @@ -11278,6 +11278,7 @@ doc: /* Per-terminal keymap that overrides all other local keymaps. If this variable is non-nil, it is used as a keymap instead of the buffer's local map, and the minor mode keymaps and text property keymaps. +It also overrides `overriding-local-map'. This variable is intended to let commands such as `universal-argument' set up a different keymap for reading the next command. */);
--- a/src/keymap.c Wed Aug 04 06:04:39 2004 +0000 +++ b/src/keymap.c Tue Aug 10 07:46:40 2004 +0000 @@ -131,10 +131,11 @@ DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0, doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST). -CHARTABLE is a char-table that holds the bindings for the ASCII -characters. ALIST is an assoc-list which holds bindings for function keys, -mouse events, and any other things that appear in the input stream. -All entries in it are initially nil, meaning "command undefined". +CHARTABLE is a char-table that holds the bindings for all characters +without modifiers. All entries in it are initially nil, meaning +"command undefined". ALIST is an assoc-list which holds bindings for +function keys, mouse events, and any other things that appear in the +input stream. Initially, ALIST is nil. The optional arg STRING supplies a menu name for the keymap in case you use it as a menu with `x-popup-menu'. */) @@ -703,7 +704,10 @@ DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 2, 0, doc: /* Call FUNCTION for every binding in KEYMAP. -FUNCTION is called with two arguments: the event and its binding. */) +FUNCTION is called with two arguments: the event and its binding. +If KEYMAP has a parent, the parent's bindings are included as well. +This works recursively: if the parent has itself a parent, then the +grandparent's bindings are also included and so on. */) (function, keymap) Lisp_Object function, keymap; { @@ -1635,7 +1639,7 @@ DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0, doc: /* Return the binding for command KEYS in current local keymap only. -KEYS is a string, a sequence of keystrokes. +KEYS is a string or vector, a sequence of keystrokes. The binding is probably a symbol with a function definition. If optional argument ACCEPT-DEFAULT is non-nil, recognize default @@ -1654,7 +1658,7 @@ DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0, doc: /* Return the binding for command KEYS in current global keymap only. -KEYS is a string, a sequence of keystrokes. +KEYS is a string or vector, a sequence of keystrokes. The binding is probably a symbol with a function definition. This function's return values are the same as those of `lookup-key' \(which see). @@ -2561,7 +2565,7 @@ DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0, doc: /* Return list of keys that invoke DEFINITION. -If KEYMAP is non-nil, search only KEYMAP and the global keymap. +If KEYMAP is a keymap, search only KEYMAP and the global keymap. If KEYMAP is nil, search all the currently active keymaps. If KEYMAP is a list of keymaps, search only those keymaps. @@ -2569,8 +2573,8 @@ rather than a list of all possible key sequences. If FIRSTONLY is the symbol `non-ascii', return the first binding found, no matter what it is. -If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters, -and entirely reject menu bindings. +If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters +\(or their meta variants) and entirely reject menu bindings. If optional 4th arg NOINDIRECT is non-nil, don't follow indirections to other keymaps or slots. This makes it possible to search for an @@ -3593,7 +3597,7 @@ DEFVAR_LISP ("key-translation-map", &Vkey_translation_map, doc: /* Keymap of key translations that can override keymaps. This keymap works like `function-key-map', but comes after that, -and applies even for keys that have ordinary bindings. */); +and its non-prefix bindings override ordinary bindings. */); Vkey_translation_map = Qnil; staticpro (&Vmouse_events);
--- a/src/window.c Wed Aug 04 06:04:39 2004 +0000 +++ b/src/window.c Tue Aug 10 07:46:40 2004 +0000 @@ -1828,7 +1828,7 @@ rest = Fmemq (window, list); if (!NILP (rest) && !EQ (rest, list)) { - for (tail = list; XCDR (tail) != rest; tail = XCDR (tail)) + for (tail = list; !EQ (XCDR (tail), rest); tail = XCDR (tail)) ; XSETCDR (tail, Qnil); list = nconc2 (rest, list);