diff options
| author | Karoly Lorentey <lorentey@elte.hu> | 2006-06-27 15:06:36 +0000 |
|---|---|---|
| committer | Karoly Lorentey <lorentey@elte.hu> | 2006-06-27 15:06:36 +0000 |
| commit | 556b89447234f15d1784a23dadbfe429464463a8 (patch) | |
| tree | d5b94bbdde7b399bb0ffdf03a01f3e8398ee0afa /lisp | |
| parent | 476e9367ec1f440aa23904b7bc482ea4a3b8041c (diff) | |
| parent | 08b1eb21d5a3f935eb245acf0844a19acc42f57c (diff) | |
| download | emacs-556b89447234f15d1784a23dadbfe429464463a8.tar.gz | |
Merged from emacs@sv.gnu.org
Patches applied:
* emacs@sv.gnu.org/emacs--devo--0--patch-305
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-306
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-307
Update from CVS: lispref/display.texi (Forcing Redisplay): Fix typo.
* emacs@sv.gnu.org/emacs--devo--0--patch-308
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-309
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-310
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-311
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-312
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-313
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-314
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-315
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-316
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-317
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-318
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-319
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-320
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-321
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-322
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-323
lisp/play/cookie1.el (cookie): Work properly when there's only one entry
* emacs@sv.gnu.org/emacs--devo--0--patch-324
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-325
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-326
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-327
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-328
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-329
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-330
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-105
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-106
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-107
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-108
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-109
Clean up merge mistakes
* emacs@sv.gnu.org/gnus--rel--5.10--patch-110
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-571
Diffstat (limited to 'lisp')
48 files changed, 2355 insertions, 823 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2a3aef6eb37..dea9cbc97a6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,10 +1,285 @@ +2006-06-25 Michael Albinus <michael.albinus@gmx.de> + + * net/rcompile.el (remote-compile): Replace ange-ftp based + implementation by Tramp functions. Based on a patch published by + Marc Abramowitz <msabramo@gmail.com>. + + * net/tramp.el (tramp-unload-tramp): Provide a doc string. + +2006-06-24 Yoshinori Koseki <kose@meadowy.org> + + * international/fontset.el (setup-default-fontset): Fix a typo in + the "Oriya-Akruti" registry name. + +2006-06-23 Lars Hansen <larsh@soem.dk> + + * desktop.el (desktop-full-file-name): New function. + (desktop-kill, desktop-save, desktop-remove, desktop-read) + (desktop-revert): Use it. + (desktop-clear, desktop-save, desktop-remove): Add autoload cookie. + (desktop-after-read-hook): Add option list-buffers. + (desktop-locals-to-save): Add tab-width. + (desktop-save-mode, desktop-no-desktop-file-hook, desktop-save-hook): + Fix docstring. + +2006-06-23 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el (org-cdlatex-mode-map) + (org-cdlatex-texmathp-advice-is-done): New variables. + (org-cdlatex-mode): New minor mode. + (org-inside-LaTeX-fragment-p, org-try-cdlatex-tab): New functions. + (org-cdlatex-underscore-caret, org-cdlatex-math-modify): New commands. + (org-export-with-archived-trees): New option. + (org-open-file): Removed the call to `convert-standard-filename'. + (org-archive-tag, org-agenda-skip-archived-trees) + (org-cycle-open-archived-trees) + (org-sparse-tree-open-archived-trees): New options. + (org-cycle-hide-archived-subtrees, org-hide-archived-subtrees) + (org-toggle-tag, org-prepare-agenda-buffers, org-agenda-skip): New + functions. + (org-agenda-toggle-archive-tag, org-toggle-archive-tag): New commands. + (org-agenda-mode-map): Add binding of `org-agenda-toggle-archive-tag'. + (org-mode-map): Add binding for `org-toggle-archive-tag'. + (org-timeline, org-agenda-list, org-todo-list, org-tags-view): + Call `org-prepare-agenda-buffers'. + (org-occur, org-scan-tags): Call `org-hide-archived-subtrees'. + (org-file-apps, org-file-apps-defaults-gnu) + (org-file-apps-defaults-macosx, org-file-apps-defaults-windowsnt): + Handle remote files by forcing them to be opened in Emacs. + +2006-06-23 Andre Spiegel <spiegel@gnu.org> + + * vc.el (vc-diff-knows-L): New variable. + (vc-diff-internal): Use it to handle "diff" programs that don't + understand -L. This works automatically, no user action is necessary. + +2006-06-23 Daniel Brockman <daniel@brockman.se> + + * net/rcirc.el (rcirc-default-user-full-name): Default to + `rcirc-default-user-name' instead of `rcirc-user-name' (which no + longer exists). + (rcirc-process-list): Check `buffer-live-p' before attempting to + switch to a buffer. + +2006-06-23 Ryan Yeske <rcyeske@gmail.com> + + * net/rcirc.el (rcirc-mode): Fix initialization of coding systems + based on rcirc-coding-system-alist. + +2006-06-23 Martin Rudalics <rudalics@gmx.at> + + * cus-edit.el (customize-apropos): A better error message. + (top level) <debug-ignored-errors>: Extend and update the list of + ignored error messages. + +2006-06-23 Michael Ernst <mernst@alum.mit.edu> + + * complete.el (PC-do-completion): Retain capitalization of user + input, when possible, even if completion-ignore-case is set. + +2006-06-23 Eli Zaretskii <eliz@gnu.org> + + * generic-x.el (bat-generic-mode): Support .cmd files. + + * dos-w32.el (top level): Use find-file-not-found-functions + instead of the obsolete find-file-not-found-hooks. + +2006-06-22 Kim F. Storm <storm@cua.dk> + + * progmodes/grep.el (grep-mode-font-lock-keywords): Correct regexps + to recognize mode name containing submodes, such as Grep/lw. + +2006-06-21 Kim F. Storm <storm@cua.dk> + + * simple.el (line-move-1): Check for move-end-of-line instead of + end-of-line when setting temporary-goal-column. + +2006-06-21 Miles Bader <miles@gnu.org> + + * play/cookie1.el (cookie): Work properly when there's only one entry. + +2006-06-21 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-exited): Ensure overlay arrow gets killed. + (gdb-frame-handler): Generalize frame regexp for templates. + +2006-06-20 Glenn Morris <rgm@gnu.org> + + * calendar/appt.el (appt-display-format): Default value must be + one of the customize options. + +2006-06-20 Dan Nicolaescu <dann@ics.uci.edu> + + * term/xterm.el (terminal-init-xterm): Update key availability info. + Bind C-return. + + * term.el (term-delete-lines, term-insert-lines): Clarify comments. + +2006-06-20 Chong Yidong <cyd@stupidchicken.com> + + * files.el (hack-local-variables): Run `hack-local-variables-hook' + whether or not a local variables list is defined. + + * msb.el (msb): Move `sit-for' hack here to handle both + "mouse-down and drag" and "mouse-up and select" situations. + (mouse-select-buffer): Move `sit-for' hack to `msb'. + +2006-06-20 Kenichi Handa <handa@m17n.org> + + * international/characters.el (word-combining-categories): + Add entries for 2-byte Han characters. + +2006-06-19 Richard Stallman <rms@gnu.org> + + * bindings.el (mode-line-format): Save some mode line space. + + * files.el (find-file-noselect): Improve the question wording. + (basic-save-buffer-2): Mask UMASK against 666. + + * mouse.el (mouse-drag-vertical-line-rightward-window): New function. + (mouse-drag-vertical-line): Call it. + + * cus-edit.el (customize-option, customize-option-other-window): + Error if SYMBOL is nil. + +2006-06-19 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el: Require noutline, also on XEmacs. + (org-end-of-subtree): Return point. + (org-dblock-start-re, org-dblock-end-re): New constants. + (org-create-dblock, org-prepare-dblock, org-map-dblocks) + (org-dblock-update, org-update-dblock, org-beginning-of-dblock) + (org-update-all-dblocks, org-find-dblock): New functions. + (org-collect-clock-time-entries): New function. + (org-html-handle-time-stamps): Never export CLOCK timeranges. + (org-fixup-indentation): Modified to deadl correctly with lines + starting with TAB. Only one argument DIFF now. + (org-demote, org-promote): Call `org-fixup-indentation' with just + one argument, DIFF. + (org-mode): Don't mark buffer as modified when aligning tables. + (org-clock-sum): Don't mark buffer modified when adding time sum + properties. + (org-export-as-html): Added support for a link validation function. + (org-archive-all-done): New function. + (org-archive-subtree): New prefix argument. When set, archive all + done subtrees in this buffer. + (org-remove-clock-overlays) + (org-remove-occur-highlights): Use `org-inhibit-highlight-removal'. + (org-inhibit-highlight-removal): New variable, for dynamic scoping. + (org-put-clock-overlay): Don't swallow last headline character + when displaying overlay. + (org-store-link): Link to `image-mode' with just the file name. + +2006-06-18 Michael Kifer <kifer@cs.stonybrook.edu> + + * viper-cmd.el (viper-special-read-and-insert-char): + Use read-key-sequence. + (viper-after-change-undo-hook): Misc enhancements. + (viper-after-change-undo-hook): New hook. + (viper-undo): Use viper-after-change-undo-hook. + (viper-add-newline-at-eob-if-necessary): Widen before making changes. + (viper-next-line-at-bol): If point is on a widget or a button, simulate + clicking on that widget/button. + + * viper.el (viper-mode): Allow a separate cursor color in Emacs state. + + * ediff-diff (ediff-test-patch-utility): Catch errors. + (ediff-actual-diff-options, ediff-actual-diff3-options): New variables. + (ediff-set-actual-diff-options): New function. + (ediff-reset-diff-options, ediff-toggle-ignore-case): + Use ediff-set-actual-diff-options. + (ediff-extract-diffs): Catch errors. + (ediff-whitespace): Add non-breakable space. + (ediff-same-file-contents): Catch errors. + + * ediff-mult.el (ediff-collect-custom-diffs): + Save coding-system-for-read. + + * ediff-vers.el (ediff-keep-tmp-versions): New variable. + (ediff-vc-internal, ediff-vc-merge-internal): + Use ediff-delete-version-file. + (ediff-delete-version-file): New function. + + * ediff-wind.el (ediff-control-frame-parameters): Set frame fringes. + + * ediff.el (ediff-directories, ediff-directory-revisions) + (ediff-merge-directories, ediff-merge-directories-with-ancestor) + (ediff-directories-internal, ediff-merge-directory-revisions) + (ediff-merge-directory-revisions-with-ancestor) + (ediff-directories3): Use read-directory-name. + +2006-06-18 Ralf Angeli <angeli@caeruleus.net> + + * textmodes/tex-mode.el (tex-font-lock-match-suscript): Remove + superfluous part of regexp for brace matching which is handled by + `scan-lists' call. + +2006-06-16 Richard Stallman <rms@gnu.org> + + * obsolete/options.el (list-options): Put "obsolete" msg in buffer. + + * files.el (basic-save-buffer-2): For a new precious file, + use the default modes in the return value. + + * facemenu.el (facemenu-color-alist): Doc fix. + + * cus-edit.el (custom-guess-name-alist): Recognize `-flag'. + +2006-06-16 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * cus-start.el (all): Add mac-ts-script-language-on-focus. + + * term/mac-win.el (mac-text-encoding-ascii): New constant. + (mac-utxt-to-string): Use it. + (mac-ts-update-active-input-area): Use mac-ae-number. + +2006-06-15 Dan Nicolaescu <dann@ics.uci.edu> + + * term.el (term-handle-scroll, term-delete-lines) + (term-insert-lines): Fix off by one errors. + +2006-06-15 Katsumi Yamaoka <yamaoka@jpl.org> (tiny change) + + * net/tramp.el (tramp-touch): Use UTC to express time. + +2006-06-15 Chong Yidong <cyd@stupidchicken.com> + + * mail/sendmail.el (mail-send): Search explicitly for + mail-header-separator when checking for corrupted header lines. + +2006-06-15 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-same-frame): New option. + (gud-old-arrow, gdb-frame-begin, gdb-printing): New variables. + (gdb-init-1): Initialise them. + (gdb-starting): Reset gdb-printing + (gdb-starting): Save value of gud-overlay-arrow-position. + (gdb-frame-begin): Set gdb-frame-begin, gdb-printing. + (gdb-stopped): Don't look for source if calling procedure e.g "p a ()". + Use gdb-*-gdb-buffer conditionally on gdb-same-frame. + (gdb-frame-gdb-buffer): Keep menu bar, tool bar for GUD buffer. + +2006-06-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * pcvs.el (cvs-retrieve-revision): Use decode-coding-inserted-region. + +2006-06-13 Martin J. Reed <mjreed@essex.ac.uk> (tiny change) + + * net/ldap.el (ldap-ldapsearch-args): Default to SASL search. + (ldap-search-internal): Keep error messages, and a regexp fix. + +2006-06-12 Thien-Thi Nguyen <ttn@gnu.org> + + * files.el (hack-local-variables-confirm): + Display string value using its printed representation. + 2006-06-11 Chong Yidong <cyd@stupidchicken.com> * server.el (server-edit): No-op if no server buffers exist. 2006-06-11 Robert J. Chassell <bob@rattlesnake.com> - * textmodes/page-ext.el (pages-directory-for-addresses): + * textmodes/page-ext.el (pages-directory-for-addresses): Including `pages-directory-address-mode' in the function results in the message "Buffer in which pages were found is deleted". @@ -82,8 +357,7 @@ 2006-06-06 Jesper Harder <harder@phys.au.dk> - * ediff-diff.el (ediff-test-utility): Protect against - file-error. + * ediff-diff.el (ediff-test-utility): Protect against file-error. 2006-06-06 Chong Yidong <cyd@stupidchicken.com> @@ -115,7 +389,7 @@ 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-get-time-of-day): Fix 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> @@ -155,8 +429,8 @@ 2006-06-05 Kenichi Handa <handa@m17n.org> - * international/mule.el (find-auto-coding): Handle - enable-character-translation in file header. + * international/mule.el (find-auto-coding): + Handle enable-character-translation in file header. 2006-06-04 Kim F. Storm <storm@cua.dk> @@ -225,8 +499,8 @@ as well as `coding'. (hack-local-variables): Likewise. - * international/mule.el (enable-character-translation): Put - permanent-local and safe-local-variable properties. + * 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> diff --git a/lisp/bindings.el b/lisp/bindings.el index d965abada6f..639ee2dabb8 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -308,8 +308,7 @@ Keymap to display on minor modes.") 'mode-line-buffer-identification (propertize " " 'help-echo help-echo) 'mode-line-position - '(vc-mode vc-mode) - (propertize " " 'help-echo help-echo) + `(vc-mode ("" vc-mode ,(propertize " " 'help-echo help-echo))) 'mode-line-modes `(which-func-mode ("" which-func-format ,dashes)) `(global-mode-string (,dashes global-mode-string)) diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index 5c862ee6c29..29e6fe56b6e 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el @@ -136,7 +136,9 @@ of the (obsolete) variables `appt-msg-window' and `appt-visible'." :type '(choice (const :tag "Separate window" window) (const :tag "Echo-area" echo) - (const :tag "No visible display" nil)) + (const :tag "No visible display" nil) + (const :tag "Backwards compatibility setting - choose another value" + ignore)) :group 'appt :version "22.1") diff --git a/lisp/complete.el b/lisp/complete.el index d0e3fbe8ddf..df1bc2bfd8b 100644 --- a/lisp/complete.el +++ b/lisp/complete.el @@ -196,7 +196,7 @@ as much as possible and `*' characters are treated likewise in file names. For example, M-x p-c-m expands to M-x partial-completion-mode since no other command begins with that sequence of characters, and \\[find-file] f_b.c TAB might complete to foo_bar.c if that file existed and no -other file in that directory begin with that sequence of characters. +other file in that directory begins with that sequence of characters. Unless `PC-disable-includes' is non-nil, the `<...>' sequence is interpreted specially in \\[find-file]. For example, @@ -358,13 +358,36 @@ See `PC-complete' for details." The function takes no arguments, and typically looks at the value of `minibuffer-completion-table' and the minibuffer contents.") +;; Returns the sequence of non-delimiter characters that follow regexp in string. +(defun PC-chunk-after (string regexp) + (if (not (string-match regexp string)) + (let ((message (format "String %s didn't match regexp %s" string regexp))) + (message message) + (error message))) + (let ((result (substring string (match-end 0)))) + ;; result may contain multiple chunks + (if (string-match PC-delim-regex result) + (setq result (substring result 0 (match-beginning 0)))) + result)) + +(defun test-completion-ignore-case (str table pred) + "Like `test-completion', but ignores case when possible." + ;; Binding completion-ignore-case to nil ensures, for compatibility with + ;; standard completion, that the return value is exactly one of the + ;; possibilities. Do this binding only if pred is nil, out of paranoia; + ;; perhaps it is safe even if pred is non-nil. + (if pred + (test-completion str table pred) + (let ((completion-ignore-case nil)) + (test-completion str table pred)))) + (defun PC-do-completion (&optional mode beg end) (or beg (setq beg (minibuffer-prompt-end))) (or end (setq end (point-max))) (let* ((table minibuffer-completion-table) (pred minibuffer-completion-predicate) (filename (funcall PC-completion-as-file-name-predicate)) - (dirname nil) + (dirname nil) ; non-nil only if a filename is being completed (dirlength 0) (str (buffer-substring beg end)) (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str))) @@ -379,7 +402,7 @@ of `minibuffer-completion-table' and the minibuffer contents.") ;; Check if buffer contents can already be considered complete (if (and (eq mode 'exit) - (test-completion str table pred)) + (test-completion-ignore-case str table pred)) 'complete ;; Do substitutions in directory names @@ -598,35 +621,38 @@ of `minibuffer-completion-table' and the minibuffer contents.") ;; Check if next few letters are the same in all cases (if (and (not (eq mode 'help)) - (setq prefix (try-completion "" (mapcar 'list poss)))) + (setq prefix (try-completion (PC-chunk-after basestr skip) (mapcar 'list poss)))) (let ((first t) i) + ;; Retain capitalization of user input even if + ;; completion-ignore-case is set. (if (eq mode 'word) (setq prefix (PC-chop-word prefix basestr))) (goto-char (+ beg (length dirname))) (while (and (progn - (setq i 0) + (setq i 0) ; index into prefix string (while (< i (length prefix)) (if (and (< (point) end) - (eq (aref prefix i) - (following-char))) + (eq (downcase (aref prefix i)) + (downcase (following-char)))) + ;; same char (modulo case); no action (forward-char 1) (if (and (< (point) end) - (or (and (looking-at " ") + (and (looking-at " ") (memq (aref prefix i) - PC-delims-list)) - (eq (downcase (aref prefix i)) - (downcase - (following-char))))) + PC-delims-list))) + ;; replace " " by the actual delimiter (progn (delete-char 1) - (setq end (1- end))) + (insert (substring prefix i (1+ i)))) + ;; insert a new character + (progn (and filename (looking-at "\\*") (progn (delete-char 1) (setq end (1- end)))) - (setq improved t)) + (setq improved t) (insert (substring prefix i (1+ i))) - (setq end (1+ end))) + (setq end (1+ end))))) (setq i (1+ i))) (or pt (setq pt (point))) (looking-at PC-delim-regex)) @@ -634,7 +660,12 @@ of `minibuffer-completion-table' and the minibuffer contents.") (regexp-quote prefix) PC-ndelims-regex) prefix (try-completion - "" + (PC-chunk-after + ;; not basestr, because that does + ;; not reflect insertions + (buffer-substring + (+ beg (length dirname)) end) + skip) (mapcar (function (lambda (x) @@ -666,7 +697,7 @@ of `minibuffer-completion-table' and the minibuffer contents.") ;; We changed it... enough to be complete? (and (eq mode 'exit) - (test-completion (field-string) table pred)) + (test-completion-ignore-case (field-string) table pred)) ;; If totally ambiguous, display a list of completions (if (or (eq completion-auto-help t) @@ -950,11 +981,10 @@ 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 (match-string 1 string)) + (name (substring string (match-beginning 1) (match-end 1))) (str2 (substring string (match-beginning 0))) (completion-table - (mapcar (lambda (x) - (format (if (string-match "/\\'" x) "<%s" "<%s>") x)) + (mapcar (lambda (x) (format "<%s>" x)) (PC-include-file-all-completions name (PC-include-file-path))))) (setq ad-return-value diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 52f66038ea6..d7ffab4bc5b 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -587,6 +587,7 @@ WIDGET is the widget to apply the filter entries of MENU on." (defcustom custom-guess-name-alist '(("-p\\'" boolean) + ("-flag\\'" boolean) ("-hook\\'" hook) ("-face\\'" face) ("-file\\'" file) @@ -1054,6 +1055,8 @@ then prompt for the MODE to customize." (defun customize-option (symbol) "Customize SYMBOL, which must be a user option variable." (interactive (custom-variable-prompt)) + (unless symbol + (error "No variable specified")) (let ((basevar (indirect-variable symbol))) (custom-buffer-create (list (list basevar 'custom-variable)) (format "*Customize Option: %s*" @@ -1069,6 +1072,8 @@ then prompt for the MODE to customize." "Customize SYMBOL, which must be a user option variable. Show the buffer in another window, but don't select it." (interactive (custom-variable-prompt)) + (unless symbol + (error "No variable specified")) (let ((basevar (indirect-variable symbol))) (custom-buffer-create-other-window (list (list basevar 'custom-variable)) @@ -1361,10 +1366,10 @@ that are not customizable options, as well as faces and groups (get symbol 'variable-documentation)))) (push (list symbol 'custom-variable) found))))) (if (not found) - (error "No matches") - (custom-buffer-create (custom-sort-items found t - custom-buffer-order-groups) - "*Customize Apropos*")))) + (error "No customizable items matching %s" regexp) + (custom-buffer-create + (custom-sort-items found t custom-buffer-order-groups) + "*Customize Apropos*")))) ;;;###autoload (defun customize-apropos-options (regexp &optional arg) @@ -4515,9 +4520,18 @@ if that value is non-nil." (put 'custom-mode 'mode-class 'special) -(add-to-list - 'debug-ignored-errors - "^No user options have changed defaults in recent Emacs versions$") +(dolist (regexp + '("^No user option defaults have been changed since Emacs " + "^Invalid face:? " + "^No \\(?:customized\\|rogue\\|saved\\) user options" + "^No customizable items matching " + "^There are unset changes" + "^Cannot set hidden variable" + "^No \\(?:saved\\|backup\\) value for " + "^No standard setting known for " + "^No standard setting for this face" + "^Saving settings from \"emacs -q\" would overwrite existing customizations")) + (add-to-list 'debug-ignored-errors regexp)) ;;; The End. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 3110252288b..cceed27951e 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -222,6 +222,13 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (mac-pass-command-to-system mac boolean "22.1") (mac-pass-control-to-system mac boolean "22.1") (mac-allow-anti-aliasing mac boolean "22.1") + (mac-ts-script-language-on-focus mac + (choice (const :tag "System default behavior" nil) + (const :tag "Restore to script/language used in the last focus frame" t) + (cons :tag "Specify script/language" + (integer :tag "Script code") + (integer :tag "Language code"))) + "22.1") ;; This is not good news because it will use the wrong ;; version-specific directories when you upgrade. We need diff --git a/lisp/desktop.el b/lisp/desktop.el index 8e9d09d4d32..fe5a278bae8 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -153,8 +153,9 @@ backward compatibility.") (define-minor-mode desktop-save-mode "Toggle desktop saving mode. With numeric ARG, turn desktop saving on if ARG is positive, off -otherwise. See variable `desktop-save' for a description of when the -desktop is saved." +otherwise. If desktop saving is turned on, the state of Emacs is +saved from one session to another. See variable `desktop-save' +and function `desktop-read' for details." :global t :group 'desktop) @@ -175,7 +176,8 @@ Possible values are: The desktop is never saved when `desktop-save-mode' is nil. The variables `desktop-dirname' and `desktop-base-file-name' determine where the desktop is saved." - :type '(choice + :type + '(choice (const :tag "Always save" t) (const :tag "Always ask" ask) (const :tag "Ask if desktop file is new, else do save" ask-if-new) @@ -212,6 +214,7 @@ If nil, just print error messages in the message buffer." (defcustom desktop-no-desktop-file-hook nil "Normal hook run when `desktop-read' can't find a desktop file. +Run in the directory in which the desktop file was sought. May be used to show a dired buffer." :type 'hook :group 'desktop @@ -222,11 +225,14 @@ May be used to show a dired buffer." May be used to show a buffer list." :type 'hook :group 'desktop + :options '(list-buffers) :version "22.1") (defcustom desktop-save-hook nil "Normal hook run before the desktop is saved in a desktop file. -This is useful for truncating history lists, for example." +Run with the desktop buffer current with only the header present. +May be used to add to the desktop code or to truncate history lists, +for example." :type 'hook :group 'desktop) @@ -282,6 +288,7 @@ these won't be deleted." size-indication-mode buffer-file-coding-system indent-tabs-mode + tab-width indicate-buffer-boundaries indicate-empty-lines show-trailing-whitespace) @@ -475,6 +482,11 @@ See also `desktop-minor-mode-table'.") (defvar desktop-dirname nil "The directory in which the desktop file should be saved.") +(defun desktop-full-file-name (&optional dirname) + "Return the full name of the desktop file in DIRNAME. +DIRNAME omitted or nil means use `desktop-dirname'." + (expand-file-name desktop-base-file-name (or dirname desktop-dirname))) + (defconst desktop-header ";; -------------------------------------------------------------------------- ;; Desktop File for Emacs @@ -492,6 +504,7 @@ See also `desktop-minor-mode-table'.") (setcdr here nil)))) ;; ---------------------------------------------------------------------------- +;;;###autoload (defun desktop-clear () "Empty the Desktop. This kills all buffers except for internal ones and those with names matched by @@ -528,29 +541,26 @@ Furthermore, it clears the variables listed in `desktop-globals-to-clear'." "If `desktop-save-mode' is non-nil, do what `desktop-save' says to do. If the desktop should be saved and `desktop-dirname' is nil, ask the user where to save the desktop." - (when - (and - desktop-save-mode - (let ((exists (file-exists-p (expand-file-name desktop-base-file-name desktop-dirname)))) - (or - (eq desktop-save t) - (and exists (memq desktop-save '(ask-if-new if-exists))) - (and - (or - (memq desktop-save '(ask ask-if-new)) - (and exists (eq desktop-save 'ask-if-exists))) - (y-or-n-p "Save desktop? "))))) + (when (and desktop-save-mode + (let ((exists (file-exists-p (desktop-full-file-name)))) + (or (eq desktop-save t) + (and exists (memq desktop-save '(ask-if-new if-exists))) + (and + (or (memq desktop-save '(ask ask-if-new)) + (and exists (eq desktop-save 'ask-if-exists))) + (y-or-n-p "Save desktop? "))))) (unless desktop-dirname (setq desktop-dirname - (file-name-as-directory - (expand-file-name - (call-interactively - (lambda (dir) (interactive "DDirectory for desktop file: ") dir)))))) + (file-name-as-directory + (expand-file-name + (call-interactively + (lambda (dir) + (interactive "DDirectory for desktop file: ") dir)))))) (condition-case err - (desktop-save desktop-dirname) + (desktop-save desktop-dirname) (file-error - (unless (yes-or-no-p "Error while saving the desktop. Ignore? ") - (signal (car err) (cdr err))))))) + (unless (yes-or-no-p "Error while saving the desktop. Ignore? ") + (signal (car err) (cdr err))))))) ;; ---------------------------------------------------------------------------- (defun desktop-list* (&rest args) @@ -715,6 +725,7 @@ DIRNAME must be the directory in which the desktop file will be saved." (t (expand-file-name filename)))) ;; ---------------------------------------------------------------------------- +;;;###autoload (defun desktop-save (dirname) "Save the desktop in a desktop file. Parameter DIRNAME specifies where to save the desktop file. @@ -723,7 +734,7 @@ See also `desktop-base-file-name'." (run-hooks 'desktop-save-hook) (setq dirname (file-name-as-directory (expand-file-name dirname))) (save-excursion - (let ((filename (expand-file-name desktop-base-file-name dirname)) + (let ((filename (desktop-full-file-name dirname)) (info (mapcar #'(lambda (b) @@ -802,12 +813,13 @@ See also `desktop-base-file-name'." (setq desktop-dirname dirname)) ;; ---------------------------------------------------------------------------- +;;;###autoload (defun desktop-remove () "Delete desktop file in `desktop-dirname'. This function also sets `desktop-dirname' to nil." (interactive) (when desktop-dirname - (let ((filename (expand-file-name desktop-base-file-name desktop-dirname))) + (let ((filename (desktop-full-file-name))) (setq desktop-dirname nil) (when (file-exists-p filename) (delete-file filename))))) @@ -830,32 +842,30 @@ It returns t if a desktop file was loaded, nil otherwise." (interactive) (unless noninteractive (setq desktop-dirname - (file-name-as-directory - (expand-file-name - (or - ;; If DIRNAME is specified, use it. - (and (< 0 (length dirname)) dirname) - ;; Otherwise search desktop file in desktop-path. - (let ((dirs desktop-path)) - (while - (and - dirs - (not - (file-exists-p (expand-file-name desktop-base-file-name (car dirs))))) - (setq dirs (cdr dirs))) - (and dirs (car dirs))) - ;; If not found and `desktop-path' is non-nil, use its first element. - (and desktop-path (car desktop-path)) - ;; Default: Home directory. - "~")))) - (if (file-exists-p (expand-file-name desktop-base-file-name desktop-dirname)) + (file-name-as-directory + (expand-file-name + (or + ;; If DIRNAME is specified, use it. + (and (< 0 (length dirname)) dirname) + ;; Otherwise search desktop file in desktop-path. + (let ((dirs desktop-path)) + (while (and dirs + (not (file-exists-p + (desktop-full-file-name (car dirs))))) + (setq dirs (cdr dirs))) + (and dirs (car dirs))) + ;; If not found and `desktop-path' is non-nil, use its first element. + (and desktop-path (car desktop-path)) + ;; Default: Home directory. + "~")))) + (if (file-exists-p (desktop-full-file-name)) ;; Desktop file found, process it. (let ((desktop-first-buffer nil) (desktop-buffer-ok-count 0) (desktop-buffer-fail-count 0)) (setq desktop-lazy-timer nil) ;; Evaluate desktop buffer. - (load (expand-file-name desktop-base-file-name desktop-dirname) t t t) + (load (desktop-full-file-name) t t t) ;; `desktop-create-buffer' puts buffers at end of the buffer list. ;; We want buffers existing prior to evaluating the desktop (and not reused) ;; to be placed at the end of the buffer list, so we move them here. @@ -925,7 +935,7 @@ directory DIRNAME." (interactive) (unless desktop-dirname (error "Unknown desktop directory")) - (unless (file-exists-p (expand-file-name desktop-base-file-name desktop-dirname)) + (unless (file-exists-p (desktop-full-file-name)) (error "No desktop file found")) (desktop-clear) (desktop-read desktop-dirname)) diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el index ae2bd8052bb..2d730c8af0f 100644 --- a/lisp/dos-w32.el +++ b/lisp/dos-w32.el @@ -186,7 +186,7 @@ set to the appropriate coding system, and the value of (setq buffer-file-type (eq buffer-file-coding-system 'no-conversion))))) ;;; To set the default coding system on new files. -(add-hook 'find-file-not-found-hooks +(add-hook 'find-file-not-found-functions 'find-file-not-found-set-buffer-file-coding-system) ;;; To accomodate filesystems that do not require CR/LF translation. diff --git a/lisp/ediff-diff.el b/lisp/ediff-diff.el index 7746954292d..e3675064010 100644 --- a/lisp/ediff-diff.el +++ b/lisp/ediff-diff.el @@ -65,10 +65,11 @@ 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) - (condition-case () + (condition-case nil (eq 0 (apply 'call-process (append (list diff-util nil nil nil option) files))) - (file-error nil))) + (error (format "Cannot execute program %S." diff-util))) + ) (defun ediff-diff-mandatory-option (diff-util) (let ((file (if (boundp 'null-device) null-device "/dev/null"))) @@ -77,13 +78,17 @@ Must produce output compatible with Unix's diff3 program." ((and (string= diff-util ediff-diff-program) (ediff-test-utility ediff-diff-program "--binary" (list file file))) - "--binary") + "--binary ") ((and (string= diff-util ediff-diff3-program) (ediff-test-utility ediff-diff3-program "--binary" (list file file file))) - "--binary") + "--binary ") (t "")))) + +;; must be before ediff-reset-diff-options to avoid compiler errors +(fset 'ediff-set-actual-diff-options '(lambda () nil)) + ;; make sure that mandatory options are added even if the user changes ;; ediff-diff-options or ediff-diff3-options in the customization widget (defun ediff-reset-diff-options (symb val) @@ -91,12 +96,9 @@ Must produce output compatible with Unix's diff3 program." (if (eq symb 'ediff-diff-options) ediff-diff-program ediff-diff3-program)) - (mandatory-option (ediff-diff-mandatory-option diff-program)) - (spacer (if (string-equal mandatory-option "") "" " "))) - (set symb - (if (string-match mandatory-option val) - val - (concat mandatory-option spacer val))) + (mandatory-option (ediff-diff-mandatory-option diff-program))) + (set symb (concat mandatory-option val)) + (ediff-set-actual-diff-options) )) @@ -155,7 +157,7 @@ GNU diff3 doesn't have such an option." :group 'ediff-diff) ;; the actual options used in comparison -(ediff-defvar-local ediff-actual-diff-options "" "") +(ediff-defvar-local ediff-actual-diff-options ediff-diff-options "") (defcustom ediff-custom-diff-program ediff-diff-program "*Program to use for generating custom diff output for saving it in a file. @@ -178,7 +180,7 @@ This output is not used by Ediff internally." :group 'ediff-diff) ;; the actual options used in comparison -(ediff-defvar-local ediff-actual-diff3-options "" "") +(ediff-defvar-local ediff-actual-diff3-options ediff-diff3-options "") (defcustom ediff-diff3-ok-lines-regexp "^\\([1-3]:\\|====\\| \\|.*Warning *:\\|.*No newline\\|.*missing newline\\|^\C-m$\\)" @@ -1272,7 +1274,9 @@ delimiter regions")) ;; Similarly for Windows-* ;; In DOS, must synchronize because DOS doesn't have ;; asynchronous processes. - (apply 'call-process program nil buffer nil args) + (condition-case nil + (apply 'call-process program nil buffer nil args) + (error (format "Cannot execute program %S." program))) ;; On other systems, do it asynchronously. (setq proc (get-buffer-process buffer)) (if proc (kill-process proc)) @@ -1328,7 +1332,8 @@ delimiter regions")) Used for splitting difference regions into individual words.") (make-variable-buffer-local 'ediff-forward-word-function) -(defvar ediff-whitespace " \n\t\f" +;; \240 is unicode symbol for nonbreakable whitespace +(defvar ediff-whitespace " \n\t\f\r\240" "*Characters constituting white space. These characters are ignored when differing regions are split into words.") (make-variable-buffer-local 'ediff-whitespace) @@ -1442,11 +1447,13 @@ arguments to `skip-chars-forward'." "Return t if files F1 and F2 have identical contents." (if (and (not (file-directory-p f1)) (not (file-directory-p f2))) - (let ((res - (apply 'call-process ediff-cmp-program nil nil nil - (append ediff-cmp-options (list f1 f2))))) - (and (numberp res) (eq res 0)))) - ) + (condition-case nil + (let ((res + (apply 'call-process ediff-cmp-program nil nil nil + (append ediff-cmp-options (list f1 f2))))) + (and (numberp res) (eq res 0))) + (error (format "Cannot execute program %S." ediff-cmp-program))) + )) (defun ediff-same-contents (d1 d2 &optional filter-re) @@ -1521,21 +1528,30 @@ affects only files whose names match the expression." (setq file-list-list (cdr file-list-list))) (reverse result))) + +(defun ediff-set-actual-diff-options () + (if ediff-ignore-case + (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)) + (setq ediff-actual-diff-options ediff-diff-options + ediff-actual-diff3-options ediff-diff3-options) + ) + (setq-default ediff-actual-diff-options ediff-actual-diff-options + ediff-actual-diff3-options ediff-actual-diff3-options) + ) + + ;; Ignore case handling - some ideas from drew.adams@@oracle.com (defun ediff-toggle-ignore-case () (interactive) (ediff-barf-if-not-control-buffer) (setq ediff-ignore-case (not ediff-ignore-case)) - (cond (ediff-ignore-case - (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)) - (message "Ignoring regions that differ only in case")) - (t - (setq ediff-actual-diff-options ediff-diff-options - ediff-actual-diff3-options ediff-diff3-options) - (message "Ignoring case differences turned OFF"))) + (ediff-set-actual-diff-options) + (if ediff-ignore-case + (message "Ignoring regions that differ only in case") + (message "Ignoring case differences turned OFF")) (cond (ediff-merge-job (message "Ignoring letter case is too dangerous in merge jobs")) ((and ediff-diff3-job (string= ediff-ignore-case-option3 "")) diff --git a/lisp/ediff-mult.el b/lisp/ediff-mult.el index 0bbd3298c7a..71859a5d4c5 100644 --- a/lisp/ediff-mult.el +++ b/lisp/ediff-mult.el @@ -1656,22 +1656,26 @@ This operation is defined only for `ediff-directories' and multifile patches. For `ediff-directory-revisions', we insist that all marked sessions must be active." (interactive) - (or (ediff-buffer-live-p ediff-meta-diff-buffer) - (setq ediff-meta-diff-buffer - (get-buffer-create - (ediff-unique-buffer-name "*Ediff Multifile Diffs" "*")))) - (ediff-with-current-buffer ediff-meta-diff-buffer - (setq buffer-read-only nil) - (erase-buffer)) - (if (> (ediff-operate-on-marked-sessions 'ediff-append-custom-diff) 0) - ;; did something - (progn - (display-buffer ediff-meta-diff-buffer 'not-this-window) - (ediff-with-current-buffer ediff-meta-diff-buffer - (set-buffer-modified-p nil) - (setq buffer-read-only t))) - (beep) - (message "No marked sessions found"))) + (let ((coding-system-for-read ediff-coding-system-for-read)) + (or (ediff-buffer-live-p ediff-meta-diff-buffer) + (setq ediff-meta-diff-buffer + (get-buffer-create + (ediff-unique-buffer-name "*Ediff Multifile Diffs" "*")))) + (ediff-with-current-buffer ediff-meta-diff-buffer + (setq buffer-read-only nil) + (erase-buffer)) + (if (> (ediff-operate-on-marked-sessions 'ediff-append-custom-diff) 0) + ;; did something + (progn + (display-buffer ediff-meta-diff-buffer 'not-this-window) + (ediff-with-current-buffer ediff-meta-diff-buffer + (set-buffer-modified-p nil) + (setq buffer-read-only t)) + (if (fboundp 'diff-mode) + (with-current-buffer ediff-meta-diff-buffer + (diff-mode)))) + (beep) + (message "No marked sessions found")))) (defun ediff-meta-show-patch () "Show the multi-file patch associated with this group session." diff --git a/lisp/ediff-vers.el b/lisp/ediff-vers.el index 3e8b1c37572..4cd1492a1c7 100644 --- a/lisp/ediff-vers.el +++ b/lisp/ediff-vers.el @@ -52,6 +52,13 @@ ))) ;; end pacifier +(defcustom ediff-keep-tmp-versions nil + "*If t, do not delete temporary previous versions for the files on which +comparison or merge operations are being performed." + :type 'boolean + :group 'ediff-vers + ) + ;; VC.el support (defun ediff-vc-latest-version (file) @@ -87,8 +94,8 @@ file2 (buffer-file-name))) (setq startup-hooks (cons `(lambda () - (delete-file ,file1) - (or ,(string= rev2 "") (delete-file ,file2))) + (ediff-delete-version-file ,file1) + (or ,(string= rev2 "") (ediff-delete-version-file ,file2))) startup-hooks))) (ediff-buffers rev1buf rev2buf @@ -199,12 +206,12 @@ (setq startup-hooks (cons `(lambda () - (delete-file ,(buffer-file-name buf1)) + (ediff-delete-version-file ,(buffer-file-name buf1)) (or ,(string= rev2 "") - (delete-file ,(buffer-file-name buf2))) + (ediff-delete-version-file ,(buffer-file-name buf2))) (or ,(string= ancestor-rev "") ,(not ancestor-rev) - (delete-file ,(buffer-file-name ancestor-buf))) + (ediff-delete-version-file ,(buffer-file-name ancestor-buf))) ) startup-hooks))) (if ancestor-rev @@ -305,8 +312,13 @@ (find-file-noselect (cvs-fileinfo->full-name fileinfo))) nil ; startup-hooks 'ediff-revisions))) - (if (stringp tmp-file) (delete-file tmp-file)) - (if (stringp ancestor-file) (delete-file ancestor-file)))) + (if (stringp tmp-file) (ediff-delete-version-file tmp-file)) + (if (stringp ancestor-file) (ediff-delete-version-file ancestor-file)))) + + +;; delete version file on exit unless ediff-keep-tmp-versions is true +(defun ediff-delete-version-file (file) + (or ediff-keep-tmp-versions (delete-file file))) (provide 'ediff-vers) diff --git a/lisp/ediff-wind.el b/lisp/ediff-wind.el index ae4d603711e..7d9daa6aac9 100644 --- a/lisp/ediff-wind.el +++ b/lisp/ediff-wind.el @@ -159,6 +159,8 @@ In this case, Ediff will use those frames to display these buffers." '(scrollbar-height . 0) ; XEmacs only '(menu-bar-lines . 0) ; Emacs only '(tool-bar-lines . 0) ; Emacs 21+ only + '(left-fringe . 0) + '(right-fringe . 0) ;; don't lower but auto-raise '(auto-lower . nil) '(auto-raise . t) diff --git a/lisp/ediff.el b/lisp/ediff.el index 14f634f0cd2..3e0be86b18b 100644 --- a/lisp/ediff.el +++ b/lisp/ediff.el @@ -500,12 +500,13 @@ expression; only file names that match the regexp are considered." (let ((dir-A (ediff-get-default-directory-name)) (default-regexp (eval ediff-default-filtering-regexp)) f) - (list (setq f (ediff-read-file-name "Directory A to compare:" dir-A nil)) - (ediff-read-file-name "Directory B to compare:" - (if ediff-use-last-dir - ediff-last-dir-B - (ediff-strip-last-dir f)) - nil) + (list (setq f (read-directory-name + "Directory A to compare:" dir-A nil 'must-match)) + (read-directory-name "Directory B to compare:" + (if ediff-use-last-dir + ediff-last-dir-B + (ediff-strip-last-dir f)) + nil 'must-match) (read-string (if (stringp default-regexp) (format "Filter through regular expression (default %s): " @@ -532,8 +533,8 @@ names. Only the files that are under revision control are taken into account." (let ((dir-A (ediff-get-default-directory-name)) (default-regexp (eval ediff-default-filtering-regexp)) ) - (list (ediff-read-file-name - "Directory to compare with revision:" dir-A nil) + (list (read-directory-name + "Directory to compare with revision:" dir-A nil 'must-match) (read-string (if (stringp default-regexp) (format "Filter through regular expression (default %s): " @@ -561,17 +562,17 @@ regular expression; only file names that match the regexp are considered." (let ((dir-A (ediff-get-default-directory-name)) (default-regexp (eval ediff-default-filtering-regexp)) f) - (list (setq f (ediff-read-file-name "Directory A to compare:" dir-A nil)) - (setq f (ediff-read-file-name "Directory B to compare:" - (if ediff-use-last-dir - ediff-last-dir-B - (ediff-strip-last-dir f)) - nil)) - (ediff-read-file-name "Directory C to compare:" - (if ediff-use-last-dir - ediff-last-dir-C - (ediff-strip-last-dir f)) - nil) + (list (setq f (read-directory-name "Directory A to compare:" dir-A nil)) + (setq f (read-directory-name "Directory B to compare:" + (if ediff-use-last-dir + ediff-last-dir-B + (ediff-strip-last-dir f)) + nil 'must-match)) + (read-directory-name "Directory C to compare:" + (if ediff-use-last-dir + ediff-last-dir-C + (ediff-strip-last-dir f)) + nil 'must-match) (read-string (if (stringp default-regexp) (format "Filter through regular expression (default %s): " @@ -597,12 +598,13 @@ expression; only file names that match the regexp are considered." (let ((dir-A (ediff-get-default-directory-name)) (default-regexp (eval ediff-default-filtering-regexp)) f) - (list (setq f (ediff-read-file-name "Directory A to merge:" dir-A nil)) - (ediff-read-file-name "Directory B to merge:" - (if ediff-use-last-dir - ediff-last-dir-B - (ediff-strip-last-dir f)) - nil) + (list (setq f (read-directory-name "Directory A to merge:" + dir-A nil 'must-match)) + (read-directory-name "Directory B to merge:" + (if ediff-use-last-dir + ediff-last-dir-B + (ediff-strip-last-dir f)) + nil 'must-match) (read-string (if (stringp default-regexp) (format "Filter through regular expression (default %s): " @@ -633,17 +635,17 @@ only file names that match the regexp are considered." (let ((dir-A (ediff-get-default-directory-name)) (default-regexp (eval ediff-default-filtering-regexp)) f) - (list (setq f (ediff-read-file-name "Directory A to merge:" dir-A nil)) - (setq f (ediff-read-file-name "Directory B to merge:" + (list (setq f (read-directory-name "Directory A to merge:" dir-A nil)) + (setq f (read-directory-name "Directory B to merge:" (if ediff-use-last-dir ediff-last-dir-B (ediff-strip-last-dir f)) - nil)) - (ediff-read-file-name "Ancestor directory:" + nil 'must-match)) + (read-directory-name "Ancestor directory:" (if ediff-use-last-dir ediff-last-dir-C (ediff-strip-last-dir f)) - nil) + nil 'must-match) (read-string (if (stringp default-regexp) (format "Filter through regular expression (default %s): " @@ -669,8 +671,8 @@ names. Only the files that are under revision control are taken into account." (let ((dir-A (ediff-get-default-directory-name)) (default-regexp (eval ediff-default-filtering-regexp)) ) - (list (ediff-read-file-name - "Directory to merge with revisions:" dir-A nil) + (list (read-directory-name + "Directory to merge with revisions:" dir-A nil 'must-match) (read-string (if (stringp default-regexp) (format "Filter through regular expression (default %s): " @@ -699,8 +701,9 @@ names. Only the files that are under revision control are taken into account." (let ((dir-A (ediff-get-default-directory-name)) (default-regexp (eval ediff-default-filtering-regexp)) ) - (list (ediff-read-file-name - "Directory to merge with revisions and ancestors:" dir-A nil) + (list (read-directory-name + "Directory to merge with revisions and ancestors:" + dir-A nil 'must-match) (read-string (if (stringp default-regexp) (format "Filter through regular expression (default %s): " @@ -733,11 +736,6 @@ names. Only the files that are under revision control are taken into account." (defun ediff-directories-internal (dir1 dir2 dir3 regexp action jobname &optional startup-hooks merge-autostore-dir) - ;; ediff-read-file-name is set to attach a previously entered file name if - ;; the currently entered file is a directory. This code takes care of that. - (setq dir1 (if (file-directory-p dir1) dir1 (file-name-directory dir1)) - dir2 (if (file-directory-p dir2) dir2 (file-name-directory dir2))) - (if (stringp dir3) (setq dir3 (if (file-directory-p dir3) dir3 (file-name-directory dir3)))) @@ -763,7 +761,7 @@ names. Only the files that are under revision control are taken into account." (ediff-merge-metajob jobname) (not merge-autostore-dir)) (setq merge-autostore-dir - (read-file-name "Save merged files in directory: " + (read-directory-name "Save merged files in directory: " (if ediff-use-last-dir ediff-last-merge-autostore-dir (ediff-strip-last-dir dir1)) @@ -823,7 +821,7 @@ names. Only the files that are under revision control are taken into account." (ediff-merge-metajob jobname) (not merge-autostore-dir)) (setq merge-autostore-dir - (read-file-name "Save merged files in directory: " + (read-directory-name "Save merged files in directory: " (if ediff-use-last-dir ediff-last-merge-autostore-dir (ediff-strip-last-dir dir1)) diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 645f4f26eaf..0dce3b94ff0 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -887,12 +887,15 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to (setq ch (aref (read-key-sequence nil) 0))) (insert ch)) (t - (setq ch (read-char-exclusive)) + ;;(setq ch (read-char-exclusive)) + (setq ch (aref (read-key-sequence nil) 0)) ;; replace ^M with the newline (if (eq ch ?\C-m) (setq ch ?\n)) ;; Make sure ^V and ^Q work as quotation chars (if (memq ch '(?\C-v ?\C-q)) - (setq ch (read-char-exclusive))) + ;;(setq ch (read-char-exclusive)) + (setq ch (aref (read-key-sequence nil) 0)) + ) (insert ch)) ) (setq last-command-event @@ -1730,20 +1733,34 @@ invokes the command before that, etc." ;; undoing +;; hook used inside undo +(defvar viper-undo-functions nil) + +;; Runs viper-before-change-functions inside before-change-functions +(defun viper-undo-sentinel (beg end length) + (run-hook-with-args 'viper-undo-functions beg end length)) + +(add-hook 'after-change-functions 'viper-undo-sentinel) + +;; Hook used in viper-undo +(defun viper-after-change-undo-hook (beg end len) + (setq undo-beg-posn beg + undo-end-posn (or end beg)) + ;; some other hooks may be changing various text properties in + ;; the buffer in response to 'undo'; so remove this hook to avoid + ;; its repeated invocation + (remove-hook 'viper-undo-functions 'viper-after-change-undo-hook 'local)) + (defun viper-undo () "Undo previous change." (interactive) (message "undo!") (let ((modified (buffer-modified-p)) (before-undo-pt (point-marker)) - (after-change-functions after-change-functions) undo-beg-posn undo-end-posn) - ;; no need to remove this hook, since this var has scope inside a let. - (add-hook 'after-change-functions - '(lambda (beg end len) - (setq undo-beg-posn beg - undo-end-posn (or end beg)))) + ;; the viper-after-change-undo-hook removes itself after the 1st invocation + (add-hook 'viper-undo-functions 'viper-after-change-undo-hook nil 'local) (undo-start) (undo-more 2) @@ -1765,7 +1782,8 @@ invokes the command before that, etc." (goto-char undo-beg-posn))) (push-mark before-undo-pt t)) (if (and (eolp) (not (bolp))) (backward-char 1)) - (if (not modified) (set-buffer-modified-p t))) + ;;(if (not modified) (set-buffer-modified-p t)) + ) (setq this-command 'viper-undo)) ;; Continue undoing previous changes. @@ -1813,7 +1831,7 @@ invokes the command before that, etc." (setq viper-undo-needs-adjustment t))))) - +;;; Viper's destructive Command ring utilities (defun viper-display-current-destructive-command () (let ((text (nth 4 viper-d-com)) @@ -1927,12 +1945,15 @@ Undo previous insertion and inserts new." (end-of-line) ;; make sure all lines end with newline, unless in the minibuffer or ;; when requested otherwise (require-final-newline is nil) - (if (and (eobp) - (not (bolp)) - require-final-newline - (not (viper-is-in-minibuffer)) - (not buffer-read-only)) - (insert "\n")))) + (save-restriction + (widen) + (if (and (eobp) + (not (bolp)) + require-final-newline + (not (viper-is-in-minibuffer)) + (not buffer-read-only)) + (insert "\n"))) + )) (defun viper-yank-defun () (mark-defun) @@ -3045,19 +3066,34 @@ On reaching beginning of line, stop and signal error." (setq this-command 'next-line) (if com (viper-execute-com 'viper-next-line val com)))) + (defun viper-next-line-at-bol (arg) - "Next line at beginning of line." + "Next line at beginning of line. +If point is on a widget or a button, simulate clicking on that widget/button." (interactive "P") - (viper-leave-region-active) - (save-excursion - (end-of-line) - (if (eobp) (error "Last line in buffer"))) - (let ((val (viper-p-val arg)) - (com (viper-getCom arg))) - (if com (viper-move-marker-locally 'viper-com-point (point))) - (forward-line val) - (back-to-indentation) - (if com (viper-execute-com 'viper-next-line-at-bol val com)))) + (let* ((field (get-char-property (point) 'field)) + (button (get-char-property (point) 'button)) + (doc (get-char-property (point) 'widget-doc)) + (widget (or field button doc))) + (if (and widget + (if (symbolp widget) + (get widget 'widget-type) + (and (consp widget) + (get (widget-type widget) 'widget-type)))) + (widget-button-press (point)) + (if (button-at (point)) + (push-button) + ;; not a widget or a button + (viper-leave-region-active) + (save-excursion + (end-of-line) + (if (eobp) (error "Last line in buffer"))) + (let ((val (viper-p-val arg)) + (com (viper-getCom arg))) + (if com (viper-move-marker-locally 'viper-com-point (point))) + (forward-line val) + (back-to-indentation) + (if com (viper-execute-com 'viper-next-line-at-bol val com))))))) (defun viper-previous-line (arg) diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index c7fe792b5f2..252088a476d 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -139,8 +139,8 @@ (defsubst viper-get-cursor-color () (viper-cond-compile-for-xemacs-or-emacs - ;; xemacs - (color-instance-name (frame-property (selected-frame) 'cursor-color)) + (color-instance-name + (frame-property (selected-frame) 'cursor-color)) ; xemacs (cdr (assoc 'cursor-color (frame-parameters))) ; emacs )) diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index fc55d291550..8f858526da3 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -534,6 +534,10 @@ If Viper is enabled, turn it off. Otherwise, turn it on." (defun viper-mode () "Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Viper'." (interactive) + (if (null viper-vi-state-cursor-color) + (modify-frame-parameters + (selected-frame) + (list (cons 'viper-vi-state-cursor-color (viper-get-cursor-color))))) (if (not noninteractive) (progn ;; if the user requested viper-mode explicitly @@ -545,8 +549,6 @@ If Viper is enabled, turn it off. Otherwise, turn it on." (if viper-first-time ; Important check. Prevents mix-up of startup (progn ; and expert-level msgs when viper-mode recurses (setq viper-first-time nil) - (setq viper-vi-state-cursor-color - (viper-get-cursor-color)) (if (not viper-inhibit-startup-message) (save-window-excursion (setq viper-inhibit-startup-message t) diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 04f70708359..5478cf12b8c 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -308,9 +308,8 @@ May also be t meaning to use `facemenu-add-face-function'." ;;; Internal Variables (defvar facemenu-color-alist nil - ;; Don't initialize here; that doesn't work if preloaded. "Alist of colors, used for completion. -If null, `facemenu-read-color' will set it.") +If this is nil, then the value of (defined-colors) is used.") (defun facemenu-update () "Add or update the \"Face\" menu in the menu bar. diff --git a/lisp/files.el b/lisp/files.el index 7f8b78b2933..8940b687246 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1514,23 +1514,53 @@ the various files." ;; hexl-mode. (not (eq major-mode 'hexl-mode))) (if (buffer-modified-p) - (if (y-or-n-p (if rawfile - "Save file and revisit literally? " - "Save file and revisit non-literally? ")) + (if (y-or-n-p + (format + (if rawfile + "The file %s is already visited normally, +and you have edited the buffer. Now you have asked to visit it literally, +meaning no coding system handling, format conversion, or local variables. +Emacs can only visit a file in one way at a time. + +Do you want to save the file, and visit it literally instead? " + "The file %s is already visited literally, +meaning no coding system handling, format conversion, or local variables. +You have edited the buffer. Now you have asked to visit the file normally, +but Emacs can only visit a file in one way at a time. + +Do you want to save the file, and visit it normally instead? ") + (file-name-nondirectory filename))) (progn (save-buffer) (find-file-noselect-1 buf filename nowarn rawfile truename number)) - (if (y-or-n-p (if rawfile - "Discard your edits and revisit file literally? " - "Discard your edits and revisit file non-literally? ")) + (if (y-or-n-p + (format + (if rawfile + "\ +Do you want to discard your changes, and visit the file literally now? " + "\ +Do you want to discard your changes, and visit the file normally now? "))) (find-file-noselect-1 buf filename nowarn rawfile truename number) (error (if rawfile "File already visited non-literally" "File already visited literally")))) - (if (y-or-n-p (if rawfile - "Revisit file literally? " - "Revisit file non-literally? ")) + (if (y-or-n-p + (format + (if rawfile + "The file %s is already visited normally. +You have asked to visit it literally, +meaning no coding system decoding, format conversion, or local variables. +But Emacs can only visit a file in one way at a time. + +Do you want to revisit the file literally now? " + "The file %s is already visited literally, +meaning no coding system decoding, format conversion, or local variables. +You have asked to visit it normally, +but Emacs can only visit a file in one way at a time. + +Do you want to revisit the file normally now? ") + (file-name-nondirectory filename))) (find-file-noselect-1 buf filename nowarn rawfile truename number) (error (if rawfile "File already visited non-literally" @@ -1577,7 +1607,7 @@ the various files." (kill-buffer buf) (signal 'file-error (list "File is not readable" filename))) - ;; Run find-file-not-found-hooks until one returns non-nil. + ;; Run find-file-not-found-functions until one returns non-nil. (or (run-hook-with-args-until-success 'find-file-not-found-functions) ;; If they fail too, set error. (setq error t))))) @@ -2407,7 +2437,11 @@ n -- to ignore the local variables list.") (insert " "))) (princ (car elt) buf) (insert " : ") - (princ (cdr elt) buf) + (if (stringp (cdr elt)) + ;; Make strings with embedded whitespace easier to read. + (let ((print-escape-newlines t)) + (prin1 (cdr elt) buf)) + (princ (cdr elt) buf)) (insert "\n")) (setq prompt (format "Please type %s%s: " @@ -2632,8 +2666,8 @@ is specified, returning t if it is specified." (hack-local-variables-confirm result unsafe-vars risky-vars)) (dolist (elt result) - (hack-one-local-variable (car elt) (cdr elt)))))) - (run-hooks 'hack-local-variables-hook)))))) + (hack-one-local-variable (car elt) (cdr elt))))))) + (run-hooks 'hack-local-variables-hook))))) (defun safe-local-variable-p (sym val) "Non-nil if SYM is safe as a file-local variable with value VAL. @@ -3627,8 +3661,10 @@ Before and after saving the buffer, this function runs (set-visited-file-modtime old-modtime))) ;; Since we have created an entirely new file, ;; make sure it gets the right permission bits set. - (setq setmodes (or setmodes (cons (file-modes buffer-file-name) - buffer-file-name))) + (setq setmodes (or setmodes + (cons (or (file-modes buffer-file-name) + (logand ?\666 umask)) + buffer-file-name))) ;; We succeeded in writing the temp file, ;; so rename it. (rename-file tempname buffer-file-name t)) diff --git a/lisp/generic-x.el b/lisp/generic-x.el index 55c4e482803..609d076d8a2 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -512,10 +512,11 @@ like an INI file. You can add this hook to `find-file-hook'." (1 font-lock-builtin-face) (2 font-lock-variable-name-face t t)))) '("\\.[bB][aA][tT]\\'" + "\\.[cC][mM][dD]\\'" "\\`[cC][oO][nN][fF][iI][gG]\\." "\\`[aA][uU][tT][oO][eE][xX][eE][cC]\\.") '(generic-bat-mode-setup-function) - "Generic mode for MS-Windows BAT files.") + "Generic mode for MS-Windows batch files.") (defvar bat-generic-mode-syntax-table nil "Syntax table in use in `bat-generic-mode' buffers.") diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 71aa3654da6..1eec8b26fdf 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,22 @@ +2006-06-20 Katsumi Yamaoka <yamaoka@jpl.org> + + * rfc2231.el (rfc2231-parse-string): Allow `*'s in parameter values. + +2006-06-19 Katsumi Yamaoka <yamaoka@jpl.org> + + * message.el (message-syntax-checks): Doc fix. + +2006-06-16 Katsumi Yamaoka <yamaoka@jpl.org> + + * message.el (message-syntax-checks): Doc fix. + (message-send-mail): Add check for continuation headers. + (message-check-news-header-syntax): Fix regexp used to check for + continuation headers. + +2006-06-14 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-display-mime): Make sure body ends with newline. + 2006-06-06 Katsumi Yamaoka <yamaoka@jpl.org> * mm-util.el (mm-mime-mule-charset-alist): Use unicode-precedence-list diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 4722e98ef19..39292e33a1f 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4927,7 +4927,11 @@ N is the numerical prefix." (article-goto-body) (narrow-to-region (point-min) (point)) (gnus-article-save-original-date - (gnus-treat-article 'head))))))))) + (gnus-treat-article 'head))))))) + ;; Cope with broken MIME messages. + (goto-char (point-max)) + (unless (bolp) + (insert "\n")))) (defcustom gnus-mime-display-multipart-as-mixed nil "Display \"multipart\" parts as \"multipart/mixed\". diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 8bc0f704b5c..4ee87933967 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -190,14 +190,13 @@ To disable checking of long signatures, for instance, add Don't touch this variable unless you really know what you're doing. -Checks include `subject-cmsg', `multiple-headers', `sendsys', -`message-id', `from', `long-lines', `control-chars', `size', -`new-text', `quoting-style', `redirected-followup', `signature', -`approved', `sender', `empty', `empty-headers', `message-id', `from', -`subject', `shorten-followup-to', `existing-newsgroups', -`buffer-file-name', `unchanged', `newsgroups', `reply-to', -`continuation-headers', `long-header-lines', `invisible-text' and -`illegible-text'." +Checks include `approved', `continuation-headers', `control-chars', +`empty', `existing-newsgroups', `from', `illegible-text', +`invisible-text', `long-header-lines', `long-lines', `message-id', +`multiple-headers', `new-text', `newsgroups', `quoting-style', +`repeated-newsgroups', `reply-to', `sender', `sendsys', `shoot', +`shorten-followup-to', `signature', `size', `subject', `subject-cmsg' +and `valid-newsgroups'." :group 'message-news :type '(repeat sexp)) ; Fixme: improve this @@ -3769,6 +3768,16 @@ It should typically alter the sending method in some way or other." (let ((message-deletable-headers (if news nil message-deletable-headers))) (message-generate-headers headers)) + ;; Check continuation headers. + (message-check 'continuation-headers + (goto-char (point-min)) + (while (re-search-forward "^[^ \t\n][^ \t\n:]*[ \t\n]" nil t) + (goto-char (match-beginning 0)) + (if (y-or-n-p "Fix continuation lines? ") + (insert " ") + (forward-line 1) + (unless (y-or-n-p "Send anyway? ") + (error "Failed to send the message"))))) ;; Let the user do all of the above. (run-hooks 'message-header-hook)) (unwind-protect @@ -4326,11 +4335,11 @@ Otherwise, generate and save a value for `canlock-password' first." (message-check 'continuation-headers (goto-char (point-min)) (let ((do-posting t)) - (while (re-search-forward "^[^ \t\n][^:\n]*$" nil t) + (while (re-search-forward "^[^ \t\n][^ \t\n:]*[ \t\n]" nil t) + (goto-char (match-beginning 0)) (if (y-or-n-p "Fix continuation lines? ") - (progn - (goto-char (match-beginning 0)) - (insert " ")) + (insert " ") + (forward-line 1) (unless (y-or-n-p "Send anyway? ") (setq do-posting nil)))) do-posting)) diff --git a/lisp/gnus/rfc2231.el b/lisp/gnus/rfc2231.el index a5827ecb70c..284c95fc151 100644 --- a/lisp/gnus/rfc2231.el +++ b/lisp/gnus/rfc2231.el @@ -176,14 +176,14 @@ must never cause a Lisp error." (buffer-substring (point) (progn - (forward-sexp) - ;; We might not have reached at the end of - ;; the value because of non-ascii chars, - ;; so we should jump over them if any. - (while (and (not (eobp)) - (> (char-after) ?\177)) + ;; Jump over asterisk, non-ASCII + ;; and non-boundary characters. + (while (and c + (or (eq c ?*) + (> c ?\177) + (not (eq (char-syntax c) ? )))) (forward-char 1) - (forward-sexp)) + (setq c (char-after))) (point))))) (t (error "Invalid header: %s" string))) diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 638d09eea6e..0b7c223c258 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -1258,7 +1258,10 @@ ;;; Setting word boundary. (setq word-combining-categories - '((?l . ?l))) + '((?l . ?l) + (?C . ?C) + (?C . ?H) + (?C . ?K))) (setq word-separating-categories ; (2-byte character sets) '((?A . ?K) ; Alpha numeric - Katakana diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index e42ab3e5ee9..80d305e2c08 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -130,7 +130,7 @@ (,(indian-font-char-range 'akruti:guj) . (nil . "Gujarati-Akruti")) (,(indian-font-char-range 'akruti:ori) - . (nil . "Oriay-Akruti")) + . (nil . "Oriya-Akruti")) (,(indian-font-char-range 'akruti:tml) . (nil . "Tamil-Akruti")) (,(indian-font-char-range 'akruti:tlg) diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index ee512b3af31..28463208c45 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -863,11 +863,14 @@ the user from the mailer." (error "Message contains non-ASCII characters")))) ;; Complain about any invalid line. (goto-char (point-min)) - (while (< (point) (mail-header-end)) - (unless (looking-at "[ \t]\\|.*:\\|$") - (push-mark opoint) - (error "Invalid header line (maybe a continuation line lacks initial whitespace)")) - (forward-line 1)) + (re-search-forward (regexp-quote mail-header-separator) (point-max) t) + (let ((header-end (or (match-beginning 0) (point-max)))) + (goto-char (point-min)) + (while (< (point) header-end) + (unless (looking-at "[ \t]\\|.*:\\|$") + (push-mark opoint) + (error "Invalid header line (maybe a continuation line lacks initial whitespace)")) + (forward-line 1))) (goto-char opoint) (run-hooks 'mail-send-hook) (message "Sending...") diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index 94632f8c38d..a390589dd0f 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,3 +1,28 @@ +2006-06-20 Bill Wohler <wohler@newt.com> + + Release MH-E version 8.0.1. + + * mh-e.el (Version, mh-version): Update for release 8.0.1. + +2006-06-15 Bill Wohler <wohler@newt.com> + + * mh-search.el (mh-index-new-folder): Use -2 suffix instead of <2> + suffix for folder names, as <> are illegal filenakme characters on + Windows (closes SF #1507002). + +2006-06-05 Jacob Morzinski <morzinski@MIT.EDU> (tiny change) + + * mh-comp.el (mh-send-uses-spost): New variable. + (mh-send-letter): Do not use -msgid and -mime if + mh-send-uses-spost is t (closes SF #1486726). + +2006-06-02 Bill Wohler <wohler@newt.com> + + (mh-folder-exists-p): Change test from an empty buffer, to one + that contains the actual folder, since GNU mailutils' folder + command displays output if the folder doesn't exist (closes SF + #1499712). + 2006-05-06 Bill Wohler <wohler@newt.com> Release MH-E version 8.0. diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index ad80e3be838..7156b0cf318 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -53,6 +53,15 @@ "Name of the MH send program. Some sites need to change this because of a name conflict.") +(defvar mh-send-uses-spost-flag nil + "Non-nil means \"send\" uses \"spost\" to submit messages. + +If the value of \"postproc:\" is \"spost\", you may need to set +this variable to t to tell MH-E to avoid using features of +\"post\" that are not supported by \"spost\". You'll know that +you'll need to do this if sending mail fails with an error of +\"spost: -msgid unknown\".") + (defvar mh-redist-background nil "If non-nil redist will be done in background like send. This allows transaction log to be visible if -watch, -verbose or @@ -267,16 +276,18 @@ use `mh-send-prog' to tell MH-E the name." (and (boundp 'default-buffer-file-coding-system ) default-buffer-file-coding-system) 'iso-latin-1)))) - ;; Adding a Message-ID field looks good, makes it easier to search for - ;; message in your +outbox, and best of all doesn't break threading for - ;; the recipient if you reply to a message in your +outbox. - (setq mh-send-args (concat "-msgid " mh-send-args)) - ;; The default BCC encapsulation will make a MIME message unreadable. - ;; With nmh use the -mime arg to prevent this. - (if (and (mh-variant-p 'nmh) - (mh-goto-header-field "Bcc:") - (mh-goto-header-field "Content-Type:")) - (setq mh-send-args (concat "-mime " mh-send-args))) + ;; Older versions of spost do not support -msgid and -mime. + (unless mh-send-uses-spost-flag + ;; Adding a Message-ID field looks good, makes it easier to search for + ;; message in your +outbox, and best of all doesn't break threading for + ;; the recipient if you reply to a message in your +outbox. + (setq mh-send-args (concat "-msgid " mh-send-args)) + ;; The default BCC encapsulation will make a MIME message unreadable. + ;; With nmh use the -mime arg to prevent this. + (if (and (mh-variant-p 'nmh) + (mh-goto-header-field "Bcc:") + (mh-goto-header-field "Content-Type:")) + (setq mh-send-args (concat "-mime " mh-send-args)))) (cond (arg (pop-to-buffer mh-mail-delivery-buffer) (erase-buffer) diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 28fff81e93b..80f0fedeb6e 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -6,7 +6,7 @@ ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> -;; Version: 8.0 +;; Version: 8.0.1 ;; Keywords: mail ;; This file is part of GNU Emacs. @@ -133,7 +133,7 @@ ;; Try to keep variables local to a single file. Provide accessors if ;; variables are shared. Use this section as a last resort. -(defconst mh-version "8.0" "Version number of MH-E.") +(defconst mh-version "8.0.1" "Version number of MH-E.") ;; Variants diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index b6f8dd71d9a..62c130bb90f 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -1537,7 +1537,7 @@ If folder NAME already exists and was generated for the same SEARCH-REGEXP then it is reused. Otherwise if the folder NAME was generated from a different -search then check if NAME<2> can be used. Otherwise try NAME<3>. +search then check if NAME-2 can be used. Otherwise try NAME-3. This is repeated till we find a new folder name. If the folder returned doesn't exist then it is created." @@ -1545,7 +1545,7 @@ If the folder returned doesn't exist then it is created." (error "The argument should be a valid MH folder name")) (let ((chosen-name (loop for i from 1 - for candidate = (if (equal i 1) name (format "%s<%s>" name i)) + for candidate = (if (equal i 1) name (format "%s-%s" name i)) when (or (not (mh-folder-exists-p candidate)) (equal (mh-index-folder-search-regexp candidate) search-regexp)) diff --git a/lisp/mouse.el b/lisp/mouse.el index c399515a3d2..145eb76446f 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -529,6 +529,24 @@ resized by dragging their header-line." (mouse-drag-mode-line-1 start-event nil)))) +(defun mouse-drag-vertical-line-rightward-window (window) + "Return a window that is immediately to the right of WINDOW, or nil." + (let ((bottom (nth 3 (window-inside-edges window))) + (left (nth 0 (window-inside-edges window))) + best best-right + (try (previous-window window))) + (while (not (eq try window)) + (let ((try-top (nth 1 (window-inside-edges try))) + (try-bottom (nth 3 (window-inside-edges try))) + (try-right (nth 2 (window-inside-edges try)))) + (if (and (< try-top bottom) + (>= try-bottom bottom) + (< try-right left) + (or (null best-right) (> try-right best-right))) + (setq best-right try-right best try))) + (setq try (previous-window try))) + best)) + (defun mouse-drag-vertical-line (start-event) "Change the width of a window by dragging on the vertical line." (interactive "e") @@ -594,7 +612,8 @@ resized by dragging their header-line." ;; adjust the window on the left. (if (eq which-side 'right) (selected-window) - (previous-window)))) + (mouse-drag-vertical-line-rightward-window + (selected-window))))) (setq x (- (car (cdr mouse)) (if (eq which-side 'right) 0 2)) edges (window-edges window) diff --git a/lisp/msb.el b/lisp/msb.el index d5f32486971..aa42e183007 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -473,18 +473,21 @@ selects that window. See the function `mouse-select-buffer' and the variable `msb-menu-cond' for more information about how the menus are split." (interactive "e") - ;; If EVENT is a down-event, read and discard the - ;; corresponding up-event. - (and (eventp event) - (memq 'down (event-modifiers event)) - (read-event)) (let ((old-window (selected-window)) - (window (posn-window (event-start event)))) + (window (posn-window (event-start event))) + early-release) (unless (framep window) (select-window window)) + ;; This `sit-for' magically makes the menu stay up if the mouse + ;; button is released within 0.1 second. + (setq early-release (not (sit-for 0.1 t))) (let ((buffer (mouse-select-buffer event))) (if buffer (switch-to-buffer buffer) - (select-window old-window)))) + (select-window old-window))) + ;; If the above `sit-for' was interrupted by a mouse-up, avoid + ;; generating a drag event. + (if (and early-release (memq 'down (event-modifiers last-input-event))) + (discard-input))) nil) ;;; @@ -995,9 +998,6 @@ variable `msb-menu-cond'." ;; adjust position (setq posX (- posX (funcall msb-horizontal-shift-function)) position (list (list posX posY) posWind)))) - ;; This `sit-for' magically makes the menu stay up if the mouse - ;; button is released within 0.1 second. - (sit-for 0 100) ;; Popup the menu (setq choice (x-popup-menu position msb--last-buffer-menu)) (cond diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 180e14fcc20..2a63615a602 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -154,7 +154,7 @@ Valid properties include: :type '(string :tag "`ldapsearch' Program") :group 'ldap) -(defcustom ldap-ldapsearch-args '("-LL" "-tt" "-x") +(defcustom ldap-ldapsearch-args '("-LL" "-tt") "*A list of additional arguments to pass to `ldapsearch'." :type '(repeat :tag "`ldapsearch' Arguments" (string :tag "Argument")) @@ -555,7 +555,7 @@ an alist of attribute/value pairs." (setq arglist (nconc arglist (list (format "-z%s" sizelimit))))) (eval `(call-process ldap-ldapsearch-prog nil - `(,buf nil) + buf nil ,@arglist ,@ldap-ldapsearch-args @@ -580,7 +580,7 @@ an alist of attribute/value pairs." (end-of-line) (point)))) (forward-line 1) - (while (looking-at "^\\(\\w*\\)\\(;\\w*\\)?[=:\t ]+\\(<[\t ]*file://\\)?\\(.*\\)$") + (while (looking-at "^\\(\\w*\\)\\(;\\w*\\)?[=:\t ]+\\(<[\t ]*file://\\)\\(.*\\)$") (setq name (match-string 1) value (match-string 4)) ;; Need to handle file:///D:/... as generated by OpenLDAP diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index a0b328413b0..1f051ffa9f2 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -74,7 +74,7 @@ :group 'rcirc) (defcustom rcirc-default-user-full-name (if (string= (user-full-name) "") - rcirc-user-name + rcirc-default-user-name (user-full-name)) "The full name sent to the server when connecting." :type 'string @@ -469,7 +469,7 @@ Functions are called with PROCESS and SENTINEL arguments.") "Return a list of rcirc processes." (let (ps) (mapc (lambda (p) - (when (process-buffer p) + (when (buffer-live-p (process-buffer p)) (with-rcirc-process-buffer p (when (eq major-mode 'rcirc-mode) (setq ps (cons p ps)))))) @@ -719,8 +719,8 @@ If NOTICEP is non-nil, send a notice instead of privmsg." (serv (if (consp (car i)) (cdar i) ""))) (when (and (string-match chan (or target "")) (string-match serv (rcirc-server-name process))) - (setq rcirc-decode-coding-system (if (consp (cdr i)) (cadr i) i) - rcirc-encode-coding-system (if (consp (cdr i)) (cddr i) i))))) + (setq rcirc-decode-coding-system (if (consp (cdr i)) (cadr i) (cdr i)) + rcirc-encode-coding-system (if (consp (cdr i)) (cddr i) (cdr i)))))) ;; setup the prompt and markers (make-local-variable 'rcirc-prompt-start-marker) diff --git a/lisp/net/rcompile.el b/lisp/net/rcompile.el index 469f268fb9c..158069986d2 100644 --- a/lisp/net/rcompile.el +++ b/lisp/net/rcompile.el @@ -115,17 +115,25 @@ nil means run no commands." ;;;; entry point +;; We use the Tramp internal functions `with-parsed-tramp-file-name' +;; and `tramp-make-tramp-file-name'. Better would be, if there are +;; functions to provide user, host and localname of a remote filename, +;; independent of Tramp's implementation. The function calls are +;; wrapped by `funcall' in order to pacify the byte compiler. +;; ange-ftp check removed, because it is handled also by Tramp. ;;;###autoload (defun remote-compile (host user command) "Compile the current buffer's directory on HOST. Log in as USER. See \\[compile]." (interactive - (let ((parsed (or (and (featurep 'ange-ftp) - (ange-ftp-ftp-name default-directory)))) - host user command prompt) + (let ((parsed (and (featurep 'tramp) + (file-remote-p default-directory))) + host user command prompt l l-host l-user) (if parsed - (setq host (nth 0 parsed) - user (nth 1 parsed)) + (funcall (symbol-function 'with-parsed-tramp-file-name) + default-directory l + (setq host l-host + user l-user)) (setq prompt (if (stringp remote-compile-host) (format "Compile on host (default %s): " remote-compile-host) @@ -155,8 +163,9 @@ See \\[compile]." (setq remote-compile-user user)) ((null remote-compile-user) (setq remote-compile-user (user-login-name)))) - (let* ((parsed (and (featurep 'ange-ftp) - (ange-ftp-ftp-name default-directory))) + (let* (localname ;; Pacify byte-compiler. + (parsed (and (featurep 'tramp) + (file-remote-p default-directory))) (compile-command (format "%s %s -l %s \"(%scd %s; %s)\"" remote-shell-program @@ -165,16 +174,25 @@ See \\[compile]." (if remote-compile-run-before (concat remote-compile-run-before "; ") "") - (if parsed (nth 2 parsed) default-directory) + (if parsed + (funcall (symbol-function 'with-parsed-tramp-file-name) + default-directory nil localname) + "") compile-command))) (setq remote-compile-host host) (save-some-buffers nil nil) (compilation-start compile-command) ;; Set comint-file-name-prefix in the compilation buffer so - ;; compilation-parse-errors will find referenced files by ange-ftp. + ;; compilation-parse-errors will find referenced files by Tramp. (with-current-buffer compilation-last-buffer - (set (make-local-variable 'comint-file-name-prefix) - (concat "/" host ":"))))) + (when (featurep 'tramp) + (set (make-local-variable 'comint-file-name-prefix) + (funcall (symbol-function 'tramp-make-tramp-file-name) + nil ;; multi-method. To be removed with Tramp 2.1. + nil + remote-compile-user + remote-compile-host + "")))))) ;;; arch-tag: 2866a132-ece4-4ce9-9f91-ec147f803f73 ;;; rcompile.el ends here diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 2ebc4d0b45e..c94ec48b76d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -5017,15 +5017,16 @@ hosts, or files, disagree." (defun tramp-touch (file time) "Set the last-modified timestamp of the given file. TIME is an Emacs internal time value as returned by `current-time'." - (let ((touch-time (format-time-string "%Y%m%d%H%M.%S" time))) + (let ((touch-time (format-time-string "%Y%m%d%H%M.%S" time t))) (if (tramp-tramp-file-p file) (with-parsed-tramp-file-name file nil (let ((buf (tramp-get-buffer multi-method method user host))) (unless (zerop (tramp-send-command-and-check multi-method method user host - (format "touch -t %s %s" + (format "TZ=UTC; export TZ; touch -t %s %s" touch-time - localname))) + localname) + t)) (pop-to-buffer buf) (error "tramp-touch: touch failed, see buffer `%s' for details" buf)))) @@ -7590,6 +7591,7 @@ Therefore, the contents of files might be included in the debug buffer(s).") ;; - Cleanup autoloads ;;;###autoload (defun tramp-unload-tramp () + "Discard Tramp from loading remote files." (interactive) ;; When Tramp is not loaded yet, its autoloads are still active. (tramp-unload-file-name-handlers) diff --git a/lisp/obsolete/options.el b/lisp/obsolete/options.el index 1383666a9b1..968a0bac5f6 100644 --- a/lisp/obsolete/options.el +++ b/lisp/obsolete/options.el @@ -41,6 +41,8 @@ It is now better to use Customize instead." (interactive) (with-output-to-temp-buffer "*List Options*" (let (vars) + (princ "This facility is obsolete; we recommend using M-x customize instead.") + (mapatoms (function (lambda (sym) (if (user-variable-p sym) (setq vars (cons sym vars)))))) diff --git a/lisp/pcvs.el b/lisp/pcvs.el index 5e322b9276a..89aeef53b80 100644 --- a/lisp/pcvs.el +++ b/lisp/pcvs.el @@ -1723,16 +1723,22 @@ Signal an error if there is no backup file." (message "Retrieving revision %s..." rev) ;; Discard stderr output to work around the CVS+SSH+libc ;; problem when stdout and stderr are the same. - (let ((res (apply 'call-process cvs-program nil '(t nil) nil - "-q" "update" "-p" - ;; If `rev' is HEAD, don't pass it at all: - ;; the default behavior is to get the head - ;; of the current branch whereas "-r HEAD" - ;; stupidly gives you the head of the trunk. - (append (unless (equal rev "HEAD") (list "-r" rev)) - (list file))))) + (let ((res + (let ((coding-system-for-read 'binary)) + (apply 'call-process cvs-program nil '(t nil) nil + "-q" "update" "-p" + ;; If `rev' is HEAD, don't pass it at all: + ;; the default behavior is to get the head + ;; of the current branch whereas "-r HEAD" + ;; stupidly gives you the head of the trunk. + (append (unless (equal rev "HEAD") (list "-r" rev)) + (list file)))))) (when (and res (not (and (equal 0 res)))) (error "Something went wrong retrieving revision %s: %s" rev res)) + ;; Figure out the encoding used and decode the byte-sequence + ;; into a sequence of chars. + (decode-coding-inserted-region + (point-min) (point-max) file t nil nil t) (set-buffer-modified-p nil) (let ((buffer-file-name (expand-file-name file))) (after-find-file)) diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el index bc4ee84da2f..7a2e6c602ea 100644 --- a/lisp/play/cookie1.el +++ b/lisp/play/cookie1.el @@ -1,6 +1,6 @@ ;;; cookie1.el --- retrieve random phrases from fortune cookie files -;; Copyright (C) 1993, 2002, 2003, 2004, 2005, +;; Copyright (C) 1993, 2002, 2003, 2004, 2005, 2006, ;; 2006 Free Software Foundation, Inc. ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> @@ -75,7 +75,7 @@ When the phrase file is read in, display STARTMSG at the beginning of load, ENDMSG at the end." (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg))) (shuffle-vector cookie-vector) - (aref cookie-vector 1))) + (aref cookie-vector 0))) ;;;###autoload (defun cookie-insert (phrase-file &optional count startmsg endmsg) diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index bb821907aa8..684102015cc 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -76,6 +76,9 @@ ;; 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). +;; 5) If you wish to call procedures from your program in GDB +;; e.g "call myproc ()", "p mysquare (5)" then use level 2 annotations +;; "gdb --annotate=2 myprog" to keep source buffer/selected frame fixed. ;;; Problems with watch expressions, GDB/MI: ;; 1) They go out of scope when the inferior is re-run. @@ -110,6 +113,7 @@ Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS FP) where STATUS is nil (unchanged), `changed' or `out-of-scope', FP the frame address for root variables.") (defvar gdb-main-file nil "Source file from which program execution begins.") +(defvar gud-old-arrow nil) (defvar gdb-overlay-arrow-position nil) (defvar gdb-server-prefix nil) (defvar gdb-flush-pending-output nil) @@ -126,6 +130,9 @@ and #define directives otherwise.") (defvar gdb-inferior-status nil) (defvar gdb-continuation nil) (defvar gdb-look-up-stack nil) +(defvar gdb-frame-begin nil + "Non-nil when GDB generates frame-begin annotation.") +(defvar gdb-printing t) (defvar gdb-buffer-type nil "One of the symbols bound in `gdb-buffer-rules'.") @@ -543,7 +550,10 @@ With arg, use separate IO iff arg is positive." gdb-source-window nil gdb-inferior-status nil gdb-continuation nil - gdb-look-up-stack nil) + gdb-look-up-stack nil + gdb-frame-begin nil + gdb-printing t + gud-old-arrow nil) (setq gdb-buffer-type 'gdba) @@ -1270,6 +1280,7 @@ This sends the next command (if any) to gdb." This says that I/O for the subprocess is now the program being debugged, not GDB." (setq gdb-active-process t) + (setq gdb-printing t) (let ((sink gdb-output-sink)) (cond ((eq sink 'user) @@ -1278,6 +1289,7 @@ not GDB." (setq gdb-inferior-status "running") (gdb-force-mode-line-update gdb-inferior-status) (gdb-remove-text-properties) + (setq gud-old-arrow gud-overlay-arrow-position) (setq gud-overlay-arrow-position nil) (setq gdb-overlay-arrow-position nil) (if gdb-use-separate-io-buffer @@ -1313,6 +1325,7 @@ directives." (setq gdb-active-process nil) (setq gud-overlay-arrow-position nil) (setq gdb-overlay-arrow-position nil) + (setq gud-old-arrow nil) (setq gdb-inferior-status "exited") (gdb-force-mode-line-update gdb-inferior-status) (gdb-stopping ignored)) @@ -1321,6 +1334,8 @@ directives." (setq gdb-signalled t)) (defun gdb-frame-begin (ignored) + (setq gdb-frame-begin t) + (setq gdb-printing nil) (let ((sink gdb-output-sink)) (cond ((eq sink 'inferior) @@ -1331,25 +1346,33 @@ directives." (gdb-resync) (error "Unexpected frame-begin annotation (%S)" sink))))) +(defcustom gdb-same-frame focus-follows-mouse + "Non-nil means pop up GUD buffer in same frame." + :group 'gud + :type 'boolean + :version "22.1") + (defun gdb-stopped (ignored) "An annotation handler for `stopped'. 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) + (if (and gdb-frame-begin gdb-printing) + (setq gud-overlay-arrow-position gud-old-arrow) ;;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)) + (if gdb-same-frame + (gdb-display-gdb-buffer) + (gdb-frame-gdb-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 + (if (gdb-get-buffer 'gdb-stack-buffer) + 'keep (progn (gdb-get-buffer-create 'gdb-stack-buffer) (gdb-invalidate-frames) - 'delete)))) + 'delete))))) (unless (member gdb-inferior-status '("exited" "signal")) (setq gdb-inferior-status "stopped") (gdb-force-mode-line-update gdb-inferior-status)) @@ -2757,7 +2780,9 @@ corresponding to the mode line clicked." "Display GUD buffer in a new frame." (interactive) (let ((special-display-regexps (append special-display-regexps '(".*"))) - (special-display-frame-alist gdb-frame-parameters) + (special-display-frame-alist + (remove '(menu-bar-lines) (remove '(tool-bar-lines) + gdb-frame-parameters))) (same-window-regexps nil)) (display-buffer gud-comint-buffer))) @@ -3193,8 +3218,8 @@ BUFFER nil or omitted means use the current buffer." (setq gdb-frame-number (match-string 1)) (setq gdb-frame-address (match-string 2))) (goto-char (point-min)) - (when (re-search-forward ".*=\\s-+0x0*\\(\\S-*\\)\\s-+in\\s-+\\(\\S-+?\\)\ -\\(?: (\\(\\S-+?\\):[0-9]+?)\\)*;? " + (when (re-search-forward ".*=\\s-+0x0*\\(\\S-*\\)\\s-+in\\s-+\\(.*?\\)\ +\\(?: (\\(\\S-+?\\):[0-9]+?)\\)*; " nil t) (setq gdb-selected-frame (match-string 2)) (if (gdb-get-buffer 'gdb-locals-buffer) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index d207094cafe..eb803422027 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -282,13 +282,13 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies (": \\(.+\\): \\(?:Permission denied\\|No such \\(?:file or directory\\|device or address\\)\\)$" 1 grep-error-face) ;; remove match from grep-regexp-alist before fontifying - ("^Grep started.*" + ("^Grep[/a-zA-z]* started.*" (0 '(face nil message nil help-echo nil mouse-face nil) t)) - ("^Grep finished \\(?:(\\(matches found\\))\\|with \\(no matches found\\)\\).*" + ("^Grep[/a-zA-z]* finished \\(?:(\\(matches found\\))\\|with \\(no matches found\\)\\).*" (0 '(face nil message nil help-echo nil mouse-face nil) t) (1 compilation-info-face nil t) (2 compilation-warning-face nil t)) - ("^Grep \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?.*" + ("^Grep[/a-zA-z]* \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?.*" (0 '(face nil message nil help-echo nil mouse-face nil) t) (1 grep-error-face) (2 grep-error-face nil t)) diff --git a/lisp/simple.el b/lisp/simple.el index a91f2a5f0fb..f1c1eb94118 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3521,7 +3521,7 @@ Outline mode sets this." (if (and track-eol (eolp) ;; Don't count beg of empty line as end of line ;; unless we just did explicit end-of-line. - (or (not (bolp)) (eq last-command 'end-of-line))) + (or (not (bolp)) (eq last-command 'move-end-of-line))) 9999 (current-column)))) diff --git a/lisp/term.el b/lisp/term.el index 8e2e0773121..4124e2a2969 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -3613,7 +3613,7 @@ all pending output has been dealt with.")) (progn ;; Delete scroll-needed lines at term-scroll-end, ;; then insert scroll-needed lines. - (term-vertical-motion (1- term-scroll-end)) + (term-vertical-motion term-scroll-end) (end-of-line) (setq save-top (point)) (term-vertical-motion scroll-needed) @@ -3767,11 +3767,15 @@ Should only be called when point is at the start of a screen line." (save-current-column term-current-column) (save-start-line-column term-start-line-column) (save-current-row (term-current-row))) - (when (>= (+ save-current-row lines) term-scroll-end) - (setq lines (- lines (- (+ save-current-row lines) term-scroll-end)))) + ;; The number of inserted lines shouldn't exceed the scroll region end. + ;; The `term-scroll-end' line is part of the scrolling region, so + ;; we need to go one line past it in order to ensure correct + ;; scrolling. + (when (> (+ save-current-row lines) (1+ term-scroll-end)) + (setq lines (- lines (- (+ save-current-row lines) (1+ term-scroll-end))))) (term-down lines) (delete-region start (point)) - (term-down (- term-scroll-end save-current-row lines)) + (term-down (- (1+ term-scroll-end) save-current-row lines)) (term-insert-char ?\n lines) (setq term-current-column save-current-column) (setq term-start-line-column save-start-line-column) @@ -3785,6 +3789,9 @@ Should only be called when point is at the start of a screen line." (save-start-line-column term-start-line-column) (save-current-row (term-current-row))) ;; Inserting lines should take into account the scroll region. + ;; The `term-scroll-end' line is part of the scrolling region, so + ;; we need to go one line past it in order to ensure correct + ;; scrolling. (if (< save-current-row term-scroll-start) ;; If point is before scroll start, (progn @@ -3792,9 +3799,9 @@ Should only be called when point is at the start of a screen line." (term-down (- term-scroll-start save-current-row)) (setq start (point))) ;; The number of inserted lines shouldn't exceed the scroll region end. - (when (>= (+ save-current-row lines) term-scroll-end) - (setq lines (- lines (- (+ save-current-row lines) term-scroll-end)))) - (term-down (- term-scroll-end save-current-row lines))) + (when (> (+ save-current-row lines) (1+ term-scroll-end)) + (setq lines (- lines (- (+ save-current-row lines)(1+ term-scroll-end))))) + (term-down (- (1+ term-scroll-end) save-current-row lines))) (setq start-deleted (point)) (term-down lines) (delete-region start-deleted (point)) diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el index 736fbef76b2..dd821de3ba8 100644 --- a/lisp/term/mac-win.el +++ b/lisp/term/mac-win.el @@ -1249,6 +1249,9 @@ correspoinding TextEncodingBase value." ;;;; Conversion between common flavors and Lisp string. +(defconst mac-text-encoding-ascii #x600 + "ASCII text encoding.") + (defconst mac-text-encoding-mac-japanese-basic-variant #x20001 "MacJapanese text encoding without Apple double-byte extensions.") @@ -1269,7 +1272,7 @@ correspoinding TextEncodingBase value." (if (string-match "[\xa0\xfd-\xff]" str) (setq str nil) ;; ASCII-only? - (unless (string-match "\\`[[:ascii:]]*\\'" str) + (unless (mac-code-convert-string data nil mac-text-encoding-ascii) (subst-char-in-string ?\x5c ?\(J\(B str t) (subst-char-in-string ?\x80 ?\\ str t))))) (or str @@ -1965,8 +1968,7 @@ either in the current buffer or in the echo area." (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")))) + (fix-len (mac-ae-number ae "tsfx")) ;; Optional parameters (hilite-rng (mac-ae-text-range-array ae "tshi")) (update-rng (mac-ae-text-range-array ae "tsup")) @@ -2008,15 +2010,15 @@ either in the current buffer or in the echo area." (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) + (let ((msg (current-message)) + message-log-max) + (if (and msg ;; 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))) + msg))) + (setq msg (propertize msg 'display + (concat msg active-input-string))) (setq msg active-input-string)) (message "%s" msg) (overlay-put mac-ts-active-input-overlay 'before-string nil)) diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 9b3ebfe3420..becf418e4e0 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -159,9 +159,10 @@ (define-key xterm-function-map "\e[4~" [select]) (define-key xterm-function-map "\e[29~" [print]) -;; These keys will be available xterm starting probably from -;; version 214. +;; These keys are available in xterm starting from version 214 +;; if the modifyOtherKeys resource is set. (define-key xterm-function-map "\e[27;5;9~" [(control ?\t)]) +(define-key xterm-function-map "\e[27;5;13~" [C-return]) (define-key xterm-function-map "\e[27;5;44~" [(control ?\,)]) (define-key xterm-function-map "\e[27;5;46~" [(control ?\.)]) (define-key xterm-function-map "\e[27;5;47~" [(control ?\/)]) diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index dd4dfc1a857..b2d79c1acbb 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.36b +;; Version: 4.39 ;; ;; This file is part of GNU Emacs. ;; @@ -90,6 +90,21 @@ ;; ;; Recent changes ;; -------------- +;; Version 4.39 +;; - Special tag ARCHIVE keeps a subtree closed and away from agenda lists. +;; - LaTeX code in Org-mode files can be converted to images for HTML. +;; - Bug fixes. +;; - CDLaTeX-mode features can be used in Org-mode to help inserting +;; LaTeX environment and math. +;; +;; Version 4.38 +;; - noutline.el is now required (important for XEmacs users only). +;; - Dynamic blocks. +;; - Archiving of all level 1 trees without open TODO items. +;; - Clock reports can be inserted into the file in a special section. +;; - FAQ removed from the manual, now only on the web. +;; - Bug fixes. +;; ;; Version 4.37 ;; - Clock-feature for measuring time spent on specific items. ;; - Improved emphasizing allows configuration and stacking. @@ -170,13 +185,18 @@ (eval-when-compile (require 'cl) (require 'calendar)) -(require 'outline) +;; For XEmacs, noutline is not yet provided by outline.el, so arrange for +;; the file noutline.el being loaded. +(if (featurep 'xemacs) (condition-case nil (require 'noutline))) +;; We require noutline, which might be provided in outline.el +(require 'outline) (require 'noutline) +;; Other stuff we need. (require 'time-date) (require 'easymenu) ;;; Customization variables -(defvar org-version "4.36b" +(defvar org-version "4.39" "The version number of the file org.el.") (defun org-version () (interactive) @@ -396,7 +416,8 @@ visibility is cycled." (const :tag "Everywhere except in headlines" t) )) -(defcustom org-cycle-hook '(org-optimize-window-after-visibility-change) +(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees + org-optimize-window-after-visibility-change) "Hook that is run after `org-cycle' has changed the buffer visibility. The function(s) in this hook must accept a single argument which indicates the new state that was set by the most recent `org-cycle' command. The @@ -524,6 +545,38 @@ use \\[org-ctrl-c-ctrl-c] to trigger renumbering." :tag "Org Archive" :group 'org-structure) +(defcustom org-archive-tag "ARCHIVE" + "The tag that marks a subtree as archived. +An archived subtree does not open during visibility cycling, and does +not contribute to the agenda listings." + :group 'org-archive + :group 'org-keywords + :type 'string) + +(defcustom org-agenda-skip-archived-trees t + "Non-nil means, the agenda will skip any items located in archived trees. +An archived tree is a tree marked with the tag ARCHIVE." + :group 'org-archive + :group 'org-agenda-display + :type 'boolean) + +(defcustom org-cycle-open-archived-trees nil + "Non-nil means, `org-cycle' will open archived trees. +An archived tree is a tree marked with the tag ARCHIVE. +When nil, archived trees will stay folded. You can still open them with +normal outline commands like `show-all', but not with the cycling commands." + :group 'org-archive + :group 'org-cycle + :type 'boolean) + +(defcustom org-sparse-tree-open-archived-trees nil + "Non-nil means sparse tree construction shows matches in archived trees. +When nil, matches in these trees are highlighted, but the trees are kept in +collapsed state." + :group 'org-archive + :group 'org-sparse-trees + :type 'boolean) + (defcustom org-archive-location "%s_archive::" "The location where subtrees should be archived. This string consists of two parts, separated by a double-colon. @@ -561,12 +614,12 @@ line like :type 'string) (defcustom org-archive-mark-done t - "Non-nil means, mark archived entries as DONE." + "Non-nil means, mark entries as DONE when they are moved to the archive file." :group 'org-archive :type 'boolean) (defcustom org-archive-stamp-time t - "Non-nil means, add a time stamp to archived entries. + "Non-nil means, add a time stamp to entries moved to an archive file. The time stamp will be added directly after the TODO state keyword in the first line, so it is probably best to use this in combinations with `org-archive-mark-done'." @@ -1015,12 +1068,14 @@ rather than having to type \"yes\"." (const :tag "no confirmation (dangerous)" nil))) (defconst org-file-apps-defaults-gnu - '((t . mailcap)) + '((remote . emacs) + (t . mailcap)) "Default file applications on a UNIX or GNU/Linux system. See `org-file-apps'.") (defconst org-file-apps-defaults-macosx - '((t . "open %s") + '((remote . emacs) + (t . "open %s") ("ps" . "gv %s") ("ps.gz" . "gv %s") ("eps" . "gv %s") @@ -1033,11 +1088,13 @@ for some files for which the OS does not have a good default. See `org-file-apps'.") (defconst org-file-apps-defaults-windowsnt - (list (cons t - (list (if (featurep 'xemacs) - 'mswindows-shell-execute - 'w32-shell-execute) - "open" 'file))) + (list + '(remote . emacs) + (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'.") @@ -1059,6 +1116,9 @@ files and the cdr the corresponding command. Possible values for the file identifier are \"ext\" A string identifying an extension `directory' Matches a directory + `remote' Matches a remove file, accessible through tramp or efs. + Remote files most likely should be visited through emacs + because external applications cannot handle such paths. t Default for all remaining files Possible values for the command are: @@ -1077,6 +1137,7 @@ For more examples, see the system specific constants (cons (choice :value "" (string :tag "Extension") (const :tag "Default for unrecognized files" t) + (const :tag "Remote file" remote) (const :tag "Links to a directory" directory)) (choice :value "" (const :tag "Visit with Emacs" emacs) @@ -1702,6 +1763,29 @@ N days, just insert a special line indicating the size of the gap." (const :tag "All" t) (number :tag "at most"))) +(defgroup org-latex nil + "Options for embedding LaTeX code into Org-mode" + :tag "Org LaTeX" + :group 'org) + +(defcustom org-format-latex-options + '(:foreground "Black" :background "Transparent" :scale 1.0 + :matchers ("begin" "$" "$$" "\\(" "\\[")) + "Options for creating images from LaTeX fragments. +This is a property list with the following properties: +:foreground the foreground color, for example \"Black\". +:background the background color, or \"Transparent\". +:scale a scaling factor for the size of the images +:matchers a list indicating which matchers should be used to + find LaTeX fragments. Valid members of this list are: + \"begin\" find environments + \"$\" find mathc expressions surrounded by $...$ + \"$$\" find math expressions surrounded by $$....$$ + \"\\(\" find math expressions surrounded by \\(...\\) + \"\\[\" find math expressions surrounded by \\[...\\]" + :group 'org-latex + :type 'plist) + (defgroup org-export nil "Options for exporting org-listings." :tag "Org Export" @@ -1800,6 +1884,19 @@ This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"." :group 'org-export-general :type 'boolean) +(defcustom org-export-with-archived-trees 'headline + "Whether subtrees with the ARCHIVE tag should be exported. +This can have three different values +nil Do not export, pretend this tree is not present +t Do export the entire tree +headline Only export the headline, but skip the tree below it." + :group 'org-export-general + :group 'org-archive + :type '(choice + (const :tag "not at all" nil) + (const :tag "headline only" 'headline) + (const :tag "entirely" t))) + (defcustom org-export-with-timestamps t "Nil means, do not export time stamps and associated keywords." :group 'org-export @@ -1863,6 +1960,19 @@ Not all export backends support this. This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"." :group 'org-export-translation + :group 'org-latex + :type 'boolean) + +(defcustom org-export-with-LaTeX-fragments nil + "Non-nil means, convert LaTeX fragments to images when exporting to HTML. +When set, the exporter will find LaTeX environments if the \\begin line is +the first non-white thing on a line. It will also find the math delimiters +like $a=b$ and \\( a=b \\) for inline math, $$a=b$$ and \\[ a=b \\] for +display math. + +This option can also be set with the +OPTIONS line, e.g. \"LaTeX:t\"." + :group 'org-export-translation + :group 'org-latex :type 'boolean) (defcustom org-export-with-fixed-width t @@ -2202,7 +2312,7 @@ stacked Non-nil means, allow stacked styles. This works only in HTML `org-emphasis-alist') will be allowed as pre/post, aiding inside-out matching. Use customize to modify this, or restart emacs after changing it." - :group 'org-fixme + :group 'org-font-lock :set 'org-set-emph-re :type '(list (sexp :tag "Allowed chars in pre ") @@ -2216,19 +2326,23 @@ Use customize to modify this, or restart emacs after changing it." '(("*" bold "<b>" "</b>") ("/" italic "<i>" "</i>") ("_" underline "<u>" "</u>") - ("=" shadow "<code>" "</code>")) + ("=" shadow "<code>" "</code>") + ("+" (:strike-through t) "<del>" "</del>") +) "Special syntax for emphasised text. Text starting and ending with a special character will be emphasized, for example *bold*, _underlined_ and /italic/. This variable sets the marker characters, the face to bbe used by font-lock for highlighting in Org-mode emacs buffers, and the HTML tags to be used for this. Use customize to modify this, or restart emacs after changing it." - :group 'org-fixme + :group 'org-font-lock :set 'org-set-emph-re :type '(repeat (list (string :tag "Marker character") - (face :tag "Font-lock-face") + (choice + (face :tag "Font-lock-face") + (plist :tag "Face property list")) (string :tag "HTML start tag") (string :tag "HTML end tag")))) @@ -2370,6 +2484,19 @@ color of the frame." This face is only used if `org-fontify-done-headline' is set." :group 'org-faces) +(defface org-archived ; similar to shadow + (org-compatible-face + '((((class color grayscale) (min-colors 88) (background light)) + (:foreground "grey50")) + (((class color grayscale) (min-colors 88) (background dark)) + (:foreground "grey70")) + (((class color) (min-colors 8) (background light)) + (:foreground "green")) + (((class color) (min-colors 8) (background dark)) + (:foreground "yellow")))) + "Face for headline with the ARCHIVE tag." + :group 'org-faces) + (defface org-link '((((class color) (background light)) (:foreground "Purple" :underline t)) (((class color) (background dark)) (:foreground "Cyan" :underline t)) @@ -2608,7 +2735,7 @@ Also put tags into group 4 if tags are present.") (and arch (set (make-local-variable 'org-archive-location) arch)) (and int (set (make-local-variable 'org-todo-interpretation) int)) (when tags - (let (e tg c tgs) + (let (e tgs) (while (setq e (pop tags)) (cond ((equal e "{") (push '(:startgroup) tgs)) @@ -2690,6 +2817,8 @@ Also put tags into group 4 if tags are present.") (defvar org-goto-start-pos) ; dynamically scoped parameter (defvar org-time-was-given) ; dynamically scoped parameter (defvar org-ts-what) ; dynamically scoped parameter +(defvar org-current-export-file) ; dynamically scoped parameter +(defvar org-current-export-dir) ; dynamically scoped parameter (defvar mark-active) ; Emacs only, not available in XEmacs. (defvar timecnt) ; dynamically scoped parameter (defvar levels-open) ; dynamically scoped parameter @@ -2708,6 +2837,7 @@ Also put tags into group 4 if tags are present.") (defvar gnus-group-name) ; from gnus (defvar gnus-article-current) ; from gnus (defvar w3m-current-url) ; from w3m +(defvar w3m-current-title) ; from w3m (defvar mh-progs) ; from MH-E (defvar mh-current-folder) ; from MH-E (defvar mh-show-folder-buffer) ; from MH-E @@ -2823,8 +2953,10 @@ The following commands are available: (insert " -*- mode: org -*-\n\n")) (unless org-inhibit-startup - (if org-startup-align-all-tables - (org-table-map-tables 'org-table-align)) + (when org-startup-align-all-tables + (let ((bmp (buffer-modified-p))) + (org-table-map-tables 'org-table-align) + (set-buffer-modified-p bmp))) (if org-startup-with-deadline-check (call-interactively 'org-check-deadlines) (cond @@ -3177,6 +3309,7 @@ between words." '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t)) (if org-format-transports-properties-p '("| *\\(<[0-9]+>\\) *" (1 'org-formula t))) + '("^\\*+ \\(.*:ARCHIVE:.*\\)" (1 'org-archived prepend)) ))) (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) ;; Now set the full font-lock-keywords @@ -3253,7 +3386,11 @@ between words." 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)) + (org-cycle-hook + (if bob-special + (delq 'org-optimize-window-after-visibility-change + (copy-sequence org-cycle-hook)) + org-cycle-hook)) (pos (point))) (if (or bob-special (equal arg '(4))) @@ -3271,7 +3408,7 @@ between words." (call-interactively 'org-table-next-field))))) ((eq arg t) ;; Global cycling - + (cond ((and (eq last-command this-command) (eq org-cycle-global-status 'overview)) @@ -3350,6 +3487,9 @@ between words." ;; TAB emulation (buffer-read-only (org-back-to-heading)) + + ((org-try-cdlatex-tab)) + ((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) @@ -3617,10 +3757,8 @@ 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))) pos) (cond ((and (org-at-item-p) (<= (point) eow)) @@ -3722,9 +3860,7 @@ in the region." (replace-match up-head nil t) ;; Fixup tag positioning (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation - (org-fixup-indentation (if (> diff 1) "^ " "^ ") "" - (if (> diff 1) "^ ? ?\\S-" "^ ?\\S-"))))) + (if org-adapt-indentation (org-fixup-indentation (- diff))))) (defun org-demote () "Demote the current heading lower down the tree. @@ -3737,8 +3873,7 @@ in the region." (replace-match down-head nil t) ;; Fixup tag positioning (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation - (org-fixup-indentation "^ " (if (> diff 1) " " " ") "^\\S-")))) + (if org-adapt-indentation (org-fixup-indentation diff)))) (defun org-map-tree (fun) "Call FUN for every heading underneath the current one." @@ -3767,20 +3902,23 @@ in the region." (not (eobp))) (funcall fun))))) -;; FIXME: this does not work well with Tabulators. This has to be re-written entirely. -(defun org-fixup-indentation (from to prohibit) - "Change the indentation in the current entry by re-replacing FROM with TO. -However, if the regexp PROHIBIT matches at all, don't do anything. -This is being used to change indentation along with the length of the -heading marker. But if there are any lines which are not indented, nothing -is changed at all." +(defun org-fixup-indentation (diff) + "Change the indentation in the current entry by DIFF +However, if any line in the current entry has no indentation, or if it +would end up with no indentation after the change, nothing at all is done." (save-excursion (let ((end (save-excursion (outline-next-heading) - (point-marker)))) + (point-marker))) + (prohibit (if (> diff 0) + "^\\S-" + (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-"))) + col) (unless (save-excursion (re-search-forward prohibit end t)) - (while (re-search-forward from end t) - (replace-match to) - (beginning-of-line 2))) + (while (re-search-forward "^[ \t]+" end t) + (goto-char (match-end 0)) + (setq col (current-column)) + (if (< diff 0) (replace-match "")) + (indent-to (+ diff col)))) (move-marker end nil)))) ;;; Vertical tree motion, cutting and pasting of subtrees @@ -3984,6 +4122,14 @@ If optional TXT is given, check this string instead of the current kill." (throw 'exit nil))) t)))) +(defun org-narrow-to-subtree () + "Narrow buffer to the current subtree." + (interactive) + (save-excursion + (narrow-to-region + (progn (org-back-to-heading) (point)) + (progn (org-end-of-subtree t) (point))))) + ;;; Plain list items (defun org-at-item-p () @@ -4101,12 +4247,10 @@ If the cursor is not in an item, throw an error." "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) + (let (ind ind1 (pos (point))) (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) @@ -4116,7 +4260,7 @@ Error if not at a plain list, or if this is the last item in the list." "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) + (let (beg ind (pos (point))) (org-beginning-of-item) (setq beg (point)) (setq ind (org-get-indentation)) @@ -4126,7 +4270,7 @@ Error if not at a plain list, or if this is the last item in the list." (beginning-of-line 0) (if (looking-at "[ \t]*$") nil - (if (<= (setq ind1 (org-get-indentation)) ind) + (if (<= (org-get-indentation) ind) (throw 'exit t))))) (condition-case nil (org-beginning-of-item) @@ -4292,103 +4436,391 @@ with something like \"1.\" or \"2)\"." ;;; Archiving -(defun org-archive-subtree () +(defun org-archive-subtree (&optional find-done) "Move the current subtree to the archive. The archive can be a certain top-level heading in the current file, or in a different file. The tree will be moved to that location, the subtree -heading be marked DONE, and the current time will be added." - (interactive) - ;; Save all relevant TODO keyword-relatex variables - (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler - (tr-org-todo-keywords org-todo-keywords) - (tr-org-todo-interpretation org-todo-interpretation) - (tr-org-done-string org-done-string) - (tr-org-todo-regexp org-todo-regexp) - (tr-org-todo-line-regexp org-todo-line-regexp) - (this-buffer (current-buffer)) - file heading buffer level newfile-p) - (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location) +heading be marked DONE, and the current time will be added. + +When called with prefix argument FIND-DONE, find whole trees without any +open TODO items and archive them (after getting confirmation from the user). +If the cursor is not at a headline when this comand is called, try all level +1 trees. If the cursor is on a headline, only try the direct children of +this heading. " + (interactive "P") + (if find-done + (org-archive-all-done) + ;; Save all relevant TODO keyword-relatex variables + + (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler + (tr-org-todo-keywords org-todo-keywords) + (tr-org-todo-interpretation org-todo-interpretation) + (tr-org-done-string org-done-string) + (tr-org-todo-regexp org-todo-regexp) + (tr-org-todo-line-regexp org-todo-line-regexp) + (this-buffer (current-buffer)) + file heading buffer level newfile-p) + (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location) + (progn + (setq file (format (match-string 1 org-archive-location) + (file-name-nondirectory buffer-file-name)) + heading (match-string 2 org-archive-location))) + (error "Invalid `org-archive-location'")) + (if (> (length file) 0) + (setq newfile-p (not (file-exists-p file)) + buffer (find-file-noselect file)) + (setq buffer (current-buffer))) + (unless buffer + (error "Cannot access file \"%s\"" file)) + (if (and (> (length heading) 0) + (string-match "^\\*+" heading)) + (setq level (match-end 0)) + (setq heading nil level 0)) + (save-excursion + ;; We first only copy, in case something goes wrong + ;; we need to protect this-command, to avoid kill-region sets it, + ;; which would lead to duplication of subtrees + (let (this-command) (org-copy-subtree)) + (set-buffer buffer) + ;; Enforce org-mode for the archive buffer + (if (not (eq major-mode 'org-mode)) + ;; Force the mode for future visits. + (let ((org-insert-mode-line-in-empty-file t)) + (call-interactively 'org-mode))) + (when newfile-p + (goto-char (point-max)) + (insert (format "\nArchived entries from file %s\n\n" + (buffer-file-name this-buffer)))) + ;; Force the TODO keywords of the original buffer + (let ((org-todo-line-regexp tr-org-todo-line-regexp) + (org-todo-keywords tr-org-todo-keywords) + (org-todo-interpretation tr-org-todo-interpretation) + (org-done-string tr-org-done-string) + (org-todo-regexp tr-org-todo-regexp) + (org-todo-line-regexp tr-org-todo-line-regexp)) + (goto-char (point-min)) + (if heading + (progn + (if (re-search-forward + (concat "\\(^\\|\r\\)" + (regexp-quote heading) "[ \t]*\\($\\|\r\\)") + nil t) + (goto-char (match-end 0)) + ;; Heading not found, just insert it at the end + (goto-char (point-max)) + (or (bolp) (insert "\n")) + (insert "\n" heading "\n") + (end-of-line 0)) + ;; 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)) + ;; Mark the entry as done, i.e. set to last work in org-todo-keywords + (if org-archive-mark-done + (org-todo (length org-todo-keywords))) + ;; Move cursor to right after the TODO keyword + (when org-archive-stamp-time + (beginning-of-line 1) + (looking-at org-todo-line-regexp) + (goto-char (or (match-end 2) (match-beginning 3))) + (insert "(" (format-time-string (cdr org-time-stamp-formats) + (org-current-time)) + ")")) + ;; Save the buffer, if it is not the same buffer. + (if (not (eq this-buffer buffer)) (save-buffer)))) + ;; 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 (and (not (eobp)) (looking-at "[ \t]*$")) (kill-line)) + (message "Subtree archived %s" + (if (eq this-buffer buffer) + (concat "under heading: " heading) + (concat "in file: " (abbreviate-file-name file))))))) + +(defun org-archive-all-done (&optional tag) + "Archive sublevels of the current tree without open TODO items. +If the cursor is not on a headline, try all level 1 trees. If +it is on a headline, try all direct children. +When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." + (let ((re (concat "^\\*+ +" org-not-done-regexp)) re1 + (rea (concat ".*:" org-archive-tag ":")) + (begm (make-marker)) + (endm (make-marker)) + (question (if tag "Set ARCHIVE tag (no open TODO items)? " + "Move subtree to archive (no open TODO items)? ")) + beg end (cntarch 0)) + (if (org-on-heading-p) (progn - (setq file (format (match-string 1 org-archive-location) - (file-name-nondirectory buffer-file-name)) - heading (match-string 2 org-archive-location))) - (error "Invalid `org-archive-location'")) - (if (> (length file) 0) - (setq newfile-p (not (file-exists-p file)) - buffer (find-file-noselect file)) - (setq buffer (current-buffer))) - (unless buffer - (error "Cannot access file \"%s\"" file)) - (if (and (> (length heading) 0) - (string-match "^\\*+" heading)) - (setq level (match-end 0)) - (setq heading nil level 0)) + (setq re1 (concat "^" (regexp-quote + (make-string + (1+ (- (match-end 0) (match-beginning 0))) + ?*)) + " ")) + (move-marker begm (point)) + (move-marker endm (org-end-of-subtree))) + (setq re1 "^* ") + (move-marker begm (point-min)) + (move-marker endm (point-max))) (save-excursion - ;; We first only copy, in case something goes wrong - ;; we need to protect this-command, to avoid kill-region sets it, - ;; which would lead to duplication of subtrees - (let (this-command) (org-copy-subtree)) - (set-buffer buffer) - ;; Enforce org-mode for the archive buffer - (if (not (eq major-mode 'org-mode)) - ;; Force the mode for future visits. - (let ((org-insert-mode-line-in-empty-file t)) - (call-interactively 'org-mode))) - (when newfile-p - (goto-char (point-max)) - (insert (format "\nArchived entries from file %s\n\n" - (buffer-file-name this-buffer)))) - ;; Force the TODO keywords of the original buffer - (let ((org-todo-line-regexp tr-org-todo-line-regexp) - (org-todo-keywords tr-org-todo-keywords) - (org-todo-interpretation tr-org-todo-interpretation) - (org-done-string tr-org-done-string) - (org-todo-regexp tr-org-todo-regexp) - (org-todo-line-regexp tr-org-todo-line-regexp)) - (goto-char (point-min)) - (if heading - (progn - (if (re-search-forward - (concat "\\(^\\|\r\\)" - (regexp-quote heading) "[ \t]*\\($\\|\r\\)") - nil t) - (goto-char (match-end 0)) - ;; Heading not found, just insert it at the end - (goto-char (point-max)) - (or (bolp) (insert "\n")) - (insert "\n" heading "\n") - (end-of-line 0)) - ;; 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)) - ;; Mark the entry as done, i.e. set to last work in org-todo-keywords - (if org-archive-mark-done - (org-todo (length org-todo-keywords))) - ;; Move cursor to right after the TODO keyword - (when org-archive-stamp-time - (beginning-of-line 1) - (looking-at org-todo-line-regexp) - (goto-char (or (match-end 2) (match-beginning 3))) - (insert "(" (format-time-string (cdr org-time-stamp-formats) - (org-current-time)) - ")")) - ;; Save the buffer, if it is not the same buffer. - (if (not (eq this-buffer buffer)) (save-buffer)))) - ;; 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 (and (not (eobp)) (looking-at "[ \t]*$")) (kill-line)) - (message "Subtree archived %s" - (if (eq this-buffer buffer) - (concat "under heading: " heading) - (concat "in file: " (abbreviate-file-name file)))))) + (goto-char begm) + (while (re-search-forward re1 endm t) + beg (match-beginning 0) + end (save-excursion (org-end-of-subtree t) (point))) + (goto-char beg) + (if (re-search-forward re end t) + (goto-char end) + (goto-char beg) + (if (and (or (not tag) (not (looking-at rea))) + (y-or-n-p question)) + (progn + (if tag + (org-toggle-tag org-archive-tag 'on) + (org-archive-subtree)) + (setq cntarch (1+ cntarch))) + (goto-char end)))) + (message "%d trees archived" cntarch))) + + +(defun org-cycle-hide-archived-subtrees (state) + "Re-hide all archived subtrees after a visibility state change." + (when (and (not org-cycle-open-archived-trees) + (not (memq state '(overview folded)))) + (save-excursion + (let* ((globalp (memq state '(contents all))) + (beg (if globalp (point-min) (point))) + (end (if globalp (point-max) (org-end-of-subtree)))) + (org-hide-archived-subtrees beg end))))) + +(defun org-hide-archived-subtrees (beg end) + "Re-hide all archived subtrees after a visibility state change." + (save-excursion + (let* ((re (concat ":" org-archive-tag ":"))) + (goto-char beg) + (while (re-search-forward re end t) + (and (org-on-heading-p) (hide-subtree)) + (org-end-of-subtree))))) + +(defun org-toggle-tag (tag &optional onoff) + "Toggle the tag TAG for the current line. +If ONOFF is `on' or `off', don't toggle but set to this state." + (unless (org-on-heading-p) (error "Not on headling")) + (let (res current) + (save-excursion + (beginning-of-line) + (if (re-search-forward "[ \t]:\\([a-zA-Z0-9_@:]+\\):[ \t]*$" + (point-at-eol) t) + (progn + (setq current (match-string 1)) + (replace-match "")) + (setq current "")) + (setq current (nreverse (org-split-string current ":"))) + (cond + ((eq onoff 'on) + (setq res t) + (or (member tag current) (push tag current))) + ((eq onoff 'off) + (or (not (member tag current)) (setq current (delete tag current)))) + (t (if (member tag current) + (setq current (delete tag current)) + (setq res t) + (push tag current)))) + (end-of-line 1) + (when current + (insert " :" (mapconcat 'identity (nreverse current) ":") ":")) + (org-set-tags nil t)) + res)) + +(defun org-toggle-archive-tag (&optional arg) + "Toggle the archive tag for the current headline. +With prefix ARG, check all children of current headline and offer tagging +the children that do not contain any open TODO items." + (interactive "P") + (if arg + (org-archive-all-done 'tag) + (let (set) + (save-excursion + (org-back-to-heading t) + (setq set (org-toggle-tag org-archive-tag)) + (when set (hide-subtree))) + (and set (beginning-of-line 1)) + (message "Subtree %s" (if set "archived" "unarchived"))))) + +(defun org-prepare-agenda-buffers (files) + "Create buffers for all agenda files, protect archived trees and comments." + (let ((pa '(:org-archived t)) + (pc '(:org-comment t)) + (pall '(:org-archived t :org-comment t)) + (rea (concat ":" org-archive-tag ":")) + file re) + (save-excursion + (while (setq file (pop files)) + (org-check-agenda-file file) + (set-buffer (org-get-agenda-file-buffer file)) + (widen) + (save-excursion + (remove-text-properties (point-min) (point-max) pall) + (when org-agenda-skip-archived-trees + (goto-char (point-min)) + (while (re-search-forward rea nil t) + (if (org-on-heading-p) + (add-text-properties (point-at-bol) (org-end-of-subtree) pa)))) + (goto-char (point-min)) + (setq re (concat "^\\*+ +" org-comment-string "\\>")) + (while (re-search-forward re nil t) + (add-text-properties + (match-beginning 0) (org-end-of-subtree) pc))))))) + +(defun org-agenda-skip () + "Throw to `:skip' in places that should be skipped." + (let ((p (point-at-bol))) + (and org-agenda-skip-archived-trees + (get-text-property p :org-archived) + (org-end-of-subtree) + (throw :skip t)) + (and (get-text-property p :org-comment) + (org-end-of-subtree) + (throw :skip t)) + (if (equal (char-after p) ?#) (throw :skip t)))) + +(defun org-agenda-toggle-archive-tag () + "Toggle the archive tag for the current entry." + (interactive) + (org-agenda-check-no-diary) + (org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed + (let* ((hdmarker (or (get-text-property (point) 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (buffer-read-only nil) + newhead) + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-hidden-entry) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil))) ; show the next heading + (call-interactively 'org-toggle-archive-tag) + (end-of-line 1) + (setq newhead (org-get-heading))) + (org-agenda-change-all-lines newhead hdmarker) + (beginning-of-line 1))) + +;;; Dynamic blocks + +(defun org-find-dblock (name) + "Find the first dynamic block with name NAME in the buffer. +If not found, stay at current position and return nil." + (let (pos) + (save-excursion + (goto-char (point-min)) + (setq pos (and (re-search-forward (concat "^#\\+BEGIN:[ \t]+" name "\\>") + nil t) + (match-beginning 0)))) + (if pos (goto-char pos)) + pos)) + +(defconst org-dblock-start-re + "^#\\+BEGIN:[ \t]+\\(\\S-+\\)[ \t]+\\(.*\\)" + "Matches the startline of a dynamic block, with parameters.") + +(defconst org-dblock-end-re "^#\\+END\\([: \t\r\n]\\|$\\)" + "Matches the end of a dyhamic block.") + +(defun org-create-dblock (plist) + "Create a dynamic block section, with parameters taken from PLIST. +PLIST must containe a :name entry which is used as name of the block." + (unless (bolp) (newline)) + (let ((name (plist-get plist :name))) + (insert "#+BEGIN: " name) + (while plist + (if (eq (car plist) :name) + (setq plist (cddr plist)) + (insert " " (prin1-to-string (pop plist))))) + (insert "\n\n#+END:\n") + (beginning-of-line -2))) + +(defun org-prepare-dblock () + "Prepare dynamic block for refresh. +This empties the block, puts the cursor at the insert position and returns +the property list including an extra property :name with the block name." + (unless (looking-at org-dblock-start-re) + (error "Not at a dynamic block")) + (let* ((begdel (1+ (match-end 0))) + (name (match-string 1)) + (params (append (list :name name) + (read (concat "(" (match-string 2) ")"))))) + (unless (re-search-forward org-dblock-end-re nil t) + (error "Dynamic block not terminated")) + (delete-region begdel (match-beginning 0)) + (goto-char begdel) + (open-line 1) + params)) + +(defun org-map-dblocks (&optional command) + "Apply COMMAND to all dynamic blocks in the current buffer. +If COMMAND is not given, use `org-update-dblock'." + (let ((cmd (or command 'org-update-dblock)) + pos) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward org-dblock-start-re nil t) + (goto-char (setq pos (match-beginning 0))) + (condition-case nil + (funcall cmd) + (error (message "Error during update of dynamic block"))) + (goto-char pos) + (unless (re-search-forward org-dblock-end-re nil t) + (error "Dynamic block not terminated")))))) + +(defun org-dblock-update (&optional arg) + "User command for updating dynamic blocks. +Update the dynamic block at point. With prefix ARG, update all dynamic +blocks in the buffer." + (interactive "P") + (if arg + (org-update-all-dblocks) + (or (looking-at org-dblock-start-re) + (org-beginning-of-dblock)) + (org-update-dblock))) + +(defun org-update-dblock () + "Update the dynamic block at point +This means to empty the block, parse for parameters and then call +the correct writing function." + (let* ((pos (point)) + (params (org-prepare-dblock)) + (name (plist-get params :name)) + (cmd (intern (concat "org-dblock-write:" name)))) + (funcall cmd params) + (goto-char pos))) + +(defun org-beginning-of-dblock () + "Find the beginning of the dynamic block at point. +Error if there is no scuh block at point." + (let ((pos (point)) + beg) + (end-of-line 1) + (if (and (re-search-backward org-dblock-start-re nil t) + (setq beg (match-beginning 0)) + (re-search-forward org-dblock-end-re nil t) + (> (match-end 0) pos)) + (goto-char beg) + (goto-char pos) + (error "Not in a dynamic block")))) + +(defun org-update-all-dblocks () + "Update all dynamic blocks in the buffer. +This function can be used in a hook." + (when (eq major-mode 'org-mode) + (org-map-dblocks 'org-update-dblock))) + ;;; Completion @@ -4662,9 +5094,8 @@ be removed." (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) + (let (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)) @@ -4734,6 +5165,8 @@ that the match should indeed be shown." (org-show-hierarchy-above)))) (org-add-hook 'before-change-functions 'org-remove-occur-highlights nil 'local) + (unless org-sparse-tree-open-archived-trees + (org-hide-archived-subtrees (point-min) (point-max))) (run-hooks 'org-occur-hook) (if (interactive-p) (message "%d match(es) for regexp %s" cnt regexp)) @@ -4777,22 +5210,25 @@ that the match should indeed be shown." (overlay-put ovl prop value))) (defvar org-occur-highlights nil) +(make-variable-buffer-local 'org-occur-highlights) (defun org-highlight-new-match (beg end) "Highlight from BEG to END and mark the highlight is an occur headline." (let ((ov (org-make-overlay beg end))) (org-overlay-put ov 'face 'secondary-selection) (push ov org-occur-highlights))) +(defvar org-inhibit-highlight-removal nil) (defun org-remove-occur-highlights (&optional beg end noremove) "Remove the occur highlights from the buffer. BEG and END are ignored. If NOREMOVE is nil, remove this function from the `before-change-functions' in the current buffer." (interactive) - (mapc 'org-delete-overlay org-occur-highlights) - (setq org-occur-highlights nil) - (unless noremove - (remove-hook 'before-change-functions - 'org-remove-occur-highlights 'local))) + (unless org-inhibit-highlight-removal + (mapc 'org-delete-overlay org-occur-highlights) + (setq org-occur-highlights nil) + (unless noremove + (remove-hook 'before-change-functions + 'org-remove-occur-highlights 'local)))) ;;; Priorities @@ -5449,15 +5885,16 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." "Sum the times for each subtree. Puts the resulting times in minutes as a text property on each headline." (interactive) - (remove-text-properties (point-min) (point-max) '(:org-clock-minutes t)) - (let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" + (let* ((bmp (buffer-modified-p)) + (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" org-clock-string ".*=>[ \t]*\\([0-9]+\\):\\([0-9]+\\)[ \t]*$")) (lmax 30) (ltimes (make-vector lmax 0)) (t1 0) (level 0) - (lastlevel 0) time) + time) + (remove-text-properties (point-min) (point-max) '(:org-clock-minutes t)) (save-excursion (goto-char (point-max)) (while (re-search-backward re nil t) @@ -5475,7 +5912,8 @@ Puts the resulting times in minutes as a text property on each headline." (aset ltimes l 0)) (goto-char (match-beginning 0)) (put-text-property (point) (point-at-eol) :org-clock-minutes time)))) - (setq org-clock-file-total-minutes (aref ltimes 0))))) + (setq org-clock-file-total-minutes (aref ltimes 0))) + (set-buffer-modified-p bmp))) (defun org-clock-display (&optional total-only) "Show subtree times in the entire buffer. @@ -5500,6 +5938,8 @@ in the echo area." (message "Total file time: %d:%02d (%d hours and %d minutes)" h m h m))) (defvar org-clock-overlays nil) +(make-variable-buffer-local 'org-clock-overlays) + (defun org-put-clock-overlay (time &optional level) "Put an overlays on the current line, displaying TIME. If LEVEL is given, prefix time with a corresponding number of stars. @@ -5510,11 +5950,11 @@ will be easy to remove." (off 0) ov tx) (move-to-column c) - (if (eolp) (setq off 1)) (unless (eolp) (skip-chars-backward "^ \t")) (skip-chars-backward " \t") - (setq ov (org-make-overlay (- (point) off) (point-at-eol)) - tx (concat (make-string (+ off (max 0 (- c (current-column)))) ?.) + (setq ov (org-make-overlay (1- (point)) (point-at-eol)) + tx (concat (buffer-substring (1- (point)) (point)) + (make-string (+ off (max 0 (- c (current-column)))) ?.) (org-add-props (format "%s %2d:%02d%s" (make-string l ?*) h m (make-string (- 10 l) ?\ )) @@ -5528,11 +5968,12 @@ will be easy to remove." BEG and END are ignored. If NOREMOVE is nil, remove this function from the `before-change-functions' in the current buffer." (interactive) - (mapc 'org-delete-overlay org-clock-overlays) - (setq org-clock-overlays nil) - (unless noremove - (remove-hook 'before-change-functions - 'org-remove-clock-overlays 'local))) + (unless org-inhibit-highlight-removal + (mapc 'org-delete-overlay org-clock-overlays) + (setq org-clock-overlays nil) + (unless noremove + (remove-hook 'before-change-functions + 'org-remove-clock-overlays 'local)))) (defun org-clock-out-if-current () "Clock out if the current entry contains the running clock. @@ -5557,6 +5998,112 @@ If yes, offer to stop it and to save the buffer with the changes." (when (y-or-n-p "Save changed buffer?") (save-buffer)))) +(defun org-clock-report () + "Create a table containing a report about clocked time. +If the buffer contains lines +#+BEGIN: clocktable :maxlevel 3 :emphasize nil + +#+END: clocktable +then the table will be inserted between these lines, replacing whatever +is was there before. If these lines are not in the buffer, the table +is inserted at point, surrounded by the special lines. +The BEGIN line can contain parameters. Allowed are: +:maxlevel The maximum level to be included in the table. Default is 3. +:emphasize t/nil, if levell 1 and level 2 should be bold/italic in the table." + (interactive) + (org-remove-clock-overlays) + (unless (org-find-dblock "clocktable") + (org-create-dblock (list :name "clocktable" + :maxlevel 2 :emphasize nil))) + (org-update-dblock)) + +(defun org-dblock-write:clocktable (params) + "Write the standard clocktable." + (let ((hlchars '((1 . "*") (2 . ?/))) + (emph nil) + (ins (make-marker)) + ipos time h m p level hlc hdl maxlevel) + (setq maxlevel (or (plist-get params :maxlevel) 3) + emph (plist-get params :emphasize)) + (move-marker ins (point)) + (setq ipos (point)) + (insert-before-markers "Clock summary at [" + (substring + (format-time-string (cdr org-time-stamp-formats)) + 1 -1) + "]\n|L|Headline|Time|\n") + (org-clock-sum) + (setq h (/ org-clock-file-total-minutes 60) + m (- org-clock-file-total-minutes (* 60 h))) + (insert-before-markers "|-\n|0|" "*Total file time*| " + (format "*%d:%02d*" h m) + "|\n") + (goto-char (point-min)) + (while (setq p (next-single-property-change (point) :org-clock-minutes)) + (goto-char p) + (when (setq time (get-text-property p :org-clock-minutes)) + (beginning-of-line 1) + (when (and (looking-at "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[0-9a-zA-Z_@:]+:\\)?[ \t]*$") + (setq level (- (match-end 1) (match-beginning 1))) + (<= level maxlevel)) + (setq hlc (if emph (or (cdr (assoc level hlchars)) "") "") + hdl (match-string 2) + h (/ time 60) + m (- time (* 60 h))) + (save-excursion + (goto-char ins) + (if (= level 1) (insert-before-markers "|-\n")) + (insert-before-markers + "| " (int-to-string level) "|" hlc hdl hlc " |" + (make-string (1- level) ?|) + hlc + (format "%d:%02d" h m) + hlc + " |\n"))))) + (goto-char ins) + (backward-delete-char 1) + (goto-char ipos) + (skip-chars-forward "^|") + (org-table-align))) + +(defun org-collect-clock-time-entries () + "Return an internal list with clocking information. +This list has one entry for each CLOCK interval. +FIXME: describe the elements." + (interactive) + (let ((re (concat "^[ \t]*" org-clock-string + " *\\[\\(.*?\\)\\]--\\[\\(.*?\\)\\]")) + rtn beg end next cont level title total closedp leafp + clockpos titlepos h m donep) + (save-excursion + (org-clock-sum) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (setq clockpos (match-beginning 0) + beg (match-string 1) end (match-string 2) + cont (match-end 0)) + (setq beg (apply 'encode-time (org-parse-time-string beg)) + end (apply 'encode-time (org-parse-time-string end))) + (org-back-to-heading t) + (setq donep (org-entry-is-done-p)) + (setq titlepos (point) + total (or (get-text-property (1+ (point)) :org-clock-minutes) 0) + h (/ total 60) m (- total (* 60 h)) + total (cons h m)) + (looking-at "\\(\\*+\\) +\\(.*\\)") + (setq level (- (match-end 1) (match-beginning 1)) + title (org-match-string-no-properties 2)) + (save-excursion (outline-next-heading) (setq next (point))) + (setq closedp (re-search-forward org-closed-time-regexp next t)) + (goto-char next) + (setq leafp (and (looking-at "^\\*+ ") + (<= (- (match-end 0) (point)) level))) + (push (list beg end clockpos closedp donep + total title titlepos level leafp) + rtn) + (goto-char cont))) + (nreverse rtn))) + ;;; Agenda, and Diary Integration ;;; Define the mode @@ -5616,6 +6163,7 @@ The following commands are available: (define-key org-agenda-mode-map "o" 'delete-other-windows) (define-key org-agenda-mode-map "L" 'org-agenda-recenter) (define-key org-agenda-mode-map "t" 'org-agenda-todo) +(define-key org-agenda-mode-map "a" 'org-agenda-toggle-archive-tag) (define-key org-agenda-mode-map ":" 'org-agenda-set-tags) (define-key org-agenda-mode-map "." 'org-agenda-goto-today) (define-key org-agenda-mode-map "d" 'org-agenda-day-view) @@ -5983,6 +6531,7 @@ dates." (past t) args s e rtn d emptyp) + (org-prepare-agenda-buffers org-agenda-files) (setq org-agenda-redo-command (list 'progn (list 'switch-to-buffer-other-window (current-buffer)) @@ -6077,6 +6626,7 @@ NDAYS defaults to `org-agenda-ndays'." (day-numbers (list start)) (inhibit-redisplay t) s e rtn rtnall file date d start-pos end-pos todayp nd) + (org-prepare-agenda-buffers files) (setq org-agenda-redo-command (list 'org-agenda-list (list 'quote include-all) start-day ndays t)) ;; Make the list of days @@ -6212,6 +6762,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in '(org-todo-list (or current-prefix-arg last-arg) t)) (setq files (org-agenda-files) rtnall nil) + (org-prepare-agenda-buffers files) (while (setq file (pop files)) (catch 'nextfile (org-check-agenda-file file) @@ -6820,8 +7371,11 @@ the documentation of `org-diary'." ee txt) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (when (not (and org-agenda-todo-ignore-scheduled - (save-match-data (looking-at sched-re)))) + (catch :skip + (and org-agenda-todo-ignore-scheduled + (looking-at sched-re) + (throw :skip nil)) + (org-agenda-skip) (goto-char (match-beginning 1)) (setq marker (org-agenda-new-marker (1+ (match-beginning 0))) category (org-get-category) @@ -6833,14 +7387,14 @@ the documentation of `org-diary'." (- org-todo-kwd-max-priority -2 (length (member (match-string 2) org-todo-keywords))) - 1))) + 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))) + (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 @@ -6866,50 +7420,51 @@ the documentation of `org-diary'." ee txt timestr tags) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (if (not (save-match-data (org-at-date-range-p))) - (progn - (setq marker (org-agenda-new-marker (match-beginning 0)) - category (org-get-category (match-beginning 0)) - tmp (buffer-substring (max (point-min) - (- (match-beginning 0) - org-ds-keyword-length)) - (match-beginning 0)) - timestr (buffer-substring (match-beginning 0) (point-at-eol)) - deadlinep (string-match org-deadline-regexp tmp) - scheduledp (string-match org-scheduled-regexp tmp) - donep (org-entry-is-done-p)) - (if (string-match ">" timestr) - ;; substring should only run to end of time stamp - (setq timestr (substring timestr 0 (match-end 0)))) - (save-excursion - (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) - (progn - (goto-char (match-end 1)) - (setq hdmarker (org-agenda-new-marker) - tags (org-get-tags-at)) - (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") - (setq txt (org-format-agenda-item - (format "%s%s" - (if deadlinep "Deadline: " "") - (if scheduledp "Scheduled: " "")) - (match-string 1) category tags timestr))) - (setq txt org-agenda-no-heading-message)) - (setq priority (org-get-priority txt)) - (org-add-props txt props - 'org-marker marker 'org-hd-marker hdmarker) - (if deadlinep - (org-add-props txt nil - 'face (if donep 'org-done 'org-warning) - 'undone-face 'org-warning 'done-face 'org-done - 'category category 'priority (+ 100 priority)) - (if scheduledp - (org-add-props txt nil - 'face 'org-scheduled-today - 'undone-face 'org-scheduled-today 'done-face 'org-done - 'category category 'priority (+ 99 priority)) - (org-add-props txt nil 'priority priority 'category category))) - (push txt ee)) - (outline-next-heading)))) + (catch :skip + (and (save-match-data (org-at-date-range-p)) (throw :skip nil)) + (org-agenda-skip) + (setq marker (org-agenda-new-marker (match-beginning 0)) + category (org-get-category (match-beginning 0)) + tmp (buffer-substring (max (point-min) + (- (match-beginning 0) + org-ds-keyword-length)) + (match-beginning 0)) + timestr (buffer-substring (match-beginning 0) (point-at-eol)) + deadlinep (string-match org-deadline-regexp tmp) + scheduledp (string-match org-scheduled-regexp tmp) + donep (org-entry-is-done-p)) + (if (string-match ">" timestr) + ;; substring should only run to end of time stamp + (setq timestr (substring timestr 0 (match-end 0)))) + (save-excursion + (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) + (progn + (goto-char (match-end 1)) + (setq hdmarker (org-agenda-new-marker) + tags (org-get-tags-at)) + (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") + (setq txt (org-format-agenda-item + (format "%s%s" + (if deadlinep "Deadline: " "") + (if scheduledp "Scheduled: " "")) + (match-string 1) category tags timestr))) + (setq txt org-agenda-no-heading-message)) + (setq priority (org-get-priority txt)) + (org-add-props txt props + 'org-marker marker 'org-hd-marker hdmarker) + (if deadlinep + (org-add-props txt nil + 'face (if donep 'org-done 'org-warning) + 'undone-face 'org-warning 'done-face 'org-done + 'category category 'priority (+ 100 priority)) + (if scheduledp + (org-add-props txt nil + 'face 'org-scheduled-today + 'undone-face 'org-scheduled-today 'done-face 'org-done + 'category category 'priority (+ 99 priority)) + (org-add-props txt nil 'priority priority 'category category))) + (push txt ee)) + (outline-next-heading))) (nreverse ee))) (defun org-agenda-get-closed () @@ -6933,35 +7488,35 @@ the documentation of `org-diary'." ee txt timestr) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (if (not (save-match-data (org-at-date-range-p))) - (progn - (setq marker (org-agenda-new-marker (match-beginning 0)) - closedp (equal (match-string 1) org-closed-string) - category (org-get-category (match-beginning 0)) - timestr (buffer-substring (match-beginning 0) (point-at-eol)) - ;; donep (org-entry-is-done-p) - ) - (if (string-match "\\]" timestr) - ;; substring should only run to end of time stamp - (setq timestr (substring timestr 0 (match-end 0)))) - (save-excursion - (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) - (progn - (goto-char (match-end 1)) - (setq hdmarker (org-agenda-new-marker) - tags (org-get-tags-at)) - (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") - (setq txt (org-format-agenda-item - (if closedp "Closed: " "Clocked: ") - (match-string 1) category tags timestr))) - (setq txt org-agenda-no-heading-message)) - (setq priority 100000) - (org-add-props txt props - 'org-marker marker 'org-hd-marker hdmarker 'face 'org-done - 'priority priority 'category category - 'undone-face 'org-warning 'done-face 'org-done) - (push txt ee)) - (outline-next-heading)))) + (catch :skip + (org-agenda-skip) + (setq marker (org-agenda-new-marker (match-beginning 0)) + closedp (equal (match-string 1) org-closed-string) + category (org-get-category (match-beginning 0)) + timestr (buffer-substring (match-beginning 0) (point-at-eol)) + ;; donep (org-entry-is-done-p) + ) + (if (string-match "\\]" timestr) + ;; substring should only run to end of time stamp + (setq timestr (substring timestr 0 (match-end 0)))) + (save-excursion + (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) + (progn + (goto-char (match-end 1)) + (setq hdmarker (org-agenda-new-marker) + tags (org-get-tags-at)) + (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") + (setq txt (org-format-agenda-item + (if closedp "Closed: " "Clocked: ") + (match-string 1) category tags timestr))) + (setq txt org-agenda-no-heading-message)) + (setq priority 100000) + (org-add-props txt props + 'org-marker marker 'org-hd-marker hdmarker 'face 'org-done + 'priority priority 'category category + 'undone-face 'org-warning 'done-face 'org-done) + (push txt ee)) + (outline-next-heading))) (nreverse ee))) (defun org-agenda-get-deadlines () @@ -6980,41 +7535,43 @@ the documentation of `org-diary'." ee txt head face) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (setq pos (1- (match-beginning 1)) - d2 (time-to-days - (org-time-string-to-time (match-string 1))) - diff (- d2 d1)) - ;; When to show a deadline in the calendar: - ;; If the expiration is within wdays warning time. - ;; Past-due deadlines are only shown on the current date - (if (and (< diff wdays) todayp (not (= diff 0))) - (save-excursion - (setq category (org-get-category)) - (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) - (progn - (goto-char (match-end 0)) - (setq pos1 (match-end 1)) - (setq tags (org-get-tags-at pos1)) - (setq head (buffer-substring-no-properties - (point) - (progn (skip-chars-forward "^\r\n") - (point)))) - (if (string-match org-looking-at-done-regexp head) - (setq txt nil) - (setq txt (org-format-agenda-item - (format "In %3d d.: " diff) head category tags)))) - (setq txt org-agenda-no-heading-message)) - (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 face 'undone-face face 'done-face 'org-done) - (push txt ee))))) + (catch :skip + (org-agenda-skip) + (setq pos (1- (match-beginning 1)) + d2 (time-to-days + (org-time-string-to-time (match-string 1))) + diff (- d2 d1)) + ;; When to show a deadline in the calendar: + ;; If the expiration is within wdays warning time. + ;; Past-due deadlines are only shown on the current date + (if (and (< diff wdays) todayp (not (= diff 0))) + (save-excursion + (setq category (org-get-category)) + (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) + (progn + (goto-char (match-end 0)) + (setq pos1 (match-end 1)) + (setq tags (org-get-tags-at pos1)) + (setq head (buffer-substring-no-properties + (point) + (progn (skip-chars-forward "^\r\n") + (point)))) + (if (string-match org-looking-at-done-regexp head) + (setq txt nil) + (setq txt (org-format-agenda-item + (format "In %3d d.: " diff) head category tags)))) + (setq txt org-agenda-no-heading-message)) + (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 face 'undone-face face 'done-face 'org-done) + (push txt ee)))))) ee)) (defun org-agenda-get-scheduled () @@ -7035,36 +7592,38 @@ the documentation of `org-diary'." ee txt head) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (setq pos (1- (match-beginning 1)) - d2 (time-to-days - (org-time-string-to-time (match-string 1))) - diff (- d2 d1)) - ;; When to show a scheduled item in the calendar: - ;; If it is on or past the date. - (if (and (< diff 0) todayp) - (save-excursion - (setq category (org-get-category)) - (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) - (progn - (goto-char (match-end 0)) - (setq pos1 (match-end 1)) - (setq tags (org-get-tags-at)) - (setq head (buffer-substring-no-properties - (point) - (progn (skip-chars-forward "^\r\n") (point)))) - (if (string-match org-looking-at-done-regexp head) - (setq txt nil) - (setq txt (org-format-agenda-item - (format "Sched.%2dx: " (- 1 diff)) head - category tags)))) - (setq txt org-agenda-no-heading-message)) - (when txt - (org-add-props txt props - 'org-marker (org-agenda-new-marker pos) - 'org-hd-marker (org-agenda-new-marker pos1) - 'priority (+ (- 5 diff) (org-get-priority txt)) - 'category category) - (push txt ee))))) + (catch :skip + (org-agenda-skip) + (setq pos (1- (match-beginning 1)) + d2 (time-to-days + (org-time-string-to-time (match-string 1))) + diff (- d2 d1)) + ;; When to show a scheduled item in the calendar: + ;; If it is on or past the date. + (if (and (< diff 0) todayp) + (save-excursion + (setq category (org-get-category)) + (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) + (progn + (goto-char (match-end 0)) + (setq pos1 (match-end 1)) + (setq tags (org-get-tags-at)) + (setq head (buffer-substring-no-properties + (point) + (progn (skip-chars-forward "^\r\n") (point)))) + (if (string-match org-looking-at-done-regexp head) + (setq txt nil) + (setq txt (org-format-agenda-item + (format "Sched.%2dx: " (- 1 diff)) head + category tags)))) + (setq txt org-agenda-no-heading-message)) + (when txt + (org-add-props txt props + 'org-marker (org-agenda-new-marker pos) + 'org-hd-marker (org-agenda-new-marker pos1) + 'priority (+ (- 5 diff) (org-get-priority txt)) + 'category category) + (push txt ee)))))) ee)) (defun org-agenda-get-blocks () @@ -7081,34 +7640,36 @@ the documentation of `org-diary'." marker hdmarker ee txt d1 d2 s1 s2 timestr category tags) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (setq timestr (match-string 0) - s1 (match-string 1) - s2 (match-string 2) - d1 (time-to-days (org-time-string-to-time s1)) - d2 (time-to-days (org-time-string-to-time s2))) - (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) - ;; Only allow days between the limits, because the normal - ;; date stamps will catch the limits. - (save-excursion - (setq marker (org-agenda-new-marker (point))) - (setq category (org-get-category)) - (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) - (progn - (setq hdmarker (org-agenda-new-marker (match-end 1))) - (goto-char (match-end 1)) - (setq tags (org-get-tags-at)) - (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") - (setq txt (org-format-agenda-item - (format (if (= d1 d2) "" "(%d/%d): ") - (1+ (- d0 d1)) (1+ (- d2 d1))) - (match-string 1) category tags - (if (= d0 d1) timestr)))) - (setq txt org-agenda-no-heading-message)) - (org-add-props txt props - 'org-marker marker 'org-hd-marker hdmarker - 'priority (org-get-priority txt) 'category category) - (push txt ee))) - (outline-next-heading)) + (catch :skip + (org-agenda-skip) + (setq timestr (match-string 0) + s1 (match-string 1) + s2 (match-string 2) + d1 (time-to-days (org-time-string-to-time s1)) + d2 (time-to-days (org-time-string-to-time s2))) + (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) + ;; Only allow days between the limits, because the normal + ;; date stamps will catch the limits. + (save-excursion + (setq marker (org-agenda-new-marker (point))) + (setq category (org-get-category)) + (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) + (progn + (setq hdmarker (org-agenda-new-marker (match-end 1))) + (goto-char (match-end 1)) + (setq tags (org-get-tags-at)) + (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") + (setq txt (org-format-agenda-item + (format (if (= d1 d2) "" "(%d/%d): ") + (1+ (- d0 d1)) (1+ (- d2 d1))) + (match-string 1) category tags + (if (= d0 d1) timestr)))) + (setq txt org-agenda-no-heading-message)) + (org-add-props txt props + 'org-marker marker 'org-hd-marker hdmarker + 'priority (org-get-priority txt) 'category category) + (push txt ee))) + (outline-next-heading))) ;; Sort the entries by expiration date. (nreverse ee))) @@ -7709,9 +8270,7 @@ be used to request time specification in the time stamp." (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)) - (hdmarker (get-text-property (point) 'org-hd-marker))) + (pos (marker-position marker))) (with-current-buffer (marker-buffer marker) (widen) (goto-char pos) @@ -7877,53 +8436,59 @@ are included in the output." lspos tags tags-list tags-alist (llast 0) rtn level category i txt todo marker) - (save-excursion (goto-char (point-min)) (when (eq action 'sparse-tree) (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))) - (goto-char (setq lspos (1+ (match-beginning 0)))) - (setq level (funcall outline-level) - category (org-get-category)) - (setq i llast llast level) - ;; remove tag lists from same and sublevels - (while (>= i level) - (when (setq entry (assoc i tags-alist)) - (setq tags-alist (delete entry tags-alist))) - (setq i (1- i))) - ;; add the nex tags - (when tags - (setq tags (mapcar 'downcase (org-split-string tags ":")) - tags-alist - (cons (cons level tags) tags-alist))) - ;; compile tags for current headline - (setq tags-list - (if org-use-tag-inheritance - (apply 'append (mapcar 'cdr tags-alist)) - tags)) - (when (and (or (not todo-only) todo) - (eval matcher)) - ;; list this headline - (if (eq action 'sparse-tree) - (progn - (org-show-hierarchy-above)) - (setq txt (org-format-agenda-item - "" - (concat - (if org-tags-match-list-sublevels - (make-string (1- level) ?.) "") - (org-get-heading)) - category tags-list)) - (goto-char lspos) - (setq marker (org-agenda-new-marker)) - (org-add-props txt props - 'org-marker marker 'org-hd-marker marker 'category category) - (push txt rtn)) - ;; if we are to skip sublevels, jump to end of subtree - (point) - (or org-tags-match-list-sublevels (org-end-of-subtree))))) + (catch :skip + (and (eq action 'agenda) (org-agenda-skip)) + (setq todo (if (match-end 1) (match-string 2)) + tags (if (match-end 4) (match-string 4))) + (goto-char (setq lspos (1+ (match-beginning 0)))) + (setq level (funcall outline-level) + category (org-get-category)) + (setq i llast llast level) + ;; remove tag lists from same and sublevels + (while (>= i level) + (when (setq entry (assoc i tags-alist)) + (setq tags-alist (delete entry tags-alist))) + (setq i (1- i))) + ;; add the nex tags + (when tags + (setq tags (mapcar 'downcase (org-split-string tags ":")) + tags-alist + (cons (cons level tags) tags-alist))) + ;; compile tags for current headline + (setq tags-list + (if org-use-tag-inheritance + (apply 'append (mapcar 'cdr tags-alist)) + tags)) + (when (and (or (not todo-only) todo) + (eval matcher) + (or (not org-agenda-skip-archived-trees) + (not (member org-archive-tag tags-list)))) + ;; list this headline + (if (eq action 'sparse-tree) + (progn + (org-show-hierarchy-above)) + (setq txt (org-format-agenda-item + "" + (concat + (if org-tags-match-list-sublevels + (make-string (1- level) ?.) "") + (org-get-heading)) + category tags-list)) + (goto-char lspos) + (setq marker (org-agenda-new-marker)) + (org-add-props txt props + 'org-marker marker 'org-hd-marker marker 'category category) + (push txt rtn)) + ;; if we are to skip sublevels, jump to end of subtree + (point) + (or org-tags-match-list-sublevels (org-end-of-subtree)))))) + (when (and (eq action 'sparse-tree) + (not org-sparse-tree-open-archived-trees)) + (org-hide-archived-subtrees (point-min) (point-max))) (nreverse rtn))) (defun org-tags-sparse-tree (&optional arg match) @@ -7994,6 +8559,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (list 'if 'current-prefix-arg nil match) t)) (setq files (org-agenda-files) rtnall nil) + (org-prepare-agenda-buffers files) (while (setq file (pop files)) (catch 'nextfile (org-check-agenda-file file) @@ -8084,7 +8650,11 @@ With prefix ARG, realign all tags in headings in the current buffer." (setq hd (match-string 1)) (delete-region (match-beginning 0) (match-end 0)) (insert-before-markers (org-trim hd) (if empty "" " "))) - (unless (equal tags "") + (if (equal tags "") + (save-excursion + (beginning-of-line 1) + (and (re-search-forward "[ \t]+$" (point-at-eol) t) + (replace-match ""))) (move-to-column (max (current-column) (if (> org-tags-column 0) org-tags-column @@ -8590,7 +9160,7 @@ in all files." (defun org-search-not-link (&rest args) "Execute `re-search-forward', but only accept matches that are not a link." (catch 'exit - (let ((pos (point)) p1) + (let (p1) (while (apply 're-search-forward args) (setq p1 (point)) (if (not (save-match-data @@ -8990,24 +9560,23 @@ If the file does not exist, an error is thrown." (setq in-emacs (or in-emacs line search)) (let* ((file (if (equal path "") buffer-file-name - (convert-standard-filename (org-expand-file-name path)))) - (dirp (file-directory-p file)) + path)) + (apps (append org-file-apps (org-default-apps))) + (remp (and (assq 'remote apps) (org-file-remote-p file))) + (dirp (if remp nil (file-directory-p file))) (dfile (downcase file)) (old-buffer (current-buffer)) (old-pos (point)) (old-mode major-mode) - ext cmd apps) - (if (and (not (file-exists-p file)) - (not org-open-non-existing-files)) - (error "No such file: %s" file)) + ext cmd) (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile) (setq ext (match-string 1 dfile)) (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile) (setq ext (match-string 1 dfile)))) - (setq apps (append org-file-apps (org-default-apps))) (if in-emacs (setq cmd 'emacs) - (setq cmd (or (and dirp (cdr (assoc 'directory apps))) + (setq cmd (or (and remp (cdr (assoc 'remote apps))) + (and dirp (cdr (assoc 'directory apps))) (cdr (assoc ext apps)) (cdr (assoc t apps))))) (when (eq cmd 'mailcap) @@ -9018,6 +9587,10 @@ If the file does not exist, an error is thrown." (if (stringp command) (setq cmd command) (setq cmd 'emacs)))) + (if (and (not (eq cmd 'emacs)) ; Emacs has not problems with non-ex files + (not (file-exists-p file)) + (not org-open-non-existing-files)) + (error "No such file: %s" file)) (cond ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) ;; Normalize use of quote, this can vary. @@ -9028,8 +9601,9 @@ If the file does not exist, an error is thrown." (shell-command (concat cmd " &")))) ((or (stringp cmd) (eq cmd 'emacs)) - (unless (equal (file-truename file) (file-truename (or buffer-file-name ""))) - (funcall (cdr (assq 'file org-link-frame-setup)) file)) +; (unless (equal (file-truename file) (file-truename (or buffer-file-name ""))) +; (funcall (cdr (assq 'file org-link-frame-setup)) file)) + (funcall (cdr (assq 'file org-link-frame-setup)) file) (if line (goto-line line) (if search (org-link-search search)))) ((consp cmd) @@ -9053,6 +9627,20 @@ If the file does not exist, an error is thrown." "Replace special path abbreviations and expand the file name." (expand-file-name path)) +(defun org-file-remote-p (file) + "Test whether FILE specifies a location on a remote system. +Return non-nil if the location is indeed remote. + +For example, the filename \"/user@host:/foo\" specifies a location +on the system \"/user@host:\"." + (cond ((fboundp 'file-remote-p) + (file-remote-p file)) + ((fboundp 'tramp-handle-file-remote-p) + (tramp-handle-file-remote-p file)) + ((and (boundp 'ange-ftp-name-format) + (string-match ange-ftp-name-format file)) + t) + (t nil))) (defvar org-insert-link-history nil "Minibuffer history for links inserted with `org-insert-link'.") @@ -9186,8 +9774,8 @@ For file links, arg negates `org-context-in-file-links'." (setq cpltxt (url-view-url t) link (org-make-link cpltxt))) ((eq major-mode 'w3m-mode) - (setq cpltxt w3m-current-url - link (org-make-link cpltxt))) + (setq cpltxt (or w3m-current-title w3m-current-url) + link (org-make-link w3m-current-url))) ((setq search (run-hook-with-args-until-success 'org-create-file-search-functions)) @@ -9195,6 +9783,11 @@ For file links, arg negates `org-context-in-file-links'." "::" search)) (setq cpltxt (or description link))) + ((eq major-mode 'image-mode) + (setq cpltxt (concat "file:" + (abbreviate-file-name buffer-file-name)) + link (org-make-link cpltxt))) + ((eq major-mode 'org-mode) ;; Just link to current headline (setq cpltxt (concat "file:" @@ -9414,7 +10007,9 @@ subdirectory. Otherwise, the link will be the absolute path as completed in the minibuffer (i.e. normally ~/path/to/file). With two \\[universal-argument] prefixes, enforce an absolute path even if the file -is in the current directory or below." +is in the current directory or below. +With three \\[universal-argument] prefixes, negate the meaning of +`org-keep-stored-link-after-insertion'." (interactive "P") (let (link desc entry remove file (pos (point))) (cond @@ -9430,7 +10025,7 @@ is in the current directory or below." (setq link (read-string "Link: " (org-link-unescape (org-match-string-no-properties 1))))) - (complete-file + ((equal complete-file '(4)) ;; Completing read for file names. (setq file (read-file-name "File: ")) (let ((pwd (file-name-as-directory (expand-file-name "."))) @@ -9455,7 +10050,8 @@ is in the current directory or below." org-insert-link-history (or (car (car org-stored-links))))) (setq entry (assoc link org-stored-links)) - (if (not org-keep-stored-link-after-insertion) + (if (funcall (if (equal complete-file '(64)) 'not 'identity) + (not org-keep-stored-link-after-insertion)) (setq org-stored-links (delq (assoc link org-stored-links) org-stored-links))) (setq link (if entry (nth 1 entry) link) @@ -9908,7 +10504,7 @@ This is being used to correctly align a single field after TAB or RET.") (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) (colpos (org-table-current-column)) (winstart (window-start)) - text lines (new "") lengths l typenums ty fields maxfields i + lines (new "") lengths l typenums ty fields maxfields i column (indent "") cnt frac rfmt hfmt @@ -9919,7 +10515,7 @@ This is being used to correctly align a single field after TAB or RET.") (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) (hfmt1 (concat (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) - emptystrings xx links narrow fmax fmin f1 len c e) + emptystrings links narrow fmax f1 len c e) (untabify beg end) (remove-text-properties beg end '(org-cwidth t display t)) ;; Check if we have links @@ -12055,9 +12651,11 @@ overwritten, and the table is not marked as requiring realignment." (:headline-levels . org-export-headline-levels) (:section-numbers . org-export-with-section-numbers) (:table-of-contents . org-export-with-toc) + (:archived-trees . org-export-with-archived-trees) (:emphasize . org-export-with-emphasize) (:sub-superscript . org-export-with-sub-superscripts) (:TeX-macros . org-export-with-TeX-macros) + (:LaTeX-fragments . org-export-with-LaTeX-fragments) (:fixed-width . org-export-with-fixed-width) (:timestamps . org-export-with-timestamps) (:tables . org-export-with-tables) @@ -12088,7 +12686,6 @@ overwritten, and the table is not marked as requiring realignment." (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) @@ -12112,7 +12709,8 @@ overwritten, and the table is not marked as requiring realignment." ("|" . :tables) ("^" . :sub-superscript) ("*" . :emphasize) - ("TeX" . :TeX-macros))) + ("TeX" . :TeX-macros) + ("LaTeX" . :LaTeX-fragments))) o) (while (setq o (pop op)) (if (string-match (concat (regexp-quote (car o)) @@ -12199,7 +12797,8 @@ ones and overrule settings in the other lists." \[X] publish... (project will be prompted for) \[A] publish all projects") (cmds - '((?v . org-export-visible) + '((?t . org-insert-export-options-template) + (?v . org-export-visible) (?a . org-export-as-ascii) (?h . org-export-as-html) (?b . org-export-as-html-and-open) @@ -12526,32 +13125,56 @@ translations. There is currently no way for users to extend this.") (defun org-cleaned-string-for-export (string &rest parameters) "Cleanup a buffer substring so that links can be created safely." (interactive) - (let* ((cb (current-buffer)) - (re-radio (and org-target-link-regexp + (let* ((re-radio (and org-target-link-regexp (concat "\\([^<]\\)\\(" org-target-link-regexp "\\)"))) (re-plain-link (concat "\\([^[<]\\)" org-plain-link-re)) (re-angle-link (concat "\\([^[]\\)" org-angle-link-re)) + (re-archive (concat ":" org-archive-tag ":")) rtn) (save-excursion (set-buffer (get-buffer-create " org-mode-tmp")) (erase-buffer) (insert string) - (org-mode) + (let ((org-inhibit-startup t)) (org-mode)) + + ;; Get rid of archived trees + (when (not (eq org-export-with-archived-trees t)) + (goto-char (point-min)) + (while (re-search-forward re-archive nil t) + (if (not (org-on-heading-p)) + (org-end-of-subtree t) + (beginning-of-line 1) + (delete-region + (if org-export-with-archived-trees (1+ (point-at-eol)) (point)) + (org-end-of-subtree))))) + ;; Find targets in comments and move them out of comments, ;; but mark them as targets that should be invisible (goto-char (point-min)) (while (re-search-forward "^#.*?\\(<<<?[^>\r\n]+>>>?\\).*" nil t) (replace-match "\\1(INVISIBLE)")) + ;; Find matches for radio targets and turn them into internal links (goto-char (point-min)) (when re-radio (while (re-search-forward re-radio nil t) (replace-match "\\1[[\\2]]"))) + ;; Find all links that contain a newline and put them into a single line (goto-char (point-min)) (while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t) (replace-match "\\1 \\3") (goto-char (match-beginning 0))) + + ;; Convert LaTeX fragments to images + (when (memq :LaTeX-fragments parameters) + (org-format-latex + (concat "ltxpng/" (file-name-sans-extension + (file-name-nondirectory + org-current-export-file))) + org-current-export-dir nil "Creating LaTeX image %s")) + (message "Expriting...") + ;; Normalize links: Convert angle and plain links into bracket links (goto-char (point-min)) (while (re-search-forward re-plain-link nil t) @@ -12565,8 +13188,9 @@ translations. There is currently no way for users to extend this.") (concat (match-string 1) "[[" (match-string 2) ":" (match-string 3) "]]") t t)) + ;; Find multiline emphasis and put them into single line - (when (assq :emph-multiline parameters) + (when (memq :emph-multiline parameters) (goto-char (point-min)) (while (re-search-forward org-emph-re nil t) (subst-char-in-region (match-beginning 0) (match-end 0) ?\n ?\ t) @@ -12671,7 +13295,6 @@ underlined headlines. The default is 3." (title (or (plist-get opt-plist :title) (file-name-sans-extension (file-name-nondirectory buffer-file-name)))) - (options nil) (email (plist-get opt-plist :email)) (language (plist-get opt-plist :language)) (text nil) @@ -12772,7 +13395,7 @@ underlined headlines. The default is 3." (normal-mode) (save-buffer) ;; remove display and invisible chars - (let (beg end s) + (let (beg end) (goto-char (point-min)) (while (setq beg (next-single-property-change (point) 'display)) (setq end (next-single-property-change beg 'display)) @@ -12849,22 +13472,27 @@ underlined headlines. The default is 3." (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 +TYPE is the final key (as a string) that also select the export command in +the `C-c C-e' export dispatcher. +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))) + (read-char-exclusive)) current-prefix-arg)) - (if (not (member type '("a" "\C-a" "b" "\C-b" "h" "x" " "))) + (if (not (member type '(?a ?\C-a ?b ?\C-b ?h ?x ?\ ))) (error "Invalid export key")) - ;; FIXME: do this more explicit? - (let* ((binding (key-binding (concat "\C-c\C-x" type))) - (keepp (equal type " ")) + (let* ((binding (cdr (assoc type + '((?a . org-export-as-ascii) + (?\C-a . org-export-as-ascii) + (?b . org-export-as-html-and-open) + (?\C-b . org-export-as-html-and-open) + (?h . org-export-as-html) + (?x . org-export-as-xoxo))))) + (keepp (equal type ?\ )) (file buffer-file-name) (buffer (get-buffer-create "*Org Export Visible*")) s e) @@ -12925,7 +13553,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." #+EMAIL: %s #+LANGUAGE: %s #+TEXT: Some descriptive text to be emitted. Several lines OK. -#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s *:%s TeX:%s +#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s *:%s TeX:%s LaTeX:%s #+CATEGORY: %s #+SEQ_TODO: %s #+TYP_TODO: %s @@ -12944,6 +13572,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." org-export-with-sub-superscripts org-export-with-emphasize org-export-with-TeX-macros + org-export-with-LaTeX-fragments (file-name-nondirectory buffer-file-name) (if (equal org-todo-interpretation 'sequence) (mapconcat 'identity org-todo-keywords " ") @@ -13041,6 +13670,7 @@ 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") + (message "Exporting...") (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) @@ -13049,16 +13679,24 @@ org-mode's default settings, but still inferior to file-local settings." (org-infile-export-plist))) (style (plist-get opt-plist :style)) + (link-validate (plist-get opt-plist :link-validation-function)) + valid (odd org-odd-levels-only) (region-p (org-region-active-p)) (region (buffer-substring (if region-p (region-beginning) (point-min)) (if region-p (region-end) (point-max)))) + ;; The following two are dynamically scoped into other + ;; routines below. + (org-current-export-dir (org-export-directory :html opt-plist)) + (org-current-export-file buffer-file-name) (all_lines (org-skip-comments (org-split-string (org-cleaned-string-for-export - region :emph-multiline) + region :emph-multiline + (if (plist-get opt-plist :LaTeX-fragments) + :LaTeX-fragments)) "[\r\n]"))) (lines (org-export-find-first-heading-line all_lines)) (level 0) (line "") (origline "") txt todo @@ -13068,6 +13706,7 @@ org-mode's default settings, but still inferior to file-local settings." (file-name-sans-extension (file-name-nondirectory buffer-file-name)) ".html")) + (current-dir (file-name-directory buffer-file-name)) (buffer (find-file-noselect filename)) (levels-open (make-vector org-level-max nil)) (date (format-time-string "%Y/%m/%d" (current-time))) @@ -13314,6 +13953,10 @@ lang=\"%s\" xml:lang=\"%s\"> (if (string-match "::\\(.*\\)" filename) (setq search (match-string 1 filename) filename (replace-match "" t nil filename))) + (setq valid + (if (functionp link-validate) + (funcall link-validate filename current-dir) + t)) (setq file-is-image-p (string-match (org-image-file-name-regexp) filename)) (setq thefile (if abs-p (expand-file-name filename) filename)) @@ -13339,7 +13982,8 @@ lang=\"%s\" xml:lang=\"%s\"> (and org-export-html-inline-images (not descp)))) (concat "<img src=\"" thefile "\"/>") - (concat "<a href=\"" thefile "\">" desc "</a>"))))) + (concat "<a href=\"" thefile "\">" desc "</a>"))) + (if (not valid) (setq rpl desc)))) ((member type '("bbdb" "vm" "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp")) (setq rpl (concat "<i><" type ":" (save-match-data (org-link-unescape path)) @@ -13497,7 +14141,9 @@ lang=\"%s\" xml:lang=\"%s\"> (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t) (replace-match "")) (save-buffer) - (goto-char (point-min))))) + (goto-char (point-min)) + (message "Exporting... done")))) + (defun org-format-table-html (lines olines) "Find out which HTML converter to use and return the HTML code." @@ -13650,27 +14296,31 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used." (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))) + (catch 'exit + (let (r b) + (while (string-match org-maybe-keyword-time-regexp s) + ;; FIXME: is it good to never export CLOCK, or do we need control? + (if (and (match-end 1) (equal (match-string 1 s) org-clock-string)) + (throw 'exit "")) + (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 if 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 > @@ -14147,6 +14797,255 @@ a time), or the day by one (if it does not contain a time)." (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d")) (concat keyword (format-time-string fmt time)))) +;;; LaTeX stuff + +(defvar org-cdlatex-mode-map (make-sparse-keymap) + "Keymap for the minor `org-cdlatex-mode'.") + +(define-key org-cdlatex-mode-map "_" 'org-cdlatex-underscore-caret) +(define-key org-cdlatex-mode-map "^" 'org-cdlatex-underscore-caret) +(define-key org-cdlatex-mode-map "`" 'cdlatex-math-symbol) +(define-key org-cdlatex-mode-map "'" 'org-cdlatex-math-modify) +(define-key org-cdlatex-mode-map "\C-c{" 'cdlatex-environment) + +(defvar org-cdlatex-texmathp-advice-is-done nil + "Flag remembering if we have applied the advice to texmathp already.") + +(define-minor-mode org-cdlatex-mode + "Toggle the minor `org-cdlatex-mode'. +This mode supports entering LaTeX environment and math in LaTeX fragments +in Org-mode. +\\{org-cdlatex-mode-map}" + nil " CDLtx" nil + (when org-cdlatex-mode (require 'cdlatex)) + (unless org-cdlatex-texmathp-advice-is-done + (setq org-cdlatex-texmathp-advice-is-done t) + (defadvice texmathp (around org-math-always-on activate) + "Always return t in org-mode buffers. +This is because we want to insert math symbols without dollars even outside +the LaTeX math segments. +\\[org-cdlatex-mode-map]" + (interactive) + (if (or (not (eq major-mode 'org-mode)) + (org-inside-LaTeX-fragment-p)) + ad-do-it + (if (eq this-command 'cdlatex-math-symbol) + (setq ad-return-value t)))))) + +(defun org-inside-LaTeX-fragment-p () + "Test if point is inside a LaTeX fragment. I.e. after a \\begin, \\(, \\[, $, or $$, withoout the corresponding closing +sequence appearing also before point." + (let ((pos (point)) + (lim (progn + (re-search-backward (concat "^\\(" paragraph-start "\\)") nil t) + (point))) + dollar-on p1) + (goto-char pos) + (if (re-search-backward "\\(\\\\begin{\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\)" lim t) + (progn + (goto-char pos) + (cond + ((match-beginning 1) (match-beginning 0)) + ((match-beginning 2) nil) + (t (while (re-search-backward "\\$" lim t) + (setq dollar-on (not dollar-on)) + (if (= (char-before) ?$) (backward-char 1)) + (setq p1 (or p1 (point)))) + (goto-char pos) + (if dollar-on p1)))) + (goto-char pos) + nil))) + +(defun org-try-cdlatex-tab () + "Check if it makes sense to execute `cdlatex-tab', and do it if yes. +It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is + - inside a LaTeX fragment, or + - after the first word in a line, where an abbreviation expansion could + insert a LaTeX environment." + ;; FIXME: This may still need refinement. + (when org-cdlatex-mode + (cond + ((save-excursion + (skip-chars-backward "a-zA-Z0-9*") + (skip-chars-backward " \t") + (bolp)) + (cdlatex-tab) t) + ((org-inside-LaTeX-fragment-p) + (cdlatex-tab) t) + (t nil)))) + +(defun org-cdlatex-underscore-caret (&optional arg) + "Execute `cdlatex-sub-superscript' in LaTeX fragments. +Revert to the normal definition outside of these fragments." + (interactive "P") + (if (org-inside-LaTeX-fragment-p) + (call-interactively 'cdlatex-sub-superscript) + (let (org-cdlatex-mode) + (call-interactively (key-binding (vector last-input-event)))))) + +(defun org-cdlatex-math-modify (&optional arg) + "Execute `cdlatex-math-modify' in LaTeX fragments. +Revert to the normal definition outside of these fragments." + (interactive "P") + (if (org-inside-LaTeX-fragment-p) + (call-interactively 'cdlatex-math-modify) + (let (org-cdlatex-mode) + (call-interactively (key-binding (vector last-input-event)))))) + +(defvar org-latex-fragment-image-overlays nil + "List of overlays carrying the images of latex fragments.") +(make-variable-buffer-local 'org-latex-fragment-image-overlays) + +(defun org-remove-latex-fragment-image-overlays () + "Remove all overlays with LaTeX fragment images in current buffer." + (mapc 'org-delete-overlay org-latex-fragment-image-overlays) + (setq org-latex-fragment-image-overlays nil)) + +(defun org-preview-latex-fragment (&optional subtree) + "Preview the LaTeX fragment at point, or all locally or globally. +If the cursor is in a LaTeX fragment, create the image and overlay +it over the source code. If there is no fragment at point, display +all fragments in the current text, from one headline to the next. With +prefix SUBTREE, display all fragments in the current subtree. With a +double prefix `C-u C-u', or when the cursor is before the first headline, +display all fragments in the buffer. +The images can be removed again with \\[org-ctrl-c-ctrl-c]." + (interactive "P") + (org-remove-latex-fragment-image-overlays) + (save-excursion + (save-restriction + (let (beg end at msg) + (cond + ((or (equal subtree '(16)) + (not (save-excursion + (re-search-backward (concat "^" outline-regexp) nil t)))) + (setq beg (point-min) end (point-max) + msg "Creating images for buffer...%s")) + ((equal subtree '(4)) + (org-back-to-heading) + (setq beg (point) end (org-end-of-subtree) + msg "Creating images for subtree...%s")) + (t + (if (setq at (org-inside-LaTeX-fragment-p)) + (goto-char (max (point-min) (- at 2))) + (org-back-to-heading)) + (setq beg (point) end (progn (outline-next-heading) (point)) + msg (if at "Creating image...%s" + "Creating images for entry...%s")))) + (message msg "") + (narrow-to-region beg end) + (org-format-latex + (concat "ltxpng/" (file-name-sans-extension + (file-name-nondirectory + buffer-file-name))) + default-directory 'overlays msg at) + (message msg "done. Use `C-c C-c' to remove images."))))) + +(defun org-format-latex (prefix &optional dir overlays msg at) + "Replace LaTeX fragments with links to an image, and produce images." + (if (and overlays (fboundp 'clear-image-cache)) (clear-image-cache)) + (let* ((prefixnodir (file-name-nondirectory prefix)) + (absprefix (expand-file-name prefix dir)) + (todir (file-name-directory absprefix)) + (opt org-format-latex-options) + (matchers (plist-get opt :matchers)) + (re-list + '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) + ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil) + ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) + ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 t) + ("$$" "\\$\\$[^\000]*?\\$\\$" 0 t))) + (cnt 0) txt link beg end re e oldfiles + m n block linkfile movefile ov) + ;; Make sure the directory exists + (or (file-directory-p todir) (make-directory todir)) + ;; Check if there are old images files with this prefix, and remove them + (setq oldfiles (directory-files + todir 'full + (concat (regexp-quote prefixnodir) "_[0-9]+\\.png$"))) + (while oldfiles (delete-file (pop oldfiles))) + ;; Check the different regular expressions + (while (setq e (pop re-list)) + (setq m (car e) re (nth 1 e) n (nth 2 e) + block (if (nth 3 e) "\n\n" "")) + (when (member m matchers) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (when (or (not at) (equal at (match-beginning n))) + (setq txt (match-string n) + beg (match-beginning n) end (match-end n) + cnt (1+ cnt) + linkfile (format "%s_%04d.png" prefix cnt) + movefile (format "%s_%04d.png" absprefix cnt) + link (concat block "[[file:" linkfile "]]" block)) + (if msg (message msg cnt)) + (goto-char beg) + (org-create-formula-image + txt movefile opt) + (if overlays + (progn + (setq ov (org-make-overlay beg end)) + (if (featurep 'xemacs) + (progn + (org-overlay-put ov 'invisible t) + (org-overlay-put + ov 'end-glyph + (make-glyph (vector 'png :file movefile)))) + (org-overlay-put + ov 'display + (list 'image :type 'png :file movefile :ascent 'center))) + (push ov org-latex-fragment-image-overlays) + (goto-char end)) + (delete-region beg end) + (insert link)))))))) + +;; This function borrows from Ganesh Swami's latex2png.el +(defun org-create-formula-image (string tofile options) + (let* ((tmpdir (if (featurep 'xemacs) + (temp-directory) + temporary-file-directory)) + (texfilebase (make-temp-name + (expand-file-name "orgtex" tmpdir))) + +;(texfilebase (make-temp-file "orgtex")) +; (dummy (delete-file texfilebase)) + (texfile (concat texfilebase ".tex")) + (dvifile (concat texfilebase ".dvi")) + (pngfile (concat texfilebase ".png")) + (scale (number-to-string (* 1000 (or (plist-get options :scale) 1.0)))) + (fg (or (plist-get options :foreground) "Black")) + (bg (or (plist-get options :background) "Transparent"))) + (with-temp-file texfile + (insert "\\documentclass{article} +\\usepackage{fullpage} +\\usepackage{amssymb} +\\usepackage[usenames]{color} +\\usepackage{amsmath} +\\usepackage{latexsym} +\\usepackage[mathscr]{eucal} +\\pagestyle{empty} +\\begin{document}\n" string "\n\\end{document}\n")) + (let ((dir default-directory)) + (condition-case nil + (progn + (cd tmpdir) + (call-process "latex" nil nil nil texfile)) + (error nil)) + (cd dir)) + (if (not (file-exists-p dvifile)) + (progn (message "Failed to create dvi file from %s" texfile) nil) + (call-process "dvipng" nil nil nil + "-E" "-fg" fg "-bg" bg + "-x" scale "-y" scale "-T" "tight" + "-o" pngfile + dvifile) + (if (not (file-exists-p pngfile)) + (progn (message "Failed to create png file from %s" texfile) nil) + ;; Use the requested file name and clean up + (copy-file pngfile tofile 'replace) + (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png") do + (delete-file (concat texfilebase e))) + pngfile)))) ;;; Key bindings @@ -14212,7 +15111,9 @@ a time), or the day by one (if it does not contain a time)." ;; All the other keys (define-key org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up. +(define-key org-mode-map "\C-xns" 'org-narrow-to-subtree) (define-key org-mode-map "\C-c$" 'org-archive-subtree) +(define-key org-mode-map "\C-c\C-x\C-a" 'org-toggle-archive-tag) (define-key org-mode-map "\C-c\C-j" 'org-goto) (define-key org-mode-map "\C-c\C-t" 'org-todo) (define-key org-mode-map "\C-c\C-s" 'org-schedule) @@ -14255,24 +15156,7 @@ a time), or the day by one (if it does not contain a time)." (define-key org-mode-map "\C-c~" 'org-table-create-with-table.el) (define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region) (define-key org-mode-map "\C-c\C-e" 'org-export) -;(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-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) -;(define-key org-mode-map "\C-c\C-xi" 'org-export-icalendar-this-file) -;(define-key org-mode-map "\C-c\C-x\C-i" 'org-export-icalendar-all-agenda-files) -;(define-key org-mode-map "\C-c\C-xc" 'org-export-icalendar-combine-agenda-files) -;(define-key org-mode-map "\C-c\C-x\C-c" 'org-export-icalendar-combine-agenda-files) -;(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-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) (define-key org-mode-map "\C-c\C-x\C-k" 'org-cut-special) (define-key org-mode-map "\C-c\C-x\C-w" 'org-cut-special) @@ -14283,15 +15167,9 @@ a time), or the day by one (if it does not contain a time)." (define-key org-mode-map "\C-c\C-x\C-o" 'org-clock-out) (define-key org-mode-map "\C-c\C-x\C-x" 'org-clock-cancel) (define-key org-mode-map "\C-c\C-x\C-d" 'org-clock-display) - -;(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) +(define-key org-mode-map "\C-c\C-x\C-r" 'org-clock-report) +(define-key org-mode-map "\C-c\C-x\C-u" 'org-dblock-update) +(define-key org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment) (when (featurep 'xemacs) (define-key org-mode-map 'button3 'popup-mode-menu)) @@ -14598,12 +15476,12 @@ This command does many different things, depending on context: (interactive "P") (let ((org-enable-table-editor t)) (cond - (org-clock-overlays + ((or org-clock-overlays org-occur-highlights + org-latex-fragment-image-overlays) (org-remove-clock-overlays) - (message "Clock overlays removed")) - (org-occur-highlights (org-remove-occur-highlights) - (message "occur highlights removed")) + (org-remove-latex-fragment-image-overlays) + (message "Temporary highlights/overlays removed from current buffer")) ((and (local-variable-p 'org-finish-function (current-buffer)) (fboundp org-finish-function)) (funcall org-finish-function)) @@ -14753,10 +15631,26 @@ See the individual commands for more information." ["Demote Heading" org-metaright (not (org-at-table-p))] ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))] "--" - ["Archive Subtree" org-archive-subtree t] - "--" ["Convert to odd levels" org-convert-to-odd-levels t] ["Convert to odd/even levels" org-convert-to-oddeven-levels t]) + ("Archive" + ["Toggle ARCHIVE tag" org-toggle-archive-tag t] + ["Check and Tag Children" (org-toggle-archive-tag (4)) + :active t :keys "C-u C-c C-x C-a"] + ["Sparse trees open ARCHIVE trees" + (setq org-sparse-tree-open-archived-trees + (not org-sparse-tree-open-archived-trees)) + :style toggle :selected org-sparse-tree-open-archived-trees] + ["Cycling opens ARCHIVE trees" + (setq org-cycle-open-archived-trees (not org-cycle-open-archived-trees)) + :style toggle :selected org-cycle-open-archived-trees] + ["Agenda includes ARCHIVE trees" + (setq org-agenda-skip-archived-trees (not org-agenda-skip-archived-trees)) + :style toggle :selected (not org-agenda-skip-archived-trees)] + "--" + ["Move Subtree to Archive" org-archive-subtree t] + ["Check and Move Children" (org-archive-subtree '(4)) + :active t :keys "C-u C-c $"]) "--" ("TODO Lists" ["TODO/DONE/-" org-todo t] @@ -14785,6 +15679,7 @@ See the individual commands for more information." ["Clock out" org-clock-out t] ["Clock cancel" org-clock-cancel t] ["Display times" org-clock-display t] + ["Create clock table" org-clock-report t] "--" ["Record DONE time" (progn (setq org-log-done (not org-log-done)) @@ -14819,6 +15714,16 @@ See the individual commands for more information." (re-search-forward "<[a-z]+:" nil t))]) "--" ["Export/Publish" org-export t] + ("LaTeX" + ["Org CDLaTeX mode" org-cdlatex-mode :style toggle + :selected org-cdlatex-mode] + ["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)] + ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)] + ["Modify math symbol" org-cdlatex-math-modify + (org-inside-LaTeX-fragment-p)] + ["Export LaTeX fragments as images" + (setq org-export-with-LaTeX-fragments (not org-export-with-LaTeX-fragments)) + :style toggle :selected org-export-with-LaTeX-fragments]) "--" ("Documentation" ["Show Version" org-version t] @@ -15012,6 +15917,7 @@ return nil." ;; In the paragraph separator we include headlines, because filling ;; text in a line directly attached to a headline would otherwise ;; fill the headline as well. + (set (make-local-variable 'comment-start-skip) "^#+[ \t]*") (set (make-local-variable 'paragraph-separate) "\f\\|\\*\\|[ ]*$\\|[ \t]*[:|]") ;; The paragraph starter includes hand-formatted lists. (set (make-local-variable 'paragraph-start) @@ -15284,7 +16190,8 @@ When ENTRY is non-nil, show the entire entry." (forward-char -1) (if (memq (preceding-char) '(?\n ?\^M)) ;; leave blank line before heading - (forward-char -1)))))) + (forward-char -1))))) + (point)) (defun org-show-subtree () "Show everything after this heading at deeper levels." @@ -15334,8 +16241,10 @@ Show the heading too, if it is currently invisible." (org-invisible-p))) (org-show-hierarchy-above))) -;;; Finish up +;;; Experimental code +;;; Finish up + (provide 'org) (run-hooks 'org-load-hook) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 8ca7c3026e8..9e78f4b6015 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -597,7 +597,7 @@ An alternative value is \" . \", if you use a font with a narrow period." (defun tex-font-lock-match-suscript (limit) "Match subscript and superscript patterns up to LIMIT." (when (re-search-forward "[_^] *\\([^\n\\{}]\\|\ -\\\\\\([a-zA-Z@]+\\|[^ \t\n]\\)\\|{[^\\{]*}\\|\\({\\)\\)" limit t) +\\\\\\([a-zA-Z@]+\\|[^ \t\n]\\)\\|\\({\\)\\)" limit t) (when (match-end 3) (let ((beg (match-beginning 3)) (end (save-restriction diff --git a/lisp/vc.el b/lisp/vc.el index 54237800e3c..c395a25798c 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -567,6 +567,13 @@ specific to any particular backend." :group 'vc :version "21.1") +(defcustom vc-diff-knows-L nil + "*Indicates whether diff understands the -L option. +The value is either `yes', `no', or nil. If it is nil, VC tries +to use -L and sets this variable to remember whether it worked." + :type '(choice (const :tag "Work out" nil) (const yes) (const no)) + :group 'vc) + (defcustom vc-allow-async-revert nil "Specifies whether the diff during \\[vc-revert-buffer] may be asynchronous. Enabling this option means that you can confirm a revert operation even @@ -1837,18 +1844,36 @@ actually call the backend, but performs a local diff." (vc-version-backup-file file rev2))) (coding-system-for-read (vc-coding-system-for-diff file))) (if (and file-rev1 file-rev2) - (apply 'vc-do-command "*vc-diff*" 1 "diff" nil - (append (vc-switches nil 'diff) - ;; Provide explicit labels like RCS or CVS would do - ;; so diff-mode refers to `file' rather than to - ;; `file-rev1' when trying to find/apply/undo hunks. - (list "-L" (vc-diff-label file file-rev1 rev1) - "-L" (vc-diff-label file file-rev2 rev2) - (file-relative-name file-rev1) - (file-relative-name file-rev2)))) + (let ((status + (if (eq vc-diff-knows-L 'no) + (apply 'vc-do-command "*vc-diff*" 1 "diff" + (append (vc-switches nil 'diff) + (list (file-relative-name file-rev1) + (file-relative-name file-rev2)))) + (apply 'vc-do-command "*vc-diff*" 2 "diff" nil + (append (vc-switches nil 'diff) + ;; Provide explicit labels like RCS or + ;; CVS would do so diff-mode refers to + ;; `file' rather than to `file-rev1' + ;; when trying to find/apply/undo + ;; hunks. + (list "-L" (vc-diff-label file file-rev1 rev1) + "-L" (vc-diff-label file file-rev2 rev2) + (file-relative-name file-rev1) + (file-relative-name file-rev2))))))) + (if (eq status 2) + (if (not vc-diff-knows-L) + (setq vc-diff-knows-L 'no + status (apply 'vc-do-command "*vc-diff*" 1 "diff" + (append + (vc-switches nil 'diff) + (list (file-relative-name file-rev1) + (file-relative-name file-rev2))))) + (error "diff failed")) + (if (not vc-diff-knows-L) (setq vc-diff-knows-L 'yes))) + status) (vc-call diff file rev1 rev2)))) - (defun vc-switches (backend op) (let ((switches (or (if backend |