diff options
| author | Miles Bader | 2005-06-30 00:31:46 +0000 |
|---|---|---|
| committer | Miles Bader | 2005-06-30 00:31:46 +0000 |
| commit | eeb88b27e1dbd3f412aa684d44e4a784f6e536a2 (patch) | |
| tree | 23ea1eda87f588e060b6c00e9c7ffac6a89a7e42 /lisp | |
| parent | 16e1457021e3f6e3b83fc9b5262fde38b7140c96 (diff) | |
| parent | 84861437f914ac45c1eea7b6477ffc4783bb3bdd (diff) | |
| download | emacs-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')
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 @@ | |||
| 1 | 2005-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 | |||
| 15 | 2005-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 | |||
| 30 | 2005-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 | |||
| 39 | 2005-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 | |||
| 79 | 2005-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 | |||
| 87 | 2005-06-28 Vinicius Jose Latorre <viniciusjl@ig.com.br> | ||
| 88 | |||
| 89 | * ps-print.el (ps-print-version): Fix version number. | ||
| 90 | |||
| 91 | 2005-06-28 Luc Teirlinck <teirllm@auburn.edu> | ||
| 92 | |||
| 93 | * textmodes/ispell.el (ispell-word): Remove stray parenthesis. | ||
| 94 | |||
| 95 | 2005-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 | |||
| 117 | 2005-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 | |||
| 122 | 2005-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 | |||
| 130 | 2005-06-27 Luc Teirlinck <teirllm@auburn.edu> | ||
| 131 | |||
| 132 | * subr.el (add-to-list, add-to-ordered-list): Doc fixes. | ||
| 133 | |||
| 134 | 2005-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 | |||
| 145 | 2005-06-26 Nick Roberts <nickrob@snap.net.nz> | ||
| 146 | |||
| 147 | * progmodes/gud.el (gud-filter): Add missing argument to | ||
| 148 | with-selected-window. | ||
| 149 | |||
| 150 | 2005-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 | |||
| 158 | 2005-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 | |||
| 179 | 2005-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 | |||
| 205 | 2005-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 | |||
| 226 | 2005-06-24 Richard M. Stallman <rms@gnu.org> | ||
| 227 | |||
| 228 | * simple.el (line-move-1): Fix previous change. | ||
| 229 | |||
| 230 | 2005-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 | |||
| 1 | 2005-06-24 Nick Roberts <nickrob@snap.net.nz> | 236 | 2005-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 | ||
| 11 | 2005-06-23 Luc Teirlinck <teirllm@auburn.edu> | 246 | 2005-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 | ||
| 79 | 2005-06-21 Juri Linkov <juri@jurta.org> | 314 | 2005-06-21 Juri Linkov <juri@jurta.org> |
| @@ -159,8 +394,7 @@ | |||
| 159 | 394 | ||
| 160 | 2005-06-18 Peter Kleiweg <p.c.j.kleiweg@rug.nl> | 395 | 2005-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 | ||
| 165 | 2005-06-18 Steve Youngs <steve@xemacs.org> | 399 | 2005-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 | ||
| 384 | 2005-06-15 Stefan Monnier <monnier@iro.umontreal.ca> | 618 | 2005-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 | ||
| 644 | 2005-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 | |||
| 410 | 2005-06-14 Miles Bader <miles@gnu.org> | 649 | 2005-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 \ |
| 291 | before edit/copy" | 291 | before 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'. |
| 295 | Only used if `diary-header-line-flag' is non-nil." | 295 | Only 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 \\|\ |
| 339 | Kerberos \\|CVS \\|UNIX \\| SMB \\|^\\)\ | 339 | Kerberos \\|CVS \\|UNIX \\| SMB \\|^\\)\ |
| 340 | \[Pp]assword\\( (again)\\)?\\|\ | 340 | \[Pp]assword\\( (again)\\)?\\|\ |
| 341 | pass phrase\\|\\(Enter\\|Repeat\\) passphrase\\)\ | 341 | pass 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. |
| 344 | This is used by `comint-watch-for-password-prompt'." | 344 | This 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. |
| 140 | Each element may be either a symbol, which is the name of a face, or a string, | 141 | Each element may be either a symbol, which is the name of a face, or a string, |
| 141 | which is a regular expression to be matched against face names. Matching | 142 | which 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. | ||
| 646 | If 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. |
| 713 | MENU should be `facemenu-foreground-menu' or | 710 | MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'. |
| 714 | `facemenu-background-menu'. | 711 | Create the appropriate face and return it. |
| 715 | 712 | ||
| 716 | This is called whenever you use a new color." | 713 | This 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. |
| 208 | Return nil otherwise. A face name can be a string or a symbol. | ||
| 209 | An internal face object is a vector of the kind used internally | ||
| 210 | to 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. | ||
| 1581 | Emacs sets it automatically depending on the terminal type. | ||
| 1582 | The value `nil' means `dark'. If Emacs runs in non-windowed | ||
| 1583 | mode from `xterm' or a similar terminal emulator, the value is | ||
| 1584 | `light'. On rxvt terminals, the value depends on the environment | ||
| 1585 | variable 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 @@ | |||
| 1 | 2005-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 | |||
| 11 | 2005-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 | |||
| 1 | 2005-06-23 Lute Kamstra <lute@gnu.org> | 16 | 2005-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. |
| 79 | One likely value is `mc-verify'. If the function in this variable | 79 | One likely value is `pgg-verify'. If the function in this variable |
| 80 | isn't bound, the message will be used unconditionally." | 80 | isn'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. |
| 490 | If the argument is left out or nil, then the current buffer is considered." | 490 | If 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. |
| 498 | Faces `compilation-error-face', `compilation-warning-face', | 533 | Faces `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. | ||
| 1541 | This 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 | ||
| 20 | Vinicius's last change version -- this file may have been edited as part of | 20 | Vinicius's last change version -- this file may have been edited as part of |
| 21 | Emacs without changes to the version number. When reporting bugs, please also | 21 | Emacs without changes to the version number. When reporting bugs, please also |
| @@ -5936,10 +5936,14 @@ XSTART YSTART are the relative position for the first page in a sheet.") | |||
| 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." | |||
| 259 | It is passed a filename to give a chance to transform it. | 259 | It is passed a filename to give a chance to transform it. |
| 260 | If it returns nil, the filename is left unchanged." | 260 | If 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. |
| 907 | Used internally by recentf dialogs. | ||
| 908 | IGNORE arguments." | 908 | IGNORE 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. | ||
| 915 | Go 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. | ||
| 981 | Used 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 | ;; |
| 985 | Used 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. | ||
| 986 | IGNORE other arguments." | 1011 | IGNORE 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) | 1021 | IGNORE 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." |
| 1001 | That 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. |
| 1018 | Select the files to be deleted from the recent list.\n\n\ | 1039 | Click on Cancel or type `q' to cancel.\n") |
| 1019 | Click on Ok to update the list. \ | ||
| 1020 | Click 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. |
| 1055 | Used internally by `recentf-open-files'. | ||
| 1056 | IGNORE other arguments." | 1064 | IGNORE 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. | ||
| 1062 | Used 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." |
| 1066 | Used 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. |
| 1091 | If optional argument FILES is non-nil, it specifies the list of | 1092 | If optional argument FILES is non-nil, it is a list of recently-opened |
| 1092 | recently-opened files to choose from. It is the whole recent list | 1093 | files to choose from. It defaults to the whole recent list. |
| 1093 | otherwise. | 1094 | If optional argument BUFFER-NAME is non-nil, it is a buffer name to |
| 1094 | If optional argument BUFFER-NAME is non-nil, it specifies which buffer | 1095 | use for the dialog. It defaults to \"*`recentf-menu-title'*\"." |
| 1095 | name to use for the interaction. It is \"*`recentf-menu-title'*\" by | ||
| 1096 | default." | ||
| 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 | 1099 | Click 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." | |||
| 516 | Prompt for a regexp with PROMPT. | 516 | Prompt for a regexp with PROMPT. |
| 517 | Value is a list, (REGEXP)." | 517 | Value 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. |
| 523 | A match split across lines preserves all the lines it lies in. | 524 | A match split across lines preserves all the lines it lies in. |
| 524 | Applies to all lines after point. | 525 | When called from Lisp (and usually interactively as well, see below) |
| 526 | applies to all lines starting after point. | ||
| 525 | 527 | ||
| 526 | If REGEXP contains upper case characters (excluding those preceded by `\\'), | 528 | If REGEXP contains upper case characters (excluding those preceded by `\\'), |
| 527 | the matching is case-sensitive. | 529 | the matching is case-sensitive. |
| 528 | 530 | ||
| 529 | Second and third arg RSTART and REND specify the region to operate on. | 531 | Second and third arg RSTART and REND specify the region to operate on. |
| 532 | This command operates on (the accessible part of) all lines whose | ||
| 533 | accessible part is entirely contained in the region determined by RSTART | ||
| 534 | and REND. (A newline ending a line counts as part of that line.) | ||
| 530 | 535 | ||
| 531 | Interactively, in Transient Mark mode when the mark is active, operate | 536 | Interactively, in Transient Mark mode when the mark is active, operate |
| 532 | on the contents of the region. Otherwise, operate from point to the | 537 | on all lines whose accessible part is entirely contained in the region. |
| 533 | end of the buffer." | 538 | Otherwise, the command applies to all lines starting after point. |
| 539 | When calling this function from Lisp, you can pretend that it was | ||
| 540 | called interactively by passing a non-nil INTERACTIVE argument. | ||
| 541 | |||
| 542 | This function starts looking for the next match from the end of | ||
| 543 | the previous match. Hence, it ignores matches that overlap | ||
| 544 | a 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. |
| 574 | If a match is split across lines, all the lines it lies in are deleted. | 597 | When called from Lisp (and usually when called interactively as |
| 575 | Applies to lines after point. | 598 | well, see below), applies to the part of the buffer after point. |
| 599 | The line point is in is deleted if and only if it contains a | ||
| 600 | match for regexp starting after point. | ||
| 576 | 601 | ||
| 577 | If REGEXP contains upper case characters (excluding those preceded by `\\'), | 602 | If REGEXP contains upper case characters (excluding those preceded by `\\'), |
| 578 | the matching is case-sensitive. | 603 | the matching is case-sensitive. |
| 579 | 604 | ||
| 580 | Second and third arg RSTART and REND specify the region to operate on. | 605 | Second and third arg RSTART and REND specify the region to operate on. |
| 606 | Lines partially contained in this region are deleted if and only if | ||
| 607 | they contain a match entirely contained in it. | ||
| 581 | 608 | ||
| 582 | Interactively, in Transient Mark mode when the mark is active, operate | 609 | Interactively, in Transient Mark mode when the mark is active, operate |
| 583 | on the contents of the region. Otherwise, operate from point to the | 610 | on the contents of the region. Otherwise, operate from point to the |
| 584 | end of the buffer." | 611 | end of (the accessible portion of) the buffer. When calling this function |
| 612 | from Lisp, you can pretend that it was called interactively by passing | ||
| 613 | a non-nil INTERACTIVE argument. | ||
| 614 | |||
| 615 | If a match is split across lines, all the lines it lies in are deleted. | ||
| 616 | They are deleted _before_ looking for the next match. Hence, a match | ||
| 617 | starting 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. |
| 648 | When called from Lisp and INTERACTIVE is omitted or nil, just return | ||
| 649 | the number, do not print it; if INTERACTIVE is t, the function behaves | ||
| 650 | in all respects has if it had been called interactively. | ||
| 613 | 651 | ||
| 614 | If REGEXP contains upper case characters (excluding those preceded by `\\'), | 652 | If REGEXP contains upper case characters (excluding those preceded by `\\'), |
| 615 | the matching is case-sensitive. | 653 | the matching is case-sensitive. |
| @@ -618,18 +656,24 @@ Second and third arg RSTART and REND specify the region to operate on. | |||
| 618 | 656 | ||
| 619 | Interactively, in Transient Mark mode when the mark is active, operate | 657 | Interactively, in Transient Mark mode when the mark is active, operate |
| 620 | on the contents of the region. Otherwise, operate from point to the | 658 | on the contents of the region. Otherwise, operate from point to the |
| 621 | end of the buffer." | 659 | end of (the accessible portion of) the buffer. |
| 660 | |||
| 661 | This function starts looking for the next match from the end of | ||
| 662 | the previous match. Hence, it ignores matches that overlap | ||
| 663 | a 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 | 942 | This function can not handle matches that span more than one line. | |
| 896 | If a match spreads across multiple lines, all those lines are shown. | ||
| 897 | 943 | ||
| 898 | Each line is displayed with NLINES lines before and after, or -NLINES | 944 | Each line is displayed with NLINES lines before and after, or -NLINES |
| 899 | before if NLINES is negative. | 945 | before 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. |
| 941 | The test for presence of ELEMENT is done with `equal'. | 941 | The test for presence of ELEMENT is done with `equal'. |
| 942 | If ELEMENT is added, it is added at the beginning of the list, | 942 | If ELEMENT is added, it is added at the beginning of the list, |
| 943 | unless the optional argument APPEND is non-nil, in which case | 943 | unless the optional argument APPEND is non-nil, in which case |
| @@ -959,15 +959,18 @@ other hooks, such as major mode hooks, can do the job." | |||
| 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. |
| 963 | The test for presence of ELEMENT is done with `eq'. | 963 | The test for presence of ELEMENT is done with `eq'. |
| 964 | 964 | ||
| 965 | The resulting list is reordered so that the elements are in the | 965 | The resulting list is reordered so that the elements are in the |
| 966 | order given by each element's numeric list order. Elements | 966 | order given by each element's numeric list order. Elements |
| 967 | without a numeric list order are placed at the end of the list. | 967 | without a numeric list order are placed at the end of the list. |
| 968 | 968 | ||
| 969 | If the third optional argument ORDER is non-nil, set the | 969 | If the third optional argument ORDER is a number (integer or |
| 970 | element's list order to the given value. | 970 | float), set the element's list order to the given value. If |
| 971 | ORDER is nil or omitted, do not change the numeric order of | ||
| 972 | ELEMENT. If ORDER has any other value, remove the numeric order | ||
| 973 | of ELEMENT if it has one. | ||
| 971 | 974 | ||
| 972 | The list order for each element is stored in LIST-VAR's | 975 | The 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. |
| 1719 | The value returned is the value of the last form in BODY. | 1722 | The value returned is the value of the last form in BODY. |
| 1720 | This does not alter the buffer list ordering. | 1723 | |
| 1721 | This function saves and restores the selected window, as well as | 1724 | This macro saves and restores the current buffer, since otherwise |
| 1725 | its normal operation could potentially make a different | ||
| 1726 | buffer current. It does not alter the buffer list ordering. | ||
| 1727 | |||
| 1728 | This macro saves and restores the selected window, as well as | ||
| 1722 | the selected window in each frame. If the previously selected | 1729 | the selected window in each frame. If the previously selected |
| 1723 | window of some frame is no longer live at the end of BODY, that | 1730 | window of some frame is no longer live at the end of BODY, that |
| 1724 | frame's selected window is left alone. If the selected window is | 1731 | frame'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', | |||
| 2916 | which must return a list of strings, to be inserted in the buffer. | 2916 | which must return a list of strings, to be inserted in the buffer. |
| 2917 | 2917 | ||
| 2918 | Text already in the buffer ``shines thru'' blanks in the rendered text." | 2918 | Text 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', | |||
| 2927 | which must return a list of strings, to be inserted in the buffer. | 2927 | which must return a list of strings, to be inserted in the buffer. |
| 2928 | 2928 | ||
| 2929 | Blanks in the rendered text overwrites any text in the buffer." | 2929 | Blanks 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. |
| 568 | When nil, cursor will remain in the current window." | 578 | When 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." | |||
| 601 | When nil, date-less entries will only be shown if `org-agenda' is called | 611 | When nil, date-less entries will only be shown if `org-agenda' is called |
| 602 | with a prefix argument. | 612 | with a prefix argument. |
| 603 | When non-nil, the TODO entries will be listed at the top of the agenda, before | 613 | When non-nil, the TODO entries will be listed at the top of the agenda, before |
| 604 | the entries for specific days." | 614 | the 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. | |||
| 646 | Leaving out `category-keep' would mean that items will be sorted across | 656 | Leaving out `category-keep' would mean that items will be sorted across |
| 647 | categories by priority." | 657 | categories 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. | |||
| 741 | The third item is a list of integers, indicating the times that should have | 751 | The third item is a list of integers, indicating the times that should have |
| 742 | a grid line." | 752 | a 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. |
| 838 | This string consists of two parts, separated by a double-colon. | 848 | This string consists of two parts, separated by a double-colon. |
| 839 | 849 | ||
| 840 | The first part is a file name - when omitted, archiving happens in the same | 850 | The first part is a file name - when omitted, archiving happens in the same |
| 841 | file. %s will be replaced by the current file name (without directory part). | 851 | file. %s will be replaced by the current file name (without directory part). |
| @@ -864,7 +874,7 @@ Here are a few examples: | |||
| 864 | 874 | ||
| 865 | You may set this option on a per-file basis by adding to the buffer a | 875 | You may set this option on a per-file basis by adding to the buffer a |
| 866 | line like | 876 | line 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. | ||
| 1232 | The list must contain alternating symbols (calc modes variables and values. | ||
| 1233 | Don't remove any of the default settings, just change the values. Org-mode | ||
| 1234 | relies 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. | ||
| 1240 | If the current field starts with an equal sign, it is assumed to be a formula | ||
| 1241 | which should be evaluated as described in the manual and in the documentation | ||
| 1242 | string of the command `org-table-eval-formula'. This feature requires the | ||
| 1243 | Emacs calc package. | ||
| 1244 | When this variable is nil, formula calculation is only available through | ||
| 1245 | the 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. | ||
| 1252 | A constant looks like `$c' or `$Grav' and will be replaced before evaluation | ||
| 1253 | by the value given in `org-table-formula-constants', or by a value obtained | ||
| 1254 | from 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. | ||
| 1260 | The car of each element is a name of a constant, without the `$' before it. | ||
| 1261 | The cdr is the value as a string. For example, if you'd like to use the | ||
| 1262 | speed of light in a formula, you would configure | ||
| 1263 | |||
| 1264 | (setq org-table-formula-constants '((\"c\" . \"299792458.\"))) | ||
| 1265 | |||
| 1266 | and 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. | ||
| 1274 | Then all input fields will be converted to a number, and the result | ||
| 1275 | must also be a number. When nil, calc's full potential is available | ||
| 1276 | in 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. |
| 1657 | This variable is set by `org-before-change-function'. `org-table-align' | 1737 | This variable is set by `org-before-change-function'. `org-table-align' |
| 1658 | sets it back to nil.") | 1738 | sets 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 | ||
| 1669 | Org-mode develops organizational tasks around a NOTES file which | 1748 | Org-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 | ||
| 2941 | While prompting, a calendar is popped up - you can also select the | 3044 | While prompting, a calendar is popped up - you can also select the |
| 2942 | date with the mouse (button 1). The calendar shows a period of three | 3045 | date with the mouse (button 1). The calendar shows a period of three |
| 2943 | month. To scroll it to other months, use the keys `>' and `<'. | 3046 | month. To scroll it to other months, use the keys `>' and `<'. |
| 2944 | If you don't like the calendar, turn it off with | 3047 | If 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 | ||
| 2947 | With optional argument TO-TIME, the date will immediately be converted | 3050 | With optional argument TO-TIME, the date will immediately be converted |
| @@ -2955,7 +3058,7 @@ used to insert the time stamp into the buffer to include the time." | |||
| 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. |
| 3072 | A deadline is considered due if it happens within `org-deadline-warning-days' | 3175 | A 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." | |||
| 3972 | These are the files which are being checked for agenda entries. | 4089 | These are the files which are being checked for agenda entries. |
| 3973 | Optional argument FILE means, use this file instead of the current. | 4090 | Optional argument FILE means, use this file instead of the current. |
| 3974 | It is possible (but not recommended) to add this function to the | 4091 | It 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. |
| 4052 | This function can be used in a \"sexp\" diary entry in the Emacs calendar. | 4169 | This function can be used in a \"sexp\" diary entry in the Emacs calendar. |
| 4053 | It accesses org files and extracts information from those files to be | 4170 | It accesses org files and extracts information from those files to be |
| 4171 | |||
| 4054 | listed in the diary. The function accepts arguments specifying what | 4172 | listed in the diary. The function accepts arguments specifying what |
| 4055 | items should be listed. The following arguments are allowed: | 4173 | items should be listed. The following arguments are allowed: |
| 4056 | 4174 | ||
| @@ -4089,9 +4207,9 @@ also be written as | |||
| 4089 | 4207 | ||
| 4090 | The function expects the lisp variables `entry' and `date' to be provided | 4208 | The function expects the lisp variables `entry' and `date' to be provided |
| 4091 | by the caller, because this is how the calendar works. Don't use this | 4209 | by the caller, because this is how the calendar works. Don't use this |
| 4092 | function from a program - use `org-agenda-get-day-entries' instead." | 4210 | function 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. | |||
| 4603 | The optional STRING argument forces conversion into a 5 character wide string | 4721 | The optional STRING argument forces conversion into a 5 character wide string |
| 4604 | HH:MM." | 4722 | HH: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." | |||
| 4902 | All the standard commands work: block, weekly etc" | 5020 | All 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 | |||
| 5581 | also indented so that it starts in the same column as the headline | 5699 | also 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 | ||
| 5584 | See also the variable `org-reverse-note-order'." | 5702 | See 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. |
| 5844 | This is being used to correctly align a single field after TAB or RET.") | 5966 | This 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. |
| 6011 | Before doing so, re-align the table if necessary." | 6141 | Before 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. |
| 6033 | Before doing so, re-align the table if necessary." | 6165 | Before 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. |
| 6049 | Before doing so, re-align the table if necessary." | 6183 | Before 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 | |||
| 6071 | non-empty field above. With argument N, use the Nth non-empty field. | 6207 | non-empty field above. With argument N, use the Nth non-empty field. |
| 6072 | If the current field is not empty, it is copied down to the next row, and | 6208 | If the current field is not empty, it is copied down to the next row, and |
| 6073 | the cursor is moved with it. Therefore, repeating this command causes the | 6209 | the cursor is moved with it. Therefore, repeating this command causes the |
| 6074 | column to be filled row-by-row. | 6210 | column to be filled row-by-row. |
| 6075 | If the variable `org-table-copy-increment' is non-nil and the field is an | 6211 | If the variable `org-table-copy-increment' is non-nil and the field is an |
| 6076 | integer, it will be incremented while copying." | 6212 | integer, 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. | |||
| 6136 | If REPLACE is a string, replace field with this value. The return value | 6278 | If REPLACE is a string, replace field with this value. The return value |
| 6137 | is always the old value." | 6279 | is 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. |
| 6164 | With optional argument ON-DELIM, stop with point before the left delimiter | 6307 | With optional argument ON-DELIM, stop with point before the left delimiter |
| 6165 | of the field. | 6308 | of the field. |
| 6166 | If there are less than N fields, just go to after the last delimiter. | 6309 | If there are less than N fields, just go to after the last delimiter. |
| 6167 | However, when FORCE is non-nil, create new columns if necessary." | 6310 | However, 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. |
| 6441 | A special clipboard is used which can only be accessed | 6592 | A special clipboard is used which can only be accessed |
| 6442 | with `org-table-paste-rectangle'" | 6593 | with `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. |
| 6477 | The upper right corner ends up in the current field. All involved fields | 6626 | The upper right corner ends up in the current field. All involved fields |
| @@ -6574,7 +6723,7 @@ blank, and the content is appended to the field above." | |||
| 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. |
| 6739 | The result will be displayed in the echo area, and will be available | 6889 | The result will be displayed in the echo area, and will be available |
| 6740 | as kill to be inserted with \\[yank]. | 6890 | as kill to be inserted with \\[yank]. |
| @@ -6746,35 +6896,38 @@ column. | |||
| 6746 | 6896 | ||
| 6747 | If at least one number looks like a time HH:MM or HH:MM:SS, all other | 6897 | If at least one number looks like a time HH:MM or HH:MM:SS, all other |
| 6748 | numbers are assumed to be times as well (in decimal hours) and the | 6898 | numbers are assumed to be times as well (in decimal hours) and the |
| 6749 | numbers are added as such." | 6899 | numbers are added as such. |
| 6900 | |||
| 6901 | If 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. | ||
| 7022 | ACTION can be `remove', `insert', `swap'. For `swap', two column numbers are | ||
| 7023 | expected, 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. | ||
| 7148 | Will 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. | ||
| 7159 | If in any row, the first field is not consistent with a mark, | ||
| 7160 | insert a new column for the makers. | ||
| 7161 | When there is an active region, change all the lines in the region, | ||
| 7162 | after prompting for the marking character. | ||
| 7163 | After each change, a message will be displayed indication the meaning | ||
| 7164 | of 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. | ||
| 7228 | When 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 | ||
| 6831 | This function makes use of Dave Gillespie's calc package, arguably the most | 7239 | This function makes use of Dave Gillespie's calc package, in my view the |
| 6832 | exciting program ever written for GNU Emacs. So you need to have calc | 7240 | most exciting program ever written for GNU Emacs. So you need to have calc |
| 6833 | installed in order to use this function. | 7241 | installed in order to use this function. |
| 6834 | 7242 | ||
| 6835 | In a table, this command replaces the value in the current field with the | 7243 | In a table, this command replaces the value in the current field with the |
| 6836 | result of a formula. While nowhere near the computation options of a | 7244 | result of a formula. While nowhere near the computation options of a |
| 6837 | spreadsheet program, this is still very useful. Note that there is no | 7245 | spreadsheet program, this is still very useful. There is no automatic |
| 6838 | automatic updating of a calculated field, nor will the field remember the | 7246 | updating of a calculated field, but the table will remember the last |
| 6839 | formula. The command needs to be applied again after changing input | 7247 | formula for each column. The command needs to be applied again after |
| 6840 | fields. | 7248 | changing input fields. |
| 6841 | 7249 | ||
| 6842 | When called, the command first prompts for a formula, which is read in the | 7250 | When called, the command first prompts for a formula, which is read in the |
| 6843 | minibuffer. Previously entered formulae are available through the history | 7251 | minibuffer. Previously entered formulas are available through the history |
| 6844 | list, and the last used formula is the default, reachable by simply | 7252 | list, and the last used formula for each column is offered as a default. |
| 6845 | pressing RET. | 7253 | These stored formulas are adapted correctly when moving, inserting, or |
| 7254 | deleting columns with the corresponding commands. | ||
| 6846 | 7255 | ||
| 6847 | The formula can be any algebraic expression understood by the calc package. | 7256 | The formula can be any algebraic expression understood by the calc package. |
| 6848 | Before evaluation, variable substitution takes place: \"$\" is replaced by | 7257 | Before evaluation, variable substitution takes place: \"$\" is replaced by |
| @@ -6852,7 +7261,7 @@ here, so the command supports only horizontal computing. The formula can | |||
| 6852 | contain an optional printf format specifier after a semicolon, to reformat | 7261 | contain an optional printf format specifier after a semicolon, to reformat |
| 6853 | the result. | 7262 | the result. |
| 6854 | 7263 | ||
| 6855 | A few examples for formulae: | 7264 | A 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 | |||
| 6864 | horizontal line or the end of the table. When the command is called with a | 7273 | horizontal line or the end of the table. When the command is called with a |
| 6865 | numeric prefix argument (like M-3 or C-7 or \\[universal-argument] 24), the formula is applied | 7274 | numeric prefix argument (like M-3 or C-7 or \\[universal-argument] 24), the formula is applied |
| 6866 | to the current row, and to the following n-1 rows (but not beyond a | 7275 | to the current row, and to the following n-1 rows (but not beyond a |
| 6867 | separator line)." | 7276 | separator line). |
| 7277 | |||
| 7278 | This function can also be called from Lisp programs and offers two additional | ||
| 7279 | Arguments: EQUATION can be the formula to apply. If this argument is given, | ||
| 7280 | the user will not be prompted. SUPPRESS-ALIGN is used to speed-up | ||
| 7281 | recursive calls by by-passing unnecessary aligns. SUPPRESS-CONST suppresses | ||
| 7282 | the interpretation of constants in the formula. SUPPRESS-STORE means the | ||
| 7283 | formula should not be stored, either because it is already stored, or because | ||
| 7284 | it 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 | ||
| 7354 | Orig: %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. | ||
| 7463 | Parameters 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) | 7565 | FUN 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.") | 7566 | command name. KEYS are keys that should be checked in for a command |
| 7001 | '(interactive "p") | 7567 | to 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 | |||
| 7125 | a reduced column width." | 7744 | a 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 | |||
| 7503 | In that case, \"\\ent\" will be translated to \"&other;\". | 8089 | In that case, \"\\ent\" will be translated to \"&other;\". |
| 7504 | The list contains HTML entities for Latin-1, Greek and other symbols. | 8090 | The list contains HTML entities for Latin-1, Greek and other symbols. |
| 7505 | It is supplemented by a number of commonly used TeX macros with appropriate | 8091 | It is supplemented by a number of commonly used TeX macros with appropriate |
| 7506 | translations.") | 8092 | translations. 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 | |||
| 8541 | a reduced column width." | 9125 | a 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. |
| 8678 | When the cursor is inside a table created by the table.el package, | 9262 | When the cursor is inside a table created by the table.el package, |
| 8679 | activate that table. Otherwise, if the cursor is at a normal table | 9263 | activate that table. Otherwise, if the cursor is at a normal table |
| 8680 | created with org.el, re-align that table. This command works even if | 9264 | created with org.el, re-align that table. This command works even if |
| 8681 | the automatic table editor has been turned off." | 9265 | the automatic table editor has been turned off. |
| 9266 | If the cursor is in one of the special #+KEYWORD lines, this triggers | ||
| 9267 | scanning 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." | |||
| 9048 | This function considers both visible and invisible heading lines. | 9644 | This function considers both visible and invisible heading lines. |
| 9049 | With argument, move up ARG levels." | 9645 | With 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 @@ | |||
| 1 | 2005-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 | |||
| 6 | 2005-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 | |||
| 11 | 2005-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 | |||
| 1 | 2005-06-23 Richard M. Stallman <rms@gnu.org> | 23 | 2005-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. | ||
| 56 | The keywords allowed are | ||
| 57 | :name NAME | ||
| 58 | :value VALUE | ||
| 59 | :expires TIME | ||
| 60 | :localpart LOCALPAR | ||
| 61 | :domain DOMAIN | ||
| 62 | :secure ??? | ||
| 63 | Could 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. | ||
| 76 | These objects represent cookies in the URL package. | ||
| 77 | A 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. |
| 43 | Also restore the selected window of each frame as it was at the start | 43 | The value returned is the value of the last form in BODY. |
| 44 | of this construct. | 44 | |
| 45 | However, if a window has become dead, don't get an error, | 45 | This macro saves and restores the current buffer, since otherwise |
| 46 | just refrain from reselecting it. | 46 | its normal operation could potentially make a different |
| 47 | Return the value of the last form in BODY." | 47 | buffer current. It does not alter the buffer list ordering. |
| 48 | |||
| 49 | This macro saves and restores the selected window, as well as | ||
| 50 | the selected window in each frame. If the previously selected | ||
| 51 | window of some frame is no longer live at the end of BODY, that | ||
| 52 | frame's selected window is left alone. If the selected window is | ||
| 53 | no longer live, then whatever window is selected at the end of | ||
| 54 | BODY 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. |