aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorMiles Bader2005-06-30 00:31:46 +0000
committerMiles Bader2005-06-30 00:31:46 +0000
commiteeb88b27e1dbd3f412aa684d44e4a784f6e536a2 (patch)
tree23ea1eda87f588e060b6c00e9c7ffac6a89a7e42 /lisp
parent16e1457021e3f6e3b83fc9b5262fde38b7140c96 (diff)
parent84861437f914ac45c1eea7b6477ffc4783bb3bdd (diff)
downloademacs-eeb88b27e1dbd3f412aa684d44e4a784f6e536a2.tar.gz
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 @@
12005-06-29 Juri Linkov <juri@jurta.org>
2
3 * faces.el (default-frame-background-mode): New internal variable.
4 (frame-set-background-mode): Use it.
5
6 * startup.el (normal-top-level): Set default-frame-background-mode
7 instead of frame-background-mode. Before setting it, test for its
8 nil value. Remove tests for frame-background-mode and frame
9 parameter `reverse'. Add test for "unspecified-fg".
10
11 * term/xterm.el (xterm-rxvt-set-background-mode):
12 * term/rxvt.el (rxvt-set-background-mode):
13 Set default-frame-background-mode instead of frame-background-mode.
14
152005-06-29 Juanma Barranquero <lekktu@gmail.com>
16
17 * imenu.el (imenu--completion-buffer):
18 * mouse.el (mouse-buffer-menu-alist):
19 * msb.el (msb-invisible-buffer-p):
20 * calendar/diary-lib.el (diary-header-line-format):
21 * emacs-lisp/pp.el (pp-buffer):
22 * progmodes/cperl-mode.el (cperl-do-auto-fill):
23 * textmodes/picture.el (picture-replace-match):
24 Change space constants followed by a sexp to "?\s ".
25
26 * play/decipher.el (decipher-loop-with-breaks):
27 * textmodes/texinfo.el (texinfo-insert-@item): Change space
28 constants "protected" from end of line by a comment to "?\s".
29
302005-06-29 Stefan Monnier <monnier@iro.umontreal.ca>
31
32 * font-lock.el (save-buffer-state): Use `declare'.
33
34 * progmodes/cperl-mode.el (cperl-find-pods-heres): Don't gratuitously
35 reset the syntax-table to cperl-mode-syntax-table.
36 (cperl-mode): Make _ into word-syntax during font-locking so "print" in
37 "foo_print_bar" is not matched as a reserved keyword.
38
392005-06-29 Carsten Dominik <dominik@science.uva.nl>
40
41 * textmodes/org.el (orgtbl-setup): New function, for delayed
42 setup for the orgtbl commands.
43 (org-calc-default-modes): New option.
44 (orgtbl-make-binding): Use `defun' to get better help display.
45 (org-diary): Call `org-compile-prefix-format'.
46 (org-table-formula-substitute-names): New function.
47 (org-agenda-day-view, org-agenda-week-view): New commands.
48 (org-agenda-toggle-week-view): Command removed.
49 (org-tbl-menu): Split off from org-org-menu.
50 (org-mode): Move removal of outline-mode menus to here.
51 (org-table-formula-debug): New option.
52 (org-table-insert-row): Keep first field if just "#" or "*".
53 (org-mode): Paragraph regexps fixed.
54 (org-table-recalculate-regexp): New constant.
55 (org-table-justify-field-maybe): Avoid replace if not necessary.
56 (org-copy-special, org-cut-special): Use `call-interactively'.
57 (org-table-copy-region): Take region from `interactive' call.
58 (org-trim): Return string even if no match.
59 (org-formula): New face.
60 (org-set-font-lock-defaults): No longer highlight "FIXME".
61 But highlight formula-related fields in table.
62 (org-table-p): Use regexp, not fontification.
63 (org-table-align): Handle white space at end of line.
64 (org-table-formula-evaluate-inline): New option.
65 (org-mode): Auto-wrapping in comment lines turned off.
66 (org-table-copy-down): Evaluate only in copied field, not in
67 destination.
68 (org-table-current-formula): Variable removed.
69 (org-table-store-formulas, org-table-get-stored-formulas)
70 (org-table-modify-formulas, org-table-replace-in-formulas)
71 (org-table-maybe-eval-formula): New functions.
72 (org-table-get-formula): Modify to use stored formulas.
73 (org-table-insert-column, org-table-delete-column)
74 (org-table-move-column): Call `org-table-modify-formulas'.
75 (org-complete): Add completion for keyword formulas.
76 (orgtbl-mode): Pull orgtbl-mode-map to start of
77 minor-mode-map-alist.
78
792005-06-29 Stefan Monnier <monnier@iro.umontreal.ca>
80
81 * progmodes/python.el (python-check): Require `compile' before
82 modifying its variables.
83
84 * newcomment.el (comment-indent-default): Don't get fooled by an early
85 end of buffer.
86
872005-06-28 Vinicius Jose Latorre <viniciusjl@ig.com.br>
88
89 * ps-print.el (ps-print-version): Fix version number.
90
912005-06-28 Luc Teirlinck <teirllm@auburn.edu>
92
93 * textmodes/ispell.el (ispell-word): Remove stray parenthesis.
94
952005-06-28 Richard M. Stallman <rms@gnu.org>
96
97 * textmodes/flyspell.el (flyspell-use-local-map): Variable deleted.
98 (flyspell-local-mouse-map): Declaration deleted.
99 (flyspell-mouse-map): Bind only mouse-2.
100 (flyspell-mode-map): Don't test flyspell-use-local-map.
101 (flyspell-overlay-keymap-property-name): Var deleted.
102 (flyspell-mode-on): Don't make local bindings for
103 flyspell-mouse-map and flyspell-mode-map.
104 (make-flyspell-overlay): Unconditionally put on `keymap' text prop.
105
106 * textmodes/ispell.el (ispell-word): Do not ignore short words.
107
108 * progmodes/compile.el (compilation-next-error-function):
109 Don't switch buffers; operate on the current buffer.
110
111 * facemenu.el (facemenu-add-face): Warn when font-lock is active.
112
113 * comint.el (comint-password-prompt-regexp): Accept ", try again".
114
115 * bindings.el (global-map): Bind insertchar and its variants.
116
1172005-06-27 Richard M. Stallman <rms@gnu.org>
118
119 * textmodes/artist.el (artist-text-overwrite)
120 (artist-figlet-get-extra-args, artist-text-see-thru): Use read-string.
121
1222005-06-27 Vinicius Jose Latorre <viniciusjl@ig.com.br>
123
124 * ps-print.el: It was not working the page selection for printing.
125 Reported by Sebastian Tennant <sebyte@smolny.plus.com>.
126 (ps-print-version): New version 6.6.7.
127 (ps-end-sheet): New fun.
128 (ps-header-sheet, ps-end-job): Call it.
129
1302005-06-27 Luc Teirlinck <teirllm@auburn.edu>
131
132 * subr.el (add-to-list, add-to-ordered-list): Doc fixes.
133
1342005-06-27 Lute Kamstra <lute@gnu.org>
135
136 * facemenu.el (facemenu-unlisted-faces): Add foreground and
137 background color faces.
138 (facemenu-get-face): Delete function.
139 (facemenu-set-face-from-menu): Don't call facemenu-get-face.
140 (facemenu-add-new-color): Make second argument mandatory.
141 Create the approprate face and return it. Simplify.
142 (facemenu-set-foreground, facemenu-set-background): Don't check if
143 color is defined. Use return value of facemenu-add-new-color.
144
1452005-06-26 Nick Roberts <nickrob@snap.net.nz>
146
147 * progmodes/gud.el (gud-filter): Add missing argument to
148 with-selected-window.
149
1502005-06-26 Stefan Monnier <monnier@iro.umontreal.ca>
151
152 * emacs-lisp/easy-mmode.el (define-minor-mode): Don't automatically add
153 a :require to the defcustom.
154
155 * emacs-lisp/autoload.el (make-autoload): Add the :setter for
156 defcustoms corresponding to minor modes.
157
1582005-06-26 David Ponce <david@dponce.com>
159
160 * recentf.el: Require tree-widget instead of wid-edit.
161 (recentf-filename-handler): Fix widget :type.
162 (recentf-cancel-dialog, recentf-open-more-files)
163 (recentf-open-files-action): Doc fix.
164 (recentf-dialog-goto-first): New function.
165 (recentf-dialog-mode-map): Set parent keymap first.
166 (recentf-dialog-mode): Define with define-derived-mode.
167 Don't display continuation lines in dialogs.
168 (recentf-edit-list): Rename from recentf-edit-selected-items.
169 (recentf-edit-list-select): Rename from recentf-edit-list-action.
170 Simplify.
171 (recentf-edit-list-validate): New function.
172 (recentf-edit-list): Update accordingly.
173 (recentf-open-files-item-shift): Remove.
174 (recentf-open-files-item): Convert menu elements into tree and
175 link widgets. Don't create the widgets.
176 (recentf-open-files): Update accordingly.
177 (recentf-save-list): Untabify.
178
1792005-06-25 Luc Teirlinck <teirllm@auburn.edu>
180
181 * replace.el (keep-lines-read-args): Add INTERACTIVE arg.
182 (keep-lines): Add INTERACTIVE arg. Never delete lines only
183 partially contained in the active region. Do not take active
184 region into account when called from Lisp, unless INTERACTIVE arg
185 is non-nil. Use `forward-line' instead of `beginning-of-line' to
186 avoid trouble with fields. Make marker point nowhere when no
187 longer used. Always return nil. Doc fix.
188 (flush-lines): Add INTERACTIVE arg. Do not take active region
189 into account when called from Lisp, unless INTERACTIVE arg is
190 non-nil. Use `forward-line' instead of `beginning-of-line' to
191 avoid trouble with fields. Make marker point nowhere when no
192 longer used. Always return nil. Doc fix.
193 (how-many): Add INTERACTIVE arg. Make RSTART and REND args
194 interchangeable. Do not take active region into account when
195 called from Lisp, unless INTERACTIVE arg is non-nil. Do not print
196 message in echo area when called from Lisp, unless INTERACTIVE arg
197 is non-nil. Avoid saying "1 occurrences". Do not use markers.
198 Return the number of matches. Doc fix.
199 (occur): Doc fix.
200 (perform-replace): Make comment follow double space convention for
201 the sake of `outline-minor-mode'.
202
203 * faces.el (facep): Doc fix.
204
2052005-06-25 Richard M. Stallman <rms@gnu.org>
206
207 * facemenu.el (facemenu-enable-faces-p): New function.
208 (facemenu-background-menu, facemenu-foreground-menu)
209 (facemenu-face-menu): Add menu-enable property.
210
211 * jka-compr.el (jka-compr-insert-file-contents):
212 Special handling if cannot find the uncompression program.
213
214 * cus-face.el (custom-face-attributes): Add autoload.
215
216 * emacs-lisp/lisp-mode.el (lisp-mode-variables):
217 Bind comment-indent-function locally.
218
219 * window.el (save-selected-window): Use save-current-buffer.
220
221 * subr.el (with-selected-window): Use save-current-buffer.
222
223 * progmodes/gud.el (gud-filter): Simplify using with-selected-window
224 and with-current-buffer.
225
2262005-06-24 Richard M. Stallman <rms@gnu.org>
227
228 * simple.el (line-move-1): Fix previous change.
229
2302005-06-24 Juanma Barranquero <lekktu@gmail.com>
231
232 * replace.el (occur-1): Set `buffer-read-only' and the
233 buffer-modified flag before running `occur-hook' to protect
234 against unintentional buffer switches that can lead to data loss.
235
12005-06-24 Nick Roberts <nickrob@snap.net.nz> 2362005-06-24 Nick Roberts <nickrob@snap.net.nz>
2 237
3 * progmodes/gud.el (gud-tooltip-print-command): Indent properly. 238 * progmodes/gud.el (gud-tooltip-print-command): Indent properly.
4 (gud-gdb-marker-filter): Use font-lock-warning-face for any 239 (gud-gdb-marker-filter): Use font-lock-warning-face for any
5 initial error. 240 initial error.
6 241
7 * progmodes/gdb-ui.el (gdb-send): Remove warning face from errors 242 * progmodes/gdb-ui.el (gdb-send): Remove warning face from errors
8 after fresh input. 243 after fresh input.
9 (gdb-var-create-handler): Put name of expression in quotes. 244 (gdb-var-create-handler): Put name of expression in quotes.
10 245
112005-06-23 Luc Teirlinck <teirllm@auburn.edu> 2462005-06-23 Luc Teirlinck <teirllm@auburn.edu>
12 247
13 * emacs-lisp/ring.el (ring-elements): Make it return a list of the 248 * emacs-lisp/ring.el (ring-elements): Make it return a list of the
@@ -19,7 +254,7 @@
19 (line-move-1): When there are overlays around, use vertical-motion. 254 (line-move-1): When there are overlays around, use vertical-motion.
20 255
21 * faces.el (escape-glyph): Use brown against light background. 256 * faces.el (escape-glyph): Use brown against light background.
22 (nobreak-space): Renamed from no-break-space. 257 (nobreak-space): Rename from no-break-space.
23 Fix previous change. 258 Fix previous change.
24 259
25 * dired-aux.el (dired-do-copy): Fix arg prompt. 260 * dired-aux.el (dired-do-copy): Fix arg prompt.
@@ -73,7 +308,7 @@
73 * bindings.el (propertized-buffer-identification): Use renamed 308 * bindings.el (propertized-buffer-identification): Use renamed
74 `Buffer-menu-buffer' face. 309 `Buffer-menu-buffer' face.
75 310
76 * faces.el (vertical-border): Renamed from `vertical-divider'. 311 * faces.el (vertical-border): Rename from `vertical-divider'.
77 (escape-glyph): Change dark-background color back to `cyan'. 312 (escape-glyph): Change dark-background color back to `cyan'.
78 313
792005-06-21 Juri Linkov <juri@jurta.org> 3142005-06-21 Juri Linkov <juri@jurta.org>
@@ -159,8 +394,7 @@
159 394
1602005-06-18 Peter Kleiweg <p.c.j.kleiweg@rug.nl> 3952005-06-18 Peter Kleiweg <p.c.j.kleiweg@rug.nl>
161 396
162 * progmodes/ps-mode.el: Update version and maintainer's email 397 * progmodes/ps-mode.el: Update version and maintainer's email address.
163 address.
164 398
1652005-06-18 Steve Youngs <steve@xemacs.org> 3992005-06-18 Steve Youngs <steve@xemacs.org>
166 400
@@ -248,8 +482,8 @@
248 New backward-compatibility aliases for renamed faces. 482 New backward-compatibility aliases for renamed faces.
249 (eshell-ls-decorated-name): Use renamed eshell-ls faces. 483 (eshell-ls-decorated-name): Use renamed eshell-ls faces.
250 484
251 * progmodes/cc-fonts.el (c-nonbreakable-space-face): Remove 485 * progmodes/cc-fonts.el (c-nonbreakable-space-face):
252 "-face" suffix from face name. 486 Remove "-face" suffix from face name.
253 (c-cpp-matchers): Use the variable `c-nonbreakable-space-face' 487 (c-cpp-matchers): Use the variable `c-nonbreakable-space-face'
254 instead of literal face. 488 instead of literal face.
255 489
@@ -377,8 +611,8 @@
377 ido-incomplete-regexp. 611 ido-incomplete-regexp.
378 (ido-incomplete-regexp): New face. 612 (ido-incomplete-regexp): New face.
379 (ido-completions): Use it. 613 (ido-completions): Use it.
380 (ido-complete, ido-exit-minibuffer, ido-completions): Handle 614 (ido-complete, ido-exit-minibuffer, ido-completions):
381 incomplete regexps. 615 Handle incomplete regexps.
382 (ido-completions): Add check for complete match when entering a regexp. 616 (ido-completions): Add check for complete match when entering a regexp.
383 617
3842005-06-15 Stefan Monnier <monnier@iro.umontreal.ca> 6182005-06-15 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -407,6 +641,11 @@
407 * progmodes/cperl-mode.el (cperl-init-faces): Use literal cperl 641 * progmodes/cperl-mode.el (cperl-init-faces): Use literal cperl
408 faces instead of (non-existent) variables. 642 faces instead of (non-existent) variables.
409 643
6442005-06-14 Stefan Monnier <monnier@iro.umontreal.ca>
645
646 * iswitchb.el (iswitchb-to-end): Replace mapcar with dolist.
647 (iswitchb-get-matched-buffers): Likewise. Simplify.
648
4102005-06-14 Miles Bader <miles@gnu.org> 6492005-06-14 Miles Bader <miles@gnu.org>
411 650
412 * progmodes/ld-script.el (ld-script-location-counter): 651 * progmodes/ld-script.el (ld-script-location-counter):
@@ -532,7 +771,7 @@
532 771
533 * progmodes/gdb-ui.el (menu): Re-order menu items. 772 * progmodes/gdb-ui.el (menu): Re-order menu items.
534 (gdb-tooltip-print): Respect tooltip-use-echo-area. 773 (gdb-tooltip-print): Respect tooltip-use-echo-area.
535 774
536 * progmodes/gud.el (tooltip-use-echo-area): Remove alias. 775 * progmodes/gud.el (tooltip-use-echo-area): Remove alias.
537 Define in tooltip.el. 776 Define in tooltip.el.
538 (gud-tooltip-process-output): Respect tooltip-use-echo-area. 777 (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."
775(define-key global-map [insert] 'overwrite-mode) 775(define-key global-map [insert] 'overwrite-mode)
776(define-key global-map [C-insert] 'kill-ring-save) 776(define-key global-map [C-insert] 'kill-ring-save)
777(define-key global-map [S-insert] 'yank) 777(define-key global-map [S-insert] 'yank)
778;; `insertchar' is what term.c produces. Should we change term.c
779;; to produce `insert' instead?
780(define-key global-map [insertchar] 'overwrite-mode)
781(define-key global-map [C-insertchar] 'kill-ring-save)
782(define-key global-map [S-insertchar] 'yank)
778(define-key global-map [undo] 'undo) 783(define-key global-map [undo] 'undo)
779(define-key global-map [redo] 'repeat-complex-command) 784(define-key global-map [redo] 'repeat-complex-command)
780(define-key global-map [again] 'repeat-complex-command) ; Sun keyboard 785(define-key global-map [again] 'repeat-complex-command) ; Sun keyboard
@@ -785,7 +790,6 @@ language you are using."
785;; (define-key global-map [clearline] 'function-key-error) 790;; (define-key global-map [clearline] 'function-key-error)
786(define-key global-map [insertline] 'open-line) 791(define-key global-map [insertline] 'open-line)
787(define-key global-map [deleteline] 'kill-line) 792(define-key global-map [deleteline] 'kill-line)
788;; (define-key global-map [insertchar] 'function-key-error)
789(define-key global-map [deletechar] 'delete-char) 793(define-key global-map [deletechar] 'delete-char)
790;; (define-key global-map [backtab] 'function-key-error) 794;; (define-key global-map [backtab] 'function-key-error)
791;; (define-key global-map [f1] 'function-key-error) 795;; (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'."
290 "Selective display active - press \"s\" in calendar \ 290 "Selective display active - press \"s\" in calendar \
291before edit/copy" 291before edit/copy"
292 "Diary")) 292 "Diary"))
293 ?\ (frame-width))) 293 ?\s (frame-width)))
294 "*Format of the header line displayed by `simple-diary-display'. 294 "*Format of the header line displayed by `simple-diary-display'.
295Only used if `diary-header-line-flag' is non-nil." 295Only used if `diary-header-line-flag' is non-nil."
296 :group 'diary 296 :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."
338 "\\(\\([Oo]ld \\|[Nn]ew \\|'s \\|login \\|\ 338 "\\(\\([Oo]ld \\|[Nn]ew \\|'s \\|login \\|\
339Kerberos \\|CVS \\|UNIX \\| SMB \\|^\\)\ 339Kerberos \\|CVS \\|UNIX \\| SMB \\|^\\)\
340\[Pp]assword\\( (again)\\)?\\|\ 340\[Pp]assword\\( (again)\\)?\\|\
341pass phrase\\|\\(Enter\\|Repeat\\) passphrase\\)\ 341pass phrase\\|\\(Enter\\|Repeat\\|Bad\\) passphrase\\)\
342\\( for [^:]+\\)?:\\s *\\'" 342\\(?:, try again\\)?\\(?: for [^:]+\\)?:\\s *\\'"
343 "*Regexp matching prompts for passwords in the inferior process. 343 "*Regexp matching prompts for passwords in the inferior process.
344This is used by `comint-watch-for-password-prompt'." 344This is used by `comint-watch-for-password-prompt'."
345 :type 'regexp 345 :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 @@
59 59
60;;; Face attributes. 60;;; Face attributes.
61 61
62;;;###autoload
62(defconst custom-face-attributes 63(defconst custom-face-attributes
63 '((:family 64 '((:family
64 (string :tag "Font Family" 65 (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 @@
1;; autoload.el --- maintain autoloads in loaddefs.el 1;; autoload.el --- maintain autoloads in loaddefs.el
2 2
3;; Copyright (C) 1991,92,93,94,95,96,97, 2001,02,03,04 3;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 2001, 2002, 2003,
4;; Free Software Foundation, Inc. 4;; 2004, 2005 Free Software Foundation, Inc.
5 5
6;; Author: Roland McGrath <roland@gnu.org> 6;; Author: Roland McGrath <roland@gnu.org>
7;; Keywords: maint 7;; Keywords: maint
@@ -123,7 +123,17 @@ or macro definition or a defcustom)."
123 ) 123 )
124 `(progn 124 `(progn
125 (defvar ,varname ,init ,doc) 125 (defvar ,varname ,init ,doc)
126 (custom-autoload ',varname ,file)))) 126 (custom-autoload ',varname ,file)
127 ;; The use of :require in a defcustom can be annoying, especially
128 ;; when defcustoms are moved from one file to another between
129 ;; releases because the :require arg gets placed in the user's
130 ;; .emacs. In order for autoloaded minor modes not to need the
131 ;; use of :require, we arrange to store their :setter.
132 ,(let ((setter (condition-case nil
133 (cadr (memq :set form))
134 (error nil))))
135 (if (equal setter ''custom-set-minor-mode)
136 `(put ',varname 'custom-set 'custom-set-minor-mode))))))
127 137
128 ;; nil here indicates that this is not a special autoload form. 138 ;; nil here indicates that this is not a special autoload form.
129 (t nil)))) 139 (t nil))))
@@ -566,5 +576,5 @@ Calls `update-directory-autoloads' on the command line arguments."
566 576
567(provide 'autoload) 577(provide 'autoload)
568 578
569;;; arch-tag: 00244766-98f4-4767-bf42-8a22103441c6 579;; arch-tag: 00244766-98f4-4767-bf42-8a22103441c6
570;;; autoload.el ends here 580;;; 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."))
201 :type 'boolean 201 :type 'boolean
202 ,@(cond 202 ,@(cond
203 ((not (and curfile require)) nil) 203 ((not (and curfile require)) nil)
204 ((not (eq require t)) `(:require ,require)) 204 ((not (eq require t)) `(:require ,require)))
205 (t `(:require
206 ',(intern (file-name-nondirectory
207 (file-name-sans-extension curfile))))))
208 ,@(nreverse extra-keywords)))) 205 ,@(nreverse extra-keywords))))
209 206
210 ;; The actual function. 207 ;; 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 @@
202 (setq comment-column 40) 202 (setq comment-column 40)
203 ;; Don't get confused by `;' in doc strings when paragraph-filling. 203 ;; Don't get confused by `;' in doc strings when paragraph-filling.
204 (set (make-local-variable 'comment-use-global-state) t) 204 (set (make-local-variable 'comment-use-global-state) t)
205 (make-local-variable 'comment-indent-function)
206 (setq comment-indent-function 'lisp-comment-indent)
205 (make-local-variable 'imenu-generic-expression) 207 (make-local-variable 'imenu-generic-expression)
206 (setq imenu-generic-expression lisp-imenu-generic-expression) 208 (setq imenu-generic-expression lisp-imenu-generic-expression)
207 (make-local-variable 'multibyte-syntax-as-symbol) 209 (make-local-variable 'multibyte-syntax-as-symbol)
@@ -714,7 +716,7 @@ which see."
714 (setq debug-on-error new-value)) 716 (setq debug-on-error new-value))
715 value))))) 717 value)))))
716 718
717 719;; Used for comment-indent-function in Lisp modes.
718(defun lisp-comment-indent () 720(defun lisp-comment-indent ()
719 (if (looking-at "\\s<\\s<\\s<") 721 (if (looking-at "\\s<\\s<\\s<")
720 (current-column) 722 (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."
67 (save-excursion 67 (save-excursion
68 (backward-char 1) 68 (backward-char 1)
69 (skip-chars-backward "'`#^") 69 (skip-chars-backward "'`#^")
70 (when (and (not (bobp)) (memq (char-before) '(?\ ?\t ?\n))) 70 (when (and (not (bobp)) (memq (char-before) '(?\s ?\t ?\n)))
71 (delete-region 71 (delete-region
72 (point) 72 (point)
73 (progn (skip-chars-backward " \t\n") (point))) 73 (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 @@
1;;; facemenu.el --- create a face menu for interactively adding fonts to text 1;;; facemenu.el --- create a face menu for interactively adding fonts to text
2 2
3;; Copyright (c) 1994, 1995, 1996, 2001, 2002 Free Software Foundation, Inc. 3;; Copyright (c) 1994, 1995, 1996, 2001, 2002, 2005 Free Software Foundation, Inc.
4 4
5;; Author: Boris Goldowsky <boris@gnu.org> 5;; Author: Boris Goldowsky <boris@gnu.org>
6;; Keywords: faces 6;; Keywords: faces
@@ -135,7 +135,8 @@ just before \"Other\" at the end."
135 `(modeline region secondary-selection highlight scratch-face 135 `(modeline region secondary-selection highlight scratch-face
136 ,(purecopy "^font-lock-") ,(purecopy "^gnus-") ,(purecopy "^message-") 136 ,(purecopy "^font-lock-") ,(purecopy "^gnus-") ,(purecopy "^message-")
137 ,(purecopy "^ediff-") ,(purecopy "^term-") ,(purecopy "^vc-") 137 ,(purecopy "^ediff-") ,(purecopy "^term-") ,(purecopy "^vc-")
138 ,(purecopy "^widget-") ,(purecopy "^custom-") ,(purecopy "^vm-")) 138 ,(purecopy "^widget-") ,(purecopy "^custom-") ,(purecopy "^vm-")
139 ,(purecopy "^fg:") ,(purecopy "^bg:"))
139 "*List of faces not to include in the Face menu. 140 "*List of faces not to include in the Face menu.
140Each element may be either a symbol, which is the name of a face, or a string, 141Each element may be either a symbol, which is the name of a face, or a string,
141which is a regular expression to be matched against face names. Matching 142which is a regular expression to be matched against face names. Matching
@@ -162,6 +163,7 @@ when they are created."
162 "Menu keymap for faces.") 163 "Menu keymap for faces.")
163;;;###autoload 164;;;###autoload
164(defalias 'facemenu-face-menu facemenu-face-menu) 165(defalias 'facemenu-face-menu facemenu-face-menu)
166(put 'facemenu-face-menu 'menu-enable '(facemenu-enable-faces-p))
165 167
166;;;###autoload 168;;;###autoload
167(defvar facemenu-foreground-menu 169(defvar facemenu-foreground-menu
@@ -171,6 +173,7 @@ when they are created."
171 "Menu keymap for foreground colors.") 173 "Menu keymap for foreground colors.")
172;;;###autoload 174;;;###autoload
173(defalias 'facemenu-foreground-menu facemenu-foreground-menu) 175(defalias 'facemenu-foreground-menu facemenu-foreground-menu)
176(put 'facemenu-foreground-menu 'menu-enable '(facemenu-enable-faces-p))
174 177
175;;;###autoload 178;;;###autoload
176(defvar facemenu-background-menu 179(defvar facemenu-background-menu
@@ -180,6 +183,11 @@ when they are created."
180 "Menu keymap for background colors.") 183 "Menu keymap for background colors.")
181;;;###autoload 184;;;###autoload
182(defalias 'facemenu-background-menu facemenu-background-menu) 185(defalias 'facemenu-background-menu facemenu-background-menu)
186(put 'facemenu-background-menu 'menu-enable '(facemenu-enable-faces-p))
187
188;;; Condition for enabling menu items that set faces.
189(defun facemenu-enable-faces-p ()
190 (not (and font-lock-mode font-lock-defaults)))
183 191
184;;;###autoload 192;;;###autoload
185(defvar facemenu-special-menu 193(defvar facemenu-special-menu
@@ -358,10 +366,8 @@ typing a character to insert cancels the specification."
358 (region-beginning)) 366 (region-beginning))
359 (if (and mark-active (not current-prefix-arg)) 367 (if (and mark-active (not current-prefix-arg))
360 (region-end)))) 368 (region-end))))
361 (unless (color-defined-p color) 369 (facemenu-add-face (facemenu-add-new-color color 'facemenu-foreground-menu)
362 (message "Color `%s' undefined" color)) 370 start end))
363 (facemenu-add-new-color color 'facemenu-foreground-menu)
364 (facemenu-add-face (list (list :foreground color)) start end))
365 371
366;;;###autoload 372;;;###autoload
367(defun facemenu-set-background (color &optional start end) 373(defun facemenu-set-background (color &optional start end)
@@ -382,10 +388,8 @@ typing a character to insert cancels the specification."
382 (region-beginning)) 388 (region-beginning))
383 (if (and mark-active (not current-prefix-arg)) 389 (if (and mark-active (not current-prefix-arg))
384 (region-end)))) 390 (region-end))))
385 (unless (color-defined-p color) 391 (facemenu-add-face (facemenu-add-new-color color 'facemenu-background-menu)
386 (message "Color `%s' undefined" color)) 392 start end))
387 (facemenu-add-new-color color 'facemenu-background-menu)
388 (facemenu-add-face (list (list :background color)) start end))
389 393
390;;;###autoload 394;;;###autoload
391(defun facemenu-set-face-from-menu (face start end) 395(defun facemenu-set-face-from-menu (face start end)
@@ -406,7 +410,6 @@ typing a character to insert cancels the specification."
406 (if (and mark-active (not current-prefix-arg)) 410 (if (and mark-active (not current-prefix-arg))
407 (region-end)))) 411 (region-end))))
408 (barf-if-buffer-read-only) 412 (barf-if-buffer-read-only)
409 (facemenu-get-face face)
410 (if start 413 (if start
411 (facemenu-add-face face start end) 414 (facemenu-add-face face start end)
412 (facemenu-add-face face))) 415 (facemenu-add-face face)))
@@ -608,7 +611,9 @@ effect. See `facemenu-remove-face-function'."
608 self-insert-face 611 self-insert-face
609 (list self-insert-face))) 612 (list self-insert-face)))
610 face) 613 face)
611 self-insert-face-command this-command))))) 614 self-insert-face-command this-command))))
615 (unless (facemenu-enable-faces-p)
616 (message "Font-lock mode will override any faces you set in this buffer")))
612 617
613(defun facemenu-active-faces (face-list &optional frame) 618(defun facemenu-active-faces (face-list &optional frame)
614 "Return from FACE-LIST those faces that would be used for display. 619 "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."
641 (setq face-list (cdr face-list))) 646 (setq face-list (cdr face-list)))
642 (nreverse active-list))) 647 (nreverse active-list)))
643 648
644(defun facemenu-get-face (symbol)
645 "Make sure FACE exists.
646If not, create it and add it to the appropriate menu. Return the SYMBOL."
647 (let ((name (symbol-name symbol)))
648 (cond ((facep symbol))
649 (t (make-face symbol))))
650 symbol)
651
652(defun facemenu-add-new-face (face) 649(defun facemenu-add-new-face (face)
653 "Add FACE (a face) to the Face menu. 650 "Add FACE (a face) to the Face menu.
654 651
@@ -708,47 +705,44 @@ This is called whenever you create a new face."
708 (define-key menu key (cons name function)))))) 705 (define-key menu key (cons name function))))))
709 nil) ; Return nil for facemenu-iterate 706 nil) ; Return nil for facemenu-iterate
710 707
711(defun facemenu-add-new-color (color &optional menu) 708(defun facemenu-add-new-color (color menu)
712 "Add COLOR (a color name string) to the appropriate Face menu. 709 "Add COLOR (a color name string) to the appropriate Face menu.
713MENU should be `facemenu-foreground-menu' or 710MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'.
714`facemenu-background-menu'. 711Create the appropriate face and return it.
715 712
716This is called whenever you use a new color." 713This is called whenever you use a new color."
717 (let* (name 714 (let (symbol docstring)
718 symbol 715 (unless (color-defined-p color)
719 docstring 716 (error "Color `%s' undefined" color))
720 function menu-val key
721 (color-p (memq menu '(facemenu-foreground-menu
722 facemenu-background-menu))))
723 (unless (stringp color)
724 (error "%s is not a color" color))
725 (setq name color
726 symbol (intern name))
727
728 (cond ((eq menu 'facemenu-foreground-menu) 717 (cond ((eq menu 'facemenu-foreground-menu)
729 (setq docstring 718 (setq docstring
730 (format "Select foreground color %s for subsequent insertion." 719 (format "Select foreground color %s for subsequent insertion."
731 name))) 720 color)
721 symbol (intern (concat "fg:" color)))
722 (set-face-foreground (make-face symbol) color))
732 ((eq menu 'facemenu-background-menu) 723 ((eq menu 'facemenu-background-menu)
733 (setq docstring 724 (setq docstring
734 (format "Select background color %s for subsequent insertion." 725 (format "Select background color %s for subsequent insertion."
735 name)))) 726 color)
727 symbol (intern (concat "bg:" color)))
728 (set-face-background (make-face symbol) color))
729 (t (error "MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'")))
736 (cond ((facemenu-iterate ; check if equivalent face is already in the menu 730 (cond ((facemenu-iterate ; check if equivalent face is already in the menu
737 (lambda (m) (and (listp m) 731 (lambda (m) (and (listp m)
738 (symbolp (car m)) 732 (symbolp (car m))
739 (stringp (cadr m)) 733 (stringp (cadr m))
740 (string-equal (cadr m) color))) 734 (string-equal (cadr m) color)))
741 (cdr (symbol-function menu)))) 735 (cdr (symbol-function menu))))
742 (t ; No keyboard equivalent. Figure out where to put it: 736 (t ; No keyboard equivalent. Figure out where to put it:
743 (setq key (vector symbol) 737 (let ((key (vector symbol))
744 function 'facemenu-set-face-from-menu 738 (function 'facemenu-set-face-from-menu)
745 menu-val (symbol-function menu)) 739 (menu-val (symbol-function menu)))
746 (if (and facemenu-new-faces-at-end 740 (if (and facemenu-new-faces-at-end
747 (> (length menu-val) 3)) 741 (> (length menu-val) 3))
748 (define-key-after menu-val key (cons name function) 742 (define-key-after menu-val key (cons color function)
749 (car (nth (- (length menu-val) 3) menu-val))) 743 (car (nth (- (length menu-val) 3) menu-val)))
750 (define-key menu key (cons name function)))))) 744 (define-key menu key (cons color function))))))
751 nil) ; Return nil for facemenu-iterate 745 symbol))
752 746
753(defun facemenu-complete-face-list (&optional oldlist) 747(defun facemenu-complete-face-list (&optional oldlist)
754 "Return list of all faces that look different. 748 "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."
204;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 204;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
205 205
206(defun facep (face) 206(defun facep (face)
207 "Return non-nil if FACE is a face name." 207 "Return non-nil if FACE is a face name or internal face object.
208Return nil otherwise. A face name can be a string or a symbol.
209An internal face object is a vector of the kind used internally
210to record face data."
208 (internal-lisp-face-p face)) 211 (internal-lisp-face-p face))
209 212
210 213
@@ -1573,6 +1576,13 @@ this won't have the expected effect."
1573 (choice-item light) 1576 (choice-item light)
1574 (choice-item :tag "default" nil))) 1577 (choice-item :tag "default" nil)))
1575 1578
1579(defvar default-frame-background-mode nil
1580 "Internal variable for the default brightness of the background.
1581Emacs sets it automatically depending on the terminal type.
1582The value `nil' means `dark'. If Emacs runs in non-windowed
1583mode from `xterm' or a similar terminal emulator, the value is
1584`light'. On rxvt terminals, the value depends on the environment
1585variable COLORFGBG.")
1576 1586
1577(defun frame-set-background-mode (frame) 1587(defun frame-set-background-mode (frame)
1578 "Set up display-dependent faces on FRAME. 1588 "Set up display-dependent faces on FRAME.
@@ -1588,13 +1598,13 @@ according to the `background-mode' and `display-type' frame parameters."
1588 (intern (downcase bg-resource))) 1598 (intern (downcase bg-resource)))
1589 ((and (null window-system) (null bg-color)) 1599 ((and (null window-system) (null bg-color))
1590 ;; No way to determine this automatically (?). 1600 ;; No way to determine this automatically (?).
1591 'dark) 1601 (or default-frame-background-mode 'dark))
1592 ;; Unspecified frame background color can only happen 1602 ;; Unspecified frame background color can only happen
1593 ;; on tty's. 1603 ;; on tty's.
1594 ((member bg-color '(unspecified "unspecified-bg")) 1604 ((member bg-color '(unspecified "unspecified-bg"))
1595 'dark) 1605 (or default-frame-background-mode 'dark))
1596 ((equal bg-color "unspecified-fg") ; inverted colors 1606 ((equal bg-color "unspecified-fg") ; inverted colors
1597 'light) 1607 (if (eq default-frame-background-mode 'light) 'dark 'light))
1598 ((>= (apply '+ (x-color-values bg-color frame)) 1608 ((>= (apply '+ (x-color-values bg-color frame))
1599 ;; Just looking at the screen, colors whose 1609 ;; Just looking at the screen, colors whose
1600 ;; values add up to .6 of the white total 1610 ;; 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.")
620 ;; We use this to preserve or protect things when modifying text properties. 620 ;; We use this to preserve or protect things when modifying text properties.
621 (defmacro save-buffer-state (varlist &rest body) 621 (defmacro save-buffer-state (varlist &rest body)
622 "Bind variables according to VARLIST and eval BODY restoring buffer state." 622 "Bind variables according to VARLIST and eval BODY restoring buffer state."
623 (declare (indent 1) (debug let))
623 (let ((modified (make-symbol "modified"))) 624 (let ((modified (make-symbol "modified")))
624 `(let* ,(append varlist 625 `(let* ,(append varlist
625 `((,modified (buffer-modified-p)) 626 `((,modified (buffer-modified-p))
@@ -634,8 +635,6 @@ Major/minor modes can set this variable if they know which option applies.")
634 ,@body) 635 ,@body)
635 (unless ,modified 636 (unless ,modified
636 (restore-buffer-modified-p nil))))) 637 (restore-buffer-modified-p nil)))))
637 (put 'save-buffer-state 'lisp-indent-function 1)
638 (def-edebug-spec save-buffer-state let)
639 ;; 638 ;;
640 ;; Shut up the byte compiler. 639 ;; Shut up the byte compiler.
641 (defvar font-lock-face-attributes)) ; Obsolete but respected if set. 640 (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 @@
12005-06-29 Katsumi Yamaoka <yamaoka@jpl.org>
2
3 * gnus-nocem.el (gnus-nocem-verifyer): Default to pgg-verify.
4 (gnus-nocem-check-article): Fetch the Type header.
5 (gnus-nocem-message-wanted-p): Fix the way to examine types.
6 (gnus-nocem-verify-issuer): Use functionp instead of fboundp.
7 (gnus-nocem-enter-article): Make sure gnus-nocem-hashtb is initialized.
8
9 * pgg.el (pgg-verify): Return the verification result.
10
112005-06-24 Juanma Barranquero <lekktu@gmail.com>
12
13 * gnus-art.el (gnus-article-mode): Set `nobreak-char-display', not
14 `show-nonbreak-escape'.
15
12005-06-23 Lute Kamstra <lute@gnu.org> 162005-06-23 Lute Kamstra <lute@gnu.org>
2 17
3 * gnus-art.el (gnus-article-mode): Use kill-all-local-variables. 18 * 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:
3755 (make-local-variable 'gnus-article-charset) 3755 (make-local-variable 'gnus-article-charset)
3756 (make-local-variable 'gnus-article-ignored-charsets) 3756 (make-local-variable 'gnus-article-ignored-charsets)
3757 ;; Prevent recent Emacsen from displaying non-break space as "\ ". 3757 ;; Prevent recent Emacsen from displaying non-break space as "\ ".
3758 (set (make-local-variable 'show-nonbreak-escape) nil) 3758 (set (make-local-variable 'nobreak-char-display) nil)
3759 (gnus-set-default-directory) 3759 (gnus-set-default-directory)
3760 (buffer-disable-undo) 3760 (buffer-disable-undo)
3761 (setq buffer-read-only t) 3761 (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 @@
1;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment 1;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment
2 2
3;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2004 3;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2004, 2005
4;; Free Software Foundation, Inc. 4;; Free Software Foundation, Inc.
5 5
6 6
@@ -74,12 +74,13 @@ issuer registry."
74 :group 'gnus-nocem 74 :group 'gnus-nocem
75 :type 'integer) 75 :type 'integer)
76 76
77(defcustom gnus-nocem-verifyer 'mc-verify 77(defcustom gnus-nocem-verifyer 'pgg-verify
78 "*Function called to verify that the NoCeM message is valid. 78 "*Function called to verify that the NoCeM message is valid.
79One likely value is `mc-verify'. If the function in this variable 79One likely value is `pgg-verify'. If the function in this variable
80isn't bound, the message will be used unconditionally." 80isn't bound, the message will be used unconditionally."
81 :group 'gnus-nocem 81 :group 'gnus-nocem
82 :type '(radio (function-item mc-verify) 82 :type '(radio (function-item pgg-verify)
83 (function-item mc-verify)
83 (function :tag "other"))) 84 (function :tag "other")))
84 85
85(defcustom gnus-nocem-liberal-fetch nil 86(defcustom gnus-nocem-liberal-fetch nil
@@ -246,7 +247,7 @@ valid issuer, which is much faster if you are selective about the issuers."
246 ;; We get the name of the issuer. 247 ;; We get the name of the issuer.
247 (narrow-to-region b e) 248 (narrow-to-region b e)
248 (setq issuer (mail-fetch-field "issuer") 249 (setq issuer (mail-fetch-field "issuer")
249 type (mail-fetch-field "issuer")) 250 type (mail-fetch-field "type"))
250 (widen) 251 (widen)
251 (if (not (gnus-nocem-message-wanted-p issuer type)) 252 (if (not (gnus-nocem-message-wanted-p issuer type))
252 (message "invalid NoCeM issuer: %s" issuer) 253 (message "invalid NoCeM issuer: %s" issuer)
@@ -267,18 +268,20 @@ valid issuer, which is much faster if you are selective about the issuers."
267 (while (setq condition (pop conditions)) 268 (while (setq condition (pop conditions))
268 (cond 269 (cond
269 ((stringp condition) 270 ((stringp condition)
270 (setq wanted (string-match condition type))) 271 (when (string-match condition type)
272 (setq wanted t)))
271 ((and (consp condition) 273 ((and (consp condition)
272 (eq (car condition) 'not) 274 (eq (car condition) 'not)
273 (stringp (cadr condition))) 275 (stringp (cadr condition)))
274 (setq wanted (not (string-match (cadr condition) type)))) 276 (when (string-match (cadr condition) type)
277 (setq wanted nil)))
275 (t 278 (t
276 (error "Invalid NoCeM condition: %S" condition)))) 279 (error "Invalid NoCeM condition: %S" condition))))
277 wanted)))) 280 wanted))))
278 281
279(defun gnus-nocem-verify-issuer (person) 282(defun gnus-nocem-verify-issuer (person)
280 "Verify using PGP that the canceler is who she says she is." 283 "Verify using PGP that the canceler is who she says she is."
281 (if (fboundp gnus-nocem-verifyer) 284 (if (functionp gnus-nocem-verifyer)
282 (ignore-errors 285 (ignore-errors
283 (funcall gnus-nocem-verifyer)) 286 (funcall gnus-nocem-verifyer))
284 ;; If we don't have Mailcrypt, then we use the message anyway. 287 ;; 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."
315 (while (eq (char-after) ?\t) 318 (while (eq (char-after) ?\t)
316 (forward-line -1)) 319 (forward-line -1))
317 (setq id (buffer-substring (point) (1- (search-forward "\t")))) 320 (setq id (buffer-substring (point) (1- (search-forward "\t"))))
318 (unless (gnus-gethash id gnus-nocem-hashtb) 321 (unless (if gnus-nocem-hashtb
322 (gnus-gethash id gnus-nocem-hashtb)
323 (setq gnus-nocem-hashtb (gnus-make-hashtable))
324 nil)
319 ;; only store if not already present 325 ;; only store if not already present
320 (gnus-sethash id t gnus-nocem-hashtb) 326 (gnus-sethash id t gnus-nocem-hashtb)
321 (push id ncm)) 327 (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."
380 (with-output-to-temp-buffer pgg-echo-buffer 380 (with-output-to-temp-buffer pgg-echo-buffer
381 (set-buffer standard-output) 381 (set-buffer standard-output)
382 (insert-buffer-substring (if status pgg-output-buffer 382 (insert-buffer-substring (if status pgg-output-buffer
383 pgg-errors-buffer))))))) 383 pgg-errors-buffer)))))
384 status))
384 385
385;;;###autoload 386;;;###autoload
386(defun pgg-insert-key () 387(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."
877 (if (not imenu-space-replacement) index-alist 877 (if (not imenu-space-replacement) index-alist
878 (mapcar 878 (mapcar
879 (lambda (item) 879 (lambda (item)
880 (cons (subst-char-in-string ?\ (aref imenu-space-replacement 0) 880 (cons (subst-char-in-string ?\s (aref imenu-space-replacement 0)
881 (car item)) 881 (car item))
882 (cdr item))) 882 (cdr item)))
883 index-alist)))) 883 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 `/'."
474 (delete-region (point) (point-max))) 474 (delete-region (point) (point-max)))
475 (goto-char start)) 475 (goto-char start))
476 (error 476 (error
477 ;; If the file we wanted to uncompress does not exist,
478 ;; handle that according to VISIT as `insert-file-contents'
479 ;; would, maybe signaling the same error it normally would.
477 (if (and (eq (car error-code) 'file-error) 480 (if (and (eq (car error-code) 'file-error)
478 (eq (nth 3 error-code) local-file)) 481 (eq (nth 3 error-code) local-file))
479 (if visit 482 (if visit
@@ -481,6 +484,13 @@ There should be no more than seven characters after the final `/'."
481 (signal 'file-error 484 (signal 'file-error
482 (cons "Opening input file" 485 (cons "Opening input file"
483 (nthcdr 2 error-code)))) 486 (nthcdr 2 error-code))))
487 ;; If the uncompression program can't be found,
488 ;; signal that as a non-file error
489 ;; so that find-file-noselect-1 won't handle it.
490 (if (and (eq (car error-code) 'file-error)
491 (equal (cadr error-code) "Searching for program"))
492 (error "Uncompression program `%s' not found"
493 (nth 3 error-code)))
484 (signal (car error-code) (cdr error-code)))))) 494 (signal (car error-code) (cdr error-code))))))
485 495
486 (and 496 (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."
1857 (string< (buffer-name elt1) (buffer-name elt2)))))) 1857 (string< (buffer-name elt1) (buffer-name elt2))))))
1858 (setq tail buffers) 1858 (setq tail buffers)
1859 (while tail 1859 (while tail
1860 (or (eq ?\ (aref (buffer-name (car tail)) 0)) 1860 (or (eq ?\s (aref (buffer-name (car tail)) 0))
1861 (setq maxlen 1861 (setq maxlen
1862 (max maxlen 1862 (max maxlen
1863 (length (buffer-name (car tail)))))) 1863 (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
489 "Return t if optional BUFFER is an \"invisible\" buffer. 489 "Return t if optional BUFFER is an \"invisible\" buffer.
490If the argument is left out or nil, then the current buffer is considered." 490If the argument is left out or nil, then the current buffer is considered."
491 (and (> (length (buffer-name buffer)) 0) 491 (and (> (length (buffer-name buffer)) 0)
492 (eq ?\ (aref (buffer-name buffer) 0)))) 492 (eq ?\s (aref (buffer-name buffer) 0))))
493 493
494(defun msb--strip-dir (dir) 494(defun msb--strip-dir (dir)
495 "Strip one hierarchy level from the end of DIR." 495 "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."
502 (or (match-end 1) (/= (current-column) (current-indentation)))) 502 (or (match-end 1) (/= (current-column) (current-indentation))))
503 0 503 0
504 (when (or (/= (current-column) (current-indentation)) 504 (when (or (/= (current-column) (current-indentation))
505 (and (> comment-add 0) (looking-at "\\s<\\S<"))) 505 (and (> comment-add 0) (looking-at "\\s<\\(\\S<\\|\\'\\)")))
506 comment-column))) 506 comment-column)))
507 507
508;;;###autoload 508;;;###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."
772 (forward-char)) 772 (forward-char))
773 (or (equal decipher-char ?\ ) 773 (or (equal decipher-char ?\ )
774 (progn 774 (progn
775 (setq decipher-char ?\ ; 775 (setq decipher-char ?\s
776 decipher--loop-prev-char ?\ ) 776 decipher--loop-prev-char ?\ )
777 (funcall func))))))) 777 (funcall func)))))))
778 778
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.")
493;; backward-compatibility alias 493;; backward-compatibility alias
494(put 'compilation-info-face 'face-alias 'compilation-info) 494(put 'compilation-info-face 'face-alias 'compilation-info)
495 495
496(defface compilation-error-file-name
497 '((default :inherit font-lock-warning-face)
498 (((supports :underline t)) :underline t))
499 "Face for displaying file names in compilation errors."
500 :group 'font-lock-highlighting-faces
501 :version "22.1")
502
503(defface compilation-warning-file-name
504 '((default :inherit font-lock-warning-face)
505 (((supports :underline t)) :underline t))
506 "Face for displaying file names in compilation errors."
507 :group 'font-lock-highlighting-faces
508 :version "22.1")
509
510(defface compilation-info-file-name
511 '((default :inherit compilation-info)
512 (((supports :underline t)) :underline t))
513 "Face for displaying file names in compilation errors."
514 :group 'font-lock-highlighting-faces
515 :version "22.1")
516
517(defface compilation-line-number
518 '((default :inherit font-lock-variable-name-face)
519 (((supports :underline t)) :underline t))
520 "Face for displaying file names in compilation errors."
521 :group 'font-lock-highlighting-faces
522 :version "22.1")
523
524(defface compilation-column-number
525 '((default :inherit font-lock-type-face)
526 (((supports :underline t)) :underline t))
527 "Face for displaying file names in compilation errors."
528 :group 'font-lock-highlighting-faces
529 :version "22.1")
530
496(defvar compilation-message-face nil 531(defvar compilation-message-face nil
497 "Face name to use for whole messages. 532 "Face name to use for whole messages.
498Faces `compilation-error-face', `compilation-warning-face', 533Faces `compilation-error-face', `compilation-warning-face',
499`compilation-info-face', `compilation-line-face' and 534`compilation-info-face', `compilation-line-face' and
500`compilation-column-face' get prepended to this, when applicable.") 535`compilation-column-face' get prepended to this, when applicable.")
501 536
502(defvar compilation-error-face 'font-lock-warning-face 537(defvar compilation-error-face 'compilation-error-file-name
503 "Face name to use for file name in error messages.") 538 "Face name to use for file name in error messages.")
504 539
505(defvar compilation-warning-face 'compilation-warning 540(defvar compilation-warning-face 'compilation-warning-file-name
506 "Face name to use for file name in warning messages.") 541 "Face name to use for file name in warning messages.")
507 542
508(defvar compilation-info-face 'compilation-info 543(defvar compilation-info-face 'compilation-info-file-name
509 "Face name to use for file name in informational messages.") 544 "Face name to use for file name in informational messages.")
510 545
511(defvar compilation-line-face 'font-lock-variable-name-face 546(defvar compilation-line-face 'compilation-line-number
512 "Face name to use for line number in message.") 547 "Face name to use for line number in message.")
513 548
514(defvar compilation-column-face 'font-lock-type-face 549(defvar compilation-column-face 'compilation-column-number
515 "Face name to use for column number in message.") 550 "Face name to use for column number in message.")
516 551
517;; same faces as dired uses 552;; same faces as dired uses
@@ -1342,8 +1377,9 @@ Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
1342 (force-mode-line-update) 1377 (force-mode-line-update)
1343 (if (and opoint (< opoint omax)) 1378 (if (and opoint (< opoint omax))
1344 (goto-char opoint)) 1379 (goto-char opoint))
1345 (if compilation-finish-function 1380 (with-no-warnings
1346 (funcall compilation-finish-function (current-buffer) msg)) 1381 (if compilation-finish-function
1382 (funcall compilation-finish-function (current-buffer) msg)))
1347 (let ((functions compilation-finish-functions)) 1383 (let ((functions compilation-finish-functions))
1348 (while functions 1384 (while functions
1349 (funcall (car functions) (current-buffer) msg) 1385 (funcall (car functions) (current-buffer) msg)
@@ -1501,8 +1537,9 @@ Use this command in a compilation log buffer. Sets the mark at point there."
1501 1537
1502;;;###autoload 1538;;;###autoload
1503(defun compilation-next-error-function (n &optional reset) 1539(defun compilation-next-error-function (n &optional reset)
1540 "Advance to the next error message and visit the file where the error was.
1541This is the value of `next-error-function' in Compilation buffers."
1504 (interactive "p") 1542 (interactive "p")
1505 (set-buffer (compilation-find-buffer))
1506 (when reset 1543 (when reset
1507 (setq compilation-current-error nil)) 1544 (setq compilation-current-error nil))
1508 (let* ((columns compilation-error-screen-columns) ; buffer's local value 1545 (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',
1516 (t 1516 (t
1517 '((cperl-load-font-lock-keywords 1517 '((cperl-load-font-lock-keywords
1518 cperl-load-font-lock-keywords-1 1518 cperl-load-font-lock-keywords-1
1519 cperl-load-font-lock-keywords-2))))) 1519 cperl-load-font-lock-keywords-2)
1520 nil nil ((?_ . "w"))))))
1520 (make-local-variable 'cperl-syntax-state) 1521 (make-local-variable 'cperl-syntax-state)
1521 (if cperl-use-syntax-table-text-property 1522 (if cperl-use-syntax-table-text-property
1522 (progn 1523 (progn
@@ -3840,7 +3841,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
3840 (and (buffer-modified-p) 3841 (and (buffer-modified-p)
3841 (not modified) 3842 (not modified)
3842 (set-buffer-modified-p nil)) 3843 (set-buffer-modified-p nil))
3843 (set-syntax-table cperl-mode-syntax-table)) 3844 ;; I do not understand what this is doing here. It breaks font-locking
3845 ;; because it resets the syntax-table from font-lock-syntax-table to
3846 ;; cperl-mode-syntax-table.
3847 ;; (set-syntax-table cperl-mode-syntax-table)
3848 )
3844 (car err-l))) 3849 (car err-l)))
3845 3850
3846(defun cperl-backward-to-noncomment (lim) 3851(defun cperl-backward-to-noncomment (lim)
@@ -4350,7 +4355,7 @@ indentation and initial hashes. Behaves usually outside of comment."
4350 fill-column) 4355 fill-column)
4351 (let ((c (save-excursion (beginning-of-line) 4356 (let ((c (save-excursion (beginning-of-line)
4352 (cperl-to-comment-or-eol) (point))) 4357 (cperl-to-comment-or-eol) (point)))
4353 (s (memq (following-char) '(?\ ?\t))) marker) 4358 (s (memq (following-char) '(?\s ?\t))) marker)
4354 (if (>= c (point)) 4359 (if (>= c (point))
4355 ;; Don't break line inside code: only inside comment. 4360 ;; Don't break line inside code: only inside comment.
4356 nil 4361 nil
@@ -4361,11 +4366,11 @@ indentation and initial hashes. Behaves usually outside of comment."
4361 (if (bolp) (progn (re-search-forward "#+[ \t]*") 4366 (if (bolp) (progn (re-search-forward "#+[ \t]*")
4362 (goto-char (match-end 0)))) 4367 (goto-char (match-end 0))))
4363 ;; Following space could have gone: 4368 ;; Following space could have gone:
4364 (if (or (not s) (memq (following-char) '(?\ ?\t))) nil 4369 (if (or (not s) (memq (following-char) '(?\s ?\t))) nil
4365 (insert " ") 4370 (insert " ")
4366 (backward-char 1)) 4371 (backward-char 1))
4367 ;; Previous space could have gone: 4372 ;; Previous space could have gone:
4368 (or (memq (preceding-char) '(?\ ?\t)) (insert " ")))))) 4373 (or (memq (preceding-char) '(?\s ?\t)) (insert " "))))))
4369 4374
4370(defun cperl-imenu-addback (lst &optional isback name) 4375(defun cperl-imenu-addback (lst &optional isback name)
4371 ;; We suppose that the lst is a DAG, unless the first element only 4376 ;; 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.")
2534 ;; This must be outside of the save-excursion 2534 ;; This must be outside of the save-excursion
2535 ;; in case the source file is our current buffer. 2535 ;; in case the source file is our current buffer.
2536 (if process-window 2536 (if process-window
2537 (save-selected-window 2537 (progn
2538 (select-window process-window) 2538 (with-selected-window process-window
2539 (gud-display-frame)) 2539 (gud-display-frame)))
2540 ;; We have to be in the proper buffer, (process-buffer proc), 2540 ;; We have to be in the proper buffer, (process-buffer proc),
2541 ;; but not in a save-excursion, because that would restore point. 2541 ;; but not in a save-excursion, because that would restore point.
2542 (let ((old-buf (current-buffer))) 2542 (with-current-buffer (process-buffer proc)
2543 (set-buffer (process-buffer proc)) 2543 (gud-display-frame))))
2544 (unwind-protect
2545 (gud-display-frame)
2546 (set-buffer old-buf)))))
2547 2544
2548 ;; If we deferred text that arrived during this processing, 2545 ;; If we deferred text that arrived during this processing,
2549 ;; handle it now. 2546 ;; 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."
949 (if name 949 (if name
950 (file-name-nondirectory name)))))))) 950 (file-name-nondirectory name))))))))
951 (setq python-saved-check-command command) 951 (setq python-saved-check-command command)
952 (require 'compile) ;To define compilation-* variables.
952 (save-some-buffers (not compilation-ask-about-save) nil) 953 (save-some-buffers (not compilation-ask-about-save) nil)
953 (let ((compilation-error-regexp-alist 954 (let ((compilation-error-regexp-alist
954 (cons '("(\\([^,]+\\), line \\([0-9]+\\))" 1 2) 955 (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 @@
10;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) 10;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
11;; Vinicius Jose Latorre <viniciusjl@ig.com.br> 11;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
12;; Keywords: wp, print, PostScript 12;; Keywords: wp, print, PostScript
13;; Time-stamp: <2005/03/19 00:40:12 vinicius> 13;; Time-stamp: <2005/06/27 00:57:22 vinicius>
14;; Version: 6.6.6 14;; Version: 6.6.7
15;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ 15;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
16 16
17(defconst ps-print-version "6.6.6" 17(defconst ps-print-version "6.6.7"
18 "ps-print.el, v 6.6.6 <2005/03/19 vinicius> 18 "ps-print.el, v 6.6.7 <2005/06/27 vinicius>
19 19
20Vinicius's last change version -- this file may have been edited as part of 20Vinicius's last change version -- this file may have been edited as part of
21Emacs without changes to the version number. When reporting bugs, please also 21Emacs 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.")
5936 (ps-begin-page)) 5936 (ps-begin-page))
5937 5937
5938 5938
5939(defun ps-end-sheet ()
5940 (and ps-print-page-p (> ps-page-sheet 0)
5941 (ps-output "EndSheet\n")))
5942
5943
5939(defun ps-header-sheet () 5944(defun ps-header-sheet ()
5940 ;; Print only when a new sheet begins. 5945 ;; Print only when a new sheet begins.
5941 (and ps-print-page-p (> ps-page-sheet 0) 5946 (ps-end-sheet)
5942 (ps-output "EndSheet\n"))
5943 (setq ps-page-sheet (1+ ps-page-sheet)) 5947 (setq ps-page-sheet (1+ ps-page-sheet))
5944 (when (ps-print-sheet-p) 5948 (when (ps-print-sheet-p)
5945 (setq ps-page-order (1+ ps-page-order)) 5949 (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."
6624 6628
6625 6629
6626(defun ps-end-job (needs-begin-file) 6630(defun ps-end-job (needs-begin-file)
6627 (let ((previous-print ps-print-page-p) 6631 (let ((ps-print-page-p t))
6628 (ps-print-page-p t))
6629 (ps-flush-output) 6632 (ps-flush-output)
6630 (save-excursion 6633 (save-excursion
6631 (let ((pages-per-sheet (mod ps-page-printed ps-n-up-printing)) 6634 (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."
6652 (number-to-string ps-lines-printed) " BeginPage\n") 6655 (number-to-string ps-lines-printed) " BeginPage\n")
6653 (ps-end-page))) 6656 (ps-end-page)))
6654 ;; Set end of PostScript file 6657 ;; Set end of PostScript file
6655 (and previous-print 6658 (ps-end-sheet)
6656 (ps-output "EndSheet\n"))
6657 (ps-output "\n%%Trailer\n%%Pages: " 6659 (ps-output "\n%%Trailer\n%%Pages: "
6658 (number-to-string 6660 (number-to-string
6659 (if (and needs-begin-file 6661 (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 @@
28;;; Commentary: 28;;; Commentary:
29 29
30;; This package maintains a menu for visiting files that were operated 30;; This package maintains a menu for visiting files that were operated
31;; on recently. When enabled a new "Open Recent" submenu is displayed 31;; on recently. When enabled a new "Open Recent" sub menu is
32;; in the "Files" menu. The recent files list is automatically saved 32;; displayed in the "Files" menu. The recent files list is
33;; across Emacs sessions. You can customize the number of recent 33;; automatically saved across Emacs sessions. You can customize the
34;; files displayed, the location of the menu and others options (see 34;; number of recent files displayed, the location of the menu and
35;; the source code for details). 35;; others options (see the source code for details).
36 36
37;;; History: 37;;; History:
38;; 38;;
39 39
40;;; Code: 40;;; Code:
41(require 'easymenu) 41(require 'easymenu)
42(require 'wid-edit) 42(require 'tree-widget)
43(require 'timer) 43(require 'timer)
44 44
45;;; Internal data 45;;; Internal data
@@ -259,7 +259,8 @@ If `file-name-history' is not empty, do nothing."
259It is passed a filename to give a chance to transform it. 259It is passed a filename to give a chance to transform it.
260If it returns nil, the filename is left unchanged." 260If it returns nil, the filename is left unchanged."
261 :group 'recentf 261 :group 'recentf
262 :type 'function) 262 :type '(choice (const :tag "None" nil)
263 function))
263 264
264;;; Utilities 265;;; Utilities
265;; 266;;
@@ -904,30 +905,54 @@ unchanged."
904;; 905;;
905(defun recentf-cancel-dialog (&rest ignore) 906(defun recentf-cancel-dialog (&rest ignore)
906 "Cancel the current dialog. 907 "Cancel the current dialog.
907Used internally by recentf dialogs.
908IGNORE arguments." 908IGNORE arguments."
909 (interactive) 909 (interactive)
910 (kill-buffer (current-buffer)) 910 (kill-buffer (current-buffer))
911 (message "Dialog canceled")) 911 (message "Dialog canceled"))
912 912
913(defun recentf-dialog-goto-first (widget-type)
914 "Move the cursor to the first WIDGET-TYPE in current dialog.
915Go to the beginning of buffer if not found."
916 (goto-char (point-min))
917 (condition-case nil
918 (let (done)
919 (widget-move 1)
920 (while (not done)
921 (if (eq widget-type (widget-type (widget-at (point))))
922 (setq done t)
923 (widget-move 1))))
924 (goto-char (point-min))))
925
913(defvar recentf-dialog-mode-map 926(defvar recentf-dialog-mode-map
914 (let ((km (make-sparse-keymap))) 927 (let ((km (make-sparse-keymap)))
928 (set-keymap-parent km widget-keymap)
915 (define-key km "q" 'recentf-cancel-dialog) 929 (define-key km "q" 'recentf-cancel-dialog)
916 (define-key km [down-mouse-1] 'widget-button-click) 930 (define-key km [down-mouse-1] 'widget-button-click)
917 (set-keymap-parent km widget-keymap)
918 km) 931 km)
919 "Keymap used in recentf dialogs.") 932 "Keymap used in recentf dialogs.")
920 933
921(defun recentf-dialog-mode () 934(define-derived-mode recentf-dialog-mode nil "recentf-dialog"
922 "Major mode of recentf dialogs. 935 "Major mode of recentf dialogs.
923 936
924\\{recentf-dialog-mode-map}" 937\\{recentf-dialog-mode-map}"
925 (interactive) 938 :syntax-table nil
926 (kill-all-local-variables) 939 :abbrev-table nil
927 (setq major-mode 'recentf-dialog-mode) 940 (setq truncate-lines t))
928 (setq mode-name "recentf-dialog") 941
929 (use-local-map recentf-dialog-mode-map) 942(defmacro recentf-dialog (name &rest forms)
930 (run-mode-hooks 'recentf-dialog-mode-hook)) 943 "Show a dialog buffer with NAME, setup with FORMS."
944 (declare (indent 1) (debug t))
945 `(with-current-buffer (get-buffer-create ,name)
946 ;; Cleanup buffer
947 (let ((inhibit-read-only t)
948 (ol (overlay-lists)))
949 (mapc 'delete-overlay (car ol))
950 (mapc 'delete-overlay (cdr ol))
951 (erase-buffer))
952 (recentf-dialog-mode)
953 ,@forms
954 (widget-setup)
955 (switch-to-buffer (current-buffer))))
931 956
932;;; Hooks 957;;; Hooks
933;; 958;;
@@ -976,163 +1001,127 @@ That is, remove a non kept file from the recent list."
976 1001
977;;; Commands 1002;;; Commands
978;; 1003;;
979(defvar recentf-edit-selected-items nil
980 "List of files to be deleted from the recent list.
981Used internally by `recentf-edit-list'.")
982 1004
983(defun recentf-edit-list-action (widget &rest ignore) 1005;;; Edit list dialog
984 "Checkbox WIDGET action that toogles a file selection. 1006;;
985Used internally by `recentf-edit-list'. 1007(defvar recentf-edit-list nil)
1008
1009(defun recentf-edit-list-select (widget &rest ignore)
1010 "Toggle a file selection based on the checkbox WIDGET state.
986IGNORE other arguments." 1011IGNORE other arguments."
987 (let ((value (widget-get widget ':tag))) 1012 (let ((value (widget-get widget :tag))
988 ;; if value is already in the selected items 1013 (check (widget-value widget)))
989 (if (memq value recentf-edit-selected-items) 1014 (if check
990 ;; then remove it 1015 (add-to-list 'recentf-edit-list value)
991 (progn 1016 (setq recentf-edit-list (delq value recentf-edit-list)))
992 (setq recentf-edit-selected-items 1017 (message "%s %sselected" value (if check "" "un"))))
993 (delq value recentf-edit-selected-items)) 1018
994 (message "%s removed from selection" value)) 1019(defun recentf-edit-list-validate (&rest ignore)
995 ;; else add it 1020 "Process the recent list when the edit list dialog is committed.
996 (push value recentf-edit-selected-items) 1021IGNORE arguments."
997 (message "%s added to selection" value)))) 1022 (if recentf-edit-list
1023 (let ((i 0))
1024 (dolist (e recentf-edit-list)
1025 (setq recentf-list (delq e recentf-list)
1026 i (1+ i)))
1027 (kill-buffer (current-buffer))
1028 (message "%S file(s) removed from the list" i)
1029 (recentf-clear-data))
1030 (message "No file selected")))
998 1031
999(defun recentf-edit-list () 1032(defun recentf-edit-list ()
1000 "Show a dialog buffer to edit the recent list. 1033 "Show a dialog to delete selected files from the recent list."
1001That is to select files to be deleted from the recent list."
1002 (interactive) 1034 (interactive)
1003 (with-current-buffer 1035 (recentf-dialog (format "*%s - Edit list*" recentf-menu-title)
1004 (get-buffer-create (format "*%s - Edit list*" recentf-menu-title)) 1036 (set (make-local-variable 'recentf-edit-list) nil)
1005 (switch-to-buffer (current-buffer))
1006 ;; Cleanup buffer
1007 (let ((inhibit-read-only t)
1008 (ol (overlay-lists)))
1009 (erase-buffer)
1010 ;; Delete all the overlays.
1011 (mapc 'delete-overlay (car ol))
1012 (mapc 'delete-overlay (cdr ol)))
1013 (recentf-dialog-mode)
1014 (setq recentf-edit-selected-items nil)
1015 ;; Insert the dialog header
1016 (widget-insert 1037 (widget-insert
1017 "\ 1038 "Click on OK to delete selected files from the recent list.
1018Select the files to be deleted from the recent list.\n\n\ 1039Click on Cancel or type `q' to cancel.\n")
1019Click on Ok to update the list. \
1020Click on Cancel or type \"q\" to quit.\n")
1021 ;; Insert the list of files as checkboxes 1040 ;; Insert the list of files as checkboxes
1022 (dolist (item recentf-list) 1041 (dolist (item recentf-list)
1023 (widget-create 1042 (widget-create 'checkbox
1024 'checkbox 1043 :value nil ; unselected checkbox
1025 :value nil ; unselected checkbox 1044 :format "\n %[%v%] %t"
1026 :format "\n %[%v%] %t" 1045 :tag item
1027 :tag item 1046 :notify 'recentf-edit-list-select))
1028 :notify 'recentf-edit-list-action))
1029 (widget-insert "\n\n") 1047 (widget-insert "\n\n")
1030 ;; Insert the Ok button
1031 (widget-create 1048 (widget-create
1032 'push-button 1049 'push-button
1033 :notify (lambda (&rest ignore) 1050 :notify 'recentf-edit-list-validate
1034 (if recentf-edit-selected-items 1051 :help-echo "Delete selected files from the recent list"
1035 (let ((i 0)) 1052 "Ok")
1036 (kill-buffer (current-buffer))
1037 (dolist (e recentf-edit-selected-items)
1038 (setq recentf-list (delq e recentf-list)
1039 i (1+ i)))
1040 (message "%S file(s) removed from the list" i)
1041 (recentf-clear-data))
1042 (message "No file selected")))
1043 "Ok")
1044 (widget-insert " ") 1053 (widget-insert " ")
1045 ;; Insert the Cancel button
1046 (widget-create 1054 (widget-create
1047 'push-button 1055 'push-button
1048 :notify 'recentf-cancel-dialog 1056 :notify 'recentf-cancel-dialog
1049 "Cancel") 1057 "Cancel")
1050 (widget-setup) 1058 (recentf-dialog-goto-first 'checkbox)))
1051 (goto-char (point-min))))
1052 1059
1060;;; Open file dialog
1061;;
1053(defun recentf-open-files-action (widget &rest ignore) 1062(defun recentf-open-files-action (widget &rest ignore)
1054 "Button WIDGET action that open a file. 1063 "Open the file stored in WIDGET's value when notified.
1055Used internally by `recentf-open-files'.
1056IGNORE other arguments." 1064IGNORE other arguments."
1057 (kill-buffer (current-buffer)) 1065 (kill-buffer (current-buffer))
1058 (funcall recentf-menu-action (widget-value widget))) 1066 (funcall recentf-menu-action (widget-value widget)))
1059 1067
1060(defvar recentf-open-files-item-shift ""
1061 "Amount of space to shift right sub-menu items.
1062Used internally by `recentf-open-files'.")
1063
1064(defun recentf-open-files-item (menu-element) 1068(defun recentf-open-files-item (menu-element)
1065 "Insert an item widget for MENU-ELEMENT in the current dialog buffer. 1069 "Return a widget to display MENU-ELEMENT in a dialog buffer."
1066Used internally by `recentf-open-files'." 1070 (if (consp (cdr menu-element))
1067 (let ((item (car menu-element)) 1071 ;; Represent a sub-menu with a tree widget
1068 (file (cdr menu-element))) 1072 `(tree-widget
1069 (if (consp file) ; This is a sub-menu 1073 :open t
1070 (let* ((shift recentf-open-files-item-shift) 1074 :match ignore
1071 (recentf-open-files-item-shift (concat shift " "))) 1075 :node (item :tag ,(car menu-element)
1072 (widget-create 1076 :sample-face bold
1073 'item 1077 :format "%{%t%}:\n")
1074 :tag item 1078 ,@(mapcar 'recentf-open-files-item
1075 :sample-face 'bold 1079 (cdr menu-element)))
1076 :format (concat shift "%{%t%}:\n")) 1080 ;; Represent a single file with a link widget
1077 (mapc 'recentf-open-files-item file) 1081 `(link :tag ,(car menu-element)
1078 (widget-insert "\n")) 1082 :button-prefix ""
1079 (widget-create 1083 :button-suffix ""
1080 'push-button 1084 :button-face default
1081 :button-face 'default 1085 :format "%[%t%]\n"
1082 :tag item 1086 :help-echo ,(concat "Open " (cdr menu-element))
1083 :help-echo (concat "Open " file) 1087 :action recentf-open-files-action
1084 :format (concat recentf-open-files-item-shift "%[%t%]") 1088 ,(cdr menu-element))))
1085 :notify 'recentf-open-files-action
1086 file)
1087 (widget-insert "\n"))))
1088 1089
1089(defun recentf-open-files (&optional files buffer-name) 1090(defun recentf-open-files (&optional files buffer-name)
1090 "Show a dialog buffer to open a recent file. 1091 "Show a dialog to open a recent file.
1091If optional argument FILES is non-nil, it specifies the list of 1092If optional argument FILES is non-nil, it is a list of recently-opened
1092recently-opened files to choose from. It is the whole recent list 1093files to choose from. It defaults to the whole recent list.
1093otherwise. 1094If optional argument BUFFER-NAME is non-nil, it is a buffer name to
1094If optional argument BUFFER-NAME is non-nil, it specifies which buffer 1095use for the dialog. It defaults to \"*`recentf-menu-title'*\"."
1095name to use for the interaction. It is \"*`recentf-menu-title'*\" by
1096default."
1097 (interactive) 1096 (interactive)
1098 (unless files 1097 (recentf-dialog (or buffer-name (format "*%s*" recentf-menu-title))
1099 (setq files recentf-list)) 1098 (widget-insert "Click on a file to open it.
1100 (unless buffer-name 1099Click on Cancel or type `q' to cancel.\n" )
1101 (setq buffer-name (format "*%s*" recentf-menu-title))) 1100 ;; Use a L&F that looks like the recentf menu.
1102 (with-current-buffer (get-buffer-create buffer-name) 1101 (tree-widget-set-theme "folder")
1103 (switch-to-buffer (current-buffer)) 1102 (apply 'widget-create
1104 ;; Cleanup buffer 1103 `(group
1105 (let ((inhibit-read-only t) 1104 :indent 2
1106 (ol (overlay-lists))) 1105 :format "\n%v\n"
1107 (erase-buffer) 1106 ,@(mapcar 'recentf-open-files-item
1108 ;; Delete all the overlays. 1107 (recentf-apply-menu-filter
1109 (mapc 'delete-overlay (car ol)) 1108 recentf-menu-filter
1110 (mapc 'delete-overlay (cdr ol))) 1109 (mapcar 'recentf-make-default-menu-element
1111 (recentf-dialog-mode) 1110 (or files recentf-list))))))
1112 ;; Insert the dialog header
1113 (widget-insert "Click on a file to open it. ")
1114 (widget-insert "Click on Cancel or type \"q\" to quit.\n\n" )
1115 ;; Insert the list of files as buttons
1116 (let ((recentf-open-files-item-shift ""))
1117 (mapc 'recentf-open-files-item
1118 (recentf-apply-menu-filter
1119 recentf-menu-filter
1120 (mapcar 'recentf-make-default-menu-element files))))
1121 (widget-insert "\n")
1122 ;; Insert the Cancel button
1123 (widget-create 1111 (widget-create
1124 'push-button 1112 'push-button
1125 :notify 'recentf-cancel-dialog 1113 :notify 'recentf-cancel-dialog
1126 "Cancel") 1114 "Cancel")
1127 (widget-setup) 1115 (recentf-dialog-goto-first 'link)))
1128 (goto-char (point-min))))
1129 1116
1130(defun recentf-open-more-files () 1117(defun recentf-open-more-files ()
1131 "Show a dialog buffer to open a recent file that is not in the menu." 1118 "Show a dialog to open a recent file that is not in the menu."
1132 (interactive) 1119 (interactive)
1133 (recentf-open-files (nthcdr recentf-max-menu-items recentf-list) 1120 (recentf-open-files (nthcdr recentf-max-menu-items recentf-list)
1134 (format "*%s - More*" recentf-menu-title))) 1121 (format "*%s - More*" recentf-menu-title)))
1135 1122
1123;;; Save/load/cleanup the recent list
1124;;
1136(defconst recentf-save-file-header 1125(defconst recentf-save-file-header
1137 ";;; Automatically generated by `recentf' on %s.\n" 1126 ";;; Automatically generated by `recentf' on %s.\n"
1138 "Header to be written into the `recentf-save-file'.") 1127 "Header to be written into the `recentf-save-file'.")
@@ -1149,16 +1138,16 @@ Write data into the file specified by `recentf-save-file'."
1149 (interactive) 1138 (interactive)
1150 (condition-case error 1139 (condition-case error
1151 (with-temp-buffer 1140 (with-temp-buffer
1152 (erase-buffer) 1141 (erase-buffer)
1153 (set-buffer-file-coding-system recentf-save-file-coding-system) 1142 (set-buffer-file-coding-system recentf-save-file-coding-system)
1154 (insert (format recentf-save-file-header (current-time-string))) 1143 (insert (format recentf-save-file-header (current-time-string)))
1155 (recentf-dump-variable 'recentf-list recentf-max-saved-items) 1144 (recentf-dump-variable 'recentf-list recentf-max-saved-items)
1156 (recentf-dump-variable 'recentf-filter-changer-state) 1145 (recentf-dump-variable 'recentf-filter-changer-state)
1157 (insert "\n \n;;; Local Variables:\n" 1146 (insert "\n \n;;; Local Variables:\n"
1158 (format ";;; coding: %s\n" recentf-save-file-coding-system) 1147 (format ";;; coding: %s\n" recentf-save-file-coding-system)
1159 ";;; End:\n") 1148 ";;; End:\n")
1160 (write-file (expand-file-name recentf-save-file)) 1149 (write-file (expand-file-name recentf-save-file))
1161 nil) 1150 nil)
1162 (error 1151 (error
1163 (warn "recentf mode: %s" (error-message-string error))))) 1152 (warn "recentf mode: %s" (error-message-string error)))))
1164 1153
@@ -1218,5 +1207,5 @@ that were operated on recently."
1218 1207
1219(run-hooks 'recentf-load-hook) 1208(run-hooks 'recentf-load-hook)
1220 1209
1221;;; arch-tag: 78f1eec9-0d16-4d19-a4eb-2e4529edb62a 1210;; arch-tag: 78f1eec9-0d16-4d19-a4eb-2e4529edb62a
1222;;; recentf.el ends here 1211;;; 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."
516Prompt for a regexp with PROMPT. 516Prompt for a regexp with PROMPT.
517Value is a list, (REGEXP)." 517Value is a list, (REGEXP)."
518 (list (read-from-minibuffer prompt nil nil nil 518 (list (read-from-minibuffer prompt nil nil nil
519 'regexp-history nil t))) 519 'regexp-history nil t)
520 nil nil t))
520 521
521(defun keep-lines (regexp &optional rstart rend) 522(defun keep-lines (regexp &optional rstart rend interactive)
522 "Delete all lines except those containing matches for REGEXP. 523 "Delete all lines except those containing matches for REGEXP.
523A match split across lines preserves all the lines it lies in. 524A match split across lines preserves all the lines it lies in.
524Applies to all lines after point. 525When called from Lisp (and usually interactively as well, see below)
526applies to all lines starting after point.
525 527
526If REGEXP contains upper case characters (excluding those preceded by `\\'), 528If REGEXP contains upper case characters (excluding those preceded by `\\'),
527the matching is case-sensitive. 529the matching is case-sensitive.
528 530
529Second and third arg RSTART and REND specify the region to operate on. 531Second and third arg RSTART and REND specify the region to operate on.
532This command operates on (the accessible part of) all lines whose
533accessible part is entirely contained in the region determined by RSTART
534and REND. (A newline ending a line counts as part of that line.)
530 535
531Interactively, in Transient Mark mode when the mark is active, operate 536Interactively, in Transient Mark mode when the mark is active, operate
532on the contents of the region. Otherwise, operate from point to the 537on all lines whose accessible part is entirely contained in the region.
533end of the buffer." 538Otherwise, the command applies to all lines starting after point.
539When calling this function from Lisp, you can pretend that it was
540called interactively by passing a non-nil INTERACTIVE argument.
541
542This function starts looking for the next match from the end of
543the previous match. Hence, it ignores matches that overlap
544a previously found match."
534 545
535 (interactive 546 (interactive
536 (progn 547 (progn
@@ -539,10 +550,20 @@ end of the buffer."
539 (if rstart 550 (if rstart
540 (progn 551 (progn
541 (goto-char (min rstart rend)) 552 (goto-char (min rstart rend))
542 (setq rend (copy-marker (max rstart rend)))) 553 (setq rend
543 (if (and transient-mark-mode mark-active) 554 (progn
555 (save-excursion
556 (goto-char (max rstart rend))
557 (unless (or (bolp) (eobp))
558 (forward-line 0))
559 (point-marker)))))
560 (if (and interactive transient-mark-mode mark-active)
544 (setq rstart (region-beginning) 561 (setq rstart (region-beginning)
545 rend (copy-marker (region-end))) 562 rend (progn
563 (goto-char (region-end))
564 (unless (or (bolp) (eobp))
565 (forward-line 0))
566 (point-marker)))
546 (setq rstart (point) 567 (setq rstart (point)
547 rend (point-max-marker))) 568 rend (point-max-marker)))
548 (goto-char rstart)) 569 (goto-char rstart))
@@ -556,7 +577,7 @@ end of the buffer."
556 (if (not (re-search-forward regexp rend 'move)) 577 (if (not (re-search-forward regexp rend 'move))
557 (delete-region start rend) 578 (delete-region start rend)
558 (let ((end (save-excursion (goto-char (match-beginning 0)) 579 (let ((end (save-excursion (goto-char (match-beginning 0))
559 (beginning-of-line) 580 (forward-line 0)
560 (point)))) 581 (point))))
561 ;; Now end is first char preserved by the new match. 582 ;; Now end is first char preserved by the new match.
562 (if (< start end) 583 (if (< start end)
@@ -566,22 +587,34 @@ end of the buffer."
566 ;; If the match was empty, avoid matching again at same place. 587 ;; If the match was empty, avoid matching again at same place.
567 (and (< (point) rend) 588 (and (< (point) rend)
568 (= (match-beginning 0) (match-end 0)) 589 (= (match-beginning 0) (match-end 0))
569 (forward-char 1)))))) 590 (forward-char 1)))))
591 (set-marker rend nil)
592 nil)
570 593
571 594
572(defun flush-lines (regexp &optional rstart rend) 595(defun flush-lines (regexp &optional rstart rend interactive)
573 "Delete lines containing matches for REGEXP. 596 "Delete lines containing matches for REGEXP.
574If a match is split across lines, all the lines it lies in are deleted. 597When called from Lisp (and usually when called interactively as
575Applies to lines after point. 598well, see below), applies to the part of the buffer after point.
599The line point is in is deleted if and only if it contains a
600match for regexp starting after point.
576 601
577If REGEXP contains upper case characters (excluding those preceded by `\\'), 602If REGEXP contains upper case characters (excluding those preceded by `\\'),
578the matching is case-sensitive. 603the matching is case-sensitive.
579 604
580Second and third arg RSTART and REND specify the region to operate on. 605Second and third arg RSTART and REND specify the region to operate on.
606Lines partially contained in this region are deleted if and only if
607they contain a match entirely contained in it.
581 608
582Interactively, in Transient Mark mode when the mark is active, operate 609Interactively, in Transient Mark mode when the mark is active, operate
583on the contents of the region. Otherwise, operate from point to the 610on the contents of the region. Otherwise, operate from point to the
584end of the buffer." 611end of (the accessible portion of) the buffer. When calling this function
612from Lisp, you can pretend that it was called interactively by passing
613a non-nil INTERACTIVE argument.
614
615If a match is split across lines, all the lines it lies in are deleted.
616They are deleted _before_ looking for the next match. Hence, a match
617starting on the same line at which another match ended is ignored."
585 618
586 (interactive 619 (interactive
587 (progn 620 (progn
@@ -591,7 +624,7 @@ end of the buffer."
591 (progn 624 (progn
592 (goto-char (min rstart rend)) 625 (goto-char (min rstart rend))
593 (setq rend (copy-marker (max rstart rend)))) 626 (setq rend (copy-marker (max rstart rend))))
594 (if (and transient-mark-mode mark-active) 627 (if (and interactive transient-mark-mode mark-active)
595 (setq rstart (region-beginning) 628 (setq rstart (region-beginning)
596 rend (copy-marker (region-end))) 629 rend (copy-marker (region-end)))
597 (setq rstart (point) 630 (setq rstart (point)
@@ -603,13 +636,18 @@ end of the buffer."
603 (while (and (< (point) rend) 636 (while (and (< (point) rend)
604 (re-search-forward regexp rend t)) 637 (re-search-forward regexp rend t))
605 (delete-region (save-excursion (goto-char (match-beginning 0)) 638 (delete-region (save-excursion (goto-char (match-beginning 0))
606 (beginning-of-line) 639 (forward-line 0)
607 (point)) 640 (point))
608 (progn (forward-line 1) (point))))))) 641 (progn (forward-line 1) (point))))))
642 (set-marker rend nil)
643 nil)
609 644
610 645
611(defun how-many (regexp &optional rstart rend) 646(defun how-many (regexp &optional rstart rend interactive)
612 "Print number of matches for REGEXP following point. 647 "Print and return number of matches for REGEXP following point.
648When called from Lisp and INTERACTIVE is omitted or nil, just return
649the number, do not print it; if INTERACTIVE is t, the function behaves
650in all respects has if it had been called interactively.
613 651
614If REGEXP contains upper case characters (excluding those preceded by `\\'), 652If REGEXP contains upper case characters (excluding those preceded by `\\'),
615the matching is case-sensitive. 653the matching is case-sensitive.
@@ -618,18 +656,24 @@ Second and third arg RSTART and REND specify the region to operate on.
618 656
619Interactively, in Transient Mark mode when the mark is active, operate 657Interactively, in Transient Mark mode when the mark is active, operate
620on the contents of the region. Otherwise, operate from point to the 658on the contents of the region. Otherwise, operate from point to the
621end of the buffer." 659end of (the accessible portion of) the buffer.
660
661This function starts looking for the next match from the end of
662the previous match. Hence, it ignores matches that overlap
663a previously found match."
622 664
623 (interactive 665 (interactive
624 (keep-lines-read-args "How many matches for (regexp): ")) 666 (keep-lines-read-args "How many matches for (regexp): "))
625 (save-excursion 667 (save-excursion
626 (if rstart 668 (if rstart
627 (goto-char (min rstart rend)) 669 (progn
628 (if (and transient-mark-mode mark-active) 670 (goto-char (min rstart rend))
671 (setq rend (max rstart rend)))
672 (if (and interactive transient-mark-mode mark-active)
629 (setq rstart (region-beginning) 673 (setq rstart (region-beginning)
630 rend (copy-marker (region-end))) 674 rend (region-end))
631 (setq rstart (point) 675 (setq rstart (point)
632 rend (point-max-marker))) 676 rend (point-max)))
633 (goto-char rstart)) 677 (goto-char rstart))
634 (let ((count 0) 678 (let ((count 0)
635 opoint 679 opoint
@@ -641,7 +685,10 @@ end of the buffer."
641 (if (= opoint (point)) 685 (if (= opoint (point))
642 (forward-char 1) 686 (forward-char 1)
643 (setq count (1+ count)))) 687 (setq count (1+ count))))
644 (message "%d occurrences" count)))) 688 (when interactive (message "%d occurrence%s"
689 count
690 (if (= count 1) "" "s")))
691 count)))
645 692
646 693
647(defvar occur-mode-map 694(defvar occur-mode-map
@@ -892,8 +939,7 @@ buffer for each buffer where you invoke `occur'."
892 939
893(defun occur (regexp &optional nlines) 940(defun occur (regexp &optional nlines)
894 "Show all lines in the current buffer containing a match for REGEXP. 941 "Show all lines in the current buffer containing a match for REGEXP.
895 942This function can not handle matches that span more than one line.
896If a match spreads across multiple lines, all those lines are shown.
897 943
898Each line is displayed with NLINES lines before and after, or -NLINES 944Each line is displayed with NLINES lines before and after, or -NLINES
899before if NLINES is negative. 945before if NLINES is negative.
@@ -1001,9 +1047,9 @@ See also `multi-occur'."
1001 (display-buffer occur-buf) 1047 (display-buffer occur-buf)
1002 (setq next-error-last-buffer occur-buf)) 1048 (setq next-error-last-buffer occur-buf))
1003 (kill-buffer occur-buf))) 1049 (kill-buffer occur-buf)))
1004 (run-hooks 'occur-hook)) 1050 (setq buffer-read-only t)
1005 (setq buffer-read-only t) 1051 (set-buffer-modified-p nil)
1006 (set-buffer-modified-p nil)))) 1052 (run-hooks 'occur-hook)))))
1007 1053
1008(defun occur-engine-add-prefix (lines) 1054(defun occur-engine-add-prefix (lines)
1009 (mapcar 1055 (mapcar
@@ -1603,15 +1649,15 @@ make, or the user didn't cancel the call."
1603 ;; Change markers to numbers in the match data 1649 ;; Change markers to numbers in the match data
1604 ;; since lots of markers slow down editing. 1650 ;; since lots of markers slow down editing.
1605 (push (list (point) replaced 1651 (push (list (point) replaced
1606;;; If the replacement has already happened, all we need is the 1652;;; If the replacement has already happened, all we need is the
1607;;; current match start and end. We could get this with a trivial 1653;;; current match start and end. We could get this with a trivial
1608;;; match like 1654;;; match like
1609;;; (save-excursion (goto-char (match-beginning 0)) 1655;;; (save-excursion (goto-char (match-beginning 0))
1610;;; (search-forward (match-string 0)) 1656;;; (search-forward (match-string 0))
1611;;; (match-data t)) 1657;;; (match-data t))
1612;;; if we really wanted to avoid manually constructing match data. 1658;;; if we really wanted to avoid manually constructing match data.
1613;;; Adding current-buffer is necessary so that match-data calls can 1659;;; Adding current-buffer is necessary so that match-data calls can
1614;;; return markers which are appropriate for editing. 1660;;; return markers which are appropriate for editing.
1615 (if replaced 1661 (if replaced
1616 (list 1662 (list
1617 (match-beginning 0) 1663 (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."
3442 (when (and (not done) 3442 (when (and (not done)
3443 (not (integerp selective-display)) 3443 (not (integerp selective-display))
3444 (not (line-move-invisible-p (point)))) 3444 (not (line-move-invisible-p (point))))
3445 ;; We avoid vertical-motion when possible
3446 ;; because that has to fontify.
3447 (forward-line 1)
3448 ;; If there are overlays in and around
3449 ;; the text we moved over, we need to be
3450 ;; sophisticated.
3451 (unless (overlays-in (max (1- pos-before) (point-min)) 3445 (unless (overlays-in (max (1- pos-before) (point-min))
3452 (min (1+ (point)) (point-max))) 3446 (min (1+ (point)) (point-max)))
3447 ;; We avoid vertical-motion when possible
3448 ;; because that has to fontify.
3449 (forward-line 1)
3453 (setq line-done t))) 3450 (setq line-done t)))
3454 ;; Otherwise move a more sophisticated way.
3455 ;; (What's the logic behind this code?)
3456 (and (not done) (not line-done) 3451 (and (not done) (not line-done)
3452 ;; Otherwise move a more sophisticated way.
3457 (zerop (vertical-motion 1)) 3453 (zerop (vertical-motion 1))
3458 (if (not noerror) 3454 (if (not noerror)
3459 (signal 'end-of-buffer nil) 3455 (signal 'end-of-buffer nil)
@@ -3473,9 +3469,9 @@ Outline mode sets this."
3473 (when (and (not done) 3469 (when (and (not done)
3474 (not (integerp selective-display)) 3470 (not (integerp selective-display))
3475 (not (line-move-invisible-p (1- (point))))) 3471 (not (line-move-invisible-p (1- (point)))))
3476 (forward-line -1)
3477 (unless (overlays-in (max (1- (point)) (point-min)) 3472 (unless (overlays-in (max (1- (point)) (point-min))
3478 (min (1+ pos-before) (point-max))) 3473 (min (1+ pos-before) (point-max)))
3474 (forward-line -1)
3479 (setq line-done t))) 3475 (setq line-done t)))
3480 (and (not done) (not line-done) 3476 (and (not done) (not line-done)
3481 (zerop (vertical-motion -1)) 3477 (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'."
444 ;; frame-notice-user-settings didn't (such as on a tty). 444 ;; frame-notice-user-settings didn't (such as on a tty).
445 ;; frame-set-background-mode is idempotent, so it won't 445 ;; frame-set-background-mode is idempotent, so it won't
446 ;; cause any harm if it's already been done. 446 ;; cause any harm if it's already been done.
447 (let ((frame-background-mode frame-background-mode) 447 (let ((frame (selected-frame))
448 (frame (selected-frame))
449 term) 448 term)
450 (when (and (null window-system) 449 (when (and (null window-system)
451 ;; Don't override a possibly customized value. 450 ;; Don't override default set by files in lisp/term.
452 (null frame-background-mode) 451 (null default-frame-background-mode)
453 ;; Don't override user specifications.
454 (null (frame-parameter frame 'reverse))
455 (let ((bg (frame-parameter frame 'background-color))) 452 (let ((bg (frame-parameter frame 'background-color)))
456 (or (null bg) 453 (or (null bg)
457 (member bg '(unspecified "unspecified-bg"))))) 454 (member bg '(unspecified "unspecified-bg"
455 "unspecified-fg")))))
456
458 (setq term (getenv "TERM")) 457 (setq term (getenv "TERM"))
459 ;; Some files in lisp/term do a better job with the 458 ;; Some files in lisp/term do a better job with the
460 ;; background mode, but we leave this here anyway, in 459 ;; background mode, but we leave this here anyway, in
461 ;; case they remove those files. 460 ;; case they remove those files.
462 (if (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)" 461 (if (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
463 term) 462 term)
464 (setq frame-background-mode 'light))) 463 (setq default-frame-background-mode 'light)))
465 (frame-set-background-mode (selected-frame))))) 464 (frame-set-background-mode (selected-frame)))))
466 465
467 ;; Now we know the user's default font, so add it to the menu. 466 ;; 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."
937 (set hook hook-value)))))) 937 (set hook hook-value))))))
938 938
939(defun add-to-list (list-var element &optional append) 939(defun add-to-list (list-var element &optional append)
940 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. 940 "Add ELEMENT to the value of LIST-VAR if it isn't there yet.
941The test for presence of ELEMENT is done with `equal'. 941The test for presence of ELEMENT is done with `equal'.
942If ELEMENT is added, it is added at the beginning of the list, 942If ELEMENT is added, it is added at the beginning of the list,
943unless the optional argument APPEND is non-nil, in which case 943unless 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."
959 959
960 960
961(defun add-to-ordered-list (list-var element &optional order) 961(defun add-to-ordered-list (list-var element &optional order)
962 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. 962 "Add ELEMENT to the value of LIST-VAR if it isn't there yet.
963The test for presence of ELEMENT is done with `eq'. 963The test for presence of ELEMENT is done with `eq'.
964 964
965The resulting list is reordered so that the elements are in the 965The resulting list is reordered so that the elements are in the
966order given by each element's numeric list order. Elements 966order given by each element's numeric list order. Elements
967without a numeric list order are placed at the end of the list. 967without a numeric list order are placed at the end of the list.
968 968
969If the third optional argument ORDER is non-nil, set the 969If the third optional argument ORDER is a number (integer or
970element's list order to the given value. 970float), set the element's list order to the given value. If
971ORDER is nil or omitted, do not change the numeric order of
972ELEMENT. If ORDER has any other value, remove the numeric order
973of ELEMENT if it has one.
971 974
972The list order for each element is stored in LIST-VAR's 975The list order for each element is stored in LIST-VAR's
973`list-order' property. 976`list-order' property.
@@ -1717,8 +1720,12 @@ See also `with-temp-buffer'."
1717(defmacro with-selected-window (window &rest body) 1720(defmacro with-selected-window (window &rest body)
1718 "Execute the forms in BODY with WINDOW as the selected window. 1721 "Execute the forms in BODY with WINDOW as the selected window.
1719The value returned is the value of the last form in BODY. 1722The value returned is the value of the last form in BODY.
1720This does not alter the buffer list ordering. 1723
1721This function saves and restores the selected window, as well as 1724This macro saves and restores the current buffer, since otherwise
1725its normal operation could potentially make a different
1726buffer current. It does not alter the buffer list ordering.
1727
1728This macro saves and restores the selected window, as well as
1722the selected window in each frame. If the previously selected 1729the selected window in each frame. If the previously selected
1723window of some frame is no longer live at the end of BODY, that 1730window of some frame is no longer live at the end of BODY, that
1724frame's selected window is left alone. If the selected window is 1731frame's selected window is left alone. If the selected window is
@@ -1734,15 +1741,16 @@ See also `with-temp-buffer'."
1734 (save-selected-window-alist 1741 (save-selected-window-alist
1735 (mapcar (lambda (frame) (list frame (frame-selected-window frame))) 1742 (mapcar (lambda (frame) (list frame (frame-selected-window frame)))
1736 (frame-list)))) 1743 (frame-list))))
1737 (unwind-protect 1744 (save-current-buffer
1738 (progn (select-window ,window 'norecord) 1745 (unwind-protect
1739 ,@body) 1746 (progn (select-window ,window 'norecord)
1740 (dolist (elt save-selected-window-alist) 1747 ,@body)
1741 (and (frame-live-p (car elt)) 1748 (dolist (elt save-selected-window-alist)
1742 (window-live-p (cadr elt)) 1749 (and (frame-live-p (car elt))
1743 (set-frame-selected-window (car elt) (cadr elt)))) 1750 (window-live-p (cadr elt))
1744 (if (window-live-p save-selected-window-window) 1751 (set-frame-selected-window (car elt) (cadr elt))))
1745 (select-window save-selected-window-window 'norecord))))) 1752 (if (window-live-p save-selected-window-window)
1753 (select-window save-selected-window-window 'norecord))))))
1746 1754
1747(defmacro with-temp-file (file &rest body) 1755(defmacro with-temp-file (file &rest body)
1748 "Create a new buffer, evaluate BODY there, and write the buffer to FILE. 1756 "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."
150 "Set background mode as appropriate for the default rxvt colors." 150 "Set background mode as appropriate for the default rxvt colors."
151 (let ((fgbg (getenv "COLORFGBG")) 151 (let ((fgbg (getenv "COLORFGBG"))
152 bg rgb) 152 bg rgb)
153 (setq frame-background-mode 'light) ; default 153 (setq default-frame-background-mode 'light)
154 (when (and fgbg 154 (when (and fgbg
155 (string-match ".*;\\([0-9][0-9]?\\)\\'" fgbg)) 155 (string-match ".*;\\([0-9][0-9]?\\)\\'" fgbg))
156 (setq bg (string-to-number (substring fgbg (match-beginning 1)))) 156 (setq bg (string-to-number (substring fgbg (match-beginning 1))))
@@ -163,7 +163,7 @@ for the currently selected frame."
163 ;; The following line assumes that white is the 15th 163 ;; The following line assumes that white is the 15th
164 ;; color in rxvt-standard-colors. 164 ;; color in rxvt-standard-colors.
165 (* (apply '+ (car (cddr (nth 15 rxvt-standard-colors)))) 0.6)) 165 (* (apply '+ (car (cddr (nth 15 rxvt-standard-colors)))) 0.6))
166 (setq frame-background-mode 'dark))) 166 (setq default-frame-background-mode 'dark)))
167 (frame-set-background-mode (selected-frame)))) 167 (frame-set-background-mode (selected-frame))))
168 168
169;; Do it! 169;; 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."
366 "Set background mode as appropriate for the default rxvt colors." 366 "Set background mode as appropriate for the default rxvt colors."
367 (let ((fgbg (getenv "COLORFGBG")) 367 (let ((fgbg (getenv "COLORFGBG"))
368 bg rgb) 368 bg rgb)
369 (setq frame-background-mode 'light) ; default 369 (setq default-frame-background-mode 'light)
370 (when (and fgbg 370 (when (and fgbg
371 (string-match ".*;\\([0-9][0-9]?\\)\\'" fgbg)) 371 (string-match ".*;\\([0-9][0-9]?\\)\\'" fgbg))
372 (setq bg (string-to-number (substring fgbg (match-beginning 1)))) 372 (setq bg (string-to-number (substring fgbg (match-beginning 1))))
@@ -379,7 +379,7 @@ versions of xterm."
379 ;; The following line assumes that white is the 15th 379 ;; The following line assumes that white is the 15th
380 ;; color in xterm-standard-colors. 380 ;; color in xterm-standard-colors.
381 (* (apply '+ (car (cddr (nth 15 xterm-standard-colors)))) 0.6)) 381 (* (apply '+ (car (cddr (nth 15 xterm-standard-colors)))) 0.6))
382 (setq frame-background-mode 'dark))) 382 (setq default-frame-background-mode 'dark)))
383 (frame-set-background-mode (selected-frame)))) 383 (frame-set-background-mode (selected-frame))))
384 384
385;; Do it! 385;; 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."
2875 2875
2876(defun artist-figlet-get-extra-args () 2876(defun artist-figlet-get-extra-args ()
2877 "Read any extra arguments for figlet." 2877 "Read any extra arguments for figlet."
2878 (let ((extra-args (read-input "Extra args to figlet: "))) 2878 (let ((extra-args (read-string "Extra args to figlet: ")))
2879 (if (string= extra-args "") 2879 (if (string= extra-args "")
2880 nil 2880 nil
2881 extra-args))) 2881 extra-args)))
@@ -2916,7 +2916,7 @@ This is done by calling the function specified by `artist-text-renderer',
2916which must return a list of strings, to be inserted in the buffer. 2916which must return a list of strings, to be inserted in the buffer.
2917 2917
2918Text already in the buffer ``shines thru'' blanks in the rendered text." 2918Text already in the buffer ``shines thru'' blanks in the rendered text."
2919 (let* ((input-text (read-input "Type text to render: ")) 2919 (let* ((input-text (read-string "Type text to render: "))
2920 (rendered-text (artist-funcall artist-text-renderer input-text))) 2920 (rendered-text (artist-funcall artist-text-renderer input-text)))
2921 (artist-text-insert-see-thru x y rendered-text))) 2921 (artist-text-insert-see-thru x y rendered-text)))
2922 2922
@@ -2927,7 +2927,7 @@ This is done by calling the function specified by `artist-text-renderer',
2927which must return a list of strings, to be inserted in the buffer. 2927which must return a list of strings, to be inserted in the buffer.
2928 2928
2929Blanks in the rendered text overwrites any text in the buffer." 2929Blanks in the rendered text overwrites any text in the buffer."
2930 (let* ((input-text (read-input "Type text to render: ")) 2930 (let* ((input-text (read-string "Type text to render: "))
2931 (rendered-text (artist-funcall artist-text-renderer input-text))) 2931 (rendered-text (artist-funcall artist-text-renderer input-text)))
2932 (artist-text-insert-overwrite x y rendered-text))) 2932 (artist-text-insert-overwrite x y rendered-text)))
2933 2933
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 @@
66 'emacs)) 66 'emacs))
67 "The type of Emacs we are currently running.") 67 "The type of Emacs we are currently running.")
68 68
69(defvar flyspell-use-local-map
70 (or (eq flyspell-emacs 'xemacs)
71 (not (string< emacs-version "20"))))
72
73;*---------------------------------------------------------------------*/ 69;*---------------------------------------------------------------------*/
74;* User configuration ... */ 70;* User configuration ... */
75;*---------------------------------------------------------------------*/ 71;*---------------------------------------------------------------------*/
@@ -403,34 +399,22 @@ property of the major mode name.")
403;*---------------------------------------------------------------------*/ 399;*---------------------------------------------------------------------*/
404;* The minor mode declaration. */ 400;* The minor mode declaration. */
405;*---------------------------------------------------------------------*/ 401;*---------------------------------------------------------------------*/
406(eval-when-compile (defvar flyspell-local-mouse-map))
407
408(defvar flyspell-mouse-map 402(defvar flyspell-mouse-map
409 (let ((map (make-sparse-keymap))) 403 (let ((map (make-sparse-keymap)))
410 (if flyspell-use-meta-tab
411 (define-key map "\M-\t" #'flyspell-auto-correct-word))
412 (define-key map (if (featurep 'xemacs) [button2] [down-mouse-2]) 404 (define-key map (if (featurep 'xemacs) [button2] [down-mouse-2])
413 #'flyspell-correct-word) 405 #'flyspell-correct-word)
414 (define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word) 406 map)
415 (define-key map [(control \,)] 'flyspell-goto-next-error) 407 "Keymap for Flyspell to put on erroneous words.")
416 (define-key map [(control \.)] 'flyspell-auto-correct-word)
417 map))
418 408
419(defvar flyspell-mode-map 409(defvar flyspell-mode-map
420 (let ((map (make-sparse-keymap))) 410 (let ((map (make-sparse-keymap)))
421 ;; mouse, keyboard bindings and misc definition
422 (if flyspell-use-meta-tab 411 (if flyspell-use-meta-tab
423 (define-key map "\M-\t" 'flyspell-auto-correct-word)) 412 (define-key map "\M-\t" 'flyspell-auto-correct-word))
424 (cond 413 (define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
425 ;; I don't understand this test, so I left it as is. --Stef 414 (define-key map [(control ?\,)] 'flyspell-goto-next-error)
426 ((or (featurep 'xemacs) flyspell-use-local-map) 415 (define-key map [(control ?\.)] 'flyspell-auto-correct-word)
427 (define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word) 416 map)
428 (define-key map [(control ?\,)] 'flyspell-goto-next-error) 417 "Minor mode keymap for Flyspell mode--for the whole buffer.")
429 (define-key map [(control ?\.)] 'flyspell-auto-correct-word)))
430 map))
431
432;; the name of the overlay property that defines the keymap
433(defvar flyspell-overlay-keymap-property-name 'keymap)
434 418
435;; dash character machinery 419;; dash character machinery
436(defvar flyspell-consider-dash-as-word-delimiter-flag nil 420(defvar flyspell-consider-dash-as-word-delimiter-flag nil
@@ -569,22 +553,6 @@ in your .emacs file.
569 (let ((mode-predicate (get major-mode 'flyspell-mode-predicate))) 553 (let ((mode-predicate (get major-mode 'flyspell-mode-predicate)))
570 (if mode-predicate 554 (if mode-predicate
571 (setq flyspell-generic-check-word-p mode-predicate))) 555 (setq flyspell-generic-check-word-p mode-predicate)))
572 ;; work around the fact that the `local-map' text-property replaces the
573 ;; buffer's local map rather than shadowing it.
574 (set (make-local-variable 'flyspell-mouse-map)
575 (let ((map (copy-keymap flyspell-mouse-map)))
576 (set-keymap-parent map (current-local-map))
577 (if (and (eq flyspell-emacs 'emacs)
578 (not (string< emacs-version "20")))
579 (define-key map '[tool-bar] nil))
580 map))
581 (set (make-local-variable 'flyspell-mode-map)
582 (let ((map (copy-keymap flyspell-mode-map)))
583 (set-keymap-parent map (current-local-map))
584 (if (and (eq flyspell-emacs 'emacs)
585 (not (string< emacs-version "20")))
586 (define-key map '[tool-bar] nil))
587 map))
588 ;; the welcome message 556 ;; the welcome message
589 (if (and flyspell-issue-message-flag 557 (if (and flyspell-issue-message-flag
590 flyspell-issue-welcome-flag 558 flyspell-issue-welcome-flag
@@ -1570,10 +1538,7 @@ for the overlay."
1570 (overlay-put flyspell-overlay 'flyspell-overlay t) 1538 (overlay-put flyspell-overlay 'flyspell-overlay t)
1571 (overlay-put flyspell-overlay 'evaporate t) 1539 (overlay-put flyspell-overlay 'evaporate t)
1572 (overlay-put flyspell-overlay 'help-echo "mouse-2: correct word at point") 1540 (overlay-put flyspell-overlay 'help-echo "mouse-2: correct word at point")
1573 (if flyspell-use-local-map 1541 (overlay-put flyspell-overlay 'keymap flyspell-mouse-map)
1574 (overlay-put flyspell-overlay
1575 flyspell-overlay-keymap-property-name
1576 flyspell-mouse-map))
1577 (when (eq face 'flyspell-incorrect) 1542 (when (eq face 'flyspell-incorrect)
1578 (and (stringp flyspell-before-incorrect-word-string) 1543 (and (stringp flyspell-before-incorrect-word-string)
1579 (overlay-put flyspell-overlay 'before-string 1544 (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."
1438 end (car (cdr (cdr word))) 1438 end (car (cdr (cdr word)))
1439 word (car word)) 1439 word (car word))
1440 1440
1441 ;; now check spelling of word if it has 3 or more characters. 1441 ;; At this point it used to ignore 2-letter words.
1442 (cond 1442 ;; But that is silly; if the user asks for it, we should do it. - rms.
1443 ((> (length word) 2) 1443 (or quietly
1444 (or quietly 1444 (message "Checking spelling of %s..."
1445 (message "Checking spelling of %s..." 1445 (funcall ispell-format-word word)))
1446 (funcall ispell-format-word word))) 1446 (ispell-send-string "%\n") ; put in verbose mode
1447 (ispell-send-string "%\n") ; put in verbose mode 1447 (ispell-send-string (concat "^" word "\n"))
1448 (ispell-send-string (concat "^" word "\n")) 1448 ;; wait until ispell has processed word
1449 ;; wait until ispell has processed word 1449 (while (progn
1450 (while (progn 1450 (ispell-accept-output)
1451 (ispell-accept-output) 1451 (not (string= "" (car ispell-filter)))))
1452 (not (string= "" (car ispell-filter))))) 1452 ;;(ispell-send-string "!\n") ;back to terse mode.
1453 ;;(ispell-send-string "!\n") ;back to terse mode. 1453 (setq ispell-filter (cdr ispell-filter)) ; remove extra \n
1454 (setq ispell-filter (cdr ispell-filter)) ; remove extra \n 1454 (if (and ispell-filter (listp ispell-filter))
1455 (if (and ispell-filter (listp ispell-filter)) 1455 (if (> (length ispell-filter) 1)
1456 (if (> (length ispell-filter) 1) 1456 (error "Ispell and its process have different character maps")
1457 (error "Ispell and its process have different character maps") 1457 (setq poss (ispell-parse-output (car ispell-filter)))))
1458 (setq poss (ispell-parse-output (car ispell-filter))))) 1458 (cond ((eq poss t)
1459 (cond ((eq poss t) 1459 (or quietly
1460 (or quietly 1460 (message "%s is correct"
1461 (message "%s is correct" 1461 (funcall ispell-format-word word)))
1462 (funcall ispell-format-word word))) 1462 (and (fboundp 'extent-at)
1463 (and (fboundp 'extent-at) 1463 (extent-at start)
1464 (extent-at start) 1464 (delete-extent (extent-at start))))
1465 (delete-extent (extent-at start)))) 1465 ((stringp poss)
1466 ((stringp poss) 1466 (or quietly
1467 (or quietly 1467 (message "%s is correct because of root %s"
1468 (message "%s is correct because of root %s" 1468 (funcall ispell-format-word word)
1469 (funcall ispell-format-word word) 1469 (funcall ispell-format-word poss)))
1470 (funcall ispell-format-word poss))) 1470 (and (fboundp 'extent-at)
1471 (and (fboundp 'extent-at) 1471 (extent-at start)
1472 (extent-at start) 1472 (delete-extent (extent-at start))))
1473 (delete-extent (extent-at start)))) 1473 ((null poss) (message "Error in ispell process"))
1474 ((null poss) (message "Error in ispell process")) 1474 (ispell-check-only ; called from ispell minor mode.
1475 (ispell-check-only ; called from ispell minor mode. 1475 (if (fboundp 'make-extent)
1476 (if (fboundp 'make-extent) 1476 (let ((ext (make-extent start end)))
1477 (let ((ext (make-extent start end))) 1477 (set-extent-property ext 'face ispell-highlight-face)
1478 (set-extent-property ext 'face ispell-highlight-face) 1478 (set-extent-property ext 'priority 2000))
1479 (set-extent-property ext 'priority 2000)) 1479 (beep)
1480 (beep) 1480 (message "%s is incorrect"(funcall ispell-format-word word))))
1481 (message "%s is incorrect"(funcall ispell-format-word word)))) 1481 (t ; prompt for correct word.
1482 (t ; prompt for correct word. 1482 (save-window-excursion
1483 (save-window-excursion 1483 (setq replace (ispell-command-loop
1484 (setq replace (ispell-command-loop 1484 (car (cdr (cdr poss)))
1485 (car (cdr (cdr poss))) 1485 (car (cdr (cdr (cdr poss))))
1486 (car (cdr (cdr (cdr poss)))) 1486 (car poss) start end)))
1487 (car poss) start end))) 1487 (cond ((equal 0 replace)
1488 (cond ((equal 0 replace) 1488 (ispell-add-per-file-word-list (car poss)))
1489 (ispell-add-per-file-word-list (car poss))) 1489 (replace
1490 (replace 1490 (setq new-word (if (atom replace) replace (car replace))
1491 (setq new-word (if (atom replace) replace (car replace)) 1491 cursor-location (+ (- (length word) (- end start))
1492 cursor-location (+ (- (length word) (- end start)) 1492 cursor-location))
1493 cursor-location)) 1493 (if (not (equal new-word (car poss)))
1494 (if (not (equal new-word (car poss))) 1494 (progn
1495 (progn 1495 (delete-region start end)
1496 (delete-region start end) 1496 (setq start (point))
1497 (setq start (point)) 1497 (ispell-insert-word new-word)
1498 (ispell-insert-word new-word) 1498 (setq end (point))))
1499 (setq end (point)))) 1499 (if (not (atom replace)) ;recheck spelling of replacement
1500 (if (not (atom replace)) ;recheck spelling of replacement 1500 (progn
1501 (progn 1501 (if (car (cdr replace)) ; query replace requested
1502 (if (car (cdr replace)) ; query replace requested 1502 (save-window-excursion
1503 (save-window-excursion 1503 (query-replace word new-word t)))
1504 (query-replace word new-word t))) 1504 (goto-char start)
1505 (goto-char start) 1505 ;; single word could be split into multiple words
1506 ;; single word could be split into multiple words 1506 (setq ispell-quit (not (ispell-region start end)))
1507 (setq ispell-quit (not (ispell-region start end))) 1507 ))))
1508 )))) 1508 ;; keep if rechecking word and we keep choices win.
1509 ;; keep if rechecking word and we keep choices win. 1509 (if (get-buffer ispell-choices-buffer)
1510 (if (get-buffer ispell-choices-buffer) 1510 (kill-buffer ispell-choices-buffer))))
1511 (kill-buffer ispell-choices-buffer)))) 1511 (ispell-pdict-save ispell-silently-savep)
1512 (ispell-pdict-save ispell-silently-savep) 1512 ;; NB: Cancels ispell-quit incorrectly if called from ispell-region
1513 ;; NB: Cancels ispell-quit incorrectly if called from ispell-region 1513 (if ispell-quit (setq ispell-quit nil replace 'quit))
1514 (if ispell-quit (setq ispell-quit nil replace 'quit))))
1515 (goto-char cursor-location) ; return to original location 1514 (goto-char cursor-location) ; return to original location
1516 replace))) 1515 replace)))
1517 1516
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 @@
1;;; org.el --- Outline-based notes management and organizer 1;; org.el --- Outline-based notes management and organizer
2;; Carstens outline-mode for keeping track of everything. 2;; Carstens outline-mode for keeping track of everything.
3;; Copyright (c) 2004, 2005 Free Software Foundation 3;; Copyright (c) 2004, 2005 Free Software Foundation
4;; 4;;
5;; Author: Carsten Dominik <dominik at science dot uva dot nl> 5;; Author: Carsten Dominik <dominik at science dot uva dot nl>
6;; Keywords: outlines, hypermedia, calendar 6;; Keywords: outlines, hypermedia, calendar
7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ 7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
8;; Version: 3.11 8;; Version: 3.12
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -80,10 +80,20 @@
80;; 80;;
81;; Changes: 81;; Changes:
82;; ------- 82;; -------
83;; Version 3.12
84;; - Tables can store formulas (one per column) and compute fields.
85;; Not quite like a full spreadsheet, but very powerful.
86;; - table.el keybinding is now `C-c ~'.
87;; - Numeric argument to org-cycle does `show-subtree' above on level ARG.
88;; - Small changes to keys in agenda buffer. Affected keys:
89;; [w] weekly view; [d] daily view; [D] toggle diary inclusion.
90;; - Bug fixes.
91;;
83;; Version 3.11 92;; Version 3.11
84;; - Links inserted with C-c C-l are now by default enclosed in angle 93;; - Links inserted with C-c C-l are now by default enclosed in angle
85;; brackets. See the new variable `org-link-format'. 94;; brackets. See the new variable `org-link-format'.
86;; - ">" terminates a link, this is a way to have several links in a line. 95;; - ">" terminates a link, this is a way to have several links in a line.
96;; Both "<" and ">" are no longer allowed as characters in a link.
87;; - Archiving of finished tasks. 97;; - Archiving of finished tasks.
88;; - C-<up>/<down> bindings removed, to allow access to paragraph commands. 98;; - C-<up>/<down> bindings removed, to allow access to paragraph commands.
89;; - Compatibility with CUA-mode (see variable `org-CUA-compatible'). 99;; - Compatibility with CUA-mode (see variable `org-CUA-compatible').
@@ -168,7 +178,7 @@
168 178
169;;; Customization variables 179;;; Customization variables
170 180
171(defvar org-version "3.11" 181(defvar org-version "3.12"
172 "The version number of the file org.el.") 182 "The version number of the file org.el.")
173(defun org-version () 183(defun org-version ()
174 (interactive) 184 (interactive)
@@ -445,7 +455,7 @@ is used instead.")
445 (goto-char (point-min)) 455 (goto-char (point-min))
446 (while (re-search-forward re nil t) 456 (while (re-search-forward re nil t)
447 (setq key (match-string 1) value (match-string 2)) 457 (setq key (match-string 1) value (match-string 2))
448 (cond 458 (cond
449 ((equal key "CATEGORY") 459 ((equal key "CATEGORY")
450 (if (string-match "[ \t]+$" value) 460 (if (string-match "[ \t]+$" value)
451 (setq value (replace-match "" t t value))) 461 (setq value (replace-match "" t t value)))
@@ -485,7 +495,7 @@ is used instead.")
485 org-todo-kwd-max-priority (1- (length org-todo-keywords)) 495 org-todo-kwd-max-priority (1- (length org-todo-keywords))
486 org-ds-keyword-length (+ 2 (max (length org-deadline-string) 496 org-ds-keyword-length (+ 2 (max (length org-deadline-string)
487 (length org-scheduled-string))) 497 (length org-scheduled-string)))
488 org-done-string 498 org-done-string
489 (nth (1- (length org-todo-keywords)) org-todo-keywords) 499 (nth (1- (length org-todo-keywords)) org-todo-keywords)
490 org-todo-regexp 500 org-todo-regexp
491 (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords 501 (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords
@@ -565,7 +575,7 @@ When nil, cursor will remain in the current window."
565 575
566(defcustom org-select-agenda-window t 576(defcustom org-select-agenda-window t
567 "Non-nil means, after creating an agenda, move cursor into Agenda window. 577 "Non-nil means, after creating an agenda, move cursor into Agenda window.
568When nil, cursor will remain in the current window." 578When nil, cursor will remain in the current window."
569 :group 'org-agenda 579 :group 'org-agenda
570 :type 'boolean) 580 :type 'boolean)
571 581
@@ -601,7 +611,7 @@ When nil, always start on the current day."
601When nil, date-less entries will only be shown if `org-agenda' is called 611When nil, date-less entries will only be shown if `org-agenda' is called
602with a prefix argument. 612with a prefix argument.
603When non-nil, the TODO entries will be listed at the top of the agenda, before 613When non-nil, the TODO entries will be listed at the top of the agenda, before
604the entries for specific days." 614the entries for specific days."
605 :group 'org-agenda 615 :group 'org-agenda
606 :type 'boolean) 616 :type 'boolean)
607 617
@@ -646,7 +656,7 @@ priority.
646Leaving out `category-keep' would mean that items will be sorted across 656Leaving out `category-keep' would mean that items will be sorted across
647categories by priority." 657categories by priority."
648 :group 'org-agenda 658 :group 'org-agenda
649 :type '(repeat 659 :type '(repeat
650 (choice 660 (choice
651 (const time-up) 661 (const time-up)
652 (const time-down) 662 (const time-down)
@@ -722,7 +732,7 @@ the variable `org-agenda-time-grid'."
722 :group 'org-agenda 732 :group 'org-agenda
723 :type 'boolean) 733 :type 'boolean)
724 734
725(defcustom org-agenda-time-grid 735(defcustom org-agenda-time-grid
726 '((daily today require-timed) 736 '((daily today require-timed)
727 "----------------" 737 "----------------"
728 (800 1000 1200 1400 1600 1800 2000)) 738 (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.
741The third item is a list of integers, indicating the times that should have 751The third item is a list of integers, indicating the times that should have
742a grid line." 752a grid line."
743 :group 'org-agenda 753 :group 'org-agenda
744 :type 754 :type
745 '(list 755 '(list
746 (set :greedy t :tag "Grid Display Options" 756 (set :greedy t :tag "Grid Display Options"
747 (const :tag "Show grid in single day agenda display" daily) 757 (const :tag "Show grid in single day agenda display" daily)
@@ -835,7 +845,7 @@ unnecessary clutter."
835 845
836(defcustom org-archive-location "%s_archive::" 846(defcustom org-archive-location "%s_archive::"
837 "The location where subtrees should be archived. 847 "The location where subtrees should be archived.
838This string consists of two parts, separated by a double-colon. 848This string consists of two parts, separated by a double-colon.
839 849
840The first part is a file name - when omitted, archiving happens in the same 850The first part is a file name - when omitted, archiving happens in the same
841file. %s will be replaced by the current file name (without directory part). 851file. %s will be replaced by the current file name (without directory part).
@@ -864,7 +874,7 @@ Here are a few examples:
864 874
865You may set this option on a per-file basis by adding to the buffer a 875You may set this option on a per-file basis by adding to the buffer a
866line like 876line like
867 877
868#+ARCHIVE: basement::** Finished Tasks" 878#+ARCHIVE: basement::** Finished Tasks"
869 :group 'org-structure 879 :group 'org-structure
870 :type 'string) 880 :type 'string)
@@ -1201,9 +1211,70 @@ line will be formatted with <th> tags."
1201 :group 'org-table 1211 :group 'org-table
1202 :type 'boolean) 1212 :type 'boolean)
1203 1213
1214
1215(defgroup org-table-calculation nil
1216 "Options concerning tables in Org-mode."
1217 :tag "Org Table Calculation"
1218 :group 'org)
1219
1204(defcustom org-table-copy-increment t 1220(defcustom org-table-copy-increment t
1205 "Non-nil means, increment when copying current field with \\[org-table-copy-down]." 1221 "Non-nil means, increment when copying current field with \\[org-table-copy-down]."
1206 :group 'org-table 1222 :group 'org-table-calculation
1223 :type 'boolean)
1224
1225(defcustom org-calc-default-modes
1226 '(calc-internal-prec 12
1227 calc-float-format (float 5)
1228 calc-angle-mode deg
1229 calc-prefer-frac nil
1230 calc-symbolic-mode nil)
1231 "List with Calc mode settings for use in calc-eval for table formulas.
1232The list must contain alternating symbols (calc modes variables and values.
1233Don't remove any of the default settings, just change the values. Org-mode
1234relies on the variables to be present in the list."
1235 :group 'org-table-calculation
1236 :type 'plist)
1237
1238(defcustom org-table-formula-evaluate-inline t
1239 "Non-nil means, TAB and RET evaluate a formula in current table field.
1240If the current field starts with an equal sign, it is assumed to be a formula
1241which should be evaluated as described in the manual and in the documentation
1242string of the command `org-table-eval-formula'. This feature requires the
1243Emacs calc package.
1244When this variable is nil, formula calculation is only available through
1245the command \\[org-table-eval-formula]."
1246 :group 'org-table-calculation
1247 :type 'boolean)
1248
1249
1250(defcustom org-table-formula-use-constants t
1251 "Non-nil means, interpret constants in formulas in tables.
1252A constant looks like `$c' or `$Grav' and will be replaced before evaluation
1253by the value given in `org-table-formula-constants', or by a value obtained
1254from the `constants.el' package."
1255 :group 'org-table-calculation
1256 :type 'boolean)
1257
1258(defcustom org-table-formula-constants nil
1259 "Alist with constant names and values, for use in table formulas.
1260The car of each element is a name of a constant, without the `$' before it.
1261The cdr is the value as a string. For example, if you'd like to use the
1262speed of light in a formula, you would configure
1263
1264 (setq org-table-formula-constants '((\"c\" . \"299792458.\")))
1265
1266and then use it in an equation like `$1*$c'."
1267 :group 'org-table-calculation
1268 :type '(repeat
1269 (cons (string :tag "name")
1270 (string :tag "value"))))
1271
1272(defcustom org-table-formula-numbers-only nil
1273 "Non-nil means, calculate only with numbers in table formulas.
1274Then all input fields will be converted to a number, and the result
1275must also be a number. When nil, calc's full potential is available
1276in table calculations, including symbolics etc."
1277 :group 'org-table-calculation
1207 :type 'boolean) 1278 :type 'boolean)
1208 1279
1209(defcustom org-table-tab-recognizes-table.el t 1280(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."
1432 :group 'org-export 1503 :group 'org-export
1433 :type 'boolean) 1504 :type 'boolean)
1434 1505
1435
1436(defgroup org-faces nil 1506(defgroup org-faces nil
1437 "Faces for highlighting in Org-mode." 1507 "Faces for highlighting in Org-mode."
1438 :tag "Org Faces" 1508 :tag "Org Faces"
@@ -1556,7 +1626,16 @@ When this is non-nil, the headline after the keyword is set to the
1556 "Face for items scheduled previously, and not yet done." 1626 "Face for items scheduled previously, and not yet done."
1557 :group 'org-faces) 1627 :group 'org-faces)
1558 1628
1559(defface org-link 1629(defface org-formula
1630 '((((type tty pc) (class color) (background light)) (:foreground "red"))
1631 (((type tty pc) (class color) (background dark)) (:foreground "red1"))
1632 (((class color) (background light)) (:foreground "Firebrick"))
1633 (((class color) (background dark)) (:foreground "chocolate1"))
1634 (t (:bold t :italic t)))
1635 "Face for items scheduled previously, and not yet done."
1636 :group 'org-faces)
1637
1638(defface org-link
1560 '((((type tty) (class color)) (:foreground "cyan" :weight bold)) 1639 '((((type tty) (class color)) (:foreground "cyan" :weight bold))
1561 (((class color) (background light)) (:foreground "Purple")) 1640 (((class color) (background light)) (:foreground "Purple"))
1562 (((class color) (background dark)) (:foreground "Cyan")) 1641 (((class color) (background dark)) (:foreground "Cyan"))
@@ -1649,6 +1728,7 @@ When this is non-nil, the headline after the keyword is set to the
1649 1728
1650(defvar org-struct-menu) 1729(defvar org-struct-menu)
1651(defvar org-org-menu) 1730(defvar org-org-menu)
1731(defvar org-tbl-menu)
1652 1732
1653;; We use a before-change function to check if a table might need 1733;; We use a before-change function to check if a table might need
1654;; an update. 1734;; an update.
@@ -1656,14 +1736,13 @@ When this is non-nil, the headline after the keyword is set to the
1656 "Indicates of a table might need an update. 1736 "Indicates of a table might need an update.
1657This variable is set by `org-before-change-function'. `org-table-align' 1737This variable is set by `org-before-change-function'. `org-table-align'
1658sets it back to nil.") 1738sets it back to nil.")
1659
1660(defvar org-mode-hook nil) 1739(defvar org-mode-hook nil)
1661(defvar org-inhibit-startup nil) ; Dynamically-scoped param. 1740(defvar org-inhibit-startup nil) ; Dynamically-scoped param.
1662 1741
1663 1742
1664;;;###autoload 1743;;;###autoload
1665(define-derived-mode org-mode outline-mode "Org" 1744(define-derived-mode org-mode outline-mode "Org"
1666 "Outline-based notes management and organizer, alias 1745 "Outline-based notes management and organizer, alias
1667\"Carstens outline-mode for keeping track of everything.\" 1746\"Carstens outline-mode for keeping track of everything.\"
1668 1747
1669Org-mode develops organizational tasks around a NOTES file which 1748Org-mode develops organizational tasks around a NOTES file which
@@ -1681,6 +1760,7 @@ The following commands are available:
1681 1760
1682\\{org-mode-map}" 1761\\{org-mode-map}"
1683 (easy-menu-add org-org-menu) 1762 (easy-menu-add org-org-menu)
1763 (easy-menu-add org-tbl-menu)
1684 (org-install-agenda-files-menu) 1764 (org-install-agenda-files-menu)
1685 (setq outline-regexp "\\*+") 1765 (setq outline-regexp "\\*+")
1686 (if org-startup-truncated (setq truncate-lines t)) 1766 (if org-startup-truncated (setq truncate-lines t))
@@ -1693,11 +1773,11 @@ The following commands are available:
1693 (add-hook 'before-change-functions 'org-before-change-function nil 1773 (add-hook 'before-change-functions 'org-before-change-function nil
1694 'local) 1774 'local)
1695 ;; Paragraph regular expressions 1775 ;; Paragraph regular expressions
1696 (set (make-local-variable 'paragraph-separate) "\f\\|[ ]*$") 1776 (set (make-local-variable 'paragraph-separate) "\f\\|[ ]*$\\|\\([*\f]+\\)")
1697 (set (make-local-variable 'paragraph-start) "\f\\|[ ]*$\\|\\([*\f]+\\)") 1777 (set (make-local-variable 'paragraph-start) "\f\\|[ ]*$\\|\\([*\f]+\\)")
1698 ;; Inhibit auto-fill for headers, tables and fixed-width lines. 1778 ;; Inhibit auto-fill for headers, tables and fixed-width lines.
1699 (set (make-local-variable 'auto-fill-inhibit-regexp) 1779 (set (make-local-variable 'auto-fill-inhibit-regexp)
1700 (concat "\\*" 1780 (concat "\\*\\|#"
1701 (if (or org-enable-table-editor org-enable-fixed-width-editor) 1781 (if (or org-enable-table-editor org-enable-fixed-width-editor)
1702 (concat 1782 (concat
1703 "\\|[ \t]*[" 1783 "\\|[ \t]*["
@@ -1709,6 +1789,20 @@ The following commands are available:
1709 (interactive-p) 1789 (interactive-p)
1710 (= (point-min) (point-max))) 1790 (= (point-min) (point-max)))
1711 (insert " -*- mode: org -*-\n\n")) 1791 (insert " -*- mode: org -*-\n\n"))
1792
1793 ;; Get rid of Outline menus, they are not needed
1794 ;; Need to do this here because define-derived-mode sets up
1795 ;; the keymap so late.
1796 (if org-xemacs-p
1797 (progn
1798 (delete-menu-item '("Headings"))
1799 (delete-menu-item '("Show"))
1800 (delete-menu-item '("Hide"))
1801 (set-menubar-dirty-flag))
1802 (define-key org-mode-map [menu-bar headings] 'undefined)
1803 (define-key org-mode-map [menu-bar hide] 'undefined)
1804 (define-key org-mode-map [menu-bar show] 'undefined))
1805
1712 (unless org-inhibit-startup 1806 (unless org-inhibit-startup
1713 (if org-startup-with-deadline-check 1807 (if org-startup-with-deadline-check
1714 (call-interactively 'org-check-deadlines) 1808 (call-interactively 'org-check-deadlines)
@@ -1725,10 +1819,13 @@ The following commands are available:
1725 (beginning-of-line 1) 1819 (beginning-of-line 1)
1726 (looking-at "\\s-*\\(|\\|\\+-+\\)"))) 1820 (looking-at "\\s-*\\(|\\|\\+-+\\)")))
1727 1821
1822(defsubst org-current-line (&optional pos)
1823 (+ (if (bolp) 1 0) (count-lines (point-min) (or pos (point)))))
1824
1728;;; Font-Lock stuff 1825;;; Font-Lock stuff
1729 1826
1730(defvar org-mouse-map (make-sparse-keymap)) 1827(defvar org-mouse-map (make-sparse-keymap))
1731(define-key org-mouse-map 1828(define-key org-mouse-map
1732 (if org-xemacs-p [button2] [mouse-2]) 'org-open-at-mouse) 1829 (if org-xemacs-p [button2] [mouse-2]) 'org-open-at-mouse)
1733(define-key org-mouse-map 1830(define-key org-mouse-map
1734 (if org-xemacs-p [button3] [mouse-3]) 'org-find-file-at-mouse) 1831 (if org-xemacs-p [button3] [mouse-3]) 'org-find-file-at-mouse)
@@ -1804,11 +1901,10 @@ The following commands are available:
1804 (list (concat "\\<" org-scheduled-string) '(0 'org-warning t)) 1901 (list (concat "\\<" org-scheduled-string) '(0 'org-warning t))
1805 ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" 1902 ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)"
1806 ;; (3 'bold)) 1903 ;; (3 'bold))
1807 ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" 1904 ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)"
1808 ;; (3 'italic)) 1905 ;; (3 'italic))
1809 ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" 1906 ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)"
1810 ;; (3 'underline)) 1907 ;; (3 'underline))
1811 '("\\<FIXME\\>" (0 'org-warning t))
1812 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>") 1908 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>")
1813 '(1 'org-warning t)) 1909 '(1 'org-warning t))
1814 '("^#.*" (0 'font-lock-comment-face t)) 1910 '("^#.*" (0 'font-lock-comment-face t))
@@ -1819,13 +1915,16 @@ The following commands are available:
1819 '(1 'org-done t))) 1915 '(1 'org-done t)))
1820 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" 1916 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
1821 (1 'org-table t)) 1917 (1 'org-table t))
1822 '("^[ \t]*\\(:.*\\)" (1 'org-table t))))) 1918 '("^[ \t]*\\(:.*\\)" (1 'org-table t))
1919 '("| *\\(=[^|\n]*\\)" (1 'org-formula t))
1920 '("^[ \t]*| *\\([#!$*]\\) *|" (1 'org-formula t))
1921 )))
1823 (set (make-local-variable 'org-font-lock-keywords) 1922 (set (make-local-variable 'org-font-lock-keywords)
1824 (append 1923 (append
1825 (if org-noutline-p ; FIXME: I am not sure if eval will work 1924 (if org-noutline-p ; FIXME: I am not sure if eval will work
1826 ; on XEmacs if noutline is ever ported 1925 ; on XEmacs if noutline is ever ported
1827 '((eval . (list "^\\(\\*+\\).*" 1926 '((eval . (list "^\\(\\*+\\).*"
1828 0 '(nth 1927 0 '(nth
1829 (% (- (match-end 1) (match-beginning 1) 1) 1928 (% (- (match-end 1) (match-beginning 1) 1)
1830 org-n-levels) 1929 org-n-levels)
1831 org-level-faces) 1930 org-level-faces)
@@ -1839,7 +1938,7 @@ The following commands are available:
1839 (set (make-local-variable 'font-lock-defaults) 1938 (set (make-local-variable 'font-lock-defaults)
1840 '(org-font-lock-keywords t nil nil backward-paragraph)) 1939 '(org-font-lock-keywords t nil nil backward-paragraph))
1841 (kill-local-variable 'font-lock-keywords) nil)) 1940 (kill-local-variable 'font-lock-keywords) nil))
1842 1941
1843(defun org-unfontify-region (beg end &optional maybe_loudly) 1942(defun org-unfontify-region (beg end &optional maybe_loudly)
1844 "Remove fontification and activation overlays from links." 1943 "Remove fontification and activation overlays from links."
1845 (font-lock-default-unfontify-region beg end) 1944 (font-lock-default-unfontify-region beg end)
@@ -1870,8 +1969,9 @@ The following commands are available:
1870 zoom in further. 1969 zoom in further.
1871 3. SUBTREE: Show the entire subtree, including body text. 1970 3. SUBTREE: Show the entire subtree, including body text.
1872 1971
1873- When there is a numeric prefix, go ARG levels up and do a `show-subtree', 1972- When there is a numeric prefix, go up to a heading with level ARG, do
1874 keeping cursor position. 1973 a `show-subtree' and return to the previous cursor position. If ARG
1974 is negative, go up that many levels.
1875 1975
1876- When point is not at the beginning of a headline, execute 1976- When point is not at the beginning of a headline, execute
1877 `indent-relative', like TAB normally does. See the option 1977 `indent-relative', like TAB normally does. See the option
@@ -1937,7 +2037,8 @@ The following commands are available:
1937 ;; Show-subtree, ARG levels up from here. 2037 ;; Show-subtree, ARG levels up from here.
1938 (save-excursion 2038 (save-excursion
1939 (org-back-to-heading) 2039 (org-back-to-heading)
1940 (outline-up-heading arg) 2040 (outline-up-heading (if (< arg 0) (- arg)
2041 (- (outline-level) arg)))
1941 (org-show-subtree))) 2042 (org-show-subtree)))
1942 2043
1943 ((save-excursion (beginning-of-line 1) (looking-at outline-regexp)) 2044 ((save-excursion (beginning-of-line 1) (looking-at outline-regexp))
@@ -2273,8 +2374,6 @@ in the region."
2273 (save-excursion 2374 (save-excursion
2274 (setq end (copy-marker end)) 2375 (setq end (copy-marker end))
2275 (goto-char beg) 2376 (goto-char beg)
2276 ;; (if (fboundp 'deactivate-mark) (deactivate-mark))
2277 ;; (if (fboundp 'zmacs-deactivate-region) (zmacs-deactivate-region))
2278 (if (and (re-search-forward (concat "^" outline-regexp) nil t) 2377 (if (and (re-search-forward (concat "^" outline-regexp) nil t)
2279 (< (point) end)) 2378 (< (point) end))
2280 (funcall fun)) 2379 (funcall fun))
@@ -2558,7 +2657,7 @@ heading be marked DONE, and the current time will be added."
2558 (end-of-line 0)) 2657 (end-of-line 0))
2559 ;; Make the heading visible, and the following as well 2658 ;; Make the heading visible, and the following as well
2560 (let ((org-show-following-heading t)) (org-show-hierarchy-above)) 2659 (let ((org-show-following-heading t)) (org-show-hierarchy-above))
2561 (if (re-search-forward 2660 (if (re-search-forward
2562 (concat "^" (regexp-quote (make-string level ?*)) "[ \t]") 2661 (concat "^" (regexp-quote (make-string level ?*)) "[ \t]")
2563 nil t) 2662 nil t)
2564 (progn (goto-char (match-beginning 0)) (insert "\n") 2663 (progn (goto-char (match-beginning 0)) (insert "\n")
@@ -2605,9 +2704,10 @@ At all other locations, this simply calls `ispell-complete-word'."
2605 (let* ((end (point)) 2704 (let* ((end (point))
2606 (beg (save-excursion 2705 (beg (save-excursion
2607 (if (equal (char-before (point)) ?\ ) (backward-char 1)) 2706 (if (equal (char-before (point)) ?\ ) (backward-char 1))
2608 (skip-chars-backward "a-zA-Z0-9_:") 2707 (skip-chars-backward "a-zA-Z0-9_:$")
2609 (point))) 2708 (point)))
2610 (texp (equal (char-before beg) ?\\)) 2709 (texp (equal (char-before beg) ?\\))
2710 (form (equal (char-before beg) ?=))
2611 (opt (equal (buffer-substring (max (point-at-bol) (- beg 2)) 2711 (opt (equal (buffer-substring (max (point-at-bol) (- beg 2))
2612 beg) 2712 beg)
2613 "#+")) 2713 "#+"))
@@ -2617,13 +2717,16 @@ At all other locations, this simply calls `ispell-complete-word'."
2617 (table (cond 2717 (table (cond
2618 (opt 2718 (opt
2619 (setq type :opt) 2719 (setq type :opt)
2620 (mapcar (lambda (x) 2720 (mapcar (lambda (x)
2621 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) 2721 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
2622 (cons (match-string 2 x) (match-string 1 x))) 2722 (cons (match-string 2 x) (match-string 1 x)))
2623 (org-split-string (org-get-current-options) "\n"))) 2723 (org-split-string (org-get-current-options) "\n")))
2624 (texp 2724 (texp
2625 (setq type :tex) 2725 (setq type :tex)
2626 org-html-entities) 2726 org-html-entities)
2727 (form
2728 (setq type :form)
2729 '(("sum") ("sumv") ("sumh")))
2627 ((string-match "\\`\\*+[ \t]*\\'" 2730 ((string-match "\\`\\*+[ \t]*\\'"
2628 (buffer-substring (point-at-bol) beg)) 2731 (buffer-substring (point-at-bol) beg))
2629 (setq type :todo) 2732 (setq type :todo)
@@ -2631,7 +2734,7 @@ At all other locations, this simply calls `ispell-complete-word'."
2631 (t (progn (ispell-complete-word arg) (throw 'exit nil))))) 2734 (t (progn (ispell-complete-word arg) (throw 'exit nil)))))
2632 (completion (try-completion pattern table))) 2735 (completion (try-completion pattern table)))
2633 (cond ((eq completion t) 2736 (cond ((eq completion t)
2634 (if (equal type :opt) 2737 (if (equal type :opt)
2635 (insert (substring (cdr (assoc (upcase pattern) table)) 2738 (insert (substring (cdr (assoc (upcase pattern) table))
2636 (length pattern))))) 2739 (length pattern)))))
2637 ((null completion) 2740 ((null completion)
@@ -2639,7 +2742,7 @@ At all other locations, this simply calls `ispell-complete-word'."
2639 (ding)) 2742 (ding))
2640 ((not (string= pattern completion)) 2743 ((not (string= pattern completion))
2641 (delete-region beg end) 2744 (delete-region beg end)
2642 (if (string-match " +$" completion) 2745 (if (string-match " +$" completion)
2643 (setq completion (replace-match "" t t completion))) 2746 (setq completion (replace-match "" t t completion)))
2644 (insert completion) 2747 (insert completion)
2645 (if (get-buffer-window "*Completions*") 2748 (if (get-buffer-window "*Completions*")
@@ -2876,9 +2979,9 @@ ACTION can be set, up, or down."
2876 (save-match-data 2979 (save-match-data
2877 (if (not (string-match org-priority-regexp s)) 2980 (if (not (string-match org-priority-regexp s))
2878 (* 1000 (- org-lowest-priority org-default-priority)) 2981 (* 1000 (- org-lowest-priority org-default-priority))
2879 (* 1000 (- org-lowest-priority 2982 (* 1000 (- org-lowest-priority
2880 (string-to-char (match-string 2 s))))))) 2983 (string-to-char (match-string 2 s)))))))
2881 2984
2882;;; Timestamps 2985;;; Timestamps
2883 2986
2884(defvar org-last-changed-timestamp nil) 2987(defvar org-last-changed-timestamp nil)
@@ -2910,7 +3013,7 @@ at the cursor, it will be modified."
2910 (setq time (let ((this-command this-command)) 3013 (setq time (let ((this-command this-command))
2911 (org-read-date arg 'totime))) 3014 (org-read-date arg 'totime)))
2912 (and (org-at-timestamp-p) (replace-match 3015 (and (org-at-timestamp-p) (replace-match
2913 (setq org-last-changed-timestamp 3016 (setq org-last-changed-timestamp
2914 (format-time-string fmt time)) 3017 (format-time-string fmt time))
2915 t t)) 3018 t t))
2916 (message "Timestamp updated")) 3019 (message "Timestamp updated"))
@@ -2940,8 +3043,8 @@ but this can be configured with the variables `parse-time-months' and
2940 3043
2941While prompting, a calendar is popped up - you can also select the 3044While prompting, a calendar is popped up - you can also select the
2942date with the mouse (button 1). The calendar shows a period of three 3045date with the mouse (button 1). The calendar shows a period of three
2943month. To scroll it to other months, use the keys `>' and `<'. 3046month. To scroll it to other months, use the keys `>' and `<'.
2944If you don't like the calendar, turn it off with 3047If you don't like the calendar, turn it off with
2945 \(setq org-popup-calendar-for-date-prompt nil). 3048 \(setq org-popup-calendar-for-date-prompt nil).
2946 3049
2947With optional argument TO-TIME, the date will immediately be converted 3050With 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."
2955 ;; Default time is either today, or, when entering a range, 3058 ;; Default time is either today, or, when entering a range,
2956 ;; the range start. 3059 ;; the range start.
2957 (if (save-excursion 3060 (if (save-excursion
2958 (re-search-backward 3061 (re-search-backward
2959 (concat org-ts-regexp "--\\=") 3062 (concat org-ts-regexp "--\\=")
2960 (- (point) 20) t)) 3063 (- (point) 20) t))
2961 (apply 3064 (apply
@@ -3066,7 +3169,7 @@ This is used by `org-read-date' in a temporary keymap for the calendar buffer."
3066 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) 3169 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
3067 (setq ans1 (format-time-string "%Y-%m-%d" time))) 3170 (setq ans1 (format-time-string "%Y-%m-%d" time)))
3068 (if (active-minibuffer-window) (exit-minibuffer)))) 3171 (if (active-minibuffer-window) (exit-minibuffer))))
3069 3172
3070(defun org-check-deadlines (ndays) 3173(defun org-check-deadlines (ndays)
3071 "Check if there are any deadlines due or past due. 3174 "Check if there are any deadlines due or past due.
3072A deadline is considered due if it happens within `org-deadline-warning-days' 3175A deadline is considered due if it happens within `org-deadline-warning-days'
@@ -3358,10 +3461,10 @@ The following commands are available:
3358 (add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local) 3461 (add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local)
3359 (add-hook 'pre-command-hook 'org-unhighlight nil 'local) 3462 (add-hook 'pre-command-hook 'org-unhighlight nil 'local)
3360 (setq org-agenda-follow-mode nil) 3463 (setq org-agenda-follow-mode nil)
3361 (easy-menu-change 3464 (easy-menu-change
3362 '("Agenda") "Agenda Files" 3465 '("Agenda") "Agenda Files"
3363 (append 3466 (append
3364 (list 3467 (list
3365 ["Edit File List" (customize-variable 'org-agenda-files) t] 3468 ["Edit File List" (customize-variable 'org-agenda-files) t]
3366 "--") 3469 "--")
3367 (mapcar 'org-file-menu-entry org-agenda-files))) 3470 (mapcar 'org-file-menu-entry org-agenda-files)))
@@ -3378,7 +3481,8 @@ The following commands are available:
3378(define-key org-agenda-mode-map "l" 'org-agenda-recenter) 3481(define-key org-agenda-mode-map "l" 'org-agenda-recenter)
3379(define-key org-agenda-mode-map "t" 'org-agenda-todo) 3482(define-key org-agenda-mode-map "t" 'org-agenda-todo)
3380(define-key org-agenda-mode-map "." 'org-agenda-goto-today) 3483(define-key org-agenda-mode-map "." 'org-agenda-goto-today)
3381(define-key org-agenda-mode-map "w" 'org-agenda-toggle-week-view) 3484(define-key org-agenda-mode-map "d" 'org-agenda-day-view)
3485(define-key org-agenda-mode-map "w" 'org-agenda-week-view)
3382(define-key org-agenda-mode-map (org-key 'S-right) 'org-agenda-date-later) 3486(define-key org-agenda-mode-map (org-key 'S-right) 'org-agenda-date-later)
3383(define-key org-agenda-mode-map (org-key 'S-left) 'org-agenda-date-earlier) 3487(define-key org-agenda-mode-map (org-key 'S-left) 'org-agenda-date-earlier)
3384 3488
@@ -3388,7 +3492,7 @@ The following commands are available:
3388 (int-to-string (pop l)) 'digit-argument))) 3492 (int-to-string (pop l)) 'digit-argument)))
3389 3493
3390(define-key org-agenda-mode-map "f" 'org-agenda-follow-mode) 3494(define-key org-agenda-mode-map "f" 'org-agenda-follow-mode)
3391(define-key org-agenda-mode-map "d" 'org-agenda-toggle-diary) 3495(define-key org-agenda-mode-map "D" 'org-agenda-toggle-diary)
3392(define-key org-agenda-mode-map "g" 'org-agenda-toggle-time-grid) 3496(define-key org-agenda-mode-map "g" 'org-agenda-toggle-time-grid)
3393(define-key org-agenda-mode-map "r" 'org-agenda-redo) 3497(define-key org-agenda-mode-map "r" 'org-agenda-redo)
3394(define-key org-agenda-mode-map "q" 'org-agenda-quit) 3498(define-key org-agenda-mode-map "q" 'org-agenda-quit)
@@ -3422,7 +3526,7 @@ The following commands are available:
3422(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) 3526(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map)
3423 "Local keymap for agenda entries from Org-mode.") 3527 "Local keymap for agenda entries from Org-mode.")
3424 3528
3425(define-key org-agenda-keymap 3529(define-key org-agenda-keymap
3426 (if org-xemacs-p [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse) 3530 (if org-xemacs-p [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse)
3427(define-key org-agenda-keymap 3531(define-key org-agenda-keymap
3428 (if org-xemacs-p [(button3)] [(mouse-3)]) 'org-agenda-show-mouse) 3532 (if org-xemacs-p [(button3)] [(mouse-3)]) 'org-agenda-show-mouse)
@@ -3434,7 +3538,7 @@ The following commands are available:
3434 ["Show" org-agenda-show t] 3538 ["Show" org-agenda-show t]
3435 ["Go To (other window)" org-agenda-goto t] 3539 ["Go To (other window)" org-agenda-goto t]
3436 ["Go To (one window)" org-agenda-switch-to t] 3540 ["Go To (one window)" org-agenda-switch-to t]
3437 ["Follow Mode" org-agenda-follow-mode 3541 ["Follow Mode" org-agenda-follow-mode
3438 :style toggle :selected org-agenda-follow-mode :active t] 3542 :style toggle :selected org-agenda-follow-mode :active t]
3439 "--" 3543 "--"
3440 ["Cycle TODO" org-agenda-todo t] 3544 ["Cycle TODO" org-agenda-todo t]
@@ -3454,8 +3558,11 @@ The following commands are available:
3454 ["Next Dates" org-agenda-later (local-variable-p 'starting-day)] 3558 ["Next Dates" org-agenda-later (local-variable-p 'starting-day)]
3455 ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)] 3559 ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)]
3456 "--" 3560 "--"
3457 ["Week/Day View" org-agenda-toggle-week-view 3561 ["Day View" org-agenda-day-view :active (local-variable-p 'starting-day)
3458 (local-variable-p 'starting-day)] 3562 :style radio :selected (equal org-agenda-ndays 1)]
3563 ["Week View" org-agenda-week-view :active (local-variable-p 'starting-day)
3564 :style radio :selected (equal org-agenda-ndays 7)]
3565 "--"
3459 ["Include Diary" org-agenda-toggle-diary 3566 ["Include Diary" org-agenda-toggle-diary
3460 :style toggle :selected org-agenda-include-diary :active t] 3567 :style toggle :selected org-agenda-include-diary :active t]
3461 ["Use Time Grid" org-agenda-toggle-time-grid 3568 ["Use Time Grid" org-agenda-toggle-time-grid
@@ -3552,7 +3659,7 @@ dates."
3552 (org-respect-restriction t) 3659 (org-respect-restriction t)
3553 (past t) 3660 (past t)
3554 s e rtn d) 3661 s e rtn d)
3555 (setq org-agenda-redo-command 3662 (setq org-agenda-redo-command
3556 (list 'progn 3663 (list 'progn
3557 (list 'switch-to-buffer-other-window (current-buffer)) 3664 (list 'switch-to-buffer-other-window (current-buffer))
3558 (list 'org-timeline include-all))) 3665 (list 'org-timeline include-all)))
@@ -3561,7 +3668,7 @@ dates."
3561 (setq day-numbers (delq nil (mapcar (lambda(x) 3668 (setq day-numbers (delq nil (mapcar (lambda(x)
3562 (if (>= x today) x nil)) 3669 (if (>= x today) x nil))
3563 day-numbers)))) 3670 day-numbers))))
3564 (switch-to-buffer-other-window 3671 (switch-to-buffer-other-window
3565 (get-buffer-create org-agenda-buffer-name)) 3672 (get-buffer-create org-agenda-buffer-name))
3566 (setq buffer-read-only nil) 3673 (setq buffer-read-only nil)
3567 (erase-buffer) 3674 (erase-buffer)
@@ -3576,7 +3683,7 @@ dates."
3576 (setq date (calendar-gregorian-from-absolute d)) 3683 (setq date (calendar-gregorian-from-absolute d))
3577 (setq s (point)) 3684 (setq s (point))
3578 (if dotodo 3685 (if dotodo
3579 (setq rtn (org-agenda-get-day-entries 3686 (setq rtn (org-agenda-get-day-entries
3580 entry date :todo :timestamp)) 3687 entry date :todo :timestamp))
3581 (setq rtn (org-agenda-get-day-entries entry date :timestamp))) 3688 (setq rtn (org-agenda-get-day-entries entry date :timestamp)))
3582 (if (or rtn (equal d today)) 3689 (if (or rtn (equal d today))
@@ -3632,7 +3739,7 @@ NDAYS defaults to `org-agenda-ndays'."
3632 (day-numbers (list start)) 3739 (day-numbers (list start))
3633 (inhibit-redisplay t) 3740 (inhibit-redisplay t)
3634 s e rtn rtnall file date d start-pos end-pos todayp nd) 3741 s e rtn rtnall file date d start-pos end-pos todayp nd)
3635 (setq org-agenda-redo-command 3742 (setq org-agenda-redo-command
3636 (list 'org-agenda include-all start-day ndays)) 3743 (list 'org-agenda include-all start-day ndays))
3637 ;; Make the list of days 3744 ;; Make the list of days
3638 (setq ndays (or ndays org-agenda-ndays) 3745 (setq ndays (or ndays org-agenda-ndays)
@@ -3644,7 +3751,7 @@ NDAYS defaults to `org-agenda-ndays'."
3644 (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name))) 3751 (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name)))
3645 (progn 3752 (progn
3646 (delete-other-windows) 3753 (delete-other-windows)
3647 (switch-to-buffer-other-window 3754 (switch-to-buffer-other-window
3648 (get-buffer-create org-agenda-buffer-name)))) 3755 (get-buffer-create org-agenda-buffer-name))))
3649 (setq buffer-read-only nil) 3756 (setq buffer-read-only nil)
3650 (erase-buffer) 3757 (erase-buffer)
@@ -3662,7 +3769,7 @@ NDAYS defaults to `org-agenda-ndays'."
3662 rtn (org-agenda-get-day-entries 3769 rtn (org-agenda-get-day-entries
3663 file date :todo)) 3770 file date :todo))
3664 (setq rtnall (append rtnall rtn)))) 3771 (setq rtnall (append rtnall rtn))))
3665 (when rtnall 3772 (when rtnall
3666 (insert "ALL CURRENTLY OPEN TODO ITEMS:\n") 3773 (insert "ALL CURRENTLY OPEN TODO ITEMS:\n")
3667 (add-text-properties (point-min) (1- (point)) 3774 (add-text-properties (point-min) (1- (point))
3668 (list 'face 'org-link)) 3775 (list 'face 'org-link))
@@ -3696,12 +3803,12 @@ NDAYS defaults to `org-agenda-ndays'."
3696 (extract-calendar-year date))) 3803 (extract-calendar-year date)))
3697 (put-text-property s (1- (point)) 'face 3804 (put-text-property s (1- (point)) 'face
3698 'org-link) 3805 'org-link)
3699 (if rtnall (insert 3806 (if rtnall (insert
3700 (org-finalize-agenda-entries ;; FIXME: condition needed 3807 (org-finalize-agenda-entries ;; FIXME: condition needed
3701 (org-agenda-add-time-grid-maybe 3808 (org-agenda-add-time-grid-maybe
3702 rtnall nd todayp)) 3809 rtnall nd todayp))
3703 "\n")) 3810 "\n"))
3704 (put-text-property s (1- (point)) 'day d)))) 3811 (put-text-property s (1- (point)) 'day d))))
3705 (goto-char (point-min)) 3812 (goto-char (point-min))
3706 (setq buffer-read-only t) 3813 (setq buffer-read-only t)
3707 (if org-fit-agenda-window 3814 (if org-fit-agenda-window
@@ -3784,19 +3891,29 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3784 (org-agenda (if (boundp 'include-all-loc) include-all-loc nil) 3891 (org-agenda (if (boundp 'include-all-loc) include-all-loc nil)
3785 (- starting-day (* arg org-agenda-ndays)))) 3892 (- starting-day (* arg org-agenda-ndays))))
3786 3893
3787(defun org-agenda-toggle-week-view () 3894(defun org-agenda-week-view ()
3788 "Toggle weekly/daily view for aagenda." 3895 "Switch to weekly view for agenda."
3896 (interactive)
3897 (unless (boundp 'starting-day)
3898 (error "Not allowed"))
3899 (setq org-agenda-ndays 7)
3900 (org-agenda include-all-loc
3901 (or (get-text-property (point) 'day)
3902 starting-day))
3903 (org-agenda-set-mode-name)
3904 (message "Switched to week view"))
3905
3906(defun org-agenda-day-view ()
3907 "Switch to weekly view for agenda."
3789 (interactive) 3908 (interactive)
3790 (unless (boundp 'starting-day) 3909 (unless (boundp 'starting-day)
3791 (error "Not allowed")) 3910 (error "Not allowed"))
3792 (setq org-agenda-ndays 3911 (setq org-agenda-ndays 1)
3793 (if (equal org-agenda-ndays 1) 7 1)) 3912 (org-agenda include-all-loc
3794 (org-agenda include-all-loc
3795 (or (get-text-property (point) 'day) 3913 (or (get-text-property (point) 'day)
3796 starting-day)) 3914 starting-day))
3797 (org-agenda-set-mode-name) 3915 (org-agenda-set-mode-name)
3798 (message "Switched to %s view" 3916 (message "Switched to day view"))
3799 (if (equal org-agenda-ndays 1) "day" "week")))
3800 3917
3801(defun org-agenda-next-date-line (&optional arg) 3918(defun org-agenda-next-date-line (&optional arg)
3802 "Jump to the next line indicating a date in agenda buffer." 3919 "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'."
3880 "Get the (Emacs Calendar) diary entries for DATE." 3997 "Get the (Emacs Calendar) diary entries for DATE."
3881 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") 3998 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*")
3882 (diary-display-hook '(fancy-diary-display)) 3999 (diary-display-hook '(fancy-diary-display))
3883 (list-diary-entries-hook 4000 (list-diary-entries-hook
3884 (cons 'org-diary-default-entry list-diary-entries-hook)) 4001 (cons 'org-diary-default-entry list-diary-entries-hook))
3885 entries 4002 entries
3886 (org-disable-diary t)) 4003 (org-disable-diary t))
@@ -3904,12 +4021,12 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3904 (kill-buffer fancy-diary-buffer))) 4021 (kill-buffer fancy-diary-buffer)))
3905 (when entries 4022 (when entries
3906 (setq entries (org-split-string entries "\n")) 4023 (setq entries (org-split-string entries "\n"))
3907 (setq entries 4024 (setq entries
3908 (mapcar 4025 (mapcar
3909 (lambda (x) 4026 (lambda (x)
3910 (setq x (org-format-agenda-item "" x "Diary" 'time)) 4027 (setq x (org-format-agenda-item "" x "Diary" 'time))
3911 ;; Extend the text properties to the beginning of the line 4028 ;; Extend the text properties to the beginning of the line
3912 (add-text-properties 4029 (add-text-properties
3913 0 (length x) 4030 0 (length x)
3914 (text-properties-at (1- (length x)) x) 4031 (text-properties-at (1- (length x)) x)
3915 x) 4032 x)
@@ -3950,7 +4067,7 @@ date. Itt also removes lines that contain only whitespace."
3950 0 (length string) 4067 0 (length string)
3951 (list 'mouse-face 'highlight 4068 (list 'mouse-face 'highlight
3952 'keymap org-agenda-keymap 4069 'keymap org-agenda-keymap
3953 'help-echo 4070 'help-echo
3954 (format 4071 (format
3955 "mouse-2 or RET jump to diary file %s" 4072 "mouse-2 or RET jump to diary file %s"
3956 (abbreviate-file-name (buffer-file-name))) 4073 (abbreviate-file-name (buffer-file-name)))
@@ -3972,7 +4089,7 @@ Needed to avoid empty dates which mess up holiday display."
3972These are the files which are being checked for agenda entries. 4089These are the files which are being checked for agenda entries.
3973Optional argument FILE means, use this file instead of the current. 4090Optional argument FILE means, use this file instead of the current.
3974It is possible (but not recommended) to add this function to the 4091It is possible (but not recommended) to add this function to the
3975`org-mode-hook'." 4092`org-mode-hook'."
3976 (interactive) 4093 (interactive)
3977 (catch 'exit 4094 (catch 'exit
3978 (let* ((file (or file (buffer-file-name) 4095 (let* ((file (or file (buffer-file-name)
@@ -3987,7 +4104,7 @@ It is possible (but not recommended) to add this function to the
3987 org-agenda-files)))) 4104 org-agenda-files))))
3988 (if (not present) 4105 (if (not present)
3989 (progn 4106 (progn
3990 (setq org-agenda-files 4107 (setq org-agenda-files
3991 (cons afile org-agenda-files)) 4108 (cons afile org-agenda-files))
3992 ;; Make sure custom.el does not end up with Org-mode 4109 ;; Make sure custom.el does not end up with Org-mode
3993 (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode)) 4110 (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."
4004 (let* ((file (or file (buffer-file-name))) 4121 (let* ((file (or file (buffer-file-name)))
4005 (true-file (file-truename file)) 4122 (true-file (file-truename file))
4006 (afile (abbreviate-file-name file)) 4123 (afile (abbreviate-file-name file))
4007 (files (delq nil (mapcar 4124 (files (delq nil (mapcar
4008 (lambda (x) 4125 (lambda (x)
4009 (if (equal true-file 4126 (if (equal true-file
4010 (file-truename x)) 4127 (file-truename x))
@@ -4051,6 +4168,7 @@ sure that TODAY is included in the list."
4051 "Return diary information from org-files. 4168 "Return diary information from org-files.
4052This function can be used in a \"sexp\" diary entry in the Emacs calendar. 4169This function can be used in a \"sexp\" diary entry in the Emacs calendar.
4053It accesses org files and extracts information from those files to be 4170It accesses org files and extracts information from those files to be
4171
4054listed in the diary. The function accepts arguments specifying what 4172listed in the diary. The function accepts arguments specifying what
4055items should be listed. The following arguments are allowed: 4173items should be listed. The following arguments are allowed:
4056 4174
@@ -4089,9 +4207,9 @@ also be written as
4089 4207
4090The function expects the lisp variables `entry' and `date' to be provided 4208The function expects the lisp variables `entry' and `date' to be provided
4091by the caller, because this is how the calendar works. Don't use this 4209by the caller, because this is how the calendar works. Don't use this
4092function from a program - use `org-agenda-get-day-entries' instead." 4210function from a program - use `org-agenda-get-day-entries' instead."
4093 (org-agenda-maybe-reset-markers) 4211 (org-agenda-maybe-reset-markers)
4094 (org-compile-agenda-prefix-format org-agenda-prefix-format) 4212 (org-compile-prefix-format org-agenda-prefix-format)
4095 (setq args (or args '(:deadline :scheduled :timestamp))) 4213 (setq args (or args '(:deadline :scheduled :timestamp)))
4096 (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) 4214 (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
4097 (list entry) 4215 (list entry)
@@ -4131,7 +4249,7 @@ the documentation of `org-diary'."
4131 (if (org-region-active-p) 4249 (if (org-region-active-p)
4132 ;; Respect a region to restrict search 4250 ;; Respect a region to restrict search
4133 (narrow-to-region (region-beginning) (region-end))) 4251 (narrow-to-region (region-beginning) (region-end)))
4134 ;; If we work for the calendar or many files, 4252 ;; If we work for the calendar or many files,
4135 ;; get rid of any restriction 4253 ;; get rid of any restriction
4136 (widen)) 4254 (widen))
4137 ;; The way we repeatedly append to `results' makes it O(n^2) :-( 4255 ;; The way we repeatedly append to `results' makes it O(n^2) :-(
@@ -4197,7 +4315,7 @@ the documentation of `org-diary'."
4197 (goto-char (match-beginning 1)) 4315 (goto-char (match-beginning 1))
4198 (setq marker (org-agenda-new-marker (point-at-bol)) 4316 (setq marker (org-agenda-new-marker (point-at-bol))
4199 txt (org-format-agenda-item "" (match-string 1)) 4317 txt (org-format-agenda-item "" (match-string 1))
4200 priority 4318 priority
4201 (+ (org-get-priority txt) 4319 (+ (org-get-priority txt)
4202 (if org-todo-kwd-priority-p 4320 (if org-todo-kwd-priority-p
4203 (- org-todo-kwd-max-priority -2 4321 (- org-todo-kwd-max-priority -2
@@ -4269,7 +4387,7 @@ the documentation of `org-diary'."
4269 (if deadlinep 4387 (if deadlinep
4270 (add-text-properties 4388 (add-text-properties
4271 0 (length txt) 4389 0 (length txt)
4272 (list 'face 4390 (list 'face
4273 (if donep 'org-done 'org-warning) 4391 (if donep 'org-done 'org-warning)
4274 'undone-face 'org-warning 4392 'undone-face 'org-warning
4275 'done-face 'org-done 4393 'done-face 'org-done
@@ -4329,8 +4447,8 @@ the documentation of `org-diary'."
4329 (setq txt org-agenda-no-heading-message)) 4447 (setq txt org-agenda-no-heading-message))
4330 (when txt 4448 (when txt
4331 (add-text-properties 4449 (add-text-properties
4332 0 (length txt) 4450 0 (length txt)
4333 (append 4451 (append
4334 (list 'org-marker (org-agenda-new-marker pos) 4452 (list 'org-marker (org-agenda-new-marker pos)
4335 'org-hd-marker (org-agenda-new-marker pos1) 4453 'org-hd-marker (org-agenda-new-marker pos1)
4336 'priority (+ (- 10 diff) (org-get-priority txt)) 4454 'priority (+ (- 10 diff) (org-get-priority txt))
@@ -4422,7 +4540,7 @@ the documentation of `org-diary'."
4422 (setq hdmarker (org-agenda-new-marker (match-end 1))) 4540 (setq hdmarker (org-agenda-new-marker (match-end 1)))
4423 (goto-char (match-end 1)) 4541 (goto-char (match-end 1))
4424 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") 4542 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
4425 (setq txt (org-format-agenda-item 4543 (setq txt (org-format-agenda-item
4426 (format (if (= d1 d2) "" "(%d/%d): ") 4544 (format (if (= d1 d2) "" "(%d/%d): ")
4427 (1+ (- d0 d1)) (1+ (- d2 d1))) 4545 (1+ (- d0 d1)) (1+ (- d2 d1)))
4428 (match-string 1) nil (if (= d0 d1) timestr)))) 4546 (match-string 1) nil (if (= d0 d1) timestr))))
@@ -4504,7 +4622,7 @@ only the correctly processes TXT should be returned - this is used by
4504 (setq s0 (match-string 0 ts) 4622 (setq s0 (match-string 0 ts)
4505 s1 (match-string (if plain 1 2) ts) 4623 s1 (match-string (if plain 1 2) ts)
4506 s2 (match-string (if plain 8 4) ts)) 4624 s2 (match-string (if plain 8 4) ts))
4507 4625
4508 ;; If the times are in TXT (not in DOTIMES), and the prefix will list 4626 ;; If the times are in TXT (not in DOTIMES), and the prefix will list
4509 ;; them, we might want to remove them there to avoid duplication. 4627 ;; them, we might want to remove them there to avoid duplication.
4510 ;; The user can turn this off with a variable. 4628 ;; 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
4517 ;; Normalize the time(s) to 24 hour 4635 ;; Normalize the time(s) to 24 hour
4518 (if s1 (setq s1 (org-get-time-of-day s1 'string))) 4636 (if s1 (setq s1 (org-get-time-of-day s1 'string)))
4519 (if s2 (setq s2 (org-get-time-of-day s2 'string)))) 4637 (if s2 (setq s2 (org-get-time-of-day s2 'string))))
4520 4638
4521 ;; Create the final string 4639 ;; Create the final string
4522 (if noprefix 4640 (if noprefix
4523 (setq rtn txt) 4641 (setq rtn txt)
@@ -4529,7 +4647,7 @@ only the correctly processes TXT should be returned - this is used by
4529 category (if (symbolp category) (symbol-name category) category)) 4647 category (if (symbolp category) (symbol-name category) category))
4530 ;; Evaluate the compiled format 4648 ;; Evaluate the compiled format
4531 (setq rtn (concat (eval org-prefix-format-compiled) txt))) 4649 (setq rtn (concat (eval org-prefix-format-compiled) txt)))
4532 4650
4533 ;; And finally add the text properties 4651 ;; And finally add the text properties
4534 (add-text-properties 4652 (add-text-properties
4535 0 (length rtn) (list 'category (downcase category) 4653 0 (length rtn) (list 'category (downcase category)
@@ -4560,11 +4678,11 @@ only the correctly processes TXT should be returned - this is used by
4560 (while (setq time (pop gridtimes)) 4678 (while (setq time (pop gridtimes))
4561 (unless (and remove (member time have)) 4679 (unless (and remove (member time have))
4562 (setq time (int-to-string time)) 4680 (setq time (int-to-string time))
4563 (push (org-format-agenda-item 4681 (push (org-format-agenda-item
4564 nil string "" ;; FIXME: put a category? 4682 nil string "" ;; FIXME: put a category?
4565 (concat (substring time 0 -2) ":" (substring time -2))) 4683 (concat (substring time 0 -2) ":" (substring time -2)))
4566 new) 4684 new)
4567 (put-text-property 4685 (put-text-property
4568 1 (length (car new)) 'face 'org-time-grid (car new)))) 4686 1 (length (car new)) 'face 'org-time-grid (car new))))
4569 (if (member 'time-up org-agenda-sorting-strategy) 4687 (if (member 'time-up org-agenda-sorting-strategy)
4570 (append new list) 4688 (append new list)
@@ -4603,7 +4721,7 @@ If not found, return nil.
4603The optional STRING argument forces conversion into a 5 character wide string 4721The optional STRING argument forces conversion into a 5 character wide string
4604HH:MM." 4722HH:MM."
4605 (save-match-data 4723 (save-match-data
4606 (when 4724 (when
4607 (or 4725 (or
4608 (string-match 4726 (string-match
4609 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) 4727 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
@@ -4659,7 +4777,7 @@ HH:MM."
4659 (category-up (org-cmp-category a b)) 4777 (category-up (org-cmp-category a b))
4660 (category-down (if category-up (- category-up) nil)) 4778 (category-down (if category-up (- category-up) nil))
4661 (category-keep (if category-up +1 nil))) ; FIXME +1 or -1? 4779 (category-keep (if category-up +1 nil))) ; FIXME +1 or -1?
4662 (cdr (assoc 4780 (cdr (assoc
4663 (eval (cons 'or org-agenda-sorting-strategy)) 4781 (eval (cons 'or org-agenda-sorting-strategy))
4664 '((-1 . t) (1 . nil) (nil . nil)))))) 4782 '((-1 . t) (1 . nil) (nil . nil))))))
4665 4783
@@ -4674,7 +4792,7 @@ and by additional input from the age of a schedules or deadline entry."
4674(defun org-agenda-goto (&optional highlight) 4792(defun org-agenda-goto (&optional highlight)
4675 "Go to the Org-mode file which contains the item at point." 4793 "Go to the Org-mode file which contains the item at point."
4676 (interactive) 4794 (interactive)
4677 (let* ((marker (or (get-text-property (point) 'org-marker) 4795 (let* ((marker (or (get-text-property (point) 'org-marker)
4678 (org-agenda-error))) 4796 (org-agenda-error)))
4679 (buffer (marker-buffer marker)) 4797 (buffer (marker-buffer marker))
4680 (pos (marker-position marker))) 4798 (pos (marker-position marker)))
@@ -4691,7 +4809,7 @@ and by additional input from the age of a schedules or deadline entry."
4691(defun org-agenda-switch-to () 4809(defun org-agenda-switch-to ()
4692 "Go to the Org-mode file which contains the item at point." 4810 "Go to the Org-mode file which contains the item at point."
4693 (interactive) 4811 (interactive)
4694 (let* ((marker (or (get-text-property (point) 'org-marker) 4812 (let* ((marker (or (get-text-property (point) 'org-marker)
4695 (org-agenda-error))) 4813 (org-agenda-error)))
4696 (buffer (marker-buffer marker)) 4814 (buffer (marker-buffer marker))
4697 (pos (marker-position marker))) 4815 (pos (marker-position marker)))
@@ -4805,7 +4923,7 @@ the new TODO state."
4805 (beginning-of-line 1) 4923 (beginning-of-line 1)
4806 (add-text-properties (point-at-bol) (point-at-eol) props) 4924 (add-text-properties (point-at-bol) (point-at-eol) props)
4807 (if fixface 4925 (if fixface
4808 (add-text-properties 4926 (add-text-properties
4809 (point-at-bol) (point-at-eol) 4927 (point-at-bol) (point-at-eol)
4810 (list 'face 4928 (list 'face
4811 (if org-last-todo-state-is-todo 4929 (if org-last-todo-state-is-todo
@@ -4902,7 +5020,7 @@ be used to request time specification in the time stamp."
4902All the standard commands work: block, weekly etc" 5020All the standard commands work: block, weekly etc"
4903 (interactive) 5021 (interactive)
4904 (require 'diary-lib) 5022 (require 'diary-lib)
4905 (let* ((char (progn 5023 (let* ((char (progn
4906 (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic") 5024 (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic")
4907 (read-char-exclusive))) 5025 (read-char-exclusive)))
4908 (cmd (cdr (assoc char 5026 (cmd (cdr (assoc char
@@ -4932,7 +5050,7 @@ All the standard commands work: block, weekly etc"
4932 (progn 5050 (progn
4933 (fset 'calendar-cursor-to-date 5051 (fset 'calendar-cursor-to-date
4934 (lambda (&optional error) 5052 (lambda (&optional error)
4935 (calendar-gregorian-from-absolute 5053 (calendar-gregorian-from-absolute
4936 (get-text-property point 'day)))) 5054 (get-text-property point 'day))))
4937 (call-interactively cmd)) 5055 (call-interactively cmd))
4938 (fset 'calendar-cursor-to-date oldf))))) 5056 (fset 'calendar-cursor-to-date oldf)))))
@@ -4955,7 +5073,7 @@ the cursor position."
4955 (progn 5073 (progn
4956 (fset 'calendar-cursor-to-date 5074 (fset 'calendar-cursor-to-date
4957 (lambda (&optional error) 5075 (lambda (&optional error)
4958 (calendar-gregorian-from-absolute 5076 (calendar-gregorian-from-absolute
4959 (get-text-property point 'day)))) 5077 (get-text-property point 'day))))
4960 (call-interactively cmd)) 5078 (call-interactively cmd))
4961 (fset 'calendar-cursor-to-date oldf)))) 5079 (fset 'calendar-cursor-to-date oldf))))
@@ -5005,7 +5123,7 @@ This is a command that has to be installed in `calendar-mode-map'."
5005 (unless day 5123 (unless day
5006 (error "Don't know which date to convert")) 5124 (error "Don't know which date to convert"))
5007 (setq date (calendar-gregorian-from-absolute day)) 5125 (setq date (calendar-gregorian-from-absolute day))
5008 (setq s (concat 5126 (setq s (concat
5009 "Gregorian: " (calendar-date-string date) "\n" 5127 "Gregorian: " (calendar-date-string date) "\n"
5010 "ISO: " (calendar-iso-date-string date) "\n" 5128 "ISO: " (calendar-iso-date-string date) "\n"
5011 "Day of Yr: " (calendar-day-of-year-string date) "\n" 5129 "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."
5118 5236
5119 ((string= type "shell") 5237 ((string= type "shell")
5120 (let ((cmd path)) 5238 (let ((cmd path))
5121 (while (string-match "@{" cmd) 5239 (while (string-match "@{" cmd)
5122 (setq cmd (replace-match "<" t t cmd))) 5240 (setq cmd (replace-match "<" t t cmd)))
5123 (while (string-match "@}" cmd) 5241 (while (string-match "@}" cmd)
5124 (setq cmd (replace-match ">" t t cmd))) 5242 (setq cmd (replace-match ">" t t cmd)))
5125 (if (or (not org-confirm-shell-links) 5243 (if (or (not org-confirm-shell-links)
5126 (yes-or-no-p (format "Execute \"%s\" in the shell? " cmd))) 5244 (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."
5217 (widen) 5335 (widen)
5218 (goto-char (point-max)) 5336 (goto-char (point-max))
5219 (if (re-search-backward 5337 (if (re-search-backward
5220 (concat "^Message-ID:\\s-+" (regexp-quote 5338 (concat "^Message-ID:\\s-+" (regexp-quote
5221 (or article ""))) 5339 (or article "")))
5222 nil t) 5340 nil t)
5223 (rmail-what-message)))))) 5341 (rmail-what-message))))))
@@ -5304,7 +5422,7 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5304 (or (bbdb-record-name (bbdb-current-record)) 5422 (or (bbdb-record-name (bbdb-current-record))
5305 (bbdb-record-company (bbdb-current-record)))) 5423 (bbdb-record-company (bbdb-current-record))))
5306 link (org-make-link cpltxt))) 5424 link (org-make-link cpltxt)))
5307 5425
5308 ((eq major-mode 'calendar-mode) 5426 ((eq major-mode 'calendar-mode)
5309 (let ((cd (calendar-cursor-to-date))) 5427 (let ((cd (calendar-cursor-to-date)))
5310 (setq link 5428 (setq link
@@ -5330,8 +5448,8 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5330 folder) 5448 folder)
5331 (setq folder (replace-match "" t t folder))) 5449 (setq folder (replace-match "" t t folder)))
5332 (setq cpltxt (concat author " on: " subject)) 5450 (setq cpltxt (concat author " on: " subject))
5333 (setq link (concat cpltxt "\n " 5451 (setq link (concat cpltxt "\n "
5334 (org-make-link 5452 (org-make-link
5335 "vm:" folder "#" message-id)))))) 5453 "vm:" folder "#" message-id))))))
5336 5454
5337 ((eq major-mode 'wl-summary-mode) 5455 ((eq major-mode 'wl-summary-mode)
@@ -5343,7 +5461,7 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5343 (author (wl-summary-line-from)) ; FIXME: how to get author name? 5461 (author (wl-summary-line-from)) ; FIXME: how to get author name?
5344 (subject "???")) ; FIXME: How to get subject of email? 5462 (subject "???")) ; FIXME: How to get subject of email?
5345 (setq cpltxt (concat author " on: " subject)) 5463 (setq cpltxt (concat author " on: " subject))
5346 (setq link (concat cpltxt "\n " 5464 (setq link (concat cpltxt "\n "
5347 (org-make-link 5465 (org-make-link
5348 "wl:" wl-summary-buffer-folder-name 5466 "wl:" wl-summary-buffer-folder-name
5349 "#" message-id))))) 5467 "#" message-id)))))
@@ -5357,7 +5475,7 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5357 (author (mail-fetch-field "from")) 5475 (author (mail-fetch-field "from"))
5358 (subject (mail-fetch-field "subject"))) 5476 (subject (mail-fetch-field "subject")))
5359 (setq cpltxt (concat author " on: " subject)) 5477 (setq cpltxt (concat author " on: " subject))
5360 (setq link (concat cpltxt "\n " 5478 (setq link (concat cpltxt "\n "
5361 (org-make-link 5479 (org-make-link
5362 "rmail:" folder "#" message-id))))))) 5480 "rmail:" folder "#" message-id)))))))
5363 5481
@@ -5411,7 +5529,7 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5411 (if (org-xor org-line-numbers-in-file-links arg) 5529 (if (org-xor org-line-numbers-in-file-links arg)
5412 (setq cpltxt 5530 (setq cpltxt
5413 (concat cpltxt 5531 (concat cpltxt
5414 ":" (int-to-string 5532 ":" (int-to-string
5415 (+ (if (bolp) 1 0) (count-lines 5533 (+ (if (bolp) 1 0) (count-lines
5416 (point-min) (point))))))) 5534 (point-min) (point)))))))
5417 (setq link (org-make-link cpltxt))) 5535 (setq link (org-make-link cpltxt)))
@@ -5581,7 +5699,7 @@ If the variable `org-adapt-indentation' is non-nil, the entire text is
5581also indented so that it starts in the same column as the headline 5699also indented so that it starts in the same column as the headline
5582\(i.e. after the stars). 5700\(i.e. after the stars).
5583 5701
5584See also the variable `org-reverse-note-order'." 5702See also the variable `org-reverse-note-order'."
5585 (catch 'quit 5703 (catch 'quit
5586 (let* ((txt (buffer-substring (point-min) (point-max))) 5704 (let* ((txt (buffer-substring (point-min) (point-max)))
5587 (fastp current-prefix-arg) 5705 (fastp current-prefix-arg)
@@ -5687,6 +5805,10 @@ See also the variable `org-reverse-note-order'."
5687 "Detects an org-type table line.") 5805 "Detects an org-type table line.")
5688(defconst org-table-dataline-regexp "^[ \t]*|[^-]" 5806(defconst org-table-dataline-regexp "^[ \t]*|[^-]"
5689 "Detects an org-type table line.") 5807 "Detects an org-type table line.")
5808(defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)"
5809 "Detects a table line marked for automatic recalculation.")
5810(defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)"
5811 "Detects a table line marked for automatic recalculation.")
5690(defconst org-table-hline-regexp "^[ \t]*|-" 5812(defconst org-table-hline-regexp "^[ \t]*|-"
5691 "Detects an org-type table hline.") 5813 "Detects an org-type table hline.")
5692(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" 5814(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]"
@@ -5843,6 +5965,7 @@ This is being used to correctly align a single field after TAB or RET.")
5843 "List of max width of fields in each column. 5965 "List of max width of fields in each column.
5844This is being used to correctly align a single field after TAB or RET.") 5966This is being used to correctly align a single field after TAB or RET.")
5845 5967
5968(defvar org-last-recalc-line nil)
5846 5969
5847(defun org-table-align () 5970(defun org-table-align ()
5848 "Align the table at point by aligning all vertical bars." 5971 "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.")
5878 (if (string-match "^ *" (car lines)) 6001 (if (string-match "^ *" (car lines))
5879 (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) 6002 (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ )))
5880 ;; Mark the hlines 6003 ;; Mark the hlines
5881 (setq lines (mapcar (lambda (l) (if (string-match "^ *|-" l) nil l)) 6004 (setq lines (mapcar (lambda (l)
6005 (if (string-match "^ *|-" l)
6006 nil
6007 (if (string-match "[ \t]+$" l)
6008 (substring l 0 (match-beginning 0))
6009 l)))
5882 lines)) 6010 lines))
5883 ;; Get the data fields 6011 ;; Get the data fields
5884 (setq fields (mapcar 6012 (setq fields (mapcar
@@ -5994,15 +6122,17 @@ With argument TABLE-TYPE, go to the end of a table.el-type table."
5994 (let* ((pos (point)) s org-table-may-need-update 6122 (let* ((pos (point)) s org-table-may-need-update
5995 (col (org-table-current-column)) 6123 (col (org-table-current-column))
5996 (num (nth (1- col) org-table-last-alignment)) 6124 (num (nth (1- col) org-table-last-alignment))
5997 l f) 6125 l f n o)
5998 (when (> col 0) 6126 (when (> col 0)
5999 (skip-chars-backward "^|\n") 6127 (skip-chars-backward "^|\n")
6000 (if (looking-at " *\\([^|\n]*?\\) *|") 6128 (if (looking-at " *\\([^|\n]*?\\) *|")
6001 (progn 6129 (progn
6002 (setq s (match-string 1) 6130 (setq s (match-string 1)
6131 o (match-string 0)
6003 l (max 1 (- (match-end 0) (match-beginning 0) 3))) 6132 l (max 1 (- (match-end 0) (match-beginning 0) 3)))
6004 (setq f (format (if num " %%%ds |" " %%-%ds |") l)) 6133 (setq f (format (if num " %%%ds |" " %%-%ds |") l)
6005 (replace-match (format f s t t))) 6134 n (format f s t t))
6135 (or (equal n o) (replace-match n)))
6006 (setq org-table-may-need-update t)) 6136 (setq org-table-may-need-update t))
6007 (goto-char pos)))))) 6137 (goto-char pos))))))
6008 6138
@@ -6010,6 +6140,8 @@ With argument TABLE-TYPE, go to the end of a table.el-type table."
6010 "Go to the next field in the current table. 6140 "Go to the next field in the current table.
6011Before doing so, re-align the table if necessary." 6141Before doing so, re-align the table if necessary."
6012 (interactive) 6142 (interactive)
6143 (org-table-maybe-eval-formula)
6144 (org-table-maybe-recalculate-line)
6013 (if (and org-table-automatic-realign 6145 (if (and org-table-automatic-realign
6014 org-table-may-need-update) 6146 org-table-may-need-update)
6015 (org-table-align)) 6147 (org-table-align))
@@ -6032,6 +6164,8 @@ Before doing so, re-align the table if necessary."
6032 "Go to the previous field in the table. 6164 "Go to the previous field in the table.
6033Before doing so, re-align the table if necessary." 6165Before doing so, re-align the table if necessary."
6034 (interactive) 6166 (interactive)
6167 (org-table-justify-field-maybe)
6168 (org-table-maybe-recalculate-line)
6035 (if (and org-table-automatic-realign 6169 (if (and org-table-automatic-realign
6036 org-table-may-need-update) 6170 org-table-may-need-update)
6037 (org-table-align)) 6171 (org-table-align))
@@ -6048,6 +6182,8 @@ Before doing so, re-align the table if necessary."
6048 "Go to the next row (same column) in the current table. 6182 "Go to the next row (same column) in the current table.
6049Before doing so, re-align the table if necessary." 6183Before doing so, re-align the table if necessary."
6050 (interactive) 6184 (interactive)
6185 (org-table-maybe-eval-formula)
6186 (org-table-maybe-recalculate-line)
6051 (if (or (looking-at "[ \t]*$") 6187 (if (or (looking-at "[ \t]*$")
6052 (save-excursion (skip-chars-backward " \t") (bolp))) 6188 (save-excursion (skip-chars-backward " \t") (bolp)))
6053 (newline) 6189 (newline)
@@ -6071,7 +6207,7 @@ If the field at the cursor is empty, copy into it the content of the nearest
6071non-empty field above. With argument N, use the Nth non-empty field. 6207non-empty field above. With argument N, use the Nth non-empty field.
6072If the current field is not empty, it is copied down to the next row, and 6208If the current field is not empty, it is copied down to the next row, and
6073the cursor is moved with it. Therefore, repeating this command causes the 6209the cursor is moved with it. Therefore, repeating this command causes the
6074column to be filled row-by-row. 6210column to be filled row-by-row.
6075If the variable `org-table-copy-increment' is non-nil and the field is an 6211If the variable `org-table-copy-increment' is non-nil and the field is an
6076integer, it will be incremented while copying." 6212integer, it will be incremented while copying."
6077 (interactive "p") 6213 (interactive "p")
@@ -6081,23 +6217,29 @@ integer, it will be incremented while copying."
6081 (beg (org-table-begin)) 6217 (beg (org-table-begin))
6082 txt) 6218 txt)
6083 (org-table-check-inside-data-field) 6219 (org-table-check-inside-data-field)
6084 (if non-empty (progn (org-table-next-row) (org-table-blank-field))) 6220 (if non-empty
6085 (if (save-excursion 6221 (progn
6086 (setq txt 6222 (setq txt (org-trim field))
6087 (catch 'exit 6223 (org-table-next-row)
6088 (while (progn (beginning-of-line 1) 6224 (org-table-blank-field))
6089 (re-search-backward org-table-dataline-regexp 6225 (save-excursion
6090 beg t)) 6226 (setq txt
6091 (org-table-goto-column colpos t) 6227 (catch 'exit
6092 (if (and (looking-at 6228 (while (progn (beginning-of-line 1)
6093 "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") 6229 (re-search-backward org-table-dataline-regexp
6094 (= (setq n (1- n)) 0)) 6230 beg t))
6095 (throw 'exit (match-string 1))))))) 6231 (org-table-goto-column colpos t)
6232 (if (and (looking-at
6233 "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
6234 (= (setq n (1- n)) 0))
6235 (throw 'exit (match-string 1))))))))
6236 (if txt
6096 (progn 6237 (progn
6097 (if (and org-table-copy-increment 6238 (if (and org-table-copy-increment
6098 (string-match "^[0-9]+$" txt)) 6239 (string-match "^[0-9]+$" txt))
6099 (setq txt (format "%d" (+ (string-to-int txt) 1)))) 6240 (setq txt (format "%d" (+ (string-to-int txt) 1))))
6100 (insert txt) 6241 (insert txt)
6242 (org-table-maybe-recalculate-line)
6101 (org-table-align)) 6243 (org-table-align))
6102 (error "No non-empty field found")))) 6244 (error "No non-empty field found"))))
6103 6245
@@ -6119,10 +6261,10 @@ I.e. not on a hline or before the first or after the last column?"
6119 (org-table-check-inside-data-field) 6261 (org-table-check-inside-data-field)
6120 (if (and (interactive-p) (org-region-active-p)) 6262 (if (and (interactive-p) (org-region-active-p))
6121 (let (org-table-clip) 6263 (let (org-table-clip)
6122 (org-table-cut-region)) 6264 (org-table-cut-region (region-beginning) (region-end)))
6123 (skip-chars-backward "^|") 6265 (skip-chars-backward "^|")
6124 (backward-char 1) 6266 (backward-char 1)
6125 (if (looking-at "|[^|]+") 6267 (if (looking-at "|[^|\n]+")
6126 (let* ((pos (match-beginning 0)) 6268 (let* ((pos (match-beginning 0))
6127 (match (match-string 0)) 6269 (match (match-string 0))
6128 (len (length match))) 6270 (len (length match)))
@@ -6136,15 +6278,16 @@ N defaults to current field.
6136If REPLACE is a string, replace field with this value. The return value 6278If REPLACE is a string, replace field with this value. The return value
6137is always the old value." 6279is always the old value."
6138 (and n (org-table-goto-column n)) 6280 (and n (org-table-goto-column n))
6139 (skip-chars-backward "^|") 6281 (skip-chars-backward "^|\n")
6140 (backward-char 1) 6282 (backward-char 1)
6141 (if (looking-at "|[^|\r\n]*") 6283 (if (looking-at "|[^|\r\n]*")
6142 (let* ((pos (match-beginning 0)) 6284 (let* ((pos (match-beginning 0))
6143 (val (buffer-substring (1+ pos) (match-end 0)))) 6285 (val (buffer-substring (1+ pos) (match-end 0))))
6144 (if replace 6286 (if replace
6145 (replace-match (concat "|" replace))) 6287 (replace-match (concat "|" replace)))
6146 (goto-char (+ 2 pos)) 6288 (goto-char (min (point-at-eol) (+ 2 pos)))
6147 val))) 6289 val)
6290 (forward-char 1) ""))
6148 6291
6149(defun org-table-current-column () 6292(defun org-table-current-column ()
6150 "Find out which column we are in. 6293 "Find out which column we are in.
@@ -6162,7 +6305,7 @@ When called interactively, column is also displayed in echo area."
6162(defun org-table-goto-column (n &optional on-delim force) 6305(defun org-table-goto-column (n &optional on-delim force)
6163 "Move the cursor to the Nth column in the current table line. 6306 "Move the cursor to the Nth column in the current table line.
6164With optional argument ON-DELIM, stop with point before the left delimiter 6307With optional argument ON-DELIM, stop with point before the left delimiter
6165of the field. 6308of the field.
6166If there are less than N fields, just go to after the last delimiter. 6309If there are less than N fields, just go to after the last delimiter.
6167However, when FORCE is non-nil, create new columns if necessary." 6310However, when FORCE is non-nil, create new columns if necessary."
6168 (let ((pos (point-at-eol))) 6311 (let ((pos (point-at-eol)))
@@ -6173,10 +6316,10 @@ However, when FORCE is non-nil, create new columns if necessary."
6173 (and force 6316 (and force
6174 (progn (end-of-line 1) 6317 (progn (end-of-line 1)
6175 (skip-chars-backward "^|") 6318 (skip-chars-backward "^|")
6176 (insert " |") 6319 (insert " | "))))))
6177 (backward-char 2) t))))) 6320; (backward-char 2) t)))))
6178 (when (and force (not (looking-at ".*|"))) 6321 (when (and force (not (looking-at ".*|")))
6179 (save-excursion (end-of-line 1) (insert "|"))) 6322 (save-excursion (end-of-line 1) (insert " | ")))
6180 (if on-delim 6323 (if on-delim
6181 (backward-char 1) 6324 (backward-char 1)
6182 (if (looking-at " ") (forward-char 1)))))) 6325 (if (looking-at " ") (forward-char 1))))))
@@ -6255,8 +6398,9 @@ If TABLE-TYPE is non-nil, also chack for table.el-type tables."
6255 (beginning-of-line 2)) 6398 (beginning-of-line 2))
6256 (move-marker end nil) 6399 (move-marker end nil)
6257 (goto-line linepos) 6400 (goto-line linepos)
6258 (org-table-goto-column colpos)) 6401 (org-table-goto-column colpos)
6259 (org-table-align)) 6402 (org-table-align)
6403 (org-table-modify-formulas 'insert col)))
6260 6404
6261(defun org-table-find-dataline () 6405(defun org-table-find-dataline ()
6262 "Find a dataline in the current table, which is needed for column commands." 6406 "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."
6300 (beginning-of-line 2)) 6444 (beginning-of-line 2))
6301 (move-marker end nil) 6445 (move-marker end nil)
6302 (goto-line linepos) 6446 (goto-line linepos)
6303 (org-table-goto-column colpos)) 6447 (org-table-goto-column colpos)
6304 (org-table-align)) 6448 (org-table-align)
6449 (org-table-modify-formulas 'remove col)))
6305 6450
6306(defun org-table-move-column-right () 6451(defun org-table-move-column-right ()
6307 "Move column to the right." 6452 "Move column to the right."
@@ -6340,15 +6485,16 @@ If TABLE-TYPE is non-nil, also chack for table.el-type tables."
6340 (beginning-of-line 2)) 6485 (beginning-of-line 2))
6341 (move-marker end nil) 6486 (move-marker end nil)
6342 (goto-line linepos) 6487 (goto-line linepos)
6343 (org-table-goto-column colpos)) 6488 (org-table-goto-column colpos)
6344 (org-table-align)) 6489 (org-table-align)
6490 (org-table-modify-formulas 'swap col (if left (1- col) (1+ col)))))
6345 6491
6346(defun org-table-move-row-down () 6492(defun org-table-move-row-down ()
6347 "Move table row down." 6493 "move table row down."
6348 (interactive) 6494 (interactive)
6349 (org-table-move-row nil)) 6495 (org-table-move-row nil))
6350(defun org-table-move-row-up () 6496(defun org-table-move-row-up ()
6351 "Move table row up." 6497 "move table row up."
6352 (interactive) 6498 (interactive)
6353 (org-table-move-row 'up)) 6499 (org-table-move-row 'up))
6354 6500
@@ -6380,13 +6526,18 @@ With prefix ARG, insert below the current line."
6380 (interactive "P") 6526 (interactive "P")
6381 (if (not (org-at-table-p)) 6527 (if (not (org-at-table-p))
6382 (error "Not at a table")) 6528 (error "Not at a table"))
6383 (let ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))) 6529 (let* ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
6530 new)
6384 (if (string-match "^[ \t]*|-" line) 6531 (if (string-match "^[ \t]*|-" line)
6385 (setq line (mapcar (lambda (x) (if (member x '(?| ?+)) ?| ?\ )) line)) 6532 (setq new (mapcar (lambda (x) (if (member x '(?| ?+)) ?| ?\ )) line))
6386 (setq line (mapcar (lambda (x) (if (equal x ?|) ?| ?\ )) line))) 6533 (setq new (mapcar (lambda (x) (if (equal x ?|) ?| ?\ )) line)))
6534 ;; Fix the first field if necessary
6535 (setq new (concat new))
6536 (if (string-match "^[ \t]*| *[#$] *|" line)
6537 (setq new (replace-match (match-string 0 line) t t new)))
6387 (beginning-of-line (if arg 2 1)) 6538 (beginning-of-line (if arg 2 1))
6388 (let (org-table-may-need-update) 6539 (let (org-table-may-need-update)
6389 (apply 'insert-before-markers line) 6540 (insert-before-markers new)
6390 (insert-before-markers "\n")) 6541 (insert-before-markers "\n"))
6391 (beginning-of-line 0) 6542 (beginning-of-line 0)
6392 (re-search-forward "| ?" (point-at-eol) t) 6543 (re-search-forward "| ?" (point-at-eol) t)
@@ -6431,26 +6582,23 @@ With prefix ARG, insert above the current line."
6431 (move-to-column col))) 6582 (move-to-column col)))
6432 6583
6433 6584
6434(defun org-table-cut-region () 6585(defun org-table-cut-region (beg end)
6435 "Copy region in table to the clipboard and blank all relevant fields." 6586 "Copy region in table to the clipboard and blank all relevant fields."
6436 (interactive) 6587 (interactive "r")
6437 (org-table-copy-region 'cut)) 6588 (org-table-copy-region beg end 'cut))
6438 6589
6439(defun org-table-copy-region (&optional cut) 6590(defun org-table-copy-region (beg end &optional cut)
6440 "Copy rectangular region in table to clipboard. 6591 "Copy rectangular region in table to clipboard.
6441A special clipboard is used which can only be accessed 6592A special clipboard is used which can only be accessed
6442with `org-table-paste-rectangle'" 6593with `org-table-paste-rectangle'"
6443 (interactive "P") 6594 (interactive "rP")
6444 (unless (org-region-active-p) (error "No active region")) 6595 (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2
6445 (let* ((beg (region-beginning))
6446 (end (region-end))
6447 l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2
6448 region cols 6596 region cols
6449 (rpl (if cut " " nil))) 6597 (rpl (if cut " " nil)))
6450 (goto-char beg) 6598 (goto-char beg)
6451 (org-table-check-inside-data-field) 6599 (org-table-check-inside-data-field)
6452 (setq l01 (count-lines (point-min) (point)) 6600 (setq l01 (count-lines (point-min) (point))
6453 c01 (org-table-current-column)) 6601 c01 (org-table-current-column))
6454 (goto-char end) 6602 (goto-char end)
6455 (org-table-check-inside-data-field) 6603 (org-table-check-inside-data-field)
6456 (setq l02 (count-lines (point-min) (point)) 6604 (setq l02 (count-lines (point-min) (point))
@@ -6470,8 +6618,9 @@ with `org-table-paste-rectangle'"
6470 (push (nreverse cols) region) 6618 (push (nreverse cols) region)
6471 (setq l1 (1+ l1))))) 6619 (setq l1 (1+ l1)))))
6472 (setq org-table-clip (nreverse region)) 6620 (setq org-table-clip (nreverse region))
6473 (if cut (org-table-align)))) 6621 (if cut (org-table-align))
6474 6622 org-table-clip))
6623
6475(defun org-table-paste-rectangle () 6624(defun org-table-paste-rectangle ()
6476 "Paste a rectangular region into a table. 6625 "Paste a rectangular region into a table.
6477The upper right corner ends up in the current field. All involved fields 6626The 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."
6574 ;; There is a region: fill as a paragraph 6723 ;; There is a region: fill as a paragraph
6575 (let ((beg (region-beginning)) 6724 (let ((beg (region-beginning))
6576 nlines) 6725 nlines)
6577 (org-table-cut-region) 6726 (org-table-cut-region (region-beginning) (region-end))
6578 (if (> (length (car org-table-clip)) 1) 6727 (if (> (length (car org-table-clip)) 1)
6579 (error "Region must be limited to single column")) 6728 (error "Region must be limited to single column"))
6580 (setq nlines (if arg 6729 (setq nlines (if arg
@@ -6582,7 +6731,7 @@ blank, and the content is appended to the field above."
6582 (+ (length org-table-clip) arg) 6731 (+ (length org-table-clip) arg)
6583 arg) 6732 arg)
6584 (length org-table-clip))) 6733 (length org-table-clip)))
6585 (setq org-table-clip 6734 (setq org-table-clip
6586 (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") 6735 (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ")
6587 nil nlines))) 6736 nil nlines)))
6588 (goto-char beg) 6737 (goto-char beg)
@@ -6611,7 +6760,8 @@ blank, and the content is appended to the field above."
6611(defun org-trim (s) 6760(defun org-trim (s)
6612 "Remove whitespace at beginning and end of string." 6761 "Remove whitespace at beginning and end of string."
6613 (if (string-match "^[ \t]+" s) (setq s (replace-match "" t t s))) 6762 (if (string-match "^[ \t]+" s) (setq s (replace-match "" t t s)))
6614 (if (string-match "[ \t]+$" s) (setq s (replace-match "" t t s)))) 6763 (if (string-match "[ \t]+$" s) (setq s (replace-match "" t t s)))
6764 s)
6615 6765
6616(defun org-wrap (string &optional width lines) 6766(defun org-wrap (string &optional width lines)
6617 "Wrap string to either a number of lines, or a width in characters. 6767 "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."
6637 (setq ll (org-do-wrap words w))) 6787 (setq ll (org-do-wrap words w)))
6638 ll)) 6788 ll))
6639 (t (error "Cannot wrap this"))))) 6789 (t (error "Cannot wrap this")))))
6640 6790
6641 6791
6642(defun org-do-wrap (words width) 6792(defun org-do-wrap (words width)
6643 "Create lines of maximum width WIDTH (in characters) from word list WORDS." 6793 "Create lines of maximum width WIDTH (in characters) from word list WORDS."
@@ -6734,7 +6884,7 @@ visible when ARG is not positive"
6734 (save-excursion (funcall function))) 6884 (save-excursion (funcall function)))
6735 (re-search-forward org-table-any-border-regexp nil 1))))) 6885 (re-search-forward org-table-any-border-regexp nil 1)))))
6736 6886
6737(defun org-table-sum () 6887(defun org-table-sum (&optional beg end nlast)
6738 "Sum numbers in region of current table column. 6888 "Sum numbers in region of current table column.
6739The result will be displayed in the echo area, and will be available 6889The result will be displayed in the echo area, and will be available
6740as kill to be inserted with \\[yank]. 6890as kill to be inserted with \\[yank].
@@ -6746,35 +6896,38 @@ column.
6746 6896
6747If at least one number looks like a time HH:MM or HH:MM:SS, all other 6897If at least one number looks like a time HH:MM or HH:MM:SS, all other
6748numbers are assumed to be times as well (in decimal hours) and the 6898numbers are assumed to be times as well (in decimal hours) and the
6749numbers are added as such." 6899numbers are added as such.
6900
6901If NLAST is a number, only the NLAST fields will actually be summed."
6750 (interactive) 6902 (interactive)
6751 (save-excursion 6903 (save-excursion
6752 (let (beg end col (timecnt 0) diff h m s) 6904 (let (col (timecnt 0) diff h m s org-table-clip)
6753 (if (org-region-active-p) 6905 (cond
6754 (setq beg (region-beginning) end (region-end)) 6906 ((and beg end)) ; beg and end given explicitly
6907 ((org-region-active-p)
6908 (setq beg (region-beginning) end (region-end)))
6909 (t
6755 (setq col (org-table-current-column)) 6910 (setq col (org-table-current-column))
6756 (goto-char (org-table-begin)) 6911 (goto-char (org-table-begin))
6757 (unless (re-search-forward "^[ \t]*|[^-]" nil t) 6912 (unless (re-search-forward "^[ \t]*|[^-]" nil t)
6758 (error "No table data")) 6913 (error "No table data"))
6759 (org-table-goto-column col) 6914 (org-table-goto-column col)
6760 (skip-chars-backward "^|") 6915;not needed? (skip-chars-backward "^|")
6761 (setq beg (point)) 6916 (setq beg (point))
6762 (goto-char (org-table-end)) 6917 (goto-char (org-table-end))
6763 (unless (re-search-backward "^[ \t]*|[^-]" nil t) 6918 (unless (re-search-backward "^[ \t]*|[^-]" nil t)
6764 (error "No table data")) 6919 (error "No table data"))
6765 (org-table-goto-column col) 6920 (org-table-goto-column col)
6766 (skip-chars-forward "^|") 6921;not needed? (skip-chars-forward "^|")
6767 (setq end (point))) 6922 (setq end (point))))
6768 (let* ((l1 (progn (goto-char beg) 6923 (let* ((items (apply 'append (org-table-copy-region beg end)))
6769 (+ (if (bolp) 1 0) (count-lines (point-min) (point))))) 6924 (items1 (cond ((not nlast) items)
6770 (l2 (progn (goto-char end) 6925 ((>= nlast (length items)) items)
6771 (+ (if (bolp) 1 0) (count-lines (point-min) (point))))) 6926 (t (setq items (reverse items))
6772 (items (if (= l1 l2) 6927 (setcdr (nthcdr (1- nlast) items) nil)
6773 (split-string (buffer-substring beg end)) 6928 (nreverse items))))
6774 (split-string
6775 (mapconcat 'identity (extract-rectangle beg end) " "))))
6776 (numbers (delq nil (mapcar 'org-table-get-number-for-summing 6929 (numbers (delq nil (mapcar 'org-table-get-number-for-summing
6777 items))) 6930 items1)))
6778 (res (apply '+ numbers)) 6931 (res (apply '+ numbers))
6779 (sres (if (= timecnt 0) 6932 (sres (if (= timecnt 0)
6780 (format "%g" res) 6933 (format "%g" res)
@@ -6784,9 +6937,11 @@ numbers are added as such."
6784 s diff) 6937 s diff)
6785 (format "%d:%02d:%02d" h m s)))) 6938 (format "%d:%02d:%02d" h m s))))
6786 (kill-new sres) 6939 (kill-new sres)
6787 (message (substitute-command-keys 6940 (if (interactive-p)
6788 (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)" 6941 (message (substitute-command-keys
6789 (length numbers) sres))))))) 6942 (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)"
6943 (length numbers) sres))))
6944 sres))))
6790 6945
6791(defun org-table-get-number-for-summing (s) 6946(defun org-table-get-number-for-summing (s)
6792 (let (n) 6947 (let (n)
@@ -6808,15 +6963,136 @@ numbers are added as such."
6808 ((equal n 0) nil) 6963 ((equal n 0) nil)
6809 (t n)))) 6964 (t n))))
6810 6965
6811(defvar org-table-current-formula nil)
6812(defvar org-table-formula-history nil) 6966(defvar org-table-formula-history nil)
6813(defun org-table-get-formula (current) 6967
6814 (if (and current (not (equal "" org-table-current-formula))) 6968(defun org-table-get-formula (&optional equation)
6815 org-table-current-formula 6969 "Read a formula from the minibuffer, offer stored formula as default."
6816 (setq org-table-current-formula 6970 (let* ((col (org-table-current-column))
6817 (read-string 6971 (stored-list (org-table-get-stored-formulas))
6818 "Formula [last]: " "" 'org-table-formula-history 6972 (stored (cdr (assoc col stored-list)))
6819 org-table-current-formula)))) 6973 (eq (cond
6974 ((and stored equation (string-match "^ *= *$" equation))
6975 stored)
6976 ((stringp equation)
6977 equation)
6978 (t (read-string
6979 "Formula: " (or stored "") 'org-table-formula-history
6980 stored)))))
6981 (if (not (string-match "\\S-" eq))
6982 (error "Empty formula"))
6983 (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq)))
6984 (if (string-match " *$" eq) (setq eq (replace-match "" t t eq)))
6985 (if stored
6986 (setcdr (assoc col stored-list) eq)
6987 (setq stored-list (cons (cons col eq) stored-list)))
6988 (if (not (equal stored eq))
6989 (org-table-store-formulas stored-list))
6990 eq))
6991
6992(defun org-table-store-formulas (alist)
6993 "Store the list of formulas below the current table."
6994 (setq alist (sort alist (lambda (a b) (< (car a) (car b)))))
6995 (save-excursion
6996 (goto-char (org-table-end))
6997 (if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:.*\n?")
6998 (delete-region (point) (match-end 0)))
6999 (insert "#+TBLFM: "
7000 (mapconcat (lambda (x)
7001 (concat "$" (int-to-string (car x)) "=" (cdr x)))
7002 alist "::")
7003 "\n")))
7004
7005(defun org-table-get-stored-formulas ()
7006 "Return an alist withh the t=stored formulas directly after current table."
7007 (interactive)
7008 (let (col eq eq-alist strings string)
7009 (save-excursion
7010 (goto-char (org-table-end))
7011 (when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)")
7012 (setq strings (org-split-string (match-string 2) " *:: *"))
7013 (while (setq string (pop strings))
7014 (if (string-match "\\$\\([0-9]+\\) *= *\\(.*[^ \t]\\)" string)
7015 (setq col (string-to-number (match-string 1 string))
7016 eq (match-string 2 string)
7017 eq-alist (cons (cons col eq) eq-alist))))))
7018 eq-alist))
7019
7020(defun org-table-modify-formulas (action &rest columns)
7021 "Modify the formulas stored below the current table.
7022ACTION can be `remove', `insert', `swap'. For `swap', two column numbers are
7023expected, for the other action only a single column number is needed."
7024 (let ((list (org-table-get-stored-formulas))
7025 (nmax (length (org-split-string (buffer-substring (point-at-bol) (point-at-eol))
7026 "|")))
7027 col col1 col2)
7028 (cond
7029 ((null list)) ; No action needed if there are no stored formulas
7030 ((eq action 'remove)
7031 (setq col (car columns))
7032 (org-table-replace-in-formulas list col "INVALID")
7033 (if (assoc col list) (setq list (delq (assoc col list) list)))
7034 (loop for i from (1+ col) upto nmax by 1 do
7035 (org-table-replace-in-formulas list i (1- i))
7036 (if (assoc i list) (setcar (assoc i list) (1- i)))))
7037 ((eq action 'insert)
7038 (setq col (car columns))
7039 (loop for i from nmax downto col by 1 do
7040 (org-table-replace-in-formulas list i (1+ i))
7041 (if (assoc i list) (setcar (assoc i list) (1+ i)))))
7042 ((eq action 'swap)
7043 (setq col1 (car columns) col2 (nth 1 columns))
7044 (org-table-replace-in-formulas list col1 "Z")
7045 (org-table-replace-in-formulas list col2 col1)
7046 (org-table-replace-in-formulas list "Z" col2)
7047 (if (assoc col1 list) (setcar (assoc col1 list) "Z"))
7048 (if (assoc col2 list) (setcar (assoc col2 list) col1))
7049 (if (assoc "Z" list) (setcar (assoc "Z" list) col2)))
7050 (t (error "Invalid action in `org-table-modify-formulas'")))
7051 (if list (org-table-store-formulas list))))
7052
7053(defun org-table-replace-in-formulas (list s1 s2)
7054 (let (elt re s)
7055 (setq s1 (concat "$" (if (integerp s1) (int-to-string s1) s1))
7056 s2 (concat "$" (if (integerp s2) (int-to-string s2) s2))
7057 re (concat (regexp-quote s1) "\\>"))
7058 (while (setq elt (pop list))
7059 (setq s (cdr elt))
7060 (while (string-match re s)
7061 (setq s (replace-match s2 t t s)))
7062 (setcdr elt s))))
7063
7064(defvar org-table-column-names nil
7065 "Alist with column names, derived from the `!' line.")
7066(defvar org-table-column-name-regexp nil
7067 "Regular expression matching the current column names.")
7068(defvar org-table-local-parameters nil
7069 "Alist with parameter names, derived from the `$' line.")
7070
7071(defun org-table-get-specials ()
7072 "Get the column nmaes and local parameters for this table."
7073 (save-excursion
7074 (let ((beg (org-table-begin)) (end (org-table-end))
7075 names name fields field cnt)
7076 (setq org-table-column-names nil
7077 org-table-local-parameters nil)
7078 (goto-char beg)
7079 (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)
7080 (setq names (org-split-string (match-string 1) " *| *")
7081 cnt 1)
7082 (while (setq name (pop names))
7083 (setq cnt (1+ cnt))
7084 (if (string-match "^[a-zA-Z][a-zA-Z0-9]*$" name)
7085 (push (cons name (int-to-string cnt)) org-table-column-names))))
7086 (setq org-table-column-names (nreverse org-table-column-names))
7087 (setq org-table-column-name-regexp
7088 (concat "\\$\\(" (mapconcat 'car org-table-column-names "\\|") "\\)\\>"))
7089 (goto-char beg)
7090 (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t)
7091 (setq fields (org-split-string (match-string 1) " *| *"))
7092 (while (setq field (pop fields))
7093 (if (string-match "^\\([a-zA-Z][a-zA-Z0-9]*\\) *= *\\(.*\\)" field)
7094 (push (cons (match-string 1 field) (match-string 2 field))
7095 org-table-local-parameters)))))))
6820 7096
6821(defun org-this-word () 7097(defun org-this-word ()
6822 ;; Get the current word 7098 ;; Get the current word
@@ -6825,24 +7101,157 @@ numbers are added as such."
6825 (end (progn (skip-chars-forward "^ \t\n") (point)))) 7101 (end (progn (skip-chars-forward "^ \t\n") (point))))
6826 (buffer-substring-no-properties beg end)))) 7102 (buffer-substring-no-properties beg end))))
6827 7103
6828(defun org-table-eval-formula (&optional ndown) 7104(defun org-table-maybe-eval-formula ()
7105 "Check if the current field starts with \"=\" and evaluate the formula."
7106 ;; We already know we are in a table. Get field will only return a formula
7107 ;; when appropriate. It might return a separator line, but no problem.
7108 (when org-table-formula-evaluate-inline
7109 (let* ((field (org-trim (or (org-table-get-field) "")))
7110 (dfield (downcase field))
7111 col bolpos nlast)
7112 (when (equal (string-to-char field) ?=)
7113 (if (string-match "^\\(=sum[vh]?\\)\\([0-9]+\\)$" dfield)
7114 (setq nlast (1+ (string-to-number (match-string 2 dfield)))
7115 dfield (match-string 1 dfield)))
7116 (cond
7117 ((equal dfield "=sumh")
7118 (org-table-get-field
7119 nil (org-table-sum
7120 (save-excursion (org-table-goto-column 1) (point))
7121 (point) nlast)))
7122 ((member dfield '("=sum" "=sumv"))
7123 (setq col (org-table-current-column)
7124 bolpos (point-at-bol))
7125 (org-table-get-field
7126 nil (org-table-sum
7127 (save-excursion
7128 (goto-char (org-table-begin))
7129 (if (re-search-forward org-table-dataline-regexp bolpos t)
7130 (progn
7131 (goto-char (match-beginning 0))
7132 (org-table-goto-column col)
7133 (point))
7134 (error "No datalines above current")))
7135 (point) nlast)))
7136 ((and (string-match "^ *=" field)
7137 (fboundp 'calc-eval))
7138 (org-table-eval-formula nil field)))))))
7139
7140(defvar org-last-recalc-undo-list nil)
7141(defcustom org-table-allow-line-recalculation t
7142 "FIXME:"
7143 :group 'org-table
7144 :type 'boolean)
7145
7146(defvar org-recalc-commands nil
7147 "List of commands triggering the reccalculation of a line.
7148Will be filled automatically during use.")
7149
7150(defvar org-recalc-marks
7151 '((" " . "Unmarked: no special line, no automatic recalculation")
7152 ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line")
7153 ("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'")
7154 ("!" . "Column name definition line. Reference in formula as $name.")
7155 ("$" . "Parameter definition line name=value. Reference in formula as $name.")))
7156
7157(defun org-table-rotate-recalc-marks (&optional newchar)
7158 "Rotate the recalculation mark in the first column.
7159If in any row, the first field is not consistent with a mark,
7160insert a new column for the makers.
7161When there is an active region, change all the lines in the region,
7162after prompting for the marking character.
7163After each change, a message will be displayed indication the meaning
7164of the new mark."
7165 (interactive)
7166 (unless (org-at-table-p) (error "Not at a table"))
7167 (let* ((marks (append (mapcar 'car org-recalc-marks) '(" ")))
7168 (beg (org-table-begin))
7169 (end (org-table-end))
7170 (l (org-current-line))
7171 (l1 (if (org-region-active-p) (org-current-line (region-beginning))))
7172 (l2 (if (org-region-active-p) (org-current-line (region-end))))
7173 (have-col
7174 (save-excursion
7175 (goto-char beg)
7176 (not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*| \t][^|]*|" end t))))
7177 (col (org-table-current-column))
7178 (forcenew (car (assoc newchar org-recalc-marks)))
7179 epos new)
7180 (if l1 (setq newchar (char-to-string (read-char-exclusive "Change region to what mark? Type # * ! $ or SPC: "))
7181 forcenew (car (assoc newchar org-recalc-marks))))
7182 (if (and newchar (not forcenew))
7183 (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'"
7184 newchar))
7185 (if l1 (goto-line l1))
7186 (save-excursion
7187 (beginning-of-line 1)
7188 (unless (looking-at org-table-dataline-regexp)
7189 (error "Not at a table data line")))
7190 (unless have-col
7191 (org-table-goto-column 1)
7192 (org-table-insert-column)
7193 (org-table-goto-column (1+ col)))
7194 (setq epos (point-at-eol))
7195 (save-excursion
7196 (beginning-of-line 1)
7197 (org-table-get-field
7198 1 (if (looking-at "^[ \t]*| *\\([#!$* ]\\) *|")
7199 (concat " "
7200 (setq new (or forcenew
7201 (cadr (member (match-string 1) marks))))
7202 " ")
7203 " # ")))
7204 (if (and l1 l2)
7205 (progn
7206 (goto-line l1)
7207 (while (progn (beginning-of-line 2) (not (= (org-current-line) l2)))
7208 (and (looking-at org-table-dataline-regexp)
7209 (org-table-get-field 1 (concat " " new " "))))
7210 (goto-line l1)))
7211 (if (not (= epos (point-at-eol))) (org-table-align))
7212 (goto-line l)
7213 (and (interactive-p) (message (cdr (assoc new org-recalc-marks))))))
7214
7215(defun org-table-maybe-recalculate-line ()
7216 "Recompute the current line if marked for it, and if we haven't just done it."
7217 (interactive)
7218 (and org-table-allow-line-recalculation
7219 (not (and (memq last-command org-recalc-commands)
7220 (equal org-last-recalc-line (org-current-line))))
7221 (save-excursion (beginning-of-line 1)
7222 (looking-at org-table-auto-recalculate-regexp))
7223 (fboundp 'calc-eval)
7224 (org-table-recalculate) t))
7225
7226(defvar org-table-formula-debug nil
7227 "Non-nil means, debug table formulas.
7228When nil, simply write \"#ERROR\" in corrupted fields.")
7229
7230(defvar modes)
7231(defsubst org-set-calc-mode (var value)
7232 (setcar (or (cdr (memq var modes)) (cons nil nil)) value))
7233
7234(defun org-table-eval-formula (&optional ndown equation
7235 suppress-align suppress-const
7236 suppress-store)
6829 "Replace the table field value at the cursor by the result of a calculation. 7237 "Replace the table field value at the cursor by the result of a calculation.
6830 7238
6831This function makes use of Dave Gillespie's calc package, arguably the most 7239This function makes use of Dave Gillespie's calc package, in my view the
6832exciting program ever written for GNU Emacs. So you need to have calc 7240most exciting program ever written for GNU Emacs. So you need to have calc
6833installed in order to use this function. 7241installed in order to use this function.
6834 7242
6835In a table, this command replaces the value in the current field with the 7243In a table, this command replaces the value in the current field with the
6836result of a formula. While nowhere near the computation options of a 7244result of a formula. While nowhere near the computation options of a
6837spreadsheet program, this is still very useful. Note that there is no 7245spreadsheet program, this is still very useful. There is no automatic
6838automatic updating of a calculated field, nor will the field remember the 7246updating of a calculated field, but the table will remember the last
6839formula. The command needs to be applied again after changing input 7247formula for each column. The command needs to be applied again after
6840fields. 7248changing input fields.
6841 7249
6842When called, the command first prompts for a formula, which is read in the 7250When called, the command first prompts for a formula, which is read in the
6843minibuffer. Previously entered formulae are available through the history 7251minibuffer. Previously entered formulas are available through the history
6844list, and the last used formula is the default, reachable by simply 7252list, and the last used formula for each column is offered as a default.
6845pressing RET. 7253These stored formulas are adapted correctly when moving, inserting, or
7254deleting columns with the corresponding commands.
6846 7255
6847The formula can be any algebraic expression understood by the calc package. 7256The formula can be any algebraic expression understood by the calc package.
6848Before evaluation, variable substitution takes place: \"$\" is replaced by 7257Before evaluation, variable substitution takes place: \"$\" is replaced by
@@ -6852,7 +7261,7 @@ here, so the command supports only horizontal computing. The formula can
6852contain an optional printf format specifier after a semicolon, to reformat 7261contain an optional printf format specifier after a semicolon, to reformat
6853the result. 7262the result.
6854 7263
6855A few examples for formulae: 7264A few examples for formulas:
6856 $1+$2 Sum of first and second field 7265 $1+$2 Sum of first and second field
6857 $1+$2;%.2f Same, and format result to two digits after dec.point 7266 $1+$2;%.2f Same, and format result to two digits after dec.point
6858 exp($2)+exp($1) Math functions can be used 7267 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
6864horizontal line or the end of the table. When the command is called with a 7273horizontal line or the end of the table. When the command is called with a
6865numeric prefix argument (like M-3 or C-7 or \\[universal-argument] 24), the formula is applied 7274numeric prefix argument (like M-3 or C-7 or \\[universal-argument] 24), the formula is applied
6866to the current row, and to the following n-1 rows (but not beyond a 7275to the current row, and to the following n-1 rows (but not beyond a
6867separator line)." 7276separator line).
7277
7278This function can also be called from Lisp programs and offers two additional
7279Arguments: EQUATION can be the formula to apply. If this argument is given,
7280the user will not be prompted. SUPPRESS-ALIGN is used to speed-up
7281recursive calls by by-passing unnecessary aligns. SUPPRESS-CONST suppresses
7282the interpretation of constants in the formula. SUPPRESS-STORE means the
7283formula should not be stored, either because it is already stored, or because
7284it is a modified equation that should not overwrite the stored one."
6868 (interactive "P") 7285 (interactive "P")
6869 (setq ndown (if (equal ndown '(4)) 10000 (prefix-numeric-value ndown))) 7286 (setq ndown (if (equal ndown '(4)) 10000 (prefix-numeric-value ndown)))
6870 (require 'calc) 7287 (require 'calc)
6871 (org-table-check-inside-data-field) 7288 (org-table-check-inside-data-field)
7289 (org-table-get-specials)
6872 (let* (fields 7290 (let* (fields
6873 (org-table-automatic-realign nil) 7291 (org-table-automatic-realign nil)
7292 (case-fold-search nil)
6874 (down (> ndown 1)) 7293 (down (> ndown 1))
6875 (formula (org-table-get-formula nil)) 7294 (formula (if (and equation suppress-store)
7295 equation
7296 (org-table-get-formula equation)))
6876 (n0 (org-table-current-column)) 7297 (n0 (org-table-current-column))
6877 n form fmt x ev) 7298 (modes (copy-sequence org-calc-default-modes))
7299 n form fmt x ev orig c)
7300 ;; Parse the format
6878 (if (string-match ";" formula) 7301 (if (string-match ";" formula)
6879 (let ((tmp (org-split-string formula ";"))) 7302 (let ((tmp (org-split-string formula ";")))
6880 (setq formula (car tmp) fmt (nth 1 tmp)))) 7303 (setq formula (car tmp) fmt (or (nth 1 tmp) ""))
7304 (while (string-match "[pnfse]\\(-?[0-9]+\\)" fmt)
7305 (setq c (string-to-char (match-string 1 fmt))
7306 n (string-to-number (or (match-string 1 fmt) "")))
7307 (if (= c ?p) (org-set-calc-mode 'calc-internal-prec n)
7308 (org-set-calc-mode 'calc-float-format
7309 (list (cdr (assoc c '((?n. float) (?f. fix)
7310 (?s. sci) (?e. eng))))
7311 n)))
7312 (setq fmt (replace-match "" t t fmt)))
7313 (when (string-match "[DR]" fmt)
7314 (org-set-calc-mode 'calc-angle-mode
7315 (if (equal (match-string 0 fmt) "D")
7316 'deg 'rad))
7317 (setq fmt (replace-match "" t t fmt)))
7318 (when (string-match "F" fmt)
7319 (org-set-calc-mode 'calc-prefer-frac t)
7320 (setq fmt (replace-match "" t t fmt)))
7321 (when (string-match "S" fmt)
7322 (org-set-calc-mode 'calc-symbolic-mode t)
7323 (setq fmt (replace-match "" t t fmt)))
7324 (unless (string-match "\\S-" fmt)
7325 (setq fmt nil))))
7326 (if (and (not suppress-const) org-table-formula-use-constants)
7327 (setq formula (org-table-formula-substitute-names formula)))
7328 (setq orig (or (get-text-property 1 :orig-formula formula) "?"))
6881 (while (> ndown 0) 7329 (while (> ndown 0)
6882 (setq fields (org-split-string 7330 (setq fields (org-split-string
6883 (concat " " (buffer-substring 7331 (buffer-substring
6884 (point-at-bol) (point-at-eol))) "|")) 7332 (point-at-bol) (point-at-eol)) " *| *"))
7333 (if org-table-formula-numbers-only
7334 (setq fields (mapcar
7335 (lambda (x) (number-to-string (string-to-number x)))
7336 fields)))
6885 (setq ndown (1- ndown)) 7337 (setq ndown (1- ndown))
6886 (setq form (copy-sequence formula)) 7338 (setq form (copy-sequence formula))
6887 (while (string-match "\\$\\([0-9]+\\)?" form) 7339 (while (string-match "\\$\\([0-9]+\\)?" form)
6888 (setq n (if (match-beginning 1) 7340 (setq n (if (match-beginning 1)
6889 (string-to-int (match-string 1 form)) 7341 (string-to-int (match-string 1 form))
6890 n0) 7342 n0)
6891 x (nth n fields)) 7343 x (nth (1- n) fields))
6892 (unless x (error "Invalid field specifier \"%s\"" 7344 (unless x (error "Invalid field specifier \"%s\""
6893 (match-string 0 form))) 7345 (match-string 0 form)))
6894 (if (equal (string-to-number x) 0) (setq x "0")) 7346 (if (equal x "") (setq x "0"))
6895 (setq form (replace-match x t t form))) 7347 (setq form (replace-match (concat "(" x ")") t t form)))
6896 (setq ev (calc-eval (list form) 'num)) 7348 (setq ev (calc-eval (cons form modes)
7349 (if org-table-formula-numbers-only 'num)))
7350
7351 (when org-table-formula-debug
7352 (with-output-to-temp-buffer "*Help*"
7353 (princ (format "Substitution history of formula
7354Orig: %s
7355$xyz-> %s
7356$1-> %s\n" orig formula form))
7357 (if (listp ev)
7358 (princ (format " %s^\nError: %s"
7359 (make-string (car ev) ?\-) (nth 1 ev)))
7360 (princ (format "Result: %s" ev))))
7361 (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*"))
7362 (unless (and (interactive-p) (not ndown))
7363 (unless (let (inhibit-redisplay)
7364 (y-or-n-p "Debugging Formula. Continue to next? "))
7365 (org-table-align)
7366 (error "Abort"))
7367 (delete-window (get-buffer-window "*Help*"))
7368 (message "")))
6897 (if (listp ev) 7369 (if (listp ev)
6898 (error "Invalid expression: %s (%s at %d)" form (nth 1 ev) (car ev))) 7370 (setq fmt nil ev "#ERROR"))
6899 (org-table-blank-field) 7371 (org-table-blank-field)
6900 (if fmt 7372 (if fmt
6901 (insert (format fmt (string-to-number ev))) 7373 (insert (format fmt (string-to-number ev)))
@@ -6903,7 +7375,96 @@ separator line)."
6903 (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]")) 7375 (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]"))
6904 (call-interactively 'org-return) 7376 (call-interactively 'org-return)
6905 (setq ndown 0))) 7377 (setq ndown 0)))
6906 (org-table-align))) 7378 (or suppress-align (org-table-align))))
7379
7380(defun org-table-recalculate (&optional all noalign)
7381 "Recalculate the current table line by applying all stored formulas."
7382 (interactive "P")
7383 (or (memq this-command org-recalc-commands)
7384 (setq org-recalc-commands (cons this-command org-recalc-commands)))
7385 (unless (org-at-table-p) (error "Not at a table"))
7386 (org-table-get-specials)
7387 (let* ((eqlist (sort (org-table-get-stored-formulas)
7388 (lambda (a b) (< (car a) (car b)))))
7389 (inhibit-redisplay t)
7390 (line-re org-table-dataline-regexp)
7391 (thisline (+ (if (bolp) 1 0) (count-lines (point-min) (point))))
7392 (thiscol (org-table-current-column))
7393 beg end entry eql (cnt 0))
7394 ;; Insert constants in all formulas
7395 (setq eqlist
7396 (mapcar (lambda (x)
7397 (setcdr x (org-table-formula-substitute-names (cdr x)))
7398 x)
7399 eqlist))
7400 (if all
7401 (progn
7402 (setq end (move-marker (make-marker) (1+ (org-table-end))))
7403 (goto-char (setq beg (org-table-begin)))
7404 (if (re-search-forward org-table-recalculate-regexp end t)
7405 (setq line-re org-table-recalculate-regexp)
7406 (if (and (re-search-forward org-table-dataline-regexp end t)
7407 (re-search-forward org-table-hline-regexp end t)
7408 (re-search-forward org-table-dataline-regexp end t))
7409 (setq beg (match-beginning 0))
7410 nil))) ;; just leave beg where it is
7411 (setq beg (point-at-bol)
7412 end (move-marker (make-marker) (1+ (point-at-eol)))))
7413 (goto-char beg)
7414 (and all (message "Re-applying formulas to full table..."))
7415 (while (re-search-forward line-re end t)
7416 (unless (string-match "^ *[!$] *$" (org-table-get-field 1))
7417 ;; Unprotected line, recalculate
7418 (and all (message "Re-applying formulas to full table...(line %d)"
7419 (setq cnt (1+ cnt))))
7420 (setq org-last-recalc-line (org-current-line))
7421 (setq eql eqlist)
7422 (while (setq entry (pop eql))
7423 (goto-line org-last-recalc-line)
7424 (org-table-goto-column (car entry) nil 'force)
7425 (org-table-eval-formula nil (cdr entry) 'noalign 'nocst 'nostore))))
7426 (goto-line thisline)
7427 (org-table-goto-column thiscol)
7428 (or noalign (org-table-align)
7429 (and all (message "Re-applying formulas to %d lines...done" cnt)))))
7430
7431(defun org-table-formula-substitute-names (f)
7432 "Replace $const with values in stirng F."
7433 (let ((start 0) a n1 n2 nn1 nn2 s (f1 f))
7434 ;; First, check for column names
7435 (while (setq start (string-match org-table-column-name-regexp f start))
7436 (setq start (1+ start))
7437 (setq a (assoc (match-string 1 f) org-table-column-names))
7438 (setq f (replace-match (concat "$" (cdr a)) t t f)))
7439 ;; Expand ranges to vectors
7440 (while (string-match "\\$\\([0-9]+\\)\\.\\.\\.?\\$\\([0-9]+\\)" f)
7441 (setq n1 (string-to-number (match-string 1 f))
7442 n2 (string-to-number (match-string 2 f))
7443 nn1 (1+ (min n1 n2)) nn2 (max n1 n2)
7444 s (concat "[($" (number-to-string (1- nn1)) ")"))
7445 (loop for i from nn1 upto nn2 do
7446 (setq s (concat s ",($" (int-to-string i) ")")))
7447 (setq s (concat s "]"))
7448 (if (< n2 n1) (setq s (concat "rev(" s ")")))
7449 (setq f (replace-match s t t f)))
7450 ;; Parameters and constants
7451 (setq start 0)
7452 (while (setq start (string-match "\\$\\([a-zA-Z][a-zA-Z0-9]*\\)" f start))
7453 (setq start (1+ start))
7454 (if (setq a (save-match-data
7455 (org-table-get-constant (match-string 1 f))))
7456 (setq f (replace-match (concat "(" a ")") t t f))))
7457 (if org-table-formula-debug
7458 (put-text-property 0 (length f) :orig-formula f1 f))
7459 f))
7460
7461(defun org-table-get-constant (const)
7462 "Find the value for a parameter or constant in a formula.
7463Parameters get priority."
7464 (or (cdr (assoc const org-table-local-parameters))
7465 (cdr (assoc const org-table-formula-constants))
7466 (and (fboundp 'constants-get) (constants-get const))
7467 "#UNDEFINED_NAME"))
6907 7468
6908;;; The orgtbl minor mode 7469;;; The orgtbl minor mode
6909 7470
@@ -6962,7 +7523,7 @@ table editor in arbitrary modes.")
6962 7523
6963;;;###autoload 7524;;;###autoload
6964(defun orgtbl-mode (&optional arg) 7525(defun orgtbl-mode (&optional arg)
6965 "The `org-mode' table editor as a minor mode for use in other modes." 7526 "The `org-mode' table editor as a minor mode for use in other modes."
6966 (interactive) 7527 (interactive)
6967 (if (eq major-mode 'org-mode) 7528 (if (eq major-mode 'org-mode)
6968 ;; Exit without error, in case some hook functions calls this 7529 ;; Exit without error, in case some hook functions calls this
@@ -6972,6 +7533,11 @@ table editor in arbitrary modes.")
6972 (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode))) 7533 (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode)))
6973 (if orgtbl-mode 7534 (if orgtbl-mode
6974 (progn 7535 (progn
7536 (and (orgtbl-setup) (defun orgtbl-setup () nil))
7537 ;; Make sure we are first in minor-mode-map-alist
7538 (let ((c (assq 'orgtbl-mode minor-mode-map-alist)))
7539 (and c (setq minor-mode-map-alist
7540 (cons c (delq c minor-mode-map-alist)))))
6975 (set (make-local-variable (quote org-table-may-need-update)) t) 7541 (set (make-local-variable (quote org-table-may-need-update)) t)
6976 (make-local-hook (quote before-change-functions)) 7542 (make-local-hook (quote before-change-functions))
6977 (add-hook 'before-change-functions 'org-before-change-function 7543 (add-hook 'before-change-functions 'org-before-change-function
@@ -6979,7 +7545,7 @@ table editor in arbitrary modes.")
6979 (set (make-local-variable 'org-old-auto-fill-inhibit-regexp) 7545 (set (make-local-variable 'org-old-auto-fill-inhibit-regexp)
6980 auto-fill-inhibit-regexp) 7546 auto-fill-inhibit-regexp)
6981 (set (make-local-variable 'auto-fill-inhibit-regexp) 7547 (set (make-local-variable 'auto-fill-inhibit-regexp)
6982 (if auto-fill-inhibit-regexp 7548 (if auto-fill-inhibit-regexp
6983 (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp) 7549 (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp)
6984 "[ \t]*|")) 7550 "[ \t]*|"))
6985 (easy-menu-add orgtbl-mode-menu) 7551 (easy-menu-add orgtbl-mode-menu)
@@ -6994,81 +7560,134 @@ table editor in arbitrary modes.")
6994(put 'orgtbl-mode :menu-tag "Org Table Mode") 7560(put 'orgtbl-mode :menu-tag "Org Table Mode")
6995(add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map) 7561(add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map)
6996 7562
6997(defun orgtbl-make-binding (fun &rest keys) 7563(defun orgtbl-make-binding (fun n &rest keys)
6998 "Create a function for binding in the table minor mode." 7564 "Create a function for binding in the table minor mode.
6999 (list 'lambda '(arg) 7565FUN is the command to call inside a table. N is used to create a unique
7000 (concat "Run `" (symbol-name fun) "' or the default binding.") 7566command name. KEYS are keys that should be checked in for a command
7001 '(interactive "p") 7567to execute outside of tables."
7002 (list 'if 7568 (eval
7003 '(org-at-table-p) 7569 (list 'defun
7004 (list 'call-interactively (list 'quote fun)) 7570 (intern (concat "orgtbl-hijacker-command-" (int-to-string n)))
7005 (list 'let '(orgtbl-mode) 7571 '(arg)
7006 (list 'call-interactively 7572 (concat "In tables, run `" (symbol-name fun) "'.\n"
7007 (append '(or) 7573 "Outside of tables, run the binding of `"
7008 (mapcar (lambda (k) 7574 (mapconcat (lambda (x) (format "%s" x)) keys "' or `")
7009 (list 'key-binding k)) 7575 "'.")
7010 keys) 7576 '(interactive "p")
7011 '('orgtbl-error))))))) 7577 (list 'if
7578 '(org-at-table-p)
7579 (list 'call-interactively (list 'quote fun))
7580 (list 'let '(orgtbl-mode)
7581 (list 'call-interactively
7582 (append '(or)
7583 (mapcar (lambda (k)
7584 (list 'key-binding k))
7585 keys)
7586 '('orgtbl-error))))))))
7012 7587
7013(defun orgtbl-error () 7588(defun orgtbl-error ()
7014 "Error when there is no default binding for a table key." 7589 "Error when there is no default binding for a table key."
7015 (interactive) 7590 (interactive)
7016 (error "This key is has no function outside tables")) 7591 (error "This key is has no function outside tables"))
7017 7592
7018;; Keybindings for the minor mode 7593(defun orgtbl-setup ()
7019(let ((bindings 7594 "Setup orgtbl keymaps."
7020 (list 7595 (let ((nfunc 0)
7021 '([(meta shift left)] org-table-delete-column) 7596 (bindings
7022 '([(meta left)] org-table-move-column-left) 7597 (list
7023 '([(meta right)] org-table-move-column-right) 7598 '([(meta shift left)] org-table-delete-column)
7024 '([(meta shift right)] org-table-insert-column) 7599 '([(meta left)] org-table-move-column-left)
7025 '([(meta shift up)] org-table-kill-row) 7600 '([(meta right)] org-table-move-column-right)
7026 '([(meta shift down)] org-table-insert-row) 7601 '([(meta shift right)] org-table-insert-column)
7027 '([(meta up)] org-table-move-row-up) 7602 '([(meta shift up)] org-table-kill-row)
7028 '([(meta down)] org-table-move-row-down) 7603 '([(meta shift down)] org-table-insert-row)
7029 '("\C-c\C-w" org-table-cut-region) 7604 '([(meta up)] org-table-move-row-up)
7030 '("\C-c\M-w" org-table-copy-region) 7605 '([(meta down)] org-table-move-row-down)
7031 '("\C-c\C-y" org-table-paste-rectangle) 7606 '("\C-c\C-w" org-table-cut-region)
7032 '("\C-c-" org-table-insert-hline) 7607 '("\C-c\M-w" org-table-copy-region)
7033 '([(shift tab)] org-table-previous-field) 7608 '("\C-c\C-y" org-table-paste-rectangle)
7034 '("\C-c\C-c" org-table-align) 7609 '("\C-c-" org-table-insert-hline)
7035 '("\C-m" org-table-next-row) 7610 '([(shift tab)] org-table-previous-field)
7036 (list (org-key 'S-return) 'org-table-copy-down) 7611 '("\C-c\C-c" org-ctrl-c-ctrl-c)
7037 '([(meta return)] org-table-wrap-region) 7612 '("\C-m" org-table-next-row)
7038 '("\C-c\C-q" org-table-wrap-region) 7613 (list (org-key 'S-return) 'org-table-copy-down)
7039 '("\C-c?" org-table-current-column) 7614 '([(meta return)] org-table-wrap-region)
7040 '("\C-c " org-table-blank-field) 7615 '("\C-c\C-q" org-table-wrap-region)
7041 '("\C-c+" org-table-sum) 7616 '("\C-c?" org-table-current-column)
7042 '("\C-c|" org-table-toggle-vline-visibility) 7617 '("\C-c " org-table-blank-field)
7043 '("\C-c=" org-table-eval-formula))) 7618 '("\C-c+" org-table-sum)
7044 elt key fun cmd) 7619 '("\C-c|" org-table-toggle-vline-visibility)
7045 (while (setq elt (pop bindings)) 7620 '("\C-c=" org-table-eval-formula)
7046 (setq key (car elt) 7621 '("\C-c*" org-table-recalculate)
7047 fun (nth 1 elt) 7622 '([(control ?#)] org-table-rotate-recalc-marks)))
7048 cmd (orgtbl-make-binding fun key)) 7623 elt key fun cmd)
7049 (define-key orgtbl-mode-map key cmd))) 7624 (while (setq elt (pop bindings))
7050 7625 (setq nfunc (1+ nfunc))
7051;; Special treatment needed for TAB and RET 7626 (setq key (car elt)
7052 7627 fun (nth 1 elt)
7053(define-key orgtbl-mode-map [(return)] 7628 cmd (orgtbl-make-binding fun nfunc key))
7054 (orgtbl-make-binding 'orgtbl-ret [(return)] "\C-m")) 7629 (define-key orgtbl-mode-map key cmd))
7055(define-key orgtbl-mode-map "\C-m" 7630 ;; Special treatment needed for TAB and RET
7056 (orgtbl-make-binding 'orgtbl-ret "\C-m" [(return)])) 7631 (define-key orgtbl-mode-map [(return)]
7057(define-key orgtbl-mode-map [(tab)] 7632 (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m"))
7058 (orgtbl-make-binding 'orgtbl-tab [(tab)] "\C-i")) 7633 (define-key orgtbl-mode-map "\C-m"
7059(define-key orgtbl-mode-map "\C-i" 7634 (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)]))
7060 (orgtbl-make-binding 'orgtbl-tab "\C-i" [(tab)])) 7635 (define-key orgtbl-mode-map [(tab)]
7061 7636 (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i"))
7062(when orgtbl-optimized 7637 (define-key orgtbl-mode-map "\C-i"
7063 ;; If the user wants maximum table support, we need to hijack 7638 (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])))
7064 ;; some standard editing functions 7639 (when orgtbl-optimized
7065 (substitute-key-definition 'self-insert-command 'orgtbl-self-insert-command 7640 ;; If the user wants maximum table support, we need to hijack
7066 orgtbl-mode-map global-map) 7641 ;; some standard editing functions
7067 (substitute-key-definition 'delete-char 'orgtbl-delete-char 7642 (substitute-key-definition 'self-insert-command 'orgtbl-self-insert-command
7068 orgtbl-mode-map global-map) 7643 orgtbl-mode-map global-map)
7069 (substitute-key-definition 'delete-backward-char 'orgtbl-delete-backward-char 7644 (substitute-key-definition 'delete-char 'orgtbl-delete-char
7070 orgtbl-mode-map global-map) 7645 orgtbl-mode-map global-map)
7071 (define-key org-mode-map "|" 'self-insert-command)) 7646 (substitute-key-definition 'delete-backward-char 'orgtbl-delete-backward-char
7647 orgtbl-mode-map global-map)
7648 (define-key org-mode-map "|" 'self-insert-command))
7649 (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu"
7650 '("OrgTbl"
7651 ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"]
7652 ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"]
7653 ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"]
7654 ["Next Row" org-return :active (org-at-table-p) :keys "RET"]
7655 "--"
7656 ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"]
7657 ["Copy Field from Above"
7658 org-table-copy-down :active (org-at-table-p) :keys "S-RET"]
7659 "--"
7660 ("Column"
7661 ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"]
7662 ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"]
7663 ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"]
7664 ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"])
7665 ("Row"
7666 ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"]
7667 ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"]
7668 ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"]
7669 ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"]
7670 "--"
7671 ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"])
7672 ("Rectangle"
7673 ["Copy Rectangle" org-copy-special :active (org-at-table-p) :keys "C-c M-w"]
7674 ["Cut Rectangle" org-cut-special :active (org-at-table-p) :keys "C-c C-w"]
7675 ["Paste Rectangle" org-paste-special :active (org-at-table-p) :keys "C-c C-y"]
7676 ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p) :keys "C-c C-q"])
7677 "--"
7678 ["Eval Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
7679 ["Eval Formula Down " (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
7680 ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"]
7681 ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"]
7682 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"]
7683 ["Sum Column/Rectangle" org-table-sum
7684 :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"]
7685 ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"]
7686 ["Debug Formulas"
7687 (setq org-table-formula-debug (not org-table-formula-debug))
7688 :style toggle :selected org-table-formula-debug]
7689 ))
7690 t)
7072 7691
7073(defun orgtbl-tab () 7692(defun orgtbl-tab ()
7074 "Justification and field motion for `orgtbl-mode'." 7693 "Justification and field motion for `orgtbl-mode'."
@@ -7108,13 +7727,13 @@ reduced column width."
7108 (interactive "p") 7727 (interactive "p")
7109 (if (and (org-at-table-p) 7728 (if (and (org-at-table-p)
7110 (eq N 1) 7729 (eq N 1)
7730 (string-match "|" (buffer-substring (point-at-bol) (point)))
7111 (looking-at ".*?|")) 7731 (looking-at ".*?|"))
7112 (let ((pos (point))) 7732 (let ((pos (point)))
7113 (backward-delete-char N) 7733 (backward-delete-char N)
7114 (skip-chars-forward "^|") 7734 (skip-chars-forward "^|")
7115 (insert " ") 7735 (insert " ")
7116 (goto-char (1- pos))) 7736 (goto-char (1- pos)))
7117 (message "%s" last-input-event) (sit-for 1)
7118 (delete-backward-char N))) 7737 (delete-backward-char N)))
7119 7738
7120(defun orgtbl-delete-char (N) 7739(defun orgtbl-delete-char (N)
@@ -7125,6 +7744,8 @@ will still be marked for re-alignment, because a narrow field may lead to
7125a reduced column width." 7744a reduced column width."
7126 (interactive "p") 7745 (interactive "p")
7127 (if (and (org-at-table-p) 7746 (if (and (org-at-table-p)
7747 (not (bolp))
7748 (not (= (char-after) ?|))
7128 (eq N 1)) 7749 (eq N 1))
7129 (if (looking-at ".*?|") 7750 (if (looking-at ".*?|")
7130 (let ((pos (point))) 7751 (let ((pos (point)))
@@ -7134,41 +7755,6 @@ a reduced column width."
7134 (goto-char pos))) 7755 (goto-char pos)))
7135 (delete-char N))) 7756 (delete-char N)))
7136 7757
7137(easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu"
7138 '("Tbl"
7139 ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"]
7140 ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"]
7141 ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"]
7142 ["Next Row" org-return :active (org-at-table-p) :keys "RET"]
7143 "--"
7144 ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"]
7145 ["Copy Field from Above"
7146 org-table-copy-down :active (org-at-table-p) :keys "S-RET"]
7147 "--"
7148 ("Column"
7149 ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"]
7150 ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"]
7151 ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"]
7152 ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"])
7153 ("Row"
7154 ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"]
7155 ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"]
7156 ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"]
7157 ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"]
7158 "--"
7159 ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"])
7160 ("Rectangle"
7161 ["Copy Rectangle" org-copy-special :active (org-at-table-p) :keys "C-c M-w"]
7162 ["Cut Rectangle" org-cut-special :active (org-at-table-p) :keys "C-c C-w"]
7163 ["Paste Rectangle" org-paste-special :active (org-at-table-p) :keys "C-c C-y"]
7164 ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p) :keys "C-c C-q"])
7165 "--"
7166 ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"]
7167 ["Sum Column/Rectangle" org-table-sum
7168 :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"]
7169 ["Eval Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
7170 ))
7171
7172;;; Exporting 7758;;; Exporting
7173 7759
7174(defconst org-level-max 20) 7760(defconst org-level-max 20)
@@ -7503,7 +8089,7 @@ Entries can be like (\"ent\"), in which case \"\\ent\" will be translated to
7503In that case, \"\\ent\" will be translated to \"&other;\". 8089In that case, \"\\ent\" will be translated to \"&other;\".
7504The list contains HTML entities for Latin-1, Greek and other symbols. 8090The list contains HTML entities for Latin-1, Greek and other symbols.
7505It is supplemented by a number of commonly used TeX macros with appropriate 8091It is supplemented by a number of commonly used TeX macros with appropriate
7506translations.") 8092translations. There is currently no way for users to extend this.")
7507 8093
7508(defvar org-last-level nil) ; dynamically scoped variable 8094(defvar org-last-level nil) ; dynamically scoped variable
7509 8095
@@ -7676,7 +8262,7 @@ and all options lines."
7676 (let* ((filename (concat (file-name-sans-extension (buffer-file-name)) 8262 (let* ((filename (concat (file-name-sans-extension (buffer-file-name))
7677 ".txt")) 8263 ".txt"))
7678 (buffer (find-file-noselect filename)) 8264 (buffer (find-file-noselect filename))
7679 (ore (concat 8265 (ore (concat
7680 (org-make-options-regexp 8266 (org-make-options-regexp
7681 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" 8267 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO"
7682 "STARTUP" "ARCHIVE" 8268 "STARTUP" "ARCHIVE"
@@ -7908,7 +8494,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
7908 ;; This is a headline 8494 ;; This is a headline
7909 (progn 8495 (progn
7910 (setq level (- (match-end 1) (match-beginning 1)) 8496 (setq level (- (match-end 1) (match-beginning 1))
7911 txt (save-match-data 8497 txt (save-match-data
7912 (org-html-expand 8498 (org-html-expand
7913 (match-string 3 line))) 8499 (match-string 3 line)))
7914 todo 8500 todo
@@ -8413,10 +8999,10 @@ When LEVEL is non-nil, increase section numbers on that level."
8413 8999
8414;; - Bindings in Org-mode map are currently 9000;; - Bindings in Org-mode map are currently
8415;; 0123456789abcdefghijklmnopqrstuvwxyz!?@#$%^&-+*/=()_{}[]:;"|,.<>~`'\t the alphabet 9001;; 0123456789abcdefghijklmnopqrstuvwxyz!?@#$%^&-+*/=()_{}[]:;"|,.<>~`'\t the alphabet
8416;; abcd fgh j lmnopqrstuvwxyz ? # -+ /= [] ; |,.<> \t necessary bindings 9002;; abcd fgh j lmnopqrstuvwxyz ? #$ -+*/= [] ; |,.<>~ \t necessary bindings
8417;; e (?) useful from outline-mode 9003;; e (?) useful from outline-mode
8418;; i k @ expendable from outline-mode 9004;; i k @ expendable from outline-mode
8419;; 0123456789 ! $%^& * ()_{} " ~`' free 9005;; 0123456789 ! %^& ()_{} " `' free
8420 9006
8421(define-key org-mode-map "\C-i" 'org-cycle) 9007(define-key org-mode-map "\C-i" 'org-cycle)
8422(define-key org-mode-map [(meta tab)] 'org-complete) 9008(define-key org-mode-map [(meta tab)] 'org-complete)
@@ -8476,7 +9062,9 @@ When LEVEL is non-nil, increase section numbers on that level."
8476(define-key org-mode-map "\C-c+" 'org-table-sum) 9062(define-key org-mode-map "\C-c+" 'org-table-sum)
8477(define-key org-mode-map "\C-c|" 'org-table-toggle-vline-visibility) 9063(define-key org-mode-map "\C-c|" 'org-table-toggle-vline-visibility)
8478(define-key org-mode-map "\C-c=" 'org-table-eval-formula) 9064(define-key org-mode-map "\C-c=" 'org-table-eval-formula)
8479(define-key org-mode-map "\C-c#" 'org-table-create-with-table.el) 9065(define-key org-mode-map "\C-c*" 'org-table-recalculate)
9066(define-key org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks)
9067(define-key org-mode-map "\C-c~" 'org-table-create-with-table.el)
8480(define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region) 9068(define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region)
8481(define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii) 9069(define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii)
8482(define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii) 9070(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."
8489(define-key org-mode-map "\C-c\C-xh" 'org-export-as-html) 9077(define-key org-mode-map "\C-c\C-xh" 'org-export-as-html)
8490(define-key org-mode-map "\C-c\C-x\C-h" 'org-export-as-html-and-open) 9078(define-key org-mode-map "\C-c\C-x\C-h" 'org-export-as-html-and-open)
8491 9079
8492(defsubst org-table-p () 9080(defsubst org-table-p () (org-at-table-p))
8493 (if (and (eq major-mode 'org-mode) font-lock-mode)
8494 (eq (get-text-property (point) 'face) 'org-table)
8495 ;; (save-match-data (org-at-table-p)))) ; FIXME: OK to not use this?
8496 (org-at-table-p)))
8497
8498 9081
8499(defun org-self-insert-command (N) 9082(defun org-self-insert-command (N)
8500 "Like `self-insert-command', use overwrite-mode for whitespace in tables. 9083 "Like `self-insert-command', use overwrite-mode for whitespace in tables.
@@ -8525,7 +9108,8 @@ reduced column width."
8525 (interactive "p") 9108 (interactive "p")
8526 (if (and (org-table-p) 9109 (if (and (org-table-p)
8527 (eq N 1) 9110 (eq N 1)
8528 (looking-at ".*?|")) 9111 (string-match "|" (buffer-substring (point-at-bol) (point)))
9112 (looking-at ".*?|"))
8529 (let ((pos (point))) 9113 (let ((pos (point)))
8530 (backward-delete-char N) 9114 (backward-delete-char N)
8531 (skip-chars-forward "^|") 9115 (skip-chars-forward "^|")
@@ -8541,6 +9125,8 @@ will still be marked for re-alignment, because a narrow field may lead to
8541a reduced column width." 9125a reduced column width."
8542 (interactive "p") 9126 (interactive "p")
8543 (if (and (org-table-p) 9127 (if (and (org-table-p)
9128 (not (bolp))
9129 (not (= (char-after) ?|))
8544 (eq N 1)) 9130 (eq N 1))
8545 (if (looking-at ".*?|") 9131 (if (looking-at ".*?|")
8546 (let ((pos (point))) 9132 (let ((pos (point)))
@@ -8655,16 +9241,14 @@ a reduced column width."
8655(defun org-copy-special () 9241(defun org-copy-special ()
8656 "Call either `org-table-copy' or `org-copy-subtree'." 9242 "Call either `org-table-copy' or `org-copy-subtree'."
8657 (interactive) 9243 (interactive)
8658 (if (org-at-table-p) 9244 (call-interactively
8659 (org-table-copy-region) 9245 (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree)))
8660 (org-copy-subtree)))
8661 9246
8662(defun org-cut-special () 9247(defun org-cut-special ()
8663 "Call either `org-table-copy' or `org-cut-subtree'." 9248 "Call either `org-table-copy' or `org-cut-subtree'."
8664 (interactive) 9249 (interactive)
8665 (if (org-at-table-p) 9250 (call-interactively
8666 (org-table-cut-region) 9251 (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree)))
8667 (org-cut-subtree)))
8668 9252
8669(defun org-paste-special (arg) 9253(defun org-paste-special (arg)
8670 "Call either `org-table-paste-rectangle' or `org-paste-subtree'." 9254 "Call either `org-table-paste-rectangle' or `org-paste-subtree'."
@@ -8674,23 +9258,37 @@ a reduced column width."
8674 (org-paste-subtree arg))) 9258 (org-paste-subtree arg)))
8675 9259
8676(defun org-ctrl-c-ctrl-c (&optional arg) 9260(defun org-ctrl-c-ctrl-c (&optional arg)
8677 "Call realign table, or recognize a table.el table. 9261 "Call realign table, or recognize a table.el table, or update keywords.
8678When the cursor is inside a table created by the table.el package, 9262When the cursor is inside a table created by the table.el package,
8679activate that table. Otherwise, if the cursor is at a normal table 9263activate that table. Otherwise, if the cursor is at a normal table
8680created with org.el, re-align that table. This command works even if 9264created with org.el, re-align that table. This command works even if
8681the automatic table editor has been turned off." 9265the automatic table editor has been turned off.
9266If the cursor is in one of the special #+KEYWORD lines, this triggers
9267scanning the buffer for these lines and updating the information."
8682 (interactive "P") 9268 (interactive "P")
8683 (let ((org-enable-table-editor t)) 9269 (let ((org-enable-table-editor t))
8684 (cond 9270 (cond
8685 ((org-at-table.el-p) 9271 ((org-at-table.el-p)
8686 (require 'table) 9272 (require 'table)
8687 (beginning-of-line 1) 9273 (beginning-of-line 1)
8688 (re-search-forward "|" (save-excursion (end-of-line 2) (point))) ;FIXME: line-end-position? 9274 (re-search-forward "|" (save-excursion (end-of-line 2) (point)))
8689 (table-recognize-table)) 9275 (table-recognize-table))
8690 ((org-at-table-p) 9276 ((org-at-table-p)
9277 (org-table-maybe-eval-formula)
9278 (if arg
9279 (org-table-recalculate t)
9280 (org-table-maybe-recalculate-line))
8691 (org-table-align)) 9281 (org-table-align))
8692 ((save-excursion (beginning-of-line 1) (looking-at "#\\+[A-Z]+")) 9282 ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)"))
8693 (let ((org-inhibit-startup t)) (org-mode))) 9283 (cond
9284 ((equal (match-string 1) "TBLFM")
9285 ;; Recalculate the table before this line
9286 (save-excursion
9287 (beginning-of-line 1)
9288 (skip-chars-backward " \r\n\t")
9289 (if (org-at-table-p) (org-table-recalculate t))))
9290 (t
9291 (let ((org-inhibit-startup t)) (org-mode)))))
8694 ((org-region-active-p) 9292 ((org-region-active-p)
8695 (org-table-convert-region (region-beginning) (region-end) arg)) 9293 (org-table-convert-region (region-beginning) (region-end) arg))
8696 ((and (region-beginning) (region-end)) 9294 ((and (region-beginning) (region-end))
@@ -8718,18 +9316,59 @@ the automatic table editor has been turned off."
8718 9316
8719;;; Menu entries 9317;;; Menu entries
8720 9318
8721;; First, remove the outline menus. Org-mode does not neede these commands.
8722(if org-xemacs-p
8723 (add-hook 'org-mode-hook
8724 (lambda ()
8725 (delete-menu-item '("Headings"))
8726 (delete-menu-item '("Show"))
8727 (delete-menu-item '("Hide"))
8728 (set-menubar-dirty-flag)))
8729 (setq org-mode-map (delq (assoc 'menu-bar (cdr org-mode-map))
8730 org-mode-map)))
8731
8732;; Define the Org-mode menus 9319;; Define the Org-mode menus
9320(easy-menu-define org-tbl-menu org-mode-map "Tbl menu"
9321 '("Tbl"
9322 ["Align" org-ctrl-c-ctrl-c (org-at-table-p)]
9323 ["Next Field" org-cycle (org-at-table-p)]
9324 ["Previous Field" org-shifttab (org-at-table-p)]
9325 ["Next Row" org-return (org-at-table-p)]
9326 "--"
9327 ["Blank Field" org-table-blank-field (org-at-table-p)]
9328 ["Copy Field from Above" org-table-copy-down (org-at-table-p)]
9329 "--"
9330 ("Column"
9331 ["Move Column Left" org-metaleft (org-at-table-p)]
9332 ["Move Column Right" org-metaright (org-at-table-p)]
9333 ["Delete Column" org-shiftmetaleft (org-at-table-p)]
9334 ["Insert Column" org-shiftmetaright (org-at-table-p)])
9335 ("Row"
9336 ["Move Row Up" org-metaup (org-at-table-p)]
9337 ["Move Row Down" org-metadown (org-at-table-p)]
9338 ["Delete Row" org-shiftmetaup (org-at-table-p)]
9339 ["Insert Row" org-shiftmetadown (org-at-table-p)]
9340 "--"
9341 ["Insert Hline" org-table-insert-hline (org-at-table-p)])
9342 ("Rectangle"
9343 ["Copy Rectangle" org-copy-special (org-at-table-p)]
9344 ["Cut Rectangle" org-cut-special (org-at-table-p)]
9345 ["Paste Rectangle" org-paste-special (org-at-table-p)]
9346 ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
9347 "--"
9348 ("Calculate"
9349 ["Eval Formula" org-table-eval-formula (org-at-table-p)]
9350 ["Eval Formula Down" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
9351 ["Recalculate line" org-table-recalculate (org-at-table-p)]
9352 ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"]
9353 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)]
9354 ["Sum Column/Rectangle" org-table-sum
9355 (or (org-at-table-p) (org-region-active-p))]
9356 ["Which Column?" org-table-current-column (org-at-table-p)])
9357 ["Debug Formulas"
9358 (setq org-table-formula-debug (not org-table-formula-debug))
9359 :style toggle :selected org-table-formula-debug]
9360 "--"
9361 ["Invisible Vlines" org-table-toggle-vline-visibility
9362 :style toggle :selected (org-in-invisibility-spec-p '(org-table))]
9363 "--"
9364 ["Create" org-table-create (and (not (org-at-table-p))
9365 org-enable-table-editor)]
9366 ["Convert Region" org-ctrl-c-ctrl-c (not (org-at-table-p 'any))]
9367 ["Import from File" org-table-import (not (org-at-table-p))]
9368 ["Export to File" org-table-export (org-at-table-p)]
9369 "--"
9370 ["Create/Convert from/to table.el" org-table-create-with-table.el t]))
9371
8733(easy-menu-define org-org-menu org-mode-map "Org menu" 9372(easy-menu-define org-org-menu org-mode-map "Org menu"
8734 '("Org" 9373 '("Org"
8735 ["Cycle Visibility" org-cycle (or (bobp) (outline-on-heading-p))] 9374 ["Cycle Visibility" org-cycle (or (bobp) (outline-on-heading-p))]
@@ -8794,49 +9433,6 @@ the automatic table editor has been turned off."
8794 ["Insert Link" org-insert-link t] 9433 ["Insert Link" org-insert-link t]
8795 ["Follow Link" org-open-at-point t]) 9434 ["Follow Link" org-open-at-point t])
8796 "--" 9435 "--"
8797 ("Table"
8798 ["Align" org-ctrl-c-ctrl-c (org-at-table-p)]
8799 ["Next Field" org-cycle (org-at-table-p)]
8800 ["Previous Field" org-shifttab (org-at-table-p)]
8801 ["Next Row" org-return (org-at-table-p)]
8802 "--"
8803 ["Blank Field" org-table-blank-field (org-at-table-p)]
8804 ["Copy Field from Above" org-table-copy-down (org-at-table-p)]
8805 "--"
8806 ("Column"
8807 ["Move Column Left" org-metaleft (org-at-table-p)]
8808 ["Move Column Right" org-metaright (org-at-table-p)]
8809 ["Delete Column" org-shiftmetaleft (org-at-table-p)]
8810 ["Insert Column" org-shiftmetaright (org-at-table-p)])
8811 ("Row"
8812 ["Move Row Up" org-metaup (org-at-table-p)]
8813 ["Move Row Down" org-metadown (org-at-table-p)]
8814 ["Delete Row" org-shiftmetaup (org-at-table-p)]
8815 ["Insert Row" org-shiftmetadown (org-at-table-p)]
8816 "--"
8817 ["Insert Hline" org-table-insert-hline (org-at-table-p)])
8818 ("Rectangle"
8819 ["Copy Rectangle" org-copy-special (org-at-table-p)]
8820 ["Cut Rectangle" org-cut-special (org-at-table-p)]
8821 ["Paste Rectangle" org-paste-special (org-at-table-p)]
8822 ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
8823 "--"
8824 ["Which Column?" org-table-current-column (org-at-table-p)]
8825 ["Sum Column/Rectangle" org-table-sum
8826 (or (org-at-table-p) (org-region-active-p))]
8827 ["Eval Formula" org-table-eval-formula (org-at-table-p)]
8828 "--"
8829 ["Invisible Vlines" org-table-toggle-vline-visibility
8830 :style toggle :selected (org-in-invisibility-spec-p '(org-table))]
8831 "--"
8832 ["Create" org-table-create (and (not (org-at-table-p))
8833 org-enable-table-editor)]
8834 ["Convert Region" org-ctrl-c-ctrl-c (not (org-at-table-p 'any))]
8835 ["Import from File" org-table-import (not (org-at-table-p))]
8836 ["Export to File" org-table-export (org-at-table-p)]
8837 "--"
8838 ["Create/Convert from/to table.el" org-table-create-with-table.el t])
8839 "--"
8840 ("Export" 9436 ("Export"
8841 ["ASCII" org-export-as-ascii t] 9437 ["ASCII" org-export-as-ascii t]
8842 ["Extract Visible Text" org-export-copy-visible t] 9438 ["Extract Visible Text" org-export-copy-visible t]
@@ -8865,10 +9461,10 @@ With optional NODE, go directly to that node."
8865 (Info-goto-node (format "(org)%s" (or node "")))) 9461 (Info-goto-node (format "(org)%s" (or node ""))))
8866 9462
8867(defun org-install-agenda-files-menu () 9463(defun org-install-agenda-files-menu ()
8868 (easy-menu-change 9464 (easy-menu-change
8869 '("Org") "File List for Agenda" 9465 '("Org") "File List for Agenda"
8870 (append 9466 (append
8871 (list 9467 (list
8872 ["Edit File List" (customize-variable 'org-agenda-files) t] 9468 ["Edit File List" (customize-variable 'org-agenda-files) t]
8873 ["Add Current File to List" org-add-file t] 9469 ["Add Current File to List" org-add-file t]
8874 ["Remove Current File from List" org-remove-file t] 9470 ["Remove Current File from List" org-remove-file t]
@@ -8983,7 +9579,7 @@ that can be added."
8983;; Functions needed for compatibility with old outline.el 9579;; Functions needed for compatibility with old outline.el
8984 9580
8985;; The following functions capture almost the entire compatibility code 9581;; The following functions capture almost the entire compatibility code
8986;; between the different versions of outline-mode. The only other place 9582;; between the different versions of outline-mode. The only other place
8987;; where this is important are the font-lock-keywords. Search for 9583;; where this is important are the font-lock-keywords. Search for
8988;; `org-noutline-p' to find it. 9584;; `org-noutline-p' to find it.
8989 9585
@@ -9048,7 +9644,7 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
9048This function considers both visible and invisible heading lines. 9644This function considers both visible and invisible heading lines.
9049With argument, move up ARG levels." 9645With argument, move up ARG levels."
9050 (if org-noutline-p 9646 (if org-noutline-p
9051 (if (fboundp 'outline-up-heading-all) 9647 (if (fboundp 'outline-up-heading-all)
9052 (outline-up-heading-all arg) ; emacs 21 version of outline.el 9648 (outline-up-heading-all arg) ; emacs 21 version of outline.el
9053 (outline-up-heading arg t)) ; emacs 22 version of outline.el 9649 (outline-up-heading arg t)) ; emacs 22 version of outline.el
9054 (org-back-to-heading t) 9650 (org-back-to-heading t)
@@ -9104,8 +9700,8 @@ When ENTRY is non-nil, show the entire entry."
9104 9700
9105(defun org-show-subtree () 9701(defun org-show-subtree ()
9106 "Show everything after this heading at deeper levels." 9702 "Show everything after this heading at deeper levels."
9107 (outline-flag-region 9703 (outline-flag-region
9108 (point) 9704 (point)
9109 (save-excursion 9705 (save-excursion
9110 (outline-end-of-subtree) (outline-next-heading) (point)) 9706 (outline-end-of-subtree) (outline-next-heading) (point))
9111 (if org-noutline-p nil ?\n))) 9707 (if org-noutline-p nil ?\n)))
@@ -9116,7 +9712,7 @@ Show the heading too, if it is currently invisible."
9116 (interactive) 9712 (interactive)
9117 (save-excursion 9713 (save-excursion
9118 (org-back-to-heading t) 9714 (org-back-to-heading t)
9119 (outline-flag-region 9715 (outline-flag-region
9120 (1- (point)) 9716 (1- (point))
9121 (save-excursion 9717 (save-excursion
9122 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) 9718 (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."
359 (point)))) 359 (point))))
360 (replace-match newtext fixedcase literal) 360 (replace-match newtext fixedcase literal)
361 (if (< change 0) 361 (if (< change 0)
362 (insert-char ?\ (- change))))) 362 (insert-char ?\s (- change)))))
363 363
364;; Picture Tabs 364;; Picture Tabs
365 365
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."
816 (texinfo-last-unended-begin) 816 (texinfo-last-unended-begin)
817 (match-string 1))) 817 (match-string 1)))
818 "table") 818 "table")
819 ? ;space 819 ?\s
820 ?\n))) 820 ?\n)))
821 821
822(defun texinfo-insert-@kbd (&optional arg) 822(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 @@
12005-06-28 Klaus Straubinger <KSNetz@Arcor.DE> (tiny change)
2
3 * url-http.el (url-http-create-request): Call url-recreate-url
4 in proxy case.
5
62005-06-27 Klaus Straubinger <KSNetz@Arcor.DE> (tiny change)
7
8 * url-http.el (url-http-create-request): When computing real-fname,
9 call url-filename in both cases.
10
112005-06-27 Richard M. Stallman <rms@gnu.org>
12
13 * url-cookie.el (url-cookie-store): Rename arg PATH to LOCALPART.
14 (url-cookie-retrieve): Likewise.
15 (url-cookie-generate-header-lines): Likewise.
16 (url-cookie-handle-set-cookie): Likewise.
17 (url-cookie-create): Expect :localpart instead of :path.
18 (url-cookie-localpart): Renamed from url-cookie-path.
19 (url-cookie-set-localpart): Renamed from url-cookie-set-path.
20 (url-cookie-file): Doc fix.
21 (url-cookie-p): Add doc string.
22
12005-06-23 Richard M. Stallman <rms@gnu.org> 232005-06-23 Richard M. Stallman <rms@gnu.org>
2 24
3 * url-cookie.el (url-cookie-generate-header-lines): Fix autoload cookie. 25 * 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 @@
34;; 'open standard' defining this crap. 34;; 'open standard' defining this crap.
35;; 35;;
36;; A cookie is stored internally as a vector of 7 slots 36;; A cookie is stored internally as a vector of 7 slots
37;; [ 'cookie name value expires path domain secure ] 37;; [ cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE ]
38 38
39(defsubst url-cookie-name (cookie) (aref cookie 1)) 39(defsubst url-cookie-name (cookie) (aref cookie 1))
40(defsubst url-cookie-value (cookie) (aref cookie 2)) 40(defsubst url-cookie-value (cookie) (aref cookie 2))
41(defsubst url-cookie-expires (cookie) (aref cookie 3)) 41(defsubst url-cookie-expires (cookie) (aref cookie 3))
42(defsubst url-cookie-path (cookie) (aref cookie 4)) 42(defsubst url-cookie-localpart (cookie) (aref cookie 4))
43(defsubst url-cookie-domain (cookie) (aref cookie 5)) 43(defsubst url-cookie-domain (cookie) (aref cookie 5))
44(defsubst url-cookie-secure (cookie) (aref cookie 6)) 44(defsubst url-cookie-secure (cookie) (aref cookie 6))
45 45
46(defsubst url-cookie-set-name (cookie val) (aset cookie 1 val)) 46(defsubst url-cookie-set-name (cookie val) (aset cookie 1 val))
47(defsubst url-cookie-set-value (cookie val) (aset cookie 2 val)) 47(defsubst url-cookie-set-value (cookie val) (aset cookie 2 val))
48(defsubst url-cookie-set-expires (cookie val) (aset cookie 3 val)) 48(defsubst url-cookie-set-expires (cookie val) (aset cookie 3 val))
49(defsubst url-cookie-set-path (cookie val) (aset cookie 4 val)) 49(defsubst url-cookie-set-localpart (cookie val) (aset cookie 4 val))
50(defsubst url-cookie-set-domain (cookie val) (aset cookie 5 val)) 50(defsubst url-cookie-set-domain (cookie val) (aset cookie 5 val))
51(defsubst url-cookie-set-secure (cookie val) (aset cookie 6 val)) 51(defsubst url-cookie-set-secure (cookie val) (aset cookie 6 val))
52(defsubst url-cookie-retrieve-arg (key args) (nth 1 (memq key args))) 52(defsubst url-cookie-retrieve-arg (key args) (nth 1 (memq key args)))
53 53
54(defsubst url-cookie-create (&rest args) 54(defsubst url-cookie-create (&rest args)
55 "Create a cookie vector object from keyword-value pairs ARGS.
56The keywords allowed are
57 :name NAME
58 :value VALUE
59 :expires TIME
60 :localpart LOCALPAR
61 :domain DOMAIN
62 :secure ???
63Could someone fill in more information?"
55 (let ((retval (make-vector 7 nil))) 64 (let ((retval (make-vector 7 nil)))
56 (aset retval 0 'cookie) 65 (aset retval 0 'cookie)
57 (url-cookie-set-name retval (url-cookie-retrieve-arg :name args)) 66 (url-cookie-set-name retval (url-cookie-retrieve-arg :name args))
58 (url-cookie-set-value retval (url-cookie-retrieve-arg :value args)) 67 (url-cookie-set-value retval (url-cookie-retrieve-arg :value args))
59 (url-cookie-set-expires retval (url-cookie-retrieve-arg :expires args)) 68 (url-cookie-set-expires retval (url-cookie-retrieve-arg :expires args))
60 (url-cookie-set-path retval (url-cookie-retrieve-arg :path args)) 69 (url-cookie-set-localpart retval (url-cookie-retrieve-arg :localpart args))
61 (url-cookie-set-domain retval (url-cookie-retrieve-arg :domain args)) 70 (url-cookie-set-domain retval (url-cookie-retrieve-arg :domain args))
62 (url-cookie-set-secure retval (url-cookie-retrieve-arg :secure args)) 71 (url-cookie-set-secure retval (url-cookie-retrieve-arg :secure args))
63 retval)) 72 retval))
64 73
65(defun url-cookie-p (obj) 74(defun url-cookie-p (obj)
75 "Return non-nil if OBJ is a cookie vector object.
76These objects represent cookies in the URL package.
77A cookie vector object is a vector of 7 slots:
78 [cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE]."
66 (and (vectorp obj) (= (length obj) 7) (eq (aref obj 0) 'cookie))) 79 (and (vectorp obj) (= (length obj) 7) (eq (aref obj 0) 'cookie)))
67 80
68(defgroup url-cookie nil 81(defgroup url-cookie nil
@@ -73,7 +86,8 @@
73 86
74(defvar url-cookie-storage nil "Where cookies are stored.") 87(defvar url-cookie-storage nil "Where cookies are stored.")
75(defvar url-cookie-secure-storage nil "Where secure cookies are stored.") 88(defvar url-cookie-secure-storage nil "Where secure cookies are stored.")
76(defcustom url-cookie-file nil "*Where cookies are stored on disk." 89(defcustom url-cookie-file nil
90 "*File where cookies are stored on disk."
77 :type '(choice (const :tag "Default" :value nil) file) 91 :type '(choice (const :tag "Default" :value nil) file)
78 :group 'url-file 92 :group 'url-file
79 :group 'url-cookie) 93 :group 'url-cookie)
@@ -154,7 +168,7 @@ telling Microsoft that."
154 (write-file fname) 168 (write-file fname)
155 (kill-buffer (current-buffer)))))) 169 (kill-buffer (current-buffer))))))
156 170
157(defun url-cookie-store (name value &optional expires domain path secure) 171(defun url-cookie-store (name value &optional expires domain localpart secure)
158 "Store a netscape-style cookie." 172 "Store a netscape-style cookie."
159 (let* ((storage (if secure url-cookie-secure-storage url-cookie-storage)) 173 (let* ((storage (if secure url-cookie-secure-storage url-cookie-storage))
160 (tmp storage) 174 (tmp storage)
@@ -173,7 +187,7 @@ telling Microsoft that."
173 (while storage 187 (while storage
174 (setq cur (car storage) 188 (setq cur (car storage)
175 storage (cdr storage)) 189 storage (cdr storage))
176 (if (and (equal path (url-cookie-path cur)) 190 (if (and (equal localpart (url-cookie-localpart cur))
177 (equal name (url-cookie-name cur))) 191 (equal name (url-cookie-name cur)))
178 (progn 192 (progn
179 (url-cookie-set-expires cur expires) 193 (url-cookie-set-expires cur expires)
@@ -186,7 +200,7 @@ telling Microsoft that."
186 :value value 200 :value value
187 :expires expires 201 :expires expires
188 :domain domain 202 :domain domain
189 :path path 203 :localpart localpart
190 :secure secure) 204 :secure secure)
191 (cdr found-domain))))) 205 (cdr found-domain)))))
192 ;; Need to add a new top-level domain 206 ;; Need to add a new top-level domain
@@ -194,7 +208,7 @@ telling Microsoft that."
194 :value value 208 :value value
195 :expires expires 209 :expires expires
196 :domain domain 210 :domain domain
197 :path path 211 :localpart localpart
198 :secure secure)) 212 :secure secure))
199 (cond 213 (cond
200 (storage 214 (storage
@@ -235,8 +249,8 @@ telling Microsoft that."
235 (> (- cur-norm exp-norm) 1)))))) 249 (> (- cur-norm exp-norm) 1))))))
236 250
237;;;###autoload 251;;;###autoload
238(defun url-cookie-retrieve (host path &optional secure) 252(defun url-cookie-retrieve (host localpart &optional secure)
239 "Retrieve all the netscape-style cookies for a specified HOST and PATH." 253 "Retrieve all the netscape-style cookies for a specified HOST and LOCALPART."
240 (let ((storage (if secure 254 (let ((storage (if secure
241 (append url-cookie-secure-storage url-cookie-storage) 255 (append url-cookie-secure-storage url-cookie-storage)
242 url-cookie-storage)) 256 url-cookie-storage))
@@ -244,7 +258,7 @@ telling Microsoft that."
244 (cookies nil) 258 (cookies nil)
245 (cur nil) 259 (cur nil)
246 (retval nil) 260 (retval nil)
247 (path-regexp nil)) 261 (localpart-regexp nil))
248 (while storage 262 (while storage
249 (setq cur (car storage) 263 (setq cur (car storage)
250 storage (cdr storage) 264 storage (cdr storage)
@@ -255,26 +269,26 @@ telling Microsoft that."
255 (while cookies 269 (while cookies
256 (setq cur (car cookies) 270 (setq cur (car cookies)
257 cookies (cdr cookies) 271 cookies (cdr cookies)
258 path-regexp (concat "^" (regexp-quote 272 localpart-regexp (concat "^" (regexp-quote
259 (url-cookie-path cur)))) 273 (url-cookie-localpart cur))))
260 (if (and (string-match path-regexp path) 274 (if (and (string-match localpart-regexp localpart)
261 (not (url-cookie-expired-p cur))) 275 (not (url-cookie-expired-p cur)))
262 (setq retval (cons cur retval)))))) 276 (setq retval (cons cur retval))))))
263 retval)) 277 retval))
264 278
265;;;###autoload 279;;;###autoload
266(defun url-cookie-generate-header-lines (host path secure) 280(defun url-cookie-generate-header-lines (host localpart secure)
267 (let* ((cookies (url-cookie-retrieve host path secure)) 281 (let* ((cookies (url-cookie-retrieve host localpart secure))
268 (retval nil) 282 (retval nil)
269 (cur nil) 283 (cur nil)
270 (chunk nil)) 284 (chunk nil))
271 ;; Have to sort this for sending most specific cookies first 285 ;; Have to sort this for sending most specific cookies first
272 (setq cookies (and cookies 286 (setq cookies (and cookies
273 (sort cookies 287 (sort cookies
274 (function 288 (function
275 (lambda (x y) 289 (lambda (x y)
276 (> (length (url-cookie-path x)) 290 (> (length (url-cookie-localpart x))
277 (length (url-cookie-path y)))))))) 291 (length (url-cookie-localpart y))))))))
278 (while cookies 292 (while cookies
279 (setq cur (car cookies) 293 (setq cur (car cookies)
280 cookies (cdr cookies) 294 cookies (cdr cookies)
@@ -340,9 +354,9 @@ telling Microsoft that."
340 (trusted url-cookie-trusted-urls) 354 (trusted url-cookie-trusted-urls)
341 (untrusted url-cookie-untrusted-urls) 355 (untrusted url-cookie-untrusted-urls)
342 (expires (cdr-safe (assoc-string "expires" args t))) 356 (expires (cdr-safe (assoc-string "expires" args t)))
343 (path (or (cdr-safe (assoc-string "path" args t)) 357 (localpart (or (cdr-safe (assoc-string "path" args t))
344 (file-name-directory 358 (file-name-directory
345 (url-filename url-current-object)))) 359 (url-filename url-current-object))))
346 (rest nil)) 360 (rest nil))
347 (while args 361 (while args
348 (if (not (member (downcase (car (car args))) 362 (if (not (member (downcase (car (car args)))
@@ -422,7 +436,7 @@ telling Microsoft that."
422 (while rest 436 (while rest
423 (setq cur (pop rest)) 437 (setq cur (pop rest))
424 (url-cookie-store (car cur) (cdr cur) 438 (url-cookie-store (car cur) (cdr cur)
425 expires domain path secure)))) 439 expires domain localpart secure))))
426 (t 440 (t
427 (message "%s tried to set a cookie for domain %s - rejected." 441 (message "%s tried to set a cookie for domain %s - rejected."
428 (url-host url-current-object) domain))))) 442 (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.
156 (let ((url-basic-auth-storage 156 (let ((url-basic-auth-storage
157 'url-http-proxy-basic-auth-storage)) 157 'url-http-proxy-basic-auth-storage))
158 (url-get-authentication url nil 'any nil)))) 158 (url-get-authentication url nil 'any nil))))
159 (real-fname (if proxy-obj (url-recreate-url proxy-obj) 159 (real-fname (url-filename (or proxy-obj url)))
160 (url-filename url)))
161 (host (url-host (or proxy-obj url))) 160 (host (url-host (or proxy-obj url)))
162 (auth (if (cdr-safe (assoc "Authorization" url-request-extra-headers)) 161 (auth (if (cdr-safe (assoc "Authorization" url-request-extra-headers))
163 nil 162 nil
@@ -200,7 +199,9 @@ request.
200 (setq request 199 (setq request
201 (concat 200 (concat
202 ;; The request 201 ;; The request
203 (or url-request-method "GET") " " real-fname " HTTP/" url-http-version "\r\n" 202 (or url-request-method "GET") " "
203 (if proxy-obj (url-recreate-url proxy-obj) real-fname)
204 " HTTP/" url-http-version "\r\n"
204 ;; Version of MIME we speak 205 ;; Version of MIME we speak
205 "MIME-Version: 1.0\r\n" 206 "MIME-Version: 1.0\r\n"
206 ;; (maybe) Try to keep the connection open 207 ;; (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.")
967 (recenter)) 967 (recenter))
968 ) 968 )
969 969
970 (let ((up t) command) 970 (let ((up t) command)
971 ;; Mouse click not on a widget button. Find the global 971 ;; Mouse click not on a widget button. Find the global
972 ;; command to run, and check whether it is bound to an 972 ;; command to run, and check whether it is bound to an
973 ;; up event. 973 ;; up event.
974 (mouse-set-point event) 974 (mouse-set-point event)
975 (if (memq (event-basic-type event) '(mouse-1 down-mouse-1)) 975 (if (memq (event-basic-type event) '(mouse-1 down-mouse-1))
976 (cond ((setq command ;down event
977 (lookup-key widget-global-map [down-mouse-1]))
978 (setq up nil))
979 ((setq command ;up event
980 (lookup-key widget-global-map [mouse-1]))))
981 (cond ((setq command ;down event 976 (cond ((setq command ;down event
982 (lookup-key widget-global-map [down-mouse-2])) 977 (lookup-key widget-global-map [down-mouse-1]))
983 (setq up nil)) 978 (setq up nil))
984 ((setq command ;up event 979 ((setq command ;up event
985 (lookup-key widget-global-map [mouse-2]))))) 980 (lookup-key widget-global-map [mouse-1]))))
986 (when up 981 (cond ((setq command ;down event
987 ;; Don't execute up events twice. 982 (lookup-key widget-global-map [down-mouse-2]))
988 (while (not (widget-button-release-event-p event)) 983 (setq up nil))
989 (setq event (read-event)))) 984 ((setq command ;up event
990 (when command 985 (lookup-key widget-global-map [mouse-2])))))
991 (call-interactively command))))) 986 (when up
987 ;; Don't execute up events twice.
988 (while (not (widget-button-release-event-p event))
989 (setq event (read-event))))
990 (when command
991 (call-interactively command)))))
992 (message "You clicked somewhere weird."))) 992 (message "You clicked somewhere weird.")))
993 993
994(defun widget-button-press (pos &optional event) 994(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.")
40 40
41(defmacro save-selected-window (&rest body) 41(defmacro save-selected-window (&rest body)
42 "Execute BODY, then select the window that was selected before BODY. 42 "Execute BODY, then select the window that was selected before BODY.
43Also restore the selected window of each frame as it was at the start 43The value returned is the value of the last form in BODY.
44of this construct. 44
45However, if a window has become dead, don't get an error, 45This macro saves and restores the current buffer, since otherwise
46just refrain from reselecting it. 46its normal operation could potentially make a different
47Return the value of the last form in BODY." 47buffer current. It does not alter the buffer list ordering.
48
49This macro saves and restores the selected window, as well as
50the selected window in each frame. If the previously selected
51window of some frame is no longer live at the end of BODY, that
52frame's selected window is left alone. If the selected window is
53no longer live, then whatever window is selected at the end of
54BODY remains selected."
48 `(let ((save-selected-window-window (selected-window)) 55 `(let ((save-selected-window-window (selected-window))
49 ;; It is necessary to save all of these, because calling 56 ;; It is necessary to save all of these, because calling
50 ;; select-window changes frame-selected-window for whatever 57 ;; select-window changes frame-selected-window for whatever
@@ -52,14 +59,15 @@ Return the value of the last form in BODY."
52 (save-selected-window-alist 59 (save-selected-window-alist
53 (mapcar (lambda (frame) (list frame (frame-selected-window frame))) 60 (mapcar (lambda (frame) (list frame (frame-selected-window frame)))
54 (frame-list)))) 61 (frame-list))))
55 (unwind-protect 62 (save-current-buffer
56 (progn ,@body) 63 (unwind-protect
57 (dolist (elt save-selected-window-alist) 64 (progn ,@body)
58 (and (frame-live-p (car elt)) 65 (dolist (elt save-selected-window-alist)
59 (window-live-p (cadr elt)) 66 (and (frame-live-p (car elt))
60 (set-frame-selected-window (car elt) (cadr elt)))) 67 (window-live-p (cadr elt))
61 (if (window-live-p save-selected-window-window) 68 (set-frame-selected-window (car elt) (cadr elt))))
62 (select-window save-selected-window-window))))) 69 (if (window-live-p save-selected-window-window)
70 (select-window save-selected-window-window))))))
63 71
64(defun window-body-height (&optional window) 72(defun window-body-height (&optional window)
65 "Return number of lines in window WINDOW for actual buffer text. 73 "Return number of lines in window WINDOW for actual buffer text.