diff options
| author | Karoly Lorentey <lorentey@elte.hu> | 2005-12-19 19:57:22 +0000 |
|---|---|---|
| committer | Karoly Lorentey <lorentey@elte.hu> | 2005-12-19 19:57:22 +0000 |
| commit | e93b29568add51c918892153759a1fcd440e85be (patch) | |
| tree | 4ca3494b355f5df3d0cdbe155eeaa3f630f293c1 /lisp | |
| parent | 8d3cdf56502e89f00e86b02f24422acfa1b34beb (diff) | |
| parent | 3031d8b0bb97f21c79b3022ff3e7564173facd18 (diff) | |
| download | emacs-e93b29568add51c918892153759a1fcd440e85be.tar.gz | |
Merged from miles@gnu.org--gnu-2005 (patch 169-173, 671-676)
Patches applied:
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-671
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-672
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-673
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-674
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-675
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-169
Merge from emacs--cvs-trunk--0
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-170
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-171
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-172
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-173
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-454
Diffstat (limited to 'lisp')
61 files changed, 2217 insertions, 1036 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 377f2ce0fc2..6e9c40d2cca 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,349 @@ +2005-12-17 Eli Zaretskii <eliz@gnu.org> + + * makefile.w32-in (autoloads, custom-deps): Warn that parts of + commands enclosed in $(ARGQUOTE)s should not be split between two + lines, as that will break with GNU Make >3.80, when sh.exe is used + and arg quoting is with '..'. + (autoloads): Don't break the quoted --eval expression between + several lines. + +2005-12-17 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/edebug.el (edebug-safe-prin1-to-string): Capture + error from printing circular structures. + +2005-12-17 Martin Rudalics <rudalics@gmx.at> (tiny change) + + * wid-edit.el (widget-checkbox-action): Clear undo info. + +2005-12-16 Bill Wohler <wohler@newt.com> + + * menu-bar.el (kill-this-buffer): Set a good example by using menu + bar, not menubar in comment. + +2005-12-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/cc-engine.el (c-after-change-check-<>-operators): + After-change-functions should not clobber the match data. + +2005-12-16 Juri Linkov <juri@jurta.org> + + * simple.el (choose-completion): Use `buffer-substring-no-properties' + instead of `buffer-substring'. + (completion-common-substring): Doc fix. + (completion-setup-function): Use minibuffer-completion-contents + instead of minibuffer-contents. Don't set common-string-length + initially. Remove special handling of partial-completion-mode. + Move computation of completion-base-size into one cond. + Call completion-base-size-function in mainbuf. In computation of + completion-base-size for file name completion don't move point to + the end of the minibuffer. Move computation of common-string-length + into one cond. Start putting faces only when common-string-length>=0. + Add condition to put completions-common-part when + common-string-length>0. + + * complete.el (PC-do-completion): Remove `(equal (point) beg)' to + place point at the first different character in the minibuffer + even if this position is at the beginning of the minibuffer. + + * info.el (Info-read-node-name-1): In completion-base-size-function's + lambda return 1 if common-substring or minibuffer-completion-contents + starts with (, and 0 otherwise. + + * emacs-lisp/crm.el (crm-minibuffer-completion-help): + Use `crm-current-element' for second arg of `display-completion-list'. + +2005-12-16 Klaus Zeitler <kzeitler@lucent.com> + + * files.el (set-auto-mode): Look for an interpreter specified on + the first line also if search for mode specification succeeded, + but the mode is not known. + +2005-12-16 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el: (org-tags-match-list-sublevels): New option. + (org-open-at-point): Implement tag searches as links. + (org-fit-agenda-window, org-get-buffer-tags, org-get-tags) + (org-make-tags-matcher, org-scan-tags, org-activate-tags): New funs. + (org-tags-sparse-tree, org-tags-view, org-set-tags) + (org-agenda-dispatch): New commands. + (org-use-tag-inheritance, org-tags-column): New options. + (org-tab-follows-link, org-return-follows-link): New options. + (org-tags): New customize group. + (org-start-icalendar-file): Get local time zone. + (org-tags-completion-function): New function. + (org-set-font-lock-defaults): Make sure links will also be + highlighted inside headlines. + +2005-12-16 Mark Plaksin <happy@usg.edu> (tiny change) + + * term.el (term-emulate-terminal): + Let term-handle-ansi-terminal-messages override what Bash says about + its current directory. + +2005-12-16 L$,1 q(Brentey K,Aa(Broly <lorentey@elte.hu> + + * bindings.el (last-buffer): Move to simple.el. + * simple.el (last-buffer): Move here. + (get-next-valid-buffer): New function. + (next-buffer): Use frame-local buffer list, maintain buried buffer list. + (prev-buffer): Ditto. Rename to `previous-buffer'. + + * menu-bar.el (menu-bar-update-buffers): Update uses of `prev-buffer'. + * bindings.el (global-map): Ditto. + +2005-12-15 Luc Teirlinck <teirllm@auburn.edu> + + * cus-edit.el: Introductory comment change. + (custom-magic-alist): Change message string for the `rogue' state. + +2005-12-15 Richard M. Stallman <rms@gnu.org> + + * tooltip.el: Delete defcustom variable :tag names. + + * complete.el (partial-completion-mode): Doc fix. + + * textmodes/flyspell.el (flyspell-external-point-words): + Use save-excursion to ensure we don't move backward in the + search loop, not even one character. + (flyspell-delete-all-overlays): Use remove-overlays directly. + + * textmodes/ispell.el (ispell-current-personal-dictionary): New var. + (ispell-start-process): Set that variable. + Clear ispell-buffer-local-name. + (ispell-internal-change-dictionary): + Set ispell-current-dictionary after killing process. + (ispell-buffer-local-dict): + Don't set spell-personal-dictionary after killing process. + (ispell-buffer-local-words): Don't clear out ispell-buffer-local-name. + (ispell-tex-skip-alists) + (ispell-html-skip-alists, ispell-skip-region-alist): Mark as risky. + + * net/newsticker.el (newsticker--retrieval-timer-list) + (newsticker--display-timer, newsticker-running-p) + (newsticker-ticker-running-p): Definitions moved up. + +2005-12-16 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-many-windows): Echo new state in minibuffer. + +2005-12-15 David Ponce <david@dponce.com> + + * recentf.el (recentf-dialog-goto-first): Fix missing error condition. + (recentf-edit-list, recentf-open-files): Signal an error when + there is no recent file. + +2005-12-14 Lennart Borgman <lennart.borgman.073@student.lu.se> + + * textmodes/texinfmt.el (texinfo-format-region): Set buffer to + read-only except for texinfo-format-region evaluation. + +2005-12-14 Richard M. Stallman <rms@gnu.org> + + * vc.el (vc-default-previous-version, vc-default-next-version) + (vc-do-command): Doc fixes. + +2005-12-14 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> + + * textmodes/bibtex.el (bibtex-expand-strings) + (bibtex-autokey-expand-string, bibtex-name-part) + (bibtex-entry-type-whitespace, bibtex-entry-type-str) + (bibtex-any-entry-maybe-empty-head, bibtex-string-type) + (bibtex-preamble-prefix, bibtex-string-empty-key): New variables. + (bibtex-entry-type, bibtex-entry-head): Match only valid entries. + (bibtex-entry-postfix, bibtex-known-entry-type-re) + (bibtex-valid-entry-re, bibtex-any-valid-entry-re) + (bibtex-valid-entry-whitespace-re, bibtex-empty-field-re) + (bibtex-field-name-for-parsing, bibtex-remove-delimiters-string) + (bibtex-beginning-of-last-entry): Remove. + (bibtex-parse-field-name): Use bibtex-field-name. Issue error + message if comma is missing but buffer is read-only. + (bibtex-parse-field-text): Handle whitespaces at the end of field + text. Return 3-element list with beginning and end of field text + and end of field. + (bibtex-end-of-text-in-field, bibtex-end-of-field): Change accordingly. + (bibtex-parse-field): Remove arg name. Use bibtex-field-name. + (bibtex-search-forward-field, bibtex-search-backward-field): + Search always delimited by limits of entry. Use more efficient + search algorithms. + (bibtex-name-in-field): Use bibtex-start-of-name-in-field and + bibtex-end-of-name-in-field. + (bibtex-text-in-field-bounds): Handle BibTeX strings when + extracting the content of a field. + (bibtex-text-in-field): Use search limits. + (bibtex-parse-string-prefix): Handle empty string keys based on + bibtex-string-empty-key. + (bibtex-parse-string): Fix docstring. + (bibtex-text-in-string): Use bibtex-text-in-field-bounds. + (bibtex-preamble-prefix, bibtex-strings): New functions. + (bibtex-skip-to-valid-entry): Include preceding whitespace in + BibTeX entries (consistent with other BibTeX functions). + (bibtex-map-entries): Use bibtex-skip-to-valid-entry. + (bibtex-search-entry): Fix docstring. Simplify. + (bibtex-flash-head, bibtex-complete-string-cleanup) + (bibtex-count-entries, bibtex-sort-buffer): Simplify. + (bibtex-beginning-of-first-entry): Use bibtex-skip-to-valid-entry. + (bibtex-parse-entry): New optional arg content. + (bibtex-format-entry, bibtex-autofill-entry, bibtex-url): Use it. + Use bibtex-text-in-field-bounds. + (bibtex-print-help-message): Handle BibTeX strings and preambles. + (bibtex-end-of-entry): Use bibtex-preamble-prefix and + bibtex-parse-string-postfix. + (bibtex-find-text-internal): New function. + (bibtex-remove-delimiters): Use it. + (bibtex-find-text): Use it. New optional arg help. + (bibtex-complete): Handle BibTeX string and preamble entries. + (bibtex-Preamble): Fix order of closing delimiters. + +2005-12-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc.el (vc-default-revert): New fun. + + * vc-mcvs.el (vc-mcvs-revert): Fix call to vc-default-revert. + +2005-12-14 Romain Francoise <romain@orebokech.com> + + * font-lock.el (font-lock-keywords-alist): Rename `append' to `how'. + (font-lock-add-keywords, font-lock-update-removed-keyword-alist): + (font-lock-remove-keywords): Likewise. + +2005-12-14 Juri Linkov <juri@jurta.org> + + * log-view.el (log-view-diff): Doc fix. + + * isearch.el (isearch-query-replace): Use (mark) instead of + isearch-opoint if mark is active in transient-mark-mode. + +2005-12-14 Aaron S. Hawley <Aaron.Hawley@uvm.edu> + + * isearch.el (isearch-query-replace): Check for isearch-other-end. + +2005-12-14 Per Abrahamsen <abraham@dina.kvl.dk> + + * progmodes/cpp.el (cpp-face): New widget. + (cpp-known-face, cpp-unknown-face, cpp-edit-list): Use it. + +2005-12-14 Juri Linkov <juri@jurta.org> + + * help-macro.el (make-help-screen): Bind `inhibit-read-only' to t + around `erase-buffer' and `insert'. + + * descr-text.el (describe-text-properties): Replace buffer name + "*Help-2*" with "*Help*<2>". + (describe-char): Add functions print-help-return-message, + toggle-read-only. Use help-setup-xref with nil to not store + describe-char in help-xref-stack. Use help-make-xrefs to + make [back] button. + + * desktop.el (desktop-minor-mode-table): Add vc-dired-mode with nil. + + * wdired.el (wdired-old-point): New internal variable. + (wdired-change-to-wdired-mode): Set it buffer-locally. + (wdired-abort-changes): Restore point after aborting changes. + +2005-12-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc.el (vc-do-command): Add a new value t for okstatus. + + * vc-svn.el (vc-svn-registered): Use it to avoid popping up a spurious + frame in case of errors. + +2005-12-13 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * menu-bar.el (menu-bar-showhide-fringe-menu): Move "On the Right" + so it comes after "On the Left" in the menu. + +2005-12-12 Luc Teirlinck <teirllm@auburn.edu> + + * cus-edit.el (customize-apropos, customize-apropos-options) + (customize-apropos-faces, customize-apropos-groups): Doc fixes. + +2005-12-12 Bill Wohler <wohler@newt.com> + + * vc-svn.el (vc-svn-registered): Fix problem of visiting + non-writable Subversion-controlled files by saving window + configuration before calling vc-do-command. vc-do-command calls + pop-to-buffer on error which is unexpected during registration. + +2005-12-12 Jay Belanger <belanger@truman.edu> + + * calc/README: Update the summary of changes. + +2005-12-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * descr-text.el (describe-char): Rework last fix to solve the problem + is the same way it's solved for everything else in that function + (i.e. by extracting the info before setting up the *Help* buffer). + +2005-12-12 Kim F. Storm <storm@cua.dk> + + * subr.el (version-regexp-alist): Allow space as separator before + non-numeric part, e.g. "1.0 alpha". + (version-to-list): Interpret .X.Y version as 0.X.Y version. + +2005-12-12 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el: (org-agenda, org-timeline, org-todo): + Implement Logging and the keep-modes setting. + (org-get-category): Make sure a string is returned. + (org-log-done): New function. + (org-log-done, org-closed-string): New options. + +2005-12-12 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * tooltip.el (tooltip-y-offset): Change default to 20. + +2005-12-12 Richard M. Stallman <rms@gnu.org> + + * mouse.el (mouse-drag-vertical-line): Use adjust-window-trailing-edge. + + * frame.el (display-hourglass): Doc fix. + + * help.el (help-for-help-internal): Simplify entry for `a'. + + * info.el (Info-on-current-buffer): Doc fix. + (info-insert-file-contents): Don't test (featurep 'jka-compr). + + * startup.el (inhibit-splash-screen): Make this the real name. + (inhibit-startup-message): Make this the alias. + (command-line): Find only simple.el, and use its directory + to fill in other preloaded files' names. + (command-line): Deactivate the mark if deactivate-mark is set. + + * international/mule.el (load-with-code-conversion): + Bind deactivate-mark. + + * progmodes/compile.el (compilation-error-regexp-alist): Doc fix. + +2005-12-11 Luc Teirlinck <teirllm@auburn.edu> + + * cus-edit.el (customize-apropos): Avoid listing an option more + than once under different aliases. No longer list user options + that are not defined with defcustom (unless a prefix arg is given). + Doc fix. + (customize-apropos-options): Doc fix. + +2005-12-11 Juri Linkov <juri@jurta.org> + + * frame.el (set-background-color, set-foreground-color) + (set-cursor-color, set-mouse-color, set-border-color): + Add explicit prompts to read colors by `facemenu-read-color'. + (show-trailing-whitespace, blink-cursor-delay) + (blink-cursor-interval, display-hourglass, hourglass-delay): + Remove tags. + (display-hourglass, hourglass-delay): Doc fix. + (cursor-in-non-selected-windows): Capitalize words in tag. + + * faces.el (frame-background-mode): Replace `choice-item' keywords + with `const' to not make [default] button. Change default value tag + from `default' to `automatic'. Doc fix. + (trailing-whitespace) <defface>: Change group `whitespace' to + `whitespace-faces'. + +2005-12-11 Richard M. Stallman <rms@gnu.org> + + * buff-menu.el (Buffer-menu-sort-column): Not a user variable. + 2005-12-11 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> * term/mac-win.el: Create keymap for mac-apple-event-map. @@ -19,8 +365,8 @@ 2005-12-10 Johan Bockg,Ae(Brd <bojohan@dd.chalmers.se> - * align.el (align-regexp, align-highlight-rule): Use - region-beginning and region-end instead of point and mark, so that + * align.el (align-regexp, align-highlight-rule): + Use region-beginning and region-end instead of point and mark, so that repetition (with `repeat-complex-command') recomputes the region bounds. @@ -40,8 +386,8 @@ (hi-lock-archaic-interface-deduce): New variables. (turn-on-hi-lock-if-enabled, hi-lock-line-face-buffer) (hi-lock-face-buffer, hi-lock-face-phrase-buffer) - (hi-lock-find-patterns, hi-lock-font-lock-hook): Replace - hi-lock-buffer-mode with hi-lock-mode. + (hi-lock-find-patterns, hi-lock-font-lock-hook): + Replace hi-lock-buffer-mode with hi-lock-mode. 2005-12-10 Kevin Rodgers <ihs_4664@ihs.com> @@ -65,14 +411,14 @@ 2005-12-10 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> - * term/mac-win.el: Require url when compiling. Call - mac-process-deferred-apple-events after loading init files. + * term/mac-win.el: Require url when compiling. + Call mac-process-deferred-apple-events after loading init files. (mac-apple-event-map): New defvar. Define event handlers in it. (core-event, internet-event): New Apple event class symbols. (open-application, reopen-application, open-documents) (print-documents, open-contents, quit-application) - (application-died, show-preferences, autosave-now, get-url): New - Apple event ID symbols. + (application-died, show-preferences, autosave-now, get-url): + New Apple event ID symbols. (about): New HICommand ID symbol. (mac-event-spec, mac-event-ae): New macros. (mac-ae-parameter, mac-ae-list, mac-bytes-to-integer) @@ -84,9 +430,7 @@ 2005-12-10 Kenichi Handa <handa@m17n.org> - * simple.el (zap-to-char): Translate CHAR by - translation-table-for-input. - + * simple.el (zap-to-char): * isearch.el (isearch-process-search-char): Translate CHAR by translation-table-for-input. @@ -3016,6 +3360,26 @@ * replace.el (occur-engine): Add marker at end of line, too. +2005-11-04 Ken Manheimer <ken.manheimer@gmail.com> + + * pgg-pgp.el (pgg-pgp-encrypt-region, pgg-pgp-decrypt-region) + (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric) + (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt) + (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase' + argument to all these routines, so the passphrase can be managed + externally and passed in to the system. + (pgg-pgp-decrypt-region, pgg-pgp-sign-region): Use new name for + pgg-add-passphrase-to-cache function. + + * pgg-pgp5.el (pgg-pgp5-encrypt-region, pgg-pgp5-decrypt-region) + (pgg-pgp5-encrypt-symmetric-region, pgg-pgp5-encrypt-symmetric) + (pgg-pgp5-encrypt, pgg-pgp5-decrypt-region, pgg-pgp5-decrypt) + (pgg-pgp5-sign-region, pgg-pgp5-sign): Add optional 'passphrase' + argument to all these routines, so the passphrase can be managed + externally and passed in to the system. + (pgg-pgp5-sign-region): Use new name of pgg-add-passphrase-to-cache + function. + 2005-11-04 Dan Nicolaescu <dann@ics.uci.edu> * font-lock.el: Don't deal with font-lock-face-attributes here, @@ -3301,7 +3665,7 @@ * mouse.el: Fix special handling of DEL after dragging a region: (mouse-drag-region-1): Treat mouse-set-region like mouse-set-point. - (mouse-region-delete-keys): Add [backspace]. + (mouse-region-delete-keys): Change to defcustom. Add [backspace]. * mail/feedmail.el: Use insert-buffer-substring, not insert-buffer. @@ -3595,6 +3959,76 @@ (jit-lock-deferred-fontify, jit-lock-context-fontify) (jit-lock-after-change): Test memory-full. +2005-10-29 Ken Manheimer <ken.manheimer@gmail.com> + + * pgg-gpg.el (pgg-gpg-select-matching-key): Fix: look at the right + part of the decoded armor to find the key-identifier. + (pgg-gpg-lookup-key-owner): New function to return the + human-readable identifier of a key owner. + (pgg-gpg-lookup-id-from-key-owner): Make it easy to identify the + key itself. + (pgg-gpg-decrypt-region): Prompt with the key owner (rather than + the key value) if we have a key and can match it against a secret + key. Also, added a note pointing out fact that the prompt only + indicates the first matching key. + + * pgg.el (pgg-decrypt): Passing along 'passphrase' in call to + pgg-decrypt-region. + (pgg-pending-timers): A new hash for tracking the passphrase cache + timers, so that new ones supercede old ones. + (pgg-add-passphrase-to-cache): Rename from + `pgg-add-passphrase-cache' to reduce confusion (all callers + changed). Modified to cancel old timers when new ones are added. + (pgg-remove-passphrase-from-cache): Rename from + `pgg-remove-passphrase-cache' to reduce confusion (all callers + changed). Modified to cancel old timers when their keys are + removed from the cache. + (pgg-cancel-timer): In Emacs, an alias for cancel-timer; in + XEmacs, an indirection to delete-itimer. + (pgg-read-passphrase-from-cache, pgg-read-passphrase): + Extract pgg-read-passphrase-from-cache from pgg-read-passphrase so + users can only check cache without risk of prompting. Correct bug in + notruncate behavior. + (pgg-read-passphrase-from-cache, pgg-read-passphrase) + (pgg-add-passphrase-cache, pgg-remove-passphrase-cache): + Add informative docstrings. + (pgg-decrypt): Convey provided passphrase in subordinate call to + pgg-decrypt-region. + + * pgg.el (pgg-encrypt-region, pgg-encrypt-symmetric-region) + (pgg-encrypt-symmetric, pgg-encrypt, pgg-decrypt-region) + (pgg-decrypt, pgg-sign-region, pgg-sign): Add optional + 'passphrase' argument, so the passphrase can be managed externally + and then passed in to the system. + + * pgg.el (pgg-read-passphrase, pgg-add-passphrase-cache) + (pgg-remove-passphrase-cache): Add optional 'notruncate' argument, + so the passphrase cache can be used reliably with identifiers + besides a pgp packet's key id. + + * pgg-gpg.el (pgg-pgp-encrypt-region) + (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric) + (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt) + (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase' + argument to all these routines, so the passphrase can be managed + externally and passed in to the system. + + * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Add optional + 'notruncate' argument, so the passphrase cache can be used + reliably with identifiers besides a pgp packet's key id. + +2005-10-29 Sascha Wilde <swilde@sha-bang.de> + + * pgg-gpg.el (pgg-gpg-encrypt-symmetric-region): New function for + symmetric encryption. + (pgg-gpg-symmetric-key-p): New function to check for an symmetric + encrypted session key. + (pgg-gpg-decrypt-region): When decrypting a symmetric encrypted + message ask for the passphrase in a proper way. + + * pgg.el (pgg-encrypt-symmetric, pgg-encrypt-symmetric-region): + New user commands for symmetric encryption. + 2005-10-29 Roland Winkler <roland.winkler@physik.uni-erlangen.de> * textmodes/conf-mode.el (conf-assignment-sign) diff --git a/lisp/bindings.el b/lisp/bindings.el index 49a10bc5723..ee01a932039 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -338,29 +338,6 @@ Keymap to display on minor modes.") (defvar mode-line-buffer-identification-keymap nil "\ Keymap for what is displayed by `mode-line-buffer-identification'.") -(defun last-buffer () "\ -Return the last non-hidden buffer in the buffer list." - ;; This logic is more or less copied from bury-buffer, - ;; except that we reverse the buffer list. - (let ((list (nreverse (buffer-list (selected-frame)))) - (pred (frame-parameter nil 'buffer-predicate)) - found notsogood) - (while (and list (not found)) - (unless (or (eq (aref (buffer-name (car list)) 0) ? ) - ;; If the selected frame has a buffer_predicate, - ;; disregard buffers that don't fit the predicate. - (and pred (not (funcall pred (car list))))) - (if (get-buffer-window (car list) 'visible) - (or notsogood (eq (car list) (current-buffer))) - (setq found (car list)))) - (pop list)) - (or found notsogood - (get-buffer "*scratch*") - (progn - (set-buffer-major-mode - (get-buffer-create "*scratch*")) - (get-buffer "*scratch*"))))) - (defun unbury-buffer () "\ Switch to the last buffer in the buffer list." (interactive) @@ -673,8 +650,8 @@ language you are using." (define-key global-map [?\C-x right] 'next-buffer) (define-key global-map [?\C-x C-right] 'next-buffer) -(define-key global-map [?\C-x left] 'prev-buffer) -(define-key global-map [?\C-x C-left] 'prev-buffer) +(define-key global-map [?\C-x left] 'previous-buffer) +(define-key global-map [?\C-x C-left] 'previous-buffer) (let ((map minibuffer-local-map)) (define-key map "\en" 'next-history-element) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 95ead284676..d8e90408889 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -101,7 +101,7 @@ as it is by default." ;; This should get updated & resorted when you click on a column heading (defvar Buffer-menu-sort-column nil - "*2 for sorting by buffer names. 5 for sorting by file names. + "2 for sorting by buffer names. 5 for sorting by file names. nil for default sorting by visited order.") (defconst Buffer-menu-buffer-column 4) diff --git a/lisp/calc/README b/lisp/calc/README index 97f2a29f6ce..86539341358 100644 --- a/lisp/calc/README +++ b/lisp/calc/README @@ -71,6 +71,11 @@ Summary of changes to "Calc" Version 2.1: +* New matrix mode for square matrices. Improved handling of + non-commutative products. + +* New functions: powerexpand and ldiv. + * Added new functions: sec, csc, cot, sech, csch, coth. * 0^0 now evaluates to 1. diff --git a/lisp/complete.el b/lisp/complete.el index f5ab178e1b3..cde669a943f 100644 --- a/lisp/complete.el +++ b/lisp/complete.el @@ -206,11 +206,10 @@ specially in \\[find-file]. For example, See also the variable `PC-include-file-path'. Partial Completion mode extends the meaning of `completion-auto-help' (which -see) so that if it is neither nil nor t, Emacs will show the *Completions* -buffer only on the second attempt to complete. I.e. if TAB finds nothing -to complete, the first TAB will just say \"Next char not unique\" without -bringing up the *Completions* buffer, and the second TAB will then bring up -the *Completions* buffer." +see), so that if it is neither nil nor t, Emacs shows the `*Completions*' +buffer only on the second attempt to complete. That is, if TAB finds nothing +to complete, the first TAB just says \"Next char not unique\" and the +second TAB brings up the `*Completions*' buffer." :global t :group 'partial-completion ;; Deal with key bindings... (PC-bindings partial-completion-mode) @@ -613,8 +612,7 @@ of `minibuffer-completion-table' and the minibuffer contents.") (insert (substring prefix i (1+ i))) (setq end (1+ end))) (setq i (1+ i))) - (or pt (equal (point) beg) - (setq pt (point))) + (or pt (setq pt (point))) (looking-at PC-delim-regex)) (setq skip (concat skip (regexp-quote prefix) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index eed12113568..20a023dee75 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -121,10 +121,11 @@ ;; 6. rogue ;; There is no standard value. This means that the variable was -;; not defined with defcustom, nor handled in cus-start.el. You -;; can not create a Custom buffer for such variables using the -;; normal interactive Custom commands. However, such Custom -;; buffers can be created in other ways, for instance, by calling +;; not defined with defcustom, nor handled in cus-start.el. Most +;; standard interactive Custom commands do not let you create a +;; Custom buffer containing such variables. However, such Custom +;; buffers can be created, for instance, by calling +;; `customize-apropos' with a prefix arg or by calling ;; `customize-option' non-interactively. ;; 7. hidden @@ -1252,12 +1253,12 @@ suggest to customize that face, if it's customizable." ;;;###autoload (defun customize-apropos (regexp &optional all) - "Customize all user options matching REGEXP. + "Customize all loaded options, faces and groups matching REGEXP. If ALL is `options', include only options. If ALL is `faces', include only faces. If ALL is `groups', include only groups. -If ALL is t (interactively, with prefix arg), include options which are not -user-settable, as well as faces and groups." +If ALL is t (interactively, with prefix arg), include variables +that are not customizable options, as well as faces and groups." (interactive "sCustomize regexp: \nP") (let ((found nil)) (mapatoms (lambda (symbol) @@ -1270,11 +1271,11 @@ user-settable, as well as faces and groups." (push (list symbol 'custom-face) found)) (when (and (not (memq all '(groups faces))) (boundp symbol) + (eq (indirect-variable symbol) symbol) (or (get symbol 'saved-value) (custom-variable-p symbol) - (if (memq all '(nil options)) - (user-variable-p symbol) - (get symbol 'variable-documentation)))) + (and (not (memq all '(nil options))) + (get symbol 'variable-documentation)))) (push (list symbol 'custom-variable) found))))) (if (not found) (error "No matches") @@ -1284,20 +1285,20 @@ user-settable, as well as faces and groups." ;;;###autoload (defun customize-apropos-options (regexp &optional arg) - "Customize all user options matching REGEXP. -With prefix arg, include options which are not user-settable." + "Customize all loaded customizable options matching REGEXP. +With prefix arg, include variables that are not customizable options." (interactive "sCustomize regexp: \nP") (customize-apropos regexp (or arg 'options))) ;;;###autoload (defun customize-apropos-faces (regexp) - "Customize all user faces matching REGEXP." + "Customize all loaded faces matching REGEXP." (interactive "sCustomize regexp: \n") (customize-apropos regexp 'faces)) ;;;###autoload (defun customize-apropos-groups (regexp) - "Customize all user groups matching REGEXP." + "Customize all loaded groups matching REGEXP." (interactive "sCustomize regexp: \n") (customize-apropos regexp 'groups)) @@ -1757,7 +1758,7 @@ something in this group has been changed outside customize.") SAVED and set." "\ something in this group has been set and saved.") (rogue "@" custom-rogue "\ -NO CUSTOMIZATION DATA; you should not see this." "\ +NO CUSTOMIZATION DATA; not intended to be customized." "\ something in this group is not prepared for customization.") (standard " " nil "\ STANDARD." "\ diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 25c81555ee8..a75e227d2b0 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -160,7 +160,7 @@ otherwise." (let ((buffer (current-buffer)) (target-buffer "*Help*")) (when (eq buffer (get-buffer target-buffer)) - (setq target-buffer "*Help-2*")) + (setq target-buffer "*Help*<2>")) (save-excursion (with-output-to-temp-buffer target-buffer (set-buffer standard-output) @@ -464,9 +464,13 @@ as well as widgets, buttons, overlays, and text properties." (single-key-description char) (string-to-multibyte (char-to-string char))))) - (orig-buf (current-buffer)) - (help-buf (if (eq orig-buf (get-buffer "*Help*")) - "*Help-2*" "*Help*")) + (text-props-desc + (let ((tmp-buf (generate-new-buffer " *text-props*"))) + (unwind-protect + (progn + (describe-text-properties pos tmp-buf) + (with-current-buffer tmp-buf (buffer-string))) + (kill-buffer tmp-buf)))) item-list max-width unicode) (if (or (< char 256) @@ -619,8 +623,10 @@ as well as widgets, buttons, overlays, and text properties." (setq max-width (apply #'max (mapcar #'(lambda (x) (if (cadr x) (length (car x)) 0)) item-list))) - (with-output-to-temp-buffer help-buf + (with-output-to-temp-buffer "*Help*" (with-current-buffer standard-output + (let ((help-xref-following t)) + (help-setup-xref nil nil)) (set-buffer-multibyte multibyte-p) (let ((formatter (format "%%%ds:" max-width))) (dolist (elt item-list) @@ -722,10 +728,11 @@ as well as widgets, buttons, overlays, and text properties." (insert "\nSee the variable `reference-point-alist' for " "the meaning of the rule.\n")) - (save-excursion - (set-buffer orig-buf) - (describe-text-properties pos help-buf)) - (describe-text-mode))))) + (if text-props-desc (insert text-props-desc)) + (describe-text-mode) + (toggle-read-only 1) + (help-make-xrefs (current-buffer)) + (print-help-return-message))))) (defalias 'describe-char-after 'describe-char) (make-obsolete 'describe-char-after 'describe-char "22.1") diff --git a/lisp/desktop.el b/lisp/desktop.el index 087cb77f39d..49034884b53 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -411,7 +411,8 @@ Furthermore the major mode function must be autoloaded.") (defcustom desktop-minor-mode-table '((auto-fill-function auto-fill-mode) - (vc-mode nil)) + (vc-mode nil) + (vc-dired-mode nil)) "Table mapping minor mode variables to minor mode functions. Each entry has the form (NAME RESTORE-FUNCTION). NAME is the name of the buffer-local variable indicating that the minor diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index 46ae6186e44..12f0788a0de 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -247,7 +247,9 @@ and return t." (if (null completions) (crm-temp-echo-area-glyphs " [No completions]") (with-output-to-temp-buffer "*Completions*" - (display-completion-list (sort completions 'string-lessp)))))) + (display-completion-list + (sort completions 'string-lessp) + crm-current-element))))) nil) (defun crm-do-completion () diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 01f1d760109..9290ede2bdf 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3711,7 +3711,9 @@ Return the result of the last expression." (print-level (or edebug-print-level print-level)) (print-circle (or edebug-print-circle print-circle)) (print-readably nil)) ;; lemacs uses this. - (edebug-prin1-to-string value))) + (condition-case nil + (edebug-prin1-to-string value) + (error "#Apparently circular structure#")))) (defun edebug-compute-previous-result (edebug-previous-value) (if edebug-unwrap-results diff --git a/lisp/faces.el b/lisp/faces.el index d0e4162b0ec..a5482f565f2 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1577,17 +1577,17 @@ If omitted or nil, that stands for the selected frame's display." (defcustom frame-background-mode nil "*The brightness of the background. Set this to the symbol `dark' if your background color is dark, -`light' if your background is light, or nil (default) if you want Emacs -to examine the brightness for you. Don't set this variable with `setq'; -this won't have the expected effect." +`light' if your background is light, or nil (automatic by default) +if you want Emacs to examine the brightness for you. Don't set this +variable with `setq'; this won't have the expected effect." :group 'faces :set #'(lambda (var value) (set-default var value) (mapc 'frame-set-background-mode (frame-list))) :initialize 'custom-initialize-changed - :type '(choice (choice-item dark) - (choice-item light) - (choice-item :tag "default" nil))) + :type '(choice (const dark) + (const light) + (const :tag "automatic" nil))) (defun frame-set-background-mode (frame) @@ -2027,7 +2027,7 @@ created." (t :inverse-video t)) "Basic face for highlighting trailing whitespace." :version "21.1" - :group 'whitespace ; like `show-trailing-whitespace' + :group 'whitespace-faces ; like `show-trailing-whitespace' :group 'basic-faces) (defface escape-glyph diff --git a/lisp/files.el b/lisp/files.el index e3760f53fad..f886b8e0ad0 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2098,7 +2098,8 @@ only set the major mode, if that would change it." (setq done t) (or (set-auto-mode-0 mode keep-mode-if-same) ;; continuing would call minor modes again, toggling them off - (throw 'nop nil))))) + (throw 'nop nil)))))) + (unless done ;; If we didn't, look for an interpreter specified in the first line. ;; As a special case, allow for things like "#!/bin/env perl", which ;; finds the interpreter anywhere in $PATH. diff --git a/lisp/foldout.el b/lisp/foldout.el index 632a09bb05f..42f889fb96e 100644 --- a/lisp/foldout.el +++ b/lisp/foldout.el @@ -3,6 +3,7 @@ ;; Copyright (C) 1994, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: Kevin Broadey <KevinB@bartley.demon.co.uk> +;; Maintainer: FSF ;; Created: 27 Jan 1994 ;; Version: foldout.el 1.10 dated 94/05/19 at 17:09:12 ;; Keywords: folding, outlines diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 645ff179080..58fdf6dd809 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -463,13 +463,13 @@ optimized.") (defvar font-lock-keywords-alist nil "Alist of additional `font-lock-keywords' elements for major modes. -Each element has the form (MODE KEYWORDS . APPEND). +Each element has the form (MODE KEYWORDS . HOW). `font-lock-set-defaults' adds the elements in the list KEYWORDS to `font-lock-keywords' when Font Lock is turned on in major mode MODE. -If APPEND is nil, KEYWORDS are added at the beginning of +If HOW is nil, KEYWORDS are added at the beginning of `font-lock-keywords'. If it is `set', they are used to replace the -value of `font-lock-keywords'. If APPEND is any other non-nil value, +value of `font-lock-keywords'. If HOW is any other non-nil value, they are added at the end. This is normally set via `font-lock-add-keywords' and @@ -650,15 +650,15 @@ Major/minor modes can set this variable if they know which option applies.") (font-lock-unfontify-buffer) (font-lock-turn-off-thing-lock))) -(defun font-lock-add-keywords (mode keywords &optional append) +(defun font-lock-add-keywords (mode keywords &optional how) "Add highlighting KEYWORDS for MODE. MODE should be a symbol, the major mode command name, such as `c-mode' or nil. If nil, highlighting keywords are added for the current buffer. KEYWORDS should be a list; see the variable `font-lock-keywords'. By default they are added at the beginning of the current highlighting list. -If optional argument APPEND is `set', they are used to replace the current -highlighting list. If APPEND is any other non-nil value, they are added at the +If optional argument HOW is `set', they are used to replace the current +highlighting list. If HOW is any other non-nil value, they are added at the end of the current highlighting list. For example: @@ -691,17 +691,17 @@ Note that some modes have specialized support for additional patterns, e.g., see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types', `objc-font-lock-extra-types' and `java-font-lock-extra-types'." (cond (mode - ;; If MODE is non-nil, add the KEYWORDS and APPEND spec to + ;; If MODE is non-nil, add the KEYWORDS and HOW spec to ;; `font-lock-keywords-alist' so `font-lock-set-defaults' uses them. - (let ((spec (cons keywords append)) cell) + (let ((spec (cons keywords how)) cell) (if (setq cell (assq mode font-lock-keywords-alist)) - (if (eq append 'set) + (if (eq how 'set) (setcdr cell (list spec)) (setcdr cell (append (cdr cell) (list spec)))) (push (list mode spec) font-lock-keywords-alist))) ;; Make sure that `font-lock-removed-keywords-alist' does not ;; contain the new keywords. - (font-lock-update-removed-keyword-alist mode keywords append)) + (font-lock-update-removed-keyword-alist mode keywords how)) (t ;; Otherwise set or add the keywords now. ;; This is a no-op if it has been done already in this buffer @@ -712,13 +712,13 @@ see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types', (if was-compiled (setq font-lock-keywords (cadr font-lock-keywords))) ;; Now modify or replace them. - (if (eq append 'set) + (if (eq how 'set) (setq font-lock-keywords keywords) (font-lock-remove-keywords nil keywords) ;to avoid duplicates (let ((old (if (eq (car-safe font-lock-keywords) t) (cdr font-lock-keywords) font-lock-keywords))) - (setq font-lock-keywords (if append + (setq font-lock-keywords (if how (append old keywords) (append keywords old))))) ;; If the keywords were compiled before, compile them again. @@ -726,7 +726,7 @@ see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types', (set (make-local-variable 'font-lock-keywords) (font-lock-compile-keywords font-lock-keywords t))))))) -(defun font-lock-update-removed-keyword-alist (mode keywords append) +(defun font-lock-update-removed-keyword-alist (mode keywords how) "Update `font-lock-removed-keywords-alist' when adding new KEYWORDS to MODE." ;; When font-lock is enabled first all keywords in the list ;; `font-lock-keywords-alist' are added, then all keywords in the @@ -736,7 +736,7 @@ see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types', ;; will not take effect. (let ((cell (assq mode font-lock-removed-keywords-alist))) (if cell - (if (eq append 'set) + (if (eq how 'set) ;; A new set of keywords is defined. Forget all about ;; our old keywords that should be removed. (setq font-lock-removed-keywords-alist @@ -786,14 +786,14 @@ happens, so the major mode can be corrected." ;; If MODE is non-nil, remove the KEYWORD from ;; `font-lock-keywords-alist'. (when top-cell - (dolist (keyword-list-append-pair (cdr top-cell)) - ;; `keywords-list-append-pair' is a cons with a list of - ;; keywords in the car top-cell and the original append + (dolist (keyword-list-how-pair (cdr top-cell)) + ;; `keywords-list-how-pair' is a cons with a list of + ;; keywords in the car top-cell and the original how ;; argument in the cdr top-cell. - (setcar keyword-list-append-pair - (delete keyword (car keyword-list-append-pair)))) - ;; Remove keyword list/append pair when the keyword list - ;; is empty and append doesn't specify `set'. (If it + (setcar keyword-list-how-pair + (delete keyword (car keyword-list-how-pair)))) + ;; Remove keyword list/how pair when the keyword list + ;; is empty and how doesn't specify `set'. (If it ;; should be deleted then previously deleted keywords ;; would appear again.) (let ((cell top-cell)) diff --git a/lisp/frame.el b/lisp/frame.el index a20317047c2..0061119c04e 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -962,7 +962,7 @@ See `modify-frame-parameters.'" "Set the background color of the selected frame to COLOR-NAME. When called interactively, prompt for the name of the color to use. To get the frame's current background color, use `frame-parameters'." - (interactive (list (facemenu-read-color))) + (interactive (list (facemenu-read-color "Background color: "))) (modify-frame-parameters (selected-frame) (list (cons 'background-color color-name))) (or window-system @@ -972,7 +972,7 @@ To get the frame's current background color, use `frame-parameters'." "Set the foreground color of the selected frame to COLOR-NAME. When called interactively, prompt for the name of the color to use. To get the frame's current foreground color, use `frame-parameters'." - (interactive (list (facemenu-read-color))) + (interactive (list (facemenu-read-color "Foreground color: "))) (modify-frame-parameters (selected-frame) (list (cons 'foreground-color color-name))) (or window-system @@ -982,7 +982,7 @@ To get the frame's current foreground color, use `frame-parameters'." "Set the text cursor color of the selected frame to COLOR-NAME. When called interactively, prompt for the name of the color to use. To get the frame's current cursor color, use `frame-parameters'." - (interactive (list (facemenu-read-color))) + (interactive (list (facemenu-read-color "Cursor color: "))) (modify-frame-parameters (selected-frame) (list (cons 'cursor-color color-name)))) @@ -990,7 +990,7 @@ To get the frame's current cursor color, use `frame-parameters'." "Set the color of the mouse pointer of the selected frame to COLOR-NAME. When called interactively, prompt for the name of the color to use. To get the frame's current mouse color, use `frame-parameters'." - (interactive (list (facemenu-read-color))) + (interactive (list (facemenu-read-color "Mouse color: "))) (modify-frame-parameters (selected-frame) (list (cons 'mouse-color (or color-name @@ -1001,7 +1001,7 @@ To get the frame's current mouse color, use `frame-parameters'." "Set the color of the border of the selected frame to COLOR-NAME. When called interactively, prompt for the name of the color to use. To get the frame's current border color, use `frame-parameters'." - (interactive (list (facemenu-read-color))) + (interactive (list (facemenu-read-color "Border color: "))) (modify-frame-parameters (selected-frame) (list (cons 'border-color color-name)))) @@ -1283,7 +1283,6 @@ left untouched. FRAME nil or omitted means use the selected frame." (defcustom show-trailing-whitespace nil "*Non-nil means highlight trailing whitespace. This is done in the face `trailing-whitespace'." - :tag "Highlight trailing whitespace." :type 'boolean :group 'whitespace-faces) @@ -1315,13 +1314,11 @@ point visible." (defcustom blink-cursor-delay 0.5 "*Seconds of idle time after which cursor starts to blink." - :tag "Delay in seconds." :type 'number :group 'cursor) (defcustom blink-cursor-interval 0.5 "*Length of cursor blink interval in seconds." - :tag "Blink interval in seconds." :type 'number :group 'cursor) @@ -1397,14 +1394,14 @@ itself as a pre-command hook." ;; Hourglass pointer (defcustom display-hourglass t - "*Non-nil means show an hourglass pointer when running under a window system." - :tag "Hourglass pointer" + "*Non-nil means show an hourglass pointer, when Emacs is busy. +This feature only works when on a window system that can change +cursor shapes." :type 'boolean :group 'cursor) (defcustom hourglass-delay 1 - "*Seconds to wait before displaying an hourglass pointer." - :tag "Hourglass delay" + "*Seconds to wait before displaying an hourglass pointer when Emacs is busy." :type 'number :group 'cursor) @@ -1413,7 +1410,7 @@ itself as a pre-command hook." "*Non-nil means show a hollow box cursor in non-selected windows. If nil, don't show a cursor except in the selected window. Use Custom to set this variable to get the display updated." - :tag "Cursor in non-selected windows" + :tag "Cursor In Non-selected Windows" :type 'boolean :group 'cursor :set #'(lambda (symbol value) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 708d232e994..40adfc1d853 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,65 @@ +2005-12-16 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-signature-separator): Fix custom type. + + * mm-decode.el (mm-inlined-types): Fix custom type. + (mm-keep-viewer-alive-types): Ditto. + (mm-automatic-display): Ditto. + (mm-attachment-override-types): Ditto. + (mm-inline-override-types): Ditto. + (mm-automatic-external-display): Ditto. + +2005-12-12 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-buttonized-mime-types): Mention addition of + multipart/alternative and add xref to mm-discouraged-alternatives + in doc string. + + * mm-decode.el (mm-discouraged-alternatives): Add xref to + gnus-buttonized-mime-types in doc string. + +2005-12-12 Katsumi Yamaoka <yamaoka@jpl.org> + + * rfc2047.el (rfc2047-charset-to-coding-system): Recognize + us-ascii as a MIME charset. + + * mm-bodies.el (mm-decode-content-transfer-encoding): Protect + against the case where the 2nd arg TYPE is nil. + +2005-12-09 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-start.el (gnus-no-server-1): Mention + `gnus-level-default-subscribed' in doc string. + +2005-11-26 Dave Love <fx@gnu.org> + + * tls.el (open-tls-stream): Rename arg SERVICE to PORT. + (tls-program, tls-success): Provide openssl alternative. + + * starttls.el: Doc fixes. + (starttls-open-stream-gnutls, starttls-open-stream): Rename arg + SERVICE to PORT. + +2005-12-09 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-start.el (gnus-start-draft-setup): Enforce + `gnus-draft-mode' for nndraft:drafts at startup. + + * gnus.el (gnus-splash): Change custom group. + (gnus-group-get-parameter, gnus-group-parameter-value): Describe + allow-list argument. + + * gnus-agent.el (gnus-agent-article-alist-save-format): Format doc + string. + +2005-12-09 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change) + + * mm-decode.el (mm-display-external): Add lacked cdr. + +2005-12-12 Richard M. Stallman <rms@gnu.org> + + * mm-url.el (mm-url-load-url): Require url-parse and url-vars. + 2005-12-08 Reiner Steib <Reiner.Steib@gmx.de> * mm-decode.el (mm-discouraged-alternatives): Fix custom type. @@ -102,103 +164,6 @@ as a buffer-local variable. This avoids creating truncated dribble files as a result of a hang up, eg. -2005-11-04 Ken Manheimer <ken.manheimer@gmail.com> - - * pgg-pgp.el (pgg-pgp-encrypt-region, pgg-pgp-decrypt-region) - (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric) - (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt) - (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase' - argument to all these routines, so the passphrase can be managed - externally and passed in to the system. - (pgg-pgp-decrypt-region, pgg-pgp-sign-region): Use new name for - pgg-add-passphrase-to-cache function. - - * pgg-pgp5.el (pgg-pgp5-encrypt-region, pgg-pgp5-decrypt-region) - (pgg-pgp5-encrypt-symmetric-region, pgg-pgp5-encrypt-symmetric) - (pgg-pgp5-encrypt, pgg-pgp5-decrypt-region, pgg-pgp5-decrypt) - (pgg-pgp5-sign-region, pgg-pgp5-sign): Add optional 'passphrase' - argument to all these routines, so the passphrase can be managed - externally and passed in to the system. - (pgg-pgp5-sign-region): Use new name of pgg-add-passphrase-to-cache - function. - -2005-10-30 Chong Yidong <cyd@stupidchicken.com> - - * imap.el (imap-open): Handle case where buffer is a buffer - object. - -2005-10-29 Ken Manheimer <ken.manheimer@gmail.com> - - * pgg-gpg.el (pgg-gpg-select-matching-key): Fix: look at the right - part of the decoded armor to find the key-identifier. - (pgg-gpg-lookup-key-owner): New function to return the - human-readable identifier of a key owner. - (pgg-gpg-lookup-id-from-key-owner): Make it easy to identify the - key itself. - (pgg-gpg-decrypt-region): Prompt with the key owner (rather than - the key value) if we have a key and can match it against a secret - key. Also, added a note pointing out fact that the prompt only - indicates the first matching key. - - * pgg.el (pgg-decrypt): Passing along 'passphrase' in call to - pgg-decrypt-region. - (pgg-pending-timers): A new hash for tracking the passphrase cache - timers, so that new ones supercede old ones. - (pgg-add-passphrase-to-cache): Rename from - `pgg-add-passphrase-cache' to reduce confusion (all callers - changed). Modified to cancel old timers when new ones are added. - (pgg-remove-passphrase-from-cache): Rename from - `pgg-remove-passphrase-cache' to reduce confusion (all callers - changed). Modified to cancel old timers when their keys are - removed from the cache. - (pgg-cancel-timer): In Emacs, an alias for cancel-timer; in - XEmacs, an indirection to delete-itimer. - (pgg-read-passphrase-from-cache, pgg-read-passphrase): - Extract pgg-read-passphrase-from-cache from pgg-read-passphrase so - users can only check cache without risk of prompting. Correct bug in - notruncate behavior. - (pgg-read-passphrase-from-cache, pgg-read-passphrase) - (pgg-add-passphrase-cache, pgg-remove-passphrase-cache): - Add informative docstrings. - (pgg-decrypt): Convey provided passphrase in subordinate call to - pgg-decrypt-region. - -2005-10-20 Ken Manheimer <ken.manheimer+emacs@gmail.com> - - * pgg.el (pgg-encrypt-region, pgg-encrypt-symmetric-region) - (pgg-encrypt-symmetric, pgg-encrypt, pgg-decrypt-region) - (pgg-decrypt, pgg-sign-region, pgg-sign): Add optional - 'passphrase' argument, so the passphrase can be managed externally - and then passed in to the system. - - * pgg.el (pgg-read-passphrase, pgg-add-passphrase-cache) - (pgg-remove-passphrase-cache): Add optional 'notruncate' argument, - so the passphrase cache can be used reliably with identifiers - besides a pgp packet's key id. - - * pgg-gpg.el (pgg-pgp-encrypt-region) - (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric) - (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt) - (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase' - argument to all these routines, so the passphrase can be managed - externally and passed in to the system. - - * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Add optional - 'notruncate' argument, so the passphrase cache can be used - reliably with identifiers besides a pgp packet's key id. - -2005-10-29 Sascha Wilde <swilde@sha-bang.de> - - * pgg-gpg.el (pgg-gpg-encrypt-symmetric-region): New function for - symmetric encryption. - (pgg-gpg-symmetric-key-p): New function to check for an symmetric - encrypted session key. - (pgg-gpg-decrypt-region): When decrypting a symmetric encrypted - message ask for the passphrase in a proper way. - - * pgg.el (pgg-encrypt-symmetric, pgg-encrypt-symmetric-region): - New user commands for symmetric encryption. - 2005-11-30 Stefan Monnier <monnier@iro.umontreal.ca> * gnus-delay.el (gnus-delay-group): Don't autoload. diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 2139c485720..400dbe7c29f 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -214,11 +214,12 @@ unplugged." :type 'boolean) (defcustom gnus-agent-article-alist-save-format 1 - "Indicates whether to use compression(2), verses no - compression(1), when writing agentview files. The compressed - files do save space but load times are 6-7 times higher. A - group must be opened then closed for the agentview to be - updated using the new format." + "Indicates whether to use compression(2), versus no +compression(1), when writing agentview files. The compressed +files do save space but load times are 6-7 times higher. A group +must be opened then closed for the agentview to be updated using +the new format." + ;; Wouldn't symbols instead numbers be nicer? --rsteib :version "22.1" :group 'gnus-agent :type '(radio (const :format "Compressed" 2) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index ef5796a6083..ad3c91f3579 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -225,7 +225,9 @@ only of boring text. Boring text is controlled by This can also be a list of regexps. In that case, it will be checked from head to tail looking for a separator. Searches will be done from the end of the buffer." - :type '(repeat string) + :type '(choice :format "%{%t%}: %[Value Menu%]\n%v" + (regexp) + (repeat :tag "List of regexp" regexp)) :group 'gnus-article-signature) (defcustom gnus-signature-limit nil @@ -822,7 +824,9 @@ This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil." "List of MIME types that should be given buttons when rendered inline. If set, this variable overrides `gnus-unbuttonized-mime-types'. To see e.g. security buttons you could set this to -`(\"multipart/signed\")'. +`(\"multipart/signed\")'. You could also add \"multipart/alternative\" to +this list to display radio buttons that allow you to choose one of two +media types those mails include. See also `mm-discouraged-alternatives'. This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil." :version "22.1" :group 'gnus-article-mime diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index d3b313c621f..53bcc4be15f 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -717,11 +717,12 @@ the first newsgroup." (defun gnus-no-server-1 (&optional arg slave) "Read network news. -If ARG is a positive number, Gnus will use that as the -startup level. If ARG is nil, Gnus will be started at level 2. -If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use. -As opposed to `gnus', this command will not connect to the local server." +If ARG is a positive number, Gnus will use that as the startup +level. If ARG is nil, Gnus will be started at level 2 +\(`gnus-level-default-subscribed' minus one). If ARG is non-nil +and not a positive number, Gnus will prompt the user for the name +of an NNTP server to use. As opposed to \\[gnus], this command +will not connect to the local server." (interactive "P") (let ((val (or arg (1- gnus-level-default-subscribed)))) (gnus val t slave) @@ -805,8 +806,12 @@ prompt the user for the name of an NNTP server to use." "Make sure the draft group exists." (gnus-request-create-group "drafts" '(nndraft "")) (unless (gnus-gethash "nndraft:drafts" gnus-newsrc-hashtb) + (gnus-message 3 "Subscribing drafts group") (let ((gnus-level-default-subscribed 1)) - (gnus-subscribe-group "nndraft:drafts" nil '(nndraft ""))) + (gnus-subscribe-group "nndraft:drafts" nil '(nndraft "")))) + (unless (equal (gnus-group-get-parameter "nndraft:drafts" 'gnus-dummy t) + '((gnus-draft-mode))) + (gnus-message 3 "Setting up drafts group") (gnus-group-set-parameter "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode))))) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 578fc49395c..20e41bde239 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -934,7 +934,7 @@ be set in `.emacs' instead." (t ())) "Face for the splash screen." - :group 'gnus) + :group 'gnus-start) ;; backward-compatibility alias (put 'gnus-splash-face 'face-alias 'gnus-splash) @@ -3820,6 +3820,7 @@ If you call this function inside a loop, consider using the faster (defun gnus-group-get-parameter (group &optional symbol allow-list) "Return the group parameters for GROUP. If SYMBOL, return the value of that symbol in the group parameters. +If ALLOW-LIST, also allow list as a result. Most functions should use `gnus-group-find-parameter', which also examines the topic parameters." (let ((params (gnus-info-params (gnus-get-info group)))) @@ -3829,7 +3830,8 @@ also examines the topic parameters." (defun gnus-group-parameter-value (params symbol &optional allow-list present-p) - "Return the value of SYMBOL in group PARAMS." + "Return the value of SYMBOL in group PARAMS. +If ALLOW-LIST, also allow list as a result." ;; We only wish to return group parameters (dotted lists) and ;; not local variables, which may have the same names. ;; But first we handle single elements... diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index e9f8f1e9391..8b47989e563 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -227,6 +227,7 @@ If TYPE is `text/plain' CRLF->LF translation may occur." (message "Error while decoding: %s" error) nil)) (when (and + type (memq encoding '(base64 x-uuencode x-uue x-binhex x-yenc)) (string-match "\\`text/" type)) (goto-char (point-min)) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 108c5056541..5b55af4d756 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -283,7 +283,7 @@ before the external MIME handler is invoked." "List of media types that are to be displayed inline. See also `mm-inline-media-tests', which says how to display a media type inline." - :type '(repeat string) + :type '(repeat regexp) :group 'mime-display) (defcustom mm-keep-viewer-alive-types @@ -292,7 +292,7 @@ type inline." "List of media types for which the external viewer will not be killed when selecting a different article." :version "22.1" - :type '(repeat string) + :type '(repeat regexp) :group 'mime-display) (defcustom mm-automatic-display @@ -304,7 +304,7 @@ when selecting a different article." "application/pkcs7-signature" "application/x-pkcs7-mime" "application/pkcs7-mime") "A list of MIME types to be displayed automatically." - :type '(repeat string) + :type '(repeat regexp) :group 'mime-display) (defcustom mm-attachment-override-types '("text/x-vcard" @@ -313,17 +313,17 @@ when selecting a different article." "application/pkcs7-signature" "application/x-pkcs7-signature") "Types to have \"attachment\" ignored if they can be displayed inline." - :type '(repeat string) + :type '(repeat regexp) :group 'mime-display) (defcustom mm-inline-override-types nil "Types to be treated as attachments even if they can be displayed inline." - :type '(repeat string) + :type '(repeat regexp) :group 'mime-display) (defcustom mm-automatic-external-display nil "List of MIME type regexps that will be displayed externally automatically." - :type '(repeat string) + :type '(repeat regexp) :group 'mime-display) (defcustom mm-discouraged-alternatives nil @@ -338,7 +338,9 @@ to: (\"text/html\" \"text/richtext\") Adding \"image/.*\" might also be useful. Spammers use it as the -prefered part of multipart/alternative messages." +prefered part of multipart/alternative messages. See also +`gnus-buttonized-mime-types', to which adding \"multipart/alternative\" +enables you to choose manually one of two types those mails include." :type '(repeat regexp) ;; See `mm-preferred-alternative-precedence'. :group 'mime-display) @@ -769,7 +771,7 @@ external if displayed external." ;; Use nametemplate (defined in RFC1524) if it is ;; specified in mailcap. (if (assoc "nametemplate" mime-info) - (format (assoc "nametemplate" mime-info) file) + (format (cdr (assoc "nametemplate" mime-info)) file) ;; Add a suffix according to `mailcap-mime-extensions'. (concat file (car (rassoc (mm-handle-media-type handle) mailcap-mime-extensions)))))) diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index b24f9d4132a..22a9dbf077c 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -276,7 +276,10 @@ This is taken from RFC 2396.") (defun mm-url-load-url () "Load `url-insert-file-contents'." (unless (condition-case () - (require 'url-handlers) + (progn + (require 'url-handlers) + (require 'url-parse) + (require 'url-vars)) (error nil)) ;; w3-4.0pre0.46 or earlier version. (require 'w3-vars) diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el index d03a25c4564..5d2710d6bb6 100644 --- a/lisp/gnus/rfc2047.el +++ b/lisp/gnus/rfc2047.el @@ -831,11 +831,11 @@ If your Emacs implementation can't decode CHARSET, return nil." (memq 'gnus-all mail-parse-ignored-charsets) (memq charset mail-parse-ignored-charsets)) (setq charset mail-parse-charset)) - (let ((cs (mm-coding-system-p (mm-charset-to-coding-system charset)))) + (let ((cs (mm-charset-to-coding-system charset))) (cond ((eq cs 'ascii) (setq cs (or (mm-charset-to-coding-system mail-parse-charset) 'raw-text))) - (cs) + ((setq cs (mm-coding-system-p cs))) ((and charset (listp mail-parse-ignored-charsets) (memq 'gnus-unknown mail-parse-ignored-charsets)) diff --git a/lisp/gnus/starttls.el b/lisp/gnus/starttls.el index 67464395c76..c63e08fc12e 100644 --- a/lisp/gnus/starttls.el +++ b/lisp/gnus/starttls.el @@ -32,7 +32,7 @@ ;; [RFC 2595] "Using TLS with IMAP, POP3 and ACAP" ;; by Chris Newman <chris.newman@innosoft.com> (1999/06) -;; This file now contain a combination of the two previous +;; This file now contains a combination of the two previous ;; implementations both called "starttls.el". The first one is Daiki ;; Ueno's starttls.el which uses his own "starttls" command line tool, ;; and the second one is Simon Josefsson's starttls.el which uses @@ -44,7 +44,7 @@ ;; both tools installed. It is recommended to use GNUTLS, though, as ;; it performs more verification of the certificates. -;; The GNUTLS support require GNUTLS 0.9.90 (released 2003-10-08) or +;; The GNUTLS support requires GNUTLS 0.9.90 (released 2003-10-08) or ;; later, from <http://www.gnu.org/software/gnutls/>, or "starttls" ;; from <ftp://ftp.opaopa.org/pub/elisp/>. @@ -58,7 +58,7 @@ ;; (message "STARTTLS output:\n%s" (starttls-negotiate tmp)) ;; (process-send-string tmp "EHLO foo\n")) -;; An example run yield the following output: +;; An example run yields the following output: ;; ;; 220 yxa.extundo.com ESMTP Sendmail 8.12.11/8.12.11/Debian-3; Wed, 26 May 2004 19:12:29 +0200; (No UCE/UBE) logging access from: c494102a.s-bi.bostream.se(OK)-c494102a.s-bi.bostream.se [217.215.27.65] ;; 220 2.0.0 Ready to start TLS @@ -146,15 +146,14 @@ i.e. when `starttls-use-gnutls' is nil." (defcustom starttls-extra-args nil "Extra arguments to `starttls-program'. -This program is used when the `starttls' command is used, -i.e. when `starttls-use-gnutls' is nil." +These apply when the `starttls' command is used, i.e. when +`starttls-use-gnutls' is nil." :type '(repeat string) :group 'starttls) (defcustom starttls-extra-arguments nil "Extra arguments to `starttls-program'. -This program is used when GNUTLS is used, i.e. when -`starttls-use-gnutls' is non-nil. +These apply when GNUTLS is used, i.e. when `starttls-use-gnutls' is non-nil. For example, non-TLS compliant servers may require '(\"--protocols\" \"ssl3\"). Invoke \"gnutls-cli --help\" to @@ -172,7 +171,7 @@ find out which parameters are available." (defcustom starttls-connect "- Simple Client Mode:\n\n" "*Regular expression indicating successful connection. The default is what GNUTLS's \"gnutls-cli\" outputs." - ;; GNUTLS cli.c:main() print this string when it is starting to run + ;; GNUTLS cli.c:main() prints this string when it is starting to run ;; in the application read/write phase. If the logic, or the string ;; itself, is modified, this must be updated. :version "22.1" @@ -182,7 +181,7 @@ The default is what GNUTLS's \"gnutls-cli\" outputs." (defcustom starttls-failure "\\*\\*\\* Handshake has failed" "*Regular expression indicating failed TLS handshake. The default is what GNUTLS's \"gnutls-cli\" outputs." - ;; GNUTLS cli.c:do_handshake() print this string on failure. If the + ;; GNUTLS cli.c:do_handshake() prints this string on failure. If the ;; logic, or the string itself, is modified, this must be updated. :version "22.1" :type 'regexp @@ -200,10 +199,10 @@ The default is what GNUTLS's \"gnutls-cli\" outputs." :group 'starttls) (defun starttls-negotiate-gnutls (process) - "Negotiate TLS on process opened by `open-starttls-stream'. -This should typically only be done once. It typically return a + "Negotiate TLS on PROCESS opened by `open-starttls-stream'. +This should typically only be done once. It typically returns a multi-line informational message with information about the -handshake, or NIL on failure." +handshake, or nil on failure." (let (buffer info old-max done-ok done-bad) (if (null (setq buffer (process-buffer process))) ;; XXX How to remove/extract the TLS negotiation junk? @@ -243,16 +242,16 @@ handshake, or NIL on failure." (defalias 'starttls-set-process-query-on-exit-flag 'process-kill-without-query))) -(defun starttls-open-stream-gnutls (name buffer host service) +(defun starttls-open-stream-gnutls (name buffer host port) (message "Opening STARTTLS connection to `%s'..." host) (let* (done (old-max (with-current-buffer buffer (point-max))) (process-connection-type starttls-process-connection-type) (process (apply #'start-process name buffer starttls-gnutls-program "-s" host - "-p" (if (integerp service) - (int-to-string service) - service) + "-p" (if (integerp port) + (int-to-string port) + port) starttls-extra-arguments))) (starttls-set-process-query-on-exit-flag process nil) (while (and (processp process) @@ -273,11 +272,11 @@ handshake, or NIL on failure." host (if done "done" "failed")) process)) -(defun starttls-open-stream (name buffer host service) - "Open a TLS connection for a service to a host. -Returns a subprocess-object to represent the connection. +(defun starttls-open-stream (name buffer host port) + "Open a TLS connection for a port to a host. +Returns a subprocess object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. -Args are NAME BUFFER HOST SERVICE. +Args are NAME BUFFER HOST PORT. NAME is name for process. It is modified if necessary to make it unique. BUFFER is the buffer (or `buffer-name') to associate with the process. Process output goes at end of that buffer, unless you specify @@ -285,14 +284,15 @@ BUFFER is the buffer (or `buffer-name') to associate with the process. BUFFER may be also nil, meaning that this process is not associated with any buffer Third arg is name of the host to connect to, or its IP address. -Fourth arg SERVICE is name of the service desired, or an integer -specifying a port number to connect to." +Fourth arg PORT is an integer specifying a port to connect to. +If `starttls-use-gnutls' is nil, this may also be a service name, but +GNUTLS requires a port number." (if starttls-use-gnutls - (starttls-open-stream-gnutls name buffer host service) + (starttls-open-stream-gnutls name buffer host port) (let* ((process-connection-type starttls-process-connection-type) (process (apply #'start-process name buffer starttls-program - host (format "%s" service) + host (format "%s" port) starttls-extra-args))) (starttls-set-process-query-on-exit-flag process nil) process))) diff --git a/lisp/help-macro.el b/lisp/help-macro.el index 33ee42abe7e..3170bf287b5 100644 --- a/lisp/help-macro.el +++ b/lisp/help-macro.el @@ -139,8 +139,9 @@ and then returns." (setq new-frame (window-frame (selected-window)) config nil)) (setq buffer-read-only nil) - (erase-buffer) - (insert help-screen) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert help-screen)) (help-mode) (goto-char (point-min)) (while (or (memq char (append help-event-list diff --git a/lisp/help.el b/lisp/help.el index 02040007f6e..3b78194b6a3 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -183,8 +183,7 @@ specifies what to do when the user exits the help buffer." \(Use SPC or DEL to scroll through this text. Type \\<help-map>\\[help-quit] to exit the Help command.) a command-apropos. Give a list of words or a regexp, to get a list of - commands whose names match (they contain two or more of the words, - or a match for the regexp). See also the apropos command. + commands whose names match. See also the apropos command. b describe-bindings. Display table of all key bindings. c describe-key-briefly. Type a command key sequence; it prints the function name that sequence runs. diff --git a/lisp/info.el b/lisp/info.el index 94bf36222f0..79a8a5d0a30 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -448,8 +448,7 @@ Do the right thing if the file has been compressed or zipped." (or tail (error "Can't find %s or any compressed version of it" filename))) ;; check for conflict with jka-compr - (if (and (featurep 'jka-compr) - (jka-compr-installed-p) + (if (and (jka-compr-installed-p) (jka-compr-get-compression-info fullname)) (setq decoder nil)) (if decoder @@ -698,9 +697,9 @@ it says do not attempt further (recursive) error recovery." ;;;###autoload (defun Info-on-current-buffer (&optional nodename) - "Use the `Info-mode' to browse the current Info buffer. -If a prefix arg is provided, it queries for the NODENAME which -else defaults to \"Top\"." + "Use Info mode to browse the current Info buffer. +With a prefix arg, this queries for the node name to visit first; +otherwise, that defaults to `Top'." (interactive (list (if current-prefix-arg (completing-read "Node name: " (Info-build-node-completions) @@ -1518,7 +1517,12 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." ;; Arrange to highlight the proper letters in the completion list buffer. (put 'Info-read-node-name-1 'completion-base-size-function - (lambda () 1)) + (lambda () + (if (string-match "\\`([^)]*\\'" + (or completion-common-substring + (minibuffer-completion-contents))) + 1 + 0))) (defun Info-read-node-name (prompt &optional default) (let* ((completion-ignore-case t) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 20bf5696f2e..e708ed4b3f0 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -73,7 +73,9 @@ Return t if file exists." (inhibit-file-name-operation nil)) (save-excursion (set-buffer buffer) - (insert-file-contents fullname) + ;; Don't let deactivate-mark remain set. + (let (deactivate-mark) + (insert-file-contents fullname)) ;; If the loaded file was inserted with no-conversion or ;; raw-text coding system, make the buffer unibyte. ;; Otherwise, eval-buffer might try to interpret random diff --git a/lisp/isearch.el b/lisp/isearch.el index 99c637e5664..8f28e13804b 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1224,9 +1224,10 @@ Use `isearch-exit' to quit without signaling." (let ((case-fold-search isearch-case-fold-search)) (isearch-done) (isearch-clean-overlays) - (if (and (< isearch-other-end (point)) + (if (and isearch-other-end + (< isearch-other-end (point)) (not (and transient-mark-mode mark-active - (< isearch-opoint (point))))) + (< (mark) (point))))) (goto-char isearch-other-end)) (set query-replace-from-history-variable (cons isearch-string diff --git a/lisp/log-view.el b/lisp/log-view.el index d640eac3835..6a9464005fb 100644 --- a/lisp/log-view.el +++ b/lisp/log-view.el @@ -195,10 +195,11 @@ ;; (defun log-view-diff (beg end) - "Get the diff for several revisions. -If the point is the same as the mark or the mark is not active, -get the diff for this revision. Otherwise, get the diff between -the revisions where the region starts and ends." + "Get the diff between two revisions. +If the mark is not active or the mark is on the revision at point, +get the diff between the revision at point and its previous revision. +Otherwise, get the diff between the revisions where the region starts +and ends." (interactive (list (if mark-active (region-beginning) (point)) (if mark-active (region-end) (point)))) diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index 31e31442378..35b9f1cbd28 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in @@ -97,6 +97,8 @@ doit: $(lisp)/cus-load.el: touch $@ +# WARNING: Do NOT split the part inside $(ARGQUOTE)s into multiple lines as +# this can break with GNU Make 3.81 and later if sh.exe is used. custom-deps: $(lisp)/cus-load.el doit @echo Directories: $(WINS) -$(emacs) -l cus-dep --eval $(ARGQUOTE)(setq find-file-hook nil)$(ARGQUOTE) -f custom-make-dependencies $(lisp) $(WINS) @@ -150,13 +152,13 @@ loaddefs.el-CMD: # including a drive letter and any leading directories, so the generated # loaddefs.el will mention file names that on other machine reference # possibly non-existent directories. +# +# WARNING: Do NOT split the part inside $(ARGQUOTE)s into multiple lines as +# this can break with GNU Make 3.81 and later if sh.exe is used. autoloads: $(lisp)/loaddefs.el doit @echo Directories: . $(WINS) $(emacs) -l autoload \ - --eval $(ARGQUOTE)(setq find-file-hook nil \ - find-file-suppress-same-file-warnings t \ - generated-autoload-file \ - $(DQUOTE)$(lisp)/loaddefs.el$(DQUOTE))$(ARGQUOTE) \ + --eval $(ARGQUOTE)(setq find-file-hook nil find-file-suppress-same-file-warnings t generated-autoload-file $(DQUOTE)$(lisp)/loaddefs.el$(DQUOTE))$(ARGQUOTE) \ -f batch-update-autoloads . $(WINS) $(lisp)/subdirs.el: diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 56745d82cc4..6fa8c8b0f03 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -831,18 +831,6 @@ mail status in mode line")) :visible (display-graphic-p) :button (:radio . (eq fringe-mode nil)))) -(defun menu-bar-showhide-fringe-menu-customize-left () - "Display fringes only on the left of each window." - (interactive) - (require 'fringe) - (customize-set-variable 'fringe-mode '(nil . 0))) - -(define-key menu-bar-showhide-fringe-menu [left] - '(menu-item "On the Left" menu-bar-showhide-fringe-menu-customize-left - :help "Fringe only on the left side" - :visible (display-graphic-p) - :button (:radio . (equal fringe-mode '(nil . 0))))) - (defun menu-bar-showhide-fringe-menu-customize-right () "Display fringes only on the right of each window." (interactive) @@ -855,6 +843,18 @@ mail status in mode line")) :visible (display-graphic-p) :button (:radio . (equal fringe-mode '(0 . nil))))) +(defun menu-bar-showhide-fringe-menu-customize-left () + "Display fringes only on the left of each window." + (interactive) + (require 'fringe) + (customize-set-variable 'fringe-mode '(nil . 0))) + +(define-key menu-bar-showhide-fringe-menu [left] + '(menu-item "On the Left" menu-bar-showhide-fringe-menu-customize-left + :help "Fringe only on the left side" + :visible (display-graphic-p) + :button (:radio . (equal fringe-mode '(nil . 0))))) + (defun menu-bar-showhide-fringe-menu-customize-disable () "Do not display window fringes." (interactive) @@ -1432,7 +1432,7 @@ for the definition of the menu frame." (selected-frame)))) (not (window-minibuffer-p (frame-selected-window menu-frame))))) -(defun kill-this-buffer () ; for the menubar +(defun kill-this-buffer () ; for the menu bar "Kill the current buffer." (interactive) (kill-buffer (current-buffer))) @@ -1662,10 +1662,10 @@ Buffers menu is regenerated." "Next Buffer" 'next-buffer :help "Switch to the \"next\" buffer in a cyclic order") - (list 'prev-buffer + (list 'previous-buffer 'menu-item "Previous Buffer" - 'prev-buffer + 'previous-buffer :help "Switch to the \"previous\" buffer in a cyclic order") (list 'select-named-buffer 'menu-item diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index dafa37c6b3d..33f016bb2f9 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,3 +1,23 @@ +2005-12-15 Bill Wohler <wohler@newt.com> + + * mh-e.el (mh-delete-msg): Sync docstrings with manual. + + * mh-seq.el (mh-delete-subject, mh-thread-next-sibling) + (mh-thread-previous-sibling, mh-thread-ancestor) + (mh-thread-delete, mh-thread-refile): Ditto. + +2005-12-14 Bill Wohler <wohler@newt.com> + + * mh-customize.el (mh-speed-flists-interval): Rename to + mh-speed-update-interval. + (mh-speed-run-flists-flag): Delete. Setting + mh-speed-flists-interval to 0 accomplishes the same thing. + + * mh-speed.el (mh-folder-speedbar-buttons, mh-speed-flists): Use + mh-speed-update-interval instead of mh-speed-run-flists-flag. + (mh-speed-toggle, mh-speed-view, mh-speed-refresh): Sync + docstrings with manual. + 2005-12-09 Bill Wohler <wohler@newt.com> * mh-customize.el (mh-path): Move here from mh-init.el. diff --git a/lisp/mh-e/mh-customize.el b/lisp/mh-e/mh-customize.el index 49aceae3b61..e07603f69ba 100644 --- a/lisp/mh-e/mh-customize.el +++ b/lisp/mh-e/mh-customize.el @@ -1780,21 +1780,12 @@ and enter the number of lines you'd like to see." ;;; The Speedbar (:group 'mh-speed) -(defcustom mh-speed-flists-interval 60 - "Time between calls to flists in seconds. -If 0, flists is not called repeatedly." +(defcustom mh-speed-update-interval 60 + "Time between speedbar updates in seconds. +Set to 0 to disable automatic update." :type 'integer :group 'mh-speed) -(defcustom mh-speed-run-flists-flag t - "Non-nil means flists is used. -If non-nil, flists is executed every `mh-speed-flists-interval' seconds to -update the display of the number of unseen and total messages in each folder. -If resources are limited, this can be set to nil and the speedbar display can -be updated manually with the \\[mh-speed-flists] command." - :type 'boolean - :group 'mh-speed) - ;;; Threading (:group 'mh-thread) diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index c69c62bd734..b87fa4c2e3d 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -535,7 +535,7 @@ the Emacs interface to the MH mail system." ;;; User executable MH-E commands: (defun mh-delete-msg (range) - "Delete message\\<mh-folder-mode-map>. + "Delete RANGE\\<mh-folder-mode-map>. To mark a message for deletion, use this command. A \"D\" is placed by the message in the scan window, and the next undeleted message is displayed. If diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el index fcf9c64e266..795970d3739 100644 --- a/lisp/mh-e/mh-seq.el +++ b/lisp/mh-e/mh-seq.el @@ -936,10 +936,12 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." ;;;###mh-autoload (defun mh-delete-subject () - "Mark all following messages with same subject to be deleted. -This puts the messages in a sequence named subject. You can undo the last -deletion marks using `mh-undo' with a prefix argument and then specifying the -subject sequence." + "Delete messages with same subject\\<mh-folder-mode-map>. + +To delete messages faster, you can use this command to delete all the messages +with the same subject as the current message. This command puts these messages +in a sequence named \"subject\". You can undo this action by using \\[mh-undo] +with a prefix argument and then specifying the \"subject\" sequence." (interactive) (let ((count (mh-subject-to-sequence nil))) (cond @@ -954,11 +956,15 @@ subject sequence." ;;;###mh-autoload (defun mh-delete-subject-or-thread () - "Mark messages for deletion intelligently. -If the folder is threaded then `mh-thread-delete' is used to mark the current -message and all its descendants for deletion. Otherwise `mh-delete-subject' is -used to mark the current message and all messages following it with the same -subject for deletion." + "Delete messages with same subject or thread\\<mh-folder-mode-map>. + +To delete messages faster, you can use this command to delete all the messages +with the same subject as the current message. This command puts these messages +in a sequence named \"subject\". You can undo this action by using \\[mh-undo] +with a prefix argument and then specifying the \"subject\" sequence. + +However, if the buffer is displaying a threaded view of the folder then this +command behaves like \\[mh-thread-delete]." (interactive) (if (memq 'unthread mh-view-ops) (mh-thread-delete) @@ -1562,7 +1568,8 @@ MSG is the message being notated with NOTATION at OFFSET." ;;;###mh-autoload (defun mh-thread-next-sibling (&optional previous-flag) - "Jump to next sibling. + "Display next sibling. + With non-nil optional argument PREVIOUS-FLAG jump to the previous sibling." (interactive) (cond ((not (memq 'unthread mh-view-ops)) @@ -1589,7 +1596,7 @@ With non-nil optional argument PREVIOUS-FLAG jump to the previous sibling." ;;;###mh-autoload (defun mh-thread-previous-sibling () - "Jump to previous sibling." + "Display previous sibling." (interactive) (mh-thread-next-sibling t)) @@ -1610,9 +1617,11 @@ With non-nil optional argument PREVIOUS-FLAG jump to the previous sibling." ;;;###mh-autoload (defun mh-thread-ancestor (&optional thread-root-flag) - "Jump to the ancestor of current message. -If optional argument THREAD-ROOT-FLAG is non-nil then jump to the root of the -thread tree the message belongs to." + "Display ancestor of current message. + +If you do not care for the way a particular thread has turned, you can move up +the chain of messages with this command. This command can also take a prefix +argument THREAD-ROOT-FLAG to jump to the message that started everything." (interactive "P") (beginning-of-line) (cond ((not (memq 'unthread mh-view-ops)) @@ -1656,7 +1665,7 @@ start of the region and the second is the point at the end." ;;;###mh-autoload (defun mh-thread-delete () - "Mark current message and all its children for subsequent deletion." + "Delete thread." (interactive) (cond ((not (memq 'unthread mh-view-ops)) (error "Folder isn't threaded")) @@ -1669,7 +1678,7 @@ start of the region and the second is the point at the end." ;;;###mh-autoload (defun mh-thread-refile (folder) - "Mark current message and all its children for refiling to FOLDER." + "Refile (output) thread into FOLDER." (interactive (list (intern (mh-prompt-for-refile-folder)))) (cond ((not (memq 'unthread mh-view-ops)) (error "Folder isn't threaded")) diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el index e11ed7e3523..4b33a81a7e9 100644 --- a/lisp/mh-e/mh-speed.el +++ b/lisp/mh-e/mh-speed.el @@ -76,7 +76,7 @@ BUFFER is the MH-E buffer for which the speedbar buffer is to be created." (line-beginning-position) (1+ (line-beginning-position)) `(mh-folder nil mh-expanded nil mh-children-p t mh-level 0)) (mh-speed-stealth-update t) - (when mh-speed-run-flists-flag + (when (> mh-speed-update-interval 0) (mh-speed-flists nil)))) ;;;###mh-autoload @@ -292,8 +292,8 @@ Do the right thing for the different kinds of buffers that MH-E uses." ;;;###mh-autoload (defun mh-speed-toggle (&rest args) - "Toggle the display of child folders. -The otional ARGS are ignored and there for compatibilty with speedbar." + "Toggle the display of child folders in the speedbar. +The optional ARGS from speedbar are ignored." (interactive) (declare (ignore args)) (beginning-of-line) @@ -335,8 +335,8 @@ The otional ARGS are ignored and there for compatibilty with speedbar." ;;;###mh-autoload (defun mh-speed-view (&rest args) - "View folder on current line. -Optional ARGS are ignored." + "Visits the selected folder just as if you had used \\<mh-folder-mode-map>\\[mh-visit-folder]. +The optional ARGS from speedbar are ignored." (interactive) (declare (ignore args)) (let* ((folder (get-text-property (line-beginning-position) 'mh-folder)) @@ -381,7 +381,9 @@ only for that one folder." (unless mh-speed-flists-timer (setq mh-speed-flists-timer (run-at-time - nil (and mh-speed-run-flists-flag mh-speed-flists-interval) + nil (if (> mh-speed-update-interval 0) + mh-speed-update-interval + nil) (lambda () (unless (and (processp mh-speed-flists-process) (not (eq (process-status mh-speed-flists-process) @@ -502,9 +504,10 @@ next." (clrhash mh-sub-folders-cache))))) (defun mh-speed-refresh () - "Refresh the speedbar. -Use this function to refresh the speedbar if folders have been added or -deleted or message ranges have been updated outside of MH-E." + "Regenerates the list of folders in the speedbar. + +Run this command if you've added or deleted a folder, or want to update the +unseen message count before the next automatic update." (interactive) (mh-speed-flists t) (mh-speed-invalidate-map "")) diff --git a/lisp/mouse.el b/lisp/mouse.el index 2c5d9cbddd6..b5881272835 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -594,14 +594,15 @@ resized by dragging their header-line." ((null (car (cdr mouse))) nil) (t - (save-selected-window - ;; If the scroll bar is on the window's left, - ;; adjust the window on the left. - (unless (eq which-side 'right) - (select-window (previous-window))) + (let ((window + ;; If the scroll bar is on the window's left, + ;; adjust the window on the left. + (if (eq which-side 'right) + (selected-window) + (previous-window)))) (setq x (- (car (cdr mouse)) (if (eq which-side 'right) 0 2)) - edges (window-edges) + edges (window-edges window) left (nth 0 edges) right (nth 2 edges)) ;; scale back a move that would make the @@ -609,19 +610,10 @@ resized by dragging their header-line." (if (< (- x left -1) window-min-width) (setq x (+ left window-min-width -1))) ;; compute size change needed - (setq growth (- x right -1) - wconfig (current-window-configuration)) - (enlarge-window growth t) - ;; if this window's growth caused another - ;; window to be deleted because it was too - ;; thin, rescind the change. - ;; - ;; if size change caused space to be stolen - ;; from a window to the left of this one, - ;; rescind the change. - (if (or (/= start-nwindows (count-windows t)) - (/= left (nth 0 (window-edges)))) - (set-window-configuration wconfig)))))))))) + (setq growth (- x right -1)) + (condition-case nil + (adjust-window-trailing-edge window growth t) + (error nil)))))))))) (defun mouse-set-point (event) "Move point to the position clicked on with the mouse. diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el index 3d4e8954e27..1854e7adda0 100644 --- a/lisp/net/newsticker.el +++ b/lisp/net/newsticker.el @@ -392,6 +392,32 @@ (defvar w3m-minor-mode-map) ;; ====================================================================== +;;; Newsticker status +;; ====================================================================== + +(defvar newsticker--retrieval-timer-list nil + "List of timers for news retrieval. +This is an alist, each element consisting of (feed-name . timer)") + +(defvar newsticker--display-timer nil + "Timer for newsticker display.") + +;;;###autoload +(defun newsticker-running-p () + "Check whether newsticker is running. +Return t if newsticker is running, nil otherwise. Newsticker is +considered to be running if the newsticker timer list is not empty." + (> (length newsticker--retrieval-timer-list) 0)) + +;;;###autoload +(defun newsticker-ticker-running-p () + "Check whether newsticker's actual ticker is running. +Return t if ticker is running, nil otherwise. Newsticker is +considered to be running if the newsticker timer list is not +empty." + (timerp newsticker--display-timer)) + +;; ====================================================================== ;;; Customizables ;; ====================================================================== (defgroup newsticker nil @@ -1188,11 +1214,6 @@ that can be added." ;; ====================================================================== ;;; Internal variables ;; ====================================================================== -(defvar newsticker--display-timer nil - "Timer for newsticker display.") -(defvar newsticker--retrieval-timer-list nil - "List of timers for news retrieval. -This is an alist, each element consisting of (feed-name . timer)") (defvar newsticker--item-list nil "List of newsticker items.") (defvar newsticker--item-position 0 @@ -3079,24 +3100,6 @@ If VALUE is nil, auto-narrowing is turned off, otherwise it is turned on." (and (memq age '(new old obsolete)) t))))) ;; ====================================================================== -;;; Newsticker status -;; ====================================================================== -;;;###autoload -(defun newsticker-running-p () - "Check whether newsticker is running. -Return t if newsticker is running, nil otherwise. Newsticker is -considered to be running if the newsticker timer list is not empty." - (> (length newsticker--retrieval-timer-list) 0)) - -;;;###autoload -(defun newsticker-ticker-running-p () - "Check whether newsticker's actual ticker is running. -Return t if ticker is running, nil otherwise. Newsticker is -considered to be running if the newsticker timer list is not -empty." - (timerp newsticker--display-timer)) - -;; ====================================================================== ;;; local stuff ;; ====================================================================== (defun newsticker-get-news (feed-name) diff --git a/lisp/net/tls.el b/lisp/net/tls.el index ceebe4b33d5..e46c98b6f6a 100644 --- a/lisp/net/tls.el +++ b/lisp/net/tls.el @@ -56,7 +56,8 @@ :group 'comm) (defcustom tls-program '("gnutls-cli -p %p %h" - "gnutls-cli -p %p %h --protocols ssl3") + "gnutls-cli -p %p %h --protocols ssl3" + "openssl s_client -connect %h:%p -no_ssl2") "List of strings containing commands to start TLS stream to a host. Each entry in the list is tried until a connection is successful. %s is replaced with server hostname, %p with port to connect to. @@ -64,6 +65,7 @@ The program should read input on stdin and write output to stdout. Also see `tls-success' for what the program should output after successful negotiation." :type '(repeat string) + :version "22.1" :group 'tls) (defcustom tls-process-connection-type nil @@ -72,9 +74,10 @@ after successful negotiation." :type 'boolean :group 'tls) -(defcustom tls-success "- Handshake was completed" +(defcustom tls-success "- Handshake was completed\\|SSL handshake has read " "*Regular expression indicating completed TLS handshakes. -The default is what GNUTLS's \"gnutls-cli\" outputs." +The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's +\"openssl s_client\" outputs." :version "22.1" :type 'regexp :group 'tls) @@ -109,11 +112,11 @@ Used by `tls-certificate-information'." (push (cons (match-string 1) (match-string 2)) vals)) (nreverse vals)))))) -(defun open-tls-stream (name buffer host service) - "Open a TLS connection for a service to a host. +(defun open-tls-stream (name buffer host port) + "Open a TLS connection for a port to a host. Returns a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. -Args are NAME BUFFER HOST SERVICE. +Args are NAME BUFFER HOST PORT. NAME is name for process. It is modified if necessary to make it unique. BUFFER is the buffer (or buffer-name) to associate with the process. Process output goes at end of that buffer, unless you specify @@ -121,8 +124,7 @@ BUFFER is the buffer (or buffer-name) to associate with the process. BUFFER may be also nil, meaning that this process is not associated with any buffer Third arg is name of the host to connect to, or its IP address. -Fourth arg SERVICE is name of the service desired, or an integer -specifying a port number to connect to." +Fourth arg PORT is an integer specifying a port to connect to." (let ((cmds tls-program) cmd done) (message "Opening TLS connection to `%s'..." host) (while (and (not done) (setq cmd (pop cmds))) @@ -134,9 +136,9 @@ specifying a port number to connect to." cmd (format-spec-make ?h host - ?p (if (integerp service) - (int-to-string service) - service))))) + ?p (if (integerp port) + (int-to-string port) + port))))) response) (while (and process (memq (process-status process) '(open run)) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index c9f2b87b7f1..7f829bd26d5 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -3993,35 +3993,36 @@ comment at the start of cc-engine.el for more info." ;; ;; This function might do hidden buffer changes. - (save-excursion - (goto-char beg) - (when (or (looking-at "[<>]") - (< (skip-chars-backward "<>") 0)) - + (save-match-data + (save-excursion (goto-char beg) - (c-beginning-of-current-token) - (when (and (< (point) beg) - (looking-at c-<>-multichar-token-regexp) - (< beg (setq beg (match-end 0)))) - (while (progn (skip-chars-forward "^<>" beg) - (< (point) beg)) - (c-clear-char-property (point) 'syntax-table) - (forward-char)))) - - (when (< beg end) - (goto-char end) (when (or (looking-at "[<>]") (< (skip-chars-backward "<>") 0)) - (goto-char end) + (goto-char beg) (c-beginning-of-current-token) - (when (and (< (point) end) + (when (and (< (point) beg) (looking-at c-<>-multichar-token-regexp) - (< end (setq end (match-end 0)))) - (while (progn (skip-chars-forward "^<>" end) - (< (point) end)) + (< beg (setq beg (match-end 0)))) + (while (progn (skip-chars-forward "^<>" beg) + (< (point) beg)) (c-clear-char-property (point) 'syntax-table) - (forward-char))))))) + (forward-char)))) + + (when (< beg end) + (goto-char end) + (when (or (looking-at "[<>]") + (< (skip-chars-backward "<>") 0)) + + (goto-char end) + (c-beginning-of-current-token) + (when (and (< (point) end) + (looking-at c-<>-multichar-token-regexp) + (< end (setq end (match-end 0)))) + (while (progn (skip-chars-forward "^<>" end) + (< (point) end)) + (c-clear-char-property (point) 'syntax-table) + (forward-char)))))))) ;; Dynamically bound variable that instructs `c-forward-type' to also ;; treat possible types (i.e. those that it normally returns 'maybe or diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 5faa21d75a2..da2a3ee9d65 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -331,7 +331,8 @@ beginning of line's indentation. FILE can also have the form (FILE FORMAT...), where the FORMATs \(e.g. \"%s.c\") will be applied in turn to the recognized file name, until a file of that name is found. Or FILE can also be a -function to return the filename. +function that returns (FILENAME) or (RELATIVE-FILENAME . DIRNAME). +In the former case, FILENAME may be relative or absolute. LINE can also be of the form (LINE . END-LINE) meaning a range of lines. COLUMN can also be of the form (COLUMN . END-COLUMN) diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el index 11d0ba444f3..7e0bb8b4f9b 100644 --- a/lisp/progmodes/cpp.el +++ b/lisp/progmodes/cpp.el @@ -59,14 +59,18 @@ :type 'file :group 'cpp) +(define-widget 'cpp-face 'lazy + "Either a face or the special symbol 'invisible'." + :type '(choice (const invisible) (face))) + (defcustom cpp-known-face 'invisible "*Face used for known cpp symbols." - :type 'face + :type 'cpp-face :group 'cpp) (defcustom cpp-unknown-face 'highlight "*Face used for unknown cpp symbols." - :type 'face + :type 'cpp-face :group 'cpp) (defcustom cpp-face-type 'light @@ -95,10 +99,12 @@ Each entry is a list with the following elements: 1. Face used for text that is `ifdef' the macro. 2. Face used for text that is `ifndef' the macro. 3. t, nil, or `both' depending on what text may be edited." - :type '(repeat (list string face face - (choice (const t) - (const nil) - (const both)))) + :type '(repeat (list (string :tag "Macro") + (cpp-face :tag "True") + (cpp-face :tag "False") + (choice (const :tag "True branch writable" t) + (const :tag "False branch writeable" nil) + (const :tag "Both branches writeable" both)))) :group 'cpp) (defvar cpp-overlay-list nil) diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index db847b74cf5..002bae1b019 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -51,7 +51,8 @@ ;; annotations to GDB/MI. ;; This mode SHOULD WORK WITH GDB 5.0 onwards but you will NEED GDB 6.0 -;; onwards to use watch expressions. +;; onwards to use watch expressions. It works best with GDB 6.4 where +;; watch expressions will update more quickly. ;;; Windows Platforms: @@ -2577,6 +2578,8 @@ With arg, display additional buffers iff arg is positive." (if (null arg) (not gdb-many-windows) (> (prefix-numeric-value arg) 0))) + (message (format "Display of other windows %sabled" + (if gdb-many-windows "en" "dis"))) (if (and gud-comint-buffer (buffer-name gud-comint-buffer)) (condition-case nil diff --git a/lisp/recentf.el b/lisp/recentf.el index d92bc92f6ee..1106fea18b6 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -1038,7 +1038,8 @@ Go to the beginning of buffer if not found." (if (eq widget-type (widget-type (widget-at (point)))) (setq done t) (widget-move 1)))) - (goto-char (point-min)))) + (error + (goto-char (point-min))))) (defvar recentf-dialog-mode-map (let ((km (copy-keymap recentf--shortcuts-keymap))) @@ -1100,6 +1101,8 @@ IGNORE arguments." (defun recentf-edit-list () "Show a dialog to delete selected files from the recent list." (interactive) + (unless recentf-list + (error "The list of recent files is empty")) (recentf-dialog (format "*%s - Edit list*" recentf-menu-title) (set (make-local-variable 'recentf-edit-list) nil) (widget-insert @@ -1194,6 +1197,8 @@ files to choose from. It defaults to the whole recent list. If optional argument BUFFER-NAME is non-nil, it is a buffer name to use for the dialog. It defaults to \"*`recentf-menu-title'*\"." (interactive) + (unless (or files recentf-list) + (error "There is no recent file to open")) (recentf-dialog (or buffer-name (format "*%s*" recentf-menu-title)) (widget-insert "Click on a file" (if recentf-show-file-shortcuts-flag diff --git a/lisp/simple.el b/lisp/simple.el index 2b0645b5a6d..77c008b2805 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -52,25 +52,68 @@ wait this many seconds after Emacs becomes idle before doing an update." "Highlight (un)matching of parens and expressions." :group 'matching) +(defun get-next-valid-buffer (list &optional buffer visible-ok frame) "\ +Search LIST for a valid buffer to display in FRAME. +Return nil when all buffers in LIST are undesirable for display, +otherwise return the first suitable buffer in LIST. + +Buffers not visible in windows are preferred to visible buffers, +unless VISIBLE-OK is non-nil. +If the optional argument FRAME is nil, it defaults to the selected frame. +If BUFFER is non-nil, ignore occurances of that buffer in LIST." + ;; This logic is more or less copied from other-buffer. + (setq frame (or frame (selected-frame))) + (let ((pred (frame-parameter frame 'buffer-predicate)) + found buf) + (while (and (not found) list) + (setq buf (car list)) + (if (and (not (eq buffer buf)) + (buffer-live-p buf) + (or (null pred) (funcall pred buf)) + (not (eq (aref (buffer-name buf) 0) ?\s)) + (or visible-ok (null (get-buffer-window buf 'visible)))) + (setq found buf) + (setq list (cdr list)))) + (car list))) + +(defun last-buffer (&optional buffer visible-ok frame) "\ +Return the last non-hidden displayable buffer in the buffer list. +If BUFFER is non-nil, last-buffer will ignore that buffer. +Buffers not visible in windows are preferred to visible buffers, +unless optional argument VISIBLE-OK is non-nil. +If the optional third argument FRAME is non-nil, use that frame's +buffer list instead of the selected frame's buffer list. +If no other buffer exists, the buffer `*scratch*' is returned." + (setq frame (or frame (selected-frame))) + (or (get-next-valid-buffer (frame-parameter frame 'buried-buffer-list) + buffer visible-ok frame) + (get-next-valid-buffer (nreverse (buffer-list frame)) + buffer visible-ok frame) + (progn + (set-buffer-major-mode (get-buffer-create "*scratch*")) + (get-buffer "*scratch*")))) + (defun next-buffer () "Switch to the next buffer in cyclic order." (interactive) - (let ((buffer (current-buffer))) - (switch-to-buffer (other-buffer buffer)) - (bury-buffer buffer))) - -(defun prev-buffer () + (let ((buffer (current-buffer)) + (bbl (frame-parameter nil 'buried-buffer-list))) + (switch-to-buffer (other-buffer buffer t)) + (bury-buffer buffer) + (set-frame-parameter nil 'buried-buffer-list + (cons buffer (delq buffer bbl))))) + +(defun previous-buffer () "Switch to the previous buffer in cyclic order." (interactive) - (let ((list (nreverse (buffer-list))) - found) - (while (and (not found) list) - (let ((buffer (car list))) - (if (and (not (get-buffer-window buffer)) - (not (string-match "\\` " (buffer-name buffer)))) - (setq found buffer))) - (setq list (cdr list))) - (switch-to-buffer found))) + (let ((buffer (last-buffer (current-buffer) t)) + (bbl (frame-parameter nil 'buried-buffer-list))) + (switch-to-buffer buffer) + ;; Clean up buried-buffer-list up to and including the chosen buffer. + (while (and bbl (not (eq (car bbl) buffer))) + (setq bbl (cdr bbl))) + (set-frame-parameter nil 'buried-buffer-list bbl))) + ;;; next-error support framework @@ -4748,7 +4791,7 @@ With prefix argument N, move N items (negative N means move backward)." (error "No completion here")) (setq beg (previous-single-property-change beg 'mouse-face)) (setq end (or (next-single-property-change end 'mouse-face) (point-max))) - (setq completion (buffer-substring beg end)) + (setq completion (buffer-substring-no-properties beg end)) (let ((owindow (selected-window))) (if (and (one-window-p t 'selected-frame) (window-dedicated-p (selected-window))) @@ -4905,68 +4948,52 @@ of the differing parts is, by contrast, slightly highlighted." "Common prefix substring to use in `completion-setup-function' to put faces. The value is set by `display-completion-list' during running `completion-setup-hook'. -To put faces, `completions-first-difference' and `completions-common-part' -into \"*Completions*\* buffer, the common prefix substring in completions is -needed as a hint. (Minibuffer is a special case. The content of minibuffer itself -is the substring.)") +To put faces `completions-first-difference' and `completions-common-part' +in the `*Completions*' buffer, the common prefix substring in completions +is needed as a hint. (The minibuffer is a special case. The content +of the minibuffer before point is always the common substring.)") ;; This function goes in completion-setup-hook, so that it is called ;; after the text of the completion list buffer is written. (defun completion-setup-function () (let* ((mainbuf (current-buffer)) - (mbuf-contents (minibuffer-contents)) - (common-string-length (length mbuf-contents))) + (mbuf-contents (minibuffer-completion-contents)) + common-string-length) ;; When reading a file name in the minibuffer, ;; set default-directory in the minibuffer ;; so it will get copied into the completion list buffer. (if minibuffer-completing-file-name (with-current-buffer mainbuf (setq default-directory (file-name-directory mbuf-contents)))) - ;; If partial-completion-mode is on, point might not be after the - ;; last character in the minibuffer. - ;; FIXME: This hack should be moved to complete.el where we call - ;; display-completion-list. - (when partial-completion-mode - (setq common-string-length - (if (eq (char-after (field-beginning)) ?-) - ;; If the text to be completed starts with a `-', there is no - ;; common prefix. - ;; FIXME: this probably still doesn't do the right thing - ;; when completing file names. It's not even clear what - ;; is TRT. - 0 - (- common-string-length (- (point-max) (point)))))) (with-current-buffer standard-output (completion-list-mode) (set (make-local-variable 'completion-reference-buffer) mainbuf) (setq completion-base-size - (if minibuffer-completing-file-name - ;; For file name completion, use the number of chars before - ;; the start of the last file name component. - (with-current-buffer mainbuf - (save-excursion - (goto-char (point-max)) - (skip-chars-backward completion-root-regexp) - (- (point) (minibuffer-prompt-end)))) - ;; Otherwise, in minibuffer, the whole input is being completed. - (if (minibufferp mainbuf) 0))) - (if (and (symbolp minibuffer-completion-table) - (get minibuffer-completion-table 'completion-base-size-function)) - (setq completion-base-size - ;; FIXME: without any extra arg, how is this function - ;; expected to return anything else than a constant unless - ;; it redoes part of the work of all-completions? - ;; In most cases this value would better be computed and - ;; returned at the same time as the list of all-completions - ;; is computed. --Stef - (funcall (get minibuffer-completion-table - 'completion-base-size-function)))) + (cond + ((and (symbolp minibuffer-completion-table) + (get minibuffer-completion-table 'completion-base-size-function)) + ;; To compute base size, a function can use the global value of + ;; completion-common-substring or minibuffer-completion-contents. + (with-current-buffer mainbuf + (funcall (get minibuffer-completion-table + 'completion-base-size-function)))) + (minibuffer-completing-file-name + ;; For file name completion, use the number of chars before + ;; the start of the file name component at point. + (with-current-buffer mainbuf + (save-excursion + (skip-chars-backward completion-root-regexp) + (- (point) (minibuffer-prompt-end))))) + ;; Otherwise, in minibuffer, the base size is 0. + ((minibufferp mainbuf) 0))) + (setq common-string-length + (cond + (completion-common-substring + (length completion-common-substring)) + (completion-base-size + (- (length mbuf-contents) completion-base-size)))) ;; Put faces on first uncommon characters and common parts. - (when (or completion-common-substring completion-base-size) - (setq common-string-length - (if completion-common-substring - (length completion-common-substring) - (- common-string-length completion-base-size))) + (when (and (integerp common-string-length) (>= common-string-length 0)) (let ((element-start (point-min)) (maxp (point-max)) element-common-end) @@ -4977,7 +5004,8 @@ is the substring.)") (+ element-start common-string-length)) maxp)) (when (get-char-property element-start 'mouse-face) - (if (get-char-property (1- element-common-end) 'mouse-face) + (if (and (> common-string-length 0) + (get-char-property (1- element-common-end) 'mouse-face)) (put-text-property element-start element-common-end 'font-lock-face 'completions-common-part)) (if (get-char-property element-common-end 'mouse-face) diff --git a/lisp/startup.el b/lisp/startup.el index 863c621de6c..e895d3325e7 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -47,14 +47,14 @@ The value is nil if the selected frame is on a text-only-terminal.") "Emacs start-up procedure." :group 'internal) -(defcustom inhibit-startup-message nil - "*Non-nil inhibits the initial startup message. +(defcustom inhibit-splash-screen nil + "*Non-nil inhibits the startup screen. This is for use in your personal init file, once you are familiar -with the contents of the startup message." +with the contents of the startup screen." :type 'boolean :group 'initialization) -(defvaralias 'inhibit-splash-screen 'inhibit-startup-message) +(defvaralias 'inhibit-startup-message 'inhibit-splash-screen) (defcustom inhibit-startup-echo-area-message nil "*Non-nil inhibits the initial startup echo area message. @@ -648,15 +648,22 @@ opening the first frame (e.g. open a connection to an X server).") (set-locale-environment nil) ;; Convert preloaded file names to absolute. - (setq load-history - (mapcar (lambda (elt) - (if (and (stringp (car elt)) - (not (file-name-absolute-p (car elt)))) - (cons (locate-file (car elt) load-path - (append load-suffixes '(""))) - (cdr elt)) - elt)) - load-history)) + (let ((lisp-dir + (file-name-directory + (locate-file "simple" load-path + load-suffixes)))) + + (setq load-history + (mapcar (lambda (elt) + (if (and (stringp (car elt)) + (not (file-name-absolute-p (car elt)))) + (cons (concat lisp-dir + (car elt) + (if (string-match "[.]el$" (car elt)) + "" ".elc")) + (cdr elt)) + elt)) + load-history))) ;; Convert the arguments to Emacs internal representation. (let ((args (cdr command-line-args))) @@ -930,6 +937,10 @@ opening the first frame (e.g. open a connection to an X server).") (pop-to-buffer "*Messages*")) (setq init-file-had-error t))))) + (if (and deactivate-mark transient-mark-mode) + (with-current-buffer (window-buffer) + (deactivate-mark))) + ;; If the user has a file of abbrevs, read it. (if (file-exists-p abbrev-file-name) (quietly-read-abbrev-file abbrev-file-name)) diff --git a/lisp/subr.el b/lisp/subr.el index 11894be25b4..e55858e42d8 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2907,11 +2907,11 @@ Usually the separator is \".\", but it can be any other string.") (defvar version-regexp-alist - '(("^[-_+]?a\\(lpha\\)?$" . -3) + '(("^[-_+ ]?a\\(lpha\\)?$" . -3) ("^[-_+]$" . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases - ("^[-_+]cvs$" . -3) ; treat "1.2.3-CVS" as alpha release - ("^[-_+]?b\\(eta\\)?$" . -2) - ("^[-_+]?\\(pre\\|rc\\)$" . -1)) + ("^[-_+ ]cvs$" . -3) ; treat "1.2.3-CVS" as alpha release + ("^[-_+ ]?b\\(eta\\)?$" . -2) + ("^[-_+ ]?\\(pre\\|rc\\)$" . -1)) "*Specify association between non-numeric version part and a priority. This association is used to handle version string like \"1.0pre2\", @@ -2922,10 +2922,10 @@ non-numeric part to an integer. For example: \"1.0pre2\" (1 0 -1 2) \"1.0PRE2\" (1 0 -1 2) \"22.8beta3\" (22 8 -2 3) - \"22.8Beta3\" (22 8 -2 3) + \"22.8 Beta3\" (22 8 -2 3) \"0.9alpha1\" (0 9 -3 1) \"0.9AlphA1\" (0 9 -3 1) - \"0.9alpha\" (0 9 -3) + \"0.9 alpha\" (0 9 -3) Each element has the following form: @@ -2977,8 +2977,13 @@ As an example of version convertion: \"0.9alpha\" (0 9 -3) See documentation for `version-separator' and `version-regexp-alist'." - (or (and (stringp ver) (not (string= ver ""))) + (or (and (stringp ver) (> (length ver) 0)) (error "Invalid version string: '%s'" ver)) + ;; Change .x.y to 0.x.y + (if (and (>= (length ver) (length version-separator)) + (string-equal (substring ver 0 (length version-separator)) + version-separator)) + (setq ver (concat "0" ver))) (save-match-data (let ((i 0) (case-fold-search t) ; ignore case in matching diff --git a/lisp/term.el b/lisp/term.el index 14d4fb9a5ab..62728f45a08 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -2687,13 +2687,17 @@ See `term-prompt-regexp'." (buffer-undo-list t) (selected (selected-window)) last-win + handled-ansi-message (str-length (length str))) (save-selected-window ;; Let's handle the messages. -mm - (setq str (term-handle-ansi-terminal-messages str)) - (setq str-length (length str)) + (let* ((newstr (term-handle-ansi-terminal-messages str))) + (if (not (eq str newstr)) + (setq handled-ansi-message t + str newstr))) + (setq str-length (length str)) (if (marker-buffer term-pending-delete-marker) (progn @@ -2849,7 +2853,8 @@ See `term-prompt-regexp'." ((eq char ?\017)) ; Shift In - ignored ((eq char ?\^G) ;; (terminfo: bel) (beep t)) - ((eq char ?\032) + ((and (eq char ?\032) + (not handled-ansi-message)) (let ((end (string-match "\r?$" str i))) (if end (funcall term-command-hook diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 7b736708268..82c79ae2569 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -551,6 +551,12 @@ See `bibtex-generate-autokey' for details." :group 'bibtex-autokey :type 'string) +(defcustom bibtex-autokey-expand-strings nil + "If non-nil, expand strings when extracting the content of a BibTeX field. +See `bibtex-generate-autokey' for details." + :group 'bibtex-autokey + :type 'boolean) + (defvar bibtex-autokey-transcriptions '(;; language specific characters ("\\\\aa" . "a") ; \aa -> a @@ -809,6 +815,8 @@ submatch), or a function called with the field's text as argument and with the `match-data' properly set. Case is always ignored. Always remove the field delimiters. +If `bibtex-expand-strings' is non-nil, BibTeX strings are expanded +for generating the URL. The following is a complex example, see http://link.aps.org/linkfaq.html. @@ -840,12 +848,17 @@ The following is a complex example, see http://link.aps.org/linkfaq.html. (integer :tag "Sub-match") (function :tag "Filter")))))))) -;; bibtex-font-lock-keywords is a user option as well, but since the +(defcustom bibtex-expand-strings nil + "If non-nil, expand strings when extracting the content of a BibTeX field." + :group 'bibtex + :type 'boolean) + +;; `bibtex-font-lock-keywords' is a user option as well, but since the ;; patterns used to define this variable are defined in a later ;; section of this file, it is defined later. -;; Syntax Table, Keybindings and BibTeX Entry List +;; Syntax Table and Keybindings (defvar bibtex-mode-syntax-table (let ((st (make-syntax-table))) (modify-syntax-entry ?\" "\"" st) @@ -1073,10 +1086,11 @@ The CDRs of the elements are t for header keys and nil for crossref keys.") "Last reformat reference keys option given.") (defconst bibtex-field-name "[^\"#%'(),={} \t\n0-9][^\"#%'(),={} \t\n]*" - "Regexp matching the name part of a BibTeX field.") + "Regexp matching the name of a BibTeX field.") -(defconst bibtex-entry-type (concat "@" bibtex-field-name) - "Regexp matching the type part of a BibTeX entry.") +(defconst bibtex-name-part + (concat ",[ \t\n]*\\(" bibtex-field-name "\\)[ \t\n]*=") + "Regexp matching the name part of a BibTeX field.") (defconst bibtex-reference-key "[][[:alnum:].:;?!`'/*@+|()<>&_^$-]+" "Regexp matching the reference key part of a BibTeX entry.") @@ -1084,54 +1098,56 @@ The CDRs of the elements are t for header keys and nil for crossref keys.") (defconst bibtex-field-const "[][[:alnum:].:;?!`'/*@+=|<>&_^$-]+" "Regexp matching a BibTeX field constant.") -(defconst bibtex-entry-head +(defvar bibtex-entry-type + (concat "@[ \t]*\\(?:" + (regexp-opt (mapcar 'car bibtex-entry-field-alist)) "\\)") + "Regexp matching the name of a BibTeX entry.") + +(defvar bibtex-entry-type-whitespace + (concat "[ \t]*" bibtex-entry-type) + "Regexp matching the name of a BibTeX entry preceded by whitespace.") + +(defvar bibtex-entry-type-str + (concat "@[ \t]*\\(?:" + (regexp-opt (append '("String") + (mapcar 'car bibtex-entry-field-alist))) "\\)") + "Regexp matching the name of a BibTeX entry (including @String).") + +(defvar bibtex-entry-head (concat "^[ \t]*\\(" bibtex-entry-type "\\)[ \t]*[({][ \t\n]*\\(" bibtex-reference-key "\\)") - "Regexp matching the header line of a BibTeX entry.") + "Regexp matching the header line of a BibTeX entry (including key).") -(defconst bibtex-entry-maybe-empty-head +(defvar bibtex-entry-maybe-empty-head (concat bibtex-entry-head "?") "Regexp matching the header line of a BibTeX entry (possibly without key).") +(defconst bibtex-any-entry-maybe-empty-head + (concat "^[ \t]*\\(@[ \t]*" bibtex-field-name "\\)[ \t]*[({][ \t\n]*\\(" + bibtex-reference-key "\\)?") + "Regexp matching the header line of any BibTeX entry (possibly without key).") + (defconst bibtex-type-in-head 1 "Regexp subexpression number of the type part in `bibtex-entry-head'.") (defconst bibtex-key-in-head 2 "Regexp subexpression number of the key part in `bibtex-entry-head'.") -(defconst bibtex-string-maybe-empty-head - (concat "^[ \t]*\\(@String\\)[ \t]*[({]\\(" - bibtex-reference-key - "\\)?") - "Regexp matching the header line of a BibTeX String entry.") - -(defconst bibtex-entry-postfix "[ \t\n]*,?[ \t\n]*[})]" - "Regexp matching the postfix of a BibTeX entry.") - -(defvar bibtex-known-entry-type-re - (regexp-opt (mapcar 'car bibtex-entry-field-alist)) - "Regexp matching the name of a BibTeX entry.") - -(defvar bibtex-valid-entry-re - (concat "@[ \t]*\\(" bibtex-known-entry-type-re "\\)") - "Regexp matching the name of a valid BibTeX entry.") +(defconst bibtex-empty-field-re "\\`\\(\"\"\\|{}\\)\\'" + "Regexp matching the text part (as a string) of an empty field.") -(defvar bibtex-valid-entry-whitespace-re - (concat "[ \t]*\\(" bibtex-valid-entry-re "\\)") - "Regexp matching the name of a valid BibTeX entry preceded by whitespace.") +(defconst bibtex-string-type "^[ \t]*\\(@[ \t]*String\\)[ \t]*[({][ \t\n]*" + "Regexp matching the name of a BibTeX String entry.") -(defvar bibtex-any-valid-entry-re - (concat "@[ \t]*" - (regexp-opt (append '("String") - (mapcar 'car bibtex-entry-field-alist)) - t)) - "Regexp matching the name of any valid BibTeX entry (including string).") +(defconst bibtex-string-maybe-empty-head + (concat bibtex-string-type "\\(" bibtex-reference-key "\\)?") + "Regexp matching the header line of a BibTeX String entry.") -(defconst bibtex-empty-field-re "\\`\\(\"\"\\|{}\\)\\'" - "Regexp matching the text part (as a string) of an empty field.") +(defconst bibtex-preamble-prefix "[ \t]*@[ \t]*Preamble[ \t]*" + "Regexp matching the prefix part of a preamble.") (defconst bibtex-font-lock-syntactic-keywords `((,(concat "^[ \t]*\\(" (substring bibtex-comment-start 0 1) "\\)" @@ -1140,7 +1156,7 @@ The CDRs of the elements are t for header keys and nil for crossref keys.") (defvar bibtex-font-lock-keywords ;; entry type and reference key - `((,bibtex-entry-maybe-empty-head + `((,bibtex-any-entry-maybe-empty-head (,bibtex-type-in-head font-lock-function-name-face) (,bibtex-key-in-head font-lock-constant-face nil t)) ;; optional field names (treated as comments) @@ -1160,9 +1176,8 @@ The CDRs of the elements are t for header keys and nil for crossref keys.") "[ \t]*=[ \t]*") "Regexp for `bibtex-font-lock-url'.") -(defvar bibtex-field-name-for-parsing nil - "Regexp of field name to be parsed by function `bibtex-parse-field-name'. -Passed by dynamic scoping.") +(defvar bibtex-string-empty-key nil + "If non-nil, `bibtex-parse-string' accepts empty key.") (defvar bibtex-sort-entry-class-alist (let ((i -1) alist) @@ -1193,8 +1208,8 @@ ARG is ignored." "Parse a string of the format <left-hand-side = right-hand-side>. The functions PARSE-LHS and PARSE-RHS are used to parse the corresponding substrings. These functions are expected to return nil if parsing is not -successful. If both functions return non-nil, a pair containing the returned -values of the functions PARSE-LHS and PARSE-RHS is returned." +successful. If the returned values of both functions are non-nil, +return a cons pair of these values. Do not move point." (save-match-data (save-excursion (let ((left (funcall parse-lhs)) @@ -1206,7 +1221,7 @@ values of the functions PARSE-LHS and PARSE-RHS is returned." (cons left right)))))) (defun bibtex-parse-field-name () - "Parse the field name stored in `bibtex-field-name-for-parsing'. + "Parse the name part of a BibTeX field. If the field name is found, return a triple consisting of the position of the very first character of the match, the actual starting position of the name part and end position of the match. Move point to end of field name. @@ -1215,14 +1230,18 @@ BibTeX field as necessary." (cond ((looking-at ",[ \t\n]*") (let ((start (point))) (goto-char (match-end 0)) - (when (looking-at bibtex-field-name-for-parsing) + (when (looking-at bibtex-field-name) (goto-char (match-end 0)) (list start (match-beginning 0) (match-end 0))))) ;; Maybe add a missing comma. ((and bibtex-autoadd-commas - (looking-at (concat "[ \t\n]*\\(?:" bibtex-field-name-for-parsing + (looking-at (concat "[ \t\n]*\\(?:" bibtex-field-name "\\)[ \t\n]*="))) (skip-chars-backward " \t\n") + ;; It can be confusing if non-editing commands try to + ;; modify the buffer. + (if buffer-read-only + (error "Comma missing at buffer position %s" (point))) (insert ",") (forward-char -1) ;; Now try again. @@ -1251,7 +1270,8 @@ BibTeX field as necessary." (defun bibtex-parse-field-string () "Parse a BibTeX field string enclosed by braces or quotes. If a syntactically correct string is found, a pair containing the start and -end position of the field string is returned, nil otherwise." +end position of the field string is returned, nil otherwise. +Do not move point." (let ((end-point (or (and (eq (following-char) ?\") (save-excursion @@ -1283,101 +1303,129 @@ returned, nil otherwise. Move point to end of field text." (if (looking-at "[ \t\n]*#[ \t\n]*") (goto-char (match-end 0)) (setq end-point (point)))) + (skip-chars-forward " \t\n") (if (and (not failure) end-point) - (cons starting-point end-point)))) + (list starting-point end-point (point))))) + +(defun bibtex-parse-field () + "Parse the BibTeX field beginning at the position of point. +If a syntactically correct field is found, return a cons pair containing +the boundaries of the name and text parts of the field. Do not move point." + (bibtex-parse-association 'bibtex-parse-field-name + 'bibtex-parse-field-text)) -(defun bibtex-parse-field (name) - "Parse a BibTeX field of regexp NAME. -If a syntactically correct field is found, a pair containing the boundaries of -the name and text parts of the field is returned." - (let ((bibtex-field-name-for-parsing name)) - (bibtex-parse-association 'bibtex-parse-field-name - 'bibtex-parse-field-text))) +(defsubst bibtex-start-of-field (bounds) + (nth 0 (car bounds))) +(defsubst bibtex-start-of-name-in-field (bounds) + (nth 1 (car bounds))) +(defsubst bibtex-end-of-name-in-field (bounds) + (nth 2 (car bounds))) +(defsubst bibtex-start-of-text-in-field (bounds) + (nth 1 bounds)) +(defsubst bibtex-end-of-text-in-field (bounds) + (nth 2 bounds)) +(defsubst bibtex-end-of-field (bounds) + (nth 3 bounds)) (defun bibtex-search-forward-field (name &optional bound) "Search forward to find a BibTeX field of name NAME. -If a syntactically correct field is found, a pair containing the boundaries of -the name and text parts of the field is returned. The search is limited by -optional arg BOUND. If BOUND is t the search is limited by the end of the -current entry. Do not move point." +If a syntactically correct field is found, return a pair containing +the boundaries of the name and text parts of the field. The search +is limited by optional arg BOUND or if nil by the end of the current +entry. Do not move point." (save-match-data (save-excursion - (unless (integer-or-marker-p bound) - (setq bound (if bound - (save-excursion (bibtex-end-of-entry)) - (point-max)))) - (let ((case-fold-search t) - (bibtex-field-name-for-parsing name) - boundaries temp-boundaries) - (while (and (not boundaries) - (< (point) bound) - (search-forward "," bound t)) - (goto-char (match-beginning 0)) - (if (and (setq temp-boundaries - (bibtex-parse-association 'bibtex-parse-field-name - 'bibtex-parse-field-text)) - (<= (cddr temp-boundaries) bound)) - (setq boundaries temp-boundaries) - (forward-char 1))) - boundaries)))) + (if bound + ;; If the search is bounded we need not worry we could overshoot. + ;; This is indeed the case when `bibtex-search-forward-field' is + ;; called many times. So we optimize this part of this function. + (let ((name-part (concat ",[ \t\n]*\\(" name "\\)[ \t\n]*=[ \t\n]*")) + (case-fold-search t) left right) + (while (and (not right) + (re-search-forward name-part bound t)) + (setq left (list (match-beginning 0) (match-beginning 1) + (match-end 1)) + ;; Don't worry that the field text could be past bound. + right (bibtex-parse-field-text))) + (if right (cons left right))) + (let ((regexp (concat bibtex-name-part "\\|" + bibtex-any-entry-maybe-empty-head)) + (case-fold-search t) bounds) + (catch 'done + (if (looking-at "[ \t]*@") (goto-char (match-end 0))) + (while (and (not bounds) + (re-search-forward regexp nil t)) + (if (match-beginning 2) + ;; We found a new entry + (throw 'done nil) + ;; We found a field + (goto-char (match-beginning 0)) + (setq bounds (bibtex-parse-field)))) + ;; Step through all fields so that we cannot overshoot. + (while bounds + (goto-char (bibtex-start-of-name-in-field bounds)) + (if (looking-at name) (throw 'done bounds)) + (goto-char (bibtex-end-of-field bounds)) + (setq bounds (bibtex-parse-field))))))))) (defun bibtex-search-backward-field (name &optional bound) "Search backward to find a BibTeX field of name NAME. -If a syntactically correct field is found, a pair containing the boundaries of -the name and text parts of the field is returned. The search is limited by -optional arg BOUND. If BOUND is t the search is limited by the beginning of the -current entry. Do not move point." +If a syntactically correct field is found, return a pair containing +the boundaries of the name and text parts of the field. The search +is limited by the optional arg BOUND. If BOUND is nil the search is +limited by the beginning of the current entry. Do not move point." (save-match-data (save-excursion - (unless (integer-or-marker-p bound) - (setq bound (if bound - (save-excursion (bibtex-beginning-of-entry)) - (point-min)))) - (let ((case-fold-search t) - (bibtex-field-name-for-parsing name) - boundaries temp-boundaries) - (while (and (not boundaries) - (>= (point) bound) - (search-backward "," bound t)) - (if (setq temp-boundaries - (bibtex-parse-association 'bibtex-parse-field-name - 'bibtex-parse-field-text)) - (setq boundaries temp-boundaries))) - boundaries)))) - -(defsubst bibtex-start-of-field (bounds) - (nth 0 (car bounds))) -(defsubst bibtex-start-of-name-in-field (bounds) - (nth 1 (car bounds))) -(defsubst bibtex-end-of-name-in-field (bounds) - (nth 2 (car bounds))) -(defsubst bibtex-end-of-field (bounds) - (cddr bounds)) -(defsubst bibtex-start-of-text-in-field (bounds) - (cadr bounds)) -(defsubst bibtex-end-of-text-in-field (bounds) - (cddr bounds)) + (let ((name-part (concat ",[ \t\n]*\\(?:" name "\\)[ \t\n]*=")) + (case-fold-search t) + bounds) + (unless bound (setq bound (save-excursion (bibtex-beginning-of-entry)))) + (while (and (not bounds) + (search-backward "," bound t) + (looking-at name-part)) + (setq bounds (bibtex-parse-field))) + bounds)))) (defun bibtex-name-in-field (bounds &optional remove-opt-alt) "Get content of name in BibTeX field defined via BOUNDS. If optional arg REMOVE-OPT-ALT is non-nil remove \"OPT\" and \"ALT\"." - (let ((name (buffer-substring-no-properties (nth 1 (car bounds)) - (nth 2 (car bounds))))) + (let ((name (buffer-substring-no-properties + (bibtex-start-of-name-in-field bounds) + (bibtex-end-of-name-in-field bounds)))) (if (and remove-opt-alt (string-match "\\`\\(OPT\\|ALT\\)" name)) (substring name 3) name))) -(defun bibtex-text-in-field-bounds (bounds &optional remove-delim) - "Get content of text in BibTeX field defined via BOUNDS. -If optional arg REMOVE-DELIM is non-nil remove enclosing field delimiters -if present." - (let ((content (buffer-substring-no-properties (cadr bounds) - (cddr bounds)))) - (if remove-delim - (bibtex-remove-delimiters-string content) - content))) +(defun bibtex-text-in-field-bounds (bounds &optional content) + "Get text in BibTeX field defined via BOUNDS. +If optional arg CONTENT is non-nil extract content of field +by removing field delimiters and concatenating the resulting string. +If `bibtex-expand-strings' is non-nil, also expand BibTeX strings." + (if content + (save-excursion + (let ((epoint (bibtex-end-of-text-in-field bounds)) + content opoint temp) + (goto-char (bibtex-start-of-text-in-field bounds)) + (while (< (setq opoint (point)) epoint) + (cond ((looking-at bibtex-field-const) + (let ((mtch (match-string-no-properties 0))) + (goto-char (match-end 0)) + (setq temp (if bibtex-expand-strings + (cdr (assoc-string mtch (bibtex-strings) t))) + content (concat content (or temp mtch))))) + + ((setq temp (bibtex-parse-field-string)) + (setq content (concat content (buffer-substring-no-properties + (1+ (car temp)) + (1- (cdr temp))))) + (goto-char (cdr temp))) + (t (error "Malformed text field"))) + (re-search-forward "\\=[ \t\n]*#[ \t\n]*" nil t)) + content)) + (buffer-substring-no-properties (bibtex-start-of-text-in-field bounds) + (bibtex-end-of-text-in-field bounds)))) (defun bibtex-text-in-field (field &optional follow-crossref) "Get content of field FIELD of current BibTeX entry. @@ -1388,13 +1436,13 @@ If optional arg FOLLOW-CROSSREF is non-nil, follow crossref." ;; We want to jump back and forth while searching FIELD (bibtex-narrow-to-entry) (goto-char (point-min)) - (let ((bounds (bibtex-search-forward-field field)) + (let ((bounds (bibtex-search-forward-field field (point-max))) crossref-field) (cond (bounds (bibtex-text-in-field-bounds bounds t)) ((and follow-crossref (progn (goto-char (point-min)) (setq bounds (bibtex-search-forward-field - "\\(OPT\\)?crossref")))) + "\\(OPT\\)?crossref" (point-max))))) (setq crossref-field (bibtex-text-in-field-bounds bounds t)) (widen) (if (bibtex-find-crossref crossref-field) @@ -1406,16 +1454,21 @@ If optional arg FOLLOW-CROSSREF is non-nil, follow crossref." "Parse the prefix part of a BibTeX string entry, including reference key. If the string prefix is found, return a triple consisting of the position of the very first character of the match, the actual starting position of the -reference key and the end position of the match." +reference key and the end position of the match. +If `bibtex-string-empty-key' is non-nil accept empty string key." (let ((case-fold-search t)) - (if (looking-at "^[ \t]*@string[ \t\n]*[({][ \t\n]*") + (if (looking-at bibtex-string-type) (let ((start (point))) (goto-char (match-end 0)) - (when (looking-at bibtex-reference-key) - (goto-char (match-end 0)) - (list start - (match-beginning 0) - (match-end 0))))))) + (cond ((looking-at bibtex-reference-key) + (goto-char (match-end 0)) + (list start + (match-beginning 0) + (match-end 0))) + ((and bibtex-string-empty-key + (looking-at "=")) + (skip-chars-backward " \t\n") + (list start (point) (point)))))))) (defun bibtex-parse-string-postfix () "Parse the postfix part of a BibTeX string entry, including the text. @@ -1425,18 +1478,18 @@ character of the string entry. Move point past BibTeX string entry." (let* ((case-fold-search t) (bounds (bibtex-parse-field-text))) (when bounds - (goto-char (cdr bounds)) + (goto-char (nth 1 bounds)) (when (looking-at "[ \t\n]*[})]") (goto-char (match-end 0)) (list (car bounds) - (cdr bounds) + (nth 1 bounds) (match-end 0)))))) (defun bibtex-parse-string () - "Parse a BibTeX string entry. -If a syntactically correct entry is found, a pair containing the boundaries of -the reference key and text parts of the entry is returned. -Move point past BibTeX string entry." + "Parse a BibTeX string entry beginning at the position of point. +If a syntactically correct entry is found, return a cons pair containing +the boundaries of the reference key and text parts of the entry. +Do not move point." (bibtex-parse-association 'bibtex-parse-string-prefix 'bibtex-parse-string-postfix)) @@ -1449,8 +1502,7 @@ the reference key and text parts of the string is returned. Do not move point." (let ((case-fold-search t) boundaries) (while (and (not boundaries) - (search-forward-regexp - "^[ \t]*@string[ \t\n]*[({][ \t\n]*" nil t)) + (search-forward-regexp bibtex-string-type nil t)) (goto-char (match-beginning 0)) (unless (setq boundaries (bibtex-parse-string)) (forward-char 1))) @@ -1465,25 +1517,22 @@ the reference key and text parts of the field is returned. Do not move point." (let ((case-fold-search t) boundaries) (while (and (not boundaries) - (search-backward-regexp - "^[ \t]*@string[ \t\n]*[({][ \t\n]*" nil t)) + (search-backward-regexp bibtex-string-type nil t)) (goto-char (match-beginning 0)) (setq boundaries (bibtex-parse-string))) boundaries)))) (defun bibtex-reference-key-in-string (bounds) + "Return the key part of a BibTeX string defined via BOUNDS" (buffer-substring-no-properties (nth 1 (car bounds)) (nth 2 (car bounds)))) -(defun bibtex-text-in-string (bounds &optional remove-delim) - "Get content of text in BibTeX string field defined via BOUNDS. -If optional arg REMOVE-DELIM is non-nil remove enclosing field -delimiters if present." - (let ((content (buffer-substring-no-properties (nth 0 (cdr bounds)) - (nth 1 (cdr bounds))))) - (if remove-delim - (bibtex-remove-delimiters-string content) - content))) +(defun bibtex-text-in-string (bounds &optional content) + "Get text in BibTeX string field defined via BOUNDS. +If optional arg CONTENT is non-nil extract content +by removing field delimiters and concatenating the resulting string. +If `bibtex-expand-strings' is non-nil, also expand BibTeX strings." + (bibtex-text-in-field-bounds bounds content)) (defsubst bibtex-start-of-text-in-string (bounds) (nth 0 (cdr bounds))) @@ -1503,14 +1552,16 @@ delimiters if present." (or (match-string-no-properties bibtex-key-in-head) empty)) -;; Helper Functions +(defun bibtex-preamble-prefix (&optional delim) + "Parse the prefix part of a BibTeX Preamble. +Point must be at beginning of prefix part. If prefix is found move point +to its end and return position of point. If optional arg DELIM is non-nil, +move past the opening delimiter. If no preamble is found return nil." + (let ((case-fold-search t)) + (re-search-forward (concat "\\=" bibtex-preamble-prefix + (if delim "[({][ \t\n]*")) nil t))) -(defun bibtex-remove-delimiters-string (str) - "Remove delimiters of string STR." - (if (and (memq (aref str 0) '(?\{ ?\")) - (memq (aref str (1- (length str))) '(?\} ?\"))) - (substring str 1 -1) - str)) +;; Helper Functions (defsubst bibtex-string= (str1 str2) "Return t if STR1 and STR2 are equal, ignoring case." @@ -1533,15 +1584,17 @@ With optional argument BACKWARD non-nil, move backward to beginning of previous valid one. A valid entry is a syntactical correct one with type contained in `bibtex-entry-field-alist' or, if `bibtex-sort-ignore-string-entries' is nil, a syntactical correct string -entry. Return buffer position of beginning and ending of entry if a valid +entry. Return buffer position of beginning and end of entry if a valid entry is found, nil otherwise." (interactive "P") (let ((case-fold-search t) found) + (beginning-of-line) + ;; Loop till we look at a valid entry. (while (not (or found (if backward (bobp) (eobp)))) (let ((pnt (point)) bounds) - (cond ((or (and (looking-at bibtex-valid-entry-re) + (cond ((or (and (looking-at bibtex-entry-type-whitespace) (setq found (bibtex-search-entry nil nil t)) (equal (match-beginning 0) pnt)) (and (not bibtex-sort-ignore-string-entries) @@ -1549,11 +1602,10 @@ entry is found, nil otherwise." (setq found (cons (bibtex-start-of-field bounds) (bibtex-end-of-string bounds))))) (goto-char pnt)) - (backward - (if (re-search-backward "^[ \t]*\\(@\\)" nil 'move) - (goto-char (match-beginning 1)))) - (t (if (re-search-forward "\n[ \t]*@" nil 'move) - (forward-char -1)))))) + (backward (re-search-backward "^[ \t]*@" nil 'move)) + (t (re-search-forward "\\=[ \t]*@" nil t) ;; don't be stuck + (if (re-search-forward "^[ \t]*@" nil 'move) + (goto-char (match-beginning 0))))))) found)) (defun bibtex-map-entries (fun) @@ -1562,20 +1614,14 @@ FUN is called with three arguments, the key of the entry and the buffer positions (marker) of beginning and end of entry. Point is inside the entry. If `bibtex-sort-ignore-string-entries' is non-nil, FUN is not called for @String entries." - (let ((case-fold-search t)) + (let ((case-fold-search t) + found) (save-excursion (goto-char (point-min)) - (while (re-search-forward bibtex-entry-head nil t) - (let ((entry-type (bibtex-type-in-head)) - (key (bibtex-key-in-head "")) - (beg (copy-marker (match-beginning 0))) - (end (copy-marker (save-excursion (bibtex-end-of-entry))))) - (save-excursion - (if (or (and (not bibtex-sort-ignore-string-entries) - (bibtex-string= entry-type "string")) - (assoc-string entry-type bibtex-entry-field-alist t)) - (funcall fun key beg end))) - (goto-char end)))))) + (while (setq found (bibtex-skip-to-valid-entry)) + (looking-at bibtex-any-entry-maybe-empty-head) + (funcall fun (bibtex-key-in-head "") (car found) (cdr found)) + (goto-char (cdr found)))))) (defun bibtex-progress-message (&optional flag interval) "Echo a message about progress of current buffer. @@ -1631,9 +1677,9 @@ BOUND and NOERROR are exactly as in `re-search-forward'. If BACKWARD is non-nil, search in reverse direction. Move point past the closing delimiter (at the beginning of entry if BACKWARD is non-nil). Return a cons pair with buffer positions of beginning and end of entry. -After call to this function MATCH-BEGINNING and MATCH-END functions -are defined, but only for the head part of the entry -\(especially (match-end 0) just gives the end of the head part)." +After a call to this function `match-data' corresponds to the head part +of the entry, see regexp `bibtex-entry-head'. +Ignore @String and @Preamble entries." (let ((pnt (point)) (entry-head-re (if empty-head bibtex-entry-maybe-empty-head @@ -1643,16 +1689,13 @@ are defined, but only for the head part of the entry (while (and (not found) (re-search-backward entry-head-re bound noerror)) (setq found (bibtex-search-entry empty-head pnt t))) - (if found - (progn (goto-char (match-beginning 0)) - found) - (cond ((not noerror) - ;; yell - (error "Backward search of BibTeX entry failed")) - ((eq noerror t) - ;; don't move - (goto-char pnt))) - nil)) + (cond (found + (goto-char (match-beginning 0)) + found) + ((not noerror) ;; yell + (error "Backward search of BibTeX entry failed")) + (t (if (eq noerror t) (goto-char pnt)) ;; don't move + nil))) (let (found) (unless bound (setq bound (point-max))) (while (and (not found) @@ -1662,52 +1705,41 @@ are defined, but only for the head part of the entry (if (save-excursion (goto-char (match-end bibtex-type-in-head)) (looking-at "[ \t]*(")) - ;; entry opened with parenthesis - ?\) - ?\})) - (infix-start (point)) - finished bounds) - (while (not finished) - (skip-chars-forward " \t\n" bound) - (if (and (setq bounds (bibtex-parse-field bibtex-field-name)) - (<= (bibtex-end-of-field bounds) bound)) - (setq infix-start (bibtex-end-of-field bounds)) - (setq finished t)) - (goto-char infix-start)) - ;; This matches the infix* part. The AND construction assures - ;; that BOUND is respected. - (when (and (looking-at bibtex-entry-postfix) - (eq (char-before (match-end 0)) entry-closer) + ",?[ \t\n]*)" ;; entry opened with `(' + ",?[ \t\n]*}")) ;; entry opened with `{' + bounds) + (skip-chars-forward " \t\n" bound) + ;; loop over all BibTeX fields + (while (and (setq bounds (bibtex-parse-field)) + (<= (bibtex-end-of-field bounds) bound)) + (goto-char (bibtex-end-of-field bounds))) + ;; This matches the infix* part. + (when (and (looking-at entry-closer) (<= (match-end 0) bound)) (goto-char (match-end 0)) (setq found t))))) - (if found - (cons (match-beginning 0) (point)) - (cond ((not noerror) - ;; yell - (error "Search of BibTeX entry failed")) - ((eq noerror t) - ;; don't move - (goto-char pnt))) - nil))))) + (cond (found + (cons (match-beginning 0) (point))) + ((not noerror) ;; yell + (error "Search of BibTeX entry failed")) + (t (if (eq noerror t) (goto-char pnt)) ;; don't move + nil)))))) (defun bibtex-flash-head () "Flash at BibTeX entry head before point, if exists." (let ((case-fold-search t) + (pnt (point)) flash) - (cond ((re-search-backward bibtex-entry-head nil t) - (goto-char (match-beginning bibtex-type-in-head)) - (setq flash (match-end bibtex-key-in-head))) - (t - (end-of-line) - (skip-chars-backward " \t") - (setq flash (point)) - (beginning-of-line) - (skip-chars-forward " \t"))) - (if (pos-visible-in-window-p (point)) - (sit-for 1) - (message "From: %s" - (buffer-substring (point) flash))))) + (save-excursion + (bibtex-beginning-of-entry) + (when (and (looking-at bibtex-any-entry-maybe-empty-head) + (< (point) pnt)) + (goto-char (match-beginning bibtex-type-in-head)) + (setq flash (match-end bibtex-key-in-head)) + (if (pos-visible-in-window-p (point)) + (sit-for 1) + (message "From: %s" + (buffer-substring (point) flash))))))) (defun bibtex-make-optional-field (field) "Make an optional field named FIELD in current BibTeX entry." @@ -1731,17 +1763,11 @@ are defined, but only for the head part of the entry (skip-chars-forward " \t\n"))) (defun bibtex-beginning-of-first-entry () - "Go to the beginning of the first BibTeX entry in buffer. Return point." + "Go to beginning of line of first BibTeX entry in buffer. +If `bibtex-sort-ignore-string-entries' is non-nil, @String entries +are ignored. Return point" (goto-char (point-min)) - (if (re-search-forward "^[ \t]*@" nil 'move) - (beginning-of-line)) - (point)) - -(defun bibtex-beginning-of-last-entry () - "Go to the beginning of the last BibTeX entry in buffer." - (goto-char (point-max)) - (if (re-search-backward "^[ \t]*@" nil 'move) - (beginning-of-line)) + (bibtex-skip-to-valid-entry) (point)) (defun bibtex-inside-field () @@ -1758,7 +1784,7 @@ are defined, but only for the head part of the entry "Search for BibTeX field enclosing point. Unless NOERR is non-nil, signal an error if no enclosing field is found. On success return bounds, nil otherwise. Do not move point." - (let ((bounds (bibtex-search-backward-field bibtex-field-name t))) + (let ((bounds (bibtex-search-backward-field bibtex-field-name))) (if (and bounds (<= (bibtex-start-of-field bounds) (point)) (>= (bibtex-end-of-field bounds) (point))) @@ -1793,7 +1819,7 @@ Beginning (but not end) of entry is given by (`match-beginning' 0)." (length (eval kr))) (eval kr)))))) (if (eq bibtex-last-kill-command 'field) - (let (bibtex-help-message) + (progn (bibtex-find-text) (if (looking-at "[}\"]") (forward-char)) @@ -1846,12 +1872,11 @@ Formats current entry according to variable `bibtex-entry-format'." ;; determine if entry has crossref field and if at least ;; one alternative is non-empty (goto-char (point-min)) - (let* ((fields-alist (bibtex-parse-entry)) + (let* ((fields-alist (bibtex-parse-entry t)) (field (assoc-string "crossref" fields-alist t))) (setq crossref-key (and field - (not (string-match bibtex-empty-field-re - (cdr field))) - (bibtex-remove-delimiters-string (cdr field))) + (not (equal "" (cdr field))) + (cdr field)) req-field-list (if crossref-key (nth 0 (nth 2 entry-list)) ; crossref part (nth 0 (nth 1 entry-list)))) ; required part @@ -1861,8 +1886,7 @@ Formats current entry according to variable `bibtex-entry-format'." (setq alternatives-there t field (assoc-string (car rfield) fields-alist t)) (if (and field - (not (string-match bibtex-empty-field-re - (cdr field)))) + (not (equal "" (cdr field)))) (cond ((not non-empty-alternative) (setq non-empty-alternative t)) ((memq 'required-fields format) @@ -1875,7 +1899,8 @@ Formats current entry according to variable `bibtex-entry-format'." ;; process all fields (goto-char (point-min)) - (while (setq bounds (bibtex-search-forward-field bibtex-field-name)) + (while (setq bounds (bibtex-search-forward-field + bibtex-field-name (point-max))) (let* ((beg-field (copy-marker (bibtex-start-of-field bounds))) (end-field (copy-marker (bibtex-end-of-field bounds) t)) (beg-name (copy-marker (bibtex-start-of-name-in-field bounds))) @@ -1887,9 +1912,7 @@ Formats current entry according to variable `bibtex-entry-format'." beg-name (+ beg-name 3)))) (field-name (buffer-substring-no-properties (if opt-alt (+ beg-name 3) beg-name) end-name)) - (empty-field (string-match bibtex-empty-field-re - (buffer-substring-no-properties - beg-text end-text))) + (empty-field (equal "" (bibtex-text-in-field-bounds bounds t))) deleted) ;; We have more elegant high-level functions for several @@ -2065,7 +2088,8 @@ is returned unchanged." Optional arg CHANGE-LIST is a list of substitution patterns that is applied to the content of FIELD. It is an alist with pairs \(OLD-REGEXP . NEW-STRING\)." - (let ((content (bibtex-text-in-field field bibtex-autokey-use-crossref)) + (let* ((bibtex-expand-strings bibtex-autokey-expand-strings) + (content (bibtex-text-in-field field bibtex-autokey-use-crossref)) case-fold-search) (unless content (setq content "")) (dolist (pattern change-list content) @@ -2195,6 +2219,7 @@ The algorithm works as follows. The name part: 1. Use the author or editor field to generate the name part of the key. + Expand BibTeX strings if `bibtex-autokey-expand-strings' is non-nil. 2. Change the content of the name field according to `bibtex-autokey-name-change-strings' (see there for further detail). 3. Use the first `bibtex-autokey-names' names in the name field. If there @@ -2299,7 +2324,9 @@ If optional arg GLOBAL is non-nil, completion is based on the keys in "Set `bibtex-reference-keys' to the keys used in the whole buffer. Find both entry keys and crossref entries. If ABORTABLE is non-nil abort on user input. If VERBOSE is non-nil give messages about progress. -Return alist of keys if parsing was completed, `aborted' otherwise." +Return alist of keys if parsing was completed, `aborted' otherwise. +If `bibtex-parse-keys-fast' is non-nil, use fast but simplified algorithm +for parsing BibTeX keys. If parsing fails, try to set this variable to nil." (let (ref-keys crossref-keys) (save-excursion (save-match-data @@ -2387,6 +2414,11 @@ Return alist of strings if parsing was completed, `aborted' otherwise." ;; successful operation --> return `bibtex-strings' (setq bibtex-strings strings)))))) +(defun bibtex-strings () + "Return `bibtex-strings'. Initialize this variable if necessary." + (if (listp bibtex-strings) bibtex-strings + (bibtex-parse-strings (bibtex-string-files-init)))) + (defun bibtex-string-files-init () "Return initialization for `bibtex-strings'. Use `bibtex-predefined-strings' and BibTeX files `bibtex-string-files'." @@ -2521,8 +2553,7 @@ of a word, all strings are listed. Return completion." (t (message "Making completion list...") (with-output-to-temp-buffer "*Completions*" - (display-completion-list (all-completions part-of-word - completions) + (display-completion-list (all-completions part-of-word completions) part-of-word)) (message "Making completion list...done") ;; return value is handled by choose-completion-string-functions @@ -2533,17 +2564,10 @@ of a word, all strings are listed. Return completion." Remove enclosing field delimiters for STR. Display message with expansion of STR using expansion list COMPL." (save-excursion - (bibtex-inside-field) - (let ((bounds (bibtex-enclosing-field)) - (abbr (cdr (if (stringp str) + (let ((abbr (cdr (if (stringp str) (assoc-string str compl t))))) (if abbr (message "Abbreviation for `%s'" abbr)) - (goto-char (bibtex-start-of-text-in-field bounds)) - (let ((boundaries (bibtex-parse-field-string))) - (if (and boundaries - (equal (cdr boundaries) - (bibtex-end-of-text-in-field bounds))) - (bibtex-remove-delimiters)))))) + (bibtex-remove-delimiters)))) (defun bibtex-complete-crossref-cleanup (key) "Display summary message on entry KEY after completion of a crossref key. @@ -2598,8 +2622,7 @@ Used as default value of `bibtex-summary-function'." (defun bibtex-pop (arg direction) "Fill current field from the ARGth same field's text in DIRECTION. Generic function used by `bibtex-pop-previous' and `bibtex-pop-next'." - (let (bibtex-help-message) - (bibtex-find-text)) + (bibtex-find-text) (save-excursion ;; parse current field (bibtex-inside-field) @@ -2642,8 +2665,7 @@ Generic function used by `bibtex-pop-previous' and `bibtex-pop-next'." (goto-char stop-old-text) (delete-region start-old-text stop-old-text) (insert new-text))))) - (let (bibtex-help-message) - (bibtex-find-text)) + (bibtex-find-text) (setq this-command 'bibtex-pop)) (defun bibtex-beginning-of-field () @@ -2667,7 +2689,7 @@ begins at the beginning of a line. We use this function for font-locking." (setq field (match-string-no-properties 1))) (setq bounds (bibtex-parse-field-text)) (progn - (setq start (car bounds) end (cdr bounds)) + (setq start (car bounds) end (nth 1 bounds)) ;; Always ignore field delimiters (if (memq (char-before end) '(?\} ?\")) (setq end (1- end))) @@ -2905,20 +2927,21 @@ according to `bibtex-field-list', but are not yet present." (unless (assoc-string (car field) fields-alist t) (bibtex-make-optional-field field)))))) -(defun bibtex-parse-entry () +(defun bibtex-parse-entry (&optional content) "Parse entry at point, return an alist. The alist elements have the form (FIELD . TEXT), where FIELD can also be the special strings \"=type=\" and \"=key=\". For the FIELD \"=key=\" TEXT may be nil. Remove \"OPT\" and \"ALT\" from FIELD. -Move point to the end of the last field." +Move point to the end of the last field. +If optional arg CONTENT is non-nil extract content of text fields." (let (alist bounds) (when (looking-at bibtex-entry-maybe-empty-head) (push (cons "=type=" (bibtex-type-in-head)) alist) (push (cons "=key=" (bibtex-key-in-head)) alist) (goto-char (match-end 0)) - (while (setq bounds (bibtex-parse-field bibtex-field-name)) + (while (setq bounds (bibtex-parse-field)) (push (cons (bibtex-name-in-field bounds t) - (bibtex-text-in-field-bounds bounds)) + (bibtex-text-in-field-bounds bounds content)) alist) (goto-char (bibtex-end-of-field bounds)))) alist)) @@ -2970,14 +2993,11 @@ entry (for example, the year parts of the keys)." (when other (setq other (save-excursion (goto-char other) (bibtex-parse-entry))) (setq key-end (point)) ;In case parse-entry changed the buffer. - (while (setq bounds (bibtex-parse-field bibtex-field-name)) + (while (setq bounds (bibtex-parse-field)) (let ((text (assoc-string (bibtex-name-in-field bounds t) other t))) (if (not (and text - (string-match bibtex-empty-field-re - (buffer-substring-no-properties - (bibtex-start-of-text-in-field bounds) - (bibtex-end-of-text-in-field bounds))))) + (equal "" (bibtex-text-in-field-bounds bounds t)))) (goto-char (bibtex-end-of-field bounds)) (goto-char (bibtex-start-of-text-in-field bounds)) (delete-region (point) (bibtex-end-of-text-in-field bounds)) @@ -2997,19 +3017,25 @@ entry (for example, the year parts of the keys)." (defun bibtex-print-help-message () "Print helpful information about current field in current BibTeX entry." (interactive) - (save-excursion - (let* ((case-fold-search t) - (field-name (bibtex-name-in-field (bibtex-enclosing-field) t)) - (field-list (bibtex-field-list (progn (re-search-backward - bibtex-entry-maybe-empty-head nil t) - (bibtex-type-in-head)))) - (comment (assoc-string field-name - (append (car field-list) - (cdr field-list)) - t))) - (if comment - (message "%s" (nth 1 comment)) - (message "No comment available"))))) + (let* ((case-fold-search t) + (type (save-excursion + (bibtex-beginning-of-entry) + (looking-at bibtex-any-entry-maybe-empty-head) + (bibtex-type-in-head))) + comment field-list) + (cond ((bibtex-string= type "string") + (message "String definition")) + ((bibtex-string= type "preamble") + (message "Preamble definition")) + (t + (setq field-list (bibtex-field-list type) + comment + (assoc-string (bibtex-name-in-field (bibtex-enclosing-field) t) + (append (car field-list) (cdr field-list)) + t)) + (if comment + (message "%s" (nth 1 comment)) + (message "No comment available")))))) (defun bibtex-make-field (field &optional move interactive) "Make a field named FIELD in current BibTeX entry. @@ -3032,11 +3058,10 @@ MOVE and INTERACTIVE are t when called interactively." t t)) (unless (consp field) (setq field (list field))) - (if move - (let (bibtex-help-message) - (bibtex-find-text) - (if (looking-at "[}\"]") - (forward-char)))) + (when move + (bibtex-find-text) + (if (looking-at "[}\"]") + (forward-char))) (insert ",\n") (indent-to-column (+ bibtex-entry-offset bibtex-field-indentation)) (if (nth 3 field) (insert "ALT")) @@ -3079,16 +3104,16 @@ Return the new location of point." (org (point)) (pnt (bibtex-beginning-of-entry)) err bounds) - (cond ((looking-at bibtex-valid-entry-whitespace-re) + (cond ((looking-at bibtex-entry-type-whitespace) (bibtex-search-entry t nil t) (unless (equal (match-beginning 0) pnt) (setq err t))) + ;; @String ((setq bounds (bibtex-parse-string)) (goto-char (bibtex-end-of-string bounds))) - ((looking-at "[ \t]*@[ \t]*preamble[ \t\n]*") - (goto-char (match-end 0)) - (if (looking-at "[({]") - (forward-sexp 1) + ;; @Preamble + ((bibtex-preamble-prefix t) + (unless (bibtex-parse-string-postfix) ;; @String postfix OK (setq err t))) (t (if (interactive-p) @@ -3142,15 +3167,10 @@ otherwise count all entries except @String entries. If mark is active count entries in region, if not in whole buffer." (interactive "P") (let ((number 0) - (bibtex-sort-ignore-string-entries - (not count-string-entries))) - (save-excursion - (save-restriction - (narrow-to-region (if mark-active (region-beginning) - (bibtex-beginning-of-first-entry)) - (if mark-active (region-end) (point-max))) - (bibtex-map-entries (lambda (key beg end) - (setq number (1+ number)))))) + (bibtex-sort-ignore-string-entries (not count-string-entries))) + (save-restriction + (if mark-active (narrow-to-region (region-beginning) (region-end))) + (bibtex-map-entries (lambda (key beg end) (setq number (1+ number))))) (message "%s contains %d entries." (if mark-active "Region" "Buffer") number))) @@ -3166,7 +3186,7 @@ If mark is active count entries in region, if not in whole buffer." (interactive) (let ((bounds (save-excursion (bibtex-beginning-of-entry) - (bibtex-search-forward-field "abstract" t)))) + (bibtex-search-forward-field "abstract")))) (if bounds (ispell-region (bibtex-start-of-text-in-field bounds) (bibtex-end-of-text-in-field bounds)) @@ -3194,7 +3214,7 @@ of the head of the entry found. Return nil if no entry found." ;; Don't search CROSSREF-KEY if we don't need it. (if (eq bibtex-maintain-sorted-entries 'crossref) (let ((bounds (bibtex-search-forward-field - "\\(OPT\\)?crossref" t))) + "\\(OPT\\)?crossref"))) (list key (if bounds (bibtex-text-in-field-bounds bounds t)) entry-name)) @@ -3237,17 +3257,13 @@ If its value is nil use plain sorting. Text outside of BibTeX entries is not affected. If `bibtex-sort-ignore-string-entries' is non-nil, @String entries are ignored." (interactive) - (save-restriction - (narrow-to-region (bibtex-beginning-of-first-entry) - (save-excursion (goto-char (point-max)) - (bibtex-end-of-entry))) - (bibtex-skip-to-valid-entry) + (bibtex-beginning-of-first-entry) ;; needed by `sort-subr' (sort-subr nil 'bibtex-skip-to-valid-entry ; NEXTREC function 'bibtex-end-of-entry ; ENDREC function 'bibtex-entry-index ; STARTKEY function nil ; ENDKEY function - 'bibtex-lessp))) ; PREDICATE + 'bibtex-lessp)) ; PREDICATE (defun bibtex-find-crossref (crossref-key &optional pnt split) "Move point to the beginning of BibTeX entry CROSSREF-KEY. @@ -3265,7 +3281,7 @@ entry and SPLIT is t." (let ((crossref-key (save-excursion (bibtex-beginning-of-entry) - (let ((bounds (bibtex-search-forward-field "crossref" t))) + (let ((bounds (bibtex-search-forward-field "crossref"))) (if bounds (bibtex-text-in-field-bounds bounds t)))))) (list (bibtex-read-key "Find crossref key: " crossref-key t) @@ -3361,11 +3377,10 @@ Return t if preparation was successful or nil if entry KEY already exists." (key-exist) (t ; bibtex-maintain-sorted-entries is non-nil (let* ((case-fold-search t) - (left (save-excursion (bibtex-beginning-of-first-entry) - (bibtex-skip-to-valid-entry) - (point))) - (right (save-excursion (bibtex-beginning-of-last-entry) - (bibtex-end-of-entry))) + (left (save-excursion (bibtex-beginning-of-first-entry))) + (bounds (save-excursion (goto-char (point-max)) + (bibtex-skip-to-valid-entry t))) + (right (if bounds (cdr bounds) (point-min))) (found (if (>= left right) left)) actual-index new) (save-excursion @@ -3412,9 +3427,8 @@ Return t if test was successful, nil otherwise." error-list syntax-error) (save-excursion (save-restriction - (narrow-to-region (if mark-active (region-beginning) - (bibtex-beginning-of-first-entry)) - (if mark-active (region-end) (point-max))) + (if mark-active + (narrow-to-region (region-beginning) (region-end))) ;; looking if entries fit syntactical structure (goto-char (point-min)) @@ -3424,7 +3438,7 @@ Return t if test was successful, nil otherwise." (bibtex-progress-message) (forward-char -1) (let ((pnt (point))) - (if (not (looking-at bibtex-any-valid-entry-re)) + (if (not (looking-at bibtex-entry-type-str)) (forward-char) (bibtex-skip-to-valid-entry) (if (equal (point) pnt) @@ -3634,33 +3648,27 @@ With prefix BEGIN non-nil, move point to its beginning." (goto-char start) (end-of-line) (forward-char)))) - (bibtex-find-text begin)) + (bibtex-find-text begin nil bibtex-help-message)) -(defun bibtex-find-text (&optional begin noerror) +(defun bibtex-find-text (&optional begin noerror help) "Move point to end of text of current BibTeX field. With optional prefix BEGIN non-nil, move point to its beginning. Unless NOERROR is non-nil, an error is signaled if point is not -on a BibTeX field." - (interactive "P") - (let* ((pnt (point)) - (_ (bibtex-inside-field)) - (bounds (bibtex-enclosing-field t))) +on a BibTeX field. If optional arg HELP is non-nil print help message. +When called interactively, the value of HELP is `bibtex-help-message'." + (interactive (list current-prefix-arg nil bibtex-help-message)) + (let ((pnt (point)) + (bounds (bibtex-find-text-internal))) (beginning-of-line) (cond (bounds (if begin - (progn (goto-char (bibtex-start-of-text-in-field bounds)) + (progn (goto-char (nth 1 bounds)) (if (looking-at "[{\"]") (forward-char))) - (goto-char (bibtex-end-of-text-in-field bounds)) - (if (or (= (preceding-char) ?}) - (= (preceding-char) ?\")) + (goto-char (nth 2 bounds)) + (if (memq (preceding-char) '(?} ?\")) (forward-char -1))) - (if bibtex-help-message - (bibtex-print-help-message))) - ((setq bounds (bibtex-parse-string)) - (goto-char (if begin - (1+ (bibtex-start-of-text-in-string bounds)) - (1- (bibtex-end-of-text-in-string bounds))))) + (if help (bibtex-print-help-message))) ((looking-at bibtex-entry-maybe-empty-head) (goto-char (if begin (match-beginning bibtex-key-in-head) @@ -3669,6 +3677,56 @@ on a BibTeX field." (goto-char pnt) (unless noerror (error "Not on BibTeX field")))))) +(defun bibtex-find-text-internal (&optional noerror subfield) + "Find text part of current BibTeX field, @String or @Preamble. +Return list (NAME START END) with field name, start and end of text +or nil if not found. +If optional arg NOERROR is non-nil, an error message is suppressed if text +is not found. If optional arg SUBFIELD is non-nil START and END correspond +to the current subfield delimited by #." + (save-excursion + (let ((pnt (point)) + (_ (bibtex-inside-field)) + (bounds (bibtex-enclosing-field t)) + (case-fold-search t) + (bibtex-string-empty-key t) + name start end) + (bibtex-beginning-of-entry) + (cond (bounds + (setq name (bibtex-name-in-field bounds t) + start (bibtex-start-of-text-in-field bounds) + end (bibtex-end-of-text-in-field bounds))) + ;; @String + ((setq bounds (bibtex-parse-string)) + (setq name "@String" ;; not a field name! + start (bibtex-start-of-text-in-string bounds) + end (bibtex-end-of-text-in-string bounds))) + ;; @Preamble + ((and (bibtex-preamble-prefix t) + (setq bounds (bibtex-parse-field-text))) + (setq name "@Preamble" ;; not a field name! + start (car bounds) + end (nth 1 bounds))) + (t (unless noerror (error "Not on BibTeX field")))) + (when (and start end subfield) + (goto-char start) + (let (done) + (while (not done) + (if (or (prog1 (looking-at bibtex-field-const) + (setq end (match-end 0))) + (prog1 (setq bounds (bibtex-parse-field-string)) + (setq end (cdr bounds)))) + (progn + (if (and (<= start pnt) (<= pnt end)) + (setq done t) + (goto-char end)) + (if (looking-at "[ \t\n]*#[ \t\n]*") + (setq start (goto-char (match-end 0))))) + (unless noerror (error "Not on text part of BibTeX field")) + (setq done t start nil end nil))))) + (if (and start end) + (list name start end))))) + (defun bibtex-remove-OPT-or-ALT () "Remove the string starting optional/alternative fields. Align text and go thereafter to end of text." @@ -3695,17 +3753,16 @@ Align text and go thereafter to end of text." (bibtex-inside-field))) (defun bibtex-remove-delimiters () - "Remove \"\" or {} around string." + "Remove \"\" or {} around current BibTeX field text." (interactive) - (save-excursion - (bibtex-inside-field) - (let* ((bounds (bibtex-enclosing-field)) - (end (bibtex-end-of-text-in-field bounds)) - (start (bibtex-start-of-text-in-field bounds))) - (if (memq (char-before end) '(?\} ?\")) - (delete-region (1- end) end)) - (if (memq (char-after start) '(?\{ ?\")) - (delete-region start (1+ start)))))) + ;; `bibtex-find-text-internal' issues an error message if bounds is nil. + (let* ((bounds (bibtex-find-text-internal nil t)) + (start (nth 1 bounds)) + (end (nth 2 bounds))) + (if (memq (char-before end) '(?\} ?\")) + (delete-region (1- end) end)) + (if (memq (char-after start) '(?\{ ?\")) + (delete-region start (1+ start))))) (defun bibtex-kill-field (&optional copy-only) "Kill the entire enclosing BibTeX field. @@ -3719,7 +3776,7 @@ but do not actually kill it." (end (bibtex-end-of-field bounds)) (beg (bibtex-start-of-field bounds))) (goto-char end) - (skip-chars-forward " \t\n,") + (skip-chars-forward ",") (push (list (bibtex-name-in-field bounds) nil (bibtex-text-in-field-bounds bounds)) bibtex-field-kill-ring) @@ -3803,9 +3860,9 @@ comes the newest one." (let ((bounds (bibtex-enclosing-field))) (goto-char (bibtex-start-of-text-in-field bounds)) (delete-region (point) (bibtex-end-of-text-in-field bounds)) - (insert (concat (bibtex-field-left-delimiter) - (bibtex-field-right-delimiter)) ) - (bibtex-find-text t))) + (insert (bibtex-field-left-delimiter) + (bibtex-field-right-delimiter)) + (bibtex-find-text t nil bibtex-help-message))) (defun bibtex-pop-previous (arg) "Replace text of current field with the similar field in previous entry. @@ -3837,7 +3894,7 @@ At end of the cleaning process, the functions in (interactive "P") (let ((case-fold-search t) (start (bibtex-beginning-of-entry)) - (_ (looking-at bibtex-entry-maybe-empty-head)) + (_ (looking-at bibtex-any-entry-maybe-empty-head)) (entry-type (bibtex-type-in-head)) (key (bibtex-key-in-head))) ;; formatting @@ -3994,18 +4051,18 @@ If `bibtex-align-at-equal-sign' is non-nil, align equal signs, too." "Realign BibTeX entries such that they are separated by one blank line." (goto-char (point-min)) (let ((case-fold-search t) - (valid-entry (concat "[ \t\n]*\\(" bibtex-valid-entry-re "\\)"))) - ;; No blank lines prior to the first valid entry if there no + (entry-type (concat "[ \t\n]*\\(" bibtex-entry-type "\\)"))) + ;; No blank lines prior to the first entry if there no ;; non-white characters in front of it. - (when (looking-at valid-entry) + (when (looking-at entry-type) (replace-match "\\1")) - ;; Valid entries are separated by one blank line. - (while (re-search-forward valid-entry nil t) + ;; Entries are separated by one blank line. + (while (re-search-forward entry-type nil t) (replace-match "\n\n\\1")) - ;; One blank line past the last valid entry if it is followed by + ;; One blank line past the last entry if it is followed by ;; non-white characters, no blank line otherwise. (beginning-of-line) - (when (re-search-forward bibtex-valid-entry-re nil t) + (when (re-search-forward bibtex-entry-type nil t) (bibtex-end-of-entry) (bibtex-delete-whitespace) (open-line (if (eobp) 1 2))))) @@ -4101,11 +4158,13 @@ entries from minibuffer." If point is inside key or crossref field perform key completion based on `bibtex-reference-keys'. Inside a month field perform key completion based on `bibtex-predefined-month-strings'. Inside any other field -perform string completion based on `bibtex-strings'. An error is -signaled if point is outside key or BibTeX field." +\(including a String or Preamble definition) perform string completion +based on `bibtex-strings'. +An error is signaled if point is outside key or BibTeX field." (interactive) (let ((pnt (point)) (case-fold-search t) + (bibtex-string-empty-key t) bounds name compl) (save-excursion (if (and (setq bounds (bibtex-enclosing-field t)) @@ -4119,22 +4178,23 @@ signaled if point is outside key or BibTeX field." ;; point is in month field bibtex-predefined-month-strings) ;; point is in other field - (t (if (listp bibtex-strings) - bibtex-strings - ;; so that bibtex-complete-string-cleanup - ;; can do its job - (bibtex-parse-strings - (bibtex-string-files-init)))))) + (t (bibtex-strings)))) (bibtex-beginning-of-entry) - (cond ((and (looking-at bibtex-string-maybe-empty-head) - ;; point is inside a string key - (or (and (match-beginning bibtex-key-in-head) - (>= pnt (match-beginning bibtex-key-in-head)) - (<= pnt (match-end bibtex-key-in-head))) - ;; or point is on empty string key - (and (not (match-beginning bibtex-key-in-head)) - (= pnt (match-end 0))))) - (setq compl 'string)) + (cond ((setq bounds (bibtex-parse-string)) + ;; point is inside a @String key + (cond ((and (>= pnt (nth 1 (car bounds))) + (<= pnt (nth 2 (car bounds)))) + (setq compl 'string)) + ;; point is inside a @String field + ((and (>= pnt (bibtex-start-of-text-in-string bounds)) + (<= pnt (bibtex-end-of-text-in-string bounds))) + (setq compl (bibtex-strings))))) + ;; point is inside a @Preamble field + ((and (bibtex-preamble-prefix t) + (setq bounds (bibtex-parse-field-text)) + (>= pnt (car bounds)) + (<= pnt (nth 1 bounds))) + (setq compl (bibtex-strings))) ((and (looking-at bibtex-entry-maybe-empty-head) ;; point is inside a key (or (and (match-beginning bibtex-key-in-head) @@ -4282,8 +4342,8 @@ signaled if point is outside key or BibTeX field." (bibtex-entry-left-delimiter) (bibtex-field-left-delimiter)) (let ((endpos (point))) - (insert (bibtex-entry-right-delimiter) - (bibtex-field-right-delimiter) + (insert (bibtex-field-right-delimiter) + (bibtex-entry-right-delimiter) "\n") (goto-char endpos))) @@ -4296,7 +4356,8 @@ The URL is generated using the schemes defined in `bibtex-generate-url-list' (save-excursion (if pos (goto-char pos)) (bibtex-beginning-of-entry) - (let ((fields-alist (bibtex-parse-entry)) + ;; Always remove field delimiters + (let ((fields-alist (bibtex-parse-entry t)) ;; Always ignore case, (case-fold-search t) (lst bibtex-generate-url-list) @@ -4304,18 +4365,14 @@ The URL is generated using the schemes defined in `bibtex-generate-url-list' (while (setq scheme (pop lst)) (when (and (setq field (cdr (assoc-string (caar scheme) fields-alist t))) - ;; Always remove field delimiters - (progn (setq field (bibtex-remove-delimiters-string field)) - (string-match (cdar scheme) field))) + (string-match (cdar scheme) field)) (setq lst nil scheme (cdr scheme) url (if (null scheme) (match-string 0 field) (if (stringp (car scheme)) (setq fmt (pop scheme))) (dolist (step scheme) - ;; Always remove field delimiters - (setq field (bibtex-remove-delimiters-string - (cdr (assoc-string (car step) fields-alist t)))) + (setq field (cdr (assoc-string (car step) fields-alist t))) (if (string-match (nth 1 step) field) (setq field (cond ((functionp (nth 2 step)) (funcall (nth 2 step) field)) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 402a3995795..4bea438bf2b 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -1332,10 +1332,9 @@ The buffer to mark them in is `flyspell-large-region-buffer'." (while keep (if (search-forward word flyspell-large-region-end t) - (progn + (save-excursion (goto-char (- (point) 1)) - (let* ((match-point (point)) ; flyspell-get-word might move it - (flyword-prev-l (flyspell-get-word nil)) + (let* ((flyword-prev-l (flyspell-get-word nil)) (flyword-prev (car flyword-prev-l)) (size-match (= (length flyword-prev) (length word)))) (when (or @@ -1362,7 +1361,7 @@ The buffer to mark them in is `flyspell-large-region-buffer'." (setq keep nil) (flyspell-word) ;; Next search will begin from end of last match - (setq flyspell-large-region-beg match-point)))) + ))) ;; Record if misspelling is not found and try new one (add-to-list 'words-not-found (concat " -> " word " - " @@ -1558,7 +1557,7 @@ FLYSPELL-BUFFER." (defun flyspell-delete-all-overlays () "Delete all the overlays used by flyspell." - (flyspell-delete-region-overlays (point-min) (point-max))) + (remove-overlays (point-min) (point-max) 'flyspell-overlay t)) ;;*---------------------------------------------------------------------*/ ;;* flyspell-unhighlight-at ... */ diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 9e81c224855..42c773240c6 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1161,6 +1161,10 @@ The variable `ispell-library-directory' defines the library location." This is passed to the ispell process using the `-d' switch and is used as key in `ispell-local-dictionary-alist' and `ispell-dictionary-alist'.") +(defvar ispell-current-personal-dictionary nil + "The name of the current personal dictionary, or nil for the default. +This is passed to the ispell process using the `-p' switch.") + (defvar ispell-dictionary nil "Default dictionary to use if `ispell-local-dictionary' is nil.") @@ -1339,7 +1343,7 @@ Valid forms include: (KEY . REGEXP) - skip to the end of REGEXP. REGEXP may be string or symbol. (KEY REGEXP) - skip to end of REGEXP. REGEXP must be a string. (KEY FUNCTION ARGS) - FUNCTION called with ARGS returns end of region.") - +(put 'ispell-skip-region-alist 'risky-local-variable t) ;;;###autoload @@ -1369,6 +1373,7 @@ Second list has key placed inside \\begin{}. Delete or add any regions you want to be automatically selected for skipping in latex mode.") +(put 'ispell-tex-skip-alist 'risky-local-variable t) ;;;###autoload @@ -1385,7 +1390,7 @@ for skipping in latex mode.") Same format as `ispell-skip-region-alist' Note - substrings of other matches must come last (e.g. \"<[tT][tT]/\" and \"<[^ \\t\\n>]\").") - +(put 'ispell-html-skip-alists 'risky-local-variable t) (defvar ispell-local-pdict ispell-personal-dictionary "A buffer local variable containing the current personal dictionary. @@ -2456,18 +2461,23 @@ Keeps argument list for future ispell invocations for no async support." ;; Local dictionary becomes the global dictionary in use. (setq ispell-current-dictionary (or ispell-local-dictionary ispell-dictionary)) + (setq ispell-current-personal-dictionary + (or ispell-local-pdict ispell-personal-dictionary)) (setq args (ispell-get-ispell-args)) (if (and ispell-current-dictionary ; use specified dictionary (not (member "-d" args))) ; only define if not overridden (setq args (append (list "-d" ispell-current-dictionary) args))) - (if ispell-personal-dictionary ; use specified pers dict + (if ispell-current-personal-dictionary ; use specified pers dict (setq args (append args (list "-p" - (expand-file-name ispell-personal-dictionary))))) + (expand-file-name ispell-current-personal-dictionary))))) (setq args (append args ispell-extra-args)) + ;; Initially we don't know any buffer's local words. + (setq ispell-buffer-local-name nil) + (if ispell-async-processp (let ((process-connection-type ispell-use-ptys-p)) (apply 'start-process @@ -2619,8 +2629,8 @@ This may kill the Ispell process; if so, a new one will be started when needed." (let ((dict (or ispell-local-dictionary ispell-dictionary))) (unless (equal ispell-current-dictionary dict) - (setq ispell-current-dictionary dict) - (ispell-kill-ispell t)))) + (ispell-kill-ispell t) + (setq ispell-current-dictionary dict)))) ;;; Spelling of comments are checked when ispell-check-comments is non-nil. @@ -3678,22 +3688,22 @@ Both should not be used to define a buffer-local dictionary." (setq ispell-local-pdict (match-string-no-properties 1))))))) ;; Reload if new personal dictionary defined. - (if (and ispell-local-pdict - (not (equal ispell-local-pdict ispell-personal-dictionary))) - (progn - (ispell-kill-ispell t) - (setq ispell-personal-dictionary ispell-local-pdict))) + (if (not (equal ispell-current-personal-dictionary + (or ispell-local-pdict ispell-personal-dictionary))) + (ispell-kill-ispell t)) ;; Reload if new dictionary defined. (ispell-internal-change-dictionary)) (defun ispell-buffer-local-words () "Loads the buffer-local dictionary in the current buffer." + ;; If there's an existing ispell process that's wrong for this use, + ;; kill it. (if (and ispell-buffer-local-name (not (equal ispell-buffer-local-name (buffer-name)))) - (progn - (ispell-kill-ispell t) - (setq ispell-buffer-local-name nil))) + (ispell-kill-ispell t)) + ;; Actually start a new ispell process, because we need + ;; to send commands now to specify the local words to it. (ispell-init-process) (save-excursion (goto-char (point-min)) diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index 47d6464da19..2e79be9e4cc 100644 --- a/lisp/textmodes/org.el +++ b/lisp/textmodes/org.el @@ -3,9 +3,9 @@ ;; Copyright (c) 2004, 2005 Free Software Foundation ;; ;; Author: Carsten Dominik <dominik at science dot uva dot nl> -;; Keywords: outlines, hypermedia, calendar +;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ -;; Version: 3.23 +;; Version: 4.00 ;; ;; This file is part of GNU Emacs. ;; @@ -59,7 +59,6 @@ ;; (autoload 'org-mode "org" "Org mode" t) ;; (autoload 'org-diary "org" "Diary entries from Org mode") ;; (autoload 'org-agenda "org" "Multi-file agenda from Org mode" t) -;; (autoload 'org-todo-list "org" "Multi-file todo list from Org mode" t) ;; (autoload 'org-store-link "org" "Store a link to the current location" t) ;; (autoload 'orgtbl-mode "org" "Org tables as a minor mode" t) ;; (autoload 'turn-on-orgtbl "org" "Org tables as a minor mode") @@ -82,6 +81,16 @@ ;; ;; Changes: ;; ------- +;; Version 4.00 +;; - Headlines can contain TAGS, and Org-mode can produced a list +;; of matching headlines based on a TAG search expression. +;; - `org-agenda' has now become a dispatcher that will produce the agenda +;; and other views on org-mode data with an additional keypress. +;; +;; Version 3.24 +;; - Switching and item to DONE records a time stamp when the variable +;; `org-log-done' is turned on. Default is off. +;; ;; Version 3.23 ;; - M-RET makes new items as well as new headings. ;; - Various small bug fixes @@ -257,7 +266,7 @@ ;;; Customization variables -(defvar org-version "3.23" +(defvar org-version "4.00" "The version number of the file org.el.") (defun org-version () (interactive) @@ -448,6 +457,11 @@ Changes become only effective after restarting Emacs." :group 'org-keywords :type 'string) +(defcustom org-closed-string "CLOSED:" + "String ued as the prefix for timestamps logging closing a TODO entry." + :group 'org-keywords + :type 'string) + (defcustom org-comment-string "COMMENT" "Entries starting with this keyword will never be exported. An entry can be toggled between COMMENT and normal with @@ -528,6 +542,7 @@ or contain a special line If the file does not specify a category, then file's base name is used instead.") +(make-variable-buffer-local 'org-category) (defgroup org-time nil "Options concerning time stamps and deadlines in Org-mode." @@ -560,6 +575,13 @@ moved to the new date." :group 'org-time :type 'boolean) +(defcustom org-log-done nil + "When set, insert a (non-active) time stamp when TODO entry is marked DONE. +When the state of an entry is changed from nothing to TODO, remove a previous +closing date." + :group 'org-time + :type 'boolean) + (defgroup org-agenda nil "Options concerning agenda display Org-mode." :tag "Org Agenda" @@ -954,11 +976,56 @@ first line, so it is probably best to use this in combinations with :group 'org-structure :type 'boolean) +(defgroup org-tags nil + "Options concerning startup of Org-mode." + :tag "Org Tags" + :group 'org) + +(defcustom org-tags-column 40 + "The column to which tags should be indented in a headline. +If this number is positive, it specified the column. If it is negative, +it means that the tags should be flushright to that column. For example, +-79 works well for a normal 80 character screen." + :group 'org-tags + :type 'integer) + +(defcustom org-use-tag-inheritance t + "Non-nil means, tags in levels apply also for sublevels. +When nil, only the tags directly give in a specific line apply there." + :group 'org-tags + :type 'boolean) + +(defcustom org-tags-match-list-sublevels nil + "Non-nil means list also sublevels of headlines matching tag search. +Because of tag inheritance (see variable `org-use-tag-inheritance'), +the sublevels of a headline matching a tag search often also match +the same search. Listing all of them can create very long lists. +Setting this variable to nil causes subtrees to be skipped." + :group 'org-tags + :type 'boolean) + +(defvar org-tags-history nil + "History of minibuffer reads for tags.") +(defvar org-last-tags-completion-table nil + "The last used completion table for tags.") + (defgroup org-link nil "Options concerning links in Org-mode." :tag "Org Link" :group 'org) +(defcustom org-tab-follows-link nil + "Non-nil means, on links TAB will follow the link. +Needs to be set before org.el is loaded." + :group 'org-link + :type 'boolean) + +(defcustom org-return-follows-link nil + "Non-nil means, on links RET will follow the link. +Needs to be set before org.el is loaded." + :group 'org-link + :type 'boolean) + (defcustom org-link-format "<%s>" "Default format for linkes in the buffer. This is a format string for printf, %s will be replaced by the link text. @@ -1997,6 +2064,7 @@ This variable is set by `org-before-change-function'. `org-table-align' sets it back to nil.") (defvar org-mode-hook nil) (defvar org-inhibit-startup nil) ; Dynamically-scoped param. +(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. ;;;###autoload @@ -2022,6 +2090,7 @@ The following commands are available: (easy-menu-add org-tbl-menu) (org-install-agenda-files-menu) (setq outline-regexp "\\*+") +; (setq outline-regexp "\\(?:\\*+\\|[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\) \\)") (setq outline-level 'org-outline-level) (if org-startup-truncated (setq truncate-lines t)) (org-set-regexps-and-options) @@ -2075,6 +2144,12 @@ The following commands are available: (if org-xemacs-p [button2] [mouse-2]) 'org-open-at-mouse) (define-key org-mouse-map (if org-xemacs-p [button3] [mouse-3]) 'org-find-file-at-mouse) +(when org-tab-follows-link + (define-key org-mouse-map [(tab)] 'org-open-at-point) + (define-key org-mouse-map "\C-i" 'org-open-at-point)) +(when org-return-follows-link + (define-key org-mouse-map [(return)] 'org-open-at-point) + (define-key org-mouse-map "\C-m" 'org-open-at-point)) (require 'font-lock) @@ -2098,7 +2173,9 @@ The following commands are available: (cons (length (format-time-string (car org-time-stamp-formats))) (length (format-time-string (cdr org-time-stamp-formats)))) "This holds the lengths of the two different time formats.") -(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^\r\n>]*\\)>" +(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^\r\n>]*?\\)>" + "Regular expression for fast time stamp matching.") +(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^\r\n>]*?\\)[]>]" "Regular expression for fast time stamp matching.") (defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\([^0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" "Regular expression matching time strings for analysis.") @@ -2128,7 +2205,8 @@ The following commands are available: 'keymap org-mouse-map)) t))) -(defvar org-camel-regexp "\\*?\\<[A-Z]+[a-z]+[A-Z][a-zA-Z]*\\>") +(defvar org-camel-regexp "\\*?\\<[A-Z]+[a-z]+[A-Z][a-zA-Z]*\\>" + "Matches CamelCase words, possibly with a star before it.") (defun org-activate-camels (limit) "Run through the buffer and add overlays to dates." (if (re-search-forward org-camel-regexp limit t) @@ -2138,6 +2216,14 @@ The following commands are available: 'keymap org-mouse-map)) t))) +(defun org-activate-tags (limit) + (if (re-search-forward "[ \t]\\(:[A-Za-z_:]+:\\)[ \r\n]" limit t) + (progn + (add-text-properties (match-beginning 1) (match-end 1) + (list 'mouse-face 'highlight + 'keymap org-mouse-map)) + t))) + (defun org-font-lock-level () (save-excursion (org-back-to-heading t) @@ -2155,16 +2241,16 @@ The following commands are available: (defun org-set-font-lock-defaults () (let ((org-font-lock-extra-keywords (list - '(org-activate-links (0 'org-link)) - '(org-activate-dates (0 'org-link)) - '(org-activate-camels (0 'org-link)) + '(org-activate-links (0 'org-link t)) + '(org-activate-dates (0 'org-link t)) + '(org-activate-camels (0 'org-link t)) + '(org-activate-tags (1 'org-link t)) (list (concat "^\\*+[ \t]*" org-not-done-regexp) '(1 'org-warning t)) (list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t)) -; (list (concat "\\<" org-deadline-string) '(0 'org-warning t)) -; (list (concat "\\<" org-scheduled-string) '(0 'org-warning t)) (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) + (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" ;; (3 'bold)) ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" @@ -2194,7 +2280,7 @@ The following commands are available: ; on XEmacs if noutline is ever ported `((eval . (list "^\\(\\*+\\).*" ,(if org-level-color-stars-only 1 0) - '(nth ;; FIXME: 1<->0 ???? + '(nth (% (- (match-end 1) (match-beginning 1) 1) org-n-levels) org-level-faces) @@ -2885,7 +2971,7 @@ If optional TXT is given, check this string instead of the current kill." (throw 'exit nil))) t)))) -;;; Plain list item +;;; Plain list items (defun org-at-item-p () "Is point in a line starting a hand-formatted item?" @@ -3046,7 +3132,7 @@ with something like \"1.\" or \"2)\"." (col (current-column)) (ind (org-get-string-indentation (buffer-substring (point-at-bol) (match-beginning 3)))) - (term (substring (match-string 3) -1)) + ;; (term (substring (match-string 3) -1)) ind1 (n (1- arg))) ;; find where this list begins (catch 'exit @@ -3111,7 +3197,6 @@ with something like \"1.\" or \"2)\"." (beginning-of-line 2)) (goto-char beg))) - ;;; Archiving (defun org-archive-subtree () @@ -3227,16 +3312,20 @@ At all other locations, this simply calls `ispell-complete-word'." (interactive "P") (catch 'exit (let* ((end (point)) + (beg1 (save-excursion + (if (equal (char-before (point)) ?\ ) (backward-char 1)) + (skip-chars-backward "a-zA-Z_") + (point))) (beg (save-excursion (if (equal (char-before (point)) ?\ ) (backward-char 1)) (skip-chars-backward "a-zA-Z0-9_:$") (point))) (camel (equal (char-before beg) ?*)) + (tag (equal (char-before beg1) ?:)) (texp (equal (char-before beg) ?\\)) (opt (equal (buffer-substring (max (point-at-bol) (- beg 2)) beg) "#+")) - (pattern (buffer-substring-no-properties beg end)) (completion-ignore-case opt) (type nil) (tbl nil) @@ -3262,7 +3351,10 @@ At all other locations, this simply calls `ispell-complete-word'." (push (list (org-make-org-heading-camel (match-string 3))) tbl))) tbl) + (tag (setq type :tag beg beg1) + (org-get-buffer-tags)) (t (progn (ispell-complete-word arg) (throw 'exit nil))))) + (pattern (buffer-substring-no-properties beg end)) (completion (try-completion pattern table))) (cond ((eq completion t) (if (equal type :opt) @@ -3278,9 +3370,9 @@ At all other locations, this simply calls `ispell-complete-word'." (insert completion) (if (get-buffer-window "*Completions*") (delete-window (get-buffer-window "*Completions*"))) - (if (and (eq type :todo) - (assoc completion table)) - (insert " ")) + (if (assoc completion table) + (if (eq type :todo) (insert " ") + (if (eq type :tag) (insert ":")))) (if (and (equal type :opt) (assoc completion table)) (message "%s" (substitute-command-keys "Press \\[org-complete] again to insert example settings")))) @@ -3370,6 +3462,11 @@ prefix arg, switch to that state." (replace-match next t t) (setq org-last-todo-state-is-todo (not (equal state org-done-string))) + (when org-log-done + (if (equal state org-done-string) + (org-log-done) + (if (not this) + (org-log-done t)))) (run-hooks 'org-after-todo-state-change-hook))) ;; Fixup cursor location if close to the keyword (if (and (outline-on-heading-p) @@ -3381,6 +3478,38 @@ prefix arg, switch to that state." (goto-char (or (match-end 2) (match-end 1))) (just-one-space)))) +(defun org-log-done (&optional undone) + "Add a time stamp logging that a TODO entry has been closed. +When UNDONE is non-nil, remove such a time stamg again." + (interactive) + (let (beg end col) + (save-excursion + (org-back-to-heading t) + (setq beg (point)) + (looking-at (concat outline-regexp " *")) + (goto-char (match-end 0)) + (setq col (current-column)) + (outline-next-heading) + (setq end (point)) + (goto-char beg) + (when (re-search-forward (concat + "[\r\n]\\([ \t]*" + (regexp-quote org-closed-string) + " *\\[.*?\\][^\n\r]*[\n\r]?\\)") end t) + (delete-region (match-beginning 1) (match-end 1))) + (unless undone + (org-back-to-heading t) + (skip-chars-forward "^\n\r") + (goto-char (min (1+ (point)) (point-max))) + (when (not (member (char-before) '(?\r ?\n))) + (insert "\n")) + (indent-to col) + (insert org-closed-string " " + (format-time-string + (concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]") + (current-time)) + "\n"))))) + (defun org-show-todo-tree (arg) "Make a compact tree which shows all headlines marked with TODO. The tree will show the lines where the regexp matches, and all higher @@ -3602,7 +3731,9 @@ at the cursor, it will be modified." "Insert an inactive time stamp. An inactive time stamp is enclosed in square brackets instead of angle brackets. It is inactive in the sense that it does not trigger agenda entries, -does not link to the calendar and cannot be changed with the S-cursor keys." +does not link to the calendar and cannot be changed with the S-cursor keys. +So these are more for recording a certain time/date." + ;; FIXME: Would it be better not to ask for a date/time here? (interactive "P") (let ((fmt (if arg (cdr org-time-stamp-formats) (car org-time-stamp-formats))) @@ -3614,6 +3745,7 @@ does not link to the calendar and cannot be changed with the S-cursor keys." (insert (format-time-string fmt time)))) ;;; FIXME: Make the function take "Fri" as "next friday" +;;; because these are mostly being used to record the current time. (defun org-read-date (&optional with-time to-time) "Read a date and make things smooth for the user. The prompt will suggest to enter an ISO date, but you can also enter anything @@ -3750,6 +3882,7 @@ Also, store the cursor date in variable ans2." (let* ((date (calendar-cursor-to-date)) (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) (setq ans2 (format-time-string "%Y-%m-%d" time)))) + (and org-xemacs-p (sit-for .2)) (select-window sw))) (defun org-calendar-select () @@ -4041,10 +4174,13 @@ If there is already a time stamp at the cursor position, update it." (defvar org-agenda-menu) (defvar org-agenda-follow-mode nil) +(defvar org-agenda-show-log nil) (defvar org-agenda-buffer-name "*Org Agenda*") (defvar org-agenda-redo-command nil) (defvar org-agenda-mode-hook nil) +(defvar org-agenda-force-single-file nil) + ;;;###autoload (defun org-agenda-mode () "Mode for time-sorted view on action items in Org-mode files. @@ -4063,14 +4199,21 @@ The following commands are available: (add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local) (make-local-hook 'pre-command-hook) ; Needed for XEmacs (add-hook 'pre-command-hook 'org-unhighlight nil 'local) - (setq org-agenda-follow-mode nil) + (unless org-agenda-keep-modes + (setq org-agenda-follow-mode nil + org-agenda-show-log nil)) (easy-menu-change '("Agenda") "Agenda Files" (append (list - ["Edit File List" (customize-variable 'org-agenda-files) t] + (vector + (if (get 'org-agenda-files 'org-restrict) + "Restricted to single file" + "Edit File List") + '(customize-variable 'org-agenda-files) + (not (get 'org-agenda-files 'org-restrict))) "--") - (mapcar 'org-file-menu-entry org-agenda-files))) + (mapcar 'org-file-menu-entry (org-agenda-files)))) (org-agenda-set-mode-name) (apply (if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks) @@ -4081,7 +4224,7 @@ The following commands are available: (define-key org-agenda-mode-map " " 'org-agenda-show) (define-key org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo) (define-key org-agenda-mode-map "o" 'delete-other-windows) -(define-key org-agenda-mode-map "l" 'org-agenda-recenter) +(define-key org-agenda-mode-map "L" 'org-agenda-recenter) (define-key org-agenda-mode-map "t" 'org-agenda-todo) (define-key org-agenda-mode-map "." 'org-agenda-goto-today) (define-key org-agenda-mode-map "d" 'org-agenda-day-view) @@ -4097,6 +4240,7 @@ The following commands are available: (int-to-string (pop l)) 'digit-argument))) (define-key org-agenda-mode-map "f" 'org-agenda-follow-mode) +(define-key org-agenda-mode-map "l" 'org-agenda-log-mode) (define-key org-agenda-mode-map "D" 'org-agenda-toggle-diary) (define-key org-agenda-mode-map "g" 'org-agenda-toggle-time-grid) (define-key org-agenda-mode-map "r" 'org-agenda-redo) @@ -4162,14 +4306,16 @@ The following commands are available: "--" ["Rebuild buffer" org-agenda-redo t] ["Goto Today" org-agenda-goto-today t] - ["Next Dates" org-agenda-later (local-variable-p 'starting-day)] - ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)] + ["Next Dates" org-agenda-later (local-variable-p 'starting-day (current-buffer))] + ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day (current-buffer))] "--" - ["Day View" org-agenda-day-view :active (local-variable-p 'starting-day) + ["Day View" org-agenda-day-view :active (local-variable-p 'starting-day (current-buffer)) :style radio :selected (equal org-agenda-ndays 1)] - ["Week View" org-agenda-week-view :active (local-variable-p 'starting-day) + ["Week View" org-agenda-week-view :active (local-variable-p 'starting-day (current-buffer)) :style radio :selected (equal org-agenda-ndays 7)] "--" + ["Show Logbook entries" org-agenda-log-mode + :style toggle :selected org-agenda-show-log :active t] ["Include Diary" org-agenda-toggle-diary :style toggle :selected org-agenda-include-diary :active t] ["Use Time Grid" org-agenda-toggle-time-grid @@ -4188,6 +4334,63 @@ The following commands are available: ["Exit and Release Buffers" org-agenda-exit t] )) +;;;###autoload +(defun org-agenda (arg) + "Dispatch agenda commands to collect entries to the agenda buffer. +Prompts for a character to select a command. Any prefix arg will be passed +on to the selected command. Possible selections are: + +a Call `org-agenda' to display the agenda for the current day or week. +t Call `org-todo-list' to display the global todo list. +T Call `org-todo-list' to display the global todo list, put + select only entries with a specific TODO keyword. +m Call `org-tags-view' to display headlines with tags matching + a condition. The tags condition is a list of positive and negative + selections, like `+WORK+URGENT-WITHBOSS'. +M like `m', but select only TODO entries, no ordinary headlines. + +If the current buffer is in Org-mode and visiting a file, you can also +first press `1' to indicate that the agenda should be temporarily +restricted to the current file." + (interactive "P") + (let ((restrict-ok (and (buffer-file-name) (eq major-mode 'org-mode))) + c) + (put 'org-agenda-files 'org-restrict nil) + (message"[a]genda [t]odoList [T]odoKwd [m]atchTags [M]atchTagsTodo%s" + (if restrict-ok " [1]JustThisFile" "")) + (setq c (read-char-exclusive)) + (message "") + (when (equal c ?1) + (if restrict-ok + (put 'org-agenda-files 'org-restrict (list (buffer-file-name))) + (error "Cannot restrict agenda to current buffer")) + (message "Single file: [a]genda [t]odoList [T]odoKwd [m]atchTags [M]atchTagsTodo") + (setq c (read-char-exclusive)) + (message "")) + (cond + ((equal c ?a) (call-interactively 'org-agenda-list)) + ((equal c ?t) (call-interactively 'org-todo-list)) + ((equal c ?T) + (setq current-prefix-arg (or arg '(4))) + (call-interactively 'org-todo-list)) + ((equal c ?m) (call-interactively 'org-tags-view)) + ((equal c ?M) + (setq current-prefix-arg (or arg '(4))) + (call-interactively 'org-tags-view)) + (t (error "Invalid key"))))) + +(defun org-fit-agenda-window () + "Fit the window to the buffer size." + (and org-fit-agenda-window + (fboundp 'fit-window-to-buffer) + (fit-window-to-buffer nil (/ (* (frame-height) 3) 4) + (/ (frame-height) 2)))) + +(defun org-agenda-files () + "Get the list of agenda files." + (or (get 'org-agenda-files 'org-restrict) + org-agenda-files)) + (defvar org-agenda-markers nil "List of all currently active markers created by `org-agenda'.") (defvar org-agenda-last-marker-time (time-to-seconds (current-time)) @@ -4240,11 +4443,10 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (defvar org-respect-restriction nil) ; Dynamically-scoped param. -(defun org-timeline (&optional include-all) +(defun org-timeline (&optional include-all keep-modes) "Show a time-sorted view of the entries in the current org file. Only entries with a time stamp of today or later will be listed. With -one \\[universal-argument] prefix argument, past entries will also be listed. -With two \\[universal-argument] prefixes, all unfinished TODO items will also be shown, +\\[universal-argument] prefix, all unfinished TODO items will also be shown, under the current date. If the buffer contains an active region, only check the region for dates." @@ -4252,8 +4454,10 @@ dates." (require 'calendar) (org-agenda-maybe-reset-markers 'force) (org-compile-prefix-format org-timeline-prefix-format) - (let* ((dopast include-all) - (dotodo (equal include-all '(16))) + (let* ((dopast t) + (dotodo include-all) + (doclosed org-agenda-show-log) + (org-agenda-keep-modes keep-modes) (entry (buffer-file-name)) (org-agenda-files (list (buffer-file-name))) (date (calendar-current-date)) @@ -4262,15 +4466,16 @@ dates." (beg (if (org-region-active-p) (region-beginning) (point-min))) (end (if (org-region-active-p) (region-end) (point-max))) (day-numbers (org-get-all-dates beg end 'no-ranges - t)) ; always include today + t doclosed)) ; always include today (today (time-to-days (current-time))) (org-respect-restriction t) (past t) + args s e rtn d) (setq org-agenda-redo-command (list 'progn (list 'switch-to-buffer-other-window (current-buffer)) - (list 'org-timeline (list 'quote include-all)))) + (list 'org-timeline (list 'quote include-all) t))) (if (not dopast) ;; Remove past dates from the list of dates. (setq day-numbers (delq nil (mapcar (lambda(x) @@ -4281,6 +4486,9 @@ dates." (setq buffer-read-only nil) (erase-buffer) (org-agenda-mode) (setq buffer-read-only nil) + (if doclosed (push :closed args)) + (push :timestamp args) + (if dotodo (push :todo args)) (while (setq d (pop day-numbers)) (if (and (>= d today) dopast @@ -4290,10 +4498,8 @@ dates." (insert (make-string 79 ?-) "\n"))) (setq date (calendar-gregorian-from-absolute d)) (setq s (point)) - (if dotodo - (setq rtn (org-agenda-get-day-entries - entry date :todo :timestamp)) - (setq rtn (org-agenda-get-day-entries entry date :timestamp))) + (setq rtn (apply 'org-agenda-get-day-entries + entry date args)) (if (or rtn (equal d today)) (progn (insert (calendar-day-name date) " " @@ -4315,12 +4521,15 @@ dates." (goto-char pos1)))) ;;;###autoload -(defun org-agenda (&optional include-all start-day ndays) +(defun org-agenda-list (&optional include-all start-day ndays keep-modes) "Produce a weekly view from all files in variable `org-agenda-files'. The view will be for the current week, but from the overview buffer you will be able to go to other weeks. With one \\[universal-argument] prefix argument INCLUDE-ALL, all unfinished TODO items will also be shown, under the current date. +With two \\[universal-argument] prefix argument INCLUDE-ALL, all TODO entries marked DONE +on the days are also shown. See the variable `org-log-done' for how +to turn on logging. START-DAY defaults to TODAY, or to the most recent match for the weekday given in `org-agenda-start-on-weekday'. NDAYS defaults to `org-agenda-ndays'." @@ -4332,7 +4541,8 @@ NDAYS defaults to `org-agenda-ndays'." (if (or (equal ndays 1) (and (null ndays) (equal 1 org-agenda-ndays))) nil org-agenda-start-on-weekday)) - (files (copy-sequence org-agenda-files)) + (org-agenda-keep-modes keep-modes) + (files (copy-sequence (org-agenda-files))) (win (selected-window)) (today (time-to-days (current-time))) (sd (or start-day today)) @@ -4348,7 +4558,7 @@ NDAYS defaults to `org-agenda-ndays'." (inhibit-redisplay t) s e rtn rtnall file date d start-pos end-pos todayp nd) (setq org-agenda-redo-command - (list 'org-agenda (list 'quote include-all) start-day ndays)) + (list 'org-agenda-list (list 'quote include-all) start-day ndays t)) ;; Make the list of days (setq ndays (or ndays org-agenda-ndays) nd ndays) @@ -4368,7 +4578,7 @@ NDAYS defaults to `org-agenda-ndays'." (set (make-local-variable 'include-all-loc) include-all) (when (and (or include-all org-agenda-include-all-todo) (member today day-numbers)) - (setq files org-agenda-files + (setq files (org-agenda-files) rtnall nil) (while (setq file (pop files)) (catch 'nextfile @@ -4390,12 +4600,18 @@ NDAYS defaults to `org-agenda-ndays'." (setq start-pos (point)) (if (and start-pos (not end-pos)) (setq end-pos (point)))) - (setq files org-agenda-files + (setq files (org-agenda-files) rtnall nil) (while (setq file (pop files)) (catch 'nextfile (org-check-agenda-file file) - (setq rtn (org-agenda-get-day-entries file date)) + (if org-agenda-show-log + (setq rtn (org-agenda-get-day-entries + file date + :deadline :scheduled :timestamp :closed)) + (setq rtn (org-agenda-get-day-entries + file date + :deadline :scheduled :timestamp))) (setq rtnall (append rtnall rtn)))) (if org-agenda-include-diary (progn @@ -4419,9 +4635,7 @@ NDAYS defaults to `org-agenda-ndays'." (put-text-property s (1- (point)) 'day d)))) (goto-char (point-min)) (setq buffer-read-only t) - (if org-fit-agenda-window - (fit-window-to-buffer nil (/ (* (frame-height) 3) 4) - (/ (frame-height) 2))) + (org-fit-agenda-window) (unless (and (pos-visible-in-window-p (point-min)) (pos-visible-in-window-p (point-max))) (goto-char (1- (point-max))) @@ -4437,7 +4651,7 @@ NDAYS defaults to `org-agenda-ndays'." (defvar org-select-this-todo-keyword nil) ;;;###autoload -(defun org-todo-list (arg) +(defun org-todo-list (arg &optional keep-modes) "Show all TODO entries from all agenda file in a single list. The prefix arg can be used to select a specific TODO keyword and limit the list to these. When using \\[universal-argument], you will be prompted @@ -4446,7 +4660,8 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (interactive "P") (org-agenda-maybe-reset-markers 'force) (org-compile-prefix-format org-agenda-prefix-format) - (let* ((today (time-to-days (current-time))) + (let* ((org-agenda-keep-modes keep-modes) + (today (time-to-days (current-time))) (date (calendar-gregorian-from-absolute today)) (win (selected-window)) (kwds org-todo-keywords) @@ -4470,8 +4685,8 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (set (make-local-variable 'last-arg) arg) (set (make-local-variable 'org-todo-keywords) kwds) (set (make-local-variable 'org-agenda-redo-command) - '(org-todo-list (or current-prefix-arg last-arg))) - (setq files org-agenda-files + '(org-todo-list (or current-prefix-arg last-arg) t)) + (setq files (org-agenda-files) rtnall nil) (while (setq file (pop files)) (catch 'nextfile @@ -4484,13 +4699,20 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (setq pos (point)) (insert (or org-select-this-todo-keyword "ALL") "\n") (add-text-properties pos (1- (point)) (list 'face 'org-warning)) + (setq pos (point)) + (insert + "Available with `N r': (0)ALL " + (let ((n 0)) + (mapconcat (lambda (x) + (format "(%d)%s" (setq n (1+ n)) x)) + org-todo-keywords " ")) + "\n") + (add-text-properties pos (1- (point)) (list 'face 'org-link)) (when rtnall (insert (org-finalize-agenda-entries rtnall) "\n")) (goto-char (point-min)) (setq buffer-read-only t) - (if org-fit-agenda-window - (fit-window-to-buffer nil (/ (* (frame-height) 3) 4) - (/ (frame-height) 2))) + (org-fit-agenda-window) (if (not org-select-agenda-window) (select-window win)))) (defun org-check-agenda-file (file) @@ -4536,8 +4758,9 @@ When this is the global TODO list, a prefix argument will be interpreted." (if (boundp 'starting-day) (let ((cmd (car org-agenda-redo-command)) (iall (nth 1 org-agenda-redo-command)) - (nday (nth 3 org-agenda-redo-command))) - (eval (list cmd iall nil nday))) + (nday (nth 3 org-agenda-redo-command)) + (keep (nth 4 org-agenda-redo-command))) + (eval (list cmd iall nil nday keep))) (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) (point-min))))) @@ -4547,8 +4770,8 @@ With prefix ARG, go forward that many times `org-agenda-ndays'." (interactive "p") (unless (boundp 'starting-day) (error "Not allowed")) - (org-agenda (if (boundp 'include-all-loc) include-all-loc nil) - (+ starting-day (* arg org-agenda-ndays)))) + (org-agenda-list (if (boundp 'include-all-loc) include-all-loc nil) + (+ starting-day (* arg org-agenda-ndays)) nil t)) (defun org-agenda-earlier (arg) "Go back in time by `org-agenda-ndays' days. @@ -4556,8 +4779,8 @@ With prefix ARG, go back that many times `org-agenda-ndays'." (interactive "p") (unless (boundp 'starting-day) (error "Not allowed")) - (org-agenda (if (boundp 'include-all-loc) include-all-loc nil) - (- starting-day (* arg org-agenda-ndays)))) + (org-agenda-list (if (boundp 'include-all-loc) include-all-loc nil) + (- starting-day (* arg org-agenda-ndays)) nil t)) (defun org-agenda-week-view () "Switch to weekly view for agenda." @@ -4565,9 +4788,10 @@ With prefix ARG, go back that many times `org-agenda-ndays'." (unless (boundp 'starting-day) (error "Not allowed")) (setq org-agenda-ndays 7) - (org-agenda include-all-loc - (or (get-text-property (point) 'day) - starting-day)) + (org-agenda-list include-all-loc + (or (get-text-property (point) 'day) + starting-day) + nil t) (org-agenda-set-mode-name) (message "Switched to week view")) @@ -4577,9 +4801,10 @@ With prefix ARG, go back that many times `org-agenda-ndays'." (unless (boundp 'starting-day) (error "Not allowed")) (setq org-agenda-ndays 1) - (org-agenda include-all-loc - (or (get-text-property (point) 'day) - starting-day)) + (org-agenda-list include-all-loc + (or (get-text-property (point) 'day) + starting-day) + nil t) (org-agenda-set-mode-name) (message "Switched to day view")) @@ -4624,6 +4849,15 @@ With prefix ARG, go back that many times `org-agenda-ndays'." (message "Follow mode is %s" (if org-agenda-follow-mode "on" "off"))) +(defun org-agenda-log-mode () + "Toggle follow mode in an agenda buffer." + (interactive) + (setq org-agenda-show-log (not org-agenda-show-log)) + (org-agenda-set-mode-name) + (org-agenda-redo) + (message "Log mode is %s" + (if org-agenda-show-log "on" "off"))) + (defun org-agenda-toggle-diary () "Toggle follow mode in an agenda buffer." (interactive) @@ -4650,7 +4884,8 @@ With prefix ARG, go back that many times `org-agenda-ndays'." (if (equal org-agenda-ndays 7) " Week" "") (if org-agenda-follow-mode " Follow" "") (if org-agenda-include-diary " Diary" "") - (if org-agenda-use-time-grid " Grid" ""))) + (if org-agenda-use-time-grid " Grid" "") + (if org-agenda-show-log " Log" ""))) (force-mode-line-update)) (defun org-agenda-post-command-hook () @@ -4834,21 +5069,23 @@ Optional argument FILE means, use this file instead of the current." (defun org-file-menu-entry (file) (vector file (list 'find-file file) t)) -;; FIXME: Maybe removed a buffer visited through the menu from +;; FIXME: Maybe we removed a buffer visited through the menu from ;; org-agenda-new-buffers, so that the buffer will not be removed ;; when exiting the agenda???? -(defun org-get-all-dates (beg end &optional no-ranges force-today) +(defun org-get-all-dates (beg end &optional no-ranges force-today inactive) "Return a list of all relevant day numbers from BEG to END buffer positions. If NO-RANGES is non-nil, include only the start and end dates of a range, not every single day in the range. If FORCE-TODAY is non-nil, make -sure that TODAY is included in the list." - (let (dates date day day1 day2 ts1 ts2) +sure that TODAY is included in the list. If INACTIVE is non-nil, also +inactive time stamps (those in square brackets) are included." + (let ((re (if inactive org-ts-regexp-both org-ts-regexp)) + dates date day day1 day2 ts1 ts2) (if force-today (setq dates (list (time-to-days (current-time))))) (save-excursion (goto-char beg) - (while (re-search-forward org-ts-regexp end t) + (while (re-search-forward re end t) (setq day (time-to-days (org-time-string-to-time (substring (match-string 1) 0 10)))) (or (memq day dates) (push day dates))) @@ -4931,16 +5168,24 @@ function from a program - use `org-agenda-get-day-entries' instead." (while (re-search-forward "\\(^\\|\r\\)#\\+CATEGORY:[ \t]*\\(.*\\)" nil t) (push (cons (point) (org-trim (match-string 2))) tbl))) tbl)) - (defun org-get-category (&optional pos) - "Get the category applying to position POS." - (if (not org-category-table) - org-category - (let ((tbl org-category-table) - (pos (or pos (point)))) - (while (and tbl (> (caar tbl) pos)) - (pop tbl)) - (or (cdar tbl) (cdr (nth (1- (length org-category-table)) - org-category-table)))))) +(defun org-get-category (&optional pos) + "Get the category applying to position POS." + (if (not org-category-table) + (cond + ((null org-category) + (setq org-category + (if (buffer-file-name) + (file-name-sans-extension + (file-name-nondirectory (buffer-file-name))) + "???"))) + ((symbolp org-category) (symbol-name org-category)) + (t org-category)) + (let ((tbl org-category-table) + (pos (or pos (point)))) + (while (and tbl (> (caar tbl) pos)) + (pop tbl)) + (or (cdar tbl) (cdr (nth (1- (length org-category-table)) + org-category-table)))))) (defun org-agenda-get-day-entries (file date &rest args) "Does the work for `org-diary' and `org-agenda'. @@ -4987,6 +5232,9 @@ the documentation of `org-diary'." ((eq arg :scheduled) (setq rtn (org-agenda-get-scheduled)) (setq results (append results rtn))) + ((eq arg :closed) + (setq rtn (org-agenda-get-closed)) + (setq results (append results rtn))) ((and (eq arg :deadline) (equal date (calendar-current-date))) (setq rtn (org-agenda-get-deadlines)) @@ -5117,6 +5365,7 @@ the documentation of `org-diary'." (if donep 'org-done 'org-warning) 'undone-face 'org-warning 'done-face 'org-done + 'category category 'priority (+ 100 priority)) txt) (if scheduledp @@ -5125,6 +5374,7 @@ the documentation of `org-diary'." (list 'face 'org-scheduled-today 'undone-face 'org-scheduled-today 'done-face 'org-done + 'category category priority (+ 99 priority)) txt) (add-text-properties @@ -5134,6 +5384,60 @@ the documentation of `org-diary'." (outline-next-heading)))) (nreverse ee))) +(defun org-agenda-get-closed () + "Return the loggedd TODO entries for agenda display." + (let* ((props (list 'mouse-face 'highlight + 'keymap org-agenda-keymap + 'help-echo + (format "mouse-2 or RET jump to org file %s" + (abbreviate-file-name (buffer-file-name))))) + (regexp (concat + "\\<" org-closed-string " *\\[" + (regexp-quote + (substring + (format-time-string + (car org-time-stamp-formats) + (apply 'encode-time ; DATE bound by calendar + (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) + 1 11)))) + marker hdmarker priority category + ee txt timestr) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (if (not (save-match-data (org-at-date-range-p))) + (progn + (setq marker (org-agenda-new-marker (match-beginning 0)) + category (org-get-category (match-beginning 0)) + timestr (buffer-substring (match-beginning 0) (point-at-eol)) + ;; donep (org-entry-is-done-p) + ) + (if (string-match "\\]" timestr) + ;; substring should only run to end of time stamp + (setq timestr (substring timestr 0 (match-end 0)))) + (save-excursion + (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) + (progn + (goto-char (match-end 1)) + (setq hdmarker (org-agenda-new-marker)) + (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") + (setq txt (org-format-agenda-item + "Closed: " + (match-string 1) category timestr))) + (setq txt org-agenda-no-heading-message)) + (setq priority 100000) + (add-text-properties + 0 (length txt) (append (list 'org-marker marker + 'org-hd-marker hdmarker + 'face 'org-done + 'priority priority + 'category category + 'undone-face 'org-warning + 'done-face 'org-done) props) + txt) + (push txt ee)) + (outline-next-heading)))) + (nreverse ee))) + (defun org-agenda-get-deadlines () "Return the deadline information for agenda display." (let* ((wdays org-deadline-warning-days) @@ -5411,7 +5715,7 @@ only the correctly processes TXT should be returned - this is used by (unless (and remove (member time have)) (setq time (int-to-string time)) (push (org-format-agenda-item - nil string "" ;; FIXME: put a category? + nil string "" ;; FIXME: put a category for the grid? (concat (substring time 0 -2) ":" (substring time -2))) new) (put-text-property @@ -5849,8 +6153,9 @@ argument, latitude and longitude will be prompted for." "Compute the Org-mode agenda for the calendar date displayed at the cursor. This is a command that has to be installed in `calendar-mode-map'." (interactive) - (org-agenda nil (calendar-absolute-from-gregorian - (calendar-cursor-to-date)))) + (org-agenda-list nil (calendar-absolute-from-gregorian + (calendar-cursor-to-date)) + nil t)) (defun org-agenda-convert-date () (interactive) @@ -5878,6 +6183,259 @@ This is a command that has to be installed in `calendar-mode-map'." (princ s)) (fit-window-to-buffer (get-buffer-window "*Dates*")))) +;;; Tags + +(defun org-scan-tags (action matcher &optional todo-only) + "Scan headline tags with inheritance and produce output ACTION. +ACTION can be `sparse-tree' or `agenda'. MATCHER is a Lisp form to be +evaluated, testing if a given set of tags qualifies a headline for +inclusion. When TODO-ONLY is non-nil, only lines with a TDOD keyword +d are included in the output." + (let* ((re (concat "[\n\r]" outline-regexp " *\\(\\<\\(" + (mapconcat 'regexp-quote + (nreverse (cdr (reverse org-todo-keywords))) + "\\|") + "\\>\\)\\)? *\\(.*?\\)\\(:[A-Za-z_:]+:\\)?[ \t]*[\n\r]")) + (props (list 'face nil + 'done-face 'org-done + 'undone-face nil + 'mouse-face 'highlight + 'keymap org-agenda-keymap + 'help-echo + (format "mouse-2 or RET jump to org file %s" + (abbreviate-file-name (buffer-file-name))))) + tags tags-list tags-alist (llast 0) rtn level category i txt + todo marker) + + (save-excursion + (goto-char (point-min)) + (when (eq action 'sparse-tree) (hide-sublevels 1)) + (while (re-search-forward re nil t) + (setq todo (if (match-end 1) (match-string 2)) + tags (if (match-end 4) (match-string 4))) + (goto-char (1+ (match-beginning 0))) + (setq level (outline-level) + category (org-get-category)) + (setq i llast llast level) + ;; remove tag lists from same and sublevels + (while (>= i level) + (when (setq entry (assoc i tags-alist)) + (setq tags-alist (delete entry tags-alist))) + (setq i (1- i))) + ;; add the nex tags + (when tags + (setq tags (mapcar 'downcase (org-split-string tags ":")) + tags-alist + (cons (cons level tags) tags-alist))) + ;; compile tags for current headline + (setq tags-list + (if org-use-tag-inheritance + (apply 'append (mapcar 'cdr tags-alist)) + tags)) + (when (and (or (not todo-only) todo) + (eval matcher)) + ;; list this headline + (if (eq action 'sparse-tree) + (progn + (org-show-hierarchy-above)) + (setq txt (org-format-agenda-item + "" + (concat + (if org-tags-match-list-sublevels + (make-string (1- level) ?.) "") + (org-get-heading)) + category)) + (setq marker (org-agenda-new-marker)) + (add-text-properties + 0 (length txt) + (append (list 'org-marker marker 'org-hd-marker marker + 'category category) + props) + txt) + (push txt rtn)) + ;; if we are to skip sublevels, jump to end of subtree + (or org-tags-match-list-sublevels (outline-end-of-subtree))))) + (nreverse rtn))) + +(defun org-tags-sparse-tree (&optional arg match) + "Create a sparse tree according to tags search string MATCH. +MATCH can contain positive and negative selection of tags, like +\"+WORK+URGENT-WITHBOSS\"." + (interactive "P") + (let ((org-show-following-heading nil) + (org-show-hierarchy-above nil)) + (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match))))) + +(defun org-make-tags-matcher (match) + "Create the TAGS matcher form for the tags-selecting string MATCH." + (unless match + (setq org-last-tags-completion-table + (or (org-get-buffer-tags) + org-last-tags-completion-table)) + (setq match (completing-read + "Tags: " 'org-tags-completion-function nil nil nil + 'org-tags-history))) + (let ((match0 match) minus tag mm matcher) + (while (string-match "^\\([-+:]\\)?\\([A-Za-z_]+\\)" match) + (setq minus (and (match-end 1) (equal (string-to-char match) ?-)) + tag (match-string 2 match) + match (substring match (match-end 0)) + mm (list 'member (downcase tag) 'tags-list) + mm (if minus (list 'not mm) mm)) + (push mm matcher)) + (cons match0 (cons 'and matcher)))) + +;;;###autoload +(defun org-tags-view (&optional todo-only match keep-modes) + "Show all headlines for all `org-agenda-files' matching a TAGS criterions. +The prefix arg TODO-ONLY limits the search to TODO entries." + (interactive "P") + (org-agenda-maybe-reset-markers 'force) + (org-compile-prefix-format org-agenda-prefix-format) + (let* ((org-agenda-keep-modes keep-modes) + (win (selected-window)) + (completion-ignore-case t) + rtn rtnall files file pos matcher + buffer) + (setq matcher (org-make-tags-matcher match) + match (car matcher) matcher (cdr matcher)) + (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name))) + (progn + (delete-other-windows) + (switch-to-buffer-other-window + (get-buffer-create org-agenda-buffer-name)))) + (setq buffer-read-only nil) + (erase-buffer) + (org-agenda-mode) (setq buffer-read-only nil) + (set (make-local-variable 'org-agenda-redo-command) + '(call-interactively 'org-tags-view)) + (setq files (org-agenda-files) + rtnall nil) + (while (setq file (pop files)) + (catch 'nextfile + (org-check-agenda-file file) + (setq buffer (if (file-exists-p file) + (org-get-agenda-file-buffer file) + (error "No such file %s" file))) + (if (not buffer) + ;; If file does not exist, merror message to agenda + (setq rtn (list + (format "ORG-AGENDA-ERROR: No such org-file %s" file)) + rtnall (append rtnall rtn)) + (with-current-buffer buffer + (unless (eq major-mode 'org-mode) + (error "Agenda file %s is not in `org-mode'" file)) + (save-excursion + (save-restriction + (if org-respect-restriction + (if (org-region-active-p) + ;; Respect a region to restrict search + (narrow-to-region (region-beginning) (region-end))) + ;; If we work for the calendar or many files, + ;; get rid of any restriction + (widen)) + (setq rtn (org-scan-tags 'agenda matcher todo-only)) + (setq rtnall (append rtnall rtn)))))))) + (insert "Headlines with TAGS match: ") + (add-text-properties (point-min) (1- (point)) + (list 'face 'org-link)) + (setq pos (point)) + (insert match "\n") + (add-text-properties pos (1- (point)) (list 'face 'org-warning)) + (when rtnall + (insert (mapconcat 'identity rtnall "\n"))) + (goto-char (point-min)) + (setq buffer-read-only t) + (org-fit-agenda-window) + (if (not org-select-agenda-window) (select-window win)))) + +(defvar org-add-colon-after-tag-completion nil) ;; dynamically skoped param +(defun org-set-tags (&optional arg just-align) + "Set the tags for the current headline. +With prefix ARG, realign all tags in headings in the current buffer." + (interactive) + (let* (;(inherit (org-get-inherited-tags)) + (re (concat "^" outline-regexp)) + (col (current-column)) + (current (org-get-tags)) + tags hd) + (if arg + (save-excursion + (goto-char (point-min)) + (while (re-search-forward re nil t) + (org-set-tags nil t)) + (message "All tags realigned to column %d" org-tags-column)) + (if just-align + (setq tags current) + (setq org-last-tags-completion-table + (or (org-get-buffer-tags);; FIXME: replace +- with :, so that we can use history stuff??? + org-last-tags-completion-table)) + (setq tags + (let ((org-add-colon-after-tag-completion t)) + (completing-read "Tags: " 'org-tags-completion-function + nil nil current 'org-tags-history))) + (while (string-match "[-+]" tags) + (setq tags (replace-match ":" t t tags))) + (unless (string-match ":$" tags) (setq tags (concat tags ":"))) + (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) + (beginning-of-line 1) + (looking-at (concat "\\(.*\\)\\(" (regexp-quote current) "\\)[ \t]*")) + (setq hd (save-match-data (org-trim (match-string 1)))) + (delete-region (match-beginning 0) (match-end 0)) + (insert hd " ") + (move-to-column (max (current-column) + (if (> org-tags-column 0) + org-tags-column + (- org-tags-column (length tags)))) + t) + (insert tags) + (move-to-column col)))) + +(defun org-tags-completion-function (string predicate &optional flag) + (let (s1 s2 rtn (ctable org-last-tags-completion-table)) + (if (string-match "^\\(.*[-+:]\\)\\([^-+:]*\\)$" string) + (setq s1 (match-string 1 string) + s2 (match-string 2 string)) + (setq s1 "" s2 string)) + (cond + ((eq flag nil) + ;; try completion + (setq rtn (try-completion s2 ctable)) + (if (stringp rtn) + (concat s1 s2 (substring rtn (length s2)) + (if (and org-add-colon-after-tag-completion + (assoc rtn ctable)) + ":" ""))) + ) + ((eq flag t) + ;; all-completions + (all-completions s2 ctable) + ) + ((eq flag 'lambda) + ;; exact match? + (assoc s2 ctable))) + )) + +(defun org-get-tags () + "Get the TAGS string in the current headline." + (unless (org-on-heading-p) + (error "Not on a heading")) + (save-excursion + (beginning-of-line 1) + (if (looking-at ".*[ \t]\\(:[A-Za-z_:]+:\\)[ \t]*\\(\r\\|$\\)") + (match-string 1) + ""))) + +(defun org-get-buffer-tags () + "Get a table of all tags used in the buffer, for completion." + (let (tags) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "[ \t]:\\([A-Za-z_:]+\\):[ \t\r\n]" nil t) + (mapc (lambda (x) (add-to-list 'tags x)) + (org-split-string (match-string-no-properties 1) ":")))) + (mapcar 'list tags))) + ;;; Link Stuff (defun org-find-file-at-mouse (ev) @@ -5901,9 +6459,9 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file." (interactive "P") (org-remove-occur-highlights nil nil t) (if (org-at-timestamp-p) - (org-agenda nil (time-to-days (org-time-string-to-time - (substring (match-string 1) 0 10))) - 1) + (org-agenda-list nil (time-to-days (org-time-string-to-time + (substring (match-string 1) 0 10))) + 1) (let (type path line search (pos (point))) (catch 'match (save-excursion @@ -5915,6 +6473,14 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file." path (match-string 2)) (throw 'match t))) (save-excursion + (skip-chars-backward "^ \t\n\r") + (when (looking-at "\\(:[A-Za-z_:]+\\):[ \t\r\n]") + (setq type "tags" + path (match-string 1)) + (while (string-match ":" path) + (setq path (replace-match "+" t t path))) + (throw 'match t))) + (save-excursion (skip-chars-backward "a-zA-Z_") (when (looking-at org-camel-regexp) (setq type "camel" path (match-string 0)) @@ -5939,6 +6505,8 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file." (cond + ((string= type "tags") + (org-tags-view path in-emacs)) ((string= type "camel") (org-link-search path @@ -10390,7 +10958,7 @@ When COMBINE is non nil, add the category to each line." (dts (org-ical-ts-to-string (format-time-string (cdr org-time-stamp-formats) (current-time)) "DTSTART")) - hd ts ts2 state (inc t) pos scheduledp deadlinep donep tmp pri) + hd ts ts2 state (inc t) pos scheduledp deadlinep tmp pri) (save-excursion (goto-char (point-min)) (while (re-search-forward org-ts-regexp nil t) @@ -10408,7 +10976,8 @@ When COMBINE is non nil, add the category to each line." pos) deadlinep (string-match org-deadline-regexp tmp) scheduledp (string-match org-scheduled-regexp tmp) - donep (org-entry-is-done-p))) + ;; donep (org-entry-is-done-p) + )) (if (or (string-match org-tr-regexp hd) (string-match org-ts-regexp hd)) (setq hd (replace-match "" t t hd))) @@ -10449,9 +11018,8 @@ END:VTODO\n" (defun org-start-icalendar-file (name) "Start an iCalendar file by inserting the header." (let ((user user-full-name) - (calname "something") (name (or name "unknown")) - (timezone "Europe/Amsterdam")) ;; FIXME: How can I get the real timezone? + (timezone (cadr (current-time-zone)))) (princ (format "BEGIN:VCALENDAR VERSION:2.0 @@ -10553,6 +11121,7 @@ a time), or the day by one (if it does not contain a time)." (define-key org-mode-map "\C-c\C-v" 'org-show-todo-tree) (define-key org-mode-map "\C-c\C-w" 'org-check-deadlines) (define-key org-mode-map "\C-c/" 'org-occur) ; Minor-mode reserved +(define-key org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res. (define-key org-mode-map "\C-c\C-m" 'org-insert-heading) (define-key org-mode-map "\M-\C-m" 'org-insert-heading) (define-key org-mode-map "\C-c\C-l" 'org-insert-link) @@ -10853,6 +11422,7 @@ See the individual commands for more information." (org-table-paste-rectangle) (org-paste-subtree arg))) +;; FIXME: document tags (defun org-ctrl-c-ctrl-c (&optional arg) "Call realign table, or recognize a table.el table, or update keywords. When the cursor is inside a table created by the table.el package, @@ -10865,6 +11435,7 @@ If the cursor is on a #+TBLFM line, re-apply the formulae to the table." (interactive "P") (let ((org-enable-table-editor t)) (cond + ((org-on-heading-p) (org-set-tags arg)) ((org-at-table.el-p) (require 'table) (beginning-of-line 1) @@ -11039,12 +11610,18 @@ See the individual commands for more information." ["Goto Calendar" org-goto-calendar t] ["Date from Calendar" org-date-from-calendar t]) "--" - ("Timeline/Agenda" - ["Show TODO Tree this File" org-show-todo-tree t] - ["Check Deadlines this File" org-check-deadlines t] - ["Timeline Current File" org-timeline t] + ("Agenda/Summary Views" + "Current File" + ["TODO Tree" org-show-todo-tree t] + ["Check Deadlines" org-check-deadlines t] + ["Timeline" org-timeline t] + ["Tags Tree" org-tags-sparse-tree t] "--" - ["Agenda" org-agenda t]) + "All Agenda Files" + ["Command Dispatcher" org-agenda t] + ["TODO list" org-todo-list t] + ["Agenda" org-agenda-list t] + ["Tags View" org-tags-view t]) ("File List for Agenda") "--" ("Hyperlinks" @@ -11435,3 +12012,4 @@ Show the heading too, if it is currently invisible." ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd ;;; org.el ends here + diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el index d46d2f81fd4..15a15eb37fb 100644 --- a/lisp/textmodes/texinfmt.el +++ b/lisp/textmodes/texinfmt.el @@ -212,6 +212,8 @@ converted to Info is stored in a temporary buffer." ;;; Find a buffer to use. (switch-to-buffer (get-buffer-create texinfo-region-buffer-name)) + (setq buffer-read-only t) + (let ((inhibit-read-only t)) (erase-buffer) ;; Insert the header into the buffer. (insert header-text) @@ -313,7 +315,7 @@ converted to Info is stored in a temporary buffer." (goto-char (point-min)) (Info-tagify input-buffer) (goto-char (point-min)) - (message "Done."))) + (message "Done.")))) ;;;###autoload (defun texi2info (&optional nosplit) diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 451ca389013..8f609601822 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -71,26 +71,22 @@ With ARG, turn tooltip mode on if and only if ARG is positive." (defcustom tooltip-delay 0.7 "Seconds to wait before displaying a tooltip the first time." - :tag "Delay" :type 'number :group 'tooltip) (defcustom tooltip-short-delay 0.1 "Seconds to wait between subsequent tooltips on different items." - :tag "Short delay" :type 'number :group 'tooltip) (defcustom tooltip-recent-seconds 1 "Display tooltips if changing tip items within this many seconds. Do so after `tooltip-short-delay'." - :tag "Recent seconds" :type 'number :group 'tooltip) (defcustom tooltip-hide-delay 10 "Hide tooltips automatically after this many seconds." - :tag "Hide delay" :type 'number :group 'tooltip) @@ -102,11 +98,10 @@ when it pops up. If `tooltip-frame-parameters' includes the `left' parameter, the value of `tooltip-x-offset' is ignored." - :tag "X offset" :type 'integer :group 'tooltip) -(defcustom tooltip-y-offset +40 +(defcustom tooltip-y-offset +20 "Y offset, in pixels, for the display of tooltips. The offset is relative to the position of the mouse. It must be chosen so that the tooltip window doesn't contain the mouse @@ -114,7 +109,6 @@ when it pops up. If `tooltip-frame-parameters' includes the `top' parameter, the value of `tooltip-y-offset' is ignored." - :tag "Y offset" :type 'integer :group 'tooltip) @@ -127,7 +121,6 @@ the value of `tooltip-y-offset' is ignored." If `left' or `top' parameters are included, they specify the absolute position to pop up the tooltip." :type 'sexp - :tag "Frame Parameters" :group 'tooltip) (defface tooltip @@ -144,7 +137,6 @@ position to pop up the tooltip." (defcustom tooltip-use-echo-area nil "Use the echo area instead of tooltip frames for help and GUD tooltips." :type 'boolean - :tag "Use echo area" :group 'tooltip) diff --git a/lisp/vc-mcvs.el b/lisp/vc-mcvs.el index b52bc797dda..4394dd510f5 100644 --- a/lisp/vc-mcvs.el +++ b/lisp/vc-mcvs.el @@ -350,7 +350,7 @@ This is only possible if Meta-CVS is responsible for FILE's directory.") (defun vc-mcvs-revert (file &optional contents-done) "Revert FILE to the version it was based on." - (vc-default-revert file contents-done) + (vc-default-revert 'MCVS file contents-done) (unless (eq (vc-checkout-model file) 'implicit) (if vc-mcvs-use-edit (vc-mcvs-command nil 0 file "unedit") diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el index 8480d61c843..b08765b89a3 100644 --- a/lisp/vc-svn.el +++ b/lisp/vc-svn.el @@ -114,15 +114,19 @@ This is only meaningful if you don't use the implicit checkout model (file-name-directory file))) (with-temp-buffer (cd (file-name-directory file)) - (condition-case nil - (vc-svn-command t 0 file "status" "-v") - ;; Some problem happened. E.g. We can't find an `svn' executable. - ;; We used to only catch `file-error' but when the process is run on - ;; a remote host via Tramp, the error is only reported via the - ;; exit status which is turned into an `error' by vc-do-command. - (error nil)) - (vc-svn-parse-status t) - (eq 'SVN (vc-file-getprop file 'vc-backend))))) + (let ((status + (condition-case nil + ;; Ignore all errors. + (vc-svn-command t t file "status" "-v") + ;; Some problem happened. E.g. We can't find an `svn' + ;; executable. We used to only catch `file-error' but when + ;; the process is run on a remote host via Tramp, the error + ;; is only reported via the exit status which is turned into + ;; an `error' by vc-do-command. + (error nil)))) + (when (eq 0 status) + (vc-svn-parse-status t) + (eq 'SVN (vc-file-getprop file 'vc-backend))))))) (defun vc-svn-state (file &optional localp) "SVN-specific version of `vc-state'." diff --git a/lisp/vc.el b/lisp/vc.el index 5ad3186ea73..d06e49ef1ba 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -762,7 +762,7 @@ in their implementation of vc-BACKEND-diff.") (defun vc-default-previous-version (backend file rev) "Return the version number immediately preceding REV for FILE, or nil if there is no previous version. This default -implementation works for <major>.<minor>-style version numbers as +implementation works for MAJOR.MINOR-style version numbers as used by RCS and CVS." (let ((branch (vc-branch-part rev)) (minor-num (string-to-number (vc-minor-part rev)))) @@ -781,7 +781,7 @@ used by RCS and CVS." (defun vc-default-next-version (backend file rev) "Return the version number immediately following REV for FILE, or nil if there is no next version. This default implementation -works for <major>.<minor>-style version numbers as used by RCS +works for MAJOR.MINOR-style version numbers as used by RCS and CVS." (when (not (string= rev (vc-workfile-version file))) (let ((branch (vc-branch-part rev)) @@ -930,8 +930,9 @@ Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the current buffer if BUFFER is t. If the destination buffer is not already current, set it up properly and erase it. The command is considered successful if its exit status does not exceed OKSTATUS (if -OKSTATUS is nil, that means to ignore errors, if it is 'async, that -means not to wait for termination of the subprocess). FILE is the +OKSTATUS is nil, that means to ignore error status, if it is `async', that +means not to wait for termination of the subprocess; if it is t it means to +ignore all execution errors). FILE is the name of the working file (may also be nil, to execute commands that don't expect a file name). If an optional list of FLAGS is present, that is inserted into the command line before the filename." @@ -976,7 +977,9 @@ that is inserted into the command line before the filename." `(unless (active-minibuffer-window) (message "Running %s in the background... done" ',command)))) (setq status (apply 'process-file command nil t nil squeezed)) - (when (or (not (integerp status)) (and okstatus (< okstatus status))) + (when (and (not (eq t okstatus)) + (or (not (integerp status)) + (and okstatus (< okstatus status)))) (pop-to-buffer (current-buffer)) (goto-char (point-min)) (shrink-window-if-larger-than-buffer) @@ -2526,6 +2529,33 @@ return its name; otherwise return nil." (if (file-exists-p backup-file) backup-file))))) +(defun vc-default-revert (backend file contents-done) + (unless contents-done + (let ((rev (vc-workfile-version file)) + (file-buffer (or (get-file-buffer file) (current-buffer)))) + (message "Checking out %s..." file) + (let ((failed t) + (backup-name (car (find-backup-file-name file)))) + (when backup-name + (copy-file file backup-name 'ok-if-already-exists 'keep-date) + (unless (file-writable-p file) + (set-file-modes file (logior (file-modes file) 128)))) + (unwind-protect + (let ((coding-system-for-read 'no-conversion) + (coding-system-for-write 'no-conversion)) + (with-temp-file file + (let ((outbuf (current-buffer))) + ;; Change buffer to get local value of vc-checkout-switches. + (with-current-buffer file-buffer + (let ((default-directory (file-name-directory file))) + (vc-call find-version file rev outbuf))))) + (setq failed nil)) + (when backup-name + (if failed + (rename-file backup-name file 'ok-if-already-exists) + (and (not vc-make-backup-files) (delete-file backup-name)))))) + (message "Checking out %s...done" file)))) + (defun vc-revert-file (file) "Revert FILE back to the version it was based on." (with-vc-properties diff --git a/lisp/wdired.el b/lisp/wdired.el index 55df66a70e6..56518691cad 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -211,6 +211,7 @@ program `dired-chmod-program', which must exist." ;; Local variables (put here to avoid compilation gripes) (defvar wdired-col-perm) ;; Column where the permission bits start (defvar wdired-old-content) +(defvar wdired-old-point) (defun wdired-mode () @@ -242,6 +243,7 @@ See `wdired-mode'." (interactive) (set (make-local-variable 'wdired-old-content) (buffer-substring (point-min) (point-max))) + (set (make-local-variable 'wdired-old-point) (point)) (set (make-local-variable 'query-replace-skip-read-only) t) (use-local-map wdired-mode-map) (force-mode-line-update) @@ -264,7 +266,8 @@ See `wdired-mode'." (set-buffer-modified-p nil) (setq buffer-undo-list nil) (run-mode-hooks 'wdired-mode-hook) - (message "%s" (substitute-command-keys "Press \\[wdired-finish-edit] when finished \ + (message "%s" (substitute-command-keys + "Press \\[wdired-finish-edit] when finished \ or \\[wdired-abort-changes] to abort changes"))) @@ -348,7 +351,8 @@ non-nil means return old filename." (interactive) (let ((inhibit-read-only t)) (erase-buffer) - (insert wdired-old-content)) + (insert wdired-old-content) + (goto-char wdired-old-point)) (wdired-change-to-dired-mode) (set-buffer-modified-p nil) (setq buffer-undo-list nil) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index b6dc9470d2c..ec3614c4d59 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -2161,7 +2161,8 @@ when he invoked the menu." (when sibling (if (widget-value widget) (widget-apply sibling :activate) - (widget-apply sibling :deactivate))))) + (widget-apply sibling :deactivate)) + (widget-clear-undo)))) ;;; The `checklist' Widget. |