diff options
Diffstat (limited to 'lisp')
87 files changed, 6144 insertions, 2947 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d2a569fa76a..24e371c2240 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,8 +1,899 @@ +2006-06-07 Kenichi Handa <handa@m17n.org> + + * international/mule.el (find-auto-coding): Don't handle the short + name `char-trans'. + + * files.el (hack-local-variables-prop-line) + (hack-local-variables): Cancel the previous change. + +2006-06-06 Jesper Harder <harder@phys.au.dk> + + * ediff-diff.el (ediff-test-utility): Protect against + file-error. + +2006-06-06 Chong Yidong <cyd@stupidchicken.com> + + * diff-mode.el (diff-mode): Set buffer-read-only to t when + diff-default-read-only is non-nill. + (diff-hunk-kill, diff-file-kill, diff-split-hunk) + (diff-refine-hunk): Set inhibit-read-only to t. + + * diff.el (diff-sentinel, diff): Set inhibit-read-only to t when + modifying the *Diff* buffer. + (diff-process-filter): New filter function for diff process that + sets inhibit-read-only to t when modifying the *Diff* buffer. + +2006-06-06 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el: (org-archive-subtree): Use end-of-subtree as + insertion point and control the number of empty lines. + (org-paste-subtree): Limit the number of empty lines at the end of + the inserted tree. + (org-agenda): Use buffer name of current file for narrowing. + (org-export-as-xml): Command removed. + (org-export-xml-type): Option removed. + (org-mode-map): Call `org-export-as-xoxo' directly. + (org-get-indentation): New optional argument LINE. + (org-fix-indentation, org-remove-tabs): New functions. + (org-export-as-ascii, org-ascii-level-start): Determine and apply + correct indentation for headlines that are converted it items. + (org-skip-comments): Remove table lines that contain narrowing + cookies but no other non-empty fields. + (org-set-tags): Allow groups of mutually exclusive tags. + (org-cmp-time): Sort 24:21 before items without time. + (org-get-time-of-day): Fixed the interpretation of 12pm and 12am. + (org-open-at-point): Require double colon also for numbers. + +2006-06-06 Kim F. Storm <storm@cua.dk> + + * ido.el (ido-default-file-method, ido-default-buffer-method): + Make choice values consistent with corresponding command names. + (ido-visit-buffer): Update accordingly. Default to selected-window. + +2006-06-06 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gud.el (gud-running): Fix doc string. + (gud-menu-map): Use :visible instead fo :enable for debugger test. + (gud-tooltip-modes): Add python-mode. + (gud-tooltip-print-command): Add pdb. Remove perldb. + +2006-06-05 Eli Zaretskii <eliz@gnu.org> + + * makefile.w32-in (bootstrap, $(lisp)/mh-e/mh-loaddefs.el): + Quote $(EMACS). + +2006-06-05 Richard Stallman <rms@gnu.org> + + * faces.el (defined-colors): Doc fix. + +2006-06-05 Thien-Thi Nguyen <ttn@gnu.org> + + * vc.el (vc-process-filter): Inhibit undo info collection around + call to insert. + (vc-setup-buffer): Likewise for call to erase-buffer. + (vc-do-command): Likewise for call to process-file. + +2006-06-05 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gud.el (gud-menu-map): Use a conditional help echo + for gud-go. + (gud-common-init): Other debuggers may trigger error. + +2006-06-05 Kenichi Handa <handa@m17n.org> + + * international/mule.el (find-auto-coding): Handle + enable-character-translation in file header. + +2006-06-04 Kim F. Storm <storm@cua.dk> + + * emacs-lisp/authors.el (authors-aliases): Add mode aliases. + (authors-fixed-entries): Fix spelling. + (authors-canonical-file-name): Don't report error for wildcards. + + * help.el (view-emacs-news): Rewrite to support new NEWS, + NEWS.major, and NEWS.1-17 file naming. Add more intelligense, + e.g. version 10 matches 1.10, and don't be confused by version 1.1 + begin a prefix of 1.12 (etc). A numeric prefix arg also works. + +2006-06-03 Vivek Dasmohapatra <vivek@etla.org> + + * progmodes/sh-script.el (sh-quoted-exec): New face for quoted + exec constructs like `foo bar`. + (sh-quoted-subshell): New helper function to search for a possibly + nested subshell (like `` or $()) within a "" quoted string. + (sh-font-lock-keywords-var): Add sh-quoted-exec for Bash. + (sh-apply-quoted-subshell): Flag quote characters inside a + subshell, which is itself already in a quoted region, as + punctuation, since this is the closest to what they actually are. + (sh-font-lock-syntactic-keywords): Add sh-quoted-subshell and + sh-apply-quoted-subshell. + (sh-font-lock-syntactic-face-function): Apply the new face for + text inside `` instead of the old font-lock-string-face. + +2006-06-03 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * term/mac-win.el (mac-ts-active-input-overlay): Add defvar. + (mac-ae-number, mac-ae-frame, mac-ae-script-language) + (mac-bytes-to-text-range, mac-ae-text-range-array) + (mac-ts-update-active-input-buf, mac-split-string-by-property-change) + (mac-replace-untranslated-utf-8-chars, mac-ts-update-active-input-area) + (mac-ts-unicode-for-key-event): New functions. + (mac-handle-toolbar-switch-mode): Use mac-ae-frame. + (mac-handle-font-selection): Use mac-ae-number. + (mac-ts-active-input-buf, mac-ts-update-active-input-area-seqno): + New variables. + (mac-ts-caret-position, mac-ts-raw-text, mac-ts-selected-raw-text) + (mac-ts-converted-text, mac-ts-selected-converted-text) + (mac-ts-block-fill-text, mac-ts-outline-text) + (mac-ts-selected-text, mac-ts-no-hilite): New faces. + (mac-ts-hilite-style-faces): New constant. + (mac-apple-event-map): Bind text input events. + (mac-dispatch-apple-event): Use command-execute instead of + call-interactively. + (global-map): Don't bind mac-apple-event. + (special-event-map): Bind mac-apple-event. + +2006-06-02 Eli Zaretskii <eliz@gnu.org> + + * makefile.w32-in (EMACS): Remove quotes from the Emacs executable + file name. + (emacs): Enclose the value of $(EMACS) in quotes. + +2006-06-02 Juri Linkov <juri@jurta.org> + + * international/mule.el (sgml-html-meta-auto-coding-function): + Remove the condition `(search-forward "<html" size t)'. + Replace `\"' with `[\"']?' in `re-search-forward'. + +2006-06-02 Kenichi Handa <handa@m17n.org> + + * files.el (hack-local-variables-prop-line): Ignore `char-trans' + as well as `coding'. + (hack-local-variables): Likewise. + + * international/mule.el (enable-character-translation): Put + permanent-local and safe-local-variable properties. + (find-auto-coding): Handle char-trans: tag. + +2006-06-02 Juri Linkov <juri@jurta.org> + + * international/mule.el (sgml-html-meta-auto-coding-function): + Limit the search by the end of the HTML header (if any). + +2006-06-01 Richard Stallman <rms@gnu.org> + + * subr.el (with-current-buffer): Doc fix. + +2006-06-02 Masatake YAMATO <jet@gyve.org> + + * progmodes/compile.el (compilation-error-regexp-alist-alist::gcov-*): + Almost rewrite. Underlines over all lines of gcov output are too + uncomfortable to read. Suggested by Dan Nicolaescu. + +2006-06-01 Luc Teirlinck <teirllm@auburn.edu> + + * progmodes/inf-lisp.el (inferior-lisp-mode): Doc fixes. + + * shell.el (shell-mode): Use shell-mode-map in docstring. + + * comint.el (comint-send-input): Do not add help-echo and + mouse-face to input if `comint-use-prompt-regexp' is non-nil. + +2006-06-01 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * term/x-win.el: Change x-menu-bar-start to menu-bar-open. + +2006-06-01 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-look-up-stack): New variable. + (gdb-stopped, gdb-info-stack-custom): If there is no source info + look up the stack and pop up GUD buffer if necessary. + (gdb-frames-select): Remove redundant call to gud-display-frame. + (gdb-info-threads-custom): Keep point at start of buffer. + (gdb-find-file-hook): Make it work for pre-GDB 6.4. + +2006-05-31 Juri Linkov <juri@jurta.org> + + * replace.el (query-replace-read-from, query-replace-read-to): + Bind `history-add-new-input' to nil. Call `add-to-history'. + +2006-05-31 Takaaki Ota <Takaaki.Ota@am.sony.com> + + * textmodes/table.el: Convert all HTML tags to lower case for + XHTML compatibility. + +2006-05-31 Masatake YAMATO <jet@gyve.org> + + * progmodes/compile.el: + (compilation-error-regexp-alist-alist::gcov-called-line): + Don't put face on `-' lines in gcov file. Suggested by Dan Nicolaescu. + +2006-05-31 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gud.el (gud-query-cmdline, gud-common-init): + Revert inadvertant changes made with last commit. + +2006-05-30 Reiner Steib <Reiner.Steib@gmx.de> + + * textmodes/flyspell.el (turn-on-flyspell, turn-off-flyspell): + New functions. + + * textmodes/text-mode.el (text-mode-hook): Use turn-on-flyspell. + +2006-05-30 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el: (org-agenda-highlight-todo): Make sure regexp + only matches in the right place. + (org-upcoming-deadline): New face. + (org-agenda-get-deadlines): Use new face `org-upcoming-deadline'. + (org-export-ascii-underline): Rename constant `org-ascii-underline' + and make it an option. + (org-export-ascii-bullets): New option. + (org-export-as-html): Many changes to emit valid XHTML. + (org-par-open): New variable. + (org-open-par, org-close-par-maybe, org-close-li-maybe): New functions. + (org-html-do-expand, org-section-number): Fixedcase in `replace-match'. + (org-timeline): Pass `org-timeline-show-empty-dates' to + `org-get-all-dates'. Interpret empty dates returned by `org-get-all-dates'. + (org-get-all-dates): New argument EMPTY. Add dates without + entries to the list, mark large ranges of empty dates. + (org-point-in-group, org-context): New functions. + +2006-05-30 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gud.el (gud-stop-subjob): Make it work in all buffers. + + * progmodes/gdb-ui.el: Move gdb-mouse-toggle-breakpoint-* to + C-mouse-1. Move gdb-mouse-until to mouse-3, gdb-mouse-jump + to C-mouse-3 (for 2 button mice). + (gdb-send): Do the right thing for C-d. + + * speedbar.el (speedbar-detach): Delete. + (speedbar-easymenu-definition-trailer): Remove speedbar-detach as + it breaks things. + (speedbar-reconfigure-keymaps): Always add extra items to pop up menu. + +2006-05-30 Daniel Pfeiffer <occitan@esperanto.org> + + * files.el (auto-mode-alist): Add makepp suffix and optional mk on + Makeppfile. + + * progmodes/compile.el (compilation-error-regexp-alist-alist): + Add makepp diagnostic. + +2006-05-29 Richard Stallman <rms@gnu.org> + + * window.el (fit-window-to-buffer): Doc fix. + + * help.el (temp-buffer-max-height): Doc fix. + + * subr.el (with-current-buffer): Doc fix. + +2006-05-29 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * term/x-win.el: Bind F10 to menu-bar-start if available. + +2006-05-28 Dan Nicolaescu <dann@ics.uci.edu> + + * term.el (term-if-xemacs, term-ifnot-xemacs): Delete, replace + uses with a simple test. + (term-set-escape-char, term-mode, term-check-kill-echo-list) + (term-send-raw-string, term-send-raw, term-mouse-paste) + (term-char-mode, term-line-mode, term-exec, term-sentinel) + (term-handle-exit, term-read-input-ring) + (term-previous-matching-input-string) + (term-previous-matching-input-string-position) + (term-previous-matching-input-from-input) + (term-replace-by-expanded-history, term-send-input) + (term-skip-prompt, term-bol, term-send-invisible) + (term-kill-input, term-delchar-or-maybe-eof) + (term-backward-matching-input, term-check-source) + (term-proc-query, term-emulate-terminal) + (term-handle-colors-array, term-process-pager, term-pager-line) + (term-pager-bob, term-unwrap-line, term-word) + (term-dynamic-complete-filename) + (term-dynamic-complete-as-filename) + (term-dynamic-simple-complete): Replace one arm ifs with whens or + unlesses. + +2006-05-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (hack-one-local-variable-eval-safep): Don't burp if used + during bootstrapping. + + * emacs-lisp/ewoc.el (ewoc--current-dll): Remove. + Basically undo the change of 2006-05-26: use extra arguments instead of + dynamic scoping. + (ewoc-locate): Remove unused var `footer'. + +2006-05-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/ewoc.el (ewoc--insert-new-node): Use ewoc--refresh-node. + + * emacs-lisp/autoload.el (no-update-autoloads): Declare. + (generate-file-autoloads): Obey it. Return whether autoloads were + added at point or not. + (update-file-autoloads): Use this new return value. + Remove redundant test for the presence of an autoload cookie. + + * emacs-lisp/autoload.el (autoload-find-file): New fun. + This one calls hack-local-variables. + (generate-file-autoloads, update-file-autoloads): Use it. + + * textmodes/bibtex.el (bibtex-autokey-name-case-convert-function) + (bibtex-sort-entry-class): Add safe-local-variable predicate. + (bibtex-sort-entry-class-alist): Don't set the global value. + (bibtex-init-sort-entry-class-alist): New fun. + (bibtex-sort-buffer, bibtex-prepare-new-entry): Call it to compute + bibtex-init-sort-entry-class-alist from the buffer-local value (if any) + of bibtex-init-sort-entry-class. + +2006-05-28 Richard Stallman <rms@gnu.org> + + * subr.el (load-history-regexp): If FILE is relative, insist + entire last name component must match it. + (load-history-filename-element, load-history-regexp): Doc fixes. + +2006-05-29 Kim F. Storm <storm@cua.dk> + + * emacs-lisp/bindat.el (bindat-idx, bindat-raw): Rename dynamic vars + `pos' and `raw-data' for clarity, as eval forms may access these. + +2006-05-28 Kim F. Storm <storm@cua.dk> + + * emacs-lisp/bindat.el (bindat--unpack-u8): Use aref also for strings. + +2006-05-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/make-mode.el (makefile-browser-map) + (makefile-mode-syntax-table): Move initialization inside declaration. + (makefile-fill-paragraph): Use the default comment-filling code. + +2006-05-28 Chong Yidong <cyd@stupidchicken.com> + + * replace.el (query-replace-defaults): New variable. + (query-replace-read-from): Use `query-replace-defaults' for + default value, instead of history list. + (query-replace-read-to): Update `query-replace-defaults'. + +2006-05-27 Chong Yidong <cyd@stupidchicken.com> + + * msb.el (mouse-select-buffer): Minor fix to make popup menu work + with no X toolkit. + +2006-05-28 Nick Roberts <nickrob@snap.net.nz> + + * tumme.el (tumme-show-all-from-dir-max-files): Fix typo. + (tumme-show-all-from-dir): Add autoload. + +2006-05-27 Mathias Dahl <mathias.dahl@gmail.com> + + * tumme.el: Change a lot of `(if .. (progn ..)' to `(when ..)'. + (tumme-remove-tag): Fix bug. + +2006-05-27 Thien-Thi Nguyen <ttn@gnu.org> + + * emacs-lisp/ewoc.el (ewoc--create): No longer take HEADER and + FOOTER args. Update unique caller. + (ewoc-delete): Compute last node once before looping. + (ewoc--node-branch): Merge into unique caller. + (ewoc--node): Don't define constructor make-ewoc--node for this + structure. + (ewoc): Add member `hf-pp' to this structure. + (ewoc--wrap): New func. + (ewoc-create): Take additional arg NOSEP. If nil, wrap node and + header/footer pretty-printers. Save header/footer pretty-printer. + (ewoc-set-hf): Use ewoc's header/footer pretty-printer. * + + * pcvs.el (cvs-make-cvs-buffer): Specify NOSEP to `ewoc-create'. + +2006-05-27 Mathias Dahl <mathias.dahl@gmail.com> + + * dired.el (dired-mode-map): Change `tumme-tag-remove' to + `tumme-delete-tag'. Rename `Remove Image Tag' to `Delete Image + Tag'. Change "Compare directories..." to "Change Directories...". + Move tumme commands to Operate, Regexp and Immediate menus. + Change "Add Comment" to "Add Image Comment". Change "Add Image + Tag" to "Add Image Tags". + + * tumme.el (tumme-delete-tag): Rename from `tumme-tag-remove'. + (tumme-setup-dired-keybindings): Change `tumme-add-remove' to + `tumme-delete-tag'. + +2006-05-26 Luc Teirlinck <teirllm@auburn.edu> + + * shell.el (shell-mode): Call shell-dirtrack-mode after + list-buffers-directory is made a local variable, to avoid setting + the default value. + +2006-05-26 Kevin Ryde <user42@zip.com.au> + + * info.el (Info-index-next): Use where-is-internal to report + actual binding of Info-index-next, rather than hard-coded `,'. + +2006-05-26 Eli Zaretskii <eliz@gnu.org> + + * menu-bar.el (menu-bar-apropos-menu): Move "Find Key in Manual" + and "Find Command in Manual" to here. + + * buff-menu.el (list-buffers-noselect): For Info buffers, use + Info-current-file as the file name. + +2006-05-26 Jonathan Yavner <jyavner@member.fsf.org> + + * ses.el (defadvice undo-more): Delete this defadvice. The undo + overrides will now be done a different way. + (ses-set-parameter): Reapply this function for undo. + (ses-set-header-row): Reconstruct header row during undo. + (ses-widen): New function. + (ses-goto-data, ses-reconstruct-all): Use new function. + (ses-command-hook): Widen buffer during undo, before unupdating + the cells. + (ses-insert-row, ses-delete-row): Widen buffer during undo. + (ses-load, ses-header-row): Permit empty (zero-row) spreadsheets. + (ses-read-cell): Avoid stupid warning for RET RET on a cell whose + formula hasn't been executed yet. + +2006-05-26 Reiner Steib <Reiner.Steib@gmx.de> + + * comint.el (comint-kill-whole-line): Rename arg to count. + Fix doc string. + +2006-05-26 Chong Yidong <cyd@stupidchicken.com> + + * files.el (backup-buffer-copy): Remove deleted MUSTBENEW argument + to copy-file. + +2006-05-26 Reiner Steib <Reiner.Steib@gmx.de> + + * simple.el (toggle-truncate-lines): Make arg optional for + backward compatibility. + +2006-05-26 Thien-Thi Nguyen <ttn@gnu.org> + + * emacs-lisp/ewoc.el (ewoc--current-dll): New var. + (ewoc--node-next, ewoc--node-prev, ewoc--node-nth): Don't take + DLL arg. Instead, use ewoc--current-dll. Update all callers. + (ewoc--set-buffer-bind-dll-let*): Bind ewoc--current-dll, not `dll'. + (ewoc--adjust): Use ewoc--current-dll. + (ewoc-next, ewoc-prev, ewoc-nth): Bind ewoc--current-dll. + +2006-05-26 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el: (org-next-item, org-previous-item): Emit more + compact error message. + (org-tags-view): Refresh category table in each file. + (org-table-justify-field-maybe): Remove superfluous arguments to + `format'. + (org-export-as-html): Insert "<p>" before postamble. + (org-paste-subtree, org-kill-is-subtree-p): Check for empty kill ring. + +2006-05-26 Kenichi Handa <handa@m17n.org> + + * textmodes/po.el (po-find-charset): Pay attention to the case + FILENAME is a cons (NAME . BUFFER). + (po-find-file-coding-system-guts): Likewise. + + * arc-mode.el (archive-set-buffer-as-visiting-file): + Call find-operation-coding-system with (FILENAME . BUFFER). + + * tar-mode.el (tar-extract): Call find-operation-coding-system + with (FILENAME . BUFFER). + + * international/mule.el (decode-coding-inserted-region): + Call find-operation-coding-system with (FILENAME . BUFFER). + +2006-05-25 Chong Yidong <cyd@stupidchicken.com> + + * image-mode.el (image-toggle-display): Use buffer contents to + generate image for a remote file. + +2006-05-25 Juri Linkov <juri@jurta.org> + + * replace.el (query-replace-read-from, query-replace-read-to): + Remove 8th arg KEEP-ALL in read-from-minibuffer. + +2006-05-25 Rajesh Vaidheeswarran <rv@gnu.org> + + * whitespace.el (whitespace-cleanup): Change to cleanup + region if one is active. + * whitespace.el (whitespace-cleanup-internal): New internal method. + +2006-05-25 Mathias Dahl <mathias.dahl@gmail.com> + + * dired.el (dired-mode-map): Add help-echo strings to tumme + commands. Bind `tumme-dired-display-image' to C-t i. + + * tumme.el (tumme-display-image): Change documentation string slightly. + (tumme-dired-display-image): Add call to `display-buffer'. + +2006-05-25 Thien-Thi Nguyen <ttn@gnu.org> + + * emacs-lisp/bindat.el (bindat-unpack, bindat-pack): + Signal error if RAW-DATA is a multibyte string. + +2006-05-24 Richard Stallman <rms@gnu.org> + + * subr.el (with-local-quit): When handling `quit' signal, + make a chance for quit-flag to cause a quit. + + * emacs-lisp/advice.el (ad-enable-advice, ad-activate) + (ad-disable-advice): Add autoloads. + + * subr.el (read-passwd): Copy PROMPT before changing its properties. + +2006-05-25 Mathias Dahl <mathias.dahl@gmail.com> + + * dired.el (dired-mode-map): Change menu items for tumme as per + suggestions in emacs-devel. + +2006-05-25 Nick Roberts <nickrob@snap.net.nz> + + * dired.el (dired-mode-map): Fix breakage. + +2006-05-25 Mathias Dahl <mathias.dahl@gmail.com> + + * tumme.el (tumme-display-dired-image): Rename to... + (tumme-dired-display-image): ...this. + (tumme-track-movement): Change default value to t. + (tumme-display-thumbs): Add new optional parameter DO-NOT-POP, + used from `tumme-next-line-and-display' and similar commands. + + * dired.el (dired-mode-map): Add Thumbnail submenu under the + Immediate menu. Add some tumme commands there. + +2006-05-24 Luc Teirlinck <teirllm@auburn.edu> + + * loadup.el ("jka-cmpr-hook"): Load it before it is needed. + +2006-05-24 Chong Yidong <cyd@mit.edu> + + * menu-bar.el, international/mule-cmds.el: Remove tooltips for + menu entries that open submenus. + +2006-05-24 Alan Mackenzie <acm@muc.de> + + * startup.el (command-line): For names of preloaded files, don't + append ".elc" (now done in Fload), and call file-truename on the + lisp directory. + + * subr.el (eval-after-load): Fix the doc-string. Allow FILE to + match ANY loaded file with the right name, not just those in + load-path. Put a regexp matching the file name into + after-load-alist, rather than the name itself. + + * subr.el: New functions load-history-regexp, + load-history-filename-element, do-after-load-evaluation. + + * international/mule.el (load-with-code-conversion): Do the + eval-after-load stuff by calling do-after-load-evaluation. + +2006-05-25 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gud.el (gud-sentinel): Condition on GUD buffer if it + has not been killed. + +2006-05-24 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * term/mac-win.el: Set idle timer to clean up expired Apple events. + (mac-ae-get-url): Redispatch Apple event on unknown scheme. + (mac-dispatch-apple-event): Resume Apple event if it is suspended. + Optionally set error message in reply. + +2006-05-24 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el: (org-open-at-point): Use renamed variable + `org-confirm-shell-link-function'. + (org-confirm-shell-link-function): Rename from + `org-confirm-shell-links'. + (org-export-directory): New function. + (org-export-as-ascii, org-export-as-html, org-export-as-xoxo) + (org-export-icalendar): Use `org-export-directory'. + (org-indent-item): Keep cursor position. + (org-link-file-path-type): New option. + (org-export-as-html): Fix bug with plain lists starting in + column 0. + (org-export-as-html): Remove deadline formatting, this happens + now already in `org-html-handle-time-stamps'. + (org-export-html-style): Deadline class removed. + (org-insert-labeled-timestamps-at-point): New option. + (org-cycle, org-occur, org-scan-tags): Use `org-overview' instead + of `hide-sublevels 1', in case the first headline is not level 1. + (org-overview, org-content): New fuction. + (org-cycle-global-status, org-cycle-subtree-status): Make these + variables buffer-local. + (org-global-cycle): New command. + (org-shifttab): Use `org-global-cycle'. + (org-insert-heading, org-insert-item): Go to end of new + headline/item after creating it. + (org-export-visible): Rename from `org-export-copy-visible'. + Now creates a temporary org-file and applies an exporting command + to it. + (org-table-eval-formula): Support for lisp forms. + (org-agenda-todo-ignore-scheduled): New option. + (org-agenda-get-todos): Use new option + `org-agenda-todo-ignore-scheduled'. + (org-export-html-inline-images): New value `maybe'. + (org-export-as-html): Inlining of images dependent on link description. + (org-archive-subtree): Check for end-of-buffer before trying + `kill-line'. + (org-agenda-follow-mode): New option. + (org-export-with-tags, org-export-with-timestamps): New options. + (org-html-handle-time-stamps): New function. + (org-keyword-time-regexp): New variable. + (org-agenda-get-todos): Use `org-agenda-todo-list-sublevels'. + (org-agenda-todo-list-sublevels): New option. + (org-html-level-start): When TITLE is nil, just close all levels. + (org-parse-key-lines, org-parse-export-options): Remove functions, + replaced by `org-infile-export-plist'. + (org-combine-plists, org-infile-export-plist) + (org-default-export-plist): New functions. + (org-export-html-preamble, org-export-html-postamble) + (org-export-html-auto-preamble, org-export-html-auto-postamble): + New variables. + (org-export-publishing-directory): New option. + (org-export-as-html, org-export-as-ascii): Use the new property + lists for settings. + (org-export-copy-visible, org-export-as-xoxo): + Respect `org-export-publishing-directory'. + (org-link-search, org-store-link, org-file-apps): Support for + links to BibTeX database entries.. + (org-get-current-options, org-set-regexps-and-options): + Implement logging as a startup option. + (org-store-link): Make sure context string is never empty + (org-insert-link): Use relative path when possible. + (org-at-item-checklet-p): New function. + (org-shifttab, org-shiftmetaleft, org-shiftmetaright) + (org-shiftmetaup, org-shiftmetadown, org-metaleft) + (org-metaright, org-metaup, org-metadown, org-shiftup) + (org-shiftdown, org-shiftright, org-shiftleft) + (org-ctrl-c-ctrl-c, org-cycle, org-return, org-meta-return): + Dispatch using `call-interactively'. + (org-call-with-arg): New defsubst. + (org-tag-alist, org-use-fast-tag-selection): New options. + (org-complete): Use `org-tag-alist'. + (org-fast-tag-insert, org-fast-tag-selection): New functions. + (org-next-item, org-previous-item): New commands. + (org-beginning-of-item, org-end-of-item): Add (interactive) to + make command. + (org-shiftup, org-shiftdown): Accommodate the item-navigation commands. + + +2006-05-23 Thien-Thi Nguyen <ttn@gnu.org> + + * emacs-lisp/ewoc.el (ewoc-delete): New function. + (ewoc-filter): Use `ewoc-delete'. + + * emacs-lisp/bindat.el (bindat-pack): Doc fix. + +2006-05-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/bibtex.el (bibtex-format-entry, bibtex-clean-entry): + Signal more user-friendly error messages. + + * complete.el (PC-do-completion): Undo the addition of implicit + wildcards if they did not lead to finding any match. + (read-file-name-internal): Don't add the final > if the completion is + not finished. + +2006-05-22 Reiner Steib <Reiner.Steib@gmx.de> + + * textmodes/bibtex.el (bibtex-maintain-sorted-entries): + Quote safe-local-variable predicate. + +2006-05-22 Thien-Thi Nguyen <ttn@gnu.org> + + * emacs-lisp/ewoc.el (ewoc-set-data): New function. + +2006-05-21 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> + + * textmodes/bibtex.el (bibtex-maintain-sorted-entries): Mark as safe. + + * progmodes/make-mode.el (makefile-special-targets-list) + (makefile-macro-table, makefile-target-table): Mark as risky. + (makefile-query-one-target-method): Make this the alias for the + following variable. + (makefile-query-one-target-method-function): Make this the real name. + + * textmodes/artist.el (artist-text-renderer): Make this the alias + for the following variable. + (artist-text-renderer-function): Make this the real name. + + * textmodes/flyspell.el (flyspell-generic-check-word-p): Make this + the alias for the following variable. + (flyspell-generic-check-word-predicate): Make this the real name. + + * textmodes/ispell.el (ispell-format-word): Make this the alias + for the following variable. + (ispell-format-word-function): Make this the real name. + (ispell-message-text-end): Mark as risky. + + * skeleton.el (skeleton-transformation, skeleton-filter) + (skeleton-pair-filter): Make these the aliases for the following + variables. + (skeleton-transformation-function, skeleton-filter-function) + (skeleton-pair-filter-function): Make these the real names. + + * progmodes/sh-script.el (sh-mode): Use skeleton-filter-function + and skeleton-pair-filter-function. + + * textmodes/sgml-mode.el (sgml-transformation): Make this the + alias for the following variable. + (sgml-transformation-function): Make this the real name. + (sgml-tag-alist): Mark as risky. + +2006-05-21 Richard Stallman <rms@gnu.org> + + * simple.el (kill-region): Interactively, pass point, then mark. + +2006-05-22 Thien-Thi Nguyen <ttn@gnu.org> + + * emacs-lisp/ewoc.el (ewoc-create): Add autoload cookie. + +2006-05-21 Romain Francoise <romain@orebokech.com> + + * dired-x.el (dired-mode-map): Don't bind M-g. + +2006-05-20 Richard Stallman <rms@gnu.org> + + * dired.el (dired-mode-map): Put dired-goto-file on j, not M-g. + (dired-goto-file): Doc fix. + +2006-05-21 Kim F. Storm <storm@cua.dk> + + * emulation/cua-base.el: Mention customizing cua-mode as alternative + way to enable built-in cua-mode if user loads older CUA-mode package. + + * ido.el (ido-read-file-name): Bind ido-show-dot-for-dired to nil + if default-filename is specified. + +2006-05-20 Eli Zaretskii <eliz@gnu.org> + + * menu-bar.el (menu-bar-manuals-menu) <info-apropos>: New menu item. + + * info.el (info-apropos): Make sure current-file and current-node + have non-nil values. Speed up by using add-to-list instead of + manual consing. + +2006-05-20 Micha,Ak(Bl Cadilhac <michael.cadilhac@lrde.org> + + * progmodes/make-mode.el (makefile-mode): Doc fix. + +2006-05-20 Eli Zaretskii <eliz@gnu.org> + + * dired-aux.el (dired-do-shell-command): Doc fix. + +2006-05-20 Kevin Ryde <user42@zip.com.au> + + * info-xref.el (info-xref-check-all-custom): Skip :tag part of + ``(custom-manual :tag "Foo" "(foo)Node")''. + +2006-05-20 Karl Chen <quarl@cs.berkeley.edu> + + * progmodes/cc-vars.el (c-backslash-column): Mark as safe if its + value is an integer. + +2006-05-20 Eli Zaretskii <eliz@gnu.org> + + * mail/rmail.el (rmail-mime-charset-pattern): Add "?:" before + "format". + (rmail-convert-to-babyl-format): Undo the change from 2006-04-19. + +2006-05-20 Martin Rudalics <rudalics@gmx.at> + + * progmodes/hideif.el (show-ifdef-block): Fix bug where parts of + a hidden block remained hidden if `hide-ifdef-lines' is non-nil. + +2006-05-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/gud.el (gdb-script-font-lock-keywords): Use a stricter + regexp for keywords. + +2006-05-20 Masayuki FUJII <boochang@m4.kcn.ne.jp> (tiny change) + + * dnd.el (dnd-get-local-file-name): Specify LITERAL in + replace-regexp-in-string. + + * term/w32-win.el (w32-drag-n-drop): Substitute '/' for '\', + encode, and escape file name on conversion to URL. + +2006-05-20 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * dnd.el (dnd-handle-one-url): Change 3rd arg ARG to URL. + Don't unescape URL. + (dnd-get-local-file-name): Unescape URL on conversion to file name. + + * x-dnd.el (x-dnd-handle-file-name): Encode and escape file names + on conversion to URLs. + + * net/browse-url.el (browse-url-file-url): Encode file name on + conversion to URL. + + * term/mac-win.el (mac-ae-open-documents): Escape file name on + conversion to URL. + +2006-05-19 Eli Zaretskii <eliz@gnu.org> + + * progmodes/cc-styles.el (c-style-alist): Doc fix. + +2006-05-19 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * term/mac-win.el (mac-bytes-to-digits): Remove function. + (mac-handle-toolbar-switch-mode): Use coercion instead of it. + +2006-05-19 Glenn Morris <rgm@gnu.org> + + * calendar/diary-lib.el (diary-bahai-date) + (list-bahai-diary-entries, mark-bahai-diary-entries) + (mark-bahai-calendar-date-pattern): Not interactive. + (add-to-diary-list): New optional arg LITERAL. Doc fix. + (diary-entries-list): Change format of 4th element in each entry. + (diary-list-entries): Use add-to-diary-list. + (diary-goto-entry): Handle the case where the buffer visiting the + diary has been killed. + (fancy-diary-display): Add 'locator to button rather than 'marker. + Only generate temp-face when there are marks to apply. + (list-sexp-diary-entries): Pass literal to add-to-diary-list. + (diary-fancy-date-pattern): New variable. + (diary-time-regexp): Doc fix. + (diary-anniversary, diary-time): New faces. + (fancy-diary-font-lock-keywords): Use diary-fancy-date-pattern and + diary-time-regexp. Add font-lock-multiline property where needed. + Use new faces diary-anniversary and diary-time. + (diary-fancy-font-lock-fontify-region-function): New function, to + handle multiline font-lock pattern in fancy diary. + (fancy-diary-display-mode): Set font-lock-fontify-region-function. + (diary-font-lock-keywords): Tweak time regexp. Use new face + diary-time. + +2006-05-19 Alexander Shopov <ash@contact.bg> (tiny change) + + * international/code-pages.el (mik): Table corrected. + +2006-05-18 Kim F. Storm <storm@cua.dk> + + * progmodes/grep.el (grep-find): Don't check grep-find-command + before running command (breaks non-interactive usage). + +2006-05-18 Thien-Thi Nguyen <ttn@gnu.org> + + * emacs-lisp/ewoc.el (ewoc--adjust): New func. + (ewoc--insert-new-node): Don't insert trailing newline. + Instead, adjust successor nodes's start markers. + (ewoc--refresh-node): Delete all text from current node's start + marker to the next one's; adjust successor nodes's start markers. + (ewoc--create): Doc fixes. + (ewoc--refresh): Don't insert newline. + (ewoc--set-hf): Use `ewoc--set-buffer-bind-dll-let*'. + * pcvs.el (cvs-make-cvs-buffer): + Specify extra newline for ewoc's header and footer. + (cvs-update-header): Update initial header recognition. + Append newline to final header and footer values. + * pcvs-info.el (cvs-fileinfo-pp): Insert trailing newline. + +2006-05-17 Richard Stallman <rms@gnu.org> + + * files.el (file-name-extension): Doc fix. + +2006-05-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * shell.el (shell-dirtrack-mode): Make it into a proper minor mode, so + we can explicitly enable/disable rather than toggle. + (shell-mode): Use it. + (shell-cd): Don't try to reproduce what `cd' does. + +2006-05-17 Kim F. Storm <storm@cua.dk> + + * ido.el (ido-read-internal): Use only nondirectory part of + default item. + 2006-05-17 Thien-Thi Nguyen <ttn@gnu.org> * emacs-lisp/ewoc.el (ewoc-data): Add docstring. (ewoc-nth): Doc fix. + (ewoc-map, ewoc-invalidate): Compute PP before looping. + 2006-05-16 Eli Zaretskii <eliz@gnu.org> * international/mule.el (auto-coding-alist): Add .lha to files @@ -161,8 +1052,7 @@ Move `safe-local-variable' declarations to the respective files. * help-fns.el (describe-variable): Don't print safe-var if it is - byte-code. Improve wording as suggested by Luc Teirlinck - <teirllm@auburn.edu>. + byte-code. Improve wording as suggested by Luc Teirlinck. 2006-05-11 Nick Roberts <nickrob@snap.net.nz> @@ -1289,7 +2179,7 @@ * files.el (hack-local-variables-confirm) <offer-save>: Clarify message text. Suggested by Ralf Angeli. -2006-04-08 Michael Cadilhac <michael.cadilhac@lrde.org> (tiny change) +2006-04-08 Michael Cadilhac <michael.cadilhac@lrde.org> * rect.el (kill-rectangle): Don't barf if `kill-read-only-ok' is set. (delete-extract-rectangle-line): Use `filter-buffer-substring' @@ -8117,7 +9007,7 @@ since the last ping. (rcirc-mode): Give rcirc-topic a local binding here. -2005-11-19 Michael Cadilhac <michael.cadilhac@lrde.org> (tiny change) +2005-11-19 Michael Cadilhac <michael.cadilhac@lrde.org> * subr.el (read-passwd): Fontify the prompt as we do with other prompts. @@ -9728,7 +10618,7 @@ * dired-x.el (dired-virtual): Don't use `dired-insert-headerline'. -2005-10-25 Michael Cadilhac <michael.cadilhac-@t-lrde.epita.fr> (tiny change) +2005-10-25 Michael Cadilhac <michael.cadilhac-@t-lrde.epita.fr> * play/blackbox.el (blackbox-redefine-key): New function. (blackbox-mode-map): Use it to remap existing bindings for cursor @@ -10992,7 +11882,7 @@ * progmodes/gdb-ui.el (gdb-fringe-width -> gdb-buffer-fringe-width): Typo. -2005-10-06 Michael Cadilhac <michael.cadilhac-@t-lrde.epita.fr> (tiny change) +2005-10-06 Michael Cadilhac <michael.cadilhac-@t-lrde.epita.fr> * play/zone.el (zone): Wrap body with save-window-excursion. @@ -11787,7 +12677,7 @@ * calendar/diary-lib.el (mark-diary-entries): Rearrange to wrap with-current-buffer form in save-excursion. -2005-09-18 D Goel <deego@gnufans.org> +2005-09-18 Deepak Goel <deego@gnufans.org> * apropos.el (apropos-command): Fix `message' call: first arg should be a format spec. In this and all other cases that appear @@ -21214,7 +22104,7 @@ * simple.el (goto-line): Doc fix. -2005-03-19 Aaron Hawley <Aaron.Hawley@uvm.edu> (tiny change) +2005-03-19 Aaron S. Hawley <Aaron.Hawley@uvm.edu> * files.el (save-buffer): Doc fix. diff --git a/lisp/ChangeLog.5 b/lisp/ChangeLog.5 index dad524ed851..5aedc76efed 100644 --- a/lisp/ChangeLog.5 +++ b/lisp/ChangeLog.5 @@ -2779,7 +2779,7 @@ continuations, don't go to line beg; perl-backward-to-start-of-continued-exp gives the right place. -1995-03-07 Enami Tsugutomo <enami@sys.ptg.sony.co.jp> +1995-03-07 Tsugutomo ENAMI <enami@sys.ptg.sony.co.jp> * simple.el (indent-new-comment-line): Clean up handling of \(...\) in comment-start-skip. diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 5b08182b7ee..2db56d0450a 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -898,8 +898,9 @@ using `make-temp-file', and the generated name is returned." ;; extracted file existed. (let ((file-name-handler-alist '(("" . archive-file-name-handler)))) - (car (find-operation-coding-system 'insert-file-contents - filename t)))))) + (car (find-operation-coding-system + 'insert-file-contents + (cons filename (current-buffer)) t)))))) (if (and (not coding-system-for-read) (not enable-multibyte-characters)) (setq coding diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 3094da3bfe8..4998c1edf07 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -116,6 +116,8 @@ This variable determines whether reverting the buffer lists only file buffers. It affects both manual reverting and reverting by Auto Revert Mode.") +(defvar Info-current-file) ;; from info.el + (make-variable-buffer-local 'Buffer-menu-files-only) (if Buffer-menu-mode-map @@ -767,10 +769,24 @@ For more information, see the function `buffer-menu'." ?\s))) (unless file ;; No visited file. Check local value of - ;; list-buffers-directory. - (when (and (boundp 'list-buffers-directory) - list-buffers-directory) - (setq file list-buffers-directory))) + ;; list-buffers-directory and, for Info buffers, + ;; Info-current-file. + (cond ((and (boundp 'list-buffers-directory) + list-buffers-directory) + (setq file list-buffers-directory)) + ((eq major-mode 'Info-mode) + (setq file Info-current-file) + (cond + ((eq file t) + (setq file "*Info Directory*")) + ((eq file 'apropos) + (setq file "*Info Apropos*")) + ((eq file 'history) + (setq file "*Info History*")) + ((eq file 'toc) + (setq file "*Info TOC*")) + ((not (stringp file)) ;; avoid errors + (setq file nil)))))) (push (list buffer bits name (buffer-size) mode file) list)))))) ;; Preserve the original buffer-list ordering, just in case. diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index c27939b8075..95588fccd92 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -121,20 +121,16 @@ The holidays are those in the list `calendar-holidays'.") "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.") (autoload 'diary-bahai-date "cal-bahai" - "Baha'i calendar equivalent of date diary entry." - t) + "Baha'i calendar equivalent of date diary entry.") (autoload 'list-bahai-diary-entries "cal-bahai" - "Add any Baha'i date entries from the diary file to `diary-entries-list'." - t) + "Add any Baha'i date entries from the diary file to `diary-entries-list'.") (autoload 'mark-bahai-diary-entries "cal-bahai" - "Mark days in the calendar window that have Baha'i date diary entries." - t) + "Mark days in the calendar window that have Baha'i date diary entries.") (autoload 'mark-bahai-calendar-date-pattern "cal-bahai" - "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR." - t) + "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR.") (autoload 'diary-hebrew-date "cal-hebrew" "Hebrew calendar equivalent of date diary entry.") @@ -323,6 +319,42 @@ number of days of diary entries displayed." (integer :tag "Saturday"))) :group 'diary) + +(defvar diary-modify-entry-list-string-function nil + "Function applied to entry string before putting it into the entries list. +Can be used by programs integrating a diary list into other buffers (e.g. +org.el and planner.el) to modify the string or add properties to it. +The function takes a string argument and must return a string.") + +(defun add-to-diary-list (date string specifier &optional marker + globcolor literal) + "Add an entry to `diary-entries-list'. +Do nothing if DATE or STRING is nil. DATE is the (MONTH DAY +YEAR) for which the entry applies; STRING is the text of the +entry as it will appear in the diary (i.e. with any format +strings such as \"%d\" expanded); SPECIFIER is the date part of +the entry as it appears in the diary-file; LITERAL is the entry +as it appears in the diary-file (i.e. before expansion). If +LITERAL is nil, it is taken to be the same as STRING. + +The entry is added to the list as (DATE STRING SPECIFIER LOCATOR +GLOBCOLOR), where LOCATOR has the form (MARKER FILENAME LITERAL), +FILENAME being the file containing the diary entry." + (when (and date string) + (if diary-file-name-prefix + (let ((prefix (funcall diary-file-name-prefix-function + (buffer-file-name)))) + (or (string= prefix "") + (setq string (format "[%s] %s" prefix string))))) + (and diary-modify-entry-list-string-function + (setq string (funcall diary-modify-entry-list-string-function + string))) + (setq diary-entries-list + (append diary-entries-list + (list (list date string specifier + (list marker (buffer-file-name) literal) + globcolor)))))) + (define-obsolete-function-alias 'list-diary-entries 'diary-list-entries) (defun diary-list-entries (date number &optional list-only) "Create and display a buffer containing the relevant lines in `diary-file'. @@ -468,9 +500,7 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list." (copy-marker entry-start) (nth 1 temp))))))) (or entry-found (not diary-list-include-blanks) - (setq diary-entries-list - (append diary-entries-list - (list (list date "" "" "" ""))))) + (add-to-diary-list date "" "" "" "")) (setq date (calendar-gregorian-from-absolute (1+ (calendar-absolute-from-gregorian date)))) @@ -577,10 +607,27 @@ changing the variable `diary-include-string'." 'face 'diary-button) (defun diary-goto-entry (button) - (let ((marker (button-get button 'marker))) - (when marker - (pop-to-buffer (marker-buffer marker)) - (goto-char (marker-position marker))))) + (let* ((locator (button-get button 'locator)) + (marker (car locator)) + markbuf file) + ;; If marker pointing to diary location is valid, use that. + (if (and marker (setq markbuf (marker-buffer marker))) + (progn + (pop-to-buffer markbuf) + (goto-char (marker-position marker))) + ;; Marker is invalid (eg buffer has been killed). + (or (and (setq file (cadr locator)) + (file-exists-p file) + (find-file-other-window file) + (progn + (when (eq major-mode default-major-mode) (diary-mode)) + (goto-char (point-min)) + (if (re-search-forward (format "%s.*\\(%s\\)" + (regexp-quote (nth 2 locator)) + (regexp-quote (nth 3 locator))) + nil t) + (goto-char (match-beginning 1))))) + (message "Unable to locate this diary entry"))))) (defun fancy-diary-display () "Prepare a diary buffer with relevant entries in a fancy, noneditable form. @@ -666,37 +713,45 @@ This function is provided for optional use as the `diary-display-hook'." (setq entry (car (cdr (car entry-list)))) (if (< 0 (length entry)) - (progn - (if (nth 3 (car entry-list)) + (let ((this-entry (car entry-list)) + this-loc) + (if (setq this-loc (nth 3 this-entry)) (insert-button (concat entry "\n") - 'marker (nth 3 (car entry-list)) + ;; (MARKER FILENAME SPECIFIER LITERAL) + 'locator (list (car this-loc) + (cadr this-loc) + (nth 2 this-entry) + (or (nth 2 this-loc) + (nth 1 this-entry))) :type 'diary-entry) (insert entry ?\n)) (save-excursion - (let* ((marks (nth 4 (car entry-list))) - (temp-face (make-symbol - (apply - 'concat "temp-face-" - (mapcar (lambda (sym) - (if (stringp sym) - sym - (symbol-name sym))) - marks)))) - (faceinfo marks)) - (make-face temp-face) - ;; Remove :face info from the marks, - ;; copy the face info into temp-face - (while (setq faceinfo (memq :face faceinfo)) - (copy-face (read (nth 1 faceinfo)) temp-face) - (setcar faceinfo nil) - (setcar (cdr faceinfo) nil)) - (setq marks (delq nil marks)) - ;; Apply the font aspects. - (apply 'set-face-attribute temp-face nil marks) - (search-backward entry) - (overlay-put - (make-overlay (match-beginning 0) (match-end 0)) - 'face temp-face))))) + (let* ((marks (nth 4 this-entry)) + (faceinfo marks) + temp-face) + (when marks + (setq temp-face (make-symbol + (apply + 'concat "temp-face-" + (mapcar (lambda (sym) + (if (stringp sym) + sym + (symbol-name sym))) + marks)))) + (make-face temp-face) + ;; Remove :face info from the marks, + ;; copy the face info into temp-face + (while (setq faceinfo (memq :face faceinfo)) + (copy-face (read (nth 1 faceinfo)) temp-face) + (setcar faceinfo nil) + (setcar (cdr faceinfo) nil)) + (setq marks (delq nil marks)) + ;; Apply the font aspects. + (apply 'set-face-attribute temp-face nil marks) + (search-backward entry) + (overlay-put + (make-overlay (match-beginning 0) (match-end 0)) + 'face temp-face)))))) (setq entry-list (cdr entry-list)))) (set-buffer-modified-p nil) (goto-char (point-min)) @@ -1350,7 +1405,7 @@ best if they are nonmarking." (setq line-start (point))) (setq specifier (buffer-substring-no-properties (1+ line-start) (point)) - entry-start (1+ line-start)) + entry-start (1+ line-start)) (forward-char 1) (if (and (or (char-equal (preceding-char) ?\^M) (char-equal (preceding-char) ?\n)) @@ -1367,24 +1422,26 @@ best if they are nonmarking." (while (string-match "[\^M]" entry) (aset entry (match-beginning 0) ?\n ))) (let ((diary-entry (diary-sexp-entry sexp entry date)) - temp) - (setq entry (if (consp diary-entry) - (cdr diary-entry) - diary-entry)) + temp literal) + (setq literal entry ; before evaluation + entry (if (consp diary-entry) + (cdr diary-entry) + diary-entry)) (if diary-entry - (progn + (progn (remove-overlays line-start (point) 'invisible 'diary) - (if (< 0 (length entry)) - (setq temp (diary-pull-attrs entry file-glob-attrs) - entry (nth 0 temp) - marks (nth 1 temp))))) - (add-to-diary-list date - entry - specifier - (if entry-start (copy-marker entry-start) - nil) - marks) - (setq entry-found (or entry-found diary-entry))))) + (if (< 0 (length entry)) + (setq temp (diary-pull-attrs entry file-glob-attrs) + entry (nth 0 temp) + marks (nth 1 temp))))) + (add-to-diary-list date + entry + specifier + (if entry-start (copy-marker entry-start) + nil) + marks + literal) + (setq entry-found (or entry-found diary-entry))))) entry-found)) (defun diary-sexp-entry (sexp entry date) @@ -1636,28 +1693,6 @@ marked on the calendar." (or (diary-remind sexp (car days) marking) (diary-remind sexp (cdr days) marking)))))) -(defvar diary-modify-entry-list-string-function nil - "Function applied to entry string before putting it into the entries list. -Can be used by programs integrating a diary list into other buffers (e.g. -org.el and planner.el) to modify the string or add properties to it. -The function takes a string argument and must return a string.") - -(defun add-to-diary-list (date string specifier &optional marker globcolor) - "Add the entry (DATE STRING SPECIFIER MARKER GLOBCOLOR) to `diary-entries-list'. -Do nothing if DATE or STRING is nil." - (when (and date string) - (if diary-file-name-prefix - (let ((prefix (funcall diary-file-name-prefix-function - (buffer-file-name)))) - (or (string= prefix "") - (setq string (format "[%s] %s" prefix string))))) - (and diary-modify-entry-list-string-function - (setq string (funcall diary-modify-entry-list-string-function - string))) - (setq diary-entries-list - (append diary-entries-list - (list (list date string specifier marker globcolor)))))) - (defun diary-redraw-calendar () "If `calendar-buffer' is live and diary entries are marked, redraw it." (and mark-diary-entries-in-calendar @@ -1796,36 +1831,86 @@ Prefix arg will make the entry nonmarking." (if diary-header-line-flag (setq header-line-format diary-header-line-format))) -(define-derived-mode fancy-diary-display-mode fundamental-mode - "Diary" - "Major mode used while displaying diary entries using Fancy Display." - (set (make-local-variable 'font-lock-defaults) - '(fancy-diary-font-lock-keywords t)) - (local-set-key "q" 'quit-window)) +(defvar diary-fancy-date-pattern + (concat + (let ((dayname (diary-name-pattern calendar-day-name-array nil t)) + (monthname (diary-name-pattern calendar-month-name-array nil t)) + (day "[0-9]+") + (month "[0-9]+") + (year "-?[0-9]+")) + (mapconcat 'eval calendar-date-display-form "")) + ;; Optional ": holiday name" after the date. + "\\(: .*\\)?") + "Regular expression matching a date header in Fancy Diary.") + +(defconst diary-time-regexp + ;; Accepted formats: 10:00 10.00 10h00 10h 10am 10:00am 10.00am + ;; Use of "." as a separator annoyingly matches numbers, eg "123.45". + ;; Hence often prefix this with "\\(^\\|\\s-\\)." + (concat "[0-9]?[0-9]\\([AaPp][mM]\\|\\(" + "[Hh]\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]" + "\\)\\([AaPp][Mm]\\)?\\)") + "Regular expression matching a time of day.") + +(defface diary-anniversary '((t :inherit font-lock-keyword-face)) + "Face used for anniversaries in the diary." + :version "22.1" + :group 'diary) + +(defface diary-time '((t :inherit font-lock-variable-name-face)) + "Face used for times of day in the diary." + :version "22.1" + :group 'diary) (defvar fancy-diary-font-lock-keywords (list - (cons - (concat - (let ((dayname (diary-name-pattern calendar-day-name-array nil t)) - (monthname (diary-name-pattern calendar-month-name-array nil t)) - (day "[0-9]+") - (month "[0-9]+") - (year "-?[0-9]+")) - (mapconcat 'eval calendar-date-display-form "")) - "\\(\\(: .*\\)\\|\\(\n +.*\\)\\)*\n=+$") - 'diary-face) - '("^.*anniversary.*$" . font-lock-keyword-face) - '("^.*birthday.*$" . font-lock-keyword-face) + (list + ;; Any number of " other holiday name" lines, followed by "==" line. + (concat diary-fancy-date-pattern "\\(\n +.*\\)*\n=+$") + '(0 (progn (put-text-property (match-beginning 0) (match-end 0) + 'font-lock-multiline t) + diary-face))) + '("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary) '("^.*Yahrzeit.*$" . font-lock-reference-face) '("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face) '("^Day.*omer.*$" . font-lock-builtin-face) '("^Parashat.*$" . font-lock-comment-face) - '("^[ \t]*[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)?\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)?\\)?" - . font-lock-variable-name-face)) + `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp + diary-time-regexp) . 'diary-time)) "Keywords to highlight in fancy diary display") +;; If region looks like it might start or end in the middle of a +;; multiline pattern, extend the region to encompass the whole pattern. +(defun diary-fancy-font-lock-fontify-region-function (beg end &optional verbose) + "Function to use for `font-lock-fontify-region-function' in Fancy Diary. +Needed to handle multiline keyword in `fancy-diary-font-lock-keywords'." + (goto-char beg) + (forward-line 0) + (if (looking-at "=+$") (forward-line -1)) + (while (and (looking-at " +[^ ]") + (zerop (forward-line -1)))) + ;; This check not essential. + (if (looking-at diary-fancy-date-pattern) + (setq beg (line-beginning-position))) + (goto-char end) + (forward-line 0) + (while (and (looking-at " +[^ ]") + (zerop (forward-line 1)))) + (if (looking-at "=+$") + (setq end (line-beginning-position 2))) + (font-lock-default-fontify-region beg end verbose)) + +(define-derived-mode fancy-diary-display-mode fundamental-mode + "Diary" + "Major mode used while displaying diary entries using Fancy Display." + (set (make-local-variable 'font-lock-defaults) + '(fancy-diary-font-lock-keywords + t nil nil nil + (font-lock-fontify-region-function + . diary-fancy-font-lock-fontify-region-function))) + (local-set-key "q" 'quit-window)) + (defun diary-font-lock-sexps (limit) "Recognize sexp diary entry for font-locking." @@ -1877,13 +1962,6 @@ names." (eval-when-compile (require 'cal-hebrew) (require 'cal-islam)) -(defconst diary-time-regexp - ;; Formats that should be accepted: - ;; 10:00 10.00 10h00 10h 10am 10:00am 10.00am - (concat "[0-9]?[0-9]\\([AaPp][mM]\\|\\(" - "[Hh]\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]" - "\\)\\([AaPp][Mm]\\)?\\)")) - (defvar diary-font-lock-keywords (append (diary-font-lock-date-forms calendar-month-name-array @@ -1924,10 +2002,9 @@ names." "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)") '(1 font-lock-reference-face)) '(diary-font-lock-sexps . font-lock-keyword-face) - (cons - (concat ;; "^[ \t]+" - diary-time-regexp "\\(-" diary-time-regexp "\\)?") - 'font-lock-function-name-face))) + `(,(concat "\\(^\\|\\s-\\)" + diary-time-regexp "\\(-" diary-time-regexp "\\)?") + . 'diary-time))) "Forms to highlight in `diary-mode'.") diff --git a/lisp/comint.el b/lisp/comint.el index 1b9d8df738f..eb5c9f28a4e 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1047,12 +1047,12 @@ Moves relative to `comint-input-ring-index'." (defun comint-previous-input (arg) "Cycle backwards through input history, saving input." (interactive "*p") - (if (and comint-input-ring-index + (if (and comint-input-ring-index (or ;; leaving the "end" of the ring (and (< arg 0) ; going down (eq comint-input-ring-index 0)) (and (> arg 0) ; going up - (eq comint-input-ring-index + (eq comint-input-ring-index (1- (ring-length comint-input-ring))))) comint-stored-incomplete-input) (comint-restore-input) @@ -1510,23 +1510,23 @@ Similarly for Soar, Scheme, etc." (concat input "\n"))) (let ((beg (marker-position pmark)) - (end (if no-newline (point) (1- (point)))) - (inhibit-modification-hooks t)) + (end (if no-newline (point) (1- (point)))) + (inhibit-modification-hooks t)) (when (> end beg) - ;; Set text-properties for the input field - (add-text-properties - beg end - '(front-sticky t - font-lock-face comint-highlight-input - mouse-face highlight - help-echo "mouse-2: insert after prompt as new input")) + (add-text-properties beg end + '(front-sticky t + font-lock-face comint-highlight-input)) (unless comint-use-prompt-regexp ;; Give old user input a field property of `input', to ;; distinguish it from both process output and unsent ;; input. The terminating newline is put into a special ;; `boundary' field to make cursor movement between input ;; and output fields smoother. - (put-text-property beg end 'field 'input))) + (add-text-properties + beg end + '(mouse-face highlight + help-echo "mouse-2: insert after prompt as new input" + field input)))) (unless (or no-newline comint-use-prompt-regexp) ;; Cover the terminating newline (add-text-properties end (1+ end) @@ -2357,19 +2357,19 @@ preceding newline is removed." (when (eq (get-text-property (1- pt) 'read-only) 'fence) (remove-list-of-text-properties (1- pt) pt '(read-only))))))) -(defun comint-kill-whole-line (&optional arg) +(defun comint-kill-whole-line (&optional count) "Kill current line, ignoring read-only and field properties. -With prefix arg, kill that many lines starting from the current line. -If arg is negative, kill backward. Also kill the preceding newline, +With prefix arg COUNT, kill that many lines starting from the current line. +If COUNT is negative, kill backward. Also kill the preceding newline, instead of the trailing one. \(This is meant to make \\[repeat] work well with negative arguments.) -If arg is zero, kill current line but exclude the trailing newline. +If COUNT is zero, kill current line but exclude the trailing newline. The read-only status of newlines is updated with `comint-update-fence', if necessary." (interactive "p") (let ((inhibit-read-only t) (inhibit-field-text-motion t)) - (kill-whole-line arg) - (when (>= arg 0) (comint-update-fence)))) + (kill-whole-line count) + (when (>= count 0) (comint-update-fence)))) (defun comint-kill-region (beg end &optional yank-handler) "Like `kill-region', but ignores read-only properties, if safe. diff --git a/lisp/complete.el b/lisp/complete.el index 6620db860c3..d0e3fbe8ddf 100644 --- a/lisp/complete.el +++ b/lisp/complete.el @@ -369,7 +369,7 @@ of `minibuffer-completion-table' and the minibuffer contents.") (str (buffer-substring beg end)) (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str))) (ambig nil) - basestr + basestr origstr env-on regex p offset @@ -415,7 +415,7 @@ of `minibuffer-completion-table' and the minibuffer contents.") (file-name-nondirectory dir)) "*/" file)) (setq dir (file-name-directory dir))) - (setq str (concat dir file)))) + (setq origstr str str (concat dir file)))) ;; Look for wildcard expansions in directory name (and filename @@ -443,7 +443,14 @@ of `minibuffer-completion-table' and the minibuffer contents.") (setq str (concat dir (file-name-nondirectory str))) (insert str) (setq end (+ beg (length str))))) - (setq filename nil table nil pred nil)))) + (if origstr + ;; If the wildcards were introduced by us, it's possible + ;; that read-file-name-internal (especially our + ;; PC-include-file advice) can still find matches for the + ;; original string even if we couldn't, so remove the + ;; added wildcards. + (setq str origstr) + (setq filename nil table nil pred nil))))) ;; Strip directory name if appropriate (if filename @@ -943,10 +950,11 @@ absolute rather than relative to some directory on the SEARCH-PATH." (if (string-match "<\\([^\"<>]*\\)>?\\'" (ad-get-arg 0)) (let* ((string (ad-get-arg 0)) (action (ad-get-arg 2)) - (name (substring string (match-beginning 1) (match-end 1))) + (name (match-string 1 string)) (str2 (substring string (match-beginning 0))) (completion-table - (mapcar (lambda (x) (format "<%s>" x)) + (mapcar (lambda (x) + (format (if (string-match "/\\'" x) "<%s" "<%s>") x)) (PC-include-file-all-completions name (PC-include-file-path))))) (setq ad-return-value diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el index 1a8402e06c4..7ea02352b0b 100644 --- a/lisp/diff-mode.el +++ b/lisp/diff-mode.el @@ -438,7 +438,8 @@ If the prefix ARG is given, restrict the view to the current file instead." (firsthunk (ignore-errors (goto-char start) (diff-beginning-of-file) (diff-hunk-next) (point))) - (nextfile (ignore-errors (diff-file-next) (point)))) + (nextfile (ignore-errors (diff-file-next) (point))) + (inhibit-read-only t)) (goto-char start) (if (and firsthunk (= firsthunk start) (or (null nexthunk) @@ -457,7 +458,8 @@ If the prefix ARG is given, restrict the view to the current file instead." (ignore-errors (diff-hunk-prev) (point)))) (index (save-excursion - (re-search-backward "^Index: " prevhunk t)))) + (re-search-backward "^Index: " prevhunk t))) + (inhibit-read-only t)) (when index (setq start index)) (diff-end-of-file) (if (looking-at "^\n") (forward-char 1)) ;`tla' generates such diffs. @@ -497,7 +499,8 @@ If the prefix ARG is given, restrict the view to the current file instead." (let* ((start1 (string-to-number (match-string 1))) (start2 (string-to-number (match-string 2))) (newstart1 (+ start1 (diff-count-matches "^[- \t]" (point) pos))) - (newstart2 (+ start2 (diff-count-matches "^[+ \t]" (point) pos)))) + (newstart2 (+ start2 (diff-count-matches "^[+ \t]" (point) pos))) + (inhibit-read-only t)) (goto-char pos) ;; Hopefully the after-change-function will not screw us over. (insert "@@ -" (number-to-string newstart1) ",1 +" @@ -993,8 +996,7 @@ a diff with \\[diff-reverse-direction]." ;; compile support (set (make-local-variable 'next-error-function) 'diff-next-error) - (when (and (> (point-max) (point-min)) diff-default-read-only) - (toggle-read-only t)) + (setq buffer-read-only diff-default-read-only) ;; setup change hooks (if (not diff-update-on-the-fly) (add-hook 'write-contents-functions 'diff-write-contents-hooks nil t) @@ -1355,6 +1357,7 @@ For use in `add-log-current-defun-function'." (file1 (make-temp-file "diff1")) (file2 (make-temp-file "diff2")) (coding-system-for-read buffer-file-coding-system) + (inhibit-read-only t) old new) (unwind-protect (save-excursion diff --git a/lisp/diff.el b/lisp/diff.el index 221d7b2e363..534a84d4317 100644 --- a/lisp/diff.el +++ b/lisp/diff.el @@ -67,9 +67,10 @@ CODE is the exit code of the process. It should be 0 iff no diffs were found." (if diff-new-temp-file (delete-file diff-new-temp-file)) (save-excursion (goto-char (point-max)) - (insert (format "\nDiff finished%s. %s\n" - (if (equal 0 code) " (no differences)" "") - (current-time-string))))) + (let ((inhibit-read-only t)) + (insert (format "\nDiff finished%s. %s\n" + (if (equal 0 code) " (no differences)" "") + (current-time-string)))))) ;;;###autoload (defun diff (old new &optional switches no-async) @@ -119,7 +120,8 @@ With prefix arg, prompt for diff switches." (set-buffer buf) (setq buffer-read-only nil) (buffer-disable-undo (current-buffer)) - (erase-buffer) + (let ((inhibit-read-only t)) + (erase-buffer)) (buffer-enable-undo (current-buffer)) (diff-mode) (set (make-local-variable 'revert-buffer-function) @@ -128,21 +130,35 @@ With prefix arg, prompt for diff switches." (set (make-local-variable 'diff-old-temp-file) old-alt) (set (make-local-variable 'diff-new-temp-file) new-alt) (setq default-directory thisdir) - (insert command "\n") + (let ((inhibit-read-only t)) + (insert command "\n")) (if (and (not no-async) (fboundp 'start-process)) (progn (setq proc (start-process "Diff" buf shell-file-name shell-command-switch command)) + (set-process-filter proc 'diff-process-filter) (set-process-sentinel proc (lambda (proc msg) (with-current-buffer (process-buffer proc) (diff-sentinel (process-exit-status proc)))))) ;; Async processes aren't available. - (diff-sentinel - (call-process shell-file-name nil buf nil - shell-command-switch command)))) + (let ((inhibit-read-only t)) + (diff-sentinel + (call-process shell-file-name nil buf nil + shell-command-switch command))))) buf)) +(defun diff-process-filter (proc string) + (with-current-buffer (process-buffer proc) + (let ((moving (= (point) (process-mark proc)))) + (save-excursion + ;; Insert the text, advancing the process marker. + (goto-char (process-mark proc)) + (let ((inhibit-read-only t)) + (insert string)) + (set-marker (process-mark proc) (point))) + (if moving (goto-char (process-mark proc)))))) + ;;;###autoload (defun diff-backup (file &optional switches) "Diff this file with its backup file or vice versa. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index e07689973e4..b4cb8933194 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -493,7 +493,8 @@ the Dired buffer, so output files usually are created there instead of in a subdir. In a noninteractive call (from Lisp code), you must specify -the list of file names explicitly with the FILE-LIST argument." +the list of file names explicitly with the FILE-LIST argument, which +can be produced by `dired-get-marked-files', for example." ;;Functions dired-run-shell-command and dired-shell-stuff-it do the ;;actual work and can be redefined for customization. (interactive diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 0a467920f11..4d3734bbd5a 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -251,7 +251,6 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used." (define-key dired-mode-map "*." 'dired-mark-extension) (define-key dired-mode-map "\M-!" 'dired-smart-shell-command) (define-key dired-mode-map "w" 'dired-copy-filename-as-kill) -(define-key dired-mode-map "\M-g" 'dired-goto-file) (define-key dired-mode-map "\M-G" 'dired-goto-subdir) (define-key dired-mode-map "F" 'dired-do-find-marked-files) (define-key dired-mode-map "Y" 'dired-do-relsymlink) diff --git a/lisp/dired.el b/lisp/dired.el index 7209248a75a..64b73184397 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1212,9 +1212,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map "f" 'dired-find-file) (define-key map "\C-m" 'dired-advertised-find-file) (define-key map "g" 'revert-buffer) - (define-key map "\M-g" 'dired-goto-file) (define-key map "h" 'describe-mode) (define-key map "i" 'dired-maybe-insert-subdir) + (define-key map "j" 'dired-goto-file) (define-key map "k" 'dired-do-kill-lines) (define-key map "l" 'dired-do-redisplay) (define-key map "m" 'dired-mark) @@ -1251,9 +1251,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." ;; thumbnail manipulation (tumme) (define-key map "\C-td" 'tumme-display-thumbs) (define-key map "\C-tt" 'tumme-tag-files) - (define-key map "\C-tr" 'tumme-tag-remove) + (define-key map "\C-tr" 'tumme-delete-tag) (define-key map "\C-tj" 'tumme-jump-thumbnail-buffer) - (define-key map "\C-ti" 'tumme-display-dired-image) + (define-key map "\C-ti" 'tumme-dired-display-image) (define-key map "\C-tx" 'tumme-dired-display-external) (define-key map "\C-ta" 'tumme-display-thumbs-append) (define-key map "\C-t." 'tumme-display-thumb) @@ -1305,6 +1305,18 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map [menu-bar immediate] (cons "Immediate" (make-sparse-keymap "Immediate"))) + (define-key map + [menu-bar immediate tumme-dired-display-external] + '(menu-item "Display Image Externally" tumme-dired-display-external + :help "Display image in external viewer")) + (define-key map + [menu-bar immediate tumme-dired-display-image] + '(menu-item "Display Image" tumme-dired-display-image + :help "Display sized image in a separate window")) + + (define-key map [menu-bar immediate dashes-4] + '("--")) + (define-key map [menu-bar immediate revert-buffer] '(menu-item "Refresh" revert-buffer :help "Update contents of shown directories")) @@ -1313,7 +1325,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." '("--")) (define-key map [menu-bar immediate compare-directories] - '(menu-item "Compare directories..." dired-compare-directories + '(menu-item "Compare Directories..." dired-compare-directories :help "Mark files with different attributes in two dired buffers")) (define-key map [menu-bar immediate backup-diff] '(menu-item "Compare with Backup" dired-backup-diff @@ -1341,6 +1353,14 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map [menu-bar regexp] (cons "Regexp" (make-sparse-keymap "Regexp"))) + (define-key map + [menu-bar regexp tumme-mark-tagged-files] + '(menu-item "Mark From Image Tag..." tumme-mark-tagged-files + :help "Mark files whose image tags matches regexp")) + + (define-key map [menu-bar regexp dashes-1] + '("--")) + (define-key map [menu-bar regexp downcase] '(menu-item "Downcase" dired-downcase ;; When running on plain MS-DOS, there's only one @@ -1428,6 +1448,29 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map [menu-bar operate] (cons "Operate" (make-sparse-keymap "Operate"))) + (define-key map [menu-bar operate dashes-2] + '("--")) + + (define-key map + [menu-bar operate tumme-delete-tag] + '(menu-item "Delete Image Tag..." tumme-delete-tag + :help "Delete image tag from current or marked files")) + (define-key map + [menu-bar operate tumme-tag-files] + '(menu-item "Add Image Tags..." tumme-tag-files + :help "Add image tags to current or marked files")) + (define-key map + [menu-bar operate tumme-dired-comment-files] + '(menu-item "Add Image Comment..." tumme-dired-comment-files + :help "Add image comment to current or marked files")) + (define-key map + [menu-bar operate tumme-display-thumbs] + '(menu-item "Display Thumbnails" tumme-display-thumbs + :help "Display thumbnails for current or marked image files")) + + (define-key map [menu-bar operate dashes-3] + '("--")) + (define-key map [menu-bar operate query-replace] '(menu-item "Query Replace in Files..." dired-do-query-replace-regexp :help "Replace regexp in marked files")) @@ -2218,7 +2261,7 @@ instead of `dired-actual-switches'." (forward-line 1)))) (defun dired-goto-file (file) - "Go to file line of FILE in this dired buffer." + "Go to line describing file FILE in this dired buffer." ;; Return value of point on success, else nil. ;; FILE must be an absolute file name. ;; Loses if FILE contains control chars like "\007" for which ls diff --git a/lisp/dnd.el b/lisp/dnd.el index dec57481570..85881b3261f 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -69,39 +69,34 @@ if some action was made, or nil if the URL is ignored." ;; Functions -(defun dnd-handle-one-url (window action arg) +(defun dnd-handle-one-url (window action url) "Handle one dropped url by calling the appropriate handler. The handler is first located by looking at `dnd-protocol-alist'. If no match is found here, and the value of `browse-url-browser-function' is a pair of (REGEXP . FUNCTION), those regexps are tried for a match. If no match is found, just call `dnd-insert-text'. WINDOW is where the drop happend, ACTION is the action for the drop, -ARG is the URL that has been dropped. +URL is what has been dropped. Returns ACTION." (require 'browse-url) - (let* ((uri (replace-regexp-in-string - "%[A-Z0-9][A-Z0-9]" - (lambda (arg) - (format "%c" (string-to-number (substring arg 1) 16))) - arg)) - ret) + (let (ret) (or (catch 'done (dolist (bf dnd-protocol-alist) - (when (string-match (car bf) uri) - (setq ret (funcall (cdr bf) uri action)) + (when (string-match (car bf) url) + (setq ret (funcall (cdr bf) url action)) (throw 'done t))) nil) (when (not (functionp browse-url-browser-function)) (catch 'done (dolist (bf browse-url-browser-function) - (when (string-match (car bf) uri) + (when (string-match (car bf) url) (setq ret 'private) - (funcall (cdr bf) uri action) + (funcall (cdr bf) url action) (throw 'done t))) nil)) (progn - (dnd-insert-text window action uri) + (dnd-insert-text window action url) (setq ret 'private))) ret)) @@ -134,6 +129,11 @@ Return nil if URI is not a local file." ((string-match "^file:" uri) ; Old KDE, Motif, Sun (substring uri (match-end 0)))))) (when (and f must-exist) + (setq f (replace-regexp-in-string + "%[A-Z0-9][A-Z0-9]" + (lambda (arg) + (format "%c" (string-to-number (substring arg 1) 16))) + f nil t)) (let* ((decoded-f (decode-coding-string f (or file-name-coding-system diff --git a/lisp/ediff-diff.el b/lisp/ediff-diff.el index 013ed9073db..7746954292d 100644 --- a/lisp/ediff-diff.el +++ b/lisp/ediff-diff.el @@ -65,8 +65,10 @@ Must produce output compatible with Unix's diff3 program." ;; The following functions needed for setting diff/diff3 options ;; test if diff supports the --binary option (defsubst ediff-test-utility (diff-util option &optional files) - (eq 0 (apply 'call-process - (append (list diff-util nil nil nil option) files)))) + (condition-case () + (eq 0 (apply 'call-process + (append (list diff-util nil nil nil option) files))) + (file-error nil))) (defun ediff-diff-mandatory-option (diff-util) (let ((file (if (boundp 'null-device) null-device "/dev/null"))) @@ -128,10 +130,10 @@ are `-I REGEXP', to ignore changes whose lines match the REGEXP." (defcustom ediff-diff-options "" "*Options to pass to `ediff-diff-program'. -If Unix diff is used as `ediff-diff-program', then a useful option is -`-w', to ignore space, and `-i', to ignore case of letters. -Options `-c' and `-i' are not allowed. Case sensitivity can be toggled -interactively using [ediff-toggle-ignore-case]" +If Unix diff is used as `ediff-diff-program', + then a useful option is `-w', to ignore space. +Options `-c' and `-i' are not allowed. Case sensitivity can be + toggled interactively using \\[ediff-toggle-ignore-case]." :set 'ediff-reset-diff-options :type 'string :group 'ediff-diff) @@ -399,7 +401,7 @@ one optional arguments, diff-number to refine.") (c-prev-pt nil) diff-list shift-A shift-B ) - + ;; diff list contains word numbers, unless changed later (setq diff-list (cons (if word-mode 'words 'points) diff-list)) @@ -411,7 +413,7 @@ one optional arguments, diff-number to refine.") shift-B (ediff-overlay-start (ediff-get-value-according-to-buffer-type 'B bounds)))) - + ;; reset point in buffers A/B/C (ediff-with-current-buffer A-buffer (goto-char (if shift-A shift-A (point-min)))) @@ -1525,7 +1527,7 @@ affects only files whose names match the expression." (ediff-barf-if-not-control-buffer) (setq ediff-ignore-case (not ediff-ignore-case)) (cond (ediff-ignore-case - (setq ediff-actual-diff-options + (setq ediff-actual-diff-options (concat ediff-diff-options " " ediff-ignore-case-option) ediff-actual-diff3-options (concat ediff-diff3-options " " ediff-ignore-case-option3)) diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 486a3b049ae..d03245bf452 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2350,6 +2350,7 @@ FUNCTION was not advised)." (ad-advice-set-enabled advice flag)))))) matched-advices))) +;;;###autoload (defun ad-enable-advice (function class name) "Enables the advice of FUNCTION with CLASS and NAME." (interactive (ad-read-advice-specification "Enable advice of")) @@ -2359,6 +2360,7 @@ FUNCTION was not advised)." function class name)) (error "ad-enable-advice: `%s' is not advised" function))) +;;;###autoload (defun ad-disable-advice (function class name) "Disable the advice of FUNCTION with CLASS and NAME." (interactive (ad-read-advice-specification "Disable advice of")) @@ -3585,6 +3587,7 @@ the value of `ad-redefinition-action' and de/activate again." ;; @@ The top-level advice interface: ;; ================================== +;;;###autoload (defun ad-activate (function &optional compile) "Activate all the advice information of an advised FUNCTION. If FUNCTION has a proper original definition then an advised diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el index 0d38ba03241..7ab0101b2a5 100644 --- a/lisp/emacs-lisp/authors.el +++ b/lisp/emacs-lisp/authors.el @@ -42,6 +42,7 @@ files.") (defconst authors-aliases '( + ("Andrew Csillag" "Drew Csillag") ("Barry A. Warsaw" "Barry A. Warsaw, Century Computing, Inc." "Barry A. Warsaw, ITB" "Barry Warsaw") ("Bj,Av(Brn Torkelsson" "Bjorn Torkelsson") @@ -118,6 +119,7 @@ files.") ("Roland B. Roberts" "Roland B Roberts" "Roland Roberts") ("Rui-Tao Dong" "Rui-Tao Dong ~{6-Hpln~}") ("Sam Steingold" "Sam Shteingold") + ("Satyaki Das" "Indexed search by Satyaki Das") ("Stefan Monnier" "Stefan") ("Stephen A. Wood" "(saw@cebaf.gov)") ("Steven L. Baur" "SL Baur" "Steven L Baur") @@ -128,6 +130,7 @@ files.") ("Torbj,Av(Brn Einarsson" "Torbj.*rn Einarsson") ("Toru Tomabechi" "Toru Tomabechi,") ("Vincent Del Vecchio" "Vince Del Vecchio") + ("William M. Perry" "Bill Perry") ("Wlodzimierz Bzyl" "W.*dek Bzyl") ("Yutaka NIIBE" "NIIBE Yutaka") ) @@ -269,7 +272,7 @@ Changes to files in this list are not listed.") ("Morten Welinder" :wrote "dosfns.c" "[many MSDOS files]" "msdos.h") ("Pace Willisson" :wrote "ispell.el") ("Garrett Wollman" :changed "sendmail.el") - ("Dale Worley" :changed "mail-extr.el") + ("Dale R. Worley" :changed "mail-extr.el") ("Jamie Zawinski" :changed "bytecode.c" :wrote "disass.el" "tar-mode.el")) "Actions taken from the original, manually (un)maintained AUTHORS file.") @@ -355,7 +358,9 @@ the file name." (setq rules (cdr rules)))))) (setq authors-checked-files-alist (cons (cons file valid) authors-checked-files-alist)) - (unless valid + (unless (or valid + (string-match "[*]" file) + (string-match "^[0-9.]+$" file)) (setq authors-invalid-file-names (cons (format "%s:%d: unrecognized `%s' for %s" log-file diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index ee2d74c5646..76699f10df8 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -273,12 +273,30 @@ which lists the file name and which functions are in it, etc." (or (eolp) (insert "\n" generate-autoload-section-continuation)))))) +(defun autoload-find-file (file) + "Fetch file and put it in a temp buffer. Return the buffer." + ;; It is faster to avoid visiting the file. + (with-current-buffer (get-buffer-create " *autoload-file*") + (kill-all-local-variables) + (erase-buffer) + (setq buffer-undo-list t + buffer-read-only nil) + (emacs-lisp-mode) + (insert-file-contents file nil) + (let ((enable-local-variables :safe)) + (hack-local-variables)) + (current-buffer))) + +(defvar no-update-autoloads nil + "File local variable to prevent scanning this file for autoload cookies.") + (defun generate-file-autoloads (file) "Insert at point a loaddefs autoload section for FILE. -autoloads are generated for defuns and defmacros in FILE +Autoloads are generated for defuns and defmacros in FILE marked by `generate-autoload-cookie' (which see). If FILE is being visited in a buffer, the contents of the buffer -are used." +are used. +Return non-nil in the case where no autoloads were added at point." (interactive "fGenerate autoloads for file: ") (let ((outbuf (current-buffer)) (autoloads-done '()) @@ -291,7 +309,7 @@ are used." (float-output-format nil) (done-any nil) (visited (get-file-buffer file)) - output-end) + output-start) ;; If the autoload section we create here uses an absolute ;; file name for FILE in its header, and then Emacs is installed @@ -309,76 +327,70 @@ are used." (string= dir-truename (substring source-truename 0 len))) (setq file (substring source-truename len)))) - (message "Generating autoloads for %s..." file) - (save-excursion - (unwind-protect - (progn - (if visited - (set-buffer visited) - ;; It is faster to avoid visiting the file. - (set-buffer (get-buffer-create " *generate-autoload-file*")) - (kill-all-local-variables) - (erase-buffer) - (setq buffer-undo-list t - buffer-read-only nil) - (emacs-lisp-mode) - (insert-file-contents file nil)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward " \t\n\f") - (cond - ((looking-at (regexp-quote generate-autoload-cookie)) - (search-forward generate-autoload-cookie) - (skip-chars-forward " \t") - (setq done-any t) - (if (eolp) - ;; Read the next form and make an autoload. - (let* ((form (prog1 (read (current-buffer)) - (or (bolp) (forward-line 1)))) - (autoload (make-autoload form load-name))) - (if autoload - (setq autoloads-done (cons (nth 1 form) - autoloads-done)) - (setq autoload form)) - (let ((autoload-print-form-outbuf outbuf)) - (autoload-print-form autoload))) - - ;; Copy the rest of the line to the output. - (princ (buffer-substring - (progn - ;; Back up over whitespace, to preserve it. - (skip-chars-backward " \f\t") - (if (= (char-after (1+ (point))) ? ) - ;; Eat one space. - (forward-char 1)) - (point)) - (progn (forward-line 1) (point))) - outbuf))) - ((looking-at ";") - ;; Don't read the comment. - (forward-line 1)) - (t - (forward-sexp 1) - (forward-line 1))))))) - (or visited - ;; We created this buffer, so we should kill it. - (kill-buffer (current-buffer))) - (set-buffer outbuf) - (setq output-end (point-marker)))) - (if done-any - (progn - ;; Insert the section-header line - ;; which lists the file name and which functions are in it, etc. - (autoload-insert-section-header outbuf autoloads-done load-name file - (nth 5 (file-attributes file))) - (insert ";;; Generated autoloads from " - (autoload-trim-file-name file) "\n") - (goto-char output-end) - (insert generate-autoload-section-trailer))) - (message "Generating autoloads for %s...done" file))) + (with-current-buffer (or visited + ;; It is faster to avoid visiting the file. + (autoload-find-file file)) + ;; Obey the no-update-autoloads file local variable. + (unless no-update-autoloads + (message "Generating autoloads for %s..." file) + (setq output-start (with-current-buffer outbuf (point))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward " \t\n\f") + (cond + ((looking-at (regexp-quote generate-autoload-cookie)) + (search-forward generate-autoload-cookie) + (skip-chars-forward " \t") + (setq done-any t) + (if (eolp) + ;; Read the next form and make an autoload. + (let* ((form (prog1 (read (current-buffer)) + (or (bolp) (forward-line 1)))) + (autoload (make-autoload form load-name))) + (if autoload + (push (nth 1 form) autoloads-done) + (setq autoload form)) + (let ((autoload-print-form-outbuf outbuf)) + (autoload-print-form autoload))) + + ;; Copy the rest of the line to the output. + (princ (buffer-substring + (progn + ;; Back up over whitespace, to preserve it. + (skip-chars-backward " \f\t") + (if (= (char-after (1+ (point))) ? ) + ;; Eat one space. + (forward-char 1)) + (point)) + (progn (forward-line 1) (point))) + outbuf))) + ((looking-at ";") + ;; Don't read the comment. + (forward-line 1)) + (t + (forward-sexp 1) + (forward-line 1)))))) + + (when done-any + (with-current-buffer outbuf + (save-excursion + ;; Insert the section-header line which lists the file name + ;; and which functions are in it, etc. + (goto-char output-start) + (autoload-insert-section-header + outbuf autoloads-done load-name file + (nth 5 (file-attributes file))) + (insert ";;; Generated autoloads from " + (autoload-trim-file-name file) "\n")) + (insert generate-autoload-section-trailer))) + (message "Generating autoloads for %s...done" file)) + (or visited + ;; We created this buffer, so we should kill it. + (kill-buffer (current-buffer)))) + (not done-any))) ;;;###autoload (defun update-file-autoloads (file &optional save-after) @@ -457,37 +469,7 @@ Autoload section for %s is up to date." (goto-char (point-max)) (search-backward "\f" nil t))) (or (eq found 'up-to-date) - (and (eq found 'new) - ;; Check that FILE has any cookies before generating a - ;; new section for it. - (save-excursion - (if existing-buffer - (set-buffer existing-buffer) - ;; It is faster to avoid visiting the file. - (set-buffer (get-buffer-create " *autoload-file*")) - (kill-all-local-variables) - (erase-buffer) - (setq buffer-undo-list t - buffer-read-only nil) - (emacs-lisp-mode) - (insert-file-contents file nil)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (prog1 - (if (re-search-forward - (concat "^" (regexp-quote - generate-autoload-cookie)) - nil t) - nil - (if (interactive-p) - (message "%s has no autoloads" file)) - (setq no-autoloads t) - t) - (or existing-buffer - (kill-buffer (current-buffer)))))))) - (generate-file-autoloads file)))) + (setq no-autoloads (generate-file-autoloads file))))) (and save-after (buffer-modified-p) (save-buffer)) diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index 455b049dc8a..d05eed2c4a2 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -171,8 +171,8 @@ ;; | INTEGER_CONSTANT ;; | DEREF -;; DEREF ::= ( [NAME | INTEGER]... ) -- Field NAME or Array index relative to -;; current structure spec. +;; DEREF ::= ( [NAME | INTEGER]... ) -- Field NAME or Array index relative +;; to current structure spec. ;; -- see bindat-get-field ;; A `union' specification @@ -188,23 +188,20 @@ ;; ([FIELD] eval FORM) ;; is interpreted by evalling FORM for its side effects only. ;; If FIELD is specified, the value is bound to that field. -;; The FORM may access and update `raw-data' and `pos' (see `bindat-unpack'), -;; as well as the lisp data structure in `struct'. +;; The FORM may access and update `bindat-raw' and `bindat-idx' (see `bindat-unpack'). ;;; Code: ;; Helper functions for structure unpacking. -;; Relies on dynamic binding of RAW-DATA and POS +;; Relies on dynamic binding of BINDAT-RAW and BINDAT-IDX -(defvar raw-data) -(defvar pos) +(defvar bindat-raw) +(defvar bindat-idx) (defun bindat--unpack-u8 () (prog1 - (if (stringp raw-data) - (string-to-char (substring raw-data pos (1+ pos))) - (aref raw-data pos)) - (setq pos (1+ pos)))) + (aref bindat-raw bindat-idx) + (setq bindat-idx (1+ bindat-idx)))) (defun bindat--unpack-u16 () (let* ((a (bindat--unpack-u8)) (b (bindat--unpack-u8))) @@ -261,16 +258,16 @@ j (lsh j -1))))) bits)) ((eq type 'str) - (let ((s (substring raw-data pos (+ pos len)))) - (setq pos (+ pos len)) + (let ((s (substring bindat-raw bindat-idx (+ bindat-idx len)))) + (setq bindat-idx (+ bindat-idx len)) (if (stringp s) s (string-make-unibyte (concat s))))) ((eq type 'strz) (let ((i 0) s) - (while (and (< i len) (/= (aref raw-data (+ pos i)) 0)) + (while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0)) (setq i (1+ i))) - (setq s (substring raw-data pos (+ pos i))) - (setq pos (+ pos len)) + (setq s (substring bindat-raw bindat-idx (+ bindat-idx i))) + (setq bindat-idx (+ bindat-idx len)) (if (stringp s) s (string-make-unibyte (concat s))))) ((eq type 'vec) @@ -312,10 +309,10 @@ (setq data (eval len)) (eval len))) ((eq type 'fill) - (setq pos (+ pos len))) + (setq bindat-idx (+ bindat-idx len))) ((eq type 'align) - (while (/= (% pos len) 0) - (setq pos (1+ pos)))) + (while (/= (% bindat-idx len) 0) + (setq bindat-idx (1+ bindat-idx)))) ((eq type 'struct) (setq data (bindat--unpack-group (eval len)))) ((eq type 'repeat) @@ -343,11 +340,13 @@ (setq struct (append data struct)))))) struct)) -(defun bindat-unpack (spec raw-data &optional pos) - "Return structured data according to SPEC for binary data in RAW-DATA. -RAW-DATA is a string or vector. Optional third arg POS specifies the -starting offset in RAW-DATA." - (unless pos (setq pos 0)) +(defun bindat-unpack (spec bindat-raw &optional bindat-idx) + "Return structured data according to SPEC for binary data in BINDAT-RAW. +BINDAT-RAW is a unibyte string or vector. Optional third arg BINDAT-IDX specifies +the starting offset in BINDAT-RAW." + (when (multibyte-string-p bindat-raw) + (error "String is multibyte")) + (unless bindat-idx (setq bindat-idx 0)) (bindat--unpack-group spec)) (defun bindat-get-field (struct &rest field) @@ -366,7 +365,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." struct) -;; Calculate raw-data length of structured data +;; Calculate bindat-raw length of structured data (defvar bindat--fixed-length-alist '((u8 . 1) (byte . 1) @@ -405,17 +404,19 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (setq struct (cons (cons field (eval len)) struct)) (eval len))) ((eq type 'fill) - (setq pos (+ pos len))) + (setq bindat-idx (+ bindat-idx len))) ((eq type 'align) - (while (/= (% pos len) 0) - (setq pos (1+ pos)))) + (while (/= (% bindat-idx len) 0) + (setq bindat-idx (1+ bindat-idx)))) ((eq type 'struct) (bindat--length-group (if field (bindat-get-field struct field) struct) (eval len))) ((eq type 'repeat) (let ((index 0)) (while (< index len) - (bindat--length-group (nth index (bindat-get-field struct field)) (nthcdr tail item)) + (bindat--length-group + (nth index (bindat-get-field struct field)) + (nthcdr tail item)) (setq index (1+ index))))) ((eq type 'union) (let ((tag len) (cases (nthcdr tail item)) case cc) @@ -433,25 +434,25 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (setq len (cdr type))) (if field (setq last (bindat-get-field struct field))) - (setq pos (+ pos len)))))))) + (setq bindat-idx (+ bindat-idx len)))))))) (defun bindat-length (spec struct) - "Calculate raw-data length for STRUCT according to bindat specification SPEC." - (let ((pos 0)) + "Calculate bindat-raw length for STRUCT according to bindat SPEC." + (let ((bindat-idx 0)) (bindat--length-group struct spec) - pos)) + bindat-idx)) -;; Pack structured data into raw-data +;; Pack structured data into bindat-raw (defun bindat--pack-u8 (v) - (aset raw-data pos (logand v 255)) - (setq pos (1+ pos))) + (aset bindat-raw bindat-idx (logand v 255)) + (setq bindat-idx (1+ bindat-idx))) (defun bindat--pack-u16 (v) - (aset raw-data pos (logand (lsh v -8) 255)) - (aset raw-data (1+ pos) (logand v 255)) - (setq pos (+ pos 2))) + (aset bindat-raw bindat-idx (logand (lsh v -8) 255)) + (aset bindat-raw (1+ bindat-idx) (logand v 255)) + (setq bindat-idx (+ bindat-idx 2))) (defun bindat--pack-u24 (v) (bindat--pack-u8 (lsh v -16)) @@ -462,9 +463,9 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (bindat--pack-u16 v)) (defun bindat--pack-u16r (v) - (aset raw-data (1+ pos) (logand (lsh v -8) 255)) - (aset raw-data pos (logand v 255)) - (setq pos (+ pos 2))) + (aset bindat-raw (1+ bindat-idx) (logand (lsh v -8) 255)) + (aset bindat-raw bindat-idx (logand v 255)) + (setq bindat-idx (+ bindat-idx 2))) (defun bindat--pack-u24r (v) (bindat--pack-u16r v) @@ -479,7 +480,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (setq type 'vec len 4)) (cond ((null v) - (setq pos (+ pos len))) + (setq bindat-idx (+ bindat-idx len))) ((memq type '(u8 byte)) (bindat--pack-u8 v)) ((memq type '(u16 word short)) @@ -511,11 +512,11 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (let ((l (length v)) (i 0)) (if (> l len) (setq l len)) (while (< i l) - (aset raw-data (+ pos i) (aref v i)) + (aset bindat-raw (+ bindat-idx i) (aref v i)) (setq i (1+ i))) - (setq pos (+ pos len)))) + (setq bindat-idx (+ bindat-idx len)))) (t - (setq pos (+ pos len))))) + (setq bindat-idx (+ bindat-idx len))))) (defun bindat--pack-group (struct spec) (let (last) @@ -547,17 +548,19 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (setq struct (cons (cons field (eval len)) struct)) (eval len))) ((eq type 'fill) - (setq pos (+ pos len))) + (setq bindat-idx (+ bindat-idx len))) ((eq type 'align) - (while (/= (% pos len) 0) - (setq pos (1+ pos)))) + (while (/= (% bindat-idx len) 0) + (setq bindat-idx (1+ bindat-idx)))) ((eq type 'struct) (bindat--pack-group (if field (bindat-get-field struct field) struct) (eval len))) ((eq type 'repeat) (let ((index 0)) (while (< index len) - (bindat--pack-group (nth index (bindat-get-field struct field)) (nthcdr tail item)) + (bindat--pack-group + (nth index (bindat-get-field struct field)) + (nthcdr tail item)) (setq index (1+ index))))) ((eq type 'union) (let ((tag len) (cases (nthcdr tail item)) case cc) @@ -575,17 +578,19 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (bindat--pack-item last type len) )))))) -(defun bindat-pack (spec struct &optional raw-data pos) +(defun bindat-pack (spec struct &optional bindat-raw bindat-idx) "Return binary data packed according to SPEC for structured data STRUCT. -Optional third arg RAW-DATA is a pre-allocated string or vector to unpack into. -Optional fourth arg POS is the starting offset into RAW-DATA. -Note: The result is a multibyte string; use `string-make-unibyte' on it -to make it unibyte if necessary." - (let ((no-return raw-data)) - (unless pos (setq pos 0)) - (unless raw-data (setq raw-data (make-vector (+ pos (bindat-length spec struct)) 0))) +Optional third arg BINDAT-RAW is a pre-allocated unibyte string or vector to +pack into. +Optional fourth arg BINDAT-IDX is the starting offset into BINDAT-RAW." + (when (multibyte-string-p bindat-raw) + (error "Pre-allocated string is multibyte")) + (let ((no-return bindat-raw)) + (unless bindat-idx (setq bindat-idx 0)) + (unless bindat-raw + (setq bindat-raw (make-vector (+ bindat-idx (bindat-length spec struct)) 0))) (bindat--pack-group struct spec) - (if no-return nil (concat raw-data)))) + (if no-return nil (concat bindat-raw)))) ;; Misc. format conversions diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el index fa85ce21fb0..b4857f4310d 100644 --- a/lisp/emacs-lisp/ewoc.el +++ b/lisp/emacs-lisp/ewoc.el @@ -88,34 +88,7 @@ ;; limit! It is even possible to have another ewoc as an ;; element. In that way some kind of tree hierarchy can be created. ;; -;; Full documentation will, God willing, soon be available in a -;; Texinfo manual. - -;; In the mean time `grep '^(.*ewoc-[^-]' emacs-lisp/ewoc.el' can help -;; you find all the exported functions: -;; -;; (defun ewoc-create (pretty-printer &optional header footer) -;; (defalias 'ewoc-data 'ewoc--node-data) -;; (defun ewoc-location (node) -;; (defun ewoc-enter-first (ewoc data) -;; (defun ewoc-enter-last (ewoc data) -;; (defun ewoc-enter-after (ewoc node data) -;; (defun ewoc-enter-before (ewoc node data) -;; (defun ewoc-next (ewoc node) -;; (defun ewoc-prev (ewoc node) -;; (defun ewoc-nth (ewoc n) -;; (defun ewoc-map (map-function ewoc &rest args) -;; (defun ewoc-filter (ewoc predicate &rest args) -;; (defun ewoc-locate (ewoc &optional pos guess) -;; (defun ewoc-invalidate (ewoc &rest nodes) -;; (defun ewoc-goto-prev (ewoc arg) -;; (defun ewoc-goto-next (ewoc arg) -;; (defun ewoc-goto-node (ewoc node) -;; (defun ewoc-refresh (ewoc) -;; (defun ewoc-collect (ewoc predicate &rest args) -;; (defun ewoc-buffer (ewoc) -;; (defun ewoc-get-hf (ewoc) -;; (defun ewoc-set-hf (ewoc header footer) +;; The Emacs Lisp Reference Manual documents ewoc.el's "public interface". ;; Coding conventions ;; ================== @@ -123,48 +96,43 @@ ;; All functions of course start with `ewoc'. Functions and macros ;; starting with the prefix `ewoc--' are meant for internal use, ;; while those starting with `ewoc-' are exported for public use. -;; There are currently no global or buffer-local variables used. - ;;; Code: -(eval-when-compile (require 'cl)) ;because of CL compiler macros - -;; The doubly linked list is implemented as a circular list -;; with a dummy node first and last. The dummy node is used as -;; "the dll" (or rather is the dll handle passed around). +(eval-when-compile (require 'cl)) +;; The doubly linked list is implemented as a circular list with a dummy +;; node first and last. The dummy node is used as "the dll". (defstruct (ewoc--node - (:type vector) ;required for ewoc--node-branch hack + (:type vector) ;ewoc--node-nth needs this + (:constructor nil) (:constructor ewoc--node-create (start-marker data))) left right data start-marker) -(defalias 'ewoc--node-branch 'aref - "Get the left (CHILD=0) or right (CHILD=1) child of the NODE. - -\(fn NODE CHILD)") - (defun ewoc--node-next (dll node) "Return the node after NODE, or nil if NODE is the last node." - (unless (eq (ewoc--node-right node) dll) (ewoc--node-right node))) + (let ((R (ewoc--node-right node))) + (unless (eq dll R) R))) (defun ewoc--node-prev (dll node) "Return the node before NODE, or nil if NODE is the first node." - (unless (eq (ewoc--node-left node) dll) (ewoc--node-left node))) + (let ((L (ewoc--node-left node))) + (unless (eq dll L) L))) (defun ewoc--node-nth (dll n) - "Return the Nth node from the doubly linked list DLL. -N counts from zero. If DLL is not that long, nil is returned. -If N is negative, return the -(N+1)th last element. + "Return the Nth node from the doubly linked list `dll'. +N counts from zero. If N is negative, return the -(N+1)th last element. +If N is out of range, return nil. Thus, (ewoc--node-nth dll 0) returns the first node, and (ewoc--node-nth dll -1) returns the last node." + ;; Presuming a node is ":type vector", starting with `left' and `right': ;; Branch 0 ("follow left pointer") is used when n is negative. ;; Branch 1 ("follow right pointer") is used otherwise. (let* ((branch (if (< n 0) 0 1)) - (node (ewoc--node-branch dll branch))) + (node (aref dll branch))) (if (< n 0) (setq n (- -1 n))) (while (and (not (eq dll node)) (> n 0)) - (setq node (ewoc--node-branch node branch)) + (setq node (aref node branch)) (setq n (1- n))) (unless (eq dll node) node))) @@ -177,16 +145,15 @@ and (ewoc--node-nth dll -1) returns the last node." (defstruct (ewoc (:constructor nil) - (:constructor ewoc--create - (buffer pretty-printer header footer dll)) + (:constructor ewoc--create (buffer pretty-printer dll)) (:conc-name ewoc--)) - buffer pretty-printer header footer dll last-node) + buffer pretty-printer header footer dll last-node hf-pp) (defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms) "Execute FORMS with ewoc--buffer selected as current buffer, -dll bound to ewoc--dll, and VARLIST bound as in a let*. -dll will be bound when VARLIST is initialized, but the current -buffer will *not* have been changed. +`dll' bound to the dll, and VARLIST bound as in a let*. +`dll' will be bound when VARLIST is initialized, but +the current buffer will *not* have been changed. Return value of last form in FORMS." (let ((hnd (make-symbol "ewoc"))) `(let* ((,hnd ,ewoc) @@ -205,45 +172,63 @@ BUT if it is the header or the footer in EWOC return nil instead." (eq node (ewoc--footer ewoc))) node)) +(defun ewoc--adjust (beg end node dll) + ;; "Manually reseat" markers for NODE and its successors (including footer + ;; and dll), in the case where they originally shared start position with + ;; BEG, to END. BEG and END are buffer positions describing NODE's left + ;; neighbor. This operation is functionally equivalent to temporarily + ;; setting these nodes' markers' insertion type to t around the pretty-print + ;; call that precedes the call to `ewoc--adjust', and then changing them back + ;; to nil. + (when (< beg end) + (let (m) + (while (and (= beg (setq m (ewoc--node-start-marker node))) + ;; The "dummy" node `dll' actually holds the marker that + ;; points to the end of the footer, so we check `dll' + ;; *after* reseating the marker. + (progn + (set-marker m end) + (not (eq dll node)))) + (setq node (ewoc--node-right node)))))) + (defun ewoc--insert-new-node (node data pretty-printer) "Insert before NODE a new node for DATA, displayed by PRETTY-PRINTER. Call PRETTY-PRINTER with point at NODE's start, thus pushing back NODE and leaving the new node's start there. Return the new node." (save-excursion - (let* ((inhibit-read-only t) - (m (copy-marker (ewoc--node-start-marker node))) - (pos (marker-position m)) - (elemnode (ewoc--node-create m data))) - (goto-char pos) - ;; Insert the trailing newline using insert-before-markers - ;; so that the start position for the next element is updated. - (insert-before-markers ?\n) - ;; Move back, and call the pretty-printer. - (backward-char 1) - (funcall pretty-printer data) - (setf (marker-position m) pos - (ewoc--node-left elemnode) (ewoc--node-left node) + (let ((elemnode (ewoc--node-create + (copy-marker (ewoc--node-start-marker node)) data))) + (setf (ewoc--node-left elemnode) (ewoc--node-left node) (ewoc--node-right elemnode) node (ewoc--node-right (ewoc--node-left node)) elemnode (ewoc--node-left node) elemnode) + (ewoc--refresh-node pretty-printer elemnode dll) elemnode))) -(defun ewoc--refresh-node (pp node) +(defun ewoc--refresh-node (pp node dll) "Redisplay the element represented by NODE using the pretty-printer PP." - (let ((inhibit-read-only t)) + (let ((inhibit-read-only t) + (m (ewoc--node-start-marker node)) + (R (ewoc--node-right node))) ;; First, remove the string from the buffer: - (delete-region (ewoc--node-start-marker node) - (1- (marker-position - (ewoc--node-start-marker (ewoc--node-right node))))) + (delete-region m (ewoc--node-start-marker R)) ;; Calculate and insert the string. - (goto-char (ewoc--node-start-marker node)) - (funcall pp (ewoc--node-data node)))) + (goto-char m) + (funcall pp (ewoc--node-data node)) + (ewoc--adjust m (point) R dll))) + +(defun ewoc--wrap (func) + (lexical-let ((ewoc--user-pp func)) + (lambda (data) + (funcall ewoc--user-pp data) + (insert "\n")))) + ;;; =========================================================================== ;;; Public members of the Ewoc package - -(defun ewoc-create (pretty-printer &optional header footer) +;;;###autoload +(defun ewoc-create (pretty-printer &optional header footer nosep) "Create an empty ewoc. The ewoc will be inserted in the current buffer at the current position. @@ -251,21 +236,25 @@ The ewoc will be inserted in the current buffer at the current position. PRETTY-PRINTER should be a function that takes one argument, an element, and inserts a string representing it in the buffer (at point). The string PRETTY-PRINTER inserts may be empty or span -several lines. A trailing newline will always be inserted -automatically. The PRETTY-PRINTER should use `insert', and not +several lines. The PRETTY-PRINTER should use `insert', and not `insert-before-markers'. -Optional second argument HEADER is a string that will always be -present at the top of the ewoc. HEADER should end with a -newline. Optional third argument FOOTER is similar, and will -be inserted at the bottom of the ewoc." +Optional second and third arguments HEADER and FOOTER are strings, +possibly empty, that will always be present at the top and bottom, +respectively, of the ewoc. + +Normally, a newline is automatically inserted after the header, +the footer and every node's printed representation. Optional +fourth arg NOSEP non-nil inhibits this." (let* ((dummy-node (ewoc--node-create 'DL-LIST 'DL-LIST)) (dll (progn (setf (ewoc--node-right dummy-node) dummy-node) (setf (ewoc--node-left dummy-node) dummy-node) dummy-node)) - (new-ewoc - (ewoc--create (current-buffer) - pretty-printer nil nil dll)) + (wrap (if nosep 'identity 'ewoc--wrap)) + (new-ewoc (ewoc--create (current-buffer) + (funcall wrap pretty-printer) + dll)) + (hf-pp (funcall wrap 'insert)) (pos (point)) head foot) (ewoc--set-buffer-bind-dll new-ewoc @@ -273,8 +262,9 @@ be inserted at the bottom of the ewoc." (unless header (setq header "")) (unless footer (setq footer "")) (setf (ewoc--node-start-marker dll) (copy-marker pos) - foot (ewoc--insert-new-node dll footer 'insert) - head (ewoc--insert-new-node foot header 'insert) + foot (ewoc--insert-new-node dll footer hf-pp) + head (ewoc--insert-new-node foot header hf-pp) + (ewoc--hf-pp new-ewoc) hf-pp (ewoc--footer new-ewoc) foot (ewoc--header new-ewoc) head)) ;; Return the ewoc @@ -285,6 +275,10 @@ be inserted at the bottom of the ewoc." \(fn NODE)") +(defun ewoc-set-data (node data) + "Set NODE to encapsulate DATA." + (setf (ewoc--node-data node) data)) + (defun ewoc-enter-first (ewoc data) "Enter DATA first in EWOC. Return the new node." @@ -297,7 +291,6 @@ Return the new node." (ewoc--set-buffer-bind-dll ewoc (ewoc-enter-before ewoc (ewoc--node-nth dll -1) data))) - (defun ewoc-enter-after (ewoc node data) "Enter a new element DATA after NODE in EWOC. Return the new node." @@ -322,21 +315,19 @@ Return nil if NODE is nil or the last element." Return nil if NODE is nil or the first element." (when node (ewoc--filter-hf-nodes - ewoc - (ewoc--node-prev (ewoc--dll ewoc) node)))) - + ewoc (ewoc--node-prev (ewoc--dll ewoc) node)))) (defun ewoc-nth (ewoc n) "Return the Nth node. N counts from zero. Return nil if there is less than N elements. If N is negative, return the -(N+1)th last element. -Thus, (ewoc-nth dll 0) returns the first node, -and (ewoc-nth dll -1) returns the last node. +Thus, (ewoc-nth ewoc 0) returns the first node, +and (ewoc-nth ewoc -1) returns the last node. Use `ewoc-data' to extract the data from the node." ;; Skip the header (or footer, if n is negative). (setq n (if (< n 0) (1- n) (1+ n))) (ewoc--filter-hf-nodes ewoc - (ewoc--node-nth (ewoc--dll ewoc) n))) + (ewoc--node-nth (ewoc--dll ewoc) n))) (defun ewoc-map (map-function ewoc &rest args) "Apply MAP-FUNCTION to all elements in EWOC. @@ -352,13 +343,35 @@ If more than two arguments are given, the remaining arguments will be passed to MAP-FUNCTION." (ewoc--set-buffer-bind-dll-let* ewoc ((footer (ewoc--footer ewoc)) + (pp (ewoc--pretty-printer ewoc)) (node (ewoc--node-nth dll 1))) (save-excursion (while (not (eq node footer)) (if (apply map-function (ewoc--node-data node) args) - (ewoc--refresh-node (ewoc--pretty-printer ewoc) node)) + (ewoc--refresh-node pp node dll)) (setq node (ewoc--node-next dll node)))))) +(defun ewoc-delete (ewoc &rest nodes) + "Delete NODES from EWOC." + (ewoc--set-buffer-bind-dll-let* ewoc + ((L nil) (R nil) (last (ewoc--last-node ewoc))) + (dolist (node nodes) + ;; If we are about to delete the node pointed at by last-node, + ;; set last-node to nil. + (when (eq last node) + (setf last nil (ewoc--last-node ewoc) nil)) + (delete-region (ewoc--node-start-marker node) + (ewoc--node-start-marker (ewoc--node-next dll node))) + (set-marker (ewoc--node-start-marker node) nil) + (setf L (ewoc--node-left node) + R (ewoc--node-right node) + ;; Link neighbors to each other. + (ewoc--node-right L) R + (ewoc--node-left R) L + ;; Forget neighbors. + (ewoc--node-left node) nil + (ewoc--node-right node) nil)))) + (defun ewoc-filter (ewoc predicate &rest args) "Remove all elements in EWOC for which PREDICATE returns nil. Note that the buffer for EWOC will be current-buffer when PREDICATE @@ -369,28 +382,13 @@ ARGS are given they will be passed to the PREDICATE." (ewoc--set-buffer-bind-dll-let* ewoc ((node (ewoc--node-nth dll 1)) (footer (ewoc--footer ewoc)) - (next nil) - (L nil) (R nil) + (goodbye nil) (inhibit-read-only t)) (while (not (eq node footer)) - (setq next (ewoc--node-next dll node)) (unless (apply predicate (ewoc--node-data node) args) - ;; If we are about to delete the node pointed at by last-node, - ;; set last-node to nil. - (if (eq (ewoc--last-node ewoc) node) - (setf (ewoc--last-node ewoc) nil)) - (delete-region (ewoc--node-start-marker node) - (ewoc--node-start-marker (ewoc--node-next dll node))) - (set-marker (ewoc--node-start-marker node) nil) - (setf L (ewoc--node-left node) - R (ewoc--node-right node) - ;; Link neighbors to each other. - (ewoc--node-right L) R - (ewoc--node-left R) L - ;; Forget neighbors. - (ewoc--node-left node) nil - (ewoc--node-right node) nil)) - (setq node next)))) + (push node goodbye)) + (setq node (ewoc--node-next dll node))) + (apply 'ewoc-delete ewoc goodbye))) (defun ewoc-locate (ewoc &optional pos guess) "Return the node that POS (a buffer position) is within. @@ -401,8 +399,7 @@ If POS points before the first element, the first node is returned. If POS points after the last element, the last node is returned. If the EWOC is empty, nil is returned." (unless pos (setq pos (point))) - (ewoc--set-buffer-bind-dll-let* ewoc - ((footer (ewoc--footer ewoc))) + (ewoc--set-buffer-bind-dll ewoc (cond ;; Nothing present? @@ -435,7 +432,7 @@ If the EWOC is empty, nil is returned." (setq distance d) (setq best-guess g))) - (when (ewoc--last-node ewoc) ;Check "previous". + (when (ewoc--last-node ewoc) ;Check "previous". (let* ((g (ewoc--last-node ewoc)) (d (abs (- pos (ewoc--node-start-marker g))))) (when (< d distance) @@ -465,10 +462,11 @@ If the EWOC is empty, nil is returned." (defun ewoc-invalidate (ewoc &rest nodes) "Call EWOC's pretty-printer for each element in NODES. Delete current text first, thus effecting a \"refresh\"." - (ewoc--set-buffer-bind-dll ewoc + (ewoc--set-buffer-bind-dll-let* ewoc + ((pp (ewoc--pretty-printer ewoc))) (save-excursion (dolist (node nodes) - (ewoc--refresh-node (ewoc--pretty-printer ewoc) node))))) + (ewoc--refresh-node pp node dll))))) (defun ewoc-goto-prev (ewoc arg) "Move point to the ARGth previous element in EWOC. @@ -525,7 +523,6 @@ number of elements needs to be refreshed." (while (not (eq node footer)) (set-marker (ewoc--node-start-marker node) (point)) (funcall pp (ewoc--node-data node)) - (insert "\n") (setq node (ewoc--node-next dll node))))) (set-marker (ewoc--node-start-marker footer) (point)))) @@ -564,19 +561,23 @@ Return nil if the buffer has been deleted." (defun ewoc-set-hf (ewoc header footer) "Set the HEADER and FOOTER of EWOC." - (setf (ewoc--node-data (ewoc--header ewoc)) header) - (setf (ewoc--node-data (ewoc--footer ewoc)) footer) - (save-excursion - (ewoc--refresh-node 'insert (ewoc--header ewoc)) - (ewoc--refresh-node 'insert (ewoc--footer ewoc)))) + (ewoc--set-buffer-bind-dll-let* ewoc + ((head (ewoc--header ewoc)) + (foot (ewoc--footer ewoc)) + (hf-pp (ewoc--hf-pp ewoc))) + (setf (ewoc--node-data head) header + (ewoc--node-data foot) footer) + (save-excursion + (ewoc--refresh-node hf-pp head dll) + (ewoc--refresh-node hf-pp foot dll)))) (provide 'ewoc) -;;; Local Variables: -;;; eval: (put 'ewoc--set-buffer-bind-dll 'lisp-indent-hook 1) -;;; eval: (put 'ewoc--set-buffer-bind-dll-let* 'lisp-indent-hook 2) -;;; End: +;; Local Variables: +;; eval: (put 'ewoc--set-buffer-bind-dll 'lisp-indent-hook 1) +;; eval: (put 'ewoc--set-buffer-bind-dll-let* 'lisp-indent-hook 2) +;; End: -;;; arch-tag: d78915b9-9a07-44bf-aac6-04a1fc1bd6d4 +;; arch-tag: d78915b9-9a07-44bf-aac6-04a1fc1bd6d4 ;;; ewoc.el ends here diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 2d169e889cd..7a11d6318a9 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -1498,8 +1498,8 @@ shifted movement key, set `cua-highlight-region-shift-only'." ;;;###autoload (eval-after-load 'CUA-mode ;;;###autoload '(error (concat "\n\n" -;;;###autoload "CUA-mode is now part of the standard GNU Emacs distribution,\n" -;;;###autoload "so you may now enable and customize CUA via the Options menu.\n\n" +;;;###autoload "CUA-mode is now part of the standard GNU Emacs distribution, so you may\n" +;;;###autoload "now enable CUA via the Options menu or by customizing option `cua-mode'.\n\n" ;;;###autoload "You have loaded an older version of CUA-mode which does\n" ;;;###autoload "not work correctly with this version of GNU Emacs.\n\n" ;;;###autoload (if user-init-file (concat diff --git a/lisp/faces.el b/lisp/faces.el index c4b86b5b402..828cbf860d9 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1576,7 +1576,8 @@ If there is neither a user setting nor a default for FACE, return nil." "Return a list of colors supported for a particular frame. The argument FRAME specifies which frame to try. The value may be different for frames on different display types. -If FRAME doesn't support colors, the value is nil." +If FRAME doesn't support colors, the value is nil. +If FRAME is nil, that stands for the selected frame." (if (memq (framep (or frame (selected-frame))) '(x w32 mac)) (xw-defined-colors frame) (mapcar 'car (tty-color-alist frame)))) diff --git a/lisp/files.el b/lisp/files.el index 16df2661fcf..b4bc8f9ffec 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1847,13 +1847,14 @@ in that case, this function acts as if `enable-local-variables' were t." ("\\.ad[bs].dg\\'" . ada-mode) ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode) ("Imakefile\\'" . makefile-imake-mode) + ("Makeppfile\\(?:\\.mk\\)?\\'" . makefile-makepp-mode) ; Put this before .mk + ("\\.makepp\\'" . makefile-makepp-mode) ,@(if (memq system-type '(berkeley-unix next-mach darwin)) '(("\\.mk\\'" . makefile-bsdmake-mode) ("GNUmakefile\\'" . makefile-gmake-mode) ("[Mm]akefile\\'" . makefile-bsdmake-mode)) '(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage ("[Mm]akefile\\'" . makefile-gmake-mode))) - ("Makeppfile\\'" . makefile-makepp-mode) ("\\.am\\'" . makefile-automake-mode) ;; Less common extensions come here ;; so more common ones above are found faster. @@ -2689,7 +2690,10 @@ It is dangerous if either of these conditions are met: (or (numberp val) (equal val ''defun))) ((eq prop 'edebug-form-spec) ;; Only allow indirect form specs. - (edebug-basic-spec val))))) + ;; During bootstrapping, edebug-basic-spec might not be + ;; defined yet. + (and (fboundp 'edebug-basic-spec) + (edebug-basic-spec val)))))) ;; Allow expressions that the user requested. (member exp safe-local-eval-forms) ;; Certain functions can be allowed with safe arguments @@ -2994,7 +2998,7 @@ BACKUPNAME is the backup file name, which is the old file renamed." (condition-case nil (delete-file to-name) (file-error nil)) - (copy-file from-name to-name t t 'excl) + (copy-file from-name to-name nil t) nil) (file-already-exists t)) ;; The file was somehow created by someone else between @@ -3062,6 +3066,7 @@ except that a leading `.', if any, doesn't count." (defun file-name-extension (filename &optional period) "Return FILENAME's final \"extension\". The extension, in a file name, is the part that follows the last `.', +excluding version numbers and backup suffixes, except that a leading `.', if any, doesn't count. Return nil for extensionless file names such as `foo'. Return the empty string for file names such as `foo.'. diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 7f0f248c7cf..71aa3654da6 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,96 @@ +2006-06-06 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-util.el (mm-mime-mule-charset-alist): Use unicode-precedence-list + to fill the utf-8 entry. + +2006-06-05 Dan Christensen <jdc@uwo.ca> + + * gnus-sum.el (gnus-summary-read-group-1): When summary is unthreaded, + respect display group parameter and gnus-summary-expunge-below. + (gnus-articles-to-read): Remove unused reference to display group + parameter. + [ Merge 2004-07-06 change from the trunk. ] + +2006-05-29 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-ml.el (gnus-mailing-list-subscribe) + (gnus-mailing-list-unsubscribe, gnus-mailing-list-owner) + (gnus-mailing-list-message): Fix doc strings. + +2006-05-29 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> + + * gnus-ml.el (gnus-mailing-list-message): Use gnus-url-mailto instead + of doing it manually. + +2006-05-29 Kevin Greiner <kevin.greiner@compsol.cc> + + * gnus-agent.el (gnus-agent-possibly-synchronize-flags): A server + must be explicitly online rather than "not explicitly offline" for + its flags to be synchronized. + (gnus-agent-read-local): All symbols allocated in my-obarray + (gnus-agent-set-local): Skip invalid entries (min and/or max is nil). + (gnus-agent-regenerate-group): Check numeric names to see if they are + messages or groups. + +2006-05-29 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-save-all-headers): Mention it might be overridden. + (gnus-saved-headers): Ditto. + (gnus-default-article-saver): Doc fix; add + gnus-summary-write-body-to-file; mention functions may have properties. + (gnus-article-save-coding-system): New variable. + (gnus-article-save): Override gnus-save-all-headers and + gnus-saved-headers by :headers property which saver function may have. + (gnus-read-save-file-name): Add optional `dir-var' argument which + specifies directory in which files are saved; work even if optional + `variable' argument is not specified. + (gnus-summary-save-in-file): Add properties :decode and :headers. + (gnus-summary-write-to-file): Add properties :decode, :function, and + :headers; read file name. + (gnus-summary-save-body-in-file): Add :decode property; add optional + `overwrite' argument. + (gnus-summary-write-body-to-file): New function; add properties + :decode and :function. + (gnus-output-to-file): Add coding cookie and encode text according + to gnus-article-save-coding-system; don't use mm-append-to-file. + + * gnus-sum.el (gnus-newsgroup-last-directory): New variable. + (gnus-summary-local-variables): Add it. + (gnus-summary-save-map): Add gnus-summary-write-article-body-file. + (gnus-summary-save-article): Require gnus-art; save decoded articles + if function that gnus-default-article-saver specifies has `:decode' + property; bind gnus-prompt-before-saving to t when saving many + articles in a file; move point to article which will be saved. + (gnus-summary-write-article-body-file): New function. + +2006-05-26 Reiner Steib <Reiner.Steib@gmx.de> + + * uudecode.el (uudecode-decode-region-external): Fix previous commit. + +2006-05-26 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Don't edit + after-load-alist. + +2006-05-22 Reiner Steib <Reiner.Steib@gmx.de> + + * uudecode.el (uudecode-decode-region-external): nil isn't a valid + coding system in XEmacs, use binary. + + * mail-source.el (mail-sources): Fix custom type. + + * imap.el (Commentary): Fix typo. + +2006-05-18 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-sum.el (gnus-summary-save-article-mail): Clarify doc string. + (gnus-summary-expire-articles-now): Shorten prompt. + + * gmm-utils.el (wid-edit): Require. + (defun-gmm): Renamed from `gmm-defun-compat'. + (gmm-image-search-load-path): Use it. + (gmm-image-load-path-for-library): Use it. Sync with `mh-compat.el'. + 2006-05-04 Stefan Monnier <monnier@iro.umontreal.ca> * mm-decode.el (mm-dissect-buffer): Remove spurious double assignment. @@ -2865,7 +2958,7 @@ article buffer with a draft file. This is a temporary measure against the 2004-08-22 change to gnus-article-edit-mode. -2004-11-02 From Ilya N. Golubev <gin@mo.msk.ru>. +2004-11-02 Ilya N. Golubev <gin@mo.msk.ru>. * mm-util.el (mm-mime-mule-charset-alist): Add the windows-1251 entry. @@ -3725,7 +3818,7 @@ * flow-fill.el (fill-flowed-display-column) (fill-flowed-encode-column): Ditto. -2004-09-06 Stefan <monnier@iro.umontreal.ca> +2004-09-06 Stefan Monnier <monnier@iro.umontreal.ca> * message.el (message-tokenize-header, message-send-mail-with-qmail): Use point-min rather than 1. @@ -4112,6 +4205,7 @@ See ChangeLog.2 for earlier changes. ;; Local Variables: ;; coding: iso-2022-7bit +;; fill-column: 79 ;; End: ;;; arch-tag: 3f33a3e7-090d-492b-bedd-02a1417d32b4 diff --git a/lisp/gnus/ChangeLog.1 b/lisp/gnus/ChangeLog.1 index bb4da4dbcad..f917d0cbf73 100644 --- a/lisp/gnus/ChangeLog.1 +++ b/lisp/gnus/ChangeLog.1 @@ -2437,7 +2437,7 @@ * gnus-topic.el (gnus-topic-rename): Check whether the new name exists. -1998-02-10 dave edmondson <dme@sco.com> +1998-02-10 David Edmondson <dme@sco.com> * message.el (message-font-lock-keywords): Allow : as a citation ending. diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index 4db811053ec..f314d0e81d7 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -30,7 +30,7 @@ ;;; Code: -;; (require 'wid-edit) +(require 'wid-edit) (defgroup gmm nil "Utility functions for Gnus, Message and MML" @@ -279,11 +279,7 @@ DEFAULT-MAP specifies the default key map for ICON-LIST." icon-list)) tool-bar-map)) -;; WARNING: The following is subject to change. Don't rely on it yet. - -;; From MH-E without modifications: - -(defmacro gmm-defun-compat (name function arg-list &rest body) +(defmacro defun-gmm (name function arg-list &rest body) "Create function NAME. If FUNCTION exists, then NAME becomes an alias for FUNCTION. Otherwise, create function NAME with ARG-LIST and BODY." @@ -292,21 +288,19 @@ Otherwise, create function NAME with ARG-LIST and BODY." `(defalias ',name ',function) `(defun ,name ,arg-list ,@body)))) -(gmm-defun-compat gmm-image-search-load-path +(defun-gmm gmm-image-search-load-path image-search-load-path (file &optional path) "Emacs 21 and XEmacs don't have `image-search-load-path'. This function returns nil on those systems." nil) -;; From MH-E with modifications: - -;; Don't use `gmm-defun-compat' until API changes in -;; `image-load-path-for-library' in Emacs CVS are completed. +;; Cf. `mh-image-load-path-for-library' in `mh-compat.el'. -(defun gmm-image-load-path-for-library (library image &optional path no-error) - "Return a suitable search path for images relative to LIBRARY. +(defun-gmm gmm-image-load-path-for-library + image-load-path-for-library (library image &optional path no-error) + "Return a suitable search path for images used by LIBRARY. -First it searches for IMAGE in `image-load-path' (excluding +It searches for IMAGE in `image-load-path' (excluding \"`data-directory'/images\") and `load-path', followed by a path suitable for LIBRARY, which includes \"../../etc/images\" and \"../etc/images\" relative to the library file itself, and then diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 123ad340ae1..f4e9f2e3dc9 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -825,7 +825,7 @@ be a select method." (save-excursion (dolist (gnus-command-method (gnus-agent-covered-methods)) (when (and (file-exists-p (gnus-agent-lib-file "flags")) - (not (eq (gnus-server-status gnus-command-method) 'offline))) + (eq (gnus-server-status gnus-command-method) 'ok)) (gnus-agent-possibly-synchronize-flags-server gnus-command-method))))) (defun gnus-agent-synchronize-flags-server (method) @@ -2133,7 +2133,8 @@ modified) original contents, they are first saved to their own file." (let (group min max - (cur (current-buffer))) + (cur (current-buffer)) + (obarray my-obarray)) (setq group (read cur) min (read cur) max (read cur)) @@ -2214,7 +2215,9 @@ modified) original contents, they are first saved to their own file." (if (cond ((and minmax (or (not (eq min (car minmax))) - (not (eq max (cdr minmax))))) + (not (eq max (cdr minmax)))) + min + max) (setcar minmax min) (setcdr minmax max) t) @@ -3743,8 +3746,10 @@ If REREAD is not nil, downloaded articles are marked as unread." (dir (file-name-directory file)) point (downloaded (if (file-exists-p dir) - (sort (mapcar (lambda (name) (string-to-number name)) - (directory-files dir nil "^[0-9]+$" t)) + (sort (delq nil (mapcar (lambda (name) + (and (not (file-directory-p (nnheader-concat dir name))) + (string-to-number name))) + (directory-files dir nil "^[0-9]+$" t))) '>) (progn (gnus-make-directory dir) nil))) dl nov-arts diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 208103f805d..4722e98ef19 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -492,7 +492,10 @@ be fed to `format-time-string'." :group 'gnus-article-washing) (defcustom gnus-save-all-headers t - "*If non-nil, don't remove any headers before saving." + "*If non-nil, don't remove any headers before saving. +This will be overridden by the `:headers' property that the symbol of +the saver function, which is specified by `gnus-default-article-saver', +might have." :group 'gnus-article-saving :type 'boolean) @@ -513,14 +516,17 @@ each invocation of the saving commands." "Headers to keep if `gnus-save-all-headers' is nil. If `gnus-save-all-headers' is non-nil, this variable will be ignored. If that variable is nil, however, all headers that match this regexp -will be kept while the rest will be deleted before saving." +will be kept while the rest will be deleted before saving. This and +`gnus-save-all-headers' will be overridden by the `:headers' property +that the symbol of the saver function, which is specified by +`gnus-default-article-saver', might have." :group 'gnus-article-saving :type 'regexp) (defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail "A function to save articles in your favourite format. -The function must be interactively callable (in other words, it must -be an Emacs command). +The function will be called by way of the `gnus-summary-save-article' +command, and friends such as `gnus-summary-save-article-rmail'. Gnus provides the following functions: @@ -530,7 +536,28 @@ Gnus provides the following functions: * gnus-summary-save-in-file (article format) * gnus-summary-save-body-in-file (article body) * gnus-summary-save-in-vm (use VM's folder format) -* gnus-summary-write-to-file (article format -- overwrite)." +* gnus-summary-write-to-file (article format -- overwrite) +* gnus-summary-write-body-to-file (article body -- overwrite) + +The symbol of each function may have the following properties: + +* :decode +The value non-nil means save decoded articles. This is meaningful +only with `gnus-summary-save-in-file', `gnus-summary-save-body-in-file', +`gnus-summary-write-to-file', and `gnus-summary-write-body-to-file'. + +* :function +The value specifies an alternative function which appends, not +overwrites, articles to a file. This implies that when saving many +articles at a time, `gnus-prompt-before-saving' is bound to t and all +articles are saved in a single file. This is meaningful only with +`gnus-summary-write-to-file' and `gnus-summary-write-body-to-file'. + +* :headers +The value specifies the symbol of a variable of which the value +specifies headers to be saved. If it is omitted, +`gnus-save-all-headers' and `gnus-saved-headers' control what +headers should be saved." :group 'gnus-article-saving :type '(radio (function-item gnus-summary-save-in-rmail) (function-item gnus-summary-save-in-mail) @@ -539,8 +566,49 @@ Gnus provides the following functions: (function-item gnus-summary-save-body-in-file) (function-item gnus-summary-save-in-vm) (function-item gnus-summary-write-to-file) + (function-item gnus-summary-write-body-to-file) (function))) +(defcustom gnus-article-save-coding-system + (or (and (mm-coding-system-p 'utf-8) 'utf-8) + (and (mm-coding-system-p 'iso-2022-7bit) 'iso-2022-7bit) + (and (mm-coding-system-p 'emacs-mule) 'emacs-mule) + (and (mm-coding-system-p 'escape-quoted) 'escape-quoted)) + "Coding system used to save decoded articles to a file. + +The recommended coding systems are `utf-8', `iso-2022-7bit' and so on, +which can safely encode any characters in text. This is used by the +commands including: + +* gnus-summary-save-article-file +* gnus-summary-save-article-body-file +* gnus-summary-write-article-file +* gnus-summary-write-article-body-file + +and the functions to which you may set `gnus-default-article-saver': + +* gnus-summary-save-in-file +* gnus-summary-save-body-in-file +* gnus-summary-write-to-file +* gnus-summary-write-body-to-file + +Those commands and functions save just text displayed in the article +buffer to a file if the value of this variable is non-nil. Note that +buttonized MIME parts will be lost in a saved file in that case. +Otherwise, raw articles will be saved." + :group 'gnus-article-saving + :type `(choice + :format "%{%t%}:\n %[Value Menu%] %v" + (const :tag "Save raw articles" nil) + ,@(delq nil + (mapcar + (lambda (arg) (if (mm-coding-system-p (nth 3 arg)) arg)) + '((const :tag "UTF-8" utf-8) + (const :tag "iso-2022-7bit" iso-2022-7bit) + (const :tag "Emacs internal" emacs-mule) + (const :tag "escape-quoted" escape-quoted)))) + (symbol :tag "Coding system"))) + (defcustom gnus-rmail-save-name 'gnus-plain-save-name "A function generating a file name to save articles in Rmail format. The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE." @@ -3249,10 +3317,13 @@ This format is defined by the `gnus-article-time-format' variable." (defun gnus-article-save (save-buffer file &optional num) "Save the currently selected article." - (unless gnus-save-all-headers - ;; Remove headers according to `gnus-saved-headers'. + (when (or (get gnus-default-article-saver :headers) + (not gnus-save-all-headers)) + ;; Remove headers according to `gnus-saved-headers' or the value + ;; of the `:headers' property that the saver function might have. (let ((gnus-visible-headers - (or gnus-saved-headers gnus-visible-headers)) + (or (symbol-value (get gnus-default-article-saver :headers)) + gnus-saved-headers gnus-visible-headers)) (gnus-article-buffer save-buffer)) (save-excursion (set-buffer save-buffer) @@ -3277,7 +3348,8 @@ This format is defined by the `gnus-article-time-format' variable." (funcall gnus-default-article-saver filename))))) (defun gnus-read-save-file-name (prompt &optional filename - function group headers variable) + function group headers variable + dir-var) (let ((default-name (funcall function group headers (symbol-value variable))) result) @@ -3290,6 +3362,10 @@ This format is defined by the `gnus-article-time-format' variable." default-name) (filename filename) (t + (when (symbol-value dir-var) + (setq default-name (expand-file-name + (file-name-nondirectory default-name) + (symbol-value dir-var)))) (let* ((split-name (gnus-get-split-value gnus-split-methods)) (prompt (format prompt @@ -3354,7 +3430,11 @@ This format is defined by the `gnus-article-time-format' variable." ;; Possibly translate some characters. (nnheader-translate-file-chars file)))))) (gnus-make-directory (file-name-directory result)) - (set variable result))) + (when variable + (set variable result)) + (when dir-var + (set dir-var (file-name-directory result))) + result)) (defun gnus-article-archive-name (group) "Return the first instance of an \"Archive-name\" in the current buffer." @@ -3402,6 +3482,8 @@ Directory to save to is default to `gnus-article-save-directory'." (gnus-output-to-mail filename))))) filename) +(put 'gnus-summary-save-in-file :decode t) +(put 'gnus-summary-save-in-file :headers 'gnus-saved-headers) (defun gnus-summary-save-in-file (&optional filename overwrite) "Append this article to file. Optional argument FILENAME specifies file name. @@ -3420,13 +3502,21 @@ Directory to save to is default to `gnus-article-save-directory'." (gnus-output-to-file filename)))) filename) +(put 'gnus-summary-write-to-file :decode t) +(put 'gnus-summary-write-to-file :function 'gnus-summary-save-in-file) +(put 'gnus-summary-write-to-file :headers 'gnus-saved-headers) (defun gnus-summary-write-to-file (&optional filename) "Write this article to a file, overwriting it if the file exists. Optional argument FILENAME specifies file name. The directory to save in defaults to `gnus-article-save-directory'." - (gnus-summary-save-in-file nil t)) + (setq filename (gnus-read-save-file-name + "Save %s in file" filename + gnus-file-save-name gnus-newsgroup-name + gnus-current-headers nil 'gnus-newsgroup-last-directory)) + (gnus-summary-save-in-file filename t)) -(defun gnus-summary-save-body-in-file (&optional filename) +(put 'gnus-summary-save-body-in-file :decode t) +(defun gnus-summary-save-body-in-file (&optional filename overwrite) "Append this article body to a file. Optional argument FILENAME specifies file name. The directory to save in defaults to `gnus-article-save-directory'." @@ -3440,9 +3530,25 @@ The directory to save in defaults to `gnus-article-save-directory'." (widen) (when (article-goto-body) (narrow-to-region (point) (point-max))) + (when (and overwrite + (file-exists-p filename)) + (delete-file filename)) (gnus-output-to-file filename)))) filename) +(put 'gnus-summary-write-body-to-file :decode t) +(put 'gnus-summary-write-body-to-file + :function 'gnus-summary-save-body-in-file) +(defun gnus-summary-write-body-to-file (&optional filename) + "Write this article body to a file, overwriting it if the file exists. +Optional argument FILENAME specifies file name. +The directory to save in defaults to `gnus-article-save-directory'." + (setq filename (gnus-read-save-file-name + "Save %s body in file" filename + gnus-file-save-name gnus-newsgroup-name + gnus-current-headers nil 'gnus-newsgroup-last-directory)) + (gnus-summary-save-body-in-file filename t)) + (defun gnus-summary-save-in-pipe (&optional command) "Pipe this article to subprocess." (setq command @@ -5182,17 +5288,55 @@ Provided for backwards compatibility." ;;; Article savers. (defun gnus-output-to-file (file-name) - "Append the current article to a file named FILE-NAME." - (let ((artbuf (current-buffer))) + "Append the current article to a file named FILE-NAME. +If `gnus-article-save-coding-system' is non-nil, it is used to encode +text and used as the value of the coding cookie which is added to the +top of a file. Otherwise, this function saves a raw article without +the coding cookie." + (let* ((artbuf (current-buffer)) + (file-name-coding-system nnmail-pathname-coding-system) + (coding gnus-article-save-coding-system) + (coding-system-for-read (if coding + nil ;; Rely on the coding cookie. + mm-text-coding-system)) + (coding-system-for-write (or coding + mm-text-coding-system-for-write + mm-text-coding-system)) + (exists (file-exists-p file-name))) (with-temp-buffer + (when exists + (insert-file-contents file-name) + (goto-char (point-min)) + ;; Remove the existing coding cookie. + (when (looking-at "X-Gnus-Coding-System: .+\n\n") + (delete-region (match-beginning 0) (match-end 0)))) + (goto-char (point-max)) (insert-buffer-substring artbuf) ;; Append newline at end of the buffer as separator, and then ;; save it to file. (goto-char (point-max)) (insert "\n") - (let ((file-name-coding-system nnmail-pathname-coding-system)) - (mm-append-to-file (point-min) (point-max) file-name)) - t))) + (when coding + ;; If the coding system is not suitable to encode the text, + ;; ask a user for a proper one. + (when (fboundp 'select-safe-coding-system) + (setq coding (coding-system-base + (save-window-excursion + (select-safe-coding-system (point-min) (point-max) + coding)))) + (setq coding-system-for-write + (or (cdr (assq coding '((mule-utf-8 . utf-8)))) + coding))) + (goto-char (point-min)) + ;; Add the coding cookie. + (insert (format "X-Gnus-Coding-System: -*- coding: %s; -*-\n\n" + coding-system-for-write))) + (if exists + (progn + (write-region (point-min) (point-max) file-name nil 'no-message) + (message "Appended to %s" file-name)) + (write-region (point-min) (point-max) file-name)))) + t) (defun gnus-narrow-to-page (&optional arg) "Narrow the article buffer to a page. diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el index cde039d03c0..8d475f968d7 100644 --- a/lisp/gnus/gnus-ml.el +++ b/lisp/gnus/gnus-ml.el @@ -4,7 +4,7 @@ ;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Julien Gilles <jgilles@free.fr> -;; Keywords: news +;; Keywords: news, mail ;; This file is part of GNU Emacs. @@ -51,8 +51,7 @@ "\C-c\C-nu" gnus-mailing-list-unsubscribe "\C-c\C-np" gnus-mailing-list-post "\C-c\C-no" gnus-mailing-list-owner - "\C-c\C-na" gnus-mailing-list-archive - )) + "\C-c\C-na" gnus-mailing-list-archive)) (defun gnus-mailing-list-make-menu-bar () (unless (boundp 'gnus-mailing-list-menu) @@ -103,7 +102,8 @@ If FORCE is non-nil, replace the old ones." ;; Set up the menu. (when (gnus-visual-p 'mailing-list-menu 'menu) (gnus-mailing-list-make-menu-bar)) - (gnus-add-minor-mode 'gnus-mailing-list-mode " Mailing-List" gnus-mailing-list-mode-map) + (gnus-add-minor-mode 'gnus-mailing-list-mode " Mailing-List" + gnus-mailing-list-mode-map) (gnus-run-hooks 'gnus-mailing-list-mode-hook)))) ;;; Commands @@ -118,7 +118,7 @@ If FORCE is non-nil, replace the old ones." (t (gnus-message 1 "no list-help in this group"))))) (defun gnus-mailing-list-subscribe () - "Subscribe" + "Subscribe to mailing list." (interactive) (let ((list-subscribe (with-current-buffer gnus-original-article-buffer @@ -127,7 +127,7 @@ If FORCE is non-nil, replace the old ones." (t (gnus-message 1 "no list-subscribe in this group"))))) (defun gnus-mailing-list-unsubscribe () - "Unsubscribe" + "Unsubscribe from mailing list." (interactive) (let ((list-unsubscribe (with-current-buffer gnus-original-article-buffer @@ -145,7 +145,7 @@ If FORCE is non-nil, replace the old ones." (t (gnus-message 1 "no list-post in this group"))))) (defun gnus-mailing-list-owner () - "Mail to the owner" + "Mail to the mailing list owner." (interactive) (let ((list-owner (with-current-buffer gnus-original-article-buffer @@ -154,7 +154,7 @@ If FORCE is non-nil, replace the old ones." (t (gnus-message 1 "no list-owner in this group"))))) (defun gnus-mailing-list-archive () - "Browse archive" + "Browse archive." (interactive) (require 'browse-url) (let ((list-archive @@ -169,33 +169,14 @@ If FORCE is non-nil, replace the old ones." ;;; Utility functions (defun gnus-mailing-list-message (address) - "" - (let ((mailto "") - (to ()) - (subject "None") - (body "") - ) - (cond - ((string-match "<mailto:\\([^>]*\\)>" address) - (let ((args (match-string 1 address))) - (cond ; with param - ((string-match "\\(.*\\)\\?\\(.*\\)" args) - (setq mailto (match-string 1 args)) - (let ((param (match-string 2 args))) - (if (string-match "subject=\\([^&]*\\)" param) - (setq subject (match-string 1 param))) - (if (string-match "body=\\([^&]*\\)" param) - (setq body (match-string 1 param))) - (if (string-match "to=\\([^&]*\\)" param) - (push (match-string 1 param) to)) - )) - (t (setq mailto args))))) ; without param - - ; other case <http://... to be done. - (t nil)) - (gnus-setup-message 'message (message-mail mailto subject)) - (insert body) - )) + "Send message to ADDRESS. +ADDRESS is specified by a \"mailto:\" URL." + (cond + ((string-match "<\\(mailto:[^>]*\\)>" address) + (require 'gnus-art) + (gnus-url-mailto (match-string 1 address))) + ;; other case <http://...> to be done. + (t nil))) (provide 'gnus-ml) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index daecb1701cd..66ab41950d1 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1249,6 +1249,7 @@ the type of the variable (string, integer, character, etc).") (defvar gnus-newsgroup-last-mail nil) (defvar gnus-newsgroup-last-folder nil) (defvar gnus-newsgroup-last-file nil) +(defvar gnus-newsgroup-last-directory nil) (defvar gnus-newsgroup-auto-expire nil) (defvar gnus-newsgroup-active nil) @@ -1364,6 +1365,7 @@ This list will always be a subset of gnus-newsgroup-undownloaded.") gnus-newsgroup-begin gnus-newsgroup-end gnus-newsgroup-last-rmail gnus-newsgroup-last-mail gnus-newsgroup-last-folder gnus-newsgroup-last-file + gnus-newsgroup-last-directory gnus-newsgroup-auto-expire gnus-newsgroup-unreads gnus-newsgroup-unselected gnus-newsgroup-marked gnus-newsgroup-spam-marked @@ -1991,6 +1993,7 @@ increase the score of each group you read." "r" gnus-summary-save-article-rmail "f" gnus-summary-save-article-file "b" gnus-summary-save-article-body-file + "B" gnus-summary-write-article-body-file "h" gnus-summary-save-article-folder "v" gnus-summary-save-article-vm "p" gnus-summary-pipe-output @@ -3709,16 +3712,10 @@ If NO-DISPLAY, don't generate a summary buffer." (when gnus-build-sparse-threads (gnus-build-sparse-threads)) ;; Find the initial limit. - (if gnus-show-threads - (if show-all - (let ((gnus-newsgroup-dormant nil)) - (gnus-summary-initial-limit show-all)) + (if show-all + (let ((gnus-newsgroup-dormant nil)) (gnus-summary-initial-limit show-all)) - ;; When unthreaded, all articles are always shown. - (setq gnus-newsgroup-limit - (mapcar - (lambda (header) (mail-header-number header)) - gnus-newsgroup-headers))) + (gnus-summary-initial-limit show-all)) ;; Generate the summary buffer. (unless no-display (gnus-summary-prepare)) @@ -5419,8 +5416,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (defun gnus-articles-to-read (group &optional read-all) "Find out what articles the user wants to read." - (let* ((display (gnus-group-find-parameter group 'display)) - (articles + (let* ((articles ;; Select all articles if `read-all' is non-nil, or if there ;; are no unread articles. (if (or read-all @@ -9507,7 +9503,7 @@ deleted forever, right now." (interactive) (or gnus-expert-user (gnus-yes-or-no-p - "Are you really, really, really sure you want to delete all these messages? ") + "Are you really, really sure you want to delete all expirable messages? ") (error "Phew!")) (gnus-summary-expire-articles t)) @@ -10993,12 +10989,26 @@ If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead. -The variable `gnus-default-article-saver' specifies the saver function." +The variable `gnus-default-article-saver' specifies the saver function. + +If the optional second argument NOT-SAVED is non-nil, articles saved +will not be marked as saved." (interactive "P") + (require 'gnus-art) (let* ((articles (gnus-summary-work-articles n)) (save-buffer (save-excursion (nnheader-set-temp-buffer " *Gnus Save*"))) (num (length articles)) + ;; Whether to save decoded articles or raw articles. + (decode (when gnus-article-save-coding-system + (get gnus-default-article-saver :decode))) + ;; When saving many articles in a single file, use the other + ;; function to save articles other than the first one. + (saver2 (get gnus-default-article-saver :function)) + (gnus-prompt-before-saving (if saver2 + t + gnus-prompt-before-saving)) + (gnus-default-article-saver gnus-default-article-saver) header file) (dolist (article articles) (setq header (gnus-summary-article-header article)) @@ -11009,17 +11019,25 @@ The variable `gnus-default-article-saver' specifies the saver function." (gnus-message 1 "Article %d is unsaveable" article)) ;; This is a real article. (save-window-excursion - (let ((gnus-display-mime-function nil) - (gnus-article-prepare-hook nil)) - (gnus-summary-select-article t nil nil article))) + (let ((gnus-display-mime-function (when decode + gnus-display-mime-function)) + (gnus-article-prepare-hook (when decode + gnus-article-prepare-hook))) + (gnus-summary-select-article t nil nil article) + (gnus-summary-goto-subject article))) (save-excursion (set-buffer save-buffer) (erase-buffer) - (insert-buffer-substring gnus-original-article-buffer)) + (insert-buffer-substring (if decode + gnus-article-buffer + gnus-original-article-buffer))) (setq file (gnus-article-save save-buffer file num)) (gnus-summary-remove-process-mark article) (unless not-saved - (gnus-summary-set-saved-mark article)))) + (gnus-summary-set-saved-mark article))) + (when saver2 + (setq gnus-default-article-saver saver2 + saver2 nil))) (gnus-kill-buffer save-buffer) (gnus-summary-position-point) (gnus-set-mode-line 'summary) @@ -11043,7 +11061,7 @@ If HEADERS (the symbolic prefix), include the headers, too." (gnus-configure-windows 'pipe)))) (defun gnus-summary-save-article-mail (&optional arg) - "Append the current article to an mail file. + "Append the current article to a Unix mail box file. If N is a positive number, save the N next articles. If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, @@ -11097,6 +11115,17 @@ save those articles instead." (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) (gnus-summary-save-article arg))) +(defun gnus-summary-write-article-body-file (&optional arg) + "Write the current article body to a file, deleting the previous file. +If N is a positive number, save the N next articles. +If N is a negative number, save the N previous articles. +If N is nil and any articles have been marked with the process mark, +save those articles instead." + (interactive "P") + (require 'gnus-art) + (let ((gnus-default-article-saver 'gnus-summary-write-body-to-file)) + (gnus-summary-save-article arg))) + (defun gnus-summary-muttprint (&optional arg) "Print the current article using Muttprint. If N is a positive number, save the N next articles. diff --git a/lisp/gnus/imap.el b/lisp/gnus/imap.el index 7b40773ca06..16fce1843db 100644 --- a/lisp/gnus/imap.el +++ b/lisp/gnus/imap.el @@ -79,7 +79,7 @@ ;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS, ;; LOGINDISABLED) (with use of external library starttls.el and ;; program starttls) and the GSSAPI / kerberos V4 sections of RFC1731 -;; (with use of external program `imtest'). It also take advantage +;; (with use of external program `imtest'). It also takes advantage of ;; the UNSELECT extension in Cyrus IMAPD. ;; ;; Without the work of John McClary Prevost and Jim Radford this library diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 9683f28154b..e350468bea4 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -63,175 +63,177 @@ This variable is a list of mail source specifiers. See Info node `(gnus)Mail Source Specifiers'." :group 'mail-source :link '(custom-manual "(gnus)Mail Source Specifiers") - :type `(repeat - (choice :format "%[Value Menu%] %v" - :value (file) - (cons :tag "Spool file" - (const :format "" file) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :path) - file))) - (cons :tag "Several files in a directory" - (const :format "" directory) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :path) - (directory :tag "Path")) - (group :inline t - (const :format "" :value :suffix) - (string :tag "Suffix")) - (group :inline t - (const :format "" :value :predicate) - (function :tag "Predicate")) - (group :inline t - (const :format "" :value :prescript) - (choice :tag "Prescript" - :value nil - (string :format "%v") - (function :format "%v"))) - (group :inline t - (const :format "" :value :postscript) - (choice :tag "Postscript" - :value nil - (string :format "%v") - (function :format "%v"))) - (group :inline t - (const :format "" :value :plugged) - (boolean :tag "Plugged")))) - (cons :tag "POP3 server" - (const :format "" pop) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :server) - (string :tag "Server")) - (group :inline t - (const :format "" :value :port) - (choice :tag "Port" - :value "pop3" - (number :format "%v") - (string :format "%v"))) - (group :inline t - (const :format "" :value :user) - (string :tag "User")) - (group :inline t - (const :format "" :value :password) - (string :tag "Password")) - (group :inline t - (const :format "" :value :program) - (string :tag "Program")) - (group :inline t - (const :format "" :value :prescript) - (choice :tag "Prescript" - :value nil - (string :format "%v") - (function :format "%v"))) - (group :inline t - (const :format "" :value :postscript) - (choice :tag "Postscript" - :value nil - (string :format "%v") - (function :format "%v"))) - (group :inline t - (const :format "" :value :function) - (function :tag "Function")) - (group :inline t - (const :format "" - :value :authentication) - (choice :tag "Authentication" - :value apop - (const password) - (const apop))) - (group :inline t - (const :format "" :value :plugged) - (boolean :tag "Plugged")))) - (cons :tag "Maildir (qmail, postfix...)" - (const :format "" maildir) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :path) - (directory :tag "Path")) - (group :inline t - (const :format "" :value :plugged) - (boolean :tag "Plugged")))) - (cons :tag "IMAP server" - (const :format "" imap) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :server) - (string :tag "Server")) - (group :inline t - (const :format "" :value :port) - (choice :tag "Port" - :value 143 - number string)) - (group :inline t - (const :format "" :value :user) - (string :tag "User")) - (group :inline t - (const :format "" :value :password) - (string :tag "Password")) - (group :inline t - (const :format "" :value :stream) - (choice :tag "Stream" - :value network - ,@mail-source-imap-streams)) - (group :inline t - (const :format "" :value :program) - (string :tag "Program")) - (group :inline t - (const :format "" - :value :authenticator) - (choice :tag "Authenticator" - :value login - ,@mail-source-imap-authenticators)) - (group :inline t - (const :format "" :value :mailbox) - (string :tag "Mailbox" - :value "INBOX")) - (group :inline t - (const :format "" :value :predicate) - (string :tag "Predicate" - :value "UNSEEN UNDELETED")) - (group :inline t - (const :format "" :value :fetchflag) - (string :tag "Fetchflag" - :value "\\Deleted")) - (group :inline t - (const :format "" - :value :dontexpunge) - (boolean :tag "Dontexpunge")) - (group :inline t - (const :format "" :value :plugged) - (boolean :tag "Plugged")))) - (cons :tag "Webmail server" - (const :format "" webmail) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :subtype) - ;; Should be generated from - ;; `webmail-type-definition', but we - ;; can't require webmail without W3. - (choice :tag "Subtype" - :value hotmail - (const hotmail) - (const yahoo) - (const netaddress) - (const netscape) - (const my-deja))) - (group :inline t - (const :format "" :value :user) - (string :tag "User")) - (group :inline t - (const :format "" :value :password) - (string :tag "Password")) - (group :inline t - (const :format "" - :value :dontexpunge) - (boolean :tag "Dontexpunge")) - (group :inline t - (const :format "" :value :plugged) - (boolean :tag "Plugged"))))))) + :type `(choice + (const nil) + (repeat + (choice :format "%[Value Menu%] %v" + :value (file) + (cons :tag "Spool file" + (const :format "" file) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :path) + file))) + (cons :tag "Several files in a directory" + (const :format "" directory) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :path) + (directory :tag "Path")) + (group :inline t + (const :format "" :value :suffix) + (string :tag "Suffix")) + (group :inline t + (const :format "" :value :predicate) + (function :tag "Predicate")) + (group :inline t + (const :format "" :value :prescript) + (choice :tag "Prescript" + :value nil + (string :format "%v") + (function :format "%v"))) + (group :inline t + (const :format "" :value :postscript) + (choice :tag "Postscript" + :value nil + (string :format "%v") + (function :format "%v"))) + (group :inline t + (const :format "" :value :plugged) + (boolean :tag "Plugged")))) + (cons :tag "POP3 server" + (const :format "" pop) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :server) + (string :tag "Server")) + (group :inline t + (const :format "" :value :port) + (choice :tag "Port" + :value "pop3" + (number :format "%v") + (string :format "%v"))) + (group :inline t + (const :format "" :value :user) + (string :tag "User")) + (group :inline t + (const :format "" :value :password) + (string :tag "Password")) + (group :inline t + (const :format "" :value :program) + (string :tag "Program")) + (group :inline t + (const :format "" :value :prescript) + (choice :tag "Prescript" + :value nil + (string :format "%v") + (function :format "%v"))) + (group :inline t + (const :format "" :value :postscript) + (choice :tag "Postscript" + :value nil + (string :format "%v") + (function :format "%v"))) + (group :inline t + (const :format "" :value :function) + (function :tag "Function")) + (group :inline t + (const :format "" + :value :authentication) + (choice :tag "Authentication" + :value apop + (const password) + (const apop))) + (group :inline t + (const :format "" :value :plugged) + (boolean :tag "Plugged")))) + (cons :tag "Maildir (qmail, postfix...)" + (const :format "" maildir) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :path) + (directory :tag "Path")) + (group :inline t + (const :format "" :value :plugged) + (boolean :tag "Plugged")))) + (cons :tag "IMAP server" + (const :format "" imap) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :server) + (string :tag "Server")) + (group :inline t + (const :format "" :value :port) + (choice :tag "Port" + :value 143 + number string)) + (group :inline t + (const :format "" :value :user) + (string :tag "User")) + (group :inline t + (const :format "" :value :password) + (string :tag "Password")) + (group :inline t + (const :format "" :value :stream) + (choice :tag "Stream" + :value network + ,@mail-source-imap-streams)) + (group :inline t + (const :format "" :value :program) + (string :tag "Program")) + (group :inline t + (const :format "" + :value :authenticator) + (choice :tag "Authenticator" + :value login + ,@mail-source-imap-authenticators)) + (group :inline t + (const :format "" :value :mailbox) + (string :tag "Mailbox" + :value "INBOX")) + (group :inline t + (const :format "" :value :predicate) + (string :tag "Predicate" + :value "UNSEEN UNDELETED")) + (group :inline t + (const :format "" :value :fetchflag) + (string :tag "Fetchflag" + :value "\\Deleted")) + (group :inline t + (const :format "" + :value :dontexpunge) + (boolean :tag "Dontexpunge")) + (group :inline t + (const :format "" :value :plugged) + (boolean :tag "Plugged")))) + (cons :tag "Webmail server" + (const :format "" webmail) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :subtype) + ;; Should be generated from + ;; `webmail-type-definition', but we + ;; can't require webmail without W3. + (choice :tag "Subtype" + :value hotmail + (const hotmail) + (const yahoo) + (const netaddress) + (const netscape) + (const my-deja))) + (group :inline t + (const :format "" :value :user) + (string :tag "User")) + (group :inline t + (const :format "" :value :password) + (string :tag "Password")) + (group :inline t + (const :format "" + :value :dontexpunge) + (boolean :tag "Dontexpunge")) + (group :inline t + (const :format "" :value :plugged) + (boolean :tag "Plugged")))))))) (defcustom mail-source-ignore-errors nil "*Ignore errors when querying mail sources. diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 9a0464be958..5803df7d419 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -364,14 +364,17 @@ could use `autoload-coding-system' here." (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208 japanese-jisx0213-1 japanese-jisx0213-2) (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208) - ,(if (or (not (fboundp 'charsetp)) ;; non-Mule case - (charsetp 'unicode-a) - (not (mm-coding-system-p 'mule-utf-8))) - '(utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e) - ;; If we have utf-8 we're in Mule 5+. - (append '(utf-8) - (delete 'ascii - (coding-system-get 'mule-utf-8 'safe-charsets))))) + ,(cond ((fboundp 'unicode-precedence-list) + (cons 'utf-8 (delq 'ascii (mapcar 'charset-name + (unicode-precedence-list))))) + ((or (not (fboundp 'charsetp)) ;; non-Mule case + (charsetp 'unicode-a) + (not (mm-coding-system-p 'mule-utf-8))) + '(utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e)) + (t ;; If we have utf-8 we're in Mule 5+. + (append '(utf-8) + (delete 'ascii + (coding-system-get 'mule-utf-8 'safe-charsets)))))) "Alist of MIME-charset/MULE-charsets.") (defun mm-enrich-utf-8-by-mule-ucs () @@ -379,10 +382,6 @@ could use `autoload-coding-system' here." This function will run when the `un-define' module is loaded under XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist' with Mule charsets. It is completely useless for Emacs." - (unless (cdr (delete '(mm-enrich-utf-8-by-mule-ucs) - (assoc "un-define" after-load-alist))) - (setq after-load-alist - (delete '("un-define") after-load-alist))) (when (boundp 'unicode-basic-translation-charset-order-list) (condition-case nil (let ((val (delq diff --git a/lisp/gnus/uudecode.el b/lisp/gnus/uudecode.el index f47a8e90c3a..616348e899f 100644 --- a/lisp/gnus/uudecode.el +++ b/lisp/gnus/uudecode.el @@ -100,7 +100,11 @@ used is specified by `uudecode-decoder-program'." (make-temp-name "uu") uudecode-temporary-file-directory)))) (let ((cdir default-directory) - default-process-coding-system) + (default-process-coding-system + (if (featurep 'xemacs) + ;; In XEmacs, `nil' is not a valid coding system. + '(binary . binary) + nil))) (unwind-protect (with-temp-buffer (insert "begin 600 " (file-name-nondirectory tempfile) "\n") diff --git a/lisp/help.el b/lisp/help.el index 1661779ca74..d9a48a0a4cf 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -326,63 +326,76 @@ of the key sequence that ran this command." ;; run describe-prefix-bindings. (setq prefix-help-command 'describe-prefix-bindings) -(defun view-emacs-news (&optional arg) +(defun view-emacs-news (&optional version) "Display info on recent changes to Emacs. With argument, display info only for the selected version." (interactive "P") - (if (not arg) - (view-file (expand-file-name "NEWS" data-directory)) - (let* ((map (sort - (delete-dups - (apply - 'nconc - (mapcar - (lambda (file) - (with-temp-buffer - (insert-file-contents - (expand-file-name file data-directory)) - (let (res) - (while (re-search-forward - (if (string-match "^ONEWS\\.[0-9]+$" file) - "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)" - "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t) - (setq res (cons (list (match-string-no-properties 1) - file) res))) - res))) - (append '("NEWS" "ONEWS") - (directory-files data-directory nil - "^ONEWS\\.[0-9]+$" nil))))) - (lambda (a b) - (string< (car b) (car a))))) - (current (caar map)) - (version (completing-read - (format "Read NEWS for the version (default %s): " current) - (mapcar 'car map) nil nil nil nil current)) - (file (cadr (assoc version map))) - res) - (if (not file) - (error "No news is good news") - (view-file (expand-file-name file data-directory)) - (widen) - (goto-char (point-min)) - (when (re-search-forward - (concat (if (string-match "^ONEWS\\.[0-9]+$" file) - "Changes in \\(?:Emacs\\|version\\)?[ \t]*" - "^\* [^0-9\n]*") version) - nil t) - (beginning-of-line) - (narrow-to-region - (point) - (save-excursion - (while (and (setq res - (re-search-forward - (if (string-match "^ONEWS\\.[0-9]+$" file) - "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)" - "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t)) - (equal (match-string-no-properties 1) version))) - (or res (goto-char (point-max))) - (beginning-of-line) - (point)))))))) + (unless version + (setq version emacs-major-version)) + (when (consp version) + (let* ((all-versions + (let (res) + (mapcar + (lambda (file) + (with-temp-buffer + (insert-file-contents + (expand-file-name file data-directory)) + (while (re-search-forward + (if (member file '("NEWS.18" "NEWS.1-17")) + "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)" + "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t) + (setq res (cons (match-string-no-properties 1) res))))) + (cons "NEWS" + (directory-files data-directory nil + "^NEWS\\.[0-9][-0-9]*$" nil))) + (sort (delete-dups res) (lambda (a b) (string< b a))))) + (current (car all-versions)) + res) + (setq version (completing-read + (format "Read NEWS for the version (default %s): " current) + all-versions nil nil nil nil current)) + (if (integerp (string-to-number version)) + (setq version (string-to-number version)) + (unless (or (member version all-versions) + (<= (string-to-number version) (string-to-number current))) + (error "No news about version %s" version))))) + (when (integerp version) + (cond ((<= version 12) + (setq version (format "1.%d" version))) + ((<= version 18) + (setq version (format "%d" version))) + ((> version emacs-major-version) + (error "No news about emacs %d (yet)" version)))) + (let* ((vn (if (stringp version) + (string-to-number version) + version)) + (file (cond + ((>= vn emacs-major-version) "NEWS") + ((< vn 18) "NEWS.1-17") + (t (format "NEWS.%d" vn))))) + (view-file (expand-file-name file data-directory)) + (widen) + (goto-char (point-min)) + (when (stringp version) + (when (re-search-forward + (concat (if (< vn 19) + "Changes in Emacs[ \t]*" + "^\* [^0-9\n]*") version "$") + nil t) + (beginning-of-line) + (narrow-to-region + (point) + (save-excursion + (while (and (setq res + (re-search-forward + (if (< vn 19) + "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)" + "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t)) + (equal (match-string-no-properties 1) version))) + (or res (goto-char (point-max))) + (beginning-of-line) + (point))))))) + (defun view-todo (&optional arg) "Display the Emacs TODO list." @@ -942,11 +955,11 @@ is currently activated with completion." (defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2)) "Maximum height of a window displaying a temporary buffer. -This is the maximum height (in text lines) which `resize-temp-buffer-window' +This is effective only when Temp Buffer Resize mode is enabled. +The value is the maximum height (in lines) which `resize-temp-buffer-window' will give to a window displaying a temporary buffer. -It can also be a function which will be called with the object corresponding -to the buffer to be displayed as argument and should return an integer -positive number." +It can also be a function to be called to choose the height for such a buffer. +It gets one argumemt, the buffer, and should return a positive integer." :type '(choice integer function) :group 'help :version "20.4") diff --git a/lisp/ido.el b/lisp/ido.el index a622a7e6275..344f8a667a1 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -448,35 +448,41 @@ in merged file and directory lists." ;;; Examples for setting the value of ido-ignore-files ;(setq ido-ignore-files '("^ " "\\.c$" "\\.h$")) -(defcustom ido-default-file-method 'always-frame - "*How to switch to new file when using `ido-find-file'. +(defcustom ido-default-file-method 'raise-frame + "*How to visit a new file when using `ido-find-file'. Possible values: -`samewindow' Show new file in same window -`otherwindow' Show new file in another window (same frame) -`display' Display file in another window without switching to it -`otherframe' Show new file in another frame -`maybe-frame' If a file is visible in another frame, prompt to ask if you - you want to see the file in the same window of the current - frame or in the other frame -`always-frame' If a file is visible in another frame, raise that - frame; otherwise, visit the file in the same window" - :type '(choice (const samewindow) - (const otherwindow) - (const display) - (const otherframe) - (const maybe-frame) - (const always-frame)) +`selected-window' Show new file in selected window +`other-window' Show new file in another window (same frame) +`display' Display file in another window without selecting to it +`other-frame' Show new file in another frame +`maybe-frame' If a file is visible in another frame, prompt to ask if you + you want to see the file in the same window of the current + frame or in the other frame +`raise-frame' If a file is visible in another frame, raise that + frame; otherwise, visit the file in the same window" + :type '(choice (const :tag "Visit in selected window" selected-window) + (const :tag "Visit in other window" other-window) + (const :tag "Display (no select) in other window" display) + (const :tag "Visit in other frame" other-frame) + (const :tag "Ask to visit in other frame" maybe-frame) + (const :tag "Raise frame if already visited" raise-frame)) :group 'ido) -(defcustom ido-default-buffer-method 'always-frame +(defcustom ido-default-buffer-method 'raise-frame "*How to switch to new buffer when using `ido-switch-buffer'. See `ido-default-file-method' for details." - :type '(choice (const samewindow) - (const otherwindow) + :type '(choice (const :tag "Show in selected window" selected-window) + (const :tag "Show in other window" other-window) + (const :tag "Display (no select) in other window" display) + (const :tag "Show in other frame" other-frame) + (const :tag "Ask to show in other frame" maybe-frame) + (const :tag "Raise frame if already shown" raise-frame)) + :type '(choice (const selected-window) + (const other-window) (const display) - (const otherframe) + (const other-frame) (const maybe-frame) - (const always-frame)) + (const raise-frame)) :group 'ido) (defcustom ido-enable-flex-matching nil @@ -1778,7 +1784,7 @@ With ARG, turn ido speed-up on if arg is positive, off otherwise." "Perform the `ido-read-buffer' and `ido-read-file-name' functions. Return the name of a buffer or file selected. PROMPT is the prompt to give to the user. -DEFAULT if given is the default directory to start with. +DEFAULT if given is the default item to start with. If REQUIRE-MATCH is non-nil, an existing file must be selected. If INITIAL is non-nil, it specifies the initial input string." (let @@ -1822,7 +1828,10 @@ If INITIAL is non-nil, it specifies the initial input string." (cond ((eq item 'buffer) (if (bufferp default) (buffer-name default) default)) - ((stringp default) default) + ((stringp default) + (if (memq item '(file dir)) + (file-name-nondirectory default) + default)) ((eq item 'file) (and ido-enable-last-directory-history (let ((d (assoc ido-current-directory ido-last-directory-list))) @@ -3739,7 +3748,7 @@ for first matching file." ;;; VISIT CHOSEN BUFFER (defun ido-visit-buffer (buffer method &optional record) - "Visit file named FILE according to METHOD. + "Switch to BUFFER according to METHOD. Record command in `command-history' if optional RECORD is non-nil." (let (win newframe) @@ -3749,33 +3758,7 @@ Record command in `command-history' if optional RECORD is non-nil." (ido-record-command 'kill-buffer buffer)) (kill-buffer buffer)) - ((eq method 'samewindow) - (if record - (ido-record-command 'switch-to-buffer buffer)) - (switch-to-buffer buffer)) - - ((memq method '(always-frame maybe-frame)) - (cond - ((and window-system - (setq win (ido-window-buffer-p buffer)) - (or (eq method 'always-frame) - (y-or-n-p "Jump to frame? "))) - (setq newframe (window-frame win)) - (if (fboundp 'select-frame-set-input-focus) - (select-frame-set-input-focus newframe) - (raise-frame newframe) - (select-frame newframe) - (unless (featurep 'xemacs) - (set-mouse-position (selected-frame) (1- (frame-width)) 0))) - (select-window win)) - (t - ;; No buffer in other frames... - (if record - (ido-record-command 'switch-to-buffer buffer)) - (switch-to-buffer buffer) - ))) - - ((eq method 'otherwindow) + ((eq method 'other-window) (if record (ido-record-command 'switch-to-buffer buffer)) (switch-to-buffer-other-window buffer)) @@ -3783,14 +3766,29 @@ Record command in `command-history' if optional RECORD is non-nil." ((eq method 'display) (display-buffer buffer)) - ((eq method 'otherframe) + ((eq method 'other-frame) (switch-to-buffer-other-frame buffer) - (unless (featurep 'xemacs) - (select-frame-set-input-focus (selected-frame))) + (select-frame-set-input-focus (selected-frame))) + + ((and (memq method '(raise-frame maybe-frame)) + window-system + (setq win (ido-buffer-window-other-frame buffer)) + (or (eq method 'raise-frame) + (y-or-n-p "Jump to frame? "))) + (setq newframe (window-frame win)) + (select-frame-set-input-focus newframe) + (select-window win)) + + ;; (eq method 'selected-window) + (t + ;; No buffer in other frames... + (if record + (ido-record-command 'switch-to-buffer buffer)) + (switch-to-buffer buffer) )))) -(defun ido-window-buffer-p (buffer) +(defun ido-buffer-window-other-frame (buffer) ;; Return window pointer if BUFFER is visible in another frame. ;; If BUFFER is visible in the current frame, return nil. (let ((blist (ido-get-buffers-in-frames 'current))) @@ -3847,7 +3845,7 @@ in a separate window. The buffer name is selected interactively by typing a substring. For details of keybindings, do `\\[describe-function] ido'." (interactive) - (ido-buffer-internal 'otherwindow 'switch-to-buffer-other-window)) + (ido-buffer-internal 'other-window 'switch-to-buffer-other-window)) ;;;###autoload (defun ido-display-buffer () @@ -3880,7 +3878,7 @@ The buffer name is selected interactively by typing a substring. For details of keybindings, do `\\[describe-function] ido'." (interactive) (if ido-mode - (ido-buffer-internal 'otherframe) + (ido-buffer-internal 'other-frame) (call-interactively 'switch-to-buffer-other-frame))) ;;;###autoload @@ -3942,7 +3940,7 @@ in a separate window. The file name is selected interactively by typing a substring. For details of keybindings, do `\\[describe-function] ido-find-file'." (interactive) - (ido-file-internal 'otherwindow 'find-file-other-window)) + (ido-file-internal 'other-window 'find-file-other-window)) ;;;###autoload (defun ido-find-alternate-file () @@ -3990,7 +3988,7 @@ For details of keybindings, do `\\[describe-function] ido-find-file'." The file name is selected interactively by typing a substring. For details of keybindings, do `\\[describe-function] ido-find-file'." (interactive) - (ido-file-internal 'otherframe 'find-file-other-frame)) + (ido-file-internal 'other-frame 'find-file-other-frame)) ;;;###autoload (defun ido-write-file () @@ -4472,6 +4470,8 @@ See `read-file-name' for additional parameters." (ido-directory-too-big (and (not ido-directory-nonreadable) (ido-directory-too-big-p ido-current-directory))) (ido-work-directory-index -1) + (ido-show-dot-for-dired (and ido-show-dot-for-dired + (not default-filename))) (ido-work-file-index -1) (ido-find-literal nil)) (setq ido-exit nil) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 1a55676e3c7..66d7fb6c16a 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -139,6 +139,7 @@ and showing the image as an image." ;; was inserted (let* ((image (if (and (buffer-file-name) + (not (file-remote-p (buffer-file-name))) (not (buffer-modified-p)) (not (and (boundp 'archive-superior-buffer) archive-superior-buffer)) diff --git a/lisp/info-xref.el b/lisp/info-xref.el index 75bc72f25b4..a6acfa8021c 100644 --- a/lisp/info-xref.el +++ b/lisp/info-xref.el @@ -301,7 +301,10 @@ quite a while." (lambda (symbol) (dolist (link (get symbol 'custom-links)) (when (memq (car link) '(custom-manual info-link)) - (if (info-xref-goto-node-p (cadr link)) + ;; skip :tag part of (custom-manual :tag "Foo" "(foo)Node") + (if (eq :tag (cadr link)) + (setq link (cddr link))) + (if (info-xref-goto-node-p (cadr link)) (setq good (1+ good)) (setq bad (1+ bad)) ;; symbol-file gives nil for preloaded variables, would need diff --git a/lisp/info.el b/lisp/info.el index d12b7a01866..107dbb72d95 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -2866,8 +2866,11 @@ Give an empty topic name to go to the Index node itself." (car (car Info-index-alternatives)) (nth 2 (car Info-index-alternatives)) (if (cdr Info-index-alternatives) - (format "(%s total; use `,' for next)" - (length Info-index-alternatives)) + (format "(%s total; use `%s' for next)" + (length Info-index-alternatives) + (key-description (where-is-internal + 'Info-index-next overriding-local-map + t))) "(Only match)"))) (defun Info-find-index-name (name) @@ -2907,11 +2910,20 @@ Build a menu of the possible matches." manuals matches node nodes) (let ((Info-fontify-maximum-menu-size nil)) (Info-directory) + ;; current-node and current-file are nil when they invoke info-apropos + ;; as the first Info command, i.e. info-apropos loads info.el. In that + ;; case, we use (DIR)Top instead, to avoid signalling an error after + ;; the search is complete. + (when (null current-node) + (setq current-file Info-current-file) + (setq current-node Info-current-node)) (message "Searching indices...") (goto-char (point-min)) (re-search-forward "\\* Menu: *\n" nil t) (while (re-search-forward "\\*.*: *(\\([^)]+\\))" nil t) - (setq manuals (cons (match-string 1) manuals))) + ;; add-to-list makes sure we don't have duplicates in `manuals', + ;; so that the following dolist loop runs faster. + (add-to-list 'manuals (match-string 1))) (dolist (manual (nreverse manuals)) (message "Searching %s" manual) (condition-case err diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index b0ad3cd5ec8..77ef9f07d59 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -73,8 +73,7 @@ (make-sparse-keymap "Set Coding System")) (define-key-after mule-menu-keymap [set-language-environment] - (list 'menu-item "Set Language Environment" setup-language-environment-map - :help "Multilingual environment suitable for a specific language")) + (list 'menu-item "Set Language Environment" setup-language-environment-map)) (define-key-after mule-menu-keymap [separator-mule] '("--") t) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 9e0edb75f29..ae3301e24a9 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -356,9 +356,9 @@ Return t if file exists." )) (let (kill-buffer-hook kill-buffer-query-functions) (kill-buffer buffer))) - (let ((hook (assoc file after-load-alist))) - (when hook - (mapcar (function eval) (cdr hook)))) + (unless purify-flag + (do-after-load-evaluation fullname)) + (unless (or nomessage noninteractive) (if source (message "Loading %s (source)...done" file) @@ -1649,6 +1649,9 @@ This is used for loading and byte-compiling Emacs Lisp files.") (setq alist (cdr alist)))) coding-system)) +(put 'enable-character-translation 'permanent-local t) +(put 'enable-character-translation 'safe-local-variable 'booleanp) + (defun find-auto-coding (filename size) "Find a coding system for a file FILENAME of which SIZE bytes follow point. These bytes should include at least the first 1k of the file @@ -1686,17 +1689,21 @@ If nothing is specified, the return value is nil." (head-end (+ head-start (min size 1024))) (tail-start (+ head-start (max (- size 3072) 0))) (tail-end (+ head-start size)) - coding-system head-found tail-found pos) + coding-system head-found tail-found pos char-trans) ;; Try a short cut by searching for the string "coding:" ;; and for "unibyte:" at the head and tail of SIZE bytes. (setq head-found (or (search-forward "coding:" head-end t) - (search-forward "unibyte:" head-end t))) + (search-forward "unibyte:" head-end t) + (search-forward "enable-character-translation:" + head-end t))) (if (and head-found (> head-found tail-start)) ;; Head and tail are overlapped. (setq tail-found head-found) (goto-char tail-start) (setq tail-found (or (search-forward "coding:" tail-end t) - (search-forward "unibyte:" tail-end t)))) + (search-forward "unibyte:" tail-end t) + (search-forward "enable-character-translation:" + tail-end t)))) ;; At first check the head. (when head-found @@ -1714,12 +1721,16 @@ If nothing is specified, the return value is nil." (re-search-forward "\\(.*;\\)?[ \t]*coding:[ \t]*\\([^ ;]+\\)" head-end t)) - (setq coding-system (intern (match-string 2)))))) + (setq coding-system (intern (match-string 2)))) + (when (re-search-forward + "\\(.*;\\)?[ \t]*enable-character-translation:[ \t]*\\([^ ;]+\\)" + head-end t) + (setq char-trans (match-string 2))))) ;; If no coding: tag in the head, check the tail. ;; Here we must pay attention to the case that the end-of-line ;; is just "\r" and we can't use "^" nor "$" in regexp. - (when (and tail-found (not coding-system)) + (when (and tail-found (or (not coding-system) (not char-trans))) (goto-char tail-start) (re-search-forward "[\r\n]\^L" nil t) (if (re-search-forward @@ -1742,6 +1753,11 @@ If nothing is specified, the return value is nil." "[\r\n]" prefix "[ \t]*unibyte[ \t]*:[ \t]*\\([^ \t\r\n]+\\)[ \t]*" suffix "[\r\n]")) + (re-char-trans + (concat + "[\r\n]" prefix + "[ \t]*enable-character-translation[ \t]*:[ \t]*\\([^ \t\r\n]+\\)[ \t]*" + suffix "[\r\n]")) (re-end (concat "[\r\n]" prefix "[ \t]*End *:[ \t]*" suffix "[\r\n]?")) @@ -1755,7 +1771,21 @@ If nothing is specified, the return value is nil." (setq coding-system 'raw-text)) (when (and (not coding-system) (re-search-forward re-coding tail-end t)) - (setq coding-system (intern (match-string 1))))))) + (setq coding-system (intern (match-string 1)))) + (when (and (not char-trans) + (re-search-forward re-char-trans tail-end t)) + (setq char-trans (match-string 1)))))) + (if coding-system + ;; If the coding-system name ends with "!", remove it and + ;; set char-trans to "nil". + (let ((name (symbol-name coding-system))) + (if (= (aref name (1- (length name))) ?!) + (setq coding-system (intern (substring name 0 -1)) + char-trans "nil")))) + (when (and char-trans + (not (setq char-trans (intern char-trans)))) + (make-local-variable 'enable-character-translation) + (setq enable-character-translation nil)) (if coding-system (cons coding-system :coding))) ;; Finally, try all the `auto-coding-functions'. @@ -1962,7 +1992,8 @@ Part of the job of this function is setting `buffer-undo-list' appropriately." (or coding (setq coding (car (find-operation-coding-system 'insert-file-contents - filename visit beg end replace)))) + (cons filename (current-buffer)) + visit beg end replace)))) (if (coding-system-p coding) (or enable-multibyte-characters (setq coding @@ -2246,18 +2277,19 @@ This function is intended to be added to `auto-coding-functions'." "If the buffer has an HTML meta tag, use it to determine encoding. This function is intended to be added to `auto-coding-functions'." (setq size (min (+ (point) size) - ;; Only search forward 10 lines (save-excursion - (forward-line 10) + ;; Limit the search by the end of the HTML header. + (or (search-forward "</head>" size t) + ;; In case of no header, search only 10 lines. + (forward-line 10)) (point)))) - (when (and (search-forward "<html" size t) - (re-search-forward "<meta\\s-+http-equiv=\"content-type\"\\s-+content=\"text/\\sw+;\\s-*charset=\\(.+?\\)\"" size t)) - (let* ((match (match-string 1)) - (sym (intern (downcase match)))) - (if (coding-system-p sym) - sym - (message "Warning: unknown coding system \"%s\"" match) - nil)))) + (when (re-search-forward "<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']text/\\sw+;\\s-*charset=\\(.+?\\)[\"']" size t) + (let* ((match (match-string 1)) + (sym (intern (downcase match)))) + (if (coding-system-p sym) + sym + (message "Warning: unknown coding system \"%s\"" match) + nil)))) ;;; (provide 'mule) diff --git a/lisp/loadup.el b/lisp/loadup.el index 00e9e35ff60..7691482f4e7 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -83,6 +83,7 @@ (load "help") +(load "jka-cmpr-hook") ;; Any Emacs Lisp source file (*.el) loaded here after can contain ;; multilingual text. (load "international/mule-cmds") @@ -201,7 +202,6 @@ (message "%s" (garbage-collect)) (load "vc-hooks") -(load "jka-cmpr-hook") (load "ediff-hook") (if (fboundp 'x-show-tip) (load "tooltip")) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 97ada1942bc..4abbd164fec 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -624,7 +624,7 @@ the variable `rmail-mime-feature'.") ;;;###autoload (defvar rmail-mime-charset-pattern (concat "^content-type:[ ]*text/plain;" - "\\(?:[ \t\n]*\\(format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*" + "\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*" "[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?") "Regexp to match MIME-charset specification in a header of message. The first parenthesized expression should match the MIME-charset name.") @@ -1994,7 +1994,7 @@ is non-nil if the user has supplied the password interactively. (re-search-backward rmail-mime-charset-pattern start t)))) - (intern (downcase (match-string 2)))))) + (intern (downcase (match-string 1)))))) (rmail-decode-region start (point) mime-charset))))) ;; Add an X-Coding-System: header if we don't have one. (save-excursion @@ -2155,7 +2155,7 @@ is non-nil if the user has supplied the password interactively. (re-search-backward rmail-mime-charset-pattern start t)))) - (intern (downcase (match-string 2)))))) + (intern (downcase (match-string 1)))))) (rmail-decode-region start (point) mime-charset))) (save-excursion (goto-char start) diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index aea34ed1474..93e9141f4cc 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in @@ -33,7 +33,7 @@ srcdir = $(CURDIR)/.. # You can specify a different executable on the make command line, # e.g. "make EMACS=../src/emacs ...". -EMACS = "$(THISDIR)/../bin/emacs.exe" +EMACS = $(THISDIR)/../bin/emacs.exe # Command line flags for Emacs. This must include --multibyte, # otherwise some files will not compile. @@ -64,8 +64,11 @@ COMPILE_FIRST = \ $(lisp)/progmodes/cc-vars.el # The actual Emacs command run in the targets below. +# The quotes around $(EMACS) are here because the user could type +# it with forward slashes and without quotes, which will fail if +# the shell is cmd.exe. -emacs = $(EMACS) $(EMACSOPT) +emacs = "$(EMACS)" $(EMACSOPT) # Common command to find subdirectories @@ -320,7 +323,7 @@ $(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC) $(MAKE) $(MFLAGS) pre-mh-loaddefs.el-$(SHELLTYPE) cp pre-mh-loaddefs.el-$(SHELLTYPE) $@ rm pre-mh-loaddefs.el-$(SHELLTYPE) - $(EMACS) $(EMACSOPT) \ + "$(EMACS)" $(EMACSOPT) \ -l autoload \ --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \ --eval "(setq find-file-suppress-same-file-warnings t)" \ @@ -381,12 +384,12 @@ pre-mh-loaddefs.el-CMD: bootstrap-clean: bootstrap-clean-$(SHELLTYPE) $(lisp)/loaddefs.el bootstrap-clean-CMD: -# if exist $(EMACS) $(MAKE) $(MFLAGS) autoloads +# if exist "$(EMACS)" $(MAKE) $(MFLAGS) autoloads cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el -for %%f in (. $(WINS)) do for %%g in (%%f\*.elc) do @$(DEL) %%g bootstrap-clean-SH: -# if test -f $(EMACS); then $(MAKE) $(MFLAGS) autoloads; fi +# if test -f "$(EMACS)"; then $(MAKE) $(MFLAGS) autoloads; fi # -rm -f $(lisp)/*.elc $(lisp)/*/*.elc cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el -for dir in . $(WINS); do rm -f $$dir/*.elc; done @@ -396,7 +399,7 @@ bootstrap-clean-SH: # it will not be mistaken for an installed binary. bootstrap: update-subdirs autoloads mh-autoloads compile finder-data custom-deps - - $(DEL) $(EMACS) + - $(DEL) "$(EMACS)" # # Assuming INSTALL_DIR is defined, copy the elisp files to it diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 0ec4339f822..cc1351b9032 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -300,8 +300,7 @@ A large number or nil slows down menu responsiveness." (define-key menu-bar-search-menu [i-search] - (list 'menu-item "Incremental Search" menu-bar-i-search-menu - :help "Incremental Search finds partial matches while you type the search string.\nIt is most convenient from the keyboard. Try it!")) + (list 'menu-item "Incremental Search" menu-bar-i-search-menu)) (define-key menu-bar-search-menu [separator-tag-isearch] '(menu-item "--")) @@ -369,8 +368,7 @@ A large number or nil slows down menu responsiveness." ;;; Assemble the top-level Edit menu items. (define-key menu-bar-edit-menu [props] - '(menu-item "Text Properties" facemenu-menu - :help "Change properties of text in region")) + '(menu-item "Text Properties" facemenu-menu)) (define-key menu-bar-edit-menu [fill] '(menu-item "Fill" fill-region @@ -382,8 +380,7 @@ A large number or nil slows down menu responsiveness." '(menu-item "--")) (define-key menu-bar-edit-menu [bookmark] - '(menu-item "Bookmarks" menu-bar-bookmark-map - :help "Record positions and jump between them")) + '(menu-item "Bookmarks" menu-bar-bookmark-map)) (defvar menu-bar-goto-menu (make-sparse-keymap "Go To")) @@ -467,8 +464,7 @@ A large number or nil slows down menu responsiveness." (fset 'yank-menu (cons 'keymap yank-menu)) (define-key menu-bar-edit-menu [select-paste] '(menu-item "Select and Paste" yank-menu - :enable (and (cdr yank-menu) (not buffer-read-only)) - :help "Paste (yank) text cut or copied earlier")) + :enable (and (cdr yank-menu) (not buffer-read-only)))) (define-key menu-bar-edit-menu [paste] '(menu-item "Paste" yank :enable (and @@ -641,8 +637,7 @@ by \"Save Options\" in Custom buffers.") ;;; Assemble all the top-level items of the "Options" menu (define-key menu-bar-options-menu [customize] - (list 'menu-item "Customize Emacs" menu-bar-custom-menu - :help "Full customization of every Emacs feature")) + (list 'menu-item "Customize Emacs" menu-bar-custom-menu)) (defun menu-bar-options-save () "Save current values of Options menu items using Custom." @@ -880,8 +875,7 @@ mail status in mode line")) (define-key menu-bar-showhide-menu [showhide-fringe] (list 'menu-item "Fringe" menu-bar-showhide-fringe-menu - :visible `(display-graphic-p) - :help "Select fringe mode")) + :visible `(display-graphic-p))) (defvar menu-bar-showhide-scroll-bar-menu (make-sparse-keymap "Scroll-bar")) @@ -925,8 +919,7 @@ mail status in mode line")) (define-key menu-bar-showhide-menu [showhide-scroll-bar] (list 'menu-item "Scroll-bar" menu-bar-showhide-scroll-bar-menu - :visible `(display-graphic-p) - :help "Select scroll-bar mode")) + :visible `(display-graphic-p))) (define-key menu-bar-showhide-menu [showhide-tooltip-mode] (list 'menu-item "Tooltips" 'tooltip-mode @@ -946,8 +939,7 @@ mail status in mode line")) :button `(:toggle . tool-bar-mode))) (define-key menu-bar-options-menu [showhide] - (list 'menu-item "Show/Hide" menu-bar-showhide-menu - :help "Toggle on/off various display features")) + (list 'menu-item "Show/Hide" menu-bar-showhide-menu)) (define-key menu-bar-options-menu [showhide-separator] '("--")) @@ -960,7 +952,7 @@ mail status in mode line")) ;; Most of the MULE menu actually does make sense in unibyte mode, ;; e.g. language selection. ;;; ':visible 'default-enable-multibyte-characters - ':help "Default language, encodings, input method")) + )) ;(setq menu-bar-final-items (cons 'mule menu-bar-final-items)) ;(define-key menu-bar-options-menu [preferences] ; (list 'menu-item "Preferences" menu-bar-preferences-menu @@ -1137,14 +1129,13 @@ mail status in mode line")) '(menu-item "Programmable Calculator" calc :help "Invoke the Emacs built-in full scientific calculator")) (define-key menu-bar-tools-menu [calendar] - '(menu-item "Display Calendar" calendar)) + '(menu-item "Calendar" calendar)) (define-key menu-bar-tools-menu [separator-net] '("--")) (define-key menu-bar-tools-menu [directory-search] - '(menu-item "Directory Search" eudc-tools-menu - :help "Query directory servers via LDAP, CCSO PH/QI or BBDB")) + '(menu-item "Directory Search" eudc-tools-menu)) (define-key menu-bar-tools-menu [compose-mail] (list 'menu-item `(format "Send Mail (with %s)" (send-mail-item-name)) @@ -1172,27 +1163,21 @@ mail status in mode line")) (defvar vc-menu-map (make-sparse-keymap "Version Control")) (define-key menu-bar-tools-menu [pcl-cvs] - '(menu-item "PCL-CVS" cvs-global-menu - :help "Module-level interface to CVS")) + '(menu-item "PCL-CVS" cvs-global-menu)) (define-key menu-bar-tools-menu [vc] - (list 'menu-item "Version Control" vc-menu-map - :help "Interface to RCS, CVS, SCCS")) + (list 'menu-item "Version Control" vc-menu-map)) (define-key menu-bar-tools-menu [separator-compare] '("--")) (define-key menu-bar-tools-menu [ediff-misc] - '(menu-item "Ediff Miscellanea" menu-bar-ediff-misc-menu - :help "Ediff manual, customization, sessions, etc.")) + '(menu-item "Ediff Miscellanea" menu-bar-ediff-misc-menu)) (define-key menu-bar-tools-menu [epatch] '(menu-item "Apply Patch" menu-bar-epatch-menu)) (define-key menu-bar-tools-menu [ediff-merge] - '(menu-item "Merge" menu-bar-ediff-merge-menu - :help "Merge different revisions of files/directories")) + '(menu-item "Merge" menu-bar-ediff-merge-menu)) (define-key menu-bar-tools-menu [compare] - '(menu-item "Compare (Ediff)" menu-bar-ediff-menu - :help "Display differences between files/directories")) - + '(menu-item "Compare (Ediff)" menu-bar-ediff-menu)) (define-key menu-bar-tools-menu [separator-spell] '("--")) @@ -1242,8 +1227,7 @@ mail status in mode line")) :help "Keyboard layout for specific input method")) (define-key menu-bar-describe-menu [describe-language-environment] (list 'menu-item "Describe Language Environment" - describe-language-environment-map - :help "Show multilingual settings for a specific language")) + describe-language-environment-map)) (define-key menu-bar-describe-menu [separator-desc-mule] '("--")) @@ -1318,6 +1302,12 @@ key, a click, or a menu-item")) :help "Find commands whose names match a regexp")) (define-key menu-bar-apropos-menu [sep1] '("--")) +(define-key menu-bar-apropos-menu [emacs-command-node] + '(menu-item "Look Up Command in User Manual..." Info-goto-emacs-command-node + :help "Display manual section that describes a command")) +(define-key menu-bar-apropos-menu [emacs-key-command-node] + '(menu-item "Look Up Key in User Manual..." Info-goto-emacs-key-command-node + :help "Display manual section that describes a key")) (define-key menu-bar-apropos-menu [elisp-index-search] '(menu-item "Look Up Subject in ELisp Manual..." elisp-index-search :help "Find description of a subject in Emacs Lisp manual")) @@ -1338,6 +1328,9 @@ key, a click, or a menu-item")) (define-key menu-bar-manuals-menu [order-emacs-manuals] '(menu-item "Ordering Manuals" view-order-manuals :help "How to order manuals from the Free Software Foundation")) +(define-key menu-bar-manuals-menu [info-apropos] + '(menu-item "Lookup Subject in all manuals..." info-apropos + :help "Find description of a subject in all installed manuals")) (define-key menu-bar-manuals-menu [info] '(menu-item "All Other Manuals (Info)" Info-directory :help "Read any of the installed manuals")) @@ -1347,14 +1340,6 @@ key, a click, or a menu-item")) (define-key menu-bar-manuals-menu [info-elintro] '(menu-item "Introduction to Emacs Lisp" menu-bar-read-lispintro :help "Read the Introduction to Emacs Lisp Programming")) -(define-key menu-bar-manuals-menu [sep3] - '("--")) -(define-key menu-bar-manuals-menu [command] - '(menu-item "Find Command in Manual..." Info-goto-emacs-command-node - :help "Display manual section that describes a command")) -(define-key menu-bar-manuals-menu [key] - '(menu-item "Find Key in Manual..." Info-goto-emacs-key-command-node - :help "Display manual section that describes a key")) (define-key menu-bar-help-menu [eliza] '(menu-item "Emacs Psychotherapist" doctor @@ -1389,17 +1374,14 @@ key, a click, or a menu-item")) '(menu-item "Find Emacs Packages" finder-by-keyword :help "Find packages and features by keyword")) (define-key menu-bar-help-menu [manuals] - (list 'menu-item "More Manuals" menu-bar-manuals-menu - :help "Search and browse on-line manuals")) + (list 'menu-item "More Manuals" menu-bar-manuals-menu)) (define-key menu-bar-help-menu [emacs-manual] '(menu-item "Read the Emacs Manual" info-emacs-manual :help "Full documentation of Emacs features")) (define-key menu-bar-help-menu [describe] - (list 'menu-item "Describe" menu-bar-describe-menu - :help "Describe commands, variables, keys")) + (list 'menu-item "Describe" menu-bar-describe-menu)) (define-key menu-bar-help-menu [apropos] - (list 'menu-item "Search Documentation" menu-bar-apropos-menu - :help "Look up terms, find commands, options, etc. (Apropos)")) + (list 'menu-item "Search Documentation" menu-bar-apropos-menu)) (define-key menu-bar-help-menu [sep1] '("--")) (define-key menu-bar-help-menu [report-emacs-bug] diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index 14891204fad..b6f8dd71d9a 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -1524,7 +1524,7 @@ construct the base name." (with-temp-buffer (mh-exec-cmd-output "folder" nil "-fast" "-nocreate" folder) (goto-char (point-min)) - (not (eobp)))))) + (looking-at (format "+?%s" folder)))))) (defun mh-msg-exists-p (msg folder) "Check if MSG exists in FOLDER." diff --git a/lisp/msb.el b/lisp/msb.el index 61ddce5dae0..d5f32486971 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -1007,7 +1007,7 @@ variable `msb-menu-cond'." (mouse-select-buffer event)) ((and (numberp (car choice)) (null (cdr choice))) - (let ((msb--last-buffer-menu (nthcdr 3 (assq (car choice) + (let ((msb--last-buffer-menu (nthcdr 2 (assq (car choice) msb--last-buffer-menu)))) (mouse-select-buffer event))) ((while (numberp (car choice)) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 101b9cf210d..3f514a2aaab 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -680,6 +680,10 @@ interactively. Turn the filename into a URL with function (defun browse-url-file-url (file) "Return the URL corresponding to FILE. Use variable `browse-url-filename-alist' to map filenames to URLs." + (let ((coding (and default-enable-multibyte-characters + (or file-name-coding-system + default-file-name-coding-system)))) + (if coding (setq file (encode-coding-string file coding)))) ;; URL-encode special chars, do % first (let ((s 0)) (while (setq s (string-match "%" file s)) diff --git a/lisp/pcvs-info.el b/lisp/pcvs-info.el index 4aaa5add58d..085f294e6fb 100644 --- a/lisp/pcvs-info.el +++ b/lisp/pcvs-info.el @@ -379,7 +379,8 @@ For use by the cookie package." ;; or nothing ""))) (format "%-11s %s %-11s %-11s %s" - side status type base file))))))) + side status type base file)))) + "\n"))) (defun cvs-fileinfo-update (fi fi-new) diff --git a/lisp/pcvs.el b/lisp/pcvs.el index b9d04522181..5e322b9276a 100644 --- a/lisp/pcvs.el +++ b/lisp/pcvs.el @@ -467,7 +467,7 @@ If non-nil, NEW means to create a new buffer no matter what." (cvs-mode) (set (make-local-variable 'list-buffers-directory) buffer-name) ;;(set (make-local-variable 'cvs-temp-buffer) (cvs-temp-buffer)) - (let ((cookies (ewoc-create 'cvs-fileinfo-pp "\n" ""))) + (let ((cookies (ewoc-create 'cvs-fileinfo-pp "\n\n" "\n" t))) (set (make-local-variable 'cvs-cookies) cookies) (add-hook 'kill-buffer-hook (lambda () @@ -618,7 +618,7 @@ If non-nil, NEW means to create a new buffer no matter what." (str (car hf)) (done "") (tin (ewoc-nth cvs-cookies 0))) - (if (eq (length str) 1) (setq str "")) + (if (eq (length str) 2) (setq str "")) ;; look for the first *real* fileinfo (to determine emptyness) (while (and tin @@ -633,6 +633,7 @@ If non-nil, NEW means to create a new buffer no matter what." (setq str (replace-match "" t t str)) (if (zerop (length str)) (setq str "\n")) (setq done (concat "-- last cmd: " cmd " --")))) + (setq str (concat str "\n") done (concat done "\n")) ;; set the new header and footer (ewoc-set-hf cvs-cookies str (concat "\n--------------------- " diff --git a/lisp/pgg-pgp.el b/lisp/pgg-pgp.el index f58fd0d3c6d..e53a0c2c867 100644 --- a/lisp/pgg-pgp.el +++ b/lisp/pgg-pgp.el @@ -136,21 +136,21 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." "Encrypt the current region between START and END." (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) (passphrase (or passphrase - (when sign - (pgg-read-passphrase - (format "PGP passphrase for %s: " - pgg-pgp-user-id) - pgg-pgp-user-id)))) + (when sign + (pgg-read-passphrase + (format "PGP passphrase for %s: " + pgg-pgp-user-id) + pgg-pgp-user-id)))) (args - (append - `("+encrypttoself=off +verbose=1" "+batchmode" - "+language=us" "-fate" - ,@(if recipients - (mapcar (lambda (rcpt) (concat "\"" rcpt "\"")) - (append recipients - (if pgg-encrypt-for-me - (list pgg-pgp-user-id)))))) - (if sign '("-s" "-u" pgg-pgp-user-id))))) + (append + `("+encrypttoself=off +verbose=1" "+batchmode" + "+language=us" "-fate" + ,@(if recipients + (mapcar (lambda (rcpt) (concat "\"" rcpt "\"")) + (append recipients + (if pgg-encrypt-for-me + (list pgg-pgp-user-id)))))) + (if sign '("-s" "-u" pgg-pgp-user-id))))) (pgg-pgp-process-region start end nil pgg-pgp-program args) (pgg-process-when-success nil))) @@ -162,11 +162,11 @@ passphrase cache or user." (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) (key (pgg-pgp-lookup-key pgg-pgp-user-id 'encrypt)) (passphrase - (or passphrase - (pgg-read-passphrase - (format "PGP passphrase for %s: " pgg-pgp-user-id) key))) + (or passphrase + (pgg-read-passphrase + (format "PGP passphrase for %s: " pgg-pgp-user-id) key))) (args - '("+verbose=1" "+batchmode" "+language=us" "-f"))) + '("+verbose=1" "+batchmode" "+language=us" "-f"))) (pgg-pgp-process-region start end passphrase pgg-pgp-program args) (pgg-process-when-success (if pgg-cache-passphrase @@ -179,10 +179,10 @@ If optional PASSPHRASE is not specified, it will be obtained from the passphrase cache or user." (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) (passphrase - (or passphrase - (pgg-read-passphrase - (format "PGP passphrase for %s: " pgg-pgp-user-id) - (pgg-pgp-lookup-key pgg-pgp-user-id 'sign)))) + (or passphrase + (pgg-read-passphrase + (format "PGP passphrase for %s: " pgg-pgp-user-id) + (pgg-pgp-lookup-key pgg-pgp-user-id 'sign)))) (args (list (if clearsign "-fast" "-fbast") "+verbose=1" "+language=us" "+batchmode" diff --git a/lisp/pgg-pgp5.el b/lisp/pgg-pgp5.el index 3cba59916e5..75c96e59909 100644 --- a/lisp/pgg-pgp5.el +++ b/lisp/pgg-pgp5.el @@ -147,23 +147,23 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." "Encrypt the current region between START and END." (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id)) (passphrase (or passphrase - (when sign - (pgg-read-passphrase - (format "PGP passphrase for %s: " - pgg-pgp5-user-id) - pgg-pgp5-user-id)))) + (when sign + (pgg-read-passphrase + (format "PGP passphrase for %s: " + pgg-pgp5-user-id) + pgg-pgp5-user-id)))) (args - (append - `("+NoBatchInvalidKeys=off" "-fat" "+batchmode=1" - ,@(if recipients - (apply #'append - (mapcar (lambda (rcpt) - (list "-r" - (concat "\"" rcpt "\""))) - (append recipients - (if pgg-encrypt-for-me - (list pgg-pgp5-user-id))))))) - (if sign '("-s" "-u" pgg-pgp5-user-id))))) + (append + `("+NoBatchInvalidKeys=off" "-fat" "+batchmode=1" + ,@(if recipients + (apply #'append + (mapcar (lambda (rcpt) + (list "-r" + (concat "\"" rcpt "\""))) + (append recipients + (if pgg-encrypt-for-me + (list pgg-pgp5-user-id))))))) + (if sign '("-s" "-u" pgg-pgp5-user-id))))) (pgg-pgp5-process-region start end nil pgg-pgp5-pgpe-program args) (pgg-process-when-success nil))) @@ -171,10 +171,10 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." "Decrypt the current region between START and END." (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id)) (passphrase - (or passphrase - (pgg-read-passphrase - (format "PGP passphrase for %s: " pgg-pgp5-user-id) - (pgg-pgp5-lookup-key pgg-pgp5-user-id 'encrypt)))) + (or passphrase + (pgg-read-passphrase + (format "PGP passphrase for %s: " pgg-pgp5-user-id) + (pgg-pgp5-lookup-key pgg-pgp5-user-id 'encrypt)))) (args '("+verbose=1" "+batchmode=1" "+language=us" "-f"))) (pgg-pgp5-process-region start end passphrase pgg-pgp5-pgpv-program args) @@ -184,10 +184,10 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." "Make detached signature from text between START and END." (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id)) (passphrase - (or passphrase - (pgg-read-passphrase - (format "PGP passphrase for %s: " pgg-pgp5-user-id) - (pgg-pgp5-lookup-key pgg-pgp5-user-id 'sign)))) + (or passphrase + (pgg-read-passphrase + (format "PGP passphrase for %s: " pgg-pgp5-user-id) + (pgg-pgp5-lookup-key pgg-pgp5-user-id 'sign)))) (args (list (if clearsign "-fat" "-fbat") "+verbose=1" "+language=us" "+batchmode=1" diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index 6f623623535..c2b9b435e4c 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -264,7 +264,7 @@ element of the list is added with `add-hook'. Do not change this variable directly. Use the function `c-add-style' to add new styles or modify existing styles (it is not a good idea to modify existing styles -- you should create a new style that inherits -the existing style.") +the existing style).") ;; Functions that manipulate styles diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 64e38be62d0..0e6738710c5 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -812,6 +812,7 @@ macro exceeds this column then the next tab stop from that line is used as alignment column instead." :type 'integer :group 'c) +;;;###autoload(put 'c-backslash-column 'safe-local-variable 'integerp) (defcustom-c-stylevar c-backslash-max-column 72 "*Maximum alignment column for line continuation backslashes. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 527624bfc4e..5da86972ec5 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -228,7 +228,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) \\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\ \\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\ \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\ - *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\)\\)?" + *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|instantiated from\\)\\)?" 1 (2 . 5) (4 . 6) (7 . 8)) (lcc @@ -236,7 +236,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) 2 3 4 (1)) (makepp - "^makepp: \\(?:\\(?:warning\\(:\\).*?\\|\\(Scanning\\|[LR]e?l?oading makefile\\) \\|.*?\\)\ + "^makepp: \\(?:\\(?:warning\\(:\\).*?\\|\\(Scanning\\|[LR]e?l?oading makefile\\|Imported\\) \\|.*?\\)\ `\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]\\)" 4 5 nil (1 . 2) 3 ("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]" nil nil @@ -293,15 +293,34 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?" \\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3)) (gcov-file - "^ +-: \\(0\\):Source:\\(.+\\)$" 2 1 nil 0) - (gcov-bb-file - "^ +-: \\(0\\):Object:\\(?:.+\\)$" nil 1 nil 0) - (gcov-never-called-line - "^ +\\(#####\\): +\\([0-9]+\\):.+$" nil 2 nil 2 nil - (1 compilation-error-face)) + "^ *-: *\\(0\\):Source:\\(.+\\)$" + 2 1 nil 0 nil + (1 compilation-line-face prepend) (2 compilation-info-face prepend)) + (gcov-header + "^ *-: *\\(0\\):\\(?:Object\\|Graph\\|Data\\|Runs\\|Programs\\):.+$" + nil 1 nil 0 nil + (1 compilation-line-face prepend)) + ;; Underlines over all lines of gcov output are too uncomfortable to read. + ;; However, hyperlinks embedded in the lines are useful. + ;; So I put default face on the lines; and then put + ;; compilation-*-face by manually to eliminate the underlines. + ;; The hyperlinks are still effective. + (gcov-nomark + "^ *-: *\\([1-9]\\|[0-9]\\{2,\\}\\):.*$" + nil 1 nil 0 nil + (0 'default t) + (1 compilation-line-face prepend)) (gcov-called-line - "^ +[-0-9]+: +\\([1-9]\\|[0-9]\\{2,\\}\\):.*$" nil 1 nil 0) -) + "^ *\\([0-9]+\\): *\\([0-9]+\\):.*$" + nil 2 nil 0 nil + (0 'default t) + (1 compilation-info-face prepend) (2 compilation-line-face prepend)) + (gcov-never-called + "^ *\\(#####\\): *\\([0-9]+\\):.*$" + nil 2 nil 2 nil + (0 'default t) + (1 compilation-error-face prepend) (2 compilation-line-face prepend)) + ) "Alist of values for `compilation-error-regexp-alist'.") (defcustom compilation-error-regexp-alist diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index f5d08d533fd..0f92523e306 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -71,11 +71,11 @@ ;;; Known Bugs: ;; 1) Strings that are watched don't update in the speedbar when their -;; contents change unless the first character changes. +;; contents change unless the first character changes. ;; 2) Cannot handle multiple debug sessions. -;; 3) Initially, the assembler buffer does not display the cursor at the -;; current line if the line is not visible in the window (but when testing -;; gdb-assembler-custom with a lisp debugger it does!). +;; 3) M-x gdb doesn't work with "run" command in .gdbinit, use M-x gdba instead. +;; 4) M-x gdb doesn't work if the corefile is specified in the command in the +;; minibuffer, use M-x gdba instead (or specify the core in the GUD buffer). ;;; Problems with watch expressions, GDB/MI: ;; 1) They go out of scope when the inferior is re-run. @@ -83,15 +83,10 @@ ;; 3) VARNUM increments even when variable object is not created ;; (maybe trivial). -;; Known Bugs: -;; 1) M-x gdb doesn't work with "run" command in .gdbinit, use M-x gdba instead. - ;;; TODO: ;; 1) Use MI command -data-read-memory for memory window. ;; 2) Use tree-widget.el instead of the speedbar for watch-expressions? ;; 3) Mark breakpoint locations on scroll-bar of source buffer? -;; 4) With gud-print and gud-pstar, print the variable name in the GUD -;; buffer instead of the value's history number. ;;; Code: @@ -130,6 +125,7 @@ and #define directives otherwise.") (defvar gdb-source-window nil) (defvar gdb-inferior-status nil) (defvar gdb-continuation nil) +(defvar gdb-look-up-stack nil) (defvar gdb-buffer-type nil "One of the symbols bound in `gdb-buffer-rules'.") @@ -493,26 +489,28 @@ With arg, use separate IO iff arg is positive." 'gdb-mouse-set-clear-breakpoint) (define-key gud-minor-mode-map [left-fringe mouse-1] 'gdb-mouse-set-clear-breakpoint) - (define-key gud-minor-mode-map [left-fringe mouse-2] - 'gdb-mouse-until) + (define-key gud-minor-mode-map [left-margin C-mouse-1] + 'gdb-mouse-toggle-breakpoint-margin) + (define-key gud-minor-mode-map [left-fringe C-mouse-1] + 'gdb-mouse-toggle-breakpoint-fringe) + (define-key gud-minor-mode-map [left-margin drag-mouse-1] 'gdb-mouse-until) (define-key gud-minor-mode-map [left-fringe drag-mouse-1] 'gdb-mouse-until) - (define-key gud-minor-mode-map [left-margin mouse-2] + (define-key gud-minor-mode-map [left-margin mouse-3] + 'gdb-mouse-until) + (define-key gud-minor-mode-map [left-fringe mouse-3] 'gdb-mouse-until) + (define-key gud-minor-mode-map [left-margin C-drag-mouse-1] 'gdb-mouse-jump) (define-key gud-minor-mode-map [left-fringe C-drag-mouse-1] 'gdb-mouse-jump) - (define-key gud-minor-mode-map [left-fringe C-mouse-2] + (define-key gud-minor-mode-map [left-fringe C-mouse-3] 'gdb-mouse-jump) - (define-key gud-minor-mode-map [left-margin C-mouse-2] + (define-key gud-minor-mode-map [left-margin C-mouse-3] 'gdb-mouse-jump) - (define-key gud-minor-mode-map [left-margin mouse-3] - 'gdb-mouse-toggle-breakpoint-margin) - (define-key gud-minor-mode-map [left-fringe mouse-3] - 'gdb-mouse-toggle-breakpoint-fringe) (setq comint-input-sender 'gdb-send) @@ -543,7 +541,8 @@ With arg, use separate IO iff arg is positive." gdb-signalled nil gdb-source-window nil gdb-inferior-status nil - gdb-continuation nil) + gdb-continuation nil + gdb-look-up-stack nil) (setq gdb-buffer-type 'gdba) @@ -738,7 +737,7 @@ With arg, enter name of variable to be watched in the minibuffer." `(lambda () (gdb-var-evaluate-expression-handler ,(car var) nil))))) (if (search-forward "Undefined command" nil t) - (message-box "Watching expressions requires gdb 6.0 onwards") + (message-box "Watching expressions requires GDB 6.0 onwards") (message-box "No symbol \"%s\" in current context." expr)))) (defun gdb-speedbar-update () @@ -1106,7 +1105,8 @@ This filter may simply queue input for a later time." (let ((item (concat string "\n"))) (if gdb-enable-debug (push (cons 'send item) gdb-debug-ring)) (process-send-string proc item))) - (if (string-match "\\\\$" string) + (if (and (string-match "\\\\$" string) + (not comint-input-sender-no-newline)) ;;Try to catch C-d. (setq gdb-continuation (concat gdb-continuation string "\n")) (let ((item (concat gdb-continuation string "\n"))) (gdb-enqueue-input item) @@ -1334,9 +1334,20 @@ directives." It is just like `gdb-stopping', except that if we already set the output sink to `user' in `gdb-stopping', that is fine." (setq gud-running nil) - (unless (or gud-overlay-arrow-position gud-last-frame - (not gud-last-last-frame)) - (gud-display-line (car gud-last-last-frame) (cdr gud-last-last-frame))) + (unless (or gud-overlay-arrow-position gud-last-frame) + ;;Pop up GUD buffer to display current frame when it doesn't have source + ;;information i.e id not compiled with -g as with libc routines generally. + (let ((special-display-regexps (append special-display-regexps '(".*"))) + (special-display-frame-alist gdb-frame-parameters) + (same-window-regexps nil)) + (display-buffer gud-comint-buffer)) + ;;Try to find source further up stack e.g after signal. + (setq gdb-look-up-stack + (if (gdb-get-buffer 'gdb-stack-buffer) 'keep + (progn + (gdb-get-buffer-create 'gdb-stack-buffer) + (gdb-invalidate-frames) + 'delete)))) (unless (member gdb-inferior-status '("exited" "signal")) (setq gdb-inferior-status "stopped") (gdb-force-mode-line-update gdb-inferior-status)) @@ -1945,36 +1956,57 @@ static char *magick[] = { (defun gdb-info-stack-custom () (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer) (save-excursion - (let ((buffer-read-only nil) - bl el) - (goto-char (point-min)) - (while (< (point) (point-max)) - (setq bl (line-beginning-position) - el (line-end-position)) - (when (looking-at "#") - (add-text-properties bl el - '(mouse-face highlight - help-echo "mouse-2, RET: Select frame"))) - (goto-char bl) - (when (looking-at "^#\\([0-9]+\\)") - (when (string-equal (match-string 1) gdb-frame-number) + (unless (eq gdb-look-up-stack 'delete) + (let ((buffer-read-only nil) + bl el) + (goto-char (point-min)) + (while (< (point) (point-max)) + (setq bl (line-beginning-position) + el (line-end-position)) + (when (looking-at "#") + (add-text-properties bl el + '(mouse-face highlight + help-echo "mouse-2, RET: Select frame"))) + (goto-char bl) + (when (looking-at "^#\\([0-9]+\\)") + (when (string-equal (match-string 1) gdb-frame-number) (put-text-property bl (+ bl 4) 'face '(:inverse-video t))) - (when (re-search-forward - (concat - (if (string-equal (match-string 1) "0") "" " in ") - "\\([^ ]+\\) (") el t) - (put-text-property (match-beginning 1) (match-end 1) - 'face font-lock-function-name-face) - (setq bl (match-end 0)) - (while (re-search-forward "<\\([^>]+\\)>" el t) + (when (re-search-forward + (concat + (if (string-equal (match-string 1) "0") "" " in ") + "\\([^ ]+\\) (") el t) (put-text-property (match-beginning 1) (match-end 1) + 'face font-lock-function-name-face) + (setq bl (match-end 0)) + (while (re-search-forward "<\\([^>]+\\)>" el t) + (put-text-property (match-beginning 1) (match-end 1) 'face font-lock-function-name-face)) - (goto-char bl) - (while (re-search-forward "\\(\\(\\sw\\|[_.]\\)+\\)=" el t) - (put-text-property (match-beginning 1) (match-end 1) - 'face font-lock-variable-name-face)))) - (forward-line 1)))))) + (goto-char bl) + (while (re-search-forward "\\(\\(\\sw\\|[_.]\\)+\\)=" el t) + (put-text-property (match-beginning 1) (match-end 1) + 'face font-lock-variable-name-face)))) + (forward-line 1)))) + (when gdb-look-up-stack + (goto-char (point-min)) + (when (re-search-forward "\\(\\S-+?\\):\\([0-9]+\\)" nil t) + (let ((start (line-beginning-position)) + (file (match-string 1)) + (line (match-string 2))) + (re-search-backward "^#*\\([0-9]+\\)" start t) + (gdb-enqueue-input + (list (concat gdb-server-prefix "frame " + (match-string 1) "\n") 'gdb-set-hollow)) + (gdb-enqueue-input + (list (concat gdb-server-prefix "frame 0\n") 'ignore))))))) + (if (eq gdb-look-up-stack 'delete) + (kill-buffer (gdb-get-buffer 'gdb-stack-buffer))) + (setq gdb-look-up-stack nil)) + +(defun gdb-set-hollow () + (with-current-buffer (gud-find-file (car gud-last-last-frame)) + (setq fringe-indicator-alist + '((overlay-arrow . hollow-right-triangle))))) (defun gdb-stack-buffer-name () (with-current-buffer gud-comint-buffer @@ -2030,8 +2062,7 @@ static char *magick[] = { (if event (posn-set-point (event-end event))) (gdb-enqueue-input (list (concat gdb-server-prefix "frame " - (gdb-get-frame-number) "\n") 'ignore)) - (gud-display-frame)) + (gdb-get-frame-number) "\n") 'ignore))) ;; Threads buffer. This displays a selectable thread list. @@ -2049,13 +2080,14 @@ static char *magick[] = { (defun gdb-info-threads-custom () (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer) (let ((buffer-read-only nil)) - (goto-char (point-min)) - (while (< (point) (point-max)) - (unless (looking-at "No ") - (add-text-properties (line-beginning-position) (line-end-position) - '(mouse-face highlight + (save-excursion + (goto-char (point-min)) + (while (< (point) (point-max)) + (unless (looking-at "No ") + (add-text-properties (line-beginning-position) (line-end-position) + '(mouse-face highlight help-echo "mouse-2, RET: select thread"))) - (forward-line 1))))) + (forward-line 1)))))) (defun gdb-threads-buffer-name () (with-current-buffer gud-comint-buffer @@ -2868,7 +2900,11 @@ of the current session." gud-comint-buffer (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) '(gdba gdbmi))) - (if (member buffer-file-name gdb-source-file-list) + ;;Pre GDB 6.3 "info sources" doesn't give absolute file name. + (if (member (if (string-equal gdb-version "pre-6.4") + (file-name-nondirectory buffer-file-name) + buffer-file-name) + gdb-source-file-list) (with-current-buffer (find-buffer-visiting buffer-file-name) (set (make-local-variable 'gud-minor-mode) (buffer-local-value 'gud-minor-mode gud-comint-buffer)) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 410a973d1b4..d207094cafe 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -553,7 +553,7 @@ easily repeat a find command." (read-string "compile.el: No `grep-find-command' command available. Press RET.") (list nil)))) - (when (and grep-find-command command-args) + (when command-args (let ((null-device nil)) ; see grep (grep command-args)))) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index d2e6cfc4ae4..1ce5d404a80 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -101,8 +101,8 @@ If SOFT is non-nil, returns nil if the symbol doesn't already exist." (if (boundp sym) (symbol-value sym)))) (defvar gud-running nil - "Non-nil if debuggee is running. -Used to grey out relevant togolbar icons.") + "Non-nil if debugged program is running. +Used to grey out relevant toolbar icons.") ;; Use existing Info buffer, if possible. (defun gud-goto-info () @@ -130,10 +130,10 @@ Used to grey out relevant togolbar icons.") (defun gud-stop-subjob () (interactive) - (if (string-equal - (buffer-local-value 'gud-target-name gud-comint-buffer) "emacs") - (comint-stop-subjob) - (comint-interrupt-subjob))) + (with-current-buffer gud-comint-buffer + (if (string-equal gud-target-name "emacs") + (comint-stop-subjob) + (comint-interrupt-subjob)))) (easy-mmode-defmap gud-menu-map '(([help] "Info" . gud-goto-info) @@ -141,13 +141,15 @@ Used to grey out relevant togolbar icons.") :enable (and (not emacs-basic-display) (display-graphic-p) (fboundp 'x-show-tip)) + :visible (memq gud-minor-mode + '(gdbmi gdba dbx sdb xdb pdb)) :button (:toggle . gud-tooltip-mode)) ([refresh] "Refresh" . gud-refresh) ([run] menu-item "Run" gud-run - :enable (and (not gud-running) - (memq gud-minor-mode '(gdbmi gdb dbx jdb))) - :visible (not (eq gud-minor-mode 'gdba))) - ([go] menu-item "Run/Continue" gud-go + :enable (not gud-running) + :visible (and (memq gud-minor-mode '(gdbmi gdb dbx jdb)) + (not (eq gud-minor-mode 'gdba)))) + ([go] menu-item (if gdb-active-process "Continue" "Run") gud-go :visible (and (not gud-running) (eq gud-minor-mode 'gdba))) ([stop] menu-item "Stop" gud-stop-subjob @@ -155,26 +157,27 @@ Used to grey out relevant togolbar icons.") (and gud-running (eq gud-minor-mode 'gdba)))) ([until] menu-item "Continue to selection" gud-until - :enable (and (not gud-running) - (memq gud-minor-mode '(gdbmi gdba gdb perldb))) - :visible (gud-tool-bar-item-visible-no-fringe)) + :enable (not gud-running) + :visible (and (memq gud-minor-mode '(gdbmi gdba gdb perldb)) + (gud-tool-bar-item-visible-no-fringe))) ([remove] menu-item "Remove Breakpoint" gud-remove :enable (not gud-running) :visible (gud-tool-bar-item-visible-no-fringe)) ([tbreak] menu-item "Temporary Breakpoint" gud-tbreak - :enable (memq gud-minor-mode + :enable (not gud-running) + :visible (memq gud-minor-mode '(gdbmi gdba gdb sdb xdb bashdb))) ([break] menu-item "Set Breakpoint" gud-break :enable (not gud-running) :visible (gud-tool-bar-item-visible-no-fringe)) ([up] menu-item "Up Stack" gud-up - :enable (and (not gud-running) - (memq gud-minor-mode - '(gdbmi gdba gdb dbx xdb jdb pdb bashdb)))) + :enable (not gud-running) + :visible (memq gud-minor-mode + '(gdbmi gdba gdb dbx xdb jdb pdb bashdb))) ([down] menu-item "Down Stack" gud-down - :enable (and (not gud-running) - (memq gud-minor-mode - '(gdbmi gdba gdb dbx xdb jdb pdb bashdb)))) + :enable (not gud-running) + :visible (memq gud-minor-mode + '(gdbmi gdba gdb dbx xdb jdb pdb bashdb))) ([pp] menu-item "Print S-expression" gud-pp :enable (and (not gud-running) gdb-active-process) @@ -183,23 +186,23 @@ Used to grey out relevant togolbar icons.") 'gud-target-name gud-comint-buffer) "emacs") (eq gud-minor-mode 'gdba))) ([print*] menu-item "Print Dereference" gud-pstar - :enable (and (not gud-running) - (memq gud-minor-mode '(gdbmi gdba gdb)))) + :enable (not gud-running) + :visible (memq gud-minor-mode '(gdbmi gdba gdb))) ([print] menu-item "Print Expression" gud-print :enable (not gud-running)) ([watch] menu-item "Watch Expression" gud-watch - :enable (and (not gud-running) - (memq gud-minor-mode '(gdbmi gdba)))) + :enable (not gud-running) + :visible (memq gud-minor-mode '(gdbmi gdba))) ([finish] menu-item "Finish Function" gud-finish - :enable (and (not gud-running) - (memq gud-minor-mode - '(gdbmi gdba gdb xdb jdb pdb bashdb)))) + :enable (not gud-running) + :visible (memq gud-minor-mode + '(gdbmi gdba gdb xdb jdb pdb bashdb))) ([stepi] menu-item "Step Instruction" gud-stepi - :enable (and (not gud-running) - (memq gud-minor-mode '(gdbmi gdba gdb dbx)))) + :enable (not gud-running) + :visible (memq gud-minor-mode '(gdbmi gdba gdb dbx))) ([nexti] menu-item "Next Instruction" gud-nexti - :enable (and (not gud-running) - (memq gud-minor-mode '(gdbmi gdba gdb dbx)))) + :enable (not gud-running) + :visible (memq gud-minor-mode '(gdbmi gdba gdb dbx))) ([step] menu-item "Step Line" gud-step :enable (not gud-running)) ([next] menu-item "Next Line" gud-next @@ -2565,7 +2568,7 @@ comint mode, which see." (existing-buffer (get-buffer (concat "*gud" filepart "*")))) (pop-to-buffer (concat "*gud" filepart "*")) (when (and existing-buffer (get-buffer-process existing-buffer)) - (error "This program is already running under gdb")) + (error "This program is already being debugged")) ;; Set the dir, in case the buffer already existed with a different dir. (setq default-directory dir) ;; Set default-directory to the file's directory. @@ -2693,10 +2696,10 @@ It is saved for when this flag is not set.") ((memq (process-status proc) '(signal exit)) ;; Stop displaying an arrow in a source file. (setq gud-overlay-arrow-position nil) - (with-current-buffer gud-comint-buffer - (if (memq gud-minor-mode-type '(gdbmi gdba)) - (gdb-reset) - (gud-reset))) + (if (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + '(gdba gdbmi)) + (gdb-reset) + (gud-reset)) (let* ((obuf (current-buffer))) ;; save-excursion isn't the right thing if ;; process-buffer is current-buffer @@ -3166,7 +3169,7 @@ class of the file (using s to separate nested class ids)." (defvar gdb-script-font-lock-keywords '(("^define\\s-+\\(\\(\\w\\|\\s_\\)+\\)" (1 font-lock-function-name-face)) ("\\$\\(\\w+\\)" (1 font-lock-variable-name-face)) - ("^\\s-*\\(\\(\\w\\|\\s_\\)+\\)" (1 font-lock-keyword-face)))) + ("^\\s-*\\(\\w\\(\\w\\|\\s_\\)*\\)" (1 font-lock-keyword-face)))) ;; FIXME: The keyword "end" associated with "document" ;; should have font-lock-keyword-face (currently font-lock-doc-face). @@ -3313,7 +3316,8 @@ Treats actions as defuns." (kill-local-variable 'gdb-define-alist) (remove-hook 'after-save-hook 'gdb-create-define-alist t)))) -(defcustom gud-tooltip-modes '(gud-mode c-mode c++-mode fortran-mode) +(defcustom gud-tooltip-modes '(gud-mode c-mode c++-mode fortran-mode + python-mode) "List of modes for which to enable GUD tooltips." :type 'sexp :group 'gud @@ -3427,9 +3431,8 @@ With arg, dereference expr iff arg is positive." (case gud-minor-mode (gdba (concat "server print " expr)) ((dbx gdbmi) (concat "print " expr)) - (xdb (concat "p " expr)) - (sdb (concat expr "/")) - (perldb expr))) + ((xdb pdb) (concat "p " expr)) + (sdb (concat expr "/")))) (defun gud-tooltip-tips (event) "Show tip for identifier or selection under the mouse. diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 04e44e2dac1..a100424108d 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -928,15 +928,17 @@ Return as (TOP . BOTTOM) the extent of ifdef block." (setq hide-ifdef-hiding t)) (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))) - (defun show-ifdef-block () "Show the ifdef block (true or false part) enclosing or before the cursor." (interactive) - (if hide-ifdef-lines - (save-excursion - (beginning-of-line) - (hif-show-ifdef-region (1- (point)) (progn (end-of-line) (point)))) - (let ((top-bottom (hif-find-ifdef-block))) + (let ((top-bottom (hif-find-ifdef-block))) + (if hide-ifdef-lines + (hif-show-ifdef-region + (save-excursion + (goto-char (car top-bottom)) (line-beginning-position)) + (save-excursion + (goto-char (1+ (cdr top-bottom))) + (hif-end-of-line) (point))) (hif-show-ifdef-region (1- (car top-bottom)) (cdr top-bottom))))) diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el index 092c7736c27..4a50e00063c 100644 --- a/lisp/progmodes/inf-lisp.el +++ b/lisp/progmodes/inf-lisp.el @@ -233,30 +233,37 @@ documentation for variable `inferior-lisp-buffer'. \\{inferior-lisp-mode-map} -Customisation: Entry to this mode runs the hooks on `comint-mode-hook' and +Customization: Entry to this mode runs the hooks on `comint-mode-hook' and `inferior-lisp-mode-hook' (in that order). You can send text to the inferior Lisp process from other buffers containing Lisp source. - switch-to-lisp switches the current buffer to the Lisp process buffer. - lisp-eval-defun sends the current defun to the Lisp process. - lisp-compile-defun compiles the current defun. - lisp-eval-region sends the current region to the Lisp process. - lisp-compile-region compiles the current region. + `switch-to-lisp' switches the current buffer to the Lisp process buffer. + `lisp-eval-defun' sends the current defun to the Lisp process. + `lisp-compile-defun' compiles the current defun. + `lisp-eval-region' sends the current region to the Lisp process. + `lisp-compile-region' compiles the current region. Prefixing the lisp-eval/compile-defun/region commands with a \\[universal-argument] causes a switch to the Lisp process buffer after sending the text. -Commands: -Return after the end of the process' output sends the text from the +Commands:\\<inferior-lisp-mode-map> +\\[comint-send-input] after the end of the process' output sends the text from the end of process to point. -Return before the end of the process' output copies the sexp ending at point +\\[comint-send-input] before the end of the process' output copies the sexp ending at point to the end of the process' output, and sends it. -Delete converts tabs to spaces as it moves back. -Tab indents for Lisp; with argument, shifts rest +\\[comint-copy-old-input] copies the sexp ending at point to the end of the process' output, + allowing you to edit it before sending it. +If `comint-use-prompt-regexp' is nil (the default), \\[comint-insert-input] on old input + copies the entire old input to the end of the process' output, allowing + you to edit it before sending it. When not used on old input, or if + `comint-use-prompt-regexp' is non-nil, \\[comint-insert-input] behaves according to + its global binding. +\\[backward-delete-char-untabify] converts tabs to spaces as it moves back. +\\[lisp-indent-line] indents for Lisp; with argument, shifts rest of expression rigidly with the current line. -C-M-q does Tab on each line starting within following expression. +\\[indent-sexp] does \\[lisp-indent-line] on each line starting within following expression. Paragraphs are separated only by blank lines. Semicolons start comments. If you accidentally suspend your process, use \\[comint-continue-subjob] to continue it." diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 3bbfeaac683..d22aedb6058 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -246,6 +246,7 @@ You will be offered to complete on one of those in the minibuffer whenever you enter a \".\" at the beginning of a line in `makefile-mode'." :type '(repeat (list string)) :group 'makefile) +(put 'makefile-special-targets-list 'risky-local-variable t) (defcustom makefile-runtime-macros-list '(("@") ("&") (">") ("<") ("*") ("^") ("+") ("?") ("%") ("$")) @@ -290,6 +291,9 @@ not be enclosed in { } or ( )." ;; that if you change this regexp you might have to fix the imenu index in ;; makefile-imenu-generic-expression. (defconst makefile-macroassign-regex + ;; We used to match not just the varname but also the whole value + ;; (spanning potentially several lines). + ;; "^ *\\([^ \n\t][^:#= \t\n]*\\)[ \t]*\\(?:!=[ \t]*\\(\\(?:.+\\\\\n\\)*.+\\)\\|[*:+]?[:?]?=[ \t]*\\(\\(?:.*\\\\\n\\)*.*\\)\\)" "^ *\\([^ \n\t][^:#= \t\n]*\\)[ \t]*\\(?:!=\\|[*:+]?[:?]?=\\)" "Regex used to find macro assignment lines in a makefile.") @@ -544,7 +548,8 @@ This should identify a `make' command that can handle the `-q' option." :type 'string :group 'makefile) -(defcustom makefile-query-one-target-method 'makefile-query-by-make-minus-q +(defcustom makefile-query-one-target-method-function + 'makefile-query-by-make-minus-q "*Function to call to determine whether a make target is up to date. The function must satisfy this calling convention: @@ -560,6 +565,8 @@ The function must satisfy this calling convention: makefile, any nonzero integer value otherwise." :type 'function :group 'makefile) +(defvaralias 'makefile-query-one-target-method + 'makefile-query-one-target-method-function) (defcustom makefile-up-to-date-buffer-name "*Makefile Up-to-date overview*" "*Name of the Up-to-date overview buffer." @@ -619,39 +626,38 @@ The function must satisfy this calling convention: map) "The keymap that is used in Makefile mode.") -(defvar makefile-browser-map nil + +(defvar makefile-browser-map + (let ((map (make-sparse-keymap))) + (define-key map "n" 'makefile-browser-next-line) + (define-key map "\C-n" 'makefile-browser-next-line) + (define-key map "p" 'makefile-browser-previous-line) + (define-key map "\C-p" 'makefile-browser-previous-line) + (define-key map " " 'makefile-browser-toggle) + (define-key map "i" 'makefile-browser-insert-selection) + (define-key map "I" 'makefile-browser-insert-selection-and-quit) + (define-key map "\C-c\C-m" 'makefile-browser-insert-continuation) + (define-key map "q" 'makefile-browser-quit) + ;; disable horizontal movement + (define-key map "\C-b" 'undefined) + (define-key map "\C-f" 'undefined) + map) "The keymap that is used in the macro- and target browser.") -(if makefile-browser-map - () - (setq makefile-browser-map (make-sparse-keymap)) - (define-key makefile-browser-map "n" 'makefile-browser-next-line) - (define-key makefile-browser-map "\C-n" 'makefile-browser-next-line) - (define-key makefile-browser-map "p" 'makefile-browser-previous-line) - (define-key makefile-browser-map "\C-p" 'makefile-browser-previous-line) - (define-key makefile-browser-map " " 'makefile-browser-toggle) - (define-key makefile-browser-map "i" 'makefile-browser-insert-selection) - (define-key makefile-browser-map "I" 'makefile-browser-insert-selection-and-quit) - (define-key makefile-browser-map "\C-c\C-m" 'makefile-browser-insert-continuation) - (define-key makefile-browser-map "q" 'makefile-browser-quit) - ;; disable horizontal movement - (define-key makefile-browser-map "\C-b" 'undefined) - (define-key makefile-browser-map "\C-f" 'undefined)) - - -(defvar makefile-mode-syntax-table nil) -(if makefile-mode-syntax-table - () - (setq makefile-mode-syntax-table (make-syntax-table)) - (modify-syntax-entry ?\( "() " makefile-mode-syntax-table) - (modify-syntax-entry ?\) ")( " makefile-mode-syntax-table) - (modify-syntax-entry ?\[ "(] " makefile-mode-syntax-table) - (modify-syntax-entry ?\] ")[ " makefile-mode-syntax-table) - (modify-syntax-entry ?\{ "(} " makefile-mode-syntax-table) - (modify-syntax-entry ?\} "){ " makefile-mode-syntax-table) - (modify-syntax-entry ?\' "\" " makefile-mode-syntax-table) - (modify-syntax-entry ?\` "\" " makefile-mode-syntax-table) - (modify-syntax-entry ?# "< " makefile-mode-syntax-table) - (modify-syntax-entry ?\n "> " makefile-mode-syntax-table)) + + +(defvar makefile-mode-syntax-table + (let ((st (make-syntax-table))) + (modify-syntax-entry ?\( "() " st) + (modify-syntax-entry ?\) ")( " st) + (modify-syntax-entry ?\[ "(] " st) + (modify-syntax-entry ?\] ")[ " st) + (modify-syntax-entry ?\{ "(} " st) + (modify-syntax-entry ?\} "){ " st) + (modify-syntax-entry ?\' "\" " st) + (modify-syntax-entry ?\` "\" " st) + (modify-syntax-entry ?# "< " st) + (modify-syntax-entry ?\n "> " st) + st)) (defvar makefile-imake-mode-syntax-table (copy-syntax-table makefile-mode-syntax-table)) @@ -670,9 +676,11 @@ The function must satisfy this calling convention: (defvar makefile-target-table nil "Table of all target names known for this buffer.") +(put 'makefile-target-table 'risky-local-variable t) (defvar makefile-macro-table nil "Table of all macro names known for this buffer.") +(put 'makefile-macro-table 'risky-local-variable t) (defvar makefile-browser-client "A buffer in Makefile mode that is currently using the browser.") @@ -724,11 +732,10 @@ The function must satisfy this calling convention: If you are editing a file for a different make, try one of the variants `makefile-automake-mode', `makefile-gmake-mode', -`makefile-makepp-mode', `makefile-bsdmake-mode' or, -`makefile-imake-mode'All but the -last should be correctly chosen based on the file name, except if -it is *.mk. This function ends by invoking the function(s) -`makefile-mode-hook'. +`makefile-makepp-mode', `makefile-bsdmake-mode' or, +`makefile-imake-mode'. All but the last should be correctly +chosen based on the file name, except if it is *.mk. This +function ends by invoking the function(s) `makefile-mode-hook'. It is strongly recommended to use `font-lock-mode', because that provides additional parsing information. This is used for @@ -1298,29 +1305,8 @@ definition and conveniently use this command." (beginning-of-line) (cond ((looking-at "^#+") - ;; Found a comment. Set the fill prefix, and find the paragraph - ;; boundaries by searching for lines that look like comment-only - ;; lines. - (let ((fill-prefix (match-string-no-properties 0)) - (fill-paragraph-function nil)) - (save-excursion - (save-restriction - (narrow-to-region - ;; Search backwards. - (save-excursion - (while (and (zerop (forward-line -1)) - (looking-at "^#"))) - ;; We may have gone too far. Go forward again. - (or (looking-at "^#") - (forward-line 1)) - (point)) - ;; Search forwards. - (save-excursion - (while (looking-at "^#") - (forward-line)) - (point))) - (fill-paragraph nil) - t)))) + ;; Found a comment. Return nil to let normal filling take place. + nil) ;; Must look for backslashed-region before looking for variable ;; assignment. @@ -1349,7 +1335,9 @@ definition and conveniently use this command." (makefile-backslash-region (point-min) (point-max) nil) (goto-char (point-max)) (if (< (skip-chars-backward "\n") 0) - (delete-region (point) (point-max)))))) + (delete-region (point) (point-max))))) + ;; Return non-nil to indicate it's been filled. + t) ((looking-at makefile-macroassign-regex) ;; Have a macro assign. Fill just this line, and then backslash @@ -1358,10 +1346,13 @@ definition and conveniently use this command." (narrow-to-region (point) (line-beginning-position 2)) (let ((fill-paragraph-function nil)) (fill-paragraph nil)) - (makefile-backslash-region (point-min) (point-max) nil))))) + (makefile-backslash-region (point-min) (point-max) nil)) + ;; Return non-nil to indicate it's been filled. + t) - ;; Always return non-nil so we don't fill anything else. - t) + (t + ;; Return non-nil so we don't fill anything else. + t)))) @@ -1616,7 +1607,8 @@ with the generated name!" (defun makefile-query-targets (filename target-table prereq-list) "Fill the up-to-date overview buffer. -Checks each target in TARGET-TABLE using `makefile-query-one-target-method' +Checks each target in TARGET-TABLE using +`makefile-query-one-target-method-function' and generates the overview, one line per target name." (insert (mapconcat @@ -1625,7 +1617,7 @@ and generates the overview, one line per target name." (no-prereqs (not (member target-name prereq-list))) (needs-rebuild (or no-prereqs (funcall - makefile-query-one-target-method + makefile-query-one-target-method-function target-name filename)))) (format "\t%s%s" @@ -1876,5 +1868,5 @@ If it isn't in one, return nil." (provide 'make-mode) -;;; arch-tag: bd23545a-de91-44fb-b1b2-feafbb2635a0 +;; arch-tag: bd23545a-de91-44fb-b1b2-feafbb2635a0 ;;; make-mode.el ends here diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 0e73427a33c..b80fe4c0fbc 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -814,6 +814,18 @@ See `sh-feature'.") (:weight bold))) "Face to show a here-document" :group 'sh-indentation) + +;; These colours are probably icky. It's just a placeholder though. +(defface sh-quoted-exec + '((((class color) (background dark)) + (:foreground "salmon")) + (((class color) (background light)) + (:foreground "magenta")) + (t + (:weight bold))) + "Face to show quoted execs like ``" + :group 'sh-indentation) + ;; backward-compatibility alias (put 'sh-heredoc-face 'face-alias 'sh-heredoc) (defvar sh-heredoc-face 'sh-heredoc) @@ -833,7 +845,7 @@ See `sh-feature'.") font-lock-variable-name-face)) (rc sh-append es) - + (bash sh-append shell ("\\$(\\(\\sw+\\)" (1 'sh-quoted-exec t) )) (sh sh-append shell ;; Variable names. ("\\$\\({#?\\)?\\([A-Za-z_][A-Za-z0-9_]*\\|[-#?@!]\\)" 2 @@ -967,6 +979,49 @@ Point is at the beginning of the next line." ;; This looks silly, but it's because `sh-here-doc-re' keeps changing. (re-search-forward sh-here-doc-re limit t)) +(defun sh-quoted-subshell (limit) + "Search for a subshell embedded in a string. Find all the unescaped +\" characters within said subshell, remembering that subshells can nest." + (if (re-search-forward "\"\\(?:.\\|\n\\)*?\\(\\$(\\|`\\)" limit t) + ;; bingo we have a $( or a ` inside a "" + (let ((char (char-after (point))) + (continue t) + (pos (point)) + (data nil) ;; value to put into match-data (and return) + (last nil) ;; last char seen + (bq (equal (match-string 1) "`")) ;; ` state flip-flop + (seen nil) ;; list of important positions + (nest 1)) ;; subshell nesting level + (while (and continue char (<= pos limit)) + ;; unescaped " inside a $( ... ) construct. + ;; state machine time... + ;; \ => ignore next char; + ;; ` => increase or decrease nesting level based on bq flag + ;; ) [where nesting > 0] => decrease nesting + ;; ( [where nesting > 0] => increase nesting + ;; ( [preceeded by $ ] => increase nesting + ;; " [nesting <= 0 ] => terminate, we're done. + ;; " [nesting > 0 ] => remember this, it's not a proper " + (if (eq ?\\ last) nil + (if (eq ?\` char) (setq nest (+ nest (if bq -1 1)) bq (not bq)) + (if (and (> nest 0) (eq ?\) char)) (setq nest (1- nest)) + (if (and (eq ?$ last) (eq ?\( char)) (setq nest (1+ nest)) + (if (and (> nest 0) (eq ?\( char)) (setq nest (1+ nest)) + (if (eq char ?\") + (if (>= 0 nest) (setq continue nil) + (setq seen (cons pos seen)) ) )))))) + ;;(message "POS: %d [%d]" pos nest) + (setq last char + pos (1+ pos) + char (char-after pos)) ) + (when seen + ;;(message "SEEN: %S" seen) + (setq data (list (current-buffer))) + (mapc (lambda (P) + (setq data (cons P (cons (1+ P) data)) ) ) seen) + (store-match-data data)) + data) )) + (defun sh-is-quoted-p (pos) (and (eq (char-before pos) ?\\) (not (sh-is-quoted-p (1- pos))))) @@ -997,6 +1052,17 @@ Point is at the beginning of the next line." (when (save-excursion (backward-char 2) (looking-at ";;\\|in")) sh-st-punc))) +(defun sh-apply-quoted-subshell () + "Apply the `sh-st-punc' syntax to all the matches in `match-data'. +This is used to flag quote characters in subshell constructs inside strings +\(which should therefore not be treated as normal quote characters\)" + (let ((m (match-data)) a b) + (while m + (setq a (car m) + b (cadr m) + m (cddr m)) + (put-text-property a b 'syntax-table sh-st-punc))) sh-st-punc) + (defconst sh-font-lock-syntactic-keywords ;; A `#' begins a comment when it is unquoted and at the beginning of a ;; word. In the shell, words are separated by metacharacters. @@ -1007,6 +1073,9 @@ Point is at the beginning of the next line." ("\\(\\\\\\)'" 1 ,sh-st-punc) ;; Make sure $@ and @? are correctly recognized as sexps. ("\\$\\([?@]\\)" 1 ,sh-st-symbol) + ;; highlight (possibly nested) subshells inside "" quoted regions correctly. + (sh-quoted-subshell + (1 (sh-apply-quoted-subshell) t t)) ;; Find HEREDOC starters and add a corresponding rule for the ender. (sh-font-lock-here-doc (2 (sh-font-lock-open-heredoc @@ -1019,11 +1088,12 @@ Point is at the beginning of the next line." (")" 0 (sh-font-lock-paren (match-beginning 0))))) (defun sh-font-lock-syntactic-face-function (state) - (if (nth 3 state) - (if (characterp (nth 3 state)) - font-lock-string-face - sh-heredoc-face) - font-lock-comment-face)) + (let ((q (nth 3 state))) + (if q + (if (characterp q) + (if (eq q ?\`) 'sh-quoted-exec font-lock-string-face) + sh-heredoc-face) + font-lock-comment-face))) (defgroup sh-indentation nil "Variables controlling indentation in shell scripts. @@ -1390,11 +1460,11 @@ with your script for an edit-interpret-debug cycle." (make-local-variable 'sh-shell-file) (make-local-variable 'sh-shell) (make-local-variable 'skeleton-pair-alist) - (make-local-variable 'skeleton-pair-filter) + (make-local-variable 'skeleton-pair-filter-function) (make-local-variable 'comint-dynamic-complete-functions) (make-local-variable 'comint-prompt-regexp) (make-local-variable 'font-lock-defaults) - (make-local-variable 'skeleton-filter) + (make-local-variable 'skeleton-filter-function) (make-local-variable 'skeleton-newline-indent-rigidly) (make-local-variable 'sh-shell-variables) (make-local-variable 'sh-shell-variables-initialized) @@ -1422,10 +1492,10 @@ with your script for an edit-interpret-debug cycle." (font-lock-syntactic-face-function . sh-font-lock-syntactic-face-function)) skeleton-pair-alist '((?` _ ?`)) - skeleton-pair-filter 'sh-quoted-p + skeleton-pair-filter-function 'sh-quoted-p skeleton-further-elements '((< '(- (min sh-indentation (current-column))))) - skeleton-filter 'sh-feature + skeleton-filter-function 'sh-feature skeleton-newline-indent-rigidly t sh-indent-supported-here nil) (set (make-local-variable 'parse-sexp-ignore-comments) t) diff --git a/lisp/replace.el b/lisp/replace.el index f1792b499fc..2f8fe86860c 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -36,6 +36,11 @@ (defvar query-replace-history nil) +(defvar query-replace-defaults nil + "Default values of FROM-STRING and TO-STRING for `query-replace'. +This is a cons cell (FROM-STRING . TO-STRING), or nil if there is +no default value.") + (defvar query-replace-interactive nil "Non-nil means `query-replace' uses the last search string. That becomes the \"string to replace\".") @@ -94,32 +99,26 @@ The return value can also be a pair (FROM . TO) indicating that the user wants to replace FROM with TO." (if query-replace-interactive (car (if regexp-flag regexp-search-ring search-ring)) - (let* ((lastfrom (car (symbol-value query-replace-from-history-variable))) - (lastto (car (symbol-value query-replace-to-history-variable))) + (let* ((history-add-new-input nil) (from ;; The save-excursion here is in case the user marks and copies ;; a region in order to specify the minibuffer input. ;; That should not clobber the region for the query-replace itself. (save-excursion - (when (equal lastfrom lastto) - ;; Typically, this is because the two histlists are shared. - (setq lastfrom (cadr (symbol-value - query-replace-from-history-variable)))) (read-from-minibuffer - (if (and lastto lastfrom) + (if query-replace-defaults (format "%s (default %s -> %s): " prompt - (query-replace-descr lastfrom) - (query-replace-descr lastto)) + (query-replace-descr (car query-replace-defaults)) + (query-replace-descr (cdr query-replace-defaults))) (format "%s: " prompt)) nil nil nil query-replace-from-history-variable - nil t t)))) - (if (and (zerop (length from)) lastto lastfrom) - (progn - (set query-replace-from-history-variable - (cdr (symbol-value query-replace-from-history-variable))) - (cons lastfrom - (query-replace-compile-replacement lastto regexp-flag))) + nil t)))) + (if (and (zerop (length from)) query-replace-defaults) + (cons (car query-replace-defaults) + (query-replace-compile-replacement + (cdr query-replace-defaults) regexp-flag)) + (add-to-history query-replace-from-history-variable from nil t) ;; Warn if user types \n or \t, but don't reject the input. (and regexp-flag (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from) @@ -177,10 +176,14 @@ the original string if not." "Query and return the `to' argument of a query-replace operation." (query-replace-compile-replacement (save-excursion - (read-from-minibuffer - (format "%s %s with: " prompt (query-replace-descr from)) - nil nil nil - query-replace-to-history-variable from t t)) + (let* ((history-add-new-input nil) + (to (read-from-minibuffer + (format "%s %s with: " prompt (query-replace-descr from)) + nil nil nil + query-replace-to-history-variable from t))) + (add-to-history query-replace-to-history-variable to nil t) + (setq query-replace-defaults (cons from to)) + to)) regexp-flag)) (defun query-replace-read-args (prompt regexp-flag &optional noerror) diff --git a/lisp/ses.el b/lisp/ses.el index debb22d84db..fc594167187 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -399,7 +399,7 @@ for safety. This is a macro to prevent propagate-on-load viruses." (defmacro ses-header-row (row) "Load the header row from the spreadsheet file and checks it for safety. This is a macro to prevent propagate-on-load viruses." - (or (and (wholenump row) (< row ses--numrows)) + (or (and (wholenump row) (or (zerop ses--numrows) (< row ses--numrows))) (error "Bad header-row")) (setq ses--header-row row) t) @@ -940,14 +940,18 @@ cell (ROW,COL) has changed." (defun ses-narrowed-p () (/= (- (point-max) (point-min)) (buffer-size))) +(defun ses-widen () + "Turn off narrowing, to be reenabled at end of command loop." + (if (ses-narrowed-p) + (setq ses--deferred-narrow t)) + (widen)) + (defun ses-goto-data (def &optional col) "Move point to data area for (DEF,COL). If DEF is a row number, COL is the column number for a data cell -- otherwise DEF is one of the symbols ses--col-widths, ses--col-printers, ses--default-printer, ses--numrows, or ses--numcols." - (if (ses-narrowed-p) - (setq ses--deferred-narrow t)) - (widen) + (ses-widen) (let ((inhibit-point-motion-hooks t)) ;In case intangible attrs are wrong (goto-char (point-min)) (if col @@ -966,9 +970,6 @@ If ELEM is specified, it is the array subscript within DEF to be set to VALUE." ;;We call ses-goto-data early, using the old values of numrows and ;;numcols in case one of them is being changed. (ses-goto-data def) - (if elem - (ses-aset-with-undo (symbol-value def) elem value) - (ses-set-with-undo def value)) (let ((inhibit-read-only t) (fmt (plist-get '(ses--col-widths "(ses-column-widths %S)" ses--col-printers "(ses-column-printers %S)" @@ -977,9 +978,20 @@ If ELEM is specified, it is the array subscript within DEF to be set to VALUE." ses--file-format " %S ;SES file-format" ses--numrows " %S ;numrows" ses--numcols " %S ;numcols") - def))) - (delete-region (point) (line-end-position)) - (insert (format fmt (symbol-value def)))))) + def)) + oldval) + (if elem + (progn + (setq oldval (aref (symbol-value def) elem)) + (aset (symbol-value def) elem value)) + (setq oldval (symbol-value def)) + (set def value)) + ;;Special undo since it's outside the narrowed buffer + (let (buffer-undo-list) + (delete-region (point) (line-end-position)) + (insert (format fmt (symbol-value def)))) + (push `(apply ses-set-parameter ,def ,oldval ,elem) buffer-undo-list)))) + (defun ses-write-cells () "Write cells in `ses--deferred-write' from local variables to data area. @@ -1278,23 +1290,6 @@ to each symbol." ;; Undo control ;;---------------------------------------------------------------------------- -;; This should be unnecessary, because the feature is now built in. - -(defadvice undo-more (around ses-undo-more activate preactivate) - "For SES mode, allow undo outside of narrowed buffer range." - (if (not (eq major-mode 'ses-mode)) - ad-do-it - ;;Here is some extra code for SES mode. - (setq ses--deferred-narrow - (or ses--deferred-narrow (ses-narrowed-p))) - (widen) - (condition-case x - ad-do-it - (error - ;;Restore narrow if appropriate - (ses-command-hook) - (signal (car x) (cdr x)))))) - (defun ses-begin-change () "For undo, remember point before we start changing hidden stuff." (let ((inhibit-read-only t)) @@ -1303,7 +1298,7 @@ to each symbol." (defun ses-set-with-undo (sym newval) "Like set, but undoable. Result is t if value has changed." - ;;We avoid adding redundant entries to the undo list, but this is + ;;We try to avoid adding redundant entries to the undo list, but this is ;;unavoidable for strings because equal ignores text properties and there's ;;no easy way to get the whole property list to see if it's different! (unless (and (boundp sym) @@ -1346,7 +1341,7 @@ execute cell formulas or print functions." (or (and (= (safe-length params) 3) (numberp (car params)) (numberp (cadr params)) - (> (cadr params) 0) + (>= (cadr params) 0) (numberp (nth 2 params)) (> (nth 2 params) 0)) (error "Invalid SES file")) @@ -1568,11 +1563,12 @@ narrows the buffer now." (let ((old ses--deferred-recalc)) (setq ses--deferred-recalc nil) (ses-update-cells old))) - (if ses--deferred-write - ;;We don't reset the deferred list before starting -- the most - ;;likely error is keyboard-quit, and we do want to keep trying - ;;these writes after a quit. - (ses-write-cells)) + (when ses--deferred-write + ;;We don't reset the deferred list before starting -- the most + ;;likely error is keyboard-quit, and we do want to keep trying + ;;these writes after a quit. + (ses-write-cells) + (push '(apply ses-widen) buffer-undo-list)) (when ses--deferred-narrow ;;We're not allowed to narrow the buffer until after-find-file has ;;read the local variables at the end of the file. Now it's safe to @@ -1794,9 +1790,7 @@ cells." (cons (ses-cell-symbol row col) (ses-cell-references yrow ycol))))))) ;;Delete everything and reconstruct basic data area - (if (ses-narrowed-p) - (setq ses--deferred-narrow t)) - (widen) + (ses-widen) (let ((inhibit-read-only t)) (goto-char (point-max)) (if (search-backward ";; Local Variables:\n" nil t) @@ -1877,7 +1871,9 @@ cell formula was unsafe and user declined confirmation." ses-mode-edit-map t ;Convert to Lisp object 'ses-read-cell-history - (prin1-to-string curval))))) + (prin1-to-string (if (eq (car-safe curval) 'ses-safe-formula) + (cadr curval) + curval)))))) (when (ses-edit-cell row col newval) (ses-command-hook) ;Update cell widths before movement (dolist (x ses-after-entry-functions) @@ -2073,6 +2069,8 @@ before current one." (ses-reset-header-string))) ;;Reconstruct text attributes (ses-setup) + ;;Prepare for undo + (push '(apply ses-widen) buffer-undo-list) ;;Return to current cell (if ses--curcell (ses-jump-safe ses--curcell) @@ -2109,6 +2107,8 @@ current one." (ses-reset-header-string))) ;;Reconstruct attributes (ses-setup) + ;;Prepare for undo + (push '(apply ses-widen) buffer-undo-list) (ses-jump-safe ses--curcell)) (defun ses-insert-column (count &optional col width printer) @@ -2643,7 +2643,10 @@ The top row is row 1. Selecting row 0 displays the default header row." (if (or (< row 0) (> row ses--numrows)) (error "Invalid header-row")) (ses-begin-change) - (ses-set-parameter 'ses--header-row row) + (let ((oldval ses--header-row)) + (let (buffer-undo-list) + (ses-set-parameter 'ses--header-row row)) + (push `(apply ses-set-header-row ,oldval) buffer-undo-list)) (ses-reset-header-string)) (defun ses-mark-row () diff --git a/lisp/shell.el b/lisp/shell.el index 71b5862feb6..6b22ac79238 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -150,7 +150,7 @@ This is a fine thing to set in your `.emacs' file." :group 'shell) (defcustom shell-completion-fignore nil - "*List of suffixes to be disregarded during file/command completion. + "List of suffixes to be disregarded during file/command completion. This variable is used to initialize `comint-completion-fignore' in the shell buffer. The default is nil, for compatibility with most shells. Some people like (\"~\" \"#\" \"%\"). @@ -199,19 +199,19 @@ shell buffer. This is a fine thing to set in your `.emacs' file.") (defcustom shell-command-regexp "[^;&|\n]+" - "*Regexp to match a single command within a pipeline. + "Regexp to match a single command within a pipeline. This is used for directory tracking and does not do a perfect job." :type 'regexp :group 'shell) (defcustom shell-command-separator-regexp "[;&|\n \t]*" - "*Regexp to match a single command within a pipeline. + "Regexp to match a single command within a pipeline. This is used for directory tracking and does not do a perfect job." :type 'regexp :group 'shell) (defcustom shell-completion-execonly t - "*If non-nil, use executable files only for completion candidates. + "If non-nil, use executable files only for completion candidates. This mirrors the optional behavior of tcsh. Detecting executability of files may slow command completion considerably." @@ -219,35 +219,35 @@ Detecting executability of files may slow command completion considerably." :group 'shell) (defcustom shell-popd-regexp "popd" - "*Regexp to match subshell commands equivalent to popd." + "Regexp to match subshell commands equivalent to popd." :type 'regexp :group 'shell-directories) (defcustom shell-pushd-regexp "pushd" - "*Regexp to match subshell commands equivalent to pushd." + "Regexp to match subshell commands equivalent to pushd." :type 'regexp :group 'shell-directories) (defcustom shell-pushd-tohome nil - "*If non-nil, make pushd with no arg behave as \"pushd ~\" (like cd). + "If non-nil, make pushd with no arg behave as \"pushd ~\" (like cd). This mirrors the optional behavior of tcsh." :type 'boolean :group 'shell-directories) (defcustom shell-pushd-dextract nil - "*If non-nil, make \"pushd +n\" pop the nth dir to the stack top. + "If non-nil, make \"pushd +n\" pop the nth dir to the stack top. This mirrors the optional behavior of tcsh." :type 'boolean :group 'shell-directories) (defcustom shell-pushd-dunique nil - "*If non-nil, make pushd only add unique directories to the stack. + "If non-nil, make pushd only add unique directories to the stack. This mirrors the optional behavior of tcsh." :type 'boolean :group 'shell-directories) (defcustom shell-cd-regexp "cd" - "*Regexp to match subshell commands equivalent to cd." + "Regexp to match subshell commands equivalent to cd." :type 'regexp :group 'shell-directories) @@ -256,19 +256,19 @@ This mirrors the optional behavior of tcsh." ; NetWare allows the five chars between upper and lower alphabetics. "[]a-zA-Z^_`\\[\\\\]:" nil) - "*If non-nil, is regexp used to track drive changes." + "If non-nil, is regexp used to track drive changes." :type '(choice regexp (const nil)) :group 'shell-directories) (defcustom shell-dirtrack-verbose t - "*If non-nil, show the directory stack following directory change. + "If non-nil, show the directory stack following directory change. This is effective only if directory tracking is enabled." :type 'boolean :group 'shell-directories) (defcustom explicit-shell-file-name nil - "*If non-nil, is file name to use for explicitly requested inferior shell." + "If non-nil, is file name to use for explicitly requested inferior shell." :type '(choice (const :tag "None" nil) file) :group 'shell) @@ -278,7 +278,7 @@ This is effective only if directory tracking is enabled." ;; than us about what terminal modes to use. '("-i" "-T") '("-i")) - "*Args passed to inferior shell by M-x shell, if the shell is csh. + "Args passed to inferior shell by \\[shell], if the shell is csh. Value is a list of strings, which may be nil." :type '(repeat (string :tag "Argument")) :group 'shell) @@ -296,13 +296,13 @@ Value is a list of strings, which may be nil." (shell-command-to-string (concat prog " --noediting")))) '("-i") '("--noediting" "-i"))) - "*Args passed to inferior shell by M-x shell, if the shell is bash. + "Args passed to inferior shell by \\[shell], if the shell is bash. Value is a list of strings, which may be nil." :type '(repeat (string :tag "Argument")) :group 'shell) (defcustom shell-input-autoexpand 'history - "*If non-nil, expand input command history references on completion. + "If non-nil, expand input command history references on completion. This mirrors the optional behavior of tcsh (its autoexpand and histlit). If the value is `input', then the expansion is seen on input. @@ -367,7 +367,7 @@ Thus, this does not include the shell's current directory.") (put 'shell-mode 'mode-class 'special) (define-derived-mode shell-mode comint-mode "Shell" - "Major mode for interacting with an inferior shell. + "Major mode for interacting with an inferior shell.\\<shell-mode-map> \\[comint-send-input] after the end of the process' output sends the text from the end of process to the end of the current line. \\[comint-send-input] before end of process output copies the current line minus the prompt to @@ -433,13 +433,11 @@ buffer." (setq shell-dirstack nil) (make-local-variable 'shell-last-dir) (setq shell-last-dir nil) - (make-local-variable 'shell-dirtrackp) - (setq shell-dirtrackp t) - (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil t) (setq comint-input-autoexpand shell-input-autoexpand) ;; This is not really correct, since the shell buffer does not really ;; edit this directory. But it is useful in the buffer list and menus. (make-local-variable 'list-buffers-directory) + (shell-dirtrack-mode 1) (setq list-buffers-directory (expand-file-name default-directory)) ;; shell-dependent assignments. (when (ring-empty-p comint-input-ring) @@ -558,48 +556,48 @@ Otherwise, one argument `-i' is passed to the shell. (shell-mode))) buffer) -;;; Don't do this when shell.el is loaded, only while dumping. +;; Don't do this when shell.el is loaded, only while dumping. ;;;###autoload (add-hook 'same-window-buffer-names "*shell*") ;;; Directory tracking -;;; -;;; This code provides the shell mode input sentinel -;;; SHELL-DIRECTORY-TRACKER -;;; that tracks cd, pushd, and popd commands issued to the shell, and -;;; changes the current directory of the shell buffer accordingly. -;;; -;;; This is basically a fragile hack, although it's more accurate than -;;; the version in Emacs 18's shell.el. It has the following failings: -;;; 1. It doesn't know about the cdpath shell variable. -;;; 2. It cannot infallibly deal with command sequences, though it does well -;;; with these and with ignoring commands forked in another shell with ()s. -;;; 3. More generally, any complex command is going to throw it. Otherwise, -;;; you'd have to build an entire shell interpreter in Emacs Lisp. Failing -;;; that, there's no way to catch shell commands where cd's are buried -;;; inside conditional expressions, aliases, and so forth. -;;; -;;; The whole approach is a crock. Shell aliases mess it up. File sourcing -;;; messes it up. You run other processes under the shell; these each have -;;; separate working directories, and some have commands for manipulating -;;; their w.d.'s (e.g., the lcd command in ftp). Some of these programs have -;;; commands that do *not* affect the current w.d. at all, but look like they -;;; do (e.g., the cd command in ftp). In shells that allow you job -;;; control, you can switch between jobs, all having different w.d.'s. So -;;; simply saying %3 can shift your w.d.. -;;; -;;; The solution is to relax, not stress out about it, and settle for -;;; a hack that works pretty well in typical circumstances. Remember -;;; that a half-assed solution is more in keeping with the spirit of Unix, -;;; anyway. Blech. -;;; -;;; One good hack not implemented here for users of programmable shells -;;; is to program up the shell w.d. manipulation commands to output -;;; a coded command sequence to the tty. Something like -;;; ESC | <cwd> | -;;; where <cwd> is the new current working directory. Then trash the -;;; directory tracking machinery currently used in this package, and -;;; replace it with a process filter that watches for and strips out -;;; these messages. +;; +;; This code provides the shell mode input sentinel +;; SHELL-DIRECTORY-TRACKER +;; that tracks cd, pushd, and popd commands issued to the shell, and +;; changes the current directory of the shell buffer accordingly. +;; +;; This is basically a fragile hack, although it's more accurate than +;; the version in Emacs 18's shell.el. It has the following failings: +;; 1. It doesn't know about the cdpath shell variable. +;; 2. It cannot infallibly deal with command sequences, though it does well +;; with these and with ignoring commands forked in another shell with ()s. +;; 3. More generally, any complex command is going to throw it. Otherwise, +;; you'd have to build an entire shell interpreter in Emacs Lisp. Failing +;; that, there's no way to catch shell commands where cd's are buried +;; inside conditional expressions, aliases, and so forth. +;; +;; The whole approach is a crock. Shell aliases mess it up. File sourcing +;; messes it up. You run other processes under the shell; these each have +;; separate working directories, and some have commands for manipulating +;; their w.d.'s (e.g., the lcd command in ftp). Some of these programs have +;; commands that do *not* affect the current w.d. at all, but look like they +;; do (e.g., the cd command in ftp). In shells that allow you job +;; control, you can switch between jobs, all having different w.d.'s. So +;; simply saying %3 can shift your w.d.. +;; +;; The solution is to relax, not stress out about it, and settle for +;; a hack that works pretty well in typical circumstances. Remember +;; that a half-assed solution is more in keeping with the spirit of Unix, +;; anyway. Blech. +;; +;; One good hack not implemented here for users of programmable shells +;; is to program up the shell w.d. manipulation commands to output +;; a coded command sequence to the tty. Something like +;; ESC | <cwd> | +;; where <cwd> is the new current working directory. Then trash the +;; directory tracking machinery currently used in this package, and +;; replace it with a process filter that watches for and strips out +;; these messages. (defun shell-directory-tracker (str) "Tracks cd, pushd and popd commands issued to the shell. @@ -607,8 +605,8 @@ This function is called on each input passed to the shell. It watches for cd, pushd and popd commands and sets the buffer's default directory to track these commands. -You may toggle this tracking on and off with M-x dirtrack-mode. -If Emacs gets confused, you can resync with the shell with M-x dirs. +You may toggle this tracking on and off with \\[dirtrack-mode]. +If Emacs gets confused, you can resync with the shell with \\[dirs]. See variables `shell-cd-regexp', `shell-chdrive-regexp', `shell-pushd-regexp', and `shell-popd-regexp', while `shell-pushd-tohome', `shell-pushd-dextract', @@ -677,7 +675,7 @@ Environment variables are expanded, see function `substitute-in-file-name'." (setq string (replace-match "" nil nil string))))) string))) -;;; popd [+n] +;; popd [+n] (defun shell-process-popd (arg) (let ((num (or (shell-extract-num arg) 0))) (cond ((and num (= num 0) shell-dirstack) @@ -703,7 +701,7 @@ Environment variables are expanded, see function `substitute-in-file-name'." ;; For relative name we assume default-directory already has the prefix. (expand-file-name dir)))) -;;; cd [dir] +;; cd [dir] (defun shell-process-cd (arg) (let ((new-dir (cond ((zerop (length arg)) (concat comint-file-name-prefix "~")) @@ -713,7 +711,7 @@ Environment variables are expanded, see function `substitute-in-file-name'." (shell-cd new-dir) (shell-dirstack-message))) -;;; pushd [+n | dir] +;; pushd [+n | dir] (defun shell-process-pushd (arg) (let ((num (shell-extract-num arg))) (cond ((zerop (length arg)) @@ -762,26 +760,25 @@ Environment variables are expanded, see function `substitute-in-file-name'." (and (string-match "^\\+[1-9][0-9]*$" str) (string-to-number str))) - -(defun shell-dirtrack-mode () +(defvaralias 'shell-dirtrack-mode 'shell-dirtrackp) +(define-minor-mode shell-dirtrack-mode "Turn directory tracking on and off in a shell buffer." - (interactive) - (if (setq shell-dirtrackp (not shell-dirtrackp)) - (setq list-buffers-directory default-directory) - (setq list-buffers-directory nil)) - (message "Directory tracking %s" (if shell-dirtrackp "ON" "OFF"))) - -;;; For your typing convenience: -(defalias 'shell-dirtrack-toggle 'shell-dirtrack-mode) + nil nil nil + (setq list-buffers-directory (if shell-dirtrack-mode default-directory)) + (if shell-dirtrack-mode + (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil t) + (remove-hook 'comint-input-filter-functions 'shell-directory-tracker t))) + +;; For your typing convenience: +(defalias 'shell-dirtrack-toggle 'shell-dirtrack-mode) ;??Convenience?? (defalias 'dirtrack-toggle 'shell-dirtrack-mode) (defalias 'dirtrack-mode 'shell-dirtrack-mode) (defun shell-cd (dir) "Do normal `cd' to DIR, and set `list-buffers-directory'." + (cd dir) (if shell-dirtrackp - (setq list-buffers-directory (file-name-as-directory - (expand-file-name dir)))) - (cd dir)) + (setq list-buffers-directory default-directory))) (defun shell-resync-dirs () "Resync the buffer's idea of the current directory stack. @@ -841,15 +838,15 @@ command again." (shell-dirstack-message)) (error (message "Couldn't cd"))))))) -;;; For your typing convenience: +;; For your typing convenience: (defalias 'dirs 'shell-resync-dirs) -;;; Show the current dirstack on the message line. -;;; Pretty up dirs a bit by changing "/usr/jqr/foo" to "~/foo". -;;; (This isn't necessary if the dirlisting is generated with a simple "dirs".) -;;; All the commands that mung the buffer's dirstack finish by calling -;;; this guy. +;; Show the current dirstack on the message line. +;; Pretty up dirs a bit by changing "/usr/jqr/foo" to "~/foo". +;; (This isn't necessary if the dirlisting is generated with a simple "dirs".) +;; All the commands that mung the buffer's dirstack finish by calling +;; this guy. (defun shell-dirstack-message () (when shell-dirtrack-verbose (let* ((msg "") @@ -1076,5 +1073,5 @@ Returns t if successful." (provide 'shell) -;;; arch-tag: bcb5f12a-c1f4-4aea-a809-2504bd5bd797 +;; arch-tag: bcb5f12a-c1f4-4aea-a809-2504bd5bd797 ;;; shell.el ends here diff --git a/lisp/simple.el b/lisp/simple.el index 6d7e3d0a3d9..b023a7b780f 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2549,7 +2549,9 @@ to make one entry in the kill ring. In Lisp code, optional third arg YANK-HANDLER, if non-nil, specifies the yank-handler text property to be set on the killed text. See `insert-for-yank'." - (interactive "r") + ;; Pass point first, then mark, because the order matters + ;; when calling kill-append. + (interactive (list (point) (mark))) (condition-case nil (let ((string (filter-buffer-substring beg end t))) (when string ;STRING is nil if BEG = END @@ -3643,10 +3645,14 @@ Outline mode sets this." (setq new (point)) ;; Process intangibility within a line. - ;; Move to the chosen destination position from above, - ;; with intangibility processing enabled. - - ;; Avoid calling point-entered and point-left. + ;; With inhibit-point-motion-hooks bound to nil, a call to + ;; goto-char moves point past intangible text. + + ;; However, inhibit-point-motion-hooks controls both the + ;; intangibility and the point-entered/point-left hooks. The + ;; following hack avoids calling the point-* hooks + ;; unnecessarily. Note that we move *forward* past intangible + ;; text when the initial and final points are the same. (goto-char new) (let ((inhibit-point-motion-hooks nil)) (goto-char new) @@ -4241,7 +4247,7 @@ The variable `selective-display' has a separate value for each buffer." (defvaralias 'indicate-unused-lines 'indicate-empty-lines) (defvaralias 'default-indicate-unused-lines 'default-indicate-empty-lines) -(defun toggle-truncate-lines (arg) +(defun toggle-truncate-lines (&optional arg) "Toggle whether to fold or truncate long lines on the screen. With arg, truncate long lines iff arg is positive. Note that in side-by-side windows, truncation is always enabled." diff --git a/lisp/skeleton.el b/lisp/skeleton.el index 0b3fc82f025..d51fd91c3b4 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -39,14 +39,15 @@ ;; page 3: mirror-mode, an example for setting up paired insertion -(defvar skeleton-transformation 'identity +(defvar skeleton-transformation-function 'identity "*If non-nil, function applied to literal strings before they are inserted. It should take strings and characters and return them transformed, or nil which means no transformation. Typical examples might be `upcase' or `capitalize'.") +(defvaralias 'skeleton-transformation 'skeleton-transformation-function) ; this should be a fourth argument to defvar -(put 'skeleton-transformation 'variable-interactive +(put 'skeleton-transformation-function 'variable-interactive "aTransformation function: ") @@ -75,8 +76,9 @@ The variables `v1' and `v2' are still set when calling this.") ;;;###autoload -(defvar skeleton-filter 'identity +(defvar skeleton-filter-function 'identity "Function for transforming a skeleton proxy's aliases' variable value.") +(defvaralias 'skeleton-filter 'skeleton-filter-function) (defvar skeleton-untabify t "When non-nil untabifies when deleting backwards with element -ARG.") @@ -157,7 +159,7 @@ This command can also be an abbrev expansion (3rd and 4th columns in Optional second argument STR may also be a string which will be the value of `str' whereas the skeleton's interactor is then ignored." - (skeleton-insert (funcall skeleton-filter skeleton) + (skeleton-insert (funcall skeleton-filter-function skeleton) ;; Pretend C-x a e passed its prefix arg to us (if (or arg current-prefix-arg) (prefix-numeric-value (or arg @@ -199,7 +201,7 @@ SKELETON is made up as (INTERACTOR ELEMENT ...). INTERACTOR may be nil if not needed, a prompt-string or an expression for complex read functions. If ELEMENT is a string or a character it gets inserted (see also -`skeleton-transformation'). Other possibilities are: +`skeleton-transformation-function'). Other possibilities are: \\n go to next line and indent according to mode _ interesting point, interregion here @@ -360,7 +362,7 @@ automatically, and you are prompted to fill in the variable parts."))) (backward-delete-char-untabify (- element)) (delete-backward-char (- element))) (insert (if (not literal) - (funcall skeleton-transformation element) + (funcall skeleton-transformation-function element) element)))) ((or (eq element '\n) ; actually (eq '\n 'n) ;; The sequence `> \n' is handled specially so as to indent the first @@ -464,7 +466,7 @@ will attempt to insert pairs of matching characters.") "*If this is nil, paired insertion is inhibited before or inside a word.") -(defvar skeleton-pair-filter (lambda () nil) +(defvar skeleton-pair-filter-function (lambda () nil) "Attempt paired insertion if this function returns nil, before inserting. This allows for context-sensitive checking whether pairing is appropriate.") @@ -490,7 +492,7 @@ Elements might be (?` ?` _ \"''\"), (?\\( ? _ \" )\") or (?{ \\n > _ \\n ?} >). With no ARG, if `skeleton-pair' is non-nil, pairing can occur. If the region is visible the pair is wrapped around it depending on `skeleton-autowrap'. Else, if `skeleton-pair-on-word' is non-nil or we are not before or inside a -word, and if `skeleton-pair-filter' returns nil, pairing is performed. +word, and if `skeleton-pair-filter-function' returns nil, pairing is performed. Pairing is also prohibited if we are right after a quoting character such as backslash. @@ -512,7 +514,7 @@ symmetrical ones, and the same character twice for the others." (and (not mark) (or overwrite-mode (if (not skeleton-pair-on-word) (looking-at "\\w")) - (funcall skeleton-pair-filter)))) + (funcall skeleton-pair-filter-function)))) (self-insert-command (prefix-numeric-value arg)) (skeleton-insert (cons nil skeleton) (if mark -1)))))) @@ -526,13 +528,13 @@ symmetrical ones, and the same character twice for the others." ;; (kill-all-local-variables) ;; (make-local-variable 'skeleton-pair) ;; (make-local-variable 'skeleton-pair-on-word) -;; (make-local-variable 'skeleton-pair-filter) +;; (make-local-variable 'skeleton-pair-filter-function) ;; (make-local-variable 'skeleton-pair-alist) ;; (setq major-mode 'mirror-mode ;; mode-name "Mirror" ;; skeleton-pair-on-word t ;; ;; in the middle column insert one or none if odd window-width -;; skeleton-pair-filter (lambda () +;; skeleton-pair-filter-function (lambda () ;; (if (>= (current-column) ;; (/ (window-width) 2)) ;; ;; insert both on next line diff --git a/lisp/speedbar.el b/lisp/speedbar.el index b3913f6f6c6..e5ab181e8c6 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -921,8 +921,6 @@ This basically creates a sparse keymap, and makes it's parent be (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) (list ["Customize..." speedbar-customize t])) (list - ["Detach" speedbar-detach (and speedbar-frame - (eq (selected-frame) speedbar-frame)) ] ["Close" dframe-close-frame t] ["Quit" delete-frame t] )) "Menu items appearing at the end of the speedbar menu.") @@ -1047,21 +1045,6 @@ supported at a time. (dframe-attached-frame speedbar-frame) speedbar-default-position)))) -(defun speedbar-detach () - "Detach the current Speedbar from auto-updating. -Doing this allows the creation of a second speedbar." - (interactive) - (let ((buffer speedbar-buffer)) - (dframe-detach 'speedbar-frame 'speedbar-cached-frame 'speedbar-buffer) - (save-excursion - (set-buffer buffer) - ;; Permanently disable auto-updating in this speedbar buffer. - (set (make-local-variable 'speedbar-update-flag) nil) - (set (make-local-variable 'speedbar-update-flag-disable) t) - ;; Make local copies of all the different variables to prevent - ;; funny stuff later... - ))) - (defsubst speedbar-current-frame () "Return the frame to use for speedbar based on current context." (dframe-current-frame 'speedbar-frame 'speedbar-mode)) @@ -1224,11 +1207,8 @@ and the existence of packages." (speedbar-initial-menu) (save-excursion (dframe-select-attached-frame speedbar-frame) - (if (local-variable-p - 'speedbar-easymenu-definition-special - (current-buffer)) - ;; If bound locally, we can use it - speedbar-easymenu-definition-special))) + (eval (nth 1 (assoc speedbar-initial-expansion-list-name + speedbar-initial-expansion-mode-alist))))) ;; Dynamic menu stuff '("-") (list (cons "Displays" diff --git a/lisp/startup.el b/lisp/startup.el index f1a68fd8509..33138ef3875 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -644,18 +644,17 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; Convert preloaded file names to absolute. (let ((lisp-dir - (file-name-directory - (locate-file "simple" load-path - (get-load-suffixes))))) + (file-truename + (file-name-directory + (locate-file "simple" load-path + (get-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")) + (car elt)) (cdr elt)) elt)) load-history))) diff --git a/lisp/subr.el b/lisp/subr.el index cd0ce2d3f33..387228fbb8c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1393,32 +1393,94 @@ That function's doc string says which file created it." t)) nil)) +(defun load-history-regexp (file) + "Form a regexp to find FILE in `load-history'. +FILE, a string, is described in the function `eval-after-load'." + (if (file-name-absolute-p file) + (setq file (file-truename file))) + (concat (if (file-name-absolute-p file) "\\`" "\\(\\`\\|/\\)") + (regexp-quote file) + (if (file-name-extension file) + "" + ;; Note: regexp-opt can't be used here, since we need to call + ;; this before Emacs has been fully started. 2006-05-21 + (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?")) + "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|") + "\\)?\\'")) + +(defun load-history-filename-element (file-regexp) + "Get the first elt of `load-history' whose car matches FILE-REGEXP. +Return nil if there isn't one." + (let* ((loads load-history) + (load-elt (and loads (car loads)))) + (save-match-data + (while (and loads + (or (null (car load-elt)) + (not (string-match file-regexp (car load-elt))))) + (setq loads (cdr loads) + load-elt (and loads (car loads))))) + load-elt)) + (defun eval-after-load (file form) "Arrange that, if FILE is ever loaded, FORM will be run at that time. -This makes or adds to an entry on `after-load-alist'. If FILE is already loaded, evaluate FORM right now. -It does nothing if FORM is already on the list for FILE. -FILE must match exactly. Normally FILE is the name of a library, -with no directory or extension specified, since that is how `load' -is normally called. -FILE can also be a feature (i.e. a symbol), in which case FORM is -evaluated whenever that feature is `provide'd." - (let ((elt (assoc file after-load-alist))) - ;; Make sure there is an element for FILE. - (unless elt (setq elt (list file)) (push elt after-load-alist)) - ;; Add FORM to the element if it isn't there. + +If a matching file is loaded again, FORM will be evaluated again. + +If FILE is a string, it may be either an absolute or a relative file +name, and may have an extension \(e.g. \".el\") or may lack one, and +additionally may or may not have an extension denoting a compressed +format \(e.g. \".gz\"). + +When FILE is absolute, this first converts it to a true name by chasing +symbolic links. Only a file of this name \(see next paragraph regarding +extensions) will trigger the evaluation of FORM. When FILE is relative, +a file whose absolute true name ends in FILE will trigger evaluation. + +When FILE lacks an extension, a file name with any extension will trigger +evaluation. Otherwise, its extension must match FILE's. A further +extension for a compressed format \(e.g. \".gz\") on FILE will not affect +this name matching. + +Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM +is evaluated whenever that feature is `provide'd. + +Usually FILE is just a library name like \"font-lock\" or a feature name +like 'font-lock. + +This function makes or adds to an entry on `after-load-alist'." + ;; Add this FORM into after-load-alist (regardless of whether we'll be + ;; evaluating it now). + (let* ((regexp-or-feature + (if (stringp file) (load-history-regexp file) file)) + (elt (assoc regexp-or-feature after-load-alist))) + (unless elt + (setq elt (list regexp-or-feature)) + (push elt after-load-alist)) + ;; Add FORM to the element unless it's already there. (unless (member form (cdr elt)) - (nconc elt (list form)) - ;; If the file has been loaded already, run FORM right away. - (if (if (symbolp file) - (featurep file) - ;; Make sure `load-history' contains the files dumped with - ;; Emacs for the case that FILE is one of them. - ;; (load-symbol-file-load-history) - (when (locate-library file) - (assoc (locate-library file) load-history))) - (eval form)))) - form) + (nconc elt (list form))) + + ;; Is there an already loaded file whose name (or `provide' name) + ;; matches FILE? + (if (if (stringp file) + (load-history-filename-element regexp-or-feature) + (featurep file)) + (eval form)))) + +(defun do-after-load-evaluation (abs-file) + "Evaluate all `eval-after-load' forms, if any, for ABS-FILE. +ABS-FILE, a string, should be the absolute true name of a file just loaded." + (let ((after-load-elts after-load-alist) + a-l-element file-elements file-element form) + (while after-load-elts + (setq a-l-element (car after-load-elts) + after-load-elts (cdr after-load-elts)) + (when (and (stringp (car a-l-element)) + (string-match (car a-l-element) abs-file)) + (while (setq a-l-element (cdr a-l-element)) ; discard the file name + (setq form (car a-l-element)) + (eval form)))))) (defun eval-next-after-load (file) "Read the following input sexp, and run it whenever FILE is loaded. @@ -1555,7 +1617,7 @@ Optional DEFAULT is a default password to use instead of empty input. This function echoes `.' for each character that the user types. The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. C-g quits; if `inhibit-quit' was non-nil around this function, -then it returns nil if the user types C-g. +then it returns nil if the user types C-g, but quit-flag remains set. Once the caller uses the password, it can erase the password by doing (clear-string STRING)." @@ -1575,6 +1637,9 @@ by doing (clear-string STRING)." (sit-for 1)))) success) (let ((pass nil) + ;; Copy it so that add-text-properties won't modify + ;; the object that was passed in by the caller. + (prompt (copy-sequence prompt)) (c 0) (echo-keystrokes 0) (cursor-in-echo-area t) @@ -2137,7 +2202,8 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again." ;;;; Lisp macros to do various things temporarily. (defmacro with-current-buffer (buffer &rest body) - "Execute the forms in BODY with BUFFER as the current buffer. + "Execute the forms in BODY with BUFFER temporarily current. +BUFFER can be a buffer or a buffer name. The value returned is the value of the last form in BODY. See also `with-temp-buffer'." (declare (indent 1) (debug t)) @@ -2250,13 +2316,19 @@ See also `with-temp-file' and `with-output-to-string'." (defmacro with-local-quit (&rest body) "Execute BODY, allowing quits to terminate BODY but not escape further. When a quit terminates BODY, `with-local-quit' returns nil but -requests another quit. That quit will be processed, the next time quitting -is allowed once again." +requests another quit. That quit will be processed as soon as quitting +is allowed once again. (Immediately, if `inhibit-quit' is nil.)" (declare (debug t) (indent 0)) `(condition-case nil (let ((inhibit-quit nil)) ,@body) - (quit (setq quit-flag t) nil))) + (quit (setq quit-flag t) + ;; This call is to give a chance to handle quit-flag + ;; in case inhibit-quit is nil. + ;; Without this, it will not be handled until the next function + ;; call, and that might allow it to exit thru a condition-case + ;; that intends to handle the quit signal next time. + (eval '(ignore nil))))) (defmacro while-no-input (&rest body) "Execute BODY only as long as there's no pending input. diff --git a/lisp/term.el b/lisp/term.el index 64f0efc767b..9ecb1efa948 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -660,13 +660,6 @@ Buffer local variable.") (put 'term-scroll-show-maximum-output 'permanent-local t) (put 'term-ptyp 'permanent-local t) -;; Do FORM if running under XEmacs (previously Lucid Emacs). -(defmacro term-if-xemacs (&rest forms) - (if (featurep 'xemacs) (cons 'progn forms))) -;; Do FORM if NOT running under XEmacs (previously Lucid Emacs). -(defmacro term-ifnot-xemacs (&rest forms) - (if (not (featurep 'xemacs)) (cons 'progn forms))) - (defmacro term-in-char-mode () '(eq (current-local-map) term-raw-map)) (defmacro term-in-line-mode () '(not (term-in-char-mode))) ;; True if currently doing PAGER handling. @@ -725,13 +718,13 @@ Notice that a setting of 0 means 'don't truncate anything'. This variable is buffer-local.") ;;; -(term-if-xemacs - (defvar term-terminal-menu - '("Terminal" - [ "Character mode" term-char-mode (term-in-line-mode)] - [ "Line mode" term-line-mode (term-in-char-mode)] - [ "Enable paging" term-pager-toggle (not term-pager-count)] - [ "Disable paging" term-pager-toggle term-pager-count]))) +(when (featurep 'xemacs) + (defvar term-terminal-menu + '("Terminal" + [ "Character mode" term-char-mode (term-in-line-mode)] + [ "Line mode" term-line-mode (term-in-char-mode)] + [ "Enable paging" term-pager-toggle (not term-pager-count)] + [ "Disable paging" term-pager-toggle term-pager-count]))) (unless term-mode-map (setq term-mode-map (make-sparse-keymap)) @@ -739,10 +732,10 @@ is buffer-local.") (define-key term-mode-map "\en" 'term-next-input) (define-key term-mode-map "\er" 'term-previous-matching-input) (define-key term-mode-map "\es" 'term-next-matching-input) - (term-ifnot-xemacs - (define-key term-mode-map [?\A-\M-r] - 'term-previous-matching-input-from-input) - (define-key term-mode-map [?\A-\M-s] 'term-next-matching-input-from-input)) + (unless (featurep 'xemacs) + (define-key term-mode-map [?\A-\M-r] + 'term-previous-matching-input-from-input) + (define-key term-mode-map [?\A-\M-s] 'term-next-matching-input-from-input)) (define-key term-mode-map "\e\C-l" 'term-show-output) (define-key term-mode-map "\C-m" 'term-send-input) (define-key term-mode-map "\C-d" 'term-delchar-or-maybe-eof) @@ -781,9 +774,7 @@ is buffer-local.") ) ;; Menu bars: -(term-ifnot-xemacs - (progn - +(unless (featurep 'xemacs) ;; terminal: (let (newmap) (setq newmap (make-sparse-keymap "Terminal")) @@ -860,14 +851,14 @@ is buffer-local.") (define-key newmap [] '("BREAK" . term-interrupt-subjob)) (define-key term-mode-map [menu-bar signals] (setq term-signals-menu (cons "Signals" newmap))) - ))) + )) ;; Set up term-raw-map, etc. (defun term-set-escape-char (c) "Change term-escape-char and keymaps that depend on it." - (if term-escape-char - (define-key term-raw-map term-escape-char 'term-send-raw)) + (when term-escape-char + (define-key term-raw-map term-escape-char 'term-send-raw)) (setq c (make-string 1 c)) (define-key term-raw-map c term-raw-escape-map) ;; Define standard bindings in term-raw-escape-map @@ -899,28 +890,26 @@ is buffer-local.") ;;; Added nearly all the 'grey keys' -mm - (progn - (term-if-xemacs - (define-key term-raw-map [button2] 'term-mouse-paste)) - (term-ifnot-xemacs - (define-key term-raw-map [mouse-2] 'term-mouse-paste) - (define-key term-raw-map [menu-bar terminal] term-terminal-menu) - (define-key term-raw-map [menu-bar signals] term-signals-menu)) - (define-key term-raw-map [up] 'term-send-up) - (define-key term-raw-map [down] 'term-send-down) - (define-key term-raw-map [right] 'term-send-right) - (define-key term-raw-map [left] 'term-send-left) - (define-key term-raw-map [delete] 'term-send-del) - (define-key term-raw-map [deletechar] 'term-send-del) - (define-key term-raw-map [backspace] 'term-send-backspace) - (define-key term-raw-map [home] 'term-send-home) - (define-key term-raw-map [end] 'term-send-end) - (define-key term-raw-map [insert] 'term-send-insert) - (define-key term-raw-map [S-prior] 'scroll-down) - (define-key term-raw-map [S-next] 'scroll-up) - (define-key term-raw-map [S-insert] 'term-paste) - (define-key term-raw-map [prior] 'term-send-prior) - (define-key term-raw-map [next] 'term-send-next))) + (if (featurep 'xemacs) + (define-key term-raw-map [button2] 'term-mouse-paste) + (define-key term-raw-map [mouse-2] 'term-mouse-paste) + (define-key term-raw-map [menu-bar terminal] term-terminal-menu) + (define-key term-raw-map [menu-bar signals] term-signals-menu)) + (define-key term-raw-map [up] 'term-send-up) + (define-key term-raw-map [down] 'term-send-down) + (define-key term-raw-map [right] 'term-send-right) + (define-key term-raw-map [left] 'term-send-left) + (define-key term-raw-map [delete] 'term-send-del) + (define-key term-raw-map [deletechar] 'term-send-del) + (define-key term-raw-map [backspace] 'term-send-backspace) + (define-key term-raw-map [home] 'term-send-home) + (define-key term-raw-map [end] 'term-send-end) + (define-key term-raw-map [insert] 'term-send-insert) + (define-key term-raw-map [S-prior] 'scroll-down) + (define-key term-raw-map [S-next] 'scroll-up) + (define-key term-raw-map [S-insert] 'term-paste) + (define-key term-raw-map [prior] 'term-send-prior) + (define-key term-raw-map [next] 'term-send-next)) (term-set-escape-char ?\C-c) @@ -1112,9 +1101,9 @@ Entry to this mode runs the hooks on `term-mode-hook'." ;; Cua-mode's keybindings interfere with the term keybindings, disable it. (set (make-local-variable 'cua-mode) nil) (run-mode-hooks 'term-mode-hook) - (term-if-xemacs - (set-buffer-menubar - (append current-menubar (list term-terminal-menu)))) + (when (featurep 'xemacs) + (set-buffer-menubar + (append current-menubar (list term-terminal-menu)))) (or term-input-ring (setq term-input-ring (make-ring term-input-ring-size))) (term-update-mode-line)) @@ -1151,16 +1140,15 @@ Entry to this mode runs the hooks on `term-mode-hook'." (setq term-start-line-column nil) (setq cur nil found t)) (setq cur (cdr cur)))))) - (if (not found) - (goto-char save-point))) + (when (not found) + (goto-char save-point))) found)) (defun term-check-size (process) - (if (or (/= term-height (1- (window-height))) - (/= term-width (term-window-width))) - (progn - (term-reset-size (1- (window-height)) (term-window-width)) - (set-process-window-size process term-height term-width)))) + (when (or (/= term-height (1- (window-height))) + (/= term-width (term-window-width))) + (term-reset-size (1- (window-height)) (term-window-width)) + (set-process-window-size process term-height term-width))) (defun term-send-raw-string (chars) (let ((proc (get-buffer-process (current-buffer)))) @@ -1169,8 +1157,8 @@ Entry to this mode runs the hooks on `term-mode-hook'." ;; Note that (term-current-row) must be called *after* ;; (point) has been updated to (process-mark proc). (goto-char (process-mark proc)) - (if (term-pager-enabled) - (setq term-pager-count (term-current-row))) + (when (term-pager-enabled) + (setq term-pager-count (term-current-row))) (process-send-string proc chars)))) (defun term-send-raw () @@ -1178,9 +1166,9 @@ Entry to this mode runs the hooks on `term-mode-hook'." without any interpretation." (interactive) ;; Convert `return' to C-m, etc. - (if (and (symbolp last-input-char) - (get last-input-char 'ascii-character)) - (setq last-input-char (get last-input-char 'ascii-character))) + (when (and (symbolp last-input-char) + (get last-input-char 'ascii-character)) + (setq last-input-char (get last-input-char 'ascii-character))) (term-send-raw-string (make-string 1 last-input-char))) (defun term-send-raw-meta () @@ -1205,19 +1193,19 @@ without any interpretation." (defun term-mouse-paste (click arg) "Insert the last stretch of killed text at the position clicked on." (interactive "e\nP") - (term-if-xemacs - (term-send-raw-string (or (condition-case () (x-get-selection) (error ())) - (x-get-cutbuffer) - (error "No selection or cut buffer available")))) - (term-ifnot-xemacs - ;; Give temporary modes such as isearch a chance to turn off. - (run-hooks 'mouse-leave-buffer-hook) - (setq this-command 'yank) - (mouse-set-point click) - (term-send-raw-string (current-kill (cond - ((listp arg) 0) - ((eq arg '-) -1) - (t (1- arg))))))) + (if (featurep 'xemacs) + (term-send-raw-string + (or (condition-case () (x-get-selection) (error ())) + (x-get-cutbuffer) + (error "No selection or cut buffer available"))) + ;; Give temporary modes such as isearch a chance to turn off. + (run-hooks 'mouse-leave-buffer-hook) + (setq this-command 'yank) + (mouse-set-point click) + (term-send-raw-string (current-kill (cond + ((listp arg) 0) + ((eq arg '-) -1) + (t (1- arg))))))) (defun term-paste () "Insert the last stretch of killed text at point." @@ -1246,33 +1234,31 @@ Each character you type is sent directly to the inferior without intervention from Emacs, except for the escape character (usually C-c)." (interactive) ;; FIXME: Emit message? Cfr ilisp-raw-message - (if (term-in-line-mode) - (progn - (setq term-old-mode-map (current-local-map)) - (use-local-map term-raw-map) - - ;; Send existing partial line to inferior (without newline). - (let ((pmark (process-mark (get-buffer-process (current-buffer)))) - (save-input-sender term-input-sender)) - (if (> (point) pmark) - (unwind-protect - (progn - (setq term-input-sender - (symbol-function 'term-send-string)) - (end-of-line) - (term-send-input)) - (setq term-input-sender save-input-sender)))) - (term-update-mode-line)))) + (when (term-in-line-mode) + (setq term-old-mode-map (current-local-map)) + (use-local-map term-raw-map) + + ;; Send existing partial line to inferior (without newline). + (let ((pmark (process-mark (get-buffer-process (current-buffer)))) + (save-input-sender term-input-sender)) + (when (> (point) pmark) + (unwind-protect + (progn + (setq term-input-sender + (symbol-function 'term-send-string)) + (end-of-line) + (term-send-input)) + (setq term-input-sender save-input-sender)))) + (term-update-mode-line))) (defun term-line-mode () "Switch to line (\"cooked\") sub-mode of term mode. This means that Emacs editing commands work as normally, until you type \\[term-send-input] which sends the current line to the inferior." (interactive) - (if (term-in-char-mode) - (progn - (use-local-map term-old-mode-map) - (term-update-mode-line)))) + (when (term-in-char-mode) + (use-local-map term-old-mode-map) + (term-update-mode-line))) (defun term-update-mode-line () (setq mode-line-process @@ -1330,7 +1316,7 @@ buffer. The hook term-exec-hook is run after each exec." (save-excursion (set-buffer buffer) (let ((proc (get-buffer-process buffer))) ; Blast any old process. - (if proc (delete-process proc))) + (when proc (delete-process proc))) ;; Crank up a new process (let ((proc (term-exec-1 name buffer command switches))) (make-local-variable 'term-ptyp) @@ -1360,29 +1346,28 @@ buffer. The hook term-exec-hook is run after each exec." "Sentinel for term buffers. The main purpose is to get rid of the local keymap." (let ((buffer (process-buffer proc))) - (if (memq (process-status proc) '(signal exit)) - (progn - (if (null (buffer-name buffer)) - ;; buffer killed - (set-process-buffer proc nil) - (let ((obuf (current-buffer))) - ;; save-excursion isn't the right thing if - ;; process-buffer is current-buffer - (unwind-protect - (progn - ;; Write something in the compilation buffer - ;; and hack its mode line. - (set-buffer buffer) - ;; Get rid of local keymap. - (use-local-map nil) - (term-handle-exit (process-name proc) - msg) - ;; Since the buffer and mode line will show that the - ;; process is dead, we can delete it now. Otherwise it - ;; will stay around until M-x list-processes. - (delete-process proc)) - (set-buffer obuf)))) - )))) + (when (memq (process-status proc) '(signal exit)) + (if (null (buffer-name buffer)) + ;; buffer killed + (set-process-buffer proc nil) + (let ((obuf (current-buffer))) + ;; save-excursion isn't the right thing if + ;; process-buffer is current-buffer + (unwind-protect + (progn + ;; Write something in the compilation buffer + ;; and hack its mode line. + (set-buffer buffer) + ;; Get rid of local keymap. + (use-local-map nil) + (term-handle-exit (process-name proc) + msg) + ;; Since the buffer and mode line will show that the + ;; process is dead, we can delete it now. Otherwise it + ;; will stay around until M-x list-processes. + (delete-process proc)) + (set-buffer obuf))) + )))) (defun term-handle-exit (process-name msg) "Write process exit (or other change) message MSG in the current buffer." @@ -1395,8 +1380,8 @@ The main purpose is to get rid of the local keymap." (insert ?\n "Process " process-name " " msg) ;; Force mode line redisplay soon. (force-mode-line-update) - (if (and opoint (< opoint omax)) - (goto-char opoint)))) + (when (and opoint (< opoint omax)) + (goto-char opoint)))) ;;; Name to use for TERM. @@ -1519,9 +1504,9 @@ See also `term-input-ignoredups' and `term-write-input-ring'." nil t)) (let ((history (buffer-substring (match-beginning 1) (match-end 1)))) - (if (or (null term-input-ignoredups) - (ring-empty-p ring) - (not (string-equal (ring-ref ring 0) history))) + (when (or (null term-input-ignoredups) + (ring-empty-p ring) + (not (string-equal (ring-ref ring 0) history))) (ring-insert-at-beginning ring history))) (setq count (1+ count)))) (kill-buffer history-buf)) @@ -1649,15 +1634,15 @@ Moves relative to `term-input-ring-index'." "Return the string matching REGEXP ARG places along the input ring. Moves relative to `term-input-ring-index'." (let* ((pos (term-previous-matching-input-string-position regexp arg))) - (if pos (ring-ref term-input-ring pos)))) + (when pos (ring-ref term-input-ring pos)))) (defun term-previous-matching-input-string-position (regexp arg &optional start) "Return the index matching REGEXP ARG places along the input ring. Moves relative to START, or `term-input-ring-index'." - (if (or (not (ring-p term-input-ring)) - (ring-empty-p term-input-ring)) - (error "No history")) + (when (or (not (ring-p term-input-ring)) + (ring-empty-p term-input-ring)) + (error "No history")) (let* ((len (ring-length term-input-ring)) (motion (if (> arg 0) 1 -1)) (n (mod (- (or start (term-search-start arg)) motion) len)) @@ -1676,8 +1661,8 @@ Moves relative to START, or `term-input-ring-index'." tried-each-ring-item (= n prev))) (setq arg (if (> arg 0) (1- arg) (1+ arg)))) ;; Now that we know which ring element to use, if we found it, return that. - (if (string-match regexp (ring-ref term-input-ring n)) - n))) + (when (string-match regexp (ring-ref term-input-ring n)) + n))) (defun term-previous-matching-input (regexp arg) "Search backwards through input history for match for REGEXP. @@ -1711,14 +1696,14 @@ If N is negative, find the previous or Nth previous match." With prefix argument N, search for Nth previous match. If N is negative, search forwards for the -Nth following match." (interactive "p") - (if (not (memq last-command '(term-previous-matching-input-from-input + (when (not (memq last-command '(term-previous-matching-input-from-input term-next-matching-input-from-input))) - ;; Starting a new search - (setq term-matching-input-from-input-string - (buffer-substring - (process-mark (get-buffer-process (current-buffer))) - (point)) - term-input-ring-index nil)) + ;; Starting a new search + (setq term-matching-input-from-input-string + (buffer-substring + (process-mark (get-buffer-process (current-buffer))) + (point)) + term-input-ring-index nil)) (term-previous-matching-input (concat "^" (regexp-quote term-matching-input-from-input-string)) arg)) @@ -1750,15 +1735,15 @@ See `term-magic-space' and `term-replace-by-expanded-history-before-point'. Returns t if successful." (interactive) - (if (and term-input-autoexpand - (string-match "[!^]" (funcall term-get-old-input)) - (save-excursion (beginning-of-line) - (looking-at term-prompt-regexp))) - ;; Looks like there might be history references in the command. - (let ((previous-modified-tick (buffer-modified-tick))) - (message "Expanding history references...") - (term-replace-by-expanded-history-before-point silent) - (/= previous-modified-tick (buffer-modified-tick))))) + (when (and term-input-autoexpand + (string-match "[!^]" (funcall term-get-old-input)) + (save-excursion (beginning-of-line) + (looking-at term-prompt-regexp))) + ;; Looks like there might be history references in the command. + (let ((previous-modified-tick (buffer-modified-tick))) + (message "Expanding history references...") + (term-replace-by-expanded-history-before-point silent) + (/= previous-modified-tick (buffer-modified-tick))))) (defun term-replace-by-expanded-history-before-point (silent) @@ -2024,17 +2009,17 @@ Similarly for Soar, Scheme, etc." (delete-region pmark (point)) (insert input) copy)))) - (if (term-pager-enabled) - (save-excursion - (goto-char (process-mark proc)) - (setq term-pager-count (term-current-row)))) - (if (and (funcall term-input-filter history) - (or (null term-input-ignoredups) - (not (ring-p term-input-ring)) - (ring-empty-p term-input-ring) - (not (string-equal (ring-ref term-input-ring 0) - history)))) - (ring-insert term-input-ring history)) + (when (term-pager-enabled) + (save-excursion + (goto-char (process-mark proc)) + (setq term-pager-count (term-current-row)))) + (when (and (funcall term-input-filter history) + (or (null term-input-ignoredups) + (not (ring-p term-input-ring)) + (ring-empty-p term-input-ring) + (not (string-equal (ring-ref term-input-ring 0) + history)))) + (ring-insert term-input-ring history)) (let ((functions term-input-filter-functions)) (while functions (funcall (car functions) (concat input "\n")) @@ -2045,13 +2030,12 @@ Similarly for Soar, Scheme, etc." ;; in case we get output amidst sending the input. (set-marker term-last-input-start pmark) (set-marker term-last-input-end (point)) - (if input-is-new - (progn - ;; Set up to delete, because inferior should echo. - (if (marker-buffer term-pending-delete-marker) - (delete-region term-pending-delete-marker pmark)) - (set-marker term-pending-delete-marker pmark-val) - (set-marker (process-mark proc) (point)))) + (when input-is-new + ;; Set up to delete, because inferior should echo. + (when (marker-buffer term-pending-delete-marker) + (delete-region term-pending-delete-marker pmark)) + (set-marker term-pending-delete-marker pmark-val) + (set-marker (process-mark proc) (point))) (goto-char pmark) (funcall term-input-sender proc input))))) @@ -2081,9 +2065,9 @@ Calls `term-get-old-input' to get old input." "Skip past the text matching regexp term-prompt-regexp. If this takes us past the end of the current line, don't skip at all." (let ((eol (save-excursion (end-of-line) (point)))) - (if (and (looking-at term-prompt-regexp) - (<= (match-end 0) eol)) - (goto-char (match-end 0))))) + (when (and (looking-at term-prompt-regexp) + (<= (match-end 0) eol)) + (goto-char (match-end 0))))) (defun term-after-pmark-p () @@ -2112,7 +2096,7 @@ The prompt skip is done by skipping text matching the regular expression term-prompt-regexp, a buffer local variable." (interactive "P") (beginning-of-line) - (if (null arg) (term-skip-prompt))) + (when (null arg) (term-skip-prompt))) ;;; These two functions are for entering text you don't want echoed or ;;; saved -- typically passwords to ftp, telnet, or somesuch. @@ -2173,10 +2157,10 @@ is additionally sent. String is not saved on term input history list. Security bug: your string can still be temporarily recovered with \\[view-lossage]." (interactive "P") ; Defeat snooping via C-x esc - (if (not (stringp str)) - (setq str (term-read-noecho "Non-echoed text: " t))) - (if (not proc) - (setq proc (get-buffer-process (current-buffer)))) + (when (not (stringp str)) + (setq str (term-read-noecho "Non-echoed text: " t))) + (when (not proc) + (setq proc (get-buffer-process (current-buffer)))) (if (not proc) (error "Current buffer has no process") (setq term-kill-echo-list (nconc term-kill-echo-list (cons str nil))) @@ -2268,8 +2252,8 @@ Useful if you accidentally suspend the top-level process." (interactive) (let* ((pmark (process-mark (get-buffer-process (current-buffer)))) (p-pos (marker-position pmark))) - (if (> (point) p-pos) - (kill-region pmark (point))))) + (when (> (point) p-pos) + (kill-region pmark (point))))) (defun term-delchar-or-maybe-eof (arg) "Delete ARG characters forward, or send an EOF to process if at end of @@ -2277,7 +2261,7 @@ buffer." (interactive "p") (if (eobp) (process-send-eof) - (delete-char arg))) + (delete-char arg))) (defun term-send-eof () "Send an EOF to the current buffer's process." @@ -2292,8 +2276,8 @@ If N is negative, find the next or Nth next match." (interactive (term-regexp-arg "Backward input matching (regexp): ")) (let* ((re (concat term-prompt-regexp ".*" regexp)) (pos (save-excursion (end-of-line (if (> arg 0) 0 1)) - (if (re-search-backward re nil t arg) - (point))))) + (when (re-search-backward re nil t arg) + (point))))) (if (null pos) (progn (message "Not found") (ding)) @@ -2405,15 +2389,15 @@ See `term-prompt-regexp'." (defun term-check-source (fname) (let ((buff (get-file-buffer fname))) - (if (and buff - (buffer-modified-p buff) - (y-or-n-p (format "Save buffer %s first? " - (buffer-name buff)))) - ;; save BUFF. - (let ((old-buffer (current-buffer))) - (set-buffer buff) - (save-buffer) - (set-buffer old-buffer))))) + (when (and buff + (buffer-modified-p buff) + (y-or-n-p (format "Save buffer %s first? " + (buffer-name buff)))) + ;; save BUFF. + (let ((old-buffer (current-buffer))) + (set-buffer buff) + (save-buffer) + (set-buffer old-buffer))))) ;;; (TERM-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p) @@ -2508,12 +2492,12 @@ See `term-prompt-regexp'." ;; Try to position the proc window so you can see the answer. ;; This is bogus code. If you delete the (sit-for 0), it breaks. ;; I don't know why. Wizards invited to improve it. - (if (not (pos-visible-in-window-p proc-pt proc-win)) - (let ((opoint (window-point proc-win))) - (set-window-point proc-win proc-mark) (sit-for 0) - (if (not (pos-visible-in-window-p opoint proc-win)) - (push-mark opoint) - (set-window-point proc-win opoint))))))) + (when (not (pos-visible-in-window-p proc-pt proc-win)) + (let ((opoint (window-point proc-win))) + (set-window-point proc-win proc-mark) (sit-for 0) + (if (not (pos-visible-in-window-p opoint proc-win)) + (push-mark opoint) + (set-window-point proc-win opoint))))))) ;;; Returns the current column in the current screen line. ;;; Note: (current-column) yields column in buffer line. @@ -2701,16 +2685,15 @@ See `term-prompt-regexp'." ;; Let's handle the messages. -mm (let* ((newstr (term-handle-ansi-terminal-messages str))) - (if (not (eq str newstr)) - (setq handled-ansi-message t - str newstr))) + (when (not (eq str newstr)) + (setq handled-ansi-message t + str newstr))) (setq str-length (length str)) - (if (marker-buffer term-pending-delete-marker) - (progn - ;; Delete text following term-pending-delete-marker. - (delete-region term-pending-delete-marker (process-mark proc)) - (set-marker term-pending-delete-marker nil))) + (when (marker-buffer term-pending-delete-marker) + ;; Delete text following term-pending-delete-marker. + (delete-region term-pending-delete-marker (process-mark proc)) + (set-marker term-pending-delete-marker nil)) (if (eq (window-buffer) (current-buffer)) (progn @@ -2721,20 +2704,20 @@ See `term-prompt-regexp'." (setq save-marker (copy-marker (process-mark proc))) - (if (/= (point) (process-mark proc)) - (progn (setq save-point (point-marker)) - (goto-char (process-mark proc)))) + (when (/= (point) (process-mark proc)) + (setq save-point (point-marker)) + (goto-char (process-mark proc))) (save-restriction ;; If the buffer is in line mode, and there is a partial ;; input line, save the line (by narrowing to leave it ;; outside the restriction ) until we're done with output. - (if (and (> (point-max) (process-mark proc)) - (term-in-line-mode)) - (narrow-to-region (point-min) (process-mark proc))) + (when (and (> (point-max) (process-mark proc)) + (term-in-line-mode)) + (narrow-to-region (point-min) (process-mark proc))) - (if term-log-buffer - (princ str term-log-buffer)) + (when term-log-buffer + (princ str term-log-buffer)) (cond ((eq term-terminal-state 4) ;; Have saved pending output. (setq str (concat term-terminal-parameter str)) (setq term-terminal-parameter nil) @@ -2748,7 +2731,7 @@ See `term-prompt-regexp'." (setq funny (string-match "[\r\n\000\007\033\t\b\032\016\017]" str i)) - (if (not funny) (setq funny str-length)) + (when (not funny) (setq funny str-length)) (cond ((> funny i) (cond ((eq term-terminal-state 1) ;; We are in state 1, we need to wrap @@ -2822,10 +2805,10 @@ See `term-prompt-regexp'." (setq count (min term-width (+ count 8 (- (mod count 8))))) (if (> term-width count) - (progn - (term-move-columns - (- count (term-current-column))) - (setq term-current-column count)) + (progn + (term-move-columns + (- count (term-current-column))) + (setq term-current-column count)) (when (> term-width (term-current-column)) (term-move-columns (1- (- term-width (term-current-column))))) @@ -2967,44 +2950,43 @@ See `term-prompt-regexp'." (setq term-terminal-previous-parameter-2 -1) (setq term-terminal-previous-parameter -1) (setq term-terminal-state 0))))) - (if (term-handling-pager) - ;; Finish stuff to get ready to handle PAGER. - (progn - (if (> (% (current-column) term-width) 0) - (setq term-terminal-parameter - (substring str i)) - ;; We're at column 0. Goto end of buffer; to compensate, - ;; prepend a ?\r for later. This looks more consistent. - (if (zerop i) - (setq term-terminal-parameter - (concat "\r" (substring str i))) - (setq term-terminal-parameter (substring str (1- i))) - (aset term-terminal-parameter 0 ?\r)) - (goto-char (point-max))) - (setq term-terminal-state 4) - (make-local-variable 'term-pager-old-filter) - (setq term-pager-old-filter (process-filter proc)) - (set-process-filter proc term-pager-filter) - (setq i str-length))) + (when (term-handling-pager) + ;; Finish stuff to get ready to handle PAGER. + (if (> (% (current-column) term-width) 0) + (setq term-terminal-parameter + (substring str i)) + ;; We're at column 0. Goto end of buffer; to compensate, + ;; prepend a ?\r for later. This looks more consistent. + (if (zerop i) + (setq term-terminal-parameter + (concat "\r" (substring str i))) + (setq term-terminal-parameter (substring str (1- i))) + (aset term-terminal-parameter 0 ?\r)) + (goto-char (point-max))) + (setq term-terminal-state 4) + (make-local-variable 'term-pager-old-filter) + (setq term-pager-old-filter (process-filter proc)) + (set-process-filter proc term-pager-filter) + (setq i str-length)) (setq i (1+ i)))) - (if (>= (term-current-row) term-height) - (term-handle-deferred-scroll)) + (when (>= (term-current-row) term-height) + (term-handle-deferred-scroll)) (set-marker (process-mark proc) (point)) - (if save-point - (progn (goto-char save-point) - (set-marker save-point nil))) + (when save-point + (goto-char save-point) + (set-marker save-point nil)) ;; Check for a pending filename-and-line number to display. ;; We do this before scrolling, because we might create a new window. - (if (and term-pending-frame - (eq (window-buffer selected) (current-buffer))) - (progn (term-display-line (car term-pending-frame) - (cdr term-pending-frame)) - (setq term-pending-frame nil) - ;; We have created a new window, so check the window size. - (term-check-size proc))) + (when (and term-pending-frame + (eq (window-buffer selected) (current-buffer))) + (term-display-line (car term-pending-frame) + (cdr term-pending-frame)) + (setq term-pending-frame nil) + ;; We have created a new window, so check the window size. + (term-check-size proc)) ;; Scroll each window displaying the buffer but (by default) ;; only if the point matches the process-mark we started with. @@ -3016,50 +2998,47 @@ See `term-prompt-regexp'." (setq last-win win) (while (progn (setq win (next-window win nil t)) - (if (eq (window-buffer win) (process-buffer proc)) - (let ((scroll term-scroll-to-bottom-on-output)) - (select-window win) - (if (or (= (point) save-marker) + (when (eq (window-buffer win) (process-buffer proc)) + (let ((scroll term-scroll-to-bottom-on-output)) + (select-window win) + (when (or (= (point) save-marker) (eq scroll t) (eq scroll 'all) ;; Maybe user wants point to jump to the end. (and (eq selected win) (or (eq scroll 'this) (not save-point))) (and (eq scroll 'others) (not (eq selected win)))) - (progn - (goto-char term-home-marker) - (recenter 0) - (goto-char (process-mark proc)) - (if (not (pos-visible-in-window-p (point) win)) - (recenter -1)))) - ;; Optionally scroll so that the text - ;; ends at the bottom of the window. - (if (and term-scroll-show-maximum-output + (goto-char term-home-marker) + (recenter 0) + (goto-char (process-mark proc)) + (if (not (pos-visible-in-window-p (point) win)) + (recenter -1))) + ;; Optionally scroll so that the text + ;; ends at the bottom of the window. + (when (and term-scroll-show-maximum-output (>= (point) (process-mark proc))) - (save-excursion - (goto-char (point-max)) - (recenter -1))))) + (save-excursion + (goto-char (point-max)) + (recenter -1))))) (not (eq win last-win)))) ;;; Stolen from comint.el and adapted -mm - (if (> term-buffer-maximum-size 0) - (save-excursion - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (forward-line (- term-buffer-maximum-size)) - (beginning-of-line) - (delete-region (point-min) (point)))) -;;; - + (when (> term-buffer-maximum-size 0) + (save-excursion + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (forward-line (- term-buffer-maximum-size)) + (beginning-of-line) + (delete-region (point-min) (point)))) (set-marker save-marker nil))))) (defun term-handle-deferred-scroll () (let ((count (- (term-current-row) term-height))) - (if (>= count 0) - (save-excursion - (goto-char term-home-marker) - (term-vertical-motion (1+ count)) - (set-marker term-home-marker (point)) - (setq term-current-row (1- term-height)))))) + (when (>= count 0) + (save-excursion + (goto-char term-home-marker) + (term-vertical-motion (1+ count)) + (set-marker term-home-marker (point)) + (setq term-current-row (1- term-height)))))) ;;; Reset the terminal, delete all the content and set the face to the ;;; default one. @@ -3170,17 +3149,17 @@ See `term-prompt-regexp'." (list :background (if (= term-ansi-current-color 0) (face-foreground 'default) - (elt ansi-term-color-vector term-ansi-current-color)) + (elt ansi-term-color-vector term-ansi-current-color)) :foreground (if (= term-ansi-current-bg-color 0) (face-background 'default) - (elt ansi-term-color-vector term-ansi-current-bg-color)))) + (elt ansi-term-color-vector term-ansi-current-bg-color)))) (when term-ansi-current-bold - (setq term-current-face - (append '(:weight bold) term-current-face))) + (setq term-current-face + (append '(:weight bold) term-current-face))) (when term-ansi-current-underline - (setq term-current-face - (append '(:underline t) term-current-face)))) + (setq term-current-face + (append '(:underline t) term-current-face)))) (if term-ansi-current-invisible (setq term-current-face (if (= term-ansi-current-bg-color 0) @@ -3200,12 +3179,12 @@ See `term-prompt-regexp'." :background (elt ansi-term-color-vector term-ansi-current-bg-color))) (when term-ansi-current-bold - (setq term-current-face - (append '(:weight bold) term-current-face))) + (setq term-current-face + (append '(:weight bold) term-current-face))) (when term-ansi-current-underline - (setq term-current-face - (append '(:underline t) term-current-face)))))) - + (setq term-current-face + (append '(:underline t) term-current-face)))))) + ;;; (message "Debug %S" term-current-face) (setq term-ansi-face-already-done nil)) @@ -3219,14 +3198,14 @@ See `term-prompt-regexp'." ;; (eq char ?f) ;; xterm seems to handle this sequence too, not ;; needed for now ) - (if (<= term-terminal-parameter 0) - (setq term-terminal-parameter 1)) - (if (<= term-terminal-previous-parameter 0) - (setq term-terminal-previous-parameter 1)) - (if (> term-terminal-previous-parameter term-height) - (setq term-terminal-previous-parameter term-height)) - (if (> term-terminal-parameter term-width) - (setq term-terminal-parameter term-width)) + (when (<= term-terminal-parameter 0) + (setq term-terminal-parameter 1)) + (when (<= term-terminal-previous-parameter 0) + (setq term-terminal-previous-parameter 1)) + (when (> term-terminal-previous-parameter term-height) + (setq term-terminal-previous-parameter term-height)) + (when (> term-terminal-parameter term-width) + (setq term-terminal-parameter term-width)) (term-goto (1- term-terminal-previous-parameter) (1- term-terminal-parameter))) @@ -3443,50 +3422,49 @@ The top-most line is line 0." ; The page is full, so enter "pager" mode, and wait for input. (defun term-process-pager () - (if (not term-pager-break-map) - (let* ((map (make-keymap)) - (i 0) tmp) + (when (not term-pager-break-map) + (let* ((map (make-keymap)) + (i 0) tmp) ; (while (< i 128) ; (define-key map (make-string 1 i) 'term-send-raw) ; (setq i (1+ i))) - (define-key map "\e" - (lookup-key (current-global-map) "\e")) - (define-key map "\C-x" - (lookup-key (current-global-map) "\C-x")) - (define-key map "\C-u" - (lookup-key (current-global-map) "\C-u")) - (define-key map " " 'term-pager-page) - (define-key map "\r" 'term-pager-line) - (define-key map "?" 'term-pager-help) - (define-key map "h" 'term-pager-help) - (define-key map "b" 'term-pager-back-page) - (define-key map "\177" 'term-pager-back-line) - (define-key map "q" 'term-pager-discard) - (define-key map "D" 'term-pager-disable) - (define-key map "<" 'term-pager-bob) - (define-key map ">" 'term-pager-eob) - - ;; Add menu bar. - (progn - (term-ifnot-xemacs - (define-key map [menu-bar terminal] term-terminal-menu) - (define-key map [menu-bar signals] term-signals-menu) - (setq tmp (make-sparse-keymap "More pages?")) - (define-key tmp [help] '("Help" . term-pager-help)) - (define-key tmp [disable] - '("Disable paging" . term-fake-pager-disable)) - (define-key tmp [discard] - '("Discard remaining output" . term-pager-discard)) - (define-key tmp [eob] '("Goto to end" . term-pager-eob)) - (define-key tmp [bob] '("Goto to beginning" . term-pager-bob)) - (define-key tmp [line] '("1 line forwards" . term-pager-line)) - (define-key tmp [bline] '("1 line backwards" . term-pager-back-line)) - (define-key tmp [back] '("1 page backwards" . term-pager-back-page)) - (define-key tmp [page] '("1 page forwards" . term-pager-page)) - (define-key map [menu-bar page] (cons "More pages?" tmp)) - )) + (define-key map "\e" + (lookup-key (current-global-map) "\e")) + (define-key map "\C-x" + (lookup-key (current-global-map) "\C-x")) + (define-key map "\C-u" + (lookup-key (current-global-map) "\C-u")) + (define-key map " " 'term-pager-page) + (define-key map "\r" 'term-pager-line) + (define-key map "?" 'term-pager-help) + (define-key map "h" 'term-pager-help) + (define-key map "b" 'term-pager-back-page) + (define-key map "\177" 'term-pager-back-line) + (define-key map "q" 'term-pager-discard) + (define-key map "D" 'term-pager-disable) + (define-key map "<" 'term-pager-bob) + (define-key map ">" 'term-pager-eob) + + ;; Add menu bar. + (unless (featurep 'xemacs) + (define-key map [menu-bar terminal] term-terminal-menu) + (define-key map [menu-bar signals] term-signals-menu) + (setq tmp (make-sparse-keymap "More pages?")) + (define-key tmp [help] '("Help" . term-pager-help)) + (define-key tmp [disable] + '("Disable paging" . term-fake-pager-disable)) + (define-key tmp [discard] + '("Discard remaining output" . term-pager-discard)) + (define-key tmp [eob] '("Goto to end" . term-pager-eob)) + (define-key tmp [bob] '("Goto to beginning" . term-pager-bob)) + (define-key tmp [line] '("1 line forwards" . term-pager-line)) + (define-key tmp [bline] '("1 line backwards" . term-pager-back-line)) + (define-key tmp [back] '("1 page backwards" . term-pager-back-page)) + (define-key tmp [page] '("1 page forwards" . term-pager-page)) + (define-key map [menu-bar page] (cons "More pages?" tmp)) + ) - (setq term-pager-break-map map))) + (setq term-pager-break-map map))) ; (let ((process (get-buffer-process (current-buffer)))) ; (stop-process process)) (setq term-pager-old-local-map (current-local-map)) @@ -3504,8 +3482,8 @@ The top-most line is line 0." (interactive "p") (let* ((moved (vertical-motion (1+ lines))) (deficit (- lines moved))) - (if (> moved lines) - (backward-char)) + (when (> moved lines) + (backward-char)) (cond ((<= deficit 0) ;; OK, had enough in the buffer for request. (recenter (1- term-height))) ((term-pager-continue deficit))))) @@ -3519,8 +3497,8 @@ The top-most line is line 0." (defun term-pager-bob () (interactive) (goto-char (point-min)) - (if (= (vertical-motion term-height) term-height) - (backward-char)) + (when (= (vertical-motion term-height) term-height) + (backward-char)) (recenter (1- term-height))) ; pager mode command to go to end of buffer @@ -3571,7 +3549,7 @@ The top-most line is line 0." (interactive) (if (term-pager-enabled) (term-pager-disable) (term-pager-enable))) -(term-ifnot-xemacs +(unless (featurep 'xemacs) (defalias 'term-fake-pager-enable 'term-pager-toggle) (defalias 'term-fake-pager-disable 'term-pager-toggle) (put 'term-char-mode 'menu-enable '(term-in-line-mode)) @@ -3624,45 +3602,45 @@ all pending output has been dealt with.")) (let ((scroll-needed (- (+ (term-current-row) down) (if (< down 0) term-scroll-start term-scroll-end)))) - (if (or (and (< down 0) (< scroll-needed 0)) - (and (> down 0) (> scroll-needed 0))) - (let ((save-point (copy-marker (point))) (save-top)) - (goto-char term-home-marker) - (cond (term-scroll-with-delete - (if (< down 0) - (progn - ;; Delete scroll-needed lines at term-scroll-end, - ;; then insert scroll-needed lines. - (term-vertical-motion (1- term-scroll-end)) - (end-of-line) - (setq save-top (point)) - (term-vertical-motion scroll-needed) - (end-of-line) - (delete-region save-top (point)) - (goto-char save-point) - (setq down (- scroll-needed down)) - (term-vertical-motion down)) - ;; Delete scroll-needed lines at term-scroll-start. - (term-vertical-motion term-scroll-start) - (setq save-top (point)) - (term-vertical-motion scroll-needed) - (delete-region save-top (point)) - (goto-char save-point) - (term-vertical-motion down) - (term-adjust-current-row-cache (- scroll-needed))) - (setq term-current-column nil) - (term-insert-char ?\n (abs scroll-needed))) - ((and (numberp term-pager-count) - (< (setq term-pager-count (- term-pager-count down)) - 0)) - (setq down 0) - (term-process-pager)) - (t - (term-adjust-current-row-cache (- scroll-needed)) + (when (or (and (< down 0) (< scroll-needed 0)) + (and (> down 0) (> scroll-needed 0))) + (let ((save-point (copy-marker (point))) (save-top)) + (goto-char term-home-marker) + (cond (term-scroll-with-delete + (if (< down 0) + (progn + ;; Delete scroll-needed lines at term-scroll-end, + ;; then insert scroll-needed lines. + (term-vertical-motion (1- term-scroll-end)) + (end-of-line) + (setq save-top (point)) + (term-vertical-motion scroll-needed) + (end-of-line) + (delete-region save-top (point)) + (goto-char save-point) + (setq down (- scroll-needed down)) + (term-vertical-motion down)) + ;; Delete scroll-needed lines at term-scroll-start. + (term-vertical-motion term-scroll-start) + (setq save-top (point)) (term-vertical-motion scroll-needed) - (set-marker term-home-marker (point)))) - (goto-char save-point) - (set-marker save-point nil)))) + (delete-region save-top (point)) + (goto-char save-point) + (term-vertical-motion down) + (term-adjust-current-row-cache (- scroll-needed))) + (setq term-current-column nil) + (term-insert-char ?\n (abs scroll-needed))) + ((and (numberp term-pager-count) + (< (setq term-pager-count (- term-pager-count down)) + 0)) + (setq down 0) + (term-process-pager)) + (t + (term-adjust-current-row-cache (- scroll-needed)) + (term-vertical-motion scroll-needed) + (set-marker term-home-marker (point)))) + (goto-char save-point) + (set-marker save-point nil)))) down) (defun term-down (down &optional check-for-scroll) @@ -3699,34 +3677,34 @@ all pending output has been dealt with.")) ;; if the line above point wraps around, add a ?\n to undo the wrapping. ;; FIXME: Probably should be called more than it is. (defun term-unwrap-line () - (if (not (bolp)) (insert-before-markers ?\n))) + (when (not (bolp)) (insert-before-markers ?\n))) (defun term-erase-in-line (kind) - (if (= kind 1) ;; erase left of point - (let ((cols (term-horizontal-column)) (saved-point (point))) - (term-vertical-motion 0) - (delete-region (point) saved-point) - (term-insert-char ? cols))) - (if (not (eq kind 1)) ;; erase right of point - (let ((saved-point (point)) - (wrapped (and (zerop (term-horizontal-column)) - (not (zerop (term-current-column)))))) - (term-vertical-motion 1) - (delete-region saved-point (point)) - ;; wrapped is true if we're at the beginning of screen line, - ;; but not a buffer line. If we delete the current screen line - ;; that will make the previous line no longer wrap, and (because - ;; of the way Emacs display works) point will be at the end of - ;; the previous screen line rather then the beginning of the - ;; current one. To avoid that, we make sure that current line - ;; contain a space, to force the previous line to continue to wrap. - ;; We could do this always, but it seems preferable to not add the - ;; extra space when wrapped is false. - (if wrapped - (insert ? )) - (insert ?\n) - (put-text-property saved-point (point) 'face 'default) - (goto-char saved-point)))) + (when (= kind 1) ;; erase left of point + (let ((cols (term-horizontal-column)) (saved-point (point))) + (term-vertical-motion 0) + (delete-region (point) saved-point) + (term-insert-char ? cols))) + (when (not (eq kind 1)) ;; erase right of point + (let ((saved-point (point)) + (wrapped (and (zerop (term-horizontal-column)) + (not (zerop (term-current-column)))))) + (term-vertical-motion 1) + (delete-region saved-point (point)) + ;; wrapped is true if we're at the beginning of screen line, + ;; but not a buffer line. If we delete the current screen line + ;; that will make the previous line no longer wrap, and (because + ;; of the way Emacs display works) point will be at the end of + ;; the previous screen line rather then the beginning of the + ;; current one. To avoid that, we make sure that current line + ;; contain a space, to force the previous line to continue to wrap. + ;; We could do this always, but it seems preferable to not add the + ;; extra space when wrapped is false. + (when wrapped + (insert ? )) + (insert ?\n) + (put-text-property saved-point (point) 'face 'default) + (goto-char saved-point)))) (defun term-erase-in-display (kind) "Erases (that is blanks out) part of the window. @@ -3932,8 +3910,8 @@ inside of a \"[...]\" (see `skip-chars-forward')." (let ((limit (point)) (word (concat "[" word-chars "]")) (non-word (concat "[^" word-chars "]"))) - (if (re-search-backward non-word nil 'move) - (forward-char 1)) + (when (re-search-backward non-word nil 'move) + (forward-char 1)) ;; Anchor the search forwards. (if (or (eolp) (looking-at non-word)) nil @@ -3974,10 +3952,10 @@ completions listing is dependent on the value of `term-completion-autolist'. Returns t if successful." (interactive) - (if (term-match-partial-filename) - (prog2 (or (eq (selected-window) (minibuffer-window)) - (message "Completing file name...")) - (term-dynamic-complete-as-filename)))) + (when (term-match-partial-filename) + (prog2 (or (eq (selected-window) (minibuffer-window)) + (message "Completing file name...")) + (term-dynamic-complete-as-filename)))) (defun term-dynamic-complete-as-filename () "Dynamically complete at point as a filename. @@ -4001,7 +3979,7 @@ See `term-dynamic-complete-filename'. Returns t if successful." (message "No completions of %s" filename) (setq success nil)) ((eq completion t) ; Means already completed "file". - (if term-completion-addsuffix (insert " ")) + (when term-completion-addsuffix (insert " ")) (or mini-flag (message "Sole completion"))) ((string-equal completion "") ; Means completion on "directory/". (term-dynamic-list-filename-completions)) @@ -4066,7 +4044,7 @@ See also `term-dynamic-complete-filename'." (message "Sole completion") (insert (substring completion (length stub))) (message "Completed")) - (if term-completion-addsuffix (insert " ")) + (when term-completion-addsuffix (insert " ")) 'sole)) (t ; There's no unique completion. (let ((completion (try-completion stub candidates))) diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el index b40e021d42d..b5dc01ff9bf 100644 --- a/lisp/term/mac-win.el +++ b/lisp/term/mac-win.el @@ -84,6 +84,7 @@ (defvar mac-apple-event-map) (defvar mac-atsu-font-table) (defvar mac-font-panel-mode) +(defvar mac-ts-active-input-overlay) (defvar x-invocation-args) (defvar x-command-line-resources nil) @@ -1620,6 +1621,15 @@ in `selection-converter-alist', which see." (mac-coerce-ae-data (car type-data) (cdr type-data) type)) (cdr desc))))))) +(defun mac-ae-number (ae keyword) + (let ((type-data (mac-ae-parameter ae keyword)) + str) + (if (and type-data + (setq str (mac-coerce-ae-data (car type-data) + (cdr type-data) "TEXT"))) + (string-to-number str) + nil))) + (defun mac-bytes-to-integer (bytes &optional from to) (or from (setq from 0)) (or to (setq to (length bytes))) @@ -1635,17 +1645,6 @@ in `selection-converter-alist', which see." (ash (lsh result extended-sign-len) (- extended-sign-len)) result))) -(defun mac-bytes-to-digits (bytes &optional from to) - (or from (setq from 0)) - (or to (setq to (length bytes))) - (let ((len (- to from)) - (val 0.0)) - (dotimes (i len) - (setq val (+ (* val 256.0) - (aref bytes (+ from (if (eq (byteorder) ?B) i - (- len i 1))))))) - (format "%.0f" val))) - (defun mac-ae-selection-range (ae) ;; #pragma options align=mac68k ;; typedef struct SelectionRange { @@ -1671,13 +1670,75 @@ in `selection-converter-alist', which see." (and utf8-text (decode-coding-string utf8-text 'utf-8)))) +(defun mac-ae-text (ae) + (or (cdr (mac-ae-parameter ae nil "TEXT")) + (error "No text in Apple event."))) + +(defun mac-ae-frame (ae &optional keyword type) + (let ((bytes (cdr (mac-ae-parameter ae keyword type)))) + (if (or (null bytes) (/= (length bytes) 4)) + (error "No window reference in Apple event.") + (let ((window-id (mac-coerce-ae-data "long" bytes "TEXT")) + (rest (frame-list)) + frame) + (while (and (null frame) rest) + (if (string= (frame-parameter (car rest) 'window-id) window-id) + (setq frame (car rest))) + (setq rest (cdr rest))) + frame)))) + +(defun mac-ae-script-language (ae keyword) +;; struct WritingCode { +;; ScriptCode theScriptCode; +;; LangCode theLangCode; +;; }; + (let ((bytes (cdr (mac-ae-parameter ae keyword "intl")))) + (and bytes + (cons (mac-bytes-to-integer bytes 0 2) + (mac-bytes-to-integer bytes 2 4))))) + +(defun mac-bytes-to-text-range (bytes &optional from to) +;; struct TextRange { +;; long fStart; +;; long fEnd; +;; short fHiliteStyle; +;; }; + (or from (setq from 0)) + (or to (setq to (length bytes))) + (and (= (- to from) (+ 4 4 2)) + (list (mac-bytes-to-integer bytes from (+ from 4)) + (mac-bytes-to-integer bytes (+ from 4) (+ from 8)) + (mac-bytes-to-integer bytes (+ from 8) to)))) + +(defun mac-ae-text-range-array (ae keyword) +;; struct TextRangeArray { +;; short fNumOfRanges; +;; TextRange fRange[1]; +;; }; + (let* ((bytes (cdr (mac-ae-parameter ae keyword "tray"))) + (len (length bytes)) + nranges result) + (when (and bytes (>= len 2) + (progn + (setq nranges (mac-bytes-to-integer bytes 0 2)) + (= len (+ 2 (* nranges 10))))) + (setq result (make-vector nranges nil)) + (dotimes (i nranges) + (aset result i + (mac-bytes-to-text-range bytes (+ (* i 10) 2) + (+ (* i 10) 12))))) + result)) + (defun mac-ae-open-documents (event) "Open the documents specified by the Apple event EVENT." (interactive "e") (let ((ae (mac-event-ae event))) (dolist (file-name (mac-ae-list ae nil 'undecoded-file-name)) (if file-name - (dnd-open-local-file (concat "file:" file-name) nil))) + (dnd-open-local-file + (concat "file://" + (mapconcat 'url-hexify-string + (split-string file-name "/") "/")) nil))) (let ((selection-range (mac-ae-selection-range ae)) (search-text (mac-ae-text-for-search ae))) (cond (selection-range @@ -1695,10 +1756,6 @@ in `selection-converter-alist', which see." nil t))))) (select-frame-set-input-focus (selected-frame))) -(defun mac-ae-text (ae) - (or (cdr (mac-ae-parameter ae nil "TEXT")) - (error "No text in Apple event."))) - (defun mac-ae-get-url (event) "Open the URL specified by the Apple event EVENT. Currently the `mailto' scheme is supported." @@ -1707,7 +1764,7 @@ Currently the `mailto' scheme is supported." (parsed-url (url-generic-parse-url (mac-ae-text ae)))) (if (string= (url-type parsed-url) "mailto") (url-mailto parsed-url) - (error "Unsupported URL scheme: %s" (url-type parsed-url))))) + (mac-resume-apple-event ae t)))) (setq mac-apple-event-map (make-sparse-keymap)) @@ -1743,13 +1800,7 @@ modifiers, it changes global tool-bar visibility setting." (if (and modifiers (not (string= modifiers "\000\000\000\000"))) ;; Globally toggle tool-bar-mode if some modifier key is pressed. (tool-bar-mode) - (let ((window-id (mac-bytes-to-digits (cdr (mac-ae-parameter ae)))) - (rest (frame-list)) - frame) - (while (and (null frame) rest) - (if (string= (frame-parameter (car rest) 'window-id) window-id) - (setq frame (car rest))) - (setq rest (cdr rest))) + (let ((frame (mac-ae-frame ae))) (set-frame-parameter frame 'tool-bar-lines (if (= (frame-parameter frame 'tool-bar-lines) 0) 1 0)))))) @@ -1779,13 +1830,12 @@ With numeric ARG, display the font panel if and only if ARG is positive." "Change default face attributes according to font selection EVENT." (interactive "e") (let* ((ae (mac-event-ae event)) - (fm-font-size (cdr (mac-ae-parameter ae "fmsz"))) + (fm-font-size (mac-ae-number ae "fmsz")) (atsu-font-id (cdr (mac-ae-parameter ae "auid"))) (attribute-values (gethash atsu-font-id mac-atsu-font-table))) (if fm-font-size (setq attribute-values - `(:height ,(* 10 (mac-bytes-to-integer fm-font-size)) - ,@attribute-values))) + `(:height ,(* 10 fm-font-size) ,@attribute-values))) (apply 'set-face-attribute 'default (selected-frame) attribute-values))) ;; kEventClassFont/kEventFontPanelClosed @@ -1802,6 +1852,258 @@ With numeric ARG, display the font panel if and only if ARG is positive." ) ;; (fboundp 'mac-set-font-panel-visibility) +;;; Text Services +(defvar mac-ts-active-input-buf "" + "Byte sequence of the current Mac TSM active input area.") +(defvar mac-ts-update-active-input-area-seqno 0 + "Number of processed update-active-input-area events.") +(setq mac-ts-active-input-overlay (make-overlay 0 0)) + +(defface mac-ts-caret-position + '((t :inverse-video t)) + "Face for caret position in Mac TSM active input area. +This is used only when the active input area is displayed in the +echo area." + :group 'mac) + +(defface mac-ts-raw-text + '((t :underline t)) + "Face for raw text in Mac TSM active input area." + :group 'mac) + +(defface mac-ts-selected-raw-text + '((t :underline t)) + "Face for selected raw text in Mac TSM active input area." + :group 'mac) + +(defface mac-ts-converted-text + '((((background dark)) :underline "gray20") + (t :underline "gray80")) + "Face for converted text in Mac TSM active input area." + :group 'mac) + +(defface mac-ts-selected-converted-text + '((t :underline t)) + "Face for selected converted text in Mac TSM active input area." + :group 'mac) + +(defface mac-ts-block-fill-text + '((t :underline t)) + "Face for block fill text in Mac TSM active input area." + :group 'mac) + +(defface mac-ts-outline-text + '((t :underline t)) + "Face for outline text in Mac TSM active input area." + :group 'mac) + +(defface mac-ts-selected-text + '((t :underline t)) + "Face for selected text in Mac TSM active input area." + :group 'mac) + +(defface mac-ts-no-hilite + '((t :inherit default)) + "Face for no hilite in Mac TSM active input area." + :group 'mac) + +(defconst mac-ts-hilite-style-faces + '((2 . mac-ts-raw-text) ; kTSMHiliteRawText + (3 . mac-ts-selected-raw-text) ; kTSMHiliteSelectedRawText + (4 . mac-ts-converted-text) ; kTSMHiliteConvertedText + (5 . mac-ts-selected-converted-text) ; kTSMHiliteSelectedConvertedText + (6 . mac-ts-block-fill-text) ; kTSMHiliteBlockFillText + (7 . mac-ts-outline-text) ; kTSMHiliteOutlineText + (8 . mac-ts-selected-text) ; kTSMHiliteSelectedText + (9 . mac-ts-no-hilite)) ; kTSMHiliteNoHilite + "Alist of Mac TSM hilite style vs Emacs face.") + +(defun mac-ts-update-active-input-buf (text fix-len hilite-rng update-rng) + (let ((buf-len (length mac-ts-active-input-buf)) + confirmed) + (if (or (null update-rng) + (/= (% (length update-rng) 2) 0)) + ;; The parameter is missing (or in a bad format). The + ;; existing inline input session is completely replaced with + ;; the new text. + (setq mac-ts-active-input-buf text) + ;; Otherwise, the current subtext specified by the (2*j)-th + ;; range is replaced with the new subtext specified by the + ;; (2*j+1)-th range. + (let ((tail buf-len) + (i (length update-rng)) + segments rng) + (while (> i 0) + (setq i (- i 2)) + (setq rng (aref update-rng i)) + (if (and (<= 0 (cadr rng)) (< (cadr rng) tail) + (<= tail buf-len)) + (setq segments + (cons (substring mac-ts-active-input-buf (cadr rng) tail) + segments))) + (setq tail (car rng)) + (setq rng (aref update-rng (1+ i))) + (if (and (<= 0 (car rng)) (< (car rng) (cadr rng)) + (<= (cadr rng) (length text))) + (setq segments + (cons (substring text (car rng) (cadr rng)) + segments)))) + (if (and (< 0 tail) (<= tail buf-len)) + (setq segments + (cons (substring mac-ts-active-input-buf 0 tail) + segments))) + (setq mac-ts-active-input-buf (apply 'concat segments)))) + (setq buf-len (length mac-ts-active-input-buf)) + ;; Confirm (a part of) inline input session. + (cond ((< fix-len 0) + ;; Entire inline session is being confirmed. + (setq confirmed mac-ts-active-input-buf) + (setq mac-ts-active-input-buf "")) + ((= fix-len 0) + ;; None of the text is being confirmed (yet). + (setq confirmed "")) + (t + (if (> fix-len buf-len) + (setq fix-len buf-len)) + (setq confirmed (substring mac-ts-active-input-buf 0 fix-len)) + (setq mac-ts-active-input-buf + (substring mac-ts-active-input-buf fix-len)))) + (setq buf-len (length mac-ts-active-input-buf)) + ;; Update highlighting and the caret position in the new inline + ;; input session. + (remove-text-properties 0 buf-len '(cursor nil) mac-ts-active-input-buf) + (mapc (lambda (rng) + (cond ((and (= (nth 2 rng) 1) ; kTSMHiliteCaretPosition + (<= 0 (car rng)) (< (car rng) buf-len)) + (put-text-property (car rng) buf-len + 'cursor t mac-ts-active-input-buf)) + ((and (<= 0 (car rng)) (< (car rng) (cadr rng)) + (<= (cadr rng) buf-len)) + (put-text-property (car rng) (cadr rng) 'face + (cdr (assq (nth 2 rng) + mac-ts-hilite-style-faces)) + mac-ts-active-input-buf)))) + hilite-rng) + confirmed)) + +(defun mac-split-string-by-property-change (string) + (let ((tail (length string)) + head result) + (unless (= tail 0) + (while (setq head (previous-property-change tail string) + result (cons (substring string (or head 0) tail) result) + tail head))) + result)) + +(defun mac-replace-untranslated-utf-8-chars (string &optional to-string) + (or to-string (setq to-string "$,3u=(B")) + (mapconcat + (lambda (str) + (if (get-text-property 0 'untranslated-utf-8 str) to-string str)) + (mac-split-string-by-property-change string) + "")) + +(defun mac-ts-update-active-input-area (event) + "Update Mac TSM active input area according to EVENT. +The confirmed text is converted to Emacs input events and pushed +into `unread-command-events'. The unconfirmed text is displayed +either in the current buffer or in the echo area." + (interactive "e") + (let* ((ae (mac-event-ae event)) + (text (or (cdr (mac-ae-parameter ae "tstx" "utxt")) "")) + (script-language (mac-ae-script-language ae "tssl")) + (coding (or (cdr (assq (car script-language) + mac-script-code-coding-systems)) + 'mac-roman)) + (fix-len (mac-bytes-to-integer + (cdr (mac-ae-parameter ae "tsfx" "long")))) + ;; Optional parameters + (hilite-rng (mac-ae-text-range-array ae "tshi")) + (update-rng (mac-ae-text-range-array ae "tsup")) + ;;(pin-rng (mac-bytes-to-text-range (cdr (mac-ae-parameter ae "tspn" "txrn")))) + ;;(clause-offsets (cdr (mac-ae-parameter ae "tscl" "ofay"))) + (seqno (mac-ae-number ae "tsSn")) + confirmed) + (unless (= seqno mac-ts-update-active-input-area-seqno) + ;; Reset internal states if sequence number is out of sync. + (setq mac-ts-active-input-buf "")) + (setq confirmed + (mac-ts-update-active-input-buf text fix-len hilite-rng update-rng)) + (let ((use-echo-area + (or isearch-mode + (and cursor-in-echo-area (current-message)) + ;; Overlay strings are not shown in some cases. + (get-char-property (point) 'display) + (get-char-property (point) 'invisible) + (get-char-property (point) 'composition))) + active-input-string caret-seen) + ;; Decode the active input area text with inheriting faces and + ;; the caret position. + (setq active-input-string + (mapconcat + (lambda (str) + (let ((decoded (mac-utxt-to-string str coding))) + (put-text-property 0 (length decoded) 'face + (get-text-property 0 'face str) decoded) + (when (and (not caret-seen) + (get-text-property 0 'cursor str)) + (setq caret-seen t) + (if use-echo-area + (put-text-property 0 1 'face 'mac-ts-caret-position + decoded) + (put-text-property 0 1 'cursor t decoded))) + decoded)) + (mac-split-string-by-property-change mac-ts-active-input-buf) + "")) + (put-text-property 0 (length active-input-string) + 'mac-ts-active-input-string t active-input-string) + (if use-echo-area + (let (msg message-log-max) + (if (and (current-message) + ;; Don't get confused by previously displayed + ;; `active-input-string'. + (null (get-text-property 0 'mac-ts-active-input-string + (current-message)))) + (setq msg (propertize (current-message) 'display + (concat (current-message) + active-input-string))) + (setq msg active-input-string)) + (message "%s" msg) + (overlay-put mac-ts-active-input-overlay 'before-string nil)) + (move-overlay mac-ts-active-input-overlay + (point) (point) (current-buffer)) + (overlay-put mac-ts-active-input-overlay 'before-string + active-input-string)) + ;; Unread confirmed characters and insert them in a keyboard + ;; macro being defined. + (apply 'isearch-unread + (append (mac-replace-untranslated-utf-8-chars + (mac-utxt-to-string confirmed coding)) '()))) + ;; The event is successfully processed. Sync the sequence number. + (setq mac-ts-update-active-input-area-seqno (1+ seqno)))) + +(defun mac-ts-unicode-for-key-event (event) + "Convert Unicode key EVENT to Emacs key events and unread them." + (interactive "e") + (let* ((ae (mac-event-ae event)) + (text (cdr (mac-ae-parameter ae "tstx" "utxt"))) + (script-language (mac-ae-script-language ae "tssl")) + (coding (or (cdr (assq (car script-language) + mac-script-code-coding-systems)) + 'mac-roman))) + ;; Unread characters and insert them in a keyboard macro being + ;; defined. + (apply 'isearch-unread + (append (mac-replace-untranslated-utf-8-chars + (mac-utxt-to-string text coding)) '())))) + +;; kEventClassTextInput/kEventTextInputUpdateActiveInputArea +(define-key mac-apple-event-map [text-input update-active-input-area] + 'mac-ts-update-active-input-area) +;; kEventClassTextInput/kEventTextInputUnicodeForKeyEvent +(define-key mac-apple-event-map [text-input unicode-for-key-event] + 'mac-ts-unicode-for-key-event) + ;;; Services (defun mac-service-open-file () "Open the file specified by the selection value for Services." @@ -1857,9 +2159,9 @@ With numeric ARG, display the font panel if and only if ARG is positive." "Dispatch EVENT according to the keymap `mac-apple-event-map'." (interactive "e") (let* ((binding (lookup-key mac-apple-event-map (mac-event-spec event))) - (service-message - (and (keymapp binding) - (cdr (mac-ae-parameter (mac-event-ae event) "svmg"))))) + (ae (mac-event-ae event)) + (service-message (and (keymapp binding) + (cdr (mac-ae-parameter ae "svmg"))))) (when service-message (setq service-message (intern (decode-coding-string service-message 'utf-8))) @@ -1867,9 +2169,18 @@ With numeric ARG, display the font panel if and only if ARG is positive." ;; Replace (cadr event) with a dummy position so that event-start ;; returns it. (setcar (cdr event) (list (selected-window) (point) '(0 . 0) 0)) - (call-interactively binding))) + (if (null (mac-ae-parameter ae 'emacs-suspension-id)) + (command-execute binding nil (vector event) t) + (condition-case err + (progn + (command-execute binding nil (vector event) t) + (mac-resume-apple-event ae)) + (error + (mac-ae-set-reply-parameter ae "errs" + (cons "TEXT" (error-message-string err))) + (mac-resume-apple-event ae -10000)))))) ; errAEEventFailed -(global-set-key [mac-apple-event] 'mac-dispatch-apple-event) +(define-key special-event-map [mac-apple-event] 'mac-dispatch-apple-event) ;; Processing of Apple events are deferred at the startup time. For ;; example, files dropped onto the Emacs application icon can only be @@ -1877,6 +2188,8 @@ With numeric ARG, display the font panel if and only if ARG is positive." ;; the files should be opened. (add-hook 'after-init-hook 'mac-process-deferred-apple-events) +(run-with-idle-timer 5 t 'mac-cleanup-expired-apple-events) + ;;;; Drag and drop diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 6061c3eb0dc..f3c32011349 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -112,6 +112,14 @@ Switch to a buffer editing the last file dropped." (if (and (> x 0) (> y 0)) (set-frame-selected-window nil window)) (mapcar (lambda (file-name) + (let ((f (subst-char-in-string ?\\ ?/ file-name)) + (coding (or file-name-coding-system + default-file-name-coding-system))) + (setq file-name + (mapconcat 'url-hexify-string + (split-string (encode-coding-string f coding) + "/") + "/"))) (dnd-handle-one-url window 'private (concat "file:" file-name))) (car (cdr (cdr event))))) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 5bc93b47fe9..c6b3c4d1ba3 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -2495,5 +2495,9 @@ order until succeed.") (add-hook 'after-make-frame-functions 'x-dnd-init-frame) (global-set-key [drag-n-drop] 'x-dnd-handle-drag-n-drop-event) +;; Let F10 do menu bar navigation. +(and (fboundp 'menu-bar-open) + (global-set-key [f10] 'menu-bar-open)) + ;; arch-tag: f1501302-db8b-4d95-88e3-116697d89f78 ;;; x-win.el ends here diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index 9305bdbf9bc..d5dcdd0d9ef 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -365,10 +365,11 @@ Example: "*If in X Windows, use this pointer shape while drawing with the mouse.") -(defcustom artist-text-renderer 'artist-figlet +(defcustom artist-text-renderer-function 'artist-figlet "Function for doing text rendering." :group 'artist-text :type 'symbol) +(defvaralias 'artist-text-renderer 'artist-text-renderer-function) (defcustom artist-figlet-program "figlet" @@ -2910,23 +2911,25 @@ Let blanks in TEXT overwrite any text already in the buffer." (defun artist-text-see-thru (x y) "Prompt for text to render, render it at X,Y. -This is done by calling the function specified by `artist-text-renderer', -which must return a list of strings, to be inserted in the buffer. +This is done by calling the function specified by +`artist-text-renderer-function', which must return a list of strings, +to be inserted in the buffer. Text already in the buffer ``shines thru'' blanks in the rendered text." (let* ((input-text (read-string "Type text to render: ")) - (rendered-text (artist-funcall artist-text-renderer input-text))) + (rendered-text (artist-funcall artist-text-renderer-function input-text))) (artist-text-insert-see-thru x y rendered-text))) (defun artist-text-overwrite (x y) "Prompt for text to render, render it at X,Y. -This is done by calling the function specified by `artist-text-renderer', -which must return a list of strings, to be inserted in the buffer. +This is done by calling the function specified by +`artist-text-renderer-function', which must return a list of strings, +to be inserted in the buffer. Blanks in the rendered text overwrites any text in the buffer." (let* ((input-text (read-string "Type text to render: ")) - (rendered-text (artist-funcall artist-text-renderer input-text))) + (rendered-text (artist-funcall artist-text-renderer-function input-text))) (artist-text-insert-overwrite x y rendered-text))) ;; diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index e4f0a3db545..c82f2dcf3d0 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -87,7 +87,7 @@ If this is a function, call it to generate the initial field text." :type '(choice (const :tag "None" nil) (string :tag "Initial text") (function :tag "Initialize Function" :value fun) - (other :tag "Default" t))) + (const :tag "Default" t))) (put 'bibtex-include-OPTkey 'risky-local-variable t) (defcustom bibtex-user-optional-fields @@ -153,7 +153,7 @@ narrowed to just the entry." (defcustom bibtex-maintain-sorted-entries nil "If non-nil, BibTeX mode maintains all entries in sorted order. Allowed non-nil values are: -plain All entries are sorted alphabetically. +plain or t All entries are sorted alphabetically. crossref All entries are sorted alphabetically unless an entry has a crossref field. These crossrefed entries are placed in alphabetical order immediately preceding the main entry. @@ -165,7 +165,10 @@ See also `bibtex-sort-ignore-string-entries'." :type '(choice (const nil) (const plain) (const crossref) - (const entry-class))) + (const entry-class) + (const t))) +(put 'bibtex-maintain-sorted-entries 'safe-local-variable + '(lambda (a) (memq a '(nil t plain crossref entry-class)))) (defcustom bibtex-sort-entry-class '(("String") @@ -180,6 +183,17 @@ to all entries not explicitly mentioned." :type '(repeat (choice :tag "Class" (const :tag "catch-all" (catch-all)) (repeat :tag "Entry name" string)))) +(put 'bibtex-sort-entry-class 'safe-local-variable + (lambda (x) (let ((OK t)) + (while (consp x) + (let ((y (pop x))) + (while (consp y) + (let ((z (pop y))) + (unless (or (stringp z) (eq z 'catch-all)) + (setq OK nil)))) + (unless (null y) (setq OK nil)))) + (unless (null x) (setq OK nil)) + OK))) (defcustom bibtex-sort-ignore-string-entries t "If non-nil, BibTeX @String entries are not sort-significant. @@ -607,6 +621,8 @@ See `bibtex-generate-autokey' for details." (const :tag "Capitalize" capitalize) (const :tag "Upcase" upcase) (function :tag "Conversion function"))) +(put 'bibtex-autokey-name-case-convert-function 'safe-local-variable + (lambda (x) (memq x '(upcase downcase capitalize identity)))) (defvaralias 'bibtex-autokey-name-case-convert 'bibtex-autokey-name-case-convert-function) @@ -1185,13 +1201,7 @@ The CDRs of the elements are t for header keys and nil for crossref keys.") (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) - (dolist (class bibtex-sort-entry-class alist) - (setq i (1+ i)) - (dolist (entry class) - ;; all entry names should be downcase (for ease of comparison) - (push (cons (if (stringp entry) (downcase entry) entry) i) alist)))) +(defvar bibtex-sort-entry-class-alist nil "Alist mapping entry types to their sorting index. Auto-generated from `bibtex-sort-entry-class'. Used when `bibtex-maintain-sorted-entries' is `entry-class'.") @@ -1800,7 +1810,8 @@ Formats current entry according to variable `bibtex-entry-format'." ;; identify entry type (goto-char (point-min)) - (re-search-forward bibtex-entry-type) + (or (re-search-forward bibtex-entry-type nil t) + (error "Not inside a BibTeX entry")) (let ((beg-type (1+ (match-beginning 0))) (end-type (match-end 0))) (setq entry-list (assoc-string (buffer-substring-no-properties @@ -3184,6 +3195,17 @@ of the head of the entry found. Return nil if no entry found." entry-name)) (list key nil entry-name)))))) +(defun bibtex-init-sort-entry-class-alist () + (unless (local-variable-p 'bibtex-sort-entry-class-alist) + (set (make-local-variable 'bibtex-sort-entry-class-alist) + (let ((i -1) alist) + (dolist (class bibtex-sort-entry-class alist) + (setq i (1+ i)) + (dolist (entry class) + ;; All entry names should be downcase (for ease of comparison). + (push (cons (if (stringp entry) (downcase entry) entry) i) + alist))))))) + (defun bibtex-lessp (index1 index2) "Predicate for sorting BibTeX entries with indices INDEX1 and INDEX2. Each index is a list (KEY CROSSREF-KEY ENTRY-NAME). @@ -3221,13 +3243,14 @@ 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) - (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-beginning-of-first-entry) ; Needed by `sort-subr' + (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'. + (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 (defun bibtex-find-crossref (crossref-key &optional pnt split) "Move point to the beginning of BibTeX entry CROSSREF-KEY. @@ -3328,6 +3351,7 @@ If `bibtex-maintain-sorted-entries' is non-nil, perform a binary search to look for place for KEY. This requires that buffer is sorted, see `bibtex-validate'. Return t if preparation was successful or nil if entry KEY already exists." + (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'. (let ((key (nth 0 index)) key-exist) (cond ((or (null key) @@ -3876,7 +3900,8 @@ At end of the cleaning process, the functions in (interactive "P") (let ((case-fold-search t) (start (bibtex-beginning-of-entry)) - (_ (looking-at bibtex-any-entry-maybe-empty-head)) + (_ (or (looking-at bibtex-any-entry-maybe-empty-head) + (error "Not inside a BibTeX entry"))) (entry-type (bibtex-type-in-head)) (key (bibtex-key-in-head))) ;; formatting diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 54b67a258a6..23f4756f4a7 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -271,21 +271,23 @@ If `flyspell-large-region' is nil, all regions are treated as small." ;;* using flyspell with mail-mode add the following expression */ ;;* in your .emacs file: */ ;;* (add-hook 'mail-mode */ -;;* '(lambda () (setq flyspell-generic-check-word-p */ -;;* 'mail-mode-flyspell-verify))) */ +;;* '(lambda () (setq flyspell-generic-check-word-predicate */ +;;* 'mail-mode-flyspell-verify))) */ ;;*---------------------------------------------------------------------*/ -(defvar flyspell-generic-check-word-p nil +(defvar flyspell-generic-check-word-predicate nil "Function providing per-mode customization over which words are flyspelled. Returns t to continue checking, nil otherwise. Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate' property of the major mode name.") -(make-variable-buffer-local 'flyspell-generic-check-word-p) +(make-variable-buffer-local 'flyspell-generic-check-word-predicate) +(defvaralias 'flyspell-generic-check-word-p + 'flyspell-generic-check-word-predicate) ;;*--- mail mode -------------------------------------------------------*/ (put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) (put 'message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) (defun mail-mode-flyspell-verify () - "This function is used for `flyspell-generic-check-word-p' in Mail mode." + "Function used for `flyspell-generic-check-word-predicate' in Mail mode." (let ((header-end (save-excursion (goto-char (point-min)) (re-search-forward @@ -313,7 +315,7 @@ property of the major mode name.") ;;*--- texinfo mode ----------------------------------------------------*/ (put 'texinfo-mode 'flyspell-mode-predicate 'texinfo-mode-flyspell-verify) (defun texinfo-mode-flyspell-verify () - "This function is used for `flyspell-generic-check-word-p' in Texinfo mode." + "Function used for `flyspell-generic-check-word-predicate' in Texinfo mode." (save-excursion (forward-word -1) (not (looking-at "@")))) @@ -321,7 +323,7 @@ property of the major mode name.") ;;*--- tex mode --------------------------------------------------------*/ (put 'tex-mode 'flyspell-mode-predicate 'tex-mode-flyspell-verify) (defun tex-mode-flyspell-verify () - "This function is used for `flyspell-generic-check-word-p' in LaTeX mode." + "Function used for `flyspell-generic-check-word-predicate' in LaTeX mode." (and (not (save-excursion (re-search-backward "^[ \t]*%%%[ \t]+Local" nil t))) @@ -338,7 +340,7 @@ property of the major mode name.") (put 'html-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify) (defun sgml-mode-flyspell-verify () - "This function is used for `flyspell-generic-check-word-p' in SGML mode." + "Function used for `flyspell-generic-check-word-predicate' in SGML mode." (not (save-excursion (let ((this (point-marker)) (s (progn (beginning-of-line) (point-marker))) @@ -368,7 +370,7 @@ property of the major mode name.") "Faces corresponding to text in programming-mode buffers.") (defun flyspell-generic-progmode-verify () - "Used for `flyspell-generic-check-word-p' in programming modes." + "Used for `flyspell-generic-check-word-predicate' in programming modes." (let ((f (get-text-property (point) 'face))) (memq f flyspell-prog-text-faces))) @@ -376,7 +378,8 @@ property of the major mode name.") (defun flyspell-prog-mode () "Turn on `flyspell-mode' for comments and strings." (interactive) - (setq flyspell-generic-check-word-p 'flyspell-generic-progmode-verify) + (setq flyspell-generic-check-word-predicate + 'flyspell-generic-progmode-verify) (flyspell-mode 1) (run-hooks 'flyspell-prog-mode-hook)) @@ -483,6 +486,18 @@ in your .emacs file. (flyspell-mode-on) (flyspell-mode-off))) +;;;###autoload +(defun turn-on-flyspell () + "Unconditionally turn on Flyspell mode." + (flyspell-mode 1)) + +;;;###autoload +(defun turn-off-flyspell () + "Unconditionally turn off Flyspell mode." + (flyspell-mode -1)) + +(custom-add-option 'text-mode-hook 'turn-on-flyspell) + ;;*---------------------------------------------------------------------*/ ;;* flyspell-buffers ... */ ;;* ------------------------------------------------------------- */ @@ -563,10 +578,10 @@ in your .emacs file. (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t) ;; we bound flyspell action to after-change hook (add-hook 'after-change-functions 'flyspell-after-change-function nil t) - ;; set flyspell-generic-check-word-p based on the major mode + ;; set flyspell-generic-check-word-predicate based on the major mode (let ((mode-predicate (get major-mode 'flyspell-mode-predicate))) (if mode-predicate - (setq flyspell-generic-check-word-p mode-predicate))) + (setq flyspell-generic-check-word-predicate mode-predicate))) ;; the welcome message (if (and flyspell-issue-message-flag flyspell-issue-welcome-flag @@ -979,8 +994,8 @@ Mostly we check word delimiters." (flyspell-word (flyspell-get-word following)) start end poss word) (if (or (eq flyspell-word nil) - (and (fboundp flyspell-generic-check-word-p) - (not (funcall flyspell-generic-check-word-p)))) + (and (fboundp flyspell-generic-check-word-predicate) + (not (funcall flyspell-generic-check-word-predicate)))) t (progn ;; destructure return flyspell-word info list. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 5629e8feb31..00a757d68bd 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -416,11 +416,12 @@ The following values are supported: :type 'boolean :group 'ispell) -(defcustom ispell-format-word (function upcase) +(defcustom ispell-format-word-function (function upcase) "*Formatting function for displaying word being spell checked. The function must take one string argument and return a string." :type 'function :group 'ispell) +(defvaralias 'ispell-format-word 'ispell-format-word-function) (defcustom ispell-use-framepop-p nil "When non-nil ispell uses framepop to display choices in a dedicated frame. @@ -1565,7 +1566,7 @@ quit spell session exited." ;; But that is silly; if the user asks for it, we should do it. - rms. (or quietly (message "Checking spelling of %s..." - (funcall ispell-format-word word))) + (funcall ispell-format-word-function word))) (ispell-send-string "%\n") ; put in verbose mode (ispell-send-string (concat "^" word "\n")) ;; wait until ispell has processed word @@ -1581,7 +1582,7 @@ quit spell session exited." (cond ((eq poss t) (or quietly (message "%s is correct" - (funcall ispell-format-word word))) + (funcall ispell-format-word-function word))) (and (fboundp 'extent-at) (extent-at start) (and (fboundp 'delete-extent) @@ -1589,8 +1590,8 @@ quit spell session exited." ((stringp poss) (or quietly (message "%s is correct because of root %s" - (funcall ispell-format-word word) - (funcall ispell-format-word poss))) + (funcall ispell-format-word-function word) + (funcall ispell-format-word-function poss))) (and (fboundp 'extent-at) (extent-at start) (and (fboundp 'delete-extent) @@ -1603,7 +1604,8 @@ quit spell session exited." (set-extent-property ext 'face ispell-highlight-face) (set-extent-property ext 'priority 2000))) (beep) - (message "%s is incorrect"(funcall ispell-format-word word)))) + (message "%s is incorrect" + (funcall ispell-format-word-function word)))) (t ; prompt for correct word. (save-window-excursion (setq replace (ispell-command-loop @@ -3329,6 +3331,7 @@ Don't read buffer-local settings or word lists." "*End of text which will be checked in `ispell-message'. If it is a string, limit at first occurrence of that regular expression. Otherwise, it must be a function which is called to get the limit.") +(put 'ispell-message-text-end 'risky-local-variable t) (defun ispell-mime-multipartp (&optional limit) diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index ea9aa4448ee..853c28f5565 100644 --- a/lisp/textmodes/org.el +++ b/lisp/textmodes/org.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <dominik at science dot uva dot nl> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ -;; Version: 4.26 +;; Version: 4.36 ;; ;; This file is part of GNU Emacs. ;; @@ -30,16 +30,21 @@ ;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing ;; project planning with a fast and effective plain-text system. ;; -;; Org-mode develops organizational tasks around a NOTES file that contains -;; information about projects as plain text. Org-mode is implemented on top -;; of outline-mode - ideal to keep the content of large files well structured. -;; It supports ToDo items, deadlines and time stamps, which can be extracted -;; to create a daily/weekly agenda that also integrates the diary of the Emacs -;; calendar. Tables are easily created with a built-in table editor. Plain -;; text URL-like links connect to websites, emails (VM, RMAIL, WANDERLUST), -;; Usenet messages (Gnus), BBDB entries, and any files related to the -;; projects. For printing and sharing of notes, an Org-mode file (or a part -;; of it) can be exported as a structured ASCII file, or as HTML. +;; Org-mode develops organizational tasks around NOTES files that contain +;; information about projects as plain text. Org-mode is implemented on +;; top of outline-mode, which makes it possible to keep the content of +;; large files well structured. Visibility cycling and structure editing +;; help to work with the tree. Tables are easily created with a built-in +;; table editor. Org-mode supports ToDo items, deadlines, time stamps, +;; and scheduling. It dynamically compiles entries into an agenda that +;; utilizes and smoothly integrates much of the Emacs calendar and diary. +;; Plain text URL-like links connect to websites, emails, Usenet +;; messages, BBDB entries, and any files related to the projects. For +;; printing and sharing of notes, an Org-mode file can be exported as a +;; structured ASCII file, as HTML, or (todo and agenda items only) as an +;; iCalendar file. It can also serve as a publishing tool for a set of +;; linked webpages. +;; ;; ;; Installation ;; ------------ @@ -52,19 +57,23 @@ ;; (define-key global-map "\C-cl" 'org-store-link) ;; (define-key global-map "\C-ca" 'org-agenda) ;; -;; If you have downloaded Org-mode from the Web, you must byte-compile -;; org.el and put it on your load path. In addition to the Emacs Lisp -;; lines above, you also need to add the following lines to .emacs: +;; Furthermore you need to activate font-lock-mode in org-mode buffers. +;; either of the following two lins will do the trick: +;; +;; (global-font-lock-mode 1) ; for all buffers +;; (add-hook 'org-mode-hook 'turn-on-font-lock) ; org-mode buffers only +;; +;; If you have downloaded Org-mode from the Web, you have to take additional +;; action: Byte-compile org.el and org-publish.el and put them together with +;; org-install.el on your load path. Then also add to your .emacs file: +;; +;; (require 'org-install) ;; -;; (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-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") ;; -;; This setup will put all files with extension ".org" into Org-mode. As -;; an alternative, make the first line of a file look like this: +;; Activation +;; ---------- +;; The setup above will put all files with extension ".org" into Org-mode. +;; As an alternative, make the first line of a file look like this: ;; ;; MY PROJECTS -*- mode: org; -*- ;; @@ -79,48 +88,78 @@ ;; excellent reference card made by Philip Rooke. This card can be found ;; in the etc/ directory of Emacs 22. ;; -;; Changes since version 4.10: -;; --------------------------- -;; Version 4.26 +;; Recent changes +;; -------------- +;; Version 4.36 +;; - Improved indentation of ASCII export, when headlines become items. +;; - Handling of 12am and 12pm fixed. Times beyond 24:00 can be used +;; and will not lead to conflicts. +;; - Support for mutually exclusive TAGS with the fast tags interface. ;; - Bug fixes. ;; -;; Version 4.25 -;; - Revision of the font-lock faces section, with better tty support. -;; - TODO keywords in Agenda buffer are fontified. -;; - Export converts links between .org files to links between .html files. -;; - Better support for bold/italic/underline emphasis. +;; Version 4.35 +;; - HTML export is now valid XHTML. +;; - Timeline can also show dates without entries. See new option +;; `org-timeline-show-empty-dates'. +;; - The bullets created by the ASCII exporter can now be configured. +;; See the new option `org-export-ascii-bullets'. +;; - New face `org-upcoming-deadline' (was `org-scheduled-previously'). +;; - New function `org-context' to allow testing for local context. ;; -;; Version 4.24 +;; Version 4.34 ;; - Bug fixes. ;; -;; Version 4.23 -;; - Bug fixes. +;; Version 4.33 +;; - New commands to move through plain lists: S-up and S-down. +;; - Bug fixes and documentation update. ;; -;; Version 4.22 +;; Version 4.32 +;; - Fast (single-key-per-tag) interface for setting TAGS. +;; - The list of legal tags can be configured globally and locally. +;; - Elisp and Info links (thanks to Todd Neal). +;; - `org-export-publishing-directory' can be an alist, with different +;; directories for different export types. +;; - All context-sensitive commands use `call-interactively' to dispatch. +;; - `org-confirm-shell-links' renamed to `org-confirm-shell-link-function'. ;; - Bug fixes. -;; - In agenda buffer, mouse-1 no longer follows link. -;; See `org-agenda-mouse-1-follows-link' and `org-mouse-1-follows-link'. -;; -;; Version 4.20 -;; - Links use now the [[link][description]] format by default. -;; When inserting links, the user is prompted for a description. -;; - If a link has a description, only the description is displayed -;; the link part is hidden. Use C-c C-l to edit the link part. -;; - TAGS are now bold, but in the same color as the headline. -;; - The width of a table column can be limited by using a field "<N>". -;; - New structure for the customization tree. +;; +;; Version 4.31 ;; - Bug fixes. ;; -;; Version 4.13 -;; - The list of agenda files can be maintainted in an external file. +;; Version 4.30 +;; - Modified installation: Autoloads have been collected in org-install.el. +;; - Logging (org-log-done) is now a #+STARTUP option. +;; - Checkboxes in plain list items, following up on Frank Ruell's idea. +;; - File links inserted with C-c C-l will use relative paths if the linked +;; file is in the current directory or a subdirectory of it. +;; - New variable `org-link-file-path-type' to specify preference for +;; relative and absolute paths. +;; - New CSS classes for tags, timestamps, timestamp keywords. +;; - Bug and typo fixes. +;; +;; Version 4.29 +;; - Inlining images in HTML export now depends on wheather the link +;; contains a description or not. +;; - TODO items can be scheduled from the global TODO list using C-c C-s. +;; - TODO items already scheduled can be made to disappear from the global +;; todo list, see `org-agenda-todo-ignore-scheduled'. +;; - In Tables, formulas may also be Lisp forms. +;; - Exporting the visible part of an outline with `C-c C-x v' works now +;; for all available exporters. +;; - Bug fixes, lots of them :-( +;; +;; Version 4.28 ;; - Bug fixes. ;; -;; Version 4.12 -;; - Templates for remember buffer. Note that the remember setup changes. -;; To set up templates, see `org-remember-templates'. -;; - The time in new time stamps can be rounded, see new option -;; `org-time-stamp-rounding-minutes'. -;; - Bug fixes (there are *always* more bugs). +;; Version 4.27 +;; - HTML exporter generalized to receive external options. +;; As part of the process, author, email and date have been moved to the +;; end of the HTML file. +;; - Support for customizable file search in file links. +;; - BibTeX database links as first application of the above. +;; - New option `org-agenda-todo-list-sublevels' to turn off listing TODO +;; entries that are sublevels of another TODO entry. +;; ;; ;;; Code: @@ -131,13 +170,9 @@ (require 'time-date) (require 'easymenu) -(defvar calc-embedded-close-formula) ; defined by the calc package -(defvar calc-embedded-open-formula) ; defined by the calc package -(defvar font-lock-unfontify-region-function) ; defined by font-lock.el - ;;; Customization variables -(defvar org-version "4.26" +(defvar org-version "4.36" "The version number of the file org.el.") (defun org-version () (interactive) @@ -325,14 +360,30 @@ An entry can be toggled between QUOTE and normal with :tag "Org Cycle" :group 'org-structure) +(defcustom org-cycle-global-at-bob t + "Cycle globally if cursor is at beginning of buffer and not at a headline. +This makes it possible to do global cycling without having to use S-TAB or +C-u TAB. For this special case to work, the first line of the buffer +must not be a headline - it may be empty ot some other text. When used in +this way, `org-cycle-hook' is disables temporarily, to make sure the +cursor stays at the beginning of the buffer. +When this option is nil, don't do anything special at the beginning +of the buffer." + :group 'org-cycle + :type 'boolean) + (defcustom org-cycle-emulate-tab t "Where should `org-cycle' emulate TAB. -nil Never -white Only in completely white lines -t Everywhere except in headlines" +nil Never +white Only in completely white lines +whitestart Only at the beginning of lines, before the first non-white char. +t Everywhere except in headlines +If TAB is used in a place where it does not emulate TAB, the current subtree +visibility is cycled." :group 'org-cycle :type '(choice (const :tag "Never" nil) (const :tag "Only in completely white lines" white) + (const :tag "Before first char in a line" whitestart) (const :tag "Everywhere except in headlines" t) )) @@ -376,6 +427,11 @@ body starts at column 0, indentation is not changed at all." :group 'org-edit-structure :type 'boolean) +(defcustom org-insert-heading-hook nil + "Hook being run after inserting a new heading." + :group 'org-edit-structure + :type 'boolean) + (defcustom org-enable-fixed-width-editor t "Non-nil means, lines starting with \":\" are treated as fixed-width. This currently only means, they are never auto-wrapped. @@ -756,6 +812,23 @@ additional URL: prefix, so the format would be \"<URL:%s>\"." (const :tag "\"<URL:%s>\" (e.g. <URL:http://www.there.com>)" "<URL:%s>") (string :tag "Other" :value "<%s>"))) +(defcustom org-link-file-path-type 'adaptive + "How the path name in file links should be stored. +Valid values are: + +relative relative to the current directory, i.e. the directory of the file + into which the link is being inserted. +absolute absolute path, if possible with ~ for home directory. +noabbrev absolute path, no abbreviation of home directory. +adaptive Use relative path for files in the current directory and sub- + directories of it. For other files, use an absolute path." + :group 'org-link + :type '(choice + (const relative) + (const absolute) + (const noabbrev) + (const adaptive))) + (defcustom org-activate-links '(bracket angle plain radio tag date) "Types of links that should be activated in Org-mode files. This is a list of symbols, each leading to the activation of a certain link @@ -898,15 +971,32 @@ When nil, an error will be generated." :group 'org-link-follow :type 'boolean) -(defcustom org-confirm-shell-links 'yes-or-no-p +(defcustom org-confirm-shell-link-function 'yes-or-no-p "Non-nil means, ask for confirmation before executing shell links. Shell links can be dangerous, just thing about a link [[shell:rm -rf ~/*][Google Search]] This link would show up in your Org-mode document as \"Google Search\" -but really it would remove your entire home directory. Dangerous indeed. -Therefore I *definitely* advise agains setting this varaiable to nil. +but really it would remove your entire home directory. +Therefore I *definitely* advise against setting this variable to nil. +Just change it to `y-or-n-p' of you want to confirm with a single key press +rather than having to type \"yes\"." + :group 'org-link-follow + :type '(choice + (const :tag "with yes-or-no (safer)" yes-or-no-p) + (const :tag "with y-or-n (faster)" y-or-n-p) + (const :tag "no confirmation (dangerous)" nil))) + +(defcustom org-confirm-elisp-link-function 'yes-or-no-p + "Non-nil means, ask for confirmation before executing elisp links. +Elisp links can be dangerous, just thing about a link + + [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]] + +This link would show up in your Org-mode document as \"Google Search\" +but really it would remove your entire home directory. +Therefore I *definitely* advise against setting this variable to nil. Just change it to `y-or-n-p' of you want to confirm with a single key press rather than having to type \"yes\"." :group 'org-link-follow @@ -934,7 +1024,11 @@ for some files for which the OS does not have a good default. See `org-file-apps'.") (defconst org-file-apps-defaults-windowsnt - '((t . (w32-shell-execute "open" file))) + (list (cons t + (list (if (featurep 'xemacs) + 'mswindows-shell-execute + 'w32-shell-execute) + "open" 'file))) "Default file applications on a Windows NT system. The system \"open\" is used for most files. See `org-file-apps'.") @@ -946,18 +1040,25 @@ See `org-file-apps'.") ("ltx" . emacs) ("org" . emacs) ("el" . emacs) + ("bib" . emacs) ) "External applications for opening `file:path' items in a document. Org-mode uses system defaults for different file types, but you can use this variable to set the application for a given file -extension. The entries in this list are cons cells with a file extension -and the corresponding command. Possible values for the command are: - `emacs' The file will be visited by the current Emacs process. - `default' Use the default application for this file type. - string A command to be executed by a shell; %s will be replaced - by the path to the file. - sexp A Lisp form which will be evaluated. The file path will - be available in the Lisp variable `file'. +extension. The entries in this list are cons cells where the car identifies +files and the cdr the corresponding command. Possible values for the +file identifier are + \"ext\" A string identifying an extension + `directory' Matches a directory + t Default for all remaining files + +Possible values for the command are: + `emacs' The file will be visited by the current Emacs process. + `default' Use the default application for this file type. + string A command to be executed by a shell; %s will be replaced + by the path to the file. + sexp A Lisp form which will be evaluated. The file path will + be available in the Lisp variable `file'. For more examples, see the system specific constants `org-file-apps-defaults-macosx' `org-file-apps-defaults-windowsnt' @@ -1085,7 +1186,12 @@ Lisp variable `state'." (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." +closing date. +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + + #+STARTUP: logging + #+STARTUP: nologging" :group 'org-todo :type 'boolean) @@ -1110,6 +1216,14 @@ This is the priority an item get if no explicit priority is given." :tag "Org Time" :group 'org) +(defcustom org-insert-labeled-timestamps-at-point nil + "Non-nil means, SCHEDULED and DEADLINE timestamps are inserted at point. +When nil, these labeled time stamps are forces into the second line of an +entry, just after the headline. When scheduling from the global TODO list, +the time stamp will always be forced into the second line." + :group 'org-time + :type 'boolean) + (defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") "Formats for `format-time-string' which are used for time stamps. It is not recommended to change this constant.") @@ -1149,6 +1263,36 @@ moved to the new date." :tag "Org Tags" :group 'org) +(defcustom org-tag-alist nil + "List of tags allowed in Org-mode files. +When this list is nil, Org-mode will base TAG input on what is already in the +buffer. +The value of this variable is an alist, the car may be (and should) be a +character that is used to select that tag through the fast-tag-selection +interface. See the manual for details." + :group 'org-tags + :type '(repeat + (choice + (cons (string :tag "Tag name") + (character :tag "Access char")) + (const :tag "Start radio group" (:startgroup)) + (const :tag "End radio group" (:endgroup))))) + +(defcustom org-use-fast-tag-selection 'auto + "Non-nil means, use fast tag selection scheme. +This is a special interface to select and deselect tags with single keys. +When nil, fast selection is never used. +When the symbol `auto', fast selection is used if and only if selection +characters for tags have been configured, either through the variable +`org-tag-alist' or through a #+TAGS line in the buffer. +When t, fast selection is always used and selection keys are assigned +automatically if necessary." + :group 'org-tags + :type '(choice + (const :tag "Always" t) + (const :tag "Never" nil) + (const :tag "When selection characters are configured" 'auto))) + (defcustom org-tags-column 48 "The column to which tags should be indented in a headline. If this number is positive, it specifies the column. If it is negative, @@ -1234,6 +1378,7 @@ key The key (a single char as a string) to be associated with the command. type The command type, any of the following symbols: todo Entries with a specific TODO keyword, in all agenda files. tags Tags match in all agenda files. + tags-todo Tags match in all agenda files, TODO entries only. todo-tree Sparse tree of specific TODO keyword in *current* file. tags-tree Sparse tree with all tags matches in *current* file. occur-tree Occur sparse tree for current file. @@ -1246,13 +1391,30 @@ match What to search for: (list (string :tag "Key") (choice :tag "Type" (const :tag "Tags search in all agenda files" tags) + (const :tag "Tags search of TODO entries, all agenda files" tags-todo) (const :tag "TODO keyword search in all agenda files" todo) (const :tag "Tags sparse tree in current buffer" tags-tree) (const :tag "TODO keyword tree in current buffer" todo-tree) (const :tag "Occur tree in current buffer" occur-tree)) (string :tag "Match")))) -(defcustom org-agenda-include-all-todo t +(defcustom org-agenda-todo-list-sublevels t + "Non-nil means, check also the sublevels of a TODO entry for TODO entries. +When nil, the sublevels of a TODO entry are not checked, resulting in +potentially much shorter TODO lists." + :group 'org-agenda + :group 'org-todo + :type 'boolean) + +(defcustom org-agenda-todo-ignore-scheduled nil + "Non-nil means, don't show scheduled entries in the global todo list. +The idea behind this is that by scheduling it, you have already taken care +of this item." + :group 'org-agenda + :group 'org-todo + :type 'boolean) + +(defcustom org-agenda-include-all-todo nil "Non-nil means, the agenda will always contain all TODO entries. When nil, date-less entries will only be shown if `org-agenda' is called with a prefix argument. @@ -1274,7 +1436,7 @@ forth between agenda and calendar." :group 'org-agenda :type 'sexp) -(defgroup org-agenda-window-setup nil +(defgroup org-agenda-setup nil "Options concerning setting up the Agenda window in Org Mode." :tag "Org Agenda Window Setup" :group 'org-agenda) @@ -1286,9 +1448,8 @@ Needs to be set before org.el is loaded." :group 'org-agenda-setup :type 'boolean) -(defcustom org-select-timeline-window t - "Non-nil means, after creating a timeline, move cursor into Timeline window. -When nil, cursor will remain in the current window." +(defcustom org-agenda-start-with-follow-mode nil + "The initial value of follwo-mode in a newly created agenda window." :group 'org-agenda-setup :type 'boolean) @@ -1411,7 +1572,7 @@ categories by priority." (defcustom org-sort-agenda-notime-is-late t "Non-nil means, items without time are considered late. This is only relevant for sorting. When t, items which have no explicit -time like 15:30 will be considered as 24:01, i.e. later than any items which +time like 15:30 will be considered as 99:01, i.e. later than any items which do have a time. When nil, the default time is before 0:00. You can use this option to decide if the schedule for today should come before or after timeless agenda entries." @@ -1472,17 +1633,11 @@ See also the variables `org-agenda-remove-times-when-in-prefix' and :type 'string :group 'org-agenda-prefix) -(defcustom org-timeline-prefix-format " % s" - "Like `org-agenda-prefix-format', but for the timeline of a single file." - :type 'string - :group 'org-agenda-prefix) - (defvar org-prefix-format-compiled nil "The compiled version of the most recently used prefix format. Depending on which command was used last, this may be the compiled version of `org-agenda-prefix-format' or `org-timeline-prefix-format'.") -;; FIXME: There seem to be situations where this does no work. (defcustom org-agenda-remove-times-when-in-prefix t "Non-nil means, remove duplicate time specifications in agenda items. When the format `org-agenda-prefix-format' contains a `%t' specifier, a @@ -1510,6 +1665,34 @@ When this is the symbol `prefix', only remove tags when (const :tag "Never" nil) (const :tag "When prefix format contains %T" prefix))) +(defgroup org-agenda-timeline nil + "Options concerning the timeline buffer in Org Mode." + :tag "Org Agenda Timeline" + :group 'org-agenda) + +(defcustom org-timeline-prefix-format " % s" + "Like `org-agenda-prefix-format', but for the timeline of a single file." + :type 'string + :group 'org-agenda-timeline) + +(defcustom org-select-timeline-window t + "Non-nil means, after creating a timeline, move cursor into Timeline window. +When nil, cursor will remain in the current window." + :group 'org-agenda-timeline + :type 'boolean) + +(defcustom org-timeline-show-empty-dates 3 + "Non-nil means, `org-timeline' also shows dates without an entry. +When nil, only the days which actually have entries are shown. +When t, all days between the first and the last date are shown. +When an integer, show also empty dates, but if there is a gap of more than +N days, just insert a special line indicating the size of the gap." + :group 'org-agenda-timeline + :type '(choice + (const :tag "None" nil) + (const :tag "All" t) + (number :tag "at most"))) + (defgroup org-export nil "Options for exporting org-listings." :tag "Org Export" @@ -1520,6 +1703,23 @@ When this is the symbol `prefix', only remove tags when :tag "Org Export General" :group 'org-export) +(defcustom org-export-publishing-directory "." + "Path to the location where exported files should be located. +This path may be relative to the directory where the Org-mode file lives. +The default is to put them into the same directory as the Org-mode file. +The variable may also be an alist with export types `:html', `:ascii', +`:ical', or `:xoxo' and the corresponding directories. If a direcoty path +is relative, it is interpreted relative to the directory where the exported +Org-mode files lives." + :group 'org-export-general + :type '(choice + (directory) + (repeat + (cons + (choice :tag "Type" + (const :html) (const :ascii) (const :ical) (const :xoxo)) + (directory))))) + (defcustom org-export-language-setup '(("en" "Author" "Date" "Table of Contents") ("da" "Ophavsmand" "Dato" "Indhold") @@ -1591,6 +1791,21 @@ This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"." :group 'org-export-general :type 'boolean) +(defcustom org-export-with-timestamps t + "Nil means, do not export time stamps and associated keywords." + :group 'org-export + :type 'boolean) + +(defcustom org-export-with-tags t + "Nil means, do not export tags, just remove them from headlines." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-timestamps t + "Nil means, do not export timestamps and associated keywords." + :group 'org-export-general + :type 'boolean) + (defgroup org-export-translation nil "Options for translating special ascii sequences for the export backends." :tag "Org Export Translation" @@ -1714,6 +1929,22 @@ much faster." :tag "Org Export ASCII" :group 'org-export) +(defcustom org-export-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-) + "Characters for underlining headings in ASCII export. +In the given sequence, these characters will be used for level 1, 2, ..." + :group 'org-export-ascii + :type '(repeat character)) + +(defcustom org-export-ascii-bullets '(?* ?+ ?-) + "Bullet characters for headlines converted to lists in ASCII export. +The first character is is used for the first lest level generated in this +way, and so on. If there are more levels than characters given here, +the list will be repeated. +Note that plain lists will keep the same bullets as the have in the +Org-mode file." + :group 'org-export-ascii + :type '(repeat character)) + (defcustom org-export-ascii-show-new-buffer t "Non-nil means, popup buffer containing the exported ASCII text. Otherwise the buffer will just be saved to a file and stay hidden." @@ -1725,14 +1956,6 @@ Otherwise the buffer will just be saved to a file and stay hidden." :tag "Org Export XML" :group 'org-export) -(defcustom org-export-xml-type 'xoxo ;kw, if we have only one. - "The kind of XML to be produced by the XML exporter. -Allowed values are: -xoxo The XOXO exporter." - :group 'org-export-xml - :type '(choice - (const :tag "XOXO" xoxo))) - (defgroup org-export-html nil "Options specific for HTML export of Org-mode files." :tag "Org Export HTML" @@ -1745,8 +1968,11 @@ xoxo The XOXO exporter." font-size: 12pt; } .title { text-align: center; } - .todo, .deadline { color: red; } + .todo { color: red; } .done { color: green; } + .timestamp { color: grey } + .timestamp-kwd { color: CadetBlue } + .tag { background-color:lightblue; font-weight:normal } .target { background-color: lavender; } pre { border: 1pt solid #AEBDCC; @@ -1796,13 +2022,16 @@ When nil, the links still point to the plain `.org' file." :group 'org-export-html :type 'boolean) -(defcustom org-export-html-inline-images t +(defcustom org-export-html-inline-images 'maybe "Non-nil means, inline images into exported HTML pages. -The link will still be to the original location of the image file. -So if you are moving the page, lets say to your public HTML site, -you will have to move the image and maybe change the link." +This is done using an <img> tag. When nil, an anchor with href is used to +link to the image. If this option is `maybe', then images in links with +an empty description will be inlined, while images with a description will +be linked only." :group 'org-export-html - :type 'boolean) + :type '(choice (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "When there is no description" maybe))) (defcustom org-export-html-expand t "Non-nil means, for HTML export, treat @<...> as HTML tag. @@ -1814,7 +2043,7 @@ This option can also be set with the +OPTIONS line, e.g. \"@:nil\"." :type 'boolean) (defcustom org-export-html-table-tag - "<table border=1 cellspacing=0 cellpadding=6>" + "<table border=\"1\" cellspacing=\"0\" cellpadding=\"6\">" "The HTML tag used to start a table. This must be a <table> tag, but you may change the options like borders and spacing." @@ -1829,7 +2058,7 @@ to a file." :type 'boolean) (defcustom org-export-html-html-helper-timestamp - "<br><br><hr><p><!-- hhmts start --> <!-- hhmts end -->\n" + "<br/><br/><hr><p><!-- hhmts start --> <!-- hhmts end --></p>\n" "The HTML tag used as timestamp delimiter for HTML-helper-mode." :group 'org-export-html :type 'string) @@ -1847,7 +2076,8 @@ Otherwise, the buffer will just be saved to a file and stay hidden." (defcustom org-combined-agenda-icalendar-file "~/org.ics" "The file name for the iCalendar file covering all agenda files. -This file is created with the command \\[org-export-icalendar-all-agenda-files]." +This file is created with the command \\[org-export-icalendar-all-agenda-files]. +The file name should be absolute." :group 'org-export-icalendar :type 'file) @@ -2003,7 +2233,7 @@ color of the frame." (org-compatible-face '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) - (((class color) (min-colors 8)) (:foreground "blue")))) ;; FIXME: for dark bg? + (((class color) (min-colors 8)) (:foreground "blue")))) "Face used for level 7 headlines." :group 'org-faces) @@ -2120,11 +2350,21 @@ This face is only used if `org-fontify-done-headline' is set." "Face for items scheduled previously, and not yet done." :group 'org-faces) +(defface org-upcoming-deadline + (org-compatible-face + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 8) (background light)) (:foreground "red")) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:bold t)))) + "Face for items scheduled previously, and not yet done." + :group 'org-faces) + (defface org-time-grid ;; font-lock-variable-name-face (org-compatible-face '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) ; FIXME: turn off??? + (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) "Face used for time grids." :group 'org-faces) @@ -2163,6 +2403,10 @@ This face is only used if `org-fontify-done-headline' is set." (defvar org-todo-line-regexp nil "Matches a headline and puts TODO state into group 2 if present.") (make-variable-buffer-local 'org-todo-line-regexp) +(defvar org-todo-line-tags-regexp nil + "Matches a headline and puts TODO state into group 2 if present. +Also put tags into group 4 if tags are present.") +(make-variable-buffer-local 'org-todo-line-tags-regexp) (defvar org-nl-done-regexp nil "Matches newline followed by a headline with the DONE keyword.") (make-variable-buffer-local 'org-nl-done-regexp) @@ -2193,21 +2437,46 @@ This face is only used if `org-fontify-done-headline' is set." (defvar org-scheduled-time-regexp nil "Matches the SCHEDULED keyword together with a time stamp.") (make-variable-buffer-local 'org-scheduled-time-regexp) +(defvar org-closed-time-regexp nil + "Matches the CLOSED keyword together with a time stamp.") +(make-variable-buffer-local 'org-closed-time-regexp) + +(defvar org-keyword-time-regexp nil + "Matches any of the 3 keywords, together with the time stamp.") +(make-variable-buffer-local 'org-keyword-time-regexp) +(defvar org-maybe-keyword-time-regexp nil + "Matches a timestamp, possibly preceeded by a keyword.") +(make-variable-buffer-local 'org-keyword-time-regexp) + +(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t + mouse-map t) + "Properties to remove when a string without properties is wanted.") + +(defsubst org-match-string-no-properties (num &optional string) + (if (featurep 'xemacs) + (let ((s (match-string num string))) + (remove-text-properties 0 (length s) org-rm-props s) + s) + (match-string-no-properties num string))) + +(defsubst org-no-properties (s) + (remove-text-properties 0 (length s) org-rm-props s) + s) (defun org-set-regexps-and-options () "Precompute regular expressions for current buffer." (when (eq major-mode 'org-mode) (let ((re (org-make-options-regexp '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" - "STARTUP" "ARCHIVE"))) + "STARTUP" "ARCHIVE" "TAGS"))) (splitre "[ \t]+") - kwds int key value cat arch) + kwds int key value cat arch tags) (save-excursion (save-restriction (widen) (goto-char (point-min)) (while (re-search-forward re nil t) - (setq key (match-string 1) value (match-string 2)) + (setq key (match-string 1) value (org-match-string-no-properties 2)) (cond ((equal key "CATEGORY") (if (string-match "[ \t]+$" value) @@ -2222,6 +2491,8 @@ This face is only used if `org-fontify-done-headline' is set." ((equal key "TYP_TODO") (setq int 'type kwds (append kwds (org-split-string value splitre)))) + ((equal key "TAGS") + (setq tags (append tags (org-split-string value splitre)))) ((equal key "STARTUP") (let ((opts (org-split-string value splitre)) (set '(("fold" org-startup-folded t) @@ -2235,6 +2506,8 @@ This face is only used if `org-fontify-done-headline' is set." ("oddeven" org-odd-levels-only nil) ("align" org-startup-align-all-tables t) ("noalign" org-startup-align-all-tables nil) + ("logging" org-log-done t) + ("nologging" org-log-done nil) ("dlcheck" org-startup-with-deadline-check t) ("nodlcheck" org-startup-with-deadline-check nil))) l var val) @@ -2250,7 +2523,24 @@ This face is only used if `org-fontify-done-headline' is set." (and cat (set (make-local-variable 'org-category) cat)) (and kwds (set (make-local-variable 'org-todo-keywords) kwds)) (and arch (set (make-local-variable 'org-archive-location) arch)) - (and int (set (make-local-variable 'org-todo-interpretation) int))) + (and int (set (make-local-variable 'org-todo-interpretation) int)) + (when tags + (let (e tg c tgs) + (while (setq e (pop tags)) + (cond + ((equal e "{") (push '(:startgroup) tgs)) + ((equal e "}") (push '(:endgroup) tgs)) + ((string-match "^\\([0-9a-zA-Z_@]+\\)(\\(.\\))$" e) + (push (cons (match-string 1 e) + (string-to-char (match-string 2 e))) + tgs)) + (t (push (list e) tgs)))) + (set (make-local-variable 'org-tag-alist) nil) + (while (setq e (pop tgs)) + (or (and (stringp (car e)) + (assoc (car e) org-tag-alist)) + (push e org-tag-alist)))))) + ;; Compute the regular expressions and other local variables (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority) org-todo-kwd-max-priority (1- (length org-todo-keywords)) @@ -2273,6 +2563,10 @@ This face is only used if `org-fontify-done-headline' is set." "\\)? *\\(.*\\)") org-nl-done-regexp (concat "[\r\n]\\*+[ \t]+" org-done-string "\\>") + org-todo-line-tags-regexp + (concat "^\\(\\*+\\)[ \t]*\\(" + (mapconcat 'regexp-quote org-todo-keywords "\\|") + "\\)? *\\(.*?\\([ \t]:[a-zA-Z0-9:_@]+:[ \t]*\\)?$\\)") org-looking-at-done-regexp (concat "^" org-done-string "\\>") org-deadline-regexp (concat "\\<" org-deadline-string) org-deadline-time-regexp @@ -2282,11 +2576,27 @@ This face is only used if `org-fontify-done-headline' is set." org-scheduled-regexp (concat "\\<" org-scheduled-string) org-scheduled-time-regexp - (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")) + (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>") + org-closed-time-regexp + (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]") + org-keyword-time-regexp + (concat "\\<\\(" org-scheduled-string + "\\|" org-deadline-string + "\\|" org-closed-string "\\)" + " *[[<]\\([^]>]+\\)[]>]") + org-maybe-keyword-time-regexp + (concat "\\(\\<\\(" org-scheduled-string + "\\|" org-deadline-string + "\\|" org-closed-string "\\)\\)?" + " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\r\n>]*?[]>]\\)")) + (org-set-font-lock-defaults))) ;; Tell the compiler about dynamically scoped variables, ;; and variables from other packages +(defvar calc-embedded-close-formula) ; defined by the calc package +(defvar calc-embedded-open-formula) ; defined by the calc package +(defvar font-lock-unfontify-region-function) ; defined by font-lock.el (defvar zmacs-regions) ; XEmacs regions (defvar original-date) ; dynamically scoped in calendar (defvar org-old-auto-fill-inhibit-regexp) ; local variable used by `orgtbl-mode' @@ -2298,14 +2608,9 @@ This face is only used if `org-fontify-done-headline' is set." (defvar mark-active) ; Emacs only, not available in XEmacs. (defvar timecnt) ; dynamically scoped parameter (defvar levels-open) ; dynamically scoped parameter -(defvar title) ; dynamically scoped parameter -(defvar author) ; dynamically scoped parameter -(defvar email) ; dynamically scoped parameter -(defvar text) ; dynamically scoped parameter (defvar entry) ; dynamically scoped parameter (defvar date) ; dynamically scoped parameter -(defvar language) ; dynamically scoped parameter -(defvar options) ; dynamically scoped parameter +(defvar description) ; dynamically scoped parameter (defvar ans1) ; dynamically scoped parameter (defvar ans2) ; dynamically scoped parameter (defvar starting-day) ; local variable @@ -2330,6 +2635,9 @@ This face is only used if `org-fontify-done-headline' is set." (defvar annotation) ; from remember.el, dynamically scoped in `remember-mode' (defvar initial) ; from remember.el, dynamically scoped in `remember-mode' (defvar orgtbl-mode) ; defined later in this file +(defvar Info-current-file) ; from info.el +(defvar Info-current-node) ; from info.el + ;;; Define the mode (defvar org-mode-map @@ -2372,11 +2680,31 @@ can be exported as a structured ASCII or HTML file. The following commands are available: \\{org-mode-map}" + + ;; Get rid of Outline menus, they are not needed + ;; Need to do this here because define-derived-mode sets up + ;; the keymap so late. + (if (featurep 'xemacs) + (if org-noutline-p + (progn + (easy-menu-remove outline-mode-menu-heading) + (easy-menu-remove outline-mode-menu-show) + (easy-menu-remove outline-mode-menu-hide)) + (delete-menu-item '("Headings")) + (delete-menu-item '("Show")) + (delete-menu-item '("Hide")) + (set-menubar-dirty-flag)) + (define-key org-mode-map [menu-bar headings] 'undefined) + (define-key org-mode-map [menu-bar hide] 'undefined) + (define-key org-mode-map [menu-bar show] 'undefined)) + (easy-menu-add org-org-menu) (easy-menu-add org-tbl-menu) (org-install-agenda-files-menu) (if org-descriptive-links (org-add-to-invisibility-spec '(org-link))) (org-add-to-invisibility-spec '(org-cwidth)) + (when (featurep 'xemacs) + (set (make-local-variable 'line-move-ignore-invisible) t)) (setq outline-regexp "\\*+") ;;(setq outline-regexp "\\(?:\\*+\\|[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\) \\)") (setq outline-level 'org-outline-level) @@ -2405,19 +2733,6 @@ The following commands are available: (= (point-min) (point-max))) (insert " -*- mode: org -*-\n\n")) - ;; Get rid of Outline menus, they are not needed - ;; Need to do this here because define-derived-mode sets up - ;; the keymap so late. - (if (featurep 'xemacs) - (progn - (delete-menu-item '("Headings")) - (delete-menu-item '("Show")) - (delete-menu-item '("Hide")) - (set-menubar-dirty-flag)) - (define-key org-mode-map [menu-bar headings] 'undefined) - (define-key org-mode-map [menu-bar hide] 'undefined) - (define-key org-mode-map [menu-bar show] 'undefined)) - (unless org-inhibit-startup (if org-startup-align-all-tables (org-table-map-tables 'org-table-align)) @@ -2430,24 +2745,13 @@ The following commands are available: (let ((this-command 'org-cycle) (last-command 'org-cycle)) (org-cycle '(4)) (org-cycle '(4)))))))) +(defsubst org-call-with-arg (command arg) + "Call COMMAND interactively, but pretend prefix are was ARG." + (let ((current-prefix-arg arg)) (call-interactively command))) + (defsubst org-current-line (&optional pos) (+ (if (bolp) 1 0) (count-lines (point-min) (or pos (point))))) -(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t - mouse-map t) - "Properties to remove when a string without properties is wanted.") - -(defsubst org-match-string-no-properties (num &optional string) - (if (featurep 'xemacs) - (let ((s (match-string num string))) - (remove-text-properties 0 (length s) org-rm-props s) - s) - (match-string-no-properties num string))) - -(defsubst org-no-properties (s) - (remove-text-properties 0 (length s) org-rm-props s) - s) - (defun org-current-time () "Current time, possibly rounded to `org-time-stamp-rounding-minutes'." (if (> org-time-stamp-rounding-minutes 0) @@ -2488,7 +2792,7 @@ that will be added to PLIST. Returns the string that was modified." (defconst org-non-link-chars "]\t\n\r<>") (defconst org-link-types '("https?" "ftp" "mailto" "file" "news" "bbdb" "vm" - "wl" "mhe" "rmail" "gnus" "shell")) + "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp")) (defconst org-link-re-with-space (concat "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):" @@ -2581,6 +2885,8 @@ that will be added to PLIST. Returns the string that was modified." (let* ((help (concat "LINK: " (org-match-string-no-properties 1))) ;; FIXME: above we should remove the escapes. + ;; but that requires another match, protecting match data, + ;; a lot of overhead for font-lock. (ip (list 'invisible 'org-link 'intangible t 'rear-nonsticky t 'keymap org-mouse-map 'mouse-face 'highlight 'help-echo help)) @@ -2719,11 +3025,13 @@ between words." (let* ((em org-fontify-emphasized-text) (lk org-activate-links) (org-font-lock-extra-keywords + ;; Headlines (list '("^\\(\\**\\)\\(\\*\\)\\(.*\\)" (1 (org-get-level-face 1)) (2 (org-get-level-face 2)) (3 (org-get-level-face 3))) '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" (1 'org-table)) + ;; Links (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) @@ -2733,27 +3041,34 @@ between words." (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) (if org-table-limit-column-width '(org-hide-wide-columns (0 nil append))) + ;; TODO lines (list (concat "^\\*+[ \t]*" org-not-done-regexp) '(1 'org-todo t)) + ;; Priorities (list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t)) + ;; Special keywords (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)) -; (if em '("\\(\\W\\|^\\)\\(\\*\\w+\\*\\)\\(\\W\\|$\\)" 2 'bold prepend)) -; (if em '("\\(\\W\\|^\\)\\(/\\w+/\\)\\(\\W\\|$\\)" 2 'italic prepend)) -; (if em '("\\(\\W\\|^\\)\\(_\\w+_\\)\\(\\W\\|$\\)" 2 'underline prepend)) + ;; Emphasis (if em (list org-bold-re 2 ''bold 'prepend)) (if em (list org-italic-re 2 ''italic 'prepend)) (if em (list org-underline-re 2 ''underline 'prepend)) + ;; Checkboxes, similar to Frank Ruell's org-checklet.el + '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)" + 2 'bold prepend) + ;; COMMENT (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\|" org-quote-string "\\)\\>") '(1 'org-special-keyword t)) '("^#.*" (0 'font-lock-comment-face t)) + ;; DONE (if org-fontify-done-headline (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>") '(1 'org-done t) '(2 'org-headline-done t)) (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") '(1 'org-done t))) + ;; Table stuff '("^[ \t]*\\(:.*\\)" (1 'org-table t)) '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t)) '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t)) @@ -2795,7 +3110,11 @@ between words." ;;; Visibility cycling (defvar org-cycle-global-status nil) +(make-variable-buffer-local 'org-cycle-global-status) (defvar org-cycle-subtree-status nil) +(make-variable-buffer-local 'org-cycle-subtree-status) + +;;;###autoload (defun org-cycle (&optional arg) "Visibility cycling for Org-mode. @@ -2825,15 +3144,18 @@ between words." no headline in line 1, this function will act as if called with prefix arg." (interactive "P") - (if (or (and (bobp) (not (looking-at outline-regexp))) - (equal arg '(4))) - ;; special case: use global cycling - (setq arg t)) + (let* ((outline-regexp + (if org-cycle-include-plain-lists + "\\*+\\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " + outline-regexp)) + (bob-special (and org-cycle-global-at-bob (bobp) + (not (looking-at outline-regexp)))) + (org-cycle-hook (if bob-special nil org-cycle-hook)) + (pos (point))) - (let ((outline-regexp - (if org-cycle-include-plain-lists - "\\*+\\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " - outline-regexp))) + (if (or bob-special (equal arg '(4))) + ;; special case: use global cycling + (setq arg t)) (cond @@ -2843,7 +3165,7 @@ between words." (progn (if arg (org-table-edit-field t) (org-table-justify-field-maybe) - (org-table-next-field))))) + (call-interactively 'org-table-next-field))))) ((eq arg t) ;; Global cycling @@ -2853,18 +3175,8 @@ between words." ;; We just created the overview - now do table of contents ;; This can be slow in very large buffers, so indicate action (message "CONTENTS...") - (save-excursion - ;; Visit all headings and show their offspring - (goto-char (point-max)) - (catch 'exit - (while (and (progn (condition-case nil - (outline-previous-visible-heading 1) - (error (goto-char (point-min)))) - t) - (looking-at outline-regexp)) - (show-branches) - (if (bobp) (throw 'exit nil)))) - (message "CONTENTS...done")) + (org-content) + (message "CONTENTS...done") (setq org-cycle-global-status 'contents) (run-hook-with-args 'org-cycle-hook 'contents)) @@ -2878,7 +3190,7 @@ between words." (t ;; Default action: go to overview - (hide-sublevels 1) + (org-overview) (message "OVERVIEW") (setq org-cycle-global-status 'overview) (run-hook-with-args 'org-cycle-hook 'overview)))) @@ -2908,10 +3220,10 @@ between words." (outline-next-heading)) ;; Find out what to do next and set `this-command' (cond - ((= eos eoh) + ((and (= eos eoh) ;; Nothing is hidden behind this heading (message "EMPTY ENTRY") - (setq org-cycle-subtree-status nil)) + (setq org-cycle-subtree-status nil))) ((>= eol eos) ;; Entire subtree is hidden in one line: open it (org-show-entry) @@ -2935,8 +3247,12 @@ between words." ;; TAB emulation (buffer-read-only (org-back-to-heading)) - ((if (and (eq org-cycle-emulate-tab 'white) - (save-excursion (beginning-of-line 1) (looking-at "[ \t]+$"))) + ((if (and (memq org-cycle-emulate-tab '(white whitestart)) + (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) + (or (and (eq org-cycle-emulate-tab 'white) + (= (match-end 0) (point-at-eol))) + (and (eq org-cycle-emulate-tab 'whitestart) + (>= (match-end 0) pos)))) t (eq org-cycle-emulate-tab t)) (if (and (looking-at "[ \n\r\t]") @@ -2951,6 +3267,44 @@ between words." (org-back-to-heading) (org-cycle)))))) +;;;###autoload +(defun org-global-cycle () + "Cycle the global visibility. For details see `org-cycle'." + (interactive) + (org-cycle '(4))) + +(defun org-overview () + "Switch to overview mode, shoing only top-level headlines. +Really, this shows all headlines with level equal or greater than the level +of the first headline in the buffer. This is important, because if the +first headline is not level one, then (hide-sublevels 1) gives confusing +results." + (interactive) + (hide-sublevels (save-excursion + (goto-char (point-min)) + (if (re-search-forward (concat "^" outline-regexp) nil t) + (progn + (goto-char (match-beginning 0)) + (funcall outline-level)) + 1)))) + +;; FIXME: allow an argument to give a limiting level for this. +(defun org-content () + "Show all headlines in the buffer, like a table of contents" + (interactive) + (save-excursion + ;; Visit all headings and show their offspring + (goto-char (point-max)) + (catch 'exit + (while (and (progn (condition-case nil + (outline-previous-visible-heading 1) + (error (goto-char (point-min)))) + t) + (looking-at outline-regexp)) + (show-branches) + (if (bobp) (throw 'exit nil)))))) + + (defun org-optimize-window-after-visibility-change (state) "Adjust the window after a change in outline visibility. This function is the default value of the hook `org-cycle-hook'." @@ -3071,7 +3425,6 @@ or nil." (kill-buffer "*org-goto*") org-selected-point)) -;; FIXME: It may not be a good idea to temper with the prefix argument... (defun org-goto-ret (&optional arg) "Finish `org-goto' by going to the new location." (interactive "P") @@ -3114,26 +3467,36 @@ or nil." "To temporarily disable the active region.") (defun org-insert-heading (&optional force-heading) - "Insert a new heading or item with same depth at point." + "Insert a new heading or item with same depth at point. +If point is in a plain list and FORCE-HEADING is nil, create a new list item. +If point is at the beginning of a headline, insert a sibling before the +current headline. If point is in the middle of a headline, split the headline +at that position and make the rest of the headline part of the sibling below +the current headline." (interactive "P") - (when (or force-heading (not (org-insert-item))) - (let* ((head (save-excursion - (condition-case nil - (org-back-to-heading) - (error (outline-next-heading))) - (prog1 (match-string 0) - (funcall outline-level))))) - (cond - ((and (org-on-heading-p) (bolp) - (save-excursion (backward-char 1) (not (org-invisible-p)))) - (open-line 1)) - ((bolp) nil) - (t (newline))) - (insert head) - (just-one-space) - (run-hooks 'org-insert-heading-hook)))) - -(defun org-insert-item () + (if (= (buffer-size) 0) + (insert "\n* ") + (when (or force-heading (not (org-insert-item))) + (let* ((head (save-excursion + (condition-case nil + (progn + (org-back-to-heading) + (match-string 0)) + (error "*")))) + pos) + (cond + ((and (org-on-heading-p) (bolp) + (save-excursion (backward-char 1) (not (org-invisible-p)))) + (open-line 1)) + ((bolp) nil) + (t (newline))) + (insert head) (just-one-space) + (setq pos (point)) + (end-of-line 1) + (unless (= (point) pos) (just-one-space) (backward-delete-char 1)) + (run-hooks 'org-insert-heading-hook))))) + +(defun org-insert-item (&optional checkbox) "Insert a new item at the current level. Return t when things worked, nil when we are not in an item." (when (save-excursion @@ -3144,9 +3507,11 @@ Return t when things worked, nil when we are not in an item." t) (error nil))) (let* ((bul (match-string 0)) + (end (match-end 0)) (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*") (match-end 0))) - (eowcol (save-excursion (goto-char eow) (current-column)))) + (eowcol (save-excursion (goto-char eow) (current-column))) + pos) (cond ((and (org-at-item-p) (<= (point) eow)) ;; before the bullet @@ -3155,8 +3520,11 @@ Return t when things worked, nil when we are not in an item." ((<= (point) eow) (beginning-of-line 1)) (t (newline))) - (insert bul) - (just-one-space)) + (insert bul (if checkbox "[ ]" "")) + (just-one-space) + (setq pos (point)) + (end-of-line 1) + (unless (= (point) pos) (just-one-space) (backward-delete-char 1))) (org-maybe-renumber-ordered-list) t)) @@ -3165,16 +3533,19 @@ Return t when things worked, nil when we are not in an item." If the heading has no TODO state, or if the state is DONE, use the first state (TODO by default). Also with prefix arg, force first state." (interactive "P") - (org-insert-heading) - (save-excursion - (org-back-to-heading) - (outline-previous-heading) - (looking-at org-todo-line-regexp)) - (if (or arg - (not (match-beginning 2)) - (equal (match-string 2) org-done-string)) - (insert (car org-todo-keywords) " ") - (insert (match-string 2) " "))) + (when (not (org-insert-item 'checkbox)) + (org-insert-heading) + (save-excursion + (org-back-to-heading) + (if org-noutline-p + (outline-previous-heading) + (outline-previous-visible-heading t)) + (looking-at org-todo-line-regexp)) + (if (or arg + (not (match-beginning 2)) + (equal (match-string 2) org-done-string)) + (insert (car org-todo-keywords) " ") + (insert (match-string 2) " ")))) (defun org-promote-subtree () "Promote the entire subtree. @@ -3408,7 +3779,7 @@ If optional TREE is given, use this text instead of the kill ring." (error (substitute-command-keys "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) - (let* ((txt (or tree (current-kill 0))) + (let* ((txt (or tree (and kill-ring (current-kill 0)))) (^re (concat "^\\(" outline-regexp "\\)")) (re (concat "\\(" outline-regexp "\\)")) (^re_ (concat "\\(" outline-regexp "\\)[ \t]*")) @@ -3457,8 +3828,12 @@ If optional TREE is given, use this text instead of the kill ring." (progn (insert "\n") (backward-char 1))) ;; Paste (setq beg (point)) + (if (string-match "[ \t\r\n]+\\'" txt) + (setq txt (replace-match "\n" t t txt))) (insert txt) (setq end (point)) + (if (looking-at "[ \t\r\n]+") + (replace-match "\n")) (goto-char beg) ;; Shift if necessary (if (= shift 0) @@ -3471,7 +3846,8 @@ If optional TREE is given, use this text instead of the kill ring." (goto-char (point-min)) (message "Pasted at level %d, with shift by %d levels" new-level shift1))) - (if (and (eq org-subtree-clip (current-kill 0)) + (if (and kill-ring + (eq org-subtree-clip (current-kill 0)) org-subtree-clip-folded) ;; The tree was folded before it was killed/copied (hide-subtree)))) @@ -3483,8 +3859,9 @@ headline level is not the largest headline level in the tree. So this will actually accept several entries of equal levels as well, which is OK for `org-paste-subtree'. If optional TXT is given, check this string instead of the current kill." - (let* ((kill (or txt (current-kill 0) "")) - (start-level (and (string-match (concat "\\`" outline-regexp) kill) + (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) + (start-level (and kill + (string-match (concat "\\`" outline-regexp) kill) (- (match-end 0) (match-beginning 0)))) (re (concat "^" outline-regexp)) (start 1)) @@ -3510,16 +3887,60 @@ If optional TXT is given, check this string instead of the current kill." ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))))) -(defun org-get-indentation () - "Get the indentation of the current line, interpreting tabs." +(defun org-at-item-checkbox-p () + "Is point at a line starting a plain-list item with a checklet?" + (and (org-at-item-p) + (save-excursion + (goto-char (match-end 0)) + (skip-chars-forward " \t") + (looking-at "\\[[ X]\\]")))) + +(defun org-toggle-checkbox () + "Toggle the checkbox in the current line." + (interactive) (save-excursion - (beginning-of-line 1) - (skip-chars-forward " \t") - (current-column))) + (if (org-at-item-checkbox-p) + (replace-match (if (equal (match-string 0) "[ ]") "[X]" "[ ]") t t)))) + +(defun org-get-indentation (&optional line) + "Get the indentation of the current line, interpreting tabs. +When LINE is given, assume it represents a line and compute its indentation." + (if line + (if (string-match "^ *" (org-remove-tabs line)) + (match-end 0)) + (save-excursion + (beginning-of-line 1) + (skip-chars-forward " \t") + (current-column)))) + +(defun org-remove-tabs (s &optional width) + "Replace tabulators in S with spaces. +Assumes that s is a single line, starting in column 0." + (setq width (or width tab-width)) + (while (string-match "\t" s) + (setq s (replace-match + (make-string + (- (* width (/ (+ (match-beginning 0) width) width)) + (match-beginning 0)) ?\ ) + t t s))) + s) + +;; FIXME: document properly. +(defun org-fix-indentation (line ind) + "If the current indenation is smaller than ind1, leave it alone. +If it is larger than ind, reduce it by ind." + (let* ((l (org-remove-tabs line)) + (i (org-get-indentation l)) + (i1 (car ind)) (i2 (cdr ind))) + (if (>= i i2) (setq l (substring line i2))) + (if (> i1 0) + (concat (make-string i1 ?\ ) l) + l))) (defun org-beginning-of-item () "Go to the beginning of the current hand-formatted item. If the cursor is not in an item, throw an error." + (interactive) (let ((pos (point)) (limit (save-excursion (org-back-to-heading) (beginning-of-line 2) (point))) @@ -3545,6 +3966,7 @@ If the cursor is not in an item, throw an error." (defun org-end-of-item () "Go to the end of the current hand-formatted item. If the cursor is not in an item, throw an error." + (interactive) (let ((pos (point)) (limit (save-excursion (outline-next-heading) (point))) (ind (save-excursion @@ -3564,11 +3986,47 @@ If the cursor is not in an item, throw an error." (goto-char pos) (error "Not in an item")))) -(defun org-move-item-down (arg) +(defun org-next-item () + "Move to the beginning of the next item in the current plain list. +Error if not at a plain list, or if this is the last item in the list." + (interactive) + (let (beg end ind ind1 (pos (point)) txt) + (org-beginning-of-item) + (setq beg (point)) + (setq ind (org-get-indentation)) + (org-end-of-item) + (setq end (point)) + (setq ind1 (org-get-indentation)) + (unless (and (org-at-item-p) (= ind ind1)) + (goto-char pos) + (error "On last item")))) + +(defun org-previous-item () + "Move to the beginning of the previous item in the current plain list. +Error if not at a plain list, or if this is the last item in the list." + (interactive) + (let (beg end ind ind1 (pos (point)) txt) + (org-beginning-of-item) + (setq beg (point)) + (setq ind (org-get-indentation)) + (goto-char beg) + (catch 'exit + (while t + (beginning-of-line 0) + (if (looking-at "[ \t]*$") + nil + (if (<= (setq ind1 (org-get-indentation)) ind) + (throw 'exit t))))) + (condition-case nil + (org-beginning-of-item) + (error (goto-char pos) + (error "On first item"))))) + +(defun org-move-item-down () "Move the plain list item at point down, i.e. swap with following item. Subitems (items with larger indentation) are considered part of the item, so this really moves item trees." - (interactive "p") + (interactive) (let (beg end ind ind1 (pos (point)) txt) (org-beginning-of-item) (setq beg (point)) @@ -3647,7 +4105,7 @@ doing the renumbering." (defun org-renumber-ordered-list (arg) "Renumber an ordered plain list. -Cursor next to be in the first line of an item, the line that starts +Cursor needs to be in the first line of an item, the line that starts with something like \"1.\" or \"2)\"." (interactive "p") (unless (and (org-at-item-p) @@ -3702,24 +4160,24 @@ with something like \"1.\" or \"2)\"." (interactive "p") (unless (org-at-item-p) (error "Not on an item")) - (let (beg end ind ind1) - (if (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (save-excursion + (let (beg end ind ind1) + (if (memq last-command '(org-shiftmetaright org-shiftmetaleft)) (setq beg org-last-indent-begin-marker end org-last-indent-end-marker) - (org-beginning-of-item) - (setq beg (move-marker org-last-indent-begin-marker (point))) - (org-end-of-item) - (setq end (move-marker org-last-indent-end-marker (point)))) - (goto-char beg) - (skip-chars-forward " \t") (setq ind (current-column)) - (if (< (+ arg ind) 0) (error "Cannot outdent beyond margin")) - (while (< (point) end) - (beginning-of-line 1) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (delete-region (point-at-bol) (point)) - (indent-to-column (+ ind1 arg)) - (beginning-of-line 2)) - (goto-char beg))) + (org-beginning-of-item) + (setq beg (move-marker org-last-indent-begin-marker (point))) + (org-end-of-item) + (setq end (move-marker org-last-indent-end-marker (point)))) + (goto-char beg) + (skip-chars-forward " \t") (setq ind (current-column)) + (if (< (+ arg ind) 0) (error "Cannot outdent beyond margin")) + (while (< (point) end) + (beginning-of-line 1) + (skip-chars-forward " \t") (setq ind1 (current-column)) + (delete-region (point-at-bol) (point)) + (indent-to-column (+ ind1 arg)) + (beginning-of-line 2))))) ;;; Archiving @@ -3789,14 +4247,13 @@ heading be marked DONE, and the current time will be added." (or (bolp) (insert "\n")) (insert "\n" heading "\n") (end-of-line 0)) - ;; Make the heading visible, and the following as well - (let ((org-show-following-heading t)) (org-show-hierarchy-above)) - (if (re-search-forward - (concat "^" (regexp-quote (make-string level ?*)) "[ \t]") - nil t) - (progn (goto-char (match-beginning 0)) (insert "\n") - (beginning-of-line 0)) - (goto-char (point-max)) (insert "\n"))) + ;; Make the subtree visible + (show-subtree) + (org-end-of-subtree t) + (skip-chars-backward " \t\r\n]") + (and (looking-at "[ \t\r\n]*") + (replace-match "\n\n"))) + ;; No specific heading, just go to end of file. (goto-char (point-max)) (insert "\n")) ;; Paste (org-paste-subtree (1+ level)) @@ -3816,7 +4273,7 @@ heading be marked DONE, and the current time will be added." ;; Here we are back in the original buffer. Everything seems to have ;; worked. So now cut the tree and finish up. (let (this-command) (org-cut-subtree)) - (if (looking-at "[ \t]*$") (kill-line)) + (if (and (not (eobp)) (looking-at "[ \t]*$")) (kill-line)) (message "Subtree archived %s" (if (eq this-buffer buffer) (concat "under heading: " heading) @@ -3844,6 +4301,7 @@ At all other locations, this simply calls `ispell-complete-word'." (if (equal (char-before (point)) ?\ ) (backward-char 1)) (skip-chars-backward "a-zA-Z0-9_:$") (point))) + (confirm (lambda (x) (stringp (car x)))) (camel (equal (char-before beg) ?*)) (tag (equal (char-before beg1) ?:)) (texp (equal (char-before beg) ?\\)) @@ -3880,10 +4338,10 @@ At all other locations, this simply calls `ispell-complete-word'." tbl))) tbl) (tag (setq type :tag beg beg1) - (org-get-buffer-tags)) + (or org-tag-alist (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))) + (completion (try-completion pattern table confirm))) (cond ((eq completion t) (if (equal type :opt) (insert (substring (cdr (assoc (upcase pattern) table)) @@ -3906,7 +4364,8 @@ At all other locations, this simply calls `ispell-complete-word'." "Press \\[org-complete] again to insert example settings")))) (t (message "Making completion list...") - (let ((list (sort (all-completions pattern table) 'string<))) + (let ((list (sort (all-completions pattern table confirm) + 'string<))) (with-output-to-temp-buffer "*Completions*" (condition-case nil ;; Protection needed for XEmacs and emacs 21 @@ -3960,44 +4419,44 @@ prefix arg, switch to that state." (member (member this org-todo-keywords)) (tail (cdr member)) (state (cond - ((equal arg '(4)) - ;; Read a state with completion - (completing-read "State: " (mapcar (lambda(x) (list x)) - org-todo-keywords) - nil t)) - ((eq arg 'right) - (if this - (if tail (car tail) nil) - (car org-todo-keywords))) - ((eq arg 'left) - (if (equal member org-todo-keywords) - nil - (if this - (nth (- (length org-todo-keywords) (length tail) 2) - org-todo-keywords) - org-done-string))) - (arg - ;; user requests a specific state - (nth (1- (prefix-numeric-value arg)) - org-todo-keywords)) - ((null member) (car org-todo-keywords)) - ((null tail) nil) ;; -> first entry - ((eq org-todo-interpretation 'sequence) - (car tail)) - ((memq org-todo-interpretation '(type priority)) - (if (eq this-command last-command) - (car tail) - (if (> (length tail) 0) org-done-string nil))) - (t nil))) + ((equal arg '(4)) + ;; Read a state with completion + (completing-read "State: " (mapcar (lambda(x) (list x)) + org-todo-keywords) + nil t)) + ((eq arg 'right) + (if this + (if tail (car tail) nil) + (car org-todo-keywords))) + ((eq arg 'left) + (if (equal member org-todo-keywords) + nil + (if this + (nth (- (length org-todo-keywords) (length tail) 2) + org-todo-keywords) + org-done-string))) + (arg + ;; user requests a specific state + (nth (1- (prefix-numeric-value arg)) + org-todo-keywords)) + ((null member) (car org-todo-keywords)) + ((null tail) nil) ;; -> first entry + ((eq org-todo-interpretation 'sequence) + (car tail)) + ((memq org-todo-interpretation '(type priority)) + (if (eq this-command last-command) + (car tail) + (if (> (length tail) 0) org-done-string nil))) + (t nil))) (next (if state (concat " " 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) + (org-add-planning-info 'closed (current-time) 'scheduled) (if (not this) - (org-log-done t)))) + (org-add-planning-info nil nil 'closed)))) ;; Fixup tag positioning (and org-auto-align-tags (org-set-tags nil t)) (run-hooks 'org-after-todo-state-change-hook))) @@ -4067,25 +4526,79 @@ of `org-todo-keywords'." A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down] to modify it to the correct date." (interactive) - (insert - org-deadline-string " " - (format-time-string (car org-time-stamp-formats) - (org-read-date nil 'to-time))) - (message "%s" (substitute-command-keys - "Use \\[org-timestamp-up-day] and \\[org-timestamp-down-day] to change the date."))) + (org-add-planning-info 'deadline nil 'closed)) (defun org-schedule () "Insert the SCHEDULED: string to schedule a TODO item. A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down] to modify it to the correct date." (interactive) - (insert - org-scheduled-string " " - (format-time-string (car org-time-stamp-formats) - (org-read-date nil 'to-time))) - (message "%s" (substitute-command-keys - "Use \\[org-timestamp-up-day] and \\[org-timestamp-down-day] to change the date."))) - + (org-add-planning-info 'scheduled nil 'closed)) + +(defun org-add-planning-info (what &optional time &rest remove) + "Insert new timestamp with keyword in the line directly after the headline. +WHAT indicates what kind of time stamp to add. TIME indicated the time to use. +If non is given, the user is prompted for a date. +REMOVE indicates what kind of entries to remove. An old WHAT entry will also +be removed." + (interactive) + (when what (setq time (or time (org-read-date nil 'to-time)))) + (when (and org-insert-labeled-timestamps-at-point + (member what '(scheduled deadline))) + (insert + (if (eq what 'scheduled) org-scheduled-string org-deadline-string) + " " + (format-time-string (car org-time-stamp-formats) time)) + (setq what nil)) + (save-excursion + (let (beg end col list elt (buffer-invisibility-spec nil) ts) + (org-back-to-heading t) + (setq beg (point)) + (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*")) + (goto-char (match-end 1)) + (setq col (current-column)) + (goto-char (1+ (match-end 0))) + (if (and (not (looking-at outline-regexp)) + (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp + "[^\r\n]*"))) + (narrow-to-region (match-beginning 0) (match-end 0)) + (insert "\n") + (backward-char 1) + (narrow-to-region (point) (point)) + (indent-to-column col)) + ;; Check if we have to remove something. + (setq list (cons what remove)) + (while list + (setq elt (pop list)) + (goto-char (point-min)) + (when (or (and (eq elt 'scheduled) + (re-search-forward org-scheduled-time-regexp nil t)) + (and (eq elt 'deadline) + (re-search-forward org-deadline-time-regexp nil t)) + (and (eq elt 'closed) + (re-search-forward org-closed-time-regexp nil t))) + (replace-match "") + (if (looking-at " +") (replace-match "")))) + (goto-char (point-max)) + (when what + (insert + (if (not (equal (char-before) ?\ )) " " "") + (cond ((eq what 'scheduled) org-scheduled-string) + ((eq what 'deadline) org-deadline-string) + ((eq what 'closed) org-closed-string)) + " ") + (insert + (setq ts + (format-time-string + (if (eq what 'closed) + (concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]") + (car org-time-stamp-formats)) + time)))) + (goto-char (point-min)) + (widen) + (if (looking-at "[ \t]+\r?\n") + (replace-match "")) + ts))) (defun org-occur (regexp &optional callback) "Make a compact tree which shows all matches of REGEXP. @@ -4100,7 +4613,7 @@ that the match should indeed be shown." (let ((cnt 0)) (save-excursion (goto-char (point-min)) - (hide-sublevels 1) + (org-overview) (while (re-search-forward regexp nil t) (when (or (not callback) (save-match-data (funcall callback))) @@ -4340,7 +4853,7 @@ used to insert the time stamp into the buffer to include the time." ;; the range start. (if (save-excursion (re-search-backward - (concat org-ts-regexp "--\\=") ; FIXME: exactly two minuses? + (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses (- (point) 20) t)) (apply 'encode-time @@ -4348,8 +4861,8 @@ used to insert the time stamp into the buffer to include the time." (parse-time-string (match-string 1)))) ct)) (calendar-move-hook nil) - (view-calendar-holidays-initially nil) (view-diary-entries-initially nil) + (view-calendar-holidays-initially nil) (timestr (format-time-string (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") default-time)) (prompt (format "YYYY-MM-DD [%s]: " timestr)) @@ -4761,7 +5274,6 @@ If there is already a time stamp at the cursor position, update it." (defvar org-agenda-type 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. @@ -4778,7 +5290,7 @@ The following commands are available: (org-add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local) (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local) (unless org-agenda-keep-modes - (setq org-agenda-follow-mode nil + (setq org-agenda-follow-mode org-agenda-start-with-follow-mode org-agenda-show-log nil)) (easy-menu-change '("Agenda") "Agenda Files" @@ -4815,6 +5327,8 @@ The following commands are available: (define-key org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-date-earlier) (define-key org-agenda-mode-map ">" 'org-agenda-date-prompt) +(define-key org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule) +(define-key org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline) (let ((l '(1 2 3 4 5 6 7 8 9 0))) (while l (define-key org-agenda-mode-map (int-to-string (pop l)) 'digit-argument))) @@ -4878,10 +5392,12 @@ The following commands are available: ("Tags" ["Show all Tags" org-agenda-show-tags t] ["Set Tags" org-agenda-set-tags t]) - ("Reschedule" + ("Schedule" + ["Schedule" org-agenda-schedule t] + ["Set Deadline" org-agenda-deadline t] + "--" ["Reschedule +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)] ["Reschedule -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)] - "--" ["Reschedule to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)]) ("Priority" ["Set Priority" org-agenda-priority t] @@ -4945,6 +5461,7 @@ next use of \\[org-agenda]) restricted to the current file." (interactive "P") (catch 'exit (let ((restrict-ok (and buffer-file-name (eq major-mode 'org-mode))) + (bfn buffer-file-name) (custom org-agenda-custom-commands) c entry key type string) (put 'org-agenda-files 'org-restrict nil) @@ -4979,7 +5496,7 @@ C Configure your own agenda commands") (message "") (when (equal c ?1) (if restrict-ok - (put 'org-agenda-files 'org-restrict (list buffer-file-name)) + (put 'org-agenda-files 'org-restrict (list bfn)) (error "Cannot restrict agenda to current buffer")) (message "Press key for agenda command%s" (if restrict-ok " (restricted to current file)" "")) @@ -4991,18 +5508,16 @@ C Configure your own agenda commands") ((equal c ?C) (customize-variable 'org-agenda-custom-commands)) ((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 ?T) (org-call-with-arg 'org-todo-list (or arg '(4)))) ((equal c ?m) (call-interactively 'org-tags-view)) - ((equal c ?M) - (setq current-prefix-arg (or arg '(4))) - (call-interactively 'org-tags-view)) + ((equal c ?M) (org-call-with-arg 'org-tags-view (or arg '(4)))) ((setq entry (assoc (char-to-string c) org-agenda-custom-commands)) (setq type (nth 1 entry) string (nth 2 entry)) (cond ((eq type 'tags) (org-tags-view current-prefix-arg string)) + ((eq type 'tags-todo) + (org-tags-view '(4) string)) ((eq type 'todo) (org-todo-list string)) ((eq type 'tags-tree) @@ -5159,12 +5674,13 @@ 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 doclosed)) ; always include today + t doclosed ; always include today + org-timeline-show-empty-dates)) (today (time-to-days (current-time))) (org-respect-restriction t) (past t) args - s e rtn d) + s e rtn d emptyp) (setq org-agenda-redo-command (list 'progn (list 'switch-to-buffer-other-window (current-buffer)) @@ -5184,28 +5700,35 @@ dates." (push :timestamp args) (if dotodo (push :todo args)) (while (setq d (pop day-numbers)) - (if (and (>= d today) - dopast - past) - (progn - (setq past nil) - (insert (make-string 79 ?-) "\n"))) - (setq date (calendar-gregorian-from-absolute d)) - (setq s (point)) - (setq rtn (apply 'org-agenda-get-day-entries - entry date args)) - (if (or rtn (equal d today)) + (if (and (listp d) (eq (car d) :omitted)) (progn - (insert (calendar-day-name date) " " - (number-to-string (extract-calendar-day date)) " " - (calendar-month-name (extract-calendar-month date)) " " - (number-to-string (extract-calendar-year date)) "\n") - (put-text-property s (1- (point)) 'face - 'org-level-3) - (if (equal d today) - (put-text-property s (1- (point)) 'org-today t)) - (insert (org-finalize-agenda-entries rtn) "\n") - (put-text-property s (1- (point)) 'day d)))) + (setq s (point)) + (insert (format "\n[... %d empty days omitted]\n\n" (cdr d))) + (put-text-property s (1- (point)) 'face 'org-level-3)) + (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil)) + (if (and (>= d today) + dopast + past) + (progn + (setq past nil) + (insert (make-string 79 ?-) "\n"))) + (setq date (calendar-gregorian-from-absolute d)) + (setq s (point)) + (setq rtn (and (not emptyp) + (apply 'org-agenda-get-day-entries + entry date args))) + (if (or rtn (equal d today) org-timeline-show-empty-dates) + (progn + (insert (calendar-day-name date) " " + (number-to-string (extract-calendar-day date)) " " + (calendar-month-name (extract-calendar-month date)) " " + (number-to-string (extract-calendar-year date)) "\n") + (put-text-property s (1- (point)) 'face + 'org-level-3) + (if (equal d today) + (put-text-property s (1- (point)) 'org-today t)) + (and rtn (insert (org-finalize-agenda-entries rtn) "\n")) + (put-text-property s (1- (point)) 'day d))))) (goto-char (point-min)) (setq buffer-read-only t) (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) @@ -5432,7 +5955,7 @@ If ERROR is non-nil, throw an error, otherwise just return nil." (if (memq org-agenda-type types) t (if error - (error "Now allowed in %s-type agenda buffers" org-agenda-type) + (error "Not allowed in %s-type agenda buffers" org-agenda-type) nil))) (defun org-agenda-quit () @@ -5768,14 +6291,15 @@ Optional argument FILE means, use this file instead of the current." (defun org-file-menu-entry (file) (vector file (list 'find-file file) t)) -(defun org-get-all-dates (beg end &optional no-ranges force-today inactive) +(defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty) "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. If INACTIVE is non-nil, also -inactive time stamps (those in square brackets) are included." +inactive time stamps (those in square brackets) are included. +When EMPTY is non-nil, also include days without any entries." (let ((re (if inactive org-ts-regexp-both org-ts-regexp)) - dates date day day1 day2 ts1 ts2) + dates dates1 date day day1 day2 ts1 ts2) (if force-today (setq dates (list (time-to-days (current-time))))) (save-excursion @@ -5793,7 +6317,19 @@ inactive time stamps (those in square brackets) are included." day2 (time-to-days (org-time-string-to-time ts2))) (while (< (setq day1 (1+ day1)) day2) (or (memq day1 dates) (push day1 dates))))) - (sort dates '<)))) + (setq dates (sort dates '<)) + (when empty + (while (setq day (pop dates)) + (setq day2 (car dates)) + (push day dates1) + (when (and day2 empty) + (if (or (eq empty t) + (and (numberp empty) (<= (- day2 day) empty))) + (while (< (setq day (1+ day)) day2) + (push (list day) dates1)) + (push (cons :omitted (- day2 day)) dates1)))) + (setq dates (nreverse dates1))) + dates))) ;;;###autoload (defun org-diary (&rest args) @@ -5977,27 +6513,32 @@ the documentation of `org-diary'." "\\)\\>") org-not-done-regexp) "[^\n\r]*\\)")) + (sched-re (concat ".*\n?.*?" org-scheduled-time-regexp)) marker priority category tags ee txt) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (goto-char (match-beginning 1)) - (setq marker (org-agenda-new-marker (1+ (match-beginning 0))) - category (org-get-category) - tags (org-get-tags-at (point)) - txt (org-format-agenda-item "" (match-string 1) category tags) - priority - (+ (org-get-priority txt) - (if org-todo-kwd-priority-p - (- org-todo-kwd-max-priority -2 - (length - (member (match-string 2) org-todo-keywords))) - 1))) - (org-add-props txt props - 'org-marker marker 'org-hd-marker marker - 'priority priority 'category category) - (push txt ee) - (goto-char (match-end 1))) + (when (not (and org-agenda-todo-ignore-scheduled + (save-match-data (looking-at sched-re)))) + (goto-char (match-beginning 1)) + (setq marker (org-agenda-new-marker (1+ (match-beginning 0))) + category (org-get-category) + tags (org-get-tags-at (point)) + txt (org-format-agenda-item "" (match-string 1) category tags) + priority + (+ (org-get-priority txt) + (if org-todo-kwd-priority-p + (- org-todo-kwd-max-priority -2 + (length + (member (match-string 2) org-todo-keywords))) + 1))) + (org-add-props txt props + 'org-marker marker 'org-hd-marker marker + 'priority priority 'category category) + (push txt ee)) + (if org-agenda-todo-list-sublevels + (goto-char (match-end 1)) + (org-end-of-subtree 'invisible))) (nreverse ee))) (defconst org-agenda-no-heading-message @@ -6133,7 +6674,7 @@ the documentation of `org-diary'." (todayp (equal date (calendar-current-date))) ; DATE bound by calendar (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar d2 diff pos pos1 category tags - ee txt head) + ee txt head face) (goto-char (point-min)) (while (re-search-forward regexp nil t) (setq pos (1- (match-beginning 1)) @@ -6160,20 +6701,16 @@ the documentation of `org-diary'." (setq txt (org-format-agenda-item (format "In %3d d.: " diff) head category tags)))) (setq txt org-agenda-no-heading-message)) - (when txt + (when txt + (setq face (cond ((<= diff 0) 'org-warning) + ((<= diff 5) 'org-upcoming-deadline) + (t nil))) (org-add-props txt props 'org-marker (org-agenda-new-marker pos) 'org-hd-marker (org-agenda-new-marker pos1) 'priority (+ (- 10 diff) (org-get-priority txt)) 'category category - 'face (cond ((<= diff 0) 'org-warning) - ((<= diff 5) 'org-scheduled-previously) - (t nil)) - 'undone-face (cond - ((<= diff 0) 'org-warning) - ((<= diff 5) 'org-scheduled-previously) - (t nil)) - 'done-face 'org-done) + 'face face 'undone-face face 'done-face 'org-done) (push txt ee))))) ee)) @@ -6351,14 +6888,19 @@ only the correctly processes TXT should be returned - this is used by t)) (setq txt (replace-match "" nil nil txt)))) ;; Normalize the time(s) to 24 hour - (if s1 (setq s1 (org-get-time-of-day s1 'string))) - (if s2 (setq s2 (org-get-time-of-day s2 'string)))) - - (when (and (or (eq org-agenda-remove-tags-when-in-prefix t) - (and org-agenda-remove-tags-when-in-prefix - org-prefix-has-tag)) - (string-match ":[a-zA-Z_@0-9:]+:[ \t]*$" txt)) - (setq txt (replace-match "" t t txt))) + (if s1 (setq s1 (org-get-time-of-day s1 'string t))) + (if s2 (setq s2 (org-get-time-of-day s2 'string t)))) + + (when (string-match "\\([ \t]+\\)\\(:[a-zA-Z_@0-9:]+:\\)[ \t]*$" txt) + ;; Tags are in the string + (if (or (eq org-agenda-remove-tags-when-in-prefix t) + (and org-agenda-remove-tags-when-in-prefix + org-prefix-has-tag)) + (setq txt (replace-match "" t t txt)) + (setq txt (replace-match + (concat (make-string (max (- 50 (length txt)) 1) ?\ ) + (match-string 2 txt)) + t t txt)))) ;; Create the final string (if noprefix @@ -6438,7 +6980,7 @@ The resulting form is returned and stored in the variable (setq vars (nreverse vars)) (setq org-prefix-format-compiled `(format ,s ,@vars)))) -(defun org-get-time-of-day (s &optional string) +(defun org-get-time-of-day (s &optional string mod24) "Check string S for a time of day. If found, return it as a military time number between 0 and 2400. If not found, return nil. @@ -6451,16 +6993,19 @@ HH:MM." "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s)) - (let* ((t0 (+ (* 100 - (+ (string-to-number (match-string 1 s)) - (if (and (match-beginning 4) - (equal (downcase (match-string 4 s)) "pm")) - 12 0))) - (if (match-beginning 3) - (string-to-number (match-string 3 s)) - 0))) - (t1 (concat " " - (if (< t0 100) "0" "") (if (< t0 10) "0" "") + (let* ((h (string-to-number (match-string 1 s))) + (m (if (match-end 3) (string-to-number (match-string 3 s)) 0)) + (ampm (if (match-end 4) (downcase (match-string 4 s)))) + (am-p (equal ampm "am")) + (h1 (cond ((not ampm) h) + ((= h 12) (if am-p 0 12)) + (t (+ h (if am-p 0 12))))) + (h2 (if (and string mod24 (not (and (= m 0) (= h1 24)))) + (mod h1 24) h1)) + (t0 (+ (* 100 h2) m)) + (t1 (concat (if (>= h1 24) "+" " ") + (if (< t0 100) "0" "") + (if (< t0 10) "0" "") (int-to-string t0)))) (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) @@ -6470,7 +7015,7 @@ HH:MM." (mapconcat 'identity (sort list 'org-entries-lessp) "\n")) (defun org-agenda-highlight-todo (x) - (let (re) + (let (re pl) (if (eq x 'line) (save-excursion (beginning-of-line 1) @@ -6479,8 +7024,9 @@ HH:MM." (and (looking-at (concat "[ \t]*" re)) (add-text-properties (match-beginning 0) (match-end 0) '(face org-todo)))) - (setq re (get-text-property 0 'org-not-done-regexp x)) - (and re (string-match re x) + (setq re (get-text-property 0 'org-not-done-regexp x) + pl (get-text-property 0 'prefix-length x)) + (and re (equal (string-match re x pl) pl) (add-text-properties (match-beginning 0) (match-end 0) '(face org-todo) x)) x))) @@ -6503,7 +7049,7 @@ HH:MM." (defsubst org-cmp-time (a b) "Compare the time-of-day values of strings A and B." - (let* ((def (if org-sort-agenda-notime-is-late 2401 -1)) + (let* ((def (if org-sort-agenda-notime-is-late 9901 -1)) (ta (or (get-text-property 1 'time-of-day a) def)) (tb (or (get-text-property 1 'time-of-day b) def))) (cond ((< ta tb) -1) @@ -6537,7 +7083,8 @@ and by additional input from the age of a schedules or deadline entry." (interactive) (let* ((tags (get-text-property (point-at-bol) 'tags))) (if tags - (message "Tags are :%s:" (mapconcat 'identity tags ":")) + (message "Tags are :%s:" + (org-no-properties (mapconcat 'identity tags ":"))) (message "No tags associated with this line")))) (defun org-agenda-goto (&optional highlight) @@ -6723,7 +7270,7 @@ the same tree node, and the headline of the tree node in the Org-mode file." (beginning-of-line 1))) (defun org-get-tags-at (&optional pos) - "Get a list of all headline targs applicable at POS. + "Get a list of all headline tags applicable at POS. POS defaults to point. If tags are inherited, the list contains the targets in the same sequence as the headlines appear, i.e. the tags of the current headline come last." @@ -6736,7 +7283,9 @@ the tags of the current headline come last." (condition-case nil (while t (if (looking-at "[^\r\n]+?:\\([a-zA-Z_@0-9:]+\\):[ \t]*\\([\n\r]\\|\\'\\)") - (setq tags (append (org-split-string (match-string 1) ":") tags))) + (setq tags (append (org-split-string + (org-match-string-no-properties 1) ":") + tags))) (or org-use-tag-inheritance (error "")) (org-up-heading-all 1)) (error nil)))) @@ -6808,6 +7357,40 @@ be used to request time specification in the time stamp." (org-time-stamp arg) (message "Time stamp changed to %s" org-last-changed-timestamp)))) +(defun org-agenda-schedule (arg) + "Schedule the item at point." + (interactive "P") + (org-agenda-check-type t 'agenda 'timeline 'todo 'tags) + (org-agenda-check-no-diary) + (let* ((marker (or (get-text-property (point) 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + (org-insert-labeled-timestamps-at-point nil) + ts) + (with-current-buffer buffer + (widen) + (goto-char pos) + (setq ts (org-schedule)) + (message "Item scheduled for %s" ts)))) + +(defun org-agenda-deadline (arg) + "Schedule the item at point." + (interactive "P") + (org-agenda-check-type t 'agenda 'timeline 'todo 'tags) + (org-agenda-check-no-diary) + (let* ((marker (or (get-text-property (point) 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + (org-insert-labeled-timestamps-at-point nil) + ts) + (with-current-buffer buffer + (widen) + (goto-char pos) + (setq ts (org-deadline)) + (message "Deadline for this item set to %s" ts)))) + (defun org-get-heading () "Return the heading of the current entry, without the stars." (save-excursion @@ -6980,7 +7563,7 @@ are included in the output." (save-excursion (goto-char (point-min)) - (when (eq action 'sparse-tree) (hide-sublevels 1)) + (when (eq action 'sparse-tree) (org-overview)) (while (re-search-forward re nil t) (setq todo (if (match-end 1) (match-string 2)) tags (if (match-end 4) (match-string 4))) @@ -7108,6 +7691,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (with-current-buffer buffer (unless (eq major-mode 'org-mode) (error "Agenda file %s is not in `org-mode'" file)) + (setq org-category-table (org-get-category-table)) (save-excursion (save-restriction (if org-respect-restriction @@ -7139,11 +7723,11 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (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)) + (interactive "P") + (let* ((re (concat "^" outline-regexp)) (col (current-column)) (current (org-get-tags)) + table current-tags inherited-tags ; computed below when needed tags hd empty invis) (if arg (save-excursion @@ -7153,16 +7737,23 @@ With prefix ARG, realign all tags in headings in the current buffer." (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) - 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))) + (setq table (or org-tag-alist (org-get-buffer-tags)) + org-last-tags-completion-table table + current-tags (org-split-string current ":") + inherited-tags (nreverse + (nthcdr (length current-tags) + (nreverse (org-get-tags-at)))) + tags + (if (or (eq t org-use-fast-tag-selection) + (and org-use-fast-tag-selection + (delq nil (mapcar 'cdr table)))) + (org-fast-tag-selection current-tags inherited-tags table) + (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)))) - ;; FIXME: still optimize this by not checking when JUST-ALIGN? + (unless (setq empty (string-match "\\`[\t ]*\\'" tags)) (unless (string-match ":$" tags) (setq tags (concat tags ":"))) (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) @@ -7188,7 +7779,8 @@ With prefix ARG, realign all tags in headings in the current buffer." (move-to-column col)))) (defun org-tags-completion-function (string predicate &optional flag) - (let (s1 s2 rtn (ctable org-last-tags-completion-table)) + (let (s1 s2 rtn (ctable org-last-tags-completion-table) + (confirm (lambda (x) (stringp (car x))))) (if (string-match "^\\(.*[-+:&|]\\)\\([^-+:&|]*\\)$" string) (setq s1 (match-string 1 string) s2 (match-string 2 string)) @@ -7196,7 +7788,7 @@ With prefix ARG, realign all tags in headings in the current buffer." (cond ((eq flag nil) ;; try completion - (setq rtn (try-completion s2 ctable)) + (setq rtn (try-completion s2 ctable confirm)) (if (stringp rtn) (concat s1 s2 (substring rtn (length s2)) (if (and org-add-colon-after-tag-completion @@ -7205,13 +7797,133 @@ With prefix ARG, realign all tags in headings in the current buffer." ) ((eq flag t) ;; all-completions - (all-completions s2 ctable) + (all-completions s2 ctable confirm) ) ((eq flag 'lambda) ;; exact match? (assoc s2 ctable))) )) +(defun org-fast-tag-insert (kwd tags face &optional end) + "Insert KDW, and the TAGS, the latter with face FACE. Also inser END." + (insert (format "%-12s" (concat kwd ":")) + (org-add-props (mapconcat 'identity tags " ") nil 'face face) + (or end ""))) + +(defun org-fast-tag-selection (current inherited table) + "Fast tag selection with single keys. +CURRENT is the current list of tags in the headline, INHERITED is the +list of inherited tags, and TABLE is an alist of tags and corresponding keys, +possibly with grouping information. +If the keys are nil, a-z are automatically assigned. +Returns the new tags string, or nil to not change the current settings." + (let* ((maxlen (apply 'max (mapcar + (lambda (x) + (if (stringp (car x)) (string-width (car x)) 0)) + table))) + (fwidth (+ maxlen 3 1 3)) + (ncol (/ (- (window-width) 4) fwidth)) + (i-face 'org-done) + (c-face 'org-tag) + tg cnt e c char c1 c2 ntable tbl rtn + groups ingroup) + (save-window-excursion + (delete-other-windows) + (split-window-vertically) + (switch-to-buffer-other-window (get-buffer-create " *Org tags*")) + (erase-buffer) + (org-fast-tag-insert "Inherited" inherited i-face "\n") + (org-fast-tag-insert "Current" current c-face "\n\n") + (setq tbl table char ?a cnt 0) + (while (setq e (pop tbl)) + (cond + ((equal e '(:startgroup)) + (push '() groups) (setq ingroup t) + (when (not (= cnt 0)) + (setq cnt 0) + (insert "\n")) + (insert "{ ")) + ((equal e '(:endgroup)) + (setq ingroup nil cnt 0) + (insert "}\n")) + (t + (setq tg (car e) c2 nil) + (if (cdr e) + (setq c (cdr e)) + ;; automatically assign a character. + (setq c1 (string-to-char + (downcase (substring + tg (if (= (string-to-char tg) ?@) 1 0))))) + (if (or (rassoc c1 ntable) (rassoc c1 table)) + (while (or (rassoc char ntable) (rassoc char table)) + (setq char (1+ char))) + (setq c2 c1)) + (setq c (or c2 char))) + (if ingroup (push tg (car groups))) + (setq tg (org-add-props tg nil 'face + (cond + ((member tg current) c-face) + ((member tg inherited) i-face) + (t nil)))) + (if (and (= cnt 0) (not ingroup)) (insert " ")) + (insert "[" c "] " tg (make-string + (- fwidth 4 (length tg)) ?\ )) + (push (cons tg c) ntable) + (when (= (setq cnt (1+ cnt)) ncol) + (insert "\n") + (if ingroup (insert " ")) + (setq cnt 0))))) + (setq ntable (nreverse ntable)) + (insert "\n") + (goto-char (point-min)) + (if (fboundp 'fit-window-to-buffer) (fit-window-to-buffer)) + (setq rtn + (catch 'exit + (while t + (message "[key]:Toggle SPC: clear current RET accept%s" + (if groups " [!] ignore goups" "")) + (setq c (read-char-exclusive)) + (cond + ((= c ?\r) (throw 'exit t)) + ((= c ?!) + (setq groups nil) + (goto-char (point-min)) + (while (re-search-forward "[{}]" nil t) (replace-match " "))) + ((or (= c ?\C-g) + (and (= c ?q) (not (rassoc c ntable)))) + (setq quit-flag t)) + ((= c ?\ ) (setq current nil)) + ((setq e (rassoc c ntable) tg (car e)) + (if (member tg current) + (setq current (delete tg current)) + (loop for g in groups do + (if (member tg g) + (mapcar (lambda (x) + (setq current (delete x current))) + g))) + (setq current (cons tg current))))) + ;; Create a sorted list + (setq current + (sort current + (lambda (a b) + (assoc b (cdr (memq (assoc a ntable) ntable)))))) + (goto-char (point-min)) + (beginning-of-line 2) + (delete-region (point) (point-at-eol)) + (org-fast-tag-insert "Current" current c-face) + (while (re-search-forward "\\[.\\] \\([a-zA-Z0-9_@]+\\)" nil t) + (setq tg (match-string 1)) + (add-text-properties (match-beginning 1) (match-end 1) + (list 'face + (cond + ((member tg current) c-face) + ((member tg inherited) i-face) + (t nil))))) + (goto-char (point-min))))) + (if rtn + (mapconcat 'identity current ":") + nil)))) + (defun org-get-tags () "Get the TAGS string in the current headline." (unless (org-on-heading-p) @@ -7234,6 +7946,50 @@ With prefix ARG, realign all tags in headings in the current buffer." ;;; Link Stuff +(defvar org-create-file-search-functions nil + "List of functions to construct the right search string for a file link. +These functions are called in turn with point at the location to +which the link should point. + +A function in the hook should first test if it would like to +handle this file type, for example by checking the major-mode or +the file extension. If it decides not to handle this file, it +should just return nil to give other functions a chance. If it +does handle the file, it must return the search string to be used +when following the link. The search string will be part of the +file link, given after a double colon, and `org-open-at-point' +will automatically search for it. If special measures must be +taken to make the search successful, another function should be +added to the companion hook `org-execute-file-search-functions', +which see. + +A function in this hook may also use `setq' to set the variable +`description' to provide a suggestion for the descriptive text to +be used for this link when it gets inserted into an Org-mode +buffer with \\[org-insert-link].") + +(defvar org-execute-file-search-functions nil + "List of functions to execute a file search triggered by a link. + +Functions added to this hook must accept a single argument, the +search string that was part of the file link, the part after the +double colon. The function must first check if it would like to +handle this search, for example by checking the major-mode or the +file extension. If it decides not to handle this search, it +should just return nil to give other functions a chance. If it +does handle the search, it must return a non-nil value to keep +other functions from trying. + +Each function can access the current prefix argument through the +variable `current-prefix-argument'. Note that a single prefix is +used to force opening a link in Emacs, so it may be good to only +use a numeric or double prefix to guide the search function. + +In case this is needed, a function in this hook can also restore +the window configuration before `org-open-at-point' was called using: + + (set-window-configuration org-window-config-before-follow-link)") + (defun org-find-file-at-mouse (ev) "Open file link or URL at mouse." (interactive "e") @@ -7246,6 +8002,10 @@ With prefix ARG, realign all tags in headings in the current buffer." (mouse-set-point ev) (org-open-at-point)) +(defvar org-window-config-before-follow-link nil + "The window configuration before following a link. +This is saved in case the need arises to restore it.") + (defun org-open-at-point (&optional in-emacs) "Open link at or after point. If there is no link at point, this function will search forward up to @@ -7253,6 +8013,7 @@ the end of the current subtree. Normally, files will be opened by an appropriate application. If the optional argument IN-EMACS is non-nil, Emacs will visit the file." (interactive "P") + (setq org-window-config-before-follow-link (current-window-configuration)) (org-remove-occur-highlights nil nil t) (if (org-at-timestamp-p) (org-agenda-list nil (time-to-days (org-time-string-to-time @@ -7336,7 +8097,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file." (t nil)))) ((string= type "file") - (if (string-match "::?\\([0-9]+\\)\\'" path) ;; second : optional + (if (string-match "::\\([0-9]+\\)\\'" path) (setq line (string-to-number (match-string 1 path)) path (substring path 0 (match-beginning 0))) (if (string-match "::\\(.+\\)\\'" path) @@ -7350,6 +8111,9 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file." ((string= type "bbdb") (org-follow-bbdb-link path)) + ((string= type "info") + (org-follow-info-link path)) + ((string= type "gnus") (let (group article) (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) @@ -7397,8 +8161,8 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file." (setq cmd (replace-match "<" t t cmd))) (while (string-match "@}" cmd) (setq cmd (replace-match ">" t t cmd))) - (if (or (not org-confirm-shell-links) - (funcall org-confirm-shell-links + (if (or (not org-confirm-shell-link-function) + (funcall org-confirm-shell-link-function (format "Execute \"%s\" in shell? " (org-add-props cmd nil 'face 'org-warning)))) @@ -7407,6 +8171,16 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file." (shell-command cmd)) (error "Abort")))) + ((string= type "elisp") + (let ((cmd path)) + (if (or (not org-confirm-elisp-link-function) + (funcall org-confirm-elisp-link-function + (format "Execute \"%s\" as elisp? " + (org-add-props cmd nil + 'face 'org-warning)))) + (message "%s => %s" cmd (eval (read cmd))) + (error "Abort")))) + (t (browse-url-at-point)))))) @@ -7423,73 +8197,77 @@ in all files." (pos (point)) (pre "") (post "") words re0 re1 re2 re3 re4 re5 re2a reall camel) - (cond ((save-excursion - (goto-char (point-min)) - (and - (re-search-forward - (concat "<<" (regexp-quote s0) ">>") nil t) - (setq pos (match-beginning 0)))) - ;; There is an exact target for this - (goto-char pos)) - ((string-match "^/\\(.*\\)/$" s) - ;; A regular expression - (cond - ((eq major-mode 'org-mode) - (org-occur (match-string 1 s))) - ;;((eq major-mode 'dired-mode) - ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *"))) - (t (org-do-occur (match-string 1 s))))) - ((or (setq camel (string-match (concat "^" org-camel-regexp "$") s)) - t) - ;; A camel or a normal search string - (when (equal (string-to-char s) ?*) - ;; Anchor on headlines, post may include tags. - (setq pre "^\\*+[ \t]*\\(\\sw+\\)?[ \t]*" - post "[ \t]*\\([ \t]+:[a-zA-Z_@0-9:+]:[ \t]*\\)?$" - s (substring s 1))) - (remove-text-properties - 0 (length s) - '(face nil mouse-face nil keymap nil fontified nil) s) - ;; Make a series of regular expressions to find a match - (setq words - (if camel - (org-camel-to-words s) - (org-split-string s "[ \n\r\t]+")) - re0 (concat "<<" (regexp-quote s0) ">>") - re2 (concat "\\<" (mapconcat 'downcase words "[ \t]+") "\\>") - re2a (concat "\\<" (mapconcat 'downcase words "[ \t\r\n]+") "\\>") - re4 (concat "\\<" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\>") - re1 (concat pre re2 post) - re3 (concat pre re4 post) - re5 (concat pre ".*" re4) - re2 (concat pre re2) - re2a (concat pre re2a) - re4 (concat pre re4) - reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2 - "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\(" - re5 "\\)" - )) - (cond - ((eq type 'org-occur) (org-occur reall)) - ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup)) - (t (goto-char (point-min)) - (if (or (org-search-not-link re0 nil t) - (org-search-not-link re1 nil t) - (org-search-not-link re2 nil t) - (org-search-not-link re2a nil t) - (org-search-not-link re3 nil t) - (org-search-not-link re4 nil t) - (org-search-not-link re5 nil t) - ) - (goto-char (match-beginning 0)) - (goto-char pos) - (error "No match"))))) - (t - ;; Normal string-search - (goto-char (point-min)) - (if (search-forward s nil t) - (goto-char (match-beginning 0)) - (error "No match")))) + (cond + ;; First check if there are any special + ((run-hook-with-args-until-success 'org-execute-file-search-functions s)) + ;; Now try the builtin stuff + ((save-excursion + (goto-char (point-min)) + (and + (re-search-forward + (concat "<<" (regexp-quote s0) ">>") nil t) + (setq pos (match-beginning 0)))) + ;; There is an exact target for this + (goto-char pos)) + ((string-match "^/\\(.*\\)/$" s) + ;; A regular expression + (cond + ((eq major-mode 'org-mode) + (org-occur (match-string 1 s))) + ;;((eq major-mode 'dired-mode) + ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *"))) + (t (org-do-occur (match-string 1 s))))) + ((or (setq camel (string-match (concat "^" org-camel-regexp "$") s)) + t) + ;; A camel or a normal search string + (when (equal (string-to-char s) ?*) + ;; Anchor on headlines, post may include tags. + (setq pre "^\\*+[ \t]*\\(?:\\sw+\\)?[ \t]*" + post "[ \t]*\\(?:[ \t]+:[a-zA-Z_@0-9:+]:[ \t]*\\)?$" + s (substring s 1))) + (remove-text-properties + 0 (length s) + '(face nil mouse-face nil keymap nil fontified nil) s) + ;; Make a series of regular expressions to find a match + (setq words + (if camel + (org-camel-to-words s) + (org-split-string s "[ \n\r\t]+")) + re0 (concat "\\(<<" (regexp-quote s0) ">>\\)") + re2 (concat "[ \t\r\n]\\(" (mapconcat 'downcase words "[ \t]+") "\\)[ \t\r\n]") + re2a (concat "[ \t\r\n]\\(" (mapconcat 'downcase words "[ \t\r\n]+") "\\)[ \t\r\n]") + re4 (concat "[^a-zA-Z_]\\(" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]") + re1 (concat pre re2 post) + re3 (concat pre re4 post) + re5 (concat pre ".*" re4) + re2 (concat pre re2) + re2a (concat pre re2a) + re4 (concat pre re4) + reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2 + "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\(" + re5 "\\)" + )) + (cond + ((eq type 'org-occur) (org-occur reall)) + ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup)) + (t (goto-char (point-min)) + (if (or (org-search-not-link re0 nil t) + (org-search-not-link re1 nil t) + (org-search-not-link re2 nil t) + (org-search-not-link re2a nil t) + (org-search-not-link re3 nil t) + (org-search-not-link re4 nil t) + (org-search-not-link re5 nil t) + ) + (goto-char (match-beginning 1)) + (goto-char pos) + (error "No match"))))) + (t + ;; Normal string-search + (goto-char (point-min)) + (if (search-forward s nil t) + (goto-char (match-beginning 0)) + (error "No match")))) (and (eq major-mode 'org-mode) (org-show-hierarchy-above)))) (defun org-search-not-link (&rest args) @@ -7609,6 +8387,18 @@ onto the ring." (delete-window (get-buffer-window "*BBDB*")) (error "No matching BBDB record"))))) + +(defun org-follow-info-link (name) + "Follow an info file & node link to NAME." + (if (or (string-match "\\(.*\\)::?\\(.*\\)" name) + (string-match "\\(.*\\)" name)) + (progn + (require 'info) + (if (match-string 2 name) ; If there isn't a node, choose "Top" + (Info-find-node (match-string 1 name) (match-string 2 name)) + (Info-find-node (match-string 1 name) "Top"))) + (message (concat "Could not open: " name)))) + (defun org-follow-gnus-link (&optional group article) "Follow a Gnus link to GROUP and ARTICLE." (require 'gnus) @@ -7792,6 +8582,61 @@ folders." (kill-this-buffer) (error "Message not found")))) +;; BibTeX links + +;; Use the custom search meachnism to construct and use search strings for +;; file links to BibTeX database entries. + +(defun org-create-file-search-in-bibtex () + "Create the search string and description for a BibTeX database entry." + (when (eq major-mode 'bibtex-mode) + ;; yes, we want to construct this search string. + ;; Make a good description for this entry, using names, year and the title + ;; Put it into the `description' variable which is dynamically scoped. + (let ((bibtex-autokey-names 1) + (bibtex-autokey-names-stretch 1) + (bibtex-autokey-name-case-convert-function 'identity) + (bibtex-autokey-name-separator " & ") + (bibtex-autokey-additional-names " et al.") + (bibtex-autokey-year-length 4) + (bibtex-autokey-name-year-separator " ") + (bibtex-autokey-titlewords 3) + (bibtex-autokey-titleword-separator " ") + (bibtex-autokey-titleword-case-convert-function 'identity) + (bibtex-autokey-titleword-length 'infty) + (bibtex-autokey-year-title-separator ": ")) + (setq description (bibtex-generate-autokey))) + ;; Now parse the entry, get the key and return it. + (save-excursion + (bibtex-beginning-of-entry) + (cdr (assoc "=key=" (bibtex-parse-entry)))))) + +(defun org-execute-file-search-in-bibtex (s) + "Find the link search string S as a key for a database entry." + (when (eq major-mode 'bibtex-mode) + ;; Yes, we want to do the search in this file. + ;; We construct a regexp that searches for "@entrytype{" followed by the key + (goto-char (point-min)) + (and (re-search-forward (concat "@[a-zA-Z]+[ \t\n]*{[ \t\n]*" + (regexp-quote s) "[ \t\n]*,") nil t) + (goto-char (match-beginning 0))) + (if (and (match-beginning 0) (equal current-prefix-arg '(16))) + ;; Use double prefix to indicate that any web link should be browsed + (let ((b (current-buffer)) (p (point))) + ;; Restore the window configuration because we just use the web link + (set-window-configuration org-window-config-before-follow-link) + (save-excursion (set-buffer b) (goto-char p) + (bibtex-url))) + (recenter 0)) ; Move entry start to beginning of window + ;; return t to indicate that the search is done. + t)) + +;; Finally add the functions to the right hooks. +(add-hook 'org-create-file-search-functions 'org-create-file-search-in-bibtex) +(add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex) + +;; end of Bibtex link setup + (defun org-upgrade-old-links (&optional query-description) "Transfer old <...> style links to new [[...]] style links. With arg query-description, ask at each match for a description text to use @@ -7907,7 +8752,7 @@ For some link types, a prefix arg is interpreted: For links to usenet articles, arg negates `org-usenet-links-prefer-google'. For file links, arg negates `org-context-in-file-links'." (interactive "P") - (let (link cpltxt desc txt (pos (point))) + (let (link cpltxt desc description search txt (pos (point))) (cond ((eq major-mode 'bbdb-mode) @@ -7917,6 +8762,13 @@ For file links, arg negates `org-context-in-file-links'." (bbdb-record-company (bbdb-current-record)))) link (org-make-link cpltxt))) + ((eq major-mode 'Info-mode) + (setq link (org-make-link "info:" + (file-name-nondirectory Info-current-file) + ":" Info-current-node)) + (setq cpltxt (concat (file-name-nondirectory Info-current-file) + ":" Info-current-node))) + ((eq major-mode 'calendar-mode) (let ((cd (calendar-cursor-to-date))) (setq link @@ -8020,6 +8872,12 @@ For file links, arg negates `org-context-in-file-links'." (setq cpltxt w3m-current-url link (org-make-link cpltxt))) + ((setq search (run-hook-with-args-until-success + 'org-create-file-search-functions)) + (setq link (concat "file:" (abbreviate-file-name buffer-file-name) + "::" search)) + (setq cpltxt (or description link))) + ((eq major-mode 'org-mode) ;; Just link to current headline (setq cpltxt (concat "file:" @@ -8039,12 +8897,13 @@ For file links, arg negates `org-context-in-file-links'." ((org-region-active-p) (buffer-substring (region-beginning) (region-end))) (t (buffer-substring (point-at-bol) (point-at-eol))))) - (setq cpltxt - (concat cpltxt "::" - (if org-file-link-context-use-camel-case - (org-make-org-heading-camel txt) - (org-make-org-heading-search-string txt))) - desc "NONE"))) + (when (or (null txt) (string-match "\\S-" txt)) + (setq cpltxt + (concat cpltxt "::" + (if org-file-link-context-use-camel-case + (org-make-org-heading-camel txt) + (org-make-org-heading-search-string txt))) + desc "NONE")))) (if (string-match "::\\'" cpltxt) (setq cpltxt (substring cpltxt 0 -2))) (setq link (org-make-link cpltxt))) @@ -8058,12 +8917,14 @@ For file links, arg negates `org-context-in-file-links'." (setq txt (if (org-region-active-p) (buffer-substring (region-beginning) (region-end)) (buffer-substring (point-at-bol) (point-at-eol)))) - (setq cpltxt - (concat cpltxt "::" - (if org-file-link-context-use-camel-case - (org-make-org-heading-camel txt) - (org-make-org-heading-search-string txt))) - desc "NONE")) + ;; Only use search option if there is some text. + (when (string-match "\\S-" txt) + (setq cpltxt + (concat cpltxt "::" + (if org-file-link-context-use-camel-case + (org-make-org-heading-camel txt) + (org-make-org-heading-search-string txt))) + desc "NONE"))) (setq link (org-make-link cpltxt))) ((interactive-p) @@ -8287,16 +9148,39 @@ is in the current directory or below." ;; URL-like link, normalize the use of angular brackets. (setq link (org-make-link (org-remove-angle-brackets link)))) - ;; Check if we are linking to the current file. If yes, simplify the link. + ;; Check if we are linking to the current file with a search option + ;; If yes, simplify the link by using only the search option. (when (string-match "\\<file:\\(.+?\\)::\\([^>]+\\)" link) (let* ((path (match-string 1 link)) (case-fold-search nil) (search (match-string 2 link))) - (when (save-match-data - (equal (file-truename buffer-file-name) - (file-truename path))) - ;; We are linking to this same file, with a search option - (setq link search)))) + (save-match-data + (if (equal (file-truename buffer-file-name) (file-truename path)) + ;; We are linking to this same file, with a search option + (setq link search))))) + + ;; Check if we can/should use a relative path. If yes, simplify the link + (when (string-match "\\<file:\\(.*\\)" link) + (let* ((path (match-string 1 link)) + (case-fold-search nil)) + (cond + ((eq org-link-file-path-type 'absolute) + (setq path (abbreviate-file-name (expand-file-name path)))) + ((eq org-link-file-path-type 'noabbrev) + (setq path (expand-file-name path))) + ((eq org-link-file-path-type 'relative) + (setq path (file-relative-name path))) + (t + (save-match-data + (if (string-match (concat "^" (regexp-quote + (file-name-as-directory + (expand-file-name ".")))) + (expand-file-name path)) + ;; We are linking a file with relative path name. + (setq path (substring (expand-file-name path) + (match-end 0))))))) + (setq link (concat "file:" path)))) + (setq desc (read-string "Description: " desc)) (unless (string-match "\\S-" desc) (setq desc nil)) (if remove (apply 'delete-region remove)) @@ -8329,48 +9213,52 @@ RET on headline -> Store as sublevel entry to current headline ;;;###autoload (defun org-remember-apply-template () - "Initialize *remember* buffer with template, invode `org-mode'. + "Initialize *remember* buffer with template, invoke `org-mode'. This function should be placed into `remember-mode-hook' and in fact requires to be run from that hook to fucntion properly." - (when org-remember-templates - (let* ((entry (if (= (length org-remember-templates) 1) - (cdar org-remember-templates) - (message "Select template: %s" - (mapconcat - (lambda (x) (char-to-string (car x))) - org-remember-templates " ")) - (cdr (assoc (read-char-exclusive) org-remember-templates)))) - (tpl (if (consp (cdr entry)) (cadr entry) (cdr entry))) - (file (if (consp (cdr entry)) (nth 2 entry))) - (v-t (format-time-string (car org-time-stamp-formats) (org-current-time))) - (v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time))) - (v-u (concat "[" (substring v-t 1 -1) "]")) - (v-U (concat "[" (substring v-T 1 -1) "]")) - (v-a annotation) ; defined in `remember-mode' - (v-i initial) ; defined in `remember-mode' - (v-n user-full-name) - ) - (unless tpl (setq tpl "") (message "No template") (ding)) - (insert tpl) (goto-char (point-min)) - (while (re-search-forward "%\\([tTuTai]\\)" nil t) - (when (and initial (equal (match-string 0) "%i")) - (save-match-data - (let* ((lead (buffer-substring - (point-at-bol) (match-beginning 0)))) - (setq v-i (mapconcat 'identity + (if org-remember-templates + + (let* ((entry (if (= (length org-remember-templates) 1) + (cdar org-remember-templates) + (message "Select template: %s" + (mapconcat + (lambda (x) (char-to-string (car x))) + org-remember-templates " ")) + (cdr (assoc (read-char-exclusive) org-remember-templates)))) + (tpl (car entry)) + (file (if (consp (cdr entry)) (nth 1 entry))) + (v-t (format-time-string (car org-time-stamp-formats) (org-current-time))) + (v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time))) + (v-u (concat "[" (substring v-t 1 -1) "]")) + (v-U (concat "[" (substring v-T 1 -1) "]")) + (v-a annotation) ; defined in `remember-mode' + (v-i initial) ; defined in `remember-mode' + (v-n user-full-name) + ) + (unless tpl (setq tpl "") (message "No template") (ding)) + (insert tpl) (goto-char (point-min)) + (while (re-search-forward "%\\([tTuTai]\\)" nil t) + (when (and initial (equal (match-string 0) "%i")) + (save-match-data + (let* ((lead (buffer-substring + (point-at-bol) (match-beginning 0)))) + (setq v-i (mapconcat 'identity (org-split-string initial "\n") (concat "\n" lead)))))) - (replace-match - (or (eval (intern (concat "v-" (match-string 1)))) "") - t t)) - (let ((org-startup-folded nil) - (org-startup-with-deadline-check nil)) - (org-mode)) - (if (and file (string-match "\\S-" file) (not (file-directory-p file))) - (set (make-local-variable 'org-default-notes-file) file)) - (goto-char (point-min)) - (if (re-search-forward "%\\?" nil t) (replace-match "")) - (set (make-local-variable 'org-finish-function) 'remember-buffer)))) + (replace-match + (or (eval (intern (concat "v-" (match-string 1)))) "") + t t)) + (let ((org-startup-folded nil) + (org-startup-with-deadline-check nil)) + (org-mode)) + (if (and file (string-match "\\S-" file) (not (file-directory-p file))) + (set (make-local-variable 'org-default-notes-file) file)) + (goto-char (point-min)) + (if (re-search-forward "%\\?" nil t) (replace-match ""))) + (let ((org-startup-folded nil) + (org-startup-with-deadline-check nil)) + (org-mode))) + (set (make-local-variable 'org-finish-function) 'remember-buffer)) ;;;###autoload (defun org-remember-handler () @@ -8439,6 +9327,9 @@ See also the variable `org-reverse-note-order'." (if (not visiting) (find-file-noselect file)) (with-current-buffer (get-file-buffer file) + (save-excursion (and (goto-char (point-min)) + (not (re-search-forward "^\\* " nil t)) + (insert "\n* Notes\n"))) (setq reversed (org-notes-order-reversed-p)) (save-excursion (save-restriction @@ -8717,7 +9608,7 @@ This is being used to correctly align a single field after TAB or RET.") ;; Check if we have links (goto-char beg) (setq links (re-search-forward org-bracket-link-regexp end t)) - ;; Make sure the link properties are right FIXME: Can this be optimized???? + ;; Make sure the link properties are right (when links (goto-char beg) (while (org-activate-bracket-links end))) ;; Check if we are narrowing any columns (goto-char beg) @@ -8866,7 +9757,7 @@ With argument TABLE-TYPE, go to the beginning of a table.el-type table." (if table-type org-table-any-border-regexp org-table-border-regexp) nil t)) - (error "Can't find beginning of table") + (progn (goto-char (point-min)) (point)) (goto-char (match-beginning 0)) (beginning-of-line 2) (point)))) @@ -8914,7 +9805,7 @@ Optional argument NEW may specify text to replace the current field content." n (format f s)) (if new (if (<= (length new) l) ;; FIXME: length -> str-width? - (setq n (format f new t t)) ;; FIXME: t t? + (setq n (format f new)) (setq n (concat new "|") org-table-may-need-update t))) (or (equal n o) (let (org-table-may-need-update) @@ -9213,7 +10104,7 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." "Please position cursor in a data line for column operations"))))) (defun org-table-delete-column () - "Delete a column into the table." + "Delete a column from the table." (interactive) (if (not (org-at-table-p)) (error "Not at a table")) @@ -9352,7 +10243,7 @@ With prefix ARG, insert above the current line." In particular, this does handle wide and invisible characters." (if (string-match "^[ \t]*|-" s) ;; It's a hline, just map the characters - (setq s (mapcar (lambda (x) (if (member x '(?| ?+)) ?| ?\ )) s)) + (setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s "")) (while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s) (setq s (replace-match (concat "|" (make-string (org-string-width (match-string 1 s)) @@ -9401,7 +10292,7 @@ also in table column 3. The command will prompt for the sorting method (lambda (a b) (< (car a) (car b))) (lambda (a b) (string< (car a) (car b))))) (setq lns (mapcar (lambda(x) (cons (org-trim (substring x bcol ecol)) x)) - (split-string (buffer-substring beg end) "\n"))) + (org-split-string (buffer-substring beg end) "\n"))) (if numericp (setq lns (mapcar (lambda(x) (cons (string-to-number (car x)) (cdr x))) @@ -9937,7 +10828,7 @@ the current column, to avoid unnecessary parsing." "\n"))) (defun org-table-get-stored-formulas () - "Return an alist with the t=stored formulas directly after current table." + "Return an alist with the stored formulas directly after current table." (interactive) (let (scol eq eq-alist strings string seen) (save-excursion @@ -10217,7 +11108,7 @@ not overwrite the stored one." (org-table-get-formula equation (equal arg '(4))))) (n0 (org-table-current-column)) (modes (copy-sequence org-calc-default-modes)) - n form fmt x ev orig c) + n form fmt x ev orig c lispp) ;; Parse the format string. Since we have a lot of modes, this is ;; a lot of work. However, I think calc still uses most of the time. (if (string-match ";" formula) @@ -10252,7 +11143,8 @@ not overwrite the stored one." (lambda (x) (number-to-string (string-to-number x))) fields))) (setq ndown (1- ndown)) - (setq form (copy-sequence formula)) + (setq form (copy-sequence formula) + lispp (equal (substring form 0 2) "'(")) ;; Insert the references to fields in same row (while (string-match "\\$\\([0-9]+\\)?" form) (setq n (if (match-beginning 1) @@ -10262,7 +11154,9 @@ not overwrite the stored one." (unless x (error "Invalid field specifier \"%s\"" (match-string 0 form))) (if (equal x "") (setq x "0")) - (setq form (replace-match (concat "(" x ")") t t form))) + (setq form (replace-match + (if lispp x (concat "(" x ")")) + t t form))) ;; Insert ranges in current column (while (string-match "\\&[-I0-9]+" form) (setq form (replace-match @@ -10270,8 +11164,11 @@ not overwrite the stored one." (org-table-get-vertical-vector (match-string 0 form) nil n0)) t t form))) - (setq ev (calc-eval (cons form modes) - (if org-table-formula-numbers-only 'num))) + (if lispp + (setq ev (eval (eval (read form))) + ev (if (numberp ev) (number-to-string ev) ev)) + (setq ev (calc-eval (cons form modes) + (if org-table-formula-numbers-only 'num)))) (when org-table-formula-debug (with-output-to-temp-buffer "*Help*" @@ -10827,6 +11724,109 @@ overwritten, and the table is not marked as requiring realignment." (defconst org-level-max 20) +(defvar org-export-html-preamble nil + "Preamble, to be inserted just after <body>. Set by publishing functions.") +(defvar org-export-html-postamble nil + "Preamble, to be inserted just before </body>. Set by publishing functions.") +(defvar org-export-html-auto-preamble t + "Should default preamble be inserted? Set by publishing functions.") +(defvar org-export-html-auto-postamble t + "Should default postamble be inserted? Set by publishing functions.") + +(defconst org-export-plist-vars + '((:language . org-export-default-language) + (:headline-levels . org-export-headline-levels) + (:section-numbers . org-export-with-section-numbers) + (:table-of-contents . org-export-with-toc) + (:emphasize . org-export-with-emphasize) + (:sub-superscript . org-export-with-sub-superscripts) + (:TeX-macros . org-export-with-TeX-macros) + (:fixed-width . org-export-with-fixed-width) + (:timestamps . org-export-with-timestamps) + (:tables . org-export-with-tables) + (:table-auto-headline . org-export-highlight-first-table-line) + (:style . org-export-html-style) + (:convert-org-links . org-export-html-link-org-files-as-html) + (:inline-images . org-export-html-inline-images) + (:expand-quoted-html . org-export-html-expand) + (:timestamp . org-export-html-with-timestamp) + (:publishing-directory . org-export-publishing-directory) + (:preamble . org-export-html-preamble) + (:postamble . org-export-html-postamble) + (:auto-preamble . org-export-html-auto-preamble) + (:auto-postamble . org-export-html-auto-postamble) + (:author . user-full-name) + (:email . user-mail-address))) + +(defun org-default-export-plist () + "Return the property list with default settings for the export variables." + (let ((l org-export-plist-vars) rtn e) + (while (setq e (pop l)) + (setq rtn (cons (car e) (cons (symbol-value (cdr e)) rtn)))) + rtn)) + +(defun org-infile-export-plist () + "Return the property list with file-local settings for export." + (save-excursion + (goto-char 0) + (let ((re (org-make-options-regexp + '("TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) + (text nil) + p key val text options) + (while (re-search-forward re nil t) + (setq key (org-match-string-no-properties 1) + val (org-match-string-no-properties 2)) + (cond + ((string-equal key "TITLE") (setq p (plist-put p :title val))) + ((string-equal key "AUTHOR")(setq p (plist-put p :author val))) + ((string-equal key "EMAIL") (setq p (plist-put p :email val))) + ((string-equal key "LANGUAGE") (setq p (plist-put p :language val))) + ((string-equal key "TEXT") + (setq text (if text (concat text "\n" val) val))) + ((string-equal key "OPTIONS") (setq options val)))) + (setq p (plist-put p :text text)) + (when options + (let ((op '(("H" . :headline-levels) + ("num" . :section-numbers) + ("toc" . :table-of-contents) + ("\\n" . :preserve-breaks) + ("@" . :expand-quoted-html) + (":" . :fixed-width) + ("|" . :tables) + ("^" . :sub-superscript) + ("*" . :emphasize) + ("TeX" . :TeX-macros))) + o) + (while (setq o (pop op)) + (if (string-match (concat (regexp-quote (car o)) + ":\\([^ \t\n\r;,.]*\\)") + options) + (setq p (plist-put p (cdr o) + (car (read-from-string + (match-string 1 options))))))))) + p))) + +(defun org-combine-plists (&rest plists) + "Create a single property list from all plists in PLISTS. +The process starts by copying the last list, and then setting properties +from the other lists. Settings in the first list are the most significant +ones and overrule settings in the other lists." + (let ((rtn (copy-sequence (pop plists))) + p v ls) + (while plists + (setq ls (pop plists)) + (while ls + (setq p (pop ls) v (pop ls)) + (setq rtn (plist-put rtn p v)))) + rtn)) + +(defun org-export-directory (type plist) + (let* ((val (plist-get plist :publishing-directory)) + (dir (if (listp val) + (or (cdr (assoc type val)) ".") + val))) + dir)) + (defun org-export-find-first-heading-line (list) "Remove all lines from LIST which are before the first headline." (let ((orig-list list) @@ -10854,7 +11854,10 @@ overwritten, and the table is not marked as requiring realignment." ;; an ordinary comment line ) ((and org-export-table-remove-special-lines - (string-match "^[ \t]*| *[!_^] *|" line)) + (string-match "^[ \t]*|" line) + (or (string-match "^[ \t]*| *[!_^] *|" line) + (and (string-match "| *<[0-9]+> *|" line) + (not (string-match "| *[^ <|]" line))))) ;; a special table line that should be removed ) (t (setq rtn (cons line rtn))))) @@ -10862,9 +11865,6 @@ overwritten, and the table is not marked as requiring realignment." ;; ASCII -(defconst org-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-) - "Characters for underlining headings in ASCII export.") - (defconst org-html-entities '(("nbsp") ("iexcl") @@ -11266,6 +12266,7 @@ is signaled in this case." (if org-odd-levels-only (1+ (/ n 2)) n)) (defvar org-last-level nil) ; dynamically scoped variable +(defvar org-ascii-current-indentation nil) ; For communication (defun org-export-as-ascii (arg) "Export the outline as a pretty ASCII file. @@ -11274,7 +12275,9 @@ The prefix ARG specifies how many levels of the outline should become underlined headlines. The default is 3." (interactive "P") (setq-default org-todo-line-regexp org-todo-line-regexp) - (let* ((region + (let* ((opt-plist (org-combine-plists (org-default-export-plist) + (org-infile-export-plist))) + (region (buffer-substring (if (org-region-active-p) (region-beginning) (point-min)) (if (org-region-active-p) (region-end) (point-max)))) @@ -11283,21 +12286,28 @@ underlined headlines. The default is 3." (org-split-string (org-cleaned-string-for-export region) "[\r\n]")))) + (org-ascii-current-indentation '(0 . 0)) (org-startup-with-deadline-check nil) (level 0) line txt (umax nil) (case-fold-search nil) - (filename (concat (file-name-sans-extension buffer-file-name) + (filename (concat (file-name-as-directory + (org-export-directory :ascii opt-plist)) + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) ".txt")) (buffer (find-file-noselect filename)) (levels-open (make-vector org-level-max nil)) + (odd org-odd-levels-only) (date (format-time-string "%Y/%m/%d" (current-time))) (time (format-time-string "%X" (org-current-time))) - (author user-full-name) - (title (buffer-name)) + (author (plist-get opt-plist :author)) + (title (or (plist-get opt-plist :title) + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)))) (options nil) - (email user-mail-address) - (language org-export-default-language) + (email (plist-get opt-plist :email)) + (language (plist-get opt-plist :language)) (text nil) (todo nil) (lang-words nil)) @@ -11307,9 +12317,6 @@ underlined headlines. The default is 3." (find-file-noselect filename) - ;; Search for the export key lines - (org-parse-key-lines) - (setq lang-words (or (assoc language org-export-language-setup) (assoc "en" org-export-language-setup))) (if org-export-ascii-show-new-buffer @@ -11317,7 +12324,13 @@ underlined headlines. The default is 3." (set-buffer buffer)) (erase-buffer) (fundamental-mode) - (if options (org-parse-export-options options)) + ;; create local variables for all options, to make sure all called + ;; functions get the correct information + (mapcar (lambda (x) + (set (make-local-variable (cdr x)) + (plist-get opt-plist (car x)))) + org-export-plist-vars) + (set (make-local-variable 'org-odd-levels-only) odd) (setq umax (if arg (prefix-numeric-value arg) org-export-headline-levels)) @@ -11347,7 +12360,8 @@ underlined headlines. The default is 3." level (org-tr-level level) txt (match-string 3 line) todo - (or (and (match-beginning 2) + (or (and org-export-mark-todo-in-toc + (match-beginning 2) (not (equal (match-string 2 line) org-done-string))) ; TODO, not DONE @@ -11386,10 +12400,24 @@ underlined headlines. The default is 3." ;; a Headline (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) txt (match-string 2 line)) - (org-ascii-level-start level txt umax)) - (t (insert line "\n")))) + (org-ascii-level-start level txt umax lines)) + (t + (insert (org-fix-indentation line org-ascii-current-indentation) "\n")))) (normal-mode) (save-buffer) + ;; remove display and invisible chars + (let (beg end s) + (goto-char (point-min)) + (while (setq beg (next-single-property-change (point) 'display)) + (setq end (next-single-property-change beg 'display)) + (delete-region beg end) + (goto-char beg) + (insert "=>")) + (goto-char (point-min)) + (while (setq beg (next-single-property-change (point) 'org-cwidth)) + (setq end (next-single-property-change beg 'org-cwidth)) + (delete-region beg end) + (goto-char beg))) (goto-char (point-min)))) (defun org-search-todo-below (line lines level) @@ -11409,8 +12437,6 @@ underlined headlines. The default is 3." (if (<= lv level) (throw 'exit nil)) (if todo (throw 'exit t)))))))) -;; FIXME: Try to handle <b> and <i> as faces via text properties. -;; We could also implement *bold*,/italic/ and _underline_ for ASCII export (defun org-html-expand-for-ascii (line) "Handle quoted HTML for ASCII export." (if org-export-html-expand @@ -11428,51 +12454,80 @@ underlined headlines. The default is 3." (make-string (string-width s) underline) "\n")))) -(defun org-ascii-level-start (level title umax) +(defun org-ascii-level-start (level title umax &optional lines) "Insert a new level in ASCII export." - (let (char) + (let (char (n (- level umax 1)) (ind 0)) (if (> level umax) - (insert (make-string (* 2 (- level umax 1)) ?\ ) "* " title "\n") + (progn + (insert (make-string (* 2 n) ?\ ) + (char-to-string (nth (% n (length org-export-ascii-bullets)) + org-export-ascii-bullets)) + " " title "\n") + ;; find the indentation of the next non-empty line + (catch 'stop + (while lines + (if (string-match "^\\*" (car lines)) (throw 'stop nil)) + (if (string-match "^\\([ \t]*\\)\\S-" (car lines)) + (throw 'stop (setq ind (org-get-indentation (car lines))))) + (pop lines))) + (setq org-ascii-current-indentation (cons (* 2 (1+ n)) ind))) (if (or (not (equal (char-before) ?\n)) (not (equal (char-before (1- (point))) ?\n))) (insert "\n")) - (setq char (nth (- umax level) (reverse org-ascii-underline))) + (setq char (nth (- umax level) (reverse org-export-ascii-underline))) (if org-export-with-section-numbers (setq title (concat (org-section-number level) " " title))) - (insert title "\n" (make-string (string-width title) char) "\n")))) - -(defun org-export-copy-visible () - "Copy the visible part of the buffer to another buffer, for printing. -Also removes the first line of the buffer if it specifies a mode, -and all options lines." - (interactive) - (let* ((filename (concat (file-name-sans-extension buffer-file-name) - ".txt")) - (buffer (find-file-noselect filename)) - (ore (concat - (org-make-options-regexp - '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" - "STARTUP" "ARCHIVE" - "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")) - (if org-noutline-p "\\(\n\\|$\\)" ""))) + (insert title "\n" (make-string (string-width title) char) "\n") + (setq org-ascii-current-indentation '(0 . 0))))) + +(defun org-export-visible (type arg) + "Create a copy of the visible part of the current buffer, and export it. +The copy is created in a temporary buffer and removed after use. +TYPE is the final key (as a string) of the `C-c C-x' key sequence that will +run the export command - in interactive use, the command prompts for this +key. As a special case, if the you type SPC at the prompt, the temporary +org-mode file will not be removed but presented to you so that you can +continue to use it. The prefix arg ARG is passed through to the exporting +command." + (interactive + (list (progn + (message "Export visible: [a]SCII [h]tml [b]rowse HTML [x]OXO [ ]keep buffer") + (char-to-string (read-char-exclusive))) + current-prefix-arg)) + (if (not (member type '("a" "\C-a" "b" "\C-b" "h" "x" " "))) + (error "Invalid export key")) + (let* ((binding (key-binding (concat "\C-c\C-x" type))) + (keepp (equal type " ")) + (file buffer-file-name) + (buffer (get-buffer-create "*Org Export Visible*")) s e) - (with-current-buffer buffer - (erase-buffer) - (text-mode)) + (with-current-buffer buffer (erase-buffer)) (save-excursion (setq s (goto-char (point-min))) (while (not (= (point) (point-max))) (goto-char (org-find-invisible)) (append-to-buffer buffer s (point)) - (setq s (goto-char (org-find-visible))))) - (switch-to-buffer-other-window buffer) - (newline) - (goto-char (point-min)) - (if (looking-at ".*-\\*- mode:.*\n") - (replace-match "")) - (while (re-search-forward ore nil t) - (replace-match "")) - (goto-char (point-min)))) + (setq s (goto-char (org-find-visible)))) + (goto-char (point-min)) + (unless keepp + ;; Copy all comment lines to the end, to make sure #+ settings are + ;; still available for the second export step. Kind of a hack, but + ;; does do the trick. + (if (looking-at "#[^\r\n]*") + (append-to-buffer buffer (match-beginning 0) (1+ (match-end 0)))) + (while (re-search-forward "[\n\r]#[^\n\r]*" nil t) + (append-to-buffer buffer (1+ (match-beginning 0)) + (min (point-max) (1+ (match-end 0)))))) + (set-buffer buffer) + (let ((buffer-file-name file) + (org-inhibit-startup t)) + (org-mode) + (show-all) + (unless keepp (funcall binding arg)))) + (if (not keepp) + (kill-buffer buffer) + (switch-to-buffer-other-window buffer) + (goto-char (point-min))))) (defun org-find-visible () (if (featurep 'noutline) @@ -11491,6 +12546,7 @@ and all options lines." (skip-chars-forward "^\r") (point))) + ;; HTML (defun org-get-current-options () @@ -11506,7 +12562,8 @@ Does include HTML export options as well as TODO and CATEGORY stuff." #+CATEGORY: %s #+SEQ_TODO: %s #+TYP_TODO: %s -#+STARTUP: %s %s %s %s %s +#+STARTUP: %s %s %s %s %s %s +#+TAGS: %s #+ARCHIVE: %s " (buffer-name) (user-full-name) user-mail-address org-export-default-language @@ -11533,6 +12590,8 @@ Does include HTML export options as well as TODO and CATEGORY stuff." (if org-odd-levels-only "odd" "oddeven") (if org-hide-leading-stars "hidestars" "showstars") (if org-startup-align-all-tables "align" "noalign") + (if org-log-done "logging" "nologging") + (if org-tag-alist (mapconcat 'car org-tag-alist " ") "") org-archive-location )) @@ -11606,16 +12665,23 @@ emacs --batch --visit=MyFile --funcall org-export-as-html-batch" (org-export-as-html org-export-headline-levels 'hidden)) -(defun org-export-as-html (arg &optional hidden) +(defun org-export-as-html (arg &optional hidden ext-plist) "Export the outline as a pretty HTML file. If there is an active region, export only the region. The prefix ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted lists." +headlines. The default is 3. Lower levels will become bulleted lists. +When HIDDEN is non-nil, don't display the HTML buffer. +EXT-PLIST is a property list with external parameters overriding +org-mode's default settings, but still inferior to file-local settings." (interactive "P") (setq-default org-todo-line-regexp org-todo-line-regexp) (setq-default org-deadline-line-regexp org-deadline-line-regexp) (setq-default org-done-string org-done-string) - (let* ((style org-export-html-style) + (let* ((opt-plist (org-combine-plists (org-default-export-plist) + ext-plist + (org-infile-export-plist))) + + (style (plist-get opt-plist :style)) (odd org-odd-levels-only) (region-p (org-region-active-p)) (region @@ -11629,30 +12695,34 @@ headlines. The default is 3. Lower levels will become bulleted lists." (lines (org-export-find-first-heading-line all_lines)) (level 0) (line "") (origline "") txt todo (umax nil) - (filename (concat (file-name-sans-extension buffer-file-name) - ".html")) + (filename (concat (file-name-as-directory + (org-export-directory :html opt-plist)) + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + ".html")) (buffer (find-file-noselect filename)) (levels-open (make-vector org-level-max nil)) (date (format-time-string "%Y/%m/%d" (current-time))) (time (format-time-string "%X" (org-current-time))) - (author user-full-name) - (title (buffer-name)) - (options nil) - (quote-re (concat "^\\*+[ \t]*" org-quote-string "\\>")) + (author (plist-get opt-plist :author)) + (title (or (plist-get opt-plist :title) + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)))) + (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) + (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)")) (inquote nil) (infixed nil) (in-local-list nil) (local-list-num nil) (local-list-indent nil) (llt org-plain-list-ordered-item-terminator) - (email user-mail-address) - (language org-export-default-language) - (text nil) - (lang-words nil) + (email (plist-get opt-plist :email)) + (language (plist-get opt-plist :language)) + (text (plist-get opt-plist :text)) + (lang-words nil) (target-alist nil) tg (head-count 0) cnt (start 0) - ;; FIXME: The following returns always nil under XEmacs (coding-system (and (fboundp 'coding-system-get) (boundp 'buffer-file-coding-system) buffer-file-coding-system)) @@ -11663,15 +12733,14 @@ headlines. The default is 3. Lower levels will become bulleted lists." table-open type table-buffer table-orig-buffer ind start-is-num starter - rpl path desc desc1 desc2 link + rpl path desc descp desc1 desc2 link ) (message "Exporting...") (setq org-last-level 1) (org-init-section-numbers) - ;; Search for the export key lines - (org-parse-key-lines) + ;; Get the language-dependent settings (setq lang-words (or (assoc language org-export-language-setup) (assoc "en" org-export-language-setup))) @@ -11683,38 +12752,46 @@ headlines. The default is 3. Lower levels will become bulleted lists." (fundamental-mode) (let ((case-fold-search nil) (org-odd-levels-only odd)) - (if options (org-parse-export-options options)) + ;; create local variables for all options, to make sure all called + ;; functions get the correct information + (mapcar (lambda (x) + (set (make-local-variable (cdr x)) + (plist-get opt-plist (car x)))) + org-export-plist-vars) (setq umax (if arg (prefix-numeric-value arg) org-export-headline-levels)) ;; File header (insert (format - "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\" - \"http://www.w3.org/TR/REC-html40/loose.dtd\"> -<html lang=\"%s\"><head> + "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" + \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\"> +<html xmlns=\"http://www.w3.org/1999/xhtml\" +lang=\"%s\" xml:lang=\"%s\"> +<head> <title>%s</title> -<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"> -<meta name=generator content=\"Org-mode\"> -<meta name=generated content=\"%s %s\"> -<meta name=author content=\"%s\"> +<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/> +<meta name=\"generator\" content=\"Org-mode\"/> +<meta name=\"generated\" content=\"%s %s\"/> +<meta name=\"author\" content=\"%s\"/> %s </head><body> " - language (org-html-expand title) (or charset "iso-8859-1") + language language (org-html-expand title) (or charset "iso-8859-1") date time author style)) - (if title (insert (concat "<H1 class=\"title\">" - (org-html-expand title) "</H1>\n"))) - (if author (insert (concat (nth 1 lang-words) ": " author "\n"))) - (if email (insert (concat "<a href=\"mailto:" email "\"><" - email "></a>\n"))) - (if (or author email) (insert "<br>\n")) - (if (and date time) (insert (concat (nth 2 lang-words) ": " - date " " time "<br>\n"))) - (if text (insert (concat "<p>\n" (org-html-expand text)))) + + + (insert (or (plist-get opt-plist :preamble) "")) + + (when (plist-get opt-plist :auto-preamble) + (if title (insert (concat "<h1 class=\"title\">" + (org-html-expand title) "</h1>\n"))) + + (if text (insert "<p>\n" (org-html-expand text) "</p>"))) + (if org-export-with-toc (progn - (insert (format "<H2>%s</H2>\n" (nth 3 lang-words))) - (insert "<ul>\n") + (insert (format "<h2>%s</h2>\n" (nth 3 lang-words))) + (insert "<ul>\n<li>") (setq lines (mapcar '(lambda (line) (if (string-match org-todo-line-regexp line) @@ -11724,9 +12801,11 @@ headlines. The default is 3. Lower levels will become bulleted lists." level (org-tr-level level) txt (save-match-data (org-html-expand - (match-string 3 line))) + (org-html-cleanup-toc-line + (match-string 3 line)))) todo - (or (and (match-beginning 2) + (or (and org-export-mark-todo-in-toc + (match-beginning 2) (not (equal (match-string 2 line) org-done-string))) ; TODO, not DONE @@ -11744,13 +12823,13 @@ headlines. The default is 3. Lower levels will become bulleted lists." (progn (setq cnt (- level org-last-level)) (while (>= (setq cnt (1- cnt)) 0) - (insert "<ul>")) + (insert "\n<ul>\n<li>")) (insert "\n"))) (if (< level org-last-level) (progn (setq cnt (- org-last-level level)) (while (>= (setq cnt (1- cnt)) 0) - (insert "</ul>")) + (insert "</li>\n</ul>")) (insert "\n"))) ;; Check for targets (while (string-match org-target-regexp line) @@ -11766,8 +12845,8 @@ headlines. The default is 3. Lower levels will become bulleted lists." (insert (format (if todo - "<li><a href=\"#sec-%d\"><span class=\"todo\">%s</span></a>\n" - "<li><a href=\"#sec-%d\">%s</a>\n") + "</li>\n<li><a href=\"#sec-%d\"><span class=\"todo\">%s</span></a>" + "</li>\n<li><a href=\"#sec-%d\">%s</a>") head-count txt)) (setq org-last-level level)) @@ -11776,7 +12855,7 @@ headlines. The default is 3. Lower levels will become bulleted lists." lines)) (while (> org-last-level 0) (setq org-last-level (1- org-last-level)) - (insert "</ul>\n")) + (insert "</li>\n</ul>\n")) )) (setq head-count 0) (org-init-section-numbers) @@ -11785,7 +12864,7 @@ headlines. The default is 3. Lower levels will become bulleted lists." (catch 'nextline ;; end of quote section? - (when (and inquote (string-match "^\\*+" line)) + (when (and inquote (string-match "^\\*+" line)) (insert "</pre>\n") (setq inquote nil)) ;; inside a quote section? @@ -11829,8 +12908,11 @@ headlines. The default is 3. Lower levels will become bulleted lists." "\" class=\"target\">" (match-string 1 line) "@</a> ") t t line))))) + (setq line (org-html-handle-time-stamps line)) + ;; replace "&" by "&", "<" and ">" by "<" and ">" ;; handle @<..> HTML tags (replace "@>..<" by "<..>") + ;; Also handle sub_superscripts and checkboxes (setq line (org-html-expand line)) ;; Format the links @@ -11841,7 +12923,9 @@ headlines. The default is 3. Lower levels will become bulleted lists." (setq path (match-string 3 line)) (setq desc1 (if (match-end 5) (match-string 5 line)) desc2 (if (match-end 2) (concat type ":" path) path) + descp (and desc1 (not (equal desc1 desc2))) desc (or desc1 desc2)) + ;; FIXME: do we need to unescape here somewhere? (cond ((equal type "internal") (setq rpl @@ -11861,7 +12945,7 @@ headlines. The default is 3. Lower levels will become bulleted lists." (save-match-data (if (string-match "::\\(.*\\)" filename) (setq search (match-string 1 filename) - filename (replace-match "" nil nil filename))) + filename (replace-match "" t nil filename))) (setq file-is-image-p (string-match (org-image-file-name-regexp) filename)) (setq thefile (if abs-p (expand-file-name filename) filename)) @@ -11877,12 +12961,18 @@ headlines. The default is 3. Lower levels will become bulleted lists." (not (string-match "^/.*/$" search))) (setq thefile (concat thefile "#" (org-solidify-link-text - (org-link-unescape search))))))) - (setq rpl (if (and org-export-html-inline-images - file-is-image-p) + (org-link-unescape search))))) + (when (string-match "^file:" desc) + (setq desc (replace-match "" t t desc)) + (if (string-match "\\.org$" desc) + (setq desc (replace-match "" t t desc)))))) + (setq rpl (if (and file-is-image-p + (or (eq t org-export-html-inline-images) + (and org-export-html-inline-images + (not descp)))) (concat "<img src=\"" thefile "\"/>") (concat "<a href=\"" thefile "\">" desc "</a>"))))) - ((member type '("bbdb" "vm" "wl" "mhe" "rmail" "gnus" "shell")) + ((member type '("bbdb" "vm" "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp")) (setq rpl (concat "<i><" type ":" (save-match-data (org-link-unescape path)) "></i>")))) @@ -11894,28 +12984,22 @@ headlines. The default is 3. Lower levels will become bulleted lists." (if (equal (match-string 2 line) org-done-string) (setq line (replace-match "<span class=\"done\">\\2</span>" - nil nil line 2)) + t nil line 2)) (setq line (replace-match "<span class=\"todo\">\\2</span>" - nil nil line 2)))) + t nil line 2)))) - ;; DEADLINES - (if (string-match org-deadline-line-regexp line) - (progn - (if (save-match-data - (string-match "<a href" - (substring line 0 (match-beginning 0)))) - nil ; Don't do the replacement - it is inside a link - (setq line (replace-match "<span class=\"deadline\">\\&</span>" - nil nil line 1))))) (cond ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) ;; This is a headline (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) txt (match-string 2 line)) + (if (string-match quote-re0 txt) + (setq txt (replace-match "" t t txt))) (if (<= level umax) (setq head-count (+ head-count 1))) (when in-local-list ;; Close any local lists before inserting a new header line (while local-list-num + (org-close-li) (insert (if (car local-list-num) "</ol>\n" "</ul>")) (pop local-list-num)) (setq local-list-indent nil @@ -11942,19 +13026,21 @@ headlines. The default is 3. Lower levels will become bulleted lists." (setq table-open nil table-buffer (nreverse table-buffer) table-orig-buffer (nreverse table-orig-buffer)) + (org-close-par-maybe) (insert (org-format-table-html table-buffer table-orig-buffer)))) (t ;; Normal lines - (when (and (string-match - (cond - ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+[.)]\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)") - ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+\\.\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)") - ((= llt ?\)) "^\\( \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+)\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)") - (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))) - line)) + (when (string-match + (cond + ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") + ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") + ((= llt ?\)) "^\\( \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") + (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))) + line) (setq ind (org-get-string-indentation line) start-is-num (match-beginning 4) - starter (if (match-beginning 2) (match-string 2 line)) + starter (if (match-beginning 2) + (substring (match-string 2 line) 0 -1)) line (substring line (match-beginning 5))) (unless (string-match "[^ \t]" line) ;; empty line. Pretend indentation is large. @@ -11963,6 +13049,7 @@ headlines. The default is 3. Lower levels will become bulleted lists." (or (and (= ind (car local-list-indent)) (not starter)) (< ind (car local-list-indent)))) + (org-close-li) (insert (if (car local-list-num) "</ol>\n" "</ul>")) (pop local-list-num) (pop local-list-indent) (setq in-local-list local-list-indent)) @@ -11971,23 +13058,76 @@ headlines. The default is 3. Lower levels will become bulleted lists." (or (not in-local-list) (> ind (car local-list-indent)))) ;; Start new (level of ) list + (org-close-par-maybe) (insert (if start-is-num "<ol>\n<li>\n" "<ul>\n<li>\n")) (push start-is-num local-list-num) (push ind local-list-indent) (setq in-local-list t)) (starter ;; continue current list - (insert "<li>\n")))) + (org-close-li) + (insert "<li>\n"))) + (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line) + (setq line + (replace-match + (if (equal (match-string 1 line) "X") + "<b>[X]</b>" + "<b>[<span style=\"visibility:hidden;\">X</span>]</b>") + t t line)))) + ;; Empty lines start a new paragraph. If hand-formatted lists ;; are not fully interpreted, lines starting with "-", "+", "*" ;; also start a new paragraph. - (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (insert "<p>")) - (insert line (if org-export-preserve-breaks "<br>\n" "\n")))) - )) + (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par)) + + ;; Check if the line break needs to be conserved + (cond + ((string-match "\\\\\\\\[ \t]*$" line) + (setq line (replace-match "<br/>" t t line))) + (org-export-preserve-breaks + (setq line (concat line "<br/>")))) + + (insert line "\n"))))) + + ;; Properly close all local lists and other lists + (when inquote (insert "</pre>\n")) + (when in-local-list + ;; Close any local lists before inserting a new header line + (while local-list-num + (org-close-li) + (insert (if (car local-list-num) "</ol>\n" "</ul>\n")) + (pop local-list-num)) + (setq local-list-indent nil + in-local-list nil)) + (org-html-level-start 1 nil umax + (and org-export-with-toc (<= level umax)) + head-count) + + (when (plist-get opt-plist :auto-postamble) + (when author + (insert "<p class=\"author\"> " + (nth 1 lang-words) ": " author "\n") + (when email + (insert "<a href=\"mailto:" email "\"><" + email "></a>\n")) + (insert "</p>\n")) + (when (and date time) + (insert "<p class=\"date\"> " + (nth 2 lang-words) ": " + date " " time "</p>\n"))) + (if org-export-html-with-timestamp (insert org-export-html-html-helper-timestamp)) + (insert (or (plist-get opt-plist :postamble) "")) (insert "</body>\n</html>\n") (normal-mode) + ;; remove empty paragraphs and lists + (goto-char (point-min)) + (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t) + (replace-match "")) (save-buffer) (goto-char (point-min))))) @@ -12091,7 +13231,7 @@ But it has the disadvantage, that no cell- or row-spanning is allowed." fields html empty) (setq html (concat org-export-html-table-tag "\n")) (while (setq line (pop lines)) - (setq empty " ") + (setq empty " ") (catch 'next-line (if (string-match "^[ \t]*\\+-" line) (progn @@ -12117,7 +13257,7 @@ But it has the disadvantage, that no cell- or row-spanning is allowed." (if field-buffer (setq field-buffer (mapcar (lambda (x) - (concat x "<br>" (pop fields))) + (concat x "<br/>" (pop fields))) field-buffer)) (setq field-buffer fields)))) (setq html (concat html "</table>\n")) @@ -12140,6 +13280,30 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used." (set-buffer " org-tmp2 ") (buffer-substring (point-min) (point-max)))) +(defun org-html-handle-time-stamps (s) + "Format time stamps in string S, or remove them." + (let (r b) + (while (string-match org-maybe-keyword-time-regexp s) + (or b (setq b (substring s 0 (match-beginning 0)))) + (if (not org-export-with-timestamps) + (setq r (concat r (substring s 0 (match-beginning 0))) + s (substring s (match-end 0))) + (setq r (concat + r (substring s 0 (match-beginning 0)) + (if (match-end 1) + (format "@<span class=\"timestamp-kwd\">%s @</span>" + (match-string 1 s))) + (format " @<span class=\"timestamp\">%s@</span>" + (substring (match-string 3 s) 1 -1))) + s (substring s (match-end 0))))) + ;; Line break of line started and ended with time stamp stuff + (if (not r) + s + (setq r (concat r s)) + (unless (string-match "\\S-" (concat b s)) + (setq r (concat r "@<br/>"))) + r))) + (defun org-html-protect (s) ;; convert & to &, < to < and > to > (let ((start 0)) @@ -12152,6 +13316,14 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used." (setq s (replace-match ">" t t s)))) s) +(defun org-html-cleanup-toc-line (s) + "Remove tags and time staps from lines going into the toc." + (if (string-match " +:[a-zA-Z0-9_@:]+: *$" s) + (setq s (replace-match "" t t s))) + (while (string-match org-maybe-keyword-time-regexp s) + (setq s (replace-match "" t t s))) + s) + (defun org-html-expand (string) "Prepare STRING for HTML export. Applies all active conversions. If there are links in the string, don't modify these." @@ -12170,7 +13342,7 @@ If there are links in the string, don't modify these." (setq s (org-html-protect s)) (if org-export-html-expand (while (string-match "@<\\([^&]*\\)>" s) - (setq s (replace-match "<\\1>" nil nil s)))) + (setq s (replace-match "<\\1>" t nil s)))) (if org-export-with-emphasize (setq s (org-export-html-convert-emphasize s))) (if org-export-with-sub-superscripts @@ -12239,49 +13411,30 @@ stacked delimiters is N. Escaping delimiters is not possible." (setq string (replace-match "\\1<u>\\3</u>\\4" t nil string))) string) -(defun org-parse-key-lines () - "Find the special key lines with the information for exporters." - (save-excursion - (goto-char 0) - (let ((re (org-make-options-regexp - '("TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) - key) - (while (re-search-forward re nil t) - (setq key (match-string 1)) - (cond ((string-equal key "TITLE") - (setq title (match-string 2))) - ((string-equal key "AUTHOR") - (setq author (match-string 2))) - ((string-equal key "EMAIL") - (setq email (match-string 2))) - ((string-equal key "LANGUAGE") - (setq language (match-string 2))) - ((string-equal key "TEXT") - (setq text (concat text "\n" (match-string 2)))) - ((string-equal key "OPTIONS") - (setq options (match-string 2)))))))) - -(defun org-parse-export-options (s) - "Parse the export options line." - (let ((op '(("H" . org-export-headline-levels) - ("num" . org-export-with-section-numbers) - ("toc" . org-export-with-toc) - ("\\n" . org-export-preserve-breaks) - ("@" . org-export-html-expand) - (":" . org-export-with-fixed-width) - ("|" . org-export-with-tables) - ("^" . org-export-with-sub-superscripts) - ("*" . org-export-with-emphasize) - ("TeX" . org-export-with-TeX-macros))) - o) - (while (setq o (pop op)) - (if (string-match (concat (regexp-quote (car o)) ":\\([^ \t\n\r;,.]*\\)") - s) - (set (make-local-variable (cdr o)) - (car (read-from-string (match-string 1 s)))))))) +(defvar org-par-open nil) +(defun org-open-par () + "Insert <p>, but first close previous paragraph if any." + (org-close-par-maybe) + (insert "\n<p>") + (setq org-par-open t)) +(defun org-close-par-maybe () + "Close paragraph if there is one open." + (when org-par-open + (insert "</p>") + (setq org-par-open nil))) +(defun org-close-li () + "Close <li> if necessary." + (org-close-par-maybe) + (insert "</li>\n")) +; (when (save-excursion +; (re-search-backward "</?\\(ul\\|ol\\|li\\|[hH][0-9]\\)>" nil t)) +; (if (member (match-string 0) '("</ul>" "</ol>" "<li>")) +; (insert "</li>")))) (defun org-html-level-start (level title umax with-toc head-count) - "Insert a new level in HTML export." + "Insert a new level in HTML export. +When TITLE is nil, just close all open levels." + (org-close-par-maybe) (let ((l (1+ (max level umax)))) (while (<= l org-level-max) (if (aref levels-open (1- l)) @@ -12289,22 +13442,42 @@ stacked delimiters is N. Escaping delimiters is not possible." (org-html-level-close l) (aset levels-open (1- l) nil))) (setq l (1+ l))) - (if (> level umax) - (progn - (if (aref levels-open (1- level)) - (insert "<li>" title "<p>\n") - (aset levels-open (1- level) t) - (insert "<ul><li>" title "<p>\n"))) - (if org-export-with-section-numbers - (setq title (concat (org-section-number level) " " title))) - (setq level (+ level 1)) - (if with-toc - (insert (format "\n<H%d><a name=\"sec-%d\">%s</a></H%d>\n" - level head-count title level)) - (insert (format "\n<H%d>%s</H%d>\n" level title level)))))) + (when title + ;; If title is nil, this means this function is called to close + ;; all levels, so the rest is done only if title is given + (when (string-match "\\(:[a-zA-Z0-9_@:]+:\\)[ \t]*$" title) + (setq title (replace-match + (if org-export-with-tags + (save-match-data + (concat + " <span class=\"tag\">" + (mapconcat 'identity (org-split-string + (match-string 1 title) ":") + " ") + "</span>")) + "") + t t title))) + (if (> level umax) + (progn + (if (aref levels-open (1- level)) + (progn + (org-close-li) + (insert "<li>" title "<br/>\n")) + (aset levels-open (1- level) t) + (org-close-par-maybe) + (insert "<ul>\n<li>" title "<br/>\n"))) + (if org-export-with-section-numbers + (setq title (concat (org-section-number level) " " title))) + (setq level (+ level 1)) + (if with-toc + (insert (format "\n<h%d><a name=\"sec-%d\">%s</a></h%d>\n" + level head-count title level)) + (insert (format "\n<h%d>%s</h%d>\n" level title level))) + (org-open-par))))) (defun org-html-level-close (&rest args) "Terminate one level in HTML export." + (org-close-li) (insert "</ul>")) ;; Variable holding the vector with section numbers @@ -12348,9 +13521,9 @@ When LEVEL is non-nil, increase section numbers on that level." (setq idx (1+ idx))) (save-match-data (if (string-match "\\`\\([@0]\\.\\)+" string) - (setq string (replace-match "" nil nil string))) + (setq string (replace-match "" t nil string))) (if (string-match "\\(\\.0\\)+\\'" string) - (setq string (replace-match "" nil nil string)))) + (setq string (replace-match "" t nil string)))) string)) @@ -12361,12 +13534,6 @@ file, but with extension `.ics'." (interactive) (org-export-icalendar nil buffer-file-name)) -(defun org-export-as-xml () - "Export current buffer as XOXO XML buffer." - (interactive) - (cond ((eq org-export-xml-type 'xoxo) - (org-export-as-xoxo (current-buffer))))) - (defun org-export-as-xoxo-insert-into (buffer &rest output) (with-current-buffer buffer (apply 'insert output))) @@ -12380,8 +13547,13 @@ The XOXO buffer is named *xoxo-<source buffer name>*" ;; Output everything as XOXO (with-current-buffer (get-buffer buffer) (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. - (let* ((filename (concat (file-name-sans-extension buffer-file-name) - ".xml")) + (let* ((opt-plist (org-combine-plists (org-default-export-plist) + (org-infile-export-plist))) + (filename (concat (file-name-as-directory + (org-export-directory :xoxo opt-plist)) + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + ".html")) (out (find-file-noselect filename)) (last-level 1) (hanging-li nil)) @@ -12464,19 +13636,29 @@ The file is stored under the name `org-combined-agenda-icalendar-file'." If COMBINE is non-nil, combine all calendar entries into a single large file and store it under the name `org-combined-agenda-icalendar-file'." (save-excursion - (let* (file ical-file ical-buffer category started org-agenda-new-buffers) + (let* ((dir (org-export-directory + :ical (list :publishing-directory + org-export-publishing-directory))) + file ical-file ical-buffer category started org-agenda-new-buffers) + (when combine - (setq ical-file org-combined-agenda-icalendar-file + (setq ical-file + (if (file-name-absolute-p org-combined-agenda-icalendar-file) + org-combined-agenda-icalendar-file + (expand-file-name org-combined-agenda-icalendar-file dir)) ical-buffer (org-get-agenda-file-buffer ical-file)) (set-buffer ical-buffer) (erase-buffer)) (while (setq file (pop files)) (catch 'nextfile (org-check-agenda-file file) + (set-buffer (org-get-agenda-file-buffer file)) (unless combine - (setq ical-file (concat (file-name-sans-extension file) ".ics")) + (setq ical-file (concat (file-name-as-directory dir) + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + ".ics")) (setq ical-buffer (org-get-agenda-file-buffer ical-file)) - (set-buffer ical-buffer) (erase-buffer)) - (set-buffer (org-get-agenda-file-buffer file)) + (with-current-buffer ical-buffer (erase-buffer))) (setq category (or org-category (file-name-sans-extension (file-name-nondirectory buffer-file-name)))) @@ -12611,6 +13793,7 @@ a time), or the day by one (if it does not contain a time)." ;; Make `C-c C-x' a prefix key (define-key org-mode-map "\C-c\C-x" (make-sparse-keymap)) +(define-key org-mode-map "\C-c\C-e" (make-sparse-keymap)) ;; TAB key with modifiers (define-key org-mode-map "\C-i" 'org-cycle) @@ -12708,8 +13891,8 @@ a time), or the day by one (if it does not contain a time)." (define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region) (define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii) (define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii) -(define-key org-mode-map "\C-c\C-xv" 'org-export-copy-visible) -(define-key org-mode-map "\C-c\C-x\C-v" 'org-export-copy-visible) +(define-key org-mode-map "\C-c\C-xv" 'org-export-visible) +(define-key org-mode-map "\C-c\C-x\C-v" 'org-export-visible) ;; OPML support is only an option for the future ;(define-key org-mode-map "\C-c\C-xo" 'org-export-as-opml) ;(define-key org-mode-map "\C-c\C-x\C-o" 'org-export-as-opml) @@ -12720,8 +13903,8 @@ a time), or the day by one (if it does not contain a time)." (define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template) (define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section) (define-key org-mode-map "\C-c\C-xh" 'org-export-as-html) -(define-key org-mode-map "\C-c\C-xx" 'org-export-as-xml) -(define-key org-mode-map "\C-c\C-x\C-x" 'org-export-as-xml) +(define-key org-mode-map "\C-c\C-xx" 'org-export-as-xoxo) +(define-key org-mode-map "\C-c\C-x\C-x" 'org-export-as-xoxo) (define-key org-mode-map "\C-c\C-xb" 'org-export-as-html-and-open) (define-key org-mode-map "\C-c\C-x\C-b" 'org-export-as-html-and-open) @@ -12730,6 +13913,18 @@ a time), or the day by one (if it does not contain a time)." (define-key org-mode-map "\C-c\C-x\M-w" 'org-copy-special) (define-key org-mode-map "\C-c\C-x\C-y" 'org-paste-special) +(define-key org-mode-map "\C-c\C-ef" 'org-publish-current-file) +(define-key org-mode-map "\C-c\C-ep" 'org-publish-current-project) +(define-key org-mode-map "\C-c\C-ec" 'org-publish) +(define-key org-mode-map "\C-c\C-ea" 'org-publish-all) +(define-key org-mode-map "\C-c\C-e\C-f" 'org-publish-current-file) +(define-key org-mode-map "\C-c\C-e\C-p" 'org-publish-current-project) +(define-key org-mode-map "\C-c\C-e\C-c" 'org-publish) +(define-key org-mode-map "\C-c\C-e\C-a" 'org-publish-all) + +(when (featurep 'xemacs) + (define-key org-mode-map 'button3 'popup-mode-menu)) + (defsubst org-table-p () (org-at-table-p)) (defun org-self-insert-command (N) @@ -12803,7 +13998,8 @@ because, in this case the deletion might narrow the column." (goto-char pos) ;; noalign: if there were two spaces at the end, this field ;; does not determine the width of the column. - (if noalign (setq org-table-may-need-update c)))) + (if noalign (setq org-table-may-need-update c))) + (delete-char N)) (delete-char N))) ;; How to do this: Measure non-white length of current string @@ -12834,12 +14030,13 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." (defun org-shifttab () "Global visibility cycling or move to previous table field. -Calls `(org-cycle t)' or `org-table-previous-field', depending on context. +Calls `org-cycle' with argument t, or `org-table-previous-field', depending +on context. See the individual commands for more information." (interactive) (cond - ((org-at-table-p) (org-table-previous-field)) - (t (org-cycle '(4))))) + ((org-at-table-p) (call-interactively 'org-table-previous-field)) + (t (call-interactively 'org-global-cycle)))) (defun org-shiftmetaleft () "Promote subtree or delete table column. @@ -12847,8 +14044,8 @@ Calls `org-promote-subtree' or `org-table-delete-column', depending on context. See the individual commands for more information." (interactive) (cond - ((org-at-table-p) (org-table-delete-column)) - ((org-on-heading-p) (org-promote-subtree)) + ((org-at-table-p) (call-interactively 'org-table-delete-column)) + ((org-on-heading-p) (call-interactively 'org-promote-subtree)) ((org-at-item-p) (call-interactively 'org-outdent-item)) (t (org-shiftcursor-error)))) @@ -12858,8 +14055,8 @@ Calls `org-demote-subtree' or `org-table-insert-column', depending on context. See the individual commands for more information." (interactive) (cond - ((org-at-table-p) (org-table-insert-column)) - ((org-on-heading-p) (org-demote-subtree)) + ((org-at-table-p) (call-interactively 'org-table-insert-column)) + ((org-on-heading-p) (call-interactively 'org-demote-subtree)) ((org-at-item-p) (call-interactively 'org-indent-item)) (t (org-shiftcursor-error)))) @@ -12870,9 +14067,9 @@ Calls `org-move-subtree-up' or `org-table-kill-row' or for more information." (interactive "P") (cond - ((org-at-table-p) (org-table-kill-row)) - ((org-on-heading-p) (org-move-subtree-up arg)) - ((org-at-item-p) (org-move-item-up arg)) + ((org-at-table-p) (call-interactively 'org-table-kill-row)) + ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) + ((org-at-item-p) (call-interactively 'org-move-item-up)) (t (org-shiftcursor-error)))) (defun org-shiftmetadown (&optional arg) "Move subtree down or insert table row. @@ -12881,9 +14078,9 @@ Calls `org-move-subtree-down' or `org-table-insert-row' or commands for more information." (interactive "P") (cond - ((org-at-table-p) (org-table-insert-row arg)) - ((org-on-heading-p) (org-move-subtree-down arg)) - ((org-at-item-p) (org-move-item-down arg)) + ((org-at-table-p) (call-interactively 'org-table-insert-row)) + ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) + ((org-at-item-p) (call-interactively 'org-move-item-down)) (t (org-shiftcursor-error)))) (defun org-metaleft (&optional arg) @@ -12893,9 +14090,10 @@ With no specific context, calls the Emacs default `backward-word'. See the individual commands for more information." (interactive "P") (cond - ((org-at-table-p) (org-table-move-column 'left)) - ((or (org-on-heading-p) (org-region-active-p)) (org-do-promote)) - (t (backward-word (prefix-numeric-value arg))))) + ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left)) + ((or (org-on-heading-p) (org-region-active-p)) + (call-interactively 'org-do-promote)) + (t (call-interactively 'backward-word)))) (defun org-metaright (&optional arg) "Demote subtree or move table column to right. @@ -12904,9 +14102,10 @@ With no specific context, calls the Emacs default `forward-word'. See the individual commands for more information." (interactive "P") (cond - ((org-at-table-p) (org-table-move-column nil)) - ((or (org-on-heading-p) (org-region-active-p)) (org-do-demote)) - (t (forward-word (prefix-numeric-value arg))))) + ((org-at-table-p) (call-interactively 'org-table-move-column)) + ((or (org-on-heading-p) (org-region-active-p)) + (call-interactively 'org-do-demote)) + (t (call-interactively 'forward-word)))) (defun org-metaup (&optional arg) "Move subtree up or move table row up. @@ -12915,9 +14114,9 @@ Calls `org-move-subtree-up' or `org-table-move-row' or for more information." (interactive "P") (cond - ((org-at-table-p) (org-table-move-row 'up)) - ((org-on-heading-p) (org-move-subtree-up arg)) - ((org-at-item-p) (org-move-item-up arg)) + ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up)) + ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) + ((org-at-item-p) (call-interactively 'org-move-item-up)) (t (org-shiftcursor-error)))) (defun org-metadown (&optional arg) @@ -12927,43 +14126,46 @@ Calls `org-move-subtree-down' or `org-table-move-row' or commands for more information." (interactive "P") (cond - ((org-at-table-p) (org-table-move-row nil)) - ((org-on-heading-p) (org-move-subtree-down arg)) - ((org-at-item-p) (org-move-item-down arg)) + ((org-at-table-p) (call-interactively 'org-table-move-row)) + ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) + ((org-at-item-p) (call-interactively 'org-move-item-down)) (t (org-shiftcursor-error)))) (defun org-shiftup (&optional arg) - "Increase item in timestamp or increase priority of current item. + "Increase item in timestamp or increase priority of current headline. Calls `org-timestamp-up' or `org-priority-up', depending on context. See the individual commands for more information." (interactive "P") (cond - ((org-at-timestamp-p) (org-timestamp-up arg)) - (t (org-priority-up)))) + ((org-at-timestamp-p) (call-interactively 'org-timestamp-up)) + ((org-on-heading-p) (call-interactively 'org-priority-up)) + ((org-at-item-p) (call-interactively 'org-previous-item)) + (t (call-interactively 'org-beginning-of-item) (beginning-of-line 1)))) (defun org-shiftdown (&optional arg) - "Decrease item in timestamp or decrease priority of current item. + "Decrease item in timestamp or decrease priority of current headline. Calls `org-timestamp-down' or `org-priority-down', depending on context. See the individual commands for more information." (interactive "P") (cond - ((org-at-timestamp-p) (org-timestamp-down arg)) - (t (org-priority-down)))) + ((org-at-timestamp-p) (call-interactively 'org-timestamp-down)) + ((org-on-heading-p) (call-interactively 'org-priority-down)) + (t (call-interactively 'org-next-item)))) (defun org-shiftright () "Next TODO keyword or timestamp one day later, depending on context." (interactive) (cond - ((org-at-timestamp-p) (org-timestamp-up-day)) - ((org-on-heading-p) (org-todo 'right)) + ((org-at-timestamp-p) (call-interactively 'org-timestamp-up-day)) + ((org-on-heading-p) (org-call-with-arg 'org-todo 'right)) (t (org-shiftcursor-error)))) (defun org-shiftleft () "Previous TODO keyword or timestamp one day earlier, depending on context." (interactive) (cond - ((org-at-timestamp-p) (org-timestamp-down-day)) - ((org-on-heading-p) (org-todo 'left)) + ((org-at-timestamp-p) (call-interactively 'org-timestamp-down-day)) + ((org-on-heading-p) (org-call-with-arg 'org-todo 'left)) (t (org-shiftcursor-error)))) (defun org-copy-special () @@ -13028,21 +14230,23 @@ This command does many different things, depending on context: ((and (local-variable-p 'org-finish-function (current-buffer)) (fboundp org-finish-function)) (funcall org-finish-function)) - ((org-on-target-p) (org-update-radio-target-regexp)) - ((org-on-heading-p) (org-set-tags arg)) + ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp)) + ((org-on-heading-p) (call-interactively 'org-set-tags)) ((org-at-table.el-p) (require 'table) (beginning-of-line 1) (re-search-forward "|" (save-excursion (end-of-line 2) (point))) - (table-recognize-table)) + (call-interactively 'table-recognize-table)) ((org-at-table-p) (org-table-maybe-eval-formula) (if arg - (org-table-recalculate t) + (call-interactively 'org-table-recalculate) (org-table-maybe-recalculate-line)) - (org-table-align)) + (call-interactively 'org-table-align)) + ((org-at-item-checkbox-p) + (call-interactively 'org-toggle-checkbox)) ((org-at-item-p) - (org-renumber-ordered-list (prefix-numeric-value arg))) + (call-interactively 'org-renumber-ordered-list)) ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)")) (cond ((equal (match-string 1) "TBLFM") @@ -13050,9 +14254,10 @@ This command does many different things, depending on context: (save-excursion (beginning-of-line 1) (skip-chars-backward " \r\n\t") - (if (org-at-table-p) (org-table-recalculate t)))) + (if (org-at-table-p) + (org-call-with-arg 'org-table-recalculate t)))) (t - (org-mode-restart)))) + (call-interactively 'org-mode-restart)))) (t (error "C-c C-c can do nothing useful at this location."))))) (defun org-mode-restart () @@ -13070,7 +14275,7 @@ See the individual commands for more information." (cond ((org-at-table-p) (org-table-justify-field-maybe) - (org-table-next-row)) + (call-interactively 'org-table-next-row)) (t (newline)))) (defun org-meta-return (&optional arg) @@ -13080,8 +14285,8 @@ See the individual commands for more information." (interactive "P") (cond ((org-at-table-p) - (org-table-wrap-region arg)) - (t (org-insert-heading arg)))) + (call-interactively 'org-table-wrap-region)) + (t (call-interactively 'org-insert-heading)))) ;;; Menu entries @@ -13226,10 +14431,10 @@ See the individual commands for more information." "--" ("Export" ["ASCII" org-export-as-ascii t] - ["Extract Visible Text" org-export-copy-visible t] + ["Export visible part..." org-export-visible t] ["HTML" org-export-as-html t] ["HTML and Open" org-export-as-html-and-open t] - ["XML (XOXO)" org-export-as-xml t] + ["XOXO" org-export-as-xoxo t] "--" ["iCalendar this file" org-export-icalendar-this-file t] ["iCalendar all agenda files" org-export-icalendar-all-agenda-files @@ -13238,6 +14443,11 @@ See the individual commands for more information." "--" ["Option Template" org-insert-export-options-template t] ["Toggle Fixed Width" org-toggle-fixed-width-section t]) + ("Publish" + ["Current File" org-publish-current-file t] + ["Current Project" org-publish-current-project t] + ["Project..." org-publish t] + ["All Projects" org-publish-all t]) "--" ("Documentation" ["Show Version" org-version t] @@ -13303,6 +14513,100 @@ With optional NODE, go directly to that node." ;;; Miscellaneous stuff +(defun org-context () + "Return a list of contexts of the current cursor position. +If several contexts apply, all are returned. +Each context entry is a list with a symbol naming the context, and +two positions indicating start and end of the context. Possible +contexts are: + +:headline anywhere in a headline +:headline-stars on the leading stars in a headline +:todo-keyword on a TODO keyword (including DONE) in a headline +:tags on the TAGS in a headline +:priority on the priority cookie in a headline +:item on the first line of a plain list item +:checkbox on the checkbox in a plain list item +:table in an org-mode table +:table-special on a special filed in a table +:table-table in a table.el table +:link on a hyperline +:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE,COMMENT, QUOTE. +:target on a <<target>> +:radio-target on a <<<radio-target>>> + +This function expects the position to be visible because it uses font-lock +faces as a help to recognize the following contexts: :table-special, :link, +and :keyword." + (let* ((f (get-text-property (point) 'face)) + (faces (if (listp f) f (list f))) + (p (point)) clist) + ;; First the large context + (cond + ((org-on-heading-p) + (push (list :headline (point-at-bol) (point-at-eol)) clist) + (when (progn + (beginning-of-line 1) + (looking-at org-todo-line-tags-regexp)) + (push (org-point-in-group p 1 :headline-stars) clist) + (push (org-point-in-group p 2 :todo-keyword) clist) + (push (org-point-in-group p 4 :tags) clist)) + (goto-char p) + (skip-chars-backward "^[\n\r \t") (or (eobp) (backward-char 1)) + (if (looking-at "\\[#[A-Z]\\]") + (push (org-point-in-group p 0 :priority) clist))) + + ((org-at-item-p) + (push (list :item (point-at-bol) + (save-excursion (org-end-of-item) (point))) + clist) + (and (org-at-item-checkbox-p) + (push (org-point-in-group p 0 :checkbox) clist))) + + ((org-at-table-p) + (push (list :table (org-table-begin) (org-table-end)) clist) + (if (memq 'org-formula faces) + (push (list :table-special + (previous-single-property-change p 'face) + (next-single-property-change p 'face)) clist))) + ((org-at-table-p 'any) + (push (list :table-table) clist))) + (goto-char p) + + ;; Now the small context + (cond + ((org-at-timestamp-p) + (push (org-point-in-group p 0 :timestamp) clist)) + ((memq 'org-link faces) + (push (list :link + (previous-single-property-change p 'face) + (next-single-property-change p 'face)) clist)) + ((memq 'org-special-keyword faces) + (push (list :keyword + (previous-single-property-change p 'face) + (next-single-property-change p 'face)) clist)) + ((org-on-target-p) + (push (org-point-in-group p 0 :target) clist) + (goto-char (1- (match-beginning 0))) + (if (looking-at org-radio-target-regexp) + (push (org-point-in-group p 0 :radio-target) clist)) + (goto-char p))) + + (setq clist (nreverse (delq nil clist))) + clist)) + +(defun org-point-in-group (point group &optional context) + "Check if POINT is in match-group GROUP. +If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the +match. If the match group does ot exist or point is not inside it, +return nil." + (and (match-beginning group) + (>= point (match-beginning group)) + (<= point (match-end group)) + (if context + (list context (match-beginning group) (match-end group)) + t))) + (defun org-move-line-down (arg) "Move the current line down. With prefix argument, move it past ARG lines." (interactive "p") @@ -13331,8 +14635,6 @@ With optional NODE, go directly to that node." ;; Paragraph filling stuff. ;; We want this to be just right, so use the full arsenal. -;; FIXME: This very likely does not work correctly for XEmacs, because the -;; filladapt package works slightly differently. (defun org-set-autofill-regexps () (interactive) @@ -13451,7 +14753,7 @@ that can be added." ;; The following functions capture almost the entire compatibility code ;; between the different versions of outline-mode. The only other ;; places where this is important are the font-lock-keywords, and in -;; `org-export-copy-visible'. Search for `org-noutline-p' to find them. +;; `org-export-visible'. Search for `org-noutline-p' to find them. ;; C-a should go to the beginning of a *visible* line, also in the ;; new outline.el. I guess this should be patched into Emacs? @@ -13471,8 +14773,6 @@ to a visible line beginning. This makes the function of C-a more intuitive." (when org-noutline-p (define-key org-mode-map "\C-a" 'org-beginning-of-line)) -;; FIXME: should I use substitute-key-definition to reach other bindings -;; of beginning-of-line? (defun org-invisible-p () "Check if point is at a character currently not visible." @@ -13503,15 +14803,15 @@ to a visible line beginning. This makes the function of C-a more intuitive." Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." (if org-noutline-p (outline-back-to-heading invisible-ok) - (if (and (memq (char-before) '(?\n ?\r)) + (if (and (or (bobp) (memq (char-before) '(?\n ?\r))) (looking-at outline-regexp)) t (if (re-search-backward (concat (if invisible-ok "\\([\r\n]\\|^\\)" "^") outline-regexp) nil t) (if invisible-ok - (progn (goto-char (match-end 1)) - (looking-at outline-regexp))) + (progn (goto-char (or (match-end 1) (match-beginning 0))) + (looking-at outline-regexp))) (error "Before first heading"))))) (defun org-on-heading-p (&optional invisible-ok) @@ -13585,10 +14885,9 @@ When ENTRY is non-nil, show the entire entry." (if entry (progn (org-show-entry) - (save-excursion ;; FIXME: Is this the fix for points in the -| - ;; middle of text? | - (and (outline-next-heading) ;; | - (org-flag-heading nil)))) ; show the next heading _| + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil)))) (outline-flag-region (max 1 (1- (point))) (save-excursion (outline-end-of-heading) (point)) (if org-noutline-p @@ -13630,7 +14929,7 @@ Show the heading too, if it is currently invisible." (save-excursion (org-back-to-heading t) (outline-flag-region - (1- (point)) + (max 1 (1- (point))) (save-excursion (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) (or (match-beginning 1) (point-max))) @@ -13669,6 +14968,10 @@ Show the heading too, if it is currently invisible." (run-hooks 'org-load-hook) + ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd ;;; org.el ends here + + + diff --git a/lisp/textmodes/po.el b/lisp/textmodes/po.el index 07b9ba1a2b1..eac1cb94105 100644 --- a/lisp/textmodes/po.el +++ b/lisp/textmodes/po.el @@ -41,15 +41,21 @@ Contains canonical charset names that don't correspond to coding systems.") (defun po-find-charset (filename) - "Return PO charset value for FILENAME." + "Return PO charset value for FILENAME. +If FILENAME is a cons, the cdr part is a buffer that already contains +the PO file (but not yet decoded)." (let ((charset-regexp "^\"Content-Type:[ \t]*text/plain;[ \t]*charset=\\(.*\\)\\\\n\"") + (buf (and (consp filename) (cdr filename))) (short-read nil)) + (when buf + (set-buffer buf) + (goto-char (point-min))) ;; Try the first 4096 bytes. In case we cannot find the charset value ;; within the first 4096 bytes (the PO file might start with a long ;; comment) try the next 4096 bytes repeatedly until we'll know for sure ;; we've checked the empty header entry entirely. - (while (not (or short-read (re-search-forward "^msgid" nil t))) + (while (not (or short-read (re-search-forward "^msgid" nil t) buf)) (save-excursion (goto-char (point-max)) (let ((pair (insert-file-contents-literally filename nil @@ -57,7 +63,7 @@ Contains canonical charset names that don't correspond to coding systems.") (1- (+ (point) 4096))))) (setq short-read (< (nth 1 pair) 4096))))) (cond ((re-search-forward charset-regexp nil t) (match-string 1)) - (short-read nil) + ((or short-read buf) nil) ;; We've found the first msgid; maybe, only a part of the msgstr ;; value was loaded. Load the next 1024 bytes; if charset still ;; isn't available, give up. @@ -71,10 +77,13 @@ Contains canonical charset names that don't correspond to coding systems.") (defun po-find-file-coding-system-guts (operation filename) "Return a (DECODING . ENCODING) pair for OPERATION on PO file FILENAME. -Do so according to FILENAME's declared charset." +Do so according to FILENAME's declared charset. +FILENAME may be a cons (NAME . BUFFER). In that case, detect charset +in BUFFER." (and (eq operation 'insert-file-contents) - (file-exists-p filename) + (or (if (consp filename) (buffer-live-p (cdr filename))) + (file-exists-p filename)) (with-temp-buffer (let* ((coding-system-for-read 'no-conversion) (charset (or (po-find-charset filename) "ascii")) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 416a3efb684..18f0c980929 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -49,13 +49,14 @@ :type 'integer :group 'sgml) -(defcustom sgml-transformation 'identity - "*Default value for `skeleton-transformation' (which see) in SGML mode." +(defcustom sgml-transformation-function 'identity + "*Default value for `skeleton-transformation-function' in SGML mode." :type 'function :group 'sgml) -(put 'sgml-transformation 'variable-interactive +(put 'sgml-transformation-function 'variable-interactive "aTransformation function: ") +(defvaralias 'sgml-transformation 'sgml-transformation-function) (defcustom sgml-mode-hook nil "Hook run by command `sgml-mode'. @@ -333,6 +334,7 @@ an optional alist of possible values." :type '(repeat (cons (string :tag "Tag Name") (repeat :tag "Tag Rule" sexp))) :group 'sgml) +(put 'sgml-tag-alist 'risky-local-variable t) (defcustom sgml-tag-help '(("!" . "Empty declaration for comment") @@ -389,7 +391,7 @@ a DOCTYPE or an XML declaration." (defun sgml-mode-facemenu-add-face-function (face end) (if (setq face (cdr (assq face sgml-face-tag-alist))) (progn - (setq face (funcall skeleton-transformation face)) + (setq face (funcall skeleton-transformation-function face)) (setq facemenu-end-add-face (concat "</" face ">")) (concat "<" face ">")) (error "Face not configured for %s mode" mode-name))) @@ -413,8 +415,8 @@ An argument of N to a tag-inserting command means to wrap it around the next N words. In Transient Mark mode, when the mark is active, N defaults to -1, which means to wrap it around the current region. -If you like upcased tags, put (setq sgml-transformation 'upcase) in -your `.emacs' file. +If you like upcased tags, put (setq sgml-transformation-function 'upcase) +in your `.emacs' file. Use \\[sgml-validate] to validate your document with an SGML parser. @@ -458,7 +460,8 @@ Do \\[describe-key] on the following bindings to discover what they do. (sgml-xml-guess) (if sgml-xml-mode (setq mode-name "XML") - (set (make-local-variable 'skeleton-transformation) sgml-transformation)) + (set (make-local-variable 'skeleton-transformation-function) + sgml-transformation-function)) ;; This will allow existing comments within declarations to be ;; recognized. (set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*") @@ -602,9 +605,9 @@ This only works for Latin-1 input." (if sgml-name-8bit-mode "ON" "OFF"))) ;; When an element of a skeleton is a string "str", it is passed -;; through skeleton-transformation and inserted. If "str" is to be -;; inserted literally, one should obtain it as the return value of a -;; function, e.g. (identity "str"). +;; through `skeleton-transformation-function' and inserted. +;; If "str" is to be inserted literally, one should obtain it as +;; the return value of a function, e.g. (identity "str"). (defvar sgml-tag-last nil) (defvar sgml-tag-history nil) @@ -612,9 +615,10 @@ This only works for Latin-1 input." "Prompt for a tag and insert it, optionally with attributes. Completion and configuration are done according to `sgml-tag-alist'. If you like tags and attributes in uppercase do \\[set-variable] -skeleton-transformation RET upcase RET, or put this in your `.emacs': - (setq sgml-transformation 'upcase)" - (funcall (or skeleton-transformation 'identity) +`skeleton-transformation-function' RET `upcase' RET, or put this +in your `.emacs': + (setq sgml-transformation-function 'upcase)" + (funcall (or skeleton-transformation-function 'identity) (setq sgml-tag-last (completing-read (if (> (length sgml-tag-last) 0) @@ -637,7 +641,7 @@ skeleton-transformation RET upcase RET, or put this in your `.emacs': ;; For xhtml's `tr' tag, we should maybe use \n instead. (if (eq v2 t) (setq v2 nil)) ;; We use `identity' to prevent skeleton from passing - ;; `str' through skeleton-transformation a second time. + ;; `str' through `skeleton-transformation-function' a second time. '(("") v2 _ v2 "</" (identity ',str) ?>)) ((eq (car v2) t) (cons '("") (cdr v2))) @@ -668,12 +672,12 @@ If QUIET, do not print a message when there are no attributes for TAG." (if (stringp (car alist)) (progn (insert (if (eq (preceding-char) ?\s) "" ?\s) - (funcall skeleton-transformation (car alist))) + (funcall skeleton-transformation-function (car alist))) (sgml-value alist)) (setq i (length alist)) (while (> i 0) (insert ?\s) - (insert (funcall skeleton-transformation + (insert (funcall skeleton-transformation-function (setq attribute (skeleton-read '(completing-read "Attribute: " @@ -1979,12 +1983,12 @@ Can be used as a value for `html-mode-hook'." "\" name=\"" (or v1 (setq v1 (skeleton-read "Name: "))) "\" value=\"" str ?\" (when (y-or-n-p "Set \"checked\" attribute? ") - (funcall skeleton-transformation + (funcall skeleton-transformation-function (if sgml-xml-mode " checked=\"checked\"" " checked"))) (if sgml-xml-mode " />" ">") (skeleton-read "Text: " (capitalize str)) (or v2 (setq v2 (if (y-or-n-p "Newline after text? ") - (funcall skeleton-transformation + (funcall skeleton-transformation-function (if sgml-xml-mode "<br />" "<br>")) ""))) \n)) @@ -1999,12 +2003,12 @@ Can be used as a value for `html-mode-hook'." "\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: "))) "\" value=\"" str ?\" (when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? "))) - (funcall skeleton-transformation + (funcall skeleton-transformation-function (if sgml-xml-mode " checked=\"checked\"" " checked"))) (if sgml-xml-mode " />" ">") (skeleton-read "Text: " (capitalize str)) (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ") - (funcall skeleton-transformation + (funcall skeleton-transformation-function (if sgml-xml-mode "<br />" "<br>")) ""))) \n)) diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 6c9463fe11e..dab08902769 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -6,7 +6,7 @@ ;; Keywords: wp, convenience ;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com> ;; Created: Sat Jul 08 2000 13:28:45 (PST) -;; Revised: Sat Aug 06 2005 19:42:54 (CEST) +;; Revised: Tue May 30 2006 10:01:43 (PDT) ;; This file is part of GNU Emacs. @@ -3104,10 +3104,10 @@ CALS (DocBook DTD): (cond ((eq language 'html) (insert (format "<!-- This HTML table template is generated by emacs %s -->\n" emacs-version) - (format "<TABLE %s>\n" table-html-table-attribute) + (format "<table %s>\n" table-html-table-attribute) (if (and (stringp caption) (not (string= caption ""))) - (format " <CAPTION>%s</CAPTION>\n" caption) + (format " <caption>%s</caption>\n" caption) ""))) ((eq language 'latex) (insert (format "%% This LaTeX table template is generated by emacs %s\n" emacs-version) @@ -3131,7 +3131,7 @@ CALS (DocBook DTD): (with-current-buffer dest-buffer (cond ((eq language 'html) - (insert "</TABLE>\n")) + (insert "</table>\n")) ((eq language 'latex) (insert "\\end{tabular}\n")) ((eq language 'cals) @@ -3152,7 +3152,7 @@ CALS (DocBook DTD): (with-current-buffer dest-buffer (cond ((eq language 'html) - (insert " <TR>\n")) + (insert " <tr>\n")) ((eq language 'cals) (insert " <row>\n")) )) @@ -3160,7 +3160,7 @@ CALS (DocBook DTD): (with-current-buffer dest-buffer (cond ((eq language 'html) - (insert " </TR>\n")) + (insert " </tr>\n")) ((eq language 'cals) (insert " </row>\n") (unless (/= (table-get-source-info 'current-row) table-cals-thead-rows) @@ -3207,7 +3207,7 @@ CALS (DocBook DTD): 'cell-type (if (or (<= (table-get-source-info 'current-row) table-html-th-rows) (<= (table-get-source-info 'current-column) table-html-th-columns)) - "TH" "TD")))) + "th" "td")))) (if (and table-html-cell-attribute (not (string= table-html-cell-attribute ""))) (insert " " table-html-cell-attribute)) (if (> colspan 1) (insert (format " colspan=\"%d\"" colspan))) @@ -3266,7 +3266,7 @@ CALS (DocBook DTD): (goto-char (point-min)) (while (and (re-search-forward "$" nil t) (not (eobp))) - (insert "<BR />") + (insert "<br />") (forward-char 1))) (unless (and table-html-delegate-spacing-to-user-agent (progn diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index a4b67057676..9263c48f18b 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -33,7 +33,7 @@ (defcustom text-mode-hook nil "Normal hook run when entering Text mode and many related modes." :type 'hook - :options '(turn-on-auto-fill flyspell-mode) + :options '(turn-on-auto-fill turn-on-flyspell) :group 'data) (defvar text-mode-variant nil diff --git a/lisp/tumme.el b/lisp/tumme.el index 6a53ed16948..d6420bf33d7 100644 --- a/lisp/tumme.el +++ b/lisp/tumme.el @@ -84,46 +84,13 @@ ;; USAGE ;; ===== ;; -;; If you plan to use tumme much, setting up key bindings for it in -;; dired is a good idea: +;; This information has been moved to the manual. Type `C-h r' to open +;; the Emacs manual and go to the node Thumbnails by typing `g +;; Thumbnails RET'. ;; -;; (tumme-setup-dired-keybindings) -;; -;; Next, do M-x tumme-dired RET. This will ask you for a directory -;; where image files are stored, setup a useful window configuration -;; and enable the two special modes that tumme provides. NOTE: If you -;; do not want tumme to split your windows, call it with a prefix -;; argument. -;; -;; Start viewing thumbnails by doing C-S-n and C-S-p to go up and down -;; in the dired buffer while at the same time displaying a thumbnail -;; image. The thumbnail images will be created on the fly, and -;; cached. This means that the first time you browse your images, it -;; will be a bit slow because the thumbnails are created. If you want -;; to avoid this, you can pre-create the thumbnail images by marking -;; all images in dired (% m \.jpg$ RET) and then do M-x -;; tumme-create-thumbs. -;; -;; Next, try `tumme-display-thumbs' (C-t d). If no file is marked, a -;; thumbnail for the file at point will show up in -;; `tumme-thumbnail-buffer'. If one or more files are marked, -;; thumbnails for those files will be displayed. -;; -;; Pressing TAB will switch to the window containing the -;; `tumme-thumbnail-buffer' buffer. In there you can move between -;; thumbnail images and display a semi-sized version in an Emacs -;; buffer (RET), or the original image in an external viewer -;; (C-RET). By pressing SPC or DEL you will navigate back and fort -;; while at the same time displaying each image in Emacs. You can also -;; navigate using arrow keys. Comment a file by pressing "c". Press -;; TAB to get back to dired. -;; -;; While in dired mode, you can tag and comment files, you can tell -;; `tumme' to mark files with a certain tag (using a regexp) etc. -;; -;; The easiest way to see the available commands is to use the Tumme -;; menus added in tumme-thumbnail-mode and dired-mode. +;; Quickstart: M-x tumme RET DIRNAME RET ;; +;; where DIRNAME is a directory containing image files. ;; ;; LIMITATIONS ;; =========== @@ -488,7 +455,7 @@ completely fit)." :type 'integer :group 'tumme) -(defcustom tumme-track-movement nil +(defcustom tumme-track-movement t "The current state of the tracking and mirroring. For more information, see the documentation for `tumme-toggle-movement-tracking'." @@ -541,13 +508,13 @@ Used by `tumme-copy-with-exif-file-name'." :group 'tumme) (defcustom tumme-show-all-from-dir-max-files 50 - "*Maximum number of files to show using`tumme-show-all-from-dir'. + "*Maximum number of files to show using `tumme-show-all-from-dir'. before warning the user." :type 'integer :group 'tumme) (defun tumme-dir () - "Return the current thumbnails directory (from `tumme-dir'). + "Return the current thumbnails directory (from variable `tumme-dir'). Create the thumbnails directory if it does not exist." (let ((tumme-dir (file-name-as-directory (expand-file-name tumme-dir)))) @@ -701,7 +668,7 @@ Otherwise, delete overlays." (interactive) (dired-next-line 1) (tumme-display-thumbs - t (or tumme-append-when-browsing nil)) + t (or tumme-append-when-browsing nil) t) (if tumme-dired-disp-props (tumme-dired-display-properties))) @@ -710,7 +677,7 @@ Otherwise, delete overlays." (interactive) (dired-previous-line 1) (tumme-display-thumbs - t (or tumme-append-when-browsing nil)) + t (or tumme-append-when-browsing nil) t) (if tumme-dired-disp-props (tumme-dired-display-properties))) @@ -729,7 +696,7 @@ Otherwise, delete overlays." (interactive) (dired-mark 1) (tumme-display-thumbs - t (or tumme-append-when-browsing nil)) + t (or tumme-append-when-browsing nil) t) (if tumme-dired-disp-props (tumme-dired-display-properties))) @@ -818,7 +785,7 @@ Restore any changes to the window configuration made by calling (message "No saved window configuration"))) ;;;###autoload -(defun tumme-display-thumbs (&optional arg append) +(defun tumme-display-thumbs (&optional arg append do-not-pop) "Display thumbnails of all marked files, in `tumme-thumbnail-buffer'. If a thumbnail image does not exist for a file, it is created on the fly. With prefix argument ARG, display only thumbnail for file at @@ -830,7 +797,14 @@ you have the dired buffer in the left window and the `tumme-thumbnail-buffer' buffer in the right window. With optional argument APPEND, append thumbnail to thumbnail buffer -instead of erasing it first." +instead of erasing it first. + +Option argument DO-NOT-POP controls if `pop-to-buffer' should be +used or not. If non-nil, use `display-buffer' instead of +`pop-to-buffer'. This is used from functions like +`tumme-next-line-and-display' and +`tumme-previous-line-and-display' where we do not want the +thumbnail buffer to be selected." (interactive "P") (let ((buf (tumme-create-thumbnail-buffer)) curr-file thumb-name files count dired-buf beg) @@ -862,8 +836,11 @@ instead of erasing it first." nil) (t (tumme-line-up-dynamic)))) - (pop-to-buffer tumme-thumbnail-buffer))) + (if do-not-pop + (display-buffer tumme-thumbnail-buffer) + (pop-to-buffer tumme-thumbnail-buffer)))) +;;;###autoload (defun tumme-show-all-from-dir (dir) "Make a preview buffer for all images in DIR and display it. If the number of files in DIR matching `image-file-name-regexp' @@ -905,10 +882,9 @@ displayed." (end-of-line) (setq end (point)) (beginning-of-line) - (if (not (search-forward (format ";%s" tag) end t)) - (progn - (end-of-line) - (insert (format ";%s" tag))))) + (when (not (search-forward (format ";%s" tag) end t)) + (end-of-line) + (insert (format ";%s" tag)))) (goto-char (point-max)) (insert (format "\n%s;%s" file tag)))) files) @@ -927,27 +903,24 @@ displayed." (mapcar (lambda (file) (goto-char (point-min)) - (if (search-forward-regexp - (format "^%s" file) nil t) - (progn - (end-of-line) - (setq end (point)) - (beginning-of-line) - (if (search-forward-regexp (format "\\(;%s\\)" tag) end t) - (progn - (delete-region (match-beginning 1) (match-end 1)) - ;; Check if file should still be in the database. If - ;; it has no tags or comments, it will be removed. - (end-of-line) - (setq end (point)) - (beginning-of-line) - (if (not (search-forward ";" end t)) - (progn - (kill-line 1) - ;; If on empty line at end of buffer - (if (and (eobp) - (looking-at "^$")) - (delete-backward-char 1))))))))) + (when (search-forward-regexp + (format "^%s" file) nil t) + (end-of-line) + (setq end (point)) + (beginning-of-line) + (when (search-forward-regexp (format "\\(;%s\\)" tag) end t) + (delete-region (match-beginning 1) (match-end 1)) + ;; Check if file should still be in the database. If + ;; it has no tags or comments, it will be removed. + (end-of-line) + (setq end (point)) + (beginning-of-line) + (when (not (search-forward ";" end t)) + (kill-line 1) + ;; If on empty line at end of buffer + (when (and (eobp) + (looking-at "^$")) + (delete-backward-char 1)))))) files) (save-buffer) (kill-buffer buf)))) @@ -958,17 +931,16 @@ displayed." (let (end buf (tags "")) (setq buf (find-file tumme-db-file)) (goto-char (point-min)) - (if (search-forward-regexp - (format "^%s" file) nil t) - (progn - (end-of-line) - (setq end (point)) - (beginning-of-line) - (if (search-forward ";" end t) - (if (search-forward "comment:" end t) - (if (search-forward ";" end t) - (setq tags (buffer-substring (point) end))) - (setq tags (buffer-substring (point) end)))))) + (when (search-forward-regexp + (format "^%s" file) nil t) + (end-of-line) + (setq end (point)) + (beginning-of-line) + (if (search-forward ";" end t) + (if (search-forward "comment:" end t) + (if (search-forward ";" end t) + (setq tags (buffer-substring (point) end))) + (setq tags (buffer-substring (point) end))))) (kill-buffer buf) (split-string tags ";")))) @@ -976,7 +948,7 @@ displayed." (defun tumme-tag-files (arg) "Tag marked file(s) in dired. With prefix ARG, tag file at point." (interactive "P") - (let ((tag (read-string "Tag to add: ")) + (let ((tag (read-string "Tags to add (separate tags with a semicolon): ")) curr-file files) (if arg (setq files (dired-get-filename)) @@ -986,13 +958,13 @@ displayed." (defun tumme-tag-thumbnail () "Tag current thumbnail." (interactive) - (let ((tag (read-string "Tag to add: "))) + (let ((tag (read-string "Tags to add (separate tags with a semicolon): "))) (tumme-write-tag (tumme-original-file-name) tag)) (tumme-update-property 'tags (tumme-list-tags (tumme-original-file-name)))) ;;;###autoload -(defun tumme-tag-remove (arg) +(defun tumme-delete-tag (arg) "Remove tag for selected file(s). With prefix argument ARG, remove tag from file at point." (interactive "P") @@ -1034,17 +1006,16 @@ use only useful if `tumme-track-movement' is nil." (let ((old-buf (current-buffer)) (dired-buf (tumme-associated-dired-buffer)) (file-name (tumme-original-file-name))) - (if (and dired-buf file-name) - (progn - (setq file-name (file-name-nondirectory file-name)) - (set-buffer dired-buf) - (goto-char (point-min)) - (if (not (search-forward file-name nil t)) - (message "Could not track file") - (dired-move-to-filename) - (set-window-point - (tumme-get-buffer-window dired-buf) (point))) - (set-buffer old-buf))))) + (when (and dired-buf file-name) + (setq file-name (file-name-nondirectory file-name)) + (set-buffer dired-buf) + (goto-char (point-min)) + (if (not (search-forward file-name nil t)) + (message "Could not track file") + (dired-move-to-filename) + (set-window-point + (tumme-get-buffer-window dired-buf) (point))) + (set-buffer old-buf)))) (defun tumme-toggle-movement-tracking () "Turn on and off `tumme-track-movement'. @@ -1063,24 +1034,22 @@ the other way around." (let ((file (dired-get-filename)) (old-buf (current-buffer)) prop-val found) - (if (get-buffer tumme-thumbnail-buffer) - (progn - (set-buffer tumme-thumbnail-buffer) - (goto-char (point-min)) - (while (and (not (eobp)) - (not found)) - (if (and (setq prop-val - (get-text-property (point) 'original-file-name)) - (string= prop-val file)) - (setq found t)) - (if (not found) - (forward-char 1))) - (if found - (progn - (set-window-point - (tumme-thumbnail-window) (point)) - (tumme-display-thumb-properties))) - (set-buffer old-buf))))) + (when (get-buffer tumme-thumbnail-buffer) + (set-buffer tumme-thumbnail-buffer) + (goto-char (point-min)) + (while (and (not (eobp)) + (not found)) + (if (and (setq prop-val + (get-text-property (point) 'original-file-name)) + (string= prop-val file)) + (setq found t)) + (if (not found) + (forward-char 1))) + (when found + (set-window-point + (tumme-thumbnail-window) (point)) + (tumme-display-thumb-properties)) + (set-buffer old-buf)))) (defun tumme-dired-next-line (&optional arg) "Call `dired-next-line', then track thumbnail. @@ -1105,29 +1074,27 @@ move ARG lines." (interactive) ;; Before we move, make sure that there is an image two positions ;; forward. - (if (save-excursion + (when (save-excursion (forward-char 2) (tumme-image-at-point-p)) - (progn - (forward-char) - (while (and (not (eobp)) - (not (tumme-image-at-point-p))) - (forward-char)) - (if tumme-track-movement - (tumme-track-original-file)))) + (forward-char) + (while (and (not (eobp)) + (not (tumme-image-at-point-p))) + (forward-char)) + (if tumme-track-movement + (tumme-track-original-file))) (tumme-display-thumb-properties)) (defun tumme-backward-char () "Move to previous image and display properties." (interactive) - (if (not (bobp)) - (progn - (backward-char) - (while (and (not (bobp)) - (not (tumme-image-at-point-p))) - (backward-char)) - (if tumme-track-movement - (tumme-track-original-file)))) + (when (not (bobp)) + (backward-char) + (while (and (not (bobp)) + (not (tumme-image-at-point-p))) + (backward-char)) + (if tumme-track-movement + (tumme-track-original-file))) (tumme-display-thumb-properties)) (defun tumme-next-line () @@ -1515,9 +1482,9 @@ Note that n, p and <down> and <up> will be hijacked and bound to (define-key dired-mode-map "\C-td" 'tumme-display-thumbs) (define-key dired-mode-map "\C-tt" 'tumme-tag-files) - (define-key dired-mode-map "\C-tr" 'tumme-tag-remove) + (define-key dired-mode-map "\C-tr" 'tumme-delete-tag) (define-key dired-mode-map [tab] 'tumme-jump-thumbnail-buffer) - (define-key dired-mode-map "\C-ti" 'tumme-display-dired-image) + (define-key dired-mode-map "\C-ti" 'tumme-dired-display-image) (define-key dired-mode-map "\C-tx" 'tumme-dired-display-external) (define-key dired-mode-map "\C-ta" 'tumme-display-thumbs-append) (define-key dired-mode-map "\C-t." 'tumme-display-thumb) @@ -1537,8 +1504,8 @@ Note that n, p and <down> and <up> will be hijacked and bound to (define-key dired-mode-map [menu-bar tumme tumme-mark-tagged-files] '("Mark tagged files" . tumme-mark-tagged-files)) - (define-key dired-mode-map [menu-bar tumme tumme-tag-remove] - '("Remove tag from files" . tumme-tag-remove)) + (define-key dired-mode-map [menu-bar tumme tumme-delete-tag] + '("Remove tag from files" . tumme-delete-tag)) (define-key dired-mode-map [menu-bar tumme tumme-tag-files] '("Tag files" . tumme-tag-files)) @@ -1561,8 +1528,8 @@ Note that n, p and <down> and <up> will be hijacked and bound to [menu-bar tumme tumme-dired-display-external] '("Display in external viewer" . tumme-dired-display-external)) (define-key dired-mode-map - [menu-bar tumme tumme-display-dired-image] - '("Display image" . tumme-display-dired-image)) + [menu-bar tumme tumme-dired-display-image] + '("Display image" . tumme-dired-display-image)) (define-key dired-mode-map [menu-bar tumme tumme-display-thumb] '("Display this thumbnail" . tumme-display-thumb)) @@ -1658,13 +1625,13 @@ Ask user for number of images to show and the delay in between." (defun tumme-display-thumbs-append () "Append thumbnails to `tumme-thumbnail-buffer'." (interactive) - (tumme-display-thumbs nil t)) + (tumme-display-thumbs nil t t)) ;;;###autoload (defun tumme-display-thumb () "Shorthard for `tumme-display-thumbs' with prefix argument." (interactive) - (tumme-display-thumbs t)) + (tumme-display-thumbs t nil t)) (defun tumme-line-up () "Line up thumbnails according to `tumme-thumbs-per-row'. @@ -1688,11 +1655,10 @@ See also `tumme-line-up-dynamic'." (insert "\n") (insert " ") (setq count (1+ count)) - (if (= count (- tumme-thumbs-per-row 1)) - (progn - (forward-char) - (insert "\n") - (setq count 0)))))) + (when (= count (- tumme-thumbs-per-row 1)) + (forward-char) + (insert "\n") + (setq count 0))))) (goto-char (point-min)))) (defun tumme-line-up-dynamic () @@ -1786,13 +1752,11 @@ Ask user how many thumbnails should be displayed per row." (defun tumme-display-image (file &optional original-size) "Display image FILE in image buffer. -Use this when you want to display the image, semi sized, in a window -next to the thumbnail window - typically a three-window configuration -with dired to the left, thumbnail window to the upper right and image -window to the lower right. The image is sized to fit the display -window (using a temporary file, don't worry). Because of this, it -will not be as quick as opening it directly, but on most modern -systems it should feel snappy enough. +Use this when you want to display the image, semi sized, in a new +window. The image is sized to fit the display window (using a +temporary file, don't worry). Because of this, it will not be as +quick as opening it directly, but on most modern systems it +should feel snappy enough. If optional argument ORIGINAL-SIZE is non-nil, display image in its original size." @@ -1841,12 +1805,13 @@ With prefix argument ARG, display image in its original size." (display-buffer tumme-display-image-buffer)))))) ;;;###autoload -(defun tumme-display-dired-image (&optional arg) +(defun tumme-dired-display-image (&optional arg) "Display current image file. See documentation for `tumme-display-image' for more information. With prefix argument ARG, display image in its original size." (interactive "P") - (tumme-display-image (dired-get-filename) arg)) + (tumme-display-image (dired-get-filename) arg) + (display-buffer tumme-display-image-buffer)) (defun tumme-image-at-point-p () "Return true if there is a tumme thumbnail at point." @@ -2122,19 +2087,18 @@ as initial value." (let (end buf comment-beg comment (base-name (file-name-nondirectory file))) (setq buf (find-file tumme-db-file)) (goto-char (point-min)) - (if (search-forward-regexp - (format "^%s" base-name) nil t) - (progn - (end-of-line) - (setq end (point)) - (beginning-of-line) - (cond ((search-forward ";comment:" end t) - (setq comment-beg (point)) - (if (search-forward ";" end t) - (setq comment-end (- (point) 1)) - (setq comment-end end)) - (setq comment (buffer-substring - comment-beg comment-end)))))) + (when (search-forward-regexp + (format "^%s" base-name) nil t) + (end-of-line) + (setq end (point)) + (beginning-of-line) + (cond ((search-forward ";comment:" end t) + (setq comment-beg (point)) + (if (search-forward ";" end t) + (setq comment-end (- (point) 1)) + (setq comment-end end)) + (setq comment (buffer-substring + comment-beg comment-end))))) (kill-buffer buf) comment))) diff --git a/lisp/vc.el b/lisp/vc.el index 61b8aa05a4b..54237800e3c 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -894,10 +894,12 @@ However, before executing BODY, find FILE, and after BODY, save buffer." (defun vc-process-filter (p s) "An alternative output filter for async process P. -The only difference with the default filter is to insert S after markers." +One difference with the default filter is that this inserts S after markers. +Another is that undo information is not kept." (with-current-buffer (process-buffer p) (save-excursion - (let ((inhibit-read-only t)) + (let ((buffer-undo-list t) + (inhibit-read-only t)) (goto-char (process-mark p)) (insert s) (set-marker (process-mark p) (point)))))) @@ -914,7 +916,8 @@ BUF defaults to \"*vc*\", can be a string and will be created if necessary." (set (make-local-variable 'vc-parent-buffer-name) (concat " from " (buffer-name camefrom))) (setq default-directory olddir) - (let ((inhibit-read-only t)) + (let ((buffer-undo-list t) + (inhibit-read-only t)) (erase-buffer)))) (defun vc-exec-after (code) @@ -1003,7 +1006,8 @@ that is inserted into the command line before the filename." (vc-exec-after `(unless (active-minibuffer-window) (message "Running %s in the background... done" ',command)))) - (setq status (apply 'process-file command nil t nil squeezed)) + (let ((buffer-undo-list t)) + (setq status (apply 'process-file command nil t nil squeezed))) (when (and (not (eq t okstatus)) (or (not (integerp status)) (and okstatus (< okstatus status)))) diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 7f3cbd913ca..449606607f6 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -430,7 +430,7 @@ and: (if buffer-read-only (if (not quiet) (message "Can't cleanup: %s is read-only" (buffer-name))) - (whitespace-cleanup)) + (whitespace-cleanup-internal)) (let ((whitespace-leading (if whitespace-check-buffer-leading (whitespace-buffer-leading) nil)) @@ -520,6 +520,11 @@ and: "Cleanup the five different kinds of whitespace problems. See `whitespace-buffer' docstring for a summary of the problems." (interactive) + (if (and transient-mark-mode mark-active) + (whitespace-cleanup-region (region-beginning) (region-end)) + (whitespace-cleanup-internal))) + +(defun whitespace-cleanup-internal () ;; If this buffer really contains a file, then run, else quit. (whitespace-check-whitespace-mode current-prefix-arg) (if (and buffer-file-name whitespace-mode) @@ -563,7 +568,7 @@ See `whitespace-buffer' docstring for a summary of the problems." ;; Call this recursively till everything is taken care of (if whitespace-any - (whitespace-cleanup) + (whitespace-cleanup-internal) (progn (if (not whitespace-silent) (message "%s clean" buffer-file-name)) @@ -577,7 +582,7 @@ See `whitespace-buffer' docstring for a summary of the problems." (save-excursion (save-restriction (narrow-to-region s e) - (whitespace-cleanup)) + (whitespace-cleanup-internal)) (whitespace-buffer t))) (defun whitespace-buffer-leading () @@ -760,7 +765,7 @@ If timer is not set, then set it to scan the files in (if whitespace-auto-cleanup (progn ;;(message "cleaning up whitespace in %s" bufname) - (whitespace-cleanup)) + (whitespace-cleanup-internal)) (progn ;;(message "whitespace-buffer %s." (buffer-name)) (whitespace-buffer t)))) @@ -806,7 +811,7 @@ This is meant to be added buffer-locally to `write-file-functions'." (interactive) (let ((werr nil)) (if whitespace-auto-cleanup - (whitespace-cleanup) + (whitespace-cleanup-internal) (setq werr (whitespace-buffer))) (if (and whitespace-abort-on-error werr) (error (concat "Abort write due to whitespaces in " diff --git a/lisp/window.el b/lisp/window.el index 4d02390be16..ef9dd5d896d 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -597,7 +597,7 @@ in some window." (1+ (vertical-motion (buffer-size) window)))))) (defun fit-window-to-buffer (&optional window max-height min-height) - "Make WINDOW the right size to display its contents exactly. + "Make WINDOW the right height to display its contents exactly. If WINDOW is omitted or nil, it defaults to the selected window. If the optional argument MAX-HEIGHT is supplied, it is the maximum height the window is allowed to be, defaulting to the frame height. diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index a5b6d409b87..693a2d7fa4b 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -256,14 +256,20 @@ STRING is the uri-list as a string. The URIs are separated by \r\n." retval)) (defun x-dnd-handle-file-name (window action string) - "Prepend file:// to file names and call `dnd-handle-one-url'. + "Convert file names to URLs and call `dnd-handle-one-url'. WINDOW is the window where the drop happened. STRING is the file names as a string, separated by nulls." (let ((uri-list (split-string string "[\0\r\n]" t)) + (coding (and default-enable-multibyte-characters + (or file-name-coding-system + default-file-name-coding-system))) retval) (dolist (bf uri-list) ;; If one URL is handeled, treat as if the whole drop succeeded. - (let* ((file-uri (concat "file://" bf)) + (if coding (setq bf (encode-coding-string bf coding))) + (let* ((file-uri (concat "file://" + (mapconcat 'url-hexify-string + (split-string bf "/") "/"))) (did-action (dnd-handle-one-url window action file-uri))) (when did-action (setq retval did-action)))) retval)) |