diff options
| author | Karoly Lorentey <lorentey@elte.hu> | 2006-07-29 09:59:12 +0000 |
|---|---|---|
| committer | Karoly Lorentey <lorentey@elte.hu> | 2006-07-29 09:59:12 +0000 |
| commit | 251bc578cc636223d618d06cf2a2bb7d07db9cce (patch) | |
| tree | 58e1c6b0a35bb4a77e6cb77876e4bc6a9d3f2ab2 /lisp | |
| parent | 99715bbc447eb633e45ffa23b87284771ce3ac74 (diff) | |
| parent | 0ed0527cb02180a50f6744086ce3a487740c73e4 (diff) | |
| download | emacs-251bc578cc636223d618d06cf2a2bb7d07db9cce.tar.gz | |
Merged from emacs@sv.gnu.org
Patches applied:
* emacs@sv.gnu.org/emacs--devo--0--patch-351
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-352
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-353
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-354
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-355
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-356
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-357
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-358
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-359
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-360
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-361
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-362
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-363
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-364
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-365
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-366
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-367
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-368
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-369
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-370
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-115
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-116
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-117
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-118
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-119
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-120
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-573
Diffstat (limited to 'lisp')
58 files changed, 1852 insertions, 903 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 54e81f850e7..30aee0030ba 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,393 @@ +2006-07-28 Nick Roberts <nickrob@snap.net.nz> + + * Makefile.in (recompile): Update comment to reflect change + on 2004-04-21. + +2006-07-27 Richard Stallman <rms@gnu.org> + + * cus-edit.el (customize-package-emacs-version-alist): Doc fix. + (customize-package-emacs-version): Change msg when pkg has no entry. + (custom-no-edit): On a button, do like widget-button-press. + +2006-07-27 Dan Nicolaescu <dann@ics.uci.edu> + + * term/xterm.el (terminal-init-xterm): Fix bindings for C-tab, + S-tab and C-S-tab. + +2006-07-28 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/which-func.el (which-function): Fix documentation/ + comment typo. + +2006-07-26 Richard Stallman <rms@gnu.org> + + * textmodes/ispell.el (ispell-word): If we replace the word, + move point to the end. Insert before deleting. + +2006-07-26 Chong Yidong <cyd@stupidchicken.com> + + * subr.el (sit-for): Use new SECONDS arg of read-event instead of + a timer. + +2006-07-26 Mathias Dahl <mathias.dahl@gmail.com> + + * tumme.el (tumme-backward-image): Add prefix argument. Add error + when at first image. + (tumme-forward-image): Add prefix argument. Add error when at last + image. + +2006-07-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * tabify.el (tabify-regexp): Use more specific regexps. + (tabify): Avoid modifying the buffer unnecessarily. + +2006-07-25 Mathias Dahl <mathias.dahl@gmail.com> + + * tumme.el (tumme-track-original-file): Add `buffer-live-p' check. + (tumme-format-properties-string): Handle empty `buf'. + (tumme-get-comment): Change variable names inside `let'. Add + missing `let' variable that cause font-lock problems. + (tumme-write-comments): Change variable names inside `let'. Add + missing `let' variable that cause font-lock problems. + (tumme-forward-image): Rename from `tumme-forward-char'. + (tumme-backward-image): Rename from `tumme-backward-char'. + +2006-07-25 Masatake YAMATO <jet@gyve.org> + + * progmodes/ld-script.el (ld-script-keywords) + (ld-script-font-lock-keywords, ld-script-builtins): Update keywords + and add comments. + +2006-07-25 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-set-gud-minor-mode-existing-buffers) + (gdb-resync, gdb-prompt, gdb-starting, gdb-exited, gdb-stopped) + (gdb-set-gud-minor-mode-existing-buffers-1): Use different faces + for status indicator. + +2006-07-24 Richard Stallman <rms@gnu.org> + + * xml.el (xml-parse-file): Clean up, and use with-temp-buffer. + + * subr.el (dolist, dotimes): Use interned symbols for locals. + (--dotimes-limit--, --dolist-tail--): New defvars. + (looking-back): Doc fix. + + * replace.el (replace-match-string-symbols): Handle dotted lists. + +2006-07-24 mathias <mathias@mattis> + + * tumme.el (tumme-write-tags): Add. + (tumme-write-comments): Add. + (tumme-tag-files): Change to use `tumme-write-tags'. + (tumme-tag-thumbnail): Change to use `tumme-write-tags'. + (tumme-dired-comment-files): Change to use `tumme-write-comments'. + (tumme-save-information-from-widgets): Change to use + `tumme-write-comments' and `tumme-write-tags'. + (tumme-comment-thumbnail): Change to use `tumme-write-comments'. + (tumme-write-tag): Remove. + (tumme-write-comment): Remove. + (tumme-display-previous-thumbnail-original): Remove empty line. + (tumme-widget-list): Add punctuation. + +2006-07-24 mathias <mathias.dahl@gmail.com> + + * tumme.el (tumme-line-up): Add an extra check for end of buffer. + +2006-07-24 Daiki Ueno <ueno@unixuser.org> + + * pgg-def.el (pgg-truncate-key-identifier): Truncate the key ID to 8 + letters from the end. Thanks to "David Smith" <davidsmith@acm.org> and + andreas@altroot.de (Andreas V,Av(Bgele) + +2006-07-23 Thien-Thi Nguyen <ttn@gnu.org> + + * mouse.el (mouse-on-link-p): Doc fix. + +2006-07-23 Nick Roberts <nickrob@snap.net.nz> + + * emacs-lisp/find-func.el (find-function-search-for-symbol): + Handle "C-h f `". + +2006-07-22 Dan Nicolaescu <dann@ics.uci.edu> + + * ibuffer.el (ibuffer-formats): Use left alignment for the mode + column. + +2006-07-22 Matt Hodges <MPHodges@member.fsf.org> + + * textmodes/table.el: Add move-beginning-of-line and + move-end-of-line to Point Motion Only Group. + +2006-07-22 Eric Hanchrow <offby1@blarg.net> + + * progmodes/delphi.el (delphi-fill-comment): Use save-restriction. + +2006-07-22 Micha,Ak(Bl Cadilhac <michael.cadilhac@lrde.org> + + * startup.el (user-mail-address): Initialize from the `EMAIL' + environment variable first. Document this. + (command-line): Ditto. + +2006-07-22 Nick Roberts <nickrob@snap.net.nz> + + * help-mode.el (help-function-def, help-variable-def) + (help-face-def): Print a message in the minibuffer. + +2006-07-21 Dan Nicolaescu <dann@ics.uci.edu> + + * term/xterm.el (terminal-init-xterm): Fix key bindings + syntax. Bind S-return, C-M-., C-TAB, S-TAB and C-S-TAB. + +2006-07-21 Eli Zaretskii <eliz@gnu.org> + + * dos-w32.el (find-buffer-file-type-coding-system): Support calls + where `(nth 1 command)' is a cons cell. Doc fix. + + * textmodes/po.el (po-find-charset): Doc fix. + +2006-07-21 Ken Manheimer <ken.manheimer@gmail.com> + + * allout.el (allout-unprotected, allout-e-o-prefix-p) + (allout-beginning-of-current-line, allout-end-of-current-line) + (allout-next-visible-heading, allout-open-topic) + (allout-kill-topic, allout-yank-processing, allout-resolve-xref) + (allout-flag-current-subtree, allout-show-to-offshoot) + (allout-hide-current-entry, allout-show-current-branches) + (allout-hide-region-body, allout-old-expose-topic) + (allout-listify-exposed, allout-latex-verbatim-quote-curr-line) + (allout-mark-topic, allout-adjust-file-variable): Enclose scopes + containing `beginning-of-line' and `end-of-line' with + `inhibit-field-text-motion' t. + +2006-07-21 Eli Zaretskii <eliz@gnu.org> + + * frame.el (focus-follows-mouse): Document that it doesn't have + any effect on MS-Windows. + +2006-07-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/sh-script.el (sh-quoted-subshell): Further fix last change. + +2006-07-20 Jay Belanger <belanger@truman.edu> + + * calc.el (calc-previous-alg-entry): Remove variable. + + * calc-aent.el (calc-alg-entry-history, calc-quick-calc-history): + New variables. + (calc-alg-entry): Use `calc-alg-entry-history'. + (calc-do-quick-calc): Use `calc-quick-calc-history'. + Remove reference to `calc-previous-alg-entry'. + (calcAlg-edit, calcAlg-enter): Remove reference to + `calc-previous-alg-entry'. + (calcAlg-previous): Use `previous-history-element' instead of + `calc-previous-alg-entry'. + (calc-do-alg-entry): Use history when calling `read-from-minibuffer'. + Change keybinding for `calcAlg-plus-minus', add keybindings for + `previous-history-element' and `next-history-element'. + + * calc-rewr.el (calc-match): Remove reference to + `calc-previous-alg-entry'. + + * calc-sel.el (calc-selection-history): New variable. + (calc-enter-selection, calc-sel-mult-both-sides) + (calc-sel-add-both-sides): Use `calc-selection-history'. + + * calc-map.el (calc-get-operator-history): New variable. + (calc-get-operator): Use `calc-get-operator-history'. + + * calcalg3.el (calc-curve-fit-history): New variable. + (calc-curve-fit): Use `calc-curve-fit-history'. + +2006-07-20 Kenichi Handa <handa@m17n.org> + + * international/mule-cmds.el (select-safe-coding-system): Fix the + way of deciding eol-type of the coding system. + +2006-07-20 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-langs.el (c-emacs-variable-inits): New variable. + (c-lang-setvar): New macro. + (c-make-init-lang-vars-fun): Use the initialization forms in + c-emacs-variable-inits in addition to those in c-lang-variable-inits. + (comment-start, comment-end, comment-start-skip): Change these from + c-lang-defvar's to c-lang-setvar's. + + * progmodes/cc-mode.el (c-make-emacs-variables-local): New macro, + which calls make-local-variable on the elements of + c-emacs-variable-inits. + (c-init-language-vars-for): Call this new macro. + +2006-07-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/compile.el (compilation-error-regexp-alist-alist) <gnu>: + Try to rule out false positives due to time stamps. + (compilation-mode-font-lock-keywords): Remove rules made redundant + because of the above change. Add `segmentation fault' to the known and + highlighted compilation termination messages. + +2006-07-19 Kim F. Storm <storm@cua.dk> + + * progmodes/grep.el (grep-find-ignored-directories): + Add .svn and _darcs to list. + +2006-07-19 Mathias Dahl <mathias.dahl@gmail.com> + + * dired.el (dired-mode-map): Add key binding `C-te' for + `tumme-dired-edit-comment-and-tags'. + + * tumme.el (tumme-display-thumbnail-original-image): Make sure + image display buffer is displayed before call to + `tumme-display-image. + (tumme-dired-display-image): Make sure image display buffer is + displayed before call to `tumme-display-image. + (tumme-mouse-display-image): Make sure image display buffer is + displayed before call to `tumme-display-image. + (tumme-widget-list): Add. + (tumme-dired-edit-comment-and-tags): Add. + (tumme-save-information-from-widgets): Add. + +2006-07-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/sh-script.el (sh-quoted-subshell): Fix last change. + +2006-07-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/sh-script.el (sh-font-lock-keywords-1): + Revert inadvertently installed patch hunk. + + * progmodes/compile.el (compilation-find-file): Handle the + cases where the user selects a non-existent file. + +2006-07-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * bindings.el (minibuffer-local-map): Rebind TAB so it inserts a \t. + +2006-07-17 Chong Yidong <cyd@stupidchicken.com> + + * subr.el (sit-for): Just sleep-for if noninteractive. + +2006-07-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/autoload.el (make-autoload): Use new arg. + + * custom.el (custom-autoload): Add `noset' argument. + (custom-push-theme): Don't autoload the variable, let callers do it. + (custom-theme-set-variables): Autoload the variable if necessary. + + * cus-edit.el (custom-variable-state-set): If the variable was + originally set outside custom, but to the same value as the default, + consider it to be standard. + + * Makefile.in (mh-loaddefs.el): Finish setting up the default empty + file *before* telling Emacs to add the autoloads, in case it fails. + + * progmodes/sh-script.el (sh-quoted-subshell): Don't match escaped `. + Use `cond', push', and `dolist'. + +2006-07-17 Richard Stallman <rms@gnu.org> + + * image-mode.el (tar-superior-buffer, archive-superior-buffer): + Add defvars to silence warnings. + +2006-07-17 Chong Yidong <cyd@stupidchicken.com> + + * progmodes/compile.el (compilation-mode-font-lock-keywords): + Don't highlight "Compiling file" messages as error. + + * dired-aux.el (dired-compress-file): Confirm again if gzipped + file already exists. + +2006-07-16 Thien-Thi Nguyen <ttn@gnu.org> + + * find-file.el (ff-special-constructs): Doc fix. Also, for C/C++ + entry, don't assign to free var; simply return the extracted filename. + (ff-treat-as-special): Incorporate common preamble from callers. + (ff-other-file-name, ff-find-the-other-file): + Update call to ff-treat-as-special. + + * progmodes/ada-mode.el (ada-mode): Rewrite ff-special-constructs init. + +2006-07-16 Mathias Dahl <mathias.dahl@gmail.com> + + * tumme.el (tumme-get-comment): Fix bug. + +2006-07-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el: Remove spurious * in docstrings. + +2006-07-14 Ken Manheimer <ken.manheimer@gmail.com> + + * allout.el (allout-run-unit-tests-on-load): Rectify docstring + grammar. + (allout-beginning-of-current-line): Beware beginning of buffer. + Also, a comment is simplified. + (allout-hotspot-key-handler): Only set allout-post-goto-bullet + when appropriate. (This fix enables use for other than + bullet-hotspot operation.) + (allout-hide-current-subtree): While escalating to sibling-close, + make sure to situate on a topic. + +2006-07-14 Kim F. Storm <storm@cua.dk> + + * emulation/cua-base.el (cua-delete-selection) + (cua-toggle-set-mark): New defcustoms. + (cua-rectangle-modifier-key): Add `alt' modifier. + (cua-replace-region): Don't delete if cua-delete-selection is nil. + (cua-set-mark): Don't clear mark if cua-toggle-set-mark is nil. + Suggested by Klaus Zeitler <kzeitler@lucent.com>. + + * emulation/cua-rect.el (cua-help-for-rectangle): Add `alt' modifier. + +2006-07-14 Ken Manheimer <ken.manheimer@gmail.com> + + * allout.el: Require 'cl during byte-compilation/interactive load, + for the `assert' macro. + (allout-mode-deactivate-hook): New hook, run when allout mode + deactivates. + (allout-developer): New allout customization subgroup. + (allout-run-unit-tests-on-load): New allout-developer + customization variable, when true allout unit tests are run towards + end of file load/eval. + (allout-inhibit-auto-fill): Disable auto-fill activity even during + auto-fill-mode. + (allout-resumptions): Remove, to be replaced by... + (allout-add-resumptions): Register variable settings to be + reinstated by `allout-do-resumptions'. The settings are made + buffer-local, but the locality/globality of the suspended setting + is restored on resumption. + (allout-do-resumptions): Reinstate all settings suspended using + `allout-add-resumptions'. + (allout-test-resumptions): Unit tests (and intermediate variables) + for resumptions. + (allout-tests-globally-unbound, allout-tests-globally-true) + (allout-tests-locally-true): Intermediate variables for + resumptions unit tests. + (allout-overlay-preparations): Replaces `allout-set-overlay-category'. + (allout-exposure-category): Replaces 'allout-overlay-category variable. + (allout-mode): Use `allout-add-resumptions' and `allout-do-resumptions' + instead of retired `allout-resumptions'. For hook functions, use + `local' parameter so hook settings are created and removed as + buffer-local settings. Revise (resumptions) setting + auto-fill-function so it is set only if already active. (The + related fill-function settings are all made in either case, so + that activating auto-fill-mode activity will have the custom + allout-mode behaviors (hanging indent on topics, if configured for it). + Remove all allout-exposure-category overlays on mode deactivation. + (allout-hotspot-key-handler): New function extracted from + `allout-pre-command-business', so the functionality can be used + for other purposes, eg as a binding in an overlay. + (allout-pre-command-business): Use new `allout-hotspot-key-handler'. + (allout-auto-fill): Respect new `allout-inhibit-auto-fill' + customization variable. + (allout-run-unit-tests): Run the (currently quite small) + repertoire of unit tests. Called just before the provide iff user + has customized `allout-run-unit-tests-on-load' non-nil. + +2006-07-14 K,Aa(Broly L,Bu(Brentey <lorentey@elte.hu> + + * emacs-lisp/authors.el (authors-aliases): Update. + 2006-07-14 Nick Roberts <nickrob@snap.net.nz> * progmodes/gdb-ui.el (gdb-display-buffer): Check for @@ -6,7 +396,7 @@ (gdb-display-breakpoints-buffer, gdb-display-stack-buffer) (gdb-display-threads-buffer, gdb-display-memory-buffer) (gdb-display-locals-buffer): Use it. - + * progmodes/gud.el (gud-display-line): Use gdb-display-buffer. Set gdb-source-window. @@ -51,10 +441,9 @@ 2006-07-12 Nick Roberts <nickrob@snap.net.nz> - * tumme.el (tumme-create-thumb) - (tumme-thumbnail-display-external, tumme-display-image) - (tumme-rotate-thumbnail, tumme-rotate-original) - (tumme-set-exif-data, tumme-get-exif-data): Use shell-command-switch. + * tumme.el (tumme-create-thumb, tumme-thumbnail-display-external) + (tumme-display-image, tumme-rotate-thumbnail, tumme-rotate-original) + (tumme-set-exif-data, tumme-get-exif-data): Use shell-command-switch. * thumbs.el (thumbs-call-convert): Use shell-command-switch. @@ -90,20 +479,16 @@ 2006-07-11 Nick Roberts <nickrob@snap.net.nz> - * tumme.el (tumme-create-thumb) - (tumme-thumbnail-display-external, tumme-display-image) - (tumme-rotate-thumbnail, tumme-rotate-original) + * tumme.el (tumme-create-thumb, tumme-thumbnail-display-external) + (tumme-display-image, tumme-rotate-thumbnail, tumme-rotate-original) (tumme-set-exif-data, tumme-get-exif-data): Use call-process instead of shell-command. - (tumme-create-thumbnail-buffer) - (tumme-create-display-image-buffer, tumme-display-thumbs) - (tumme-modify-mark-on-thumb-original-file, tumme-display-image) - (tumme-get-exif-data): Use with-current-buffer. - (tumme-display-properties-format) - (tumme-dired-insert-marked-thumbs, tumme-rotate-original) - (tumme-get-exif-file-name) - (tumme-thumbnail-set-image-description, tumme-gallery-generate): - Fit to 80 columns. + (tumme-create-thumbnail-buffer, tumme-create-display-image-buffer) + (tumme-display-thumbs, tumme-modify-mark-on-thumb-original-file) + (tumme-display-image, tumme-get-exif-data): Use with-current-buffer. + (tumme-display-properties-format, tumme-dired-insert-marked-thumbs) + (tumme-thumbnail-set-image-description, tumme-gallery-generate) + (tumme-rotate-original, tumme-get-exif-file-name): Fit to 80 columns. 2006-07-11 Kim F. Storm <storm@cua.dk> @@ -414,8 +799,8 @@ 2006-06-25 Michael Albinus <michael.albinus@gmx.de> * net/rcompile.el (remote-compile): Replace ange-ftp based - implementation by Tramp functions. Based on a patch published by - Marc Abramowitz <msabramo@gmail.com>. + implementation by Tramp functions. + Suggested by Marc Abramowitz <msabramo@gmail.com>. * net/tramp.el (tramp-unload-tramp): Provide a doc string. @@ -2090,8 +2475,6 @@ to `ispell-local-dictionary'. (ispell-internal-change-dictionary): Check for a change in personal dictionary use too. - Cosmetic changes from Agustin Martin - <agustin.martin@hispalinux.es>. 2006-05-05 Eli Zaretskii <eliz@gnu.org> diff --git a/lisp/Makefile.in b/lisp/Makefile.in index e90c6161f75..f6caedcccda 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -204,9 +204,8 @@ backup-compiled-files: compile-after-backup: backup-compiled-files compile-always -# Recompile all Lisp files which are newer than their .elc files. -# Note that this doesn't create .elc files. It only recompiles if an -# .elc is present. +# Recompile all Lisp files which are newer than their .elc files and compile +# new ones. recompile: doit mh-autoloads $(lisp)/progmodes/cc-mode.elc $(EMACS) $(EMACSOPT) --eval "(batch-byte-recompile-directory 0)" $(lisp) @@ -247,12 +246,6 @@ $(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC) echo ";;; Commentary:" >> $@ echo ";;; Change Log:" >> $@ echo ";;; Code:" >> $@ - $(EMACS) $(EMACSOPT) \ - -l autoload \ - --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \ - --eval "(setq generated-autoload-file \"$(lisp)/mh-e/mh-loaddefs.el\")" \ - --eval "(setq make-backup-files nil)" \ - -f batch-update-autoloads $(lisp)/mh-e echo " " >> $@ echo "(provide 'mh-loaddefs)" >> $@ echo ";; Local Variables:" >> $@ @@ -261,6 +254,12 @@ $(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC) echo ";; no-update-autoloads: t" >> $@ echo ";; End:" >> $@ echo ";;; mh-loaddefs.el ends here" >> $@ + $(EMACS) $(EMACSOPT) \ + -l autoload \ + --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \ + --eval "(setq generated-autoload-file \"$(lisp)/mh-e/mh-loaddefs.el\")" \ + --eval "(setq make-backup-files nil)" \ + -f batch-update-autoloads $(lisp)/mh-e # Prepare a bootstrap in the lisp subdirectory. # diff --git a/lisp/allout.el b/lisp/allout.el index 2fbef5b2cd8..f1f262c70b7 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -8,6 +8,7 @@ ;; Created: Dec 1991 - first release to usenet ;; Version: 2.2.1 ;; Keywords: outlines wp languages +;; Website: http://myriadicity.net/Sundry/EmacsAllout ;; This file is part of GNU Emacs. @@ -58,7 +59,9 @@ ;; and more. ;; ;; See the `allout-mode' function's docstring for an introduction to the -;; mode. The development version and helpful notes are available at +;; mode. +;; +;; The latest development version and helpful notes are available at ;; http://myriadicity.net/Sundry/EmacsAllout . ;; ;; The outline menubar additions provide quick reference to many of @@ -80,10 +83,19 @@ ;;;_* Dependency autoloads (require 'overlay) -(eval-when-compile (progn (require 'pgg) - (require 'pgg-gpg) - (require 'overlay) - )) +(eval-when-compile + ;; Most of the requires here are for stuff covered by autoloads. + ;; Since just byte-compiling doesn't trigger autoloads, so that + ;; "function not found" warnings would occur without these requires. + (progn + (require 'pgg) + (require 'pgg-gpg) + (require 'overlay) + ;; `cl' is required for `assert'. `assert' is not covered by a standard + ;; autoload, but it is a macro, so that eval-when-compile is sufficient + ;; to byte-compile it in, or to do the require when the buffer evalled. + (require 'cl) + )) ;;;_* USER CUSTOMIZATION VARIABLES: @@ -556,6 +568,25 @@ disable auto-saves for that file." :group 'allout-encryption) (make-variable-buffer-local 'allout-encrypt-unencrypted-on-saves) +;;;_ + Developer +;;;_ = allout-developer group +(defgroup allout-developer nil + "Settings for topic encryption features of allout outliner." + :group 'allout) +;;;_ = allout-run-unit-tests-on-load +(defcustom allout-run-unit-tests-on-load nil + "*When non-nil, unit tests will be run at end of loading the allout module. + +Generally, allout code developers are the only ones who'll want to set this. + +\(If set, this makes it an even better practice to exercise changes by +doing byte-compilation with a repeat count, so the file is loaded after +compilation.) + +See `allout-run-unit-tests' to see what's run." + :type 'boolean + :group 'allout-developer) + ;;;_ + Miscellaneous customization ;;;_ = allout-command-prefix @@ -615,6 +646,23 @@ unless optional third, non-nil element is present.") ("=t" allout-latexify-exposed) ("=p" allout-flatten-exposed-to-buffer))) +;;;_ = allout-inhibit-auto-fill +(defcustom allout-inhibit-auto-fill nil + "*If non-nil, auto-fill will be inhibited in the allout buffers. + +You can customize this setting to set it for all allout buffers, or set it +in individual buffers if you want to inhibit auto-fill only in particular +buffers. \(You could use a function on `allout-mode-hook' to inhibit +auto-fill according, eg, to the major mode.\) + +If you don't set this and auto-fill-mode is enabled, allout will use the +value that `normal-auto-fill-function', if any, when allout mode starts, or +else allout's special hanging-indent maintaining auto-fill function, +`allout-auto-fill'." + :type 'boolean + :group 'allout) +(make-variable-buffer-local 'allout-inhibit-auto-fill) + ;;;_ = allout-use-hanging-indents (defcustom allout-use-hanging-indents t "*If non-nil, topic body text auto-indent defaults to indent of the header. @@ -993,81 +1041,84 @@ activation. Being deprecated.") "----" ["Set Header Lead" allout-reset-header-lead t] ["Set New Exposure" allout-expose-topic t]))) -;;;_ : Mode-Specific Variable Maintenance Utilities +;;;_ : Allout Modal-Variables Utilities ;;;_ = allout-mode-prior-settings (defvar allout-mode-prior-settings nil - "Internal `allout-mode' use; settings to be resumed on mode deactivation.") -(make-variable-buffer-local 'allout-mode-prior-settings) -;;;_ > allout-resumptions (name &optional value) -(defun allout-resumptions (name &optional value) - - "Registers or resumes settings over `allout-mode' activation/deactivation. - -First arg is NAME of variable affected. Optional second arg is list -containing allout-mode-specific VALUE to be imposed on named -variable, and to be registered. \(It's a list so you can specify -registrations of null values.) If no value is specified, the -registered value is returned (encapsulated in the list, so the caller -can distinguish nil vs no value), and the registration is popped -from the list." - - (let ((on-list (assq name allout-mode-prior-settings)) - prior-capsule ; By `capsule' i mean a list - ; containing a value, so we can - ; distinguish nil from no value. - ) - - (if value - - ;; Registering: - (progn - (if on-list - nil ; Already preserved prior value - don't mess with it. - ;; Register the old value, or nil if previously unbound: - (setq allout-mode-prior-settings - (cons (list name - (if (boundp name) (list (symbol-value name)))) - allout-mode-prior-settings))) - ; And impose the new value, locally: - (progn (make-local-variable name) - (set name (car value)))) - - ;; Relinquishing: - (if (not on-list) - - ;; Oops, not registered - leave it be: - nil + "Internal `allout-mode' use; settings to be resumed on mode deactivation. - ;; Some registration: - ; reestablish it: - (setq prior-capsule (car (cdr on-list))) - (if prior-capsule - (set name (car prior-capsule)) ; Some prior value - reestablish it. - (makunbound name)) ; Previously unbound - demolish var. - ; Remove registration: - (let (rebuild) - (while allout-mode-prior-settings - (if (not (eq (car allout-mode-prior-settings) - on-list)) - (setq rebuild - (cons (car allout-mode-prior-settings) - rebuild))) - (setq allout-mode-prior-settings - (cdr allout-mode-prior-settings))) - (setq allout-mode-prior-settings rebuild))))) - ) +See `allout-add-resumptions' and `allout-do-resumptions'.") +(make-variable-buffer-local 'allout-mode-prior-settings) +;;;_ > allout-add-resumptions (&rest pairs) +(defun allout-add-resumptions (&rest pairs) + "Set name/value pairs. + +Old settings are preserved for later resumption using `allout-do-resumptions'. + +The pairs are lists whose car is the name of the variable and car of the +cdr is the new value: '(some-var some-value)'. + +The new value is set as a buffer local. + +If the variable was not previously buffer-local, then that is noted and the +`allout-do-resumptions' will just `kill-local-variable' of that binding. + +If it previously was buffer-local, the old value is noted and resurrected +by `allout-do-resumptions'. \(If the local value was previously void, then +it is left as nil on resumption.\) + +The settings are stored on `allout-mode-prior-settings'." + (while pairs + (let* ((pair (pop pairs)) + (name (car pair)) + (value (cadr pair))) + (if (not (symbolp name)) + (error "Pair's name, %S, must be a symbol, not %s" + name (type-of name))) + (when (not (assoc name allout-mode-prior-settings)) + ;; Not already added as a resumption, create the prior setting entry. + (if (local-variable-p name) + ;; is already local variable - preserve the prior value: + (push (list name (condition-case err + (symbol-value name) + (void-variable nil))) + allout-mode-prior-settings) + ;; wasn't local variable, indicate so for resumption by killing + ;; local value, and make it local: + (push (list name) allout-mode-prior-settings) + (make-local-variable name))) + (set name value)))) +;;;_ > allout-do-resumptions () +(defun allout-do-resumptions () + "Resume all name/value settings registered by `allout-add-resumptions'. + +This is used when concluding allout-mode, to resume selected variables to +their settings before allout-mode was started." + + (while allout-mode-prior-settings + (let* ((pair (pop allout-mode-prior-settings)) + (name (car pair)) + (value-cell (cdr pair))) + (if (not value-cell) + ;; Prior value was global: + (kill-local-variable name) + ;; Prior value was explicit: + (set name (car value-cell)))))) ;;;_ : Mode-specific incidentals ;;;_ > allout-unprotected (expr) (defmacro allout-unprotected (expr) "Enable internal outline operations to alter invisible text." - `(let ((inhibit-read-only t)) + `(let ((inhibit-read-only t) + (inhibit-field-text-motion t)) ,expr)) ;;;_ = allout-mode-hook (defvar allout-mode-hook nil "*Hook that's run when allout mode starts.") -;;;_ = allout-overlay-category -(defvar allout-overlay-category nil - "Symbol for use in allout invisible-text overlays as the category.") +;;;_ = allout-mode-deactivate-hook +(defvar allout-mode-deactivate-hook nil + "*Hook that's run when allout mode ends.") +;;;_ = allout-exposure-category +(defvar allout-exposure-category nil + "Symbol for use as allout invisible-text overlay category.") ;;;_ x allout-view-change-hook (defvar allout-view-change-hook nil "*\(Deprecated\) Hook that's run after allout outline exposure changes. @@ -1293,30 +1344,26 @@ the following two lines in your Emacs init file: (setq cur (car menus) menus (cdr menus)) (easy-menu-add cur)))) -;;;_ > allout-set-overlay-category -(defun allout-set-overlay-category () - "Set the properties of the allout invisible-text overlay." - (setplist 'allout-overlay-category nil) - (put 'allout-overlay-category 'invisible 'allout) - (put 'allout-overlay-category 'evaporate t) +;;;_ > allout-overlay-preparations +(defun allout-overlay-preparations () + "Set the properties of the allout invisible-text overlay and others." + (setplist 'allout-exposure-category nil) + (put 'allout-exposure-category 'invisible 'allout) + (put 'allout-exposure-category 'evaporate t) ;; XXX We use isearch-open-invisible *and* isearch-mode-end-hook. The ;; latter would be sufficient, but it seems that a separate behavior - ;; the _transient_ opening of invisible text during isearch - is keyed to ;; presence of the isearch-open-invisible property - even though this ;; property controls the isearch _arrival_ behavior. This is the case at ;; least in emacs 21, 22.0, and xemacs 21.4. - (put 'allout-overlay-category 'isearch-open-invisible + (put 'allout-exposure-category 'isearch-open-invisible 'allout-isearch-end-handler) (if (featurep 'xemacs) - (put 'allout-overlay-category 'start-open t) - (put 'allout-overlay-category 'insert-in-front-hooks + (put 'allout-exposure-category 'start-open t) + (put 'allout-exposure-category 'insert-in-front-hooks '(allout-overlay-insert-in-front-handler))) - (if (featurep 'xemacs) - (progn (make-variable-buffer-local 'before-change-functions) - (add-hook 'before-change-functions - 'allout-before-change-handler)) - (put 'allout-overlay-category 'modification-hooks - '(allout-overlay-interior-modification-handler)))) + (put 'allout-exposure-category 'modification-hooks + '(allout-overlay-interior-modification-handler))) ;;;_ > allout-mode (&optional toggle) ;;;_ : Defun: ;;;###autoload @@ -1575,118 +1622,92 @@ OPEN: A topic that is not closed, though its offspring or body may be." ; active state or *de*activation ; specifically requested: (setq allout-explicitly-deactivated t) - (if (string-match "^18\." emacs-version) - ; Revoke those keys that remain - ; as we set them: - (let ((curr-loc (current-local-map))) - (mapcar (function - (lambda (cell) - (if (eq (lookup-key curr-loc (car cell)) - (car (cdr cell))) - (define-key curr-loc (car cell) - (assq (car cell) allout-prior-bindings))))) - allout-added-bindings) - (allout-resumptions 'allout-added-bindings) - (allout-resumptions 'allout-prior-bindings))) - (if allout-old-style-prefixes - (progn - (allout-resumptions 'allout-primary-bullet) - (allout-resumptions 'allout-old-style-prefixes))) - ;;(allout-resumptions 'selective-display) + (allout-do-resumptions) + (remove-from-invisibility-spec '(allout . t)) - (set write-file-hook-var-name - (delq 'allout-write-file-hook-handler - (symbol-value write-file-hook-var-name))) - (setq auto-save-hook - (delq 'allout-auto-save-hook-handler - auto-save-hook)) - (allout-resumptions 'paragraph-start) - (allout-resumptions 'paragraph-separate) - (allout-resumptions 'auto-fill-function) - (allout-resumptions 'normal-auto-fill-function) - (allout-resumptions 'allout-former-auto-filler) + (remove-hook 'pre-command-hook 'allout-pre-command-business t) + (remove-hook 'post-command-hook 'allout-post-command-business t) + (when (featurep 'xemacs) + (remove-hook 'before-change-functions 'allout-before-change-handler t)) + (remove-hook 'isearch-mode-end-hook 'allout-isearch-end-handler t) + (remove-hook write-file-hook-var-name 'allout-write-file-hook-handler t) + (remove-hook 'auto-save-hook 'allout-auto-save-hook-handler t) + + (remove-overlays (point-min) (point-max) + 'category 'allout-exposure-category) + + (run-hooks 'allout-mode-deactivate-hook) (setq allout-mode nil)) ;; Activation: ((not active) (setq allout-explicitly-deactivated nil) (if allout-old-style-prefixes - (progn ; Inhibit all the fancy formatting: - (allout-resumptions 'allout-primary-bullet '("*")) - (allout-resumptions 'allout-old-style-prefixes '(())))) + ;; Inhibit all the fancy formatting: + (allout-add-resumptions '((allout-primary-bullet "*") + (allout-old-style-prefixes ())))) - (allout-set-overlay-category) ; Doesn't hurt to redo this. + (allout-overlay-preparations) ; Doesn't hurt to redo this. (allout-infer-header-lead) (allout-infer-body-reindent) (set-allout-regexp) - ; Produce map from current version - ; of allout-keybindings-list: - (if (boundp 'minor-mode-map-alist) - - (progn ; V19, and maybe lucid and - ; epoch, minor-mode key bindings: - (setq allout-mode-map - (produce-allout-mode-map allout-keybindings-list)) - (substitute-key-definition 'beginning-of-line - 'move-beginning-of-line - allout-mode-map global-map) - (substitute-key-definition 'end-of-line - 'move-end-of-line - allout-mode-map global-map) - (produce-allout-mode-menubar-entries) - (fset 'allout-mode-map allout-mode-map) - ; Include on minor-mode-map-alist, - ; if not already there: - (if (not (member '(allout-mode . allout-mode-map) - minor-mode-map-alist)) - (setq minor-mode-map-alist - (cons '(allout-mode . allout-mode-map) - minor-mode-map-alist)))) - - ; V18 minor-mode key bindings: - ; Stash record of added bindings - ; for later revocation: - (allout-resumptions 'allout-added-bindings - (list allout-keybindings-list)) - (allout-resumptions 'allout-prior-bindings - (list (current-local-map))) - ; and add them: - (use-local-map (produce-allout-mode-map allout-keybindings-list - (current-local-map))) - ) + ;; Produce map from current version of allout-keybindings-list: + (setq allout-mode-map + (produce-allout-mode-map allout-keybindings-list)) + (substitute-key-definition 'beginning-of-line + 'move-beginning-of-line + allout-mode-map global-map) + (substitute-key-definition 'end-of-line + 'move-end-of-line + allout-mode-map global-map) + (produce-allout-mode-menubar-entries) + (fset 'allout-mode-map allout-mode-map) + + ;; Include on minor-mode-map-alist, if not already there: + (if (not (member '(allout-mode . allout-mode-map) + minor-mode-map-alist)) + (setq minor-mode-map-alist + (cons '(allout-mode . allout-mode-map) + minor-mode-map-alist))) (add-to-invisibility-spec '(allout . t)) - (make-local-variable 'line-move-ignore-invisible) - (setq line-move-ignore-invisible t) - (add-hook 'pre-command-hook 'allout-pre-command-business) - (add-hook 'post-command-hook 'allout-post-command-business) - (add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler) - (add-hook write-file-hook-var-name 'allout-write-file-hook-handler) - (add-hook 'auto-save-hook 'allout-auto-save-hook-handler) - ; Custom auto-fill func, to support - ; respect for topic headline, - ; hanging-indents, etc: - ;; Register prevailing fill func for use by allout-auto-fill: - (allout-resumptions 'allout-former-auto-filler (list auto-fill-function)) - ;; Register allout-auto-fill to be used if filling is active: - (allout-resumptions 'auto-fill-function '(allout-auto-fill)) - (allout-resumptions 'allout-outside-normal-auto-fill-function - (list normal-auto-fill-function)) - (allout-resumptions 'normal-auto-fill-function '(allout-auto-fill)) - ;; Paragraphs are broken by topic headlines. - (make-local-variable 'paragraph-start) - (allout-resumptions 'paragraph-start - (list (concat paragraph-start "\\|^\\(" - allout-regexp "\\)"))) - (make-local-variable 'paragraph-separate) - (allout-resumptions 'paragraph-separate - (list (concat paragraph-separate "\\|^\\(" - allout-regexp "\\)"))) - + (allout-add-resumptions '(line-move-ignore-invisible t)) + (add-hook 'pre-command-hook 'allout-pre-command-business nil t) + (add-hook 'post-command-hook 'allout-post-command-business nil t) + (when (featurep 'xemacs) + (add-hook 'before-change-functions 'allout-before-change-handler + nil t)) + (add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler nil t) + (add-hook write-file-hook-var-name 'allout-write-file-hook-handler + nil t) + (add-hook 'auto-save-hook 'allout-auto-save-hook-handler + nil t) + + ;; Stash auto-fill settings and adjust so custom allout auto-fill + ;; func will be used if auto-fill is active or activated. (The + ;; custom func respects topic headline, maintains hanging-indents, + ;; etc.) + (if (and auto-fill-function (not allout-inhibit-auto-fill)) + ;; allout-auto-fill will use the stashed values and so forth. + (allout-add-resumptions '(auto-fill-function allout-auto-fill))) + (allout-add-resumptions (list 'allout-former-auto-filler + auto-fill-function) + ;; Register allout-auto-fill to be used if + ;; filling is active: + (list 'allout-outside-normal-auto-fill-function + normal-auto-fill-function) + '(normal-auto-fill-function allout-auto-fill) + ;; Paragraphs are broken by topic headlines. + (list 'paragraph-start + (concat paragraph-start "\\|^\\(" + allout-regexp "\\)")) + (list 'paragraph-separate + (concat paragraph-separate "\\|^\\(" + allout-regexp "\\)"))) (or (assq 'allout-mode minor-mode-alist) (setq minor-mode-alist (cons '(allout-mode " Allout") minor-mode-alist))) @@ -1702,8 +1723,9 @@ OPEN: A topic that is not closed, though its offspring or body may be." ;; Reactivation: ((setq do-layout t) (allout-infer-body-reindent)) - ) ; cond + ) ;; end of activation-mode cases. + ;; Do auto layout if warranted: (let ((use-layout (if (listp allout-layout) allout-layout allout-default-layout))) @@ -1802,9 +1824,14 @@ See allout-overlay-interior-modification-handler for details. This before-change handler is used only where modification-hooks overlay property is not supported." - (if (not (allout-mode-p)) - nil - (allout-overlay-interior-modification-handler nil nil beg end nil))) + ;; allout-overlay-interior-modification-handler on an overlay handles + ;; this in other emacs, via `allout-exposure-category's 'modification-hooks. + (when (and (featurep 'xemacs) (allout-mode-p)) + ;; process all of the pending overlays: + (dolist (overlay (overlays-in beg end)) + (if (eq (overlay-get ol 'invisible) 'allout) + (allout-overlay-interior-modification-handler + overlay nil beg end nil))))) ;;;_ > allout-isearch-end-handler (&optional overlay) (defun allout-isearch-end-handler (&optional overlay) "Reconcile allout outline exposure on arriving in hidden text after isearch. @@ -1894,7 +1921,8 @@ Actually, returns prefix beginning point." ;;;_ > allout-e-o-prefix-p () (defun allout-e-o-prefix-p () "True if point is located where current topic prefix ends, heading begins." - (and (save-excursion (beginning-of-line) + (and (save-excursion (let ((inhibit-field-text-motion t)) + (beginning-of-line)) (looking-at allout-regexp)) (= (point)(save-excursion (allout-end-of-prefix)(point))))) ;;;_ : Location attributes @@ -1996,34 +2024,34 @@ Outermost is first." (defun allout-beginning-of-current-line () "Like beginning of line, but to visible text." - ;; XXX We would use `(move-beginning-of-line 1)', but it gets - ;; stuck on some hidden newlines, eg at column 80, as of GNU Emacs 22.0.50. - ;; Conversely, `beginning-of-line' can make no progress in other - ;; situations. Both are necessary, in the order used below. - (move-beginning-of-line 1) - (beginning-of-line) - (while (or (not (bolp)) (allout-hidden-p)) + ;; This combination of move-beginning-of-line and beginning-of-line is + ;; deliberate, but the (beginning-of-line) may now be superfluous. + (let ((inhibit-field-text-motion t)) + (move-beginning-of-line 1) (beginning-of-line) - (if (or (allout-hidden-p) (not (bolp))) - (forward-char -1)))) + (while (and (not (bobp)) (or (not (bolp)) (allout-hidden-p))) + (beginning-of-line) + (if (or (allout-hidden-p) (not (bolp))) + (forward-char -1))))) ;;;_ > allout-end-of-current-line () (defun allout-end-of-current-line () "Move to the end of line, past concealed text if any." ;; XXX This is for symmetry with `allout-beginning-of-current-line' - ;; `move-end-of-line' doesn't suffer the same problem as ;; `move-beginning-of-line'. - (end-of-line) - (while (allout-hidden-p) + (let ((inhibit-field-text-motion t)) (end-of-line) - (if (allout-hidden-p) (forward-char 1)))) + (while (allout-hidden-p) + (end-of-line) + (if (allout-hidden-p) (forward-char 1))))) ;;;_ > allout-next-heading () (defsubst allout-next-heading () - "Move to the heading for the topic \(possibly invisible) before this one. + "Move to the heading for the topic \(possibly invisible) after this one. Returns the location of the heading, or nil if none found." - (if (and (bobp) (not (eobp))) - (forward-char 1)) + (if (and (bobp) (not (eobp)) (looking-at allout-regexp)) + (forward-char 1)) (if (re-search-forward allout-line-boundary-regexp nil 0) (allout-prefix-data ; Got valid location state - set vars: @@ -2553,7 +2581,8 @@ Presumes point is at the start of a topic prefix." Move to buffer limit in indicated direction if headings are exhausted." (interactive "p") - (let* ((backward (if (< arg 0) (setq arg (* -1 arg)))) + (let* ((inhibit-field-text-motion t) + (backward (if (< arg 0) (setq arg (* -1 arg)))) (step (if backward -1 1)) prev got) @@ -2688,36 +2717,51 @@ return to regular interpretation of self-insert characters." (if (not (allout-mode-p)) nil - ;; Hot-spot navigation provisions: (if (and (eq this-command 'self-insert-command) (eq (point)(allout-current-bullet-pos))) - (let* ((this-key-num (cond - ((numberp last-command-char) - last-command-char) - ;; Only xemacs has characterp. - ((and (fboundp 'characterp) - (apply 'characterp - (list last-command-char))) - (apply 'char-to-int (list last-command-char))) - (t 0))) - mapped-binding) - (if (zerop this-key-num) - nil - ; Map upper-register literals - ; to lower register: - (if (<= 96 this-key-num) - (setq this-key-num (- this-key-num 32))) - ; Check if we have a literal: - (if (and (<= 64 this-key-num) - (>= 96 this-key-num)) - (setq mapped-binding - (lookup-key 'allout-mode-map - (concat allout-command-prefix - (char-to-string (- this-key-num - 64)))))) - (if mapped-binding - (setq allout-post-goto-bullet t - this-command mapped-binding))))))) + (allout-hotspot-key-handler)))) +;;;_ > allout-hotspot-key-handler () +(defun allout-hotspot-key-handler () + "Catchall handling of key bindings in hot-spots. + +Translates unmodified keystrokes to corresponding allout commands, when +they would qualify if prefixed with the allout-command-prefix, and sets +this-command accordingly. + +Returns the qualifying command, if any, else nil." + (interactive) + (let* ((key-num (cond ((numberp last-command-char) last-command-char) + ;; for XEmacs character type: + ((and (fboundp 'characterp) + (apply 'characterp (list last-command-char))) + (apply 'char-to-int (list last-command-char))) + (t 0))) + mapped-binding + (on-bullet (eq (point) (allout-current-bullet-pos)))) + + (if (zerop key-num) + nil + + (if (and (<= 33 key-num) + (setq mapped-binding + (key-binding (concat allout-command-prefix + (char-to-string + (if (and (<= 97 key-num) ; "a" + (>= 122 key-num)) ; "z" + (- key-num 96) key-num))) + t))) + ;; Qualified with the allout prefix - do hot-spot operation. + (setq allout-post-goto-bullet t) + ;; accept-defaults nil, or else we'll get allout-item-icon-key-handler. + (setq mapped-binding (key-binding (char-to-string key-num)))) + + (while (keymapp mapped-binding) + (setq mapped-binding + (lookup-key mapped-binding (read-key-sequence-vector nil t)))) + + (if mapped-binding + (setq this-command mapped-binding))))) + ;;;_ > allout-find-file-hook () (defun allout-find-file-hook () "Activate `allout-mode' on non-nil `allout-auto-activation', `allout-layout'. @@ -2969,7 +3013,8 @@ Nuances: from there." (allout-beginning-of-current-line) - (let* ((depth (+ (allout-current-depth) relative-depth)) + (let* ((inhibit-field-text-motion t) + (depth (+ (allout-current-depth) relative-depth)) (opening-on-blank (if (looking-at "^\$") (not (setq before nil)))) ;; bunch o vars set while computing ref-topic @@ -3146,21 +3191,23 @@ topic prior to the current one." Maintains outline hanging topic indentation if `allout-use-hanging-indents' is set." - (let ((fill-prefix (if allout-use-hanging-indents - ;; Check for topic header indentation: - (save-excursion - (beginning-of-line) - (if (looking-at allout-regexp) - ;; ... construct indentation to account for - ;; length of topic prefix: - (make-string (progn (allout-end-of-prefix) - (current-column)) - ?\ ))))) - (use-auto-fill-function (or allout-outside-normal-auto-fill-function - auto-fill-function - 'do-auto-fill))) - (if (or allout-former-auto-filler allout-use-hanging-indents) - (funcall use-auto-fill-function)))) + + (when (not allout-inhibit-auto-fill) + (let ((fill-prefix (if allout-use-hanging-indents + ;; Check for topic header indentation: + (save-excursion + (beginning-of-line) + (if (looking-at allout-regexp) + ;; ... construct indentation to account for + ;; length of topic prefix: + (make-string (progn (allout-end-of-prefix) + (current-column)) + ?\ ))))) + (use-auto-fill-function (or allout-outside-normal-auto-fill-function + auto-fill-function + 'do-auto-fill))) + (if (or allout-former-auto-filler allout-use-hanging-indents) + (funcall use-auto-fill-function))))) ;;;_ > allout-reindent-body (old-depth new-depth &optional number) (defun allout-reindent-body (old-depth new-depth &optional number) "Reindent body lines which were indented at OLD-DEPTH to NEW-DEPTH. @@ -3585,7 +3632,8 @@ when yank with allout-yank into an outline as a heading." ;; a lag *after* a kill has been performed. (interactive) - (let* ((collapsed (allout-current-topic-collapsed-p)) + (let* ((inhibit-field-text-motion t) + (collapsed (allout-current-topic-collapsed-p)) (beg (prog1 (allout-back-to-current-heading) (beginning-of-line))) (depth (allout-recent-depth))) (allout-end-of-current-subtree) @@ -3601,8 +3649,10 @@ when yank with allout-yank into an outline as a heading." (forward-char 1))) (if collapsed - (put-text-property beg (1+ beg) 'allout-was-collapsed t) - (remove-text-properties beg (1+ beg) '(allout-was-collapsed t))) + (allout-unprotected + (put-text-property beg (1+ beg) 'allout-was-collapsed t)) + (allout-unprotected + (remove-text-properties beg (1+ beg) '(allout-was-collapsed t)))) (allout-unprotected (kill-region beg (point))) (sit-for 0) (save-excursion @@ -3633,7 +3683,8 @@ however, are left exactly like normal, non-allout-specific yanks." ; region around subject: (if (< (allout-mark-marker t) (point)) (exchange-point-and-mark)) - (let* ((subj-beg (point)) + (let* ((inhibit-field-text-motion t) + (subj-beg (point)) (into-bol (bolp)) (subj-end (allout-mark-marker t)) (was-collapsed (get-text-property subj-beg 'allout-was-collapsed)) @@ -3802,7 +3853,8 @@ by pops to non-distinctive yanks. Bug..." (if (not (string= (allout-current-bullet) allout-file-xref-bullet)) (error "Current heading lacks cross-reference bullet `%s'" allout-file-xref-bullet) - (let (file-name) + (let ((inhibit-field-text-motion t) + file-name) (save-excursion (let* ((text-start allout-recent-prefix-end) (heading-end (progn (end-of-line) (point)))) @@ -3834,12 +3886,12 @@ by pops to non-distinctive yanks. Bug..." Text is shown if flag is nil and hidden otherwise." ;; We use outline invisibility spec. - (remove-overlays from to 'category 'allout-overlay-category) + (remove-overlays from to 'category 'allout-exposure-category) (when flag (let ((o (make-overlay from to))) - (overlay-put o 'category 'allout-overlay-category) + (overlay-put o 'category 'allout-exposure-category) (when (featurep 'xemacs) - (let ((props (symbol-plist 'allout-overlay-category))) + (let ((props (symbol-plist 'allout-exposure-category))) (while props (overlay-put o (pop props) (pop props))))))) (run-hooks 'allout-view-change-hook) @@ -3850,7 +3902,8 @@ Text is shown if flag is nil and hidden otherwise." (save-excursion (allout-back-to-current-heading) - (end-of-line) + (let ((inhibit-field-text-motion t)) + (end-of-line)) (allout-flag-region (point) ;; Exposing must not leave trailing blanks hidden, ;; but can leave them exposed when hiding, so we @@ -3860,9 +3913,9 @@ Text is shown if flag is nil and hidden otherwise." flag))) ;;;_ - Topic-specific -;;;_ > allout-show-entry (&optional inclusive) -(defun allout-show-entry (&optional inclusive) - "Like `allout-show-current-entry', reveals entries nested in hidden topics. +;;;_ > allout-show-entry () +(defun allout-show-entry () + "Like `allout-show-current-entry', but reveals entries in hidden topics. This is a way to give restricted peek at a concealed locality without the expense of exposing its context, but can leave the outline with aberrant @@ -3939,7 +3992,8 @@ point of non-opened subtree?)" Useful for coherently exposing to a random point in a hidden region." (interactive) (save-excursion - (let ((orig-pt (point)) + (let ((inhibit-field-text-motion t) + (orig-pt (point)) (orig-pref (allout-goto-prefix)) (last-at (point)) bag-it) @@ -3971,13 +4025,13 @@ Useful for coherently exposing to a random point in a hidden region." (interactive) (allout-back-to-current-heading) (save-excursion - (end-of-line) + (let ((inhibit-field-text-motion t)) + (end-of-line)) (allout-flag-region (point) (progn (allout-end-of-entry) (point)) t))) ;;;_ > allout-show-current-entry (&optional arg) (defun allout-show-current-entry (&optional arg) - "Show body following current heading, or hide entry with universal argument." (interactive "P") @@ -4042,6 +4096,7 @@ siblings, even if the target topic is already closed." ((allout-up-current-level 1 t) (allout-hide-current-subtree)) (t (goto-char 0) (message sibs-msg) + (allout-goto-prefix) (allout-expose-topic '(0 :)) (message (concat sibs-msg " Done.")))) (goto-char from))) @@ -4049,7 +4104,8 @@ siblings, even if the target topic is already closed." (defun allout-show-current-branches () "Show all subheadings of this heading, but not their bodies." (interactive) - (beginning-of-line) + (let ((inhibit-field-text-motion t)) + (beginning-of-line)) (allout-show-children t)) ;;;_ > allout-hide-current-leaves () (defun allout-hide-current-leaves () @@ -4079,13 +4135,14 @@ siblings, even if the target topic is already closed." (save-restriction (narrow-to-region start end) (goto-char (point-min)) - (while (not (eobp)) - (end-of-line) - (allout-flag-region (point) (allout-end-of-entry) t) - (if (not (eobp)) - (forward-char - (if (looking-at "\n\n") - 2 1))))))) + (let ((inhibit-field-text-motion t)) + (while (not (eobp)) + (end-of-line) + (allout-flag-region (point) (allout-end-of-entry) t) + (if (not (eobp)) + (forward-char + (if (looking-at "\n\n") + 2 1)))))))) ;;;_ > allout-expose-topic (spec) (defun allout-expose-topic (spec) @@ -4238,7 +4295,8 @@ for the corresponding offspring of the topic. Optional FOLLOWERS arguments dictate exposure for succeeding siblings." (interactive "xExposure spec: ") - (let ((depth (allout-current-depth)) + (let ((inhibit-field-text-motion t) + (depth (allout-current-depth)) max-pos) (cond ((null spec) nil) ((symbolp spec) @@ -4417,8 +4475,9 @@ header and body. The elements of that list are: (interactive "r") (save-excursion (let* - ;; state vars: - (strings prefix result depth new-depth out gone-out bullet beg + ((inhibit-field-text-motion t) + ;; state vars: + strings prefix result depth new-depth out gone-out bullet beg next done) (goto-char start) @@ -4697,18 +4756,19 @@ string across LaTeX processing." Adjust line contents so it is unaltered \(from the original line) across LaTeX processing, within the context of a `verbatim' environment. Leaves point at the end of the line." - (beginning-of-line) - (let ((beg (point)) - (end (progn (end-of-line)(point)))) - (goto-char beg) - (while (re-search-forward "\\\\" - ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#" - end ; bounded by end-of-line - 1) ; no matches, move to end & return nil - (goto-char (match-beginning 0)) - (insert "\\") - (setq end (1+ end)) - (goto-char (1+ (match-end 0)))))) + (let ((inhibit-field-text-motion t)) + (beginning-of-line) + (let ((beg (point)) + (end (progn (end-of-line)(point)))) + (goto-char beg) + (while (re-search-forward "\\\\" + ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#" + end ; bounded by end-of-line + 1) ; no matches, move to end & return nil + (goto-char (match-beginning 0)) + (insert "\\") + (setq end (1+ end)) + (goto-char (1+ (match-end 0))))))) ;;;_ > allout-insert-latex-header (buffer) (defun allout-insert-latex-header (buffer) "Insert initial LaTeX commands at point in BUFFER." @@ -5556,7 +5616,8 @@ save. See `allout-encrypt-unencrypted-on-saves' for more info." (defun allout-mark-topic () "Put the region around topic currently containing point." (interactive) - (beginning-of-line) + (let ((inhibit-field-text-motion t)) + (beginning-of-line)) (allout-goto-prefix) (push-mark (point)) (allout-end-of-current-subtree) @@ -5631,7 +5692,8 @@ enable-local-variables must be true for any of this to happen." allout-enable-file-variable-adjustment)) nil (save-excursion - (let ((section-data (allout-file-vars-section-data)) + (let ((inhibit-field-text-motion t) + (section-data (allout-file-vars-section-data)) beg prefix suffix) (if section-data (setq beg (car section-data) @@ -5919,7 +5981,131 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." (isearch-repeat 'forward) (isearch-mode t))) -;;;_ #11 Provide +;;;_ #11 Unit tests - this should be last item before "Provide" +;;;_ > allout-run-unit-tests () +(defun allout-run-unit-tests () + "Run the various allout unit tests." + (message "Running allout tests...") + (allout-test-resumptions) + (message "Running allout tests... Done.") + (sit-for .5)) +;;;_ : test resumptions: +;;;_ > allout-tests-obliterate-variable (name) +(defun allout-tests-obliterate-variable (name) + "Completely unbind variable with NAME." + (if (local-variable-p name) (kill-local-variable name)) + (while (boundp name) (makunbound name))) +;;;_ > allout-test-resumptions () +(defvar allout-tests-globally-unbound nil + "Fodder for allout resumptions tests - defvar just for byte compiler.") +(defvar allout-tests-globally-true nil + "Fodder for allout resumptions tests - defvar just just for byte compiler.") +(defvar allout-tests-locally-true nil + "Fodder for allout resumptions tests - defvar just for byte compiler.") +(defun allout-test-resumptions () + "Exercise allout resumptions." + ;; for each resumption case, we also test that the right local/global + ;; scopes are affected during resumption effects: + + ;; ensure that previously unbound variables return to the unbound state. + (with-temp-buffer + (allout-tests-obliterate-variable 'allout-tests-globally-unbound) + (allout-add-resumptions '(allout-tests-globally-unbound t)) + (assert (not (default-boundp 'allout-tests-globally-unbound))) + (assert (local-variable-p 'allout-tests-globally-unbound)) + (assert (boundp 'allout-tests-globally-unbound)) + (assert (equal allout-tests-globally-unbound t)) + (allout-do-resumptions) + (assert (not (local-variable-p 'allout-tests-globally-unbound))) + (assert (not (boundp 'allout-tests-globally-unbound)))) + + ;; ensure that variable with prior global value is resumed + (with-temp-buffer + (allout-tests-obliterate-variable 'allout-tests-globally-true) + (setq allout-tests-globally-true t) + (allout-add-resumptions '(allout-tests-globally-true nil)) + (assert (equal (default-value 'allout-tests-globally-true) t)) + (assert (local-variable-p 'allout-tests-globally-true)) + (assert (equal allout-tests-globally-true nil)) + (allout-do-resumptions) + (assert (not (local-variable-p 'allout-tests-globally-true))) + (assert (boundp 'allout-tests-globally-true)) + (assert (equal allout-tests-globally-true t))) + + ;; ensure that prior local value is resumed + (with-temp-buffer + (allout-tests-obliterate-variable 'allout-tests-locally-true) + (set (make-local-variable 'allout-tests-locally-true) t) + (assert (not (default-boundp 'allout-tests-locally-true)) + nil (concat "Test setup mistake - variable supposed to" + " not have global binding, but it does.")) + (assert (local-variable-p 'allout-tests-locally-true) + nil (concat "Test setup mistake - variable supposed to have" + " local binding, but it lacks one.")) + (allout-add-resumptions '(allout-tests-locally-true nil)) + (assert (not (default-boundp 'allout-tests-locally-true))) + (assert (local-variable-p 'allout-tests-locally-true)) + (assert (equal allout-tests-locally-true nil)) + (allout-do-resumptions) + (assert (boundp 'allout-tests-locally-true)) + (assert (local-variable-p 'allout-tests-locally-true)) + (assert (equal allout-tests-locally-true t)) + (assert (not (default-boundp 'allout-tests-locally-true)))) + + ;; ensure that last of multiple resumptions holds, for various scopes. + (with-temp-buffer + (allout-tests-obliterate-variable 'allout-tests-globally-unbound) + (allout-tests-obliterate-variable 'allout-tests-globally-true) + (setq allout-tests-globally-true t) + (allout-tests-obliterate-variable 'allout-tests-locally-true) + (set (make-local-variable 'allout-tests-locally-true) t) + (allout-add-resumptions '(allout-tests-globally-unbound t) + '(allout-tests-globally-true nil) + '(allout-tests-locally-true nil)) + (allout-add-resumptions '(allout-tests-globally-unbound 2) + '(allout-tests-globally-true 3) + '(allout-tests-locally-true 4)) + ;; reestablish many of the basic conditions are maintained after re-add: + (assert (not (default-boundp 'allout-tests-globally-unbound))) + (assert (local-variable-p 'allout-tests-globally-unbound)) + (assert (equal allout-tests-globally-unbound 2)) + (assert (default-boundp 'allout-tests-globally-true)) + (assert (local-variable-p 'allout-tests-globally-true)) + (assert (equal allout-tests-globally-true 3)) + (assert (not (default-boundp 'allout-tests-locally-true))) + (assert (local-variable-p 'allout-tests-locally-true)) + (assert (equal allout-tests-locally-true 4)) + (allout-do-resumptions) + (assert (not (local-variable-p 'allout-tests-globally-unbound))) + (assert (not (boundp 'allout-tests-globally-unbound))) + (assert (not (local-variable-p 'allout-tests-globally-true))) + (assert (boundp 'allout-tests-globally-true)) + (assert (equal allout-tests-globally-true t)) + (assert (boundp 'allout-tests-locally-true)) + (assert (local-variable-p 'allout-tests-locally-true)) + (assert (equal allout-tests-locally-true t)) + (assert (not (default-boundp 'allout-tests-locally-true)))) + + ;; ensure that deliberately unbinding registered variables doesn't foul things + (with-temp-buffer + (allout-tests-obliterate-variable 'allout-tests-globally-unbound) + (allout-tests-obliterate-variable 'allout-tests-globally-true) + (setq allout-tests-globally-true t) + (allout-tests-obliterate-variable 'allout-tests-locally-true) + (set (make-local-variable 'allout-tests-locally-true) t) + (allout-add-resumptions '(allout-tests-globally-unbound t) + '(allout-tests-globally-true nil) + '(allout-tests-locally-true nil)) + (allout-tests-obliterate-variable 'allout-tests-globally-unbound) + (allout-tests-obliterate-variable 'allout-tests-globally-true) + (allout-tests-obliterate-variable 'allout-tests-locally-true) + (allout-do-resumptions)) + ) +;;;_ % Run unit tests if `allout-run-unit-tests-after-load' is true: +(when allout-run-unit-tests-on-load + (allout-run-unit-tests)) + +;;;_ #12 Provide (provide 'allout) ;;;_* Local emacs vars. diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 500ad5ff5fa..4afdfac2bf5 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -870,10 +870,14 @@ using `make-temp-file', and the generated name is returned." (save-excursion (funcall set-auto-coding-function filename (- (point-max) (point-min))))) - ;; dos-w32.el defines find-operation-coding-system for - ;; DOS/Windows systems which preserves the coding-system - ;; of existing files. We want it to act here as if the - ;; extracted file existed. + ;; dos-w32.el defines the function + ;; find-buffer-file-type-coding-system for DOS/Windows + ;; systems which preserves the coding-system of existing files. + ;; (That function is called via file-coding-system-alist.) + ;; Here, we want it to act as if the extracted file existed. + ;; The following let-binding of file-name-handler-alist forces + ;; find-file-not-found-set-buffer-file-coding-system to ignore + ;; the file's name (see dos-w32.el). (let ((file-name-handler-alist '(("" . archive-file-name-handler)))) (car (find-operation-coding-system diff --git a/lisp/bindings.el b/lisp/bindings.el index 639ee2dabb8..fc66d36b41f 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -683,7 +683,11 @@ language you are using." (define-key map [prior] 'previous-history-element) (define-key map [up] 'previous-history-element) (define-key map "\es" 'next-matching-history-element) - (define-key map "\er" 'previous-matching-history-element)) + (define-key map "\er" 'previous-matching-history-element) + ;; Override the global binding (which calls indent-relative via + ;; indent-for-tab-command). The alignment that indent-relative tries to + ;; do doesn't make much sense here since the prompt messes it up. + (define-key map "\t" 'self-insert-command)) (define-key global-map "\C-u" 'universal-argument) (let ((i ?0)) diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index fadfabce663..fe5bf4cf9e0 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -32,7 +32,11 @@ (require 'calc) (require 'calc-macs) +(defvar calc-quick-calc-history nil + "The history list for quick-calc.") + (defun calc-do-quick-calc () + (require 'calc-ext) (calc-check-defines) (if (eq major-mode 'calc-mode) (calc-algebraic-entry t) @@ -45,23 +49,12 @@ (enable-recursive-minibuffers t) (calc-language (if (memq calc-language '(nil big)) 'flat calc-language)) - (entry (calc-do-alg-entry "" "Quick calc: " t)) - (alg-exp (mapcar (function - (lambda (x) - (if (and (not (featurep 'calc-ext)) - calc-previous-alg-entry - (string-match - "\\`[-0-9._+*/^() ]+\\'" - calc-previous-alg-entry)) - (calc-normalize x) - (require 'calc-ext) - (math-evaluate-expr x)))) - entry))) + (entry (calc-do-alg-entry "" "Quick calc: " t 'calc-quick-calc-history)) + (alg-exp (mapcar 'math-evaluate-expr entry))) (when (and (= (length alg-exp) 1) (eq (car-safe (car alg-exp)) 'calcFunc-assign) (= (length (car alg-exp)) 3) (eq (car-safe (nth 1 (car alg-exp))) 'var)) - (require 'calc-ext) (set (nth 2 (nth 1 (car alg-exp))) (nth 2 (car alg-exp))) (calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp)))) (setq alg-exp (list (nth 2 (car alg-exp))))) @@ -264,13 +257,16 @@ T means abort and give an error message.") (math-expr-opers (if prefix math-standard-opers math-expr-opers))) (calc-alg-entry (and auto (char-to-string last-command-char)))))) +(defvar calc-alg-entry-history nil + "History for algebraic entry.") + (defun calc-alg-entry (&optional initial prompt) (let* ((sel-mode nil) (calc-dollar-values (mapcar 'calc-get-stack-element (nthcdr calc-stack-top calc-stack))) (calc-dollar-used 0) (calc-plain-entry t) - (alg-exp (calc-do-alg-entry initial prompt t))) + (alg-exp (calc-do-alg-entry initial prompt t 'calc-alg-entry-history))) (if (stringp alg-exp) (progn (require 'calc-ext) @@ -301,7 +297,7 @@ T means abort and give an error message.") (defvar calc-alg-exp) -(defun calc-do-alg-entry (&optional initial prompt no-normalize) +(defun calc-do-alg-entry (&optional initial prompt no-normalize history) (let* ((calc-buffer (current-buffer)) (blink-paren-function 'calcAlg-blink-matching-open) (calc-alg-exp 'error)) @@ -319,15 +315,17 @@ T means abort and give an error message.") (define-key calc-alg-ent-map "\e" nil) (if (eq calc-algebraic-mode 'total) (define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map) - (define-key calc-alg-ent-map "\ep" 'calcAlg-plus-minus) + (define-key calc-alg-ent-map "\e+" 'calcAlg-plus-minus) (define-key calc-alg-ent-map "\em" 'calcAlg-mod) (define-key calc-alg-ent-map "\e=" 'calcAlg-equals) (define-key calc-alg-ent-map "\e\r" 'calcAlg-equals) + (define-key calc-alg-ent-map "\ep" 'previous-history-element) + (define-key calc-alg-ent-map "\en" 'next-history-element) (define-key calc-alg-ent-map "\e%" 'self-insert-command)) (setq calc-aborted-prefix nil) (let ((buf (read-from-minibuffer (or prompt "Algebraic: ") (or initial "") - calc-alg-ent-map nil))) + calc-alg-ent-map nil history))) (when (eq calc-alg-exp 'error) (when (eq (car-safe (setq calc-alg-exp (math-read-exprs buf))) 'error) (setq calc-alg-exp nil))) @@ -355,9 +353,7 @@ T means abort and give an error message.") (defun calcAlg-previous () (interactive) (if (calc-minibuffer-contains "\\'") - (if calc-previous-alg-entry - (insert calc-previous-alg-entry) - (beep)) + (previous-history-element 1) (insert "'"))) (defun calcAlg-equals () @@ -384,7 +380,6 @@ T means abort and give an error message.") "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'")) (insert "`") (setq calc-alg-exp (minibuffer-contents)) - (and (> (length calc-alg-exp) 0) (setq calc-previous-alg-entry calc-alg-exp)) (exit-minibuffer))) (defvar calc-buffer) @@ -407,7 +402,6 @@ T means abort and give an error message.") (setq calc-alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'") '((incomplete vec)) exp)) - (and (> (length str) 0) (setq calc-previous-alg-entry str)) (exit-minibuffer)))) (defun calcAlg-blink-matching-open () diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el index 63e45538c32..c9c71b3ebf1 100644 --- a/lisp/calc/calc-map.el +++ b/lisp/calc/calc-map.el @@ -498,6 +498,9 @@ ;;; Return a list of the form (nargs func name) +(defvar calc-get-operator-history nil + "History for calc-get-operator.") + (defun calc-get-operator (msg &optional nargs) (setq calc-aborted-prefix nil) (let ((inv nil) (hyp nil) (prefix nil) (forcenargs nil) @@ -583,7 +586,8 @@ (let* ((calc-dollar-values calc-arg-values) (calc-dollar-used 0) (calc-hashes-used 0) - (func (calc-do-alg-entry "" "Function: "))) + (func (calc-do-alg-entry "" "Function: " nil + 'calc-get-operator-history))) (setq record-entry t) (or (= (length func) 1) (error "Bad format")) diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el index 71dce50d976..d7530dc4cb6 100644 --- a/lisp/calc/calc-rewr.el +++ b/lisp/calc/calc-rewr.el @@ -154,7 +154,6 @@ (setq expr (calc-top-n 2) pat (calc-top-n 1) n 2) - (if interactive (setq calc-previous-alg-entry pat)) (setq pat (if (stringp pat) (math-read-expr pat) pat)) (if (eq (car-safe pat) 'error) (error "Bad format in expression: %s" (nth 1 pat))) diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el index bf18fa968c5..7f6dbb7f999 100644 --- a/lisp/calc/calc-sel.el +++ b/lisp/calc/calc-sel.el @@ -633,6 +633,9 @@ (setcar (nthcdr 2 entry) (and (not (eq sel (car entry))) sel)) (calc-delete-selection num)))) +(defvar calc-selection-history nil + "History for calc selections.") + (defun calc-enter-selection () (interactive) (calc-wrapper @@ -645,7 +648,8 @@ alg) (let ((calc-dollar-values (list sel)) (calc-dollar-used 0)) - (setq alg (calc-do-alg-entry "" "Replace selection with: ")) + (setq alg (calc-do-alg-entry "" "Replace selection with: " nil + 'calc-selection-history)) (and alg (progn (setq alg (calc-encase-atoms (car alg))) @@ -765,7 +769,8 @@ (car (calc-do-alg-entry "" (if divide "Divide both sides by: " - "Multiply both sides by: "))))) + "Multiply both sides by: ") + nil 'calc-selection-history)))) (and alg (progn (if (and (or (eq func '/) @@ -830,7 +835,8 @@ (car (calc-do-alg-entry "" (if subtract "Subtract from both sides: " - "Add to both sides: "))))) + "Add to both sides: ") + nil 'calc-selection-history)))) (and alg (progn (if (and (assq func calc-tweak-eqn-table) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index c251d28acfb..bbb80bebc1d 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -886,7 +886,6 @@ If nil, selections displayed but ignored.") "Formatting function used for non-decimal numbers.") (defvar calc-last-kill nil) ; Last number killed in calc-mode. -(defvar calc-previous-alg-entry nil) ; Previous algebraic entry. (defvar calc-dollar-values nil) ; Values to be used for '$'. (defvar calc-dollar-used nil) ; Highest order of '$' that occurred. (defvar calc-hashes-used nil) ; Highest order of '#' that occurred. diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el index b1c5b80b17b..4c0134263d9 100644 --- a/lisp/calc/calcalg3.el +++ b/lisp/calc/calcalg3.el @@ -103,6 +103,9 @@ (defvar calc-curve-model) (defvar calc-curve-coefnames) +(defvar calc-curve-fit-history nil + "History for calc-curve-fit.") + (defun calc-curve-fit (arg &optional calc-curve-model calc-curve-coefnames calc-curve-varnames) (interactive "P") @@ -259,7 +262,8 @@ (let* ((calc-dollar-values calc-arg-values) (calc-dollar-used 0) (calc-hashes-used 0)) - (setq calc-curve-model (calc-do-alg-entry "" "Model formula: ")) + (setq calc-curve-model (calc-do-alg-entry "" "Model formula: " + nil 'calc-curve-fit-history)) (if (/= (length calc-curve-model) 1) (error "Bad format")) (setq calc-curve-model (car calc-curve-model) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 15efbc5ab91..15f43080aff 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1087,18 +1087,24 @@ Show the buffer in another window, but don't select it." ;; Packages will update this variable, so make it available. ;;;###autoload (defvar customize-package-emacs-version-alist nil - "Alist mapping versions of Emacs to versions of a package. -These package versions are listed in the :package-version -keyword used in `defcustom', `defgroup', and `defface'. Its -elements look like this: + "Alist mapping versions of a package to Emacs versions. +We use this for packages that have their own names, but are released +as part of Emacs itself. + +Each elements looks like this: (PACKAGE (PVERSION . EVERSION)...) -For each PACKAGE, which is a symbol, there are one or more -elements that contain a package version PVERSION with an -associated Emacs version EVERSION. These versions are strings. -For example, the MH-E package updates this alist with the -following: +Here PACKAGE is the name of a package, as a symbol. After +PACKAGE come one or more elements, each associating a +package version PVERSION with the first Emacs version +EVERSION in which it (or a subsequent version of PACKAGE) +was first released. Both PVERSION and EVERSION are strings. +PVERSION should be a string that this package used in +the :package-version keyword for `defcustom', `defgroup', +and `defface'. + +For example, the MH-E package updates this alist as follows: (add-to-list 'customize-package-emacs-version-alist '(MH-E (\"6.0\" . \"22.1\") (\"6.1\" . \"22.1\") @@ -1173,11 +1179,10 @@ that were added or redefined since that version." since-version)))) (defun customize-package-emacs-version (symbol package-version) - "Return Emacs version of SYMBOL. -PACKAGE-VERSION has the form (PACKAGE . VERSION). The VERSION of -PACKAGE is looked up in the associated list + "Return the Emacs version in which SYMBOL's meaning last changed. +PACKAGE-VERSION has the form (PACKAGE . VERSION). We use `customize-package-emacs-version-alist' to find the version of -Emacs that is associated with it." +Emacs that is associated with version VERSION of PACKAGE." (let (package-versions emacs-version) ;; Use message instead of error since we want user to be able to ;; see the rest of the symbols even if a package author has @@ -1193,9 +1198,9 @@ Emacs that is associated with it." (cdr package-version) "customize-package-emacs-version-alist"))) (t - (message "Package %s neglected to update %s" + (message "Package %s version %s lists no corresponding Emacs version" (car package-version) - "customize-package-emacs-version-alist"))) + (cdr package-version)))) emacs-version)) (defun customize-version-lessp (version1 version2) @@ -2668,7 +2673,18 @@ Otherwise, look up symbol in `custom-guess-type-alist'." (error nil)) (cond ((eq (caar tmp) 'user) 'saved) - ((eq (caar tmp) 'changed) 'changed) + ((eq (caar tmp) 'changed) + (if (condition-case nil + (and (null comment) + (equal value + (eval + (car (get symbol 'standard-value))))) + (error nil)) + ;; The value was originally set outside + ;; custom, but it was set to the standard + ;; value (probably an autoloaded defcustom). + 'standard + 'changed)) (t 'themed)) 'changed)) ((setq tmp (get symbol 'standard-value)) @@ -4433,10 +4449,13 @@ The format is suitable for use with `easy-menu-define'." map) "Keymap for `custom-mode'.") -(defun custom-no-edit () - "Refuse to allow editing of Custom buffer." - (interactive) - (error "You can't edit this part of the Custom buffer")) +(defun custom-no-edit (pos &optional event) + "Invoke button at POS, or refuse to allow editing of Custom buffer." + (interactive "@d") + (let ((button (get-char-property pos 'button))) + (if button + (widget-apply-action button event) + (error "You can't edit this part of the Custom buffer")))) (easy-menu-define Custom-mode-menu custom-mode-map diff --git a/lisp/custom.el b/lisp/custom.el index c0169812d36..2e5c0a59d9b 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -558,9 +558,10 @@ LOAD should be either a library file name, or a feature name." (unless (member load loads) (put symbol 'custom-loads (cons (purecopy load) loads))))) -(defun custom-autoload (symbol load) - "Mark SYMBOL as autoloaded custom variable and add dependency LOAD." - (put symbol 'custom-autoload t) +(defun custom-autoload (symbol load &optional noset) + "Mark SYMBOL as autoloaded custom variable and add dependency LOAD. +If NOSET is non-nil, don't bother autoloading LOAD when setting the variable." + (put symbol 'custom-autoload (if noset 'noset t)) (custom-add-load symbol load)) ;; This test is also in the C code of `user-variable-p'. @@ -699,10 +700,10 @@ Return non-nil iff the `customized-value' property actually changed." (customized (get symbol 'customized-value)) (old (or (get symbol 'saved-value) (get symbol 'standard-value)))) ;; Mark default value as set iff different from old value. - (if (or (null old) - (not (equal value (condition-case nil - (eval (car old)) - (error nil))))) + (if (not (and old + (equal value (condition-case nil + (eval (car old)) + (error nil))))) (progn (put symbol 'customized-value (list (custom-quote value))) (custom-push-theme 'theme-value symbol 'user 'set (custom-quote value))) @@ -827,13 +828,9 @@ See `custom-known-themes' for a list of known themes." (if (and (eq prop 'theme-value) (boundp symbol)) (let ((sv (get symbol 'standard-value))) - (when (and (null sv) (custom-variable-p symbol)) - (custom-load-symbol symbol) - (setq sv (get symbol 'standard-value))) - (if (or (null sv) - (not (equal (eval (car (get symbol 'standard-value))) - (symbol-value symbol)))) - (setq old (list (list 'changed (symbol-value symbol)))))) + (unless (and sv + (equal (eval (car sv)) (symbol-value symbol))) + (setq old (list (list 'changed (symbol-value symbol)))))) (if (and (facep symbol) (not (face-spec-match-p symbol (get symbol 'face-defface-spec)))) (setq old (list (list 'changed (list @@ -907,6 +904,10 @@ in SYMBOL's list property `theme-value' \(using `custom-push-theme')." (when requests (put symbol 'custom-requests requests) (mapc 'require requests)) + (unless (or (get symbol 'standard-value) + (memq (get symbol 'custom-autoload) '(nil noset))) + ;; This symbol needs to be autoloaded, even just for a `set'. + (custom-load-symbol symbol)) (setq set (or (get symbol 'custom-set) 'custom-set-default)) (put symbol 'saved-value (list value)) (put symbol 'saved-variable-comment comment) @@ -926,6 +927,8 @@ in SYMBOL's list property `theme-value' \(using `custom-push-theme')." (setq args (cdr args)) (and (or now (default-boundp symbol)) (put symbol 'variable-comment comment))) + ;; I believe this is dead-code, because the `sort' code above would + ;; have burped before we could get here. --Stef ;; Old format, a plist of SYMBOL VALUE pairs. (message "Warning: old format `custom-set-variables'") (ding) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index b4cb8933194..0942c6d1dff 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -745,19 +745,22 @@ Otherwise, the rule is a compression rule, and compression is done with gzip.") ;;; We don't recognize the file as compressed, so compress it. ;;; Try gzip; if we don't have that, use compress. (condition-case nil - (if (not (dired-check-process (concat "Compressing " file) - "gzip" "-f" file)) - (let ((out-name - (if (file-exists-p (concat file ".gz")) - (concat file ".gz") - (concat file ".z")))) - ;; Rename the compressed file to NEWNAME - ;; if it hasn't got that name already. - (if (and newname (not (equal newname out-name))) - (progn - (rename-file out-name newname t) - newname) - out-name))) + (let ((out-name (concat file ".gz"))) + (and (or (not (file-exists-p out-name)) + (y-or-n-p + (format "File %s already exists. Really compress? " + out-name))) + (not (dired-check-process (concat "Compressing " file) + "gzip" "-f" file)) + (or (file-exists-p out-name) + (setq out-name (concat file ".z"))) + ;; Rename the compressed file to NEWNAME + ;; if it hasn't got that name already. + (if (and newname (not (equal newname out-name))) + (progn + (rename-file out-name newname t) + newname) + out-name))) (file-error (if (not (dired-check-process (concat "Compressing " file) "compress" "-f" file)) diff --git a/lisp/dired.el b/lisp/dired.el index 64b73184397..59fb21a004f 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1260,6 +1260,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map "\C-tc" 'tumme-dired-comment-files) (define-key map "\C-tf" 'tumme-mark-tagged-files) (define-key map "\C-t\C-t" 'tumme-dired-insert-marked-thumbs) + (define-key map "\C-te" 'tumme-dired-edit-comment-and-tags) ;; Make menu bar items. diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el index 2d730c8af0f..5fb6d5a0f6b 100644 --- a/lisp/dos-w32.el +++ b/lisp/dos-w32.el @@ -88,10 +88,13 @@ against the file name, and TYPE is nil for text, t for binary.") (setq-default buffer-file-coding-system 'undecided-dos) (defun find-buffer-file-type-coding-system (command) - "Choose a coding system for a file operation. -If COMMAND is `insert-file-contents', the coding system is chosen based -upon the filename, the contents of `untranslated-filesystem-list' and -`file-name-buffer-file-type-alist', and whether the file exists: + "Choose a coding system for a file operation in COMMAND. +COMMAND is a list that specifies the operation, and I/O primitive as its +CAR, and the arguments that might be given to that operation as its CDR. +If operation is `insert-file-contents', the coding system is chosen based +upon the filename (the CAR of the arguments beyond the operation), the contents +of `untranslated-filesystem-list' and `file-name-buffer-file-type-alist', +and whether the file exists: If it matches in `untranslated-filesystem-list': If the file exists: `undecided' @@ -103,7 +106,7 @@ upon the filename, the contents of `untranslated-filesystem-list' and If the file exists: `undecided' If the file does not exist: default-buffer-file-coding-system -If COMMAND is `write-region', the coding system is chosen based upon +If operation is `write-region', the coding system is chosen based upon the value of `buffer-file-coding-system' and `buffer-file-type'. If `buffer-file-coding-system' is non-nil, its value is used. If it is nil and `buffer-file-type' is t, the coding system is `no-conversion'. @@ -126,6 +129,13 @@ set to the appropriate coding system, and the value of (undecided nil) (undecided-unix nil)) (cond ((eq op 'insert-file-contents) (setq target (nth 1 command)) + ;; If TARGET is a cons cell, it has the form (FILENAME . BUFFER), + ;; where BUFFER is a buffer into which the file was already read, + ;; but its contents were not yet decoded. (This form of the + ;; arguments is used, e.g., in arc-mode.el.) This function + ;; doesn't care about the contents, it only looks at the file's + ;; name, which is the CAR of the cons cell. + (if (consp target) (setq target (car target))) ;; First check for a file name that indicates ;; it is truly binary. (setq binary (find-buffer-file-type target)) diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el index 912f6b2d77f..d1710dba7a4 100644 --- a/lisp/emacs-lisp/authors.el +++ b/lisp/emacs-lisp/authors.el @@ -92,6 +92,7 @@ files.") "Kai.Grossjohann@Cs.Uni-Dortmund.De" "Kai.Grossjohann@Gmx.Net") ("Karl Berry" "K. Berry") + ("K,Aa(Broly L$,1 q(Brentey" "K,Aa(Broly L,Bu(Brentey" "L$,1 q(Brentey K,Aa(Broly") ("Kazushi Marukawa" "Kazushi") ("Ken Manheimer" "Kenneth Manheimer") ("Kenichi Handa" "Ken'ichi Handa" "Kenichi HANDA") diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 4000b4da282..da85cbd817a 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -124,7 +124,10 @@ or macro definition or a defcustom)." ) `(progn (defvar ,varname ,init ,doc) - (custom-autoload ',varname ,file)))) + (custom-autoload ',varname ,file + ,(condition-case nil + (null (cadr (memq :set form))) + (error nil)))))) ((eq car 'defgroup) ;; In Emacs this is normally handled separately by cus-dep.el, but for diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 41c940f1cec..50b7d8dc9ef 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -226,7 +226,12 @@ The search is done in the source for library LIBRARY." (regexp-symbol (cdr (assq type find-function-regexp-alist)))) (with-current-buffer (find-file-noselect filename) (let ((regexp (format (symbol-value regexp-symbol) - (regexp-quote (symbol-name symbol)))) + ;; Entry for ` (backquote) macro in loaddefs.el, + ;; (defalias (quote \`)..., has a \ but + ;; (symbol-name symbol) doesn't. Add an + ;; optional \ to catch this. + (concat "\\\\?" + (regexp-quote (symbol-name symbol))))) (case-fold-search)) (with-syntax-table emacs-lisp-mode-syntax-table (goto-char (point-min)) diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 245c274abd3..b16ae17eda0 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -305,11 +305,23 @@ If the value is nil, use a shifted prefix key to inhibit the override." (const :tag "No delay" nil)) :group 'cua) +(defcustom cua-delete-selection t + "*If non-nil, typed text replaces text in the active selection." + :type '(choice (const :tag "Disabled" nil) + (other :tag "Enabled" t)) + :group 'cua) + (defcustom cua-keep-region-after-copy nil "If non-nil, don't deselect the region after copying." :type 'boolean :group 'cua) +(defcustom cua-toggle-set-mark t + "*In non-nil, the `cua-set-mark' command toggles the mark." + :type '(choice (const :tag "Disabled" nil) + (other :tag "Enabled" t)) + :group 'cua) + (defcustom cua-enable-register-prefix 'not-ctrl-u "*If non-nil, registers are supported via numeric prefix arg. If the value is t, any numeric prefix arg in the range 0 to 9 will be @@ -391,7 +403,8 @@ and after the region marked by the rectangle to search." On non-window systems, always use the meta modifier. Must be set prior to enabling CUA." :type '(choice (const :tag "Meta key" meta) - (const :tag "Hyper key" hyper ) + (const :tag "Alt key" alt) + (const :tag "Hyper key" hyper) (const :tag "Super key" super)) :group 'cua) @@ -783,7 +796,7 @@ Save a copy in register 0 if `cua-delete-copy-to-register-0' is non-nil." (defun cua-replace-region () "Replace the active region with the character you type." (interactive) - (let ((not-empty (cua-delete-region))) + (let ((not-empty (and cua-delete-selection (cua-delete-region)))) (unless (eq this-original-command this-command) (let ((overwrite-mode (and overwrite-mode @@ -1001,7 +1014,7 @@ With a double \\[universal-argument] prefix argument, unconditionally set mark." (arg (setq this-command 'pop-to-mark-command) (pop-to-mark-command)) - (mark-active + ((and cua-toggle-set-mark mark-active) (cua--deactivate) (message "Mark Cleared")) (t diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index 43a66fd0e3e..7db3cca8fae 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -1361,6 +1361,7 @@ With prefix arg, indent to that column." (interactive) (let ((M (cond ((eq cua--rectangle-modifier-key 'hyper) " H-") ((eq cua--rectangle-modifier-key 'super) " s-") + ((eq cua--rectangle-modifier-key 'alt) " A-") (t " M-")))) (message (concat (if help "C-?:help" "") diff --git a/lisp/files.el b/lisp/files.el index 315c11de529..2b1446683be 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -44,7 +44,7 @@ (defcustom delete-auto-save-files t - "*Non-nil means delete auto-save file when a buffer is saved or killed. + "Non-nil means delete auto-save file when a buffer is saved or killed. Note that the auto-save file will not be deleted if the buffer is killed when it has unsaved changes." @@ -53,7 +53,7 @@ when it has unsaved changes." (defcustom directory-abbrev-alist nil - "*Alist of abbreviations for file directories. + "Alist of abbreviations for file directories. A list of elements of the form (FROM . TO), each meaning to replace FROM with TO when it appears in a directory name. This replacement is done when setting up the default directory of a newly visited file. @@ -74,7 +74,7 @@ the name it is linked to." ;; Turn off backup files on VMS since it has version numbers. (defcustom make-backup-files (not (eq system-type 'vax-vms)) - "*Non-nil means make a backup of a file the first time it is saved. + "Non-nil means make a backup of a file the first time it is saved. This can be done by renaming the file or by copying. Renaming means that Emacs renames the existing file so that it is a @@ -103,20 +103,20 @@ But it is local only if you make it local.") (put 'backup-inhibited 'permanent-local t) (defcustom backup-by-copying nil - "*Non-nil means always use copying to create backup files. + "Non-nil means always use copying to create backup files. See documentation of variable `make-backup-files'." :type 'boolean :group 'backup) (defcustom backup-by-copying-when-linked nil - "*Non-nil means use copying to create backups for files with multiple names. + "Non-nil means use copying to create backups for files with multiple names. This causes the alternate names to refer to the latest version as edited. This variable is relevant only if `backup-by-copying' is nil." :type 'boolean :group 'backup) (defcustom backup-by-copying-when-mismatch nil - "*Non-nil means create backups by copying if this preserves owner or group. + "Non-nil means create backups by copying if this preserves owner or group. Renaming may still be used (subject to control of other variables) when it would not result in changing the owner or group of the file; that is, for files which are owned by you and whose group matches @@ -126,7 +126,7 @@ This variable is relevant only if `backup-by-copying' is nil." :group 'backup) (defcustom backup-by-copying-when-privileged-mismatch 200 - "*Non-nil means create backups by copying to preserve a privileged owner. + "Non-nil means create backups by copying to preserve a privileged owner. Renaming may still be used (subject to control of other variables) when it would not result in changing the owner of the file or if the owner has a user id greater than the value of this variable. This is useful @@ -142,7 +142,7 @@ This variable is relevant only if `backup-by-copying' and Called with an absolute file name as argument, it returns t to enable backup.") (defcustom buffer-offer-save nil - "*Non-nil in a buffer means always offer to save buffer on exit. + "Non-nil in a buffer means always offer to save buffer on exit. Do so even if the buffer is not visiting a file. Automatically local in all buffers." :type 'boolean @@ -150,7 +150,7 @@ Automatically local in all buffers." (make-variable-buffer-local 'buffer-offer-save) (defcustom find-file-existing-other-name t - "*Non-nil means find a file under alternative names, in existing buffers. + "Non-nil means find a file under alternative names, in existing buffers. This means if any existing buffer is visiting the file you want under another name, you get the existing buffer instead of a new buffer." :type 'boolean @@ -165,7 +165,7 @@ both at the file level and at the levels of the containing directories." (put 'find-file-visit-truename 'safe-local-variable 'boolean) (defcustom revert-without-query nil - "*Specify which files should be reverted without query. + "Specify which files should be reverted without query. The value is a list of regular expressions. If the file name matches one of these regular expressions, then `revert-buffer' reverts the file without querying @@ -226,7 +226,7 @@ have fast storage with limited space, such as a RAM disk." "Regexp recognizing file names which aren't allowed by the filesystem.") (defcustom file-precious-flag nil - "*Non-nil means protect against I/O errors while saving files. + "Non-nil means protect against I/O errors while saving files. Some modes set this non-nil in particular buffers. This feature works by writing the new contents into a temporary file @@ -241,7 +241,7 @@ breaks any hard links between it and other files." :group 'backup) (defcustom version-control nil - "*Control use of version numbers for backup files. + "Control use of version numbers for backup files. t means make numeric backup versions unconditionally. nil means make them for files that have some already. `never' means do not make them." @@ -254,13 +254,13 @@ nil means make them for files that have some already. '(lambda (x) (or (booleanp x) (equal x 'never)))) (defcustom dired-kept-versions 2 - "*When cleaning directory, number of versions to keep." + "When cleaning directory, number of versions to keep." :type 'integer :group 'backup :group 'dired) (defcustom delete-old-versions nil - "*If t, delete excess backup versions silently. + "If t, delete excess backup versions silently. If nil, ask confirmation. Any other value prevents any trimming." :type '(choice (const :tag "Delete" t) (const :tag "Ask" nil) @@ -268,20 +268,20 @@ If nil, ask confirmation. Any other value prevents any trimming." :group 'backup) (defcustom kept-old-versions 2 - "*Number of oldest versions to keep when a new numbered backup is made." + "Number of oldest versions to keep when a new numbered backup is made." :type 'integer :group 'backup) (put 'kept-old-versions 'safe-local-variable 'integerp) (defcustom kept-new-versions 2 - "*Number of newest versions to keep when a new numbered backup is made. + "Number of newest versions to keep when a new numbered backup is made. Includes the new backup. Must be > 0" :type 'integer :group 'backup) (put 'kept-new-versions 'safe-local-variable 'integerp) (defcustom require-final-newline nil - "*Whether to add a newline automatically at the end of the file. + "Whether to add a newline automatically at the end of the file. A value of t means do this only when the file is about to be saved. A value of `visit' means do this right after the file is visited. @@ -299,7 +299,7 @@ from `mode-require-final-newline'." :group 'editing-basics) (defcustom mode-require-final-newline t - "*Whether to add a newline at end of file, in certain major modes. + "Whether to add a newline at end of file, in certain major modes. Those modes set `require-final-newline' to this value when you enable them. They do so because they are often used for files that are supposed to end in newlines, and the question is how to arrange that. @@ -322,12 +322,12 @@ a final newline, whenever you save a file that really needs one." :version "22.1") (defcustom auto-save-default t - "*Non-nil says by default do auto-saving of every file-visiting buffer." + "Non-nil says by default do auto-saving of every file-visiting buffer." :type 'boolean :group 'auto-save) (defcustom auto-save-visited-file-name nil - "*Non-nil says auto-save a buffer in the file it is visiting, when practical. + "Non-nil says auto-save a buffer in the file it is visiting, when practical. Normally auto-save files are written under other names." :type 'boolean :group 'auto-save) @@ -337,7 +337,7 @@ Normally auto-save files are written under other names." ;; Don't put "\\2" inside expand-file-name, since it will be ;; transformed to "/2" on DOS/Windows. ,(concat temporary-file-directory "\\2") t)) - "*Transforms to apply to buffer file name before making auto-save file name. + "Transforms to apply to buffer file name before making auto-save file name. Each transform is a list (REGEXP REPLACEMENT UNIQUIFY): REGEXP is a regular expression to match against the file name. If it matches, `replace-match' is used to replace the @@ -364,19 +364,19 @@ ignored." :version "21.1") (defcustom save-abbrevs t - "*Non-nil means save word abbrevs too when files are saved. + "Non-nil means save word abbrevs too when files are saved. If `silently', don't ask the user before saving." :type '(choice (const t) (const nil) (const silently)) :group 'abbrev) (defcustom find-file-run-dired t - "*Non-nil means allow `find-file' to visit directories. + "Non-nil means allow `find-file' to visit directories. To visit the directory, `find-file' runs `find-directory-functions'." :type 'boolean :group 'find-file) (defcustom find-directory-functions '(cvs-dired-noselect dired-noselect) - "*List of functions to try in sequence to visit a directory. + "List of functions to try in sequence to visit a directory. Each function is called with the directory name as the sole argument and should return either a buffer or nil." :type '(hook :options (cvs-dired-noselect dired-noselect)) @@ -448,7 +448,7 @@ use `before-save-hook'.") 'write-contents-functions "22.1") (defcustom enable-local-variables t - "*Control use of local variables in files you visit. + "Control use of local variables in files you visit. The value can be t, nil, :safe, or something else. A value of t means file local variables specifications are obeyed @@ -506,7 +506,7 @@ nil means ignore them; anything else means query." (defalias 'file-locked-p 'ignore)) (defcustom view-read-only nil - "*Non-nil means buffers visiting files read-only do so in view mode. + "Non-nil means buffers visiting files read-only do so in view mode. In fact, this means that all read-only buffers normally have View mode enabled, including buffers that are read-only because you visit a file you cannot alter, and buffers you make read-only @@ -1324,7 +1324,7 @@ removes automounter prefixes (see the variable `automount-dir-prefix')." filename))) (defcustom find-file-not-true-dirname-list nil - "*List of logical names for which visiting shouldn't save the true dirname. + "List of logical names for which visiting shouldn't save the true dirname. On VMS, when you visit a file using a logical name that searches a path, you may or may not want the visited file name to record the specific directory where the file was found. If you *do not* want that, add the logical @@ -1373,7 +1373,7 @@ If there is no such live buffer, return nil." found)))) (defcustom find-file-wildcards t - "*Non-nil means file-visiting commands should handle wildcards. + "Non-nil means file-visiting commands should handle wildcards. For example, if you specify `*.c', that would visit all the files whose names match the pattern." :group 'files @@ -1381,7 +1381,7 @@ whose names match the pattern." :type 'boolean) (defcustom find-file-suppress-same-file-warnings nil - "*Non-nil means suppress warning messages for symlinked files. + "Non-nil means suppress warning messages for symlinked files. When nil, Emacs prints a warning when visiting a file that is already visited, but with a different name. Setting this option to t suppresses this warning." @@ -2303,7 +2303,7 @@ symbol and VAL is a value that is considered safe." :type 'alist) (defcustom safe-local-eval-forms nil - "*Expressions that are considered safe in an `eval:' local variable. + "Expressions that are considered safe in an `eval:' local variable. Add expressions to this list if you want Emacs to evaluate them, when they appear in an `eval' local variable specification, without first asking you for confirmation." @@ -2765,7 +2765,7 @@ It is dangerous if either of these conditions are met: (defcustom change-major-mode-with-file-name t - "*Non-nil means \\[write-file] should set the major mode from the file name. + "Non-nil means \\[write-file] should set the major mode from the file name. However, the mode will not be changed if \(1) a local variables list or the `-*-' line specifies a major mode, or \(2) the current major mode is a \"special\" mode, @@ -4500,7 +4500,7 @@ by `sh' are supported." (defcustom list-directory-brief-switches (if (eq system-type 'vax-vms) "" "-CF") - "*Switches for `list-directory' to pass to `ls' for brief listing." + "Switches for `list-directory' to pass to `ls' for brief listing." :type 'string :group 'dired) @@ -4508,7 +4508,7 @@ by `sh' are supported." (if (eq system-type 'vax-vms) "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(OWNER:10)" "-l") - "*Switches for `list-directory' to pass to `ls' for verbose listing." + "Switches for `list-directory' to pass to `ls' for verbose listing." :type 'string :group 'dired) @@ -4639,7 +4639,7 @@ PATTERN that already quotes some of the special characters." "Absolute or relative name of the `ls' program used by `insert-directory'.") (defcustom directory-free-space-program "df" - "*Program to get the amount of free space on a file system. + "Program to get the amount of free space on a file system. We assume the output has the format of `df'. The value of this variable must be just a command name or file name; if you want to specify options, use `directory-free-space-args'. @@ -4653,7 +4653,7 @@ preference to the program given by this variable." (defcustom directory-free-space-args (if (eq system-type 'darwin) "-k" "-Pk") - "*Options to use when running `directory-free-space-program'." + "Options to use when running `directory-free-space-program'." :type 'string :group 'dired) diff --git a/lisp/find-file.el b/lisp/find-file.el index e15d6e62b0b..5618ba58dbe 100644 --- a/lisp/find-file.el +++ b/lisp/find-file.el @@ -189,12 +189,16 @@ To override this, give an argument to `ff-find-other-file'." ;; C/C++ include, for NeXTSTEP too ("^\#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]" . (lambda () - (setq fname (buffer-substring (match-beginning 2) (match-end 2))))) + (buffer-substring (match-beginning 2) (match-end 2)))) ) - "*A list of regular expressions for `ff-find-file'. -Specifies how to recognize special constructs such as include files -etc. and an associated method for extracting the filename from that -construct.") + ;; We include `ff-treat-as-special' documentation here so that autoload + ;; can make it available to be read prior to loading this file. + "*List of special constructs for `ff-treat-as-special' to recognize. +Each element, tried in order, has the form (REGEXP . EXTRACT). +If REGEXP matches the current line (from the beginning of the line), +`ff-treat-as-special' calls function EXTRACT with no args. +If EXTRACT returns nil, keep trying. Otherwise, return the +filename that EXTRACT returned.") (defvaralias 'ff-related-file-alist 'ff-other-file-alist) (defcustom ff-other-file-alist 'cc-other-file-alist @@ -405,9 +409,7 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window." (ff-list-replace-env-vars (symbol-value ff-search-directories)) (ff-list-replace-env-vars ff-search-directories))) - (save-excursion - (beginning-of-line 1) - (setq fname (ff-treat-as-special))) + (setq fname (ff-treat-as-special)) (cond ((and (not ff-ignore-include) fname) @@ -540,9 +542,7 @@ the `ff-ignore-include' variable." (ff-list-replace-env-vars (symbol-value ff-search-directories)) (ff-list-replace-env-vars ff-search-directories))) - (save-excursion - (beginning-of-line 1) - (setq fname (ff-treat-as-special))) + (setq fname (ff-treat-as-special)) (cond ((and (not ff-ignore-include) fname) @@ -771,20 +771,22 @@ The value used comes from `ff-case-fold-search'." (defun ff-treat-as-special () "Return the file to look for if the construct was special, else nil. -The construct is defined in the variable `ff-special-constructs'." - (let* (fname - (list ff-special-constructs) - (elem (car list)) - (regexp (car elem)) - (match (cdr elem))) - (while (and list (not fname)) - (if (and (looking-at regexp) match) - (setq fname (funcall match))) - (setq list (cdr list)) - (setq elem (car list)) - (setq regexp (car elem)) - (setq match (cdr elem))) - fname)) +See variable `ff-special-constructs'." + (save-excursion + (beginning-of-line 1) + (let* (fname + (list ff-special-constructs) + (elem (car list)) + (regexp (car elem)) + (match (cdr elem))) + (while (and list (not fname)) + (if (and (looking-at regexp) match) + (setq fname (funcall match))) + (setq list (cdr list)) + (setq elem (car list)) + (setq regexp (car elem)) + (setq match (cdr elem))) + fname))) (defun ff-basename (string) "Return the basename of pathname STRING." diff --git a/lisp/frame.el b/lisp/frame.el index f5d3f4b0c37..ff07999f804 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -776,7 +776,9 @@ the user during startup." "*Non-nil if window system changes focus when you move the mouse. You should set this variable to tell Emacs how your window manager handles focus, since there is no way in general for Emacs to find out -automatically." +automatically. + +This variable does not have any effect on MS-Windows." :type 'boolean :group 'frames :version "20.3") diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 825a8bce003..beccd918c3e 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,38 @@ +2006-07-19 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> + + * mm-url.el (mm-url-insert-file-contents): Inhibit Connection: close + workaround for the url package included with Emacs. + + * nnweb.el (nnweb-google-create-mapping): Update regexp. + +2006-07-18 Karl Fogel <kfogel@red-bean.com> + + * nnmail.el (nnmail-article-group): If splitting raises an error, give + some information about the error when saying that the `bogus' mail + group will be used. + +2006-07-18 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> + + [ Backported bug fixes from No Gnus. ] + + * nnweb.el (nnweb-google-parse-1): Update regexp for author and date. + (nnweb-google-search): Respect nnweb-max-hits as upper bound. + (nnweb-request-article): Do proper xwfu encoding when fetching articles + by message-id. + + * gnus-srvr.el (gnus-browse-unsubscribe-group): Don't subscribe + unsubscribed groups as if they were killed ones. It causes duplicate + entries in gnus-newsrc-alist. + +2006-07-17 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-sum.el (gnus-summary-delete-article): Don't use TAB in doc + string. + +2006-07-16 NAKAJI Hiroyuki <nakaji@heimat.jp> (tiny change) + + * mm-util.el (mm-charset-synonym-alist): Map windows-31j to cp932. + 2006-07-14 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> * gnus-start.el (gnus-subscribe-options-newsgroup-method): Doc fix. @@ -131,8 +166,7 @@ (mm-display-part): Simplify. (mm-inlinable-p): Add optional arg `type'. - * gnus-art.el (gnus-mime-view-part-as-type): Add optional PRED - argument. + * gnus-art.el (gnus-mime-view-part-as-type): Add optional PRED arg. (gnus-mime-view-part-externally, gnus-mime-view-part-internally): Try harder to show the attachment internally or externally using gnus-mime-view-part-as-type. @@ -142,8 +176,7 @@ * gnus-art.el (gnus-mime-view-part-as-type-internal): Try to fetch `filename' from Content-Disposition if Content-Type doesn't provide `name'. - (gnus-mime-view-part-as-type): Set default instead of - initial-input. + (gnus-mime-view-part-as-type): Set default instead of initial-input. 2006-04-28 Katsumi Yamaoka <yamaoka@jpl.org> @@ -166,8 +199,8 @@ * mml-sec.el (mml-secure-method): New internal variable. (mml-secure-sign, mml-secure-encrypt, mml-secure-message-sign) - (mml-secure-message-sign-encrypt, mml-secure-message-encrypt): New - functions using mml-secure-method. Sync from the trunk. + (mml-secure-message-sign-encrypt, mml-secure-message-encrypt): + New functions using mml-secure-method. Sync from the trunk. * mml.el (mml-mode-map): Add key bindings for those functions. (mml-menu): Simplify security menu entries. Suggested by Jesper @@ -211,8 +244,8 @@ 2006-04-20 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-util.el (gnus-replace-in-string): Prefer - replace-regexp-in-string over of replace-in-string. + * gnus-util.el (gnus-replace-in-string): + Prefer replace-regexp-in-string over of replace-in-string. 2006-04-20 Katsumi Yamaoka <yamaoka@jpl.org> @@ -220,8 +253,8 @@ * gnus-sum.el: Ditto. - * gnus-util.el (gnus-select-frame-set-input-focus): Use - select-frame-set-input-focus if it is available in XEmacs; use + * gnus-util.el (gnus-select-frame-set-input-focus): + Use select-frame-set-input-focus if it is available in XEmacs; use definition defined in Emacs 22 for old Emacsen. 2006-04-17 Reiner Steib <Reiner.Steib@gmx.de> @@ -233,13 +266,13 @@ (mm-charset-to-coding-system): Use it. (mm-codepage-setup): New helper function. (mm-charset-eval-alist): New variable. - (mm-charset-to-coding-system): Use mm-charset-eval-alist. Warn - about unknown charsets. Add allow-override. Use - `mm-charset-override-alist' only when decoding. + (mm-charset-to-coding-system): Use mm-charset-eval-alist. + Warn about unknown charsets. Add allow-override. + Use `mm-charset-override-alist' only when decoding. (mm-detect-mime-charset-region): Use :mime-charset. - * mm-bodies.el (mm-decode-body, mm-decode-string): Call - `mm-charset-to-coding-system' with allow-override argument. + * mm-bodies.el (mm-decode-body, mm-decode-string): + Call `mm-charset-to-coding-system' with allow-override argument. * message.el (message-tool-bar-zap-list, message-tool-bar) (message-tool-bar-gnome, message-tool-bar-retro): New variables. @@ -255,8 +288,8 @@ `gmm-tool-bar-from-list'. * gnus-group.el (gnus-group-tool-bar, gnus-group-tool-bar-gnome) - (gnus-group-tool-bar-retro, gnus-group-tool-bar-zap-list): New - variables. + (gnus-group-tool-bar-retro, gnus-group-tool-bar-zap-list): + New variables. (gnus-group-make-tool-bar): Complete rewrite using `gmm-tool-bar-from-list'. (gnus-group-tool-bar-update): New function. @@ -270,8 +303,8 @@ 2006-04-12 Reiner Steib <Reiner.Steib@gmx.de> - * gnus-art.el (gnus-article-mode): Set - cursor-in-non-selected-windows to nil. + * gnus-art.el (gnus-article-mode): + Set cursor-in-non-selected-windows to nil. 2006-04-12 Katsumi Yamaoka <yamaoka@jpl.org> @@ -302,8 +335,7 @@ 2006-04-11 Lars Magne Ingebrigtsen <larsi@gnus.org> - * nnslashdot.el (nnslashdot-retrieve-headers-1): Fix up to new - layout. + * nnslashdot.el (nnslashdot-retrieve-headers-1): Fix up to new layout. * rfc2047.el (rfc2047-decode-encoded-words): Don't message about unknown charset. @@ -365,13 +397,12 @@ * gnus-agent.el (gnus-agent-queue-mail): Fix custom tag for `t'. - * spam.el (spam-mark-new-messages-in-spam-group-as-spam): Add - comment on version. + * spam.el (spam-mark-new-messages-in-spam-group-as-spam): + Add comment on version. 2006-03-20 Teodor Zlatanov <tzz@lifelogs.com> - * spam.el (spam-mark-new-messages-in-spam-group-as-spam): New - variable. + * spam.el (spam-mark-new-messages-in-spam-group-as-spam): New variable. (spam-mark-junk-as-spam-routine): Use it. Allow to disable assigning the spam-mark to new messages. @@ -402,14 +433,14 @@ * gnus-art.el (gnus-article-only-boring-p): Bind inhibit-point-motion-hooks to avoid infinite loop when entering - intangible text. Reported by Ralf Wachinger - <rwnewsmampfer@geekmail.de>. + intangible text. + Reported by Ralf Wachinger <rwnewsmampfer@geekmail.de>. 2006-03-14 Simon Josefsson <jas@extundo.com> * message.el (message-unique-id): Don't use message-number-base36 - if (user-uid) is a float. Reported by Bjorn Solberg - <bjorn_ding1@hekneby.org>. + if (user-uid) is a float. + Reported by Bjorn Solberg <bjorn_ding1@hekneby.org>. 2006-03-13 Katsumi Yamaoka <yamaoka@jpl.org> diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 5d4f9c2a3f6..aabf8efbf6b 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -943,19 +943,23 @@ If NUMBER, fetch this number of articles." (progn ;; Make sure the group has been properly removed before we ;; subscribe to it. - (gnus-kill-ephemeral-group group) + (if (gnus-ephemeral-group-p group) + (gnus-kill-ephemeral-group group)) + ;; We need to discern between killed/zombie groups and + ;; just unsubscribed ones. (gnus-group-change-level - (list t group gnus-level-default-subscribed - nil nil (if (gnus-server-equal - gnus-browse-current-method "native") - nil - (gnus-method-simplify - gnus-browse-current-method))) + (or (gnus-group-entry group) + (list t group gnus-level-default-subscribed + nil nil (if (gnus-server-equal + gnus-browse-current-method "native") + nil + (gnus-method-simplify + gnus-browse-current-method)))) gnus-level-default-subscribed (gnus-group-level group) (and (car (nth 1 gnus-newsrc-alist)) (gnus-gethash (car (nth 1 gnus-newsrc-alist)) gnus-newsrc-hashtb)) - t) + (null (gnus-group-entry group))) (delete-char 1) (insert ? )) (gnus-group-change-level diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 66ab41950d1..b94d093329a 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -9510,7 +9510,7 @@ deleted forever, right now." ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. (defun gnus-summary-delete-article (&optional n) "Delete the N next (mail) articles. -This command actually deletes articles. This is not a marking +This command actually deletes articles. This is not a marking command. The article will disappear forever from your life, never to return. diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index ba21247f356..5e228f0af72 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -301,7 +301,13 @@ If `mm-url-use-external' is non-nil, use `mm-url-program'." (list url (buffer-size))) (mm-url-load-url) (let ((name buffer-file-name) - (url-request-extra-headers (list (cons "Connection" "Close"))) + (url-request-extra-headers + ;; ISTM setting a Connection header was a workaround for + ;; older versions of url included with w3, but it does more + ;; harm than good with the one shipped with Emacs. --ansel + (if (not (and (boundp 'url-version) + (equal url-version "Emacs"))) + (list (cons "Connection" "Close")))) (url-package-name (or mm-url-package-name url-package-name)) (url-package-version (or mm-url-package-version diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 634d1f66675..26a1bf23e84 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -204,19 +204,19 @@ the alias. Else windows-NUMBER is used." `( ;; Not in XEmacs, but it's not a proper MIME charset anyhow. ,@(unless (mm-coding-system-p 'x-ctext) - '((x-ctext . ctext))) + '((x-ctext . ctext))) ;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_! ,@(unless (mm-coding-system-p 'iso-8859-15) - '((iso-8859-15 . iso-8859-1))) + '((iso-8859-15 . iso-8859-1))) ;; BIG-5HKSCS is similar to, but different than, BIG-5. ,@(unless (mm-coding-system-p 'big5-hkscs) '((big5-hkscs . big5))) ;; Windows-1252 is actually a superset of Latin-1. See also ;; `gnus-article-dumbquotes-map'. ,@(unless (mm-coding-system-p 'windows-1252) - (if (mm-coding-system-p 'cp1252) - '((windows-1252 . cp1252)) - '((windows-1252 . iso-8859-1)))) + (if (mm-coding-system-p 'cp1252) + '((windows-1252 . cp1252)) + '((windows-1252 . iso-8859-1)))) ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft ;; Outlook users in Czech republic. Use this to allow reading of their ;; e-mails. cp1250 should be defined by M-x codepage-setup. @@ -232,6 +232,10 @@ the alias. Else windows-NUMBER is used." (if (mm-coding-system-p 'cp949) '((ks_c_5601-1987 . cp949)) '((ks_c_5601-1987 . euc-kr)))) + ;; Windows-31J is Windows Codepage 932. + ,@(if (and (not (mm-coding-system-p 'windows-31j)) + (mm-coding-system-p 'cp932)) + '((windows-31j . cp932))) ) "A mapping from unknown or invalid charset names to the real charset names.") diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index f4275fa8ed5..98af7ba41f2 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -1131,7 +1131,7 @@ FUNC will be called with the group name to determine the article number." (if (and (symbolp nnmail-split-methods) (fboundp nnmail-split-methods)) (let ((split - (condition-case nil + (condition-case error-info ;; `nnmail-split-methods' is a function, so we ;; just call this function here and use the ;; result. @@ -1139,7 +1139,7 @@ FUNC will be called with the group name to determine the article number." '("bogus")) (error (nnheader-message - 5 "Error in `nnmail-split-methods'; using `bogus' mail group") + 5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info) (sit-for 1) '("bogus"))))) (setq split (mm-delete-duplicates split)) diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index a67d5a469f6..7c0c8e0e444 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -171,7 +171,8 @@ Valid types include `google', `dejanews', and `gmane'.") (when (string-match "^<\\(.*\\)>$" article) (setq art (match-string 1 article))) (when (and fetch art) - (setq url (format fetch art)) + (setq url (format fetch + (mm-url-form-encode-xwfu art))) (mm-with-unibyte-current-buffer (mm-url-insert url)) (if (nnweb-definition 'reference t) @@ -365,7 +366,7 @@ Valid types include `google', `dejanews', and `gmane'.") (mm-url-decode-entities) (search-backward " - ") (when (looking-at - " - \\([a-zA-Z]+\\) \\([0-9]+\\)\\(?: \\([0-9]\\{4\\}\\)\\)?, [^\n]+by \\([^<\n]+\\)\n") + " - \\([a-zA-Z]+\\) \\([0-9]+\\)\\(?: \\([0-9]\\{4\\}\\)\\)?[^\n]+by ?\n?\\([^<\n]+\\)\n") (setq From (match-string 4) Date (format "%s %s 00:00:00 %s" (match-string 1) @@ -415,7 +416,7 @@ Valid types include `google', `dejanews', and `gmane'.") (goto-char (point-min)) (incf i 100) (if (or (not (re-search-forward - "<a href=\"\n\\([^>\" \n\t]+\\)[^<]*<img src=[^>]+next" + "<a [^>]+href=\"\n?\\([^>\" \n\t]+\\)[^<]*<img[^>]+src=[^>]+next" nil t)) (>= i nnweb-max-hits)) (setq more nil) @@ -437,7 +438,8 @@ Valid types include `google', `dejanews', and `gmane'.") "?" (mm-url-encode-www-form-urlencoded `(("q" . ,search) - ("num" . "100") + ("num" . ,(number-to-string + (min 100 nnweb-max-hits))) ("hq" . "") ("hl" . "en") ("lr" . "") diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 7cdf78fbe13..ce79e618cd5 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -157,8 +157,9 @@ The format is (FUNCTION ARGS...).") (let ((location (find-function-search-for-symbol fun nil file))) (pop-to-buffer (car location)) - (when (cdr location) - (goto-char (cdr location))))) + (if (cdr location) + (goto-char (cdr location)) + (message "Unable to find location in file")))) 'help-echo (purecopy "mouse-2, RET: find function's definition")) (define-button-type 'help-variable-def @@ -168,8 +169,9 @@ The format is (FUNCTION ARGS...).") (setq file (help-C-file-name var 'var))) (let ((location (find-variable-noselect var file))) (pop-to-buffer (car location)) - (when (cdr location) - (goto-char (cdr location))))) + (if (cdr location) + (goto-char (cdr location)) + (message "Unable to find location in file")))) 'help-echo (purecopy "mouse-2, RET: find variable's definition")) (define-button-type 'help-face-def @@ -181,8 +183,9 @@ The format is (FUNCTION ARGS...).") (let ((location (find-function-search-for-symbol fun 'defface file))) (pop-to-buffer (car location)) - (when (cdr location) - (goto-char (cdr location))))) + (if (cdr location) + (goto-char (cdr location)) + (message "Unable to find location in file")))) 'help-echo (purecopy "mouse-2, RET: find face's definition")) diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index b5f9c4f1bcf..29767cee7f6 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -66,7 +66,7 @@ the ability to filter the displayed buffers by various criteria." (defcustom ibuffer-formats '((mark modified read-only " " (name 18 18 :left :elide) " " (size 9 -1 :right) - " " (mode 16 16 :right :elide) " " filename-and-process) + " " (mode 16 16 :left :elide) " " filename-and-process) (mark " " (name 16 -1) " " filename)) "A list of ways to display buffer lines. diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 66d7fb6c16a..523ef3f73a8 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -118,6 +118,9 @@ information on these modes." (if (get-text-property (point-min) 'display) (image-toggle-display))) +(defvar archive-superior-buffer) +(defvar tar-superior-buffer) + (defun image-toggle-display () "Start or stop displaying an image file as the actual image. This command toggles between showing the text of the image file diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 1cd077413c3..aecf2128456 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -831,7 +831,7 @@ re-visited and edited.) Optional 3rd arg DEFAULT-CODING-SYSTEM specifies a coding system or a list of coding systems to be prepended to the default coding system list. However, if DEFAULT-CODING-SYSTEM is a list and the first -element is t, the cdr part is used as the defualt coding system list, +element is t, the cdr part is used as the default coding system list, i.e. `buffer-file-coding-system', `default-buffer-file-coding-system', and the most preferred coding system are not used. @@ -898,9 +898,6 @@ It is highly recommended to fix it before writing to a file." (rassq base default-coding-system) (push (cons auto-cs base) default-coding-system)))) - ;; From now on, the list of defaults is reversed. - (setq default-coding-system (nreverse default-coding-system)) - (unless no-other-defaults ;; If buffer-file-coding-system is not nil nor undecided, append it ;; to the defaults. @@ -908,8 +905,9 @@ It is highly recommended to fix it before writing to a file." (let ((base (coding-system-base buffer-file-coding-system))) (or (eq base 'undecided) (rassq base default-coding-system) - (push (cons buffer-file-coding-system base) - default-coding-system)))) + (setq default-coding-system + (append default-coding-system + (list (cons buffer-file-coding-system base))))))) ;; If default-buffer-file-coding-system is not nil nor undecided, ;; append it to the defaults. @@ -917,8 +915,10 @@ It is highly recommended to fix it before writing to a file." (let ((base (coding-system-base default-buffer-file-coding-system))) (or (eq base 'undecided) (rassq base default-coding-system) - (push (cons default-buffer-file-coding-system base) - default-coding-system)))) + (setq default-coding-system + (append default-coding-system + (list (cons default-buffer-file-coding-system + base))))))) ;; If the most preferred coding system has the property mime-charset, ;; append it to the defaults. @@ -930,18 +930,40 @@ It is highly recommended to fix it before writing to a file." (setq base (coding-system-base preferred)) (coding-system-get preferred 'mime-charset) (not (rassq base default-coding-system)) - (push (cons preferred base) - default-coding-system)))) + (setq default-coding-system + (append default-coding-system + (list (cons preferred base))))))) (if select-safe-coding-system-accept-default-p (setq accept-default-p select-safe-coding-system-accept-default-p)) + ;; Decide the eol-type from the top of the default codings, + ;; buffer-file-coding-system, or + ;; default-buffer-file-coding-system. + (if default-coding-system + (let ((default-eol-type (coding-system-eol-type + (caar default-coding-system)))) + (if (and (vectorp default-eol-type) buffer-file-coding-system) + (setq default-eol-type (coding-system-eol-type + buffer-file-coding-system))) + (if (and (vectorp default-eol-type) default-buffer-file-coding-system) + (setq default-eol-type (coding-system-eol-type + default-buffer-file-coding-system))) + (if (and default-eol-type (not (vectorp default-eol-type))) + (dolist (elt default-coding-system) + (setcar elt (coding-system-change-eol-conversion + (car elt) default-eol-type)))))) + (let ((codings (find-coding-systems-region from to)) (coding-system nil) safe rejected unsafe) (if (eq (car codings) 'undecided) ;; Any coding system is ok. - (setq coding-system t) + (setq coding-system (caar default-coding-system)) + ;; Reverse the list so that elements are accumulated in safe, + ;; rejected, and unsafe in the correct order. + (setq default-coding-system (nreverse default-coding-system)) + ;; Classify the defaults into safe, rejected, and unsafe. (dolist (elt default-coding-system) (if (memq (cdr elt) codings) @@ -958,14 +980,6 @@ It is highly recommended to fix it before writing to a file." (setq coding-system (select-safe-coding-system-interactively from to codings unsafe rejected (car codings)))) - (if (vectorp (coding-system-eol-type coding-system)) - (let ((eol (coding-system-eol-type buffer-file-coding-system))) - (if (numberp eol) - (setq coding-system - (coding-system-change-eol-conversion coding-system eol))))) - - (if (eq coding-system t) - (setq coding-system buffer-file-coding-system)) ;; Check we're not inconsistent with what `coding:' spec &c would ;; give when file is re-read. ;; But don't do this if we explicitly ignored the cookie diff --git a/lisp/mouse.el b/lisp/mouse.el index 145eb76446f..043c78578db 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -777,8 +777,8 @@ If the click is in the echo area, display the `*Messages*' buffer." (defun mouse-on-link-p (pos) "Return non-nil if POS is on a link in the current buffer. -POS must be a buffer position in the current buffer or an mouse -event location in the selected window, see `event-start'. +POS must be a buffer position in the current buffer or a mouse +event location in the selected window (see `event-start'). However, if `mouse-1-click-in-non-selected-windows' is non-nil, POS may be a mouse event location in any window. @@ -798,7 +798,7 @@ is a non-nil `mouse-face' property at POS. Return t in this case. - If the value is a function, FUNC, POS is inside a link if the call \(FUNC POS) returns non-nil. Return the return value -from that call. Arg is \(posn-point POS) if POS is a mouse event, +from that call. Arg is \(posn-point POS) if POS is a mouse event. - Otherwise, return the value itself. diff --git a/lisp/pgg-def.el b/lisp/pgg-def.el index 058dca4fa8f..6481a433423 100644 --- a/lisp/pgg-def.el +++ b/lisp/pgg-def.el @@ -87,7 +87,7 @@ Whether the passphrase is cached at all is controlled by "If t, inform the recipient that the input is text.") (defmacro pgg-truncate-key-identifier (key) - `(if (> (length ,key) 8) (substring ,key 8) ,key)) + `(if (> (length ,key) 8) (substring ,key -8) ,key)) (provide 'pgg-def) diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index 9dc74264da8..bc00d859c2d 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -1208,60 +1208,36 @@ If you use ada-xref.el: ff-file-created-hook 'ada-make-body) (add-hook 'ff-pre-load-hook 'ada-which-function-are-we-in) - ;; Some special constructs for find-file.el - ;; We do not need to add the construction for 'with', which is in the - ;; standard find-file.el + ;; Some special constructs for find-file.el. (make-local-variable 'ff-special-constructs) - - ;; Go to the parent package : - (add-to-list 'ff-special-constructs - (cons (eval-when-compile - (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+" - "\\(body[ \t]+\\)?" - "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is")) - (lambda () - (if (fboundp 'ff-get-file) - (if (boundp 'fname) - (set 'fname (ff-get-file - ada-search-directories-internal - (ada-make-filename-from-adaname - (match-string 3)) - ada-spec-suffixes))))))) - ;; Another special construct for find-file.el : when in a separate clause, - ;; go to the correct package. - (add-to-list 'ff-special-constructs - (cons "^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))" - (lambda () - (if (fboundp 'ff-get-file) - (if (boundp 'fname) - (setq fname (ff-get-file - ada-search-directories-internal - (ada-make-filename-from-adaname - (match-string 1)) - ada-spec-suffixes))))))) - - ;; Another special construct, that redefines the one in find-file.el. The - ;; old one can handle only one possible type of extension for Ada files - ;; remove from the list the standard "with..." that is put by find-file.el, - ;; since it uses the old ada-spec-suffix variable - ;; This one needs to replace the standard one defined in find-file.el (with - ;; Emacs <= 20.4), since that one uses the old variable ada-spec-suffix - (let ((old-construct - (assoc "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)" ff-special-constructs)) - (new-cdr - (lambda () - (if (fboundp 'ff-get-file) - (if (boundp 'fname) - (set 'fname (ff-get-file - ada-search-directories-internal - (ada-make-filename-from-adaname - (match-string 1)) - ada-spec-suffixes))))))) - (if old-construct - (setcdr old-construct new-cdr) - (add-to-list 'ff-special-constructs - (cons "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)" - new-cdr)))) + (mapc (lambda (pair) + (add-to-list 'ff-special-constructs pair)) + `( + ;; Go to the parent package. + (,(eval-when-compile + (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+" + "\\(body[ \t]+\\)?" + "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is")) + . ,(lambda () + (ff-get-file + ada-search-directories-internal + (ada-make-filename-from-adaname (match-string 3)) + ada-spec-suffixes))) + ;; A "separate" clause. + ("^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))" + . ,(lambda () + (ff-get-file + ada-search-directories-internal + (ada-make-filename-from-adaname (match-string 1)) + ada-spec-suffixes))) + ;; A "with" clause. + ("^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)" + . ,(lambda () + (ff-get-file + ada-search-directories-internal + (ada-make-filename-from-adaname (match-string 1)) + ada-spec-suffixes))) + )) ;; Support for outline-minor-mode (set (make-local-variable 'outline-regexp) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index e7a0d03cc55..d29e75e92f0 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -134,12 +134,18 @@ (eval-and-compile ;; These are used to collect the init forms from the subsequent - ;; `c-lang-defvar'. They are used to build the lambda in - ;; `c-make-init-lang-vars-fun' below. + ;; `c-lang-defvar' and `c-lang-setvar'. They are used to build the + ;; lambda in `c-make-init-lang-vars-fun' below, and to build `defvar's + ;; and `make-variable-buffer-local's in cc-engine and + ;; `make-local-variable's in `c-init-language-vars-for'. (defvar c-lang-variable-inits nil) (defvar c-lang-variable-inits-tail nil) (setq c-lang-variable-inits (list nil) - c-lang-variable-inits-tail c-lang-variable-inits)) + c-lang-variable-inits-tail c-lang-variable-inits) + (defvar c-emacs-variable-inits nil) + (defvar c-emacs-variable-inits-tail nil) + (setq c-emacs-variable-inits (list nil) + c-emacs-variable-inits-tail c-emacs-variable-inits)) (defmacro c-lang-defvar (var val &optional doc) "Declares the buffer local variable VAR to get the value VAL. VAL is @@ -172,6 +178,25 @@ the evaluated constant value at compile time." ;; Return the symbol, like the other def* forms. `',var) +(defmacro c-lang-setvar (var val) + "Causes the variable VAR to be made buffer local and to get set to the +value VAL. VAL is evaluated and assigned at mode initialization. More +precisely, VAL is evaluated and bound to VAR when the result from the +macro `c-init-language-vars' is evaluated. VAR is typically a standard +Emacs variable like `comment-start'. + +`c-lang-const' is typically used in VAL to get the right value for the +language being initialized, and such calls will be macro expanded to +the evaluated constant value at compile time." + (let ((elem (assq var (cdr c-emacs-variable-inits)))) + (if elem + (setcdr elem (list val)) ; Maybe remove "list", sometime. 2006-07-19 + (setcdr c-emacs-variable-inits-tail (list (list var val))) + (setq c-emacs-variable-inits-tail (cdr c-emacs-variable-inits-tail)))) + + ;; Return the symbol, like the other def* forms. + `',var) + (put 'c-lang-defvar 'lisp-indent-function 'defun) ; (eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el. ; ' @@ -1103,8 +1128,7 @@ properly." ;; In C we still default to the block comment style since line ;; comments aren't entirely portable. c "/* ") -(c-lang-defvar comment-start (c-lang-const comment-start) - 'dont-doc) +(c-lang-setvar comment-start (c-lang-const comment-start)) (c-lang-defconst comment-end "String that ends comments inserted with M-; etc. @@ -1117,8 +1141,7 @@ properly." (c-lang-const comment-start)) (concat " " (c-lang-const c-block-comment-ender)) "")) -(c-lang-defvar comment-end (c-lang-const comment-end) - 'dont-doc) +(c-lang-setvar comment-end (c-lang-const comment-end)) (c-lang-defconst comment-start-skip "Regexp to match the start of a comment plus everything up to its body. @@ -1134,8 +1157,7 @@ properly." (c-lang-const c-block-comment-starter))) "\\|") "\\)\\s *")) -(c-lang-defvar comment-start-skip (c-lang-const comment-start-skip) - 'dont-doc) +(c-lang-setvar comment-start-skip (c-lang-const comment-start-skip)) (c-lang-defconst c-syntactic-ws-start ;; Regexp matching any sequence that can start syntactic whitespace. @@ -2806,9 +2828,10 @@ way." ;;; Wrap up the `c-lang-defvar' system. ;; Compile in the list of language variables that has been collected -;; with the `c-lang-defvar' macro. Note that the first element is -;; nil. +;; with the `c-lang-defvar' and `c-lang-setvar' macros. Note that the +;; first element of each is nil. (defconst c-lang-variable-inits (cc-eval-when-compile c-lang-variable-inits)) +(defconst c-emacs-variable-inits (cc-eval-when-compile c-emacs-variable-inits)) (defun c-make-init-lang-vars-fun (mode) "Create a function that initializes all the language dependent variables @@ -2841,12 +2864,16 @@ accomplish that conveniently." ;; `c-lang-const' will expand to the evaluated ;; constant immediately in `cl-macroexpand-all' ;; below. - (mapcan - (lambda (init) - `(current-var ',(car init) - ,(car init) ,(cl-macroexpand-all - (elt init 1)))) - (cdr c-lang-variable-inits)))) + (mapcan + (lambda (init) + `(current-var ',(car init) + ,(car init) ,(cl-macroexpand-all + (elt init 1)))) + ;; Note: The following `append' copies the + ;; first argument. That list is small, so + ;; this doesn't matter too much. + (append (cdr c-emacs-variable-inits) + (cdr c-lang-variable-inits))))) ;; This diagnostic message isn't useful for end ;; users, so it's disabled. @@ -2859,7 +2886,8 @@ accomplish that conveniently." (require 'cc-langs) (setq source-eval t) - (let ((init (cdr c-lang-variable-inits))) + (let ((init (append (cdr c-emacs-variable-inits) + (cdr c-lang-variable-inits)))) (while init (setq current-var (caar init)) (set (caar init) (eval (cadar init))) @@ -2867,7 +2895,7 @@ accomplish that conveniently." (error (if current-var - (message "Eval error in the `c-lang-defvar' for `%s'%s: %S" + (message "Eval error in the `c-lang-defvar' or `c-lang-setvar' for `%s'%s: %S" current-var (if source-eval (format "\ @@ -2883,7 +2911,8 @@ accomplish that conveniently." `(lambda () (require 'cc-langs) (let ((c-buffer-is-cc-mode ',mode) - (init (cdr c-lang-variable-inits)) + (init (append (cdr c-emacs-variable-inits) + (cdr c-lang-variable-inits))) current-var) (condition-case err @@ -2895,7 +2924,7 @@ accomplish that conveniently." (error (if current-var (message - "Eval error in the `c-lang-defvar' for `%s' (source eval): %S" + "Eval error in the `c-lang-defvar' or `c-lang-setver' for `%s' (source eval): %S" current-var err) (signal (car err) (cdr err))))))) )) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 7343ec735ea..eb5ae4b63b6 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -153,12 +153,21 @@ (defun c-leave-cc-mode-mode () (setq c-buffer-is-cc-mode nil)) +;; Make the `c-lang-setvar' variables buffer local in the current buffer. +;; These are typically standard emacs variables such as `comment-start'. +(defmacro c-make-emacs-variables-local () + `(progn + ,@(mapcan (lambda (init) + `((make-local-variable ',(car init)))) + (cdr c-emacs-variable-inits)))) + (defun c-init-language-vars-for (mode) "Initialize the language variables for one of the language modes directly supported by CC Mode. This can be used instead of the `c-init-language-vars' macro if the language you want to use is one of those, rather than a derived language defined through the language variable system (see \"cc-langs.el\")." + (c-make-emacs-variables-local) (cond ((eq mode 'c-mode) (c-init-language-vars c-mode)) ((eq mode 'c++-mode) (c-init-language-vars c++-mode)) ((eq mode 'objc-mode) (c-init-language-vars objc-mode)) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 3c63d5f01b1..e8c09113d39 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -226,14 +226,19 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) ;; I have no idea what this first line is supposed to match, but it ;; makes things ambiguous with output such as "foo:344:50:blabla" since ;; the "foo" part can match this first line (in which case the file - ;; name as "344"). To avoid this, we disallow filenames exclusively - ;; composed of digits. --Stef + ;; name as "344"). To avoid this, the second line disallows filenames + ;; exclusively composed of digits. --Stef + ;; Similarly, we get lots of false positives with messages including + ;; times of the form "HH:MM:SS" where MM is taken as a line number, so + ;; the last line tries to rule out message where the info after the + ;; line number starts with "SS". --Stef "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\ \\([0-9]*[^0-9\n].*?\\): ?\ \\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\ \\(?:-\\([0-9]+\\)?\\(?:\\3\\([0-9]+\\)\\)?\\)?:\ \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\ - *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|instantiated from\\)\\)?" + *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|instantiated from\\)\\|\ +\[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)" 1 (2 . 5) (4 . 6) (7 . 8)) (lcc @@ -405,10 +410,7 @@ you may also want to change `compilation-page-delimiter'.") "Value of `page-delimiter' in Compilation mode.") (defvar compilation-mode-font-lock-keywords - '(;; Don't highlight this as a compilation message. - ("^Compilation started at.*" - (0 '(face nil message nil help-echo nil mouse-face nil) t)) - ;; configure output lines. + '(;; configure output lines. ("^[Cc]hecking \\(?:[Ff]or \\|[Ii]f \\|[Ww]hether \\(?:to \\)?\\)?\\(.+\\)\\.\\.\\. *\\(?:(cached) *\\)?\\(\\(yes\\(?: .+\\)?\\)\\|no\\|\\(.*\\)\\)$" (1 font-lock-variable-name-face) (2 (compilation-face '(4 . 3)))) @@ -419,7 +421,7 @@ you may also want to change `compilation-page-delimiter'.") ("^Compilation \\(finished\\).*" (0 '(face nil message nil help-echo nil mouse-face nil) t) (1 compilation-info-face)) - ("^Compilation \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?.*" + ("^Compilation \\(exited abnormally\\|interrupt\\|killed\\|terminated\\|segmentation fault\\)\\(?:.*with code \\([0-9]+\\)\\)?.*" (0 '(face nil message nil help-echo nil mouse-face nil) t) (1 compilation-error-face) (2 compilation-error-face nil t))) @@ -1823,28 +1825,44 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user." (find-file-noselect name)) fmts (cdr fmts))) (setq dirs (cdr dirs))) - (or buffer - ;; The file doesn't exist. Ask the user where to find it. - (save-excursion ;This save-excursion is probably not right. - (let ((pop-up-windows t)) - (compilation-set-window (display-buffer (marker-buffer marker)) - marker) - (let ((name (expand-file-name - (read-file-name - (format "Find this %s in (default %s): " - compilation-error filename) - spec-dir filename t)))) - (if (file-directory-p name) - (setq name (expand-file-name filename name))) - (setq buffer (and (file-exists-p name) - (find-file-noselect name))))))) + (while (null buffer) ;Repeat until the user selects an existing file. + ;; The file doesn't exist. Ask the user where to find it. + (save-excursion ;This save-excursion is probably not right. + (let ((pop-up-windows t)) + (compilation-set-window (display-buffer (marker-buffer marker)) + marker) + (let* ((name (read-file-name + (format "Find this %s in (default %s): " + compilation-error filename) + spec-dir filename t nil + ;; Try to make sure the user can only select + ;; a valid answer. This predicate may be ignored, + ;; tho, so we still have to double-check afterwards. + ;; TODO: We should probably fix read-file-name so + ;; that it never ignores this predicate, even when + ;; using popup dialog boxes. + (lambda (name) + (if (file-directory-p name) + (setq name (expand-file-name filename name))) + (file-exists-p name)))) + (origname name)) + (cond + ((not (file-exists-p name)) + (message "Cannot find file `%s'" name) + (ding) (sit-for 2)) + ((and (file-directory-p name) + (not (file-exists-p + (setq name (expand-file-name filename name))))) + (message "No `%s' in directory %s" filename origname) + (ding) (sit-for 2)) + (t + (setq buffer (find-file-noselect name)))))))) ;; Make intangible overlays tangible. - ;; This is very weird: it's not even clear which is the current buffer, - ;; so the code below can't be expected to DTRT here. --Stef - (mapcar (function (lambda (ov) - (when (overlay-get ov 'intangible) - (overlay-put ov 'intangible nil)))) - (overlays-in (point-min) (point-max))) + ;; This is weird: it's not even clear which is the current buffer, + ;; so the code below can't be expected to DTRT here. -- Stef + (dolist (ov (overlays-in (point-min) (point-max))) + (when (overlay-get ov 'intangible) + (overlay-put ov 'intangible nil))) buffer)) (defun compilation-get-file-structure (file &optional fmt) diff --git a/lisp/progmodes/delphi.el b/lisp/progmodes/delphi.el index 03ab24adf47..44a192ab772 100644 --- a/lisp/progmodes/delphi.el +++ b/lisp/progmodes/delphi.el @@ -1767,6 +1767,7 @@ it is a routine." An error is raised if not in a comment." (interactive) (save-excursion + (save-restriction (let* ((comment (delphi-current-token)) (comment-kind (delphi-token-kind comment))) (if (not (delphi-is comment-kind delphi-comments)) @@ -1845,7 +1846,7 @@ An error is raised if not in a comment." ;; React to the entire fill change as a whole. (delphi-progress-start) (delphi-parse-region comment-start comment-end) - (delphi-progress-done)))))) + (delphi-progress-done))))))) (defun delphi-new-comment-line () "If in a // comment, does a newline, indented such that one is still in the diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index 810a7b3e973..dca6fa16df0 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -434,7 +434,8 @@ With arg, use separate IO iff arg is positive." (make-local-variable 'gdb-define-alist) (gdb-create-define-alist) (add-hook 'after-save-hook 'gdb-create-define-alist nil t)))))) - (gdb-force-mode-line-update "ready")) + (gdb-force-mode-line-update + (propertize "ready" 'face font-lock-variable-name-face))) (defun gdb-find-watch-expression () (let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list)) @@ -1209,7 +1210,8 @@ This filter may simply queue input for a later time." (defun gdb-resync() (setq gdb-flush-pending-output t) (setq gud-running nil) - (gdb-force-mode-line-update "stopped") + (gdb-force-mode-line-update + (propertize "stopped"'face font-lock-warning-face)) (setq gdb-output-sink 'user) (setq gdb-input-queue nil) (setq gdb-pending-triggers nil) @@ -1249,7 +1251,8 @@ happens to be in effect." "An annotation handler for `prompt'. This sends the next command (if any) to gdb." (when gdb-first-prompt - (gdb-force-mode-line-update "initializing...") + (gdb-force-mode-line-update + (propertize "initializing..." 'face font-lock-variable-name-face)) (gdb-init-1) (setq gdb-first-prompt nil)) (let ((sink gdb-output-sink)) @@ -1287,7 +1290,8 @@ not GDB." (progn (setq gud-running t) (setq gdb-inferior-status "running") - (gdb-force-mode-line-update gdb-inferior-status) + (gdb-force-mode-line-update + (propertize gdb-inferior-status 'face font-lock-type-face)) (gdb-remove-text-properties) (setq gud-old-arrow gud-overlay-arrow-position) (setq gud-overlay-arrow-position nil) @@ -1300,7 +1304,8 @@ not GDB." (defun gdb-signal (ignored) (setq gdb-inferior-status "signal") - (gdb-force-mode-line-update gdb-inferior-status) + (gdb-force-mode-line-update + (propertize gdb-inferior-status 'face font-lock-warning-face)) (gdb-stopping ignored)) (defun gdb-stopping (ignored) @@ -1327,7 +1332,8 @@ directives." (setq gdb-overlay-arrow-position nil) (setq gud-old-arrow nil) (setq gdb-inferior-status "exited") - (gdb-force-mode-line-update gdb-inferior-status) + (gdb-force-mode-line-update + (propertize gdb-inferior-status 'face font-lock-warning-face)) (gdb-stopping ignored)) (defun gdb-signalled (ignored) @@ -1375,7 +1381,8 @@ sink to `user' in `gdb-stopping', that is fine." 'delete))))) (unless (member gdb-inferior-status '("exited" "signal")) (setq gdb-inferior-status "stopped") - (gdb-force-mode-line-update gdb-inferior-status)) + (gdb-force-mode-line-update + (propertize gdb-inferior-status 'face font-lock-warning-face))) (let ((sink gdb-output-sink)) (cond ((eq sink 'inferior) @@ -3268,7 +3275,8 @@ is set in them." (make-local-variable 'gdb-define-alist) (gdb-create-define-alist) (add-hook 'after-save-hook 'gdb-create-define-alist nil t))))) - (gdb-force-mode-line-update "ready")) + (gdb-force-mode-line-update + (propertize "ready" 'face font-lock-variable-name-face))) ; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards. (defun gdb-var-list-children-1 (varnum) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 37d4952058b..e7d85910a63 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -155,7 +155,7 @@ The following place holders should be present in the string: :type 'alist :group 'grep) -(defcustom grep-find-ignored-directories '("CVS" ".hg" "{arch}") +(defcustom grep-find-ignored-directories '("CVS" ".svn" "{arch}" ".hg" "_darcs") "*List of names of sub-directories which `rgrep' shall not recurse into." :type '(repeat string) :group 'grep) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index bdc8161c80f..f4c117fd935 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -4384,7 +4384,7 @@ idlwave-shell-electric-debug-mode-map) ["Edit Default Cmd" idlwave-shell-edit-default-command-line t]) ("Breakpoints" ["Set Breakpoint" idlwave-shell-break-here - :keys "C-c C-d C-c" :active (eq major-mode 'idlwave-mode)] + :keys "C-c C-d C-b" :active (eq major-mode 'idlwave-mode)] ("Set Special Breakpoint" ["Set After Count Breakpoint" (progn diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el index ec12468e5d9..4f0159c5992 100644 --- a/lisp/progmodes/ld-script.el +++ b/lisp/progmodes/ld-script.el @@ -74,25 +74,55 @@ "Syntax table used while in `ld-script-mode'.") ;; Font lock keywords +;; (The section number comes from ld's info.) (defvar ld-script-keywords - '("ENTRY" "INCLUDE" "INPUT" "GROUP" - "OUTPUT" "SEARCH_DIR" "STARTUP" + '( + ;; 3.4.1 Setting the Entry Point + "ENTRY" + ;; 3.4.2 Commands Dealing with Files + "INCLUDE" "INPUT" "GROUP" "AS_NEEDED" "OUTPUT" "SEARCH_DIR" "STARTUP" + ;; 3.4.3 Commands Dealing with Object File Formats "OUTPUT_FORMAT" "TARGET" - "ASSERT" "EXTERN" "FORCE_COMMON_ALLOCATION" "NOCROSSREFS" "OUTPUT_ARCH" + ;; 3.4.3 Other Linker Script Commands + "ASSERT" "EXTERN" "FORCE_COMMON_ALLOCATION" + "INHIBIT_COMMON_ALLOCATION" "NOCROSSREFS" "OUTPUT_ARCH" + ;; 3.5.2 PROVIDE "PROVIDE" - "SECTIONS" "SORT" "COMMON" "KEEP" - "BYTE" "SHORT" "LONG" "QUAD" "SQAD" - "FILL" - "CREATE_OBJECT_SYMBOLS" - "CONSTRUCTORS" + ;; 3.5.3 PROVIDE_HIDDEN + "PROVIDE_HIDEN" + ;; 3.6 SECTIONS Command + "SECTIONS" + ;; 3.6.4.2 Input Section Wildcard Patterns + "SORT" "SORT_BY_NAME" "SORT_BY_ALIGNMENT" + ;; 3.6.4.3 Input Section for Common Symbols + "COMMON" + ;; 3.6.4.4 Input Section and Garbage Collection + "KEEP" + ;; 3.6.5 Output Section Data + "BYTE" "SHORT" "LONG" "QUAD" "SQUAD" "FILL" + ;; 3.6.6 Output Section Keywords + "CREATE_OBJECT_SYMBOLS" "CONSTRUCTORS" + "__CTOR_LIST__" "__CTOR_END__" "__DTOR_LIST__" "__DTOR_END__" + ;; 3.6.7 Output Section Discarding + ;; See `ld-script-font-lock-keywords' + ;; 3.6.8.1 Output Section Type "NOLOAD" "DSECT" "COPY" "INFO" "OVERLAY" + ;; 3.6.8.2 Output Section LMA "AT" + ;; 3.6.8.4 Forced Input Alignment + "SUBALIGN" + ;; 3.6.8.6 Output Section Phdr + ":PHDR" + ;; 3.7 MEMORY Command "MEMORY" + ;; 3.8 PHDRS Command "PHDRS" "FILEHDR" "FLAGS" "PT_NULL" "PT_LOAD" "PT_DYNAMIC" "PT_INTERP" "PT_NONE" "PT_SHLIB" "PT_PHDR" + ;; 3.9 VERSION Command "VERSION") "Keywords used of GNU ld script.") +;; 3.10.8 Builtin Functions (defvar ld-script-builtins '("ABSOLUTE" "ADDR" @@ -102,12 +132,12 @@ "DATA_SEGMENT_END" "DATA_SEGMENT_RELRO_END" "DEFINED" - "LENGTH" + "LENGTH" "len" "l" "LOADADDR" "MAX" "MIN" "NEXT" - "ORIGIN" + "ORIGIN" "org" "o" "SEGMENT_START" "SIZEOF" "SIZEOF_HEADERS" @@ -120,7 +150,10 @@ 1 font-lock-keyword-face) (,(regexp-opt ld-script-builtins 'words) 1 font-lock-builtin-face) - ("/DISCARD/" . font-lock-warning-face) + ;; 3.6.7 Output Section Discarding + ;; 3.6.4.1 Input Section Basics + ;; 3.6.8.6 Output Section Phdr + ("/DISCARD/\\|EXCLUDE_FILE\\|:NONE" . font-lock-warning-face) ("\\W\\(\\.\\)\\W" 1 ld-script-location-counter-face) ) cpp-font-lock-keywords) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index ef80d28c578..6098c8be067 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -980,47 +980,55 @@ Point is at the beginning of the next line." (re-search-forward sh-here-doc-re limit t)) (defun sh-quoted-subshell (limit) - "Search for a subshell embedded in a string. Find all the unescaped -\" characters within said subshell, remembering that subshells can nest." - (if (re-search-forward "\"\\(?:.\\|\n\\)*?\\(\\$(\\|`\\)" limit t) - ;; bingo we have a $( or a ` inside a "" - (let ((char (char-after (point))) - (continue t) - (pos (point)) - (data nil) ;; value to put into match-data (and return) - (last nil) ;; last char seen - (bq (equal (match-string 1) "`")) ;; ` state flip-flop - (seen nil) ;; list of important positions - (nest 1)) ;; subshell nesting level - (while (and continue char (<= pos limit)) - ;; unescaped " inside a $( ... ) construct. - ;; state machine time... - ;; \ => ignore next char; - ;; ` => increase or decrease nesting level based on bq flag - ;; ) [where nesting > 0] => decrease nesting - ;; ( [where nesting > 0] => increase nesting - ;; ( [preceeded by $ ] => increase nesting - ;; " [nesting <= 0 ] => terminate, we're done. - ;; " [nesting > 0 ] => remember this, it's not a proper " - (if (eq ?\\ last) nil - (if (eq ?\` char) (setq nest (+ nest (if bq -1 1)) bq (not bq)) - (if (and (> nest 0) (eq ?\) char)) (setq nest (1- nest)) - (if (and (eq ?$ last) (eq ?\( char)) (setq nest (1+ nest)) - (if (and (> nest 0) (eq ?\( char)) (setq nest (1+ nest)) - (if (eq char ?\") - (if (>= 0 nest) (setq continue nil) - (setq seen (cons pos seen)) ) )))))) - ;;(message "POS: %d [%d]" pos nest) - (setq last char - pos (1+ pos) - char (char-after pos)) ) - (when seen - ;;(message "SEEN: %S" seen) - (setq data (list (current-buffer))) - (mapc (lambda (P) - (setq data (cons P (cons (1+ P) data)) ) ) seen) - (store-match-data data)) - data) )) + "Search for a subshell embedded in a string. +Find all the unescaped \" characters within said subshell, remembering that +subshells can nest." + ;; FIXME: This can (and often does) match multiple lines, yet it makes no + ;; effort to handle multiline cases correctly, so it ends up being + ;; rather flakey. + (when (re-search-forward "\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" limit t) + ;; bingo we have a $( or a ` inside a "" + (let ((char (char-after (point))) + (continue t) + (pos (point)) + (data nil) ;; value to put into match-data (and return) + (last nil) ;; last char seen + (bq (equal (match-string 1) "`")) ;; ` state flip-flop + (seen nil) ;; list of important positions + (nest 1)) ;; subshell nesting level + (while (and continue char (<= pos limit)) + ;; unescaped " inside a $( ... ) construct. + ;; state machine time... + ;; \ => ignore next char; + ;; ` => increase or decrease nesting level based on bq flag + ;; ) [where nesting > 0] => decrease nesting + ;; ( [where nesting > 0] => increase nesting + ;; ( [preceeded by $ ] => increase nesting + ;; " [nesting <= 0 ] => terminate, we're done. + ;; " [nesting > 0 ] => remember this, it's not a proper " + ;; FIXME: don't count parens that appear within quotes. + (cond + ((eq ?\\ last) nil) + ((eq ?\` char) (setq nest (+ nest (if bq -1 1)) bq (not bq))) + ((and (> nest 0) (eq ?\) char)) (setq nest (1- nest))) + ((and (eq ?$ last) (eq ?\( char)) (setq nest (1+ nest))) + ((and (> nest 0) (eq ?\( char)) (setq nest (1+ nest))) + ((eq char ?\") + (if (>= 0 nest) (setq continue nil) (push pos seen)))) + ;;(message "POS: %d [%d]" pos nest) + (setq last char + pos (1+ pos) + char (char-after pos)) ) + ;; FIXME: why construct a costly match data to pass to + ;; sh-apply-quoted-subshell rather than apply the highlight + ;; directly here? -- Stef + (when seen + ;;(message "SEEN: %S" seen) + (setq data (list (current-buffer))) + (dolist(P seen) + (setq data (cons P (cons (1+ P) data)))) + (store-match-data data)) + data) )) (defun sh-is-quoted-p (pos) (and (eq (char-before pos) ?\\) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 8ca7eb188ec..b622e536d26 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -262,11 +262,11 @@ It calls them sequentially, and if any returns non-nil, (defun which-function () "Return current function name based on point. -Uses `which-function-functions', `imenu--index-alist' +Uses `which-func-functions', `imenu--index-alist' or `add-log-current-defun-function'. If no function name is found, return nil." (let ((name - ;; Try the `which-function-functions' functions first. + ;; Try the `which-func-functions' functions first. (run-hook-with-args-until-success 'which-func-functions))) ;; If Imenu is loaded, try to make an index alist with it. diff --git a/lisp/replace.el b/lisp/replace.el index 2f8fe86860c..4275aef8d87 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1283,8 +1283,8 @@ N (match-string N) (where N is a string of digits) # replace-count Note that these symbols must be preceeded by a backslash in order to -type them." - (while n +type them using Lisp syntax." + (while (consp n) (cond ((consp (car n)) (replace-match-string-symbols (car n))) ;Process sub-list diff --git a/lisp/startup.el b/lisp/startup.el index 0ec53f98ae7..5a6b4089770 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -254,14 +254,16 @@ this variable usefully is to set it while building and dumping Emacs." :group 'mail) (defcustom user-mail-address (if command-line-processed - (concat (user-login-name) "@" - (or mail-host-address - (system-name))) + (or (getenv "EMAIL") + (concat (user-login-name) "@" + (or mail-host-address + (system-name)))) ;; Empty string means "not set yet". "") "*Full mailing address of this user. -This is initialized based on `mail-host-address', -after your init file is read, in case it sets `mail-host-address'." +This is initialized with environment variable `EMAIL' or, as a +fallback, using `mail-host-address'. This is done after your +init file is read, in case it sets `mail-host-address'." :type 'string :group 'mail) @@ -984,9 +986,10 @@ opening the first frame (e.g. open a connection to an X server).") ;; Do this here in case the init file sets mail-host-address. (if (equal user-mail-address "") - (setq user-mail-address (concat (user-login-name) "@" - (or mail-host-address - (system-name))))) + (setq user-mail-address (or (getenv "EMAIL") + (concat (user-login-name) "@" + (or mail-host-address + (system-name)))))) ;; Originally face attributes were specified via ;; `font-lock-face-attributes'. Users then changed the default diff --git a/lisp/subr.el b/lisp/subr.el index 9b5d5f47ef2..6d35171bf04 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -108,6 +108,9 @@ change the list." (declare (indent 1) (debug t)) (cons 'if (cons cond (cons nil body)))) +(defvar --dolist-tail-- nil + "Temporary variable used in `dolist' expansion.") + (defmacro dolist (spec &rest body) "Loop over a list. Evaluate BODY with VAR bound to each car from LIST, in turn. @@ -115,16 +118,22 @@ Then evaluate RESULT to get return value, default nil. \(fn (VAR LIST [RESULT]) BODY...)" (declare (indent 1) (debug ((symbolp form &optional form) body))) - (let ((temp (make-symbol "--dolist-temp--"))) + ;; It would be cleaner to create an uninterned symbol, + ;; but that uses a lot more space when many functions in many files + ;; use dolist. + (let ((temp '--dolist-tail--)) `(let ((,temp ,(nth 1 spec)) ,(car spec)) (while ,temp (setq ,(car spec) (car ,temp)) - (setq ,temp (cdr ,temp)) - ,@body) + ,@body + (setq ,temp (cdr ,temp))) ,@(if (cdr (cdr spec)) `((setq ,(car spec) nil) ,@(cdr (cdr spec))))))) +(defvar --dotimes-limit-- nil + "Temporary variable used in `dotimes' expansion.") + (defmacro dotimes (spec &rest body) "Loop a certain number of times. Evaluate BODY with VAR bound to successive integers running from 0, @@ -133,7 +142,10 @@ the return value (nil if RESULT is omitted). \(fn (VAR COUNT [RESULT]) BODY...)" (declare (indent 1) (debug dolist)) - (let ((temp (make-symbol "--dotimes-temp--")) + ;; It would be cleaner to create an uninterned symbol, + ;; but that uses a lot more space when many functions in many files + ;; use dotimes. + (let ((temp '--dotimes-limit--) (start 0) (end (nth 1 spec))) `(let ((,temp ,end) @@ -1721,22 +1733,13 @@ floating point support. (when (or obsolete (numberp nodisp)) (setq seconds (+ seconds (* 1e-3 nodisp))) (setq nodisp obsolete)) - (unless nodisp - (redisplay)) - (or (<= seconds 0) - (let ((timer (timer-create)) - (echo-keystrokes 0)) - (if (catch 'sit-for-timeout - (timer-set-time timer (timer-relative-time - (current-time) seconds)) - (timer-set-function timer 'with-timeout-handler - '(sit-for-timeout)) - (timer-activate timer) - (push (read-event) unread-command-events) - nil) - t - (cancel-timer timer) - nil)))) + (if noninteractive + (progn (sleep-for seconds) t) + (unless nodisp (redisplay)) + (or (<= seconds 0) + (let ((read (read-event nil nil seconds))) + (or (null read) + (progn (push read unread-command-events) nil)))))) ;;; Atomic change groups. @@ -2547,8 +2550,9 @@ STRING should be given if the last search was by `string-match' on STRING." (defun looking-back (regexp &optional limit greedy) "Return non-nil if text before point matches regular expression REGEXP. Like `looking-at' except matches before point, and is slower. -LIMIT if non-nil speeds up the search by specifying how far back the -match can start. +LIMIT if non-nil speeds up the search by specifying a minimum +starting position, to avoid checking matches that would start +before LIMIT. If GREEDY is non-nil, extend the match backwards as far as possible, stopping when a single additional previous character cannot be part diff --git a/lisp/tabify.el b/lisp/tabify.el index 6e12270bf47..de37f281eda 100644 --- a/lisp/tabify.el +++ b/lisp/tabify.el @@ -50,10 +50,10 @@ The variable `tab-width' controls the spacing of tab stops." (delete-region tab-beg (point)) (indent-to column)))))) -(defvar tabify-regexp "[ \t][ \t]+" +(defvar tabify-regexp " [ \t]+" "Regexp matching whitespace that tabify should consider. -Usually this will be \"[ \\t][ \\t]+\" to match two or more spaces or tabs. -\"^[ \\t]+\" is also useful, for tabifying only initial whitespace.") +Usually this will be \" [ \\t]+\" to match two or more spaces or tabs. +\"^\\t* [ \\t]+\" is also useful, for tabifying only initial whitespace.") ;;;###autoload (defun tabify (start end) @@ -72,13 +72,24 @@ The variable `tab-width' controls the spacing of tab stops." (beginning-of-line) (narrow-to-region (point) end) (goto-char start) - (while (re-search-forward tabify-regexp nil t) - (let ((column (current-column)) - (indent-tabs-mode t)) - (delete-region (match-beginning 0) (point)) - (indent-to column)))))) + (let ((indent-tabs-mode t)) + (while (re-search-forward tabify-regexp nil t) + ;; The region between (match-beginning 0) and (match-end 0) is just + ;; spacing which we want to adjust to use TABs where possible. + (let ((end-col (current-column)) + (beg-col (save-excursion (goto-char (match-beginning 0)) + (skip-chars-forward "\t") + (current-column)))) + (if (= (/ end-col tab-width) (/ beg-col tab-width)) + ;; The spacing (after some leading TABs which we wouldn't + ;; want to touch anyway) does not straddle a TAB boundary, + ;; so it neither contains a TAB, nor will we be able to use + ;; a TAB here anyway: there's nothing to do. + nil + (delete-region (match-beginning 0) (point)) + (indent-to end-col)))))))) (provide 'tabify) -;;; arch-tag: c83893b1-e0cc-4e57-8a09-73fd03466416 +;; arch-tag: c83893b1-e0cc-4e57-8a09-73fd03466416 ;;; tabify.el ends here diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index becf418e4e0..79324306ad1 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -160,13 +160,21 @@ (define-key xterm-function-map "\e[29~" [print]) ;; These keys are available in xterm starting from version 214 -;; if the modifyOtherKeys resource is set. -(define-key xterm-function-map "\e[27;5;9~" [(control ?\t)]) +;; if the modifyOtherKeys resource is set to 1. +(define-key xterm-function-map "\e[27;5;9~" [C-tab]) (define-key xterm-function-map "\e[27;5;13~" [C-return]) -(define-key xterm-function-map "\e[27;5;44~" [(control ?\,)]) -(define-key xterm-function-map "\e[27;5;46~" [(control ?\.)]) -(define-key xterm-function-map "\e[27;5;47~" [(control ?\/)]) -(define-key xterm-function-map "\e[27;5;92~" [(control ?\\)]) +(define-key xterm-function-map "\e[27;5;44~" [?\C-,]) +(define-key xterm-function-map "\e[27;5;46~" [?\C-.]) +(define-key xterm-function-map "\e[27;5;47~" [?\C-/]) +(define-key xterm-function-map "\e[27;5;92~" [?\C-\\)]) + +(define-key xterm-function-map "\e[27;2;9~" [S-tab]) +(define-key xterm-function-map "\e[27;2;13~" [S-return]) + +(define-key xterm-function-map "\e[27;6;9~" [(C-S-tab)]) + +(define-key xterm-function-map "\e[27;13;46~" [?\C-\M-.]) + ;; Other versions of xterm might emit these. (define-key xterm-function-map "\e[A" [up]) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index a4d873a543d..a0eb147d9c8 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1650,9 +1650,15 @@ quit spell session exited." cursor-location)) (if (not (equal new-word (car poss))) (progn - (delete-region start end) - (setq start (point)) + (goto-char start) + ;; Insert first and then delete, + ;; to avoid collapsing markers before and after + ;; into a single place. (ispell-insert-word new-word) + (delete-region (point) (+ (point) (- end start))) + ;; It is meaningless to preserve the cursor position + ;; inside a word that has changed. + (setq cursor-location (point)) (setq end (point)))) (if (not (atom replace)) ;recheck spelling of replacement (progn diff --git a/lisp/textmodes/po.el b/lisp/textmodes/po.el index eac1cb94105..701095caa8e 100644 --- a/lisp/textmodes/po.el +++ b/lisp/textmodes/po.el @@ -42,7 +42,7 @@ Contains canonical charset names that don't correspond to coding systems.") (defun po-find-charset (filename) "Return PO charset value for FILENAME. -If FILENAME is a cons, the cdr part is a buffer that already contains +If FILENAME is a cons cell, its CDR is a buffer that already contains the PO file (but not yet decoded)." (let ((charset-regexp "^\"Content-Type:[ \t]*text/plain;[ \t]*charset=\\(.*\\)\\\\n\"") diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index dab08902769..002ab9dac11 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -6,7 +6,7 @@ ;; Keywords: wp, convenience ;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com> ;; Created: Sat Jul 08 2000 13:28:45 (PST) -;; Revised: Tue May 30 2006 10:01:43 (PDT) +;; Revised: Thu Jul 20 2006 17:30:09 (PDT) ;; This file is part of GNU Emacs. @@ -1394,7 +1394,9 @@ the last cache point coordinate." (setq table-command-remap-alist (cons (cons command func-symbol) table-command-remap-alist)))) - '(beginning-of-line + '(move-beginning-of-line + beginning-of-line + move-end-of-line end-of-line beginning-of-buffer end-of-buffer diff --git a/lisp/tumme.el b/lisp/tumme.el index 26d48e77b2f..3bd1d41886e 100644 --- a/lisp/tumme.el +++ b/lisp/tumme.el @@ -84,7 +84,7 @@ ;; USAGE ;; ===== ;; -;; This information has been moved to the manual. Type `C-h r' to open +;; This information has been moved to the manual. Type `C-h r' to open ;; the Emacs manual and go to the node Thumbnails by typing `g ;; Thumbnails RET'. ;; @@ -161,6 +161,10 @@ (require 'dired) (require 'format-spec) +(require 'widget) + +(eval-when-compile + (require 'wid-edit)) (defgroup tumme nil "Use dired to browse your images as thumbnails, and more." @@ -644,7 +648,7 @@ according to the Thumbnail Managing Standard." ;; Can't use (overlays-at (point)), BUG? (overlays-in (point) (1+ (point))))) (put-image thumb-file image-pos) - (setq + (setq overlay (car (delq nil (mapcar (lambda (o) (and (overlay-get o 'put-image) o)) (overlays-in (point) (1+ (point))))))) @@ -864,32 +868,27 @@ displayed." ;;;###autoload (defalias 'tumme 'tumme-show-all-from-dir) -(defun tumme-write-tag (files tag) - "For all FILES, writes TAG to the image database." - (save-excursion - (let (end buf) - (setq buf (find-file tumme-db-file)) - (if (not (listp files)) - (if (stringp files) - (setq files (list files)) - (error "Files must be a string or a list of strings!"))) - (mapcar - (lambda (file) - (goto-char (point-min)) - (if (search-forward-regexp - (format "^%s" file) nil t) - (progn - (end-of-line) - (setq end (point)) - (beginning-of-line) - (when (not (search-forward (format ";%s" tag) end t)) - (end-of-line) - (insert (format ";%s" tag)))) - (goto-char (point-max)) - (insert (format "\n%s;%s" file tag)))) - files) - (save-buffer) - (kill-buffer buf)))) +(defun tumme-write-tags (file-tags) + "Write file tags to database. +Write each file and tag in FILE-TAGS to the database. FILE-TAGS +is an alist in the following form: + ((FILE . TAG) ... )" + (let (end file tag) + (with-temp-file tumme-db-file + (insert-file-contents tumme-db-file) + (dolist (elt file-tags) + (setq file (car elt) + tag (cdr elt)) + (goto-char (point-min)) + (if (search-forward-regexp (format "^%s.*$" file) nil t) + (progn + (setq end (point)) + (beginning-of-line) + (when (not (search-forward (format ";%s" tag) end t)) + (end-of-line) + (insert (format ";%s" tag)))) + (goto-char (point-max)) + (insert (format "\n%s;%s" file tag))))))) (defun tumme-remove-tag (files tag) "For all FILES, remove TAG from the image database." @@ -951,15 +950,19 @@ displayed." (let ((tag (read-string "Tags to add (separate tags with a semicolon): ")) curr-file files) (if arg - (setq files (dired-get-filename)) + (setq files (list (dired-get-filename))) (setq files (dired-get-marked-files))) - (tumme-write-tag files tag))) + (tumme-write-tags + (mapcar + (lambda (x) + (cons x tag)) + files)))) (defun tumme-tag-thumbnail () "Tag current thumbnail." (interactive) (let ((tag (read-string "Tags to add (separate tags with a semicolon): "))) - (tumme-write-tag (tumme-original-file-name) tag)) + (tumme-write-tags (list (cons (tumme-original-file-name) tag)))) (tumme-update-property 'tags (tumme-list-tags (tumme-original-file-name)))) @@ -1006,7 +1009,7 @@ use only useful if `tumme-track-movement' is nil." (let ((old-buf (current-buffer)) (dired-buf (tumme-associated-dired-buffer)) (file-name (tumme-original-file-name))) - (when (and dired-buf file-name) + (when (and (buffer-live-p dired-buf) file-name) (setq file-name (file-name-nondirectory file-name)) (set-buffer dired-buf) (goto-char (point-min)) @@ -1069,32 +1072,46 @@ move ARG lines." (if tumme-track-movement (tumme-track-thumbnail))) -(defun tumme-forward-char () - "Move to next image and display properties." - (interactive) - ;; Before we move, make sure that there is an image two positions - ;; forward. - (when (save-excursion - (forward-char 2) - (tumme-image-at-point-p)) - (forward-char) - (while (and (not (eobp)) - (not (tumme-image-at-point-p))) - (forward-char)) - (if tumme-track-movement - (tumme-track-original-file))) +(defun tumme-forward-image (&optional arg) + "Move to next image and display properties. +Optional prefix ARG says how many images to move; default is one +image." + (interactive "p") + (let (pos (steps (or arg 1))) + (dotimes (i steps) + (if (and (not (eobp)) + (save-excursion + (forward-char) + (while (and (not (eobp)) + (not (tumme-image-at-point-p))) + (forward-char)) + (setq pos (point)) + (tumme-image-at-point-p))) + (goto-char pos) + (error "At last image")))) + (when tumme-track-movement + (tumme-track-original-file)) (tumme-display-thumb-properties)) -(defun tumme-backward-char () - "Move to previous image and display properties." - (interactive) - (when (not (bobp)) - (backward-char) - (while (and (not (bobp)) - (not (tumme-image-at-point-p))) - (backward-char)) - (if tumme-track-movement - (tumme-track-original-file))) +(defun tumme-backward-image (&optional arg) + "Move to previous image and display properties. +Optional prefix ARG says how many images to move; default is one +image." + (interactive "p") + (let (pos (steps (or arg 1))) + (dotimes (i steps) + (if (and (not (bobp)) + (save-excursion + (backward-char) + (while (and (not (bobp)) + (not (tumme-image-at-point-p))) + (backward-char)) + (setq pos (point)) + (tumme-image-at-point-p))) + (goto-char pos) + (error "At first image")))) + (when tumme-track-movement + (tumme-track-original-file)) (tumme-display-thumb-properties)) (defun tumme-next-line () @@ -1103,7 +1120,7 @@ move ARG lines." (next-line 1) ;; If we end up in an empty spot, back up to the next thumbnail. (if (not (tumme-image-at-point-p)) - (tumme-backward-char)) + (tumme-backward-image)) (if tumme-track-movement (tumme-track-original-file)) (tumme-display-thumb-properties)) @@ -1118,7 +1135,7 @@ move ARG lines." ;; thumbnail and did not refresh, so it is not very common. But we ;; can handle it in a good manner, so why not? (if (not (tumme-image-at-point-p)) - (tumme-backward-char)) + (tumme-backward-image)) (if tumme-track-movement (tumme-track-original-file)) (tumme-display-thumb-properties)) @@ -1131,7 +1148,7 @@ comment." (format-spec tumme-display-properties-format (list - (cons ?b buf) + (cons ?b (or buf "")) (cons ?f file) (cons ?t (or (princ props) "")) (cons ?c (or comment ""))))) @@ -1187,19 +1204,19 @@ dired." "Mark original image file in associated dired buffer." (interactive) (tumme-modify-mark-on-thumb-original-file 'mark) - (tumme-forward-char)) + (tumme-forward-image)) (defun tumme-unmark-thumb-original-file () "Unmark original image file in associated dired buffer." (interactive) (tumme-modify-mark-on-thumb-original-file 'unmark) - (tumme-forward-char)) + (tumme-forward-image)) (defun tumme-flag-thumb-original-file () "Flag original image file for deletion in associated dired buffer." (interactive) (tumme-modify-mark-on-thumb-original-file 'flag) - (tumme-forward-char)) + (tumme-forward-image)) (defun tumme-toggle-mark-thumb-original-file () "Toggle mark on original image file in associated dired buffer." @@ -1247,12 +1264,12 @@ You probably want to use this together with "Define keymap for `tumme-thumbnail-mode'." ;; Keys - (define-key tumme-thumbnail-mode-map [right] 'tumme-forward-char) - (define-key tumme-thumbnail-mode-map [left] 'tumme-backward-char) + (define-key tumme-thumbnail-mode-map [right] 'tumme-forward-image) + (define-key tumme-thumbnail-mode-map [left] 'tumme-backward-image) (define-key tumme-thumbnail-mode-map [up] 'tumme-previous-line) (define-key tumme-thumbnail-mode-map [down] 'tumme-next-line) - (define-key tumme-thumbnail-mode-map "\C-f" 'tumme-forward-char) - (define-key tumme-thumbnail-mode-map "\C-b" 'tumme-backward-char) + (define-key tumme-thumbnail-mode-map "\C-f" 'tumme-forward-image) + (define-key tumme-thumbnail-mode-map "\C-b" 'tumme-backward-image) (define-key tumme-thumbnail-mode-map "\C-p" 'tumme-previous-line) (define-key tumme-thumbnail-mode-map "\C-n" 'tumme-next-line) @@ -1655,7 +1672,8 @@ See also `tumme-line-up-dynamic'." (insert "\n") (insert " ") (setq count (1+ count)) - (when (= count (- tumme-thumbs-per-row 1)) + (when (and (= count (- tumme-thumbs-per-row 1)) + (not (eobp))) (forward-char) (insert "\n") (setq count 0))))) @@ -1798,8 +1816,10 @@ With prefix argument ARG, display image in its original size." (message "No thumbnail at point") (if (not file) (message "No original file name found") - (tumme-display-image file arg) - (display-buffer tumme-display-image-buffer)))))) + (tumme-create-display-image-buffer) + (display-buffer tumme-display-image-buffer) + (tumme-display-image file arg)))))) + ;;;###autoload (defun tumme-dired-display-image (&optional arg) @@ -1807,8 +1827,9 @@ With prefix argument ARG, display image in its original size." See documentation for `tumme-display-image' for more information. With prefix argument ARG, display image in its original size." (interactive "P") - (tumme-display-image (dired-get-filename) arg) - (display-buffer tumme-display-image-buffer)) + (tumme-create-display-image-buffer) + (display-buffer tumme-display-image-buffer) + (tumme-display-image (dired-get-filename) arg)) (defun tumme-image-at-point-p () "Return true if there is a tumme thumbnail at point." @@ -2000,49 +2021,49 @@ function. The result is a couple of new files in (defun tumme-display-next-thumbnail-original () "In thubnail buffer, move to next thumbnail and display the image." (interactive) - (tumme-forward-char) + (tumme-forward-image) (tumme-display-thumbnail-original-image)) (defun tumme-display-previous-thumbnail-original () "Move to previous thumbnail and display image." - (interactive) - (tumme-backward-char) + (tumme-backward-image) (tumme-display-thumbnail-original-image)) -(defun tumme-write-comment (file comment) - "For FILE, write comment COMMENT in database." - (save-excursion - (let (end buf comment-beg) - (setq buf (find-file tumme-db-file)) - (goto-char (point-min)) - (if (search-forward-regexp - (format "^%s" file) nil t) - (progn - (end-of-line) - (setq end (point)) - (beginning-of-line) - ;; Delete old comment, if any - (cond ((search-forward ";comment:" end t) - (setq comment-beg (match-beginning 0)) - ;; Any tags after the comment? - (if (search-forward ";" end t) - (setq comment-end (- (point) 1)) - (setq comment-end end)) - ;; Delete comment tag and comment - (delete-region comment-beg comment-end))) - ;; Insert new comment - (beginning-of-line) - (if (not (search-forward ";" end t)) - (progn - (end-of-line) - (insert ";"))) - (insert (format "comment:%s;" comment))) - ;; File does not exist in databse - add it. - (goto-char (point-max)) - (insert (format "\n%s;comment:%s" file comment))) - (save-buffer) - (kill-buffer buf)))) +(defun tumme-write-comments (file-comments) + "Write file comments to database. +Write file comments to one or more files. FILE-COMMENTS is an alist on +the following form: + ((FILE . COMMENT) ... )" + (let (end comment-beg-pos comment-end-pos file comment) + (with-temp-file tumme-db-file + (insert-file-contents tumme-db-file) + (dolist (elt file-comments) + (setq file (car elt) + comment (cdr elt)) + (goto-char (point-min)) + (if (search-forward-regexp (format "^%s.*$" file) nil t) + (progn + (setq end (point)) + (beginning-of-line) + ;; Delete old comment, if any + (when (search-forward ";comment:" end t) + (setq comment-beg-pos (match-beginning 0)) + ;; Any tags after the comment? + (if (search-forward ";" end t) + (setq comment-end-pos (- (point) 1)) + (setq comment-end-pos end)) + ;; Delete comment tag and comment + (delete-region comment-beg-pos comment-end-pos)) + ;; Insert new comment + (beginning-of-line) + (unless (search-forward ";" end t) + (end-of-line) + (insert ";")) + (insert (format "comment:%s;" comment))) + ;; File does not exist in database - add it. + (goto-char (point-max)) + (insert (format "\n%s;comment:%s" file comment))))))) (defun tumme-update-property (prop value) "Update text property PROP with value VALUE at point." @@ -2056,19 +2077,19 @@ function. The result is a couple of new files in (defun tumme-dired-comment-files () "Add comment to current or marked files in dired." (interactive) - (let ((files (dired-get-marked-files)) - (comment (tumme-read-comment))) - (mapcar - (lambda (curr-file) - (tumme-write-comment curr-file comment)) - files))) + (let ((comment (tumme-read-comment))) + (tumme-write-comments + (mapcar + (lambda (curr-file) + (cons curr-file comment)) + (dired-get-marked-files))))) (defun tumme-comment-thumbnail () "Add comment to current thumbnail in thumbnail buffer." (interactive) (let* ((file (tumme-original-file-name)) (comment (tumme-read-comment file))) - (tumme-write-comment file comment) + (tumme-write-comments (list (cons file comment))) (tumme-update-property 'comment comment)) (tumme-display-thumb-properties)) @@ -2085,21 +2106,21 @@ as initial value." (defun tumme-get-comment (file) "Get comment for file FILE." (save-excursion - (let (end buf comment-beg comment (base-name (file-name-nondirectory file))) + (let (end buf comment-beg-pos comment-end-pos comment) (setq buf (find-file tumme-db-file)) (goto-char (point-min)) (when (search-forward-regexp - (format "^%s" base-name) nil t) + (format "^%s" file) nil t) (end-of-line) (setq end (point)) (beginning-of-line) (cond ((search-forward ";comment:" end t) - (setq comment-beg (point)) + (setq comment-beg-pos (point)) (if (search-forward ";" end t) - (setq comment-end (- (point) 1)) - (setq comment-end end)) + (setq comment-end-pos (- (point) 1)) + (setq comment-end-pos end)) (setq comment (buffer-substring - comment-beg comment-end))))) + comment-beg-pos comment-end-pos))))) (kill-buffer buf) comment))) @@ -2153,6 +2174,8 @@ non-nil." (setq file (tumme-original-file-name)) (if tumme-track-movement (tumme-track-original-file)) + (tumme-create-display-image-buffer) + (display-buffer tumme-display-image-buffer) (tumme-display-image file))) (defun tumme-mouse-select-thumbnail (event) @@ -2421,6 +2444,107 @@ when using per-directory thumbnail file storage")) (error nil)) (kill-buffer buffer))) +(defvar tumme-widget-list nil + "List to keep track of meta data in edit buffer.") + +;;;###autoload +(defun tumme-dired-edit-comment-and-tags () + "Edit comment and tags of current or marked image files. +Edit comment and tags for all marked image files in an +easy-to-use form." + (interactive) + (setq tumme-widget-list nil) + ;; Setup buffer. + (let ((files (dired-get-marked-files))) + (switch-to-buffer "*Tumme Edit Meta Data*") + (kill-all-local-variables) + (make-local-variable 'widget-example-repeat) + (let ((inhibit-read-only t)) + (erase-buffer)) + (remove-overlays) + ;; Some help for the user. + (widget-insert +"\nEdit comments and tags for each image. Separate multiple tags +with a comma. Move forward between fields using TAB or RET. +Move to the previous field using backtab (S-TAB). Save by +activating the Save button at the bottom of the form or cancel +the operation by activating the Cancel button.\n\n") + ;; Here comes all images and a comment and tag field for each + ;; image. + (let (thumb-file img comment-widget tag-widget) + + (dolist (file files) + + (setq thumb-file (tumme-thumb-name file) + img (create-image thumb-file)) + + (insert-image img) + (widget-insert "\n\nComment: ") + (setq comment-widget + (widget-create 'editable-field + :size 60 + :format "%v " + :value (or (tumme-get-comment file) ""))) + (widget-insert "\nTags: ") + (setq tag-widget + (widget-create 'editable-field + :size 60 + :format "%v " + :value (or (mapconcat + (lambda (tag) + tag) + (tumme-list-tags file) + ",") ""))) + ;; Save information in all widgets so that we can use it when + ;; the user saves the form. + (setq tumme-widget-list + (append tumme-widget-list + (list (list file comment-widget tag-widget)))) + (widget-insert "\n\n"))) + + ;; Footer with Save and Cancel button. + (widget-insert "\n") + (widget-create 'push-button + :notify + (lambda (&rest ignore) + (tumme-save-information-from-widgets) + (bury-buffer) + (message "Done.")) + "Save") + (widget-insert " ") + (widget-create 'push-button + :notify + (lambda (&rest ignore) + (bury-buffer) + (message "Operation canceled.")) + "Cancel") + (widget-insert "\n") + (use-local-map widget-keymap) + (widget-setup) + ;; Jump to the first widget. + (widget-forward 1))) + +(defun tumme-save-information-from-widgets () + "Save information found in `tumme-widget-list'. +Use the information in `tumme-widget-list' to save comments and +tags to their respective image file. Internal function used by +`tumme-dired-edit-comment-and-tags'." + (let (file comment tag-string tag-list lst) + (tumme-write-comments + (mapcar + (lambda (widget) + (setq file (car widget) + comment (widget-value (cadr widget))) + (cons file comment)) + tumme-widget-list)) + (tumme-write-tags + (dolist (widget tumme-widget-list lst) + (setq file (car widget) + tag-string (widget-value (car (cddr widget))) + tag-list (split-string tag-string ",")) + (dolist (tag tag-list) + (push (cons file tag) lst)))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;; TEST-SECTION ;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/xml.el b/lisp/xml.el index 2ce3ec7b4f9..ca8f5bdc81b 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -165,22 +165,19 @@ If FILE is already visited, use its buffer and don't kill it. Returns the top node with all its children. If PARSE-DTD is non-nil, the DTD is parsed rather than skipped. If PARSE-NS is non-nil, then QNAMES are expanded." - (let ((keep)) - (if (get-file-buffer file) - (progn - (set-buffer (get-file-buffer file)) - (setq keep (point))) - (let (auto-mode-alist) ; no need for xml-mode - (find-file file))) - - (let ((xml (xml-parse-region (point-min) - (point-max) - (current-buffer) - parse-dtd parse-ns))) - (if keep - (goto-char keep) - (kill-buffer (current-buffer))) - xml))) + (if (get-file-buffer file) + (with-current-buffer (get-file-buffer file) + (save-excursion + (xml-parse-region (point-min) + (point-max) + (current-buffer) + parse-dtd parse-ns))) + (with-temp-buffer + (insert-file-contents file) + (xml-parse-region (point-min) + (point-max) + (current-buffer) + parse-dtd parse-ns)))) (defvar xml-name-re) |