summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorMiles Bader <miles@gnu.org>2005-06-30 00:31:46 +0000
committerMiles Bader <miles@gnu.org>2005-06-30 00:31:46 +0000
commiteeb88b27e1dbd3f412aa684d44e4a784f6e536a2 (patch)
tree23ea1eda87f588e060b6c00e9c7ffac6a89a7e42 /lisp
parent16e1457021e3f6e3b83fc9b5262fde38b7140c96 (diff)
parent84861437f914ac45c1eea7b6477ffc4783bb3bdd (diff)
downloademacs-eeb88b27e1dbd3f412aa684d44e4a784f6e536a2.tar.gz
emacs-eeb88b27e1dbd3f412aa684d44e4a784f6e536a2.tar.bz2
emacs-eeb88b27e1dbd3f412aa684d44e4a784f6e536a2.zip
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-67
Merge from emacs--cvs-trunk--0 Patches applied: * emacs--cvs-trunk--0 (patch 447-458) - Update from CVS - Update from CVS: lisp/subr.el (add-to-ordered-list): Doc fix. - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 83-85) - Merge from emacs--cvs-trunk--0 - Update from CVS
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog261
-rw-r--r--lisp/bindings.el6
-rw-r--r--lisp/calendar/diary-lib.el2
-rw-r--r--lisp/comint.el4
-rw-r--r--lisp/cus-face.el1
-rw-r--r--lisp/emacs-lisp/autoload.el18
-rw-r--r--lisp/emacs-lisp/easy-mmode.el5
-rw-r--r--lisp/emacs-lisp/lisp-mode.el4
-rw-r--r--lisp/emacs-lisp/pp.el2
-rw-r--r--lisp/facemenu.el86
-rw-r--r--lisp/faces.el18
-rw-r--r--lisp/font-lock.el3
-rw-r--r--lisp/gnus/ChangeLog15
-rw-r--r--lisp/gnus/gnus-art.el2
-rw-r--r--lisp/gnus/gnus-nocem.el24
-rw-r--r--lisp/gnus/pgg.el3
-rw-r--r--lisp/imenu.el2
-rw-r--r--lisp/jka-compr.el10
-rw-r--r--lisp/mouse.el2
-rw-r--r--lisp/msb.el2
-rw-r--r--lisp/newcomment.el2
-rw-r--r--lisp/play/decipher.el2
-rw-r--r--lisp/progmodes/compile.el53
-rw-r--r--lisp/progmodes/cperl-mode.el15
-rw-r--r--lisp/progmodes/gud.el13
-rw-r--r--lisp/progmodes/python.el1
-rw-r--r--lisp/ps-print.el22
-rw-r--r--lisp/recentf.el285
-rw-r--r--lisp/replace.el126
-rw-r--r--lisp/simple.el14
-rw-r--r--lisp/startup.el15
-rw-r--r--lisp/subr.el38
-rw-r--r--lisp/term/rxvt.el4
-rw-r--r--lisp/term/xterm.el4
-rw-r--r--lisp/textmodes/artist.el6
-rw-r--r--lisp/textmodes/flyspell.el51
-rw-r--r--lisp/textmodes/ispell.el147
-rw-r--r--lisp/textmodes/org.el1404
-rw-r--r--lisp/textmodes/picture.el2
-rw-r--r--lisp/textmodes/texinfo.el2
-rw-r--r--lisp/url/ChangeLog22
-rw-r--r--lisp/url/url-cookie.el66
-rw-r--r--lisp/url/url-http.el7
-rw-r--r--lisp/wid-edit.el38
-rw-r--r--lisp/window.el34
45 files changed, 1908 insertions, 935 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d498e15f1d2..a446a343692 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,13 +1,248 @@
+2005-06-29 Juri Linkov <juri@jurta.org>
+
+ * faces.el (default-frame-background-mode): New internal variable.
+ (frame-set-background-mode): Use it.
+
+ * startup.el (normal-top-level): Set default-frame-background-mode
+ instead of frame-background-mode. Before setting it, test for its
+ nil value. Remove tests for frame-background-mode and frame
+ parameter `reverse'. Add test for "unspecified-fg".
+
+ * term/xterm.el (xterm-rxvt-set-background-mode):
+ * term/rxvt.el (rxvt-set-background-mode):
+ Set default-frame-background-mode instead of frame-background-mode.
+
+2005-06-29 Juanma Barranquero <lekktu@gmail.com>
+
+ * imenu.el (imenu--completion-buffer):
+ * mouse.el (mouse-buffer-menu-alist):
+ * msb.el (msb-invisible-buffer-p):
+ * calendar/diary-lib.el (diary-header-line-format):
+ * emacs-lisp/pp.el (pp-buffer):
+ * progmodes/cperl-mode.el (cperl-do-auto-fill):
+ * textmodes/picture.el (picture-replace-match):
+ Change space constants followed by a sexp to "?\s ".
+
+ * play/decipher.el (decipher-loop-with-breaks):
+ * textmodes/texinfo.el (texinfo-insert-@item): Change space
+ constants "protected" from end of line by a comment to "?\s".
+
+2005-06-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * font-lock.el (save-buffer-state): Use `declare'.
+
+ * progmodes/cperl-mode.el (cperl-find-pods-heres): Don't gratuitously
+ reset the syntax-table to cperl-mode-syntax-table.
+ (cperl-mode): Make _ into word-syntax during font-locking so "print" in
+ "foo_print_bar" is not matched as a reserved keyword.
+
+2005-06-29 Carsten Dominik <dominik@science.uva.nl>
+
+ * textmodes/org.el (orgtbl-setup): New function, for delayed
+ setup for the orgtbl commands.
+ (org-calc-default-modes): New option.
+ (orgtbl-make-binding): Use `defun' to get better help display.
+ (org-diary): Call `org-compile-prefix-format'.
+ (org-table-formula-substitute-names): New function.
+ (org-agenda-day-view, org-agenda-week-view): New commands.
+ (org-agenda-toggle-week-view): Command removed.
+ (org-tbl-menu): Split off from org-org-menu.
+ (org-mode): Move removal of outline-mode menus to here.
+ (org-table-formula-debug): New option.
+ (org-table-insert-row): Keep first field if just "#" or "*".
+ (org-mode): Paragraph regexps fixed.
+ (org-table-recalculate-regexp): New constant.
+ (org-table-justify-field-maybe): Avoid replace if not necessary.
+ (org-copy-special, org-cut-special): Use `call-interactively'.
+ (org-table-copy-region): Take region from `interactive' call.
+ (org-trim): Return string even if no match.
+ (org-formula): New face.
+ (org-set-font-lock-defaults): No longer highlight "FIXME".
+ But highlight formula-related fields in table.
+ (org-table-p): Use regexp, not fontification.
+ (org-table-align): Handle white space at end of line.
+ (org-table-formula-evaluate-inline): New option.
+ (org-mode): Auto-wrapping in comment lines turned off.
+ (org-table-copy-down): Evaluate only in copied field, not in
+ destination.
+ (org-table-current-formula): Variable removed.
+ (org-table-store-formulas, org-table-get-stored-formulas)
+ (org-table-modify-formulas, org-table-replace-in-formulas)
+ (org-table-maybe-eval-formula): New functions.
+ (org-table-get-formula): Modify to use stored formulas.
+ (org-table-insert-column, org-table-delete-column)
+ (org-table-move-column): Call `org-table-modify-formulas'.
+ (org-complete): Add completion for keyword formulas.
+ (orgtbl-mode): Pull orgtbl-mode-map to start of
+ minor-mode-map-alist.
+
+2005-06-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/python.el (python-check): Require `compile' before
+ modifying its variables.
+
+ * newcomment.el (comment-indent-default): Don't get fooled by an early
+ end of buffer.
+
+2005-06-28 Vinicius Jose Latorre <viniciusjl@ig.com.br>
+
+ * ps-print.el (ps-print-version): Fix version number.
+
+2005-06-28 Luc Teirlinck <teirllm@auburn.edu>
+
+ * textmodes/ispell.el (ispell-word): Remove stray parenthesis.
+
+2005-06-28 Richard M. Stallman <rms@gnu.org>
+
+ * textmodes/flyspell.el (flyspell-use-local-map): Variable deleted.
+ (flyspell-local-mouse-map): Declaration deleted.
+ (flyspell-mouse-map): Bind only mouse-2.
+ (flyspell-mode-map): Don't test flyspell-use-local-map.
+ (flyspell-overlay-keymap-property-name): Var deleted.
+ (flyspell-mode-on): Don't make local bindings for
+ flyspell-mouse-map and flyspell-mode-map.
+ (make-flyspell-overlay): Unconditionally put on `keymap' text prop.
+
+ * textmodes/ispell.el (ispell-word): Do not ignore short words.
+
+ * progmodes/compile.el (compilation-next-error-function):
+ Don't switch buffers; operate on the current buffer.
+
+ * facemenu.el (facemenu-add-face): Warn when font-lock is active.
+
+ * comint.el (comint-password-prompt-regexp): Accept ", try again".
+
+ * bindings.el (global-map): Bind insertchar and its variants.
+
+2005-06-27 Richard M. Stallman <rms@gnu.org>
+
+ * textmodes/artist.el (artist-text-overwrite)
+ (artist-figlet-get-extra-args, artist-text-see-thru): Use read-string.
+
+2005-06-27 Vinicius Jose Latorre <viniciusjl@ig.com.br>
+
+ * ps-print.el: It was not working the page selection for printing.
+ Reported by Sebastian Tennant <sebyte@smolny.plus.com>.
+ (ps-print-version): New version 6.6.7.
+ (ps-end-sheet): New fun.
+ (ps-header-sheet, ps-end-job): Call it.
+
+2005-06-27 Luc Teirlinck <teirllm@auburn.edu>
+
+ * subr.el (add-to-list, add-to-ordered-list): Doc fixes.
+
+2005-06-27 Lute Kamstra <lute@gnu.org>
+
+ * facemenu.el (facemenu-unlisted-faces): Add foreground and
+ background color faces.
+ (facemenu-get-face): Delete function.
+ (facemenu-set-face-from-menu): Don't call facemenu-get-face.
+ (facemenu-add-new-color): Make second argument mandatory.
+ Create the approprate face and return it. Simplify.
+ (facemenu-set-foreground, facemenu-set-background): Don't check if
+ color is defined. Use return value of facemenu-add-new-color.
+
+2005-06-26 Nick Roberts <nickrob@snap.net.nz>
+
+ * progmodes/gud.el (gud-filter): Add missing argument to
+ with-selected-window.
+
+2005-06-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/easy-mmode.el (define-minor-mode): Don't automatically add
+ a :require to the defcustom.
+
+ * emacs-lisp/autoload.el (make-autoload): Add the :setter for
+ defcustoms corresponding to minor modes.
+
+2005-06-26 David Ponce <david@dponce.com>
+
+ * recentf.el: Require tree-widget instead of wid-edit.
+ (recentf-filename-handler): Fix widget :type.
+ (recentf-cancel-dialog, recentf-open-more-files)
+ (recentf-open-files-action): Doc fix.
+ (recentf-dialog-goto-first): New function.
+ (recentf-dialog-mode-map): Set parent keymap first.
+ (recentf-dialog-mode): Define with define-derived-mode.
+ Don't display continuation lines in dialogs.
+ (recentf-edit-list): Rename from recentf-edit-selected-items.
+ (recentf-edit-list-select): Rename from recentf-edit-list-action.
+ Simplify.
+ (recentf-edit-list-validate): New function.
+ (recentf-edit-list): Update accordingly.
+ (recentf-open-files-item-shift): Remove.
+ (recentf-open-files-item): Convert menu elements into tree and
+ link widgets. Don't create the widgets.
+ (recentf-open-files): Update accordingly.
+ (recentf-save-list): Untabify.
+
+2005-06-25 Luc Teirlinck <teirllm@auburn.edu>
+
+ * replace.el (keep-lines-read-args): Add INTERACTIVE arg.
+ (keep-lines): Add INTERACTIVE arg. Never delete lines only
+ partially contained in the active region. Do not take active
+ region into account when called from Lisp, unless INTERACTIVE arg
+ is non-nil. Use `forward-line' instead of `beginning-of-line' to
+ avoid trouble with fields. Make marker point nowhere when no
+ longer used. Always return nil. Doc fix.
+ (flush-lines): Add INTERACTIVE arg. Do not take active region
+ into account when called from Lisp, unless INTERACTIVE arg is
+ non-nil. Use `forward-line' instead of `beginning-of-line' to
+ avoid trouble with fields. Make marker point nowhere when no
+ longer used. Always return nil. Doc fix.
+ (how-many): Add INTERACTIVE arg. Make RSTART and REND args
+ interchangeable. Do not take active region into account when
+ called from Lisp, unless INTERACTIVE arg is non-nil. Do not print
+ message in echo area when called from Lisp, unless INTERACTIVE arg
+ is non-nil. Avoid saying "1 occurrences". Do not use markers.
+ Return the number of matches. Doc fix.
+ (occur): Doc fix.
+ (perform-replace): Make comment follow double space convention for
+ the sake of `outline-minor-mode'.
+
+ * faces.el (facep): Doc fix.
+
+2005-06-25 Richard M. Stallman <rms@gnu.org>
+
+ * facemenu.el (facemenu-enable-faces-p): New function.
+ (facemenu-background-menu, facemenu-foreground-menu)
+ (facemenu-face-menu): Add menu-enable property.
+
+ * jka-compr.el (jka-compr-insert-file-contents):
+ Special handling if cannot find the uncompression program.
+
+ * cus-face.el (custom-face-attributes): Add autoload.
+
+ * emacs-lisp/lisp-mode.el (lisp-mode-variables):
+ Bind comment-indent-function locally.
+
+ * window.el (save-selected-window): Use save-current-buffer.
+
+ * subr.el (with-selected-window): Use save-current-buffer.
+
+ * progmodes/gud.el (gud-filter): Simplify using with-selected-window
+ and with-current-buffer.
+
+2005-06-24 Richard M. Stallman <rms@gnu.org>
+
+ * simple.el (line-move-1): Fix previous change.
+
+2005-06-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * replace.el (occur-1): Set `buffer-read-only' and the
+ buffer-modified flag before running `occur-hook' to protect
+ against unintentional buffer switches that can lead to data loss.
+
2005-06-24 Nick Roberts <nickrob@snap.net.nz>
* progmodes/gud.el (gud-tooltip-print-command): Indent properly.
(gud-gdb-marker-filter): Use font-lock-warning-face for any
initial error.
-
+
* progmodes/gdb-ui.el (gdb-send): Remove warning face from errors
after fresh input.
(gdb-var-create-handler): Put name of expression in quotes.
-
+
2005-06-23 Luc Teirlinck <teirllm@auburn.edu>
* emacs-lisp/ring.el (ring-elements): Make it return a list of the
@@ -19,7 +254,7 @@
(line-move-1): When there are overlays around, use vertical-motion.
* faces.el (escape-glyph): Use brown against light background.
- (nobreak-space): Renamed from no-break-space.
+ (nobreak-space): Rename from no-break-space.
Fix previous change.
* dired-aux.el (dired-do-copy): Fix arg prompt.
@@ -73,7 +308,7 @@
* bindings.el (propertized-buffer-identification): Use renamed
`Buffer-menu-buffer' face.
- * faces.el (vertical-border): Renamed from `vertical-divider'.
+ * faces.el (vertical-border): Rename from `vertical-divider'.
(escape-glyph): Change dark-background color back to `cyan'.
2005-06-21 Juri Linkov <juri@jurta.org>
@@ -159,8 +394,7 @@
2005-06-18 Peter Kleiweg <p.c.j.kleiweg@rug.nl>
- * progmodes/ps-mode.el: Update version and maintainer's email
- address.
+ * progmodes/ps-mode.el: Update version and maintainer's email address.
2005-06-18 Steve Youngs <steve@xemacs.org>
@@ -248,8 +482,8 @@
New backward-compatibility aliases for renamed faces.
(eshell-ls-decorated-name): Use renamed eshell-ls faces.
- * progmodes/cc-fonts.el (c-nonbreakable-space-face): Remove
- "-face" suffix from face name.
+ * progmodes/cc-fonts.el (c-nonbreakable-space-face):
+ Remove "-face" suffix from face name.
(c-cpp-matchers): Use the variable `c-nonbreakable-space-face'
instead of literal face.
@@ -377,8 +611,8 @@
ido-incomplete-regexp.
(ido-incomplete-regexp): New face.
(ido-completions): Use it.
- (ido-complete, ido-exit-minibuffer, ido-completions): Handle
- incomplete regexps.
+ (ido-complete, ido-exit-minibuffer, ido-completions):
+ Handle incomplete regexps.
(ido-completions): Add check for complete match when entering a regexp.
2005-06-15 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -407,6 +641,11 @@
* progmodes/cperl-mode.el (cperl-init-faces): Use literal cperl
faces instead of (non-existent) variables.
+2005-06-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * iswitchb.el (iswitchb-to-end): Replace mapcar with dolist.
+ (iswitchb-get-matched-buffers): Likewise. Simplify.
+
2005-06-14 Miles Bader <miles@gnu.org>
* progmodes/ld-script.el (ld-script-location-counter):
@@ -532,7 +771,7 @@
* progmodes/gdb-ui.el (menu): Re-order menu items.
(gdb-tooltip-print): Respect tooltip-use-echo-area.
-
+
* progmodes/gud.el (tooltip-use-echo-area): Remove alias.
Define in tooltip.el.
(gud-tooltip-process-output): Respect tooltip-use-echo-area.
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 2046c101640..ceab70ed6cd 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -775,6 +775,11 @@ language you are using."
(define-key global-map [insert] 'overwrite-mode)
(define-key global-map [C-insert] 'kill-ring-save)
(define-key global-map [S-insert] 'yank)
+;; `insertchar' is what term.c produces. Should we change term.c
+;; to produce `insert' instead?
+(define-key global-map [insertchar] 'overwrite-mode)
+(define-key global-map [C-insertchar] 'kill-ring-save)
+(define-key global-map [S-insertchar] 'yank)
(define-key global-map [undo] 'undo)
(define-key global-map [redo] 'repeat-complex-command)
(define-key global-map [again] 'repeat-complex-command) ; Sun keyboard
@@ -785,7 +790,6 @@ language you are using."
;; (define-key global-map [clearline] 'function-key-error)
(define-key global-map [insertline] 'open-line)
(define-key global-map [deleteline] 'kill-line)
-;; (define-key global-map [insertchar] 'function-key-error)
(define-key global-map [deletechar] 'delete-char)
;; (define-key global-map [backtab] 'function-key-error)
;; (define-key global-map [f1] 'function-key-error)
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index a0e9d1f90b7..851459fe574 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -290,7 +290,7 @@ The format of the header is specified by `diary-header-line-format'."
"Selective display active - press \"s\" in calendar \
before edit/copy"
"Diary"))
- ?\ (frame-width)))
+ ?\s (frame-width)))
"*Format of the header line displayed by `simple-diary-display'.
Only used if `diary-header-line-flag' is non-nil."
:group 'diary
diff --git a/lisp/comint.el b/lisp/comint.el
index 29208d6379c..20b365e9fe1 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -338,8 +338,8 @@ This variable is buffer-local."
"\\(\\([Oo]ld \\|[Nn]ew \\|'s \\|login \\|\
Kerberos \\|CVS \\|UNIX \\| SMB \\|^\\)\
\[Pp]assword\\( (again)\\)?\\|\
-pass phrase\\|\\(Enter\\|Repeat\\) passphrase\\)\
-\\( for [^:]+\\)?:\\s *\\'"
+pass phrase\\|\\(Enter\\|Repeat\\|Bad\\) passphrase\\)\
+\\(?:, try again\\)?\\(?: for [^:]+\\)?:\\s *\\'"
"*Regexp matching prompts for passwords in the inferior process.
This is used by `comint-watch-for-password-prompt'."
:type 'regexp
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 33c8c995a4c..054ad9acaa3 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -59,6 +59,7 @@
;;; Face attributes.
+;;;###autoload
(defconst custom-face-attributes
'((:family
(string :tag "Font Family"
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 68d1287d98c..7dbf61c5bf3 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -1,7 +1,7 @@
;; autoload.el --- maintain autoloads in loaddefs.el
-;; Copyright (C) 1991,92,93,94,95,96,97, 2001,02,03,04
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 2001, 2002, 2003,
+;; 2004, 2005 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Keywords: maint
@@ -123,7 +123,17 @@ or macro definition or a defcustom)."
)
`(progn
(defvar ,varname ,init ,doc)
- (custom-autoload ',varname ,file))))
+ (custom-autoload ',varname ,file)
+ ;; The use of :require in a defcustom can be annoying, especially
+ ;; when defcustoms are moved from one file to another between
+ ;; releases because the :require arg gets placed in the user's
+ ;; .emacs. In order for autoloaded minor modes not to need the
+ ;; use of :require, we arrange to store their :setter.
+ ,(let ((setter (condition-case nil
+ (cadr (memq :set form))
+ (error nil))))
+ (if (equal setter ''custom-set-minor-mode)
+ `(put ',varname 'custom-set 'custom-set-minor-mode))))))
;; nil here indicates that this is not a special autoload form.
(t nil))))
@@ -566,5 +576,5 @@ Calls `update-directory-autoloads' on the command line arguments."
(provide 'autoload)
-;;; arch-tag: 00244766-98f4-4767-bf42-8a22103441c6
+;; arch-tag: 00244766-98f4-4767-bf42-8a22103441c6
;;; autoload.el ends here
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index a342f8a5530..6ee87919d38 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -201,10 +201,7 @@ See the command `%s' for a description of this minor-mode."))
:type 'boolean
,@(cond
((not (and curfile require)) nil)
- ((not (eq require t)) `(:require ,require))
- (t `(:require
- ',(intern (file-name-nondirectory
- (file-name-sans-extension curfile))))))
+ ((not (eq require t)) `(:require ,require)))
,@(nreverse extra-keywords))))
;; The actual function.
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 1ffc33835e9..972fe6bafc8 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -202,6 +202,8 @@
(setq comment-column 40)
;; Don't get confused by `;' in doc strings when paragraph-filling.
(set (make-local-variable 'comment-use-global-state) t)
+ (make-local-variable 'comment-indent-function)
+ (setq comment-indent-function 'lisp-comment-indent)
(make-local-variable 'imenu-generic-expression)
(setq imenu-generic-expression lisp-imenu-generic-expression)
(make-local-variable 'multibyte-syntax-as-symbol)
@@ -714,7 +716,7 @@ which see."
(setq debug-on-error new-value))
value)))))
-
+;; Used for comment-indent-function in Lisp modes.
(defun lisp-comment-indent ()
(if (looking-at "\\s<\\s<\\s<")
(current-column)
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index 93e30fb0f55..d9f3df99bae 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -67,7 +67,7 @@ to make output that `read' can handle, whenever this is possible."
(save-excursion
(backward-char 1)
(skip-chars-backward "'`#^")
- (when (and (not (bobp)) (memq (char-before) '(?\ ?\t ?\n)))
+ (when (and (not (bobp)) (memq (char-before) '(?\s ?\t ?\n)))
(delete-region
(point)
(progn (skip-chars-backward " \t\n") (point)))
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index cd3998520a1..43c275e4a2f 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -1,6 +1,6 @@
;;; facemenu.el --- create a face menu for interactively adding fonts to text
-;; Copyright (c) 1994, 1995, 1996, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (c) 1994, 1995, 1996, 2001, 2002, 2005 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: faces
@@ -135,7 +135,8 @@ just before \"Other\" at the end."
`(modeline region secondary-selection highlight scratch-face
,(purecopy "^font-lock-") ,(purecopy "^gnus-") ,(purecopy "^message-")
,(purecopy "^ediff-") ,(purecopy "^term-") ,(purecopy "^vc-")
- ,(purecopy "^widget-") ,(purecopy "^custom-") ,(purecopy "^vm-"))
+ ,(purecopy "^widget-") ,(purecopy "^custom-") ,(purecopy "^vm-")
+ ,(purecopy "^fg:") ,(purecopy "^bg:"))
"*List of faces not to include in the Face menu.
Each element may be either a symbol, which is the name of a face, or a string,
which is a regular expression to be matched against face names. Matching
@@ -162,6 +163,7 @@ when they are created."
"Menu keymap for faces.")
;;;###autoload
(defalias 'facemenu-face-menu facemenu-face-menu)
+(put 'facemenu-face-menu 'menu-enable '(facemenu-enable-faces-p))
;;;###autoload
(defvar facemenu-foreground-menu
@@ -171,6 +173,7 @@ when they are created."
"Menu keymap for foreground colors.")
;;;###autoload
(defalias 'facemenu-foreground-menu facemenu-foreground-menu)
+(put 'facemenu-foreground-menu 'menu-enable '(facemenu-enable-faces-p))
;;;###autoload
(defvar facemenu-background-menu
@@ -180,6 +183,11 @@ when they are created."
"Menu keymap for background colors.")
;;;###autoload
(defalias 'facemenu-background-menu facemenu-background-menu)
+(put 'facemenu-background-menu 'menu-enable '(facemenu-enable-faces-p))
+
+;;; Condition for enabling menu items that set faces.
+(defun facemenu-enable-faces-p ()
+ (not (and font-lock-mode font-lock-defaults)))
;;;###autoload
(defvar facemenu-special-menu
@@ -358,10 +366,8 @@ typing a character to insert cancels the specification."
(region-beginning))
(if (and mark-active (not current-prefix-arg))
(region-end))))
- (unless (color-defined-p color)
- (message "Color `%s' undefined" color))
- (facemenu-add-new-color color 'facemenu-foreground-menu)
- (facemenu-add-face (list (list :foreground color)) start end))
+ (facemenu-add-face (facemenu-add-new-color color 'facemenu-foreground-menu)
+ start end))
;;;###autoload
(defun facemenu-set-background (color &optional start end)
@@ -382,10 +388,8 @@ typing a character to insert cancels the specification."
(region-beginning))
(if (and mark-active (not current-prefix-arg))
(region-end))))
- (unless (color-defined-p color)
- (message "Color `%s' undefined" color))
- (facemenu-add-new-color color 'facemenu-background-menu)
- (facemenu-add-face (list (list :background color)) start end))
+ (facemenu-add-face (facemenu-add-new-color color 'facemenu-background-menu)
+ start end))
;;;###autoload
(defun facemenu-set-face-from-menu (face start end)
@@ -406,7 +410,6 @@ typing a character to insert cancels the specification."
(if (and mark-active (not current-prefix-arg))
(region-end))))
(barf-if-buffer-read-only)
- (facemenu-get-face face)
(if start
(facemenu-add-face face start end)
(facemenu-add-face face)))
@@ -608,7 +611,9 @@ effect. See `facemenu-remove-face-function'."
self-insert-face
(list self-insert-face)))
face)
- self-insert-face-command this-command)))))
+ self-insert-face-command this-command))))
+ (unless (facemenu-enable-faces-p)
+ (message "Font-lock mode will override any faces you set in this buffer")))
(defun facemenu-active-faces (face-list &optional frame)
"Return from FACE-LIST those faces that would be used for display.
@@ -641,14 +646,6 @@ use the selected frame. If t, then the global, non-frame faces are used."
(setq face-list (cdr face-list)))
(nreverse active-list)))
-(defun facemenu-get-face (symbol)
- "Make sure FACE exists.
-If not, create it and add it to the appropriate menu. Return the SYMBOL."
- (let ((name (symbol-name symbol)))
- (cond ((facep symbol))
- (t (make-face symbol))))
- symbol)
-
(defun facemenu-add-new-face (face)
"Add FACE (a face) to the Face menu.
@@ -708,47 +705,44 @@ This is called whenever you create a new face."
(define-key menu key (cons name function))))))
nil) ; Return nil for facemenu-iterate
-(defun facemenu-add-new-color (color &optional menu)
+(defun facemenu-add-new-color (color menu)
"Add COLOR (a color name string) to the appropriate Face menu.
-MENU should be `facemenu-foreground-menu' or
-`facemenu-background-menu'.
+MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'.
+Create the appropriate face and return it.
This is called whenever you use a new color."
- (let* (name
- symbol
- docstring
- function menu-val key
- (color-p (memq menu '(facemenu-foreground-menu
- facemenu-background-menu))))
- (unless (stringp color)
- (error "%s is not a color" color))
- (setq name color
- symbol (intern name))
-
+ (let (symbol docstring)
+ (unless (color-defined-p color)
+ (error "Color `%s' undefined" color))
(cond ((eq menu 'facemenu-foreground-menu)
(setq docstring
(format "Select foreground color %s for subsequent insertion."
- name)))
+ color)
+ symbol (intern (concat "fg:" color)))
+ (set-face-foreground (make-face symbol) color))
((eq menu 'facemenu-background-menu)
(setq docstring
(format "Select background color %s for subsequent insertion."
- name))))
+ color)
+ symbol (intern (concat "bg:" color)))
+ (set-face-background (make-face symbol) color))
+ (t (error "MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'")))
(cond ((facemenu-iterate ; check if equivalent face is already in the menu
(lambda (m) (and (listp m)
(symbolp (car m))
(stringp (cadr m))
(string-equal (cadr m) color)))
(cdr (symbol-function menu))))
- (t ; No keyboard equivalent. Figure out where to put it:
- (setq key (vector symbol)
- function 'facemenu-set-face-from-menu
- menu-val (symbol-function menu))
- (if (and facemenu-new-faces-at-end
- (> (length menu-val) 3))
- (define-key-after menu-val key (cons name function)
- (car (nth (- (length menu-val) 3) menu-val)))
- (define-key menu key (cons name function))))))
- nil) ; Return nil for facemenu-iterate
+ (t ; No keyboard equivalent. Figure out where to put it:
+ (let ((key (vector symbol))
+ (function 'facemenu-set-face-from-menu)
+ (menu-val (symbol-function menu)))
+ (if (and facemenu-new-faces-at-end
+ (> (length menu-val) 3))
+ (define-key-after menu-val key (cons color function)
+ (car (nth (- (length menu-val) 3) menu-val)))
+ (define-key menu key (cons color function))))))
+ symbol))
(defun facemenu-complete-face-list (&optional oldlist)
"Return list of all faces that look different.
diff --git a/lisp/faces.el b/lisp/faces.el
index 60e34d3976d..bcdef05e8ec 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -204,7 +204,10 @@ If NAME is already a face, it is simply returned."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun facep (face)
- "Return non-nil if FACE is a face name."
+ "Return non-nil if FACE is a face name or internal face object.
+Return nil otherwise. A face name can be a string or a symbol.
+An internal face object is a vector of the kind used internally
+to record face data."
(internal-lisp-face-p face))
@@ -1573,6 +1576,13 @@ this won't have the expected effect."
(choice-item light)
(choice-item :tag "default" nil)))
+(defvar default-frame-background-mode nil
+ "Internal variable for the default brightness of the background.
+Emacs sets it automatically depending on the terminal type.
+The value `nil' means `dark'. If Emacs runs in non-windowed
+mode from `xterm' or a similar terminal emulator, the value is
+`light'. On rxvt terminals, the value depends on the environment
+variable COLORFGBG.")
(defun frame-set-background-mode (frame)
"Set up display-dependent faces on FRAME.
@@ -1588,13 +1598,13 @@ according to the `background-mode' and `display-type' frame parameters."
(intern (downcase bg-resource)))
((and (null window-system) (null bg-color))
;; No way to determine this automatically (?).
- 'dark)
+ (or default-frame-background-mode 'dark))
;; Unspecified frame background color can only happen
;; on tty's.
((member bg-color '(unspecified "unspecified-bg"))
- 'dark)
+ (or default-frame-background-mode 'dark))
((equal bg-color "unspecified-fg") ; inverted colors
- 'light)
+ (if (eq default-frame-background-mode 'light) 'dark 'light))
((>= (apply '+ (x-color-values bg-color frame))
;; Just looking at the screen, colors whose
;; values add up to .6 of the white total
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 6ee541aea88..da838981576 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -620,6 +620,7 @@ Major/minor modes can set this variable if they know which option applies.")
;; We use this to preserve or protect things when modifying text properties.
(defmacro save-buffer-state (varlist &rest body)
"Bind variables according to VARLIST and eval BODY restoring buffer state."
+ (declare (indent 1) (debug let))
(let ((modified (make-symbol "modified")))
`(let* ,(append varlist
`((,modified (buffer-modified-p))
@@ -634,8 +635,6 @@ Major/minor modes can set this variable if they know which option applies.")
,@body)
(unless ,modified
(restore-buffer-modified-p nil)))))
- (put 'save-buffer-state 'lisp-indent-function 1)
- (def-edebug-spec save-buffer-state let)
;;
;; Shut up the byte compiler.
(defvar font-lock-face-attributes)) ; Obsolete but respected if set.
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index a1128f214cb..1f305f3adeb 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,18 @@
+2005-06-29 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-nocem.el (gnus-nocem-verifyer): Default to pgg-verify.
+ (gnus-nocem-check-article): Fetch the Type header.
+ (gnus-nocem-message-wanted-p): Fix the way to examine types.
+ (gnus-nocem-verify-issuer): Use functionp instead of fboundp.
+ (gnus-nocem-enter-article): Make sure gnus-nocem-hashtb is initialized.
+
+ * pgg.el (pgg-verify): Return the verification result.
+
+2005-06-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * gnus-art.el (gnus-article-mode): Set `nobreak-char-display', not
+ `show-nonbreak-escape'.
+
2005-06-23 Lute Kamstra <lute@gnu.org>
* gnus-art.el (gnus-article-mode): Use kill-all-local-variables.
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 56a79951b0c..b92ce8616d5 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -3755,7 +3755,7 @@ commands:
(make-local-variable 'gnus-article-charset)
(make-local-variable 'gnus-article-ignored-charsets)
;; Prevent recent Emacsen from displaying non-break space as "\ ".
- (set (make-local-variable 'show-nonbreak-escape) nil)
+ (set (make-local-variable 'nobreak-char-display) nil)
(gnus-set-default-directory)
(buffer-disable-undo)
(setq buffer-read-only t)
diff --git a/lisp/gnus/gnus-nocem.el b/lisp/gnus/gnus-nocem.el
index 5a5f779b732..cd51efcf100 100644
--- a/lisp/gnus/gnus-nocem.el
+++ b/lisp/gnus/gnus-nocem.el
@@ -1,6 +1,6 @@
;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2004
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2004, 2005
;; Free Software Foundation, Inc.
@@ -74,12 +74,13 @@ issuer registry."
:group 'gnus-nocem
:type 'integer)
-(defcustom gnus-nocem-verifyer 'mc-verify
+(defcustom gnus-nocem-verifyer 'pgg-verify
"*Function called to verify that the NoCeM message is valid.
-One likely value is `mc-verify'. If the function in this variable
+One likely value is `pgg-verify'. If the function in this variable
isn't bound, the message will be used unconditionally."
:group 'gnus-nocem
- :type '(radio (function-item mc-verify)
+ :type '(radio (function-item pgg-verify)
+ (function-item mc-verify)
(function :tag "other")))
(defcustom gnus-nocem-liberal-fetch nil
@@ -246,7 +247,7 @@ valid issuer, which is much faster if you are selective about the issuers."
;; We get the name of the issuer.
(narrow-to-region b e)
(setq issuer (mail-fetch-field "issuer")
- type (mail-fetch-field "issuer"))
+ type (mail-fetch-field "type"))
(widen)
(if (not (gnus-nocem-message-wanted-p issuer type))
(message "invalid NoCeM issuer: %s" issuer)
@@ -267,18 +268,20 @@ valid issuer, which is much faster if you are selective about the issuers."
(while (setq condition (pop conditions))
(cond
((stringp condition)
- (setq wanted (string-match condition type)))
+ (when (string-match condition type)
+ (setq wanted t)))
((and (consp condition)
(eq (car condition) 'not)
(stringp (cadr condition)))
- (setq wanted (not (string-match (cadr condition) type))))
+ (when (string-match (cadr condition) type)
+ (setq wanted nil)))
(t
(error "Invalid NoCeM condition: %S" condition))))
wanted))))
(defun gnus-nocem-verify-issuer (person)
"Verify using PGP that the canceler is who she says she is."
- (if (fboundp gnus-nocem-verifyer)
+ (if (functionp gnus-nocem-verifyer)
(ignore-errors
(funcall gnus-nocem-verifyer))
;; If we don't have Mailcrypt, then we use the message anyway.
@@ -315,7 +318,10 @@ valid issuer, which is much faster if you are selective about the issuers."
(while (eq (char-after) ?\t)
(forward-line -1))
(setq id (buffer-substring (point) (1- (search-forward "\t"))))
- (unless (gnus-gethash id gnus-nocem-hashtb)
+ (unless (if gnus-nocem-hashtb
+ (gnus-gethash id gnus-nocem-hashtb)
+ (setq gnus-nocem-hashtb (gnus-make-hashtable))
+ nil)
;; only store if not already present
(gnus-sethash id t gnus-nocem-hashtb)
(push id ncm))
diff --git a/lisp/gnus/pgg.el b/lisp/gnus/pgg.el
index eff02a1c32a..ca351c90cd2 100644
--- a/lisp/gnus/pgg.el
+++ b/lisp/gnus/pgg.el
@@ -380,7 +380,8 @@ within the region."
(with-output-to-temp-buffer pgg-echo-buffer
(set-buffer standard-output)
(insert-buffer-substring (if status pgg-output-buffer
- pgg-errors-buffer)))))))
+ pgg-errors-buffer)))))
+ status))
;;;###autoload
(defun pgg-insert-key ()
diff --git a/lisp/imenu.el b/lisp/imenu.el
index 0ebdbc4b5f3..2248ece3dbd 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -877,7 +877,7 @@ Return one of the entries in index-alist or nil."
(if (not imenu-space-replacement) index-alist
(mapcar
(lambda (item)
- (cons (subst-char-in-string ?\ (aref imenu-space-replacement 0)
+ (cons (subst-char-in-string ?\s (aref imenu-space-replacement 0)
(car item))
(cdr item)))
index-alist))))
diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index ca5e158349d..f282957512c 100644
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -474,6 +474,9 @@ There should be no more than seven characters after the final `/'."
(delete-region (point) (point-max)))
(goto-char start))
(error
+ ;; If the file we wanted to uncompress does not exist,
+ ;; handle that according to VISIT as `insert-file-contents'
+ ;; would, maybe signaling the same error it normally would.
(if (and (eq (car error-code) 'file-error)
(eq (nth 3 error-code) local-file))
(if visit
@@ -481,6 +484,13 @@ There should be no more than seven characters after the final `/'."
(signal 'file-error
(cons "Opening input file"
(nthcdr 2 error-code))))
+ ;; If the uncompression program can't be found,
+ ;; signal that as a non-file error
+ ;; so that find-file-noselect-1 won't handle it.
+ (if (and (eq (car error-code) 'file-error)
+ (equal (cadr error-code) "Searching for program"))
+ (error "Uncompression program `%s' not found"
+ (nth 3 error-code)))
(signal (car error-code) (cdr error-code))))))
(and
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 07e593a70c1..03740e780d5 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1857,7 +1857,7 @@ and selects that window."
(string< (buffer-name elt1) (buffer-name elt2))))))
(setq tail buffers)
(while tail
- (or (eq ?\ (aref (buffer-name (car tail)) 0))
+ (or (eq ?\s (aref (buffer-name (car tail)) 0))
(setq maxlen
(max maxlen
(length (buffer-name (car tail))))))
diff --git a/lisp/msb.el b/lisp/msb.el
index 0bcdad314a6..02ab487bc69 100644
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -489,7 +489,7 @@ See the function `mouse-select-buffer' and the variable
"Return t if optional BUFFER is an \"invisible\" buffer.
If the argument is left out or nil, then the current buffer is considered."
(and (> (length (buffer-name buffer)) 0)
- (eq ?\ (aref (buffer-name buffer) 0))))
+ (eq ?\s (aref (buffer-name buffer) 0))))
(defun msb--strip-dir (dir)
"Strip one hierarchy level from the end of DIR."
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index 59044da6ef9..590e6ce37ba 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -502,7 +502,7 @@ Point is assumed to be just at the end of a comment."
(or (match-end 1) (/= (current-column) (current-indentation))))
0
(when (or (/= (current-column) (current-indentation))
- (and (> comment-add 0) (looking-at "\\s<\\S<")))
+ (and (> comment-add 0) (looking-at "\\s<\\(\\S<\\|\\'\\)")))
comment-column)))
;;;###autoload
diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el
index 9ef8d0fd01f..86e6a35b646 100644
--- a/lisp/play/decipher.el
+++ b/lisp/play/decipher.el
@@ -772,7 +772,7 @@ See `decipher-loop-no-breaks' if you do not care about word divisions."
(forward-char))
(or (equal decipher-char ?\ )
(progn
- (setq decipher-char ?\ ;
+ (setq decipher-char ?\s
decipher--loop-prev-char ?\ )
(funcall func)))))))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 3f3b385c5ed..f8da248535b 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -493,25 +493,60 @@ starting the compilation process.")
;; backward-compatibility alias
(put 'compilation-info-face 'face-alias 'compilation-info)
+(defface compilation-error-file-name
+ '((default :inherit font-lock-warning-face)
+ (((supports :underline t)) :underline t))
+ "Face for displaying file names in compilation errors."
+ :group 'font-lock-highlighting-faces
+ :version "22.1")
+
+(defface compilation-warning-file-name
+ '((default :inherit font-lock-warning-face)
+ (((supports :underline t)) :underline t))
+ "Face for displaying file names in compilation errors."
+ :group 'font-lock-highlighting-faces
+ :version "22.1")
+
+(defface compilation-info-file-name
+ '((default :inherit compilation-info)
+ (((supports :underline t)) :underline t))
+ "Face for displaying file names in compilation errors."
+ :group 'font-lock-highlighting-faces
+ :version "22.1")
+
+(defface compilation-line-number
+ '((default :inherit font-lock-variable-name-face)
+ (((supports :underline t)) :underline t))
+ "Face for displaying file names in compilation errors."
+ :group 'font-lock-highlighting-faces
+ :version "22.1")
+
+(defface compilation-column-number
+ '((default :inherit font-lock-type-face)
+ (((supports :underline t)) :underline t))
+ "Face for displaying file names in compilation errors."
+ :group 'font-lock-highlighting-faces
+ :version "22.1")
+
(defvar compilation-message-face nil
"Face name to use for whole messages.
Faces `compilation-error-face', `compilation-warning-face',
`compilation-info-face', `compilation-line-face' and
`compilation-column-face' get prepended to this, when applicable.")
-(defvar compilation-error-face 'font-lock-warning-face
+(defvar compilation-error-face 'compilation-error-file-name
"Face name to use for file name in error messages.")
-(defvar compilation-warning-face 'compilation-warning
+(defvar compilation-warning-face 'compilation-warning-file-name
"Face name to use for file name in warning messages.")
-(defvar compilation-info-face 'compilation-info
+(defvar compilation-info-face 'compilation-info-file-name
"Face name to use for file name in informational messages.")
-(defvar compilation-line-face 'font-lock-variable-name-face
+(defvar compilation-line-face 'compilation-line-number
"Face name to use for line number in message.")
-(defvar compilation-column-face 'font-lock-type-face
+(defvar compilation-column-face 'compilation-column-number
"Face name to use for column number in message.")
;; same faces as dired uses
@@ -1342,8 +1377,9 @@ Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
(force-mode-line-update)
(if (and opoint (< opoint omax))
(goto-char opoint))
- (if compilation-finish-function
- (funcall compilation-finish-function (current-buffer) msg))
+ (with-no-warnings
+ (if compilation-finish-function
+ (funcall compilation-finish-function (current-buffer) msg)))
(let ((functions compilation-finish-functions))
(while functions
(funcall (car functions) (current-buffer) msg)
@@ -1501,8 +1537,9 @@ Use this command in a compilation log buffer. Sets the mark at point there."
;;;###autoload
(defun compilation-next-error-function (n &optional reset)
+ "Advance to the next error message and visit the file where the error was.
+This is the value of `next-error-function' in Compilation buffers."
(interactive "p")
- (set-buffer (compilation-find-buffer))
(when reset
(setq compilation-current-error nil))
(let* ((columns compilation-error-screen-columns) ; buffer's local value
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index d95c0294c4d..052df4eedda 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1516,7 +1516,8 @@ or as help on variables `cperl-tips', `cperl-problems',
(t
'((cperl-load-font-lock-keywords
cperl-load-font-lock-keywords-1
- cperl-load-font-lock-keywords-2)))))
+ cperl-load-font-lock-keywords-2)
+ nil nil ((?_ . "w"))))))
(make-local-variable 'cperl-syntax-state)
(if cperl-use-syntax-table-text-property
(progn
@@ -3840,7 +3841,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(and (buffer-modified-p)
(not modified)
(set-buffer-modified-p nil))
- (set-syntax-table cperl-mode-syntax-table))
+ ;; I do not understand what this is doing here. It breaks font-locking
+ ;; because it resets the syntax-table from font-lock-syntax-table to
+ ;; cperl-mode-syntax-table.
+ ;; (set-syntax-table cperl-mode-syntax-table)
+ )
(car err-l)))
(defun cperl-backward-to-noncomment (lim)
@@ -4350,7 +4355,7 @@ indentation and initial hashes. Behaves usually outside of comment."
fill-column)
(let ((c (save-excursion (beginning-of-line)
(cperl-to-comment-or-eol) (point)))
- (s (memq (following-char) '(?\ ?\t))) marker)
+ (s (memq (following-char) '(?\s ?\t))) marker)
(if (>= c (point))
;; Don't break line inside code: only inside comment.
nil
@@ -4361,11 +4366,11 @@ indentation and initial hashes. Behaves usually outside of comment."
(if (bolp) (progn (re-search-forward "#+[ \t]*")
(goto-char (match-end 0))))
;; Following space could have gone:
- (if (or (not s) (memq (following-char) '(?\ ?\t))) nil
+ (if (or (not s) (memq (following-char) '(?\s ?\t))) nil
(insert " ")
(backward-char 1))
;; Previous space could have gone:
- (or (memq (preceding-char) '(?\ ?\t)) (insert " "))))))
+ (or (memq (preceding-char) '(?\s ?\t)) (insert " "))))))
(defun cperl-imenu-addback (lst &optional isback name)
;; We suppose that the lst is a DAG, unless the first element only
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index c6e85934db4..dc7e64e6e35 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -2534,16 +2534,13 @@ It is saved for when this flag is not set.")
;; This must be outside of the save-excursion
;; in case the source file is our current buffer.
(if process-window
- (save-selected-window
- (select-window process-window)
- (gud-display-frame))
+ (progn
+ (with-selected-window process-window
+ (gud-display-frame)))
;; We have to be in the proper buffer, (process-buffer proc),
;; but not in a save-excursion, because that would restore point.
- (let ((old-buf (current-buffer)))
- (set-buffer (process-buffer proc))
- (unwind-protect
- (gud-display-frame)
- (set-buffer old-buf)))))
+ (with-current-buffer (process-buffer proc)
+ (gud-display-frame))))
;; If we deferred text that arrived during this processing,
;; handle it now.
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 3f556bdb695..70ea8b4bac6 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -949,6 +949,7 @@ See `python-check-command' for the default."
(if name
(file-name-nondirectory name))))))))
(setq python-saved-check-command command)
+ (require 'compile) ;To define compilation-* variables.
(save-some-buffers (not compilation-ask-about-save) nil)
(let ((compilation-error-regexp-alist
(cons '("(\\([^,]+\\), line \\([0-9]+\\))" 1 2)
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 825b035ba52..6252187724a 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -10,12 +10,12 @@
;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Keywords: wp, print, PostScript
-;; Time-stamp: <2005/03/19 00:40:12 vinicius>
-;; Version: 6.6.6
+;; Time-stamp: <2005/06/27 00:57:22 vinicius>
+;; Version: 6.6.7
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
-(defconst ps-print-version "6.6.6"
- "ps-print.el, v 6.6.6 <2005/03/19 vinicius>
+(defconst ps-print-version "6.6.7"
+ "ps-print.el, v 6.6.7 <2005/06/27 vinicius>
Vinicius's last change version -- this file may have been edited as part of
Emacs without changes to the version number. When reporting bugs, please also
@@ -5936,10 +5936,14 @@ XSTART YSTART are the relative position for the first page in a sheet.")
(ps-begin-page))
+(defun ps-end-sheet ()
+ (and ps-print-page-p (> ps-page-sheet 0)
+ (ps-output "EndSheet\n")))
+
+
(defun ps-header-sheet ()
;; Print only when a new sheet begins.
- (and ps-print-page-p (> ps-page-sheet 0)
- (ps-output "EndSheet\n"))
+ (ps-end-sheet)
(setq ps-page-sheet (1+ ps-page-sheet))
(when (ps-print-sheet-p)
(setq ps-page-order (1+ ps-page-order))
@@ -6624,8 +6628,7 @@ If FACE is not a valid face name, it is used default face."
(defun ps-end-job (needs-begin-file)
- (let ((previous-print ps-print-page-p)
- (ps-print-page-p t))
+ (let ((ps-print-page-p t))
(ps-flush-output)
(save-excursion
(let ((pages-per-sheet (mod ps-page-printed ps-n-up-printing))
@@ -6652,8 +6655,7 @@ If FACE is not a valid face name, it is used default face."
(number-to-string ps-lines-printed) " BeginPage\n")
(ps-end-page)))
;; Set end of PostScript file
- (and previous-print
- (ps-output "EndSheet\n"))
+ (ps-end-sheet)
(ps-output "\n%%Trailer\n%%Pages: "
(number-to-string
(if (and needs-begin-file
diff --git a/lisp/recentf.el b/lisp/recentf.el
index 1ea3ae6ecb2..64af3b1da3f 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -28,18 +28,18 @@
;;; Commentary:
;; This package maintains a menu for visiting files that were operated
-;; on recently. When enabled a new "Open Recent" submenu is displayed
-;; in the "Files" menu. The recent files list is automatically saved
-;; across Emacs sessions. You can customize the number of recent
-;; files displayed, the location of the menu and others options (see
-;; the source code for details).
+;; on recently. When enabled a new "Open Recent" sub menu is
+;; displayed in the "Files" menu. The recent files list is
+;; automatically saved across Emacs sessions. You can customize the
+;; number of recent files displayed, the location of the menu and
+;; others options (see the source code for details).
;;; History:
;;
;;; Code:
(require 'easymenu)
-(require 'wid-edit)
+(require 'tree-widget)
(require 'timer)
;;; Internal data
@@ -259,7 +259,8 @@ If `file-name-history' is not empty, do nothing."
It is passed a filename to give a chance to transform it.
If it returns nil, the filename is left unchanged."
:group 'recentf
- :type 'function)
+ :type '(choice (const :tag "None" nil)
+ function))
;;; Utilities
;;
@@ -904,30 +905,54 @@ unchanged."
;;
(defun recentf-cancel-dialog (&rest ignore)
"Cancel the current dialog.
-Used internally by recentf dialogs.
IGNORE arguments."
(interactive)
(kill-buffer (current-buffer))
(message "Dialog canceled"))
+(defun recentf-dialog-goto-first (widget-type)
+ "Move the cursor to the first WIDGET-TYPE in current dialog.
+Go to the beginning of buffer if not found."
+ (goto-char (point-min))
+ (condition-case nil
+ (let (done)
+ (widget-move 1)
+ (while (not done)
+ (if (eq widget-type (widget-type (widget-at (point))))
+ (setq done t)
+ (widget-move 1))))
+ (goto-char (point-min))))
+
(defvar recentf-dialog-mode-map
(let ((km (make-sparse-keymap)))
+ (set-keymap-parent km widget-keymap)
(define-key km "q" 'recentf-cancel-dialog)
(define-key km [down-mouse-1] 'widget-button-click)
- (set-keymap-parent km widget-keymap)
km)
"Keymap used in recentf dialogs.")
-(defun recentf-dialog-mode ()
+(define-derived-mode recentf-dialog-mode nil "recentf-dialog"
"Major mode of recentf dialogs.
\\{recentf-dialog-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'recentf-dialog-mode)
- (setq mode-name "recentf-dialog")
- (use-local-map recentf-dialog-mode-map)
- (run-mode-hooks 'recentf-dialog-mode-hook))
+ :syntax-table nil
+ :abbrev-table nil
+ (setq truncate-lines t))
+
+(defmacro recentf-dialog (name &rest forms)
+ "Show a dialog buffer with NAME, setup with FORMS."
+ (declare (indent 1) (debug t))
+ `(with-current-buffer (get-buffer-create ,name)
+ ;; Cleanup buffer
+ (let ((inhibit-read-only t)
+ (ol (overlay-lists)))
+ (mapc 'delete-overlay (car ol))
+ (mapc 'delete-overlay (cdr ol))
+ (erase-buffer))
+ (recentf-dialog-mode)
+ ,@forms
+ (widget-setup)
+ (switch-to-buffer (current-buffer))))
;;; Hooks
;;
@@ -976,163 +1001,127 @@ That is, remove a non kept file from the recent list."
;;; Commands
;;
-(defvar recentf-edit-selected-items nil
- "List of files to be deleted from the recent list.
-Used internally by `recentf-edit-list'.")
-(defun recentf-edit-list-action (widget &rest ignore)
- "Checkbox WIDGET action that toogles a file selection.
-Used internally by `recentf-edit-list'.
+;;; Edit list dialog
+;;
+(defvar recentf-edit-list nil)
+
+(defun recentf-edit-list-select (widget &rest ignore)
+ "Toggle a file selection based on the checkbox WIDGET state.
IGNORE other arguments."
- (let ((value (widget-get widget ':tag)))
- ;; if value is already in the selected items
- (if (memq value recentf-edit-selected-items)
- ;; then remove it
- (progn
- (setq recentf-edit-selected-items
- (delq value recentf-edit-selected-items))
- (message "%s removed from selection" value))
- ;; else add it
- (push value recentf-edit-selected-items)
- (message "%s added to selection" value))))
+ (let ((value (widget-get widget :tag))
+ (check (widget-value widget)))
+ (if check
+ (add-to-list 'recentf-edit-list value)
+ (setq recentf-edit-list (delq value recentf-edit-list)))
+ (message "%s %sselected" value (if check "" "un"))))
+
+(defun recentf-edit-list-validate (&rest ignore)
+ "Process the recent list when the edit list dialog is committed.
+IGNORE arguments."
+ (if recentf-edit-list
+ (let ((i 0))
+ (dolist (e recentf-edit-list)
+ (setq recentf-list (delq e recentf-list)
+ i (1+ i)))
+ (kill-buffer (current-buffer))
+ (message "%S file(s) removed from the list" i)
+ (recentf-clear-data))
+ (message "No file selected")))
(defun recentf-edit-list ()
- "Show a dialog buffer to edit the recent list.
-That is to select files to be deleted from the recent list."
+ "Show a dialog to delete selected files from the recent list."
(interactive)
- (with-current-buffer
- (get-buffer-create (format "*%s - Edit list*" recentf-menu-title))
- (switch-to-buffer (current-buffer))
- ;; Cleanup buffer
- (let ((inhibit-read-only t)
- (ol (overlay-lists)))
- (erase-buffer)
- ;; Delete all the overlays.
- (mapc 'delete-overlay (car ol))
- (mapc 'delete-overlay (cdr ol)))
- (recentf-dialog-mode)
- (setq recentf-edit-selected-items nil)
- ;; Insert the dialog header
+ (recentf-dialog (format "*%s - Edit list*" recentf-menu-title)
+ (set (make-local-variable 'recentf-edit-list) nil)
(widget-insert
- "\
-Select the files to be deleted from the recent list.\n\n\
-Click on Ok to update the list. \
-Click on Cancel or type \"q\" to quit.\n")
+ "Click on OK to delete selected files from the recent list.
+Click on Cancel or type `q' to cancel.\n")
;; Insert the list of files as checkboxes
(dolist (item recentf-list)
- (widget-create
- 'checkbox
- :value nil ; unselected checkbox
- :format "\n %[%v%] %t"
- :tag item
- :notify 'recentf-edit-list-action))
+ (widget-create 'checkbox
+ :value nil ; unselected checkbox
+ :format "\n %[%v%] %t"
+ :tag item
+ :notify 'recentf-edit-list-select))
(widget-insert "\n\n")
- ;; Insert the Ok button
(widget-create
'push-button
- :notify (lambda (&rest ignore)
- (if recentf-edit-selected-items
- (let ((i 0))
- (kill-buffer (current-buffer))
- (dolist (e recentf-edit-selected-items)
- (setq recentf-list (delq e recentf-list)
- i (1+ i)))
- (message "%S file(s) removed from the list" i)
- (recentf-clear-data))
- (message "No file selected")))
- "Ok")
+ :notify 'recentf-edit-list-validate
+ :help-echo "Delete selected files from the recent list"
+ "Ok")
(widget-insert " ")
- ;; Insert the Cancel button
(widget-create
'push-button
:notify 'recentf-cancel-dialog
"Cancel")
- (widget-setup)
- (goto-char (point-min))))
+ (recentf-dialog-goto-first 'checkbox)))
+;;; Open file dialog
+;;
(defun recentf-open-files-action (widget &rest ignore)
- "Button WIDGET action that open a file.
-Used internally by `recentf-open-files'.
+ "Open the file stored in WIDGET's value when notified.
IGNORE other arguments."
(kill-buffer (current-buffer))
(funcall recentf-menu-action (widget-value widget)))
-(defvar recentf-open-files-item-shift ""
- "Amount of space to shift right sub-menu items.
-Used internally by `recentf-open-files'.")
-
(defun recentf-open-files-item (menu-element)
- "Insert an item widget for MENU-ELEMENT in the current dialog buffer.
-Used internally by `recentf-open-files'."
- (let ((item (car menu-element))
- (file (cdr menu-element)))
- (if (consp file) ; This is a sub-menu
- (let* ((shift recentf-open-files-item-shift)
- (recentf-open-files-item-shift (concat shift " ")))
- (widget-create
- 'item
- :tag item
- :sample-face 'bold
- :format (concat shift "%{%t%}:\n"))
- (mapc 'recentf-open-files-item file)
- (widget-insert "\n"))
- (widget-create
- 'push-button
- :button-face 'default
- :tag item
- :help-echo (concat "Open " file)
- :format (concat recentf-open-files-item-shift "%[%t%]")
- :notify 'recentf-open-files-action
- file)
- (widget-insert "\n"))))
+ "Return a widget to display MENU-ELEMENT in a dialog buffer."
+ (if (consp (cdr menu-element))
+ ;; Represent a sub-menu with a tree widget
+ `(tree-widget
+ :open t
+ :match ignore
+ :node (item :tag ,(car menu-element)
+ :sample-face bold
+ :format "%{%t%}:\n")
+ ,@(mapcar 'recentf-open-files-item
+ (cdr menu-element)))
+ ;; Represent a single file with a link widget
+ `(link :tag ,(car menu-element)
+ :button-prefix ""
+ :button-suffix ""
+ :button-face default
+ :format "%[%t%]\n"
+ :help-echo ,(concat "Open " (cdr menu-element))
+ :action recentf-open-files-action
+ ,(cdr menu-element))))
(defun recentf-open-files (&optional files buffer-name)
- "Show a dialog buffer to open a recent file.
-If optional argument FILES is non-nil, it specifies the list of
-recently-opened files to choose from. It is the whole recent list
-otherwise.
-If optional argument BUFFER-NAME is non-nil, it specifies which buffer
-name to use for the interaction. It is \"*`recentf-menu-title'*\" by
-default."
+ "Show a dialog to open a recent file.
+If optional argument FILES is non-nil, it is a list of recently-opened
+files to choose from. It defaults to the whole recent list.
+If optional argument BUFFER-NAME is non-nil, it is a buffer name to
+use for the dialog. It defaults to \"*`recentf-menu-title'*\"."
(interactive)
- (unless files
- (setq files recentf-list))
- (unless buffer-name
- (setq buffer-name (format "*%s*" recentf-menu-title)))
- (with-current-buffer (get-buffer-create buffer-name)
- (switch-to-buffer (current-buffer))
- ;; Cleanup buffer
- (let ((inhibit-read-only t)
- (ol (overlay-lists)))
- (erase-buffer)
- ;; Delete all the overlays.
- (mapc 'delete-overlay (car ol))
- (mapc 'delete-overlay (cdr ol)))
- (recentf-dialog-mode)
- ;; Insert the dialog header
- (widget-insert "Click on a file to open it. ")
- (widget-insert "Click on Cancel or type \"q\" to quit.\n\n" )
- ;; Insert the list of files as buttons
- (let ((recentf-open-files-item-shift ""))
- (mapc 'recentf-open-files-item
- (recentf-apply-menu-filter
- recentf-menu-filter
- (mapcar 'recentf-make-default-menu-element files))))
- (widget-insert "\n")
- ;; Insert the Cancel button
+ (recentf-dialog (or buffer-name (format "*%s*" recentf-menu-title))
+ (widget-insert "Click on a file to open it.
+Click on Cancel or type `q' to cancel.\n" )
+ ;; Use a L&F that looks like the recentf menu.
+ (tree-widget-set-theme "folder")
+ (apply 'widget-create
+ `(group
+ :indent 2
+ :format "\n%v\n"
+ ,@(mapcar 'recentf-open-files-item
+ (recentf-apply-menu-filter
+ recentf-menu-filter
+ (mapcar 'recentf-make-default-menu-element
+ (or files recentf-list))))))
(widget-create
'push-button
:notify 'recentf-cancel-dialog
"Cancel")
- (widget-setup)
- (goto-char (point-min))))
+ (recentf-dialog-goto-first 'link)))
(defun recentf-open-more-files ()
- "Show a dialog buffer to open a recent file that is not in the menu."
+ "Show a dialog to open a recent file that is not in the menu."
(interactive)
(recentf-open-files (nthcdr recentf-max-menu-items recentf-list)
(format "*%s - More*" recentf-menu-title)))
+;;; Save/load/cleanup the recent list
+;;
(defconst recentf-save-file-header
";;; Automatically generated by `recentf' on %s.\n"
"Header to be written into the `recentf-save-file'.")
@@ -1149,16 +1138,16 @@ Write data into the file specified by `recentf-save-file'."
(interactive)
(condition-case error
(with-temp-buffer
- (erase-buffer)
- (set-buffer-file-coding-system recentf-save-file-coding-system)
- (insert (format recentf-save-file-header (current-time-string)))
- (recentf-dump-variable 'recentf-list recentf-max-saved-items)
- (recentf-dump-variable 'recentf-filter-changer-state)
- (insert "\n \n;;; Local Variables:\n"
- (format ";;; coding: %s\n" recentf-save-file-coding-system)
- ";;; End:\n")
- (write-file (expand-file-name recentf-save-file))
- nil)
+ (erase-buffer)
+ (set-buffer-file-coding-system recentf-save-file-coding-system)
+ (insert (format recentf-save-file-header (current-time-string)))
+ (recentf-dump-variable 'recentf-list recentf-max-saved-items)
+ (recentf-dump-variable 'recentf-filter-changer-state)
+ (insert "\n \n;;; Local Variables:\n"
+ (format ";;; coding: %s\n" recentf-save-file-coding-system)
+ ";;; End:\n")
+ (write-file (expand-file-name recentf-save-file))
+ nil)
(error
(warn "recentf mode: %s" (error-message-string error)))))
@@ -1218,5 +1207,5 @@ that were operated on recently."
(run-hooks 'recentf-load-hook)
-;;; arch-tag: 78f1eec9-0d16-4d19-a4eb-2e4529edb62a
+;; arch-tag: 78f1eec9-0d16-4d19-a4eb-2e4529edb62a
;;; recentf.el ends here
diff --git a/lisp/replace.el b/lisp/replace.el
index d5ccd8723c2..0b19d72178f 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -516,21 +516,32 @@ which will run faster and will not set the mark or print anything."
Prompt for a regexp with PROMPT.
Value is a list, (REGEXP)."
(list (read-from-minibuffer prompt nil nil nil
- 'regexp-history nil t)))
+ 'regexp-history nil t)
+ nil nil t))
-(defun keep-lines (regexp &optional rstart rend)
+(defun keep-lines (regexp &optional rstart rend interactive)
"Delete all lines except those containing matches for REGEXP.
A match split across lines preserves all the lines it lies in.
-Applies to all lines after point.
+When called from Lisp (and usually interactively as well, see below)
+applies to all lines starting after point.
If REGEXP contains upper case characters (excluding those preceded by `\\'),
the matching is case-sensitive.
Second and third arg RSTART and REND specify the region to operate on.
+This command operates on (the accessible part of) all lines whose
+accessible part is entirely contained in the region determined by RSTART
+and REND. (A newline ending a line counts as part of that line.)
Interactively, in Transient Mark mode when the mark is active, operate
-on the contents of the region. Otherwise, operate from point to the
-end of the buffer."
+on all lines whose accessible part is entirely contained in the region.
+Otherwise, the command applies to all lines starting after point.
+When calling this function from Lisp, you can pretend that it was
+called interactively by passing a non-nil INTERACTIVE argument.
+
+This function starts looking for the next match from the end of
+the previous match. Hence, it ignores matches that overlap
+a previously found match."
(interactive
(progn
@@ -539,10 +550,20 @@ end of the buffer."
(if rstart
(progn
(goto-char (min rstart rend))
- (setq rend (copy-marker (max rstart rend))))
- (if (and transient-mark-mode mark-active)
+ (setq rend
+ (progn
+ (save-excursion
+ (goto-char (max rstart rend))
+ (unless (or (bolp) (eobp))
+ (forward-line 0))
+ (point-marker)))))
+ (if (and interactive transient-mark-mode mark-active)
(setq rstart (region-beginning)
- rend (copy-marker (region-end)))
+ rend (progn
+ (goto-char (region-end))
+ (unless (or (bolp) (eobp))
+ (forward-line 0))
+ (point-marker)))
(setq rstart (point)
rend (point-max-marker)))
(goto-char rstart))
@@ -556,7 +577,7 @@ end of the buffer."
(if (not (re-search-forward regexp rend 'move))
(delete-region start rend)
(let ((end (save-excursion (goto-char (match-beginning 0))
- (beginning-of-line)
+ (forward-line 0)
(point))))
;; Now end is first char preserved by the new match.
(if (< start end)
@@ -566,22 +587,34 @@ end of the buffer."
;; If the match was empty, avoid matching again at same place.
(and (< (point) rend)
(= (match-beginning 0) (match-end 0))
- (forward-char 1))))))
+ (forward-char 1)))))
+ (set-marker rend nil)
+ nil)
-(defun flush-lines (regexp &optional rstart rend)
- "Delete lines containing matches for REGEXP.
-If a match is split across lines, all the lines it lies in are deleted.
-Applies to lines after point.
+(defun flush-lines (regexp &optional rstart rend interactive)
+ "Delete lines containing matches for REGEXP.
+When called from Lisp (and usually when called interactively as
+well, see below), applies to the part of the buffer after point.
+The line point is in is deleted if and only if it contains a
+match for regexp starting after point.
If REGEXP contains upper case characters (excluding those preceded by `\\'),
the matching is case-sensitive.
Second and third arg RSTART and REND specify the region to operate on.
+Lines partially contained in this region are deleted if and only if
+they contain a match entirely contained in it.
Interactively, in Transient Mark mode when the mark is active, operate
on the contents of the region. Otherwise, operate from point to the
-end of the buffer."
+end of (the accessible portion of) the buffer. When calling this function
+from Lisp, you can pretend that it was called interactively by passing
+a non-nil INTERACTIVE argument.
+
+If a match is split across lines, all the lines it lies in are deleted.
+They are deleted _before_ looking for the next match. Hence, a match
+starting on the same line at which another match ended is ignored."
(interactive
(progn
@@ -591,7 +624,7 @@ end of the buffer."
(progn
(goto-char (min rstart rend))
(setq rend (copy-marker (max rstart rend))))
- (if (and transient-mark-mode mark-active)
+ (if (and interactive transient-mark-mode mark-active)
(setq rstart (region-beginning)
rend (copy-marker (region-end)))
(setq rstart (point)
@@ -603,13 +636,18 @@ end of the buffer."
(while (and (< (point) rend)
(re-search-forward regexp rend t))
(delete-region (save-excursion (goto-char (match-beginning 0))
- (beginning-of-line)
+ (forward-line 0)
(point))
- (progn (forward-line 1) (point)))))))
+ (progn (forward-line 1) (point))))))
+ (set-marker rend nil)
+ nil)
-(defun how-many (regexp &optional rstart rend)
- "Print number of matches for REGEXP following point.
+(defun how-many (regexp &optional rstart rend interactive)
+ "Print and return number of matches for REGEXP following point.
+When called from Lisp and INTERACTIVE is omitted or nil, just return
+the number, do not print it; if INTERACTIVE is t, the function behaves
+in all respects has if it had been called interactively.
If REGEXP contains upper case characters (excluding those preceded by `\\'),
the matching is case-sensitive.
@@ -618,18 +656,24 @@ Second and third arg RSTART and REND specify the region to operate on.
Interactively, in Transient Mark mode when the mark is active, operate
on the contents of the region. Otherwise, operate from point to the
-end of the buffer."
+end of (the accessible portion of) the buffer.
+
+This function starts looking for the next match from the end of
+the previous match. Hence, it ignores matches that overlap
+a previously found match."
(interactive
(keep-lines-read-args "How many matches for (regexp): "))
(save-excursion
(if rstart
- (goto-char (min rstart rend))
- (if (and transient-mark-mode mark-active)
+ (progn
+ (goto-char (min rstart rend))
+ (setq rend (max rstart rend)))
+ (if (and interactive transient-mark-mode mark-active)
(setq rstart (region-beginning)
- rend (copy-marker (region-end)))
+ rend (region-end))
(setq rstart (point)
- rend (point-max-marker)))
+ rend (point-max)))
(goto-char rstart))
(let ((count 0)
opoint
@@ -641,7 +685,10 @@ end of the buffer."
(if (= opoint (point))
(forward-char 1)
(setq count (1+ count))))
- (message "%d occurrences" count))))
+ (when interactive (message "%d occurrence%s"
+ count
+ (if (= count 1) "" "s")))
+ count)))
(defvar occur-mode-map
@@ -892,8 +939,7 @@ buffer for each buffer where you invoke `occur'."
(defun occur (regexp &optional nlines)
"Show all lines in the current buffer containing a match for REGEXP.
-
-If a match spreads across multiple lines, all those lines are shown.
+This function can not handle matches that span more than one line.
Each line is displayed with NLINES lines before and after, or -NLINES
before if NLINES is negative.
@@ -1001,9 +1047,9 @@ See also `multi-occur'."
(display-buffer occur-buf)
(setq next-error-last-buffer occur-buf))
(kill-buffer occur-buf)))
- (run-hooks 'occur-hook))
- (setq buffer-read-only t)
- (set-buffer-modified-p nil))))
+ (setq buffer-read-only t)
+ (set-buffer-modified-p nil)
+ (run-hooks 'occur-hook)))))
(defun occur-engine-add-prefix (lines)
(mapcar
@@ -1603,15 +1649,15 @@ make, or the user didn't cancel the call."
;; Change markers to numbers in the match data
;; since lots of markers slow down editing.
(push (list (point) replaced
-;;; If the replacement has already happened, all we need is the
-;;; current match start and end. We could get this with a trivial
-;;; match like
-;;; (save-excursion (goto-char (match-beginning 0))
-;;; (search-forward (match-string 0))
-;;; (match-data t))
-;;; if we really wanted to avoid manually constructing match data.
-;;; Adding current-buffer is necessary so that match-data calls can
-;;; return markers which are appropriate for editing.
+;;; If the replacement has already happened, all we need is the
+;;; current match start and end. We could get this with a trivial
+;;; match like
+;;; (save-excursion (goto-char (match-beginning 0))
+;;; (search-forward (match-string 0))
+;;; (match-data t))
+;;; if we really wanted to avoid manually constructing match data.
+;;; Adding current-buffer is necessary so that match-data calls can
+;;; return markers which are appropriate for editing.
(if replaced
(list
(match-beginning 0)
diff --git a/lisp/simple.el b/lisp/simple.el
index 08e87737288..3f9b4788373 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -3442,18 +3442,14 @@ Outline mode sets this."
(when (and (not done)
(not (integerp selective-display))
(not (line-move-invisible-p (point))))
- ;; We avoid vertical-motion when possible
- ;; because that has to fontify.
- (forward-line 1)
- ;; If there are overlays in and around
- ;; the text we moved over, we need to be
- ;; sophisticated.
(unless (overlays-in (max (1- pos-before) (point-min))
(min (1+ (point)) (point-max)))
+ ;; We avoid vertical-motion when possible
+ ;; because that has to fontify.
+ (forward-line 1)
(setq line-done t)))
- ;; Otherwise move a more sophisticated way.
- ;; (What's the logic behind this code?)
(and (not done) (not line-done)
+ ;; Otherwise move a more sophisticated way.
(zerop (vertical-motion 1))
(if (not noerror)
(signal 'end-of-buffer nil)
@@ -3473,9 +3469,9 @@ Outline mode sets this."
(when (and (not done)
(not (integerp selective-display))
(not (line-move-invisible-p (1- (point)))))
- (forward-line -1)
(unless (overlays-in (max (1- (point)) (point-min))
(min (1+ pos-before) (point-max)))
+ (forward-line -1)
(setq line-done t)))
(and (not done) (not line-done)
(zerop (vertical-motion -1))
diff --git a/lisp/startup.el b/lisp/startup.el
index fa18b607b2d..a570581d02b 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -444,24 +444,23 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
;; frame-notice-user-settings didn't (such as on a tty).
;; frame-set-background-mode is idempotent, so it won't
;; cause any harm if it's already been done.
- (let ((frame-background-mode frame-background-mode)
- (frame (selected-frame))
+ (let ((frame (selected-frame))
term)
(when (and (null window-system)
- ;; Don't override a possibly customized value.
- (null frame-background-mode)
- ;; Don't override user specifications.
- (null (frame-parameter frame 'reverse))
+ ;; Don't override default set by files in lisp/term.
+ (null default-frame-background-mode)
(let ((bg (frame-parameter frame 'background-color)))
(or (null bg)
- (member bg '(unspecified "unspecified-bg")))))
+ (member bg '(unspecified "unspecified-bg"
+ "unspecified-fg")))))
+
(setq term (getenv "TERM"))
;; Some files in lisp/term do a better job with the
;; background mode, but we leave this here anyway, in
;; case they remove those files.
(if (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
term)
- (setq frame-background-mode 'light)))
+ (setq default-frame-background-mode 'light)))
(frame-set-background-mode (selected-frame)))))
;; Now we know the user's default font, so add it to the menu.
diff --git a/lisp/subr.el b/lisp/subr.el
index 8bcdc42706f..8e871673bbc 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -937,7 +937,7 @@ the hook's buffer-local value rather than its default value."
(set hook hook-value))))))
(defun add-to-list (list-var element &optional append)
- "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
+ "Add ELEMENT to the value of LIST-VAR if it isn't there yet.
The test for presence of ELEMENT is done with `equal'.
If ELEMENT is added, it is added at the beginning of the list,
unless the optional argument APPEND is non-nil, in which case
@@ -959,15 +959,18 @@ other hooks, such as major mode hooks, can do the job."
(defun add-to-ordered-list (list-var element &optional order)
- "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
+ "Add ELEMENT to the value of LIST-VAR if it isn't there yet.
The test for presence of ELEMENT is done with `eq'.
The resulting list is reordered so that the elements are in the
order given by each element's numeric list order. Elements
without a numeric list order are placed at the end of the list.
-If the third optional argument ORDER is non-nil, set the
-element's list order to the given value.
+If the third optional argument ORDER is a number (integer or
+float), set the element's list order to the given value. If
+ORDER is nil or omitted, do not change the numeric order of
+ELEMENT. If ORDER has any other value, remove the numeric order
+of ELEMENT if it has one.
The list order for each element is stored in LIST-VAR's
`list-order' property.
@@ -1717,8 +1720,12 @@ See also `with-temp-buffer'."
(defmacro with-selected-window (window &rest body)
"Execute the forms in BODY with WINDOW as the selected window.
The value returned is the value of the last form in BODY.
-This does not alter the buffer list ordering.
-This function saves and restores the selected window, as well as
+
+This macro saves and restores the current buffer, since otherwise
+its normal operation could potentially make a different
+buffer current. It does not alter the buffer list ordering.
+
+This macro saves and restores the selected window, as well as
the selected window in each frame. If the previously selected
window of some frame is no longer live at the end of BODY, that
frame's selected window is left alone. If the selected window is
@@ -1734,15 +1741,16 @@ See also `with-temp-buffer'."
(save-selected-window-alist
(mapcar (lambda (frame) (list frame (frame-selected-window frame)))
(frame-list))))
- (unwind-protect
- (progn (select-window ,window 'norecord)
- ,@body)
- (dolist (elt save-selected-window-alist)
- (and (frame-live-p (car elt))
- (window-live-p (cadr elt))
- (set-frame-selected-window (car elt) (cadr elt))))
- (if (window-live-p save-selected-window-window)
- (select-window save-selected-window-window 'norecord)))))
+ (save-current-buffer
+ (unwind-protect
+ (progn (select-window ,window 'norecord)
+ ,@body)
+ (dolist (elt save-selected-window-alist)
+ (and (frame-live-p (car elt))
+ (window-live-p (cadr elt))
+ (set-frame-selected-window (car elt) (cadr elt))))
+ (if (window-live-p save-selected-window-window)
+ (select-window save-selected-window-window 'norecord))))))
(defmacro with-temp-file (file &rest body)
"Create a new buffer, evaluate BODY there, and write the buffer to FILE.
diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el
index 7839ebba95d..a47b6787913 100644
--- a/lisp/term/rxvt.el
+++ b/lisp/term/rxvt.el
@@ -150,7 +150,7 @@ for the currently selected frame."
"Set background mode as appropriate for the default rxvt colors."
(let ((fgbg (getenv "COLORFGBG"))
bg rgb)
- (setq frame-background-mode 'light) ; default
+ (setq default-frame-background-mode 'light)
(when (and fgbg
(string-match ".*;\\([0-9][0-9]?\\)\\'" fgbg))
(setq bg (string-to-number (substring fgbg (match-beginning 1))))
@@ -163,7 +163,7 @@ for the currently selected frame."
;; The following line assumes that white is the 15th
;; color in rxvt-standard-colors.
(* (apply '+ (car (cddr (nth 15 rxvt-standard-colors)))) 0.6))
- (setq frame-background-mode 'dark)))
+ (setq default-frame-background-mode 'dark)))
(frame-set-background-mode (selected-frame))))
;; Do it!
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index b55f18f6883..2a2df2564e4 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -366,7 +366,7 @@ versions of xterm."
"Set background mode as appropriate for the default rxvt colors."
(let ((fgbg (getenv "COLORFGBG"))
bg rgb)
- (setq frame-background-mode 'light) ; default
+ (setq default-frame-background-mode 'light)
(when (and fgbg
(string-match ".*;\\([0-9][0-9]?\\)\\'" fgbg))
(setq bg (string-to-number (substring fgbg (match-beginning 1))))
@@ -379,7 +379,7 @@ versions of xterm."
;; The following line assumes that white is the 15th
;; color in xterm-standard-colors.
(* (apply '+ (car (cddr (nth 15 xterm-standard-colors)))) 0.6))
- (setq frame-background-mode 'dark)))
+ (setq default-frame-background-mode 'dark)))
(frame-set-background-mode (selected-frame))))
;; Do it!
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 2d40d6da026..1fe3c9dcbfe 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -2875,7 +2875,7 @@ Returns a list of strings."
(defun artist-figlet-get-extra-args ()
"Read any extra arguments for figlet."
- (let ((extra-args (read-input "Extra args to figlet: ")))
+ (let ((extra-args (read-string "Extra args to figlet: ")))
(if (string= extra-args "")
nil
extra-args)))
@@ -2916,7 +2916,7 @@ This is done by calling the function specified by `artist-text-renderer',
which must return a list of strings, to be inserted in the buffer.
Text already in the buffer ``shines thru'' blanks in the rendered text."
- (let* ((input-text (read-input "Type text to render: "))
+ (let* ((input-text (read-string "Type text to render: "))
(rendered-text (artist-funcall artist-text-renderer input-text)))
(artist-text-insert-see-thru x y rendered-text)))
@@ -2927,7 +2927,7 @@ This is done by calling the function specified by `artist-text-renderer',
which must return a list of strings, to be inserted in the buffer.
Blanks in the rendered text overwrites any text in the buffer."
- (let* ((input-text (read-input "Type text to render: "))
+ (let* ((input-text (read-string "Type text to render: "))
(rendered-text (artist-funcall artist-text-renderer input-text)))
(artist-text-insert-overwrite x y rendered-text)))
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 8c2d0937a5a..fc74fc67041 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -66,10 +66,6 @@
'emacs))
"The type of Emacs we are currently running.")
-(defvar flyspell-use-local-map
- (or (eq flyspell-emacs 'xemacs)
- (not (string< emacs-version "20"))))
-
;*---------------------------------------------------------------------*/
;* User configuration ... */
;*---------------------------------------------------------------------*/
@@ -403,34 +399,22 @@ property of the major mode name.")
;*---------------------------------------------------------------------*/
;* The minor mode declaration. */
;*---------------------------------------------------------------------*/
-(eval-when-compile (defvar flyspell-local-mouse-map))
-
(defvar flyspell-mouse-map
(let ((map (make-sparse-keymap)))
- (if flyspell-use-meta-tab
- (define-key map "\M-\t" #'flyspell-auto-correct-word))
(define-key map (if (featurep 'xemacs) [button2] [down-mouse-2])
#'flyspell-correct-word)
- (define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
- (define-key map [(control \,)] 'flyspell-goto-next-error)
- (define-key map [(control \.)] 'flyspell-auto-correct-word)
- map))
+ map)
+ "Keymap for Flyspell to put on erroneous words.")
(defvar flyspell-mode-map
(let ((map (make-sparse-keymap)))
- ;; mouse, keyboard bindings and misc definition
(if flyspell-use-meta-tab
(define-key map "\M-\t" 'flyspell-auto-correct-word))
- (cond
- ;; I don't understand this test, so I left it as is. --Stef
- ((or (featurep 'xemacs) flyspell-use-local-map)
- (define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
- (define-key map [(control ?\,)] 'flyspell-goto-next-error)
- (define-key map [(control ?\.)] 'flyspell-auto-correct-word)))
- map))
-
-;; the name of the overlay property that defines the keymap
-(defvar flyspell-overlay-keymap-property-name 'keymap)
+ (define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
+ (define-key map [(control ?\,)] 'flyspell-goto-next-error)
+ (define-key map [(control ?\.)] 'flyspell-auto-correct-word)
+ map)
+ "Minor mode keymap for Flyspell mode--for the whole buffer.")
;; dash character machinery
(defvar flyspell-consider-dash-as-word-delimiter-flag nil
@@ -569,22 +553,6 @@ in your .emacs file.
(let ((mode-predicate (get major-mode 'flyspell-mode-predicate)))
(if mode-predicate
(setq flyspell-generic-check-word-p mode-predicate)))
- ;; work around the fact that the `local-map' text-property replaces the
- ;; buffer's local map rather than shadowing it.
- (set (make-local-variable 'flyspell-mouse-map)
- (let ((map (copy-keymap flyspell-mouse-map)))
- (set-keymap-parent map (current-local-map))
- (if (and (eq flyspell-emacs 'emacs)
- (not (string< emacs-version "20")))
- (define-key map '[tool-bar] nil))
- map))
- (set (make-local-variable 'flyspell-mode-map)
- (let ((map (copy-keymap flyspell-mode-map)))
- (set-keymap-parent map (current-local-map))
- (if (and (eq flyspell-emacs 'emacs)
- (not (string< emacs-version "20")))
- (define-key map '[tool-bar] nil))
- map))
;; the welcome message
(if (and flyspell-issue-message-flag
flyspell-issue-welcome-flag
@@ -1570,10 +1538,7 @@ for the overlay."
(overlay-put flyspell-overlay 'flyspell-overlay t)
(overlay-put flyspell-overlay 'evaporate t)
(overlay-put flyspell-overlay 'help-echo "mouse-2: correct word at point")
- (if flyspell-use-local-map
- (overlay-put flyspell-overlay
- flyspell-overlay-keymap-property-name
- flyspell-mouse-map))
+ (overlay-put flyspell-overlay 'keymap flyspell-mouse-map)
(when (eq face 'flyspell-incorrect)
(and (stringp flyspell-before-incorrect-word-string)
(overlay-put flyspell-overlay 'before-string
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 67af240f522..eda2872df68 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1438,80 +1438,79 @@ quit spell session exited."
end (car (cdr (cdr word)))
word (car word))
- ;; now check spelling of word if it has 3 or more characters.
- (cond
- ((> (length word) 2)
- (or quietly
- (message "Checking spelling of %s..."
- (funcall ispell-format-word word)))
- (ispell-send-string "%\n") ; put in verbose mode
- (ispell-send-string (concat "^" word "\n"))
- ;; wait until ispell has processed word
- (while (progn
- (ispell-accept-output)
- (not (string= "" (car ispell-filter)))))
- ;;(ispell-send-string "!\n") ;back to terse mode.
- (setq ispell-filter (cdr ispell-filter)) ; remove extra \n
- (if (and ispell-filter (listp ispell-filter))
- (if (> (length ispell-filter) 1)
- (error "Ispell and its process have different character maps")
- (setq poss (ispell-parse-output (car ispell-filter)))))
- (cond ((eq poss t)
- (or quietly
- (message "%s is correct"
- (funcall ispell-format-word word)))
- (and (fboundp 'extent-at)
- (extent-at start)
- (delete-extent (extent-at start))))
- ((stringp poss)
- (or quietly
- (message "%s is correct because of root %s"
- (funcall ispell-format-word word)
- (funcall ispell-format-word poss)))
- (and (fboundp 'extent-at)
- (extent-at start)
- (delete-extent (extent-at start))))
- ((null poss) (message "Error in ispell process"))
- (ispell-check-only ; called from ispell minor mode.
- (if (fboundp 'make-extent)
- (let ((ext (make-extent start end)))
- (set-extent-property ext 'face ispell-highlight-face)
- (set-extent-property ext 'priority 2000))
- (beep)
- (message "%s is incorrect"(funcall ispell-format-word word))))
- (t ; prompt for correct word.
- (save-window-excursion
- (setq replace (ispell-command-loop
- (car (cdr (cdr poss)))
- (car (cdr (cdr (cdr poss))))
- (car poss) start end)))
- (cond ((equal 0 replace)
- (ispell-add-per-file-word-list (car poss)))
- (replace
- (setq new-word (if (atom replace) replace (car replace))
- cursor-location (+ (- (length word) (- end start))
- cursor-location))
- (if (not (equal new-word (car poss)))
- (progn
- (delete-region start end)
- (setq start (point))
- (ispell-insert-word new-word)
- (setq end (point))))
- (if (not (atom replace)) ;recheck spelling of replacement
- (progn
- (if (car (cdr replace)) ; query replace requested
- (save-window-excursion
- (query-replace word new-word t)))
- (goto-char start)
- ;; single word could be split into multiple words
- (setq ispell-quit (not (ispell-region start end)))
- ))))
- ;; keep if rechecking word and we keep choices win.
- (if (get-buffer ispell-choices-buffer)
- (kill-buffer ispell-choices-buffer))))
- (ispell-pdict-save ispell-silently-savep)
- ;; NB: Cancels ispell-quit incorrectly if called from ispell-region
- (if ispell-quit (setq ispell-quit nil replace 'quit))))
+ ;; At this point it used to ignore 2-letter words.
+ ;; But that is silly; if the user asks for it, we should do it. - rms.
+ (or quietly
+ (message "Checking spelling of %s..."
+ (funcall ispell-format-word word)))
+ (ispell-send-string "%\n") ; put in verbose mode
+ (ispell-send-string (concat "^" word "\n"))
+ ;; wait until ispell has processed word
+ (while (progn
+ (ispell-accept-output)
+ (not (string= "" (car ispell-filter)))))
+ ;;(ispell-send-string "!\n") ;back to terse mode.
+ (setq ispell-filter (cdr ispell-filter)) ; remove extra \n
+ (if (and ispell-filter (listp ispell-filter))
+ (if (> (length ispell-filter) 1)
+ (error "Ispell and its process have different character maps")
+ (setq poss (ispell-parse-output (car ispell-filter)))))
+ (cond ((eq poss t)
+ (or quietly
+ (message "%s is correct"
+ (funcall ispell-format-word word)))
+ (and (fboundp 'extent-at)
+ (extent-at start)
+ (delete-extent (extent-at start))))
+ ((stringp poss)
+ (or quietly
+ (message "%s is correct because of root %s"
+ (funcall ispell-format-word word)
+ (funcall ispell-format-word poss)))
+ (and (fboundp 'extent-at)
+ (extent-at start)
+ (delete-extent (extent-at start))))
+ ((null poss) (message "Error in ispell process"))
+ (ispell-check-only ; called from ispell minor mode.
+ (if (fboundp 'make-extent)
+ (let ((ext (make-extent start end)))
+ (set-extent-property ext 'face ispell-highlight-face)
+ (set-extent-property ext 'priority 2000))
+ (beep)
+ (message "%s is incorrect"(funcall ispell-format-word word))))
+ (t ; prompt for correct word.
+ (save-window-excursion
+ (setq replace (ispell-command-loop
+ (car (cdr (cdr poss)))
+ (car (cdr (cdr (cdr poss))))
+ (car poss) start end)))
+ (cond ((equal 0 replace)
+ (ispell-add-per-file-word-list (car poss)))
+ (replace
+ (setq new-word (if (atom replace) replace (car replace))
+ cursor-location (+ (- (length word) (- end start))
+ cursor-location))
+ (if (not (equal new-word (car poss)))
+ (progn
+ (delete-region start end)
+ (setq start (point))
+ (ispell-insert-word new-word)
+ (setq end (point))))
+ (if (not (atom replace)) ;recheck spelling of replacement
+ (progn
+ (if (car (cdr replace)) ; query replace requested
+ (save-window-excursion
+ (query-replace word new-word t)))
+ (goto-char start)
+ ;; single word could be split into multiple words
+ (setq ispell-quit (not (ispell-region start end)))
+ ))))
+ ;; keep if rechecking word and we keep choices win.
+ (if (get-buffer ispell-choices-buffer)
+ (kill-buffer ispell-choices-buffer))))
+ (ispell-pdict-save ispell-silently-savep)
+ ;; NB: Cancels ispell-quit incorrectly if called from ispell-region
+ (if ispell-quit (setq ispell-quit nil replace 'quit))
(goto-char cursor-location) ; return to original location
replace)))
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el
index 635bb6b5a98..9db111ea7a9 100644
--- a/lisp/textmodes/org.el
+++ b/lisp/textmodes/org.el
@@ -1,11 +1,11 @@
-;;; org.el --- Outline-based notes management and organizer
+;; org.el --- Outline-based notes management and organizer
;; Carstens outline-mode for keeping track of everything.
;; Copyright (c) 2004, 2005 Free Software Foundation
;;
;; Author: Carsten Dominik <dominik at science dot uva dot nl>
;; Keywords: outlines, hypermedia, calendar
;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
-;; Version: 3.11
+;; Version: 3.12
;;
;; This file is part of GNU Emacs.
;;
@@ -80,10 +80,20 @@
;;
;; Changes:
;; -------
+;; Version 3.12
+;; - Tables can store formulas (one per column) and compute fields.
+;; Not quite like a full spreadsheet, but very powerful.
+;; - table.el keybinding is now `C-c ~'.
+;; - Numeric argument to org-cycle does `show-subtree' above on level ARG.
+;; - Small changes to keys in agenda buffer. Affected keys:
+;; [w] weekly view; [d] daily view; [D] toggle diary inclusion.
+;; - Bug fixes.
+;;
;; Version 3.11
;; - Links inserted with C-c C-l are now by default enclosed in angle
;; brackets. See the new variable `org-link-format'.
;; - ">" terminates a link, this is a way to have several links in a line.
+;; Both "<" and ">" are no longer allowed as characters in a link.
;; - Archiving of finished tasks.
;; - C-<up>/<down> bindings removed, to allow access to paragraph commands.
;; - Compatibility with CUA-mode (see variable `org-CUA-compatible').
@@ -168,7 +178,7 @@
;;; Customization variables
-(defvar org-version "3.11"
+(defvar org-version "3.12"
"The version number of the file org.el.")
(defun org-version ()
(interactive)
@@ -445,7 +455,7 @@ is used instead.")
(goto-char (point-min))
(while (re-search-forward re nil t)
(setq key (match-string 1) value (match-string 2))
- (cond
+ (cond
((equal key "CATEGORY")
(if (string-match "[ \t]+$" value)
(setq value (replace-match "" t t value)))
@@ -485,7 +495,7 @@ is used instead.")
org-todo-kwd-max-priority (1- (length org-todo-keywords))
org-ds-keyword-length (+ 2 (max (length org-deadline-string)
(length org-scheduled-string)))
- org-done-string
+ org-done-string
(nth (1- (length org-todo-keywords)) org-todo-keywords)
org-todo-regexp
(concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords
@@ -565,7 +575,7 @@ When nil, cursor will remain in the current window."
(defcustom org-select-agenda-window t
"Non-nil means, after creating an agenda, move cursor into Agenda window.
-When nil, cursor will remain in the current window."
+When nil, cursor will remain in the current window."
:group 'org-agenda
:type 'boolean)
@@ -601,7 +611,7 @@ When nil, always start on the current day."
When nil, date-less entries will only be shown if `org-agenda' is called
with a prefix argument.
When non-nil, the TODO entries will be listed at the top of the agenda, before
-the entries for specific days."
+the entries for specific days."
:group 'org-agenda
:type 'boolean)
@@ -646,7 +656,7 @@ priority.
Leaving out `category-keep' would mean that items will be sorted across
categories by priority."
:group 'org-agenda
- :type '(repeat
+ :type '(repeat
(choice
(const time-up)
(const time-down)
@@ -722,7 +732,7 @@ the variable `org-agenda-time-grid'."
:group 'org-agenda
:type 'boolean)
-(defcustom org-agenda-time-grid
+(defcustom org-agenda-time-grid
'((daily today require-timed)
"----------------"
(800 1000 1200 1400 1600 1800 2000))
@@ -741,7 +751,7 @@ The second item is a string which will be places behing the grid time.
The third item is a list of integers, indicating the times that should have
a grid line."
:group 'org-agenda
- :type
+ :type
'(list
(set :greedy t :tag "Grid Display Options"
(const :tag "Show grid in single day agenda display" daily)
@@ -835,7 +845,7 @@ unnecessary clutter."
(defcustom org-archive-location "%s_archive::"
"The location where subtrees should be archived.
-This string consists of two parts, separated by a double-colon.
+This string consists of two parts, separated by a double-colon.
The first part is a file name - when omitted, archiving happens in the same
file. %s will be replaced by the current file name (without directory part).
@@ -864,7 +874,7 @@ Here are a few examples:
You may set this option on a per-file basis by adding to the buffer a
line like
-
+
#+ARCHIVE: basement::** Finished Tasks"
:group 'org-structure
:type 'string)
@@ -1201,9 +1211,70 @@ line will be formatted with <th> tags."
:group 'org-table
:type 'boolean)
+
+(defgroup org-table-calculation nil
+ "Options concerning tables in Org-mode."
+ :tag "Org Table Calculation"
+ :group 'org)
+
(defcustom org-table-copy-increment t
"Non-nil means, increment when copying current field with \\[org-table-copy-down]."
- :group 'org-table
+ :group 'org-table-calculation
+ :type 'boolean)
+
+(defcustom org-calc-default-modes
+ '(calc-internal-prec 12
+ calc-float-format (float 5)
+ calc-angle-mode deg
+ calc-prefer-frac nil
+ calc-symbolic-mode nil)
+ "List with Calc mode settings for use in calc-eval for table formulas.
+The list must contain alternating symbols (calc modes variables and values.
+Don't remove any of the default settings, just change the values. Org-mode
+relies on the variables to be present in the list."
+ :group 'org-table-calculation
+ :type 'plist)
+
+(defcustom org-table-formula-evaluate-inline t
+ "Non-nil means, TAB and RET evaluate a formula in current table field.
+If the current field starts with an equal sign, it is assumed to be a formula
+which should be evaluated as described in the manual and in the documentation
+string of the command `org-table-eval-formula'. This feature requires the
+Emacs calc package.
+When this variable is nil, formula calculation is only available through
+the command \\[org-table-eval-formula]."
+ :group 'org-table-calculation
+ :type 'boolean)
+
+
+(defcustom org-table-formula-use-constants t
+ "Non-nil means, interpret constants in formulas in tables.
+A constant looks like `$c' or `$Grav' and will be replaced before evaluation
+by the value given in `org-table-formula-constants', or by a value obtained
+from the `constants.el' package."
+ :group 'org-table-calculation
+ :type 'boolean)
+
+(defcustom org-table-formula-constants nil
+ "Alist with constant names and values, for use in table formulas.
+The car of each element is a name of a constant, without the `$' before it.
+The cdr is the value as a string. For example, if you'd like to use the
+speed of light in a formula, you would configure
+
+ (setq org-table-formula-constants '((\"c\" . \"299792458.\")))
+
+and then use it in an equation like `$1*$c'."
+ :group 'org-table-calculation
+ :type '(repeat
+ (cons (string :tag "name")
+ (string :tag "value"))))
+
+(defcustom org-table-formula-numbers-only nil
+ "Non-nil means, calculate only with numbers in table formulas.
+Then all input fields will be converted to a number, and the result
+must also be a number. When nil, calc's full potential is available
+in table calculations, including symbolics etc."
+ :group 'org-table-calculation
:type 'boolean)
(defcustom org-table-tab-recognizes-table.el t
@@ -1432,7 +1503,6 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
:group 'org-export
:type 'boolean)
-
(defgroup org-faces nil
"Faces for highlighting in Org-mode."
:tag "Org Faces"
@@ -1556,7 +1626,16 @@ When this is non-nil, the headline after the keyword is set to the
"Face for items scheduled previously, and not yet done."
:group 'org-faces)
-(defface org-link
+(defface org-formula
+ '((((type tty pc) (class color) (background light)) (:foreground "red"))
+ (((type tty pc) (class color) (background dark)) (:foreground "red1"))
+ (((class color) (background light)) (:foreground "Firebrick"))
+ (((class color) (background dark)) (:foreground "chocolate1"))
+ (t (:bold t :italic t)))
+ "Face for items scheduled previously, and not yet done."
+ :group 'org-faces)
+
+(defface org-link
'((((type tty) (class color)) (:foreground "cyan" :weight bold))
(((class color) (background light)) (:foreground "Purple"))
(((class color) (background dark)) (:foreground "Cyan"))
@@ -1649,6 +1728,7 @@ When this is non-nil, the headline after the keyword is set to the
(defvar org-struct-menu)
(defvar org-org-menu)
+(defvar org-tbl-menu)
;; We use a before-change function to check if a table might need
;; an update.
@@ -1656,14 +1736,13 @@ When this is non-nil, the headline after the keyword is set to the
"Indicates of a table might need an update.
This variable is set by `org-before-change-function'. `org-table-align'
sets it back to nil.")
-
(defvar org-mode-hook nil)
(defvar org-inhibit-startup nil) ; Dynamically-scoped param.
;;;###autoload
(define-derived-mode org-mode outline-mode "Org"
- "Outline-based notes management and organizer, alias
+ "Outline-based notes management and organizer, alias
\"Carstens outline-mode for keeping track of everything.\"
Org-mode develops organizational tasks around a NOTES file which
@@ -1681,6 +1760,7 @@ The following commands are available:
\\{org-mode-map}"
(easy-menu-add org-org-menu)
+ (easy-menu-add org-tbl-menu)
(org-install-agenda-files-menu)
(setq outline-regexp "\\*+")
(if org-startup-truncated (setq truncate-lines t))
@@ -1693,11 +1773,11 @@ The following commands are available:
(add-hook 'before-change-functions 'org-before-change-function nil
'local)
;; Paragraph regular expressions
- (set (make-local-variable 'paragraph-separate) "\f\\|[ ]*$")
+ (set (make-local-variable 'paragraph-separate) "\f\\|[ ]*$\\|\\([*\f]+\\)")
(set (make-local-variable 'paragraph-start) "\f\\|[ ]*$\\|\\([*\f]+\\)")
;; Inhibit auto-fill for headers, tables and fixed-width lines.
(set (make-local-variable 'auto-fill-inhibit-regexp)
- (concat "\\*"
+ (concat "\\*\\|#"
(if (or org-enable-table-editor org-enable-fixed-width-editor)
(concat
"\\|[ \t]*["
@@ -1709,6 +1789,20 @@ The following commands are available:
(interactive-p)
(= (point-min) (point-max)))
(insert " -*- mode: org -*-\n\n"))
+
+ ;; Get rid of Outline menus, they are not needed
+ ;; Need to do this here because define-derived-mode sets up
+ ;; the keymap so late.
+ (if org-xemacs-p
+ (progn
+ (delete-menu-item '("Headings"))
+ (delete-menu-item '("Show"))
+ (delete-menu-item '("Hide"))
+ (set-menubar-dirty-flag))
+ (define-key org-mode-map [menu-bar headings] 'undefined)
+ (define-key org-mode-map [menu-bar hide] 'undefined)
+ (define-key org-mode-map [menu-bar show] 'undefined))
+
(unless org-inhibit-startup
(if org-startup-with-deadline-check
(call-interactively 'org-check-deadlines)
@@ -1725,10 +1819,13 @@ The following commands are available:
(beginning-of-line 1)
(looking-at "\\s-*\\(|\\|\\+-+\\)")))
+(defsubst org-current-line (&optional pos)
+ (+ (if (bolp) 1 0) (count-lines (point-min) (or pos (point)))))
+
;;; Font-Lock stuff
(defvar org-mouse-map (make-sparse-keymap))
-(define-key org-mouse-map
+(define-key org-mouse-map
(if org-xemacs-p [button2] [mouse-2]) 'org-open-at-mouse)
(define-key org-mouse-map
(if org-xemacs-p [button3] [mouse-3]) 'org-find-file-at-mouse)
@@ -1804,11 +1901,10 @@ The following commands are available:
(list (concat "\\<" org-scheduled-string) '(0 'org-warning t))
;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)"
;; (3 'bold))
- ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)"
+ ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)"
;; (3 'italic))
- ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)"
+ ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)"
;; (3 'underline))
- '("\\<FIXME\\>" (0 'org-warning t))
(list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>")
'(1 'org-warning t))
'("^#.*" (0 'font-lock-comment-face t))
@@ -1819,13 +1915,16 @@ The following commands are available:
'(1 'org-done t)))
'("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
(1 'org-table t))
- '("^[ \t]*\\(:.*\\)" (1 'org-table t)))))
+ '("^[ \t]*\\(:.*\\)" (1 'org-table t))
+ '("| *\\(=[^|\n]*\\)" (1 'org-formula t))
+ '("^[ \t]*| *\\([#!$*]\\) *|" (1 'org-formula t))
+ )))
(set (make-local-variable 'org-font-lock-keywords)
(append
(if org-noutline-p ; FIXME: I am not sure if eval will work
; on XEmacs if noutline is ever ported
'((eval . (list "^\\(\\*+\\).*"
- 0 '(nth
+ 0 '(nth
(% (- (match-end 1) (match-beginning 1) 1)
org-n-levels)
org-level-faces)
@@ -1839,7 +1938,7 @@ The following commands are available:
(set (make-local-variable 'font-lock-defaults)
'(org-font-lock-keywords t nil nil backward-paragraph))
(kill-local-variable 'font-lock-keywords) nil))
-
+
(defun org-unfontify-region (beg end &optional maybe_loudly)
"Remove fontification and activation overlays from links."
(font-lock-default-unfontify-region beg end)
@@ -1870,8 +1969,9 @@ The following commands are available:
zoom in further.
3. SUBTREE: Show the entire subtree, including body text.
-- When there is a numeric prefix, go ARG levels up and do a `show-subtree',
- keeping cursor position.
+- When there is a numeric prefix, go up to a heading with level ARG, do
+ a `show-subtree' and return to the previous cursor position. If ARG
+ is negative, go up that many levels.
- When point is not at the beginning of a headline, execute
`indent-relative', like TAB normally does. See the option
@@ -1937,7 +2037,8 @@ The following commands are available:
;; Show-subtree, ARG levels up from here.
(save-excursion
(org-back-to-heading)
- (outline-up-heading arg)
+ (outline-up-heading (if (< arg 0) (- arg)
+ (- (outline-level) arg)))
(org-show-subtree)))
((save-excursion (beginning-of-line 1) (looking-at outline-regexp))
@@ -2273,8 +2374,6 @@ in the region."
(save-excursion
(setq end (copy-marker end))
(goto-char beg)
- ;; (if (fboundp 'deactivate-mark) (deactivate-mark))
- ;; (if (fboundp 'zmacs-deactivate-region) (zmacs-deactivate-region))
(if (and (re-search-forward (concat "^" outline-regexp) nil t)
(< (point) end))
(funcall fun))
@@ -2558,7 +2657,7 @@ heading be marked DONE, and the current time will be added."
(end-of-line 0))
;; Make the heading visible, and the following as well
(let ((org-show-following-heading t)) (org-show-hierarchy-above))
- (if (re-search-forward
+ (if (re-search-forward
(concat "^" (regexp-quote (make-string level ?*)) "[ \t]")
nil t)
(progn (goto-char (match-beginning 0)) (insert "\n")
@@ -2605,9 +2704,10 @@ At all other locations, this simply calls `ispell-complete-word'."
(let* ((end (point))
(beg (save-excursion
(if (equal (char-before (point)) ?\ ) (backward-char 1))
- (skip-chars-backward "a-zA-Z0-9_:")
+ (skip-chars-backward "a-zA-Z0-9_:$")
(point)))
(texp (equal (char-before beg) ?\\))
+ (form (equal (char-before beg) ?=))
(opt (equal (buffer-substring (max (point-at-bol) (- beg 2))
beg)
"#+"))
@@ -2617,13 +2717,16 @@ At all other locations, this simply calls `ispell-complete-word'."
(table (cond
(opt
(setq type :opt)
- (mapcar (lambda (x)
+ (mapcar (lambda (x)
(string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
(cons (match-string 2 x) (match-string 1 x)))
(org-split-string (org-get-current-options) "\n")))
- (texp
+ (texp
(setq type :tex)
org-html-entities)
+ (form
+ (setq type :form)
+ '(("sum") ("sumv") ("sumh")))
((string-match "\\`\\*+[ \t]*\\'"
(buffer-substring (point-at-bol) beg))
(setq type :todo)
@@ -2631,7 +2734,7 @@ At all other locations, this simply calls `ispell-complete-word'."
(t (progn (ispell-complete-word arg) (throw 'exit nil)))))
(completion (try-completion pattern table)))
(cond ((eq completion t)
- (if (equal type :opt)
+ (if (equal type :opt)
(insert (substring (cdr (assoc (upcase pattern) table))
(length pattern)))))
((null completion)
@@ -2639,7 +2742,7 @@ At all other locations, this simply calls `ispell-complete-word'."
(ding))
((not (string= pattern completion))
(delete-region beg end)
- (if (string-match " +$" completion)
+ (if (string-match " +$" completion)
(setq completion (replace-match "" t t completion)))
(insert completion)
(if (get-buffer-window "*Completions*")
@@ -2876,9 +2979,9 @@ ACTION can be set, up, or down."
(save-match-data
(if (not (string-match org-priority-regexp s))
(* 1000 (- org-lowest-priority org-default-priority))
- (* 1000 (- org-lowest-priority
+ (* 1000 (- org-lowest-priority
(string-to-char (match-string 2 s)))))))
-
+
;;; Timestamps
(defvar org-last-changed-timestamp nil)
@@ -2910,7 +3013,7 @@ at the cursor, it will be modified."
(setq time (let ((this-command this-command))
(org-read-date arg 'totime)))
(and (org-at-timestamp-p) (replace-match
- (setq org-last-changed-timestamp
+ (setq org-last-changed-timestamp
(format-time-string fmt time))
t t))
(message "Timestamp updated"))
@@ -2940,8 +3043,8 @@ but this can be configured with the variables `parse-time-months' and
While prompting, a calendar is popped up - you can also select the
date with the mouse (button 1). The calendar shows a period of three
-month. To scroll it to other months, use the keys `>' and `<'.
-If you don't like the calendar, turn it off with
+month. To scroll it to other months, use the keys `>' and `<'.
+If you don't like the calendar, turn it off with
\(setq org-popup-calendar-for-date-prompt nil).
With optional argument TO-TIME, the date will immediately be converted
@@ -2955,7 +3058,7 @@ used to insert the time stamp into the buffer to include the time."
;; Default time is either today, or, when entering a range,
;; the range start.
(if (save-excursion
- (re-search-backward
+ (re-search-backward
(concat org-ts-regexp "--\\=")
(- (point) 20) t))
(apply
@@ -3066,7 +3169,7 @@ This is used by `org-read-date' in a temporary keymap for the calendar buffer."
(time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
(setq ans1 (format-time-string "%Y-%m-%d" time)))
(if (active-minibuffer-window) (exit-minibuffer))))
-
+
(defun org-check-deadlines (ndays)
"Check if there are any deadlines due or past due.
A deadline is considered due if it happens within `org-deadline-warning-days'
@@ -3358,10 +3461,10 @@ The following commands are available:
(add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local)
(add-hook 'pre-command-hook 'org-unhighlight nil 'local)
(setq org-agenda-follow-mode nil)
- (easy-menu-change
+ (easy-menu-change
'("Agenda") "Agenda Files"
(append
- (list
+ (list
["Edit File List" (customize-variable 'org-agenda-files) t]
"--")
(mapcar 'org-file-menu-entry org-agenda-files)))
@@ -3378,7 +3481,8 @@ The following commands are available:
(define-key org-agenda-mode-map "l" 'org-agenda-recenter)
(define-key org-agenda-mode-map "t" 'org-agenda-todo)
(define-key org-agenda-mode-map "." 'org-agenda-goto-today)
-(define-key org-agenda-mode-map "w" 'org-agenda-toggle-week-view)
+(define-key org-agenda-mode-map "d" 'org-agenda-day-view)
+(define-key org-agenda-mode-map "w" 'org-agenda-week-view)
(define-key org-agenda-mode-map (org-key 'S-right) 'org-agenda-date-later)
(define-key org-agenda-mode-map (org-key 'S-left) 'org-agenda-date-earlier)
@@ -3388,7 +3492,7 @@ The following commands are available:
(int-to-string (pop l)) 'digit-argument)))
(define-key org-agenda-mode-map "f" 'org-agenda-follow-mode)
-(define-key org-agenda-mode-map "d" 'org-agenda-toggle-diary)
+(define-key org-agenda-mode-map "D" 'org-agenda-toggle-diary)
(define-key org-agenda-mode-map "g" 'org-agenda-toggle-time-grid)
(define-key org-agenda-mode-map "r" 'org-agenda-redo)
(define-key org-agenda-mode-map "q" 'org-agenda-quit)
@@ -3422,7 +3526,7 @@ The following commands are available:
(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map)
"Local keymap for agenda entries from Org-mode.")
-(define-key org-agenda-keymap
+(define-key org-agenda-keymap
(if org-xemacs-p [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse)
(define-key org-agenda-keymap
(if org-xemacs-p [(button3)] [(mouse-3)]) 'org-agenda-show-mouse)
@@ -3434,7 +3538,7 @@ The following commands are available:
["Show" org-agenda-show t]
["Go To (other window)" org-agenda-goto t]
["Go To (one window)" org-agenda-switch-to t]
- ["Follow Mode" org-agenda-follow-mode
+ ["Follow Mode" org-agenda-follow-mode
:style toggle :selected org-agenda-follow-mode :active t]
"--"
["Cycle TODO" org-agenda-todo t]
@@ -3454,8 +3558,11 @@ The following commands are available:
["Next Dates" org-agenda-later (local-variable-p 'starting-day)]
["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)]
"--"
- ["Week/Day View" org-agenda-toggle-week-view
- (local-variable-p 'starting-day)]
+ ["Day View" org-agenda-day-view :active (local-variable-p 'starting-day)
+ :style radio :selected (equal org-agenda-ndays 1)]
+ ["Week View" org-agenda-week-view :active (local-variable-p 'starting-day)
+ :style radio :selected (equal org-agenda-ndays 7)]
+ "--"
["Include Diary" org-agenda-toggle-diary
:style toggle :selected org-agenda-include-diary :active t]
["Use Time Grid" org-agenda-toggle-time-grid
@@ -3552,7 +3659,7 @@ dates."
(org-respect-restriction t)
(past t)
s e rtn d)
- (setq org-agenda-redo-command
+ (setq org-agenda-redo-command
(list 'progn
(list 'switch-to-buffer-other-window (current-buffer))
(list 'org-timeline include-all)))
@@ -3561,7 +3668,7 @@ dates."
(setq day-numbers (delq nil (mapcar (lambda(x)
(if (>= x today) x nil))
day-numbers))))
- (switch-to-buffer-other-window
+ (switch-to-buffer-other-window
(get-buffer-create org-agenda-buffer-name))
(setq buffer-read-only nil)
(erase-buffer)
@@ -3576,7 +3683,7 @@ dates."
(setq date (calendar-gregorian-from-absolute d))
(setq s (point))
(if dotodo
- (setq rtn (org-agenda-get-day-entries
+ (setq rtn (org-agenda-get-day-entries
entry date :todo :timestamp))
(setq rtn (org-agenda-get-day-entries entry date :timestamp)))
(if (or rtn (equal d today))
@@ -3632,7 +3739,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)
- (setq org-agenda-redo-command
+ (setq org-agenda-redo-command
(list 'org-agenda include-all start-day ndays))
;; Make the list of days
(setq ndays (or ndays org-agenda-ndays)
@@ -3644,7 +3751,7 @@ NDAYS defaults to `org-agenda-ndays'."
(if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name)))
(progn
(delete-other-windows)
- (switch-to-buffer-other-window
+ (switch-to-buffer-other-window
(get-buffer-create org-agenda-buffer-name))))
(setq buffer-read-only nil)
(erase-buffer)
@@ -3662,7 +3769,7 @@ NDAYS defaults to `org-agenda-ndays'."
rtn (org-agenda-get-day-entries
file date :todo))
(setq rtnall (append rtnall rtn))))
- (when rtnall
+ (when rtnall
(insert "ALL CURRENTLY OPEN TODO ITEMS:\n")
(add-text-properties (point-min) (1- (point))
(list 'face 'org-link))
@@ -3696,12 +3803,12 @@ NDAYS defaults to `org-agenda-ndays'."
(extract-calendar-year date)))
(put-text-property s (1- (point)) 'face
'org-link)
- (if rtnall (insert
+ (if rtnall (insert
(org-finalize-agenda-entries ;; FIXME: condition needed
(org-agenda-add-time-grid-maybe
rtnall nd todayp))
"\n"))
- (put-text-property s (1- (point)) 'day d))))
+ (put-text-property s (1- (point)) 'day d))))
(goto-char (point-min))
(setq buffer-read-only t)
(if org-fit-agenda-window
@@ -3784,19 +3891,29 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
(org-agenda (if (boundp 'include-all-loc) include-all-loc nil)
(- starting-day (* arg org-agenda-ndays))))
-(defun org-agenda-toggle-week-view ()
- "Toggle weekly/daily view for aagenda."
+(defun org-agenda-week-view ()
+ "Switch to weekly view for agenda."
+ (interactive)
+ (unless (boundp 'starting-day)
+ (error "Not allowed"))
+ (setq org-agenda-ndays 7)
+ (org-agenda include-all-loc
+ (or (get-text-property (point) 'day)
+ starting-day))
+ (org-agenda-set-mode-name)
+ (message "Switched to week view"))
+
+(defun org-agenda-day-view ()
+ "Switch to weekly view for agenda."
(interactive)
(unless (boundp 'starting-day)
(error "Not allowed"))
- (setq org-agenda-ndays
- (if (equal org-agenda-ndays 1) 7 1))
- (org-agenda include-all-loc
+ (setq org-agenda-ndays 1)
+ (org-agenda include-all-loc
(or (get-text-property (point) 'day)
starting-day))
(org-agenda-set-mode-name)
- (message "Switched to %s view"
- (if (equal org-agenda-ndays 1) "day" "week")))
+ (message "Switched to day view"))
(defun org-agenda-next-date-line (&optional arg)
"Jump to the next line indicating a date in agenda buffer."
@@ -3880,7 +3997,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
"Get the (Emacs Calendar) diary entries for DATE."
(let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*")
(diary-display-hook '(fancy-diary-display))
- (list-diary-entries-hook
+ (list-diary-entries-hook
(cons 'org-diary-default-entry list-diary-entries-hook))
entries
(org-disable-diary t))
@@ -3904,12 +4021,12 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
(kill-buffer fancy-diary-buffer)))
(when entries
(setq entries (org-split-string entries "\n"))
- (setq entries
- (mapcar
+ (setq entries
+ (mapcar
(lambda (x)
(setq x (org-format-agenda-item "" x "Diary" 'time))
;; Extend the text properties to the beginning of the line
- (add-text-properties
+ (add-text-properties
0 (length x)
(text-properties-at (1- (length x)) x)
x)
@@ -3950,7 +4067,7 @@ date. Itt also removes lines that contain only whitespace."
0 (length string)
(list 'mouse-face 'highlight
'keymap org-agenda-keymap
- 'help-echo
+ 'help-echo
(format
"mouse-2 or RET jump to diary file %s"
(abbreviate-file-name (buffer-file-name)))
@@ -3972,7 +4089,7 @@ Needed to avoid empty dates which mess up holiday display."
These are the files which are being checked for agenda entries.
Optional argument FILE means, use this file instead of the current.
It is possible (but not recommended) to add this function to the
-`org-mode-hook'."
+`org-mode-hook'."
(interactive)
(catch 'exit
(let* ((file (or file (buffer-file-name)
@@ -3987,7 +4104,7 @@ It is possible (but not recommended) to add this function to the
org-agenda-files))))
(if (not present)
(progn
- (setq org-agenda-files
+ (setq org-agenda-files
(cons afile org-agenda-files))
;; Make sure custom.el does not end up with Org-mode
(let ((org-mode-hook nil) (default-major-mode 'fundamental-mode))
@@ -4004,7 +4121,7 @@ Optional argument FILE means, use this file instead of the current."
(let* ((file (or file (buffer-file-name)))
(true-file (file-truename file))
(afile (abbreviate-file-name file))
- (files (delq nil (mapcar
+ (files (delq nil (mapcar
(lambda (x)
(if (equal true-file
(file-truename x))
@@ -4051,6 +4168,7 @@ sure that TODAY is included in the list."
"Return diary information from org-files.
This function can be used in a \"sexp\" diary entry in the Emacs calendar.
It accesses org files and extracts information from those files to be
+
listed in the diary. The function accepts arguments specifying what
items should be listed. The following arguments are allowed:
@@ -4089,9 +4207,9 @@ also be written as
The function expects the lisp variables `entry' and `date' to be provided
by the caller, because this is how the calendar works. Don't use this
-function from a program - use `org-agenda-get-day-entries' instead."
+function from a program - use `org-agenda-get-day-entries' instead."
(org-agenda-maybe-reset-markers)
- (org-compile-agenda-prefix-format org-agenda-prefix-format)
+ (org-compile-prefix-format org-agenda-prefix-format)
(setq args (or args '(:deadline :scheduled :timestamp)))
(let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
(list entry)
@@ -4131,7 +4249,7 @@ the documentation of `org-diary'."
(if (org-region-active-p)
;; Respect a region to restrict search
(narrow-to-region (region-beginning) (region-end)))
- ;; If we work for the calendar or many files,
+ ;; If we work for the calendar or many files,
;; get rid of any restriction
(widen))
;; The way we repeatedly append to `results' makes it O(n^2) :-(
@@ -4197,7 +4315,7 @@ the documentation of `org-diary'."
(goto-char (match-beginning 1))
(setq marker (org-agenda-new-marker (point-at-bol))
txt (org-format-agenda-item "" (match-string 1))
- priority
+ priority
(+ (org-get-priority txt)
(if org-todo-kwd-priority-p
(- org-todo-kwd-max-priority -2
@@ -4269,7 +4387,7 @@ the documentation of `org-diary'."
(if deadlinep
(add-text-properties
0 (length txt)
- (list 'face
+ (list 'face
(if donep 'org-done 'org-warning)
'undone-face 'org-warning
'done-face 'org-done
@@ -4329,8 +4447,8 @@ the documentation of `org-diary'."
(setq txt org-agenda-no-heading-message))
(when txt
(add-text-properties
- 0 (length txt)
- (append
+ 0 (length txt)
+ (append
(list 'org-marker (org-agenda-new-marker pos)
'org-hd-marker (org-agenda-new-marker pos1)
'priority (+ (- 10 diff) (org-get-priority txt))
@@ -4422,7 +4540,7 @@ the documentation of `org-diary'."
(setq hdmarker (org-agenda-new-marker (match-end 1)))
(goto-char (match-end 1))
(looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
- (setq txt (org-format-agenda-item
+ (setq txt (org-format-agenda-item
(format (if (= d1 d2) "" "(%d/%d): ")
(1+ (- d0 d1)) (1+ (- d2 d1)))
(match-string 1) nil (if (= d0 d1) timestr))))
@@ -4504,7 +4622,7 @@ only the correctly processes TXT should be returned - this is used by
(setq s0 (match-string 0 ts)
s1 (match-string (if plain 1 2) ts)
s2 (match-string (if plain 8 4) ts))
-
+
;; If the times are in TXT (not in DOTIMES), and the prefix will list
;; them, we might want to remove them there to avoid duplication.
;; The user can turn this off with a variable.
@@ -4517,7 +4635,7 @@ only the correctly processes TXT should be returned - this is used by
;; Normalize the time(s) to 24 hour
(if s1 (setq s1 (org-get-time-of-day s1 'string)))
(if s2 (setq s2 (org-get-time-of-day s2 'string))))
-
+
;; Create the final string
(if noprefix
(setq rtn txt)
@@ -4529,7 +4647,7 @@ only the correctly processes TXT should be returned - this is used by
category (if (symbolp category) (symbol-name category) category))
;; Evaluate the compiled format
(setq rtn (concat (eval org-prefix-format-compiled) txt)))
-
+
;; And finally add the text properties
(add-text-properties
0 (length rtn) (list 'category (downcase category)
@@ -4560,11 +4678,11 @@ only the correctly processes TXT should be returned - this is used by
(while (setq time (pop gridtimes))
(unless (and remove (member time have))
(setq time (int-to-string time))
- (push (org-format-agenda-item
+ (push (org-format-agenda-item
nil string "" ;; FIXME: put a category?
(concat (substring time 0 -2) ":" (substring time -2)))
new)
- (put-text-property
+ (put-text-property
1 (length (car new)) 'face 'org-time-grid (car new))))
(if (member 'time-up org-agenda-sorting-strategy)
(append new list)
@@ -4603,7 +4721,7 @@ If not found, return nil.
The optional STRING argument forces conversion into a 5 character wide string
HH:MM."
(save-match-data
- (when
+ (when
(or
(string-match
"\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
@@ -4659,7 +4777,7 @@ HH:MM."
(category-up (org-cmp-category a b))
(category-down (if category-up (- category-up) nil))
(category-keep (if category-up +1 nil))) ; FIXME +1 or -1?
- (cdr (assoc
+ (cdr (assoc
(eval (cons 'or org-agenda-sorting-strategy))
'((-1 . t) (1 . nil) (nil . nil))))))
@@ -4674,7 +4792,7 @@ and by additional input from the age of a schedules or deadline entry."
(defun org-agenda-goto (&optional highlight)
"Go to the Org-mode file which contains the item at point."
(interactive)
- (let* ((marker (or (get-text-property (point) 'org-marker)
+ (let* ((marker (or (get-text-property (point) 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker)))
@@ -4691,7 +4809,7 @@ and by additional input from the age of a schedules or deadline entry."
(defun org-agenda-switch-to ()
"Go to the Org-mode file which contains the item at point."
(interactive)
- (let* ((marker (or (get-text-property (point) 'org-marker)
+ (let* ((marker (or (get-text-property (point) 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker)))
@@ -4805,7 +4923,7 @@ the new TODO state."
(beginning-of-line 1)
(add-text-properties (point-at-bol) (point-at-eol) props)
(if fixface
- (add-text-properties
+ (add-text-properties
(point-at-bol) (point-at-eol)
(list 'face
(if org-last-todo-state-is-todo
@@ -4902,7 +5020,7 @@ be used to request time specification in the time stamp."
All the standard commands work: block, weekly etc"
(interactive)
(require 'diary-lib)
- (let* ((char (progn
+ (let* ((char (progn
(message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic")
(read-char-exclusive)))
(cmd (cdr (assoc char
@@ -4932,7 +5050,7 @@ All the standard commands work: block, weekly etc"
(progn
(fset 'calendar-cursor-to-date
(lambda (&optional error)
- (calendar-gregorian-from-absolute
+ (calendar-gregorian-from-absolute
(get-text-property point 'day))))
(call-interactively cmd))
(fset 'calendar-cursor-to-date oldf)))))
@@ -4955,7 +5073,7 @@ the cursor position."
(progn
(fset 'calendar-cursor-to-date
(lambda (&optional error)
- (calendar-gregorian-from-absolute
+ (calendar-gregorian-from-absolute
(get-text-property point 'day))))
(call-interactively cmd))
(fset 'calendar-cursor-to-date oldf))))
@@ -5005,7 +5123,7 @@ This is a command that has to be installed in `calendar-mode-map'."
(unless day
(error "Don't know which date to convert"))
(setq date (calendar-gregorian-from-absolute day))
- (setq s (concat
+ (setq s (concat
"Gregorian: " (calendar-date-string date) "\n"
"ISO: " (calendar-iso-date-string date) "\n"
"Day of Yr: " (calendar-day-of-year-string date) "\n"
@@ -5118,9 +5236,9 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
((string= type "shell")
(let ((cmd path))
- (while (string-match "@{" cmd)
+ (while (string-match "@{" cmd)
(setq cmd (replace-match "<" t t cmd)))
- (while (string-match "@}" cmd)
+ (while (string-match "@}" cmd)
(setq cmd (replace-match ">" t t cmd)))
(if (or (not org-confirm-shell-links)
(yes-or-no-p (format "Execute \"%s\" in the shell? " cmd)))
@@ -5217,7 +5335,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
(widen)
(goto-char (point-max))
(if (re-search-backward
- (concat "^Message-ID:\\s-+" (regexp-quote
+ (concat "^Message-ID:\\s-+" (regexp-quote
(or article "")))
nil t)
(rmail-what-message))))))
@@ -5304,7 +5422,7 @@ For file links, arg negates `org-line-numbers-in-file-links'."
(or (bbdb-record-name (bbdb-current-record))
(bbdb-record-company (bbdb-current-record))))
link (org-make-link cpltxt)))
-
+
((eq major-mode 'calendar-mode)
(let ((cd (calendar-cursor-to-date)))
(setq link
@@ -5330,8 +5448,8 @@ For file links, arg negates `org-line-numbers-in-file-links'."
folder)
(setq folder (replace-match "" t t folder)))
(setq cpltxt (concat author " on: " subject))
- (setq link (concat cpltxt "\n "
- (org-make-link
+ (setq link (concat cpltxt "\n "
+ (org-make-link
"vm:" folder "#" message-id))))))
((eq major-mode 'wl-summary-mode)
@@ -5343,7 +5461,7 @@ For file links, arg negates `org-line-numbers-in-file-links'."
(author (wl-summary-line-from)) ; FIXME: how to get author name?
(subject "???")) ; FIXME: How to get subject of email?
(setq cpltxt (concat author " on: " subject))
- (setq link (concat cpltxt "\n "
+ (setq link (concat cpltxt "\n "
(org-make-link
"wl:" wl-summary-buffer-folder-name
"#" message-id)))))
@@ -5357,7 +5475,7 @@ For file links, arg negates `org-line-numbers-in-file-links'."
(author (mail-fetch-field "from"))
(subject (mail-fetch-field "subject")))
(setq cpltxt (concat author " on: " subject))
- (setq link (concat cpltxt "\n "
+ (setq link (concat cpltxt "\n "
(org-make-link
"rmail:" folder "#" message-id)))))))
@@ -5411,7 +5529,7 @@ For file links, arg negates `org-line-numbers-in-file-links'."
(if (org-xor org-line-numbers-in-file-links arg)
(setq cpltxt
(concat cpltxt
- ":" (int-to-string
+ ":" (int-to-string
(+ (if (bolp) 1 0) (count-lines
(point-min) (point)))))))
(setq link (org-make-link cpltxt)))
@@ -5581,7 +5699,7 @@ If the variable `org-adapt-indentation' is non-nil, the entire text is
also indented so that it starts in the same column as the headline
\(i.e. after the stars).
-See also the variable `org-reverse-note-order'."
+See also the variable `org-reverse-note-order'."
(catch 'quit
(let* ((txt (buffer-substring (point-min) (point-max)))
(fastp current-prefix-arg)
@@ -5687,6 +5805,10 @@ See also the variable `org-reverse-note-order'."
"Detects an org-type table line.")
(defconst org-table-dataline-regexp "^[ \t]*|[^-]"
"Detects an org-type table line.")
+(defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)"
+ "Detects a table line marked for automatic recalculation.")
+(defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)"
+ "Detects a table line marked for automatic recalculation.")
(defconst org-table-hline-regexp "^[ \t]*|-"
"Detects an org-type table hline.")
(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]"
@@ -5843,6 +5965,7 @@ This is being used to correctly align a single field after TAB or RET.")
"List of max width of fields in each column.
This is being used to correctly align a single field after TAB or RET.")
+(defvar org-last-recalc-line nil)
(defun org-table-align ()
"Align the table at point by aligning all vertical bars."
@@ -5878,7 +6001,12 @@ This is being used to correctly align a single field after TAB or RET.")
(if (string-match "^ *" (car lines))
(setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ )))
;; Mark the hlines
- (setq lines (mapcar (lambda (l) (if (string-match "^ *|-" l) nil l))
+ (setq lines (mapcar (lambda (l)
+ (if (string-match "^ *|-" l)
+ nil
+ (if (string-match "[ \t]+$" l)
+ (substring l 0 (match-beginning 0))
+ l)))
lines))
;; Get the data fields
(setq fields (mapcar
@@ -5994,15 +6122,17 @@ With argument TABLE-TYPE, go to the end of a table.el-type table."
(let* ((pos (point)) s org-table-may-need-update
(col (org-table-current-column))
(num (nth (1- col) org-table-last-alignment))
- l f)
+ l f n o)
(when (> col 0)
(skip-chars-backward "^|\n")
(if (looking-at " *\\([^|\n]*?\\) *|")
(progn
(setq s (match-string 1)
+ o (match-string 0)
l (max 1 (- (match-end 0) (match-beginning 0) 3)))
- (setq f (format (if num " %%%ds |" " %%-%ds |") l))
- (replace-match (format f s t t)))
+ (setq f (format (if num " %%%ds |" " %%-%ds |") l)
+ n (format f s t t))
+ (or (equal n o) (replace-match n)))
(setq org-table-may-need-update t))
(goto-char pos))))))
@@ -6010,6 +6140,8 @@ With argument TABLE-TYPE, go to the end of a table.el-type table."
"Go to the next field in the current table.
Before doing so, re-align the table if necessary."
(interactive)
+ (org-table-maybe-eval-formula)
+ (org-table-maybe-recalculate-line)
(if (and org-table-automatic-realign
org-table-may-need-update)
(org-table-align))
@@ -6032,6 +6164,8 @@ Before doing so, re-align the table if necessary."
"Go to the previous field in the table.
Before doing so, re-align the table if necessary."
(interactive)
+ (org-table-justify-field-maybe)
+ (org-table-maybe-recalculate-line)
(if (and org-table-automatic-realign
org-table-may-need-update)
(org-table-align))
@@ -6048,6 +6182,8 @@ Before doing so, re-align the table if necessary."
"Go to the next row (same column) in the current table.
Before doing so, re-align the table if necessary."
(interactive)
+ (org-table-maybe-eval-formula)
+ (org-table-maybe-recalculate-line)
(if (or (looking-at "[ \t]*$")
(save-excursion (skip-chars-backward " \t") (bolp)))
(newline)
@@ -6071,7 +6207,7 @@ If the field at the cursor is empty, copy into it the content of the nearest
non-empty field above. With argument N, use the Nth non-empty field.
If the current field is not empty, it is copied down to the next row, and
the cursor is moved with it. Therefore, repeating this command causes the
-column to be filled row-by-row.
+column to be filled row-by-row.
If the variable `org-table-copy-increment' is non-nil and the field is an
integer, it will be incremented while copying."
(interactive "p")
@@ -6081,23 +6217,29 @@ integer, it will be incremented while copying."
(beg (org-table-begin))
txt)
(org-table-check-inside-data-field)
- (if non-empty (progn (org-table-next-row) (org-table-blank-field)))
- (if (save-excursion
- (setq txt
- (catch 'exit
- (while (progn (beginning-of-line 1)
- (re-search-backward org-table-dataline-regexp
- beg t))
- (org-table-goto-column colpos t)
- (if (and (looking-at
- "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
- (= (setq n (1- n)) 0))
- (throw 'exit (match-string 1)))))))
+ (if non-empty
+ (progn
+ (setq txt (org-trim field))
+ (org-table-next-row)
+ (org-table-blank-field))
+ (save-excursion
+ (setq txt
+ (catch 'exit
+ (while (progn (beginning-of-line 1)
+ (re-search-backward org-table-dataline-regexp
+ beg t))
+ (org-table-goto-column colpos t)
+ (if (and (looking-at
+ "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
+ (= (setq n (1- n)) 0))
+ (throw 'exit (match-string 1))))))))
+ (if txt
(progn
(if (and org-table-copy-increment
(string-match "^[0-9]+$" txt))
(setq txt (format "%d" (+ (string-to-int txt) 1))))
(insert txt)
+ (org-table-maybe-recalculate-line)
(org-table-align))
(error "No non-empty field found"))))
@@ -6119,10 +6261,10 @@ I.e. not on a hline or before the first or after the last column?"
(org-table-check-inside-data-field)
(if (and (interactive-p) (org-region-active-p))
(let (org-table-clip)
- (org-table-cut-region))
+ (org-table-cut-region (region-beginning) (region-end)))
(skip-chars-backward "^|")
(backward-char 1)
- (if (looking-at "|[^|]+")
+ (if (looking-at "|[^|\n]+")
(let* ((pos (match-beginning 0))
(match (match-string 0))
(len (length match)))
@@ -6136,15 +6278,16 @@ N defaults to current field.
If REPLACE is a string, replace field with this value. The return value
is always the old value."
(and n (org-table-goto-column n))
- (skip-chars-backward "^|")
+ (skip-chars-backward "^|\n")
(backward-char 1)
(if (looking-at "|[^|\r\n]*")
(let* ((pos (match-beginning 0))
(val (buffer-substring (1+ pos) (match-end 0))))
(if replace
(replace-match (concat "|" replace)))
- (goto-char (+ 2 pos))
- val)))
+ (goto-char (min (point-at-eol) (+ 2 pos)))
+ val)
+ (forward-char 1) ""))
(defun org-table-current-column ()
"Find out which column we are in.
@@ -6162,7 +6305,7 @@ When called interactively, column is also displayed in echo area."
(defun org-table-goto-column (n &optional on-delim force)
"Move the cursor to the Nth column in the current table line.
With optional argument ON-DELIM, stop with point before the left delimiter
-of the field.
+of the field.
If there are less than N fields, just go to after the last delimiter.
However, when FORCE is non-nil, create new columns if necessary."
(let ((pos (point-at-eol)))
@@ -6173,10 +6316,10 @@ However, when FORCE is non-nil, create new columns if necessary."
(and force
(progn (end-of-line 1)
(skip-chars-backward "^|")
- (insert " |")
- (backward-char 2) t)))))
+ (insert " | "))))))
+; (backward-char 2) t)))))
(when (and force (not (looking-at ".*|")))
- (save-excursion (end-of-line 1) (insert "|")))
+ (save-excursion (end-of-line 1) (insert " | ")))
(if on-delim
(backward-char 1)
(if (looking-at " ") (forward-char 1))))))
@@ -6255,8 +6398,9 @@ If TABLE-TYPE is non-nil, also chack for table.el-type tables."
(beginning-of-line 2))
(move-marker end nil)
(goto-line linepos)
- (org-table-goto-column colpos))
- (org-table-align))
+ (org-table-goto-column colpos)
+ (org-table-align)
+ (org-table-modify-formulas 'insert col)))
(defun org-table-find-dataline ()
"Find a dataline in the current table, which is needed for column commands."
@@ -6300,8 +6444,9 @@ If TABLE-TYPE is non-nil, also chack for table.el-type tables."
(beginning-of-line 2))
(move-marker end nil)
(goto-line linepos)
- (org-table-goto-column colpos))
- (org-table-align))
+ (org-table-goto-column colpos)
+ (org-table-align)
+ (org-table-modify-formulas 'remove col)))
(defun org-table-move-column-right ()
"Move column to the right."
@@ -6340,15 +6485,16 @@ If TABLE-TYPE is non-nil, also chack for table.el-type tables."
(beginning-of-line 2))
(move-marker end nil)
(goto-line linepos)
- (org-table-goto-column colpos))
- (org-table-align))
+ (org-table-goto-column colpos)
+ (org-table-align)
+ (org-table-modify-formulas 'swap col (if left (1- col) (1+ col)))))
(defun org-table-move-row-down ()
- "Move table row down."
+ "move table row down."
(interactive)
(org-table-move-row nil))
(defun org-table-move-row-up ()
- "Move table row up."
+ "move table row up."
(interactive)
(org-table-move-row 'up))
@@ -6380,13 +6526,18 @@ With prefix ARG, insert below the current line."
(interactive "P")
(if (not (org-at-table-p))
(error "Not at a table"))
- (let ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
+ (let* ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
+ new)
(if (string-match "^[ \t]*|-" line)
- (setq line (mapcar (lambda (x) (if (member x '(?| ?+)) ?| ?\ )) line))
- (setq line (mapcar (lambda (x) (if (equal x ?|) ?| ?\ )) line)))
+ (setq new (mapcar (lambda (x) (if (member x '(?| ?+)) ?| ?\ )) line))
+ (setq new (mapcar (lambda (x) (if (equal x ?|) ?| ?\ )) line)))
+ ;; Fix the first field if necessary
+ (setq new (concat new))
+ (if (string-match "^[ \t]*| *[#$] *|" line)
+ (setq new (replace-match (match-string 0 line) t t new)))
(beginning-of-line (if arg 2 1))
(let (org-table-may-need-update)
- (apply 'insert-before-markers line)
+ (insert-before-markers new)
(insert-before-markers "\n"))
(beginning-of-line 0)
(re-search-forward "| ?" (point-at-eol) t)
@@ -6431,26 +6582,23 @@ With prefix ARG, insert above the current line."
(move-to-column col)))
-(defun org-table-cut-region ()
+(defun org-table-cut-region (beg end)
"Copy region in table to the clipboard and blank all relevant fields."
- (interactive)
- (org-table-copy-region 'cut))
+ (interactive "r")
+ (org-table-copy-region beg end 'cut))
-(defun org-table-copy-region (&optional cut)
+(defun org-table-copy-region (beg end &optional cut)
"Copy rectangular region in table to clipboard.
A special clipboard is used which can only be accessed
with `org-table-paste-rectangle'"
- (interactive "P")
- (unless (org-region-active-p) (error "No active region"))
- (let* ((beg (region-beginning))
- (end (region-end))
- l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2
+ (interactive "rP")
+ (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2
region cols
(rpl (if cut " " nil)))
(goto-char beg)
(org-table-check-inside-data-field)
(setq l01 (count-lines (point-min) (point))
- c01 (org-table-current-column))
+ c01 (org-table-current-column))
(goto-char end)
(org-table-check-inside-data-field)
(setq l02 (count-lines (point-min) (point))
@@ -6470,8 +6618,9 @@ with `org-table-paste-rectangle'"
(push (nreverse cols) region)
(setq l1 (1+ l1)))))
(setq org-table-clip (nreverse region))
- (if cut (org-table-align))))
-
+ (if cut (org-table-align))
+ org-table-clip))
+
(defun org-table-paste-rectangle ()
"Paste a rectangular region into a table.
The upper right corner ends up in the current field. All involved fields
@@ -6574,7 +6723,7 @@ blank, and the content is appended to the field above."
;; There is a region: fill as a paragraph
(let ((beg (region-beginning))
nlines)
- (org-table-cut-region)
+ (org-table-cut-region (region-beginning) (region-end))
(if (> (length (car org-table-clip)) 1)
(error "Region must be limited to single column"))
(setq nlines (if arg
@@ -6582,7 +6731,7 @@ blank, and the content is appended to the field above."
(+ (length org-table-clip) arg)
arg)
(length org-table-clip)))
- (setq org-table-clip
+ (setq org-table-clip
(mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ")
nil nlines)))
(goto-char beg)
@@ -6611,7 +6760,8 @@ blank, and the content is appended to the field above."
(defun org-trim (s)
"Remove whitespace at beginning and end of string."
(if (string-match "^[ \t]+" s) (setq s (replace-match "" t t s)))
- (if (string-match "[ \t]+$" s) (setq s (replace-match "" t t s))))
+ (if (string-match "[ \t]+$" s) (setq s (replace-match "" t t s)))
+ s)
(defun org-wrap (string &optional width lines)
"Wrap string to either a number of lines, or a width in characters.
@@ -6637,7 +6787,7 @@ The return value is a list of lines, without newlines at the end."
(setq ll (org-do-wrap words w)))
ll))
(t (error "Cannot wrap this")))))
-
+
(defun org-do-wrap (words width)
"Create lines of maximum width WIDTH (in characters) from word list WORDS."
@@ -6734,7 +6884,7 @@ visible when ARG is not positive"
(save-excursion (funcall function)))
(re-search-forward org-table-any-border-regexp nil 1)))))
-(defun org-table-sum ()
+(defun org-table-sum (&optional beg end nlast)
"Sum numbers in region of current table column.
The result will be displayed in the echo area, and will be available
as kill to be inserted with \\[yank].
@@ -6746,35 +6896,38 @@ column.
If at least one number looks like a time HH:MM or HH:MM:SS, all other
numbers are assumed to be times as well (in decimal hours) and the
-numbers are added as such."
+numbers are added as such.
+
+If NLAST is a number, only the NLAST fields will actually be summed."
(interactive)
(save-excursion
- (let (beg end col (timecnt 0) diff h m s)
- (if (org-region-active-p)
- (setq beg (region-beginning) end (region-end))
+ (let (col (timecnt 0) diff h m s org-table-clip)
+ (cond
+ ((and beg end)) ; beg and end given explicitly
+ ((org-region-active-p)
+ (setq beg (region-beginning) end (region-end)))
+ (t
(setq col (org-table-current-column))
(goto-char (org-table-begin))
(unless (re-search-forward "^[ \t]*|[^-]" nil t)
(error "No table data"))
(org-table-goto-column col)
- (skip-chars-backward "^|")
+;not needed? (skip-chars-backward "^|")
(setq beg (point))
(goto-char (org-table-end))
(unless (re-search-backward "^[ \t]*|[^-]" nil t)
(error "No table data"))
(org-table-goto-column col)
- (skip-chars-forward "^|")
- (setq end (point)))
- (let* ((l1 (progn (goto-char beg)
- (+ (if (bolp) 1 0) (count-lines (point-min) (point)))))
- (l2 (progn (goto-char end)
- (+ (if (bolp) 1 0) (count-lines (point-min) (point)))))
- (items (if (= l1 l2)
- (split-string (buffer-substring beg end))
- (split-string
- (mapconcat 'identity (extract-rectangle beg end) " "))))
+;not needed? (skip-chars-forward "^|")
+ (setq end (point))))
+ (let* ((items (apply 'append (org-table-copy-region beg end)))
+ (items1 (cond ((not nlast) items)
+ ((>= nlast (length items)) items)
+ (t (setq items (reverse items))
+ (setcdr (nthcdr (1- nlast) items) nil)
+ (nreverse items))))
(numbers (delq nil (mapcar 'org-table-get-number-for-summing
- items)))
+ items1)))
(res (apply '+ numbers))
(sres (if (= timecnt 0)
(format "%g" res)
@@ -6784,9 +6937,11 @@ numbers are added as such."
s diff)
(format "%d:%02d:%02d" h m s))))
(kill-new sres)
- (message (substitute-command-keys
- (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)"
- (length numbers) sres)))))))
+ (if (interactive-p)
+ (message (substitute-command-keys
+ (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)"
+ (length numbers) sres))))
+ sres))))
(defun org-table-get-number-for-summing (s)
(let (n)
@@ -6808,15 +6963,136 @@ numbers are added as such."
((equal n 0) nil)
(t n))))
-(defvar org-table-current-formula nil)
(defvar org-table-formula-history nil)
-(defun org-table-get-formula (current)
- (if (and current (not (equal "" org-table-current-formula)))
- org-table-current-formula
- (setq org-table-current-formula
- (read-string
- "Formula [last]: " "" 'org-table-formula-history
- org-table-current-formula))))
+
+(defun org-table-get-formula (&optional equation)
+ "Read a formula from the minibuffer, offer stored formula as default."
+ (let* ((col (org-table-current-column))
+ (stored-list (org-table-get-stored-formulas))
+ (stored (cdr (assoc col stored-list)))
+ (eq (cond
+ ((and stored equation (string-match "^ *= *$" equation))
+ stored)
+ ((stringp equation)
+ equation)
+ (t (read-string
+ "Formula: " (or stored "") 'org-table-formula-history
+ stored)))))
+ (if (not (string-match "\\S-" eq))
+ (error "Empty formula"))
+ (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq)))
+ (if (string-match " *$" eq) (setq eq (replace-match "" t t eq)))
+ (if stored
+ (setcdr (assoc col stored-list) eq)
+ (setq stored-list (cons (cons col eq) stored-list)))
+ (if (not (equal stored eq))
+ (org-table-store-formulas stored-list))
+ eq))
+
+(defun org-table-store-formulas (alist)
+ "Store the list of formulas below the current table."
+ (setq alist (sort alist (lambda (a b) (< (car a) (car b)))))
+ (save-excursion
+ (goto-char (org-table-end))
+ (if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:.*\n?")
+ (delete-region (point) (match-end 0)))
+ (insert "#+TBLFM: "
+ (mapconcat (lambda (x)
+ (concat "$" (int-to-string (car x)) "=" (cdr x)))
+ alist "::")
+ "\n")))
+
+(defun org-table-get-stored-formulas ()
+ "Return an alist withh the t=stored formulas directly after current table."
+ (interactive)
+ (let (col eq eq-alist strings string)
+ (save-excursion
+ (goto-char (org-table-end))
+ (when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)")
+ (setq strings (org-split-string (match-string 2) " *:: *"))
+ (while (setq string (pop strings))
+ (if (string-match "\\$\\([0-9]+\\) *= *\\(.*[^ \t]\\)" string)
+ (setq col (string-to-number (match-string 1 string))
+ eq (match-string 2 string)
+ eq-alist (cons (cons col eq) eq-alist))))))
+ eq-alist))
+
+(defun org-table-modify-formulas (action &rest columns)
+ "Modify the formulas stored below the current table.
+ACTION can be `remove', `insert', `swap'. For `swap', two column numbers are
+expected, for the other action only a single column number is needed."
+ (let ((list (org-table-get-stored-formulas))
+ (nmax (length (org-split-string (buffer-substring (point-at-bol) (point-at-eol))
+ "|")))
+ col col1 col2)
+ (cond
+ ((null list)) ; No action needed if there are no stored formulas
+ ((eq action 'remove)
+ (setq col (car columns))
+ (org-table-replace-in-formulas list col "INVALID")
+ (if (assoc col list) (setq list (delq (assoc col list) list)))
+ (loop for i from (1+ col) upto nmax by 1 do
+ (org-table-replace-in-formulas list i (1- i))
+ (if (assoc i list) (setcar (assoc i list) (1- i)))))
+ ((eq action 'insert)
+ (setq col (car columns))
+ (loop for i from nmax downto col by 1 do
+ (org-table-replace-in-formulas list i (1+ i))
+ (if (assoc i list) (setcar (assoc i list) (1+ i)))))
+ ((eq action 'swap)
+ (setq col1 (car columns) col2 (nth 1 columns))
+ (org-table-replace-in-formulas list col1 "Z")
+ (org-table-replace-in-formulas list col2 col1)
+ (org-table-replace-in-formulas list "Z" col2)
+ (if (assoc col1 list) (setcar (assoc col1 list) "Z"))
+ (if (assoc col2 list) (setcar (assoc col2 list) col1))
+ (if (assoc "Z" list) (setcar (assoc "Z" list) col2)))
+ (t (error "Invalid action in `org-table-modify-formulas'")))
+ (if list (org-table-store-formulas list))))
+
+(defun org-table-replace-in-formulas (list s1 s2)
+ (let (elt re s)
+ (setq s1 (concat "$" (if (integerp s1) (int-to-string s1) s1))
+ s2 (concat "$" (if (integerp s2) (int-to-string s2) s2))
+ re (concat (regexp-quote s1) "\\>"))
+ (while (setq elt (pop list))
+ (setq s (cdr elt))
+ (while (string-match re s)
+ (setq s (replace-match s2 t t s)))
+ (setcdr elt s))))
+
+(defvar org-table-column-names nil
+ "Alist with column names, derived from the `!' line.")
+(defvar org-table-column-name-regexp nil
+ "Regular expression matching the current column names.")
+(defvar org-table-local-parameters nil
+ "Alist with parameter names, derived from the `$' line.")
+
+(defun org-table-get-specials ()
+ "Get the column nmaes and local parameters for this table."
+ (save-excursion
+ (let ((beg (org-table-begin)) (end (org-table-end))
+ names name fields field cnt)
+ (setq org-table-column-names nil
+ org-table-local-parameters nil)
+ (goto-char beg)
+ (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)
+ (setq names (org-split-string (match-string 1) " *| *")
+ cnt 1)
+ (while (setq name (pop names))
+ (setq cnt (1+ cnt))
+ (if (string-match "^[a-zA-Z][a-zA-Z0-9]*$" name)
+ (push (cons name (int-to-string cnt)) org-table-column-names))))
+ (setq org-table-column-names (nreverse org-table-column-names))
+ (setq org-table-column-name-regexp
+ (concat "\\$\\(" (mapconcat 'car org-table-column-names "\\|") "\\)\\>"))
+ (goto-char beg)
+ (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t)
+ (setq fields (org-split-string (match-string 1) " *| *"))
+ (while (setq field (pop fields))
+ (if (string-match "^\\([a-zA-Z][a-zA-Z0-9]*\\) *= *\\(.*\\)" field)
+ (push (cons (match-string 1 field) (match-string 2 field))
+ org-table-local-parameters)))))))
(defun org-this-word ()
;; Get the current word
@@ -6825,24 +7101,157 @@ numbers are added as such."
(end (progn (skip-chars-forward "^ \t\n") (point))))
(buffer-substring-no-properties beg end))))
-(defun org-table-eval-formula (&optional ndown)
+(defun org-table-maybe-eval-formula ()
+ "Check if the current field starts with \"=\" and evaluate the formula."
+ ;; We already know we are in a table. Get field will only return a formula
+ ;; when appropriate. It might return a separator line, but no problem.
+ (when org-table-formula-evaluate-inline
+ (let* ((field (org-trim (or (org-table-get-field) "")))
+ (dfield (downcase field))
+ col bolpos nlast)
+ (when (equal (string-to-char field) ?=)
+ (if (string-match "^\\(=sum[vh]?\\)\\([0-9]+\\)$" dfield)
+ (setq nlast (1+ (string-to-number (match-string 2 dfield)))
+ dfield (match-string 1 dfield)))
+ (cond
+ ((equal dfield "=sumh")
+ (org-table-get-field
+ nil (org-table-sum
+ (save-excursion (org-table-goto-column 1) (point))
+ (point) nlast)))
+ ((member dfield '("=sum" "=sumv"))
+ (setq col (org-table-current-column)
+ bolpos (point-at-bol))
+ (org-table-get-field
+ nil (org-table-sum
+ (save-excursion
+ (goto-char (org-table-begin))
+ (if (re-search-forward org-table-dataline-regexp bolpos t)
+ (progn
+ (goto-char (match-beginning 0))
+ (org-table-goto-column col)
+ (point))
+ (error "No datalines above current")))
+ (point) nlast)))
+ ((and (string-match "^ *=" field)
+ (fboundp 'calc-eval))
+ (org-table-eval-formula nil field)))))))
+
+(defvar org-last-recalc-undo-list nil)
+(defcustom org-table-allow-line-recalculation t
+ "FIXME:"
+ :group 'org-table
+ :type 'boolean)
+
+(defvar org-recalc-commands nil
+ "List of commands triggering the reccalculation of a line.
+Will be filled automatically during use.")
+
+(defvar org-recalc-marks
+ '((" " . "Unmarked: no special line, no automatic recalculation")
+ ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line")
+ ("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'")
+ ("!" . "Column name definition line. Reference in formula as $name.")
+ ("$" . "Parameter definition line name=value. Reference in formula as $name.")))
+
+(defun org-table-rotate-recalc-marks (&optional newchar)
+ "Rotate the recalculation mark in the first column.
+If in any row, the first field is not consistent with a mark,
+insert a new column for the makers.
+When there is an active region, change all the lines in the region,
+after prompting for the marking character.
+After each change, a message will be displayed indication the meaning
+of the new mark."
+ (interactive)
+ (unless (org-at-table-p) (error "Not at a table"))
+ (let* ((marks (append (mapcar 'car org-recalc-marks) '(" ")))
+ (beg (org-table-begin))
+ (end (org-table-end))
+ (l (org-current-line))
+ (l1 (if (org-region-active-p) (org-current-line (region-beginning))))
+ (l2 (if (org-region-active-p) (org-current-line (region-end))))
+ (have-col
+ (save-excursion
+ (goto-char beg)
+ (not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*| \t][^|]*|" end t))))
+ (col (org-table-current-column))
+ (forcenew (car (assoc newchar org-recalc-marks)))
+ epos new)
+ (if l1 (setq newchar (char-to-string (read-char-exclusive "Change region to what mark? Type # * ! $ or SPC: "))
+ forcenew (car (assoc newchar org-recalc-marks))))
+ (if (and newchar (not forcenew))
+ (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'"
+ newchar))
+ (if l1 (goto-line l1))
+ (save-excursion
+ (beginning-of-line 1)
+ (unless (looking-at org-table-dataline-regexp)
+ (error "Not at a table data line")))
+ (unless have-col
+ (org-table-goto-column 1)
+ (org-table-insert-column)
+ (org-table-goto-column (1+ col)))
+ (setq epos (point-at-eol))
+ (save-excursion
+ (beginning-of-line 1)
+ (org-table-get-field
+ 1 (if (looking-at "^[ \t]*| *\\([#!$* ]\\) *|")
+ (concat " "
+ (setq new (or forcenew
+ (cadr (member (match-string 1) marks))))
+ " ")
+ " # ")))
+ (if (and l1 l2)
+ (progn
+ (goto-line l1)
+ (while (progn (beginning-of-line 2) (not (= (org-current-line) l2)))
+ (and (looking-at org-table-dataline-regexp)
+ (org-table-get-field 1 (concat " " new " "))))
+ (goto-line l1)))
+ (if (not (= epos (point-at-eol))) (org-table-align))
+ (goto-line l)
+ (and (interactive-p) (message (cdr (assoc new org-recalc-marks))))))
+
+(defun org-table-maybe-recalculate-line ()
+ "Recompute the current line if marked for it, and if we haven't just done it."
+ (interactive)
+ (and org-table-allow-line-recalculation
+ (not (and (memq last-command org-recalc-commands)
+ (equal org-last-recalc-line (org-current-line))))
+ (save-excursion (beginning-of-line 1)
+ (looking-at org-table-auto-recalculate-regexp))
+ (fboundp 'calc-eval)
+ (org-table-recalculate) t))
+
+(defvar org-table-formula-debug nil
+ "Non-nil means, debug table formulas.
+When nil, simply write \"#ERROR\" in corrupted fields.")
+
+(defvar modes)
+(defsubst org-set-calc-mode (var value)
+ (setcar (or (cdr (memq var modes)) (cons nil nil)) value))
+
+(defun org-table-eval-formula (&optional ndown equation
+ suppress-align suppress-const
+ suppress-store)
"Replace the table field value at the cursor by the result of a calculation.
-This function makes use of Dave Gillespie's calc package, arguably the most
-exciting program ever written for GNU Emacs. So you need to have calc
+This function makes use of Dave Gillespie's calc package, in my view the
+most exciting program ever written for GNU Emacs. So you need to have calc
installed in order to use this function.
In a table, this command replaces the value in the current field with the
result of a formula. While nowhere near the computation options of a
-spreadsheet program, this is still very useful. Note that there is no
-automatic updating of a calculated field, nor will the field remember the
-formula. The command needs to be applied again after changing input
-fields.
+spreadsheet program, this is still very useful. There is no automatic
+updating of a calculated field, but the table will remember the last
+formula for each column. The command needs to be applied again after
+changing input fields.
When called, the command first prompts for a formula, which is read in the
-minibuffer. Previously entered formulae are available through the history
-list, and the last used formula is the default, reachable by simply
-pressing RET.
+minibuffer. Previously entered formulas are available through the history
+list, and the last used formula for each column is offered as a default.
+These stored formulas are adapted correctly when moving, inserting, or
+deleting columns with the corresponding commands.
The formula can be any algebraic expression understood by the calc package.
Before evaluation, variable substitution takes place: \"$\" is replaced by
@@ -6852,7 +7261,7 @@ here, so the command supports only horizontal computing. The formula can
contain an optional printf format specifier after a semicolon, to reformat
the result.
-A few examples for formulae:
+A few examples for formulas:
$1+$2 Sum of first and second field
$1+$2;%.2f Same, and format result to two digits after dec.point
exp($2)+exp($1) Math functions can be used
@@ -6864,38 +7273,101 @@ field, and to the same same column in all following rows, until reaching a
horizontal line or the end of the table. When the command is called with a
numeric prefix argument (like M-3 or C-7 or \\[universal-argument] 24), the formula is applied
to the current row, and to the following n-1 rows (but not beyond a
-separator line)."
+separator line).
+
+This function can also be called from Lisp programs and offers two additional
+Arguments: EQUATION can be the formula to apply. If this argument is given,
+the user will not be prompted. SUPPRESS-ALIGN is used to speed-up
+recursive calls by by-passing unnecessary aligns. SUPPRESS-CONST suppresses
+the interpretation of constants in the formula. SUPPRESS-STORE means the
+formula should not be stored, either because it is already stored, or because
+it is a modified equation that should not overwrite the stored one."
(interactive "P")
(setq ndown (if (equal ndown '(4)) 10000 (prefix-numeric-value ndown)))
(require 'calc)
(org-table-check-inside-data-field)
+ (org-table-get-specials)
(let* (fields
(org-table-automatic-realign nil)
+ (case-fold-search nil)
(down (> ndown 1))
- (formula (org-table-get-formula nil))
+ (formula (if (and equation suppress-store)
+ equation
+ (org-table-get-formula equation)))
(n0 (org-table-current-column))
- n form fmt x ev)
+ (modes (copy-sequence org-calc-default-modes))
+ n form fmt x ev orig c)
+ ;; Parse the format
(if (string-match ";" formula)
(let ((tmp (org-split-string formula ";")))
- (setq formula (car tmp) fmt (nth 1 tmp))))
+ (setq formula (car tmp) fmt (or (nth 1 tmp) ""))
+ (while (string-match "[pnfse]\\(-?[0-9]+\\)" fmt)
+ (setq c (string-to-char (match-string 1 fmt))
+ n (string-to-number (or (match-string 1 fmt) "")))
+ (if (= c ?p) (org-set-calc-mode 'calc-internal-prec n)
+ (org-set-calc-mode 'calc-float-format
+ (list (cdr (assoc c '((?n. float) (?f. fix)
+ (?s. sci) (?e. eng))))
+ n)))
+ (setq fmt (replace-match "" t t fmt)))
+ (when (string-match "[DR]" fmt)
+ (org-set-calc-mode 'calc-angle-mode
+ (if (equal (match-string 0 fmt) "D")
+ 'deg 'rad))
+ (setq fmt (replace-match "" t t fmt)))
+ (when (string-match "F" fmt)
+ (org-set-calc-mode 'calc-prefer-frac t)
+ (setq fmt (replace-match "" t t fmt)))
+ (when (string-match "S" fmt)
+ (org-set-calc-mode 'calc-symbolic-mode t)
+ (setq fmt (replace-match "" t t fmt)))
+ (unless (string-match "\\S-" fmt)
+ (setq fmt nil))))
+ (if (and (not suppress-const) org-table-formula-use-constants)
+ (setq formula (org-table-formula-substitute-names formula)))
+ (setq orig (or (get-text-property 1 :orig-formula formula) "?"))
(while (> ndown 0)
(setq fields (org-split-string
- (concat " " (buffer-substring
- (point-at-bol) (point-at-eol))) "|"))
+ (buffer-substring
+ (point-at-bol) (point-at-eol)) " *| *"))
+ (if org-table-formula-numbers-only
+ (setq fields (mapcar
+ (lambda (x) (number-to-string (string-to-number x)))
+ fields)))
(setq ndown (1- ndown))
(setq form (copy-sequence formula))
(while (string-match "\\$\\([0-9]+\\)?" form)
(setq n (if (match-beginning 1)
(string-to-int (match-string 1 form))
n0)
- x (nth n fields))
+ x (nth (1- n) fields))
(unless x (error "Invalid field specifier \"%s\""
(match-string 0 form)))
- (if (equal (string-to-number x) 0) (setq x "0"))
- (setq form (replace-match x t t form)))
- (setq ev (calc-eval (list form) 'num))
+ (if (equal x "") (setq x "0"))
+ (setq form (replace-match (concat "(" x ")") t t form)))
+ (setq ev (calc-eval (cons form modes)
+ (if org-table-formula-numbers-only 'num)))
+
+ (when org-table-formula-debug
+ (with-output-to-temp-buffer "*Help*"
+ (princ (format "Substitution history of formula
+Orig: %s
+$xyz-> %s
+$1-> %s\n" orig formula form))
+ (if (listp ev)
+ (princ (format " %s^\nError: %s"
+ (make-string (car ev) ?\-) (nth 1 ev)))
+ (princ (format "Result: %s" ev))))
+ (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*"))
+ (unless (and (interactive-p) (not ndown))
+ (unless (let (inhibit-redisplay)
+ (y-or-n-p "Debugging Formula. Continue to next? "))
+ (org-table-align)
+ (error "Abort"))
+ (delete-window (get-buffer-window "*Help*"))
+ (message "")))
(if (listp ev)
- (error "Invalid expression: %s (%s at %d)" form (nth 1 ev) (car ev)))
+ (setq fmt nil ev "#ERROR"))
(org-table-blank-field)
(if fmt
(insert (format fmt (string-to-number ev)))
@@ -6903,7 +7375,96 @@ separator line)."
(if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]"))
(call-interactively 'org-return)
(setq ndown 0)))
- (org-table-align)))
+ (or suppress-align (org-table-align))))
+
+(defun org-table-recalculate (&optional all noalign)
+ "Recalculate the current table line by applying all stored formulas."
+ (interactive "P")
+ (or (memq this-command org-recalc-commands)
+ (setq org-recalc-commands (cons this-command org-recalc-commands)))
+ (unless (org-at-table-p) (error "Not at a table"))
+ (org-table-get-specials)
+ (let* ((eqlist (sort (org-table-get-stored-formulas)
+ (lambda (a b) (< (car a) (car b)))))
+ (inhibit-redisplay t)
+ (line-re org-table-dataline-regexp)
+ (thisline (+ (if (bolp) 1 0) (count-lines (point-min) (point))))
+ (thiscol (org-table-current-column))
+ beg end entry eql (cnt 0))
+ ;; Insert constants in all formulas
+ (setq eqlist
+ (mapcar (lambda (x)
+ (setcdr x (org-table-formula-substitute-names (cdr x)))
+ x)
+ eqlist))
+ (if all
+ (progn
+ (setq end (move-marker (make-marker) (1+ (org-table-end))))
+ (goto-char (setq beg (org-table-begin)))
+ (if (re-search-forward org-table-recalculate-regexp end t)
+ (setq line-re org-table-recalculate-regexp)
+ (if (and (re-search-forward org-table-dataline-regexp end t)
+ (re-search-forward org-table-hline-regexp end t)
+ (re-search-forward org-table-dataline-regexp end t))
+ (setq beg (match-beginning 0))
+ nil))) ;; just leave beg where it is
+ (setq beg (point-at-bol)
+ end (move-marker (make-marker) (1+ (point-at-eol)))))
+ (goto-char beg)
+ (and all (message "Re-applying formulas to full table..."))
+ (while (re-search-forward line-re end t)
+ (unless (string-match "^ *[!$] *$" (org-table-get-field 1))
+ ;; Unprotected line, recalculate
+ (and all (message "Re-applying formulas to full table...(line %d)"
+ (setq cnt (1+ cnt))))
+ (setq org-last-recalc-line (org-current-line))
+ (setq eql eqlist)
+ (while (setq entry (pop eql))
+ (goto-line org-last-recalc-line)
+ (org-table-goto-column (car entry) nil 'force)
+ (org-table-eval-formula nil (cdr entry) 'noalign 'nocst 'nostore))))
+ (goto-line thisline)
+ (org-table-goto-column thiscol)
+ (or noalign (org-table-align)
+ (and all (message "Re-applying formulas to %d lines...done" cnt)))))
+
+(defun org-table-formula-substitute-names (f)
+ "Replace $const with values in stirng F."
+ (let ((start 0) a n1 n2 nn1 nn2 s (f1 f))
+ ;; First, check for column names
+ (while (setq start (string-match org-table-column-name-regexp f start))
+ (setq start (1+ start))
+ (setq a (assoc (match-string 1 f) org-table-column-names))
+ (setq f (replace-match (concat "$" (cdr a)) t t f)))
+ ;; Expand ranges to vectors
+ (while (string-match "\\$\\([0-9]+\\)\\.\\.\\.?\\$\\([0-9]+\\)" f)
+ (setq n1 (string-to-number (match-string 1 f))
+ n2 (string-to-number (match-string 2 f))
+ nn1 (1+ (min n1 n2)) nn2 (max n1 n2)
+ s (concat "[($" (number-to-string (1- nn1)) ")"))
+ (loop for i from nn1 upto nn2 do
+ (setq s (concat s ",($" (int-to-string i) ")")))
+ (setq s (concat s "]"))
+ (if (< n2 n1) (setq s (concat "rev(" s ")")))
+ (setq f (replace-match s t t f)))
+ ;; Parameters and constants
+ (setq start 0)
+ (while (setq start (string-match "\\$\\([a-zA-Z][a-zA-Z0-9]*\\)" f start))
+ (setq start (1+ start))
+ (if (setq a (save-match-data
+ (org-table-get-constant (match-string 1 f))))
+ (setq f (replace-match (concat "(" a ")") t t f))))
+ (if org-table-formula-debug
+ (put-text-property 0 (length f) :orig-formula f1 f))
+ f))
+
+(defun org-table-get-constant (const)
+ "Find the value for a parameter or constant in a formula.
+Parameters get priority."
+ (or (cdr (assoc const org-table-local-parameters))
+ (cdr (assoc const org-table-formula-constants))
+ (and (fboundp 'constants-get) (constants-get const))
+ "#UNDEFINED_NAME"))
;;; The orgtbl minor mode
@@ -6962,7 +7523,7 @@ table editor in arbitrary modes.")
;;;###autoload
(defun orgtbl-mode (&optional arg)
- "The `org-mode' table editor as a minor mode for use in other modes."
+ "The `org-mode' table editor as a minor mode for use in other modes."
(interactive)
(if (eq major-mode 'org-mode)
;; Exit without error, in case some hook functions calls this
@@ -6972,6 +7533,11 @@ table editor in arbitrary modes.")
(if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode)))
(if orgtbl-mode
(progn
+ (and (orgtbl-setup) (defun orgtbl-setup () nil))
+ ;; Make sure we are first in minor-mode-map-alist
+ (let ((c (assq 'orgtbl-mode minor-mode-map-alist)))
+ (and c (setq minor-mode-map-alist
+ (cons c (delq c minor-mode-map-alist)))))
(set (make-local-variable (quote org-table-may-need-update)) t)
(make-local-hook (quote before-change-functions))
(add-hook 'before-change-functions 'org-before-change-function
@@ -6979,7 +7545,7 @@ table editor in arbitrary modes.")
(set (make-local-variable 'org-old-auto-fill-inhibit-regexp)
auto-fill-inhibit-regexp)
(set (make-local-variable 'auto-fill-inhibit-regexp)
- (if auto-fill-inhibit-regexp
+ (if auto-fill-inhibit-regexp
(concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp)
"[ \t]*|"))
(easy-menu-add orgtbl-mode-menu)
@@ -6994,81 +7560,134 @@ table editor in arbitrary modes.")
(put 'orgtbl-mode :menu-tag "Org Table Mode")
(add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map)
-(defun orgtbl-make-binding (fun &rest keys)
- "Create a function for binding in the table minor mode."
- (list 'lambda '(arg)
- (concat "Run `" (symbol-name fun) "' or the default binding.")
- '(interactive "p")
- (list 'if
- '(org-at-table-p)
- (list 'call-interactively (list 'quote fun))
- (list 'let '(orgtbl-mode)
- (list 'call-interactively
- (append '(or)
- (mapcar (lambda (k)
- (list 'key-binding k))
- keys)
- '('orgtbl-error)))))))
+(defun orgtbl-make-binding (fun n &rest keys)
+ "Create a function for binding in the table minor mode.
+FUN is the command to call inside a table. N is used to create a unique
+command name. KEYS are keys that should be checked in for a command
+to execute outside of tables."
+ (eval
+ (list 'defun
+ (intern (concat "orgtbl-hijacker-command-" (int-to-string n)))
+ '(arg)
+ (concat "In tables, run `" (symbol-name fun) "'.\n"
+ "Outside of tables, run the binding of `"
+ (mapconcat (lambda (x) (format "%s" x)) keys "' or `")
+ "'.")
+ '(interactive "p")
+ (list 'if
+ '(org-at-table-p)
+ (list 'call-interactively (list 'quote fun))
+ (list 'let '(orgtbl-mode)
+ (list 'call-interactively
+ (append '(or)
+ (mapcar (lambda (k)
+ (list 'key-binding k))
+ keys)
+ '('orgtbl-error))))))))
(defun orgtbl-error ()
"Error when there is no default binding for a table key."
(interactive)
(error "This key is has no function outside tables"))
-;; Keybindings for the minor mode
-(let ((bindings
- (list
- '([(meta shift left)] org-table-delete-column)
- '([(meta left)] org-table-move-column-left)
- '([(meta right)] org-table-move-column-right)
- '([(meta shift right)] org-table-insert-column)
- '([(meta shift up)] org-table-kill-row)
- '([(meta shift down)] org-table-insert-row)
- '([(meta up)] org-table-move-row-up)
- '([(meta down)] org-table-move-row-down)
- '("\C-c\C-w" org-table-cut-region)
- '("\C-c\M-w" org-table-copy-region)
- '("\C-c\C-y" org-table-paste-rectangle)
- '("\C-c-" org-table-insert-hline)
- '([(shift tab)] org-table-previous-field)
- '("\C-c\C-c" org-table-align)
- '("\C-m" org-table-next-row)
- (list (org-key 'S-return) 'org-table-copy-down)
- '([(meta return)] org-table-wrap-region)
- '("\C-c\C-q" org-table-wrap-region)
- '("\C-c?" org-table-current-column)
- '("\C-c " org-table-blank-field)
- '("\C-c+" org-table-sum)
- '("\C-c|" org-table-toggle-vline-visibility)
- '("\C-c=" org-table-eval-formula)))
- elt key fun cmd)
- (while (setq elt (pop bindings))
- (setq key (car elt)
- fun (nth 1 elt)
- cmd (orgtbl-make-binding fun key))
- (define-key orgtbl-mode-map key cmd)))
-
-;; Special treatment needed for TAB and RET
-
-(define-key orgtbl-mode-map [(return)]
- (orgtbl-make-binding 'orgtbl-ret [(return)] "\C-m"))
-(define-key orgtbl-mode-map "\C-m"
- (orgtbl-make-binding 'orgtbl-ret "\C-m" [(return)]))
-(define-key orgtbl-mode-map [(tab)]
- (orgtbl-make-binding 'orgtbl-tab [(tab)] "\C-i"))
-(define-key orgtbl-mode-map "\C-i"
- (orgtbl-make-binding 'orgtbl-tab "\C-i" [(tab)]))
-
-(when orgtbl-optimized
- ;; If the user wants maximum table support, we need to hijack
- ;; some standard editing functions
- (substitute-key-definition 'self-insert-command 'orgtbl-self-insert-command
- orgtbl-mode-map global-map)
- (substitute-key-definition 'delete-char 'orgtbl-delete-char
- orgtbl-mode-map global-map)
- (substitute-key-definition 'delete-backward-char 'orgtbl-delete-backward-char
- orgtbl-mode-map global-map)
- (define-key org-mode-map "|" 'self-insert-command))
+(defun orgtbl-setup ()
+ "Setup orgtbl keymaps."
+ (let ((nfunc 0)
+ (bindings
+ (list
+ '([(meta shift left)] org-table-delete-column)
+ '([(meta left)] org-table-move-column-left)
+ '([(meta right)] org-table-move-column-right)
+ '([(meta shift right)] org-table-insert-column)
+ '([(meta shift up)] org-table-kill-row)
+ '([(meta shift down)] org-table-insert-row)
+ '([(meta up)] org-table-move-row-up)
+ '([(meta down)] org-table-move-row-down)
+ '("\C-c\C-w" org-table-cut-region)
+ '("\C-c\M-w" org-table-copy-region)
+ '("\C-c\C-y" org-table-paste-rectangle)
+ '("\C-c-" org-table-insert-hline)
+ '([(shift tab)] org-table-previous-field)
+ '("\C-c\C-c" org-ctrl-c-ctrl-c)
+ '("\C-m" org-table-next-row)
+ (list (org-key 'S-return) 'org-table-copy-down)
+ '([(meta return)] org-table-wrap-region)
+ '("\C-c\C-q" org-table-wrap-region)
+ '("\C-c?" org-table-current-column)
+ '("\C-c " org-table-blank-field)
+ '("\C-c+" org-table-sum)
+ '("\C-c|" org-table-toggle-vline-visibility)
+ '("\C-c=" org-table-eval-formula)
+ '("\C-c*" org-table-recalculate)
+ '([(control ?#)] org-table-rotate-recalc-marks)))
+ elt key fun cmd)
+ (while (setq elt (pop bindings))
+ (setq nfunc (1+ nfunc))
+ (setq key (car elt)
+ fun (nth 1 elt)
+ cmd (orgtbl-make-binding fun nfunc key))
+ (define-key orgtbl-mode-map key cmd))
+ ;; Special treatment needed for TAB and RET
+ (define-key orgtbl-mode-map [(return)]
+ (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m"))
+ (define-key orgtbl-mode-map "\C-m"
+ (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)]))
+ (define-key orgtbl-mode-map [(tab)]
+ (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i"))
+ (define-key orgtbl-mode-map "\C-i"
+ (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])))
+ (when orgtbl-optimized
+ ;; If the user wants maximum table support, we need to hijack
+ ;; some standard editing functions
+ (substitute-key-definition 'self-insert-command 'orgtbl-self-insert-command
+ orgtbl-mode-map global-map)
+ (substitute-key-definition 'delete-char 'orgtbl-delete-char
+ orgtbl-mode-map global-map)
+ (substitute-key-definition 'delete-backward-char 'orgtbl-delete-backward-char
+ orgtbl-mode-map global-map)
+ (define-key org-mode-map "|" 'self-insert-command))
+ (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu"
+ '("OrgTbl"
+ ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"]
+ ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"]
+ ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"]
+ ["Next Row" org-return :active (org-at-table-p) :keys "RET"]
+ "--"
+ ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"]
+ ["Copy Field from Above"
+ org-table-copy-down :active (org-at-table-p) :keys "S-RET"]
+ "--"
+ ("Column"
+ ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"]
+ ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"]
+ ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"]
+ ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"])
+ ("Row"
+ ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"]
+ ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"]
+ ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"]
+ ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"]
+ "--"
+ ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"])
+ ("Rectangle"
+ ["Copy Rectangle" org-copy-special :active (org-at-table-p) :keys "C-c M-w"]
+ ["Cut Rectangle" org-cut-special :active (org-at-table-p) :keys "C-c C-w"]
+ ["Paste Rectangle" org-paste-special :active (org-at-table-p) :keys "C-c C-y"]
+ ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p) :keys "C-c C-q"])
+ "--"
+ ["Eval Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
+ ["Eval Formula Down " (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
+ ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"]
+ ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"]
+ ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"]
+ ["Sum Column/Rectangle" org-table-sum
+ :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"]
+ ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"]
+ ["Debug Formulas"
+ (setq org-table-formula-debug (not org-table-formula-debug))
+ :style toggle :selected org-table-formula-debug]
+ ))
+ t)
(defun orgtbl-tab ()
"Justification and field motion for `orgtbl-mode'."
@@ -7108,13 +7727,13 @@ reduced column width."
(interactive "p")
(if (and (org-at-table-p)
(eq N 1)
+ (string-match "|" (buffer-substring (point-at-bol) (point)))
(looking-at ".*?|"))
(let ((pos (point)))
(backward-delete-char N)
(skip-chars-forward "^|")
(insert " ")
(goto-char (1- pos)))
- (message "%s" last-input-event) (sit-for 1)
(delete-backward-char N)))
(defun orgtbl-delete-char (N)
@@ -7125,6 +7744,8 @@ will still be marked for re-alignment, because a narrow field may lead to
a reduced column width."
(interactive "p")
(if (and (org-at-table-p)
+ (not (bolp))
+ (not (= (char-after) ?|))
(eq N 1))
(if (looking-at ".*?|")
(let ((pos (point)))
@@ -7134,41 +7755,6 @@ a reduced column width."
(goto-char pos)))
(delete-char N)))
-(easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu"
- '("Tbl"
- ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"]
- ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"]
- ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"]
- ["Next Row" org-return :active (org-at-table-p) :keys "RET"]
- "--"
- ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"]
- ["Copy Field from Above"
- org-table-copy-down :active (org-at-table-p) :keys "S-RET"]
- "--"
- ("Column"
- ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"]
- ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"]
- ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"]
- ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"])
- ("Row"
- ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"]
- ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"]
- ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"]
- ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"]
- "--"
- ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"])
- ("Rectangle"
- ["Copy Rectangle" org-copy-special :active (org-at-table-p) :keys "C-c M-w"]
- ["Cut Rectangle" org-cut-special :active (org-at-table-p) :keys "C-c C-w"]
- ["Paste Rectangle" org-paste-special :active (org-at-table-p) :keys "C-c C-y"]
- ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p) :keys "C-c C-q"])
- "--"
- ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"]
- ["Sum Column/Rectangle" org-table-sum
- :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"]
- ["Eval Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
- ))
-
;;; Exporting
(defconst org-level-max 20)
@@ -7503,7 +8089,7 @@ Entries can be like (\"ent\"), in which case \"\\ent\" will be translated to
In that case, \"\\ent\" will be translated to \"&other;\".
The list contains HTML entities for Latin-1, Greek and other symbols.
It is supplemented by a number of commonly used TeX macros with appropriate
-translations.")
+translations. There is currently no way for users to extend this.")
(defvar org-last-level nil) ; dynamically scoped variable
@@ -7676,7 +8262,7 @@ and all options lines."
(let* ((filename (concat (file-name-sans-extension (buffer-file-name))
".txt"))
(buffer (find-file-noselect filename))
- (ore (concat
+ (ore (concat
(org-make-options-regexp
'("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO"
"STARTUP" "ARCHIVE"
@@ -7908,7 +8494,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
;; This is a headline
(progn
(setq level (- (match-end 1) (match-beginning 1))
- txt (save-match-data
+ txt (save-match-data
(org-html-expand
(match-string 3 line)))
todo
@@ -8413,10 +8999,10 @@ When LEVEL is non-nil, increase section numbers on that level."
;; - Bindings in Org-mode map are currently
;; 0123456789abcdefghijklmnopqrstuvwxyz!?@#$%^&-+*/=()_{}[]:;"|,.<>~`'\t the alphabet
-;; abcd fgh j lmnopqrstuvwxyz ? # -+ /= [] ; |,.<> \t necessary bindings
+;; abcd fgh j lmnopqrstuvwxyz ? #$ -+*/= [] ; |,.<>~ \t necessary bindings
;; e (?) useful from outline-mode
;; i k @ expendable from outline-mode
-;; 0123456789 ! $%^& * ()_{} " ~`' free
+;; 0123456789 ! %^& ()_{} " `' free
(define-key org-mode-map "\C-i" 'org-cycle)
(define-key org-mode-map [(meta tab)] 'org-complete)
@@ -8476,7 +9062,9 @@ When LEVEL is non-nil, increase section numbers on that level."
(define-key org-mode-map "\C-c+" 'org-table-sum)
(define-key org-mode-map "\C-c|" 'org-table-toggle-vline-visibility)
(define-key org-mode-map "\C-c=" 'org-table-eval-formula)
-(define-key org-mode-map "\C-c#" 'org-table-create-with-table.el)
+(define-key org-mode-map "\C-c*" 'org-table-recalculate)
+(define-key org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks)
+(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-xa" 'org-export-as-ascii)
(define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii)
@@ -8489,12 +9077,7 @@ When LEVEL is non-nil, increase section numbers on that level."
(define-key org-mode-map "\C-c\C-xh" 'org-export-as-html)
(define-key org-mode-map "\C-c\C-x\C-h" 'org-export-as-html-and-open)
-(defsubst org-table-p ()
- (if (and (eq major-mode 'org-mode) font-lock-mode)
- (eq (get-text-property (point) 'face) 'org-table)
- ;; (save-match-data (org-at-table-p)))) ; FIXME: OK to not use this?
- (org-at-table-p)))
-
+(defsubst org-table-p () (org-at-table-p))
(defun org-self-insert-command (N)
"Like `self-insert-command', use overwrite-mode for whitespace in tables.
@@ -8525,7 +9108,8 @@ reduced column width."
(interactive "p")
(if (and (org-table-p)
(eq N 1)
- (looking-at ".*?|"))
+ (string-match "|" (buffer-substring (point-at-bol) (point)))
+ (looking-at ".*?|"))
(let ((pos (point)))
(backward-delete-char N)
(skip-chars-forward "^|")
@@ -8541,6 +9125,8 @@ will still be marked for re-alignment, because a narrow field may lead to
a reduced column width."
(interactive "p")
(if (and (org-table-p)
+ (not (bolp))
+ (not (= (char-after) ?|))
(eq N 1))
(if (looking-at ".*?|")
(let ((pos (point)))
@@ -8655,16 +9241,14 @@ a reduced column width."
(defun org-copy-special ()
"Call either `org-table-copy' or `org-copy-subtree'."
(interactive)
- (if (org-at-table-p)
- (org-table-copy-region)
- (org-copy-subtree)))
+ (call-interactively
+ (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree)))
(defun org-cut-special ()
"Call either `org-table-copy' or `org-cut-subtree'."
(interactive)
- (if (org-at-table-p)
- (org-table-cut-region)
- (org-cut-subtree)))
+ (call-interactively
+ (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree)))
(defun org-paste-special (arg)
"Call either `org-table-paste-rectangle' or `org-paste-subtree'."
@@ -8674,23 +9258,37 @@ a reduced column width."
(org-paste-subtree arg)))
(defun org-ctrl-c-ctrl-c (&optional arg)
- "Call realign table, or recognize a table.el table.
+ "Call realign table, or recognize a table.el table, or update keywords.
When the cursor is inside a table created by the table.el package,
activate that table. Otherwise, if the cursor is at a normal table
created with org.el, re-align that table. This command works even if
-the automatic table editor has been turned off."
+the automatic table editor has been turned off.
+If the cursor is in one of the special #+KEYWORD lines, this triggers
+scanning the buffer for these lines and updating the information."
(interactive "P")
(let ((org-enable-table-editor t))
(cond
((org-at-table.el-p)
(require 'table)
(beginning-of-line 1)
- (re-search-forward "|" (save-excursion (end-of-line 2) (point))) ;FIXME: line-end-position?
+ (re-search-forward "|" (save-excursion (end-of-line 2) (point)))
(table-recognize-table))
((org-at-table-p)
+ (org-table-maybe-eval-formula)
+ (if arg
+ (org-table-recalculate t)
+ (org-table-maybe-recalculate-line))
(org-table-align))
- ((save-excursion (beginning-of-line 1) (looking-at "#\\+[A-Z]+"))
- (let ((org-inhibit-startup t)) (org-mode)))
+ ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)"))
+ (cond
+ ((equal (match-string 1) "TBLFM")
+ ;; Recalculate the table before this line
+ (save-excursion
+ (beginning-of-line 1)
+ (skip-chars-backward " \r\n\t")
+ (if (org-at-table-p) (org-table-recalculate t))))
+ (t
+ (let ((org-inhibit-startup t)) (org-mode)))))
((org-region-active-p)
(org-table-convert-region (region-beginning) (region-end) arg))
((and (region-beginning) (region-end))
@@ -8718,18 +9316,59 @@ the automatic table editor has been turned off."
;;; Menu entries
-;; First, remove the outline menus. Org-mode does not neede these commands.
-(if org-xemacs-p
- (add-hook 'org-mode-hook
- (lambda ()
- (delete-menu-item '("Headings"))
- (delete-menu-item '("Show"))
- (delete-menu-item '("Hide"))
- (set-menubar-dirty-flag)))
- (setq org-mode-map (delq (assoc 'menu-bar (cdr org-mode-map))
- org-mode-map)))
-
;; Define the Org-mode menus
+(easy-menu-define org-tbl-menu org-mode-map "Tbl menu"
+ '("Tbl"
+ ["Align" org-ctrl-c-ctrl-c (org-at-table-p)]
+ ["Next Field" org-cycle (org-at-table-p)]
+ ["Previous Field" org-shifttab (org-at-table-p)]
+ ["Next Row" org-return (org-at-table-p)]
+ "--"
+ ["Blank Field" org-table-blank-field (org-at-table-p)]
+ ["Copy Field from Above" org-table-copy-down (org-at-table-p)]
+ "--"
+ ("Column"
+ ["Move Column Left" org-metaleft (org-at-table-p)]
+ ["Move Column Right" org-metaright (org-at-table-p)]
+ ["Delete Column" org-shiftmetaleft (org-at-table-p)]
+ ["Insert Column" org-shiftmetaright (org-at-table-p)])
+ ("Row"
+ ["Move Row Up" org-metaup (org-at-table-p)]
+ ["Move Row Down" org-metadown (org-at-table-p)]
+ ["Delete Row" org-shiftmetaup (org-at-table-p)]
+ ["Insert Row" org-shiftmetadown (org-at-table-p)]
+ "--"
+ ["Insert Hline" org-table-insert-hline (org-at-table-p)])
+ ("Rectangle"
+ ["Copy Rectangle" org-copy-special (org-at-table-p)]
+ ["Cut Rectangle" org-cut-special (org-at-table-p)]
+ ["Paste Rectangle" org-paste-special (org-at-table-p)]
+ ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
+ "--"
+ ("Calculate"
+ ["Eval Formula" org-table-eval-formula (org-at-table-p)]
+ ["Eval Formula Down" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
+ ["Recalculate line" org-table-recalculate (org-at-table-p)]
+ ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"]
+ ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)]
+ ["Sum Column/Rectangle" org-table-sum
+ (or (org-at-table-p) (org-region-active-p))]
+ ["Which Column?" org-table-current-column (org-at-table-p)])
+ ["Debug Formulas"
+ (setq org-table-formula-debug (not org-table-formula-debug))
+ :style toggle :selected org-table-formula-debug]
+ "--"
+ ["Invisible Vlines" org-table-toggle-vline-visibility
+ :style toggle :selected (org-in-invisibility-spec-p '(org-table))]
+ "--"
+ ["Create" org-table-create (and (not (org-at-table-p))
+ org-enable-table-editor)]
+ ["Convert Region" org-ctrl-c-ctrl-c (not (org-at-table-p 'any))]
+ ["Import from File" org-table-import (not (org-at-table-p))]
+ ["Export to File" org-table-export (org-at-table-p)]
+ "--"
+ ["Create/Convert from/to table.el" org-table-create-with-table.el t]))
+
(easy-menu-define org-org-menu org-mode-map "Org menu"
'("Org"
["Cycle Visibility" org-cycle (or (bobp) (outline-on-heading-p))]
@@ -8794,49 +9433,6 @@ the automatic table editor has been turned off."
["Insert Link" org-insert-link t]
["Follow Link" org-open-at-point t])
"--"
- ("Table"
- ["Align" org-ctrl-c-ctrl-c (org-at-table-p)]
- ["Next Field" org-cycle (org-at-table-p)]
- ["Previous Field" org-shifttab (org-at-table-p)]
- ["Next Row" org-return (org-at-table-p)]
- "--"
- ["Blank Field" org-table-blank-field (org-at-table-p)]
- ["Copy Field from Above" org-table-copy-down (org-at-table-p)]
- "--"
- ("Column"
- ["Move Column Left" org-metaleft (org-at-table-p)]
- ["Move Column Right" org-metaright (org-at-table-p)]
- ["Delete Column" org-shiftmetaleft (org-at-table-p)]
- ["Insert Column" org-shiftmetaright (org-at-table-p)])
- ("Row"
- ["Move Row Up" org-metaup (org-at-table-p)]
- ["Move Row Down" org-metadown (org-at-table-p)]
- ["Delete Row" org-shiftmetaup (org-at-table-p)]
- ["Insert Row" org-shiftmetadown (org-at-table-p)]
- "--"
- ["Insert Hline" org-table-insert-hline (org-at-table-p)])
- ("Rectangle"
- ["Copy Rectangle" org-copy-special (org-at-table-p)]
- ["Cut Rectangle" org-cut-special (org-at-table-p)]
- ["Paste Rectangle" org-paste-special (org-at-table-p)]
- ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
- "--"
- ["Which Column?" org-table-current-column (org-at-table-p)]
- ["Sum Column/Rectangle" org-table-sum
- (or (org-at-table-p) (org-region-active-p))]
- ["Eval Formula" org-table-eval-formula (org-at-table-p)]
- "--"
- ["Invisible Vlines" org-table-toggle-vline-visibility
- :style toggle :selected (org-in-invisibility-spec-p '(org-table))]
- "--"
- ["Create" org-table-create (and (not (org-at-table-p))
- org-enable-table-editor)]
- ["Convert Region" org-ctrl-c-ctrl-c (not (org-at-table-p 'any))]
- ["Import from File" org-table-import (not (org-at-table-p))]
- ["Export to File" org-table-export (org-at-table-p)]
- "--"
- ["Create/Convert from/to table.el" org-table-create-with-table.el t])
- "--"
("Export"
["ASCII" org-export-as-ascii t]
["Extract Visible Text" org-export-copy-visible t]
@@ -8865,10 +9461,10 @@ With optional NODE, go directly to that node."
(Info-goto-node (format "(org)%s" (or node ""))))
(defun org-install-agenda-files-menu ()
- (easy-menu-change
+ (easy-menu-change
'("Org") "File List for Agenda"
(append
- (list
+ (list
["Edit File List" (customize-variable 'org-agenda-files) t]
["Add Current File to List" org-add-file t]
["Remove Current File from List" org-remove-file t]
@@ -8983,7 +9579,7 @@ that can be added."
;; Functions needed for compatibility with old outline.el
;; The following functions capture almost the entire compatibility code
-;; between the different versions of outline-mode. The only other place
+;; between the different versions of outline-mode. The only other place
;; where this is important are the font-lock-keywords. Search for
;; `org-noutline-p' to find it.
@@ -9048,7 +9644,7 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
This function considers both visible and invisible heading lines.
With argument, move up ARG levels."
(if org-noutline-p
- (if (fboundp 'outline-up-heading-all)
+ (if (fboundp 'outline-up-heading-all)
(outline-up-heading-all arg) ; emacs 21 version of outline.el
(outline-up-heading arg t)) ; emacs 22 version of outline.el
(org-back-to-heading t)
@@ -9104,8 +9700,8 @@ When ENTRY is non-nil, show the entire entry."
(defun org-show-subtree ()
"Show everything after this heading at deeper levels."
- (outline-flag-region
- (point)
+ (outline-flag-region
+ (point)
(save-excursion
(outline-end-of-subtree) (outline-next-heading) (point))
(if org-noutline-p nil ?\n)))
@@ -9116,7 +9712,7 @@ Show the heading too, if it is currently invisible."
(interactive)
(save-excursion
(org-back-to-heading t)
- (outline-flag-region
+ (outline-flag-region
(1- (point))
(save-excursion
(re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move)
diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
index b3c69ca657f..34b661afcc4 100644
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -359,7 +359,7 @@ With positive argument insert that many lines."
(point))))
(replace-match newtext fixedcase literal)
(if (< change 0)
- (insert-char ?\ (- change)))))
+ (insert-char ?\s (- change)))))
;; Picture Tabs
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index 2be01d630f9..aac70dd1e23 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -816,7 +816,7 @@ Otherwise, follow with a newline."
(texinfo-last-unended-begin)
(match-string 1)))
"table")
- ? ;space
+ ?\s
?\n)))
(defun texinfo-insert-@kbd (&optional arg)
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 4da3d22584a..4148d62c263 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,25 @@
+2005-06-28 Klaus Straubinger <KSNetz@Arcor.DE> (tiny change)
+
+ * url-http.el (url-http-create-request): Call url-recreate-url
+ in proxy case.
+
+2005-06-27 Klaus Straubinger <KSNetz@Arcor.DE> (tiny change)
+
+ * url-http.el (url-http-create-request): When computing real-fname,
+ call url-filename in both cases.
+
+2005-06-27 Richard M. Stallman <rms@gnu.org>
+
+ * url-cookie.el (url-cookie-store): Rename arg PATH to LOCALPART.
+ (url-cookie-retrieve): Likewise.
+ (url-cookie-generate-header-lines): Likewise.
+ (url-cookie-handle-set-cookie): Likewise.
+ (url-cookie-create): Expect :localpart instead of :path.
+ (url-cookie-localpart): Renamed from url-cookie-path.
+ (url-cookie-set-localpart): Renamed from url-cookie-set-path.
+ (url-cookie-file): Doc fix.
+ (url-cookie-p): Add doc string.
+
2005-06-23 Richard M. Stallman <rms@gnu.org>
* url-cookie.el (url-cookie-generate-header-lines): Fix autoload cookie.
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index db50f289521..42c74080ec8 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -34,35 +34,48 @@
;; 'open standard' defining this crap.
;;
;; A cookie is stored internally as a vector of 7 slots
-;; [ 'cookie name value expires path domain secure ]
+;; [ cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE ]
(defsubst url-cookie-name (cookie) (aref cookie 1))
(defsubst url-cookie-value (cookie) (aref cookie 2))
(defsubst url-cookie-expires (cookie) (aref cookie 3))
-(defsubst url-cookie-path (cookie) (aref cookie 4))
+(defsubst url-cookie-localpart (cookie) (aref cookie 4))
(defsubst url-cookie-domain (cookie) (aref cookie 5))
(defsubst url-cookie-secure (cookie) (aref cookie 6))
(defsubst url-cookie-set-name (cookie val) (aset cookie 1 val))
(defsubst url-cookie-set-value (cookie val) (aset cookie 2 val))
(defsubst url-cookie-set-expires (cookie val) (aset cookie 3 val))
-(defsubst url-cookie-set-path (cookie val) (aset cookie 4 val))
+(defsubst url-cookie-set-localpart (cookie val) (aset cookie 4 val))
(defsubst url-cookie-set-domain (cookie val) (aset cookie 5 val))
(defsubst url-cookie-set-secure (cookie val) (aset cookie 6 val))
(defsubst url-cookie-retrieve-arg (key args) (nth 1 (memq key args)))
(defsubst url-cookie-create (&rest args)
+ "Create a cookie vector object from keyword-value pairs ARGS.
+The keywords allowed are
+ :name NAME
+ :value VALUE
+ :expires TIME
+ :localpart LOCALPAR
+ :domain DOMAIN
+ :secure ???
+Could someone fill in more information?"
(let ((retval (make-vector 7 nil)))
(aset retval 0 'cookie)
(url-cookie-set-name retval (url-cookie-retrieve-arg :name args))
(url-cookie-set-value retval (url-cookie-retrieve-arg :value args))
(url-cookie-set-expires retval (url-cookie-retrieve-arg :expires args))
- (url-cookie-set-path retval (url-cookie-retrieve-arg :path args))
+ (url-cookie-set-localpart retval (url-cookie-retrieve-arg :localpart args))
(url-cookie-set-domain retval (url-cookie-retrieve-arg :domain args))
(url-cookie-set-secure retval (url-cookie-retrieve-arg :secure args))
retval))
(defun url-cookie-p (obj)
+ "Return non-nil if OBJ is a cookie vector object.
+These objects represent cookies in the URL package.
+A cookie vector object is a vector of 7 slots:
+ [cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE]."
(and (vectorp obj) (= (length obj) 7) (eq (aref obj 0) 'cookie)))
(defgroup url-cookie nil
@@ -73,7 +86,8 @@
(defvar url-cookie-storage nil "Where cookies are stored.")
(defvar url-cookie-secure-storage nil "Where secure cookies are stored.")
-(defcustom url-cookie-file nil "*Where cookies are stored on disk."
+(defcustom url-cookie-file nil
+ "*File where cookies are stored on disk."
:type '(choice (const :tag "Default" :value nil) file)
:group 'url-file
:group 'url-cookie)
@@ -154,7 +168,7 @@ telling Microsoft that."
(write-file fname)
(kill-buffer (current-buffer))))))
-(defun url-cookie-store (name value &optional expires domain path secure)
+(defun url-cookie-store (name value &optional expires domain localpart secure)
"Store a netscape-style cookie."
(let* ((storage (if secure url-cookie-secure-storage url-cookie-storage))
(tmp storage)
@@ -173,7 +187,7 @@ telling Microsoft that."
(while storage
(setq cur (car storage)
storage (cdr storage))
- (if (and (equal path (url-cookie-path cur))
+ (if (and (equal localpart (url-cookie-localpart cur))
(equal name (url-cookie-name cur)))
(progn
(url-cookie-set-expires cur expires)
@@ -186,7 +200,7 @@ telling Microsoft that."
:value value
:expires expires
:domain domain
- :path path
+ :localpart localpart
:secure secure)
(cdr found-domain)))))
;; Need to add a new top-level domain
@@ -194,7 +208,7 @@ telling Microsoft that."
:value value
:expires expires
:domain domain
- :path path
+ :localpart localpart
:secure secure))
(cond
(storage
@@ -235,8 +249,8 @@ telling Microsoft that."
(> (- cur-norm exp-norm) 1))))))
;;;###autoload
-(defun url-cookie-retrieve (host path &optional secure)
- "Retrieve all the netscape-style cookies for a specified HOST and PATH."
+(defun url-cookie-retrieve (host localpart &optional secure)
+ "Retrieve all the netscape-style cookies for a specified HOST and LOCALPART."
(let ((storage (if secure
(append url-cookie-secure-storage url-cookie-storage)
url-cookie-storage))
@@ -244,7 +258,7 @@ telling Microsoft that."
(cookies nil)
(cur nil)
(retval nil)
- (path-regexp nil))
+ (localpart-regexp nil))
(while storage
(setq cur (car storage)
storage (cdr storage)
@@ -255,26 +269,26 @@ telling Microsoft that."
(while cookies
(setq cur (car cookies)
cookies (cdr cookies)
- path-regexp (concat "^" (regexp-quote
- (url-cookie-path cur))))
- (if (and (string-match path-regexp path)
+ localpart-regexp (concat "^" (regexp-quote
+ (url-cookie-localpart cur))))
+ (if (and (string-match localpart-regexp localpart)
(not (url-cookie-expired-p cur)))
(setq retval (cons cur retval))))))
retval))
;;;###autoload
-(defun url-cookie-generate-header-lines (host path secure)
- (let* ((cookies (url-cookie-retrieve host path secure))
- (retval nil)
- (cur nil)
- (chunk nil))
+(defun url-cookie-generate-header-lines (host localpart secure)
+ (let* ((cookies (url-cookie-retrieve host localpart secure))
+ (retval nil)
+ (cur nil)
+ (chunk nil))
;; Have to sort this for sending most specific cookies first
(setq cookies (and cookies
(sort cookies
(function
(lambda (x y)
- (> (length (url-cookie-path x))
- (length (url-cookie-path y))))))))
+ (> (length (url-cookie-localpart x))
+ (length (url-cookie-localpart y))))))))
(while cookies
(setq cur (car cookies)
cookies (cdr cookies)
@@ -340,9 +354,9 @@ telling Microsoft that."
(trusted url-cookie-trusted-urls)
(untrusted url-cookie-untrusted-urls)
(expires (cdr-safe (assoc-string "expires" args t)))
- (path (or (cdr-safe (assoc-string "path" args t))
- (file-name-directory
- (url-filename url-current-object))))
+ (localpart (or (cdr-safe (assoc-string "path" args t))
+ (file-name-directory
+ (url-filename url-current-object))))
(rest nil))
(while args
(if (not (member (downcase (car (car args)))
@@ -422,7 +436,7 @@ telling Microsoft that."
(while rest
(setq cur (pop rest))
(url-cookie-store (car cur) (cdr cur)
- expires domain path secure))))
+ expires domain localpart secure))))
(t
(message "%s tried to set a cookie for domain %s - rejected."
(url-host url-current-object) domain)))))
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index f5bbf4a7bf4..0b7e2cef8a1 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -156,8 +156,7 @@ request.
(let ((url-basic-auth-storage
'url-http-proxy-basic-auth-storage))
(url-get-authentication url nil 'any nil))))
- (real-fname (if proxy-obj (url-recreate-url proxy-obj)
- (url-filename url)))
+ (real-fname (url-filename (or proxy-obj url)))
(host (url-host (or proxy-obj url)))
(auth (if (cdr-safe (assoc "Authorization" url-request-extra-headers))
nil
@@ -200,7 +199,9 @@ request.
(setq request
(concat
;; The request
- (or url-request-method "GET") " " real-fname " HTTP/" url-http-version "\r\n"
+ (or url-request-method "GET") " "
+ (if proxy-obj (url-recreate-url proxy-obj) real-fname)
+ " HTTP/" url-http-version "\r\n"
;; Version of MIME we speak
"MIME-Version: 1.0\r\n"
;; (maybe) Try to keep the connection open
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 6cfb03f2ac6..b5fd9f80def 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -967,28 +967,28 @@ Recommended as a parent keymap for modes using widgets.")
(recenter))
)
- (let ((up t) command)
- ;; Mouse click not on a widget button. Find the global
- ;; command to run, and check whether it is bound to an
- ;; up event.
- (mouse-set-point event)
- (if (memq (event-basic-type event) '(mouse-1 down-mouse-1))
- (cond ((setq command ;down event
- (lookup-key widget-global-map [down-mouse-1]))
- (setq up nil))
- ((setq command ;up event
- (lookup-key widget-global-map [mouse-1]))))
+ (let ((up t) command)
+ ;; Mouse click not on a widget button. Find the global
+ ;; command to run, and check whether it is bound to an
+ ;; up event.
+ (mouse-set-point event)
+ (if (memq (event-basic-type event) '(mouse-1 down-mouse-1))
(cond ((setq command ;down event
- (lookup-key widget-global-map [down-mouse-2]))
+ (lookup-key widget-global-map [down-mouse-1]))
(setq up nil))
((setq command ;up event
- (lookup-key widget-global-map [mouse-2])))))
- (when up
- ;; Don't execute up events twice.
- (while (not (widget-button-release-event-p event))
- (setq event (read-event))))
- (when command
- (call-interactively command)))))
+ (lookup-key widget-global-map [mouse-1]))))
+ (cond ((setq command ;down event
+ (lookup-key widget-global-map [down-mouse-2]))
+ (setq up nil))
+ ((setq command ;up event
+ (lookup-key widget-global-map [mouse-2])))))
+ (when up
+ ;; Don't execute up events twice.
+ (while (not (widget-button-release-event-p event))
+ (setq event (read-event))))
+ (when command
+ (call-interactively command)))))
(message "You clicked somewhere weird.")))
(defun widget-button-press (pos &optional event)
diff --git a/lisp/window.el b/lisp/window.el
index 09fac6c520f..75052f9a5f1 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -40,11 +40,18 @@ unless you explicitly change the size, or Emacs has no other choice.")
(defmacro save-selected-window (&rest body)
"Execute BODY, then select the window that was selected before BODY.
-Also restore the selected window of each frame as it was at the start
-of this construct.
-However, if a window has become dead, don't get an error,
-just refrain from reselecting it.
-Return the value of the last form in BODY."
+The value returned is the value of the last form in BODY.
+
+This macro saves and restores the current buffer, since otherwise
+its normal operation could potentially make a different
+buffer current. It does not alter the buffer list ordering.
+
+This macro saves and restores the selected window, as well as
+the selected window in each frame. If the previously selected
+window of some frame is no longer live at the end of BODY, that
+frame's selected window is left alone. If the selected window is
+no longer live, then whatever window is selected at the end of
+BODY remains selected."
`(let ((save-selected-window-window (selected-window))
;; It is necessary to save all of these, because calling
;; select-window changes frame-selected-window for whatever
@@ -52,14 +59,15 @@ Return the value of the last form in BODY."
(save-selected-window-alist
(mapcar (lambda (frame) (list frame (frame-selected-window frame)))
(frame-list))))
- (unwind-protect
- (progn ,@body)
- (dolist (elt save-selected-window-alist)
- (and (frame-live-p (car elt))
- (window-live-p (cadr elt))
- (set-frame-selected-window (car elt) (cadr elt))))
- (if (window-live-p save-selected-window-window)
- (select-window save-selected-window-window)))))
+ (save-current-buffer
+ (unwind-protect
+ (progn ,@body)
+ (dolist (elt save-selected-window-alist)
+ (and (frame-live-p (car elt))
+ (window-live-p (cadr elt))
+ (set-frame-selected-window (car elt) (cadr elt))))
+ (if (window-live-p save-selected-window-window)
+ (select-window save-selected-window-window))))))
(defun window-body-height (&optional window)
"Return number of lines in window WINDOW for actual buffer text.