aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorMiles Bader2006-06-07 18:05:10 +0000
committerMiles Bader2006-06-07 18:05:10 +0000
commitb883cdb2fefa8ea9c3b0d82eba7a9ee792f871bb (patch)
treede3804210a8cd955e0d3b9abc15679480930bc82 /lisp
parent885b7d0991bd4b4b8f4bd1d3cd21c18a697bbce2 (diff)
parent26c9afc3239e18b03537faaea33e3e82e28099e6 (diff)
downloademacs-b883cdb2fefa8ea9c3b0d82eba7a9ee792f871bb.tar.gz
emacs-b883cdb2fefa8ea9c3b0d82eba7a9ee792f871bb.zip
Merge from emacs--devo--0
Patches applied: * emacs--devo--0 (patch 285-296) - Update from CVS - Merge from gnus--rel--5.10 - Update from CVS: admin/FOR-RELEASE: Update refcard section. * gnus--rel--5.10 (patch 102-104) - Update from CVS Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-64
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog906
-rw-r--r--lisp/ChangeLog.52
-rw-r--r--lisp/arc-mode.el5
-rw-r--r--lisp/buff-menu.el24
-rw-r--r--lisp/calendar/diary-lib.el301
-rw-r--r--lisp/comint.el36
-rw-r--r--lisp/complete.el18
-rw-r--r--lisp/diff-mode.el13
-rw-r--r--lisp/diff.el32
-rw-r--r--lisp/dired-aux.el3
-rw-r--r--lisp/dired-x.el1
-rw-r--r--lisp/dired.el53
-rw-r--r--lisp/dnd.el26
-rw-r--r--lisp/ediff-diff.el20
-rw-r--r--lisp/emacs-lisp/advice.el3
-rw-r--r--lisp/emacs-lisp/authors.el9
-rw-r--r--lisp/emacs-lisp/autoload.el190
-rw-r--r--lisp/emacs-lisp/bindat.el123
-rw-r--r--lisp/emacs-lisp/ewoc.el261
-rw-r--r--lisp/emulation/cua-base.el4
-rw-r--r--lisp/faces.el3
-rw-r--r--lisp/files.el11
-rw-r--r--lisp/gnus/ChangeLog98
-rw-r--r--lisp/gnus/ChangeLog.12
-rw-r--r--lisp/gnus/gmm-utils.el22
-rw-r--r--lisp/gnus/gnus-agent.el15
-rw-r--r--lisp/gnus/gnus-art.el178
-rw-r--r--lisp/gnus/gnus-ml.el51
-rw-r--r--lisp/gnus/gnus-sum.el67
-rw-r--r--lisp/gnus/imap.el2
-rw-r--r--lisp/gnus/mail-source.el340
-rw-r--r--lisp/gnus/mm-util.el23
-rw-r--r--lisp/gnus/uudecode.el6
-rw-r--r--lisp/help.el129
-rw-r--r--lisp/ido.el120
-rw-r--r--lisp/image-mode.el1
-rw-r--r--lisp/info-xref.el5
-rw-r--r--lisp/info.el18
-rw-r--r--lisp/international/mule-cmds.el3
-rw-r--r--lisp/international/mule.el72
-rw-r--r--lisp/loadup.el2
-rw-r--r--lisp/mail/rmail.el6
-rw-r--r--lisp/makefile.w32-in15
-rw-r--r--lisp/menu-bar.el76
-rw-r--r--lisp/mh-e/mh-search.el2
-rw-r--r--lisp/msb.el2
-rw-r--r--lisp/net/browse-url.el4
-rw-r--r--lisp/pcvs-info.el3
-rw-r--r--lisp/pcvs.el5
-rw-r--r--lisp/pgg-pgp.el44
-rw-r--r--lisp/pgg-pgp5.el48
-rw-r--r--lisp/progmodes/cc-styles.el2
-rw-r--r--lisp/progmodes/cc-vars.el1
-rw-r--r--lisp/progmodes/compile.el39
-rw-r--r--lisp/progmodes/gdb-ui.el154
-rw-r--r--lisp/progmodes/grep.el2
-rw-r--r--lisp/progmodes/gud.el85
-rw-r--r--lisp/progmodes/hideif.el14
-rw-r--r--lisp/progmodes/inf-lisp.el31
-rw-r--r--lisp/progmodes/make-mode.el128
-rw-r--r--lisp/progmodes/sh-script.el90
-rw-r--r--lisp/replace.el43
-rw-r--r--lisp/ses.el81
-rw-r--r--lisp/shell.el165
-rw-r--r--lisp/simple.el18
-rw-r--r--lisp/skeleton.el24
-rw-r--r--lisp/speedbar.el24
-rw-r--r--lisp/startup.el11
-rw-r--r--lisp/subr.el126
-rw-r--r--lisp/term.el798
-rw-r--r--lisp/term/mac-win.el377
-rw-r--r--lisp/term/w32-win.el8
-rw-r--r--lisp/term/x-win.el4
-rw-r--r--lisp/textmodes/artist.el17
-rw-r--r--lisp/textmodes/bibtex.el63
-rw-r--r--lisp/textmodes/flyspell.el43
-rw-r--r--lisp/textmodes/ispell.el15
-rw-r--r--lisp/textmodes/org.el2909
-rw-r--r--lisp/textmodes/po.el19
-rw-r--r--lisp/textmodes/sgml-mode.el44
-rw-r--r--lisp/textmodes/table.el16
-rw-r--r--lisp/textmodes/text-mode.el2
-rw-r--r--lisp/tumme.el296
-rw-r--r--lisp/vc.el12
-rw-r--r--lisp/whitespace.el15
-rw-r--r--lisp/window.el2
-rw-r--r--lisp/x-dnd.el10
87 files changed, 6144 insertions, 2947 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d2a569fa76a..24e371c2240 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,8 +1,899 @@
12006-06-07 Kenichi Handa <handa@m17n.org>
2
3 * international/mule.el (find-auto-coding): Don't handle the short
4 name `char-trans'.
5
6 * files.el (hack-local-variables-prop-line)
7 (hack-local-variables): Cancel the previous change.
8
92006-06-06 Jesper Harder <harder@phys.au.dk>
10
11 * ediff-diff.el (ediff-test-utility): Protect against
12 file-error.
13
142006-06-06 Chong Yidong <cyd@stupidchicken.com>
15
16 * diff-mode.el (diff-mode): Set buffer-read-only to t when
17 diff-default-read-only is non-nill.
18 (diff-hunk-kill, diff-file-kill, diff-split-hunk)
19 (diff-refine-hunk): Set inhibit-read-only to t.
20
21 * diff.el (diff-sentinel, diff): Set inhibit-read-only to t when
22 modifying the *Diff* buffer.
23 (diff-process-filter): New filter function for diff process that
24 sets inhibit-read-only to t when modifying the *Diff* buffer.
25
262006-06-06 Carsten Dominik <dominik@science.uva.nl>
27
28 * textmodes/org.el: (org-archive-subtree): Use end-of-subtree as
29 insertion point and control the number of empty lines.
30 (org-paste-subtree): Limit the number of empty lines at the end of
31 the inserted tree.
32 (org-agenda): Use buffer name of current file for narrowing.
33 (org-export-as-xml): Command removed.
34 (org-export-xml-type): Option removed.
35 (org-mode-map): Call `org-export-as-xoxo' directly.
36 (org-get-indentation): New optional argument LINE.
37 (org-fix-indentation, org-remove-tabs): New functions.
38 (org-export-as-ascii, org-ascii-level-start): Determine and apply
39 correct indentation for headlines that are converted it items.
40 (org-skip-comments): Remove table lines that contain narrowing
41 cookies but no other non-empty fields.
42 (org-set-tags): Allow groups of mutually exclusive tags.
43 (org-cmp-time): Sort 24:21 before items without time.
44 (org-get-time-of-day): Fixed the interpretation of 12pm and 12am.
45 (org-open-at-point): Require double colon also for numbers.
46
472006-06-06 Kim F. Storm <storm@cua.dk>
48
49 * ido.el (ido-default-file-method, ido-default-buffer-method):
50 Make choice values consistent with corresponding command names.
51 (ido-visit-buffer): Update accordingly. Default to selected-window.
52
532006-06-06 Nick Roberts <nickrob@snap.net.nz>
54
55 * progmodes/gud.el (gud-running): Fix doc string.
56 (gud-menu-map): Use :visible instead fo :enable for debugger test.
57 (gud-tooltip-modes): Add python-mode.
58 (gud-tooltip-print-command): Add pdb. Remove perldb.
59
602006-06-05 Eli Zaretskii <eliz@gnu.org>
61
62 * makefile.w32-in (bootstrap, $(lisp)/mh-e/mh-loaddefs.el):
63 Quote $(EMACS).
64
652006-06-05 Richard Stallman <rms@gnu.org>
66
67 * faces.el (defined-colors): Doc fix.
68
692006-06-05 Thien-Thi Nguyen <ttn@gnu.org>
70
71 * vc.el (vc-process-filter): Inhibit undo info collection around
72 call to insert.
73 (vc-setup-buffer): Likewise for call to erase-buffer.
74 (vc-do-command): Likewise for call to process-file.
75
762006-06-05 Nick Roberts <nickrob@snap.net.nz>
77
78 * progmodes/gud.el (gud-menu-map): Use a conditional help echo
79 for gud-go.
80 (gud-common-init): Other debuggers may trigger error.
81
822006-06-05 Kenichi Handa <handa@m17n.org>
83
84 * international/mule.el (find-auto-coding): Handle
85 enable-character-translation in file header.
86
872006-06-04 Kim F. Storm <storm@cua.dk>
88
89 * emacs-lisp/authors.el (authors-aliases): Add mode aliases.
90 (authors-fixed-entries): Fix spelling.
91 (authors-canonical-file-name): Don't report error for wildcards.
92
93 * help.el (view-emacs-news): Rewrite to support new NEWS,
94 NEWS.major, and NEWS.1-17 file naming. Add more intelligense,
95 e.g. version 10 matches 1.10, and don't be confused by version 1.1
96 begin a prefix of 1.12 (etc). A numeric prefix arg also works.
97
982006-06-03 Vivek Dasmohapatra <vivek@etla.org>
99
100 * progmodes/sh-script.el (sh-quoted-exec): New face for quoted
101 exec constructs like `foo bar`.
102 (sh-quoted-subshell): New helper function to search for a possibly
103 nested subshell (like `` or $()) within a "" quoted string.
104 (sh-font-lock-keywords-var): Add sh-quoted-exec for Bash.
105 (sh-apply-quoted-subshell): Flag quote characters inside a
106 subshell, which is itself already in a quoted region, as
107 punctuation, since this is the closest to what they actually are.
108 (sh-font-lock-syntactic-keywords): Add sh-quoted-subshell and
109 sh-apply-quoted-subshell.
110 (sh-font-lock-syntactic-face-function): Apply the new face for
111 text inside `` instead of the old font-lock-string-face.
112
1132006-06-03 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
114
115 * term/mac-win.el (mac-ts-active-input-overlay): Add defvar.
116 (mac-ae-number, mac-ae-frame, mac-ae-script-language)
117 (mac-bytes-to-text-range, mac-ae-text-range-array)
118 (mac-ts-update-active-input-buf, mac-split-string-by-property-change)
119 (mac-replace-untranslated-utf-8-chars, mac-ts-update-active-input-area)
120 (mac-ts-unicode-for-key-event): New functions.
121 (mac-handle-toolbar-switch-mode): Use mac-ae-frame.
122 (mac-handle-font-selection): Use mac-ae-number.
123 (mac-ts-active-input-buf, mac-ts-update-active-input-area-seqno):
124 New variables.
125 (mac-ts-caret-position, mac-ts-raw-text, mac-ts-selected-raw-text)
126 (mac-ts-converted-text, mac-ts-selected-converted-text)
127 (mac-ts-block-fill-text, mac-ts-outline-text)
128 (mac-ts-selected-text, mac-ts-no-hilite): New faces.
129 (mac-ts-hilite-style-faces): New constant.
130 (mac-apple-event-map): Bind text input events.
131 (mac-dispatch-apple-event): Use command-execute instead of
132 call-interactively.
133 (global-map): Don't bind mac-apple-event.
134 (special-event-map): Bind mac-apple-event.
135
1362006-06-02 Eli Zaretskii <eliz@gnu.org>
137
138 * makefile.w32-in (EMACS): Remove quotes from the Emacs executable
139 file name.
140 (emacs): Enclose the value of $(EMACS) in quotes.
141
1422006-06-02 Juri Linkov <juri@jurta.org>
143
144 * international/mule.el (sgml-html-meta-auto-coding-function):
145 Remove the condition `(search-forward "<html" size t)'.
146 Replace `\"' with `[\"']?' in `re-search-forward'.
147
1482006-06-02 Kenichi Handa <handa@m17n.org>
149
150 * files.el (hack-local-variables-prop-line): Ignore `char-trans'
151 as well as `coding'.
152 (hack-local-variables): Likewise.
153
154 * international/mule.el (enable-character-translation): Put
155 permanent-local and safe-local-variable properties.
156 (find-auto-coding): Handle char-trans: tag.
157
1582006-06-02 Juri Linkov <juri@jurta.org>
159
160 * international/mule.el (sgml-html-meta-auto-coding-function):
161 Limit the search by the end of the HTML header (if any).
162
1632006-06-01 Richard Stallman <rms@gnu.org>
164
165 * subr.el (with-current-buffer): Doc fix.
166
1672006-06-02 Masatake YAMATO <jet@gyve.org>
168
169 * progmodes/compile.el (compilation-error-regexp-alist-alist::gcov-*):
170 Almost rewrite. Underlines over all lines of gcov output are too
171 uncomfortable to read. Suggested by Dan Nicolaescu.
172
1732006-06-01 Luc Teirlinck <teirllm@auburn.edu>
174
175 * progmodes/inf-lisp.el (inferior-lisp-mode): Doc fixes.
176
177 * shell.el (shell-mode): Use shell-mode-map in docstring.
178
179 * comint.el (comint-send-input): Do not add help-echo and
180 mouse-face to input if `comint-use-prompt-regexp' is non-nil.
181
1822006-06-01 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
183
184 * term/x-win.el: Change x-menu-bar-start to menu-bar-open.
185
1862006-06-01 Nick Roberts <nickrob@snap.net.nz>
187
188 * progmodes/gdb-ui.el (gdb-look-up-stack): New variable.
189 (gdb-stopped, gdb-info-stack-custom): If there is no source info
190 look up the stack and pop up GUD buffer if necessary.
191 (gdb-frames-select): Remove redundant call to gud-display-frame.
192 (gdb-info-threads-custom): Keep point at start of buffer.
193 (gdb-find-file-hook): Make it work for pre-GDB 6.4.
194
1952006-05-31 Juri Linkov <juri@jurta.org>
196
197 * replace.el (query-replace-read-from, query-replace-read-to):
198 Bind `history-add-new-input' to nil. Call `add-to-history'.
199
2002006-05-31 Takaaki Ota <Takaaki.Ota@am.sony.com>
201
202 * textmodes/table.el: Convert all HTML tags to lower case for
203 XHTML compatibility.
204
2052006-05-31 Masatake YAMATO <jet@gyve.org>
206
207 * progmodes/compile.el:
208 (compilation-error-regexp-alist-alist::gcov-called-line):
209 Don't put face on `-' lines in gcov file. Suggested by Dan Nicolaescu.
210
2112006-05-31 Nick Roberts <nickrob@snap.net.nz>
212
213 * progmodes/gud.el (gud-query-cmdline, gud-common-init):
214 Revert inadvertant changes made with last commit.
215
2162006-05-30 Reiner Steib <Reiner.Steib@gmx.de>
217
218 * textmodes/flyspell.el (turn-on-flyspell, turn-off-flyspell):
219 New functions.
220
221 * textmodes/text-mode.el (text-mode-hook): Use turn-on-flyspell.
222
2232006-05-30 Carsten Dominik <dominik@science.uva.nl>
224
225 * textmodes/org.el: (org-agenda-highlight-todo): Make sure regexp
226 only matches in the right place.
227 (org-upcoming-deadline): New face.
228 (org-agenda-get-deadlines): Use new face `org-upcoming-deadline'.
229 (org-export-ascii-underline): Rename constant `org-ascii-underline'
230 and make it an option.
231 (org-export-ascii-bullets): New option.
232 (org-export-as-html): Many changes to emit valid XHTML.
233 (org-par-open): New variable.
234 (org-open-par, org-close-par-maybe, org-close-li-maybe): New functions.
235 (org-html-do-expand, org-section-number): Fixedcase in `replace-match'.
236 (org-timeline): Pass `org-timeline-show-empty-dates' to
237 `org-get-all-dates'. Interpret empty dates returned by `org-get-all-dates'.
238 (org-get-all-dates): New argument EMPTY. Add dates without
239 entries to the list, mark large ranges of empty dates.
240 (org-point-in-group, org-context): New functions.
241
2422006-05-30 Nick Roberts <nickrob@snap.net.nz>
243
244 * progmodes/gud.el (gud-stop-subjob): Make it work in all buffers.
245
246 * progmodes/gdb-ui.el: Move gdb-mouse-toggle-breakpoint-* to
247 C-mouse-1. Move gdb-mouse-until to mouse-3, gdb-mouse-jump
248 to C-mouse-3 (for 2 button mice).
249 (gdb-send): Do the right thing for C-d.
250
251 * speedbar.el (speedbar-detach): Delete.
252 (speedbar-easymenu-definition-trailer): Remove speedbar-detach as
253 it breaks things.
254 (speedbar-reconfigure-keymaps): Always add extra items to pop up menu.
255
2562006-05-30 Daniel Pfeiffer <occitan@esperanto.org>
257
258 * files.el (auto-mode-alist): Add makepp suffix and optional mk on
259 Makeppfile.
260
261 * progmodes/compile.el (compilation-error-regexp-alist-alist):
262 Add makepp diagnostic.
263
2642006-05-29 Richard Stallman <rms@gnu.org>
265
266 * window.el (fit-window-to-buffer): Doc fix.
267
268 * help.el (temp-buffer-max-height): Doc fix.
269
270 * subr.el (with-current-buffer): Doc fix.
271
2722006-05-29 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
273
274 * term/x-win.el: Bind F10 to menu-bar-start if available.
275
2762006-05-28 Dan Nicolaescu <dann@ics.uci.edu>
277
278 * term.el (term-if-xemacs, term-ifnot-xemacs): Delete, replace
279 uses with a simple test.
280 (term-set-escape-char, term-mode, term-check-kill-echo-list)
281 (term-send-raw-string, term-send-raw, term-mouse-paste)
282 (term-char-mode, term-line-mode, term-exec, term-sentinel)
283 (term-handle-exit, term-read-input-ring)
284 (term-previous-matching-input-string)
285 (term-previous-matching-input-string-position)
286 (term-previous-matching-input-from-input)
287 (term-replace-by-expanded-history, term-send-input)
288 (term-skip-prompt, term-bol, term-send-invisible)
289 (term-kill-input, term-delchar-or-maybe-eof)
290 (term-backward-matching-input, term-check-source)
291 (term-proc-query, term-emulate-terminal)
292 (term-handle-colors-array, term-process-pager, term-pager-line)
293 (term-pager-bob, term-unwrap-line, term-word)
294 (term-dynamic-complete-filename)
295 (term-dynamic-complete-as-filename)
296 (term-dynamic-simple-complete): Replace one arm ifs with whens or
297 unlesses.
298
2992006-05-29 Stefan Monnier <monnier@iro.umontreal.ca>
300
301 * files.el (hack-one-local-variable-eval-safep): Don't burp if used
302 during bootstrapping.
303
304 * emacs-lisp/ewoc.el (ewoc--current-dll): Remove.
305 Basically undo the change of 2006-05-26: use extra arguments instead of
306 dynamic scoping.
307 (ewoc-locate): Remove unused var `footer'.
308
3092006-05-28 Stefan Monnier <monnier@iro.umontreal.ca>
310
311 * emacs-lisp/ewoc.el (ewoc--insert-new-node): Use ewoc--refresh-node.
312
313 * emacs-lisp/autoload.el (no-update-autoloads): Declare.
314 (generate-file-autoloads): Obey it. Return whether autoloads were
315 added at point or not.
316 (update-file-autoloads): Use this new return value.
317 Remove redundant test for the presence of an autoload cookie.
318
319 * emacs-lisp/autoload.el (autoload-find-file): New fun.
320 This one calls hack-local-variables.
321 (generate-file-autoloads, update-file-autoloads): Use it.
322
323 * textmodes/bibtex.el (bibtex-autokey-name-case-convert-function)
324 (bibtex-sort-entry-class): Add safe-local-variable predicate.
325 (bibtex-sort-entry-class-alist): Don't set the global value.
326 (bibtex-init-sort-entry-class-alist): New fun.
327 (bibtex-sort-buffer, bibtex-prepare-new-entry): Call it to compute
328 bibtex-init-sort-entry-class-alist from the buffer-local value (if any)
329 of bibtex-init-sort-entry-class.
330
3312006-05-28 Richard Stallman <rms@gnu.org>
332
333 * subr.el (load-history-regexp): If FILE is relative, insist
334 entire last name component must match it.
335 (load-history-filename-element, load-history-regexp): Doc fixes.
336
3372006-05-29 Kim F. Storm <storm@cua.dk>
338
339 * emacs-lisp/bindat.el (bindat-idx, bindat-raw): Rename dynamic vars
340 `pos' and `raw-data' for clarity, as eval forms may access these.
341
3422006-05-28 Kim F. Storm <storm@cua.dk>
343
344 * emacs-lisp/bindat.el (bindat--unpack-u8): Use aref also for strings.
345
3462006-05-28 Stefan Monnier <monnier@iro.umontreal.ca>
347
348 * progmodes/make-mode.el (makefile-browser-map)
349 (makefile-mode-syntax-table): Move initialization inside declaration.
350 (makefile-fill-paragraph): Use the default comment-filling code.
351
3522006-05-28 Chong Yidong <cyd@stupidchicken.com>
353
354 * replace.el (query-replace-defaults): New variable.
355 (query-replace-read-from): Use `query-replace-defaults' for
356 default value, instead of history list.
357 (query-replace-read-to): Update `query-replace-defaults'.
358
3592006-05-27 Chong Yidong <cyd@stupidchicken.com>
360
361 * msb.el (mouse-select-buffer): Minor fix to make popup menu work
362 with no X toolkit.
363
3642006-05-28 Nick Roberts <nickrob@snap.net.nz>
365
366 * tumme.el (tumme-show-all-from-dir-max-files): Fix typo.
367 (tumme-show-all-from-dir): Add autoload.
368
3692006-05-27 Mathias Dahl <mathias.dahl@gmail.com>
370
371 * tumme.el: Change a lot of `(if .. (progn ..)' to `(when ..)'.
372 (tumme-remove-tag): Fix bug.
373
3742006-05-27 Thien-Thi Nguyen <ttn@gnu.org>
375
376 * emacs-lisp/ewoc.el (ewoc--create): No longer take HEADER and
377 FOOTER args. Update unique caller.
378 (ewoc-delete): Compute last node once before looping.
379 (ewoc--node-branch): Merge into unique caller.
380 (ewoc--node): Don't define constructor make-ewoc--node for this
381 structure.
382 (ewoc): Add member `hf-pp' to this structure.
383 (ewoc--wrap): New func.
384 (ewoc-create): Take additional arg NOSEP. If nil, wrap node and
385 header/footer pretty-printers. Save header/footer pretty-printer.
386 (ewoc-set-hf): Use ewoc's header/footer pretty-printer. *
387
388 * pcvs.el (cvs-make-cvs-buffer): Specify NOSEP to `ewoc-create'.
389
3902006-05-27 Mathias Dahl <mathias.dahl@gmail.com>
391
392 * dired.el (dired-mode-map): Change `tumme-tag-remove' to
393 `tumme-delete-tag'. Rename `Remove Image Tag' to `Delete Image
394 Tag'. Change "Compare directories..." to "Change Directories...".
395 Move tumme commands to Operate, Regexp and Immediate menus.
396 Change "Add Comment" to "Add Image Comment". Change "Add Image
397 Tag" to "Add Image Tags".
398
399 * tumme.el (tumme-delete-tag): Rename from `tumme-tag-remove'.
400 (tumme-setup-dired-keybindings): Change `tumme-add-remove' to
401 `tumme-delete-tag'.
402
4032006-05-26 Luc Teirlinck <teirllm@auburn.edu>
404
405 * shell.el (shell-mode): Call shell-dirtrack-mode after
406 list-buffers-directory is made a local variable, to avoid setting
407 the default value.
408
4092006-05-26 Kevin Ryde <user42@zip.com.au>
410
411 * info.el (Info-index-next): Use where-is-internal to report
412 actual binding of Info-index-next, rather than hard-coded `,'.
413
4142006-05-26 Eli Zaretskii <eliz@gnu.org>
415
416 * menu-bar.el (menu-bar-apropos-menu): Move "Find Key in Manual"
417 and "Find Command in Manual" to here.
418
419 * buff-menu.el (list-buffers-noselect): For Info buffers, use
420 Info-current-file as the file name.
421
4222006-05-26 Jonathan Yavner <jyavner@member.fsf.org>
423
424 * ses.el (defadvice undo-more): Delete this defadvice. The undo
425 overrides will now be done a different way.
426 (ses-set-parameter): Reapply this function for undo.
427 (ses-set-header-row): Reconstruct header row during undo.
428 (ses-widen): New function.
429 (ses-goto-data, ses-reconstruct-all): Use new function.
430 (ses-command-hook): Widen buffer during undo, before unupdating
431 the cells.
432 (ses-insert-row, ses-delete-row): Widen buffer during undo.
433 (ses-load, ses-header-row): Permit empty (zero-row) spreadsheets.
434 (ses-read-cell): Avoid stupid warning for RET RET on a cell whose
435 formula hasn't been executed yet.
436
4372006-05-26 Reiner Steib <Reiner.Steib@gmx.de>
438
439 * comint.el (comint-kill-whole-line): Rename arg to count.
440 Fix doc string.
441
4422006-05-26 Chong Yidong <cyd@stupidchicken.com>
443
444 * files.el (backup-buffer-copy): Remove deleted MUSTBENEW argument
445 to copy-file.
446
4472006-05-26 Reiner Steib <Reiner.Steib@gmx.de>
448
449 * simple.el (toggle-truncate-lines): Make arg optional for
450 backward compatibility.
451
4522006-05-26 Thien-Thi Nguyen <ttn@gnu.org>
453
454 * emacs-lisp/ewoc.el (ewoc--current-dll): New var.
455 (ewoc--node-next, ewoc--node-prev, ewoc--node-nth): Don't take
456 DLL arg. Instead, use ewoc--current-dll. Update all callers.
457 (ewoc--set-buffer-bind-dll-let*): Bind ewoc--current-dll, not `dll'.
458 (ewoc--adjust): Use ewoc--current-dll.
459 (ewoc-next, ewoc-prev, ewoc-nth): Bind ewoc--current-dll.
460
4612006-05-26 Carsten Dominik <dominik@science.uva.nl>
462
463 * textmodes/org.el: (org-next-item, org-previous-item): Emit more
464 compact error message.
465 (org-tags-view): Refresh category table in each file.
466 (org-table-justify-field-maybe): Remove superfluous arguments to
467 `format'.
468 (org-export-as-html): Insert "<p>" before postamble.
469 (org-paste-subtree, org-kill-is-subtree-p): Check for empty kill ring.
470
4712006-05-26 Kenichi Handa <handa@m17n.org>
472
473 * textmodes/po.el (po-find-charset): Pay attention to the case
474 FILENAME is a cons (NAME . BUFFER).
475 (po-find-file-coding-system-guts): Likewise.
476
477 * arc-mode.el (archive-set-buffer-as-visiting-file):
478 Call find-operation-coding-system with (FILENAME . BUFFER).
479
480 * tar-mode.el (tar-extract): Call find-operation-coding-system
481 with (FILENAME . BUFFER).
482
483 * international/mule.el (decode-coding-inserted-region):
484 Call find-operation-coding-system with (FILENAME . BUFFER).
485
4862006-05-25 Chong Yidong <cyd@stupidchicken.com>
487
488 * image-mode.el (image-toggle-display): Use buffer contents to
489 generate image for a remote file.
490
4912006-05-25 Juri Linkov <juri@jurta.org>
492
493 * replace.el (query-replace-read-from, query-replace-read-to):
494 Remove 8th arg KEEP-ALL in read-from-minibuffer.
495
4962006-05-25 Rajesh Vaidheeswarran <rv@gnu.org>
497
498 * whitespace.el (whitespace-cleanup): Change to cleanup
499 region if one is active.
500 * whitespace.el (whitespace-cleanup-internal): New internal method.
501
5022006-05-25 Mathias Dahl <mathias.dahl@gmail.com>
503
504 * dired.el (dired-mode-map): Add help-echo strings to tumme
505 commands. Bind `tumme-dired-display-image' to C-t i.
506
507 * tumme.el (tumme-display-image): Change documentation string slightly.
508 (tumme-dired-display-image): Add call to `display-buffer'.
509
5102006-05-25 Thien-Thi Nguyen <ttn@gnu.org>
511
512 * emacs-lisp/bindat.el (bindat-unpack, bindat-pack):
513 Signal error if RAW-DATA is a multibyte string.
514
5152006-05-24 Richard Stallman <rms@gnu.org>
516
517 * subr.el (with-local-quit): When handling `quit' signal,
518 make a chance for quit-flag to cause a quit.
519
520 * emacs-lisp/advice.el (ad-enable-advice, ad-activate)
521 (ad-disable-advice): Add autoloads.
522
523 * subr.el (read-passwd): Copy PROMPT before changing its properties.
524
5252006-05-25 Mathias Dahl <mathias.dahl@gmail.com>
526
527 * dired.el (dired-mode-map): Change menu items for tumme as per
528 suggestions in emacs-devel.
529
5302006-05-25 Nick Roberts <nickrob@snap.net.nz>
531
532 * dired.el (dired-mode-map): Fix breakage.
533
5342006-05-25 Mathias Dahl <mathias.dahl@gmail.com>
535
536 * tumme.el (tumme-display-dired-image): Rename to...
537 (tumme-dired-display-image): ...this.
538 (tumme-track-movement): Change default value to t.
539 (tumme-display-thumbs): Add new optional parameter DO-NOT-POP,
540 used from `tumme-next-line-and-display' and similar commands.
541
542 * dired.el (dired-mode-map): Add Thumbnail submenu under the
543 Immediate menu. Add some tumme commands there.
544
5452006-05-24 Luc Teirlinck <teirllm@auburn.edu>
546
547 * loadup.el ("jka-cmpr-hook"): Load it before it is needed.
548
5492006-05-24 Chong Yidong <cyd@mit.edu>
550
551 * menu-bar.el, international/mule-cmds.el: Remove tooltips for
552 menu entries that open submenus.
553
5542006-05-24 Alan Mackenzie <acm@muc.de>
555
556 * startup.el (command-line): For names of preloaded files, don't
557 append ".elc" (now done in Fload), and call file-truename on the
558 lisp directory.
559
560 * subr.el (eval-after-load): Fix the doc-string. Allow FILE to
561 match ANY loaded file with the right name, not just those in
562 load-path. Put a regexp matching the file name into
563 after-load-alist, rather than the name itself.
564
565 * subr.el: New functions load-history-regexp,
566 load-history-filename-element, do-after-load-evaluation.
567
568 * international/mule.el (load-with-code-conversion): Do the
569 eval-after-load stuff by calling do-after-load-evaluation.
570
5712006-05-25 Nick Roberts <nickrob@snap.net.nz>
572
573 * progmodes/gud.el (gud-sentinel): Condition on GUD buffer if it
574 has not been killed.
575
5762006-05-24 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
577
578 * term/mac-win.el: Set idle timer to clean up expired Apple events.
579 (mac-ae-get-url): Redispatch Apple event on unknown scheme.
580 (mac-dispatch-apple-event): Resume Apple event if it is suspended.
581 Optionally set error message in reply.
582
5832006-05-24 Carsten Dominik <dominik@science.uva.nl>
584
585 * textmodes/org.el: (org-open-at-point): Use renamed variable
586 `org-confirm-shell-link-function'.
587 (org-confirm-shell-link-function): Rename from
588 `org-confirm-shell-links'.
589 (org-export-directory): New function.
590 (org-export-as-ascii, org-export-as-html, org-export-as-xoxo)
591 (org-export-icalendar): Use `org-export-directory'.
592 (org-indent-item): Keep cursor position.
593 (org-link-file-path-type): New option.
594 (org-export-as-html): Fix bug with plain lists starting in
595 column 0.
596 (org-export-as-html): Remove deadline formatting, this happens
597 now already in `org-html-handle-time-stamps'.
598 (org-export-html-style): Deadline class removed.
599 (org-insert-labeled-timestamps-at-point): New option.
600 (org-cycle, org-occur, org-scan-tags): Use `org-overview' instead
601 of `hide-sublevels 1', in case the first headline is not level 1.
602 (org-overview, org-content): New fuction.
603 (org-cycle-global-status, org-cycle-subtree-status): Make these
604 variables buffer-local.
605 (org-global-cycle): New command.
606 (org-shifttab): Use `org-global-cycle'.
607 (org-insert-heading, org-insert-item): Go to end of new
608 headline/item after creating it.
609 (org-export-visible): Rename from `org-export-copy-visible'.
610 Now creates a temporary org-file and applies an exporting command
611 to it.
612 (org-table-eval-formula): Support for lisp forms.
613 (org-agenda-todo-ignore-scheduled): New option.
614 (org-agenda-get-todos): Use new option
615 `org-agenda-todo-ignore-scheduled'.
616 (org-export-html-inline-images): New value `maybe'.
617 (org-export-as-html): Inlining of images dependent on link description.
618 (org-archive-subtree): Check for end-of-buffer before trying
619 `kill-line'.
620 (org-agenda-follow-mode): New option.
621 (org-export-with-tags, org-export-with-timestamps): New options.
622 (org-html-handle-time-stamps): New function.
623 (org-keyword-time-regexp): New variable.
624 (org-agenda-get-todos): Use `org-agenda-todo-list-sublevels'.
625 (org-agenda-todo-list-sublevels): New option.
626 (org-html-level-start): When TITLE is nil, just close all levels.
627 (org-parse-key-lines, org-parse-export-options): Remove functions,
628 replaced by `org-infile-export-plist'.
629 (org-combine-plists, org-infile-export-plist)
630 (org-default-export-plist): New functions.
631 (org-export-html-preamble, org-export-html-postamble)
632 (org-export-html-auto-preamble, org-export-html-auto-postamble):
633 New variables.
634 (org-export-publishing-directory): New option.
635 (org-export-as-html, org-export-as-ascii): Use the new property
636 lists for settings.
637 (org-export-copy-visible, org-export-as-xoxo):
638 Respect `org-export-publishing-directory'.
639 (org-link-search, org-store-link, org-file-apps): Support for
640 links to BibTeX database entries..
641 (org-get-current-options, org-set-regexps-and-options):
642 Implement logging as a startup option.
643 (org-store-link): Make sure context string is never empty
644 (org-insert-link): Use relative path when possible.
645 (org-at-item-checklet-p): New function.
646 (org-shifttab, org-shiftmetaleft, org-shiftmetaright)
647 (org-shiftmetaup, org-shiftmetadown, org-metaleft)
648 (org-metaright, org-metaup, org-metadown, org-shiftup)
649 (org-shiftdown, org-shiftright, org-shiftleft)
650 (org-ctrl-c-ctrl-c, org-cycle, org-return, org-meta-return):
651 Dispatch using `call-interactively'.
652 (org-call-with-arg): New defsubst.
653 (org-tag-alist, org-use-fast-tag-selection): New options.
654 (org-complete): Use `org-tag-alist'.
655 (org-fast-tag-insert, org-fast-tag-selection): New functions.
656 (org-next-item, org-previous-item): New commands.
657 (org-beginning-of-item, org-end-of-item): Add (interactive) to
658 make command.
659 (org-shiftup, org-shiftdown): Accommodate the item-navigation commands.
660
661
6622006-05-23 Thien-Thi Nguyen <ttn@gnu.org>
663
664 * emacs-lisp/ewoc.el (ewoc-delete): New function.
665 (ewoc-filter): Use `ewoc-delete'.
666
667 * emacs-lisp/bindat.el (bindat-pack): Doc fix.
668
6692006-05-22 Stefan Monnier <monnier@iro.umontreal.ca>
670
671 * textmodes/bibtex.el (bibtex-format-entry, bibtex-clean-entry):
672 Signal more user-friendly error messages.
673
674 * complete.el (PC-do-completion): Undo the addition of implicit
675 wildcards if they did not lead to finding any match.
676 (read-file-name-internal): Don't add the final > if the completion is
677 not finished.
678
6792006-05-22 Reiner Steib <Reiner.Steib@gmx.de>
680
681 * textmodes/bibtex.el (bibtex-maintain-sorted-entries):
682 Quote safe-local-variable predicate.
683
6842006-05-22 Thien-Thi Nguyen <ttn@gnu.org>
685
686 * emacs-lisp/ewoc.el (ewoc-set-data): New function.
687
6882006-05-21 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
689
690 * textmodes/bibtex.el (bibtex-maintain-sorted-entries): Mark as safe.
691
692 * progmodes/make-mode.el (makefile-special-targets-list)
693 (makefile-macro-table, makefile-target-table): Mark as risky.
694 (makefile-query-one-target-method): Make this the alias for the
695 following variable.
696 (makefile-query-one-target-method-function): Make this the real name.
697
698 * textmodes/artist.el (artist-text-renderer): Make this the alias
699 for the following variable.
700 (artist-text-renderer-function): Make this the real name.
701
702 * textmodes/flyspell.el (flyspell-generic-check-word-p): Make this
703 the alias for the following variable.
704 (flyspell-generic-check-word-predicate): Make this the real name.
705
706 * textmodes/ispell.el (ispell-format-word): Make this the alias
707 for the following variable.
708 (ispell-format-word-function): Make this the real name.
709 (ispell-message-text-end): Mark as risky.
710
711 * skeleton.el (skeleton-transformation, skeleton-filter)
712 (skeleton-pair-filter): Make these the aliases for the following
713 variables.
714 (skeleton-transformation-function, skeleton-filter-function)
715 (skeleton-pair-filter-function): Make these the real names.
716
717 * progmodes/sh-script.el (sh-mode): Use skeleton-filter-function
718 and skeleton-pair-filter-function.
719
720 * textmodes/sgml-mode.el (sgml-transformation): Make this the
721 alias for the following variable.
722 (sgml-transformation-function): Make this the real name.
723 (sgml-tag-alist): Mark as risky.
724
7252006-05-21 Richard Stallman <rms@gnu.org>
726
727 * simple.el (kill-region): Interactively, pass point, then mark.
728
7292006-05-22 Thien-Thi Nguyen <ttn@gnu.org>
730
731 * emacs-lisp/ewoc.el (ewoc-create): Add autoload cookie.
732
7332006-05-21 Romain Francoise <romain@orebokech.com>
734
735 * dired-x.el (dired-mode-map): Don't bind M-g.
736
7372006-05-20 Richard Stallman <rms@gnu.org>
738
739 * dired.el (dired-mode-map): Put dired-goto-file on j, not M-g.
740 (dired-goto-file): Doc fix.
741
7422006-05-21 Kim F. Storm <storm@cua.dk>
743
744 * emulation/cua-base.el: Mention customizing cua-mode as alternative
745 way to enable built-in cua-mode if user loads older CUA-mode package.
746
747 * ido.el (ido-read-file-name): Bind ido-show-dot-for-dired to nil
748 if default-filename is specified.
749
7502006-05-20 Eli Zaretskii <eliz@gnu.org>
751
752 * menu-bar.el (menu-bar-manuals-menu) <info-apropos>: New menu item.
753
754 * info.el (info-apropos): Make sure current-file and current-node
755 have non-nil values. Speed up by using add-to-list instead of
756 manual consing.
757
7582006-05-20 Micha,Ak(Bl Cadilhac <michael.cadilhac@lrde.org>
759
760 * progmodes/make-mode.el (makefile-mode): Doc fix.
761
7622006-05-20 Eli Zaretskii <eliz@gnu.org>
763
764 * dired-aux.el (dired-do-shell-command): Doc fix.
765
7662006-05-20 Kevin Ryde <user42@zip.com.au>
767
768 * info-xref.el (info-xref-check-all-custom): Skip :tag part of
769 ``(custom-manual :tag "Foo" "(foo)Node")''.
770
7712006-05-20 Karl Chen <quarl@cs.berkeley.edu>
772
773 * progmodes/cc-vars.el (c-backslash-column): Mark as safe if its
774 value is an integer.
775
7762006-05-20 Eli Zaretskii <eliz@gnu.org>
777
778 * mail/rmail.el (rmail-mime-charset-pattern): Add "?:" before
779 "format".
780 (rmail-convert-to-babyl-format): Undo the change from 2006-04-19.
781
7822006-05-20 Martin Rudalics <rudalics@gmx.at>
783
784 * progmodes/hideif.el (show-ifdef-block): Fix bug where parts of
785 a hidden block remained hidden if `hide-ifdef-lines' is non-nil.
786
7872006-05-20 Stefan Monnier <monnier@iro.umontreal.ca>
788
789 * progmodes/gud.el (gdb-script-font-lock-keywords): Use a stricter
790 regexp for keywords.
791
7922006-05-20 Masayuki FUJII <boochang@m4.kcn.ne.jp> (tiny change)
793
794 * dnd.el (dnd-get-local-file-name): Specify LITERAL in
795 replace-regexp-in-string.
796
797 * term/w32-win.el (w32-drag-n-drop): Substitute '/' for '\',
798 encode, and escape file name on conversion to URL.
799
8002006-05-20 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
801
802 * dnd.el (dnd-handle-one-url): Change 3rd arg ARG to URL.
803 Don't unescape URL.
804 (dnd-get-local-file-name): Unescape URL on conversion to file name.
805
806 * x-dnd.el (x-dnd-handle-file-name): Encode and escape file names
807 on conversion to URLs.
808
809 * net/browse-url.el (browse-url-file-url): Encode file name on
810 conversion to URL.
811
812 * term/mac-win.el (mac-ae-open-documents): Escape file name on
813 conversion to URL.
814
8152006-05-19 Eli Zaretskii <eliz@gnu.org>
816
817 * progmodes/cc-styles.el (c-style-alist): Doc fix.
818
8192006-05-19 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
820
821 * term/mac-win.el (mac-bytes-to-digits): Remove function.
822 (mac-handle-toolbar-switch-mode): Use coercion instead of it.
823
8242006-05-19 Glenn Morris <rgm@gnu.org>
825
826 * calendar/diary-lib.el (diary-bahai-date)
827 (list-bahai-diary-entries, mark-bahai-diary-entries)
828 (mark-bahai-calendar-date-pattern): Not interactive.
829 (add-to-diary-list): New optional arg LITERAL. Doc fix.
830 (diary-entries-list): Change format of 4th element in each entry.
831 (diary-list-entries): Use add-to-diary-list.
832 (diary-goto-entry): Handle the case where the buffer visiting the
833 diary has been killed.
834 (fancy-diary-display): Add 'locator to button rather than 'marker.
835 Only generate temp-face when there are marks to apply.
836 (list-sexp-diary-entries): Pass literal to add-to-diary-list.
837 (diary-fancy-date-pattern): New variable.
838 (diary-time-regexp): Doc fix.
839 (diary-anniversary, diary-time): New faces.
840 (fancy-diary-font-lock-keywords): Use diary-fancy-date-pattern and
841 diary-time-regexp. Add font-lock-multiline property where needed.
842 Use new faces diary-anniversary and diary-time.
843 (diary-fancy-font-lock-fontify-region-function): New function, to
844 handle multiline font-lock pattern in fancy diary.
845 (fancy-diary-display-mode): Set font-lock-fontify-region-function.
846 (diary-font-lock-keywords): Tweak time regexp. Use new face
847 diary-time.
848
8492006-05-19 Alexander Shopov <ash@contact.bg> (tiny change)
850
851 * international/code-pages.el (mik): Table corrected.
852
8532006-05-18 Kim F. Storm <storm@cua.dk>
854
855 * progmodes/grep.el (grep-find): Don't check grep-find-command
856 before running command (breaks non-interactive usage).
857
8582006-05-18 Thien-Thi Nguyen <ttn@gnu.org>
859
860 * emacs-lisp/ewoc.el (ewoc--adjust): New func.
861 (ewoc--insert-new-node): Don't insert trailing newline.
862 Instead, adjust successor nodes's start markers.
863 (ewoc--refresh-node): Delete all text from current node's start
864 marker to the next one's; adjust successor nodes's start markers.
865 (ewoc--create): Doc fixes.
866 (ewoc--refresh): Don't insert newline.
867 (ewoc--set-hf): Use `ewoc--set-buffer-bind-dll-let*'.
868 * pcvs.el (cvs-make-cvs-buffer):
869 Specify extra newline for ewoc's header and footer.
870 (cvs-update-header): Update initial header recognition.
871 Append newline to final header and footer values.
872 * pcvs-info.el (cvs-fileinfo-pp): Insert trailing newline.
873
8742006-05-17 Richard Stallman <rms@gnu.org>
875
876 * files.el (file-name-extension): Doc fix.
877
8782006-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
879
880 * shell.el (shell-dirtrack-mode): Make it into a proper minor mode, so
881 we can explicitly enable/disable rather than toggle.
882 (shell-mode): Use it.
883 (shell-cd): Don't try to reproduce what `cd' does.
884
8852006-05-17 Kim F. Storm <storm@cua.dk>
886
887 * ido.el (ido-read-internal): Use only nondirectory part of
888 default item.
889
12006-05-17 Thien-Thi Nguyen <ttn@gnu.org> 8902006-05-17 Thien-Thi Nguyen <ttn@gnu.org>
2 891
3 * emacs-lisp/ewoc.el (ewoc-data): Add docstring. 892 * emacs-lisp/ewoc.el (ewoc-data): Add docstring.
4 (ewoc-nth): Doc fix. 893 (ewoc-nth): Doc fix.
5 894
895 (ewoc-map, ewoc-invalidate): Compute PP before looping.
896
62006-05-16 Eli Zaretskii <eliz@gnu.org> 8972006-05-16 Eli Zaretskii <eliz@gnu.org>
7 898
8 * international/mule.el (auto-coding-alist): Add .lha to files 899 * international/mule.el (auto-coding-alist): Add .lha to files
@@ -161,8 +1052,7 @@
161 Move `safe-local-variable' declarations to the respective files. 1052 Move `safe-local-variable' declarations to the respective files.
162 1053
163 * help-fns.el (describe-variable): Don't print safe-var if it is 1054 * help-fns.el (describe-variable): Don't print safe-var if it is
164 byte-code. Improve wording as suggested by Luc Teirlinck 1055 byte-code. Improve wording as suggested by Luc Teirlinck.
165 <teirllm@auburn.edu>.
166 1056
1672006-05-11 Nick Roberts <nickrob@snap.net.nz> 10572006-05-11 Nick Roberts <nickrob@snap.net.nz>
168 1058
@@ -1289,7 +2179,7 @@
1289 * files.el (hack-local-variables-confirm) <offer-save>: 2179 * files.el (hack-local-variables-confirm) <offer-save>:
1290 Clarify message text. Suggested by Ralf Angeli. 2180 Clarify message text. Suggested by Ralf Angeli.
1291 2181
12922006-04-08 Michael Cadilhac <michael.cadilhac@lrde.org> (tiny change) 21822006-04-08 Michael Cadilhac <michael.cadilhac@lrde.org>
1293 2183
1294 * rect.el (kill-rectangle): Don't barf if `kill-read-only-ok' is set. 2184 * rect.el (kill-rectangle): Don't barf if `kill-read-only-ok' is set.
1295 (delete-extract-rectangle-line): Use `filter-buffer-substring' 2185 (delete-extract-rectangle-line): Use `filter-buffer-substring'
@@ -8117,7 +9007,7 @@
8117 since the last ping. 9007 since the last ping.
8118 (rcirc-mode): Give rcirc-topic a local binding here. 9008 (rcirc-mode): Give rcirc-topic a local binding here.
8119 9009
81202005-11-19 Michael Cadilhac <michael.cadilhac@lrde.org> (tiny change) 90102005-11-19 Michael Cadilhac <michael.cadilhac@lrde.org>
8121 9011
8122 * subr.el (read-passwd): Fontify the prompt as we do with other 9012 * subr.el (read-passwd): Fontify the prompt as we do with other
8123 prompts. 9013 prompts.
@@ -9728,7 +10618,7 @@
9728 10618
9729 * dired-x.el (dired-virtual): Don't use `dired-insert-headerline'. 10619 * dired-x.el (dired-virtual): Don't use `dired-insert-headerline'.
9730 10620
97312005-10-25 Michael Cadilhac <michael.cadilhac-@t-lrde.epita.fr> (tiny change) 106212005-10-25 Michael Cadilhac <michael.cadilhac-@t-lrde.epita.fr>
9732 10622
9733 * play/blackbox.el (blackbox-redefine-key): New function. 10623 * play/blackbox.el (blackbox-redefine-key): New function.
9734 (blackbox-mode-map): Use it to remap existing bindings for cursor 10624 (blackbox-mode-map): Use it to remap existing bindings for cursor
@@ -10992,7 +11882,7 @@
10992 * progmodes/gdb-ui.el (gdb-fringe-width -> gdb-buffer-fringe-width): 11882 * progmodes/gdb-ui.el (gdb-fringe-width -> gdb-buffer-fringe-width):
10993 Typo. 11883 Typo.
10994 11884
109952005-10-06 Michael Cadilhac <michael.cadilhac-@t-lrde.epita.fr> (tiny change) 118852005-10-06 Michael Cadilhac <michael.cadilhac-@t-lrde.epita.fr>
10996 11886
10997 * play/zone.el (zone): Wrap body with save-window-excursion. 11887 * play/zone.el (zone): Wrap body with save-window-excursion.
10998 11888
@@ -11787,7 +12677,7 @@
11787 * calendar/diary-lib.el (mark-diary-entries): Rearrange to wrap 12677 * calendar/diary-lib.el (mark-diary-entries): Rearrange to wrap
11788 with-current-buffer form in save-excursion. 12678 with-current-buffer form in save-excursion.
11789 12679
117902005-09-18 D Goel <deego@gnufans.org> 126802005-09-18 Deepak Goel <deego@gnufans.org>
11791 12681
11792 * apropos.el (apropos-command): Fix `message' call: first arg 12682 * apropos.el (apropos-command): Fix `message' call: first arg
11793 should be a format spec. In this and all other cases that appear 12683 should be a format spec. In this and all other cases that appear
@@ -21214,7 +22104,7 @@
21214 22104
21215 * simple.el (goto-line): Doc fix. 22105 * simple.el (goto-line): Doc fix.
21216 22106
212172005-03-19 Aaron Hawley <Aaron.Hawley@uvm.edu> (tiny change) 221072005-03-19 Aaron S. Hawley <Aaron.Hawley@uvm.edu>
21218 22108
21219 * files.el (save-buffer): Doc fix. 22109 * files.el (save-buffer): Doc fix.
21220 22110
diff --git a/lisp/ChangeLog.5 b/lisp/ChangeLog.5
index dad524ed851..5aedc76efed 100644
--- a/lisp/ChangeLog.5
+++ b/lisp/ChangeLog.5
@@ -2779,7 +2779,7 @@
2779 continuations, don't go to line beg; 2779 continuations, don't go to line beg;
2780 perl-backward-to-start-of-continued-exp gives the right place. 2780 perl-backward-to-start-of-continued-exp gives the right place.
2781 2781
27821995-03-07 Enami Tsugutomo <enami@sys.ptg.sony.co.jp> 27821995-03-07 Tsugutomo ENAMI <enami@sys.ptg.sony.co.jp>
2783 2783
2784 * simple.el (indent-new-comment-line): Clean up handling 2784 * simple.el (indent-new-comment-line): Clean up handling
2785 of \(...\) in comment-start-skip. 2785 of \(...\) in comment-start-skip.
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 5b08182b7ee..2db56d0450a 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -898,8 +898,9 @@ using `make-temp-file', and the generated name is returned."
898 ;; extracted file existed. 898 ;; extracted file existed.
899 (let ((file-name-handler-alist 899 (let ((file-name-handler-alist
900 '(("" . archive-file-name-handler)))) 900 '(("" . archive-file-name-handler))))
901 (car (find-operation-coding-system 'insert-file-contents 901 (car (find-operation-coding-system
902 filename t)))))) 902 'insert-file-contents
903 (cons filename (current-buffer)) t))))))
903 (if (and (not coding-system-for-read) 904 (if (and (not coding-system-for-read)
904 (not enable-multibyte-characters)) 905 (not enable-multibyte-characters))
905 (setq coding 906 (setq coding
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 3094da3bfe8..4998c1edf07 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -116,6 +116,8 @@ This variable determines whether reverting the buffer lists only
116file buffers. It affects both manual reverting and reverting by 116file buffers. It affects both manual reverting and reverting by
117Auto Revert Mode.") 117Auto Revert Mode.")
118 118
119(defvar Info-current-file) ;; from info.el
120
119(make-variable-buffer-local 'Buffer-menu-files-only) 121(make-variable-buffer-local 'Buffer-menu-files-only)
120 122
121(if Buffer-menu-mode-map 123(if Buffer-menu-mode-map
@@ -767,10 +769,24 @@ For more information, see the function `buffer-menu'."
767 ?\s))) 769 ?\s)))
768 (unless file 770 (unless file
769 ;; No visited file. Check local value of 771 ;; No visited file. Check local value of
770 ;; list-buffers-directory. 772 ;; list-buffers-directory and, for Info buffers,
771 (when (and (boundp 'list-buffers-directory) 773 ;; Info-current-file.
772 list-buffers-directory) 774 (cond ((and (boundp 'list-buffers-directory)
773 (setq file list-buffers-directory))) 775 list-buffers-directory)
776 (setq file list-buffers-directory))
777 ((eq major-mode 'Info-mode)
778 (setq file Info-current-file)
779 (cond
780 ((eq file t)
781 (setq file "*Info Directory*"))
782 ((eq file 'apropos)
783 (setq file "*Info Apropos*"))
784 ((eq file 'history)
785 (setq file "*Info History*"))
786 ((eq file 'toc)
787 (setq file "*Info TOC*"))
788 ((not (stringp file)) ;; avoid errors
789 (setq file nil))))))
774 (push (list buffer bits name (buffer-size) mode file) 790 (push (list buffer bits name (buffer-size) mode file)
775 list)))))) 791 list))))))
776 ;; Preserve the original buffer-list ordering, just in case. 792 ;; Preserve the original buffer-list ordering, just in case.
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index c27939b8075..95588fccd92 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -121,20 +121,16 @@ The holidays are those in the list `calendar-holidays'.")
121 "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.") 121 "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.")
122 122
123(autoload 'diary-bahai-date "cal-bahai" 123(autoload 'diary-bahai-date "cal-bahai"
124 "Baha'i calendar equivalent of date diary entry." 124 "Baha'i calendar equivalent of date diary entry.")
125 t)
126 125
127(autoload 'list-bahai-diary-entries "cal-bahai" 126(autoload 'list-bahai-diary-entries "cal-bahai"
128 "Add any Baha'i date entries from the diary file to `diary-entries-list'." 127 "Add any Baha'i date entries from the diary file to `diary-entries-list'.")
129 t)
130 128
131(autoload 'mark-bahai-diary-entries "cal-bahai" 129(autoload 'mark-bahai-diary-entries "cal-bahai"
132 "Mark days in the calendar window that have Baha'i date diary entries." 130 "Mark days in the calendar window that have Baha'i date diary entries.")
133 t)
134 131
135(autoload 'mark-bahai-calendar-date-pattern "cal-bahai" 132(autoload 'mark-bahai-calendar-date-pattern "cal-bahai"
136 "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR." 133 "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR.")
137 t)
138 134
139(autoload 'diary-hebrew-date "cal-hebrew" 135(autoload 'diary-hebrew-date "cal-hebrew"
140 "Hebrew calendar equivalent of date diary entry.") 136 "Hebrew calendar equivalent of date diary entry.")
@@ -323,6 +319,42 @@ number of days of diary entries displayed."
323 (integer :tag "Saturday"))) 319 (integer :tag "Saturday")))
324 :group 'diary) 320 :group 'diary)
325 321
322
323(defvar diary-modify-entry-list-string-function nil
324 "Function applied to entry string before putting it into the entries list.
325Can be used by programs integrating a diary list into other buffers (e.g.
326org.el and planner.el) to modify the string or add properties to it.
327The function takes a string argument and must return a string.")
328
329(defun add-to-diary-list (date string specifier &optional marker
330 globcolor literal)
331 "Add an entry to `diary-entries-list'.
332Do nothing if DATE or STRING is nil. DATE is the (MONTH DAY
333YEAR) for which the entry applies; STRING is the text of the
334entry as it will appear in the diary (i.e. with any format
335strings such as \"%d\" expanded); SPECIFIER is the date part of
336the entry as it appears in the diary-file; LITERAL is the entry
337as it appears in the diary-file (i.e. before expansion). If
338LITERAL is nil, it is taken to be the same as STRING.
339
340The entry is added to the list as (DATE STRING SPECIFIER LOCATOR
341GLOBCOLOR), where LOCATOR has the form (MARKER FILENAME LITERAL),
342FILENAME being the file containing the diary entry."
343 (when (and date string)
344 (if diary-file-name-prefix
345 (let ((prefix (funcall diary-file-name-prefix-function
346 (buffer-file-name))))
347 (or (string= prefix "")
348 (setq string (format "[%s] %s" prefix string)))))
349 (and diary-modify-entry-list-string-function
350 (setq string (funcall diary-modify-entry-list-string-function
351 string)))
352 (setq diary-entries-list
353 (append diary-entries-list
354 (list (list date string specifier
355 (list marker (buffer-file-name) literal)
356 globcolor))))))
357
326(define-obsolete-function-alias 'list-diary-entries 'diary-list-entries) 358(define-obsolete-function-alias 'list-diary-entries 'diary-list-entries)
327(defun diary-list-entries (date number &optional list-only) 359(defun diary-list-entries (date number &optional list-only)
328 "Create and display a buffer containing the relevant lines in `diary-file'. 360 "Create and display a buffer containing the relevant lines in `diary-file'.
@@ -468,9 +500,7 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list."
468 (copy-marker entry-start) (nth 1 temp))))))) 500 (copy-marker entry-start) (nth 1 temp)))))))
469 (or entry-found 501 (or entry-found
470 (not diary-list-include-blanks) 502 (not diary-list-include-blanks)
471 (setq diary-entries-list 503 (add-to-diary-list date "" "" "" ""))
472 (append diary-entries-list
473 (list (list date "" "" "" "")))))
474 (setq date 504 (setq date
475 (calendar-gregorian-from-absolute 505 (calendar-gregorian-from-absolute
476 (1+ (calendar-absolute-from-gregorian date)))) 506 (1+ (calendar-absolute-from-gregorian date))))
@@ -577,10 +607,27 @@ changing the variable `diary-include-string'."
577 'face 'diary-button) 607 'face 'diary-button)
578 608
579(defun diary-goto-entry (button) 609(defun diary-goto-entry (button)
580 (let ((marker (button-get button 'marker))) 610 (let* ((locator (button-get button 'locator))
581 (when marker 611 (marker (car locator))
582 (pop-to-buffer (marker-buffer marker)) 612 markbuf file)
583 (goto-char (marker-position marker))))) 613 ;; If marker pointing to diary location is valid, use that.
614 (if (and marker (setq markbuf (marker-buffer marker)))
615 (progn
616 (pop-to-buffer markbuf)
617 (goto-char (marker-position marker)))
618 ;; Marker is invalid (eg buffer has been killed).
619 (or (and (setq file (cadr locator))
620 (file-exists-p file)
621 (find-file-other-window file)
622 (progn
623 (when (eq major-mode default-major-mode) (diary-mode))
624 (goto-char (point-min))
625 (if (re-search-forward (format "%s.*\\(%s\\)"
626 (regexp-quote (nth 2 locator))
627 (regexp-quote (nth 3 locator)))
628 nil t)
629 (goto-char (match-beginning 1)))))
630 (message "Unable to locate this diary entry")))))
584 631
585(defun fancy-diary-display () 632(defun fancy-diary-display ()
586 "Prepare a diary buffer with relevant entries in a fancy, noneditable form. 633 "Prepare a diary buffer with relevant entries in a fancy, noneditable form.
@@ -666,37 +713,45 @@ This function is provided for optional use as the `diary-display-hook'."
666 713
667 (setq entry (car (cdr (car entry-list)))) 714 (setq entry (car (cdr (car entry-list))))
668 (if (< 0 (length entry)) 715 (if (< 0 (length entry))
669 (progn 716 (let ((this-entry (car entry-list))
670 (if (nth 3 (car entry-list)) 717 this-loc)
718 (if (setq this-loc (nth 3 this-entry))
671 (insert-button (concat entry "\n") 719 (insert-button (concat entry "\n")
672 'marker (nth 3 (car entry-list)) 720 ;; (MARKER FILENAME SPECIFIER LITERAL)
721 'locator (list (car this-loc)
722 (cadr this-loc)
723 (nth 2 this-entry)
724 (or (nth 2 this-loc)
725 (nth 1 this-entry)))
673 :type 'diary-entry) 726 :type 'diary-entry)
674 (insert entry ?\n)) 727 (insert entry ?\n))
675 (save-excursion 728 (save-excursion
676 (let* ((marks (nth 4 (car entry-list))) 729 (let* ((marks (nth 4 this-entry))
677 (temp-face (make-symbol 730 (faceinfo marks)
678 (apply 731 temp-face)
679 'concat "temp-face-" 732 (when marks
680 (mapcar (lambda (sym) 733 (setq temp-face (make-symbol
681 (if (stringp sym) 734 (apply
682 sym 735 'concat "temp-face-"
683 (symbol-name sym))) 736 (mapcar (lambda (sym)
684 marks)))) 737 (if (stringp sym)
685 (faceinfo marks)) 738 sym
686 (make-face temp-face) 739 (symbol-name sym)))
687 ;; Remove :face info from the marks, 740 marks))))
688 ;; copy the face info into temp-face 741 (make-face temp-face)
689 (while (setq faceinfo (memq :face faceinfo)) 742 ;; Remove :face info from the marks,
690 (copy-face (read (nth 1 faceinfo)) temp-face) 743 ;; copy the face info into temp-face
691 (setcar faceinfo nil) 744 (while (setq faceinfo (memq :face faceinfo))
692 (setcar (cdr faceinfo) nil)) 745 (copy-face (read (nth 1 faceinfo)) temp-face)
693 (setq marks (delq nil marks)) 746 (setcar faceinfo nil)
694 ;; Apply the font aspects. 747 (setcar (cdr faceinfo) nil))
695 (apply 'set-face-attribute temp-face nil marks) 748 (setq marks (delq nil marks))
696 (search-backward entry) 749 ;; Apply the font aspects.
697 (overlay-put 750 (apply 'set-face-attribute temp-face nil marks)
698 (make-overlay (match-beginning 0) (match-end 0)) 751 (search-backward entry)
699 'face temp-face))))) 752 (overlay-put
753 (make-overlay (match-beginning 0) (match-end 0))
754 'face temp-face))))))
700 (setq entry-list (cdr entry-list)))) 755 (setq entry-list (cdr entry-list))))
701 (set-buffer-modified-p nil) 756 (set-buffer-modified-p nil)
702 (goto-char (point-min)) 757 (goto-char (point-min))
@@ -1350,7 +1405,7 @@ best if they are nonmarking."
1350 (setq line-start (point))) 1405 (setq line-start (point)))
1351 (setq specifier 1406 (setq specifier
1352 (buffer-substring-no-properties (1+ line-start) (point)) 1407 (buffer-substring-no-properties (1+ line-start) (point))
1353 entry-start (1+ line-start)) 1408 entry-start (1+ line-start))
1354 (forward-char 1) 1409 (forward-char 1)
1355 (if (and (or (char-equal (preceding-char) ?\^M) 1410 (if (and (or (char-equal (preceding-char) ?\^M)
1356 (char-equal (preceding-char) ?\n)) 1411 (char-equal (preceding-char) ?\n))
@@ -1367,24 +1422,26 @@ best if they are nonmarking."
1367 (while (string-match "[\^M]" entry) 1422 (while (string-match "[\^M]" entry)
1368 (aset entry (match-beginning 0) ?\n ))) 1423 (aset entry (match-beginning 0) ?\n )))
1369 (let ((diary-entry (diary-sexp-entry sexp entry date)) 1424 (let ((diary-entry (diary-sexp-entry sexp entry date))
1370 temp) 1425 temp literal)
1371 (setq entry (if (consp diary-entry) 1426 (setq literal entry ; before evaluation
1372 (cdr diary-entry) 1427 entry (if (consp diary-entry)
1373 diary-entry)) 1428 (cdr diary-entry)
1429 diary-entry))
1374 (if diary-entry 1430 (if diary-entry
1375 (progn 1431 (progn
1376 (remove-overlays line-start (point) 'invisible 'diary) 1432 (remove-overlays line-start (point) 'invisible 'diary)
1377 (if (< 0 (length entry)) 1433 (if (< 0 (length entry))
1378 (setq temp (diary-pull-attrs entry file-glob-attrs) 1434 (setq temp (diary-pull-attrs entry file-glob-attrs)
1379 entry (nth 0 temp) 1435 entry (nth 0 temp)
1380 marks (nth 1 temp))))) 1436 marks (nth 1 temp)))))
1381 (add-to-diary-list date 1437 (add-to-diary-list date
1382 entry 1438 entry
1383 specifier 1439 specifier
1384 (if entry-start (copy-marker entry-start) 1440 (if entry-start (copy-marker entry-start)
1385 nil) 1441 nil)
1386 marks) 1442 marks
1387 (setq entry-found (or entry-found diary-entry))))) 1443 literal)
1444 (setq entry-found (or entry-found diary-entry)))))
1388 entry-found)) 1445 entry-found))
1389 1446
1390(defun diary-sexp-entry (sexp entry date) 1447(defun diary-sexp-entry (sexp entry date)
@@ -1636,28 +1693,6 @@ marked on the calendar."
1636 (or (diary-remind sexp (car days) marking) 1693 (or (diary-remind sexp (car days) marking)
1637 (diary-remind sexp (cdr days) marking)))))) 1694 (diary-remind sexp (cdr days) marking))))))
1638 1695
1639(defvar diary-modify-entry-list-string-function nil
1640 "Function applied to entry string before putting it into the entries list.
1641Can be used by programs integrating a diary list into other buffers (e.g.
1642org.el and planner.el) to modify the string or add properties to it.
1643The function takes a string argument and must return a string.")
1644
1645(defun add-to-diary-list (date string specifier &optional marker globcolor)
1646 "Add the entry (DATE STRING SPECIFIER MARKER GLOBCOLOR) to `diary-entries-list'.
1647Do nothing if DATE or STRING is nil."
1648 (when (and date string)
1649 (if diary-file-name-prefix
1650 (let ((prefix (funcall diary-file-name-prefix-function
1651 (buffer-file-name))))
1652 (or (string= prefix "")
1653 (setq string (format "[%s] %s" prefix string)))))
1654 (and diary-modify-entry-list-string-function
1655 (setq string (funcall diary-modify-entry-list-string-function
1656 string)))
1657 (setq diary-entries-list
1658 (append diary-entries-list
1659 (list (list date string specifier marker globcolor))))))
1660
1661(defun diary-redraw-calendar () 1696(defun diary-redraw-calendar ()
1662 "If `calendar-buffer' is live and diary entries are marked, redraw it." 1697 "If `calendar-buffer' is live and diary entries are marked, redraw it."
1663 (and mark-diary-entries-in-calendar 1698 (and mark-diary-entries-in-calendar
@@ -1796,36 +1831,86 @@ Prefix arg will make the entry nonmarking."
1796 (if diary-header-line-flag 1831 (if diary-header-line-flag
1797 (setq header-line-format diary-header-line-format))) 1832 (setq header-line-format diary-header-line-format)))
1798 1833
1799(define-derived-mode fancy-diary-display-mode fundamental-mode
1800 "Diary"
1801 "Major mode used while displaying diary entries using Fancy Display."
1802 (set (make-local-variable 'font-lock-defaults)
1803 '(fancy-diary-font-lock-keywords t))
1804 (local-set-key "q" 'quit-window))
1805 1834
1835(defvar diary-fancy-date-pattern
1836 (concat
1837 (let ((dayname (diary-name-pattern calendar-day-name-array nil t))
1838 (monthname (diary-name-pattern calendar-month-name-array nil t))
1839 (day "[0-9]+")
1840 (month "[0-9]+")
1841 (year "-?[0-9]+"))
1842 (mapconcat 'eval calendar-date-display-form ""))
1843 ;; Optional ": holiday name" after the date.
1844 "\\(: .*\\)?")
1845 "Regular expression matching a date header in Fancy Diary.")
1846
1847(defconst diary-time-regexp
1848 ;; Accepted formats: 10:00 10.00 10h00 10h 10am 10:00am 10.00am
1849 ;; Use of "." as a separator annoyingly matches numbers, eg "123.45".
1850 ;; Hence often prefix this with "\\(^\\|\\s-\\)."
1851 (concat "[0-9]?[0-9]\\([AaPp][mM]\\|\\("
1852 "[Hh]\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]"
1853 "\\)\\([AaPp][Mm]\\)?\\)")
1854 "Regular expression matching a time of day.")
1855
1856(defface diary-anniversary '((t :inherit font-lock-keyword-face))
1857 "Face used for anniversaries in the diary."
1858 :version "22.1"
1859 :group 'diary)
1860
1861(defface diary-time '((t :inherit font-lock-variable-name-face))
1862 "Face used for times of day in the diary."
1863 :version "22.1"
1864 :group 'diary)
1806 1865
1807(defvar fancy-diary-font-lock-keywords 1866(defvar fancy-diary-font-lock-keywords
1808 (list 1867 (list
1809 (cons 1868 (list
1810 (concat 1869 ;; Any number of " other holiday name" lines, followed by "==" line.
1811 (let ((dayname (diary-name-pattern calendar-day-name-array nil t)) 1870 (concat diary-fancy-date-pattern "\\(\n +.*\\)*\n=+$")
1812 (monthname (diary-name-pattern calendar-month-name-array nil t)) 1871 '(0 (progn (put-text-property (match-beginning 0) (match-end 0)
1813 (day "[0-9]+") 1872 'font-lock-multiline t)
1814 (month "[0-9]+") 1873 diary-face)))
1815 (year "-?[0-9]+")) 1874 '("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary)
1816 (mapconcat 'eval calendar-date-display-form ""))
1817 "\\(\\(: .*\\)\\|\\(\n +.*\\)\\)*\n=+$")
1818 'diary-face)
1819 '("^.*anniversary.*$" . font-lock-keyword-face)
1820 '("^.*birthday.*$" . font-lock-keyword-face)
1821 '("^.*Yahrzeit.*$" . font-lock-reference-face) 1875 '("^.*Yahrzeit.*$" . font-lock-reference-face)
1822 '("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face) 1876 '("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face)
1823 '("^Day.*omer.*$" . font-lock-builtin-face) 1877 '("^Day.*omer.*$" . font-lock-builtin-face)
1824 '("^Parashat.*$" . font-lock-comment-face) 1878 '("^Parashat.*$" . font-lock-comment-face)
1825 '("^[ \t]*[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)?\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)?\\)?" 1879 `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
1826 . font-lock-variable-name-face)) 1880 diary-time-regexp) . 'diary-time))
1827 "Keywords to highlight in fancy diary display") 1881 "Keywords to highlight in fancy diary display")
1828 1882
1883;; If region looks like it might start or end in the middle of a
1884;; multiline pattern, extend the region to encompass the whole pattern.
1885(defun diary-fancy-font-lock-fontify-region-function (beg end &optional verbose)
1886 "Function to use for `font-lock-fontify-region-function' in Fancy Diary.
1887Needed to handle multiline keyword in `fancy-diary-font-lock-keywords'."
1888 (goto-char beg)
1889 (forward-line 0)
1890 (if (looking-at "=+$") (forward-line -1))
1891 (while (and (looking-at " +[^ ]")
1892 (zerop (forward-line -1))))
1893 ;; This check not essential.
1894 (if (looking-at diary-fancy-date-pattern)
1895 (setq beg (line-beginning-position)))
1896 (goto-char end)
1897 (forward-line 0)
1898 (while (and (looking-at " +[^ ]")
1899 (zerop (forward-line 1))))
1900 (if (looking-at "=+$")
1901 (setq end (line-beginning-position 2)))
1902 (font-lock-default-fontify-region beg end verbose))
1903
1904(define-derived-mode fancy-diary-display-mode fundamental-mode
1905 "Diary"
1906 "Major mode used while displaying diary entries using Fancy Display."
1907 (set (make-local-variable 'font-lock-defaults)
1908 '(fancy-diary-font-lock-keywords
1909 t nil nil nil
1910 (font-lock-fontify-region-function
1911 . diary-fancy-font-lock-fontify-region-function)))
1912 (local-set-key "q" 'quit-window))
1913
1829 1914
1830(defun diary-font-lock-sexps (limit) 1915(defun diary-font-lock-sexps (limit)
1831 "Recognize sexp diary entry for font-locking." 1916 "Recognize sexp diary entry for font-locking."
@@ -1877,13 +1962,6 @@ names."
1877(eval-when-compile (require 'cal-hebrew) 1962(eval-when-compile (require 'cal-hebrew)
1878 (require 'cal-islam)) 1963 (require 'cal-islam))
1879 1964
1880(defconst diary-time-regexp
1881 ;; Formats that should be accepted:
1882 ;; 10:00 10.00 10h00 10h 10am 10:00am 10.00am
1883 (concat "[0-9]?[0-9]\\([AaPp][mM]\\|\\("
1884 "[Hh]\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]"
1885 "\\)\\([AaPp][Mm]\\)?\\)"))
1886
1887(defvar diary-font-lock-keywords 1965(defvar diary-font-lock-keywords
1888 (append 1966 (append
1889 (diary-font-lock-date-forms calendar-month-name-array 1967 (diary-font-lock-date-forms calendar-month-name-array
@@ -1924,10 +2002,9 @@ names."
1924 "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)") 2002 "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)")
1925 '(1 font-lock-reference-face)) 2003 '(1 font-lock-reference-face))
1926 '(diary-font-lock-sexps . font-lock-keyword-face) 2004 '(diary-font-lock-sexps . font-lock-keyword-face)
1927 (cons 2005 `(,(concat "\\(^\\|\\s-\\)"
1928 (concat ;; "^[ \t]+" 2006 diary-time-regexp "\\(-" diary-time-regexp "\\)?")
1929 diary-time-regexp "\\(-" diary-time-regexp "\\)?") 2007 . 'diary-time)))
1930 'font-lock-function-name-face)))
1931 "Forms to highlight in `diary-mode'.") 2008 "Forms to highlight in `diary-mode'.")
1932 2009
1933 2010
diff --git a/lisp/comint.el b/lisp/comint.el
index 1b9d8df738f..eb5c9f28a4e 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -1047,12 +1047,12 @@ Moves relative to `comint-input-ring-index'."
1047(defun comint-previous-input (arg) 1047(defun comint-previous-input (arg)
1048 "Cycle backwards through input history, saving input." 1048 "Cycle backwards through input history, saving input."
1049 (interactive "*p") 1049 (interactive "*p")
1050 (if (and comint-input-ring-index 1050 (if (and comint-input-ring-index
1051 (or ;; leaving the "end" of the ring 1051 (or ;; leaving the "end" of the ring
1052 (and (< arg 0) ; going down 1052 (and (< arg 0) ; going down
1053 (eq comint-input-ring-index 0)) 1053 (eq comint-input-ring-index 0))
1054 (and (> arg 0) ; going up 1054 (and (> arg 0) ; going up
1055 (eq comint-input-ring-index 1055 (eq comint-input-ring-index
1056 (1- (ring-length comint-input-ring))))) 1056 (1- (ring-length comint-input-ring)))))
1057 comint-stored-incomplete-input) 1057 comint-stored-incomplete-input)
1058 (comint-restore-input) 1058 (comint-restore-input)
@@ -1510,23 +1510,23 @@ Similarly for Soar, Scheme, etc."
1510 (concat input "\n"))) 1510 (concat input "\n")))
1511 1511
1512 (let ((beg (marker-position pmark)) 1512 (let ((beg (marker-position pmark))
1513 (end (if no-newline (point) (1- (point)))) 1513 (end (if no-newline (point) (1- (point))))
1514 (inhibit-modification-hooks t)) 1514 (inhibit-modification-hooks t))
1515 (when (> end beg) 1515 (when (> end beg)
1516 ;; Set text-properties for the input field 1516 (add-text-properties beg end
1517 (add-text-properties 1517 '(front-sticky t
1518 beg end 1518 font-lock-face comint-highlight-input))
1519 '(front-sticky t
1520 font-lock-face comint-highlight-input
1521 mouse-face highlight
1522 help-echo "mouse-2: insert after prompt as new input"))
1523 (unless comint-use-prompt-regexp 1519 (unless comint-use-prompt-regexp
1524 ;; Give old user input a field property of `input', to 1520 ;; Give old user input a field property of `input', to
1525 ;; distinguish it from both process output and unsent 1521 ;; distinguish it from both process output and unsent
1526 ;; input. The terminating newline is put into a special 1522 ;; input. The terminating newline is put into a special
1527 ;; `boundary' field to make cursor movement between input 1523 ;; `boundary' field to make cursor movement between input
1528 ;; and output fields smoother. 1524 ;; and output fields smoother.
1529 (put-text-property beg end 'field 'input))) 1525 (add-text-properties
1526 beg end
1527 '(mouse-face highlight
1528 help-echo "mouse-2: insert after prompt as new input"
1529 field input))))
1530 (unless (or no-newline comint-use-prompt-regexp) 1530 (unless (or no-newline comint-use-prompt-regexp)
1531 ;; Cover the terminating newline 1531 ;; Cover the terminating newline
1532 (add-text-properties end (1+ end) 1532 (add-text-properties end (1+ end)
@@ -2357,19 +2357,19 @@ preceding newline is removed."
2357 (when (eq (get-text-property (1- pt) 'read-only) 'fence) 2357 (when (eq (get-text-property (1- pt) 'read-only) 'fence)
2358 (remove-list-of-text-properties (1- pt) pt '(read-only))))))) 2358 (remove-list-of-text-properties (1- pt) pt '(read-only)))))))
2359 2359
2360(defun comint-kill-whole-line (&optional arg) 2360(defun comint-kill-whole-line (&optional count)
2361 "Kill current line, ignoring read-only and field properties. 2361 "Kill current line, ignoring read-only and field properties.
2362With prefix arg, kill that many lines starting from the current line. 2362With prefix arg COUNT, kill that many lines starting from the current line.
2363If arg is negative, kill backward. Also kill the preceding newline, 2363If COUNT is negative, kill backward. Also kill the preceding newline,
2364instead of the trailing one. \(This is meant to make \\[repeat] work well 2364instead of the trailing one. \(This is meant to make \\[repeat] work well
2365with negative arguments.) 2365with negative arguments.)
2366If arg is zero, kill current line but exclude the trailing newline. 2366If COUNT is zero, kill current line but exclude the trailing newline.
2367The read-only status of newlines is updated with `comint-update-fence', 2367The read-only status of newlines is updated with `comint-update-fence',
2368if necessary." 2368if necessary."
2369 (interactive "p") 2369 (interactive "p")
2370 (let ((inhibit-read-only t) (inhibit-field-text-motion t)) 2370 (let ((inhibit-read-only t) (inhibit-field-text-motion t))
2371 (kill-whole-line arg) 2371 (kill-whole-line count)
2372 (when (>= arg 0) (comint-update-fence)))) 2372 (when (>= count 0) (comint-update-fence))))
2373 2373
2374(defun comint-kill-region (beg end &optional yank-handler) 2374(defun comint-kill-region (beg end &optional yank-handler)
2375 "Like `kill-region', but ignores read-only properties, if safe. 2375 "Like `kill-region', but ignores read-only properties, if safe.
diff --git a/lisp/complete.el b/lisp/complete.el
index 6620db860c3..d0e3fbe8ddf 100644
--- a/lisp/complete.el
+++ b/lisp/complete.el
@@ -369,7 +369,7 @@ of `minibuffer-completion-table' and the minibuffer contents.")
369 (str (buffer-substring beg end)) 369 (str (buffer-substring beg end))
370 (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str))) 370 (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str)))
371 (ambig nil) 371 (ambig nil)
372 basestr 372 basestr origstr
373 env-on 373 env-on
374 regex 374 regex
375 p offset 375 p offset
@@ -415,7 +415,7 @@ of `minibuffer-completion-table' and the minibuffer contents.")
415 (file-name-nondirectory dir)) 415 (file-name-nondirectory dir))
416 "*/" file)) 416 "*/" file))
417 (setq dir (file-name-directory dir))) 417 (setq dir (file-name-directory dir)))
418 (setq str (concat dir file)))) 418 (setq origstr str str (concat dir file))))
419 419
420 ;; Look for wildcard expansions in directory name 420 ;; Look for wildcard expansions in directory name
421 (and filename 421 (and filename
@@ -443,7 +443,14 @@ of `minibuffer-completion-table' and the minibuffer contents.")
443 (setq str (concat dir (file-name-nondirectory str))) 443 (setq str (concat dir (file-name-nondirectory str)))
444 (insert str) 444 (insert str)
445 (setq end (+ beg (length str))))) 445 (setq end (+ beg (length str)))))
446 (setq filename nil table nil pred nil)))) 446 (if origstr
447 ;; If the wildcards were introduced by us, it's possible
448 ;; that read-file-name-internal (especially our
449 ;; PC-include-file advice) can still find matches for the
450 ;; original string even if we couldn't, so remove the
451 ;; added wildcards.
452 (setq str origstr)
453 (setq filename nil table nil pred nil)))))
447 454
448 ;; Strip directory name if appropriate 455 ;; Strip directory name if appropriate
449 (if filename 456 (if filename
@@ -943,10 +950,11 @@ absolute rather than relative to some directory on the SEARCH-PATH."
943 (if (string-match "<\\([^\"<>]*\\)>?\\'" (ad-get-arg 0)) 950 (if (string-match "<\\([^\"<>]*\\)>?\\'" (ad-get-arg 0))
944 (let* ((string (ad-get-arg 0)) 951 (let* ((string (ad-get-arg 0))
945 (action (ad-get-arg 2)) 952 (action (ad-get-arg 2))
946 (name (substring string (match-beginning 1) (match-end 1))) 953 (name (match-string 1 string))
947 (str2 (substring string (match-beginning 0))) 954 (str2 (substring string (match-beginning 0)))
948 (completion-table 955 (completion-table
949 (mapcar (lambda (x) (format "<%s>" x)) 956 (mapcar (lambda (x)
957 (format (if (string-match "/\\'" x) "<%s" "<%s>") x))
950 (PC-include-file-all-completions 958 (PC-include-file-all-completions
951 name (PC-include-file-path))))) 959 name (PC-include-file-path)))))
952 (setq ad-return-value 960 (setq ad-return-value
diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el
index 1a8402e06c4..7ea02352b0b 100644
--- a/lisp/diff-mode.el
+++ b/lisp/diff-mode.el
@@ -438,7 +438,8 @@ If the prefix ARG is given, restrict the view to the current file instead."
438 (firsthunk (ignore-errors 438 (firsthunk (ignore-errors
439 (goto-char start) 439 (goto-char start)
440 (diff-beginning-of-file) (diff-hunk-next) (point))) 440 (diff-beginning-of-file) (diff-hunk-next) (point)))
441 (nextfile (ignore-errors (diff-file-next) (point)))) 441 (nextfile (ignore-errors (diff-file-next) (point)))
442 (inhibit-read-only t))
442 (goto-char start) 443 (goto-char start)
443 (if (and firsthunk (= firsthunk start) 444 (if (and firsthunk (= firsthunk start)
444 (or (null nexthunk) 445 (or (null nexthunk)
@@ -457,7 +458,8 @@ If the prefix ARG is given, restrict the view to the current file instead."
457 (ignore-errors 458 (ignore-errors
458 (diff-hunk-prev) (point)))) 459 (diff-hunk-prev) (point))))
459 (index (save-excursion 460 (index (save-excursion
460 (re-search-backward "^Index: " prevhunk t)))) 461 (re-search-backward "^Index: " prevhunk t)))
462 (inhibit-read-only t))
461 (when index (setq start index)) 463 (when index (setq start index))
462 (diff-end-of-file) 464 (diff-end-of-file)
463 (if (looking-at "^\n") (forward-char 1)) ;`tla' generates such diffs. 465 (if (looking-at "^\n") (forward-char 1)) ;`tla' generates such diffs.
@@ -497,7 +499,8 @@ If the prefix ARG is given, restrict the view to the current file instead."
497 (let* ((start1 (string-to-number (match-string 1))) 499 (let* ((start1 (string-to-number (match-string 1)))
498 (start2 (string-to-number (match-string 2))) 500 (start2 (string-to-number (match-string 2)))
499 (newstart1 (+ start1 (diff-count-matches "^[- \t]" (point) pos))) 501 (newstart1 (+ start1 (diff-count-matches "^[- \t]" (point) pos)))
500 (newstart2 (+ start2 (diff-count-matches "^[+ \t]" (point) pos)))) 502 (newstart2 (+ start2 (diff-count-matches "^[+ \t]" (point) pos)))
503 (inhibit-read-only t))
501 (goto-char pos) 504 (goto-char pos)
502 ;; Hopefully the after-change-function will not screw us over. 505 ;; Hopefully the after-change-function will not screw us over.
503 (insert "@@ -" (number-to-string newstart1) ",1 +" 506 (insert "@@ -" (number-to-string newstart1) ",1 +"
@@ -993,8 +996,7 @@ a diff with \\[diff-reverse-direction]."
993 ;; compile support 996 ;; compile support
994 (set (make-local-variable 'next-error-function) 'diff-next-error) 997 (set (make-local-variable 'next-error-function) 'diff-next-error)
995 998
996 (when (and (> (point-max) (point-min)) diff-default-read-only) 999 (setq buffer-read-only diff-default-read-only)
997 (toggle-read-only t))
998 ;; setup change hooks 1000 ;; setup change hooks
999 (if (not diff-update-on-the-fly) 1001 (if (not diff-update-on-the-fly)
1000 (add-hook 'write-contents-functions 'diff-write-contents-hooks nil t) 1002 (add-hook 'write-contents-functions 'diff-write-contents-hooks nil t)
@@ -1355,6 +1357,7 @@ For use in `add-log-current-defun-function'."
1355 (file1 (make-temp-file "diff1")) 1357 (file1 (make-temp-file "diff1"))
1356 (file2 (make-temp-file "diff2")) 1358 (file2 (make-temp-file "diff2"))
1357 (coding-system-for-read buffer-file-coding-system) 1359 (coding-system-for-read buffer-file-coding-system)
1360 (inhibit-read-only t)
1358 old new) 1361 old new)
1359 (unwind-protect 1362 (unwind-protect
1360 (save-excursion 1363 (save-excursion
diff --git a/lisp/diff.el b/lisp/diff.el
index 221d7b2e363..534a84d4317 100644
--- a/lisp/diff.el
+++ b/lisp/diff.el
@@ -67,9 +67,10 @@ CODE is the exit code of the process. It should be 0 iff no diffs were found."
67 (if diff-new-temp-file (delete-file diff-new-temp-file)) 67 (if diff-new-temp-file (delete-file diff-new-temp-file))
68 (save-excursion 68 (save-excursion
69 (goto-char (point-max)) 69 (goto-char (point-max))
70 (insert (format "\nDiff finished%s. %s\n" 70 (let ((inhibit-read-only t))
71 (if (equal 0 code) " (no differences)" "") 71 (insert (format "\nDiff finished%s. %s\n"
72 (current-time-string))))) 72 (if (equal 0 code) " (no differences)" "")
73 (current-time-string))))))
73 74
74;;;###autoload 75;;;###autoload
75(defun diff (old new &optional switches no-async) 76(defun diff (old new &optional switches no-async)
@@ -119,7 +120,8 @@ With prefix arg, prompt for diff switches."
119 (set-buffer buf) 120 (set-buffer buf)
120 (setq buffer-read-only nil) 121 (setq buffer-read-only nil)
121 (buffer-disable-undo (current-buffer)) 122 (buffer-disable-undo (current-buffer))
122 (erase-buffer) 123 (let ((inhibit-read-only t))
124 (erase-buffer))
123 (buffer-enable-undo (current-buffer)) 125 (buffer-enable-undo (current-buffer))
124 (diff-mode) 126 (diff-mode)
125 (set (make-local-variable 'revert-buffer-function) 127 (set (make-local-variable 'revert-buffer-function)
@@ -128,21 +130,35 @@ With prefix arg, prompt for diff switches."
128 (set (make-local-variable 'diff-old-temp-file) old-alt) 130 (set (make-local-variable 'diff-old-temp-file) old-alt)
129 (set (make-local-variable 'diff-new-temp-file) new-alt) 131 (set (make-local-variable 'diff-new-temp-file) new-alt)
130 (setq default-directory thisdir) 132 (setq default-directory thisdir)
131 (insert command "\n") 133 (let ((inhibit-read-only t))
134 (insert command "\n"))
132 (if (and (not no-async) (fboundp 'start-process)) 135 (if (and (not no-async) (fboundp 'start-process))
133 (progn 136 (progn
134 (setq proc (start-process "Diff" buf shell-file-name 137 (setq proc (start-process "Diff" buf shell-file-name
135 shell-command-switch command)) 138 shell-command-switch command))
139 (set-process-filter proc 'diff-process-filter)
136 (set-process-sentinel 140 (set-process-sentinel
137 proc (lambda (proc msg) 141 proc (lambda (proc msg)
138 (with-current-buffer (process-buffer proc) 142 (with-current-buffer (process-buffer proc)
139 (diff-sentinel (process-exit-status proc)))))) 143 (diff-sentinel (process-exit-status proc))))))
140 ;; Async processes aren't available. 144 ;; Async processes aren't available.
141 (diff-sentinel 145 (let ((inhibit-read-only t))
142 (call-process shell-file-name nil buf nil 146 (diff-sentinel
143 shell-command-switch command)))) 147 (call-process shell-file-name nil buf nil
148 shell-command-switch command)))))
144 buf)) 149 buf))
145 150
151(defun diff-process-filter (proc string)
152 (with-current-buffer (process-buffer proc)
153 (let ((moving (= (point) (process-mark proc))))
154 (save-excursion
155 ;; Insert the text, advancing the process marker.
156 (goto-char (process-mark proc))
157 (let ((inhibit-read-only t))
158 (insert string))
159 (set-marker (process-mark proc) (point)))
160 (if moving (goto-char (process-mark proc))))))
161
146;;;###autoload 162;;;###autoload
147(defun diff-backup (file &optional switches) 163(defun diff-backup (file &optional switches)
148 "Diff this file with its backup file or vice versa. 164 "Diff this file with its backup file or vice versa.
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index e07689973e4..b4cb8933194 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -493,7 +493,8 @@ the Dired buffer, so output files usually are created there instead of
493in a subdir. 493in a subdir.
494 494
495In a noninteractive call (from Lisp code), you must specify 495In a noninteractive call (from Lisp code), you must specify
496the list of file names explicitly with the FILE-LIST argument." 496the list of file names explicitly with the FILE-LIST argument, which
497can be produced by `dired-get-marked-files', for example."
497;;Functions dired-run-shell-command and dired-shell-stuff-it do the 498;;Functions dired-run-shell-command and dired-shell-stuff-it do the
498;;actual work and can be redefined for customization. 499;;actual work and can be redefined for customization.
499 (interactive 500 (interactive
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 0a467920f11..4d3734bbd5a 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -251,7 +251,6 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used."
251(define-key dired-mode-map "*." 'dired-mark-extension) 251(define-key dired-mode-map "*." 'dired-mark-extension)
252(define-key dired-mode-map "\M-!" 'dired-smart-shell-command) 252(define-key dired-mode-map "\M-!" 'dired-smart-shell-command)
253(define-key dired-mode-map "w" 'dired-copy-filename-as-kill) 253(define-key dired-mode-map "w" 'dired-copy-filename-as-kill)
254(define-key dired-mode-map "\M-g" 'dired-goto-file)
255(define-key dired-mode-map "\M-G" 'dired-goto-subdir) 254(define-key dired-mode-map "\M-G" 'dired-goto-subdir)
256(define-key dired-mode-map "F" 'dired-do-find-marked-files) 255(define-key dired-mode-map "F" 'dired-do-find-marked-files)
257(define-key dired-mode-map "Y" 'dired-do-relsymlink) 256(define-key dired-mode-map "Y" 'dired-do-relsymlink)
diff --git a/lisp/dired.el b/lisp/dired.el
index 7209248a75a..64b73184397 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1212,9 +1212,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
1212 (define-key map "f" 'dired-find-file) 1212 (define-key map "f" 'dired-find-file)
1213 (define-key map "\C-m" 'dired-advertised-find-file) 1213 (define-key map "\C-m" 'dired-advertised-find-file)
1214 (define-key map "g" 'revert-buffer) 1214 (define-key map "g" 'revert-buffer)
1215 (define-key map "\M-g" 'dired-goto-file)
1216 (define-key map "h" 'describe-mode) 1215 (define-key map "h" 'describe-mode)
1217 (define-key map "i" 'dired-maybe-insert-subdir) 1216 (define-key map "i" 'dired-maybe-insert-subdir)
1217 (define-key map "j" 'dired-goto-file)
1218 (define-key map "k" 'dired-do-kill-lines) 1218 (define-key map "k" 'dired-do-kill-lines)
1219 (define-key map "l" 'dired-do-redisplay) 1219 (define-key map "l" 'dired-do-redisplay)
1220 (define-key map "m" 'dired-mark) 1220 (define-key map "m" 'dired-mark)
@@ -1251,9 +1251,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
1251 ;; thumbnail manipulation (tumme) 1251 ;; thumbnail manipulation (tumme)
1252 (define-key map "\C-td" 'tumme-display-thumbs) 1252 (define-key map "\C-td" 'tumme-display-thumbs)
1253 (define-key map "\C-tt" 'tumme-tag-files) 1253 (define-key map "\C-tt" 'tumme-tag-files)
1254 (define-key map "\C-tr" 'tumme-tag-remove) 1254 (define-key map "\C-tr" 'tumme-delete-tag)
1255 (define-key map "\C-tj" 'tumme-jump-thumbnail-buffer) 1255 (define-key map "\C-tj" 'tumme-jump-thumbnail-buffer)
1256 (define-key map "\C-ti" 'tumme-display-dired-image) 1256 (define-key map "\C-ti" 'tumme-dired-display-image)
1257 (define-key map "\C-tx" 'tumme-dired-display-external) 1257 (define-key map "\C-tx" 'tumme-dired-display-external)
1258 (define-key map "\C-ta" 'tumme-display-thumbs-append) 1258 (define-key map "\C-ta" 'tumme-display-thumbs-append)
1259 (define-key map "\C-t." 'tumme-display-thumb) 1259 (define-key map "\C-t." 'tumme-display-thumb)
@@ -1305,6 +1305,18 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
1305 (define-key map [menu-bar immediate] 1305 (define-key map [menu-bar immediate]
1306 (cons "Immediate" (make-sparse-keymap "Immediate"))) 1306 (cons "Immediate" (make-sparse-keymap "Immediate")))
1307 1307
1308 (define-key map
1309 [menu-bar immediate tumme-dired-display-external]
1310 '(menu-item "Display Image Externally" tumme-dired-display-external
1311 :help "Display image in external viewer"))
1312 (define-key map
1313 [menu-bar immediate tumme-dired-display-image]
1314 '(menu-item "Display Image" tumme-dired-display-image
1315 :help "Display sized image in a separate window"))
1316
1317 (define-key map [menu-bar immediate dashes-4]
1318 '("--"))
1319
1308 (define-key map [menu-bar immediate revert-buffer] 1320 (define-key map [menu-bar immediate revert-buffer]
1309 '(menu-item "Refresh" revert-buffer 1321 '(menu-item "Refresh" revert-buffer
1310 :help "Update contents of shown directories")) 1322 :help "Update contents of shown directories"))
@@ -1313,7 +1325,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
1313 '("--")) 1325 '("--"))
1314 1326
1315 (define-key map [menu-bar immediate compare-directories] 1327 (define-key map [menu-bar immediate compare-directories]
1316 '(menu-item "Compare directories..." dired-compare-directories 1328 '(menu-item "Compare Directories..." dired-compare-directories
1317 :help "Mark files with different attributes in two dired buffers")) 1329 :help "Mark files with different attributes in two dired buffers"))
1318 (define-key map [menu-bar immediate backup-diff] 1330 (define-key map [menu-bar immediate backup-diff]
1319 '(menu-item "Compare with Backup" dired-backup-diff 1331 '(menu-item "Compare with Backup" dired-backup-diff
@@ -1341,6 +1353,14 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
1341 (define-key map [menu-bar regexp] 1353 (define-key map [menu-bar regexp]
1342 (cons "Regexp" (make-sparse-keymap "Regexp"))) 1354 (cons "Regexp" (make-sparse-keymap "Regexp")))
1343 1355
1356 (define-key map
1357 [menu-bar regexp tumme-mark-tagged-files]
1358 '(menu-item "Mark From Image Tag..." tumme-mark-tagged-files
1359 :help "Mark files whose image tags matches regexp"))
1360
1361 (define-key map [menu-bar regexp dashes-1]
1362 '("--"))
1363
1344 (define-key map [menu-bar regexp downcase] 1364 (define-key map [menu-bar regexp downcase]
1345 '(menu-item "Downcase" dired-downcase 1365 '(menu-item "Downcase" dired-downcase
1346 ;; When running on plain MS-DOS, there's only one 1366 ;; When running on plain MS-DOS, there's only one
@@ -1428,6 +1448,29 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
1428 (define-key map [menu-bar operate] 1448 (define-key map [menu-bar operate]
1429 (cons "Operate" (make-sparse-keymap "Operate"))) 1449 (cons "Operate" (make-sparse-keymap "Operate")))
1430 1450
1451 (define-key map [menu-bar operate dashes-2]
1452 '("--"))
1453
1454 (define-key map
1455 [menu-bar operate tumme-delete-tag]
1456 '(menu-item "Delete Image Tag..." tumme-delete-tag
1457 :help "Delete image tag from current or marked files"))
1458 (define-key map
1459 [menu-bar operate tumme-tag-files]
1460 '(menu-item "Add Image Tags..." tumme-tag-files
1461 :help "Add image tags to current or marked files"))
1462 (define-key map
1463 [menu-bar operate tumme-dired-comment-files]
1464 '(menu-item "Add Image Comment..." tumme-dired-comment-files
1465 :help "Add image comment to current or marked files"))
1466 (define-key map
1467 [menu-bar operate tumme-display-thumbs]
1468 '(menu-item "Display Thumbnails" tumme-display-thumbs
1469 :help "Display thumbnails for current or marked image files"))
1470
1471 (define-key map [menu-bar operate dashes-3]
1472 '("--"))
1473
1431 (define-key map [menu-bar operate query-replace] 1474 (define-key map [menu-bar operate query-replace]
1432 '(menu-item "Query Replace in Files..." dired-do-query-replace-regexp 1475 '(menu-item "Query Replace in Files..." dired-do-query-replace-regexp
1433 :help "Replace regexp in marked files")) 1476 :help "Replace regexp in marked files"))
@@ -2218,7 +2261,7 @@ instead of `dired-actual-switches'."
2218 (forward-line 1)))) 2261 (forward-line 1))))
2219 2262
2220(defun dired-goto-file (file) 2263(defun dired-goto-file (file)
2221 "Go to file line of FILE in this dired buffer." 2264 "Go to line describing file FILE in this dired buffer."
2222 ;; Return value of point on success, else nil. 2265 ;; Return value of point on success, else nil.
2223 ;; FILE must be an absolute file name. 2266 ;; FILE must be an absolute file name.
2224 ;; Loses if FILE contains control chars like "\007" for which ls 2267 ;; Loses if FILE contains control chars like "\007" for which ls
diff --git a/lisp/dnd.el b/lisp/dnd.el
index dec57481570..85881b3261f 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -69,39 +69,34 @@ if some action was made, or nil if the URL is ignored."
69 69
70;; Functions 70;; Functions
71 71
72(defun dnd-handle-one-url (window action arg) 72(defun dnd-handle-one-url (window action url)
73 "Handle one dropped url by calling the appropriate handler. 73 "Handle one dropped url by calling the appropriate handler.
74The handler is first located by looking at `dnd-protocol-alist'. 74The handler is first located by looking at `dnd-protocol-alist'.
75If no match is found here, and the value of `browse-url-browser-function' 75If no match is found here, and the value of `browse-url-browser-function'
76is a pair of (REGEXP . FUNCTION), those regexps are tried for a match. 76is a pair of (REGEXP . FUNCTION), those regexps are tried for a match.
77If no match is found, just call `dnd-insert-text'. 77If no match is found, just call `dnd-insert-text'.
78WINDOW is where the drop happend, ACTION is the action for the drop, 78WINDOW is where the drop happend, ACTION is the action for the drop,
79ARG is the URL that has been dropped. 79URL is what has been dropped.
80Returns ACTION." 80Returns ACTION."
81 (require 'browse-url) 81 (require 'browse-url)
82 (let* ((uri (replace-regexp-in-string 82 (let (ret)
83 "%[A-Z0-9][A-Z0-9]"
84 (lambda (arg)
85 (format "%c" (string-to-number (substring arg 1) 16)))
86 arg))
87 ret)
88 (or 83 (or
89 (catch 'done 84 (catch 'done
90 (dolist (bf dnd-protocol-alist) 85 (dolist (bf dnd-protocol-alist)
91 (when (string-match (car bf) uri) 86 (when (string-match (car bf) url)
92 (setq ret (funcall (cdr bf) uri action)) 87 (setq ret (funcall (cdr bf) url action))
93 (throw 'done t))) 88 (throw 'done t)))
94 nil) 89 nil)
95 (when (not (functionp browse-url-browser-function)) 90 (when (not (functionp browse-url-browser-function))
96 (catch 'done 91 (catch 'done
97 (dolist (bf browse-url-browser-function) 92 (dolist (bf browse-url-browser-function)
98 (when (string-match (car bf) uri) 93 (when (string-match (car bf) url)
99 (setq ret 'private) 94 (setq ret 'private)
100 (funcall (cdr bf) uri action) 95 (funcall (cdr bf) url action)
101 (throw 'done t))) 96 (throw 'done t)))
102 nil)) 97 nil))
103 (progn 98 (progn
104 (dnd-insert-text window action uri) 99 (dnd-insert-text window action url)
105 (setq ret 'private))) 100 (setq ret 'private)))
106 ret)) 101 ret))
107 102
@@ -134,6 +129,11 @@ Return nil if URI is not a local file."
134 ((string-match "^file:" uri) ; Old KDE, Motif, Sun 129 ((string-match "^file:" uri) ; Old KDE, Motif, Sun
135 (substring uri (match-end 0)))))) 130 (substring uri (match-end 0))))))
136 (when (and f must-exist) 131 (when (and f must-exist)
132 (setq f (replace-regexp-in-string
133 "%[A-Z0-9][A-Z0-9]"
134 (lambda (arg)
135 (format "%c" (string-to-number (substring arg 1) 16)))
136 f nil t))
137 (let* ((decoded-f (decode-coding-string 137 (let* ((decoded-f (decode-coding-string
138 f 138 f
139 (or file-name-coding-system 139 (or file-name-coding-system
diff --git a/lisp/ediff-diff.el b/lisp/ediff-diff.el
index 013ed9073db..7746954292d 100644
--- a/lisp/ediff-diff.el
+++ b/lisp/ediff-diff.el
@@ -65,8 +65,10 @@ Must produce output compatible with Unix's diff3 program."
65;; The following functions needed for setting diff/diff3 options 65;; The following functions needed for setting diff/diff3 options
66;; test if diff supports the --binary option 66;; test if diff supports the --binary option
67(defsubst ediff-test-utility (diff-util option &optional files) 67(defsubst ediff-test-utility (diff-util option &optional files)
68 (eq 0 (apply 'call-process 68 (condition-case ()
69 (append (list diff-util nil nil nil option) files)))) 69 (eq 0 (apply 'call-process
70 (append (list diff-util nil nil nil option) files)))
71 (file-error nil)))
70 72
71(defun ediff-diff-mandatory-option (diff-util) 73(defun ediff-diff-mandatory-option (diff-util)
72 (let ((file (if (boundp 'null-device) null-device "/dev/null"))) 74 (let ((file (if (boundp 'null-device) null-device "/dev/null")))
@@ -128,10 +130,10 @@ are `-I REGEXP', to ignore changes whose lines match the REGEXP."
128 130
129(defcustom ediff-diff-options "" 131(defcustom ediff-diff-options ""
130 "*Options to pass to `ediff-diff-program'. 132 "*Options to pass to `ediff-diff-program'.
131If Unix diff is used as `ediff-diff-program', then a useful option is 133If Unix diff is used as `ediff-diff-program',
132`-w', to ignore space, and `-i', to ignore case of letters. 134 then a useful option is `-w', to ignore space.
133Options `-c' and `-i' are not allowed. Case sensitivity can be toggled 135Options `-c' and `-i' are not allowed. Case sensitivity can be
134interactively using [ediff-toggle-ignore-case]" 136 toggled interactively using \\[ediff-toggle-ignore-case]."
135 :set 'ediff-reset-diff-options 137 :set 'ediff-reset-diff-options
136 :type 'string 138 :type 'string
137 :group 'ediff-diff) 139 :group 'ediff-diff)
@@ -399,7 +401,7 @@ one optional arguments, diff-number to refine.")
399 (c-prev-pt nil) 401 (c-prev-pt nil)
400 diff-list shift-A shift-B 402 diff-list shift-A shift-B
401 ) 403 )
402 404
403 ;; diff list contains word numbers, unless changed later 405 ;; diff list contains word numbers, unless changed later
404 (setq diff-list (cons (if word-mode 'words 'points) 406 (setq diff-list (cons (if word-mode 'words 'points)
405 diff-list)) 407 diff-list))
@@ -411,7 +413,7 @@ one optional arguments, diff-number to refine.")
411 shift-B 413 shift-B
412 (ediff-overlay-start 414 (ediff-overlay-start
413 (ediff-get-value-according-to-buffer-type 'B bounds)))) 415 (ediff-get-value-according-to-buffer-type 'B bounds))))
414 416
415 ;; reset point in buffers A/B/C 417 ;; reset point in buffers A/B/C
416 (ediff-with-current-buffer A-buffer 418 (ediff-with-current-buffer A-buffer
417 (goto-char (if shift-A shift-A (point-min)))) 419 (goto-char (if shift-A shift-A (point-min))))
@@ -1525,7 +1527,7 @@ affects only files whose names match the expression."
1525 (ediff-barf-if-not-control-buffer) 1527 (ediff-barf-if-not-control-buffer)
1526 (setq ediff-ignore-case (not ediff-ignore-case)) 1528 (setq ediff-ignore-case (not ediff-ignore-case))
1527 (cond (ediff-ignore-case 1529 (cond (ediff-ignore-case
1528 (setq ediff-actual-diff-options 1530 (setq ediff-actual-diff-options
1529 (concat ediff-diff-options " " ediff-ignore-case-option) 1531 (concat ediff-diff-options " " ediff-ignore-case-option)
1530 ediff-actual-diff3-options 1532 ediff-actual-diff3-options
1531 (concat ediff-diff3-options " " ediff-ignore-case-option3)) 1533 (concat ediff-diff3-options " " ediff-ignore-case-option3))
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 486a3b049ae..d03245bf452 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -2350,6 +2350,7 @@ FUNCTION was not advised)."
2350 (ad-advice-set-enabled advice flag)))))) 2350 (ad-advice-set-enabled advice flag))))))
2351 matched-advices))) 2351 matched-advices)))
2352 2352
2353;;;###autoload
2353(defun ad-enable-advice (function class name) 2354(defun ad-enable-advice (function class name)
2354 "Enables the advice of FUNCTION with CLASS and NAME." 2355 "Enables the advice of FUNCTION with CLASS and NAME."
2355 (interactive (ad-read-advice-specification "Enable advice of")) 2356 (interactive (ad-read-advice-specification "Enable advice of"))
@@ -2359,6 +2360,7 @@ FUNCTION was not advised)."
2359 function class name)) 2360 function class name))
2360 (error "ad-enable-advice: `%s' is not advised" function))) 2361 (error "ad-enable-advice: `%s' is not advised" function)))
2361 2362
2363;;;###autoload
2362(defun ad-disable-advice (function class name) 2364(defun ad-disable-advice (function class name)
2363 "Disable the advice of FUNCTION with CLASS and NAME." 2365 "Disable the advice of FUNCTION with CLASS and NAME."
2364 (interactive (ad-read-advice-specification "Disable advice of")) 2366 (interactive (ad-read-advice-specification "Disable advice of"))
@@ -3585,6 +3587,7 @@ the value of `ad-redefinition-action' and de/activate again."
3585;; @@ The top-level advice interface: 3587;; @@ The top-level advice interface:
3586;; ================================== 3588;; ==================================
3587 3589
3590;;;###autoload
3588(defun ad-activate (function &optional compile) 3591(defun ad-activate (function &optional compile)
3589 "Activate all the advice information of an advised FUNCTION. 3592 "Activate all the advice information of an advised FUNCTION.
3590If FUNCTION has a proper original definition then an advised 3593If FUNCTION has a proper original definition then an advised
diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el
index 0d38ba03241..7ab0101b2a5 100644
--- a/lisp/emacs-lisp/authors.el
+++ b/lisp/emacs-lisp/authors.el
@@ -42,6 +42,7 @@ files.")
42 42
43(defconst authors-aliases 43(defconst authors-aliases
44 '( 44 '(
45 ("Andrew Csillag" "Drew Csillag")
45 ("Barry A. Warsaw" "Barry A. Warsaw, Century Computing, Inc." 46 ("Barry A. Warsaw" "Barry A. Warsaw, Century Computing, Inc."
46 "Barry A. Warsaw, ITB" "Barry Warsaw") 47 "Barry A. Warsaw, ITB" "Barry Warsaw")
47 ("Bj,Av(Brn Torkelsson" "Bjorn Torkelsson") 48 ("Bj,Av(Brn Torkelsson" "Bjorn Torkelsson")
@@ -118,6 +119,7 @@ files.")
118 ("Roland B. Roberts" "Roland B Roberts" "Roland Roberts") 119 ("Roland B. Roberts" "Roland B Roberts" "Roland Roberts")
119 ("Rui-Tao Dong" "Rui-Tao Dong ~{6-Hpln~}") 120 ("Rui-Tao Dong" "Rui-Tao Dong ~{6-Hpln~}")
120 ("Sam Steingold" "Sam Shteingold") 121 ("Sam Steingold" "Sam Shteingold")
122 ("Satyaki Das" "Indexed search by Satyaki Das")
121 ("Stefan Monnier" "Stefan") 123 ("Stefan Monnier" "Stefan")
122 ("Stephen A. Wood" "(saw@cebaf.gov)") 124 ("Stephen A. Wood" "(saw@cebaf.gov)")
123 ("Steven L. Baur" "SL Baur" "Steven L Baur") 125 ("Steven L. Baur" "SL Baur" "Steven L Baur")
@@ -128,6 +130,7 @@ files.")
128 ("Torbj,Av(Brn Einarsson" "Torbj.*rn Einarsson") 130 ("Torbj,Av(Brn Einarsson" "Torbj.*rn Einarsson")
129 ("Toru Tomabechi" "Toru Tomabechi,") 131 ("Toru Tomabechi" "Toru Tomabechi,")
130 ("Vincent Del Vecchio" "Vince Del Vecchio") 132 ("Vincent Del Vecchio" "Vince Del Vecchio")
133 ("William M. Perry" "Bill Perry")
131 ("Wlodzimierz Bzyl" "W.*dek Bzyl") 134 ("Wlodzimierz Bzyl" "W.*dek Bzyl")
132 ("Yutaka NIIBE" "NIIBE Yutaka") 135 ("Yutaka NIIBE" "NIIBE Yutaka")
133 ) 136 )
@@ -269,7 +272,7 @@ Changes to files in this list are not listed.")
269 ("Morten Welinder" :wrote "dosfns.c" "[many MSDOS files]" "msdos.h") 272 ("Morten Welinder" :wrote "dosfns.c" "[many MSDOS files]" "msdos.h")
270 ("Pace Willisson" :wrote "ispell.el") 273 ("Pace Willisson" :wrote "ispell.el")
271 ("Garrett Wollman" :changed "sendmail.el") 274 ("Garrett Wollman" :changed "sendmail.el")
272 ("Dale Worley" :changed "mail-extr.el") 275 ("Dale R. Worley" :changed "mail-extr.el")
273 ("Jamie Zawinski" :changed "bytecode.c" :wrote "disass.el" "tar-mode.el")) 276 ("Jamie Zawinski" :changed "bytecode.c" :wrote "disass.el" "tar-mode.el"))
274 "Actions taken from the original, manually (un)maintained AUTHORS file.") 277 "Actions taken from the original, manually (un)maintained AUTHORS file.")
275 278
@@ -355,7 +358,9 @@ the file name."
355 (setq rules (cdr rules)))))) 358 (setq rules (cdr rules))))))
356 (setq authors-checked-files-alist 359 (setq authors-checked-files-alist
357 (cons (cons file valid) authors-checked-files-alist)) 360 (cons (cons file valid) authors-checked-files-alist))
358 (unless valid 361 (unless (or valid
362 (string-match "[*]" file)
363 (string-match "^[0-9.]+$" file))
359 (setq authors-invalid-file-names 364 (setq authors-invalid-file-names
360 (cons (format "%s:%d: unrecognized `%s' for %s" 365 (cons (format "%s:%d: unrecognized `%s' for %s"
361 log-file 366 log-file
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index ee2d74c5646..76699f10df8 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -273,12 +273,30 @@ which lists the file name and which functions are in it, etc."
273 (or (eolp) 273 (or (eolp)
274 (insert "\n" generate-autoload-section-continuation)))))) 274 (insert "\n" generate-autoload-section-continuation))))))
275 275
276(defun autoload-find-file (file)
277 "Fetch file and put it in a temp buffer. Return the buffer."
278 ;; It is faster to avoid visiting the file.
279 (with-current-buffer (get-buffer-create " *autoload-file*")
280 (kill-all-local-variables)
281 (erase-buffer)
282 (setq buffer-undo-list t
283 buffer-read-only nil)
284 (emacs-lisp-mode)
285 (insert-file-contents file nil)
286 (let ((enable-local-variables :safe))
287 (hack-local-variables))
288 (current-buffer)))
289
290(defvar no-update-autoloads nil
291 "File local variable to prevent scanning this file for autoload cookies.")
292
276(defun generate-file-autoloads (file) 293(defun generate-file-autoloads (file)
277 "Insert at point a loaddefs autoload section for FILE. 294 "Insert at point a loaddefs autoload section for FILE.
278autoloads are generated for defuns and defmacros in FILE 295Autoloads are generated for defuns and defmacros in FILE
279marked by `generate-autoload-cookie' (which see). 296marked by `generate-autoload-cookie' (which see).
280If FILE is being visited in a buffer, the contents of the buffer 297If FILE is being visited in a buffer, the contents of the buffer
281are used." 298are used.
299Return non-nil in the case where no autoloads were added at point."
282 (interactive "fGenerate autoloads for file: ") 300 (interactive "fGenerate autoloads for file: ")
283 (let ((outbuf (current-buffer)) 301 (let ((outbuf (current-buffer))
284 (autoloads-done '()) 302 (autoloads-done '())
@@ -291,7 +309,7 @@ are used."
291 (float-output-format nil) 309 (float-output-format nil)
292 (done-any nil) 310 (done-any nil)
293 (visited (get-file-buffer file)) 311 (visited (get-file-buffer file))
294 output-end) 312 output-start)
295 313
296 ;; If the autoload section we create here uses an absolute 314 ;; If the autoload section we create here uses an absolute
297 ;; file name for FILE in its header, and then Emacs is installed 315 ;; file name for FILE in its header, and then Emacs is installed
@@ -309,76 +327,70 @@ are used."
309 (string= dir-truename (substring source-truename 0 len))) 327 (string= dir-truename (substring source-truename 0 len)))
310 (setq file (substring source-truename len)))) 328 (setq file (substring source-truename len))))
311 329
312 (message "Generating autoloads for %s..." file) 330 (with-current-buffer (or visited
313 (save-excursion 331 ;; It is faster to avoid visiting the file.
314 (unwind-protect 332 (autoload-find-file file))
315 (progn 333 ;; Obey the no-update-autoloads file local variable.
316 (if visited 334 (unless no-update-autoloads
317 (set-buffer visited) 335 (message "Generating autoloads for %s..." file)
318 ;; It is faster to avoid visiting the file. 336 (setq output-start (with-current-buffer outbuf (point)))
319 (set-buffer (get-buffer-create " *generate-autoload-file*")) 337 (save-excursion
320 (kill-all-local-variables) 338 (save-restriction
321 (erase-buffer) 339 (widen)
322 (setq buffer-undo-list t 340 (goto-char (point-min))
323 buffer-read-only nil) 341 (while (not (eobp))
324 (emacs-lisp-mode) 342 (skip-chars-forward " \t\n\f")
325 (insert-file-contents file nil)) 343 (cond
326 (save-excursion 344 ((looking-at (regexp-quote generate-autoload-cookie))
327 (save-restriction 345 (search-forward generate-autoload-cookie)
328 (widen) 346 (skip-chars-forward " \t")
329 (goto-char (point-min)) 347 (setq done-any t)
330 (while (not (eobp)) 348 (if (eolp)
331 (skip-chars-forward " \t\n\f") 349 ;; Read the next form and make an autoload.
332 (cond 350 (let* ((form (prog1 (read (current-buffer))
333 ((looking-at (regexp-quote generate-autoload-cookie)) 351 (or (bolp) (forward-line 1))))
334 (search-forward generate-autoload-cookie) 352 (autoload (make-autoload form load-name)))
335 (skip-chars-forward " \t") 353 (if autoload
336 (setq done-any t) 354 (push (nth 1 form) autoloads-done)
337 (if (eolp) 355 (setq autoload form))
338 ;; Read the next form and make an autoload. 356 (let ((autoload-print-form-outbuf outbuf))
339 (let* ((form (prog1 (read (current-buffer)) 357 (autoload-print-form autoload)))
340 (or (bolp) (forward-line 1)))) 358
341 (autoload (make-autoload form load-name))) 359 ;; Copy the rest of the line to the output.
342 (if autoload 360 (princ (buffer-substring
343 (setq autoloads-done (cons (nth 1 form) 361 (progn
344 autoloads-done)) 362 ;; Back up over whitespace, to preserve it.
345 (setq autoload form)) 363 (skip-chars-backward " \f\t")
346 (let ((autoload-print-form-outbuf outbuf)) 364 (if (= (char-after (1+ (point))) ? )
347 (autoload-print-form autoload))) 365 ;; Eat one space.
348 366 (forward-char 1))
349 ;; Copy the rest of the line to the output. 367 (point))
350 (princ (buffer-substring 368 (progn (forward-line 1) (point)))
351 (progn 369 outbuf)))
352 ;; Back up over whitespace, to preserve it. 370 ((looking-at ";")
353 (skip-chars-backward " \f\t") 371 ;; Don't read the comment.
354 (if (= (char-after (1+ (point))) ? ) 372 (forward-line 1))
355 ;; Eat one space. 373 (t
356 (forward-char 1)) 374 (forward-sexp 1)
357 (point)) 375 (forward-line 1))))))
358 (progn (forward-line 1) (point))) 376
359 outbuf))) 377 (when done-any
360 ((looking-at ";") 378 (with-current-buffer outbuf
361 ;; Don't read the comment. 379 (save-excursion
362 (forward-line 1)) 380 ;; Insert the section-header line which lists the file name
363 (t 381 ;; and which functions are in it, etc.
364 (forward-sexp 1) 382 (goto-char output-start)
365 (forward-line 1))))))) 383 (autoload-insert-section-header
366 (or visited 384 outbuf autoloads-done load-name file
367 ;; We created this buffer, so we should kill it. 385 (nth 5 (file-attributes file)))
368 (kill-buffer (current-buffer))) 386 (insert ";;; Generated autoloads from "
369 (set-buffer outbuf) 387 (autoload-trim-file-name file) "\n"))
370 (setq output-end (point-marker)))) 388 (insert generate-autoload-section-trailer)))
371 (if done-any 389 (message "Generating autoloads for %s...done" file))
372 (progn 390 (or visited
373 ;; Insert the section-header line 391 ;; We created this buffer, so we should kill it.
374 ;; which lists the file name and which functions are in it, etc. 392 (kill-buffer (current-buffer))))
375 (autoload-insert-section-header outbuf autoloads-done load-name file 393 (not done-any)))
376 (nth 5 (file-attributes file)))
377 (insert ";;; Generated autoloads from "
378 (autoload-trim-file-name file) "\n")
379 (goto-char output-end)
380 (insert generate-autoload-section-trailer)))
381 (message "Generating autoloads for %s...done" file)))
382 394
383;;;###autoload 395;;;###autoload
384(defun update-file-autoloads (file &optional save-after) 396(defun update-file-autoloads (file &optional save-after)
@@ -457,37 +469,7 @@ Autoload section for %s is up to date."
457 (goto-char (point-max)) 469 (goto-char (point-max))
458 (search-backward "\f" nil t))) 470 (search-backward "\f" nil t)))
459 (or (eq found 'up-to-date) 471 (or (eq found 'up-to-date)
460 (and (eq found 'new) 472 (setq no-autoloads (generate-file-autoloads file)))))
461 ;; Check that FILE has any cookies before generating a
462 ;; new section for it.
463 (save-excursion
464 (if existing-buffer
465 (set-buffer existing-buffer)
466 ;; It is faster to avoid visiting the file.
467 (set-buffer (get-buffer-create " *autoload-file*"))
468 (kill-all-local-variables)
469 (erase-buffer)
470 (setq buffer-undo-list t
471 buffer-read-only nil)
472 (emacs-lisp-mode)
473 (insert-file-contents file nil))
474 (save-excursion
475 (save-restriction
476 (widen)
477 (goto-char (point-min))
478 (prog1
479 (if (re-search-forward
480 (concat "^" (regexp-quote
481 generate-autoload-cookie))
482 nil t)
483 nil
484 (if (interactive-p)
485 (message "%s has no autoloads" file))
486 (setq no-autoloads t)
487 t)
488 (or existing-buffer
489 (kill-buffer (current-buffer))))))))
490 (generate-file-autoloads file))))
491 (and save-after 473 (and save-after
492 (buffer-modified-p) 474 (buffer-modified-p)
493 (save-buffer)) 475 (save-buffer))
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 455b049dc8a..d05eed2c4a2 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -171,8 +171,8 @@
171;; | INTEGER_CONSTANT 171;; | INTEGER_CONSTANT
172;; | DEREF 172;; | DEREF
173 173
174;; DEREF ::= ( [NAME | INTEGER]... ) -- Field NAME or Array index relative to 174;; DEREF ::= ( [NAME | INTEGER]... ) -- Field NAME or Array index relative
175;; current structure spec. 175;; to current structure spec.
176;; -- see bindat-get-field 176;; -- see bindat-get-field
177 177
178;; A `union' specification 178;; A `union' specification
@@ -188,23 +188,20 @@
188;; ([FIELD] eval FORM) 188;; ([FIELD] eval FORM)
189;; is interpreted by evalling FORM for its side effects only. 189;; is interpreted by evalling FORM for its side effects only.
190;; If FIELD is specified, the value is bound to that field. 190;; If FIELD is specified, the value is bound to that field.
191;; The FORM may access and update `raw-data' and `pos' (see `bindat-unpack'), 191;; The FORM may access and update `bindat-raw' and `bindat-idx' (see `bindat-unpack').
192;; as well as the lisp data structure in `struct'.
193 192
194;;; Code: 193;;; Code:
195 194
196;; Helper functions for structure unpacking. 195;; Helper functions for structure unpacking.
197;; Relies on dynamic binding of RAW-DATA and POS 196;; Relies on dynamic binding of BINDAT-RAW and BINDAT-IDX
198 197
199(defvar raw-data) 198(defvar bindat-raw)
200(defvar pos) 199(defvar bindat-idx)
201 200
202(defun bindat--unpack-u8 () 201(defun bindat--unpack-u8 ()
203 (prog1 202 (prog1
204 (if (stringp raw-data) 203 (aref bindat-raw bindat-idx)
205 (string-to-char (substring raw-data pos (1+ pos))) 204 (setq bindat-idx (1+ bindat-idx))))
206 (aref raw-data pos))
207 (setq pos (1+ pos))))
208 205
209(defun bindat--unpack-u16 () 206(defun bindat--unpack-u16 ()
210 (let* ((a (bindat--unpack-u8)) (b (bindat--unpack-u8))) 207 (let* ((a (bindat--unpack-u8)) (b (bindat--unpack-u8)))
@@ -261,16 +258,16 @@
261 j (lsh j -1))))) 258 j (lsh j -1)))))
262 bits)) 259 bits))
263 ((eq type 'str) 260 ((eq type 'str)
264 (let ((s (substring raw-data pos (+ pos len)))) 261 (let ((s (substring bindat-raw bindat-idx (+ bindat-idx len))))
265 (setq pos (+ pos len)) 262 (setq bindat-idx (+ bindat-idx len))
266 (if (stringp s) s 263 (if (stringp s) s
267 (string-make-unibyte (concat s))))) 264 (string-make-unibyte (concat s)))))
268 ((eq type 'strz) 265 ((eq type 'strz)
269 (let ((i 0) s) 266 (let ((i 0) s)
270 (while (and (< i len) (/= (aref raw-data (+ pos i)) 0)) 267 (while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0))
271 (setq i (1+ i))) 268 (setq i (1+ i)))
272 (setq s (substring raw-data pos (+ pos i))) 269 (setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
273 (setq pos (+ pos len)) 270 (setq bindat-idx (+ bindat-idx len))
274 (if (stringp s) s 271 (if (stringp s) s
275 (string-make-unibyte (concat s))))) 272 (string-make-unibyte (concat s)))))
276 ((eq type 'vec) 273 ((eq type 'vec)
@@ -312,10 +309,10 @@
312 (setq data (eval len)) 309 (setq data (eval len))
313 (eval len))) 310 (eval len)))
314 ((eq type 'fill) 311 ((eq type 'fill)
315 (setq pos (+ pos len))) 312 (setq bindat-idx (+ bindat-idx len)))
316 ((eq type 'align) 313 ((eq type 'align)
317 (while (/= (% pos len) 0) 314 (while (/= (% bindat-idx len) 0)
318 (setq pos (1+ pos)))) 315 (setq bindat-idx (1+ bindat-idx))))
319 ((eq type 'struct) 316 ((eq type 'struct)
320 (setq data (bindat--unpack-group (eval len)))) 317 (setq data (bindat--unpack-group (eval len))))
321 ((eq type 'repeat) 318 ((eq type 'repeat)
@@ -343,11 +340,13 @@
343 (setq struct (append data struct)))))) 340 (setq struct (append data struct))))))
344 struct)) 341 struct))
345 342
346(defun bindat-unpack (spec raw-data &optional pos) 343(defun bindat-unpack (spec bindat-raw &optional bindat-idx)
347 "Return structured data according to SPEC for binary data in RAW-DATA. 344 "Return structured data according to SPEC for binary data in BINDAT-RAW.
348RAW-DATA is a string or vector. Optional third arg POS specifies the 345BINDAT-RAW is a unibyte string or vector. Optional third arg BINDAT-IDX specifies
349starting offset in RAW-DATA." 346the starting offset in BINDAT-RAW."
350 (unless pos (setq pos 0)) 347 (when (multibyte-string-p bindat-raw)
348 (error "String is multibyte"))
349 (unless bindat-idx (setq bindat-idx 0))
351 (bindat--unpack-group spec)) 350 (bindat--unpack-group spec))
352 351
353(defun bindat-get-field (struct &rest field) 352(defun bindat-get-field (struct &rest field)
@@ -366,7 +365,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
366 struct) 365 struct)
367 366
368 367
369;; Calculate raw-data length of structured data 368;; Calculate bindat-raw length of structured data
370 369
371(defvar bindat--fixed-length-alist 370(defvar bindat--fixed-length-alist
372 '((u8 . 1) (byte . 1) 371 '((u8 . 1) (byte . 1)
@@ -405,17 +404,19 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
405 (setq struct (cons (cons field (eval len)) struct)) 404 (setq struct (cons (cons field (eval len)) struct))
406 (eval len))) 405 (eval len)))
407 ((eq type 'fill) 406 ((eq type 'fill)
408 (setq pos (+ pos len))) 407 (setq bindat-idx (+ bindat-idx len)))
409 ((eq type 'align) 408 ((eq type 'align)
410 (while (/= (% pos len) 0) 409 (while (/= (% bindat-idx len) 0)
411 (setq pos (1+ pos)))) 410 (setq bindat-idx (1+ bindat-idx))))
412 ((eq type 'struct) 411 ((eq type 'struct)
413 (bindat--length-group 412 (bindat--length-group
414 (if field (bindat-get-field struct field) struct) (eval len))) 413 (if field (bindat-get-field struct field) struct) (eval len)))
415 ((eq type 'repeat) 414 ((eq type 'repeat)
416 (let ((index 0)) 415 (let ((index 0))
417 (while (< index len) 416 (while (< index len)
418 (bindat--length-group (nth index (bindat-get-field struct field)) (nthcdr tail item)) 417 (bindat--length-group
418 (nth index (bindat-get-field struct field))
419 (nthcdr tail item))
419 (setq index (1+ index))))) 420 (setq index (1+ index)))))
420 ((eq type 'union) 421 ((eq type 'union)
421 (let ((tag len) (cases (nthcdr tail item)) case cc) 422 (let ((tag len) (cases (nthcdr tail item)) case cc)
@@ -433,25 +434,25 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
433 (setq len (cdr type))) 434 (setq len (cdr type)))
434 (if field 435 (if field
435 (setq last (bindat-get-field struct field))) 436 (setq last (bindat-get-field struct field)))
436 (setq pos (+ pos len)))))))) 437 (setq bindat-idx (+ bindat-idx len))))))))
437 438
438(defun bindat-length (spec struct) 439(defun bindat-length (spec struct)
439 "Calculate raw-data length for STRUCT according to bindat specification SPEC." 440 "Calculate bindat-raw length for STRUCT according to bindat SPEC."
440 (let ((pos 0)) 441 (let ((bindat-idx 0))
441 (bindat--length-group struct spec) 442 (bindat--length-group struct spec)
442 pos)) 443 bindat-idx))
443 444
444 445
445;; Pack structured data into raw-data 446;; Pack structured data into bindat-raw
446 447
447(defun bindat--pack-u8 (v) 448(defun bindat--pack-u8 (v)
448 (aset raw-data pos (logand v 255)) 449 (aset bindat-raw bindat-idx (logand v 255))
449 (setq pos (1+ pos))) 450 (setq bindat-idx (1+ bindat-idx)))
450 451
451(defun bindat--pack-u16 (v) 452(defun bindat--pack-u16 (v)
452 (aset raw-data pos (logand (lsh v -8) 255)) 453 (aset bindat-raw bindat-idx (logand (lsh v -8) 255))
453 (aset raw-data (1+ pos) (logand v 255)) 454 (aset bindat-raw (1+ bindat-idx) (logand v 255))
454 (setq pos (+ pos 2))) 455 (setq bindat-idx (+ bindat-idx 2)))
455 456
456(defun bindat--pack-u24 (v) 457(defun bindat--pack-u24 (v)
457 (bindat--pack-u8 (lsh v -16)) 458 (bindat--pack-u8 (lsh v -16))
@@ -462,9 +463,9 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
462 (bindat--pack-u16 v)) 463 (bindat--pack-u16 v))
463 464
464(defun bindat--pack-u16r (v) 465(defun bindat--pack-u16r (v)
465 (aset raw-data (1+ pos) (logand (lsh v -8) 255)) 466 (aset bindat-raw (1+ bindat-idx) (logand (lsh v -8) 255))
466 (aset raw-data pos (logand v 255)) 467 (aset bindat-raw bindat-idx (logand v 255))
467 (setq pos (+ pos 2))) 468 (setq bindat-idx (+ bindat-idx 2)))
468 469
469(defun bindat--pack-u24r (v) 470(defun bindat--pack-u24r (v)
470 (bindat--pack-u16r v) 471 (bindat--pack-u16r v)
@@ -479,7 +480,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
479 (setq type 'vec len 4)) 480 (setq type 'vec len 4))
480 (cond 481 (cond
481 ((null v) 482 ((null v)
482 (setq pos (+ pos len))) 483 (setq bindat-idx (+ bindat-idx len)))
483 ((memq type '(u8 byte)) 484 ((memq type '(u8 byte))
484 (bindat--pack-u8 v)) 485 (bindat--pack-u8 v))
485 ((memq type '(u16 word short)) 486 ((memq type '(u16 word short))
@@ -511,11 +512,11 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
511 (let ((l (length v)) (i 0)) 512 (let ((l (length v)) (i 0))
512 (if (> l len) (setq l len)) 513 (if (> l len) (setq l len))
513 (while (< i l) 514 (while (< i l)
514 (aset raw-data (+ pos i) (aref v i)) 515 (aset bindat-raw (+ bindat-idx i) (aref v i))
515 (setq i (1+ i))) 516 (setq i (1+ i)))
516 (setq pos (+ pos len)))) 517 (setq bindat-idx (+ bindat-idx len))))
517 (t 518 (t
518 (setq pos (+ pos len))))) 519 (setq bindat-idx (+ bindat-idx len)))))
519 520
520(defun bindat--pack-group (struct spec) 521(defun bindat--pack-group (struct spec)
521 (let (last) 522 (let (last)
@@ -547,17 +548,19 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
547 (setq struct (cons (cons field (eval len)) struct)) 548 (setq struct (cons (cons field (eval len)) struct))
548 (eval len))) 549 (eval len)))
549 ((eq type 'fill) 550 ((eq type 'fill)
550 (setq pos (+ pos len))) 551 (setq bindat-idx (+ bindat-idx len)))
551 ((eq type 'align) 552 ((eq type 'align)
552 (while (/= (% pos len) 0) 553 (while (/= (% bindat-idx len) 0)
553 (setq pos (1+ pos)))) 554 (setq bindat-idx (1+ bindat-idx))))
554 ((eq type 'struct) 555 ((eq type 'struct)
555 (bindat--pack-group 556 (bindat--pack-group
556 (if field (bindat-get-field struct field) struct) (eval len))) 557 (if field (bindat-get-field struct field) struct) (eval len)))
557 ((eq type 'repeat) 558 ((eq type 'repeat)
558 (let ((index 0)) 559 (let ((index 0))
559 (while (< index len) 560 (while (< index len)
560 (bindat--pack-group (nth index (bindat-get-field struct field)) (nthcdr tail item)) 561 (bindat--pack-group
562 (nth index (bindat-get-field struct field))
563 (nthcdr tail item))
561 (setq index (1+ index))))) 564 (setq index (1+ index)))))
562 ((eq type 'union) 565 ((eq type 'union)
563 (let ((tag len) (cases (nthcdr tail item)) case cc) 566 (let ((tag len) (cases (nthcdr tail item)) case cc)
@@ -575,17 +578,19 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
575 (bindat--pack-item last type len) 578 (bindat--pack-item last type len)
576 )))))) 579 ))))))
577 580
578(defun bindat-pack (spec struct &optional raw-data pos) 581(defun bindat-pack (spec struct &optional bindat-raw bindat-idx)
579 "Return binary data packed according to SPEC for structured data STRUCT. 582 "Return binary data packed according to SPEC for structured data STRUCT.
580Optional third arg RAW-DATA is a pre-allocated string or vector to unpack into. 583Optional third arg BINDAT-RAW is a pre-allocated unibyte string or vector to
581Optional fourth arg POS is the starting offset into RAW-DATA. 584pack into.
582Note: The result is a multibyte string; use `string-make-unibyte' on it 585Optional fourth arg BINDAT-IDX is the starting offset into BINDAT-RAW."
583to make it unibyte if necessary." 586 (when (multibyte-string-p bindat-raw)
584 (let ((no-return raw-data)) 587 (error "Pre-allocated string is multibyte"))
585 (unless pos (setq pos 0)) 588 (let ((no-return bindat-raw))
586 (unless raw-data (setq raw-data (make-vector (+ pos (bindat-length spec struct)) 0))) 589 (unless bindat-idx (setq bindat-idx 0))
590 (unless bindat-raw
591 (setq bindat-raw (make-vector (+ bindat-idx (bindat-length spec struct)) 0)))
587 (bindat--pack-group struct spec) 592 (bindat--pack-group struct spec)
588 (if no-return nil (concat raw-data)))) 593 (if no-return nil (concat bindat-raw))))
589 594
590 595
591;; Misc. format conversions 596;; Misc. format conversions
diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el
index fa85ce21fb0..b4857f4310d 100644
--- a/lisp/emacs-lisp/ewoc.el
+++ b/lisp/emacs-lisp/ewoc.el
@@ -88,34 +88,7 @@
88;; limit! It is even possible to have another ewoc as an 88;; limit! It is even possible to have another ewoc as an
89;; element. In that way some kind of tree hierarchy can be created. 89;; element. In that way some kind of tree hierarchy can be created.
90;; 90;;
91;; Full documentation will, God willing, soon be available in a 91;; The Emacs Lisp Reference Manual documents ewoc.el's "public interface".
92;; Texinfo manual.
93
94;; In the mean time `grep '^(.*ewoc-[^-]' emacs-lisp/ewoc.el' can help
95;; you find all the exported functions:
96;;
97;; (defun ewoc-create (pretty-printer &optional header footer)
98;; (defalias 'ewoc-data 'ewoc--node-data)
99;; (defun ewoc-location (node)
100;; (defun ewoc-enter-first (ewoc data)
101;; (defun ewoc-enter-last (ewoc data)
102;; (defun ewoc-enter-after (ewoc node data)
103;; (defun ewoc-enter-before (ewoc node data)
104;; (defun ewoc-next (ewoc node)
105;; (defun ewoc-prev (ewoc node)
106;; (defun ewoc-nth (ewoc n)
107;; (defun ewoc-map (map-function ewoc &rest args)
108;; (defun ewoc-filter (ewoc predicate &rest args)
109;; (defun ewoc-locate (ewoc &optional pos guess)
110;; (defun ewoc-invalidate (ewoc &rest nodes)
111;; (defun ewoc-goto-prev (ewoc arg)
112;; (defun ewoc-goto-next (ewoc arg)
113;; (defun ewoc-goto-node (ewoc node)
114;; (defun ewoc-refresh (ewoc)
115;; (defun ewoc-collect (ewoc predicate &rest args)
116;; (defun ewoc-buffer (ewoc)
117;; (defun ewoc-get-hf (ewoc)
118;; (defun ewoc-set-hf (ewoc header footer)
119 92
120;; Coding conventions 93;; Coding conventions
121;; ================== 94;; ==================
@@ -123,48 +96,43 @@
123;; All functions of course start with `ewoc'. Functions and macros 96;; All functions of course start with `ewoc'. Functions and macros
124;; starting with the prefix `ewoc--' are meant for internal use, 97;; starting with the prefix `ewoc--' are meant for internal use,
125;; while those starting with `ewoc-' are exported for public use. 98;; while those starting with `ewoc-' are exported for public use.
126;; There are currently no global or buffer-local variables used.
127
128 99
129;;; Code: 100;;; Code:
130 101
131(eval-when-compile (require 'cl)) ;because of CL compiler macros 102(eval-when-compile (require 'cl))
132
133;; The doubly linked list is implemented as a circular list
134;; with a dummy node first and last. The dummy node is used as
135;; "the dll" (or rather is the dll handle passed around).
136 103
104;; The doubly linked list is implemented as a circular list with a dummy
105;; node first and last. The dummy node is used as "the dll".
137(defstruct (ewoc--node 106(defstruct (ewoc--node
138 (:type vector) ;required for ewoc--node-branch hack 107 (:type vector) ;ewoc--node-nth needs this
108 (:constructor nil)
139 (:constructor ewoc--node-create (start-marker data))) 109 (:constructor ewoc--node-create (start-marker data)))
140 left right data start-marker) 110 left right data start-marker)
141 111
142(defalias 'ewoc--node-branch 'aref
143 "Get the left (CHILD=0) or right (CHILD=1) child of the NODE.
144
145\(fn NODE CHILD)")
146
147(defun ewoc--node-next (dll node) 112(defun ewoc--node-next (dll node)
148 "Return the node after NODE, or nil if NODE is the last node." 113 "Return the node after NODE, or nil if NODE is the last node."
149 (unless (eq (ewoc--node-right node) dll) (ewoc--node-right node))) 114 (let ((R (ewoc--node-right node)))
115 (unless (eq dll R) R)))
150 116
151(defun ewoc--node-prev (dll node) 117(defun ewoc--node-prev (dll node)
152 "Return the node before NODE, or nil if NODE is the first node." 118 "Return the node before NODE, or nil if NODE is the first node."
153 (unless (eq (ewoc--node-left node) dll) (ewoc--node-left node))) 119 (let ((L (ewoc--node-left node)))
120 (unless (eq dll L) L)))
154 121
155(defun ewoc--node-nth (dll n) 122(defun ewoc--node-nth (dll n)
156 "Return the Nth node from the doubly linked list DLL. 123 "Return the Nth node from the doubly linked list `dll'.
157N counts from zero. If DLL is not that long, nil is returned. 124N counts from zero. If N is negative, return the -(N+1)th last element.
158If N is negative, return the -(N+1)th last element. 125If N is out of range, return nil.
159Thus, (ewoc--node-nth dll 0) returns the first node, 126Thus, (ewoc--node-nth dll 0) returns the first node,
160and (ewoc--node-nth dll -1) returns the last node." 127and (ewoc--node-nth dll -1) returns the last node."
128 ;; Presuming a node is ":type vector", starting with `left' and `right':
161 ;; Branch 0 ("follow left pointer") is used when n is negative. 129 ;; Branch 0 ("follow left pointer") is used when n is negative.
162 ;; Branch 1 ("follow right pointer") is used otherwise. 130 ;; Branch 1 ("follow right pointer") is used otherwise.
163 (let* ((branch (if (< n 0) 0 1)) 131 (let* ((branch (if (< n 0) 0 1))
164 (node (ewoc--node-branch dll branch))) 132 (node (aref dll branch)))
165 (if (< n 0) (setq n (- -1 n))) 133 (if (< n 0) (setq n (- -1 n)))
166 (while (and (not (eq dll node)) (> n 0)) 134 (while (and (not (eq dll node)) (> n 0))
167 (setq node (ewoc--node-branch node branch)) 135 (setq node (aref node branch))
168 (setq n (1- n))) 136 (setq n (1- n)))
169 (unless (eq dll node) node))) 137 (unless (eq dll node) node)))
170 138
@@ -177,16 +145,15 @@ and (ewoc--node-nth dll -1) returns the last node."
177 145
178(defstruct (ewoc 146(defstruct (ewoc
179 (:constructor nil) 147 (:constructor nil)
180 (:constructor ewoc--create 148 (:constructor ewoc--create (buffer pretty-printer dll))
181 (buffer pretty-printer header footer dll))
182 (:conc-name ewoc--)) 149 (:conc-name ewoc--))
183 buffer pretty-printer header footer dll last-node) 150 buffer pretty-printer header footer dll last-node hf-pp)
184 151
185(defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms) 152(defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms)
186 "Execute FORMS with ewoc--buffer selected as current buffer, 153 "Execute FORMS with ewoc--buffer selected as current buffer,
187dll bound to ewoc--dll, and VARLIST bound as in a let*. 154`dll' bound to the dll, and VARLIST bound as in a let*.
188dll will be bound when VARLIST is initialized, but the current 155`dll' will be bound when VARLIST is initialized, but
189buffer will *not* have been changed. 156the current buffer will *not* have been changed.
190Return value of last form in FORMS." 157Return value of last form in FORMS."
191 (let ((hnd (make-symbol "ewoc"))) 158 (let ((hnd (make-symbol "ewoc")))
192 `(let* ((,hnd ,ewoc) 159 `(let* ((,hnd ,ewoc)
@@ -205,45 +172,63 @@ BUT if it is the header or the footer in EWOC return nil instead."
205 (eq node (ewoc--footer ewoc))) 172 (eq node (ewoc--footer ewoc)))
206 node)) 173 node))
207 174
175(defun ewoc--adjust (beg end node dll)
176 ;; "Manually reseat" markers for NODE and its successors (including footer
177 ;; and dll), in the case where they originally shared start position with
178 ;; BEG, to END. BEG and END are buffer positions describing NODE's left
179 ;; neighbor. This operation is functionally equivalent to temporarily
180 ;; setting these nodes' markers' insertion type to t around the pretty-print
181 ;; call that precedes the call to `ewoc--adjust', and then changing them back
182 ;; to nil.
183 (when (< beg end)
184 (let (m)
185 (while (and (= beg (setq m (ewoc--node-start-marker node)))
186 ;; The "dummy" node `dll' actually holds the marker that
187 ;; points to the end of the footer, so we check `dll'
188 ;; *after* reseating the marker.
189 (progn
190 (set-marker m end)
191 (not (eq dll node))))
192 (setq node (ewoc--node-right node))))))
193
208(defun ewoc--insert-new-node (node data pretty-printer) 194(defun ewoc--insert-new-node (node data pretty-printer)
209 "Insert before NODE a new node for DATA, displayed by PRETTY-PRINTER. 195 "Insert before NODE a new node for DATA, displayed by PRETTY-PRINTER.
210Call PRETTY-PRINTER with point at NODE's start, thus pushing back 196Call PRETTY-PRINTER with point at NODE's start, thus pushing back
211NODE and leaving the new node's start there. Return the new node." 197NODE and leaving the new node's start there. Return the new node."
212 (save-excursion 198 (save-excursion
213 (let* ((inhibit-read-only t) 199 (let ((elemnode (ewoc--node-create
214 (m (copy-marker (ewoc--node-start-marker node))) 200 (copy-marker (ewoc--node-start-marker node)) data)))
215 (pos (marker-position m)) 201 (setf (ewoc--node-left elemnode) (ewoc--node-left node)
216 (elemnode (ewoc--node-create m data)))
217 (goto-char pos)
218 ;; Insert the trailing newline using insert-before-markers
219 ;; so that the start position for the next element is updated.
220 (insert-before-markers ?\n)
221 ;; Move back, and call the pretty-printer.
222 (backward-char 1)
223 (funcall pretty-printer data)
224 (setf (marker-position m) pos
225 (ewoc--node-left elemnode) (ewoc--node-left node)
226 (ewoc--node-right elemnode) node 202 (ewoc--node-right elemnode) node
227 (ewoc--node-right (ewoc--node-left node)) elemnode 203 (ewoc--node-right (ewoc--node-left node)) elemnode
228 (ewoc--node-left node) elemnode) 204 (ewoc--node-left node) elemnode)
205 (ewoc--refresh-node pretty-printer elemnode dll)
229 elemnode))) 206 elemnode)))
230 207
231(defun ewoc--refresh-node (pp node) 208(defun ewoc--refresh-node (pp node dll)
232 "Redisplay the element represented by NODE using the pretty-printer PP." 209 "Redisplay the element represented by NODE using the pretty-printer PP."
233 (let ((inhibit-read-only t)) 210 (let ((inhibit-read-only t)
211 (m (ewoc--node-start-marker node))
212 (R (ewoc--node-right node)))
234 ;; First, remove the string from the buffer: 213 ;; First, remove the string from the buffer:
235 (delete-region (ewoc--node-start-marker node) 214 (delete-region m (ewoc--node-start-marker R))
236 (1- (marker-position
237 (ewoc--node-start-marker (ewoc--node-right node)))))
238 ;; Calculate and insert the string. 215 ;; Calculate and insert the string.
239 (goto-char (ewoc--node-start-marker node)) 216 (goto-char m)
240 (funcall pp (ewoc--node-data node)))) 217 (funcall pp (ewoc--node-data node))
218 (ewoc--adjust m (point) R dll)))
219
220(defun ewoc--wrap (func)
221 (lexical-let ((ewoc--user-pp func))
222 (lambda (data)
223 (funcall ewoc--user-pp data)
224 (insert "\n"))))
225
241 226
242;;; =========================================================================== 227;;; ===========================================================================
243;;; Public members of the Ewoc package 228;;; Public members of the Ewoc package
244 229
245 230;;;###autoload
246(defun ewoc-create (pretty-printer &optional header footer) 231(defun ewoc-create (pretty-printer &optional header footer nosep)
247 "Create an empty ewoc. 232 "Create an empty ewoc.
248 233
249The ewoc will be inserted in the current buffer at the current position. 234The ewoc will be inserted in the current buffer at the current position.
@@ -251,21 +236,25 @@ The ewoc will be inserted in the current buffer at the current position.
251PRETTY-PRINTER should be a function that takes one argument, an 236PRETTY-PRINTER should be a function that takes one argument, an
252element, and inserts a string representing it in the buffer (at 237element, and inserts a string representing it in the buffer (at
253point). The string PRETTY-PRINTER inserts may be empty or span 238point). The string PRETTY-PRINTER inserts may be empty or span
254several lines. A trailing newline will always be inserted 239several lines. The PRETTY-PRINTER should use `insert', and not
255automatically. The PRETTY-PRINTER should use `insert', and not
256`insert-before-markers'. 240`insert-before-markers'.
257 241
258Optional second argument HEADER is a string that will always be 242Optional second and third arguments HEADER and FOOTER are strings,
259present at the top of the ewoc. HEADER should end with a 243possibly empty, that will always be present at the top and bottom,
260newline. Optional third argument FOOTER is similar, and will 244respectively, of the ewoc.
261be inserted at the bottom of the ewoc." 245
246Normally, a newline is automatically inserted after the header,
247the footer and every node's printed representation. Optional
248fourth arg NOSEP non-nil inhibits this."
262 (let* ((dummy-node (ewoc--node-create 'DL-LIST 'DL-LIST)) 249 (let* ((dummy-node (ewoc--node-create 'DL-LIST 'DL-LIST))
263 (dll (progn (setf (ewoc--node-right dummy-node) dummy-node) 250 (dll (progn (setf (ewoc--node-right dummy-node) dummy-node)
264 (setf (ewoc--node-left dummy-node) dummy-node) 251 (setf (ewoc--node-left dummy-node) dummy-node)
265 dummy-node)) 252 dummy-node))
266 (new-ewoc 253 (wrap (if nosep 'identity 'ewoc--wrap))
267 (ewoc--create (current-buffer) 254 (new-ewoc (ewoc--create (current-buffer)
268 pretty-printer nil nil dll)) 255 (funcall wrap pretty-printer)
256 dll))
257 (hf-pp (funcall wrap 'insert))
269 (pos (point)) 258 (pos (point))
270 head foot) 259 head foot)
271 (ewoc--set-buffer-bind-dll new-ewoc 260 (ewoc--set-buffer-bind-dll new-ewoc
@@ -273,8 +262,9 @@ be inserted at the bottom of the ewoc."
273 (unless header (setq header "")) 262 (unless header (setq header ""))
274 (unless footer (setq footer "")) 263 (unless footer (setq footer ""))
275 (setf (ewoc--node-start-marker dll) (copy-marker pos) 264 (setf (ewoc--node-start-marker dll) (copy-marker pos)
276 foot (ewoc--insert-new-node dll footer 'insert) 265 foot (ewoc--insert-new-node dll footer hf-pp)
277 head (ewoc--insert-new-node foot header 'insert) 266 head (ewoc--insert-new-node foot header hf-pp)
267 (ewoc--hf-pp new-ewoc) hf-pp
278 (ewoc--footer new-ewoc) foot 268 (ewoc--footer new-ewoc) foot
279 (ewoc--header new-ewoc) head)) 269 (ewoc--header new-ewoc) head))
280 ;; Return the ewoc 270 ;; Return the ewoc
@@ -285,6 +275,10 @@ be inserted at the bottom of the ewoc."
285 275
286\(fn NODE)") 276\(fn NODE)")
287 277
278(defun ewoc-set-data (node data)
279 "Set NODE to encapsulate DATA."
280 (setf (ewoc--node-data node) data))
281
288(defun ewoc-enter-first (ewoc data) 282(defun ewoc-enter-first (ewoc data)
289 "Enter DATA first in EWOC. 283 "Enter DATA first in EWOC.
290Return the new node." 284Return the new node."
@@ -297,7 +291,6 @@ Return the new node."
297 (ewoc--set-buffer-bind-dll ewoc 291 (ewoc--set-buffer-bind-dll ewoc
298 (ewoc-enter-before ewoc (ewoc--node-nth dll -1) data))) 292 (ewoc-enter-before ewoc (ewoc--node-nth dll -1) data)))
299 293
300
301(defun ewoc-enter-after (ewoc node data) 294(defun ewoc-enter-after (ewoc node data)
302 "Enter a new element DATA after NODE in EWOC. 295 "Enter a new element DATA after NODE in EWOC.
303Return the new node." 296Return the new node."
@@ -322,21 +315,19 @@ Return nil if NODE is nil or the last element."
322Return nil if NODE is nil or the first element." 315Return nil if NODE is nil or the first element."
323 (when node 316 (when node
324 (ewoc--filter-hf-nodes 317 (ewoc--filter-hf-nodes
325 ewoc 318 ewoc (ewoc--node-prev (ewoc--dll ewoc) node))))
326 (ewoc--node-prev (ewoc--dll ewoc) node))))
327
328 319
329(defun ewoc-nth (ewoc n) 320(defun ewoc-nth (ewoc n)
330 "Return the Nth node. 321 "Return the Nth node.
331N counts from zero. Return nil if there is less than N elements. 322N counts from zero. Return nil if there is less than N elements.
332If N is negative, return the -(N+1)th last element. 323If N is negative, return the -(N+1)th last element.
333Thus, (ewoc-nth dll 0) returns the first node, 324Thus, (ewoc-nth ewoc 0) returns the first node,
334and (ewoc-nth dll -1) returns the last node. 325and (ewoc-nth ewoc -1) returns the last node.
335Use `ewoc-data' to extract the data from the node." 326Use `ewoc-data' to extract the data from the node."
336 ;; Skip the header (or footer, if n is negative). 327 ;; Skip the header (or footer, if n is negative).
337 (setq n (if (< n 0) (1- n) (1+ n))) 328 (setq n (if (< n 0) (1- n) (1+ n)))
338 (ewoc--filter-hf-nodes ewoc 329 (ewoc--filter-hf-nodes ewoc
339 (ewoc--node-nth (ewoc--dll ewoc) n))) 330 (ewoc--node-nth (ewoc--dll ewoc) n)))
340 331
341(defun ewoc-map (map-function ewoc &rest args) 332(defun ewoc-map (map-function ewoc &rest args)
342 "Apply MAP-FUNCTION to all elements in EWOC. 333 "Apply MAP-FUNCTION to all elements in EWOC.
@@ -352,13 +343,35 @@ If more than two arguments are given, the remaining
352arguments will be passed to MAP-FUNCTION." 343arguments will be passed to MAP-FUNCTION."
353 (ewoc--set-buffer-bind-dll-let* ewoc 344 (ewoc--set-buffer-bind-dll-let* ewoc
354 ((footer (ewoc--footer ewoc)) 345 ((footer (ewoc--footer ewoc))
346 (pp (ewoc--pretty-printer ewoc))
355 (node (ewoc--node-nth dll 1))) 347 (node (ewoc--node-nth dll 1)))
356 (save-excursion 348 (save-excursion
357 (while (not (eq node footer)) 349 (while (not (eq node footer))
358 (if (apply map-function (ewoc--node-data node) args) 350 (if (apply map-function (ewoc--node-data node) args)
359 (ewoc--refresh-node (ewoc--pretty-printer ewoc) node)) 351 (ewoc--refresh-node pp node dll))
360 (setq node (ewoc--node-next dll node)))))) 352 (setq node (ewoc--node-next dll node))))))
361 353
354(defun ewoc-delete (ewoc &rest nodes)
355 "Delete NODES from EWOC."
356 (ewoc--set-buffer-bind-dll-let* ewoc
357 ((L nil) (R nil) (last (ewoc--last-node ewoc)))
358 (dolist (node nodes)
359 ;; If we are about to delete the node pointed at by last-node,
360 ;; set last-node to nil.
361 (when (eq last node)
362 (setf last nil (ewoc--last-node ewoc) nil))
363 (delete-region (ewoc--node-start-marker node)
364 (ewoc--node-start-marker (ewoc--node-next dll node)))
365 (set-marker (ewoc--node-start-marker node) nil)
366 (setf L (ewoc--node-left node)
367 R (ewoc--node-right node)
368 ;; Link neighbors to each other.
369 (ewoc--node-right L) R
370 (ewoc--node-left R) L
371 ;; Forget neighbors.
372 (ewoc--node-left node) nil
373 (ewoc--node-right node) nil))))
374
362(defun ewoc-filter (ewoc predicate &rest args) 375(defun ewoc-filter (ewoc predicate &rest args)
363 "Remove all elements in EWOC for which PREDICATE returns nil. 376 "Remove all elements in EWOC for which PREDICATE returns nil.
364Note that the buffer for EWOC will be current-buffer when PREDICATE 377Note that the buffer for EWOC will be current-buffer when PREDICATE
@@ -369,28 +382,13 @@ ARGS are given they will be passed to the PREDICATE."
369 (ewoc--set-buffer-bind-dll-let* ewoc 382 (ewoc--set-buffer-bind-dll-let* ewoc
370 ((node (ewoc--node-nth dll 1)) 383 ((node (ewoc--node-nth dll 1))
371 (footer (ewoc--footer ewoc)) 384 (footer (ewoc--footer ewoc))
372 (next nil) 385 (goodbye nil)
373 (L nil) (R nil)
374 (inhibit-read-only t)) 386 (inhibit-read-only t))
375 (while (not (eq node footer)) 387 (while (not (eq node footer))
376 (setq next (ewoc--node-next dll node))
377 (unless (apply predicate (ewoc--node-data node) args) 388 (unless (apply predicate (ewoc--node-data node) args)
378 ;; If we are about to delete the node pointed at by last-node, 389 (push node goodbye))
379 ;; set last-node to nil. 390 (setq node (ewoc--node-next dll node)))
380 (if (eq (ewoc--last-node ewoc) node) 391 (apply 'ewoc-delete ewoc goodbye)))
381 (setf (ewoc--last-node ewoc) nil))
382 (delete-region (ewoc--node-start-marker node)
383 (ewoc--node-start-marker (ewoc--node-next dll node)))
384 (set-marker (ewoc--node-start-marker node) nil)
385 (setf L (ewoc--node-left node)
386 R (ewoc--node-right node)
387 ;; Link neighbors to each other.
388 (ewoc--node-right L) R
389 (ewoc--node-left R) L
390 ;; Forget neighbors.
391 (ewoc--node-left node) nil
392 (ewoc--node-right node) nil))
393 (setq node next))))
394 392
395(defun ewoc-locate (ewoc &optional pos guess) 393(defun ewoc-locate (ewoc &optional pos guess)
396 "Return the node that POS (a buffer position) is within. 394 "Return the node that POS (a buffer position) is within.
@@ -401,8 +399,7 @@ If POS points before the first element, the first node is returned.
401If POS points after the last element, the last node is returned. 399If POS points after the last element, the last node is returned.
402If the EWOC is empty, nil is returned." 400If the EWOC is empty, nil is returned."
403 (unless pos (setq pos (point))) 401 (unless pos (setq pos (point)))
404 (ewoc--set-buffer-bind-dll-let* ewoc 402 (ewoc--set-buffer-bind-dll ewoc
405 ((footer (ewoc--footer ewoc)))
406 403
407 (cond 404 (cond
408 ;; Nothing present? 405 ;; Nothing present?
@@ -435,7 +432,7 @@ If the EWOC is empty, nil is returned."
435 (setq distance d) 432 (setq distance d)
436 (setq best-guess g))) 433 (setq best-guess g)))
437 434
438 (when (ewoc--last-node ewoc) ;Check "previous". 435 (when (ewoc--last-node ewoc) ;Check "previous".
439 (let* ((g (ewoc--last-node ewoc)) 436 (let* ((g (ewoc--last-node ewoc))
440 (d (abs (- pos (ewoc--node-start-marker g))))) 437 (d (abs (- pos (ewoc--node-start-marker g)))))
441 (when (< d distance) 438 (when (< d distance)
@@ -465,10 +462,11 @@ If the EWOC is empty, nil is returned."
465(defun ewoc-invalidate (ewoc &rest nodes) 462(defun ewoc-invalidate (ewoc &rest nodes)
466 "Call EWOC's pretty-printer for each element in NODES. 463 "Call EWOC's pretty-printer for each element in NODES.
467Delete current text first, thus effecting a \"refresh\"." 464Delete current text first, thus effecting a \"refresh\"."
468 (ewoc--set-buffer-bind-dll ewoc 465 (ewoc--set-buffer-bind-dll-let* ewoc
466 ((pp (ewoc--pretty-printer ewoc)))
469 (save-excursion 467 (save-excursion
470 (dolist (node nodes) 468 (dolist (node nodes)
471 (ewoc--refresh-node (ewoc--pretty-printer ewoc) node))))) 469 (ewoc--refresh-node pp node dll)))))
472 470
473(defun ewoc-goto-prev (ewoc arg) 471(defun ewoc-goto-prev (ewoc arg)
474 "Move point to the ARGth previous element in EWOC. 472 "Move point to the ARGth previous element in EWOC.
@@ -525,7 +523,6 @@ number of elements needs to be refreshed."
525 (while (not (eq node footer)) 523 (while (not (eq node footer))
526 (set-marker (ewoc--node-start-marker node) (point)) 524 (set-marker (ewoc--node-start-marker node) (point))
527 (funcall pp (ewoc--node-data node)) 525 (funcall pp (ewoc--node-data node))
528 (insert "\n")
529 (setq node (ewoc--node-next dll node))))) 526 (setq node (ewoc--node-next dll node)))))
530 (set-marker (ewoc--node-start-marker footer) (point)))) 527 (set-marker (ewoc--node-start-marker footer) (point))))
531 528
@@ -564,19 +561,23 @@ Return nil if the buffer has been deleted."
564 561
565(defun ewoc-set-hf (ewoc header footer) 562(defun ewoc-set-hf (ewoc header footer)
566 "Set the HEADER and FOOTER of EWOC." 563 "Set the HEADER and FOOTER of EWOC."
567 (setf (ewoc--node-data (ewoc--header ewoc)) header) 564 (ewoc--set-buffer-bind-dll-let* ewoc
568 (setf (ewoc--node-data (ewoc--footer ewoc)) footer) 565 ((head (ewoc--header ewoc))
569 (save-excursion 566 (foot (ewoc--footer ewoc))
570 (ewoc--refresh-node 'insert (ewoc--header ewoc)) 567 (hf-pp (ewoc--hf-pp ewoc)))
571 (ewoc--refresh-node 'insert (ewoc--footer ewoc)))) 568 (setf (ewoc--node-data head) header
569 (ewoc--node-data foot) footer)
570 (save-excursion
571 (ewoc--refresh-node hf-pp head dll)
572 (ewoc--refresh-node hf-pp foot dll))))
572 573
573 574
574(provide 'ewoc) 575(provide 'ewoc)
575 576
576;;; Local Variables: 577;; Local Variables:
577;;; eval: (put 'ewoc--set-buffer-bind-dll 'lisp-indent-hook 1) 578;; eval: (put 'ewoc--set-buffer-bind-dll 'lisp-indent-hook 1)
578;;; eval: (put 'ewoc--set-buffer-bind-dll-let* 'lisp-indent-hook 2) 579;; eval: (put 'ewoc--set-buffer-bind-dll-let* 'lisp-indent-hook 2)
579;;; End: 580;; End:
580 581
581;;; arch-tag: d78915b9-9a07-44bf-aac6-04a1fc1bd6d4 582;; arch-tag: d78915b9-9a07-44bf-aac6-04a1fc1bd6d4
582;;; ewoc.el ends here 583;;; ewoc.el ends here
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 2d169e889cd..7a11d6318a9 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -1498,8 +1498,8 @@ shifted movement key, set `cua-highlight-region-shift-only'."
1498 1498
1499;;;###autoload (eval-after-load 'CUA-mode 1499;;;###autoload (eval-after-load 'CUA-mode
1500;;;###autoload '(error (concat "\n\n" 1500;;;###autoload '(error (concat "\n\n"
1501;;;###autoload "CUA-mode is now part of the standard GNU Emacs distribution,\n" 1501;;;###autoload "CUA-mode is now part of the standard GNU Emacs distribution, so you may\n"
1502;;;###autoload "so you may now enable and customize CUA via the Options menu.\n\n" 1502;;;###autoload "now enable CUA via the Options menu or by customizing option `cua-mode'.\n\n"
1503;;;###autoload "You have loaded an older version of CUA-mode which does\n" 1503;;;###autoload "You have loaded an older version of CUA-mode which does\n"
1504;;;###autoload "not work correctly with this version of GNU Emacs.\n\n" 1504;;;###autoload "not work correctly with this version of GNU Emacs.\n\n"
1505;;;###autoload (if user-init-file (concat 1505;;;###autoload (if user-init-file (concat
diff --git a/lisp/faces.el b/lisp/faces.el
index c4b86b5b402..828cbf860d9 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1576,7 +1576,8 @@ If there is neither a user setting nor a default for FACE, return nil."
1576 "Return a list of colors supported for a particular frame. 1576 "Return a list of colors supported for a particular frame.
1577The argument FRAME specifies which frame to try. 1577The argument FRAME specifies which frame to try.
1578The value may be different for frames on different display types. 1578The value may be different for frames on different display types.
1579If FRAME doesn't support colors, the value is nil." 1579If FRAME doesn't support colors, the value is nil.
1580If FRAME is nil, that stands for the selected frame."
1580 (if (memq (framep (or frame (selected-frame))) '(x w32 mac)) 1581 (if (memq (framep (or frame (selected-frame))) '(x w32 mac))
1581 (xw-defined-colors frame) 1582 (xw-defined-colors frame)
1582 (mapcar 'car (tty-color-alist frame)))) 1583 (mapcar 'car (tty-color-alist frame))))
diff --git a/lisp/files.el b/lisp/files.el
index 16df2661fcf..b4bc8f9ffec 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1847,13 +1847,14 @@ in that case, this function acts as if `enable-local-variables' were t."
1847 ("\\.ad[bs].dg\\'" . ada-mode) 1847 ("\\.ad[bs].dg\\'" . ada-mode)
1848 ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode) 1848 ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode)
1849 ("Imakefile\\'" . makefile-imake-mode) 1849 ("Imakefile\\'" . makefile-imake-mode)
1850 ("Makeppfile\\(?:\\.mk\\)?\\'" . makefile-makepp-mode) ; Put this before .mk
1851 ("\\.makepp\\'" . makefile-makepp-mode)
1850 ,@(if (memq system-type '(berkeley-unix next-mach darwin)) 1852 ,@(if (memq system-type '(berkeley-unix next-mach darwin))
1851 '(("\\.mk\\'" . makefile-bsdmake-mode) 1853 '(("\\.mk\\'" . makefile-bsdmake-mode)
1852 ("GNUmakefile\\'" . makefile-gmake-mode) 1854 ("GNUmakefile\\'" . makefile-gmake-mode)
1853 ("[Mm]akefile\\'" . makefile-bsdmake-mode)) 1855 ("[Mm]akefile\\'" . makefile-bsdmake-mode))
1854 '(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage 1856 '(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage
1855 ("[Mm]akefile\\'" . makefile-gmake-mode))) 1857 ("[Mm]akefile\\'" . makefile-gmake-mode)))
1856 ("Makeppfile\\'" . makefile-makepp-mode)
1857 ("\\.am\\'" . makefile-automake-mode) 1858 ("\\.am\\'" . makefile-automake-mode)
1858 ;; Less common extensions come here 1859 ;; Less common extensions come here
1859 ;; so more common ones above are found faster. 1860 ;; so more common ones above are found faster.
@@ -2689,7 +2690,10 @@ It is dangerous if either of these conditions are met:
2689 (or (numberp val) (equal val ''defun))) 2690 (or (numberp val) (equal val ''defun)))
2690 ((eq prop 'edebug-form-spec) 2691 ((eq prop 'edebug-form-spec)
2691 ;; Only allow indirect form specs. 2692 ;; Only allow indirect form specs.
2692 (edebug-basic-spec val))))) 2693 ;; During bootstrapping, edebug-basic-spec might not be
2694 ;; defined yet.
2695 (and (fboundp 'edebug-basic-spec)
2696 (edebug-basic-spec val))))))
2693 ;; Allow expressions that the user requested. 2697 ;; Allow expressions that the user requested.
2694 (member exp safe-local-eval-forms) 2698 (member exp safe-local-eval-forms)
2695 ;; Certain functions can be allowed with safe arguments 2699 ;; Certain functions can be allowed with safe arguments
@@ -2994,7 +2998,7 @@ BACKUPNAME is the backup file name, which is the old file renamed."
2994 (condition-case nil 2998 (condition-case nil
2995 (delete-file to-name) 2999 (delete-file to-name)
2996 (file-error nil)) 3000 (file-error nil))
2997 (copy-file from-name to-name t t 'excl) 3001 (copy-file from-name to-name nil t)
2998 nil) 3002 nil)
2999 (file-already-exists t)) 3003 (file-already-exists t))
3000 ;; The file was somehow created by someone else between 3004 ;; The file was somehow created by someone else between
@@ -3062,6 +3066,7 @@ except that a leading `.', if any, doesn't count."
3062(defun file-name-extension (filename &optional period) 3066(defun file-name-extension (filename &optional period)
3063 "Return FILENAME's final \"extension\". 3067 "Return FILENAME's final \"extension\".
3064The extension, in a file name, is the part that follows the last `.', 3068The extension, in a file name, is the part that follows the last `.',
3069excluding version numbers and backup suffixes,
3065except that a leading `.', if any, doesn't count. 3070except that a leading `.', if any, doesn't count.
3066Return nil for extensionless file names such as `foo'. 3071Return nil for extensionless file names such as `foo'.
3067Return the empty string for file names such as `foo.'. 3072Return the empty string for file names such as `foo.'.
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 7f0f248c7cf..71aa3654da6 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,96 @@
12006-06-06 Katsumi Yamaoka <yamaoka@jpl.org>
2
3 * mm-util.el (mm-mime-mule-charset-alist): Use unicode-precedence-list
4 to fill the utf-8 entry.
5
62006-06-05 Dan Christensen <jdc@uwo.ca>
7
8 * gnus-sum.el (gnus-summary-read-group-1): When summary is unthreaded,
9 respect display group parameter and gnus-summary-expunge-below.
10 (gnus-articles-to-read): Remove unused reference to display group
11 parameter.
12 [ Merge 2004-07-06 change from the trunk. ]
13
142006-05-29 Reiner Steib <Reiner.Steib@gmx.de>
15
16 * gnus-ml.el (gnus-mailing-list-subscribe)
17 (gnus-mailing-list-unsubscribe, gnus-mailing-list-owner)
18 (gnus-mailing-list-message): Fix doc strings.
19
202006-05-29 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
21
22 * gnus-ml.el (gnus-mailing-list-message): Use gnus-url-mailto instead
23 of doing it manually.
24
252006-05-29 Kevin Greiner <kevin.greiner@compsol.cc>
26
27 * gnus-agent.el (gnus-agent-possibly-synchronize-flags): A server
28 must be explicitly online rather than "not explicitly offline" for
29 its flags to be synchronized.
30 (gnus-agent-read-local): All symbols allocated in my-obarray
31 (gnus-agent-set-local): Skip invalid entries (min and/or max is nil).
32 (gnus-agent-regenerate-group): Check numeric names to see if they are
33 messages or groups.
34
352006-05-29 Katsumi Yamaoka <yamaoka@jpl.org>
36
37 * gnus-art.el (gnus-save-all-headers): Mention it might be overridden.
38 (gnus-saved-headers): Ditto.
39 (gnus-default-article-saver): Doc fix; add
40 gnus-summary-write-body-to-file; mention functions may have properties.
41 (gnus-article-save-coding-system): New variable.
42 (gnus-article-save): Override gnus-save-all-headers and
43 gnus-saved-headers by :headers property which saver function may have.
44 (gnus-read-save-file-name): Add optional `dir-var' argument which
45 specifies directory in which files are saved; work even if optional
46 `variable' argument is not specified.
47 (gnus-summary-save-in-file): Add properties :decode and :headers.
48 (gnus-summary-write-to-file): Add properties :decode, :function, and
49 :headers; read file name.
50 (gnus-summary-save-body-in-file): Add :decode property; add optional
51 `overwrite' argument.
52 (gnus-summary-write-body-to-file): New function; add properties
53 :decode and :function.
54 (gnus-output-to-file): Add coding cookie and encode text according
55 to gnus-article-save-coding-system; don't use mm-append-to-file.
56
57 * gnus-sum.el (gnus-newsgroup-last-directory): New variable.
58 (gnus-summary-local-variables): Add it.
59 (gnus-summary-save-map): Add gnus-summary-write-article-body-file.
60 (gnus-summary-save-article): Require gnus-art; save decoded articles
61 if function that gnus-default-article-saver specifies has `:decode'
62 property; bind gnus-prompt-before-saving to t when saving many
63 articles in a file; move point to article which will be saved.
64 (gnus-summary-write-article-body-file): New function.
65
662006-05-26 Reiner Steib <Reiner.Steib@gmx.de>
67
68 * uudecode.el (uudecode-decode-region-external): Fix previous commit.
69
702006-05-26 Katsumi Yamaoka <yamaoka@jpl.org>
71
72 * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Don't edit
73 after-load-alist.
74
752006-05-22 Reiner Steib <Reiner.Steib@gmx.de>
76
77 * uudecode.el (uudecode-decode-region-external): nil isn't a valid
78 coding system in XEmacs, use binary.
79
80 * mail-source.el (mail-sources): Fix custom type.
81
82 * imap.el (Commentary): Fix typo.
83
842006-05-18 Reiner Steib <Reiner.Steib@gmx.de>
85
86 * gnus-sum.el (gnus-summary-save-article-mail): Clarify doc string.
87 (gnus-summary-expire-articles-now): Shorten prompt.
88
89 * gmm-utils.el (wid-edit): Require.
90 (defun-gmm): Renamed from `gmm-defun-compat'.
91 (gmm-image-search-load-path): Use it.
92 (gmm-image-load-path-for-library): Use it. Sync with `mh-compat.el'.
93
12006-05-04 Stefan Monnier <monnier@iro.umontreal.ca> 942006-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
2 95
3 * mm-decode.el (mm-dissect-buffer): Remove spurious double assignment. 96 * mm-decode.el (mm-dissect-buffer): Remove spurious double assignment.
@@ -2865,7 +2958,7 @@
2865 article buffer with a draft file. This is a temporary measure 2958 article buffer with a draft file. This is a temporary measure
2866 against the 2004-08-22 change to gnus-article-edit-mode. 2959 against the 2004-08-22 change to gnus-article-edit-mode.
2867 2960
28682004-11-02 From Ilya N. Golubev <gin@mo.msk.ru>. 29612004-11-02 Ilya N. Golubev <gin@mo.msk.ru>.
2869 2962
2870 * mm-util.el (mm-mime-mule-charset-alist): Add the windows-1251 2963 * mm-util.el (mm-mime-mule-charset-alist): Add the windows-1251
2871 entry. 2964 entry.
@@ -3725,7 +3818,7 @@
3725 * flow-fill.el (fill-flowed-display-column) 3818 * flow-fill.el (fill-flowed-display-column)
3726 (fill-flowed-encode-column): Ditto. 3819 (fill-flowed-encode-column): Ditto.
3727 3820
37282004-09-06 Stefan <monnier@iro.umontreal.ca> 38212004-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
3729 3822
3730 * message.el (message-tokenize-header, message-send-mail-with-qmail): 3823 * message.el (message-tokenize-header, message-send-mail-with-qmail):
3731 Use point-min rather than 1. 3824 Use point-min rather than 1.
@@ -4112,6 +4205,7 @@ See ChangeLog.2 for earlier changes.
4112 4205
4113;; Local Variables: 4206;; Local Variables:
4114;; coding: iso-2022-7bit 4207;; coding: iso-2022-7bit
4208;; fill-column: 79
4115;; End: 4209;; End:
4116 4210
4117;;; arch-tag: 3f33a3e7-090d-492b-bedd-02a1417d32b4 4211;;; arch-tag: 3f33a3e7-090d-492b-bedd-02a1417d32b4
diff --git a/lisp/gnus/ChangeLog.1 b/lisp/gnus/ChangeLog.1
index bb4da4dbcad..f917d0cbf73 100644
--- a/lisp/gnus/ChangeLog.1
+++ b/lisp/gnus/ChangeLog.1
@@ -2437,7 +2437,7 @@
2437 * gnus-topic.el (gnus-topic-rename): Check whether the new name 2437 * gnus-topic.el (gnus-topic-rename): Check whether the new name
2438 exists. 2438 exists.
2439 2439
24401998-02-10 dave edmondson <dme@sco.com> 24401998-02-10 David Edmondson <dme@sco.com>
2441 2441
2442 * message.el (message-font-lock-keywords): Allow : as a citation 2442 * message.el (message-font-lock-keywords): Allow : as a citation
2443 ending. 2443 ending.
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el
index 4db811053ec..f314d0e81d7 100644
--- a/lisp/gnus/gmm-utils.el
+++ b/lisp/gnus/gmm-utils.el
@@ -30,7 +30,7 @@
30 30
31;;; Code: 31;;; Code:
32 32
33;; (require 'wid-edit) 33(require 'wid-edit)
34 34
35(defgroup gmm nil 35(defgroup gmm nil
36 "Utility functions for Gnus, Message and MML" 36 "Utility functions for Gnus, Message and MML"
@@ -279,11 +279,7 @@ DEFAULT-MAP specifies the default key map for ICON-LIST."
279 icon-list)) 279 icon-list))
280 tool-bar-map)) 280 tool-bar-map))
281 281
282;; WARNING: The following is subject to change. Don't rely on it yet. 282(defmacro defun-gmm (name function arg-list &rest body)
283
284;; From MH-E without modifications:
285
286(defmacro gmm-defun-compat (name function arg-list &rest body)
287 "Create function NAME. 283 "Create function NAME.
288If FUNCTION exists, then NAME becomes an alias for FUNCTION. 284If FUNCTION exists, then NAME becomes an alias for FUNCTION.
289Otherwise, create function NAME with ARG-LIST and BODY." 285Otherwise, create function NAME with ARG-LIST and BODY."
@@ -292,21 +288,19 @@ Otherwise, create function NAME with ARG-LIST and BODY."
292 `(defalias ',name ',function) 288 `(defalias ',name ',function)
293 `(defun ,name ,arg-list ,@body)))) 289 `(defun ,name ,arg-list ,@body))))
294 290
295(gmm-defun-compat gmm-image-search-load-path 291(defun-gmm gmm-image-search-load-path
296 image-search-load-path (file &optional path) 292 image-search-load-path (file &optional path)
297 "Emacs 21 and XEmacs don't have `image-search-load-path'. 293 "Emacs 21 and XEmacs don't have `image-search-load-path'.
298This function returns nil on those systems." 294This function returns nil on those systems."
299 nil) 295 nil)
300 296
301;; From MH-E with modifications: 297;; Cf. `mh-image-load-path-for-library' in `mh-compat.el'.
302
303;; Don't use `gmm-defun-compat' until API changes in
304;; `image-load-path-for-library' in Emacs CVS are completed.
305 298
306(defun gmm-image-load-path-for-library (library image &optional path no-error) 299(defun-gmm gmm-image-load-path-for-library
307 "Return a suitable search path for images relative to LIBRARY. 300 image-load-path-for-library (library image &optional path no-error)
301 "Return a suitable search path for images used by LIBRARY.
308 302
309First it searches for IMAGE in `image-load-path' (excluding 303It searches for IMAGE in `image-load-path' (excluding
310\"`data-directory'/images\") and `load-path', followed by a path 304\"`data-directory'/images\") and `load-path', followed by a path
311suitable for LIBRARY, which includes \"../../etc/images\" and 305suitable for LIBRARY, which includes \"../../etc/images\" and
312\"../etc/images\" relative to the library file itself, and then 306\"../etc/images\" relative to the library file itself, and then
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 123ad340ae1..f4e9f2e3dc9 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -825,7 +825,7 @@ be a select method."
825 (save-excursion 825 (save-excursion
826 (dolist (gnus-command-method (gnus-agent-covered-methods)) 826 (dolist (gnus-command-method (gnus-agent-covered-methods))
827 (when (and (file-exists-p (gnus-agent-lib-file "flags")) 827 (when (and (file-exists-p (gnus-agent-lib-file "flags"))
828 (not (eq (gnus-server-status gnus-command-method) 'offline))) 828 (eq (gnus-server-status gnus-command-method) 'ok))
829 (gnus-agent-possibly-synchronize-flags-server gnus-command-method))))) 829 (gnus-agent-possibly-synchronize-flags-server gnus-command-method)))))
830 830
831(defun gnus-agent-synchronize-flags-server (method) 831(defun gnus-agent-synchronize-flags-server (method)
@@ -2133,7 +2133,8 @@ modified) original contents, they are first saved to their own file."
2133 (let (group 2133 (let (group
2134 min 2134 min
2135 max 2135 max
2136 (cur (current-buffer))) 2136 (cur (current-buffer))
2137 (obarray my-obarray))
2137 (setq group (read cur) 2138 (setq group (read cur)
2138 min (read cur) 2139 min (read cur)
2139 max (read cur)) 2140 max (read cur))
@@ -2214,7 +2215,9 @@ modified) original contents, they are first saved to their own file."
2214 2215
2215 (if (cond ((and minmax 2216 (if (cond ((and minmax
2216 (or (not (eq min (car minmax))) 2217 (or (not (eq min (car minmax)))
2217 (not (eq max (cdr minmax))))) 2218 (not (eq max (cdr minmax))))
2219 min
2220 max)
2218 (setcar minmax min) 2221 (setcar minmax min)
2219 (setcdr minmax max) 2222 (setcdr minmax max)
2220 t) 2223 t)
@@ -3743,8 +3746,10 @@ If REREAD is not nil, downloaded articles are marked as unread."
3743 (dir (file-name-directory file)) 3746 (dir (file-name-directory file))
3744 point 3747 point
3745 (downloaded (if (file-exists-p dir) 3748 (downloaded (if (file-exists-p dir)
3746 (sort (mapcar (lambda (name) (string-to-number name)) 3749 (sort (delq nil (mapcar (lambda (name)
3747 (directory-files dir nil "^[0-9]+$" t)) 3750 (and (not (file-directory-p (nnheader-concat dir name)))
3751 (string-to-number name)))
3752 (directory-files dir nil "^[0-9]+$" t)))
3748 '>) 3753 '>)
3749 (progn (gnus-make-directory dir) nil))) 3754 (progn (gnus-make-directory dir) nil)))
3750 dl nov-arts 3755 dl nov-arts
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 208103f805d..4722e98ef19 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -492,7 +492,10 @@ be fed to `format-time-string'."
492 :group 'gnus-article-washing) 492 :group 'gnus-article-washing)
493 493
494(defcustom gnus-save-all-headers t 494(defcustom gnus-save-all-headers t
495 "*If non-nil, don't remove any headers before saving." 495 "*If non-nil, don't remove any headers before saving.
496This will be overridden by the `:headers' property that the symbol of
497the saver function, which is specified by `gnus-default-article-saver',
498might have."
496 :group 'gnus-article-saving 499 :group 'gnus-article-saving
497 :type 'boolean) 500 :type 'boolean)
498 501
@@ -513,14 +516,17 @@ each invocation of the saving commands."
513 "Headers to keep if `gnus-save-all-headers' is nil. 516 "Headers to keep if `gnus-save-all-headers' is nil.
514If `gnus-save-all-headers' is non-nil, this variable will be ignored. 517If `gnus-save-all-headers' is non-nil, this variable will be ignored.
515If that variable is nil, however, all headers that match this regexp 518If that variable is nil, however, all headers that match this regexp
516will be kept while the rest will be deleted before saving." 519will be kept while the rest will be deleted before saving. This and
520`gnus-save-all-headers' will be overridden by the `:headers' property
521that the symbol of the saver function, which is specified by
522`gnus-default-article-saver', might have."
517 :group 'gnus-article-saving 523 :group 'gnus-article-saving
518 :type 'regexp) 524 :type 'regexp)
519 525
520(defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail 526(defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
521 "A function to save articles in your favourite format. 527 "A function to save articles in your favourite format.
522The function must be interactively callable (in other words, it must 528The function will be called by way of the `gnus-summary-save-article'
523be an Emacs command). 529command, and friends such as `gnus-summary-save-article-rmail'.
524 530
525Gnus provides the following functions: 531Gnus provides the following functions:
526 532
@@ -530,7 +536,28 @@ Gnus provides the following functions:
530* gnus-summary-save-in-file (article format) 536* gnus-summary-save-in-file (article format)
531* gnus-summary-save-body-in-file (article body) 537* gnus-summary-save-body-in-file (article body)
532* gnus-summary-save-in-vm (use VM's folder format) 538* gnus-summary-save-in-vm (use VM's folder format)
533* gnus-summary-write-to-file (article format -- overwrite)." 539* gnus-summary-write-to-file (article format -- overwrite)
540* gnus-summary-write-body-to-file (article body -- overwrite)
541
542The symbol of each function may have the following properties:
543
544* :decode
545The value non-nil means save decoded articles. This is meaningful
546only with `gnus-summary-save-in-file', `gnus-summary-save-body-in-file',
547`gnus-summary-write-to-file', and `gnus-summary-write-body-to-file'.
548
549* :function
550The value specifies an alternative function which appends, not
551overwrites, articles to a file. This implies that when saving many
552articles at a time, `gnus-prompt-before-saving' is bound to t and all
553articles are saved in a single file. This is meaningful only with
554`gnus-summary-write-to-file' and `gnus-summary-write-body-to-file'.
555
556* :headers
557The value specifies the symbol of a variable of which the value
558specifies headers to be saved. If it is omitted,
559`gnus-save-all-headers' and `gnus-saved-headers' control what
560headers should be saved."
534 :group 'gnus-article-saving 561 :group 'gnus-article-saving
535 :type '(radio (function-item gnus-summary-save-in-rmail) 562 :type '(radio (function-item gnus-summary-save-in-rmail)
536 (function-item gnus-summary-save-in-mail) 563 (function-item gnus-summary-save-in-mail)
@@ -539,8 +566,49 @@ Gnus provides the following functions:
539 (function-item gnus-summary-save-body-in-file) 566 (function-item gnus-summary-save-body-in-file)
540 (function-item gnus-summary-save-in-vm) 567 (function-item gnus-summary-save-in-vm)
541 (function-item gnus-summary-write-to-file) 568 (function-item gnus-summary-write-to-file)
569 (function-item gnus-summary-write-body-to-file)
542 (function))) 570 (function)))
543 571
572(defcustom gnus-article-save-coding-system
573 (or (and (mm-coding-system-p 'utf-8) 'utf-8)
574 (and (mm-coding-system-p 'iso-2022-7bit) 'iso-2022-7bit)
575 (and (mm-coding-system-p 'emacs-mule) 'emacs-mule)
576 (and (mm-coding-system-p 'escape-quoted) 'escape-quoted))
577 "Coding system used to save decoded articles to a file.
578
579The recommended coding systems are `utf-8', `iso-2022-7bit' and so on,
580which can safely encode any characters in text. This is used by the
581commands including:
582
583* gnus-summary-save-article-file
584* gnus-summary-save-article-body-file
585* gnus-summary-write-article-file
586* gnus-summary-write-article-body-file
587
588and the functions to which you may set `gnus-default-article-saver':
589
590* gnus-summary-save-in-file
591* gnus-summary-save-body-in-file
592* gnus-summary-write-to-file
593* gnus-summary-write-body-to-file
594
595Those commands and functions save just text displayed in the article
596buffer to a file if the value of this variable is non-nil. Note that
597buttonized MIME parts will be lost in a saved file in that case.
598Otherwise, raw articles will be saved."
599 :group 'gnus-article-saving
600 :type `(choice
601 :format "%{%t%}:\n %[Value Menu%] %v"
602 (const :tag "Save raw articles" nil)
603 ,@(delq nil
604 (mapcar
605 (lambda (arg) (if (mm-coding-system-p (nth 3 arg)) arg))
606 '((const :tag "UTF-8" utf-8)
607 (const :tag "iso-2022-7bit" iso-2022-7bit)
608 (const :tag "Emacs internal" emacs-mule)
609 (const :tag "escape-quoted" escape-quoted))))
610 (symbol :tag "Coding system")))
611
544(defcustom gnus-rmail-save-name 'gnus-plain-save-name 612(defcustom gnus-rmail-save-name 'gnus-plain-save-name
545 "A function generating a file name to save articles in Rmail format. 613 "A function generating a file name to save articles in Rmail format.
546The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE." 614The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
@@ -3249,10 +3317,13 @@ This format is defined by the `gnus-article-time-format' variable."
3249 3317
3250(defun gnus-article-save (save-buffer file &optional num) 3318(defun gnus-article-save (save-buffer file &optional num)
3251 "Save the currently selected article." 3319 "Save the currently selected article."
3252 (unless gnus-save-all-headers 3320 (when (or (get gnus-default-article-saver :headers)
3253 ;; Remove headers according to `gnus-saved-headers'. 3321 (not gnus-save-all-headers))
3322 ;; Remove headers according to `gnus-saved-headers' or the value
3323 ;; of the `:headers' property that the saver function might have.
3254 (let ((gnus-visible-headers 3324 (let ((gnus-visible-headers
3255 (or gnus-saved-headers gnus-visible-headers)) 3325 (or (symbol-value (get gnus-default-article-saver :headers))
3326 gnus-saved-headers gnus-visible-headers))
3256 (gnus-article-buffer save-buffer)) 3327 (gnus-article-buffer save-buffer))
3257 (save-excursion 3328 (save-excursion
3258 (set-buffer save-buffer) 3329 (set-buffer save-buffer)
@@ -3277,7 +3348,8 @@ This format is defined by the `gnus-article-time-format' variable."
3277 (funcall gnus-default-article-saver filename))))) 3348 (funcall gnus-default-article-saver filename)))))
3278 3349
3279(defun gnus-read-save-file-name (prompt &optional filename 3350(defun gnus-read-save-file-name (prompt &optional filename
3280 function group headers variable) 3351 function group headers variable
3352 dir-var)
3281 (let ((default-name 3353 (let ((default-name
3282 (funcall function group headers (symbol-value variable))) 3354 (funcall function group headers (symbol-value variable)))
3283 result) 3355 result)
@@ -3290,6 +3362,10 @@ This format is defined by the `gnus-article-time-format' variable."
3290 default-name) 3362 default-name)
3291 (filename filename) 3363 (filename filename)
3292 (t 3364 (t
3365 (when (symbol-value dir-var)
3366 (setq default-name (expand-file-name
3367 (file-name-nondirectory default-name)
3368 (symbol-value dir-var))))
3293 (let* ((split-name (gnus-get-split-value gnus-split-methods)) 3369 (let* ((split-name (gnus-get-split-value gnus-split-methods))
3294 (prompt 3370 (prompt
3295 (format prompt 3371 (format prompt
@@ -3354,7 +3430,11 @@ This format is defined by the `gnus-article-time-format' variable."
3354 ;; Possibly translate some characters. 3430 ;; Possibly translate some characters.
3355 (nnheader-translate-file-chars file)))))) 3431 (nnheader-translate-file-chars file))))))
3356 (gnus-make-directory (file-name-directory result)) 3432 (gnus-make-directory (file-name-directory result))
3357 (set variable result))) 3433 (when variable
3434 (set variable result))
3435 (when dir-var
3436 (set dir-var (file-name-directory result)))
3437 result))
3358 3438
3359(defun gnus-article-archive-name (group) 3439(defun gnus-article-archive-name (group)
3360 "Return the first instance of an \"Archive-name\" in the current buffer." 3440 "Return the first instance of an \"Archive-name\" in the current buffer."
@@ -3402,6 +3482,8 @@ Directory to save to is default to `gnus-article-save-directory'."
3402 (gnus-output-to-mail filename))))) 3482 (gnus-output-to-mail filename)))))
3403 filename) 3483 filename)
3404 3484
3485(put 'gnus-summary-save-in-file :decode t)
3486(put 'gnus-summary-save-in-file :headers 'gnus-saved-headers)
3405(defun gnus-summary-save-in-file (&optional filename overwrite) 3487(defun gnus-summary-save-in-file (&optional filename overwrite)
3406 "Append this article to file. 3488 "Append this article to file.
3407Optional argument FILENAME specifies file name. 3489Optional argument FILENAME specifies file name.
@@ -3420,13 +3502,21 @@ Directory to save to is default to `gnus-article-save-directory'."
3420 (gnus-output-to-file filename)))) 3502 (gnus-output-to-file filename))))
3421 filename) 3503 filename)
3422 3504
3505(put 'gnus-summary-write-to-file :decode t)
3506(put 'gnus-summary-write-to-file :function 'gnus-summary-save-in-file)
3507(put 'gnus-summary-write-to-file :headers 'gnus-saved-headers)
3423(defun gnus-summary-write-to-file (&optional filename) 3508(defun gnus-summary-write-to-file (&optional filename)
3424 "Write this article to a file, overwriting it if the file exists. 3509 "Write this article to a file, overwriting it if the file exists.
3425Optional argument FILENAME specifies file name. 3510Optional argument FILENAME specifies file name.
3426The directory to save in defaults to `gnus-article-save-directory'." 3511The directory to save in defaults to `gnus-article-save-directory'."
3427 (gnus-summary-save-in-file nil t)) 3512 (setq filename (gnus-read-save-file-name
3513 "Save %s in file" filename
3514 gnus-file-save-name gnus-newsgroup-name
3515 gnus-current-headers nil 'gnus-newsgroup-last-directory))
3516 (gnus-summary-save-in-file filename t))
3428 3517
3429(defun gnus-summary-save-body-in-file (&optional filename) 3518(put 'gnus-summary-save-body-in-file :decode t)
3519(defun gnus-summary-save-body-in-file (&optional filename overwrite)
3430 "Append this article body to a file. 3520 "Append this article body to a file.
3431Optional argument FILENAME specifies file name. 3521Optional argument FILENAME specifies file name.
3432The directory to save in defaults to `gnus-article-save-directory'." 3522The directory to save in defaults to `gnus-article-save-directory'."
@@ -3440,9 +3530,25 @@ The directory to save in defaults to `gnus-article-save-directory'."
3440 (widen) 3530 (widen)
3441 (when (article-goto-body) 3531 (when (article-goto-body)
3442 (narrow-to-region (point) (point-max))) 3532 (narrow-to-region (point) (point-max)))
3533 (when (and overwrite
3534 (file-exists-p filename))
3535 (delete-file filename))
3443 (gnus-output-to-file filename)))) 3536 (gnus-output-to-file filename))))
3444 filename) 3537 filename)
3445 3538
3539(put 'gnus-summary-write-body-to-file :decode t)
3540(put 'gnus-summary-write-body-to-file
3541 :function 'gnus-summary-save-body-in-file)
3542(defun gnus-summary-write-body-to-file (&optional filename)
3543 "Write this article body to a file, overwriting it if the file exists.
3544Optional argument FILENAME specifies file name.
3545The directory to save in defaults to `gnus-article-save-directory'."
3546 (setq filename (gnus-read-save-file-name
3547 "Save %s body in file" filename
3548 gnus-file-save-name gnus-newsgroup-name
3549 gnus-current-headers nil 'gnus-newsgroup-last-directory))
3550 (gnus-summary-save-body-in-file filename t))
3551
3446(defun gnus-summary-save-in-pipe (&optional command) 3552(defun gnus-summary-save-in-pipe (&optional command)
3447 "Pipe this article to subprocess." 3553 "Pipe this article to subprocess."
3448 (setq command 3554 (setq command
@@ -5182,17 +5288,55 @@ Provided for backwards compatibility."
5182;;; Article savers. 5288;;; Article savers.
5183 5289
5184(defun gnus-output-to-file (file-name) 5290(defun gnus-output-to-file (file-name)
5185 "Append the current article to a file named FILE-NAME." 5291 "Append the current article to a file named FILE-NAME.
5186 (let ((artbuf (current-buffer))) 5292If `gnus-article-save-coding-system' is non-nil, it is used to encode
5293text and used as the value of the coding cookie which is added to the
5294top of a file. Otherwise, this function saves a raw article without
5295the coding cookie."
5296 (let* ((artbuf (current-buffer))
5297 (file-name-coding-system nnmail-pathname-coding-system)
5298 (coding gnus-article-save-coding-system)
5299 (coding-system-for-read (if coding
5300 nil ;; Rely on the coding cookie.
5301 mm-text-coding-system))
5302 (coding-system-for-write (or coding
5303 mm-text-coding-system-for-write
5304 mm-text-coding-system))
5305 (exists (file-exists-p file-name)))
5187 (with-temp-buffer 5306 (with-temp-buffer
5307 (when exists
5308 (insert-file-contents file-name)
5309 (goto-char (point-min))
5310 ;; Remove the existing coding cookie.
5311 (when (looking-at "X-Gnus-Coding-System: .+\n\n")
5312 (delete-region (match-beginning 0) (match-end 0))))
5313 (goto-char (point-max))
5188 (insert-buffer-substring artbuf) 5314 (insert-buffer-substring artbuf)
5189 ;; Append newline at end of the buffer as separator, and then 5315 ;; Append newline at end of the buffer as separator, and then
5190 ;; save it to file. 5316 ;; save it to file.
5191 (goto-char (point-max)) 5317 (goto-char (point-max))
5192 (insert "\n") 5318 (insert "\n")
5193 (let ((file-name-coding-system nnmail-pathname-coding-system)) 5319 (when coding
5194 (mm-append-to-file (point-min) (point-max) file-name)) 5320 ;; If the coding system is not suitable to encode the text,
5195 t))) 5321 ;; ask a user for a proper one.
5322 (when (fboundp 'select-safe-coding-system)
5323 (setq coding (coding-system-base
5324 (save-window-excursion
5325 (select-safe-coding-system (point-min) (point-max)
5326 coding))))
5327 (setq coding-system-for-write
5328 (or (cdr (assq coding '((mule-utf-8 . utf-8))))
5329 coding)))
5330 (goto-char (point-min))
5331 ;; Add the coding cookie.
5332 (insert (format "X-Gnus-Coding-System: -*- coding: %s; -*-\n\n"
5333 coding-system-for-write)))
5334 (if exists
5335 (progn
5336 (write-region (point-min) (point-max) file-name nil 'no-message)
5337 (message "Appended to %s" file-name))
5338 (write-region (point-min) (point-max) file-name))))
5339 t)
5196 5340
5197(defun gnus-narrow-to-page (&optional arg) 5341(defun gnus-narrow-to-page (&optional arg)
5198 "Narrow the article buffer to a page. 5342 "Narrow the article buffer to a page.
diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el
index cde039d03c0..8d475f968d7 100644
--- a/lisp/gnus/gnus-ml.el
+++ b/lisp/gnus/gnus-ml.el
@@ -4,7 +4,7 @@
4;; 2005, 2006 Free Software Foundation, Inc. 4;; 2005, 2006 Free Software Foundation, Inc.
5 5
6;; Author: Julien Gilles <jgilles@free.fr> 6;; Author: Julien Gilles <jgilles@free.fr>
7;; Keywords: news 7;; Keywords: news, mail
8 8
9;; This file is part of GNU Emacs. 9;; This file is part of GNU Emacs.
10 10
@@ -51,8 +51,7 @@
51 "\C-c\C-nu" gnus-mailing-list-unsubscribe 51 "\C-c\C-nu" gnus-mailing-list-unsubscribe
52 "\C-c\C-np" gnus-mailing-list-post 52 "\C-c\C-np" gnus-mailing-list-post
53 "\C-c\C-no" gnus-mailing-list-owner 53 "\C-c\C-no" gnus-mailing-list-owner
54 "\C-c\C-na" gnus-mailing-list-archive 54 "\C-c\C-na" gnus-mailing-list-archive))
55 ))
56 55
57(defun gnus-mailing-list-make-menu-bar () 56(defun gnus-mailing-list-make-menu-bar ()
58 (unless (boundp 'gnus-mailing-list-menu) 57 (unless (boundp 'gnus-mailing-list-menu)
@@ -103,7 +102,8 @@ If FORCE is non-nil, replace the old ones."
103 ;; Set up the menu. 102 ;; Set up the menu.
104 (when (gnus-visual-p 'mailing-list-menu 'menu) 103 (when (gnus-visual-p 'mailing-list-menu 'menu)
105 (gnus-mailing-list-make-menu-bar)) 104 (gnus-mailing-list-make-menu-bar))
106 (gnus-add-minor-mode 'gnus-mailing-list-mode " Mailing-List" gnus-mailing-list-mode-map) 105 (gnus-add-minor-mode 'gnus-mailing-list-mode " Mailing-List"
106 gnus-mailing-list-mode-map)
107 (gnus-run-hooks 'gnus-mailing-list-mode-hook)))) 107 (gnus-run-hooks 'gnus-mailing-list-mode-hook))))
108 108
109;;; Commands 109;;; Commands
@@ -118,7 +118,7 @@ If FORCE is non-nil, replace the old ones."
118 (t (gnus-message 1 "no list-help in this group"))))) 118 (t (gnus-message 1 "no list-help in this group")))))
119 119
120(defun gnus-mailing-list-subscribe () 120(defun gnus-mailing-list-subscribe ()
121 "Subscribe" 121 "Subscribe to mailing list."
122 (interactive) 122 (interactive)
123 (let ((list-subscribe 123 (let ((list-subscribe
124 (with-current-buffer gnus-original-article-buffer 124 (with-current-buffer gnus-original-article-buffer
@@ -127,7 +127,7 @@ If FORCE is non-nil, replace the old ones."
127 (t (gnus-message 1 "no list-subscribe in this group"))))) 127 (t (gnus-message 1 "no list-subscribe in this group")))))
128 128
129(defun gnus-mailing-list-unsubscribe () 129(defun gnus-mailing-list-unsubscribe ()
130 "Unsubscribe" 130 "Unsubscribe from mailing list."
131 (interactive) 131 (interactive)
132 (let ((list-unsubscribe 132 (let ((list-unsubscribe
133 (with-current-buffer gnus-original-article-buffer 133 (with-current-buffer gnus-original-article-buffer
@@ -145,7 +145,7 @@ If FORCE is non-nil, replace the old ones."
145 (t (gnus-message 1 "no list-post in this group"))))) 145 (t (gnus-message 1 "no list-post in this group")))))
146 146
147(defun gnus-mailing-list-owner () 147(defun gnus-mailing-list-owner ()
148 "Mail to the owner" 148 "Mail to the mailing list owner."
149 (interactive) 149 (interactive)
150 (let ((list-owner 150 (let ((list-owner
151 (with-current-buffer gnus-original-article-buffer 151 (with-current-buffer gnus-original-article-buffer
@@ -154,7 +154,7 @@ If FORCE is non-nil, replace the old ones."
154 (t (gnus-message 1 "no list-owner in this group"))))) 154 (t (gnus-message 1 "no list-owner in this group")))))
155 155
156(defun gnus-mailing-list-archive () 156(defun gnus-mailing-list-archive ()
157 "Browse archive" 157 "Browse archive."
158 (interactive) 158 (interactive)
159 (require 'browse-url) 159 (require 'browse-url)
160 (let ((list-archive 160 (let ((list-archive
@@ -169,33 +169,14 @@ If FORCE is non-nil, replace the old ones."
169;;; Utility functions 169;;; Utility functions
170 170
171(defun gnus-mailing-list-message (address) 171(defun gnus-mailing-list-message (address)
172 "" 172 "Send message to ADDRESS.
173 (let ((mailto "") 173ADDRESS is specified by a \"mailto:\" URL."
174 (to ()) 174 (cond
175 (subject "None") 175 ((string-match "<\\(mailto:[^>]*\\)>" address)
176 (body "") 176 (require 'gnus-art)
177 ) 177 (gnus-url-mailto (match-string 1 address)))
178 (cond 178 ;; other case <http://...> to be done.
179 ((string-match "<mailto:\\([^>]*\\)>" address) 179 (t nil)))
180 (let ((args (match-string 1 address)))
181 (cond ; with param
182 ((string-match "\\(.*\\)\\?\\(.*\\)" args)
183 (setq mailto (match-string 1 args))
184 (let ((param (match-string 2 args)))
185 (if (string-match "subject=\\([^&]*\\)" param)
186 (setq subject (match-string 1 param)))
187 (if (string-match "body=\\([^&]*\\)" param)
188 (setq body (match-string 1 param)))
189 (if (string-match "to=\\([^&]*\\)" param)
190 (push (match-string 1 param) to))
191 ))
192 (t (setq mailto args))))) ; without param
193
194 ; other case <http://... to be done.
195 (t nil))
196 (gnus-setup-message 'message (message-mail mailto subject))
197 (insert body)
198 ))
199 180
200(provide 'gnus-ml) 181(provide 'gnus-ml)
201 182
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index daecb1701cd..66ab41950d1 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -1249,6 +1249,7 @@ the type of the variable (string, integer, character, etc).")
1249(defvar gnus-newsgroup-last-mail nil) 1249(defvar gnus-newsgroup-last-mail nil)
1250(defvar gnus-newsgroup-last-folder nil) 1250(defvar gnus-newsgroup-last-folder nil)
1251(defvar gnus-newsgroup-last-file nil) 1251(defvar gnus-newsgroup-last-file nil)
1252(defvar gnus-newsgroup-last-directory nil)
1252(defvar gnus-newsgroup-auto-expire nil) 1253(defvar gnus-newsgroup-auto-expire nil)
1253(defvar gnus-newsgroup-active nil) 1254(defvar gnus-newsgroup-active nil)
1254 1255
@@ -1364,6 +1365,7 @@ This list will always be a subset of gnus-newsgroup-undownloaded.")
1364 gnus-newsgroup-begin gnus-newsgroup-end 1365 gnus-newsgroup-begin gnus-newsgroup-end
1365 gnus-newsgroup-last-rmail gnus-newsgroup-last-mail 1366 gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
1366 gnus-newsgroup-last-folder gnus-newsgroup-last-file 1367 gnus-newsgroup-last-folder gnus-newsgroup-last-file
1368 gnus-newsgroup-last-directory
1367 gnus-newsgroup-auto-expire gnus-newsgroup-unreads 1369 gnus-newsgroup-auto-expire gnus-newsgroup-unreads
1368 gnus-newsgroup-unselected gnus-newsgroup-marked 1370 gnus-newsgroup-unselected gnus-newsgroup-marked
1369 gnus-newsgroup-spam-marked 1371 gnus-newsgroup-spam-marked
@@ -1991,6 +1993,7 @@ increase the score of each group you read."
1991 "r" gnus-summary-save-article-rmail 1993 "r" gnus-summary-save-article-rmail
1992 "f" gnus-summary-save-article-file 1994 "f" gnus-summary-save-article-file
1993 "b" gnus-summary-save-article-body-file 1995 "b" gnus-summary-save-article-body-file
1996 "B" gnus-summary-write-article-body-file
1994 "h" gnus-summary-save-article-folder 1997 "h" gnus-summary-save-article-folder
1995 "v" gnus-summary-save-article-vm 1998 "v" gnus-summary-save-article-vm
1996 "p" gnus-summary-pipe-output 1999 "p" gnus-summary-pipe-output
@@ -3709,16 +3712,10 @@ If NO-DISPLAY, don't generate a summary buffer."
3709 (when gnus-build-sparse-threads 3712 (when gnus-build-sparse-threads
3710 (gnus-build-sparse-threads)) 3713 (gnus-build-sparse-threads))
3711 ;; Find the initial limit. 3714 ;; Find the initial limit.
3712 (if gnus-show-threads 3715 (if show-all
3713 (if show-all 3716 (let ((gnus-newsgroup-dormant nil))
3714 (let ((gnus-newsgroup-dormant nil))
3715 (gnus-summary-initial-limit show-all))
3716 (gnus-summary-initial-limit show-all)) 3717 (gnus-summary-initial-limit show-all))
3717 ;; When unthreaded, all articles are always shown. 3718 (gnus-summary-initial-limit show-all))
3718 (setq gnus-newsgroup-limit
3719 (mapcar
3720 (lambda (header) (mail-header-number header))
3721 gnus-newsgroup-headers)))
3722 ;; Generate the summary buffer. 3719 ;; Generate the summary buffer.
3723 (unless no-display 3720 (unless no-display
3724 (gnus-summary-prepare)) 3721 (gnus-summary-prepare))
@@ -5419,8 +5416,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
5419 5416
5420(defun gnus-articles-to-read (group &optional read-all) 5417(defun gnus-articles-to-read (group &optional read-all)
5421 "Find out what articles the user wants to read." 5418 "Find out what articles the user wants to read."
5422 (let* ((display (gnus-group-find-parameter group 'display)) 5419 (let* ((articles
5423 (articles
5424 ;; Select all articles if `read-all' is non-nil, or if there 5420 ;; Select all articles if `read-all' is non-nil, or if there
5425 ;; are no unread articles. 5421 ;; are no unread articles.
5426 (if (or read-all 5422 (if (or read-all
@@ -9507,7 +9503,7 @@ deleted forever, right now."
9507 (interactive) 9503 (interactive)
9508 (or gnus-expert-user 9504 (or gnus-expert-user
9509 (gnus-yes-or-no-p 9505 (gnus-yes-or-no-p
9510 "Are you really, really, really sure you want to delete all these messages? ") 9506 "Are you really, really sure you want to delete all expirable messages? ")
9511 (error "Phew!")) 9507 (error "Phew!"))
9512 (gnus-summary-expire-articles t)) 9508 (gnus-summary-expire-articles t))
9513 9509
@@ -10993,12 +10989,26 @@ If N is a positive number, save the N next articles.
10993If N is a negative number, save the N previous articles. 10989If N is a negative number, save the N previous articles.
10994If N is nil and any articles have been marked with the process mark, 10990If N is nil and any articles have been marked with the process mark,
10995save those articles instead. 10991save those articles instead.
10996The variable `gnus-default-article-saver' specifies the saver function." 10992The variable `gnus-default-article-saver' specifies the saver function.
10993
10994If the optional second argument NOT-SAVED is non-nil, articles saved
10995will not be marked as saved."
10997 (interactive "P") 10996 (interactive "P")
10997 (require 'gnus-art)
10998 (let* ((articles (gnus-summary-work-articles n)) 10998 (let* ((articles (gnus-summary-work-articles n))
10999 (save-buffer (save-excursion 10999 (save-buffer (save-excursion
11000 (nnheader-set-temp-buffer " *Gnus Save*"))) 11000 (nnheader-set-temp-buffer " *Gnus Save*")))
11001 (num (length articles)) 11001 (num (length articles))
11002 ;; Whether to save decoded articles or raw articles.
11003 (decode (when gnus-article-save-coding-system
11004 (get gnus-default-article-saver :decode)))
11005 ;; When saving many articles in a single file, use the other
11006 ;; function to save articles other than the first one.
11007 (saver2 (get gnus-default-article-saver :function))
11008 (gnus-prompt-before-saving (if saver2
11009 t
11010 gnus-prompt-before-saving))
11011 (gnus-default-article-saver gnus-default-article-saver)
11002 header file) 11012 header file)
11003 (dolist (article articles) 11013 (dolist (article articles)
11004 (setq header (gnus-summary-article-header article)) 11014 (setq header (gnus-summary-article-header article))
@@ -11009,17 +11019,25 @@ The variable `gnus-default-article-saver' specifies the saver function."
11009 (gnus-message 1 "Article %d is unsaveable" article)) 11019 (gnus-message 1 "Article %d is unsaveable" article))
11010 ;; This is a real article. 11020 ;; This is a real article.
11011 (save-window-excursion 11021 (save-window-excursion
11012 (let ((gnus-display-mime-function nil) 11022 (let ((gnus-display-mime-function (when decode
11013 (gnus-article-prepare-hook nil)) 11023 gnus-display-mime-function))
11014 (gnus-summary-select-article t nil nil article))) 11024 (gnus-article-prepare-hook (when decode
11025 gnus-article-prepare-hook)))
11026 (gnus-summary-select-article t nil nil article)
11027 (gnus-summary-goto-subject article)))
11015 (save-excursion 11028 (save-excursion
11016 (set-buffer save-buffer) 11029 (set-buffer save-buffer)
11017 (erase-buffer) 11030 (erase-buffer)
11018 (insert-buffer-substring gnus-original-article-buffer)) 11031 (insert-buffer-substring (if decode
11032 gnus-article-buffer
11033 gnus-original-article-buffer)))
11019 (setq file (gnus-article-save save-buffer file num)) 11034 (setq file (gnus-article-save save-buffer file num))
11020 (gnus-summary-remove-process-mark article) 11035 (gnus-summary-remove-process-mark article)
11021 (unless not-saved 11036 (unless not-saved
11022 (gnus-summary-set-saved-mark article)))) 11037 (gnus-summary-set-saved-mark article)))
11038 (when saver2
11039 (setq gnus-default-article-saver saver2
11040 saver2 nil)))
11023 (gnus-kill-buffer save-buffer) 11041 (gnus-kill-buffer save-buffer)
11024 (gnus-summary-position-point) 11042 (gnus-summary-position-point)
11025 (gnus-set-mode-line 'summary) 11043 (gnus-set-mode-line 'summary)
@@ -11043,7 +11061,7 @@ If HEADERS (the symbolic prefix), include the headers, too."
11043 (gnus-configure-windows 'pipe)))) 11061 (gnus-configure-windows 'pipe))))
11044 11062
11045(defun gnus-summary-save-article-mail (&optional arg) 11063(defun gnus-summary-save-article-mail (&optional arg)
11046 "Append the current article to an mail file. 11064 "Append the current article to a Unix mail box file.
11047If N is a positive number, save the N next articles. 11065If N is a positive number, save the N next articles.
11048If N is a negative number, save the N previous articles. 11066If N is a negative number, save the N previous articles.
11049If N is nil and any articles have been marked with the process mark, 11067If N is nil and any articles have been marked with the process mark,
@@ -11097,6 +11115,17 @@ save those articles instead."
11097 (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) 11115 (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
11098 (gnus-summary-save-article arg))) 11116 (gnus-summary-save-article arg)))
11099 11117
11118(defun gnus-summary-write-article-body-file (&optional arg)
11119 "Write the current article body to a file, deleting the previous file.
11120If N is a positive number, save the N next articles.
11121If N is a negative number, save the N previous articles.
11122If N is nil and any articles have been marked with the process mark,
11123save those articles instead."
11124 (interactive "P")
11125 (require 'gnus-art)
11126 (let ((gnus-default-article-saver 'gnus-summary-write-body-to-file))
11127 (gnus-summary-save-article arg)))
11128
11100(defun gnus-summary-muttprint (&optional arg) 11129(defun gnus-summary-muttprint (&optional arg)
11101 "Print the current article using Muttprint. 11130 "Print the current article using Muttprint.
11102If N is a positive number, save the N next articles. 11131If N is a positive number, save the N next articles.
diff --git a/lisp/gnus/imap.el b/lisp/gnus/imap.el
index 7b40773ca06..16fce1843db 100644
--- a/lisp/gnus/imap.el
+++ b/lisp/gnus/imap.el
@@ -79,7 +79,7 @@
79;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS, 79;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS,
80;; LOGINDISABLED) (with use of external library starttls.el and 80;; LOGINDISABLED) (with use of external library starttls.el and
81;; program starttls) and the GSSAPI / kerberos V4 sections of RFC1731 81;; program starttls) and the GSSAPI / kerberos V4 sections of RFC1731
82;; (with use of external program `imtest'). It also take advantage 82;; (with use of external program `imtest'). It also takes advantage of
83;; the UNSELECT extension in Cyrus IMAPD. 83;; the UNSELECT extension in Cyrus IMAPD.
84;; 84;;
85;; Without the work of John McClary Prevost and Jim Radford this library 85;; Without the work of John McClary Prevost and Jim Radford this library
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 9683f28154b..e350468bea4 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -63,175 +63,177 @@ This variable is a list of mail source specifiers.
63See Info node `(gnus)Mail Source Specifiers'." 63See Info node `(gnus)Mail Source Specifiers'."
64 :group 'mail-source 64 :group 'mail-source
65 :link '(custom-manual "(gnus)Mail Source Specifiers") 65 :link '(custom-manual "(gnus)Mail Source Specifiers")
66 :type `(repeat 66 :type `(choice
67 (choice :format "%[Value Menu%] %v" 67 (const nil)
68 :value (file) 68 (repeat
69 (cons :tag "Spool file" 69 (choice :format "%[Value Menu%] %v"
70 (const :format "" file) 70 :value (file)
71 (checklist :tag "Options" :greedy t 71 (cons :tag "Spool file"
72 (group :inline t 72 (const :format "" file)
73 (const :format "" :value :path) 73 (checklist :tag "Options" :greedy t
74 file))) 74 (group :inline t
75 (cons :tag "Several files in a directory" 75 (const :format "" :value :path)
76 (const :format "" directory) 76 file)))
77 (checklist :tag "Options" :greedy t 77 (cons :tag "Several files in a directory"
78 (group :inline t 78 (const :format "" directory)
79 (const :format "" :value :path) 79 (checklist :tag "Options" :greedy t
80 (directory :tag "Path")) 80 (group :inline t
81 (group :inline t 81 (const :format "" :value :path)
82 (const :format "" :value :suffix) 82 (directory :tag "Path"))
83 (string :tag "Suffix")) 83 (group :inline t
84 (group :inline t 84 (const :format "" :value :suffix)
85 (const :format "" :value :predicate) 85 (string :tag "Suffix"))
86 (function :tag "Predicate")) 86 (group :inline t
87 (group :inline t 87 (const :format "" :value :predicate)
88 (const :format "" :value :prescript) 88 (function :tag "Predicate"))
89 (choice :tag "Prescript" 89 (group :inline t
90 :value nil 90 (const :format "" :value :prescript)
91 (string :format "%v") 91 (choice :tag "Prescript"
92 (function :format "%v"))) 92 :value nil
93 (group :inline t 93 (string :format "%v")
94 (const :format "" :value :postscript) 94 (function :format "%v")))
95 (choice :tag "Postscript" 95 (group :inline t
96 :value nil 96 (const :format "" :value :postscript)
97 (string :format "%v") 97 (choice :tag "Postscript"
98 (function :format "%v"))) 98 :value nil
99 (group :inline t 99 (string :format "%v")
100 (const :format "" :value :plugged) 100 (function :format "%v")))
101 (boolean :tag "Plugged")))) 101 (group :inline t
102 (cons :tag "POP3 server" 102 (const :format "" :value :plugged)
103 (const :format "" pop) 103 (boolean :tag "Plugged"))))
104 (checklist :tag "Options" :greedy t 104 (cons :tag "POP3 server"
105 (group :inline t 105 (const :format "" pop)
106 (const :format "" :value :server) 106 (checklist :tag "Options" :greedy t
107 (string :tag "Server")) 107 (group :inline t
108 (group :inline t 108 (const :format "" :value :server)
109 (const :format "" :value :port) 109 (string :tag "Server"))
110 (choice :tag "Port" 110 (group :inline t
111 :value "pop3" 111 (const :format "" :value :port)
112 (number :format "%v") 112 (choice :tag "Port"
113 (string :format "%v"))) 113 :value "pop3"
114 (group :inline t 114 (number :format "%v")
115 (const :format "" :value :user) 115 (string :format "%v")))
116 (string :tag "User")) 116 (group :inline t
117 (group :inline t 117 (const :format "" :value :user)
118 (const :format "" :value :password) 118 (string :tag "User"))
119 (string :tag "Password")) 119 (group :inline t
120 (group :inline t 120 (const :format "" :value :password)
121 (const :format "" :value :program) 121 (string :tag "Password"))
122 (string :tag "Program")) 122 (group :inline t
123 (group :inline t 123 (const :format "" :value :program)
124 (const :format "" :value :prescript) 124 (string :tag "Program"))
125 (choice :tag "Prescript" 125 (group :inline t
126 :value nil 126 (const :format "" :value :prescript)
127 (string :format "%v") 127 (choice :tag "Prescript"
128 (function :format "%v"))) 128 :value nil
129 (group :inline t 129 (string :format "%v")
130 (const :format "" :value :postscript) 130 (function :format "%v")))
131 (choice :tag "Postscript" 131 (group :inline t
132 :value nil 132 (const :format "" :value :postscript)
133 (string :format "%v") 133 (choice :tag "Postscript"
134 (function :format "%v"))) 134 :value nil
135 (group :inline t 135 (string :format "%v")
136 (const :format "" :value :function) 136 (function :format "%v")))
137 (function :tag "Function")) 137 (group :inline t
138 (group :inline t 138 (const :format "" :value :function)
139 (const :format "" 139 (function :tag "Function"))
140 :value :authentication) 140 (group :inline t
141 (choice :tag "Authentication" 141 (const :format ""
142 :value apop 142 :value :authentication)
143 (const password) 143 (choice :tag "Authentication"
144 (const apop))) 144 :value apop
145 (group :inline t 145 (const password)
146 (const :format "" :value :plugged) 146 (const apop)))
147 (boolean :tag "Plugged")))) 147 (group :inline t
148 (cons :tag "Maildir (qmail, postfix...)" 148 (const :format "" :value :plugged)
149 (const :format "" maildir) 149 (boolean :tag "Plugged"))))
150 (checklist :tag "Options" :greedy t 150 (cons :tag "Maildir (qmail, postfix...)"
151 (group :inline t 151 (const :format "" maildir)
152 (const :format "" :value :path) 152 (checklist :tag "Options" :greedy t
153 (directory :tag "Path")) 153 (group :inline t
154 (group :inline t 154 (const :format "" :value :path)
155 (const :format "" :value :plugged) 155 (directory :tag "Path"))
156 (boolean :tag "Plugged")))) 156 (group :inline t
157 (cons :tag "IMAP server" 157 (const :format "" :value :plugged)
158 (const :format "" imap) 158 (boolean :tag "Plugged"))))
159 (checklist :tag "Options" :greedy t 159 (cons :tag "IMAP server"
160 (group :inline t 160 (const :format "" imap)
161 (const :format "" :value :server) 161 (checklist :tag "Options" :greedy t
162 (string :tag "Server")) 162 (group :inline t
163 (group :inline t 163 (const :format "" :value :server)
164 (const :format "" :value :port) 164 (string :tag "Server"))
165 (choice :tag "Port" 165 (group :inline t
166 :value 143 166 (const :format "" :value :port)
167 number string)) 167 (choice :tag "Port"
168 (group :inline t 168 :value 143
169 (const :format "" :value :user) 169 number string))
170 (string :tag "User")) 170 (group :inline t
171 (group :inline t 171 (const :format "" :value :user)
172 (const :format "" :value :password) 172 (string :tag "User"))
173 (string :tag "Password")) 173 (group :inline t
174 (group :inline t 174 (const :format "" :value :password)
175 (const :format "" :value :stream) 175 (string :tag "Password"))
176 (choice :tag "Stream" 176 (group :inline t
177 :value network 177 (const :format "" :value :stream)
178 ,@mail-source-imap-streams)) 178 (choice :tag "Stream"
179 (group :inline t 179 :value network
180 (const :format "" :value :program) 180 ,@mail-source-imap-streams))
181 (string :tag "Program")) 181 (group :inline t
182 (group :inline t 182 (const :format "" :value :program)
183 (const :format "" 183 (string :tag "Program"))
184 :value :authenticator) 184 (group :inline t
185 (choice :tag "Authenticator" 185 (const :format ""
186 :value login 186 :value :authenticator)
187 ,@mail-source-imap-authenticators)) 187 (choice :tag "Authenticator"
188 (group :inline t 188 :value login
189 (const :format "" :value :mailbox) 189 ,@mail-source-imap-authenticators))
190 (string :tag "Mailbox" 190 (group :inline t
191 :value "INBOX")) 191 (const :format "" :value :mailbox)
192 (group :inline t 192 (string :tag "Mailbox"
193 (const :format "" :value :predicate) 193 :value "INBOX"))
194 (string :tag "Predicate" 194 (group :inline t
195 :value "UNSEEN UNDELETED")) 195 (const :format "" :value :predicate)
196 (group :inline t 196 (string :tag "Predicate"
197 (const :format "" :value :fetchflag) 197 :value "UNSEEN UNDELETED"))
198 (string :tag "Fetchflag" 198 (group :inline t
199 :value "\\Deleted")) 199 (const :format "" :value :fetchflag)
200 (group :inline t 200 (string :tag "Fetchflag"
201 (const :format "" 201 :value "\\Deleted"))
202 :value :dontexpunge) 202 (group :inline t
203 (boolean :tag "Dontexpunge")) 203 (const :format ""
204 (group :inline t 204 :value :dontexpunge)
205 (const :format "" :value :plugged) 205 (boolean :tag "Dontexpunge"))
206 (boolean :tag "Plugged")))) 206 (group :inline t
207 (cons :tag "Webmail server" 207 (const :format "" :value :plugged)
208 (const :format "" webmail) 208 (boolean :tag "Plugged"))))
209 (checklist :tag "Options" :greedy t 209 (cons :tag "Webmail server"
210 (group :inline t 210 (const :format "" webmail)
211 (const :format "" :value :subtype) 211 (checklist :tag "Options" :greedy t
212 ;; Should be generated from 212 (group :inline t
213 ;; `webmail-type-definition', but we 213 (const :format "" :value :subtype)
214 ;; can't require webmail without W3. 214 ;; Should be generated from
215 (choice :tag "Subtype" 215 ;; `webmail-type-definition', but we
216 :value hotmail 216 ;; can't require webmail without W3.
217 (const hotmail) 217 (choice :tag "Subtype"
218 (const yahoo) 218 :value hotmail
219 (const netaddress) 219 (const hotmail)
220 (const netscape) 220 (const yahoo)
221 (const my-deja))) 221 (const netaddress)
222 (group :inline t 222 (const netscape)
223 (const :format "" :value :user) 223 (const my-deja)))
224 (string :tag "User")) 224 (group :inline t
225 (group :inline t 225 (const :format "" :value :user)
226 (const :format "" :value :password) 226 (string :tag "User"))
227 (string :tag "Password")) 227 (group :inline t
228 (group :inline t 228 (const :format "" :value :password)
229 (const :format "" 229 (string :tag "Password"))
230 :value :dontexpunge) 230 (group :inline t
231 (boolean :tag "Dontexpunge")) 231 (const :format ""
232 (group :inline t 232 :value :dontexpunge)
233 (const :format "" :value :plugged) 233 (boolean :tag "Dontexpunge"))
234 (boolean :tag "Plugged"))))))) 234 (group :inline t
235 (const :format "" :value :plugged)
236 (boolean :tag "Plugged"))))))))
235 237
236(defcustom mail-source-ignore-errors nil 238(defcustom mail-source-ignore-errors nil
237 "*Ignore errors when querying mail sources. 239 "*Ignore errors when querying mail sources.
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 9a0464be958..5803df7d419 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -364,14 +364,17 @@ could use `autoload-coding-system' here."
364 (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208 364 (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208
365 japanese-jisx0213-1 japanese-jisx0213-2) 365 japanese-jisx0213-1 japanese-jisx0213-2)
366 (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208) 366 (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208)
367 ,(if (or (not (fboundp 'charsetp)) ;; non-Mule case 367 ,(cond ((fboundp 'unicode-precedence-list)
368 (charsetp 'unicode-a) 368 (cons 'utf-8 (delq 'ascii (mapcar 'charset-name
369 (not (mm-coding-system-p 'mule-utf-8))) 369 (unicode-precedence-list)))))
370 '(utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e) 370 ((or (not (fboundp 'charsetp)) ;; non-Mule case
371 ;; If we have utf-8 we're in Mule 5+. 371 (charsetp 'unicode-a)
372 (append '(utf-8) 372 (not (mm-coding-system-p 'mule-utf-8)))
373 (delete 'ascii 373 '(utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e))
374 (coding-system-get 'mule-utf-8 'safe-charsets))))) 374 (t ;; If we have utf-8 we're in Mule 5+.
375 (append '(utf-8)
376 (delete 'ascii
377 (coding-system-get 'mule-utf-8 'safe-charsets))))))
375 "Alist of MIME-charset/MULE-charsets.") 378 "Alist of MIME-charset/MULE-charsets.")
376 379
377(defun mm-enrich-utf-8-by-mule-ucs () 380(defun mm-enrich-utf-8-by-mule-ucs ()
@@ -379,10 +382,6 @@ could use `autoload-coding-system' here."
379This function will run when the `un-define' module is loaded under 382This function will run when the `un-define' module is loaded under
380XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist' 383XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist'
381with Mule charsets. It is completely useless for Emacs." 384with Mule charsets. It is completely useless for Emacs."
382 (unless (cdr (delete '(mm-enrich-utf-8-by-mule-ucs)
383 (assoc "un-define" after-load-alist)))
384 (setq after-load-alist
385 (delete '("un-define") after-load-alist)))
386 (when (boundp 'unicode-basic-translation-charset-order-list) 385 (when (boundp 'unicode-basic-translation-charset-order-list)
387 (condition-case nil 386 (condition-case nil
388 (let ((val (delq 387 (let ((val (delq
diff --git a/lisp/gnus/uudecode.el b/lisp/gnus/uudecode.el
index f47a8e90c3a..616348e899f 100644
--- a/lisp/gnus/uudecode.el
+++ b/lisp/gnus/uudecode.el
@@ -100,7 +100,11 @@ used is specified by `uudecode-decoder-program'."
100 (make-temp-name "uu") 100 (make-temp-name "uu")
101 uudecode-temporary-file-directory)))) 101 uudecode-temporary-file-directory))))
102 (let ((cdir default-directory) 102 (let ((cdir default-directory)
103 default-process-coding-system) 103 (default-process-coding-system
104 (if (featurep 'xemacs)
105 ;; In XEmacs, `nil' is not a valid coding system.
106 '(binary . binary)
107 nil)))
104 (unwind-protect 108 (unwind-protect
105 (with-temp-buffer 109 (with-temp-buffer
106 (insert "begin 600 " (file-name-nondirectory tempfile) "\n") 110 (insert "begin 600 " (file-name-nondirectory tempfile) "\n")
diff --git a/lisp/help.el b/lisp/help.el
index 1661779ca74..d9a48a0a4cf 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -326,63 +326,76 @@ of the key sequence that ran this command."
326;; run describe-prefix-bindings. 326;; run describe-prefix-bindings.
327(setq prefix-help-command 'describe-prefix-bindings) 327(setq prefix-help-command 'describe-prefix-bindings)
328 328
329(defun view-emacs-news (&optional arg) 329(defun view-emacs-news (&optional version)
330 "Display info on recent changes to Emacs. 330 "Display info on recent changes to Emacs.
331With argument, display info only for the selected version." 331With argument, display info only for the selected version."
332 (interactive "P") 332 (interactive "P")
333 (if (not arg) 333 (unless version
334 (view-file (expand-file-name "NEWS" data-directory)) 334 (setq version emacs-major-version))
335 (let* ((map (sort 335 (when (consp version)
336 (delete-dups 336 (let* ((all-versions
337 (apply 337 (let (res)
338 'nconc 338 (mapcar
339 (mapcar 339 (lambda (file)
340 (lambda (file) 340 (with-temp-buffer
341 (with-temp-buffer 341 (insert-file-contents
342 (insert-file-contents 342 (expand-file-name file data-directory))
343 (expand-file-name file data-directory)) 343 (while (re-search-forward
344 (let (res) 344 (if (member file '("NEWS.18" "NEWS.1-17"))
345 (while (re-search-forward 345 "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)"
346 (if (string-match "^ONEWS\\.[0-9]+$" file) 346 "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t)
347 "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)" 347 (setq res (cons (match-string-no-properties 1) res)))))
348 "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t) 348 (cons "NEWS"
349 (setq res (cons (list (match-string-no-properties 1) 349 (directory-files data-directory nil
350 file) res))) 350 "^NEWS\\.[0-9][-0-9]*$" nil)))
351 res))) 351 (sort (delete-dups res) (lambda (a b) (string< b a)))))
352 (append '("NEWS" "ONEWS") 352 (current (car all-versions))
353 (directory-files data-directory nil 353 res)
354 "^ONEWS\\.[0-9]+$" nil))))) 354 (setq version (completing-read
355 (lambda (a b) 355 (format "Read NEWS for the version (default %s): " current)
356 (string< (car b) (car a))))) 356 all-versions nil nil nil nil current))
357 (current (caar map)) 357 (if (integerp (string-to-number version))
358 (version (completing-read 358 (setq version (string-to-number version))
359 (format "Read NEWS for the version (default %s): " current) 359 (unless (or (member version all-versions)
360 (mapcar 'car map) nil nil nil nil current)) 360 (<= (string-to-number version) (string-to-number current)))
361 (file (cadr (assoc version map))) 361 (error "No news about version %s" version)))))
362 res) 362 (when (integerp version)
363 (if (not file) 363 (cond ((<= version 12)
364 (error "No news is good news") 364 (setq version (format "1.%d" version)))
365 (view-file (expand-file-name file data-directory)) 365 ((<= version 18)
366 (widen) 366 (setq version (format "%d" version)))
367 (goto-char (point-min)) 367 ((> version emacs-major-version)
368 (when (re-search-forward 368 (error "No news about emacs %d (yet)" version))))
369 (concat (if (string-match "^ONEWS\\.[0-9]+$" file) 369 (let* ((vn (if (stringp version)
370 "Changes in \\(?:Emacs\\|version\\)?[ \t]*" 370 (string-to-number version)
371 "^\* [^0-9\n]*") version) 371 version))
372 nil t) 372 (file (cond
373 (beginning-of-line) 373 ((>= vn emacs-major-version) "NEWS")
374 (narrow-to-region 374 ((< vn 18) "NEWS.1-17")
375 (point) 375 (t (format "NEWS.%d" vn)))))
376 (save-excursion 376 (view-file (expand-file-name file data-directory))
377 (while (and (setq res 377 (widen)
378 (re-search-forward 378 (goto-char (point-min))
379 (if (string-match "^ONEWS\\.[0-9]+$" file) 379 (when (stringp version)
380 "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)" 380 (when (re-search-forward
381 "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t)) 381 (concat (if (< vn 19)
382 (equal (match-string-no-properties 1) version))) 382 "Changes in Emacs[ \t]*"
383 (or res (goto-char (point-max))) 383 "^\* [^0-9\n]*") version "$")
384 (beginning-of-line) 384 nil t)
385 (point)))))))) 385 (beginning-of-line)
386 (narrow-to-region
387 (point)
388 (save-excursion
389 (while (and (setq res
390 (re-search-forward
391 (if (< vn 19)
392 "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)"
393 "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t))
394 (equal (match-string-no-properties 1) version)))
395 (or res (goto-char (point-max)))
396 (beginning-of-line)
397 (point)))))))
398
386 399
387(defun view-todo (&optional arg) 400(defun view-todo (&optional arg)
388 "Display the Emacs TODO list." 401 "Display the Emacs TODO list."
@@ -942,11 +955,11 @@ is currently activated with completion."
942 955
943(defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2)) 956(defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2))
944 "Maximum height of a window displaying a temporary buffer. 957 "Maximum height of a window displaying a temporary buffer.
945This is the maximum height (in text lines) which `resize-temp-buffer-window' 958This is effective only when Temp Buffer Resize mode is enabled.
959The value is the maximum height (in lines) which `resize-temp-buffer-window'
946will give to a window displaying a temporary buffer. 960will give to a window displaying a temporary buffer.
947It can also be a function which will be called with the object corresponding 961It can also be a function to be called to choose the height for such a buffer.
948to the buffer to be displayed as argument and should return an integer 962It gets one argumemt, the buffer, and should return a positive integer."
949positive number."
950 :type '(choice integer function) 963 :type '(choice integer function)
951 :group 'help 964 :group 'help
952 :version "20.4") 965 :version "20.4")
diff --git a/lisp/ido.el b/lisp/ido.el
index a622a7e6275..344f8a667a1 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -448,35 +448,41 @@ in merged file and directory lists."
448;;; Examples for setting the value of ido-ignore-files 448;;; Examples for setting the value of ido-ignore-files
449;(setq ido-ignore-files '("^ " "\\.c$" "\\.h$")) 449;(setq ido-ignore-files '("^ " "\\.c$" "\\.h$"))
450 450
451(defcustom ido-default-file-method 'always-frame 451(defcustom ido-default-file-method 'raise-frame
452 "*How to switch to new file when using `ido-find-file'. 452 "*How to visit a new file when using `ido-find-file'.
453Possible values: 453Possible values:
454`samewindow' Show new file in same window 454`selected-window' Show new file in selected window
455`otherwindow' Show new file in another window (same frame) 455`other-window' Show new file in another window (same frame)
456`display' Display file in another window without switching to it 456`display' Display file in another window without selecting to it
457`otherframe' Show new file in another frame 457`other-frame' Show new file in another frame
458`maybe-frame' If a file is visible in another frame, prompt to ask if you 458`maybe-frame' If a file is visible in another frame, prompt to ask if you
459 you want to see the file in the same window of the current 459 you want to see the file in the same window of the current
460 frame or in the other frame 460 frame or in the other frame
461`always-frame' If a file is visible in another frame, raise that 461`raise-frame' If a file is visible in another frame, raise that
462 frame; otherwise, visit the file in the same window" 462 frame; otherwise, visit the file in the same window"
463 :type '(choice (const samewindow) 463 :type '(choice (const :tag "Visit in selected window" selected-window)
464 (const otherwindow) 464 (const :tag "Visit in other window" other-window)
465 (const display) 465 (const :tag "Display (no select) in other window" display)
466 (const otherframe) 466 (const :tag "Visit in other frame" other-frame)
467 (const maybe-frame) 467 (const :tag "Ask to visit in other frame" maybe-frame)
468 (const always-frame)) 468 (const :tag "Raise frame if already visited" raise-frame))
469 :group 'ido) 469 :group 'ido)
470 470
471(defcustom ido-default-buffer-method 'always-frame 471(defcustom ido-default-buffer-method 'raise-frame
472 "*How to switch to new buffer when using `ido-switch-buffer'. 472 "*How to switch to new buffer when using `ido-switch-buffer'.
473See `ido-default-file-method' for details." 473See `ido-default-file-method' for details."
474 :type '(choice (const samewindow) 474 :type '(choice (const :tag "Show in selected window" selected-window)
475 (const otherwindow) 475 (const :tag "Show in other window" other-window)
476 (const :tag "Display (no select) in other window" display)
477 (const :tag "Show in other frame" other-frame)
478 (const :tag "Ask to show in other frame" maybe-frame)
479 (const :tag "Raise frame if already shown" raise-frame))
480 :type '(choice (const selected-window)
481 (const other-window)
476 (const display) 482 (const display)
477 (const otherframe) 483 (const other-frame)
478 (const maybe-frame) 484 (const maybe-frame)
479 (const always-frame)) 485 (const raise-frame))
480 :group 'ido) 486 :group 'ido)
481 487
482(defcustom ido-enable-flex-matching nil 488(defcustom ido-enable-flex-matching nil
@@ -1778,7 +1784,7 @@ With ARG, turn ido speed-up on if arg is positive, off otherwise."
1778 "Perform the `ido-read-buffer' and `ido-read-file-name' functions. 1784 "Perform the `ido-read-buffer' and `ido-read-file-name' functions.
1779Return the name of a buffer or file selected. 1785Return the name of a buffer or file selected.
1780PROMPT is the prompt to give to the user. 1786PROMPT is the prompt to give to the user.
1781DEFAULT if given is the default directory to start with. 1787DEFAULT if given is the default item to start with.
1782If REQUIRE-MATCH is non-nil, an existing file must be selected. 1788If REQUIRE-MATCH is non-nil, an existing file must be selected.
1783If INITIAL is non-nil, it specifies the initial input string." 1789If INITIAL is non-nil, it specifies the initial input string."
1784 (let 1790 (let
@@ -1822,7 +1828,10 @@ If INITIAL is non-nil, it specifies the initial input string."
1822 (cond 1828 (cond
1823 ((eq item 'buffer) 1829 ((eq item 'buffer)
1824 (if (bufferp default) (buffer-name default) default)) 1830 (if (bufferp default) (buffer-name default) default))
1825 ((stringp default) default) 1831 ((stringp default)
1832 (if (memq item '(file dir))
1833 (file-name-nondirectory default)
1834 default))
1826 ((eq item 'file) 1835 ((eq item 'file)
1827 (and ido-enable-last-directory-history 1836 (and ido-enable-last-directory-history
1828 (let ((d (assoc ido-current-directory ido-last-directory-list))) 1837 (let ((d (assoc ido-current-directory ido-last-directory-list)))
@@ -3739,7 +3748,7 @@ for first matching file."
3739 3748
3740;;; VISIT CHOSEN BUFFER 3749;;; VISIT CHOSEN BUFFER
3741(defun ido-visit-buffer (buffer method &optional record) 3750(defun ido-visit-buffer (buffer method &optional record)
3742 "Visit file named FILE according to METHOD. 3751 "Switch to BUFFER according to METHOD.
3743Record command in `command-history' if optional RECORD is non-nil." 3752Record command in `command-history' if optional RECORD is non-nil."
3744 3753
3745 (let (win newframe) 3754 (let (win newframe)
@@ -3749,33 +3758,7 @@ Record command in `command-history' if optional RECORD is non-nil."
3749 (ido-record-command 'kill-buffer buffer)) 3758 (ido-record-command 'kill-buffer buffer))
3750 (kill-buffer buffer)) 3759 (kill-buffer buffer))
3751 3760
3752 ((eq method 'samewindow) 3761 ((eq method 'other-window)
3753 (if record
3754 (ido-record-command 'switch-to-buffer buffer))
3755 (switch-to-buffer buffer))
3756
3757 ((memq method '(always-frame maybe-frame))
3758 (cond
3759 ((and window-system
3760 (setq win (ido-window-buffer-p buffer))
3761 (or (eq method 'always-frame)
3762 (y-or-n-p "Jump to frame? ")))
3763 (setq newframe (window-frame win))
3764 (if (fboundp 'select-frame-set-input-focus)
3765 (select-frame-set-input-focus newframe)
3766 (raise-frame newframe)
3767 (select-frame newframe)
3768 (unless (featurep 'xemacs)
3769 (set-mouse-position (selected-frame) (1- (frame-width)) 0)))
3770 (select-window win))
3771 (t
3772 ;; No buffer in other frames...
3773 (if record
3774 (ido-record-command 'switch-to-buffer buffer))
3775 (switch-to-buffer buffer)
3776 )))
3777
3778 ((eq method 'otherwindow)
3779 (if record 3762 (if record
3780 (ido-record-command 'switch-to-buffer buffer)) 3763 (ido-record-command 'switch-to-buffer buffer))
3781 (switch-to-buffer-other-window buffer)) 3764 (switch-to-buffer-other-window buffer))
@@ -3783,14 +3766,29 @@ Record command in `command-history' if optional RECORD is non-nil."
3783 ((eq method 'display) 3766 ((eq method 'display)
3784 (display-buffer buffer)) 3767 (display-buffer buffer))
3785 3768
3786 ((eq method 'otherframe) 3769 ((eq method 'other-frame)
3787 (switch-to-buffer-other-frame buffer) 3770 (switch-to-buffer-other-frame buffer)
3788 (unless (featurep 'xemacs) 3771 (select-frame-set-input-focus (selected-frame)))
3789 (select-frame-set-input-focus (selected-frame))) 3772
3773 ((and (memq method '(raise-frame maybe-frame))
3774 window-system
3775 (setq win (ido-buffer-window-other-frame buffer))
3776 (or (eq method 'raise-frame)
3777 (y-or-n-p "Jump to frame? ")))
3778 (setq newframe (window-frame win))
3779 (select-frame-set-input-focus newframe)
3780 (select-window win))
3781
3782 ;; (eq method 'selected-window)
3783 (t
3784 ;; No buffer in other frames...
3785 (if record
3786 (ido-record-command 'switch-to-buffer buffer))
3787 (switch-to-buffer buffer)
3790 )))) 3788 ))))
3791 3789
3792 3790
3793(defun ido-window-buffer-p (buffer) 3791(defun ido-buffer-window-other-frame (buffer)
3794 ;; Return window pointer if BUFFER is visible in another frame. 3792 ;; Return window pointer if BUFFER is visible in another frame.
3795 ;; If BUFFER is visible in the current frame, return nil. 3793 ;; If BUFFER is visible in the current frame, return nil.
3796 (let ((blist (ido-get-buffers-in-frames 'current))) 3794 (let ((blist (ido-get-buffers-in-frames 'current)))
@@ -3847,7 +3845,7 @@ in a separate window.
3847The buffer name is selected interactively by typing a substring. 3845The buffer name is selected interactively by typing a substring.
3848For details of keybindings, do `\\[describe-function] ido'." 3846For details of keybindings, do `\\[describe-function] ido'."
3849 (interactive) 3847 (interactive)
3850 (ido-buffer-internal 'otherwindow 'switch-to-buffer-other-window)) 3848 (ido-buffer-internal 'other-window 'switch-to-buffer-other-window))
3851 3849
3852;;;###autoload 3850;;;###autoload
3853(defun ido-display-buffer () 3851(defun ido-display-buffer ()
@@ -3880,7 +3878,7 @@ The buffer name is selected interactively by typing a substring.
3880For details of keybindings, do `\\[describe-function] ido'." 3878For details of keybindings, do `\\[describe-function] ido'."
3881 (interactive) 3879 (interactive)
3882 (if ido-mode 3880 (if ido-mode
3883 (ido-buffer-internal 'otherframe) 3881 (ido-buffer-internal 'other-frame)
3884 (call-interactively 'switch-to-buffer-other-frame))) 3882 (call-interactively 'switch-to-buffer-other-frame)))
3885 3883
3886;;;###autoload 3884;;;###autoload
@@ -3942,7 +3940,7 @@ in a separate window.
3942The file name is selected interactively by typing a substring. 3940The file name is selected interactively by typing a substring.
3943For details of keybindings, do `\\[describe-function] ido-find-file'." 3941For details of keybindings, do `\\[describe-function] ido-find-file'."
3944 (interactive) 3942 (interactive)
3945 (ido-file-internal 'otherwindow 'find-file-other-window)) 3943 (ido-file-internal 'other-window 'find-file-other-window))
3946 3944
3947;;;###autoload 3945;;;###autoload
3948(defun ido-find-alternate-file () 3946(defun ido-find-alternate-file ()
@@ -3990,7 +3988,7 @@ For details of keybindings, do `\\[describe-function] ido-find-file'."
3990The file name is selected interactively by typing a substring. 3988The file name is selected interactively by typing a substring.
3991For details of keybindings, do `\\[describe-function] ido-find-file'." 3989For details of keybindings, do `\\[describe-function] ido-find-file'."
3992 (interactive) 3990 (interactive)
3993 (ido-file-internal 'otherframe 'find-file-other-frame)) 3991 (ido-file-internal 'other-frame 'find-file-other-frame))
3994 3992
3995;;;###autoload 3993;;;###autoload
3996(defun ido-write-file () 3994(defun ido-write-file ()
@@ -4472,6 +4470,8 @@ See `read-file-name' for additional parameters."
4472 (ido-directory-too-big (and (not ido-directory-nonreadable) 4470 (ido-directory-too-big (and (not ido-directory-nonreadable)
4473 (ido-directory-too-big-p ido-current-directory))) 4471 (ido-directory-too-big-p ido-current-directory)))
4474 (ido-work-directory-index -1) 4472 (ido-work-directory-index -1)
4473 (ido-show-dot-for-dired (and ido-show-dot-for-dired
4474 (not default-filename)))
4475 (ido-work-file-index -1) 4475 (ido-work-file-index -1)
4476 (ido-find-literal nil)) 4476 (ido-find-literal nil))
4477 (setq ido-exit nil) 4477 (setq ido-exit nil)
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 1a55676e3c7..66d7fb6c16a 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -139,6 +139,7 @@ and showing the image as an image."
139 ;; was inserted 139 ;; was inserted
140 (let* ((image 140 (let* ((image
141 (if (and (buffer-file-name) 141 (if (and (buffer-file-name)
142 (not (file-remote-p (buffer-file-name)))
142 (not (buffer-modified-p)) 143 (not (buffer-modified-p))
143 (not (and (boundp 'archive-superior-buffer) 144 (not (and (boundp 'archive-superior-buffer)
144 archive-superior-buffer)) 145 archive-superior-buffer))
diff --git a/lisp/info-xref.el b/lisp/info-xref.el
index 75bc72f25b4..a6acfa8021c 100644
--- a/lisp/info-xref.el
+++ b/lisp/info-xref.el
@@ -301,7 +301,10 @@ quite a while."
301 (lambda (symbol) 301 (lambda (symbol)
302 (dolist (link (get symbol 'custom-links)) 302 (dolist (link (get symbol 'custom-links))
303 (when (memq (car link) '(custom-manual info-link)) 303 (when (memq (car link) '(custom-manual info-link))
304 (if (info-xref-goto-node-p (cadr link)) 304 ;; skip :tag part of (custom-manual :tag "Foo" "(foo)Node")
305 (if (eq :tag (cadr link))
306 (setq link (cddr link)))
307 (if (info-xref-goto-node-p (cadr link))
305 (setq good (1+ good)) 308 (setq good (1+ good))
306 (setq bad (1+ bad)) 309 (setq bad (1+ bad))
307 ;; symbol-file gives nil for preloaded variables, would need 310 ;; symbol-file gives nil for preloaded variables, would need
diff --git a/lisp/info.el b/lisp/info.el
index d12b7a01866..107dbb72d95 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -2866,8 +2866,11 @@ Give an empty topic name to go to the Index node itself."
2866 (car (car Info-index-alternatives)) 2866 (car (car Info-index-alternatives))
2867 (nth 2 (car Info-index-alternatives)) 2867 (nth 2 (car Info-index-alternatives))
2868 (if (cdr Info-index-alternatives) 2868 (if (cdr Info-index-alternatives)
2869 (format "(%s total; use `,' for next)" 2869 (format "(%s total; use `%s' for next)"
2870 (length Info-index-alternatives)) 2870 (length Info-index-alternatives)
2871 (key-description (where-is-internal
2872 'Info-index-next overriding-local-map
2873 t)))
2871 "(Only match)"))) 2874 "(Only match)")))
2872 2875
2873(defun Info-find-index-name (name) 2876(defun Info-find-index-name (name)
@@ -2907,11 +2910,20 @@ Build a menu of the possible matches."
2907 manuals matches node nodes) 2910 manuals matches node nodes)
2908 (let ((Info-fontify-maximum-menu-size nil)) 2911 (let ((Info-fontify-maximum-menu-size nil))
2909 (Info-directory) 2912 (Info-directory)
2913 ;; current-node and current-file are nil when they invoke info-apropos
2914 ;; as the first Info command, i.e. info-apropos loads info.el. In that
2915 ;; case, we use (DIR)Top instead, to avoid signalling an error after
2916 ;; the search is complete.
2917 (when (null current-node)
2918 (setq current-file Info-current-file)
2919 (setq current-node Info-current-node))
2910 (message "Searching indices...") 2920 (message "Searching indices...")
2911 (goto-char (point-min)) 2921 (goto-char (point-min))
2912 (re-search-forward "\\* Menu: *\n" nil t) 2922 (re-search-forward "\\* Menu: *\n" nil t)
2913 (while (re-search-forward "\\*.*: *(\\([^)]+\\))" nil t) 2923 (while (re-search-forward "\\*.*: *(\\([^)]+\\))" nil t)
2914 (setq manuals (cons (match-string 1) manuals))) 2924 ;; add-to-list makes sure we don't have duplicates in `manuals',
2925 ;; so that the following dolist loop runs faster.
2926 (add-to-list 'manuals (match-string 1)))
2915 (dolist (manual (nreverse manuals)) 2927 (dolist (manual (nreverse manuals))
2916 (message "Searching %s" manual) 2928 (message "Searching %s" manual)
2917 (condition-case err 2929 (condition-case err
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index b0ad3cd5ec8..77ef9f07d59 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -73,8 +73,7 @@
73 (make-sparse-keymap "Set Coding System")) 73 (make-sparse-keymap "Set Coding System"))
74 74
75(define-key-after mule-menu-keymap [set-language-environment] 75(define-key-after mule-menu-keymap [set-language-environment]
76 (list 'menu-item "Set Language Environment" setup-language-environment-map 76 (list 'menu-item "Set Language Environment" setup-language-environment-map))
77 :help "Multilingual environment suitable for a specific language"))
78(define-key-after mule-menu-keymap [separator-mule] 77(define-key-after mule-menu-keymap [separator-mule]
79 '("--") 78 '("--")
80 t) 79 t)
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 9e0edb75f29..ae3301e24a9 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -356,9 +356,9 @@ Return t if file exists."
356 )) 356 ))
357 (let (kill-buffer-hook kill-buffer-query-functions) 357 (let (kill-buffer-hook kill-buffer-query-functions)
358 (kill-buffer buffer))) 358 (kill-buffer buffer)))
359 (let ((hook (assoc file after-load-alist))) 359 (unless purify-flag
360 (when hook 360 (do-after-load-evaluation fullname))
361 (mapcar (function eval) (cdr hook)))) 361
362 (unless (or nomessage noninteractive) 362 (unless (or nomessage noninteractive)
363 (if source 363 (if source
364 (message "Loading %s (source)...done" file) 364 (message "Loading %s (source)...done" file)
@@ -1649,6 +1649,9 @@ This is used for loading and byte-compiling Emacs Lisp files.")
1649 (setq alist (cdr alist)))) 1649 (setq alist (cdr alist))))
1650 coding-system)) 1650 coding-system))
1651 1651
1652(put 'enable-character-translation 'permanent-local t)
1653(put 'enable-character-translation 'safe-local-variable 'booleanp)
1654
1652(defun find-auto-coding (filename size) 1655(defun find-auto-coding (filename size)
1653 "Find a coding system for a file FILENAME of which SIZE bytes follow point. 1656 "Find a coding system for a file FILENAME of which SIZE bytes follow point.
1654These bytes should include at least the first 1k of the file 1657These bytes should include at least the first 1k of the file
@@ -1686,17 +1689,21 @@ If nothing is specified, the return value is nil."
1686 (head-end (+ head-start (min size 1024))) 1689 (head-end (+ head-start (min size 1024)))
1687 (tail-start (+ head-start (max (- size 3072) 0))) 1690 (tail-start (+ head-start (max (- size 3072) 0)))
1688 (tail-end (+ head-start size)) 1691 (tail-end (+ head-start size))
1689 coding-system head-found tail-found pos) 1692 coding-system head-found tail-found pos char-trans)
1690 ;; Try a short cut by searching for the string "coding:" 1693 ;; Try a short cut by searching for the string "coding:"
1691 ;; and for "unibyte:" at the head and tail of SIZE bytes. 1694 ;; and for "unibyte:" at the head and tail of SIZE bytes.
1692 (setq head-found (or (search-forward "coding:" head-end t) 1695 (setq head-found (or (search-forward "coding:" head-end t)
1693 (search-forward "unibyte:" head-end t))) 1696 (search-forward "unibyte:" head-end t)
1697 (search-forward "enable-character-translation:"
1698 head-end t)))
1694 (if (and head-found (> head-found tail-start)) 1699 (if (and head-found (> head-found tail-start))
1695 ;; Head and tail are overlapped. 1700 ;; Head and tail are overlapped.
1696 (setq tail-found head-found) 1701 (setq tail-found head-found)
1697 (goto-char tail-start) 1702 (goto-char tail-start)
1698 (setq tail-found (or (search-forward "coding:" tail-end t) 1703 (setq tail-found (or (search-forward "coding:" tail-end t)
1699 (search-forward "unibyte:" tail-end t)))) 1704 (search-forward "unibyte:" tail-end t)
1705 (search-forward "enable-character-translation:"
1706 tail-end t))))
1700 1707
1701 ;; At first check the head. 1708 ;; At first check the head.
1702 (when head-found 1709 (when head-found
@@ -1714,12 +1721,16 @@ If nothing is specified, the return value is nil."
1714 (re-search-forward 1721 (re-search-forward
1715 "\\(.*;\\)?[ \t]*coding:[ \t]*\\([^ ;]+\\)" 1722 "\\(.*;\\)?[ \t]*coding:[ \t]*\\([^ ;]+\\)"
1716 head-end t)) 1723 head-end t))
1717 (setq coding-system (intern (match-string 2)))))) 1724 (setq coding-system (intern (match-string 2))))
1725 (when (re-search-forward
1726 "\\(.*;\\)?[ \t]*enable-character-translation:[ \t]*\\([^ ;]+\\)"
1727 head-end t)
1728 (setq char-trans (match-string 2)))))
1718 1729
1719 ;; If no coding: tag in the head, check the tail. 1730 ;; If no coding: tag in the head, check the tail.
1720 ;; Here we must pay attention to the case that the end-of-line 1731 ;; Here we must pay attention to the case that the end-of-line
1721 ;; is just "\r" and we can't use "^" nor "$" in regexp. 1732 ;; is just "\r" and we can't use "^" nor "$" in regexp.
1722 (when (and tail-found (not coding-system)) 1733 (when (and tail-found (or (not coding-system) (not char-trans)))
1723 (goto-char tail-start) 1734 (goto-char tail-start)
1724 (re-search-forward "[\r\n]\^L" nil t) 1735 (re-search-forward "[\r\n]\^L" nil t)
1725 (if (re-search-forward 1736 (if (re-search-forward
@@ -1742,6 +1753,11 @@ If nothing is specified, the return value is nil."
1742 "[\r\n]" prefix 1753 "[\r\n]" prefix
1743 "[ \t]*unibyte[ \t]*:[ \t]*\\([^ \t\r\n]+\\)[ \t]*" 1754 "[ \t]*unibyte[ \t]*:[ \t]*\\([^ \t\r\n]+\\)[ \t]*"
1744 suffix "[\r\n]")) 1755 suffix "[\r\n]"))
1756 (re-char-trans
1757 (concat
1758 "[\r\n]" prefix
1759 "[ \t]*enable-character-translation[ \t]*:[ \t]*\\([^ \t\r\n]+\\)[ \t]*"
1760 suffix "[\r\n]"))
1745 (re-end 1761 (re-end
1746 (concat "[\r\n]" prefix "[ \t]*End *:[ \t]*" suffix 1762 (concat "[\r\n]" prefix "[ \t]*End *:[ \t]*" suffix
1747 "[\r\n]?")) 1763 "[\r\n]?"))
@@ -1755,7 +1771,21 @@ If nothing is specified, the return value is nil."
1755 (setq coding-system 'raw-text)) 1771 (setq coding-system 'raw-text))
1756 (when (and (not coding-system) 1772 (when (and (not coding-system)
1757 (re-search-forward re-coding tail-end t)) 1773 (re-search-forward re-coding tail-end t))
1758 (setq coding-system (intern (match-string 1))))))) 1774 (setq coding-system (intern (match-string 1))))
1775 (when (and (not char-trans)
1776 (re-search-forward re-char-trans tail-end t))
1777 (setq char-trans (match-string 1))))))
1778 (if coding-system
1779 ;; If the coding-system name ends with "!", remove it and
1780 ;; set char-trans to "nil".
1781 (let ((name (symbol-name coding-system)))
1782 (if (= (aref name (1- (length name))) ?!)
1783 (setq coding-system (intern (substring name 0 -1))
1784 char-trans "nil"))))
1785 (when (and char-trans
1786 (not (setq char-trans (intern char-trans))))
1787 (make-local-variable 'enable-character-translation)
1788 (setq enable-character-translation nil))
1759 (if coding-system 1789 (if coding-system
1760 (cons coding-system :coding))) 1790 (cons coding-system :coding)))
1761 ;; Finally, try all the `auto-coding-functions'. 1791 ;; Finally, try all the `auto-coding-functions'.
@@ -1962,7 +1992,8 @@ Part of the job of this function is setting `buffer-undo-list' appropriately."
1962 (or coding 1992 (or coding
1963 (setq coding (car (find-operation-coding-system 1993 (setq coding (car (find-operation-coding-system
1964 'insert-file-contents 1994 'insert-file-contents
1965 filename visit beg end replace)))) 1995 (cons filename (current-buffer))
1996 visit beg end replace))))
1966 (if (coding-system-p coding) 1997 (if (coding-system-p coding)
1967 (or enable-multibyte-characters 1998 (or enable-multibyte-characters
1968 (setq coding 1999 (setq coding
@@ -2246,18 +2277,19 @@ This function is intended to be added to `auto-coding-functions'."
2246 "If the buffer has an HTML meta tag, use it to determine encoding. 2277 "If the buffer has an HTML meta tag, use it to determine encoding.
2247This function is intended to be added to `auto-coding-functions'." 2278This function is intended to be added to `auto-coding-functions'."
2248 (setq size (min (+ (point) size) 2279 (setq size (min (+ (point) size)
2249 ;; Only search forward 10 lines
2250 (save-excursion 2280 (save-excursion
2251 (forward-line 10) 2281 ;; Limit the search by the end of the HTML header.
2282 (or (search-forward "</head>" size t)
2283 ;; In case of no header, search only 10 lines.
2284 (forward-line 10))
2252 (point)))) 2285 (point))))
2253 (when (and (search-forward "<html" size t) 2286 (when (re-search-forward "<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']text/\\sw+;\\s-*charset=\\(.+?\\)[\"']" size t)
2254 (re-search-forward "<meta\\s-+http-equiv=\"content-type\"\\s-+content=\"text/\\sw+;\\s-*charset=\\(.+?\\)\"" size t)) 2287 (let* ((match (match-string 1))
2255 (let* ((match (match-string 1)) 2288 (sym (intern (downcase match))))
2256 (sym (intern (downcase match)))) 2289 (if (coding-system-p sym)
2257 (if (coding-system-p sym) 2290 sym
2258 sym 2291 (message "Warning: unknown coding system \"%s\"" match)
2259 (message "Warning: unknown coding system \"%s\"" match) 2292 nil))))
2260 nil))))
2261 2293
2262;;; 2294;;;
2263(provide 'mule) 2295(provide 'mule)
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 00e9e35ff60..7691482f4e7 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -83,6 +83,7 @@
83 83
84(load "help") 84(load "help")
85 85
86(load "jka-cmpr-hook")
86;; Any Emacs Lisp source file (*.el) loaded here after can contain 87;; Any Emacs Lisp source file (*.el) loaded here after can contain
87;; multilingual text. 88;; multilingual text.
88(load "international/mule-cmds") 89(load "international/mule-cmds")
@@ -201,7 +202,6 @@
201(message "%s" (garbage-collect)) 202(message "%s" (garbage-collect))
202 203
203(load "vc-hooks") 204(load "vc-hooks")
204(load "jka-cmpr-hook")
205(load "ediff-hook") 205(load "ediff-hook")
206(if (fboundp 'x-show-tip) (load "tooltip")) 206(if (fboundp 'x-show-tip) (load "tooltip"))
207 207
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 97ada1942bc..4abbd164fec 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -624,7 +624,7 @@ the variable `rmail-mime-feature'.")
624;;;###autoload 624;;;###autoload
625(defvar rmail-mime-charset-pattern 625(defvar rmail-mime-charset-pattern
626 (concat "^content-type:[ ]*text/plain;" 626 (concat "^content-type:[ ]*text/plain;"
627 "\\(?:[ \t\n]*\\(format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*" 627 "\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*"
628 "[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?") 628 "[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?")
629 "Regexp to match MIME-charset specification in a header of message. 629 "Regexp to match MIME-charset specification in a header of message.
630The first parenthesized expression should match the MIME-charset name.") 630The first parenthesized expression should match the MIME-charset name.")
@@ -1994,7 +1994,7 @@ is non-nil if the user has supplied the password interactively.
1994 (re-search-backward 1994 (re-search-backward
1995 rmail-mime-charset-pattern 1995 rmail-mime-charset-pattern
1996 start t)))) 1996 start t))))
1997 (intern (downcase (match-string 2)))))) 1997 (intern (downcase (match-string 1))))))
1998 (rmail-decode-region start (point) mime-charset))))) 1998 (rmail-decode-region start (point) mime-charset)))))
1999 ;; Add an X-Coding-System: header if we don't have one. 1999 ;; Add an X-Coding-System: header if we don't have one.
2000 (save-excursion 2000 (save-excursion
@@ -2155,7 +2155,7 @@ is non-nil if the user has supplied the password interactively.
2155 (re-search-backward 2155 (re-search-backward
2156 rmail-mime-charset-pattern 2156 rmail-mime-charset-pattern
2157 start t)))) 2157 start t))))
2158 (intern (downcase (match-string 2)))))) 2158 (intern (downcase (match-string 1))))))
2159 (rmail-decode-region start (point) mime-charset))) 2159 (rmail-decode-region start (point) mime-charset)))
2160 (save-excursion 2160 (save-excursion
2161 (goto-char start) 2161 (goto-char start)
diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in
index aea34ed1474..93e9141f4cc 100644
--- a/lisp/makefile.w32-in
+++ b/lisp/makefile.w32-in
@@ -33,7 +33,7 @@ srcdir = $(CURDIR)/..
33# You can specify a different executable on the make command line, 33# You can specify a different executable on the make command line,
34# e.g. "make EMACS=../src/emacs ...". 34# e.g. "make EMACS=../src/emacs ...".
35 35
36EMACS = "$(THISDIR)/../bin/emacs.exe" 36EMACS = $(THISDIR)/../bin/emacs.exe
37 37
38# Command line flags for Emacs. This must include --multibyte, 38# Command line flags for Emacs. This must include --multibyte,
39# otherwise some files will not compile. 39# otherwise some files will not compile.
@@ -64,8 +64,11 @@ COMPILE_FIRST = \
64 $(lisp)/progmodes/cc-vars.el 64 $(lisp)/progmodes/cc-vars.el
65 65
66# The actual Emacs command run in the targets below. 66# The actual Emacs command run in the targets below.
67# The quotes around $(EMACS) are here because the user could type
68# it with forward slashes and without quotes, which will fail if
69# the shell is cmd.exe.
67 70
68emacs = $(EMACS) $(EMACSOPT) 71emacs = "$(EMACS)" $(EMACSOPT)
69 72
70# Common command to find subdirectories 73# Common command to find subdirectories
71 74
@@ -320,7 +323,7 @@ $(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC)
320 $(MAKE) $(MFLAGS) pre-mh-loaddefs.el-$(SHELLTYPE) 323 $(MAKE) $(MFLAGS) pre-mh-loaddefs.el-$(SHELLTYPE)
321 cp pre-mh-loaddefs.el-$(SHELLTYPE) $@ 324 cp pre-mh-loaddefs.el-$(SHELLTYPE) $@
322 rm pre-mh-loaddefs.el-$(SHELLTYPE) 325 rm pre-mh-loaddefs.el-$(SHELLTYPE)
323 $(EMACS) $(EMACSOPT) \ 326 "$(EMACS)" $(EMACSOPT) \
324 -l autoload \ 327 -l autoload \
325 --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \ 328 --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \
326 --eval "(setq find-file-suppress-same-file-warnings t)" \ 329 --eval "(setq find-file-suppress-same-file-warnings t)" \
@@ -381,12 +384,12 @@ pre-mh-loaddefs.el-CMD:
381bootstrap-clean: bootstrap-clean-$(SHELLTYPE) $(lisp)/loaddefs.el 384bootstrap-clean: bootstrap-clean-$(SHELLTYPE) $(lisp)/loaddefs.el
382 385
383bootstrap-clean-CMD: 386bootstrap-clean-CMD:
384# if exist $(EMACS) $(MAKE) $(MFLAGS) autoloads 387# if exist "$(EMACS)" $(MAKE) $(MFLAGS) autoloads
385 cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el 388 cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el
386 -for %%f in (. $(WINS)) do for %%g in (%%f\*.elc) do @$(DEL) %%g 389 -for %%f in (. $(WINS)) do for %%g in (%%f\*.elc) do @$(DEL) %%g
387 390
388bootstrap-clean-SH: 391bootstrap-clean-SH:
389# if test -f $(EMACS); then $(MAKE) $(MFLAGS) autoloads; fi 392# if test -f "$(EMACS)"; then $(MAKE) $(MFLAGS) autoloads; fi
390# -rm -f $(lisp)/*.elc $(lisp)/*/*.elc 393# -rm -f $(lisp)/*.elc $(lisp)/*/*.elc
391 cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el 394 cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el
392 -for dir in . $(WINS); do rm -f $$dir/*.elc; done 395 -for dir in . $(WINS); do rm -f $$dir/*.elc; done
@@ -396,7 +399,7 @@ bootstrap-clean-SH:
396# it will not be mistaken for an installed binary. 399# it will not be mistaken for an installed binary.
397 400
398bootstrap: update-subdirs autoloads mh-autoloads compile finder-data custom-deps 401bootstrap: update-subdirs autoloads mh-autoloads compile finder-data custom-deps
399 - $(DEL) $(EMACS) 402 - $(DEL) "$(EMACS)"
400 403
401# 404#
402# Assuming INSTALL_DIR is defined, copy the elisp files to it 405# Assuming INSTALL_DIR is defined, copy the elisp files to it
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 0ec4339f822..cc1351b9032 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -300,8 +300,7 @@ A large number or nil slows down menu responsiveness."
300 300
301 301
302(define-key menu-bar-search-menu [i-search] 302(define-key menu-bar-search-menu [i-search]
303 (list 'menu-item "Incremental Search" menu-bar-i-search-menu 303 (list 'menu-item "Incremental Search" menu-bar-i-search-menu))
304 :help "Incremental Search finds partial matches while you type the search string.\nIt is most convenient from the keyboard. Try it!"))
305(define-key menu-bar-search-menu [separator-tag-isearch] 304(define-key menu-bar-search-menu [separator-tag-isearch]
306 '(menu-item "--")) 305 '(menu-item "--"))
307 306
@@ -369,8 +368,7 @@ A large number or nil slows down menu responsiveness."
369 368
370;;; Assemble the top-level Edit menu items. 369;;; Assemble the top-level Edit menu items.
371(define-key menu-bar-edit-menu [props] 370(define-key menu-bar-edit-menu [props]
372 '(menu-item "Text Properties" facemenu-menu 371 '(menu-item "Text Properties" facemenu-menu))
373 :help "Change properties of text in region"))
374 372
375(define-key menu-bar-edit-menu [fill] 373(define-key menu-bar-edit-menu [fill]
376 '(menu-item "Fill" fill-region 374 '(menu-item "Fill" fill-region
@@ -382,8 +380,7 @@ A large number or nil slows down menu responsiveness."
382 '(menu-item "--")) 380 '(menu-item "--"))
383 381
384(define-key menu-bar-edit-menu [bookmark] 382(define-key menu-bar-edit-menu [bookmark]
385 '(menu-item "Bookmarks" menu-bar-bookmark-map 383 '(menu-item "Bookmarks" menu-bar-bookmark-map))
386 :help "Record positions and jump between them"))
387 384
388(defvar menu-bar-goto-menu (make-sparse-keymap "Go To")) 385(defvar menu-bar-goto-menu (make-sparse-keymap "Go To"))
389 386
@@ -467,8 +464,7 @@ A large number or nil slows down menu responsiveness."
467(fset 'yank-menu (cons 'keymap yank-menu)) 464(fset 'yank-menu (cons 'keymap yank-menu))
468(define-key menu-bar-edit-menu [select-paste] 465(define-key menu-bar-edit-menu [select-paste]
469 '(menu-item "Select and Paste" yank-menu 466 '(menu-item "Select and Paste" yank-menu
470 :enable (and (cdr yank-menu) (not buffer-read-only)) 467 :enable (and (cdr yank-menu) (not buffer-read-only))))
471 :help "Paste (yank) text cut or copied earlier"))
472(define-key menu-bar-edit-menu [paste] 468(define-key menu-bar-edit-menu [paste]
473 '(menu-item "Paste" yank 469 '(menu-item "Paste" yank
474 :enable (and 470 :enable (and
@@ -641,8 +637,7 @@ by \"Save Options\" in Custom buffers.")
641 637
642;;; Assemble all the top-level items of the "Options" menu 638;;; Assemble all the top-level items of the "Options" menu
643(define-key menu-bar-options-menu [customize] 639(define-key menu-bar-options-menu [customize]
644 (list 'menu-item "Customize Emacs" menu-bar-custom-menu 640 (list 'menu-item "Customize Emacs" menu-bar-custom-menu))
645 :help "Full customization of every Emacs feature"))
646 641
647(defun menu-bar-options-save () 642(defun menu-bar-options-save ()
648 "Save current values of Options menu items using Custom." 643 "Save current values of Options menu items using Custom."
@@ -880,8 +875,7 @@ mail status in mode line"))
880 875
881(define-key menu-bar-showhide-menu [showhide-fringe] 876(define-key menu-bar-showhide-menu [showhide-fringe]
882 (list 'menu-item "Fringe" menu-bar-showhide-fringe-menu 877 (list 'menu-item "Fringe" menu-bar-showhide-fringe-menu
883 :visible `(display-graphic-p) 878 :visible `(display-graphic-p)))
884 :help "Select fringe mode"))
885 879
886(defvar menu-bar-showhide-scroll-bar-menu (make-sparse-keymap "Scroll-bar")) 880(defvar menu-bar-showhide-scroll-bar-menu (make-sparse-keymap "Scroll-bar"))
887 881
@@ -925,8 +919,7 @@ mail status in mode line"))
925 919
926(define-key menu-bar-showhide-menu [showhide-scroll-bar] 920(define-key menu-bar-showhide-menu [showhide-scroll-bar]
927 (list 'menu-item "Scroll-bar" menu-bar-showhide-scroll-bar-menu 921 (list 'menu-item "Scroll-bar" menu-bar-showhide-scroll-bar-menu
928 :visible `(display-graphic-p) 922 :visible `(display-graphic-p)))
929 :help "Select scroll-bar mode"))
930 923
931(define-key menu-bar-showhide-menu [showhide-tooltip-mode] 924(define-key menu-bar-showhide-menu [showhide-tooltip-mode]
932 (list 'menu-item "Tooltips" 'tooltip-mode 925 (list 'menu-item "Tooltips" 'tooltip-mode
@@ -946,8 +939,7 @@ mail status in mode line"))
946 :button `(:toggle . tool-bar-mode))) 939 :button `(:toggle . tool-bar-mode)))
947 940
948(define-key menu-bar-options-menu [showhide] 941(define-key menu-bar-options-menu [showhide]
949 (list 'menu-item "Show/Hide" menu-bar-showhide-menu 942 (list 'menu-item "Show/Hide" menu-bar-showhide-menu))
950 :help "Toggle on/off various display features"))
951 943
952(define-key menu-bar-options-menu [showhide-separator] 944(define-key menu-bar-options-menu [showhide-separator]
953 '("--")) 945 '("--"))
@@ -960,7 +952,7 @@ mail status in mode line"))
960;; Most of the MULE menu actually does make sense in unibyte mode, 952;; Most of the MULE menu actually does make sense in unibyte mode,
961;; e.g. language selection. 953;; e.g. language selection.
962;;; ':visible 'default-enable-multibyte-characters 954;;; ':visible 'default-enable-multibyte-characters
963 ':help "Default language, encodings, input method")) 955 ))
964;(setq menu-bar-final-items (cons 'mule menu-bar-final-items)) 956;(setq menu-bar-final-items (cons 'mule menu-bar-final-items))
965;(define-key menu-bar-options-menu [preferences] 957;(define-key menu-bar-options-menu [preferences]
966; (list 'menu-item "Preferences" menu-bar-preferences-menu 958; (list 'menu-item "Preferences" menu-bar-preferences-menu
@@ -1137,14 +1129,13 @@ mail status in mode line"))
1137 '(menu-item "Programmable Calculator" calc 1129 '(menu-item "Programmable Calculator" calc
1138 :help "Invoke the Emacs built-in full scientific calculator")) 1130 :help "Invoke the Emacs built-in full scientific calculator"))
1139(define-key menu-bar-tools-menu [calendar] 1131(define-key menu-bar-tools-menu [calendar]
1140 '(menu-item "Display Calendar" calendar)) 1132 '(menu-item "Calendar" calendar))
1141 1133
1142(define-key menu-bar-tools-menu [separator-net] 1134(define-key menu-bar-tools-menu [separator-net]
1143 '("--")) 1135 '("--"))
1144 1136
1145(define-key menu-bar-tools-menu [directory-search] 1137(define-key menu-bar-tools-menu [directory-search]
1146 '(menu-item "Directory Search" eudc-tools-menu 1138 '(menu-item "Directory Search" eudc-tools-menu))
1147 :help "Query directory servers via LDAP, CCSO PH/QI or BBDB"))
1148(define-key menu-bar-tools-menu [compose-mail] 1139(define-key menu-bar-tools-menu [compose-mail]
1149 (list 1140 (list
1150 'menu-item `(format "Send Mail (with %s)" (send-mail-item-name)) 1141 'menu-item `(format "Send Mail (with %s)" (send-mail-item-name))
@@ -1172,27 +1163,21 @@ mail status in mode line"))
1172 1163
1173(defvar vc-menu-map (make-sparse-keymap "Version Control")) 1164(defvar vc-menu-map (make-sparse-keymap "Version Control"))
1174(define-key menu-bar-tools-menu [pcl-cvs] 1165(define-key menu-bar-tools-menu [pcl-cvs]
1175 '(menu-item "PCL-CVS" cvs-global-menu 1166 '(menu-item "PCL-CVS" cvs-global-menu))
1176 :help "Module-level interface to CVS"))
1177(define-key menu-bar-tools-menu [vc] 1167(define-key menu-bar-tools-menu [vc]
1178 (list 'menu-item "Version Control" vc-menu-map 1168 (list 'menu-item "Version Control" vc-menu-map))
1179 :help "Interface to RCS, CVS, SCCS"))
1180 1169
1181(define-key menu-bar-tools-menu [separator-compare] 1170(define-key menu-bar-tools-menu [separator-compare]
1182 '("--")) 1171 '("--"))
1183 1172
1184(define-key menu-bar-tools-menu [ediff-misc] 1173(define-key menu-bar-tools-menu [ediff-misc]
1185 '(menu-item "Ediff Miscellanea" menu-bar-ediff-misc-menu 1174 '(menu-item "Ediff Miscellanea" menu-bar-ediff-misc-menu))
1186 :help "Ediff manual, customization, sessions, etc."))
1187(define-key menu-bar-tools-menu [epatch] 1175(define-key menu-bar-tools-menu [epatch]
1188 '(menu-item "Apply Patch" menu-bar-epatch-menu)) 1176 '(menu-item "Apply Patch" menu-bar-epatch-menu))
1189(define-key menu-bar-tools-menu [ediff-merge] 1177(define-key menu-bar-tools-menu [ediff-merge]
1190 '(menu-item "Merge" menu-bar-ediff-merge-menu 1178 '(menu-item "Merge" menu-bar-ediff-merge-menu))
1191 :help "Merge different revisions of files/directories"))
1192(define-key menu-bar-tools-menu [compare] 1179(define-key menu-bar-tools-menu [compare]
1193 '(menu-item "Compare (Ediff)" menu-bar-ediff-menu 1180 '(menu-item "Compare (Ediff)" menu-bar-ediff-menu))
1194 :help "Display differences between files/directories"))
1195
1196 1181
1197(define-key menu-bar-tools-menu [separator-spell] 1182(define-key menu-bar-tools-menu [separator-spell]
1198 '("--")) 1183 '("--"))
@@ -1242,8 +1227,7 @@ mail status in mode line"))
1242 :help "Keyboard layout for specific input method")) 1227 :help "Keyboard layout for specific input method"))
1243(define-key menu-bar-describe-menu [describe-language-environment] 1228(define-key menu-bar-describe-menu [describe-language-environment]
1244 (list 'menu-item "Describe Language Environment" 1229 (list 'menu-item "Describe Language Environment"
1245 describe-language-environment-map 1230 describe-language-environment-map))
1246 :help "Show multilingual settings for a specific language"))
1247 1231
1248(define-key menu-bar-describe-menu [separator-desc-mule] 1232(define-key menu-bar-describe-menu [separator-desc-mule]
1249 '("--")) 1233 '("--"))
@@ -1318,6 +1302,12 @@ key, a click, or a menu-item"))
1318 :help "Find commands whose names match a regexp")) 1302 :help "Find commands whose names match a regexp"))
1319(define-key menu-bar-apropos-menu [sep1] 1303(define-key menu-bar-apropos-menu [sep1]
1320 '("--")) 1304 '("--"))
1305(define-key menu-bar-apropos-menu [emacs-command-node]
1306 '(menu-item "Look Up Command in User Manual..." Info-goto-emacs-command-node
1307 :help "Display manual section that describes a command"))
1308(define-key menu-bar-apropos-menu [emacs-key-command-node]
1309 '(menu-item "Look Up Key in User Manual..." Info-goto-emacs-key-command-node
1310 :help "Display manual section that describes a key"))
1321(define-key menu-bar-apropos-menu [elisp-index-search] 1311(define-key menu-bar-apropos-menu [elisp-index-search]
1322 '(menu-item "Look Up Subject in ELisp Manual..." elisp-index-search 1312 '(menu-item "Look Up Subject in ELisp Manual..." elisp-index-search
1323 :help "Find description of a subject in Emacs Lisp manual")) 1313 :help "Find description of a subject in Emacs Lisp manual"))
@@ -1338,6 +1328,9 @@ key, a click, or a menu-item"))
1338(define-key menu-bar-manuals-menu [order-emacs-manuals] 1328(define-key menu-bar-manuals-menu [order-emacs-manuals]
1339 '(menu-item "Ordering Manuals" view-order-manuals 1329 '(menu-item "Ordering Manuals" view-order-manuals
1340 :help "How to order manuals from the Free Software Foundation")) 1330 :help "How to order manuals from the Free Software Foundation"))
1331(define-key menu-bar-manuals-menu [info-apropos]
1332 '(menu-item "Lookup Subject in all manuals..." info-apropos
1333 :help "Find description of a subject in all installed manuals"))
1341(define-key menu-bar-manuals-menu [info] 1334(define-key menu-bar-manuals-menu [info]
1342 '(menu-item "All Other Manuals (Info)" Info-directory 1335 '(menu-item "All Other Manuals (Info)" Info-directory
1343 :help "Read any of the installed manuals")) 1336 :help "Read any of the installed manuals"))
@@ -1347,14 +1340,6 @@ key, a click, or a menu-item"))
1347(define-key menu-bar-manuals-menu [info-elintro] 1340(define-key menu-bar-manuals-menu [info-elintro]
1348 '(menu-item "Introduction to Emacs Lisp" menu-bar-read-lispintro 1341 '(menu-item "Introduction to Emacs Lisp" menu-bar-read-lispintro
1349 :help "Read the Introduction to Emacs Lisp Programming")) 1342 :help "Read the Introduction to Emacs Lisp Programming"))
1350(define-key menu-bar-manuals-menu [sep3]
1351 '("--"))
1352(define-key menu-bar-manuals-menu [command]
1353 '(menu-item "Find Command in Manual..." Info-goto-emacs-command-node
1354 :help "Display manual section that describes a command"))
1355(define-key menu-bar-manuals-menu [key]
1356 '(menu-item "Find Key in Manual..." Info-goto-emacs-key-command-node
1357 :help "Display manual section that describes a key"))
1358 1343
1359(define-key menu-bar-help-menu [eliza] 1344(define-key menu-bar-help-menu [eliza]
1360 '(menu-item "Emacs Psychotherapist" doctor 1345 '(menu-item "Emacs Psychotherapist" doctor
@@ -1389,17 +1374,14 @@ key, a click, or a menu-item"))
1389 '(menu-item "Find Emacs Packages" finder-by-keyword 1374 '(menu-item "Find Emacs Packages" finder-by-keyword
1390 :help "Find packages and features by keyword")) 1375 :help "Find packages and features by keyword"))
1391(define-key menu-bar-help-menu [manuals] 1376(define-key menu-bar-help-menu [manuals]
1392 (list 'menu-item "More Manuals" menu-bar-manuals-menu 1377 (list 'menu-item "More Manuals" menu-bar-manuals-menu))
1393 :help "Search and browse on-line manuals"))
1394(define-key menu-bar-help-menu [emacs-manual] 1378(define-key menu-bar-help-menu [emacs-manual]
1395 '(menu-item "Read the Emacs Manual" info-emacs-manual 1379 '(menu-item "Read the Emacs Manual" info-emacs-manual
1396 :help "Full documentation of Emacs features")) 1380 :help "Full documentation of Emacs features"))
1397(define-key menu-bar-help-menu [describe] 1381(define-key menu-bar-help-menu [describe]
1398 (list 'menu-item "Describe" menu-bar-describe-menu 1382 (list 'menu-item "Describe" menu-bar-describe-menu))
1399 :help "Describe commands, variables, keys"))
1400(define-key menu-bar-help-menu [apropos] 1383(define-key menu-bar-help-menu [apropos]
1401 (list 'menu-item "Search Documentation" menu-bar-apropos-menu 1384 (list 'menu-item "Search Documentation" menu-bar-apropos-menu))
1402 :help "Look up terms, find commands, options, etc. (Apropos)"))
1403(define-key menu-bar-help-menu [sep1] 1385(define-key menu-bar-help-menu [sep1]
1404 '("--")) 1386 '("--"))
1405(define-key menu-bar-help-menu [report-emacs-bug] 1387(define-key menu-bar-help-menu [report-emacs-bug]
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index 14891204fad..b6f8dd71d9a 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -1524,7 +1524,7 @@ construct the base name."
1524 (with-temp-buffer 1524 (with-temp-buffer
1525 (mh-exec-cmd-output "folder" nil "-fast" "-nocreate" folder) 1525 (mh-exec-cmd-output "folder" nil "-fast" "-nocreate" folder)
1526 (goto-char (point-min)) 1526 (goto-char (point-min))
1527 (not (eobp)))))) 1527 (looking-at (format "+?%s" folder))))))
1528 1528
1529(defun mh-msg-exists-p (msg folder) 1529(defun mh-msg-exists-p (msg folder)
1530 "Check if MSG exists in FOLDER." 1530 "Check if MSG exists in FOLDER."
diff --git a/lisp/msb.el b/lisp/msb.el
index 61ddce5dae0..d5f32486971 100644
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -1007,7 +1007,7 @@ variable `msb-menu-cond'."
1007 (mouse-select-buffer event)) 1007 (mouse-select-buffer event))
1008 ((and (numberp (car choice)) 1008 ((and (numberp (car choice))
1009 (null (cdr choice))) 1009 (null (cdr choice)))
1010 (let ((msb--last-buffer-menu (nthcdr 3 (assq (car choice) 1010 (let ((msb--last-buffer-menu (nthcdr 2 (assq (car choice)
1011 msb--last-buffer-menu)))) 1011 msb--last-buffer-menu))))
1012 (mouse-select-buffer event))) 1012 (mouse-select-buffer event)))
1013 ((while (numberp (car choice)) 1013 ((while (numberp (car choice))
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 101b9cf210d..3f514a2aaab 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -680,6 +680,10 @@ interactively. Turn the filename into a URL with function
680(defun browse-url-file-url (file) 680(defun browse-url-file-url (file)
681 "Return the URL corresponding to FILE. 681 "Return the URL corresponding to FILE.
682Use variable `browse-url-filename-alist' to map filenames to URLs." 682Use variable `browse-url-filename-alist' to map filenames to URLs."
683 (let ((coding (and default-enable-multibyte-characters
684 (or file-name-coding-system
685 default-file-name-coding-system))))
686 (if coding (setq file (encode-coding-string file coding))))
683 ;; URL-encode special chars, do % first 687 ;; URL-encode special chars, do % first
684 (let ((s 0)) 688 (let ((s 0))
685 (while (setq s (string-match "%" file s)) 689 (while (setq s (string-match "%" file s))
diff --git a/lisp/pcvs-info.el b/lisp/pcvs-info.el
index 4aaa5add58d..085f294e6fb 100644
--- a/lisp/pcvs-info.el
+++ b/lisp/pcvs-info.el
@@ -379,7 +379,8 @@ For use by the cookie package."
379 ;; or nothing 379 ;; or nothing
380 ""))) 380 "")))
381 (format "%-11s %s %-11s %-11s %s" 381 (format "%-11s %s %-11s %-11s %s"
382 side status type base file))))))) 382 side status type base file))))
383 "\n")))
383 384
384 385
385(defun cvs-fileinfo-update (fi fi-new) 386(defun cvs-fileinfo-update (fi fi-new)
diff --git a/lisp/pcvs.el b/lisp/pcvs.el
index b9d04522181..5e322b9276a 100644
--- a/lisp/pcvs.el
+++ b/lisp/pcvs.el
@@ -467,7 +467,7 @@ If non-nil, NEW means to create a new buffer no matter what."
467 (cvs-mode) 467 (cvs-mode)
468 (set (make-local-variable 'list-buffers-directory) buffer-name) 468 (set (make-local-variable 'list-buffers-directory) buffer-name)
469 ;;(set (make-local-variable 'cvs-temp-buffer) (cvs-temp-buffer)) 469 ;;(set (make-local-variable 'cvs-temp-buffer) (cvs-temp-buffer))
470 (let ((cookies (ewoc-create 'cvs-fileinfo-pp "\n" ""))) 470 (let ((cookies (ewoc-create 'cvs-fileinfo-pp "\n\n" "\n" t)))
471 (set (make-local-variable 'cvs-cookies) cookies) 471 (set (make-local-variable 'cvs-cookies) cookies)
472 (add-hook 'kill-buffer-hook 472 (add-hook 'kill-buffer-hook
473 (lambda () 473 (lambda ()
@@ -618,7 +618,7 @@ If non-nil, NEW means to create a new buffer no matter what."
618 (str (car hf)) 618 (str (car hf))
619 (done "") 619 (done "")
620 (tin (ewoc-nth cvs-cookies 0))) 620 (tin (ewoc-nth cvs-cookies 0)))
621 (if (eq (length str) 1) (setq str "")) 621 (if (eq (length str) 2) (setq str ""))
622 ;; look for the first *real* fileinfo (to determine emptyness) 622 ;; look for the first *real* fileinfo (to determine emptyness)
623 (while 623 (while
624 (and tin 624 (and tin
@@ -633,6 +633,7 @@ If non-nil, NEW means to create a new buffer no matter what."
633 (setq str (replace-match "" t t str)) 633 (setq str (replace-match "" t t str))
634 (if (zerop (length str)) (setq str "\n")) 634 (if (zerop (length str)) (setq str "\n"))
635 (setq done (concat "-- last cmd: " cmd " --")))) 635 (setq done (concat "-- last cmd: " cmd " --"))))
636 (setq str (concat str "\n") done (concat done "\n"))
636 ;; set the new header and footer 637 ;; set the new header and footer
637 (ewoc-set-hf cvs-cookies 638 (ewoc-set-hf cvs-cookies
638 str (concat "\n--------------------- " 639 str (concat "\n--------------------- "
diff --git a/lisp/pgg-pgp.el b/lisp/pgg-pgp.el
index f58fd0d3c6d..e53a0c2c867 100644
--- a/lisp/pgg-pgp.el
+++ b/lisp/pgg-pgp.el
@@ -136,21 +136,21 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
136 "Encrypt the current region between START and END." 136 "Encrypt the current region between START and END."
137 (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) 137 (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
138 (passphrase (or passphrase 138 (passphrase (or passphrase
139 (when sign 139 (when sign
140 (pgg-read-passphrase 140 (pgg-read-passphrase
141 (format "PGP passphrase for %s: " 141 (format "PGP passphrase for %s: "
142 pgg-pgp-user-id) 142 pgg-pgp-user-id)
143 pgg-pgp-user-id)))) 143 pgg-pgp-user-id))))
144 (args 144 (args
145 (append 145 (append
146 `("+encrypttoself=off +verbose=1" "+batchmode" 146 `("+encrypttoself=off +verbose=1" "+batchmode"
147 "+language=us" "-fate" 147 "+language=us" "-fate"
148 ,@(if recipients 148 ,@(if recipients
149 (mapcar (lambda (rcpt) (concat "\"" rcpt "\"")) 149 (mapcar (lambda (rcpt) (concat "\"" rcpt "\""))
150 (append recipients 150 (append recipients
151 (if pgg-encrypt-for-me 151 (if pgg-encrypt-for-me
152 (list pgg-pgp-user-id)))))) 152 (list pgg-pgp-user-id))))))
153 (if sign '("-s" "-u" pgg-pgp-user-id))))) 153 (if sign '("-s" "-u" pgg-pgp-user-id)))))
154 (pgg-pgp-process-region start end nil pgg-pgp-program args) 154 (pgg-pgp-process-region start end nil pgg-pgp-program args)
155 (pgg-process-when-success nil))) 155 (pgg-process-when-success nil)))
156 156
@@ -162,11 +162,11 @@ passphrase cache or user."
162 (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) 162 (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
163 (key (pgg-pgp-lookup-key pgg-pgp-user-id 'encrypt)) 163 (key (pgg-pgp-lookup-key pgg-pgp-user-id 'encrypt))
164 (passphrase 164 (passphrase
165 (or passphrase 165 (or passphrase
166 (pgg-read-passphrase 166 (pgg-read-passphrase
167 (format "PGP passphrase for %s: " pgg-pgp-user-id) key))) 167 (format "PGP passphrase for %s: " pgg-pgp-user-id) key)))
168 (args 168 (args
169 '("+verbose=1" "+batchmode" "+language=us" "-f"))) 169 '("+verbose=1" "+batchmode" "+language=us" "-f")))
170 (pgg-pgp-process-region start end passphrase pgg-pgp-program args) 170 (pgg-pgp-process-region start end passphrase pgg-pgp-program args)
171 (pgg-process-when-success 171 (pgg-process-when-success
172 (if pgg-cache-passphrase 172 (if pgg-cache-passphrase
@@ -179,10 +179,10 @@ If optional PASSPHRASE is not specified, it will be obtained from the
179passphrase cache or user." 179passphrase cache or user."
180 (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) 180 (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
181 (passphrase 181 (passphrase
182 (or passphrase 182 (or passphrase
183 (pgg-read-passphrase 183 (pgg-read-passphrase
184 (format "PGP passphrase for %s: " pgg-pgp-user-id) 184 (format "PGP passphrase for %s: " pgg-pgp-user-id)
185 (pgg-pgp-lookup-key pgg-pgp-user-id 'sign)))) 185 (pgg-pgp-lookup-key pgg-pgp-user-id 'sign))))
186 (args 186 (args
187 (list (if clearsign "-fast" "-fbast") 187 (list (if clearsign "-fast" "-fbast")
188 "+verbose=1" "+language=us" "+batchmode" 188 "+verbose=1" "+language=us" "+batchmode"
diff --git a/lisp/pgg-pgp5.el b/lisp/pgg-pgp5.el
index 3cba59916e5..75c96e59909 100644
--- a/lisp/pgg-pgp5.el
+++ b/lisp/pgg-pgp5.el
@@ -147,23 +147,23 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
147 "Encrypt the current region between START and END." 147 "Encrypt the current region between START and END."
148 (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id)) 148 (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
149 (passphrase (or passphrase 149 (passphrase (or passphrase
150 (when sign 150 (when sign
151 (pgg-read-passphrase 151 (pgg-read-passphrase
152 (format "PGP passphrase for %s: " 152 (format "PGP passphrase for %s: "
153 pgg-pgp5-user-id) 153 pgg-pgp5-user-id)
154 pgg-pgp5-user-id)))) 154 pgg-pgp5-user-id))))
155 (args 155 (args
156 (append 156 (append
157 `("+NoBatchInvalidKeys=off" "-fat" "+batchmode=1" 157 `("+NoBatchInvalidKeys=off" "-fat" "+batchmode=1"
158 ,@(if recipients 158 ,@(if recipients
159 (apply #'append 159 (apply #'append
160 (mapcar (lambda (rcpt) 160 (mapcar (lambda (rcpt)
161 (list "-r" 161 (list "-r"
162 (concat "\"" rcpt "\""))) 162 (concat "\"" rcpt "\"")))
163 (append recipients 163 (append recipients
164 (if pgg-encrypt-for-me 164 (if pgg-encrypt-for-me
165 (list pgg-pgp5-user-id))))))) 165 (list pgg-pgp5-user-id)))))))
166 (if sign '("-s" "-u" pgg-pgp5-user-id))))) 166 (if sign '("-s" "-u" pgg-pgp5-user-id)))))
167 (pgg-pgp5-process-region start end nil pgg-pgp5-pgpe-program args) 167 (pgg-pgp5-process-region start end nil pgg-pgp5-pgpe-program args)
168 (pgg-process-when-success nil))) 168 (pgg-process-when-success nil)))
169 169
@@ -171,10 +171,10 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
171 "Decrypt the current region between START and END." 171 "Decrypt the current region between START and END."
172 (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id)) 172 (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
173 (passphrase 173 (passphrase
174 (or passphrase 174 (or passphrase
175 (pgg-read-passphrase 175 (pgg-read-passphrase
176 (format "PGP passphrase for %s: " pgg-pgp5-user-id) 176 (format "PGP passphrase for %s: " pgg-pgp5-user-id)
177 (pgg-pgp5-lookup-key pgg-pgp5-user-id 'encrypt)))) 177 (pgg-pgp5-lookup-key pgg-pgp5-user-id 'encrypt))))
178 (args 178 (args
179 '("+verbose=1" "+batchmode=1" "+language=us" "-f"))) 179 '("+verbose=1" "+batchmode=1" "+language=us" "-f")))
180 (pgg-pgp5-process-region start end passphrase pgg-pgp5-pgpv-program args) 180 (pgg-pgp5-process-region start end passphrase pgg-pgp5-pgpv-program args)
@@ -184,10 +184,10 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
184 "Make detached signature from text between START and END." 184 "Make detached signature from text between START and END."
185 (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id)) 185 (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
186 (passphrase 186 (passphrase
187 (or passphrase 187 (or passphrase
188 (pgg-read-passphrase 188 (pgg-read-passphrase
189 (format "PGP passphrase for %s: " pgg-pgp5-user-id) 189 (format "PGP passphrase for %s: " pgg-pgp5-user-id)
190 (pgg-pgp5-lookup-key pgg-pgp5-user-id 'sign)))) 190 (pgg-pgp5-lookup-key pgg-pgp5-user-id 'sign))))
191 (args 191 (args
192 (list (if clearsign "-fat" "-fbat") 192 (list (if clearsign "-fat" "-fbat")
193 "+verbose=1" "+language=us" "+batchmode=1" 193 "+verbose=1" "+language=us" "+batchmode=1"
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index 6f623623535..c2b9b435e4c 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -264,7 +264,7 @@ element of the list is added with `add-hook'.
264Do not change this variable directly. Use the function `c-add-style' 264Do not change this variable directly. Use the function `c-add-style'
265to add new styles or modify existing styles (it is not a good idea to 265to add new styles or modify existing styles (it is not a good idea to
266modify existing styles -- you should create a new style that inherits 266modify existing styles -- you should create a new style that inherits
267the existing style.") 267the existing style).")
268 268
269 269
270;; Functions that manipulate styles 270;; Functions that manipulate styles
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index 64e38be62d0..0e6738710c5 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -812,6 +812,7 @@ macro exceeds this column then the next tab stop from that line is
812used as alignment column instead." 812used as alignment column instead."
813 :type 'integer 813 :type 'integer
814 :group 'c) 814 :group 'c)
815;;;###autoload(put 'c-backslash-column 'safe-local-variable 'integerp)
815 816
816(defcustom-c-stylevar c-backslash-max-column 72 817(defcustom-c-stylevar c-backslash-max-column 72
817 "*Maximum alignment column for line continuation backslashes. 818 "*Maximum alignment column for line continuation backslashes.
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 527624bfc4e..5da86972ec5 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -228,7 +228,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
228\\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\ 228\\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\
229\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\ 229\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\
230\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\ 230\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
231 *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\)\\)?" 231 *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|instantiated from\\)\\)?"
232 1 (2 . 5) (4 . 6) (7 . 8)) 232 1 (2 . 5) (4 . 6) (7 . 8))
233 233
234 (lcc 234 (lcc
@@ -236,7 +236,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
236 2 3 4 (1)) 236 2 3 4 (1))
237 237
238 (makepp 238 (makepp
239 "^makepp: \\(?:\\(?:warning\\(:\\).*?\\|\\(Scanning\\|[LR]e?l?oading makefile\\) \\|.*?\\)\ 239 "^makepp: \\(?:\\(?:warning\\(:\\).*?\\|\\(Scanning\\|[LR]e?l?oading makefile\\|Imported\\) \\|.*?\\)\
240`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]\\)" 240`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]\\)"
241 4 5 nil (1 . 2) 3 241 4 5 nil (1 . 2) 3
242 ("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]" nil nil 242 ("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]" nil nil
@@ -293,15 +293,34 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
293\\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3)) 293\\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3))
294 294
295 (gcov-file 295 (gcov-file
296 "^ +-: \\(0\\):Source:\\(.+\\)$" 2 1 nil 0) 296 "^ *-: *\\(0\\):Source:\\(.+\\)$"
297 (gcov-bb-file 297 2 1 nil 0 nil
298 "^ +-: \\(0\\):Object:\\(?:.+\\)$" nil 1 nil 0) 298 (1 compilation-line-face prepend) (2 compilation-info-face prepend))
299 (gcov-never-called-line 299 (gcov-header
300 "^ +\\(#####\\): +\\([0-9]+\\):.+$" nil 2 nil 2 nil 300 "^ *-: *\\(0\\):\\(?:Object\\|Graph\\|Data\\|Runs\\|Programs\\):.+$"
301 (1 compilation-error-face)) 301 nil 1 nil 0 nil
302 (1 compilation-line-face prepend))
303 ;; Underlines over all lines of gcov output are too uncomfortable to read.
304 ;; However, hyperlinks embedded in the lines are useful.
305 ;; So I put default face on the lines; and then put
306 ;; compilation-*-face by manually to eliminate the underlines.
307 ;; The hyperlinks are still effective.
308 (gcov-nomark
309 "^ *-: *\\([1-9]\\|[0-9]\\{2,\\}\\):.*$"
310 nil 1 nil 0 nil
311 (0 'default t)
312 (1 compilation-line-face prepend))
302 (gcov-called-line 313 (gcov-called-line
303 "^ +[-0-9]+: +\\([1-9]\\|[0-9]\\{2,\\}\\):.*$" nil 1 nil 0) 314 "^ *\\([0-9]+\\): *\\([0-9]+\\):.*$"
304) 315 nil 2 nil 0 nil
316 (0 'default t)
317 (1 compilation-info-face prepend) (2 compilation-line-face prepend))
318 (gcov-never-called
319 "^ *\\(#####\\): *\\([0-9]+\\):.*$"
320 nil 2 nil 2 nil
321 (0 'default t)
322 (1 compilation-error-face prepend) (2 compilation-line-face prepend))
323 )
305 "Alist of values for `compilation-error-regexp-alist'.") 324 "Alist of values for `compilation-error-regexp-alist'.")
306 325
307(defcustom compilation-error-regexp-alist 326(defcustom compilation-error-regexp-alist
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el
index f5d08d533fd..0f92523e306 100644
--- a/lisp/progmodes/gdb-ui.el
+++ b/lisp/progmodes/gdb-ui.el
@@ -71,11 +71,11 @@
71;;; Known Bugs: 71;;; Known Bugs:
72 72
73;; 1) Strings that are watched don't update in the speedbar when their 73;; 1) Strings that are watched don't update in the speedbar when their
74;; contents change unless the first character changes. 74;; contents change unless the first character changes.
75;; 2) Cannot handle multiple debug sessions. 75;; 2) Cannot handle multiple debug sessions.
76;; 3) Initially, the assembler buffer does not display the cursor at the 76;; 3) M-x gdb doesn't work with "run" command in .gdbinit, use M-x gdba instead.
77;; current line if the line is not visible in the window (but when testing 77;; 4) M-x gdb doesn't work if the corefile is specified in the command in the
78;; gdb-assembler-custom with a lisp debugger it does!). 78;; minibuffer, use M-x gdba instead (or specify the core in the GUD buffer).
79 79
80;;; Problems with watch expressions, GDB/MI: 80;;; Problems with watch expressions, GDB/MI:
81;; 1) They go out of scope when the inferior is re-run. 81;; 1) They go out of scope when the inferior is re-run.
@@ -83,15 +83,10 @@
83;; 3) VARNUM increments even when variable object is not created 83;; 3) VARNUM increments even when variable object is not created
84;; (maybe trivial). 84;; (maybe trivial).
85 85
86;; Known Bugs:
87;; 1) M-x gdb doesn't work with "run" command in .gdbinit, use M-x gdba instead.
88
89;;; TODO: 86;;; TODO:
90;; 1) Use MI command -data-read-memory for memory window. 87;; 1) Use MI command -data-read-memory for memory window.
91;; 2) Use tree-widget.el instead of the speedbar for watch-expressions? 88;; 2) Use tree-widget.el instead of the speedbar for watch-expressions?
92;; 3) Mark breakpoint locations on scroll-bar of source buffer? 89;; 3) Mark breakpoint locations on scroll-bar of source buffer?
93;; 4) With gud-print and gud-pstar, print the variable name in the GUD
94;; buffer instead of the value's history number.
95 90
96;;; Code: 91;;; Code:
97 92
@@ -130,6 +125,7 @@ and #define directives otherwise.")
130(defvar gdb-source-window nil) 125(defvar gdb-source-window nil)
131(defvar gdb-inferior-status nil) 126(defvar gdb-inferior-status nil)
132(defvar gdb-continuation nil) 127(defvar gdb-continuation nil)
128(defvar gdb-look-up-stack nil)
133 129
134(defvar gdb-buffer-type nil 130(defvar gdb-buffer-type nil
135 "One of the symbols bound in `gdb-buffer-rules'.") 131 "One of the symbols bound in `gdb-buffer-rules'.")
@@ -493,26 +489,28 @@ With arg, use separate IO iff arg is positive."
493 'gdb-mouse-set-clear-breakpoint) 489 'gdb-mouse-set-clear-breakpoint)
494 (define-key gud-minor-mode-map [left-fringe mouse-1] 490 (define-key gud-minor-mode-map [left-fringe mouse-1]
495 'gdb-mouse-set-clear-breakpoint) 491 'gdb-mouse-set-clear-breakpoint)
496 (define-key gud-minor-mode-map [left-fringe mouse-2] 492 (define-key gud-minor-mode-map [left-margin C-mouse-1]
497 'gdb-mouse-until) 493 'gdb-mouse-toggle-breakpoint-margin)
494 (define-key gud-minor-mode-map [left-fringe C-mouse-1]
495 'gdb-mouse-toggle-breakpoint-fringe)
496
498 (define-key gud-minor-mode-map [left-margin drag-mouse-1] 497 (define-key gud-minor-mode-map [left-margin drag-mouse-1]
499 'gdb-mouse-until) 498 'gdb-mouse-until)
500 (define-key gud-minor-mode-map [left-fringe drag-mouse-1] 499 (define-key gud-minor-mode-map [left-fringe drag-mouse-1]
501 'gdb-mouse-until) 500 'gdb-mouse-until)
502 (define-key gud-minor-mode-map [left-margin mouse-2] 501 (define-key gud-minor-mode-map [left-margin mouse-3]
502 'gdb-mouse-until)
503 (define-key gud-minor-mode-map [left-fringe mouse-3]
503 'gdb-mouse-until) 504 'gdb-mouse-until)
505
504 (define-key gud-minor-mode-map [left-margin C-drag-mouse-1] 506 (define-key gud-minor-mode-map [left-margin C-drag-mouse-1]
505 'gdb-mouse-jump) 507 'gdb-mouse-jump)
506 (define-key gud-minor-mode-map [left-fringe C-drag-mouse-1] 508 (define-key gud-minor-mode-map [left-fringe C-drag-mouse-1]
507 'gdb-mouse-jump) 509 'gdb-mouse-jump)
508 (define-key gud-minor-mode-map [left-fringe C-mouse-2] 510 (define-key gud-minor-mode-map [left-fringe C-mouse-3]
509 'gdb-mouse-jump) 511 'gdb-mouse-jump)
510 (define-key gud-minor-mode-map [left-margin C-mouse-2] 512 (define-key gud-minor-mode-map [left-margin C-mouse-3]
511 'gdb-mouse-jump) 513 'gdb-mouse-jump)
512 (define-key gud-minor-mode-map [left-margin mouse-3]
513 'gdb-mouse-toggle-breakpoint-margin)
514 (define-key gud-minor-mode-map [left-fringe mouse-3]
515 'gdb-mouse-toggle-breakpoint-fringe)
516 514
517 (setq comint-input-sender 'gdb-send) 515 (setq comint-input-sender 'gdb-send)
518 516
@@ -543,7 +541,8 @@ With arg, use separate IO iff arg is positive."
543 gdb-signalled nil 541 gdb-signalled nil
544 gdb-source-window nil 542 gdb-source-window nil
545 gdb-inferior-status nil 543 gdb-inferior-status nil
546 gdb-continuation nil) 544 gdb-continuation nil
545 gdb-look-up-stack nil)
547 546
548 (setq gdb-buffer-type 'gdba) 547 (setq gdb-buffer-type 'gdba)
549 548
@@ -738,7 +737,7 @@ With arg, enter name of variable to be watched in the minibuffer."
738 `(lambda () (gdb-var-evaluate-expression-handler 737 `(lambda () (gdb-var-evaluate-expression-handler
739 ,(car var) nil))))) 738 ,(car var) nil)))))
740 (if (search-forward "Undefined command" nil t) 739 (if (search-forward "Undefined command" nil t)
741 (message-box "Watching expressions requires gdb 6.0 onwards") 740 (message-box "Watching expressions requires GDB 6.0 onwards")
742 (message-box "No symbol \"%s\" in current context." expr)))) 741 (message-box "No symbol \"%s\" in current context." expr))))
743 742
744(defun gdb-speedbar-update () 743(defun gdb-speedbar-update ()
@@ -1106,7 +1105,8 @@ This filter may simply queue input for a later time."
1106 (let ((item (concat string "\n"))) 1105 (let ((item (concat string "\n")))
1107 (if gdb-enable-debug (push (cons 'send item) gdb-debug-ring)) 1106 (if gdb-enable-debug (push (cons 'send item) gdb-debug-ring))
1108 (process-send-string proc item))) 1107 (process-send-string proc item)))
1109 (if (string-match "\\\\$" string) 1108 (if (and (string-match "\\\\$" string)
1109 (not comint-input-sender-no-newline)) ;;Try to catch C-d.
1110 (setq gdb-continuation (concat gdb-continuation string "\n")) 1110 (setq gdb-continuation (concat gdb-continuation string "\n"))
1111 (let ((item (concat gdb-continuation string "\n"))) 1111 (let ((item (concat gdb-continuation string "\n")))
1112 (gdb-enqueue-input item) 1112 (gdb-enqueue-input item)
@@ -1334,9 +1334,20 @@ directives."
1334It is just like `gdb-stopping', except that if we already set the output 1334It is just like `gdb-stopping', except that if we already set the output
1335sink to `user' in `gdb-stopping', that is fine." 1335sink to `user' in `gdb-stopping', that is fine."
1336 (setq gud-running nil) 1336 (setq gud-running nil)
1337 (unless (or gud-overlay-arrow-position gud-last-frame 1337 (unless (or gud-overlay-arrow-position gud-last-frame)
1338 (not gud-last-last-frame)) 1338 ;;Pop up GUD buffer to display current frame when it doesn't have source
1339 (gud-display-line (car gud-last-last-frame) (cdr gud-last-last-frame))) 1339 ;;information i.e id not compiled with -g as with libc routines generally.
1340 (let ((special-display-regexps (append special-display-regexps '(".*")))
1341 (special-display-frame-alist gdb-frame-parameters)
1342 (same-window-regexps nil))
1343 (display-buffer gud-comint-buffer))
1344 ;;Try to find source further up stack e.g after signal.
1345 (setq gdb-look-up-stack
1346 (if (gdb-get-buffer 'gdb-stack-buffer) 'keep
1347 (progn
1348 (gdb-get-buffer-create 'gdb-stack-buffer)
1349 (gdb-invalidate-frames)
1350 'delete))))
1340 (unless (member gdb-inferior-status '("exited" "signal")) 1351 (unless (member gdb-inferior-status '("exited" "signal"))
1341 (setq gdb-inferior-status "stopped") 1352 (setq gdb-inferior-status "stopped")
1342 (gdb-force-mode-line-update gdb-inferior-status)) 1353 (gdb-force-mode-line-update gdb-inferior-status))
@@ -1945,36 +1956,57 @@ static char *magick[] = {
1945(defun gdb-info-stack-custom () 1956(defun gdb-info-stack-custom ()
1946 (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer) 1957 (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
1947 (save-excursion 1958 (save-excursion
1948 (let ((buffer-read-only nil) 1959 (unless (eq gdb-look-up-stack 'delete)
1949 bl el) 1960 (let ((buffer-read-only nil)
1950 (goto-char (point-min)) 1961 bl el)
1951 (while (< (point) (point-max)) 1962 (goto-char (point-min))
1952 (setq bl (line-beginning-position) 1963 (while (< (point) (point-max))
1953 el (line-end-position)) 1964 (setq bl (line-beginning-position)
1954 (when (looking-at "#") 1965 el (line-end-position))
1955 (add-text-properties bl el 1966 (when (looking-at "#")
1956 '(mouse-face highlight 1967 (add-text-properties bl el
1957 help-echo "mouse-2, RET: Select frame"))) 1968 '(mouse-face highlight
1958 (goto-char bl) 1969 help-echo "mouse-2, RET: Select frame")))
1959 (when (looking-at "^#\\([0-9]+\\)") 1970 (goto-char bl)
1960 (when (string-equal (match-string 1) gdb-frame-number) 1971 (when (looking-at "^#\\([0-9]+\\)")
1972 (when (string-equal (match-string 1) gdb-frame-number)
1961 (put-text-property bl (+ bl 4) 1973 (put-text-property bl (+ bl 4)
1962 'face '(:inverse-video t))) 1974 'face '(:inverse-video t)))
1963 (when (re-search-forward 1975 (when (re-search-forward
1964 (concat 1976 (concat
1965 (if (string-equal (match-string 1) "0") "" " in ") 1977 (if (string-equal (match-string 1) "0") "" " in ")
1966 "\\([^ ]+\\) (") el t) 1978 "\\([^ ]+\\) (") el t)
1967 (put-text-property (match-beginning 1) (match-end 1)
1968 'face font-lock-function-name-face)
1969 (setq bl (match-end 0))
1970 (while (re-search-forward "<\\([^>]+\\)>" el t)
1971 (put-text-property (match-beginning 1) (match-end 1) 1979 (put-text-property (match-beginning 1) (match-end 1)
1980 'face font-lock-function-name-face)
1981 (setq bl (match-end 0))
1982 (while (re-search-forward "<\\([^>]+\\)>" el t)
1983 (put-text-property (match-beginning 1) (match-end 1)
1972 'face font-lock-function-name-face)) 1984 'face font-lock-function-name-face))
1973 (goto-char bl) 1985 (goto-char bl)
1974 (while (re-search-forward "\\(\\(\\sw\\|[_.]\\)+\\)=" el t) 1986 (while (re-search-forward "\\(\\(\\sw\\|[_.]\\)+\\)=" el t)
1975 (put-text-property (match-beginning 1) (match-end 1) 1987 (put-text-property (match-beginning 1) (match-end 1)
1976 'face font-lock-variable-name-face)))) 1988 'face font-lock-variable-name-face))))
1977 (forward-line 1)))))) 1989 (forward-line 1))))
1990 (when gdb-look-up-stack
1991 (goto-char (point-min))
1992 (when (re-search-forward "\\(\\S-+?\\):\\([0-9]+\\)" nil t)
1993 (let ((start (line-beginning-position))
1994 (file (match-string 1))
1995 (line (match-string 2)))
1996 (re-search-backward "^#*\\([0-9]+\\)" start t)
1997 (gdb-enqueue-input
1998 (list (concat gdb-server-prefix "frame "
1999 (match-string 1) "\n") 'gdb-set-hollow))
2000 (gdb-enqueue-input
2001 (list (concat gdb-server-prefix "frame 0\n") 'ignore)))))))
2002 (if (eq gdb-look-up-stack 'delete)
2003 (kill-buffer (gdb-get-buffer 'gdb-stack-buffer)))
2004 (setq gdb-look-up-stack nil))
2005
2006(defun gdb-set-hollow ()
2007 (with-current-buffer (gud-find-file (car gud-last-last-frame))
2008 (setq fringe-indicator-alist
2009 '((overlay-arrow . hollow-right-triangle)))))
1978 2010
1979(defun gdb-stack-buffer-name () 2011(defun gdb-stack-buffer-name ()
1980 (with-current-buffer gud-comint-buffer 2012 (with-current-buffer gud-comint-buffer
@@ -2030,8 +2062,7 @@ static char *magick[] = {
2030 (if event (posn-set-point (event-end event))) 2062 (if event (posn-set-point (event-end event)))
2031 (gdb-enqueue-input 2063 (gdb-enqueue-input
2032 (list (concat gdb-server-prefix "frame " 2064 (list (concat gdb-server-prefix "frame "
2033 (gdb-get-frame-number) "\n") 'ignore)) 2065 (gdb-get-frame-number) "\n") 'ignore)))
2034 (gud-display-frame))
2035 2066
2036 2067
2037;; Threads buffer. This displays a selectable thread list. 2068;; Threads buffer. This displays a selectable thread list.
@@ -2049,13 +2080,14 @@ static char *magick[] = {
2049(defun gdb-info-threads-custom () 2080(defun gdb-info-threads-custom ()
2050 (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer) 2081 (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer)
2051 (let ((buffer-read-only nil)) 2082 (let ((buffer-read-only nil))
2052 (goto-char (point-min)) 2083 (save-excursion
2053 (while (< (point) (point-max)) 2084 (goto-char (point-min))
2054 (unless (looking-at "No ") 2085 (while (< (point) (point-max))
2055 (add-text-properties (line-beginning-position) (line-end-position) 2086 (unless (looking-at "No ")
2056 '(mouse-face highlight 2087 (add-text-properties (line-beginning-position) (line-end-position)
2088 '(mouse-face highlight
2057 help-echo "mouse-2, RET: select thread"))) 2089 help-echo "mouse-2, RET: select thread")))
2058 (forward-line 1))))) 2090 (forward-line 1))))))
2059 2091
2060(defun gdb-threads-buffer-name () 2092(defun gdb-threads-buffer-name ()
2061 (with-current-buffer gud-comint-buffer 2093 (with-current-buffer gud-comint-buffer
@@ -2868,7 +2900,11 @@ of the current session."
2868 gud-comint-buffer 2900 gud-comint-buffer
2869 (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 2901 (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
2870 '(gdba gdbmi))) 2902 '(gdba gdbmi)))
2871 (if (member buffer-file-name gdb-source-file-list) 2903 ;;Pre GDB 6.3 "info sources" doesn't give absolute file name.
2904 (if (member (if (string-equal gdb-version "pre-6.4")
2905 (file-name-nondirectory buffer-file-name)
2906 buffer-file-name)
2907 gdb-source-file-list)
2872 (with-current-buffer (find-buffer-visiting buffer-file-name) 2908 (with-current-buffer (find-buffer-visiting buffer-file-name)
2873 (set (make-local-variable 'gud-minor-mode) 2909 (set (make-local-variable 'gud-minor-mode)
2874 (buffer-local-value 'gud-minor-mode gud-comint-buffer)) 2910 (buffer-local-value 'gud-minor-mode gud-comint-buffer))
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 410a973d1b4..d207094cafe 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -553,7 +553,7 @@ easily repeat a find command."
553 (read-string 553 (read-string
554 "compile.el: No `grep-find-command' command available. Press RET.") 554 "compile.el: No `grep-find-command' command available. Press RET.")
555 (list nil)))) 555 (list nil))))
556 (when (and grep-find-command command-args) 556 (when command-args
557 (let ((null-device nil)) ; see grep 557 (let ((null-device nil)) ; see grep
558 (grep command-args)))) 558 (grep command-args))))
559 559
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index d2e6cfc4ae4..1ce5d404a80 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -101,8 +101,8 @@ If SOFT is non-nil, returns nil if the symbol doesn't already exist."
101 (if (boundp sym) (symbol-value sym)))) 101 (if (boundp sym) (symbol-value sym))))
102 102
103(defvar gud-running nil 103(defvar gud-running nil
104 "Non-nil if debuggee is running. 104 "Non-nil if debugged program is running.
105Used to grey out relevant togolbar icons.") 105Used to grey out relevant toolbar icons.")
106 106
107;; Use existing Info buffer, if possible. 107;; Use existing Info buffer, if possible.
108(defun gud-goto-info () 108(defun gud-goto-info ()
@@ -130,10 +130,10 @@ Used to grey out relevant togolbar icons.")
130 130
131(defun gud-stop-subjob () 131(defun gud-stop-subjob ()
132 (interactive) 132 (interactive)
133 (if (string-equal 133 (with-current-buffer gud-comint-buffer
134 (buffer-local-value 'gud-target-name gud-comint-buffer) "emacs") 134 (if (string-equal gud-target-name "emacs")
135 (comint-stop-subjob) 135 (comint-stop-subjob)
136 (comint-interrupt-subjob))) 136 (comint-interrupt-subjob))))
137 137
138(easy-mmode-defmap gud-menu-map 138(easy-mmode-defmap gud-menu-map
139 '(([help] "Info" . gud-goto-info) 139 '(([help] "Info" . gud-goto-info)
@@ -141,13 +141,15 @@ Used to grey out relevant togolbar icons.")
141 :enable (and (not emacs-basic-display) 141 :enable (and (not emacs-basic-display)
142 (display-graphic-p) 142 (display-graphic-p)
143 (fboundp 'x-show-tip)) 143 (fboundp 'x-show-tip))
144 :visible (memq gud-minor-mode
145 '(gdbmi gdba dbx sdb xdb pdb))
144 :button (:toggle . gud-tooltip-mode)) 146 :button (:toggle . gud-tooltip-mode))
145 ([refresh] "Refresh" . gud-refresh) 147 ([refresh] "Refresh" . gud-refresh)
146 ([run] menu-item "Run" gud-run 148 ([run] menu-item "Run" gud-run
147 :enable (and (not gud-running) 149 :enable (not gud-running)
148 (memq gud-minor-mode '(gdbmi gdb dbx jdb))) 150 :visible (and (memq gud-minor-mode '(gdbmi gdb dbx jdb))
149 :visible (not (eq gud-minor-mode 'gdba))) 151 (not (eq gud-minor-mode 'gdba))))
150 ([go] menu-item "Run/Continue" gud-go 152 ([go] menu-item (if gdb-active-process "Continue" "Run") gud-go
151 :visible (and (not gud-running) 153 :visible (and (not gud-running)
152 (eq gud-minor-mode 'gdba))) 154 (eq gud-minor-mode 'gdba)))
153 ([stop] menu-item "Stop" gud-stop-subjob 155 ([stop] menu-item "Stop" gud-stop-subjob
@@ -155,26 +157,27 @@ Used to grey out relevant togolbar icons.")
155 (and gud-running 157 (and gud-running
156 (eq gud-minor-mode 'gdba)))) 158 (eq gud-minor-mode 'gdba))))
157 ([until] menu-item "Continue to selection" gud-until 159 ([until] menu-item "Continue to selection" gud-until
158 :enable (and (not gud-running) 160 :enable (not gud-running)
159 (memq gud-minor-mode '(gdbmi gdba gdb perldb))) 161 :visible (and (memq gud-minor-mode '(gdbmi gdba gdb perldb))
160 :visible (gud-tool-bar-item-visible-no-fringe)) 162 (gud-tool-bar-item-visible-no-fringe)))
161 ([remove] menu-item "Remove Breakpoint" gud-remove 163 ([remove] menu-item "Remove Breakpoint" gud-remove
162 :enable (not gud-running) 164 :enable (not gud-running)
163 :visible (gud-tool-bar-item-visible-no-fringe)) 165 :visible (gud-tool-bar-item-visible-no-fringe))
164 ([tbreak] menu-item "Temporary Breakpoint" gud-tbreak 166 ([tbreak] menu-item "Temporary Breakpoint" gud-tbreak
165 :enable (memq gud-minor-mode 167 :enable (not gud-running)
168 :visible (memq gud-minor-mode
166 '(gdbmi gdba gdb sdb xdb bashdb))) 169 '(gdbmi gdba gdb sdb xdb bashdb)))
167 ([break] menu-item "Set Breakpoint" gud-break 170 ([break] menu-item "Set Breakpoint" gud-break
168 :enable (not gud-running) 171 :enable (not gud-running)
169 :visible (gud-tool-bar-item-visible-no-fringe)) 172 :visible (gud-tool-bar-item-visible-no-fringe))
170 ([up] menu-item "Up Stack" gud-up 173 ([up] menu-item "Up Stack" gud-up
171 :enable (and (not gud-running) 174 :enable (not gud-running)
172 (memq gud-minor-mode 175 :visible (memq gud-minor-mode
173 '(gdbmi gdba gdb dbx xdb jdb pdb bashdb)))) 176 '(gdbmi gdba gdb dbx xdb jdb pdb bashdb)))
174 ([down] menu-item "Down Stack" gud-down 177 ([down] menu-item "Down Stack" gud-down
175 :enable (and (not gud-running) 178 :enable (not gud-running)
176 (memq gud-minor-mode 179 :visible (memq gud-minor-mode
177 '(gdbmi gdba gdb dbx xdb jdb pdb bashdb)))) 180 '(gdbmi gdba gdb dbx xdb jdb pdb bashdb)))
178 ([pp] menu-item "Print S-expression" gud-pp 181 ([pp] menu-item "Print S-expression" gud-pp
179 :enable (and (not gud-running) 182 :enable (and (not gud-running)
180 gdb-active-process) 183 gdb-active-process)
@@ -183,23 +186,23 @@ Used to grey out relevant togolbar icons.")
183 'gud-target-name gud-comint-buffer) "emacs") 186 'gud-target-name gud-comint-buffer) "emacs")
184 (eq gud-minor-mode 'gdba))) 187 (eq gud-minor-mode 'gdba)))
185 ([print*] menu-item "Print Dereference" gud-pstar 188 ([print*] menu-item "Print Dereference" gud-pstar
186 :enable (and (not gud-running) 189 :enable (not gud-running)
187 (memq gud-minor-mode '(gdbmi gdba gdb)))) 190 :visible (memq gud-minor-mode '(gdbmi gdba gdb)))
188 ([print] menu-item "Print Expression" gud-print 191 ([print] menu-item "Print Expression" gud-print
189 :enable (not gud-running)) 192 :enable (not gud-running))
190 ([watch] menu-item "Watch Expression" gud-watch 193 ([watch] menu-item "Watch Expression" gud-watch
191 :enable (and (not gud-running) 194 :enable (not gud-running)
192 (memq gud-minor-mode '(gdbmi gdba)))) 195 :visible (memq gud-minor-mode '(gdbmi gdba)))
193 ([finish] menu-item "Finish Function" gud-finish 196 ([finish] menu-item "Finish Function" gud-finish
194 :enable (and (not gud-running) 197 :enable (not gud-running)
195 (memq gud-minor-mode 198 :visible (memq gud-minor-mode
196 '(gdbmi gdba gdb xdb jdb pdb bashdb)))) 199 '(gdbmi gdba gdb xdb jdb pdb bashdb)))
197 ([stepi] menu-item "Step Instruction" gud-stepi 200 ([stepi] menu-item "Step Instruction" gud-stepi
198 :enable (and (not gud-running) 201 :enable (not gud-running)
199 (memq gud-minor-mode '(gdbmi gdba gdb dbx)))) 202 :visible (memq gud-minor-mode '(gdbmi gdba gdb dbx)))
200 ([nexti] menu-item "Next Instruction" gud-nexti 203 ([nexti] menu-item "Next Instruction" gud-nexti
201 :enable (and (not gud-running) 204 :enable (not gud-running)
202 (memq gud-minor-mode '(gdbmi gdba gdb dbx)))) 205 :visible (memq gud-minor-mode '(gdbmi gdba gdb dbx)))
203 ([step] menu-item "Step Line" gud-step 206 ([step] menu-item "Step Line" gud-step
204 :enable (not gud-running)) 207 :enable (not gud-running))
205 ([next] menu-item "Next Line" gud-next 208 ([next] menu-item "Next Line" gud-next
@@ -2565,7 +2568,7 @@ comint mode, which see."
2565 (existing-buffer (get-buffer (concat "*gud" filepart "*")))) 2568 (existing-buffer (get-buffer (concat "*gud" filepart "*"))))
2566 (pop-to-buffer (concat "*gud" filepart "*")) 2569 (pop-to-buffer (concat "*gud" filepart "*"))
2567 (when (and existing-buffer (get-buffer-process existing-buffer)) 2570 (when (and existing-buffer (get-buffer-process existing-buffer))
2568 (error "This program is already running under gdb")) 2571 (error "This program is already being debugged"))
2569 ;; Set the dir, in case the buffer already existed with a different dir. 2572 ;; Set the dir, in case the buffer already existed with a different dir.
2570 (setq default-directory dir) 2573 (setq default-directory dir)
2571 ;; Set default-directory to the file's directory. 2574 ;; Set default-directory to the file's directory.
@@ -2693,10 +2696,10 @@ It is saved for when this flag is not set.")
2693 ((memq (process-status proc) '(signal exit)) 2696 ((memq (process-status proc) '(signal exit))
2694 ;; Stop displaying an arrow in a source file. 2697 ;; Stop displaying an arrow in a source file.
2695 (setq gud-overlay-arrow-position nil) 2698 (setq gud-overlay-arrow-position nil)
2696 (with-current-buffer gud-comint-buffer 2699 (if (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
2697 (if (memq gud-minor-mode-type '(gdbmi gdba)) 2700 '(gdba gdbmi))
2698 (gdb-reset) 2701 (gdb-reset)
2699 (gud-reset))) 2702 (gud-reset))
2700 (let* ((obuf (current-buffer))) 2703 (let* ((obuf (current-buffer)))
2701 ;; save-excursion isn't the right thing if 2704 ;; save-excursion isn't the right thing if
2702 ;; process-buffer is current-buffer 2705 ;; process-buffer is current-buffer
@@ -3166,7 +3169,7 @@ class of the file (using s to separate nested class ids)."
3166(defvar gdb-script-font-lock-keywords 3169(defvar gdb-script-font-lock-keywords
3167 '(("^define\\s-+\\(\\(\\w\\|\\s_\\)+\\)" (1 font-lock-function-name-face)) 3170 '(("^define\\s-+\\(\\(\\w\\|\\s_\\)+\\)" (1 font-lock-function-name-face))
3168 ("\\$\\(\\w+\\)" (1 font-lock-variable-name-face)) 3171 ("\\$\\(\\w+\\)" (1 font-lock-variable-name-face))
3169 ("^\\s-*\\(\\(\\w\\|\\s_\\)+\\)" (1 font-lock-keyword-face)))) 3172 ("^\\s-*\\(\\w\\(\\w\\|\\s_\\)*\\)" (1 font-lock-keyword-face))))
3170 3173
3171;; FIXME: The keyword "end" associated with "document" 3174;; FIXME: The keyword "end" associated with "document"
3172;; should have font-lock-keyword-face (currently font-lock-doc-face). 3175;; should have font-lock-keyword-face (currently font-lock-doc-face).
@@ -3313,7 +3316,8 @@ Treats actions as defuns."
3313 (kill-local-variable 'gdb-define-alist) 3316 (kill-local-variable 'gdb-define-alist)
3314 (remove-hook 'after-save-hook 'gdb-create-define-alist t)))) 3317 (remove-hook 'after-save-hook 'gdb-create-define-alist t))))
3315 3318
3316(defcustom gud-tooltip-modes '(gud-mode c-mode c++-mode fortran-mode) 3319(defcustom gud-tooltip-modes '(gud-mode c-mode c++-mode fortran-mode
3320 python-mode)
3317 "List of modes for which to enable GUD tooltips." 3321 "List of modes for which to enable GUD tooltips."
3318 :type 'sexp 3322 :type 'sexp
3319 :group 'gud 3323 :group 'gud
@@ -3427,9 +3431,8 @@ With arg, dereference expr iff arg is positive."
3427 (case gud-minor-mode 3431 (case gud-minor-mode
3428 (gdba (concat "server print " expr)) 3432 (gdba (concat "server print " expr))
3429 ((dbx gdbmi) (concat "print " expr)) 3433 ((dbx gdbmi) (concat "print " expr))
3430 (xdb (concat "p " expr)) 3434 ((xdb pdb) (concat "p " expr))
3431 (sdb (concat expr "/")) 3435 (sdb (concat expr "/"))))
3432 (perldb expr)))
3433 3436
3434(defun gud-tooltip-tips (event) 3437(defun gud-tooltip-tips (event)
3435 "Show tip for identifier or selection under the mouse. 3438 "Show tip for identifier or selection under the mouse.
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 04e44e2dac1..a100424108d 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -928,15 +928,17 @@ Return as (TOP . BOTTOM) the extent of ifdef block."
928 (setq hide-ifdef-hiding t)) 928 (setq hide-ifdef-hiding t))
929 (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))) 929 (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only)))
930 930
931
932(defun show-ifdef-block () 931(defun show-ifdef-block ()
933 "Show the ifdef block (true or false part) enclosing or before the cursor." 932 "Show the ifdef block (true or false part) enclosing or before the cursor."
934 (interactive) 933 (interactive)
935 (if hide-ifdef-lines 934 (let ((top-bottom (hif-find-ifdef-block)))
936 (save-excursion 935 (if hide-ifdef-lines
937 (beginning-of-line) 936 (hif-show-ifdef-region
938 (hif-show-ifdef-region (1- (point)) (progn (end-of-line) (point)))) 937 (save-excursion
939 (let ((top-bottom (hif-find-ifdef-block))) 938 (goto-char (car top-bottom)) (line-beginning-position))
939 (save-excursion
940 (goto-char (1+ (cdr top-bottom)))
941 (hif-end-of-line) (point)))
940 (hif-show-ifdef-region (1- (car top-bottom)) (cdr top-bottom))))) 942 (hif-show-ifdef-region (1- (car top-bottom)) (cdr top-bottom)))))
941 943
942 944
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index 092c7736c27..4a50e00063c 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -233,30 +233,37 @@ documentation for variable `inferior-lisp-buffer'.
233 233
234\\{inferior-lisp-mode-map} 234\\{inferior-lisp-mode-map}
235 235
236Customisation: Entry to this mode runs the hooks on `comint-mode-hook' and 236Customization: Entry to this mode runs the hooks on `comint-mode-hook' and
237`inferior-lisp-mode-hook' (in that order). 237`inferior-lisp-mode-hook' (in that order).
238 238
239You can send text to the inferior Lisp process from other buffers containing 239You can send text to the inferior Lisp process from other buffers containing
240Lisp source. 240Lisp source.
241 switch-to-lisp switches the current buffer to the Lisp process buffer. 241 `switch-to-lisp' switches the current buffer to the Lisp process buffer.
242 lisp-eval-defun sends the current defun to the Lisp process. 242 `lisp-eval-defun' sends the current defun to the Lisp process.
243 lisp-compile-defun compiles the current defun. 243 `lisp-compile-defun' compiles the current defun.
244 lisp-eval-region sends the current region to the Lisp process. 244 `lisp-eval-region' sends the current region to the Lisp process.
245 lisp-compile-region compiles the current region. 245 `lisp-compile-region' compiles the current region.
246 246
247 Prefixing the lisp-eval/compile-defun/region commands with 247 Prefixing the lisp-eval/compile-defun/region commands with
248 a \\[universal-argument] causes a switch to the Lisp process buffer after sending 248 a \\[universal-argument] causes a switch to the Lisp process buffer after sending
249 the text. 249 the text.
250 250
251Commands: 251Commands:\\<inferior-lisp-mode-map>
252Return after the end of the process' output sends the text from the 252\\[comint-send-input] after the end of the process' output sends the text from the
253 end of process to point. 253 end of process to point.
254Return before the end of the process' output copies the sexp ending at point 254\\[comint-send-input] before the end of the process' output copies the sexp ending at point
255 to the end of the process' output, and sends it. 255 to the end of the process' output, and sends it.
256Delete converts tabs to spaces as it moves back. 256\\[comint-copy-old-input] copies the sexp ending at point to the end of the process' output,
257Tab indents for Lisp; with argument, shifts rest 257 allowing you to edit it before sending it.
258If `comint-use-prompt-regexp' is nil (the default), \\[comint-insert-input] on old input
259 copies the entire old input to the end of the process' output, allowing
260 you to edit it before sending it. When not used on old input, or if
261 `comint-use-prompt-regexp' is non-nil, \\[comint-insert-input] behaves according to
262 its global binding.
263\\[backward-delete-char-untabify] converts tabs to spaces as it moves back.
264\\[lisp-indent-line] indents for Lisp; with argument, shifts rest
258 of expression rigidly with the current line. 265 of expression rigidly with the current line.
259C-M-q does Tab on each line starting within following expression. 266\\[indent-sexp] does \\[lisp-indent-line] on each line starting within following expression.
260Paragraphs are separated only by blank lines. Semicolons start comments. 267Paragraphs are separated only by blank lines. Semicolons start comments.
261If you accidentally suspend your process, use \\[comint-continue-subjob] 268If you accidentally suspend your process, use \\[comint-continue-subjob]
262to continue it." 269to continue it."
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 3bbfeaac683..d22aedb6058 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -246,6 +246,7 @@ You will be offered to complete on one of those in the minibuffer whenever
246you enter a \".\" at the beginning of a line in `makefile-mode'." 246you enter a \".\" at the beginning of a line in `makefile-mode'."
247 :type '(repeat (list string)) 247 :type '(repeat (list string))
248 :group 'makefile) 248 :group 'makefile)
249(put 'makefile-special-targets-list 'risky-local-variable t)
249 250
250(defcustom makefile-runtime-macros-list 251(defcustom makefile-runtime-macros-list
251 '(("@") ("&") (">") ("<") ("*") ("^") ("+") ("?") ("%") ("$")) 252 '(("@") ("&") (">") ("<") ("*") ("^") ("+") ("?") ("%") ("$"))
@@ -290,6 +291,9 @@ not be enclosed in { } or ( )."
290;; that if you change this regexp you might have to fix the imenu index in 291;; that if you change this regexp you might have to fix the imenu index in
291;; makefile-imenu-generic-expression. 292;; makefile-imenu-generic-expression.
292(defconst makefile-macroassign-regex 293(defconst makefile-macroassign-regex
294 ;; We used to match not just the varname but also the whole value
295 ;; (spanning potentially several lines).
296 ;; "^ *\\([^ \n\t][^:#= \t\n]*\\)[ \t]*\\(?:!=[ \t]*\\(\\(?:.+\\\\\n\\)*.+\\)\\|[*:+]?[:?]?=[ \t]*\\(\\(?:.*\\\\\n\\)*.*\\)\\)"
293 "^ *\\([^ \n\t][^:#= \t\n]*\\)[ \t]*\\(?:!=\\|[*:+]?[:?]?=\\)" 297 "^ *\\([^ \n\t][^:#= \t\n]*\\)[ \t]*\\(?:!=\\|[*:+]?[:?]?=\\)"
294 "Regex used to find macro assignment lines in a makefile.") 298 "Regex used to find macro assignment lines in a makefile.")
295 299
@@ -544,7 +548,8 @@ This should identify a `make' command that can handle the `-q' option."
544 :type 'string 548 :type 'string
545 :group 'makefile) 549 :group 'makefile)
546 550
547(defcustom makefile-query-one-target-method 'makefile-query-by-make-minus-q 551(defcustom makefile-query-one-target-method-function
552 'makefile-query-by-make-minus-q
548 "*Function to call to determine whether a make target is up to date. 553 "*Function to call to determine whether a make target is up to date.
549The function must satisfy this calling convention: 554The function must satisfy this calling convention:
550 555
@@ -560,6 +565,8 @@ The function must satisfy this calling convention:
560 makefile, any nonzero integer value otherwise." 565 makefile, any nonzero integer value otherwise."
561 :type 'function 566 :type 'function
562 :group 'makefile) 567 :group 'makefile)
568(defvaralias 'makefile-query-one-target-method
569 'makefile-query-one-target-method-function)
563 570
564(defcustom makefile-up-to-date-buffer-name "*Makefile Up-to-date overview*" 571(defcustom makefile-up-to-date-buffer-name "*Makefile Up-to-date overview*"
565 "*Name of the Up-to-date overview buffer." 572 "*Name of the Up-to-date overview buffer."
@@ -619,39 +626,38 @@ The function must satisfy this calling convention:
619 map) 626 map)
620 "The keymap that is used in Makefile mode.") 627 "The keymap that is used in Makefile mode.")
621 628
622(defvar makefile-browser-map nil 629
630(defvar makefile-browser-map
631 (let ((map (make-sparse-keymap)))
632 (define-key map "n" 'makefile-browser-next-line)
633 (define-key map "\C-n" 'makefile-browser-next-line)
634 (define-key map "p" 'makefile-browser-previous-line)
635 (define-key map "\C-p" 'makefile-browser-previous-line)
636 (define-key map " " 'makefile-browser-toggle)
637 (define-key map "i" 'makefile-browser-insert-selection)
638 (define-key map "I" 'makefile-browser-insert-selection-and-quit)
639 (define-key map "\C-c\C-m" 'makefile-browser-insert-continuation)
640 (define-key map "q" 'makefile-browser-quit)
641 ;; disable horizontal movement
642 (define-key map "\C-b" 'undefined)
643 (define-key map "\C-f" 'undefined)
644 map)
623 "The keymap that is used in the macro- and target browser.") 645 "The keymap that is used in the macro- and target browser.")
624(if makefile-browser-map 646
625 () 647
626 (setq makefile-browser-map (make-sparse-keymap)) 648(defvar makefile-mode-syntax-table
627 (define-key makefile-browser-map "n" 'makefile-browser-next-line) 649 (let ((st (make-syntax-table)))
628 (define-key makefile-browser-map "\C-n" 'makefile-browser-next-line) 650 (modify-syntax-entry ?\( "() " st)
629 (define-key makefile-browser-map "p" 'makefile-browser-previous-line) 651 (modify-syntax-entry ?\) ")( " st)
630 (define-key makefile-browser-map "\C-p" 'makefile-browser-previous-line) 652 (modify-syntax-entry ?\[ "(] " st)
631 (define-key makefile-browser-map " " 'makefile-browser-toggle) 653 (modify-syntax-entry ?\] ")[ " st)
632 (define-key makefile-browser-map "i" 'makefile-browser-insert-selection) 654 (modify-syntax-entry ?\{ "(} " st)
633 (define-key makefile-browser-map "I" 'makefile-browser-insert-selection-and-quit) 655 (modify-syntax-entry ?\} "){ " st)
634 (define-key makefile-browser-map "\C-c\C-m" 'makefile-browser-insert-continuation) 656 (modify-syntax-entry ?\' "\" " st)
635 (define-key makefile-browser-map "q" 'makefile-browser-quit) 657 (modify-syntax-entry ?\` "\" " st)
636 ;; disable horizontal movement 658 (modify-syntax-entry ?# "< " st)
637 (define-key makefile-browser-map "\C-b" 'undefined) 659 (modify-syntax-entry ?\n "> " st)
638 (define-key makefile-browser-map "\C-f" 'undefined)) 660 st))
639
640
641(defvar makefile-mode-syntax-table nil)
642(if makefile-mode-syntax-table
643 ()
644 (setq makefile-mode-syntax-table (make-syntax-table))
645 (modify-syntax-entry ?\( "() " makefile-mode-syntax-table)
646 (modify-syntax-entry ?\) ")( " makefile-mode-syntax-table)
647 (modify-syntax-entry ?\[ "(] " makefile-mode-syntax-table)
648 (modify-syntax-entry ?\] ")[ " makefile-mode-syntax-table)
649 (modify-syntax-entry ?\{ "(} " makefile-mode-syntax-table)
650 (modify-syntax-entry ?\} "){ " makefile-mode-syntax-table)
651 (modify-syntax-entry ?\' "\" " makefile-mode-syntax-table)
652 (modify-syntax-entry ?\` "\" " makefile-mode-syntax-table)
653 (modify-syntax-entry ?# "< " makefile-mode-syntax-table)
654 (modify-syntax-entry ?\n "> " makefile-mode-syntax-table))
655 661
656(defvar makefile-imake-mode-syntax-table (copy-syntax-table 662(defvar makefile-imake-mode-syntax-table (copy-syntax-table
657 makefile-mode-syntax-table)) 663 makefile-mode-syntax-table))
@@ -670,9 +676,11 @@ The function must satisfy this calling convention:
670 676
671(defvar makefile-target-table nil 677(defvar makefile-target-table nil
672 "Table of all target names known for this buffer.") 678 "Table of all target names known for this buffer.")
679(put 'makefile-target-table 'risky-local-variable t)
673 680
674(defvar makefile-macro-table nil 681(defvar makefile-macro-table nil
675 "Table of all macro names known for this buffer.") 682 "Table of all macro names known for this buffer.")
683(put 'makefile-macro-table 'risky-local-variable t)
676 684
677(defvar makefile-browser-client 685(defvar makefile-browser-client
678 "A buffer in Makefile mode that is currently using the browser.") 686 "A buffer in Makefile mode that is currently using the browser.")
@@ -724,11 +732,10 @@ The function must satisfy this calling convention:
724 732
725If you are editing a file for a different make, try one of the 733If you are editing a file for a different make, try one of the
726variants `makefile-automake-mode', `makefile-gmake-mode', 734variants `makefile-automake-mode', `makefile-gmake-mode',
727`makefile-makepp-mode', `makefile-bsdmake-mode' or, 735`makefile-makepp-mode', `makefile-bsdmake-mode' or,
728`makefile-imake-mode'All but the 736`makefile-imake-mode'. All but the last should be correctly
729last should be correctly chosen based on the file name, except if 737chosen based on the file name, except if it is *.mk. This
730it is *.mk. This function ends by invoking the function(s) 738function ends by invoking the function(s) `makefile-mode-hook'.
731`makefile-mode-hook'.
732 739
733It is strongly recommended to use `font-lock-mode', because that 740It is strongly recommended to use `font-lock-mode', because that
734provides additional parsing information. This is used for 741provides additional parsing information. This is used for
@@ -1298,29 +1305,8 @@ definition and conveniently use this command."
1298 (beginning-of-line) 1305 (beginning-of-line)
1299 (cond 1306 (cond
1300 ((looking-at "^#+") 1307 ((looking-at "^#+")
1301 ;; Found a comment. Set the fill prefix, and find the paragraph 1308 ;; Found a comment. Return nil to let normal filling take place.
1302 ;; boundaries by searching for lines that look like comment-only 1309 nil)
1303 ;; lines.
1304 (let ((fill-prefix (match-string-no-properties 0))
1305 (fill-paragraph-function nil))
1306 (save-excursion
1307 (save-restriction
1308 (narrow-to-region
1309 ;; Search backwards.
1310 (save-excursion
1311 (while (and (zerop (forward-line -1))
1312 (looking-at "^#")))
1313 ;; We may have gone too far. Go forward again.
1314 (or (looking-at "^#")
1315 (forward-line 1))
1316 (point))
1317 ;; Search forwards.
1318 (save-excursion
1319 (while (looking-at "^#")
1320 (forward-line))
1321 (point)))
1322 (fill-paragraph nil)
1323 t))))
1324 1310
1325 ;; Must look for backslashed-region before looking for variable 1311 ;; Must look for backslashed-region before looking for variable
1326 ;; assignment. 1312 ;; assignment.
@@ -1349,7 +1335,9 @@ definition and conveniently use this command."
1349 (makefile-backslash-region (point-min) (point-max) nil) 1335 (makefile-backslash-region (point-min) (point-max) nil)
1350 (goto-char (point-max)) 1336 (goto-char (point-max))
1351 (if (< (skip-chars-backward "\n") 0) 1337 (if (< (skip-chars-backward "\n") 0)
1352 (delete-region (point) (point-max)))))) 1338 (delete-region (point) (point-max)))))
1339 ;; Return non-nil to indicate it's been filled.
1340 t)
1353 1341
1354 ((looking-at makefile-macroassign-regex) 1342 ((looking-at makefile-macroassign-regex)
1355 ;; Have a macro assign. Fill just this line, and then backslash 1343 ;; Have a macro assign. Fill just this line, and then backslash
@@ -1358,10 +1346,13 @@ definition and conveniently use this command."
1358 (narrow-to-region (point) (line-beginning-position 2)) 1346 (narrow-to-region (point) (line-beginning-position 2))
1359 (let ((fill-paragraph-function nil)) 1347 (let ((fill-paragraph-function nil))
1360 (fill-paragraph nil)) 1348 (fill-paragraph nil))
1361 (makefile-backslash-region (point-min) (point-max) nil))))) 1349 (makefile-backslash-region (point-min) (point-max) nil))
1350 ;; Return non-nil to indicate it's been filled.
1351 t)
1362 1352
1363 ;; Always return non-nil so we don't fill anything else. 1353 (t
1364 t) 1354 ;; Return non-nil so we don't fill anything else.
1355 t))))
1365 1356
1366 1357
1367 1358
@@ -1616,7 +1607,8 @@ with the generated name!"
1616 1607
1617(defun makefile-query-targets (filename target-table prereq-list) 1608(defun makefile-query-targets (filename target-table prereq-list)
1618 "Fill the up-to-date overview buffer. 1609 "Fill the up-to-date overview buffer.
1619Checks each target in TARGET-TABLE using `makefile-query-one-target-method' 1610Checks each target in TARGET-TABLE using
1611`makefile-query-one-target-method-function'
1620and generates the overview, one line per target name." 1612and generates the overview, one line per target name."
1621 (insert 1613 (insert
1622 (mapconcat 1614 (mapconcat
@@ -1625,7 +1617,7 @@ and generates the overview, one line per target name."
1625 (no-prereqs (not (member target-name prereq-list))) 1617 (no-prereqs (not (member target-name prereq-list)))
1626 (needs-rebuild (or no-prereqs 1618 (needs-rebuild (or no-prereqs
1627 (funcall 1619 (funcall
1628 makefile-query-one-target-method 1620 makefile-query-one-target-method-function
1629 target-name 1621 target-name
1630 filename)))) 1622 filename))))
1631 (format "\t%s%s" 1623 (format "\t%s%s"
@@ -1876,5 +1868,5 @@ If it isn't in one, return nil."
1876 1868
1877(provide 'make-mode) 1869(provide 'make-mode)
1878 1870
1879;;; arch-tag: bd23545a-de91-44fb-b1b2-feafbb2635a0 1871;; arch-tag: bd23545a-de91-44fb-b1b2-feafbb2635a0
1880;;; make-mode.el ends here 1872;;; make-mode.el ends here
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 0e73427a33c..b80fe4c0fbc 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -814,6 +814,18 @@ See `sh-feature'.")
814 (:weight bold))) 814 (:weight bold)))
815 "Face to show a here-document" 815 "Face to show a here-document"
816 :group 'sh-indentation) 816 :group 'sh-indentation)
817
818;; These colours are probably icky. It's just a placeholder though.
819(defface sh-quoted-exec
820 '((((class color) (background dark))
821 (:foreground "salmon"))
822 (((class color) (background light))
823 (:foreground "magenta"))
824 (t
825 (:weight bold)))
826 "Face to show quoted execs like ``"
827 :group 'sh-indentation)
828
817;; backward-compatibility alias 829;; backward-compatibility alias
818(put 'sh-heredoc-face 'face-alias 'sh-heredoc) 830(put 'sh-heredoc-face 'face-alias 'sh-heredoc)
819(defvar sh-heredoc-face 'sh-heredoc) 831(defvar sh-heredoc-face 'sh-heredoc)
@@ -833,7 +845,7 @@ See `sh-feature'.")
833 font-lock-variable-name-face)) 845 font-lock-variable-name-face))
834 846
835 (rc sh-append es) 847 (rc sh-append es)
836 848 (bash sh-append shell ("\\$(\\(\\sw+\\)" (1 'sh-quoted-exec t) ))
837 (sh sh-append shell 849 (sh sh-append shell
838 ;; Variable names. 850 ;; Variable names.
839 ("\\$\\({#?\\)?\\([A-Za-z_][A-Za-z0-9_]*\\|[-#?@!]\\)" 2 851 ("\\$\\({#?\\)?\\([A-Za-z_][A-Za-z0-9_]*\\|[-#?@!]\\)" 2
@@ -967,6 +979,49 @@ Point is at the beginning of the next line."
967 ;; This looks silly, but it's because `sh-here-doc-re' keeps changing. 979 ;; This looks silly, but it's because `sh-here-doc-re' keeps changing.
968 (re-search-forward sh-here-doc-re limit t)) 980 (re-search-forward sh-here-doc-re limit t))
969 981
982(defun sh-quoted-subshell (limit)
983 "Search for a subshell embedded in a string. Find all the unescaped
984\" characters within said subshell, remembering that subshells can nest."
985 (if (re-search-forward "\"\\(?:.\\|\n\\)*?\\(\\$(\\|`\\)" limit t)
986 ;; bingo we have a $( or a ` inside a ""
987 (let ((char (char-after (point)))
988 (continue t)
989 (pos (point))
990 (data nil) ;; value to put into match-data (and return)
991 (last nil) ;; last char seen
992 (bq (equal (match-string 1) "`")) ;; ` state flip-flop
993 (seen nil) ;; list of important positions
994 (nest 1)) ;; subshell nesting level
995 (while (and continue char (<= pos limit))
996 ;; unescaped " inside a $( ... ) construct.
997 ;; state machine time...
998 ;; \ => ignore next char;
999 ;; ` => increase or decrease nesting level based on bq flag
1000 ;; ) [where nesting > 0] => decrease nesting
1001 ;; ( [where nesting > 0] => increase nesting
1002 ;; ( [preceeded by $ ] => increase nesting
1003 ;; " [nesting <= 0 ] => terminate, we're done.
1004 ;; " [nesting > 0 ] => remember this, it's not a proper "
1005 (if (eq ?\\ last) nil
1006 (if (eq ?\` char) (setq nest (+ nest (if bq -1 1)) bq (not bq))
1007 (if (and (> nest 0) (eq ?\) char)) (setq nest (1- nest))
1008 (if (and (eq ?$ last) (eq ?\( char)) (setq nest (1+ nest))
1009 (if (and (> nest 0) (eq ?\( char)) (setq nest (1+ nest))
1010 (if (eq char ?\")
1011 (if (>= 0 nest) (setq continue nil)
1012 (setq seen (cons pos seen)) ) ))))))
1013 ;;(message "POS: %d [%d]" pos nest)
1014 (setq last char
1015 pos (1+ pos)
1016 char (char-after pos)) )
1017 (when seen
1018 ;;(message "SEEN: %S" seen)
1019 (setq data (list (current-buffer)))
1020 (mapc (lambda (P)
1021 (setq data (cons P (cons (1+ P) data)) ) ) seen)
1022 (store-match-data data))
1023 data) ))
1024
970(defun sh-is-quoted-p (pos) 1025(defun sh-is-quoted-p (pos)
971 (and (eq (char-before pos) ?\\) 1026 (and (eq (char-before pos) ?\\)
972 (not (sh-is-quoted-p (1- pos))))) 1027 (not (sh-is-quoted-p (1- pos)))))
@@ -997,6 +1052,17 @@ Point is at the beginning of the next line."
997 (when (save-excursion (backward-char 2) (looking-at ";;\\|in")) 1052 (when (save-excursion (backward-char 2) (looking-at ";;\\|in"))
998 sh-st-punc))) 1053 sh-st-punc)))
999 1054
1055(defun sh-apply-quoted-subshell ()
1056 "Apply the `sh-st-punc' syntax to all the matches in `match-data'.
1057This is used to flag quote characters in subshell constructs inside strings
1058\(which should therefore not be treated as normal quote characters\)"
1059 (let ((m (match-data)) a b)
1060 (while m
1061 (setq a (car m)
1062 b (cadr m)
1063 m (cddr m))
1064 (put-text-property a b 'syntax-table sh-st-punc))) sh-st-punc)
1065
1000(defconst sh-font-lock-syntactic-keywords 1066(defconst sh-font-lock-syntactic-keywords
1001 ;; A `#' begins a comment when it is unquoted and at the beginning of a 1067 ;; A `#' begins a comment when it is unquoted and at the beginning of a
1002 ;; word. In the shell, words are separated by metacharacters. 1068 ;; word. In the shell, words are separated by metacharacters.
@@ -1007,6 +1073,9 @@ Point is at the beginning of the next line."
1007 ("\\(\\\\\\)'" 1 ,sh-st-punc) 1073 ("\\(\\\\\\)'" 1 ,sh-st-punc)
1008 ;; Make sure $@ and @? are correctly recognized as sexps. 1074 ;; Make sure $@ and @? are correctly recognized as sexps.
1009 ("\\$\\([?@]\\)" 1 ,sh-st-symbol) 1075 ("\\$\\([?@]\\)" 1 ,sh-st-symbol)
1076 ;; highlight (possibly nested) subshells inside "" quoted regions correctly.
1077 (sh-quoted-subshell
1078 (1 (sh-apply-quoted-subshell) t t))
1010 ;; Find HEREDOC starters and add a corresponding rule for the ender. 1079 ;; Find HEREDOC starters and add a corresponding rule for the ender.
1011 (sh-font-lock-here-doc 1080 (sh-font-lock-here-doc
1012 (2 (sh-font-lock-open-heredoc 1081 (2 (sh-font-lock-open-heredoc
@@ -1019,11 +1088,12 @@ Point is at the beginning of the next line."
1019 (")" 0 (sh-font-lock-paren (match-beginning 0))))) 1088 (")" 0 (sh-font-lock-paren (match-beginning 0)))))
1020 1089
1021(defun sh-font-lock-syntactic-face-function (state) 1090(defun sh-font-lock-syntactic-face-function (state)
1022 (if (nth 3 state) 1091 (let ((q (nth 3 state)))
1023 (if (characterp (nth 3 state)) 1092 (if q
1024 font-lock-string-face 1093 (if (characterp q)
1025 sh-heredoc-face) 1094 (if (eq q ?\`) 'sh-quoted-exec font-lock-string-face)
1026 font-lock-comment-face)) 1095 sh-heredoc-face)
1096 font-lock-comment-face)))
1027 1097
1028(defgroup sh-indentation nil 1098(defgroup sh-indentation nil
1029 "Variables controlling indentation in shell scripts. 1099 "Variables controlling indentation in shell scripts.
@@ -1390,11 +1460,11 @@ with your script for an edit-interpret-debug cycle."
1390 (make-local-variable 'sh-shell-file) 1460 (make-local-variable 'sh-shell-file)
1391 (make-local-variable 'sh-shell) 1461 (make-local-variable 'sh-shell)
1392 (make-local-variable 'skeleton-pair-alist) 1462 (make-local-variable 'skeleton-pair-alist)
1393 (make-local-variable 'skeleton-pair-filter) 1463 (make-local-variable 'skeleton-pair-filter-function)
1394 (make-local-variable 'comint-dynamic-complete-functions) 1464 (make-local-variable 'comint-dynamic-complete-functions)
1395 (make-local-variable 'comint-prompt-regexp) 1465 (make-local-variable 'comint-prompt-regexp)
1396 (make-local-variable 'font-lock-defaults) 1466 (make-local-variable 'font-lock-defaults)
1397 (make-local-variable 'skeleton-filter) 1467 (make-local-variable 'skeleton-filter-function)
1398 (make-local-variable 'skeleton-newline-indent-rigidly) 1468 (make-local-variable 'skeleton-newline-indent-rigidly)
1399 (make-local-variable 'sh-shell-variables) 1469 (make-local-variable 'sh-shell-variables)
1400 (make-local-variable 'sh-shell-variables-initialized) 1470 (make-local-variable 'sh-shell-variables-initialized)
@@ -1422,10 +1492,10 @@ with your script for an edit-interpret-debug cycle."
1422 (font-lock-syntactic-face-function 1492 (font-lock-syntactic-face-function
1423 . sh-font-lock-syntactic-face-function)) 1493 . sh-font-lock-syntactic-face-function))
1424 skeleton-pair-alist '((?` _ ?`)) 1494 skeleton-pair-alist '((?` _ ?`))
1425 skeleton-pair-filter 'sh-quoted-p 1495 skeleton-pair-filter-function 'sh-quoted-p
1426 skeleton-further-elements '((< '(- (min sh-indentation 1496 skeleton-further-elements '((< '(- (min sh-indentation
1427 (current-column))))) 1497 (current-column)))))
1428 skeleton-filter 'sh-feature 1498 skeleton-filter-function 'sh-feature
1429 skeleton-newline-indent-rigidly t 1499 skeleton-newline-indent-rigidly t
1430 sh-indent-supported-here nil) 1500 sh-indent-supported-here nil)
1431 (set (make-local-variable 'parse-sexp-ignore-comments) t) 1501 (set (make-local-variable 'parse-sexp-ignore-comments) t)
diff --git a/lisp/replace.el b/lisp/replace.el
index f1792b499fc..2f8fe86860c 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -36,6 +36,11 @@
36 36
37(defvar query-replace-history nil) 37(defvar query-replace-history nil)
38 38
39(defvar query-replace-defaults nil
40 "Default values of FROM-STRING and TO-STRING for `query-replace'.
41This is a cons cell (FROM-STRING . TO-STRING), or nil if there is
42no default value.")
43
39(defvar query-replace-interactive nil 44(defvar query-replace-interactive nil
40 "Non-nil means `query-replace' uses the last search string. 45 "Non-nil means `query-replace' uses the last search string.
41That becomes the \"string to replace\".") 46That becomes the \"string to replace\".")
@@ -94,32 +99,26 @@ The return value can also be a pair (FROM . TO) indicating that the user
94wants to replace FROM with TO." 99wants to replace FROM with TO."
95 (if query-replace-interactive 100 (if query-replace-interactive
96 (car (if regexp-flag regexp-search-ring search-ring)) 101 (car (if regexp-flag regexp-search-ring search-ring))
97 (let* ((lastfrom (car (symbol-value query-replace-from-history-variable))) 102 (let* ((history-add-new-input nil)
98 (lastto (car (symbol-value query-replace-to-history-variable)))
99 (from 103 (from
100 ;; The save-excursion here is in case the user marks and copies 104 ;; The save-excursion here is in case the user marks and copies
101 ;; a region in order to specify the minibuffer input. 105 ;; a region in order to specify the minibuffer input.
102 ;; That should not clobber the region for the query-replace itself. 106 ;; That should not clobber the region for the query-replace itself.
103 (save-excursion 107 (save-excursion
104 (when (equal lastfrom lastto)
105 ;; Typically, this is because the two histlists are shared.
106 (setq lastfrom (cadr (symbol-value
107 query-replace-from-history-variable))))
108 (read-from-minibuffer 108 (read-from-minibuffer
109 (if (and lastto lastfrom) 109 (if query-replace-defaults
110 (format "%s (default %s -> %s): " prompt 110 (format "%s (default %s -> %s): " prompt
111 (query-replace-descr lastfrom) 111 (query-replace-descr (car query-replace-defaults))
112 (query-replace-descr lastto)) 112 (query-replace-descr (cdr query-replace-defaults)))
113 (format "%s: " prompt)) 113 (format "%s: " prompt))
114 nil nil nil 114 nil nil nil
115 query-replace-from-history-variable 115 query-replace-from-history-variable
116 nil t t)))) 116 nil t))))
117 (if (and (zerop (length from)) lastto lastfrom) 117 (if (and (zerop (length from)) query-replace-defaults)
118 (progn 118 (cons (car query-replace-defaults)
119 (set query-replace-from-history-variable 119 (query-replace-compile-replacement
120 (cdr (symbol-value query-replace-from-history-variable))) 120 (cdr query-replace-defaults) regexp-flag))
121 (cons lastfrom 121 (add-to-history query-replace-from-history-variable from nil t)
122 (query-replace-compile-replacement lastto regexp-flag)))
123 ;; Warn if user types \n or \t, but don't reject the input. 122 ;; Warn if user types \n or \t, but don't reject the input.
124 (and regexp-flag 123 (and regexp-flag
125 (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from) 124 (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from)
@@ -177,10 +176,14 @@ the original string if not."
177 "Query and return the `to' argument of a query-replace operation." 176 "Query and return the `to' argument of a query-replace operation."
178 (query-replace-compile-replacement 177 (query-replace-compile-replacement
179 (save-excursion 178 (save-excursion
180 (read-from-minibuffer 179 (let* ((history-add-new-input nil)
181 (format "%s %s with: " prompt (query-replace-descr from)) 180 (to (read-from-minibuffer
182 nil nil nil 181 (format "%s %s with: " prompt (query-replace-descr from))
183 query-replace-to-history-variable from t t)) 182 nil nil nil
183 query-replace-to-history-variable from t)))
184 (add-to-history query-replace-to-history-variable to nil t)
185 (setq query-replace-defaults (cons from to))
186 to))
184 regexp-flag)) 187 regexp-flag))
185 188
186(defun query-replace-read-args (prompt regexp-flag &optional noerror) 189(defun query-replace-read-args (prompt regexp-flag &optional noerror)
diff --git a/lisp/ses.el b/lisp/ses.el
index debb22d84db..fc594167187 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -399,7 +399,7 @@ for safety. This is a macro to prevent propagate-on-load viruses."
399(defmacro ses-header-row (row) 399(defmacro ses-header-row (row)
400 "Load the header row from the spreadsheet file and checks it 400 "Load the header row from the spreadsheet file and checks it
401for safety. This is a macro to prevent propagate-on-load viruses." 401for safety. This is a macro to prevent propagate-on-load viruses."
402 (or (and (wholenump row) (< row ses--numrows)) 402 (or (and (wholenump row) (or (zerop ses--numrows) (< row ses--numrows)))
403 (error "Bad header-row")) 403 (error "Bad header-row"))
404 (setq ses--header-row row) 404 (setq ses--header-row row)
405 t) 405 t)
@@ -940,14 +940,18 @@ cell (ROW,COL) has changed."
940 940
941(defun ses-narrowed-p () (/= (- (point-max) (point-min)) (buffer-size))) 941(defun ses-narrowed-p () (/= (- (point-max) (point-min)) (buffer-size)))
942 942
943(defun ses-widen ()
944 "Turn off narrowing, to be reenabled at end of command loop."
945 (if (ses-narrowed-p)
946 (setq ses--deferred-narrow t))
947 (widen))
948
943(defun ses-goto-data (def &optional col) 949(defun ses-goto-data (def &optional col)
944 "Move point to data area for (DEF,COL). If DEF is a row 950 "Move point to data area for (DEF,COL). If DEF is a row
945number, COL is the column number for a data cell -- otherwise DEF 951number, COL is the column number for a data cell -- otherwise DEF
946is one of the symbols ses--col-widths, ses--col-printers, 952is one of the symbols ses--col-widths, ses--col-printers,
947ses--default-printer, ses--numrows, or ses--numcols." 953ses--default-printer, ses--numrows, or ses--numcols."
948 (if (ses-narrowed-p) 954 (ses-widen)
949 (setq ses--deferred-narrow t))
950 (widen)
951 (let ((inhibit-point-motion-hooks t)) ;In case intangible attrs are wrong 955 (let ((inhibit-point-motion-hooks t)) ;In case intangible attrs are wrong
952 (goto-char (point-min)) 956 (goto-char (point-min))
953 (if col 957 (if col
@@ -966,9 +970,6 @@ If ELEM is specified, it is the array subscript within DEF to be set to VALUE."
966 ;;We call ses-goto-data early, using the old values of numrows and 970 ;;We call ses-goto-data early, using the old values of numrows and
967 ;;numcols in case one of them is being changed. 971 ;;numcols in case one of them is being changed.
968 (ses-goto-data def) 972 (ses-goto-data def)
969 (if elem
970 (ses-aset-with-undo (symbol-value def) elem value)
971 (ses-set-with-undo def value))
972 (let ((inhibit-read-only t) 973 (let ((inhibit-read-only t)
973 (fmt (plist-get '(ses--col-widths "(ses-column-widths %S)" 974 (fmt (plist-get '(ses--col-widths "(ses-column-widths %S)"
974 ses--col-printers "(ses-column-printers %S)" 975 ses--col-printers "(ses-column-printers %S)"
@@ -977,9 +978,20 @@ If ELEM is specified, it is the array subscript within DEF to be set to VALUE."
977 ses--file-format " %S ;SES file-format" 978 ses--file-format " %S ;SES file-format"
978 ses--numrows " %S ;numrows" 979 ses--numrows " %S ;numrows"
979 ses--numcols " %S ;numcols") 980 ses--numcols " %S ;numcols")
980 def))) 981 def))
981 (delete-region (point) (line-end-position)) 982 oldval)
982 (insert (format fmt (symbol-value def)))))) 983 (if elem
984 (progn
985 (setq oldval (aref (symbol-value def) elem))
986 (aset (symbol-value def) elem value))
987 (setq oldval (symbol-value def))
988 (set def value))
989 ;;Special undo since it's outside the narrowed buffer
990 (let (buffer-undo-list)
991 (delete-region (point) (line-end-position))
992 (insert (format fmt (symbol-value def))))
993 (push `(apply ses-set-parameter ,def ,oldval ,elem) buffer-undo-list))))
994
983 995
984(defun ses-write-cells () 996(defun ses-write-cells ()
985 "Write cells in `ses--deferred-write' from local variables to data area. 997 "Write cells in `ses--deferred-write' from local variables to data area.
@@ -1278,23 +1290,6 @@ to each symbol."
1278;; Undo control 1290;; Undo control
1279;;---------------------------------------------------------------------------- 1291;;----------------------------------------------------------------------------
1280 1292
1281;; This should be unnecessary, because the feature is now built in.
1282
1283(defadvice undo-more (around ses-undo-more activate preactivate)
1284 "For SES mode, allow undo outside of narrowed buffer range."
1285 (if (not (eq major-mode 'ses-mode))
1286 ad-do-it
1287 ;;Here is some extra code for SES mode.
1288 (setq ses--deferred-narrow
1289 (or ses--deferred-narrow (ses-narrowed-p)))
1290 (widen)
1291 (condition-case x
1292 ad-do-it
1293 (error
1294 ;;Restore narrow if appropriate
1295 (ses-command-hook)
1296 (signal (car x) (cdr x))))))
1297
1298(defun ses-begin-change () 1293(defun ses-begin-change ()
1299 "For undo, remember point before we start changing hidden stuff." 1294 "For undo, remember point before we start changing hidden stuff."
1300 (let ((inhibit-read-only t)) 1295 (let ((inhibit-read-only t))
@@ -1303,7 +1298,7 @@ to each symbol."
1303 1298
1304(defun ses-set-with-undo (sym newval) 1299(defun ses-set-with-undo (sym newval)
1305 "Like set, but undoable. Result is t if value has changed." 1300 "Like set, but undoable. Result is t if value has changed."
1306 ;;We avoid adding redundant entries to the undo list, but this is 1301 ;;We try to avoid adding redundant entries to the undo list, but this is
1307 ;;unavoidable for strings because equal ignores text properties and there's 1302 ;;unavoidable for strings because equal ignores text properties and there's
1308 ;;no easy way to get the whole property list to see if it's different! 1303 ;;no easy way to get the whole property list to see if it's different!
1309 (unless (and (boundp sym) 1304 (unless (and (boundp sym)
@@ -1346,7 +1341,7 @@ execute cell formulas or print functions."
1346 (or (and (= (safe-length params) 3) 1341 (or (and (= (safe-length params) 3)
1347 (numberp (car params)) 1342 (numberp (car params))
1348 (numberp (cadr params)) 1343 (numberp (cadr params))
1349 (> (cadr params) 0) 1344 (>= (cadr params) 0)
1350 (numberp (nth 2 params)) 1345 (numberp (nth 2 params))
1351 (> (nth 2 params) 0)) 1346 (> (nth 2 params) 0))
1352 (error "Invalid SES file")) 1347 (error "Invalid SES file"))
@@ -1568,11 +1563,12 @@ narrows the buffer now."
1568 (let ((old ses--deferred-recalc)) 1563 (let ((old ses--deferred-recalc))
1569 (setq ses--deferred-recalc nil) 1564 (setq ses--deferred-recalc nil)
1570 (ses-update-cells old))) 1565 (ses-update-cells old)))
1571 (if ses--deferred-write 1566 (when ses--deferred-write
1572 ;;We don't reset the deferred list before starting -- the most 1567 ;;We don't reset the deferred list before starting -- the most
1573 ;;likely error is keyboard-quit, and we do want to keep trying 1568 ;;likely error is keyboard-quit, and we do want to keep trying
1574 ;;these writes after a quit. 1569 ;;these writes after a quit.
1575 (ses-write-cells)) 1570 (ses-write-cells)
1571 (push '(apply ses-widen) buffer-undo-list))
1576 (when ses--deferred-narrow 1572 (when ses--deferred-narrow
1577 ;;We're not allowed to narrow the buffer until after-find-file has 1573 ;;We're not allowed to narrow the buffer until after-find-file has
1578 ;;read the local variables at the end of the file. Now it's safe to 1574 ;;read the local variables at the end of the file. Now it's safe to
@@ -1794,9 +1790,7 @@ cells."
1794 (cons (ses-cell-symbol row col) 1790 (cons (ses-cell-symbol row col)
1795 (ses-cell-references yrow ycol))))))) 1791 (ses-cell-references yrow ycol)))))))
1796 ;;Delete everything and reconstruct basic data area 1792 ;;Delete everything and reconstruct basic data area
1797 (if (ses-narrowed-p) 1793 (ses-widen)
1798 (setq ses--deferred-narrow t))
1799 (widen)
1800 (let ((inhibit-read-only t)) 1794 (let ((inhibit-read-only t))
1801 (goto-char (point-max)) 1795 (goto-char (point-max))
1802 (if (search-backward ";; Local Variables:\n" nil t) 1796 (if (search-backward ";; Local Variables:\n" nil t)
@@ -1877,7 +1871,9 @@ cell formula was unsafe and user declined confirmation."
1877 ses-mode-edit-map 1871 ses-mode-edit-map
1878 t ;Convert to Lisp object 1872 t ;Convert to Lisp object
1879 'ses-read-cell-history 1873 'ses-read-cell-history
1880 (prin1-to-string curval))))) 1874 (prin1-to-string (if (eq (car-safe curval) 'ses-safe-formula)
1875 (cadr curval)
1876 curval))))))
1881 (when (ses-edit-cell row col newval) 1877 (when (ses-edit-cell row col newval)
1882 (ses-command-hook) ;Update cell widths before movement 1878 (ses-command-hook) ;Update cell widths before movement
1883 (dolist (x ses-after-entry-functions) 1879 (dolist (x ses-after-entry-functions)
@@ -2073,6 +2069,8 @@ before current one."
2073 (ses-reset-header-string))) 2069 (ses-reset-header-string)))
2074 ;;Reconstruct text attributes 2070 ;;Reconstruct text attributes
2075 (ses-setup) 2071 (ses-setup)
2072 ;;Prepare for undo
2073 (push '(apply ses-widen) buffer-undo-list)
2076 ;;Return to current cell 2074 ;;Return to current cell
2077 (if ses--curcell 2075 (if ses--curcell
2078 (ses-jump-safe ses--curcell) 2076 (ses-jump-safe ses--curcell)
@@ -2109,6 +2107,8 @@ current one."
2109 (ses-reset-header-string))) 2107 (ses-reset-header-string)))
2110 ;;Reconstruct attributes 2108 ;;Reconstruct attributes
2111 (ses-setup) 2109 (ses-setup)
2110 ;;Prepare for undo
2111 (push '(apply ses-widen) buffer-undo-list)
2112 (ses-jump-safe ses--curcell)) 2112 (ses-jump-safe ses--curcell))
2113 2113
2114(defun ses-insert-column (count &optional col width printer) 2114(defun ses-insert-column (count &optional col width printer)
@@ -2643,7 +2643,10 @@ The top row is row 1. Selecting row 0 displays the default header row."
2643 (if (or (< row 0) (> row ses--numrows)) 2643 (if (or (< row 0) (> row ses--numrows))
2644 (error "Invalid header-row")) 2644 (error "Invalid header-row"))
2645 (ses-begin-change) 2645 (ses-begin-change)
2646 (ses-set-parameter 'ses--header-row row) 2646 (let ((oldval ses--header-row))
2647 (let (buffer-undo-list)
2648 (ses-set-parameter 'ses--header-row row))
2649 (push `(apply ses-set-header-row ,oldval) buffer-undo-list))
2647 (ses-reset-header-string)) 2650 (ses-reset-header-string))
2648 2651
2649(defun ses-mark-row () 2652(defun ses-mark-row ()
diff --git a/lisp/shell.el b/lisp/shell.el
index 71b5862feb6..6b22ac79238 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -150,7 +150,7 @@ This is a fine thing to set in your `.emacs' file."
150 :group 'shell) 150 :group 'shell)
151 151
152(defcustom shell-completion-fignore nil 152(defcustom shell-completion-fignore nil
153 "*List of suffixes to be disregarded during file/command completion. 153 "List of suffixes to be disregarded during file/command completion.
154This variable is used to initialize `comint-completion-fignore' in the shell 154This variable is used to initialize `comint-completion-fignore' in the shell
155buffer. The default is nil, for compatibility with most shells. 155buffer. The default is nil, for compatibility with most shells.
156Some people like (\"~\" \"#\" \"%\"). 156Some people like (\"~\" \"#\" \"%\").
@@ -199,19 +199,19 @@ shell buffer.
199This is a fine thing to set in your `.emacs' file.") 199This is a fine thing to set in your `.emacs' file.")
200 200
201(defcustom shell-command-regexp "[^;&|\n]+" 201(defcustom shell-command-regexp "[^;&|\n]+"
202 "*Regexp to match a single command within a pipeline. 202 "Regexp to match a single command within a pipeline.
203This is used for directory tracking and does not do a perfect job." 203This is used for directory tracking and does not do a perfect job."
204 :type 'regexp 204 :type 'regexp
205 :group 'shell) 205 :group 'shell)
206 206
207(defcustom shell-command-separator-regexp "[;&|\n \t]*" 207(defcustom shell-command-separator-regexp "[;&|\n \t]*"
208 "*Regexp to match a single command within a pipeline. 208 "Regexp to match a single command within a pipeline.
209This is used for directory tracking and does not do a perfect job." 209This is used for directory tracking and does not do a perfect job."
210 :type 'regexp 210 :type 'regexp
211 :group 'shell) 211 :group 'shell)
212 212
213(defcustom shell-completion-execonly t 213(defcustom shell-completion-execonly t
214 "*If non-nil, use executable files only for completion candidates. 214 "If non-nil, use executable files only for completion candidates.
215This mirrors the optional behavior of tcsh. 215This mirrors the optional behavior of tcsh.
216 216
217Detecting executability of files may slow command completion considerably." 217Detecting executability of files may slow command completion considerably."
@@ -219,35 +219,35 @@ Detecting executability of files may slow command completion considerably."
219 :group 'shell) 219 :group 'shell)
220 220
221(defcustom shell-popd-regexp "popd" 221(defcustom shell-popd-regexp "popd"
222 "*Regexp to match subshell commands equivalent to popd." 222 "Regexp to match subshell commands equivalent to popd."
223 :type 'regexp 223 :type 'regexp
224 :group 'shell-directories) 224 :group 'shell-directories)
225 225
226(defcustom shell-pushd-regexp "pushd" 226(defcustom shell-pushd-regexp "pushd"
227 "*Regexp to match subshell commands equivalent to pushd." 227 "Regexp to match subshell commands equivalent to pushd."
228 :type 'regexp 228 :type 'regexp
229 :group 'shell-directories) 229 :group 'shell-directories)
230 230
231(defcustom shell-pushd-tohome nil 231(defcustom shell-pushd-tohome nil
232 "*If non-nil, make pushd with no arg behave as \"pushd ~\" (like cd). 232 "If non-nil, make pushd with no arg behave as \"pushd ~\" (like cd).
233This mirrors the optional behavior of tcsh." 233This mirrors the optional behavior of tcsh."
234 :type 'boolean 234 :type 'boolean
235 :group 'shell-directories) 235 :group 'shell-directories)
236 236
237(defcustom shell-pushd-dextract nil 237(defcustom shell-pushd-dextract nil
238 "*If non-nil, make \"pushd +n\" pop the nth dir to the stack top. 238 "If non-nil, make \"pushd +n\" pop the nth dir to the stack top.
239This mirrors the optional behavior of tcsh." 239This mirrors the optional behavior of tcsh."
240 :type 'boolean 240 :type 'boolean
241 :group 'shell-directories) 241 :group 'shell-directories)
242 242
243(defcustom shell-pushd-dunique nil 243(defcustom shell-pushd-dunique nil
244 "*If non-nil, make pushd only add unique directories to the stack. 244 "If non-nil, make pushd only add unique directories to the stack.
245This mirrors the optional behavior of tcsh." 245This mirrors the optional behavior of tcsh."
246 :type 'boolean 246 :type 'boolean
247 :group 'shell-directories) 247 :group 'shell-directories)
248 248
249(defcustom shell-cd-regexp "cd" 249(defcustom shell-cd-regexp "cd"
250 "*Regexp to match subshell commands equivalent to cd." 250 "Regexp to match subshell commands equivalent to cd."
251 :type 'regexp 251 :type 'regexp
252 :group 'shell-directories) 252 :group 'shell-directories)
253 253
@@ -256,19 +256,19 @@ This mirrors the optional behavior of tcsh."
256 ; NetWare allows the five chars between upper and lower alphabetics. 256 ; NetWare allows the five chars between upper and lower alphabetics.
257 "[]a-zA-Z^_`\\[\\\\]:" 257 "[]a-zA-Z^_`\\[\\\\]:"
258 nil) 258 nil)
259 "*If non-nil, is regexp used to track drive changes." 259 "If non-nil, is regexp used to track drive changes."
260 :type '(choice regexp 260 :type '(choice regexp
261 (const nil)) 261 (const nil))
262 :group 'shell-directories) 262 :group 'shell-directories)
263 263
264(defcustom shell-dirtrack-verbose t 264(defcustom shell-dirtrack-verbose t
265 "*If non-nil, show the directory stack following directory change. 265 "If non-nil, show the directory stack following directory change.
266This is effective only if directory tracking is enabled." 266This is effective only if directory tracking is enabled."
267 :type 'boolean 267 :type 'boolean
268 :group 'shell-directories) 268 :group 'shell-directories)
269 269
270(defcustom explicit-shell-file-name nil 270(defcustom explicit-shell-file-name nil
271 "*If non-nil, is file name to use for explicitly requested inferior shell." 271 "If non-nil, is file name to use for explicitly requested inferior shell."
272 :type '(choice (const :tag "None" nil) file) 272 :type '(choice (const :tag "None" nil) file)
273 :group 'shell) 273 :group 'shell)
274 274
@@ -278,7 +278,7 @@ This is effective only if directory tracking is enabled."
278 ;; than us about what terminal modes to use. 278 ;; than us about what terminal modes to use.
279 '("-i" "-T") 279 '("-i" "-T")
280 '("-i")) 280 '("-i"))
281 "*Args passed to inferior shell by M-x shell, if the shell is csh. 281 "Args passed to inferior shell by \\[shell], if the shell is csh.
282Value is a list of strings, which may be nil." 282Value is a list of strings, which may be nil."
283 :type '(repeat (string :tag "Argument")) 283 :type '(repeat (string :tag "Argument"))
284 :group 'shell) 284 :group 'shell)
@@ -296,13 +296,13 @@ Value is a list of strings, which may be nil."
296 (shell-command-to-string (concat prog " --noediting")))) 296 (shell-command-to-string (concat prog " --noediting"))))
297 '("-i") 297 '("-i")
298 '("--noediting" "-i"))) 298 '("--noediting" "-i")))
299 "*Args passed to inferior shell by M-x shell, if the shell is bash. 299 "Args passed to inferior shell by \\[shell], if the shell is bash.
300Value is a list of strings, which may be nil." 300Value is a list of strings, which may be nil."
301 :type '(repeat (string :tag "Argument")) 301 :type '(repeat (string :tag "Argument"))
302 :group 'shell) 302 :group 'shell)
303 303
304(defcustom shell-input-autoexpand 'history 304(defcustom shell-input-autoexpand 'history
305 "*If non-nil, expand input command history references on completion. 305 "If non-nil, expand input command history references on completion.
306This mirrors the optional behavior of tcsh (its autoexpand and histlit). 306This mirrors the optional behavior of tcsh (its autoexpand and histlit).
307 307
308If the value is `input', then the expansion is seen on input. 308If the value is `input', then the expansion is seen on input.
@@ -367,7 +367,7 @@ Thus, this does not include the shell's current directory.")
367(put 'shell-mode 'mode-class 'special) 367(put 'shell-mode 'mode-class 'special)
368 368
369(define-derived-mode shell-mode comint-mode "Shell" 369(define-derived-mode shell-mode comint-mode "Shell"
370 "Major mode for interacting with an inferior shell. 370 "Major mode for interacting with an inferior shell.\\<shell-mode-map>
371\\[comint-send-input] after the end of the process' output sends the text from 371\\[comint-send-input] after the end of the process' output sends the text from
372 the end of process to the end of the current line. 372 the end of process to the end of the current line.
373\\[comint-send-input] before end of process output copies the current line minus the prompt to 373\\[comint-send-input] before end of process output copies the current line minus the prompt to
@@ -433,13 +433,11 @@ buffer."
433 (setq shell-dirstack nil) 433 (setq shell-dirstack nil)
434 (make-local-variable 'shell-last-dir) 434 (make-local-variable 'shell-last-dir)
435 (setq shell-last-dir nil) 435 (setq shell-last-dir nil)
436 (make-local-variable 'shell-dirtrackp)
437 (setq shell-dirtrackp t)
438 (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil t)
439 (setq comint-input-autoexpand shell-input-autoexpand) 436 (setq comint-input-autoexpand shell-input-autoexpand)
440 ;; This is not really correct, since the shell buffer does not really 437 ;; This is not really correct, since the shell buffer does not really
441 ;; edit this directory. But it is useful in the buffer list and menus. 438 ;; edit this directory. But it is useful in the buffer list and menus.
442 (make-local-variable 'list-buffers-directory) 439 (make-local-variable 'list-buffers-directory)
440 (shell-dirtrack-mode 1)
443 (setq list-buffers-directory (expand-file-name default-directory)) 441 (setq list-buffers-directory (expand-file-name default-directory))
444 ;; shell-dependent assignments. 442 ;; shell-dependent assignments.
445 (when (ring-empty-p comint-input-ring) 443 (when (ring-empty-p comint-input-ring)
@@ -558,48 +556,48 @@ Otherwise, one argument `-i' is passed to the shell.
558 (shell-mode))) 556 (shell-mode)))
559 buffer) 557 buffer)
560 558
561;;; Don't do this when shell.el is loaded, only while dumping. 559;; Don't do this when shell.el is loaded, only while dumping.
562;;;###autoload (add-hook 'same-window-buffer-names "*shell*") 560;;;###autoload (add-hook 'same-window-buffer-names "*shell*")
563 561
564;;; Directory tracking 562;;; Directory tracking
565;;; 563;;
566;;; This code provides the shell mode input sentinel 564;; This code provides the shell mode input sentinel
567;;; SHELL-DIRECTORY-TRACKER 565;; SHELL-DIRECTORY-TRACKER
568;;; that tracks cd, pushd, and popd commands issued to the shell, and 566;; that tracks cd, pushd, and popd commands issued to the shell, and
569;;; changes the current directory of the shell buffer accordingly. 567;; changes the current directory of the shell buffer accordingly.
570;;; 568;;
571;;; This is basically a fragile hack, although it's more accurate than 569;; This is basically a fragile hack, although it's more accurate than
572;;; the version in Emacs 18's shell.el. It has the following failings: 570;; the version in Emacs 18's shell.el. It has the following failings:
573;;; 1. It doesn't know about the cdpath shell variable. 571;; 1. It doesn't know about the cdpath shell variable.
574;;; 2. It cannot infallibly deal with command sequences, though it does well 572;; 2. It cannot infallibly deal with command sequences, though it does well
575;;; with these and with ignoring commands forked in another shell with ()s. 573;; with these and with ignoring commands forked in another shell with ()s.
576;;; 3. More generally, any complex command is going to throw it. Otherwise, 574;; 3. More generally, any complex command is going to throw it. Otherwise,
577;;; you'd have to build an entire shell interpreter in Emacs Lisp. Failing 575;; you'd have to build an entire shell interpreter in Emacs Lisp. Failing
578;;; that, there's no way to catch shell commands where cd's are buried 576;; that, there's no way to catch shell commands where cd's are buried
579;;; inside conditional expressions, aliases, and so forth. 577;; inside conditional expressions, aliases, and so forth.
580;;; 578;;
581;;; The whole approach is a crock. Shell aliases mess it up. File sourcing 579;; The whole approach is a crock. Shell aliases mess it up. File sourcing
582;;; messes it up. You run other processes under the shell; these each have 580;; messes it up. You run other processes under the shell; these each have
583;;; separate working directories, and some have commands for manipulating 581;; separate working directories, and some have commands for manipulating
584;;; their w.d.'s (e.g., the lcd command in ftp). Some of these programs have 582;; their w.d.'s (e.g., the lcd command in ftp). Some of these programs have
585;;; commands that do *not* affect the current w.d. at all, but look like they 583;; commands that do *not* affect the current w.d. at all, but look like they
586;;; do (e.g., the cd command in ftp). In shells that allow you job 584;; do (e.g., the cd command in ftp). In shells that allow you job
587;;; control, you can switch between jobs, all having different w.d.'s. So 585;; control, you can switch between jobs, all having different w.d.'s. So
588;;; simply saying %3 can shift your w.d.. 586;; simply saying %3 can shift your w.d..
589;;; 587;;
590;;; The solution is to relax, not stress out about it, and settle for 588;; The solution is to relax, not stress out about it, and settle for
591;;; a hack that works pretty well in typical circumstances. Remember 589;; a hack that works pretty well in typical circumstances. Remember
592;;; that a half-assed solution is more in keeping with the spirit of Unix, 590;; that a half-assed solution is more in keeping with the spirit of Unix,
593;;; anyway. Blech. 591;; anyway. Blech.
594;;; 592;;
595;;; One good hack not implemented here for users of programmable shells 593;; One good hack not implemented here for users of programmable shells
596;;; is to program up the shell w.d. manipulation commands to output 594;; is to program up the shell w.d. manipulation commands to output
597;;; a coded command sequence to the tty. Something like 595;; a coded command sequence to the tty. Something like
598;;; ESC | <cwd> | 596;; ESC | <cwd> |
599;;; where <cwd> is the new current working directory. Then trash the 597;; where <cwd> is the new current working directory. Then trash the
600;;; directory tracking machinery currently used in this package, and 598;; directory tracking machinery currently used in this package, and
601;;; replace it with a process filter that watches for and strips out 599;; replace it with a process filter that watches for and strips out
602;;; these messages. 600;; these messages.
603 601
604(defun shell-directory-tracker (str) 602(defun shell-directory-tracker (str)
605 "Tracks cd, pushd and popd commands issued to the shell. 603 "Tracks cd, pushd and popd commands issued to the shell.
@@ -607,8 +605,8 @@ This function is called on each input passed to the shell.
607It watches for cd, pushd and popd commands and sets the buffer's 605It watches for cd, pushd and popd commands and sets the buffer's
608default directory to track these commands. 606default directory to track these commands.
609 607
610You may toggle this tracking on and off with M-x dirtrack-mode. 608You may toggle this tracking on and off with \\[dirtrack-mode].
611If Emacs gets confused, you can resync with the shell with M-x dirs. 609If Emacs gets confused, you can resync with the shell with \\[dirs].
612 610
613See variables `shell-cd-regexp', `shell-chdrive-regexp', `shell-pushd-regexp', 611See variables `shell-cd-regexp', `shell-chdrive-regexp', `shell-pushd-regexp',
614and `shell-popd-regexp', while `shell-pushd-tohome', `shell-pushd-dextract', 612and `shell-popd-regexp', while `shell-pushd-tohome', `shell-pushd-dextract',
@@ -677,7 +675,7 @@ Environment variables are expanded, see function `substitute-in-file-name'."
677 (setq string (replace-match "" nil nil string))))) 675 (setq string (replace-match "" nil nil string)))))
678 string))) 676 string)))
679 677
680;;; popd [+n] 678;; popd [+n]
681(defun shell-process-popd (arg) 679(defun shell-process-popd (arg)
682 (let ((num (or (shell-extract-num arg) 0))) 680 (let ((num (or (shell-extract-num arg) 0)))
683 (cond ((and num (= num 0) shell-dirstack) 681 (cond ((and num (= num 0) shell-dirstack)
@@ -703,7 +701,7 @@ Environment variables are expanded, see function `substitute-in-file-name'."
703 ;; For relative name we assume default-directory already has the prefix. 701 ;; For relative name we assume default-directory already has the prefix.
704 (expand-file-name dir)))) 702 (expand-file-name dir))))
705 703
706;;; cd [dir] 704;; cd [dir]
707(defun shell-process-cd (arg) 705(defun shell-process-cd (arg)
708 (let ((new-dir (cond ((zerop (length arg)) (concat comint-file-name-prefix 706 (let ((new-dir (cond ((zerop (length arg)) (concat comint-file-name-prefix
709 "~")) 707 "~"))
@@ -713,7 +711,7 @@ Environment variables are expanded, see function `substitute-in-file-name'."
713 (shell-cd new-dir) 711 (shell-cd new-dir)
714 (shell-dirstack-message))) 712 (shell-dirstack-message)))
715 713
716;;; pushd [+n | dir] 714;; pushd [+n | dir]
717(defun shell-process-pushd (arg) 715(defun shell-process-pushd (arg)
718 (let ((num (shell-extract-num arg))) 716 (let ((num (shell-extract-num arg)))
719 (cond ((zerop (length arg)) 717 (cond ((zerop (length arg))
@@ -762,26 +760,25 @@ Environment variables are expanded, see function `substitute-in-file-name'."
762 (and (string-match "^\\+[1-9][0-9]*$" str) 760 (and (string-match "^\\+[1-9][0-9]*$" str)
763 (string-to-number str))) 761 (string-to-number str)))
764 762
765 763(defvaralias 'shell-dirtrack-mode 'shell-dirtrackp)
766(defun shell-dirtrack-mode () 764(define-minor-mode shell-dirtrack-mode
767 "Turn directory tracking on and off in a shell buffer." 765 "Turn directory tracking on and off in a shell buffer."
768 (interactive) 766 nil nil nil
769 (if (setq shell-dirtrackp (not shell-dirtrackp)) 767 (setq list-buffers-directory (if shell-dirtrack-mode default-directory))
770 (setq list-buffers-directory default-directory) 768 (if shell-dirtrack-mode
771 (setq list-buffers-directory nil)) 769 (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil t)
772 (message "Directory tracking %s" (if shell-dirtrackp "ON" "OFF"))) 770 (remove-hook 'comint-input-filter-functions 'shell-directory-tracker t)))
773 771
774;;; For your typing convenience: 772;; For your typing convenience:
775(defalias 'shell-dirtrack-toggle 'shell-dirtrack-mode) 773(defalias 'shell-dirtrack-toggle 'shell-dirtrack-mode) ;??Convenience??
776(defalias 'dirtrack-toggle 'shell-dirtrack-mode) 774(defalias 'dirtrack-toggle 'shell-dirtrack-mode)
777(defalias 'dirtrack-mode 'shell-dirtrack-mode) 775(defalias 'dirtrack-mode 'shell-dirtrack-mode)
778 776
779(defun shell-cd (dir) 777(defun shell-cd (dir)
780 "Do normal `cd' to DIR, and set `list-buffers-directory'." 778 "Do normal `cd' to DIR, and set `list-buffers-directory'."
779 (cd dir)
781 (if shell-dirtrackp 780 (if shell-dirtrackp
782 (setq list-buffers-directory (file-name-as-directory 781 (setq list-buffers-directory default-directory)))
783 (expand-file-name dir))))
784 (cd dir))
785 782
786(defun shell-resync-dirs () 783(defun shell-resync-dirs ()
787 "Resync the buffer's idea of the current directory stack. 784 "Resync the buffer's idea of the current directory stack.
@@ -841,15 +838,15 @@ command again."
841 (shell-dirstack-message)) 838 (shell-dirstack-message))
842 (error (message "Couldn't cd"))))))) 839 (error (message "Couldn't cd")))))))
843 840
844;;; For your typing convenience: 841;; For your typing convenience:
845(defalias 'dirs 'shell-resync-dirs) 842(defalias 'dirs 'shell-resync-dirs)
846 843
847 844
848;;; Show the current dirstack on the message line. 845;; Show the current dirstack on the message line.
849;;; Pretty up dirs a bit by changing "/usr/jqr/foo" to "~/foo". 846;; Pretty up dirs a bit by changing "/usr/jqr/foo" to "~/foo".
850;;; (This isn't necessary if the dirlisting is generated with a simple "dirs".) 847;; (This isn't necessary if the dirlisting is generated with a simple "dirs".)
851;;; All the commands that mung the buffer's dirstack finish by calling 848;; All the commands that mung the buffer's dirstack finish by calling
852;;; this guy. 849;; this guy.
853(defun shell-dirstack-message () 850(defun shell-dirstack-message ()
854 (when shell-dirtrack-verbose 851 (when shell-dirtrack-verbose
855 (let* ((msg "") 852 (let* ((msg "")
@@ -1076,5 +1073,5 @@ Returns t if successful."
1076 1073
1077(provide 'shell) 1074(provide 'shell)
1078 1075
1079;;; arch-tag: bcb5f12a-c1f4-4aea-a809-2504bd5bd797 1076;; arch-tag: bcb5f12a-c1f4-4aea-a809-2504bd5bd797
1080;;; shell.el ends here 1077;;; shell.el ends here
diff --git a/lisp/simple.el b/lisp/simple.el
index 6d7e3d0a3d9..b023a7b780f 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2549,7 +2549,9 @@ to make one entry in the kill ring.
2549In Lisp code, optional third arg YANK-HANDLER, if non-nil, 2549In Lisp code, optional third arg YANK-HANDLER, if non-nil,
2550specifies the yank-handler text property to be set on the killed 2550specifies the yank-handler text property to be set on the killed
2551text. See `insert-for-yank'." 2551text. See `insert-for-yank'."
2552 (interactive "r") 2552 ;; Pass point first, then mark, because the order matters
2553 ;; when calling kill-append.
2554 (interactive (list (point) (mark)))
2553 (condition-case nil 2555 (condition-case nil
2554 (let ((string (filter-buffer-substring beg end t))) 2556 (let ((string (filter-buffer-substring beg end t)))
2555 (when string ;STRING is nil if BEG = END 2557 (when string ;STRING is nil if BEG = END
@@ -3643,10 +3645,14 @@ Outline mode sets this."
3643 (setq new (point)) 3645 (setq new (point))
3644 3646
3645 ;; Process intangibility within a line. 3647 ;; Process intangibility within a line.
3646 ;; Move to the chosen destination position from above, 3648 ;; With inhibit-point-motion-hooks bound to nil, a call to
3647 ;; with intangibility processing enabled. 3649 ;; goto-char moves point past intangible text.
3648 3650
3649 ;; Avoid calling point-entered and point-left. 3651 ;; However, inhibit-point-motion-hooks controls both the
3652 ;; intangibility and the point-entered/point-left hooks. The
3653 ;; following hack avoids calling the point-* hooks
3654 ;; unnecessarily. Note that we move *forward* past intangible
3655 ;; text when the initial and final points are the same.
3650 (goto-char new) 3656 (goto-char new)
3651 (let ((inhibit-point-motion-hooks nil)) 3657 (let ((inhibit-point-motion-hooks nil))
3652 (goto-char new) 3658 (goto-char new)
@@ -4241,7 +4247,7 @@ The variable `selective-display' has a separate value for each buffer."
4241(defvaralias 'indicate-unused-lines 'indicate-empty-lines) 4247(defvaralias 'indicate-unused-lines 'indicate-empty-lines)
4242(defvaralias 'default-indicate-unused-lines 'default-indicate-empty-lines) 4248(defvaralias 'default-indicate-unused-lines 'default-indicate-empty-lines)
4243 4249
4244(defun toggle-truncate-lines (arg) 4250(defun toggle-truncate-lines (&optional arg)
4245 "Toggle whether to fold or truncate long lines on the screen. 4251 "Toggle whether to fold or truncate long lines on the screen.
4246With arg, truncate long lines iff arg is positive. 4252With arg, truncate long lines iff arg is positive.
4247Note that in side-by-side windows, truncation is always enabled." 4253Note that in side-by-side windows, truncation is always enabled."
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
index 0b3fc82f025..d51fd91c3b4 100644
--- a/lisp/skeleton.el
+++ b/lisp/skeleton.el
@@ -39,14 +39,15 @@
39;; page 3: mirror-mode, an example for setting up paired insertion 39;; page 3: mirror-mode, an example for setting up paired insertion
40 40
41 41
42(defvar skeleton-transformation 'identity 42(defvar skeleton-transformation-function 'identity
43 "*If non-nil, function applied to literal strings before they are inserted. 43 "*If non-nil, function applied to literal strings before they are inserted.
44It should take strings and characters and return them transformed, or nil 44It should take strings and characters and return them transformed, or nil
45which means no transformation. 45which means no transformation.
46Typical examples might be `upcase' or `capitalize'.") 46Typical examples might be `upcase' or `capitalize'.")
47(defvaralias 'skeleton-transformation 'skeleton-transformation-function)
47 48
48; this should be a fourth argument to defvar 49; this should be a fourth argument to defvar
49(put 'skeleton-transformation 'variable-interactive 50(put 'skeleton-transformation-function 'variable-interactive
50 "aTransformation function: ") 51 "aTransformation function: ")
51 52
52 53
@@ -75,8 +76,9 @@ The variables `v1' and `v2' are still set when calling this.")
75 76
76 77
77;;;###autoload 78;;;###autoload
78(defvar skeleton-filter 'identity 79(defvar skeleton-filter-function 'identity
79 "Function for transforming a skeleton proxy's aliases' variable value.") 80 "Function for transforming a skeleton proxy's aliases' variable value.")
81(defvaralias 'skeleton-filter 'skeleton-filter-function)
80 82
81(defvar skeleton-untabify t 83(defvar skeleton-untabify t
82 "When non-nil untabifies when deleting backwards with element -ARG.") 84 "When non-nil untabifies when deleting backwards with element -ARG.")
@@ -157,7 +159,7 @@ This command can also be an abbrev expansion (3rd and 4th columns in
157 159
158Optional second argument STR may also be a string which will be the value 160Optional second argument STR may also be a string which will be the value
159of `str' whereas the skeleton's interactor is then ignored." 161of `str' whereas the skeleton's interactor is then ignored."
160 (skeleton-insert (funcall skeleton-filter skeleton) 162 (skeleton-insert (funcall skeleton-filter-function skeleton)
161 ;; Pretend C-x a e passed its prefix arg to us 163 ;; Pretend C-x a e passed its prefix arg to us
162 (if (or arg current-prefix-arg) 164 (if (or arg current-prefix-arg)
163 (prefix-numeric-value (or arg 165 (prefix-numeric-value (or arg
@@ -199,7 +201,7 @@ SKELETON is made up as (INTERACTOR ELEMENT ...). INTERACTOR may be nil if
199not needed, a prompt-string or an expression for complex read functions. 201not needed, a prompt-string or an expression for complex read functions.
200 202
201If ELEMENT is a string or a character it gets inserted (see also 203If ELEMENT is a string or a character it gets inserted (see also
202`skeleton-transformation'). Other possibilities are: 204`skeleton-transformation-function'). Other possibilities are:
203 205
204 \\n go to next line and indent according to mode 206 \\n go to next line and indent according to mode
205 _ interesting point, interregion here 207 _ interesting point, interregion here
@@ -360,7 +362,7 @@ automatically, and you are prompted to fill in the variable parts.")))
360 (backward-delete-char-untabify (- element)) 362 (backward-delete-char-untabify (- element))
361 (delete-backward-char (- element))) 363 (delete-backward-char (- element)))
362 (insert (if (not literal) 364 (insert (if (not literal)
363 (funcall skeleton-transformation element) 365 (funcall skeleton-transformation-function element)
364 element)))) 366 element))))
365 ((or (eq element '\n) ; actually (eq '\n 'n) 367 ((or (eq element '\n) ; actually (eq '\n 'n)
366 ;; The sequence `> \n' is handled specially so as to indent the first 368 ;; The sequence `> \n' is handled specially so as to indent the first
@@ -464,7 +466,7 @@ will attempt to insert pairs of matching characters.")
464 "*If this is nil, paired insertion is inhibited before or inside a word.") 466 "*If this is nil, paired insertion is inhibited before or inside a word.")
465 467
466 468
467(defvar skeleton-pair-filter (lambda () nil) 469(defvar skeleton-pair-filter-function (lambda () nil)
468 "Attempt paired insertion if this function returns nil, before inserting. 470 "Attempt paired insertion if this function returns nil, before inserting.
469This allows for context-sensitive checking whether pairing is appropriate.") 471This allows for context-sensitive checking whether pairing is appropriate.")
470 472
@@ -490,7 +492,7 @@ Elements might be (?` ?` _ \"''\"), (?\\( ? _ \" )\") or (?{ \\n > _ \\n ?} >).
490With no ARG, if `skeleton-pair' is non-nil, pairing can occur. If the region 492With no ARG, if `skeleton-pair' is non-nil, pairing can occur. If the region
491is visible the pair is wrapped around it depending on `skeleton-autowrap'. 493is visible the pair is wrapped around it depending on `skeleton-autowrap'.
492Else, if `skeleton-pair-on-word' is non-nil or we are not before or inside a 494Else, if `skeleton-pair-on-word' is non-nil or we are not before or inside a
493word, and if `skeleton-pair-filter' returns nil, pairing is performed. 495word, and if `skeleton-pair-filter-function' returns nil, pairing is performed.
494Pairing is also prohibited if we are right after a quoting character 496Pairing is also prohibited if we are right after a quoting character
495such as backslash. 497such as backslash.
496 498
@@ -512,7 +514,7 @@ symmetrical ones, and the same character twice for the others."
512 (and (not mark) 514 (and (not mark)
513 (or overwrite-mode 515 (or overwrite-mode
514 (if (not skeleton-pair-on-word) (looking-at "\\w")) 516 (if (not skeleton-pair-on-word) (looking-at "\\w"))
515 (funcall skeleton-pair-filter)))) 517 (funcall skeleton-pair-filter-function))))
516 (self-insert-command (prefix-numeric-value arg)) 518 (self-insert-command (prefix-numeric-value arg))
517 (skeleton-insert (cons nil skeleton) (if mark -1)))))) 519 (skeleton-insert (cons nil skeleton) (if mark -1))))))
518 520
@@ -526,13 +528,13 @@ symmetrical ones, and the same character twice for the others."
526;; (kill-all-local-variables) 528;; (kill-all-local-variables)
527;; (make-local-variable 'skeleton-pair) 529;; (make-local-variable 'skeleton-pair)
528;; (make-local-variable 'skeleton-pair-on-word) 530;; (make-local-variable 'skeleton-pair-on-word)
529;; (make-local-variable 'skeleton-pair-filter) 531;; (make-local-variable 'skeleton-pair-filter-function)
530;; (make-local-variable 'skeleton-pair-alist) 532;; (make-local-variable 'skeleton-pair-alist)
531;; (setq major-mode 'mirror-mode 533;; (setq major-mode 'mirror-mode
532;; mode-name "Mirror" 534;; mode-name "Mirror"
533;; skeleton-pair-on-word t 535;; skeleton-pair-on-word t
534;; ;; in the middle column insert one or none if odd window-width 536;; ;; in the middle column insert one or none if odd window-width
535;; skeleton-pair-filter (lambda () 537;; skeleton-pair-filter-function (lambda ()
536;; (if (>= (current-column) 538;; (if (>= (current-column)
537;; (/ (window-width) 2)) 539;; (/ (window-width) 2))
538;; ;; insert both on next line 540;; ;; insert both on next line
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index b3913f6f6c6..e5ab181e8c6 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -921,8 +921,6 @@ This basically creates a sparse keymap, and makes it's parent be
921 (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) 921 (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
922 (list ["Customize..." speedbar-customize t])) 922 (list ["Customize..." speedbar-customize t]))
923 (list 923 (list
924 ["Detach" speedbar-detach (and speedbar-frame
925 (eq (selected-frame) speedbar-frame)) ]
926 ["Close" dframe-close-frame t] 924 ["Close" dframe-close-frame t]
927 ["Quit" delete-frame t] )) 925 ["Quit" delete-frame t] ))
928 "Menu items appearing at the end of the speedbar menu.") 926 "Menu items appearing at the end of the speedbar menu.")
@@ -1047,21 +1045,6 @@ supported at a time.
1047 (dframe-attached-frame speedbar-frame) 1045 (dframe-attached-frame speedbar-frame)
1048 speedbar-default-position)))) 1046 speedbar-default-position))))
1049 1047
1050(defun speedbar-detach ()
1051 "Detach the current Speedbar from auto-updating.
1052Doing this allows the creation of a second speedbar."
1053 (interactive)
1054 (let ((buffer speedbar-buffer))
1055 (dframe-detach 'speedbar-frame 'speedbar-cached-frame 'speedbar-buffer)
1056 (save-excursion
1057 (set-buffer buffer)
1058 ;; Permanently disable auto-updating in this speedbar buffer.
1059 (set (make-local-variable 'speedbar-update-flag) nil)
1060 (set (make-local-variable 'speedbar-update-flag-disable) t)
1061 ;; Make local copies of all the different variables to prevent
1062 ;; funny stuff later...
1063 )))
1064
1065(defsubst speedbar-current-frame () 1048(defsubst speedbar-current-frame ()
1066 "Return the frame to use for speedbar based on current context." 1049 "Return the frame to use for speedbar based on current context."
1067 (dframe-current-frame 'speedbar-frame 'speedbar-mode)) 1050 (dframe-current-frame 'speedbar-frame 'speedbar-mode))
@@ -1224,11 +1207,8 @@ and the existence of packages."
1224 (speedbar-initial-menu) 1207 (speedbar-initial-menu)
1225 (save-excursion 1208 (save-excursion
1226 (dframe-select-attached-frame speedbar-frame) 1209 (dframe-select-attached-frame speedbar-frame)
1227 (if (local-variable-p 1210 (eval (nth 1 (assoc speedbar-initial-expansion-list-name
1228 'speedbar-easymenu-definition-special 1211 speedbar-initial-expansion-mode-alist)))))
1229 (current-buffer))
1230 ;; If bound locally, we can use it
1231 speedbar-easymenu-definition-special)))
1232 ;; Dynamic menu stuff 1212 ;; Dynamic menu stuff
1233 '("-") 1213 '("-")
1234 (list (cons "Displays" 1214 (list (cons "Displays"
diff --git a/lisp/startup.el b/lisp/startup.el
index f1a68fd8509..33138ef3875 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -644,18 +644,17 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
644 644
645 ;; Convert preloaded file names to absolute. 645 ;; Convert preloaded file names to absolute.
646 (let ((lisp-dir 646 (let ((lisp-dir
647 (file-name-directory 647 (file-truename
648 (locate-file "simple" load-path 648 (file-name-directory
649 (get-load-suffixes))))) 649 (locate-file "simple" load-path
650 (get-load-suffixes))))))
650 651
651 (setq load-history 652 (setq load-history
652 (mapcar (lambda (elt) 653 (mapcar (lambda (elt)
653 (if (and (stringp (car elt)) 654 (if (and (stringp (car elt))
654 (not (file-name-absolute-p (car elt)))) 655 (not (file-name-absolute-p (car elt))))
655 (cons (concat lisp-dir 656 (cons (concat lisp-dir
656 (car elt) 657 (car elt))
657 (if (string-match "[.]el$" (car elt))
658 "" ".elc"))
659 (cdr elt)) 658 (cdr elt))
660 elt)) 659 elt))
661 load-history))) 660 load-history)))
diff --git a/lisp/subr.el b/lisp/subr.el
index cd0ce2d3f33..387228fbb8c 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1393,32 +1393,94 @@ That function's doc string says which file created it."
1393 t)) 1393 t))
1394 nil)) 1394 nil))
1395 1395
1396(defun load-history-regexp (file)
1397 "Form a regexp to find FILE in `load-history'.
1398FILE, a string, is described in the function `eval-after-load'."
1399 (if (file-name-absolute-p file)
1400 (setq file (file-truename file)))
1401 (concat (if (file-name-absolute-p file) "\\`" "\\(\\`\\|/\\)")
1402 (regexp-quote file)
1403 (if (file-name-extension file)
1404 ""
1405 ;; Note: regexp-opt can't be used here, since we need to call
1406 ;; this before Emacs has been fully started. 2006-05-21
1407 (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?"))
1408 "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|")
1409 "\\)?\\'"))
1410
1411(defun load-history-filename-element (file-regexp)
1412 "Get the first elt of `load-history' whose car matches FILE-REGEXP.
1413Return nil if there isn't one."
1414 (let* ((loads load-history)
1415 (load-elt (and loads (car loads))))
1416 (save-match-data
1417 (while (and loads
1418 (or (null (car load-elt))
1419 (not (string-match file-regexp (car load-elt)))))
1420 (setq loads (cdr loads)
1421 load-elt (and loads (car loads)))))
1422 load-elt))
1423
1396(defun eval-after-load (file form) 1424(defun eval-after-load (file form)
1397 "Arrange that, if FILE is ever loaded, FORM will be run at that time. 1425 "Arrange that, if FILE is ever loaded, FORM will be run at that time.
1398This makes or adds to an entry on `after-load-alist'.
1399If FILE is already loaded, evaluate FORM right now. 1426If FILE is already loaded, evaluate FORM right now.
1400It does nothing if FORM is already on the list for FILE. 1427
1401FILE must match exactly. Normally FILE is the name of a library, 1428If a matching file is loaded again, FORM will be evaluated again.
1402with no directory or extension specified, since that is how `load' 1429
1403is normally called. 1430If FILE is a string, it may be either an absolute or a relative file
1404FILE can also be a feature (i.e. a symbol), in which case FORM is 1431name, and may have an extension \(e.g. \".el\") or may lack one, and
1405evaluated whenever that feature is `provide'd." 1432additionally may or may not have an extension denoting a compressed
1406 (let ((elt (assoc file after-load-alist))) 1433format \(e.g. \".gz\").
1407 ;; Make sure there is an element for FILE. 1434
1408 (unless elt (setq elt (list file)) (push elt after-load-alist)) 1435When FILE is absolute, this first converts it to a true name by chasing
1409 ;; Add FORM to the element if it isn't there. 1436symbolic links. Only a file of this name \(see next paragraph regarding
1437extensions) will trigger the evaluation of FORM. When FILE is relative,
1438a file whose absolute true name ends in FILE will trigger evaluation.
1439
1440When FILE lacks an extension, a file name with any extension will trigger
1441evaluation. Otherwise, its extension must match FILE's. A further
1442extension for a compressed format \(e.g. \".gz\") on FILE will not affect
1443this name matching.
1444
1445Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM
1446is evaluated whenever that feature is `provide'd.
1447
1448Usually FILE is just a library name like \"font-lock\" or a feature name
1449like 'font-lock.
1450
1451This function makes or adds to an entry on `after-load-alist'."
1452 ;; Add this FORM into after-load-alist (regardless of whether we'll be
1453 ;; evaluating it now).
1454 (let* ((regexp-or-feature
1455 (if (stringp file) (load-history-regexp file) file))
1456 (elt (assoc regexp-or-feature after-load-alist)))
1457 (unless elt
1458 (setq elt (list regexp-or-feature))
1459 (push elt after-load-alist))
1460 ;; Add FORM to the element unless it's already there.
1410 (unless (member form (cdr elt)) 1461 (unless (member form (cdr elt))
1411 (nconc elt (list form)) 1462 (nconc elt (list form)))
1412 ;; If the file has been loaded already, run FORM right away. 1463
1413 (if (if (symbolp file) 1464 ;; Is there an already loaded file whose name (or `provide' name)
1414 (featurep file) 1465 ;; matches FILE?
1415 ;; Make sure `load-history' contains the files dumped with 1466 (if (if (stringp file)
1416 ;; Emacs for the case that FILE is one of them. 1467 (load-history-filename-element regexp-or-feature)
1417 ;; (load-symbol-file-load-history) 1468 (featurep file))
1418 (when (locate-library file) 1469 (eval form))))
1419 (assoc (locate-library file) load-history))) 1470
1420 (eval form)))) 1471(defun do-after-load-evaluation (abs-file)
1421 form) 1472 "Evaluate all `eval-after-load' forms, if any, for ABS-FILE.
1473ABS-FILE, a string, should be the absolute true name of a file just loaded."
1474 (let ((after-load-elts after-load-alist)
1475 a-l-element file-elements file-element form)
1476 (while after-load-elts
1477 (setq a-l-element (car after-load-elts)
1478 after-load-elts (cdr after-load-elts))
1479 (when (and (stringp (car a-l-element))
1480 (string-match (car a-l-element) abs-file))
1481 (while (setq a-l-element (cdr a-l-element)) ; discard the file name
1482 (setq form (car a-l-element))
1483 (eval form))))))
1422 1484
1423(defun eval-next-after-load (file) 1485(defun eval-next-after-load (file)
1424 "Read the following input sexp, and run it whenever FILE is loaded. 1486 "Read the following input sexp, and run it whenever FILE is loaded.
@@ -1555,7 +1617,7 @@ Optional DEFAULT is a default password to use instead of empty input.
1555This function echoes `.' for each character that the user types. 1617This function echoes `.' for each character that the user types.
1556The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. 1618The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line.
1557C-g quits; if `inhibit-quit' was non-nil around this function, 1619C-g quits; if `inhibit-quit' was non-nil around this function,
1558then it returns nil if the user types C-g. 1620then it returns nil if the user types C-g, but quit-flag remains set.
1559 1621
1560Once the caller uses the password, it can erase the password 1622Once the caller uses the password, it can erase the password
1561by doing (clear-string STRING)." 1623by doing (clear-string STRING)."
@@ -1575,6 +1637,9 @@ by doing (clear-string STRING)."
1575 (sit-for 1)))) 1637 (sit-for 1))))
1576 success) 1638 success)
1577 (let ((pass nil) 1639 (let ((pass nil)
1640 ;; Copy it so that add-text-properties won't modify
1641 ;; the object that was passed in by the caller.
1642 (prompt (copy-sequence prompt))
1578 (c 0) 1643 (c 0)
1579 (echo-keystrokes 0) 1644 (echo-keystrokes 0)
1580 (cursor-in-echo-area t) 1645 (cursor-in-echo-area t)
@@ -2137,7 +2202,8 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again."
2137;;;; Lisp macros to do various things temporarily. 2202;;;; Lisp macros to do various things temporarily.
2138 2203
2139(defmacro with-current-buffer (buffer &rest body) 2204(defmacro with-current-buffer (buffer &rest body)
2140 "Execute the forms in BODY with BUFFER as the current buffer. 2205 "Execute the forms in BODY with BUFFER temporarily current.
2206BUFFER can be a buffer or a buffer name.
2141The value returned is the value of the last form in BODY. 2207The value returned is the value of the last form in BODY.
2142See also `with-temp-buffer'." 2208See also `with-temp-buffer'."
2143 (declare (indent 1) (debug t)) 2209 (declare (indent 1) (debug t))
@@ -2250,13 +2316,19 @@ See also `with-temp-file' and `with-output-to-string'."
2250(defmacro with-local-quit (&rest body) 2316(defmacro with-local-quit (&rest body)
2251 "Execute BODY, allowing quits to terminate BODY but not escape further. 2317 "Execute BODY, allowing quits to terminate BODY but not escape further.
2252When a quit terminates BODY, `with-local-quit' returns nil but 2318When a quit terminates BODY, `with-local-quit' returns nil but
2253requests another quit. That quit will be processed, the next time quitting 2319requests another quit. That quit will be processed as soon as quitting
2254is allowed once again." 2320is allowed once again. (Immediately, if `inhibit-quit' is nil.)"
2255 (declare (debug t) (indent 0)) 2321 (declare (debug t) (indent 0))
2256 `(condition-case nil 2322 `(condition-case nil
2257 (let ((inhibit-quit nil)) 2323 (let ((inhibit-quit nil))
2258 ,@body) 2324 ,@body)
2259 (quit (setq quit-flag t) nil))) 2325 (quit (setq quit-flag t)
2326 ;; This call is to give a chance to handle quit-flag
2327 ;; in case inhibit-quit is nil.
2328 ;; Without this, it will not be handled until the next function
2329 ;; call, and that might allow it to exit thru a condition-case
2330 ;; that intends to handle the quit signal next time.
2331 (eval '(ignore nil)))))
2260 2332
2261(defmacro while-no-input (&rest body) 2333(defmacro while-no-input (&rest body)
2262 "Execute BODY only as long as there's no pending input. 2334 "Execute BODY only as long as there's no pending input.
diff --git a/lisp/term.el b/lisp/term.el
index 64f0efc767b..9ecb1efa948 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -660,13 +660,6 @@ Buffer local variable.")
660(put 'term-scroll-show-maximum-output 'permanent-local t) 660(put 'term-scroll-show-maximum-output 'permanent-local t)
661(put 'term-ptyp 'permanent-local t) 661(put 'term-ptyp 'permanent-local t)
662 662
663;; Do FORM if running under XEmacs (previously Lucid Emacs).
664(defmacro term-if-xemacs (&rest forms)
665 (if (featurep 'xemacs) (cons 'progn forms)))
666;; Do FORM if NOT running under XEmacs (previously Lucid Emacs).
667(defmacro term-ifnot-xemacs (&rest forms)
668 (if (not (featurep 'xemacs)) (cons 'progn forms)))
669
670(defmacro term-in-char-mode () '(eq (current-local-map) term-raw-map)) 663(defmacro term-in-char-mode () '(eq (current-local-map) term-raw-map))
671(defmacro term-in-line-mode () '(not (term-in-char-mode))) 664(defmacro term-in-line-mode () '(not (term-in-char-mode)))
672;; True if currently doing PAGER handling. 665;; True if currently doing PAGER handling.
@@ -725,13 +718,13 @@ Notice that a setting of 0 means 'don't truncate anything'. This variable
725is buffer-local.") 718is buffer-local.")
726;;; 719;;;
727 720
728(term-if-xemacs 721(when (featurep 'xemacs)
729 (defvar term-terminal-menu 722 (defvar term-terminal-menu
730 '("Terminal" 723 '("Terminal"
731 [ "Character mode" term-char-mode (term-in-line-mode)] 724 [ "Character mode" term-char-mode (term-in-line-mode)]
732 [ "Line mode" term-line-mode (term-in-char-mode)] 725 [ "Line mode" term-line-mode (term-in-char-mode)]
733 [ "Enable paging" term-pager-toggle (not term-pager-count)] 726 [ "Enable paging" term-pager-toggle (not term-pager-count)]
734 [ "Disable paging" term-pager-toggle term-pager-count]))) 727 [ "Disable paging" term-pager-toggle term-pager-count])))
735 728
736(unless term-mode-map 729(unless term-mode-map
737 (setq term-mode-map (make-sparse-keymap)) 730 (setq term-mode-map (make-sparse-keymap))
@@ -739,10 +732,10 @@ is buffer-local.")
739 (define-key term-mode-map "\en" 'term-next-input) 732 (define-key term-mode-map "\en" 'term-next-input)
740 (define-key term-mode-map "\er" 'term-previous-matching-input) 733 (define-key term-mode-map "\er" 'term-previous-matching-input)
741 (define-key term-mode-map "\es" 'term-next-matching-input) 734 (define-key term-mode-map "\es" 'term-next-matching-input)
742 (term-ifnot-xemacs 735 (unless (featurep 'xemacs)
743 (define-key term-mode-map [?\A-\M-r] 736 (define-key term-mode-map [?\A-\M-r]
744 'term-previous-matching-input-from-input) 737 'term-previous-matching-input-from-input)
745 (define-key term-mode-map [?\A-\M-s] 'term-next-matching-input-from-input)) 738 (define-key term-mode-map [?\A-\M-s] 'term-next-matching-input-from-input))
746 (define-key term-mode-map "\e\C-l" 'term-show-output) 739 (define-key term-mode-map "\e\C-l" 'term-show-output)
747 (define-key term-mode-map "\C-m" 'term-send-input) 740 (define-key term-mode-map "\C-m" 'term-send-input)
748 (define-key term-mode-map "\C-d" 'term-delchar-or-maybe-eof) 741 (define-key term-mode-map "\C-d" 'term-delchar-or-maybe-eof)
@@ -781,9 +774,7 @@ is buffer-local.")
781 ) 774 )
782 775
783;; Menu bars: 776;; Menu bars:
784(term-ifnot-xemacs 777(unless (featurep 'xemacs)
785 (progn
786
787 ;; terminal: 778 ;; terminal:
788 (let (newmap) 779 (let (newmap)
789 (setq newmap (make-sparse-keymap "Terminal")) 780 (setq newmap (make-sparse-keymap "Terminal"))
@@ -860,14 +851,14 @@ is buffer-local.")
860 (define-key newmap [] '("BREAK" . term-interrupt-subjob)) 851 (define-key newmap [] '("BREAK" . term-interrupt-subjob))
861 (define-key term-mode-map [menu-bar signals] 852 (define-key term-mode-map [menu-bar signals]
862 (setq term-signals-menu (cons "Signals" newmap))) 853 (setq term-signals-menu (cons "Signals" newmap)))
863 ))) 854 ))
864 855
865;; Set up term-raw-map, etc. 856;; Set up term-raw-map, etc.
866 857
867(defun term-set-escape-char (c) 858(defun term-set-escape-char (c)
868 "Change term-escape-char and keymaps that depend on it." 859 "Change term-escape-char and keymaps that depend on it."
869 (if term-escape-char 860 (when term-escape-char
870 (define-key term-raw-map term-escape-char 'term-send-raw)) 861 (define-key term-raw-map term-escape-char 'term-send-raw))
871 (setq c (make-string 1 c)) 862 (setq c (make-string 1 c))
872 (define-key term-raw-map c term-raw-escape-map) 863 (define-key term-raw-map c term-raw-escape-map)
873 ;; Define standard bindings in term-raw-escape-map 864 ;; Define standard bindings in term-raw-escape-map
@@ -899,28 +890,26 @@ is buffer-local.")
899 890
900;;; Added nearly all the 'grey keys' -mm 891;;; Added nearly all the 'grey keys' -mm
901 892
902 (progn 893 (if (featurep 'xemacs)
903 (term-if-xemacs 894 (define-key term-raw-map [button2] 'term-mouse-paste)
904 (define-key term-raw-map [button2] 'term-mouse-paste)) 895 (define-key term-raw-map [mouse-2] 'term-mouse-paste)
905 (term-ifnot-xemacs 896 (define-key term-raw-map [menu-bar terminal] term-terminal-menu)
906 (define-key term-raw-map [mouse-2] 'term-mouse-paste) 897 (define-key term-raw-map [menu-bar signals] term-signals-menu))
907 (define-key term-raw-map [menu-bar terminal] term-terminal-menu) 898 (define-key term-raw-map [up] 'term-send-up)
908 (define-key term-raw-map [menu-bar signals] term-signals-menu)) 899 (define-key term-raw-map [down] 'term-send-down)
909 (define-key term-raw-map [up] 'term-send-up) 900 (define-key term-raw-map [right] 'term-send-right)
910 (define-key term-raw-map [down] 'term-send-down) 901 (define-key term-raw-map [left] 'term-send-left)
911 (define-key term-raw-map [right] 'term-send-right) 902 (define-key term-raw-map [delete] 'term-send-del)
912 (define-key term-raw-map [left] 'term-send-left) 903 (define-key term-raw-map [deletechar] 'term-send-del)
913 (define-key term-raw-map [delete] 'term-send-del) 904 (define-key term-raw-map [backspace] 'term-send-backspace)
914 (define-key term-raw-map [deletechar] 'term-send-del) 905 (define-key term-raw-map [home] 'term-send-home)
915 (define-key term-raw-map [backspace] 'term-send-backspace) 906 (define-key term-raw-map [end] 'term-send-end)
916 (define-key term-raw-map [home] 'term-send-home) 907 (define-key term-raw-map [insert] 'term-send-insert)
917 (define-key term-raw-map [end] 'term-send-end) 908 (define-key term-raw-map [S-prior] 'scroll-down)
918 (define-key term-raw-map [insert] 'term-send-insert) 909 (define-key term-raw-map [S-next] 'scroll-up)
919 (define-key term-raw-map [S-prior] 'scroll-down) 910 (define-key term-raw-map [S-insert] 'term-paste)
920 (define-key term-raw-map [S-next] 'scroll-up) 911 (define-key term-raw-map [prior] 'term-send-prior)
921 (define-key term-raw-map [S-insert] 'term-paste) 912 (define-key term-raw-map [next] 'term-send-next))
922 (define-key term-raw-map [prior] 'term-send-prior)
923 (define-key term-raw-map [next] 'term-send-next)))
924 913
925(term-set-escape-char ?\C-c) 914(term-set-escape-char ?\C-c)
926 915
@@ -1112,9 +1101,9 @@ Entry to this mode runs the hooks on `term-mode-hook'."
1112 ;; Cua-mode's keybindings interfere with the term keybindings, disable it. 1101 ;; Cua-mode's keybindings interfere with the term keybindings, disable it.
1113 (set (make-local-variable 'cua-mode) nil) 1102 (set (make-local-variable 'cua-mode) nil)
1114 (run-mode-hooks 'term-mode-hook) 1103 (run-mode-hooks 'term-mode-hook)
1115 (term-if-xemacs 1104 (when (featurep 'xemacs)
1116 (set-buffer-menubar 1105 (set-buffer-menubar
1117 (append current-menubar (list term-terminal-menu)))) 1106 (append current-menubar (list term-terminal-menu))))
1118 (or term-input-ring 1107 (or term-input-ring
1119 (setq term-input-ring (make-ring term-input-ring-size))) 1108 (setq term-input-ring (make-ring term-input-ring-size)))
1120 (term-update-mode-line)) 1109 (term-update-mode-line))
@@ -1151,16 +1140,15 @@ Entry to this mode runs the hooks on `term-mode-hook'."
1151 (setq term-start-line-column nil) 1140 (setq term-start-line-column nil)
1152 (setq cur nil found t)) 1141 (setq cur nil found t))
1153 (setq cur (cdr cur)))))) 1142 (setq cur (cdr cur))))))
1154 (if (not found) 1143 (when (not found)
1155 (goto-char save-point))) 1144 (goto-char save-point)))
1156 found)) 1145 found))
1157 1146
1158(defun term-check-size (process) 1147(defun term-check-size (process)
1159 (if (or (/= term-height (1- (window-height))) 1148 (when (or (/= term-height (1- (window-height)))
1160 (/= term-width (term-window-width))) 1149 (/= term-width (term-window-width)))
1161 (progn 1150 (term-reset-size (1- (window-height)) (term-window-width))
1162 (term-reset-size (1- (window-height)) (term-window-width)) 1151 (set-process-window-size process term-height term-width)))
1163 (set-process-window-size process term-height term-width))))
1164 1152
1165(defun term-send-raw-string (chars) 1153(defun term-send-raw-string (chars)
1166 (let ((proc (get-buffer-process (current-buffer)))) 1154 (let ((proc (get-buffer-process (current-buffer))))
@@ -1169,8 +1157,8 @@ Entry to this mode runs the hooks on `term-mode-hook'."
1169 ;; Note that (term-current-row) must be called *after* 1157 ;; Note that (term-current-row) must be called *after*
1170 ;; (point) has been updated to (process-mark proc). 1158 ;; (point) has been updated to (process-mark proc).
1171 (goto-char (process-mark proc)) 1159 (goto-char (process-mark proc))
1172 (if (term-pager-enabled) 1160 (when (term-pager-enabled)
1173 (setq term-pager-count (term-current-row))) 1161 (setq term-pager-count (term-current-row)))
1174 (process-send-string proc chars)))) 1162 (process-send-string proc chars))))
1175 1163
1176(defun term-send-raw () 1164(defun term-send-raw ()
@@ -1178,9 +1166,9 @@ Entry to this mode runs the hooks on `term-mode-hook'."
1178without any interpretation." 1166without any interpretation."
1179 (interactive) 1167 (interactive)
1180 ;; Convert `return' to C-m, etc. 1168 ;; Convert `return' to C-m, etc.
1181 (if (and (symbolp last-input-char) 1169 (when (and (symbolp last-input-char)
1182 (get last-input-char 'ascii-character)) 1170 (get last-input-char 'ascii-character))
1183 (setq last-input-char (get last-input-char 'ascii-character))) 1171 (setq last-input-char (get last-input-char 'ascii-character)))
1184 (term-send-raw-string (make-string 1 last-input-char))) 1172 (term-send-raw-string (make-string 1 last-input-char)))
1185 1173
1186(defun term-send-raw-meta () 1174(defun term-send-raw-meta ()
@@ -1205,19 +1193,19 @@ without any interpretation."
1205(defun term-mouse-paste (click arg) 1193(defun term-mouse-paste (click arg)
1206 "Insert the last stretch of killed text at the position clicked on." 1194 "Insert the last stretch of killed text at the position clicked on."
1207 (interactive "e\nP") 1195 (interactive "e\nP")
1208 (term-if-xemacs 1196 (if (featurep 'xemacs)
1209 (term-send-raw-string (or (condition-case () (x-get-selection) (error ())) 1197 (term-send-raw-string
1210 (x-get-cutbuffer) 1198 (or (condition-case () (x-get-selection) (error ()))
1211 (error "No selection or cut buffer available")))) 1199 (x-get-cutbuffer)
1212 (term-ifnot-xemacs 1200 (error "No selection or cut buffer available")))
1213 ;; Give temporary modes such as isearch a chance to turn off. 1201 ;; Give temporary modes such as isearch a chance to turn off.
1214 (run-hooks 'mouse-leave-buffer-hook) 1202 (run-hooks 'mouse-leave-buffer-hook)
1215 (setq this-command 'yank) 1203 (setq this-command 'yank)
1216 (mouse-set-point click) 1204 (mouse-set-point click)
1217 (term-send-raw-string (current-kill (cond 1205 (term-send-raw-string (current-kill (cond
1218 ((listp arg) 0) 1206 ((listp arg) 0)
1219 ((eq arg '-) -1) 1207 ((eq arg '-) -1)
1220 (t (1- arg))))))) 1208 (t (1- arg)))))))
1221 1209
1222(defun term-paste () 1210(defun term-paste ()
1223 "Insert the last stretch of killed text at point." 1211 "Insert the last stretch of killed text at point."
@@ -1246,33 +1234,31 @@ Each character you type is sent directly to the inferior without
1246intervention from Emacs, except for the escape character (usually C-c)." 1234intervention from Emacs, except for the escape character (usually C-c)."
1247 (interactive) 1235 (interactive)
1248 ;; FIXME: Emit message? Cfr ilisp-raw-message 1236 ;; FIXME: Emit message? Cfr ilisp-raw-message
1249 (if (term-in-line-mode) 1237 (when (term-in-line-mode)
1250 (progn 1238 (setq term-old-mode-map (current-local-map))
1251 (setq term-old-mode-map (current-local-map)) 1239 (use-local-map term-raw-map)
1252 (use-local-map term-raw-map) 1240
1253 1241 ;; Send existing partial line to inferior (without newline).
1254 ;; Send existing partial line to inferior (without newline). 1242 (let ((pmark (process-mark (get-buffer-process (current-buffer))))
1255 (let ((pmark (process-mark (get-buffer-process (current-buffer)))) 1243 (save-input-sender term-input-sender))
1256 (save-input-sender term-input-sender)) 1244 (when (> (point) pmark)
1257 (if (> (point) pmark) 1245 (unwind-protect
1258 (unwind-protect 1246 (progn
1259 (progn 1247 (setq term-input-sender
1260 (setq term-input-sender 1248 (symbol-function 'term-send-string))
1261 (symbol-function 'term-send-string)) 1249 (end-of-line)
1262 (end-of-line) 1250 (term-send-input))
1263 (term-send-input)) 1251 (setq term-input-sender save-input-sender))))
1264 (setq term-input-sender save-input-sender)))) 1252 (term-update-mode-line)))
1265 (term-update-mode-line))))
1266 1253
1267(defun term-line-mode () 1254(defun term-line-mode ()
1268 "Switch to line (\"cooked\") sub-mode of term mode. 1255 "Switch to line (\"cooked\") sub-mode of term mode.
1269This means that Emacs editing commands work as normally, until 1256This means that Emacs editing commands work as normally, until
1270you type \\[term-send-input] which sends the current line to the inferior." 1257you type \\[term-send-input] which sends the current line to the inferior."
1271 (interactive) 1258 (interactive)
1272 (if (term-in-char-mode) 1259 (when (term-in-char-mode)
1273 (progn 1260 (use-local-map term-old-mode-map)
1274 (use-local-map term-old-mode-map) 1261 (term-update-mode-line)))
1275 (term-update-mode-line))))
1276 1262
1277(defun term-update-mode-line () 1263(defun term-update-mode-line ()
1278 (setq mode-line-process 1264 (setq mode-line-process
@@ -1330,7 +1316,7 @@ buffer. The hook term-exec-hook is run after each exec."
1330 (save-excursion 1316 (save-excursion
1331 (set-buffer buffer) 1317 (set-buffer buffer)
1332 (let ((proc (get-buffer-process buffer))) ; Blast any old process. 1318 (let ((proc (get-buffer-process buffer))) ; Blast any old process.
1333 (if proc (delete-process proc))) 1319 (when proc (delete-process proc)))
1334 ;; Crank up a new process 1320 ;; Crank up a new process
1335 (let ((proc (term-exec-1 name buffer command switches))) 1321 (let ((proc (term-exec-1 name buffer command switches)))
1336 (make-local-variable 'term-ptyp) 1322 (make-local-variable 'term-ptyp)
@@ -1360,29 +1346,28 @@ buffer. The hook term-exec-hook is run after each exec."
1360 "Sentinel for term buffers. 1346 "Sentinel for term buffers.
1361The main purpose is to get rid of the local keymap." 1347The main purpose is to get rid of the local keymap."
1362 (let ((buffer (process-buffer proc))) 1348 (let ((buffer (process-buffer proc)))
1363 (if (memq (process-status proc) '(signal exit)) 1349 (when (memq (process-status proc) '(signal exit))
1364 (progn 1350 (if (null (buffer-name buffer))
1365 (if (null (buffer-name buffer)) 1351 ;; buffer killed
1366 ;; buffer killed 1352 (set-process-buffer proc nil)
1367 (set-process-buffer proc nil) 1353 (let ((obuf (current-buffer)))
1368 (let ((obuf (current-buffer))) 1354 ;; save-excursion isn't the right thing if
1369 ;; save-excursion isn't the right thing if 1355 ;; process-buffer is current-buffer
1370 ;; process-buffer is current-buffer 1356 (unwind-protect
1371 (unwind-protect 1357 (progn
1372 (progn 1358 ;; Write something in the compilation buffer
1373 ;; Write something in the compilation buffer 1359 ;; and hack its mode line.
1374 ;; and hack its mode line. 1360 (set-buffer buffer)
1375 (set-buffer buffer) 1361 ;; Get rid of local keymap.
1376 ;; Get rid of local keymap. 1362 (use-local-map nil)
1377 (use-local-map nil) 1363 (term-handle-exit (process-name proc)
1378 (term-handle-exit (process-name proc) 1364 msg)
1379 msg) 1365 ;; Since the buffer and mode line will show that the
1380 ;; Since the buffer and mode line will show that the 1366 ;; process is dead, we can delete it now. Otherwise it
1381 ;; process is dead, we can delete it now. Otherwise it 1367 ;; will stay around until M-x list-processes.
1382 ;; will stay around until M-x list-processes. 1368 (delete-process proc))
1383 (delete-process proc)) 1369 (set-buffer obuf)))
1384 (set-buffer obuf)))) 1370 ))))
1385 ))))
1386 1371
1387(defun term-handle-exit (process-name msg) 1372(defun term-handle-exit (process-name msg)
1388 "Write process exit (or other change) message MSG in the current buffer." 1373 "Write process exit (or other change) message MSG in the current buffer."
@@ -1395,8 +1380,8 @@ The main purpose is to get rid of the local keymap."
1395 (insert ?\n "Process " process-name " " msg) 1380 (insert ?\n "Process " process-name " " msg)
1396 ;; Force mode line redisplay soon. 1381 ;; Force mode line redisplay soon.
1397 (force-mode-line-update) 1382 (force-mode-line-update)
1398 (if (and opoint (< opoint omax)) 1383 (when (and opoint (< opoint omax))
1399 (goto-char opoint)))) 1384 (goto-char opoint))))
1400 1385
1401 1386
1402;;; Name to use for TERM. 1387;;; Name to use for TERM.
@@ -1519,9 +1504,9 @@ See also `term-input-ignoredups' and `term-write-input-ring'."
1519 nil t)) 1504 nil t))
1520 (let ((history (buffer-substring (match-beginning 1) 1505 (let ((history (buffer-substring (match-beginning 1)
1521 (match-end 1)))) 1506 (match-end 1))))
1522 (if (or (null term-input-ignoredups) 1507 (when (or (null term-input-ignoredups)
1523 (ring-empty-p ring) 1508 (ring-empty-p ring)
1524 (not (string-equal (ring-ref ring 0) history))) 1509 (not (string-equal (ring-ref ring 0) history)))
1525 (ring-insert-at-beginning ring history))) 1510 (ring-insert-at-beginning ring history)))
1526 (setq count (1+ count)))) 1511 (setq count (1+ count))))
1527 (kill-buffer history-buf)) 1512 (kill-buffer history-buf))
@@ -1649,15 +1634,15 @@ Moves relative to `term-input-ring-index'."
1649 "Return the string matching REGEXP ARG places along the input ring. 1634 "Return the string matching REGEXP ARG places along the input ring.
1650Moves relative to `term-input-ring-index'." 1635Moves relative to `term-input-ring-index'."
1651 (let* ((pos (term-previous-matching-input-string-position regexp arg))) 1636 (let* ((pos (term-previous-matching-input-string-position regexp arg)))
1652 (if pos (ring-ref term-input-ring pos)))) 1637 (when pos (ring-ref term-input-ring pos))))
1653 1638
1654(defun term-previous-matching-input-string-position 1639(defun term-previous-matching-input-string-position
1655 (regexp arg &optional start) 1640 (regexp arg &optional start)
1656 "Return the index matching REGEXP ARG places along the input ring. 1641 "Return the index matching REGEXP ARG places along the input ring.
1657Moves relative to START, or `term-input-ring-index'." 1642Moves relative to START, or `term-input-ring-index'."
1658 (if (or (not (ring-p term-input-ring)) 1643 (when (or (not (ring-p term-input-ring))
1659 (ring-empty-p term-input-ring)) 1644 (ring-empty-p term-input-ring))
1660 (error "No history")) 1645 (error "No history"))
1661 (let* ((len (ring-length term-input-ring)) 1646 (let* ((len (ring-length term-input-ring))
1662 (motion (if (> arg 0) 1 -1)) 1647 (motion (if (> arg 0) 1 -1))
1663 (n (mod (- (or start (term-search-start arg)) motion) len)) 1648 (n (mod (- (or start (term-search-start arg)) motion) len))
@@ -1676,8 +1661,8 @@ Moves relative to START, or `term-input-ring-index'."
1676 tried-each-ring-item (= n prev))) 1661 tried-each-ring-item (= n prev)))
1677 (setq arg (if (> arg 0) (1- arg) (1+ arg)))) 1662 (setq arg (if (> arg 0) (1- arg) (1+ arg))))
1678 ;; Now that we know which ring element to use, if we found it, return that. 1663 ;; Now that we know which ring element to use, if we found it, return that.
1679 (if (string-match regexp (ring-ref term-input-ring n)) 1664 (when (string-match regexp (ring-ref term-input-ring n))
1680 n))) 1665 n)))
1681 1666
1682(defun term-previous-matching-input (regexp arg) 1667(defun term-previous-matching-input (regexp arg)
1683 "Search backwards through input history for match for REGEXP. 1668 "Search backwards through input history for match for REGEXP.
@@ -1711,14 +1696,14 @@ If N is negative, find the previous or Nth previous match."
1711With prefix argument N, search for Nth previous match. 1696With prefix argument N, search for Nth previous match.
1712If N is negative, search forwards for the -Nth following match." 1697If N is negative, search forwards for the -Nth following match."
1713 (interactive "p") 1698 (interactive "p")
1714 (if (not (memq last-command '(term-previous-matching-input-from-input 1699 (when (not (memq last-command '(term-previous-matching-input-from-input
1715 term-next-matching-input-from-input))) 1700 term-next-matching-input-from-input)))
1716 ;; Starting a new search 1701 ;; Starting a new search
1717 (setq term-matching-input-from-input-string 1702 (setq term-matching-input-from-input-string
1718 (buffer-substring 1703 (buffer-substring
1719 (process-mark (get-buffer-process (current-buffer))) 1704 (process-mark (get-buffer-process (current-buffer)))
1720 (point)) 1705 (point))
1721 term-input-ring-index nil)) 1706 term-input-ring-index nil))
1722 (term-previous-matching-input 1707 (term-previous-matching-input
1723 (concat "^" (regexp-quote term-matching-input-from-input-string)) 1708 (concat "^" (regexp-quote term-matching-input-from-input-string))
1724 arg)) 1709 arg))
@@ -1750,15 +1735,15 @@ See `term-magic-space' and `term-replace-by-expanded-history-before-point'.
1750 1735
1751Returns t if successful." 1736Returns t if successful."
1752 (interactive) 1737 (interactive)
1753 (if (and term-input-autoexpand 1738 (when (and term-input-autoexpand
1754 (string-match "[!^]" (funcall term-get-old-input)) 1739 (string-match "[!^]" (funcall term-get-old-input))
1755 (save-excursion (beginning-of-line) 1740 (save-excursion (beginning-of-line)
1756 (looking-at term-prompt-regexp))) 1741 (looking-at term-prompt-regexp)))
1757 ;; Looks like there might be history references in the command. 1742 ;; Looks like there might be history references in the command.
1758 (let ((previous-modified-tick (buffer-modified-tick))) 1743 (let ((previous-modified-tick (buffer-modified-tick)))
1759 (message "Expanding history references...") 1744 (message "Expanding history references...")
1760 (term-replace-by-expanded-history-before-point silent) 1745 (term-replace-by-expanded-history-before-point silent)
1761 (/= previous-modified-tick (buffer-modified-tick))))) 1746 (/= previous-modified-tick (buffer-modified-tick)))))
1762 1747
1763 1748
1764(defun term-replace-by-expanded-history-before-point (silent) 1749(defun term-replace-by-expanded-history-before-point (silent)
@@ -2024,17 +2009,17 @@ Similarly for Soar, Scheme, etc."
2024 (delete-region pmark (point)) 2009 (delete-region pmark (point))
2025 (insert input) 2010 (insert input)
2026 copy)))) 2011 copy))))
2027 (if (term-pager-enabled) 2012 (when (term-pager-enabled)
2028 (save-excursion 2013 (save-excursion
2029 (goto-char (process-mark proc)) 2014 (goto-char (process-mark proc))
2030 (setq term-pager-count (term-current-row)))) 2015 (setq term-pager-count (term-current-row))))
2031 (if (and (funcall term-input-filter history) 2016 (when (and (funcall term-input-filter history)
2032 (or (null term-input-ignoredups) 2017 (or (null term-input-ignoredups)
2033 (not (ring-p term-input-ring)) 2018 (not (ring-p term-input-ring))
2034 (ring-empty-p term-input-ring) 2019 (ring-empty-p term-input-ring)
2035 (not (string-equal (ring-ref term-input-ring 0) 2020 (not (string-equal (ring-ref term-input-ring 0)
2036 history)))) 2021 history))))
2037 (ring-insert term-input-ring history)) 2022 (ring-insert term-input-ring history))
2038 (let ((functions term-input-filter-functions)) 2023 (let ((functions term-input-filter-functions))
2039 (while functions 2024 (while functions
2040 (funcall (car functions) (concat input "\n")) 2025 (funcall (car functions) (concat input "\n"))
@@ -2045,13 +2030,12 @@ Similarly for Soar, Scheme, etc."
2045 ;; in case we get output amidst sending the input. 2030 ;; in case we get output amidst sending the input.
2046 (set-marker term-last-input-start pmark) 2031 (set-marker term-last-input-start pmark)
2047 (set-marker term-last-input-end (point)) 2032 (set-marker term-last-input-end (point))
2048 (if input-is-new 2033 (when input-is-new
2049 (progn 2034 ;; Set up to delete, because inferior should echo.
2050 ;; Set up to delete, because inferior should echo. 2035 (when (marker-buffer term-pending-delete-marker)
2051 (if (marker-buffer term-pending-delete-marker) 2036 (delete-region term-pending-delete-marker pmark))
2052 (delete-region term-pending-delete-marker pmark)) 2037 (set-marker term-pending-delete-marker pmark-val)
2053 (set-marker term-pending-delete-marker pmark-val) 2038 (set-marker (process-mark proc) (point)))
2054 (set-marker (process-mark proc) (point))))
2055 (goto-char pmark) 2039 (goto-char pmark)
2056 (funcall term-input-sender proc input))))) 2040 (funcall term-input-sender proc input)))))
2057 2041
@@ -2081,9 +2065,9 @@ Calls `term-get-old-input' to get old input."
2081 "Skip past the text matching regexp term-prompt-regexp. 2065 "Skip past the text matching regexp term-prompt-regexp.
2082If this takes us past the end of the current line, don't skip at all." 2066If this takes us past the end of the current line, don't skip at all."
2083 (let ((eol (save-excursion (end-of-line) (point)))) 2067 (let ((eol (save-excursion (end-of-line) (point))))
2084 (if (and (looking-at term-prompt-regexp) 2068 (when (and (looking-at term-prompt-regexp)
2085 (<= (match-end 0) eol)) 2069 (<= (match-end 0) eol))
2086 (goto-char (match-end 0))))) 2070 (goto-char (match-end 0)))))
2087 2071
2088 2072
2089(defun term-after-pmark-p () 2073(defun term-after-pmark-p ()
@@ -2112,7 +2096,7 @@ The prompt skip is done by skipping text matching the regular expression
2112term-prompt-regexp, a buffer local variable." 2096term-prompt-regexp, a buffer local variable."
2113 (interactive "P") 2097 (interactive "P")
2114 (beginning-of-line) 2098 (beginning-of-line)
2115 (if (null arg) (term-skip-prompt))) 2099 (when (null arg) (term-skip-prompt)))
2116 2100
2117;;; These two functions are for entering text you don't want echoed or 2101;;; These two functions are for entering text you don't want echoed or
2118;;; saved -- typically passwords to ftp, telnet, or somesuch. 2102;;; saved -- typically passwords to ftp, telnet, or somesuch.
@@ -2173,10 +2157,10 @@ is additionally sent. String is not saved on term input history list.
2173Security bug: your string can still be temporarily recovered with 2157Security bug: your string can still be temporarily recovered with
2174\\[view-lossage]." 2158\\[view-lossage]."
2175 (interactive "P") ; Defeat snooping via C-x esc 2159 (interactive "P") ; Defeat snooping via C-x esc
2176 (if (not (stringp str)) 2160 (when (not (stringp str))
2177 (setq str (term-read-noecho "Non-echoed text: " t))) 2161 (setq str (term-read-noecho "Non-echoed text: " t)))
2178 (if (not proc) 2162 (when (not proc)
2179 (setq proc (get-buffer-process (current-buffer)))) 2163 (setq proc (get-buffer-process (current-buffer))))
2180 (if (not proc) (error "Current buffer has no process") 2164 (if (not proc) (error "Current buffer has no process")
2181 (setq term-kill-echo-list (nconc term-kill-echo-list 2165 (setq term-kill-echo-list (nconc term-kill-echo-list
2182 (cons str nil))) 2166 (cons str nil)))
@@ -2268,8 +2252,8 @@ Useful if you accidentally suspend the top-level process."
2268 (interactive) 2252 (interactive)
2269 (let* ((pmark (process-mark (get-buffer-process (current-buffer)))) 2253 (let* ((pmark (process-mark (get-buffer-process (current-buffer))))
2270 (p-pos (marker-position pmark))) 2254 (p-pos (marker-position pmark)))
2271 (if (> (point) p-pos) 2255 (when (> (point) p-pos)
2272 (kill-region pmark (point))))) 2256 (kill-region pmark (point)))))
2273 2257
2274(defun term-delchar-or-maybe-eof (arg) 2258(defun term-delchar-or-maybe-eof (arg)
2275 "Delete ARG characters forward, or send an EOF to process if at end of 2259 "Delete ARG characters forward, or send an EOF to process if at end of
@@ -2277,7 +2261,7 @@ buffer."
2277 (interactive "p") 2261 (interactive "p")
2278 (if (eobp) 2262 (if (eobp)
2279 (process-send-eof) 2263 (process-send-eof)
2280 (delete-char arg))) 2264 (delete-char arg)))
2281 2265
2282(defun term-send-eof () 2266(defun term-send-eof ()
2283 "Send an EOF to the current buffer's process." 2267 "Send an EOF to the current buffer's process."
@@ -2292,8 +2276,8 @@ If N is negative, find the next or Nth next match."
2292 (interactive (term-regexp-arg "Backward input matching (regexp): ")) 2276 (interactive (term-regexp-arg "Backward input matching (regexp): "))
2293 (let* ((re (concat term-prompt-regexp ".*" regexp)) 2277 (let* ((re (concat term-prompt-regexp ".*" regexp))
2294 (pos (save-excursion (end-of-line (if (> arg 0) 0 1)) 2278 (pos (save-excursion (end-of-line (if (> arg 0) 0 1))
2295 (if (re-search-backward re nil t arg) 2279 (when (re-search-backward re nil t arg)
2296 (point))))) 2280 (point)))))
2297 (if (null pos) 2281 (if (null pos)
2298 (progn (message "Not found") 2282 (progn (message "Not found")
2299 (ding)) 2283 (ding))
@@ -2405,15 +2389,15 @@ See `term-prompt-regexp'."
2405 2389
2406(defun term-check-source (fname) 2390(defun term-check-source (fname)
2407 (let ((buff (get-file-buffer fname))) 2391 (let ((buff (get-file-buffer fname)))
2408 (if (and buff 2392 (when (and buff
2409 (buffer-modified-p buff) 2393 (buffer-modified-p buff)
2410 (y-or-n-p (format "Save buffer %s first? " 2394 (y-or-n-p (format "Save buffer %s first? "
2411 (buffer-name buff)))) 2395 (buffer-name buff))))
2412 ;; save BUFF. 2396 ;; save BUFF.
2413 (let ((old-buffer (current-buffer))) 2397 (let ((old-buffer (current-buffer)))
2414 (set-buffer buff) 2398 (set-buffer buff)
2415 (save-buffer) 2399 (save-buffer)
2416 (set-buffer old-buffer))))) 2400 (set-buffer old-buffer)))))
2417 2401
2418 2402
2419;;; (TERM-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p) 2403;;; (TERM-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p)
@@ -2508,12 +2492,12 @@ See `term-prompt-regexp'."
2508 ;; Try to position the proc window so you can see the answer. 2492 ;; Try to position the proc window so you can see the answer.
2509 ;; This is bogus code. If you delete the (sit-for 0), it breaks. 2493 ;; This is bogus code. If you delete the (sit-for 0), it breaks.
2510 ;; I don't know why. Wizards invited to improve it. 2494 ;; I don't know why. Wizards invited to improve it.
2511 (if (not (pos-visible-in-window-p proc-pt proc-win)) 2495 (when (not (pos-visible-in-window-p proc-pt proc-win))
2512 (let ((opoint (window-point proc-win))) 2496 (let ((opoint (window-point proc-win)))
2513 (set-window-point proc-win proc-mark) (sit-for 0) 2497 (set-window-point proc-win proc-mark) (sit-for 0)
2514 (if (not (pos-visible-in-window-p opoint proc-win)) 2498 (if (not (pos-visible-in-window-p opoint proc-win))
2515 (push-mark opoint) 2499 (push-mark opoint)
2516 (set-window-point proc-win opoint))))))) 2500 (set-window-point proc-win opoint)))))))
2517 2501
2518;;; Returns the current column in the current screen line. 2502;;; Returns the current column in the current screen line.
2519;;; Note: (current-column) yields column in buffer line. 2503;;; Note: (current-column) yields column in buffer line.
@@ -2701,16 +2685,15 @@ See `term-prompt-regexp'."
2701 ;; Let's handle the messages. -mm 2685 ;; Let's handle the messages. -mm
2702 2686
2703 (let* ((newstr (term-handle-ansi-terminal-messages str))) 2687 (let* ((newstr (term-handle-ansi-terminal-messages str)))
2704 (if (not (eq str newstr)) 2688 (when (not (eq str newstr))
2705 (setq handled-ansi-message t 2689 (setq handled-ansi-message t
2706 str newstr))) 2690 str newstr)))
2707 (setq str-length (length str)) 2691 (setq str-length (length str))
2708 2692
2709 (if (marker-buffer term-pending-delete-marker) 2693 (when (marker-buffer term-pending-delete-marker)
2710 (progn 2694 ;; Delete text following term-pending-delete-marker.
2711 ;; Delete text following term-pending-delete-marker. 2695 (delete-region term-pending-delete-marker (process-mark proc))
2712 (delete-region term-pending-delete-marker (process-mark proc)) 2696 (set-marker term-pending-delete-marker nil))
2713 (set-marker term-pending-delete-marker nil)))
2714 2697
2715 (if (eq (window-buffer) (current-buffer)) 2698 (if (eq (window-buffer) (current-buffer))
2716 (progn 2699 (progn
@@ -2721,20 +2704,20 @@ See `term-prompt-regexp'."
2721 2704
2722 (setq save-marker (copy-marker (process-mark proc))) 2705 (setq save-marker (copy-marker (process-mark proc)))
2723 2706
2724 (if (/= (point) (process-mark proc)) 2707 (when (/= (point) (process-mark proc))
2725 (progn (setq save-point (point-marker)) 2708 (setq save-point (point-marker))
2726 (goto-char (process-mark proc)))) 2709 (goto-char (process-mark proc)))
2727 2710
2728 (save-restriction 2711 (save-restriction
2729 ;; If the buffer is in line mode, and there is a partial 2712 ;; If the buffer is in line mode, and there is a partial
2730 ;; input line, save the line (by narrowing to leave it 2713 ;; input line, save the line (by narrowing to leave it
2731 ;; outside the restriction ) until we're done with output. 2714 ;; outside the restriction ) until we're done with output.
2732 (if (and (> (point-max) (process-mark proc)) 2715 (when (and (> (point-max) (process-mark proc))
2733 (term-in-line-mode)) 2716 (term-in-line-mode))
2734 (narrow-to-region (point-min) (process-mark proc))) 2717 (narrow-to-region (point-min) (process-mark proc)))
2735 2718
2736 (if term-log-buffer 2719 (when term-log-buffer
2737 (princ str term-log-buffer)) 2720 (princ str term-log-buffer))
2738 (cond ((eq term-terminal-state 4) ;; Have saved pending output. 2721 (cond ((eq term-terminal-state 4) ;; Have saved pending output.
2739 (setq str (concat term-terminal-parameter str)) 2722 (setq str (concat term-terminal-parameter str))
2740 (setq term-terminal-parameter nil) 2723 (setq term-terminal-parameter nil)
@@ -2748,7 +2731,7 @@ See `term-prompt-regexp'."
2748 (setq funny 2731 (setq funny
2749 (string-match "[\r\n\000\007\033\t\b\032\016\017]" 2732 (string-match "[\r\n\000\007\033\t\b\032\016\017]"
2750 str i)) 2733 str i))
2751 (if (not funny) (setq funny str-length)) 2734 (when (not funny) (setq funny str-length))
2752 (cond ((> funny i) 2735 (cond ((> funny i)
2753 (cond ((eq term-terminal-state 1) 2736 (cond ((eq term-terminal-state 1)
2754 ;; We are in state 1, we need to wrap 2737 ;; We are in state 1, we need to wrap
@@ -2822,10 +2805,10 @@ See `term-prompt-regexp'."
2822 (setq count (min term-width 2805 (setq count (min term-width
2823 (+ count 8 (- (mod count 8))))) 2806 (+ count 8 (- (mod count 8)))))
2824 (if (> term-width count) 2807 (if (> term-width count)
2825 (progn 2808 (progn
2826 (term-move-columns 2809 (term-move-columns
2827 (- count (term-current-column))) 2810 (- count (term-current-column)))
2828 (setq term-current-column count)) 2811 (setq term-current-column count))
2829 (when (> term-width (term-current-column)) 2812 (when (> term-width (term-current-column))
2830 (term-move-columns 2813 (term-move-columns
2831 (1- (- term-width (term-current-column))))) 2814 (1- (- term-width (term-current-column)))))
@@ -2967,44 +2950,43 @@ See `term-prompt-regexp'."
2967 (setq term-terminal-previous-parameter-2 -1) 2950 (setq term-terminal-previous-parameter-2 -1)
2968 (setq term-terminal-previous-parameter -1) 2951 (setq term-terminal-previous-parameter -1)
2969 (setq term-terminal-state 0))))) 2952 (setq term-terminal-state 0)))))
2970 (if (term-handling-pager) 2953 (when (term-handling-pager)
2971 ;; Finish stuff to get ready to handle PAGER. 2954 ;; Finish stuff to get ready to handle PAGER.
2972 (progn 2955 (if (> (% (current-column) term-width) 0)
2973 (if (> (% (current-column) term-width) 0) 2956 (setq term-terminal-parameter
2974 (setq term-terminal-parameter 2957 (substring str i))
2975 (substring str i)) 2958 ;; We're at column 0. Goto end of buffer; to compensate,
2976 ;; We're at column 0. Goto end of buffer; to compensate, 2959 ;; prepend a ?\r for later. This looks more consistent.
2977 ;; prepend a ?\r for later. This looks more consistent. 2960 (if (zerop i)
2978 (if (zerop i) 2961 (setq term-terminal-parameter
2979 (setq term-terminal-parameter 2962 (concat "\r" (substring str i)))
2980 (concat "\r" (substring str i))) 2963 (setq term-terminal-parameter (substring str (1- i)))
2981 (setq term-terminal-parameter (substring str (1- i))) 2964 (aset term-terminal-parameter 0 ?\r))
2982 (aset term-terminal-parameter 0 ?\r)) 2965 (goto-char (point-max)))
2983 (goto-char (point-max))) 2966 (setq term-terminal-state 4)
2984 (setq term-terminal-state 4) 2967 (make-local-variable 'term-pager-old-filter)
2985 (make-local-variable 'term-pager-old-filter) 2968 (setq term-pager-old-filter (process-filter proc))
2986 (setq term-pager-old-filter (process-filter proc)) 2969 (set-process-filter proc term-pager-filter)
2987 (set-process-filter proc term-pager-filter) 2970 (setq i str-length))
2988 (setq i str-length)))
2989 (setq i (1+ i)))) 2971 (setq i (1+ i))))
2990 2972
2991 (if (>= (term-current-row) term-height) 2973 (when (>= (term-current-row) term-height)
2992 (term-handle-deferred-scroll)) 2974 (term-handle-deferred-scroll))
2993 2975
2994 (set-marker (process-mark proc) (point)) 2976 (set-marker (process-mark proc) (point))
2995 (if save-point 2977 (when save-point
2996 (progn (goto-char save-point) 2978 (goto-char save-point)
2997 (set-marker save-point nil))) 2979 (set-marker save-point nil))
2998 2980
2999 ;; Check for a pending filename-and-line number to display. 2981 ;; Check for a pending filename-and-line number to display.
3000 ;; We do this before scrolling, because we might create a new window. 2982 ;; We do this before scrolling, because we might create a new window.
3001 (if (and term-pending-frame 2983 (when (and term-pending-frame
3002 (eq (window-buffer selected) (current-buffer))) 2984 (eq (window-buffer selected) (current-buffer)))
3003 (progn (term-display-line (car term-pending-frame) 2985 (term-display-line (car term-pending-frame)
3004 (cdr term-pending-frame)) 2986 (cdr term-pending-frame))
3005 (setq term-pending-frame nil) 2987 (setq term-pending-frame nil)
3006 ;; We have created a new window, so check the window size. 2988 ;; We have created a new window, so check the window size.
3007 (term-check-size proc))) 2989 (term-check-size proc))
3008 2990
3009 ;; Scroll each window displaying the buffer but (by default) 2991 ;; Scroll each window displaying the buffer but (by default)
3010 ;; only if the point matches the process-mark we started with. 2992 ;; only if the point matches the process-mark we started with.
@@ -3016,50 +2998,47 @@ See `term-prompt-regexp'."
3016 (setq last-win win) 2998 (setq last-win win)
3017 (while (progn 2999 (while (progn
3018 (setq win (next-window win nil t)) 3000 (setq win (next-window win nil t))
3019 (if (eq (window-buffer win) (process-buffer proc)) 3001 (when (eq (window-buffer win) (process-buffer proc))
3020 (let ((scroll term-scroll-to-bottom-on-output)) 3002 (let ((scroll term-scroll-to-bottom-on-output))
3021 (select-window win) 3003 (select-window win)
3022 (if (or (= (point) save-marker) 3004 (when (or (= (point) save-marker)
3023 (eq scroll t) (eq scroll 'all) 3005 (eq scroll t) (eq scroll 'all)
3024 ;; Maybe user wants point to jump to the end. 3006 ;; Maybe user wants point to jump to the end.
3025 (and (eq selected win) 3007 (and (eq selected win)
3026 (or (eq scroll 'this) (not save-point))) 3008 (or (eq scroll 'this) (not save-point)))
3027 (and (eq scroll 'others) 3009 (and (eq scroll 'others)
3028 (not (eq selected win)))) 3010 (not (eq selected win))))
3029 (progn 3011 (goto-char term-home-marker)
3030 (goto-char term-home-marker) 3012 (recenter 0)
3031 (recenter 0) 3013 (goto-char (process-mark proc))
3032 (goto-char (process-mark proc)) 3014 (if (not (pos-visible-in-window-p (point) win))
3033 (if (not (pos-visible-in-window-p (point) win)) 3015 (recenter -1)))
3034 (recenter -1)))) 3016 ;; Optionally scroll so that the text
3035 ;; Optionally scroll so that the text 3017 ;; ends at the bottom of the window.
3036 ;; ends at the bottom of the window. 3018 (when (and term-scroll-show-maximum-output
3037 (if (and term-scroll-show-maximum-output
3038 (>= (point) (process-mark proc))) 3019 (>= (point) (process-mark proc)))
3039 (save-excursion 3020 (save-excursion
3040 (goto-char (point-max)) 3021 (goto-char (point-max))
3041 (recenter -1))))) 3022 (recenter -1)))))
3042 (not (eq win last-win)))) 3023 (not (eq win last-win))))
3043 3024
3044;;; Stolen from comint.el and adapted -mm 3025;;; Stolen from comint.el and adapted -mm
3045 (if (> term-buffer-maximum-size 0) 3026 (when (> term-buffer-maximum-size 0)
3046 (save-excursion 3027 (save-excursion
3047 (goto-char (process-mark (get-buffer-process (current-buffer)))) 3028 (goto-char (process-mark (get-buffer-process (current-buffer))))
3048 (forward-line (- term-buffer-maximum-size)) 3029 (forward-line (- term-buffer-maximum-size))
3049 (beginning-of-line) 3030 (beginning-of-line)
3050 (delete-region (point-min) (point)))) 3031 (delete-region (point-min) (point))))
3051;;;
3052
3053 (set-marker save-marker nil))))) 3032 (set-marker save-marker nil)))))
3054 3033
3055(defun term-handle-deferred-scroll () 3034(defun term-handle-deferred-scroll ()
3056 (let ((count (- (term-current-row) term-height))) 3035 (let ((count (- (term-current-row) term-height)))
3057 (if (>= count 0) 3036 (when (>= count 0)
3058 (save-excursion 3037 (save-excursion
3059 (goto-char term-home-marker) 3038 (goto-char term-home-marker)
3060 (term-vertical-motion (1+ count)) 3039 (term-vertical-motion (1+ count))
3061 (set-marker term-home-marker (point)) 3040 (set-marker term-home-marker (point))
3062 (setq term-current-row (1- term-height)))))) 3041 (setq term-current-row (1- term-height))))))
3063 3042
3064;;; Reset the terminal, delete all the content and set the face to the 3043;;; Reset the terminal, delete all the content and set the face to the
3065;;; default one. 3044;;; default one.
@@ -3170,17 +3149,17 @@ See `term-prompt-regexp'."
3170 (list :background 3149 (list :background
3171 (if (= term-ansi-current-color 0) 3150 (if (= term-ansi-current-color 0)
3172 (face-foreground 'default) 3151 (face-foreground 'default)
3173 (elt ansi-term-color-vector term-ansi-current-color)) 3152 (elt ansi-term-color-vector term-ansi-current-color))
3174 :foreground 3153 :foreground
3175 (if (= term-ansi-current-bg-color 0) 3154 (if (= term-ansi-current-bg-color 0)
3176 (face-background 'default) 3155 (face-background 'default)
3177 (elt ansi-term-color-vector term-ansi-current-bg-color)))) 3156 (elt ansi-term-color-vector term-ansi-current-bg-color))))
3178 (when term-ansi-current-bold 3157 (when term-ansi-current-bold
3179 (setq term-current-face 3158 (setq term-current-face
3180 (append '(:weight bold) term-current-face))) 3159 (append '(:weight bold) term-current-face)))
3181 (when term-ansi-current-underline 3160 (when term-ansi-current-underline
3182 (setq term-current-face 3161 (setq term-current-face
3183 (append '(:underline t) term-current-face)))) 3162 (append '(:underline t) term-current-face))))
3184 (if term-ansi-current-invisible 3163 (if term-ansi-current-invisible
3185 (setq term-current-face 3164 (setq term-current-face
3186 (if (= term-ansi-current-bg-color 0) 3165 (if (= term-ansi-current-bg-color 0)
@@ -3200,12 +3179,12 @@ See `term-prompt-regexp'."
3200 :background 3179 :background
3201 (elt ansi-term-color-vector term-ansi-current-bg-color))) 3180 (elt ansi-term-color-vector term-ansi-current-bg-color)))
3202 (when term-ansi-current-bold 3181 (when term-ansi-current-bold
3203 (setq term-current-face 3182 (setq term-current-face
3204 (append '(:weight bold) term-current-face))) 3183 (append '(:weight bold) term-current-face)))
3205 (when term-ansi-current-underline 3184 (when term-ansi-current-underline
3206 (setq term-current-face 3185 (setq term-current-face
3207 (append '(:underline t) term-current-face)))))) 3186 (append '(:underline t) term-current-face))))))
3208 3187
3209;;; (message "Debug %S" term-current-face) 3188;;; (message "Debug %S" term-current-face)
3210 (setq term-ansi-face-already-done nil)) 3189 (setq term-ansi-face-already-done nil))
3211 3190
@@ -3219,14 +3198,14 @@ See `term-prompt-regexp'."
3219 ;; (eq char ?f) ;; xterm seems to handle this sequence too, not 3198 ;; (eq char ?f) ;; xterm seems to handle this sequence too, not
3220 ;; needed for now 3199 ;; needed for now
3221 ) 3200 )
3222 (if (<= term-terminal-parameter 0) 3201 (when (<= term-terminal-parameter 0)
3223 (setq term-terminal-parameter 1)) 3202 (setq term-terminal-parameter 1))
3224 (if (<= term-terminal-previous-parameter 0) 3203 (when (<= term-terminal-previous-parameter 0)
3225 (setq term-terminal-previous-parameter 1)) 3204 (setq term-terminal-previous-parameter 1))
3226 (if (> term-terminal-previous-parameter term-height) 3205 (when (> term-terminal-previous-parameter term-height)
3227 (setq term-terminal-previous-parameter term-height)) 3206 (setq term-terminal-previous-parameter term-height))
3228 (if (> term-terminal-parameter term-width) 3207 (when (> term-terminal-parameter term-width)
3229 (setq term-terminal-parameter term-width)) 3208 (setq term-terminal-parameter term-width))
3230 (term-goto 3209 (term-goto
3231 (1- term-terminal-previous-parameter) 3210 (1- term-terminal-previous-parameter)
3232 (1- term-terminal-parameter))) 3211 (1- term-terminal-parameter)))
@@ -3443,50 +3422,49 @@ The top-most line is line 0."
3443; The page is full, so enter "pager" mode, and wait for input. 3422; The page is full, so enter "pager" mode, and wait for input.
3444 3423
3445(defun term-process-pager () 3424(defun term-process-pager ()
3446 (if (not term-pager-break-map) 3425 (when (not term-pager-break-map)
3447 (let* ((map (make-keymap)) 3426 (let* ((map (make-keymap))
3448 (i 0) tmp) 3427 (i 0) tmp)
3449; (while (< i 128) 3428; (while (< i 128)
3450; (define-key map (make-string 1 i) 'term-send-raw) 3429; (define-key map (make-string 1 i) 'term-send-raw)
3451; (setq i (1+ i))) 3430; (setq i (1+ i)))
3452 (define-key map "\e" 3431 (define-key map "\e"
3453 (lookup-key (current-global-map) "\e")) 3432 (lookup-key (current-global-map) "\e"))
3454 (define-key map "\C-x" 3433 (define-key map "\C-x"
3455 (lookup-key (current-global-map) "\C-x")) 3434 (lookup-key (current-global-map) "\C-x"))
3456 (define-key map "\C-u" 3435 (define-key map "\C-u"
3457 (lookup-key (current-global-map) "\C-u")) 3436 (lookup-key (current-global-map) "\C-u"))
3458 (define-key map " " 'term-pager-page) 3437 (define-key map " " 'term-pager-page)
3459 (define-key map "\r" 'term-pager-line) 3438 (define-key map "\r" 'term-pager-line)
3460 (define-key map "?" 'term-pager-help) 3439 (define-key map "?" 'term-pager-help)
3461 (define-key map "h" 'term-pager-help) 3440 (define-key map "h" 'term-pager-help)
3462 (define-key map "b" 'term-pager-back-page) 3441 (define-key map "b" 'term-pager-back-page)
3463 (define-key map "\177" 'term-pager-back-line) 3442 (define-key map "\177" 'term-pager-back-line)
3464 (define-key map "q" 'term-pager-discard) 3443 (define-key map "q" 'term-pager-discard)
3465 (define-key map "D" 'term-pager-disable) 3444 (define-key map "D" 'term-pager-disable)
3466 (define-key map "<" 'term-pager-bob) 3445 (define-key map "<" 'term-pager-bob)
3467 (define-key map ">" 'term-pager-eob) 3446 (define-key map ">" 'term-pager-eob)
3468 3447
3469 ;; Add menu bar. 3448 ;; Add menu bar.
3470 (progn 3449 (unless (featurep 'xemacs)
3471 (term-ifnot-xemacs 3450 (define-key map [menu-bar terminal] term-terminal-menu)
3472 (define-key map [menu-bar terminal] term-terminal-menu) 3451 (define-key map [menu-bar signals] term-signals-menu)
3473 (define-key map [menu-bar signals] term-signals-menu) 3452 (setq tmp (make-sparse-keymap "More pages?"))
3474 (setq tmp (make-sparse-keymap "More pages?")) 3453 (define-key tmp [help] '("Help" . term-pager-help))
3475 (define-key tmp [help] '("Help" . term-pager-help)) 3454 (define-key tmp [disable]
3476 (define-key tmp [disable] 3455 '("Disable paging" . term-fake-pager-disable))
3477 '("Disable paging" . term-fake-pager-disable)) 3456 (define-key tmp [discard]
3478 (define-key tmp [discard] 3457 '("Discard remaining output" . term-pager-discard))
3479 '("Discard remaining output" . term-pager-discard)) 3458 (define-key tmp [eob] '("Goto to end" . term-pager-eob))
3480 (define-key tmp [eob] '("Goto to end" . term-pager-eob)) 3459 (define-key tmp [bob] '("Goto to beginning" . term-pager-bob))
3481 (define-key tmp [bob] '("Goto to beginning" . term-pager-bob)) 3460 (define-key tmp [line] '("1 line forwards" . term-pager-line))
3482 (define-key tmp [line] '("1 line forwards" . term-pager-line)) 3461 (define-key tmp [bline] '("1 line backwards" . term-pager-back-line))
3483 (define-key tmp [bline] '("1 line backwards" . term-pager-back-line)) 3462 (define-key tmp [back] '("1 page backwards" . term-pager-back-page))
3484 (define-key tmp [back] '("1 page backwards" . term-pager-back-page)) 3463 (define-key tmp [page] '("1 page forwards" . term-pager-page))
3485 (define-key tmp [page] '("1 page forwards" . term-pager-page)) 3464 (define-key map [menu-bar page] (cons "More pages?" tmp))
3486 (define-key map [menu-bar page] (cons "More pages?" tmp)) 3465 )
3487 ))
3488 3466
3489 (setq term-pager-break-map map))) 3467 (setq term-pager-break-map map)))
3490; (let ((process (get-buffer-process (current-buffer)))) 3468; (let ((process (get-buffer-process (current-buffer))))
3491; (stop-process process)) 3469; (stop-process process))
3492 (setq term-pager-old-local-map (current-local-map)) 3470 (setq term-pager-old-local-map (current-local-map))
@@ -3504,8 +3482,8 @@ The top-most line is line 0."
3504 (interactive "p") 3482 (interactive "p")
3505 (let* ((moved (vertical-motion (1+ lines))) 3483 (let* ((moved (vertical-motion (1+ lines)))
3506 (deficit (- lines moved))) 3484 (deficit (- lines moved)))
3507 (if (> moved lines) 3485 (when (> moved lines)
3508 (backward-char)) 3486 (backward-char))
3509 (cond ((<= deficit 0) ;; OK, had enough in the buffer for request. 3487 (cond ((<= deficit 0) ;; OK, had enough in the buffer for request.
3510 (recenter (1- term-height))) 3488 (recenter (1- term-height)))
3511 ((term-pager-continue deficit))))) 3489 ((term-pager-continue deficit)))))
@@ -3519,8 +3497,8 @@ The top-most line is line 0."
3519(defun term-pager-bob () 3497(defun term-pager-bob ()
3520 (interactive) 3498 (interactive)
3521 (goto-char (point-min)) 3499 (goto-char (point-min))
3522 (if (= (vertical-motion term-height) term-height) 3500 (when (= (vertical-motion term-height) term-height)
3523 (backward-char)) 3501 (backward-char))
3524 (recenter (1- term-height))) 3502 (recenter (1- term-height)))
3525 3503
3526; pager mode command to go to end of buffer 3504; pager mode command to go to end of buffer
@@ -3571,7 +3549,7 @@ The top-most line is line 0."
3571 (interactive) 3549 (interactive)
3572 (if (term-pager-enabled) (term-pager-disable) (term-pager-enable))) 3550 (if (term-pager-enabled) (term-pager-disable) (term-pager-enable)))
3573 3551
3574(term-ifnot-xemacs 3552(unless (featurep 'xemacs)
3575 (defalias 'term-fake-pager-enable 'term-pager-toggle) 3553 (defalias 'term-fake-pager-enable 'term-pager-toggle)
3576 (defalias 'term-fake-pager-disable 'term-pager-toggle) 3554 (defalias 'term-fake-pager-disable 'term-pager-toggle)
3577 (put 'term-char-mode 'menu-enable '(term-in-line-mode)) 3555 (put 'term-char-mode 'menu-enable '(term-in-line-mode))
@@ -3624,45 +3602,45 @@ all pending output has been dealt with."))
3624 (let ((scroll-needed 3602 (let ((scroll-needed
3625 (- (+ (term-current-row) down) 3603 (- (+ (term-current-row) down)
3626 (if (< down 0) term-scroll-start term-scroll-end)))) 3604 (if (< down 0) term-scroll-start term-scroll-end))))
3627 (if (or (and (< down 0) (< scroll-needed 0)) 3605 (when (or (and (< down 0) (< scroll-needed 0))
3628 (and (> down 0) (> scroll-needed 0))) 3606 (and (> down 0) (> scroll-needed 0)))
3629 (let ((save-point (copy-marker (point))) (save-top)) 3607 (let ((save-point (copy-marker (point))) (save-top))
3630 (goto-char term-home-marker) 3608 (goto-char term-home-marker)
3631 (cond (term-scroll-with-delete 3609 (cond (term-scroll-with-delete
3632 (if (< down 0) 3610 (if (< down 0)
3633 (progn 3611 (progn
3634 ;; Delete scroll-needed lines at term-scroll-end, 3612 ;; Delete scroll-needed lines at term-scroll-end,
3635 ;; then insert scroll-needed lines. 3613 ;; then insert scroll-needed lines.
3636 (term-vertical-motion (1- term-scroll-end)) 3614 (term-vertical-motion (1- term-scroll-end))
3637 (end-of-line) 3615 (end-of-line)
3638 (setq save-top (point)) 3616 (setq save-top (point))
3639 (term-vertical-motion scroll-needed) 3617 (term-vertical-motion scroll-needed)
3640 (end-of-line) 3618 (end-of-line)
3641 (delete-region save-top (point)) 3619 (delete-region save-top (point))
3642 (goto-char save-point) 3620 (goto-char save-point)
3643 (setq down (- scroll-needed down)) 3621 (setq down (- scroll-needed down))
3644 (term-vertical-motion down)) 3622 (term-vertical-motion down))
3645 ;; Delete scroll-needed lines at term-scroll-start. 3623 ;; Delete scroll-needed lines at term-scroll-start.
3646 (term-vertical-motion term-scroll-start) 3624 (term-vertical-motion term-scroll-start)
3647 (setq save-top (point)) 3625 (setq save-top (point))
3648 (term-vertical-motion scroll-needed)
3649 (delete-region save-top (point))
3650 (goto-char save-point)
3651 (term-vertical-motion down)
3652 (term-adjust-current-row-cache (- scroll-needed)))
3653 (setq term-current-column nil)
3654 (term-insert-char ?\n (abs scroll-needed)))
3655 ((and (numberp term-pager-count)
3656 (< (setq term-pager-count (- term-pager-count down))
3657 0))
3658 (setq down 0)
3659 (term-process-pager))
3660 (t
3661 (term-adjust-current-row-cache (- scroll-needed))
3662 (term-vertical-motion scroll-needed) 3626 (term-vertical-motion scroll-needed)
3663 (set-marker term-home-marker (point)))) 3627 (delete-region save-top (point))
3664 (goto-char save-point) 3628 (goto-char save-point)
3665 (set-marker save-point nil)))) 3629 (term-vertical-motion down)
3630 (term-adjust-current-row-cache (- scroll-needed)))
3631 (setq term-current-column nil)
3632 (term-insert-char ?\n (abs scroll-needed)))
3633 ((and (numberp term-pager-count)
3634 (< (setq term-pager-count (- term-pager-count down))
3635 0))
3636 (setq down 0)
3637 (term-process-pager))
3638 (t
3639 (term-adjust-current-row-cache (- scroll-needed))
3640 (term-vertical-motion scroll-needed)
3641 (set-marker term-home-marker (point))))
3642 (goto-char save-point)
3643 (set-marker save-point nil))))
3666 down) 3644 down)
3667 3645
3668(defun term-down (down &optional check-for-scroll) 3646(defun term-down (down &optional check-for-scroll)
@@ -3699,34 +3677,34 @@ all pending output has been dealt with."))
3699;; if the line above point wraps around, add a ?\n to undo the wrapping. 3677;; if the line above point wraps around, add a ?\n to undo the wrapping.
3700;; FIXME: Probably should be called more than it is. 3678;; FIXME: Probably should be called more than it is.
3701(defun term-unwrap-line () 3679(defun term-unwrap-line ()
3702 (if (not (bolp)) (insert-before-markers ?\n))) 3680 (when (not (bolp)) (insert-before-markers ?\n)))
3703 3681
3704(defun term-erase-in-line (kind) 3682(defun term-erase-in-line (kind)
3705 (if (= kind 1) ;; erase left of point 3683 (when (= kind 1) ;; erase left of point
3706 (let ((cols (term-horizontal-column)) (saved-point (point))) 3684 (let ((cols (term-horizontal-column)) (saved-point (point)))
3707 (term-vertical-motion 0) 3685 (term-vertical-motion 0)
3708 (delete-region (point) saved-point) 3686 (delete-region (point) saved-point)
3709 (term-insert-char ? cols))) 3687 (term-insert-char ? cols)))
3710 (if (not (eq kind 1)) ;; erase right of point 3688 (when (not (eq kind 1)) ;; erase right of point
3711 (let ((saved-point (point)) 3689 (let ((saved-point (point))
3712 (wrapped (and (zerop (term-horizontal-column)) 3690 (wrapped (and (zerop (term-horizontal-column))
3713 (not (zerop (term-current-column)))))) 3691 (not (zerop (term-current-column))))))
3714 (term-vertical-motion 1) 3692 (term-vertical-motion 1)
3715 (delete-region saved-point (point)) 3693 (delete-region saved-point (point))
3716 ;; wrapped is true if we're at the beginning of screen line, 3694 ;; wrapped is true if we're at the beginning of screen line,
3717 ;; but not a buffer line. If we delete the current screen line 3695 ;; but not a buffer line. If we delete the current screen line
3718 ;; that will make the previous line no longer wrap, and (because 3696 ;; that will make the previous line no longer wrap, and (because
3719 ;; of the way Emacs display works) point will be at the end of 3697 ;; of the way Emacs display works) point will be at the end of
3720 ;; the previous screen line rather then the beginning of the 3698 ;; the previous screen line rather then the beginning of the
3721 ;; current one. To avoid that, we make sure that current line 3699 ;; current one. To avoid that, we make sure that current line
3722 ;; contain a space, to force the previous line to continue to wrap. 3700 ;; contain a space, to force the previous line to continue to wrap.
3723 ;; We could do this always, but it seems preferable to not add the 3701 ;; We could do this always, but it seems preferable to not add the
3724 ;; extra space when wrapped is false. 3702 ;; extra space when wrapped is false.
3725 (if wrapped 3703 (when wrapped
3726 (insert ? )) 3704 (insert ? ))
3727 (insert ?\n) 3705 (insert ?\n)
3728 (put-text-property saved-point (point) 'face 'default) 3706 (put-text-property saved-point (point) 'face 'default)
3729 (goto-char saved-point)))) 3707 (goto-char saved-point))))
3730 3708
3731(defun term-erase-in-display (kind) 3709(defun term-erase-in-display (kind)
3732 "Erases (that is blanks out) part of the window. 3710 "Erases (that is blanks out) part of the window.
@@ -3932,8 +3910,8 @@ inside of a \"[...]\" (see `skip-chars-forward')."
3932 (let ((limit (point)) 3910 (let ((limit (point))
3933 (word (concat "[" word-chars "]")) 3911 (word (concat "[" word-chars "]"))
3934 (non-word (concat "[^" word-chars "]"))) 3912 (non-word (concat "[^" word-chars "]")))
3935 (if (re-search-backward non-word nil 'move) 3913 (when (re-search-backward non-word nil 'move)
3936 (forward-char 1)) 3914 (forward-char 1))
3937 ;; Anchor the search forwards. 3915 ;; Anchor the search forwards.
3938 (if (or (eolp) (looking-at non-word)) 3916 (if (or (eolp) (looking-at non-word))
3939 nil 3917 nil
@@ -3974,10 +3952,10 @@ completions listing is dependent on the value of `term-completion-autolist'.
3974 3952
3975Returns t if successful." 3953Returns t if successful."
3976 (interactive) 3954 (interactive)
3977 (if (term-match-partial-filename) 3955 (when (term-match-partial-filename)
3978 (prog2 (or (eq (selected-window) (minibuffer-window)) 3956 (prog2 (or (eq (selected-window) (minibuffer-window))
3979 (message "Completing file name...")) 3957 (message "Completing file name..."))
3980 (term-dynamic-complete-as-filename)))) 3958 (term-dynamic-complete-as-filename))))
3981 3959
3982(defun term-dynamic-complete-as-filename () 3960(defun term-dynamic-complete-as-filename ()
3983 "Dynamically complete at point as a filename. 3961 "Dynamically complete at point as a filename.
@@ -4001,7 +3979,7 @@ See `term-dynamic-complete-filename'. Returns t if successful."
4001 (message "No completions of %s" filename) 3979 (message "No completions of %s" filename)
4002 (setq success nil)) 3980 (setq success nil))
4003 ((eq completion t) ; Means already completed "file". 3981 ((eq completion t) ; Means already completed "file".
4004 (if term-completion-addsuffix (insert " ")) 3982 (when term-completion-addsuffix (insert " "))
4005 (or mini-flag (message "Sole completion"))) 3983 (or mini-flag (message "Sole completion")))
4006 ((string-equal completion "") ; Means completion on "directory/". 3984 ((string-equal completion "") ; Means completion on "directory/".
4007 (term-dynamic-list-filename-completions)) 3985 (term-dynamic-list-filename-completions))
@@ -4066,7 +4044,7 @@ See also `term-dynamic-complete-filename'."
4066 (message "Sole completion") 4044 (message "Sole completion")
4067 (insert (substring completion (length stub))) 4045 (insert (substring completion (length stub)))
4068 (message "Completed")) 4046 (message "Completed"))
4069 (if term-completion-addsuffix (insert " ")) 4047 (when term-completion-addsuffix (insert " "))
4070 'sole)) 4048 'sole))
4071 (t ; There's no unique completion. 4049 (t ; There's no unique completion.
4072 (let ((completion (try-completion stub candidates))) 4050 (let ((completion (try-completion stub candidates)))
diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el
index b40e021d42d..b5dc01ff9bf 100644
--- a/lisp/term/mac-win.el
+++ b/lisp/term/mac-win.el
@@ -84,6 +84,7 @@
84(defvar mac-apple-event-map) 84(defvar mac-apple-event-map)
85(defvar mac-atsu-font-table) 85(defvar mac-atsu-font-table)
86(defvar mac-font-panel-mode) 86(defvar mac-font-panel-mode)
87(defvar mac-ts-active-input-overlay)
87(defvar x-invocation-args) 88(defvar x-invocation-args)
88 89
89(defvar x-command-line-resources nil) 90(defvar x-command-line-resources nil)
@@ -1620,6 +1621,15 @@ in `selection-converter-alist', which see."
1620 (mac-coerce-ae-data (car type-data) (cdr type-data) type)) 1621 (mac-coerce-ae-data (car type-data) (cdr type-data) type))
1621 (cdr desc))))))) 1622 (cdr desc)))))))
1622 1623
1624(defun mac-ae-number (ae keyword)
1625 (let ((type-data (mac-ae-parameter ae keyword))
1626 str)
1627 (if (and type-data
1628 (setq str (mac-coerce-ae-data (car type-data)
1629 (cdr type-data) "TEXT")))
1630 (string-to-number str)
1631 nil)))
1632
1623(defun mac-bytes-to-integer (bytes &optional from to) 1633(defun mac-bytes-to-integer (bytes &optional from to)
1624 (or from (setq from 0)) 1634 (or from (setq from 0))
1625 (or to (setq to (length bytes))) 1635 (or to (setq to (length bytes)))
@@ -1635,17 +1645,6 @@ in `selection-converter-alist', which see."
1635 (ash (lsh result extended-sign-len) (- extended-sign-len)) 1645 (ash (lsh result extended-sign-len) (- extended-sign-len))
1636 result))) 1646 result)))
1637 1647
1638(defun mac-bytes-to-digits (bytes &optional from to)
1639 (or from (setq from 0))
1640 (or to (setq to (length bytes)))
1641 (let ((len (- to from))
1642 (val 0.0))
1643 (dotimes (i len)
1644 (setq val (+ (* val 256.0)
1645 (aref bytes (+ from (if (eq (byteorder) ?B) i
1646 (- len i 1)))))))
1647 (format "%.0f" val)))
1648
1649(defun mac-ae-selection-range (ae) 1648(defun mac-ae-selection-range (ae)
1650;; #pragma options align=mac68k 1649;; #pragma options align=mac68k
1651;; typedef struct SelectionRange { 1650;; typedef struct SelectionRange {
@@ -1671,13 +1670,75 @@ in `selection-converter-alist', which see."
1671 (and utf8-text 1670 (and utf8-text
1672 (decode-coding-string utf8-text 'utf-8)))) 1671 (decode-coding-string utf8-text 'utf-8))))
1673 1672
1673(defun mac-ae-text (ae)
1674 (or (cdr (mac-ae-parameter ae nil "TEXT"))
1675 (error "No text in Apple event.")))
1676
1677(defun mac-ae-frame (ae &optional keyword type)
1678 (let ((bytes (cdr (mac-ae-parameter ae keyword type))))
1679 (if (or (null bytes) (/= (length bytes) 4))
1680 (error "No window reference in Apple event.")
1681 (let ((window-id (mac-coerce-ae-data "long" bytes "TEXT"))
1682 (rest (frame-list))
1683 frame)
1684 (while (and (null frame) rest)
1685 (if (string= (frame-parameter (car rest) 'window-id) window-id)
1686 (setq frame (car rest)))
1687 (setq rest (cdr rest)))
1688 frame))))
1689
1690(defun mac-ae-script-language (ae keyword)
1691;; struct WritingCode {
1692;; ScriptCode theScriptCode;
1693;; LangCode theLangCode;
1694;; };
1695 (let ((bytes (cdr (mac-ae-parameter ae keyword "intl"))))
1696 (and bytes
1697 (cons (mac-bytes-to-integer bytes 0 2)
1698 (mac-bytes-to-integer bytes 2 4)))))
1699
1700(defun mac-bytes-to-text-range (bytes &optional from to)
1701;; struct TextRange {
1702;; long fStart;
1703;; long fEnd;
1704;; short fHiliteStyle;
1705;; };
1706 (or from (setq from 0))
1707 (or to (setq to (length bytes)))
1708 (and (= (- to from) (+ 4 4 2))
1709 (list (mac-bytes-to-integer bytes from (+ from 4))
1710 (mac-bytes-to-integer bytes (+ from 4) (+ from 8))
1711 (mac-bytes-to-integer bytes (+ from 8) to))))
1712
1713(defun mac-ae-text-range-array (ae keyword)
1714;; struct TextRangeArray {
1715;; short fNumOfRanges;
1716;; TextRange fRange[1];
1717;; };
1718 (let* ((bytes (cdr (mac-ae-parameter ae keyword "tray")))
1719 (len (length bytes))
1720 nranges result)
1721 (when (and bytes (>= len 2)
1722 (progn
1723 (setq nranges (mac-bytes-to-integer bytes 0 2))
1724 (= len (+ 2 (* nranges 10)))))
1725 (setq result (make-vector nranges nil))
1726 (dotimes (i nranges)
1727 (aset result i
1728 (mac-bytes-to-text-range bytes (+ (* i 10) 2)
1729 (+ (* i 10) 12)))))
1730 result))
1731
1674(defun mac-ae-open-documents (event) 1732(defun mac-ae-open-documents (event)
1675 "Open the documents specified by the Apple event EVENT." 1733 "Open the documents specified by the Apple event EVENT."
1676 (interactive "e") 1734 (interactive "e")
1677 (let ((ae (mac-event-ae event))) 1735 (let ((ae (mac-event-ae event)))
1678 (dolist (file-name (mac-ae-list ae nil 'undecoded-file-name)) 1736 (dolist (file-name (mac-ae-list ae nil 'undecoded-file-name))
1679 (if file-name 1737 (if file-name
1680 (dnd-open-local-file (concat "file:" file-name) nil))) 1738 (dnd-open-local-file
1739 (concat "file://"
1740 (mapconcat 'url-hexify-string
1741 (split-string file-name "/") "/")) nil)))
1681 (let ((selection-range (mac-ae-selection-range ae)) 1742 (let ((selection-range (mac-ae-selection-range ae))
1682 (search-text (mac-ae-text-for-search ae))) 1743 (search-text (mac-ae-text-for-search ae)))
1683 (cond (selection-range 1744 (cond (selection-range
@@ -1695,10 +1756,6 @@ in `selection-converter-alist', which see."
1695 nil t))))) 1756 nil t)))))
1696 (select-frame-set-input-focus (selected-frame))) 1757 (select-frame-set-input-focus (selected-frame)))
1697 1758
1698(defun mac-ae-text (ae)
1699 (or (cdr (mac-ae-parameter ae nil "TEXT"))
1700 (error "No text in Apple event.")))
1701
1702(defun mac-ae-get-url (event) 1759(defun mac-ae-get-url (event)
1703 "Open the URL specified by the Apple event EVENT. 1760 "Open the URL specified by the Apple event EVENT.
1704Currently the `mailto' scheme is supported." 1761Currently the `mailto' scheme is supported."
@@ -1707,7 +1764,7 @@ Currently the `mailto' scheme is supported."
1707 (parsed-url (url-generic-parse-url (mac-ae-text ae)))) 1764 (parsed-url (url-generic-parse-url (mac-ae-text ae))))
1708 (if (string= (url-type parsed-url) "mailto") 1765 (if (string= (url-type parsed-url) "mailto")
1709 (url-mailto parsed-url) 1766 (url-mailto parsed-url)
1710 (error "Unsupported URL scheme: %s" (url-type parsed-url))))) 1767 (mac-resume-apple-event ae t))))
1711 1768
1712(setq mac-apple-event-map (make-sparse-keymap)) 1769(setq mac-apple-event-map (make-sparse-keymap))
1713 1770
@@ -1743,13 +1800,7 @@ modifiers, it changes global tool-bar visibility setting."
1743 (if (and modifiers (not (string= modifiers "\000\000\000\000"))) 1800 (if (and modifiers (not (string= modifiers "\000\000\000\000")))
1744 ;; Globally toggle tool-bar-mode if some modifier key is pressed. 1801 ;; Globally toggle tool-bar-mode if some modifier key is pressed.
1745 (tool-bar-mode) 1802 (tool-bar-mode)
1746 (let ((window-id (mac-bytes-to-digits (cdr (mac-ae-parameter ae)))) 1803 (let ((frame (mac-ae-frame ae)))
1747 (rest (frame-list))
1748 frame)
1749 (while (and (null frame) rest)
1750 (if (string= (frame-parameter (car rest) 'window-id) window-id)
1751 (setq frame (car rest)))
1752 (setq rest (cdr rest)))
1753 (set-frame-parameter frame 'tool-bar-lines 1804 (set-frame-parameter frame 'tool-bar-lines
1754 (if (= (frame-parameter frame 'tool-bar-lines) 0) 1805 (if (= (frame-parameter frame 'tool-bar-lines) 0)
1755 1 0)))))) 1806 1 0))))))
@@ -1779,13 +1830,12 @@ With numeric ARG, display the font panel if and only if ARG is positive."
1779 "Change default face attributes according to font selection EVENT." 1830 "Change default face attributes according to font selection EVENT."
1780 (interactive "e") 1831 (interactive "e")
1781 (let* ((ae (mac-event-ae event)) 1832 (let* ((ae (mac-event-ae event))
1782 (fm-font-size (cdr (mac-ae-parameter ae "fmsz"))) 1833 (fm-font-size (mac-ae-number ae "fmsz"))
1783 (atsu-font-id (cdr (mac-ae-parameter ae "auid"))) 1834 (atsu-font-id (cdr (mac-ae-parameter ae "auid")))
1784 (attribute-values (gethash atsu-font-id mac-atsu-font-table))) 1835 (attribute-values (gethash atsu-font-id mac-atsu-font-table)))
1785 (if fm-font-size 1836 (if fm-font-size
1786 (setq attribute-values 1837 (setq attribute-values
1787 `(:height ,(* 10 (mac-bytes-to-integer fm-font-size)) 1838 `(:height ,(* 10 fm-font-size) ,@attribute-values)))
1788 ,@attribute-values)))
1789 (apply 'set-face-attribute 'default (selected-frame) attribute-values))) 1839 (apply 'set-face-attribute 'default (selected-frame) attribute-values)))
1790 1840
1791;; kEventClassFont/kEventFontPanelClosed 1841;; kEventClassFont/kEventFontPanelClosed
@@ -1802,6 +1852,258 @@ With numeric ARG, display the font panel if and only if ARG is positive."
1802 1852
1803) ;; (fboundp 'mac-set-font-panel-visibility) 1853) ;; (fboundp 'mac-set-font-panel-visibility)
1804 1854
1855;;; Text Services
1856(defvar mac-ts-active-input-buf ""
1857 "Byte sequence of the current Mac TSM active input area.")
1858(defvar mac-ts-update-active-input-area-seqno 0
1859 "Number of processed update-active-input-area events.")
1860(setq mac-ts-active-input-overlay (make-overlay 0 0))
1861
1862(defface mac-ts-caret-position
1863 '((t :inverse-video t))
1864 "Face for caret position in Mac TSM active input area.
1865This is used only when the active input area is displayed in the
1866echo area."
1867 :group 'mac)
1868
1869(defface mac-ts-raw-text
1870 '((t :underline t))
1871 "Face for raw text in Mac TSM active input area."
1872 :group 'mac)
1873
1874(defface mac-ts-selected-raw-text
1875 '((t :underline t))
1876 "Face for selected raw text in Mac TSM active input area."
1877 :group 'mac)
1878
1879(defface mac-ts-converted-text
1880 '((((background dark)) :underline "gray20")
1881 (t :underline "gray80"))
1882 "Face for converted text in Mac TSM active input area."
1883 :group 'mac)
1884
1885(defface mac-ts-selected-converted-text
1886 '((t :underline t))
1887 "Face for selected converted text in Mac TSM active input area."
1888 :group 'mac)
1889
1890(defface mac-ts-block-fill-text
1891 '((t :underline t))
1892 "Face for block fill text in Mac TSM active input area."
1893 :group 'mac)
1894
1895(defface mac-ts-outline-text
1896 '((t :underline t))
1897 "Face for outline text in Mac TSM active input area."
1898 :group 'mac)
1899
1900(defface mac-ts-selected-text
1901 '((t :underline t))
1902 "Face for selected text in Mac TSM active input area."
1903 :group 'mac)
1904
1905(defface mac-ts-no-hilite
1906 '((t :inherit default))
1907 "Face for no hilite in Mac TSM active input area."
1908 :group 'mac)
1909
1910(defconst mac-ts-hilite-style-faces
1911 '((2 . mac-ts-raw-text) ; kTSMHiliteRawText
1912 (3 . mac-ts-selected-raw-text) ; kTSMHiliteSelectedRawText
1913 (4 . mac-ts-converted-text) ; kTSMHiliteConvertedText
1914 (5 . mac-ts-selected-converted-text) ; kTSMHiliteSelectedConvertedText
1915 (6 . mac-ts-block-fill-text) ; kTSMHiliteBlockFillText
1916 (7 . mac-ts-outline-text) ; kTSMHiliteOutlineText
1917 (8 . mac-ts-selected-text) ; kTSMHiliteSelectedText
1918 (9 . mac-ts-no-hilite)) ; kTSMHiliteNoHilite
1919 "Alist of Mac TSM hilite style vs Emacs face.")
1920
1921(defun mac-ts-update-active-input-buf (text fix-len hilite-rng update-rng)
1922 (let ((buf-len (length mac-ts-active-input-buf))
1923 confirmed)
1924 (if (or (null update-rng)
1925 (/= (% (length update-rng) 2) 0))
1926 ;; The parameter is missing (or in a bad format). The
1927 ;; existing inline input session is completely replaced with
1928 ;; the new text.
1929 (setq mac-ts-active-input-buf text)
1930 ;; Otherwise, the current subtext specified by the (2*j)-th
1931 ;; range is replaced with the new subtext specified by the
1932 ;; (2*j+1)-th range.
1933 (let ((tail buf-len)
1934 (i (length update-rng))
1935 segments rng)
1936 (while (> i 0)
1937 (setq i (- i 2))
1938 (setq rng (aref update-rng i))
1939 (if (and (<= 0 (cadr rng)) (< (cadr rng) tail)
1940 (<= tail buf-len))
1941 (setq segments
1942 (cons (substring mac-ts-active-input-buf (cadr rng) tail)
1943 segments)))
1944 (setq tail (car rng))
1945 (setq rng (aref update-rng (1+ i)))
1946 (if (and (<= 0 (car rng)) (< (car rng) (cadr rng))
1947 (<= (cadr rng) (length text)))
1948 (setq segments
1949 (cons (substring text (car rng) (cadr rng))
1950 segments))))
1951 (if (and (< 0 tail) (<= tail buf-len))
1952 (setq segments
1953 (cons (substring mac-ts-active-input-buf 0 tail)
1954 segments)))
1955 (setq mac-ts-active-input-buf (apply 'concat segments))))
1956 (setq buf-len (length mac-ts-active-input-buf))
1957 ;; Confirm (a part of) inline input session.
1958 (cond ((< fix-len 0)
1959 ;; Entire inline session is being confirmed.
1960 (setq confirmed mac-ts-active-input-buf)
1961 (setq mac-ts-active-input-buf ""))
1962 ((= fix-len 0)
1963 ;; None of the text is being confirmed (yet).
1964 (setq confirmed ""))
1965 (t
1966 (if (> fix-len buf-len)
1967 (setq fix-len buf-len))
1968 (setq confirmed (substring mac-ts-active-input-buf 0 fix-len))
1969 (setq mac-ts-active-input-buf
1970 (substring mac-ts-active-input-buf fix-len))))
1971 (setq buf-len (length mac-ts-active-input-buf))
1972 ;; Update highlighting and the caret position in the new inline
1973 ;; input session.
1974 (remove-text-properties 0 buf-len '(cursor nil) mac-ts-active-input-buf)
1975 (mapc (lambda (rng)
1976 (cond ((and (= (nth 2 rng) 1) ; kTSMHiliteCaretPosition
1977 (<= 0 (car rng)) (< (car rng) buf-len))
1978 (put-text-property (car rng) buf-len
1979 'cursor t mac-ts-active-input-buf))
1980 ((and (<= 0 (car rng)) (< (car rng) (cadr rng))
1981 (<= (cadr rng) buf-len))
1982 (put-text-property (car rng) (cadr rng) 'face
1983 (cdr (assq (nth 2 rng)
1984 mac-ts-hilite-style-faces))
1985 mac-ts-active-input-buf))))
1986 hilite-rng)
1987 confirmed))
1988
1989(defun mac-split-string-by-property-change (string)
1990 (let ((tail (length string))
1991 head result)
1992 (unless (= tail 0)
1993 (while (setq head (previous-property-change tail string)
1994 result (cons (substring string (or head 0) tail) result)
1995 tail head)))
1996 result))
1997
1998(defun mac-replace-untranslated-utf-8-chars (string &optional to-string)
1999 (or to-string (setq to-string "$,3u=(B"))
2000 (mapconcat
2001 (lambda (str)
2002 (if (get-text-property 0 'untranslated-utf-8 str) to-string str))
2003 (mac-split-string-by-property-change string)
2004 ""))
2005
2006(defun mac-ts-update-active-input-area (event)
2007 "Update Mac TSM active input area according to EVENT.
2008The confirmed text is converted to Emacs input events and pushed
2009into `unread-command-events'. The unconfirmed text is displayed
2010either in the current buffer or in the echo area."
2011 (interactive "e")
2012 (let* ((ae (mac-event-ae event))
2013 (text (or (cdr (mac-ae-parameter ae "tstx" "utxt")) ""))
2014 (script-language (mac-ae-script-language ae "tssl"))
2015 (coding (or (cdr (assq (car script-language)
2016 mac-script-code-coding-systems))
2017 'mac-roman))
2018 (fix-len (mac-bytes-to-integer
2019 (cdr (mac-ae-parameter ae "tsfx" "long"))))
2020 ;; Optional parameters
2021 (hilite-rng (mac-ae-text-range-array ae "tshi"))
2022 (update-rng (mac-ae-text-range-array ae "tsup"))
2023 ;;(pin-rng (mac-bytes-to-text-range (cdr (mac-ae-parameter ae "tspn" "txrn"))))
2024 ;;(clause-offsets (cdr (mac-ae-parameter ae "tscl" "ofay")))
2025 (seqno (mac-ae-number ae "tsSn"))
2026 confirmed)
2027 (unless (= seqno mac-ts-update-active-input-area-seqno)
2028 ;; Reset internal states if sequence number is out of sync.
2029 (setq mac-ts-active-input-buf ""))
2030 (setq confirmed
2031 (mac-ts-update-active-input-buf text fix-len hilite-rng update-rng))
2032 (let ((use-echo-area
2033 (or isearch-mode
2034 (and cursor-in-echo-area (current-message))
2035 ;; Overlay strings are not shown in some cases.
2036 (get-char-property (point) 'display)
2037 (get-char-property (point) 'invisible)
2038 (get-char-property (point) 'composition)))
2039 active-input-string caret-seen)
2040 ;; Decode the active input area text with inheriting faces and
2041 ;; the caret position.
2042 (setq active-input-string
2043 (mapconcat
2044 (lambda (str)
2045 (let ((decoded (mac-utxt-to-string str coding)))
2046 (put-text-property 0 (length decoded) 'face
2047 (get-text-property 0 'face str) decoded)
2048 (when (and (not caret-seen)
2049 (get-text-property 0 'cursor str))
2050 (setq caret-seen t)
2051 (if use-echo-area
2052 (put-text-property 0 1 'face 'mac-ts-caret-position
2053 decoded)
2054 (put-text-property 0 1 'cursor t decoded)))
2055 decoded))
2056 (mac-split-string-by-property-change mac-ts-active-input-buf)
2057 ""))
2058 (put-text-property 0 (length active-input-string)
2059 'mac-ts-active-input-string t active-input-string)
2060 (if use-echo-area
2061 (let (msg message-log-max)
2062 (if (and (current-message)
2063 ;; Don't get confused by previously displayed
2064 ;; `active-input-string'.
2065 (null (get-text-property 0 'mac-ts-active-input-string
2066 (current-message))))
2067 (setq msg (propertize (current-message) 'display
2068 (concat (current-message)
2069 active-input-string)))
2070 (setq msg active-input-string))
2071 (message "%s" msg)
2072 (overlay-put mac-ts-active-input-overlay 'before-string nil))
2073 (move-overlay mac-ts-active-input-overlay
2074 (point) (point) (current-buffer))
2075 (overlay-put mac-ts-active-input-overlay 'before-string
2076 active-input-string))
2077 ;; Unread confirmed characters and insert them in a keyboard
2078 ;; macro being defined.
2079 (apply 'isearch-unread
2080 (append (mac-replace-untranslated-utf-8-chars
2081 (mac-utxt-to-string confirmed coding)) '())))
2082 ;; The event is successfully processed. Sync the sequence number.
2083 (setq mac-ts-update-active-input-area-seqno (1+ seqno))))
2084
2085(defun mac-ts-unicode-for-key-event (event)
2086 "Convert Unicode key EVENT to Emacs key events and unread them."
2087 (interactive "e")
2088 (let* ((ae (mac-event-ae event))
2089 (text (cdr (mac-ae-parameter ae "tstx" "utxt")))
2090 (script-language (mac-ae-script-language ae "tssl"))
2091 (coding (or (cdr (assq (car script-language)
2092 mac-script-code-coding-systems))
2093 'mac-roman)))
2094 ;; Unread characters and insert them in a keyboard macro being
2095 ;; defined.
2096 (apply 'isearch-unread
2097 (append (mac-replace-untranslated-utf-8-chars
2098 (mac-utxt-to-string text coding)) '()))))
2099
2100;; kEventClassTextInput/kEventTextInputUpdateActiveInputArea
2101(define-key mac-apple-event-map [text-input update-active-input-area]
2102 'mac-ts-update-active-input-area)
2103;; kEventClassTextInput/kEventTextInputUnicodeForKeyEvent
2104(define-key mac-apple-event-map [text-input unicode-for-key-event]
2105 'mac-ts-unicode-for-key-event)
2106
1805;;; Services 2107;;; Services
1806(defun mac-service-open-file () 2108(defun mac-service-open-file ()
1807 "Open the file specified by the selection value for Services." 2109 "Open the file specified by the selection value for Services."
@@ -1857,9 +2159,9 @@ With numeric ARG, display the font panel if and only if ARG is positive."
1857 "Dispatch EVENT according to the keymap `mac-apple-event-map'." 2159 "Dispatch EVENT according to the keymap `mac-apple-event-map'."
1858 (interactive "e") 2160 (interactive "e")
1859 (let* ((binding (lookup-key mac-apple-event-map (mac-event-spec event))) 2161 (let* ((binding (lookup-key mac-apple-event-map (mac-event-spec event)))
1860 (service-message 2162 (ae (mac-event-ae event))
1861 (and (keymapp binding) 2163 (service-message (and (keymapp binding)
1862 (cdr (mac-ae-parameter (mac-event-ae event) "svmg"))))) 2164 (cdr (mac-ae-parameter ae "svmg")))))
1863 (when service-message 2165 (when service-message
1864 (setq service-message 2166 (setq service-message
1865 (intern (decode-coding-string service-message 'utf-8))) 2167 (intern (decode-coding-string service-message 'utf-8)))
@@ -1867,9 +2169,18 @@ With numeric ARG, display the font panel if and only if ARG is positive."
1867 ;; Replace (cadr event) with a dummy position so that event-start 2169 ;; Replace (cadr event) with a dummy position so that event-start
1868 ;; returns it. 2170 ;; returns it.
1869 (setcar (cdr event) (list (selected-window) (point) '(0 . 0) 0)) 2171 (setcar (cdr event) (list (selected-window) (point) '(0 . 0) 0))
1870 (call-interactively binding))) 2172 (if (null (mac-ae-parameter ae 'emacs-suspension-id))
2173 (command-execute binding nil (vector event) t)
2174 (condition-case err
2175 (progn
2176 (command-execute binding nil (vector event) t)
2177 (mac-resume-apple-event ae))
2178 (error
2179 (mac-ae-set-reply-parameter ae "errs"
2180 (cons "TEXT" (error-message-string err)))
2181 (mac-resume-apple-event ae -10000)))))) ; errAEEventFailed
1871 2182
1872(global-set-key [mac-apple-event] 'mac-dispatch-apple-event) 2183(define-key special-event-map [mac-apple-event] 'mac-dispatch-apple-event)
1873 2184
1874;; Processing of Apple events are deferred at the startup time. For 2185;; Processing of Apple events are deferred at the startup time. For
1875;; example, files dropped onto the Emacs application icon can only be 2186;; example, files dropped onto the Emacs application icon can only be
@@ -1877,6 +2188,8 @@ With numeric ARG, display the font panel if and only if ARG is positive."
1877;; the files should be opened. 2188;; the files should be opened.
1878(add-hook 'after-init-hook 'mac-process-deferred-apple-events) 2189(add-hook 'after-init-hook 'mac-process-deferred-apple-events)
1879 2190
2191(run-with-idle-timer 5 t 'mac-cleanup-expired-apple-events)
2192
1880 2193
1881;;;; Drag and drop 2194;;;; Drag and drop
1882 2195
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index 6061c3eb0dc..f3c32011349 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -112,6 +112,14 @@ Switch to a buffer editing the last file dropped."
112 (if (and (> x 0) (> y 0)) 112 (if (and (> x 0) (> y 0))
113 (set-frame-selected-window nil window)) 113 (set-frame-selected-window nil window))
114 (mapcar (lambda (file-name) 114 (mapcar (lambda (file-name)
115 (let ((f (subst-char-in-string ?\\ ?/ file-name))
116 (coding (or file-name-coding-system
117 default-file-name-coding-system)))
118 (setq file-name
119 (mapconcat 'url-hexify-string
120 (split-string (encode-coding-string f coding)
121 "/")
122 "/")))
115 (dnd-handle-one-url window 'private 123 (dnd-handle-one-url window 'private
116 (concat "file:" file-name))) 124 (concat "file:" file-name)))
117 (car (cdr (cdr event))))) 125 (car (cdr (cdr event)))))
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 5bc93b47fe9..c6b3c4d1ba3 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -2495,5 +2495,9 @@ order until succeed.")
2495(add-hook 'after-make-frame-functions 'x-dnd-init-frame) 2495(add-hook 'after-make-frame-functions 'x-dnd-init-frame)
2496(global-set-key [drag-n-drop] 'x-dnd-handle-drag-n-drop-event) 2496(global-set-key [drag-n-drop] 'x-dnd-handle-drag-n-drop-event)
2497 2497
2498;; Let F10 do menu bar navigation.
2499(and (fboundp 'menu-bar-open)
2500 (global-set-key [f10] 'menu-bar-open))
2501
2498;; arch-tag: f1501302-db8b-4d95-88e3-116697d89f78 2502;; arch-tag: f1501302-db8b-4d95-88e3-116697d89f78
2499;;; x-win.el ends here 2503;;; x-win.el ends here
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 9305bdbf9bc..d5dcdd0d9ef 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -365,10 +365,11 @@ Example:
365 "*If in X Windows, use this pointer shape while drawing with the mouse.") 365 "*If in X Windows, use this pointer shape while drawing with the mouse.")
366 366
367 367
368(defcustom artist-text-renderer 'artist-figlet 368(defcustom artist-text-renderer-function 'artist-figlet
369 "Function for doing text rendering." 369 "Function for doing text rendering."
370 :group 'artist-text 370 :group 'artist-text
371 :type 'symbol) 371 :type 'symbol)
372(defvaralias 'artist-text-renderer 'artist-text-renderer-function)
372 373
373 374
374(defcustom artist-figlet-program "figlet" 375(defcustom artist-figlet-program "figlet"
@@ -2910,23 +2911,25 @@ Let blanks in TEXT overwrite any text already in the buffer."
2910 2911
2911(defun artist-text-see-thru (x y) 2912(defun artist-text-see-thru (x y)
2912 "Prompt for text to render, render it at X,Y. 2913 "Prompt for text to render, render it at X,Y.
2913This is done by calling the function specified by `artist-text-renderer', 2914This is done by calling the function specified by
2914which must return a list of strings, to be inserted in the buffer. 2915`artist-text-renderer-function', which must return a list of strings,
2916to be inserted in the buffer.
2915 2917
2916Text already in the buffer ``shines thru'' blanks in the rendered text." 2918Text already in the buffer ``shines thru'' blanks in the rendered text."
2917 (let* ((input-text (read-string "Type text to render: ")) 2919 (let* ((input-text (read-string "Type text to render: "))
2918 (rendered-text (artist-funcall artist-text-renderer input-text))) 2920 (rendered-text (artist-funcall artist-text-renderer-function input-text)))
2919 (artist-text-insert-see-thru x y rendered-text))) 2921 (artist-text-insert-see-thru x y rendered-text)))
2920 2922
2921 2923
2922(defun artist-text-overwrite (x y) 2924(defun artist-text-overwrite (x y)
2923 "Prompt for text to render, render it at X,Y. 2925 "Prompt for text to render, render it at X,Y.
2924This is done by calling the function specified by `artist-text-renderer', 2926This is done by calling the function specified by
2925which must return a list of strings, to be inserted in the buffer. 2927`artist-text-renderer-function', which must return a list of strings,
2928to be inserted in the buffer.
2926 2929
2927Blanks in the rendered text overwrites any text in the buffer." 2930Blanks in the rendered text overwrites any text in the buffer."
2928 (let* ((input-text (read-string "Type text to render: ")) 2931 (let* ((input-text (read-string "Type text to render: "))
2929 (rendered-text (artist-funcall artist-text-renderer input-text))) 2932 (rendered-text (artist-funcall artist-text-renderer-function input-text)))
2930 (artist-text-insert-overwrite x y rendered-text))) 2933 (artist-text-insert-overwrite x y rendered-text)))
2931 2934
2932;; 2935;;
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index e4f0a3db545..c82f2dcf3d0 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -87,7 +87,7 @@ If this is a function, call it to generate the initial field text."
87 :type '(choice (const :tag "None" nil) 87 :type '(choice (const :tag "None" nil)
88 (string :tag "Initial text") 88 (string :tag "Initial text")
89 (function :tag "Initialize Function" :value fun) 89 (function :tag "Initialize Function" :value fun)
90 (other :tag "Default" t))) 90 (const :tag "Default" t)))
91(put 'bibtex-include-OPTkey 'risky-local-variable t) 91(put 'bibtex-include-OPTkey 'risky-local-variable t)
92 92
93(defcustom bibtex-user-optional-fields 93(defcustom bibtex-user-optional-fields
@@ -153,7 +153,7 @@ narrowed to just the entry."
153(defcustom bibtex-maintain-sorted-entries nil 153(defcustom bibtex-maintain-sorted-entries nil
154 "If non-nil, BibTeX mode maintains all entries in sorted order. 154 "If non-nil, BibTeX mode maintains all entries in sorted order.
155Allowed non-nil values are: 155Allowed non-nil values are:
156plain All entries are sorted alphabetically. 156plain or t All entries are sorted alphabetically.
157crossref All entries are sorted alphabetically unless an entry has a 157crossref All entries are sorted alphabetically unless an entry has a
158 crossref field. These crossrefed entries are placed in 158 crossref field. These crossrefed entries are placed in
159 alphabetical order immediately preceding the main entry. 159 alphabetical order immediately preceding the main entry.
@@ -165,7 +165,10 @@ See also `bibtex-sort-ignore-string-entries'."
165 :type '(choice (const nil) 165 :type '(choice (const nil)
166 (const plain) 166 (const plain)
167 (const crossref) 167 (const crossref)
168 (const entry-class))) 168 (const entry-class)
169 (const t)))
170(put 'bibtex-maintain-sorted-entries 'safe-local-variable
171 '(lambda (a) (memq a '(nil t plain crossref entry-class))))
169 172
170(defcustom bibtex-sort-entry-class 173(defcustom bibtex-sort-entry-class
171 '(("String") 174 '(("String")
@@ -180,6 +183,17 @@ to all entries not explicitly mentioned."
180 :type '(repeat (choice :tag "Class" 183 :type '(repeat (choice :tag "Class"
181 (const :tag "catch-all" (catch-all)) 184 (const :tag "catch-all" (catch-all))
182 (repeat :tag "Entry name" string)))) 185 (repeat :tag "Entry name" string))))
186(put 'bibtex-sort-entry-class 'safe-local-variable
187 (lambda (x) (let ((OK t))
188 (while (consp x)
189 (let ((y (pop x)))
190 (while (consp y)
191 (let ((z (pop y)))
192 (unless (or (stringp z) (eq z 'catch-all))
193 (setq OK nil))))
194 (unless (null y) (setq OK nil))))
195 (unless (null x) (setq OK nil))
196 OK)))
183 197
184(defcustom bibtex-sort-ignore-string-entries t 198(defcustom bibtex-sort-ignore-string-entries t
185 "If non-nil, BibTeX @String entries are not sort-significant. 199 "If non-nil, BibTeX @String entries are not sort-significant.
@@ -607,6 +621,8 @@ See `bibtex-generate-autokey' for details."
607 (const :tag "Capitalize" capitalize) 621 (const :tag "Capitalize" capitalize)
608 (const :tag "Upcase" upcase) 622 (const :tag "Upcase" upcase)
609 (function :tag "Conversion function"))) 623 (function :tag "Conversion function")))
624(put 'bibtex-autokey-name-case-convert-function 'safe-local-variable
625 (lambda (x) (memq x '(upcase downcase capitalize identity))))
610(defvaralias 'bibtex-autokey-name-case-convert 626(defvaralias 'bibtex-autokey-name-case-convert
611 'bibtex-autokey-name-case-convert-function) 627 'bibtex-autokey-name-case-convert-function)
612 628
@@ -1185,13 +1201,7 @@ The CDRs of the elements are t for header keys and nil for crossref keys.")
1185(defvar bibtex-string-empty-key nil 1201(defvar bibtex-string-empty-key nil
1186 "If non-nil, `bibtex-parse-string' accepts empty key.") 1202 "If non-nil, `bibtex-parse-string' accepts empty key.")
1187 1203
1188(defvar bibtex-sort-entry-class-alist 1204(defvar bibtex-sort-entry-class-alist nil
1189 (let ((i -1) alist)
1190 (dolist (class bibtex-sort-entry-class alist)
1191 (setq i (1+ i))
1192 (dolist (entry class)
1193 ;; all entry names should be downcase (for ease of comparison)
1194 (push (cons (if (stringp entry) (downcase entry) entry) i) alist))))
1195 "Alist mapping entry types to their sorting index. 1205 "Alist mapping entry types to their sorting index.
1196Auto-generated from `bibtex-sort-entry-class'. 1206Auto-generated from `bibtex-sort-entry-class'.
1197Used when `bibtex-maintain-sorted-entries' is `entry-class'.") 1207Used when `bibtex-maintain-sorted-entries' is `entry-class'.")
@@ -1800,7 +1810,8 @@ Formats current entry according to variable `bibtex-entry-format'."
1800 1810
1801 ;; identify entry type 1811 ;; identify entry type
1802 (goto-char (point-min)) 1812 (goto-char (point-min))
1803 (re-search-forward bibtex-entry-type) 1813 (or (re-search-forward bibtex-entry-type nil t)
1814 (error "Not inside a BibTeX entry"))
1804 (let ((beg-type (1+ (match-beginning 0))) 1815 (let ((beg-type (1+ (match-beginning 0)))
1805 (end-type (match-end 0))) 1816 (end-type (match-end 0)))
1806 (setq entry-list (assoc-string (buffer-substring-no-properties 1817 (setq entry-list (assoc-string (buffer-substring-no-properties
@@ -3184,6 +3195,17 @@ of the head of the entry found. Return nil if no entry found."
3184 entry-name)) 3195 entry-name))
3185 (list key nil entry-name)))))) 3196 (list key nil entry-name))))))
3186 3197
3198(defun bibtex-init-sort-entry-class-alist ()
3199 (unless (local-variable-p 'bibtex-sort-entry-class-alist)
3200 (set (make-local-variable 'bibtex-sort-entry-class-alist)
3201 (let ((i -1) alist)
3202 (dolist (class bibtex-sort-entry-class alist)
3203 (setq i (1+ i))
3204 (dolist (entry class)
3205 ;; All entry names should be downcase (for ease of comparison).
3206 (push (cons (if (stringp entry) (downcase entry) entry) i)
3207 alist)))))))
3208
3187(defun bibtex-lessp (index1 index2) 3209(defun bibtex-lessp (index1 index2)
3188 "Predicate for sorting BibTeX entries with indices INDEX1 and INDEX2. 3210 "Predicate for sorting BibTeX entries with indices INDEX1 and INDEX2.
3189Each index is a list (KEY CROSSREF-KEY ENTRY-NAME). 3211Each index is a list (KEY CROSSREF-KEY ENTRY-NAME).
@@ -3221,13 +3243,14 @@ If its value is nil use plain sorting. Text outside of BibTeX entries is not
3221affected. If `bibtex-sort-ignore-string-entries' is non-nil, @String entries 3243affected. If `bibtex-sort-ignore-string-entries' is non-nil, @String entries
3222are ignored." 3244are ignored."
3223 (interactive) 3245 (interactive)
3224 (bibtex-beginning-of-first-entry) ;; needed by `sort-subr' 3246 (bibtex-beginning-of-first-entry) ; Needed by `sort-subr'
3225 (sort-subr nil 3247 (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'.
3226 'bibtex-skip-to-valid-entry ; NEXTREC function 3248 (sort-subr nil
3227 'bibtex-end-of-entry ; ENDREC function 3249 'bibtex-skip-to-valid-entry ; NEXTREC function
3228 'bibtex-entry-index ; STARTKEY function 3250 'bibtex-end-of-entry ; ENDREC function
3229 nil ; ENDKEY function 3251 'bibtex-entry-index ; STARTKEY function
3230 'bibtex-lessp)) ; PREDICATE 3252 nil ; ENDKEY function
3253 'bibtex-lessp)) ; PREDICATE
3231 3254
3232(defun bibtex-find-crossref (crossref-key &optional pnt split) 3255(defun bibtex-find-crossref (crossref-key &optional pnt split)
3233 "Move point to the beginning of BibTeX entry CROSSREF-KEY. 3256 "Move point to the beginning of BibTeX entry CROSSREF-KEY.
@@ -3328,6 +3351,7 @@ If `bibtex-maintain-sorted-entries' is non-nil, perform a binary
3328search to look for place for KEY. This requires that buffer is sorted, 3351search to look for place for KEY. This requires that buffer is sorted,
3329see `bibtex-validate'. 3352see `bibtex-validate'.
3330Return t if preparation was successful or nil if entry KEY already exists." 3353Return t if preparation was successful or nil if entry KEY already exists."
3354 (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'.
3331 (let ((key (nth 0 index)) 3355 (let ((key (nth 0 index))
3332 key-exist) 3356 key-exist)
3333 (cond ((or (null key) 3357 (cond ((or (null key)
@@ -3876,7 +3900,8 @@ At end of the cleaning process, the functions in
3876 (interactive "P") 3900 (interactive "P")
3877 (let ((case-fold-search t) 3901 (let ((case-fold-search t)
3878 (start (bibtex-beginning-of-entry)) 3902 (start (bibtex-beginning-of-entry))
3879 (_ (looking-at bibtex-any-entry-maybe-empty-head)) 3903 (_ (or (looking-at bibtex-any-entry-maybe-empty-head)
3904 (error "Not inside a BibTeX entry")))
3880 (entry-type (bibtex-type-in-head)) 3905 (entry-type (bibtex-type-in-head))
3881 (key (bibtex-key-in-head))) 3906 (key (bibtex-key-in-head)))
3882 ;; formatting 3907 ;; formatting
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 54b67a258a6..23f4756f4a7 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -271,21 +271,23 @@ If `flyspell-large-region' is nil, all regions are treated as small."
271;;* using flyspell with mail-mode add the following expression */ 271;;* using flyspell with mail-mode add the following expression */
272;;* in your .emacs file: */ 272;;* in your .emacs file: */
273;;* (add-hook 'mail-mode */ 273;;* (add-hook 'mail-mode */
274;;* '(lambda () (setq flyspell-generic-check-word-p */ 274;;* '(lambda () (setq flyspell-generic-check-word-predicate */
275;;* 'mail-mode-flyspell-verify))) */ 275;;* 'mail-mode-flyspell-verify))) */
276;;*---------------------------------------------------------------------*/ 276;;*---------------------------------------------------------------------*/
277(defvar flyspell-generic-check-word-p nil 277(defvar flyspell-generic-check-word-predicate nil
278 "Function providing per-mode customization over which words are flyspelled. 278 "Function providing per-mode customization over which words are flyspelled.
279Returns t to continue checking, nil otherwise. 279Returns t to continue checking, nil otherwise.
280Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate' 280Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate'
281property of the major mode name.") 281property of the major mode name.")
282(make-variable-buffer-local 'flyspell-generic-check-word-p) 282(make-variable-buffer-local 'flyspell-generic-check-word-predicate)
283(defvaralias 'flyspell-generic-check-word-p
284 'flyspell-generic-check-word-predicate)
283 285
284;;*--- mail mode -------------------------------------------------------*/ 286;;*--- mail mode -------------------------------------------------------*/
285(put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) 287(put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
286(put 'message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) 288(put 'message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
287(defun mail-mode-flyspell-verify () 289(defun mail-mode-flyspell-verify ()
288 "This function is used for `flyspell-generic-check-word-p' in Mail mode." 290 "Function used for `flyspell-generic-check-word-predicate' in Mail mode."
289 (let ((header-end (save-excursion 291 (let ((header-end (save-excursion
290 (goto-char (point-min)) 292 (goto-char (point-min))
291 (re-search-forward 293 (re-search-forward
@@ -313,7 +315,7 @@ property of the major mode name.")
313;;*--- texinfo mode ----------------------------------------------------*/ 315;;*--- texinfo mode ----------------------------------------------------*/
314(put 'texinfo-mode 'flyspell-mode-predicate 'texinfo-mode-flyspell-verify) 316(put 'texinfo-mode 'flyspell-mode-predicate 'texinfo-mode-flyspell-verify)
315(defun texinfo-mode-flyspell-verify () 317(defun texinfo-mode-flyspell-verify ()
316 "This function is used for `flyspell-generic-check-word-p' in Texinfo mode." 318 "Function used for `flyspell-generic-check-word-predicate' in Texinfo mode."
317 (save-excursion 319 (save-excursion
318 (forward-word -1) 320 (forward-word -1)
319 (not (looking-at "@")))) 321 (not (looking-at "@"))))
@@ -321,7 +323,7 @@ property of the major mode name.")
321;;*--- tex mode --------------------------------------------------------*/ 323;;*--- tex mode --------------------------------------------------------*/
322(put 'tex-mode 'flyspell-mode-predicate 'tex-mode-flyspell-verify) 324(put 'tex-mode 'flyspell-mode-predicate 'tex-mode-flyspell-verify)
323(defun tex-mode-flyspell-verify () 325(defun tex-mode-flyspell-verify ()
324 "This function is used for `flyspell-generic-check-word-p' in LaTeX mode." 326 "Function used for `flyspell-generic-check-word-predicate' in LaTeX mode."
325 (and 327 (and
326 (not (save-excursion 328 (not (save-excursion
327 (re-search-backward "^[ \t]*%%%[ \t]+Local" nil t))) 329 (re-search-backward "^[ \t]*%%%[ \t]+Local" nil t)))
@@ -338,7 +340,7 @@ property of the major mode name.")
338(put 'html-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify) 340(put 'html-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify)
339 341
340(defun sgml-mode-flyspell-verify () 342(defun sgml-mode-flyspell-verify ()
341 "This function is used for `flyspell-generic-check-word-p' in SGML mode." 343 "Function used for `flyspell-generic-check-word-predicate' in SGML mode."
342 (not (save-excursion 344 (not (save-excursion
343 (let ((this (point-marker)) 345 (let ((this (point-marker))
344 (s (progn (beginning-of-line) (point-marker))) 346 (s (progn (beginning-of-line) (point-marker)))
@@ -368,7 +370,7 @@ property of the major mode name.")
368 "Faces corresponding to text in programming-mode buffers.") 370 "Faces corresponding to text in programming-mode buffers.")
369 371
370(defun flyspell-generic-progmode-verify () 372(defun flyspell-generic-progmode-verify ()
371 "Used for `flyspell-generic-check-word-p' in programming modes." 373 "Used for `flyspell-generic-check-word-predicate' in programming modes."
372 (let ((f (get-text-property (point) 'face))) 374 (let ((f (get-text-property (point) 'face)))
373 (memq f flyspell-prog-text-faces))) 375 (memq f flyspell-prog-text-faces)))
374 376
@@ -376,7 +378,8 @@ property of the major mode name.")
376(defun flyspell-prog-mode () 378(defun flyspell-prog-mode ()
377 "Turn on `flyspell-mode' for comments and strings." 379 "Turn on `flyspell-mode' for comments and strings."
378 (interactive) 380 (interactive)
379 (setq flyspell-generic-check-word-p 'flyspell-generic-progmode-verify) 381 (setq flyspell-generic-check-word-predicate
382 'flyspell-generic-progmode-verify)
380 (flyspell-mode 1) 383 (flyspell-mode 1)
381 (run-hooks 'flyspell-prog-mode-hook)) 384 (run-hooks 'flyspell-prog-mode-hook))
382 385
@@ -483,6 +486,18 @@ in your .emacs file.
483 (flyspell-mode-on) 486 (flyspell-mode-on)
484 (flyspell-mode-off))) 487 (flyspell-mode-off)))
485 488
489;;;###autoload
490(defun turn-on-flyspell ()
491 "Unconditionally turn on Flyspell mode."
492 (flyspell-mode 1))
493
494;;;###autoload
495(defun turn-off-flyspell ()
496 "Unconditionally turn off Flyspell mode."
497 (flyspell-mode -1))
498
499(custom-add-option 'text-mode-hook 'turn-on-flyspell)
500
486;;*---------------------------------------------------------------------*/ 501;;*---------------------------------------------------------------------*/
487;;* flyspell-buffers ... */ 502;;* flyspell-buffers ... */
488;;* ------------------------------------------------------------- */ 503;;* ------------------------------------------------------------- */
@@ -563,10 +578,10 @@ in your .emacs file.
563 (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t) 578 (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t)
564 ;; we bound flyspell action to after-change hook 579 ;; we bound flyspell action to after-change hook
565 (add-hook 'after-change-functions 'flyspell-after-change-function nil t) 580 (add-hook 'after-change-functions 'flyspell-after-change-function nil t)
566 ;; set flyspell-generic-check-word-p based on the major mode 581 ;; set flyspell-generic-check-word-predicate based on the major mode
567 (let ((mode-predicate (get major-mode 'flyspell-mode-predicate))) 582 (let ((mode-predicate (get major-mode 'flyspell-mode-predicate)))
568 (if mode-predicate 583 (if mode-predicate
569 (setq flyspell-generic-check-word-p mode-predicate))) 584 (setq flyspell-generic-check-word-predicate mode-predicate)))
570 ;; the welcome message 585 ;; the welcome message
571 (if (and flyspell-issue-message-flag 586 (if (and flyspell-issue-message-flag
572 flyspell-issue-welcome-flag 587 flyspell-issue-welcome-flag
@@ -979,8 +994,8 @@ Mostly we check word delimiters."
979 (flyspell-word (flyspell-get-word following)) 994 (flyspell-word (flyspell-get-word following))
980 start end poss word) 995 start end poss word)
981 (if (or (eq flyspell-word nil) 996 (if (or (eq flyspell-word nil)
982 (and (fboundp flyspell-generic-check-word-p) 997 (and (fboundp flyspell-generic-check-word-predicate)
983 (not (funcall flyspell-generic-check-word-p)))) 998 (not (funcall flyspell-generic-check-word-predicate))))
984 t 999 t
985 (progn 1000 (progn
986 ;; destructure return flyspell-word info list. 1001 ;; destructure return flyspell-word info list.
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 5629e8feb31..00a757d68bd 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -416,11 +416,12 @@ The following values are supported:
416 :type 'boolean 416 :type 'boolean
417 :group 'ispell) 417 :group 'ispell)
418 418
419(defcustom ispell-format-word (function upcase) 419(defcustom ispell-format-word-function (function upcase)
420 "*Formatting function for displaying word being spell checked. 420 "*Formatting function for displaying word being spell checked.
421The function must take one string argument and return a string." 421The function must take one string argument and return a string."
422 :type 'function 422 :type 'function
423 :group 'ispell) 423 :group 'ispell)
424(defvaralias 'ispell-format-word 'ispell-format-word-function)
424 425
425(defcustom ispell-use-framepop-p nil 426(defcustom ispell-use-framepop-p nil
426 "When non-nil ispell uses framepop to display choices in a dedicated frame. 427 "When non-nil ispell uses framepop to display choices in a dedicated frame.
@@ -1565,7 +1566,7 @@ quit spell session exited."
1565 ;; But that is silly; if the user asks for it, we should do it. - rms. 1566 ;; But that is silly; if the user asks for it, we should do it. - rms.
1566 (or quietly 1567 (or quietly
1567 (message "Checking spelling of %s..." 1568 (message "Checking spelling of %s..."
1568 (funcall ispell-format-word word))) 1569 (funcall ispell-format-word-function word)))
1569 (ispell-send-string "%\n") ; put in verbose mode 1570 (ispell-send-string "%\n") ; put in verbose mode
1570 (ispell-send-string (concat "^" word "\n")) 1571 (ispell-send-string (concat "^" word "\n"))
1571 ;; wait until ispell has processed word 1572 ;; wait until ispell has processed word
@@ -1581,7 +1582,7 @@ quit spell session exited."
1581 (cond ((eq poss t) 1582 (cond ((eq poss t)
1582 (or quietly 1583 (or quietly
1583 (message "%s is correct" 1584 (message "%s is correct"
1584 (funcall ispell-format-word word))) 1585 (funcall ispell-format-word-function word)))
1585 (and (fboundp 'extent-at) 1586 (and (fboundp 'extent-at)
1586 (extent-at start) 1587 (extent-at start)
1587 (and (fboundp 'delete-extent) 1588 (and (fboundp 'delete-extent)
@@ -1589,8 +1590,8 @@ quit spell session exited."
1589 ((stringp poss) 1590 ((stringp poss)
1590 (or quietly 1591 (or quietly
1591 (message "%s is correct because of root %s" 1592 (message "%s is correct because of root %s"
1592 (funcall ispell-format-word word) 1593 (funcall ispell-format-word-function word)
1593 (funcall ispell-format-word poss))) 1594 (funcall ispell-format-word-function poss)))
1594 (and (fboundp 'extent-at) 1595 (and (fboundp 'extent-at)
1595 (extent-at start) 1596 (extent-at start)
1596 (and (fboundp 'delete-extent) 1597 (and (fboundp 'delete-extent)
@@ -1603,7 +1604,8 @@ quit spell session exited."
1603 (set-extent-property ext 'face ispell-highlight-face) 1604 (set-extent-property ext 'face ispell-highlight-face)
1604 (set-extent-property ext 'priority 2000))) 1605 (set-extent-property ext 'priority 2000)))
1605 (beep) 1606 (beep)
1606 (message "%s is incorrect"(funcall ispell-format-word word)))) 1607 (message "%s is incorrect"
1608 (funcall ispell-format-word-function word))))
1607 (t ; prompt for correct word. 1609 (t ; prompt for correct word.
1608 (save-window-excursion 1610 (save-window-excursion
1609 (setq replace (ispell-command-loop 1611 (setq replace (ispell-command-loop
@@ -3329,6 +3331,7 @@ Don't read buffer-local settings or word lists."
3329 "*End of text which will be checked in `ispell-message'. 3331 "*End of text which will be checked in `ispell-message'.
3330If it is a string, limit at first occurrence of that regular expression. 3332If it is a string, limit at first occurrence of that regular expression.
3331Otherwise, it must be a function which is called to get the limit.") 3333Otherwise, it must be a function which is called to get the limit.")
3334(put 'ispell-message-text-end 'risky-local-variable t)
3332 3335
3333 3336
3334(defun ispell-mime-multipartp (&optional limit) 3337(defun ispell-mime-multipartp (&optional limit)
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el
index ea9aa4448ee..853c28f5565 100644
--- a/lisp/textmodes/org.el
+++ b/lisp/textmodes/org.el
@@ -5,7 +5,7 @@
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, wp 6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ 7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
8;; Version: 4.26 8;; Version: 4.36
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -30,16 +30,21 @@
30;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing 30;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing
31;; project planning with a fast and effective plain-text system. 31;; project planning with a fast and effective plain-text system.
32;; 32;;
33;; Org-mode develops organizational tasks around a NOTES file that contains 33;; Org-mode develops organizational tasks around NOTES files that contain
34;; information about projects as plain text. Org-mode is implemented on top 34;; information about projects as plain text. Org-mode is implemented on
35;; of outline-mode - ideal to keep the content of large files well structured. 35;; top of outline-mode, which makes it possible to keep the content of
36;; It supports ToDo items, deadlines and time stamps, which can be extracted 36;; large files well structured. Visibility cycling and structure editing
37;; to create a daily/weekly agenda that also integrates the diary of the Emacs 37;; help to work with the tree. Tables are easily created with a built-in
38;; calendar. Tables are easily created with a built-in table editor. Plain 38;; table editor. Org-mode supports ToDo items, deadlines, time stamps,
39;; text URL-like links connect to websites, emails (VM, RMAIL, WANDERLUST), 39;; and scheduling. It dynamically compiles entries into an agenda that
40;; Usenet messages (Gnus), BBDB entries, and any files related to the 40;; utilizes and smoothly integrates much of the Emacs calendar and diary.
41;; projects. For printing and sharing of notes, an Org-mode file (or a part 41;; Plain text URL-like links connect to websites, emails, Usenet
42;; of it) can be exported as a structured ASCII file, or as HTML. 42;; messages, BBDB entries, and any files related to the projects. For
43;; printing and sharing of notes, an Org-mode file can be exported as a
44;; structured ASCII file, as HTML, or (todo and agenda items only) as an
45;; iCalendar file. It can also serve as a publishing tool for a set of
46;; linked webpages.
47;;
43;; 48;;
44;; Installation 49;; Installation
45;; ------------ 50;; ------------
@@ -52,19 +57,23 @@
52;; (define-key global-map "\C-cl" 'org-store-link) 57;; (define-key global-map "\C-cl" 'org-store-link)
53;; (define-key global-map "\C-ca" 'org-agenda) 58;; (define-key global-map "\C-ca" 'org-agenda)
54;; 59;;
55;; If you have downloaded Org-mode from the Web, you must byte-compile 60;; Furthermore you need to activate font-lock-mode in org-mode buffers.
56;; org.el and put it on your load path. In addition to the Emacs Lisp 61;; either of the following two lins will do the trick:
57;; lines above, you also need to add the following lines to .emacs: 62;;
63;; (global-font-lock-mode 1) ; for all buffers
64;; (add-hook 'org-mode-hook 'turn-on-font-lock) ; org-mode buffers only
65;;
66;; If you have downloaded Org-mode from the Web, you have to take additional
67;; action: Byte-compile org.el and org-publish.el and put them together with
68;; org-install.el on your load path. Then also add to your .emacs file:
69;;
70;; (require 'org-install)
58;; 71;;
59;; (autoload 'org-mode "org" "Org mode" t)
60;; (autoload 'org-diary "org" "Diary entries from Org mode")
61;; (autoload 'org-agenda "org" "Multi-file agenda from Org mode" t)
62;; (autoload 'org-store-link "org" "Store a link to the current location" t)
63;; (autoload 'orgtbl-mode "org" "Org tables as a minor mode" t)
64;; (autoload 'turn-on-orgtbl "org" "Org tables as a minor mode")
65;; 72;;
66;; This setup will put all files with extension ".org" into Org-mode. As 73;; Activation
67;; an alternative, make the first line of a file look like this: 74;; ----------
75;; The setup above will put all files with extension ".org" into Org-mode.
76;; As an alternative, make the first line of a file look like this:
68;; 77;;
69;; MY PROJECTS -*- mode: org; -*- 78;; MY PROJECTS -*- mode: org; -*-
70;; 79;;
@@ -79,48 +88,78 @@
79;; excellent reference card made by Philip Rooke. This card can be found 88;; excellent reference card made by Philip Rooke. This card can be found
80;; in the etc/ directory of Emacs 22. 89;; in the etc/ directory of Emacs 22.
81;; 90;;
82;; Changes since version 4.10: 91;; Recent changes
83;; --------------------------- 92;; --------------
84;; Version 4.26 93;; Version 4.36
94;; - Improved indentation of ASCII export, when headlines become items.
95;; - Handling of 12am and 12pm fixed. Times beyond 24:00 can be used
96;; and will not lead to conflicts.
97;; - Support for mutually exclusive TAGS with the fast tags interface.
85;; - Bug fixes. 98;; - Bug fixes.
86;; 99;;
87;; Version 4.25 100;; Version 4.35
88;; - Revision of the font-lock faces section, with better tty support. 101;; - HTML export is now valid XHTML.
89;; - TODO keywords in Agenda buffer are fontified. 102;; - Timeline can also show dates without entries. See new option
90;; - Export converts links between .org files to links between .html files. 103;; `org-timeline-show-empty-dates'.
91;; - Better support for bold/italic/underline emphasis. 104;; - The bullets created by the ASCII exporter can now be configured.
105;; See the new option `org-export-ascii-bullets'.
106;; - New face `org-upcoming-deadline' (was `org-scheduled-previously').
107;; - New function `org-context' to allow testing for local context.
92;; 108;;
93;; Version 4.24 109;; Version 4.34
94;; - Bug fixes. 110;; - Bug fixes.
95;; 111;;
96;; Version 4.23 112;; Version 4.33
97;; - Bug fixes. 113;; - New commands to move through plain lists: S-up and S-down.
114;; - Bug fixes and documentation update.
98;; 115;;
99;; Version 4.22 116;; Version 4.32
117;; - Fast (single-key-per-tag) interface for setting TAGS.
118;; - The list of legal tags can be configured globally and locally.
119;; - Elisp and Info links (thanks to Todd Neal).
120;; - `org-export-publishing-directory' can be an alist, with different
121;; directories for different export types.
122;; - All context-sensitive commands use `call-interactively' to dispatch.
123;; - `org-confirm-shell-links' renamed to `org-confirm-shell-link-function'.
100;; - Bug fixes. 124;; - Bug fixes.
101;; - In agenda buffer, mouse-1 no longer follows link. 125;;
102;; See `org-agenda-mouse-1-follows-link' and `org-mouse-1-follows-link'. 126;; Version 4.31
103;;
104;; Version 4.20
105;; - Links use now the [[link][description]] format by default.
106;; When inserting links, the user is prompted for a description.
107;; - If a link has a description, only the description is displayed
108;; the link part is hidden. Use C-c C-l to edit the link part.
109;; - TAGS are now bold, but in the same color as the headline.
110;; - The width of a table column can be limited by using a field "<N>".
111;; - New structure for the customization tree.
112;; - Bug fixes. 127;; - Bug fixes.
113;; 128;;
114;; Version 4.13 129;; Version 4.30
115;; - The list of agenda files can be maintainted in an external file. 130;; - Modified installation: Autoloads have been collected in org-install.el.
131;; - Logging (org-log-done) is now a #+STARTUP option.
132;; - Checkboxes in plain list items, following up on Frank Ruell's idea.
133;; - File links inserted with C-c C-l will use relative paths if the linked
134;; file is in the current directory or a subdirectory of it.
135;; - New variable `org-link-file-path-type' to specify preference for
136;; relative and absolute paths.
137;; - New CSS classes for tags, timestamps, timestamp keywords.
138;; - Bug and typo fixes.
139;;
140;; Version 4.29
141;; - Inlining images in HTML export now depends on wheather the link
142;; contains a description or not.
143;; - TODO items can be scheduled from the global TODO list using C-c C-s.
144;; - TODO items already scheduled can be made to disappear from the global
145;; todo list, see `org-agenda-todo-ignore-scheduled'.
146;; - In Tables, formulas may also be Lisp forms.
147;; - Exporting the visible part of an outline with `C-c C-x v' works now
148;; for all available exporters.
149;; - Bug fixes, lots of them :-(
150;;
151;; Version 4.28
116;; - Bug fixes. 152;; - Bug fixes.
117;; 153;;
118;; Version 4.12 154;; Version 4.27
119;; - Templates for remember buffer. Note that the remember setup changes. 155;; - HTML exporter generalized to receive external options.
120;; To set up templates, see `org-remember-templates'. 156;; As part of the process, author, email and date have been moved to the
121;; - The time in new time stamps can be rounded, see new option 157;; end of the HTML file.
122;; `org-time-stamp-rounding-minutes'. 158;; - Support for customizable file search in file links.
123;; - Bug fixes (there are *always* more bugs). 159;; - BibTeX database links as first application of the above.
160;; - New option `org-agenda-todo-list-sublevels' to turn off listing TODO
161;; entries that are sublevels of another TODO entry.
162;;
124;; 163;;
125;;; Code: 164;;; Code:
126 165
@@ -131,13 +170,9 @@
131(require 'time-date) 170(require 'time-date)
132(require 'easymenu) 171(require 'easymenu)
133 172
134(defvar calc-embedded-close-formula) ; defined by the calc package
135(defvar calc-embedded-open-formula) ; defined by the calc package
136(defvar font-lock-unfontify-region-function) ; defined by font-lock.el
137
138;;; Customization variables 173;;; Customization variables
139 174
140(defvar org-version "4.26" 175(defvar org-version "4.36"
141 "The version number of the file org.el.") 176 "The version number of the file org.el.")
142(defun org-version () 177(defun org-version ()
143 (interactive) 178 (interactive)
@@ -325,14 +360,30 @@ An entry can be toggled between QUOTE and normal with
325 :tag "Org Cycle" 360 :tag "Org Cycle"
326 :group 'org-structure) 361 :group 'org-structure)
327 362
363(defcustom org-cycle-global-at-bob t
364 "Cycle globally if cursor is at beginning of buffer and not at a headline.
365This makes it possible to do global cycling without having to use S-TAB or
366C-u TAB. For this special case to work, the first line of the buffer
367must not be a headline - it may be empty ot some other text. When used in
368this way, `org-cycle-hook' is disables temporarily, to make sure the
369cursor stays at the beginning of the buffer.
370When this option is nil, don't do anything special at the beginning
371of the buffer."
372 :group 'org-cycle
373 :type 'boolean)
374
328(defcustom org-cycle-emulate-tab t 375(defcustom org-cycle-emulate-tab t
329 "Where should `org-cycle' emulate TAB. 376 "Where should `org-cycle' emulate TAB.
330nil Never 377nil Never
331white Only in completely white lines 378white Only in completely white lines
332t Everywhere except in headlines" 379whitestart Only at the beginning of lines, before the first non-white char.
380t Everywhere except in headlines
381If TAB is used in a place where it does not emulate TAB, the current subtree
382visibility is cycled."
333 :group 'org-cycle 383 :group 'org-cycle
334 :type '(choice (const :tag "Never" nil) 384 :type '(choice (const :tag "Never" nil)
335 (const :tag "Only in completely white lines" white) 385 (const :tag "Only in completely white lines" white)
386 (const :tag "Before first char in a line" whitestart)
336 (const :tag "Everywhere except in headlines" t) 387 (const :tag "Everywhere except in headlines" t)
337 )) 388 ))
338 389
@@ -376,6 +427,11 @@ body starts at column 0, indentation is not changed at all."
376 :group 'org-edit-structure 427 :group 'org-edit-structure
377 :type 'boolean) 428 :type 'boolean)
378 429
430(defcustom org-insert-heading-hook nil
431 "Hook being run after inserting a new heading."
432 :group 'org-edit-structure
433 :type 'boolean)
434
379(defcustom org-enable-fixed-width-editor t 435(defcustom org-enable-fixed-width-editor t
380 "Non-nil means, lines starting with \":\" are treated as fixed-width. 436 "Non-nil means, lines starting with \":\" are treated as fixed-width.
381This currently only means, they are never auto-wrapped. 437This currently only means, they are never auto-wrapped.
@@ -756,6 +812,23 @@ additional URL: prefix, so the format would be \"<URL:%s>\"."
756 (const :tag "\"<URL:%s>\" (e.g. <URL:http://www.there.com>)" "<URL:%s>") 812 (const :tag "\"<URL:%s>\" (e.g. <URL:http://www.there.com>)" "<URL:%s>")
757 (string :tag "Other" :value "<%s>"))) 813 (string :tag "Other" :value "<%s>")))
758 814
815(defcustom org-link-file-path-type 'adaptive
816 "How the path name in file links should be stored.
817Valid values are:
818
819relative relative to the current directory, i.e. the directory of the file
820 into which the link is being inserted.
821absolute absolute path, if possible with ~ for home directory.
822noabbrev absolute path, no abbreviation of home directory.
823adaptive Use relative path for files in the current directory and sub-
824 directories of it. For other files, use an absolute path."
825 :group 'org-link
826 :type '(choice
827 (const relative)
828 (const absolute)
829 (const noabbrev)
830 (const adaptive)))
831
759(defcustom org-activate-links '(bracket angle plain radio tag date) 832(defcustom org-activate-links '(bracket angle plain radio tag date)
760 "Types of links that should be activated in Org-mode files. 833 "Types of links that should be activated in Org-mode files.
761This is a list of symbols, each leading to the activation of a certain link 834This is a list of symbols, each leading to the activation of a certain link
@@ -898,15 +971,32 @@ When nil, an error will be generated."
898 :group 'org-link-follow 971 :group 'org-link-follow
899 :type 'boolean) 972 :type 'boolean)
900 973
901(defcustom org-confirm-shell-links 'yes-or-no-p 974(defcustom org-confirm-shell-link-function 'yes-or-no-p
902 "Non-nil means, ask for confirmation before executing shell links. 975 "Non-nil means, ask for confirmation before executing shell links.
903Shell links can be dangerous, just thing about a link 976Shell links can be dangerous, just thing about a link
904 977
905 [[shell:rm -rf ~/*][Google Search]] 978 [[shell:rm -rf ~/*][Google Search]]
906 979
907This link would show up in your Org-mode document as \"Google Search\" 980This link would show up in your Org-mode document as \"Google Search\"
908but really it would remove your entire home directory. Dangerous indeed. 981but really it would remove your entire home directory.
909Therefore I *definitely* advise agains setting this varaiable to nil. 982Therefore I *definitely* advise against setting this variable to nil.
983Just change it to `y-or-n-p' of you want to confirm with a single key press
984rather than having to type \"yes\"."
985 :group 'org-link-follow
986 :type '(choice
987 (const :tag "with yes-or-no (safer)" yes-or-no-p)
988 (const :tag "with y-or-n (faster)" y-or-n-p)
989 (const :tag "no confirmation (dangerous)" nil)))
990
991(defcustom org-confirm-elisp-link-function 'yes-or-no-p
992 "Non-nil means, ask for confirmation before executing elisp links.
993Elisp links can be dangerous, just thing about a link
994
995 [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]]
996
997This link would show up in your Org-mode document as \"Google Search\"
998but really it would remove your entire home directory.
999Therefore I *definitely* advise against setting this variable to nil.
910Just change it to `y-or-n-p' of you want to confirm with a single key press 1000Just change it to `y-or-n-p' of you want to confirm with a single key press
911rather than having to type \"yes\"." 1001rather than having to type \"yes\"."
912 :group 'org-link-follow 1002 :group 'org-link-follow
@@ -934,7 +1024,11 @@ for some files for which the OS does not have a good default.
934See `org-file-apps'.") 1024See `org-file-apps'.")
935 1025
936(defconst org-file-apps-defaults-windowsnt 1026(defconst org-file-apps-defaults-windowsnt
937 '((t . (w32-shell-execute "open" file))) 1027 (list (cons t
1028 (list (if (featurep 'xemacs)
1029 'mswindows-shell-execute
1030 'w32-shell-execute)
1031 "open" 'file)))
938 "Default file applications on a Windows NT system. 1032 "Default file applications on a Windows NT system.
939The system \"open\" is used for most files. 1033The system \"open\" is used for most files.
940See `org-file-apps'.") 1034See `org-file-apps'.")
@@ -946,18 +1040,25 @@ See `org-file-apps'.")
946 ("ltx" . emacs) 1040 ("ltx" . emacs)
947 ("org" . emacs) 1041 ("org" . emacs)
948 ("el" . emacs) 1042 ("el" . emacs)
1043 ("bib" . emacs)
949 ) 1044 )
950 "External applications for opening `file:path' items in a document. 1045 "External applications for opening `file:path' items in a document.
951Org-mode uses system defaults for different file types, but 1046Org-mode uses system defaults for different file types, but
952you can use this variable to set the application for a given file 1047you can use this variable to set the application for a given file
953extension. The entries in this list are cons cells with a file extension 1048extension. The entries in this list are cons cells where the car identifies
954and the corresponding command. Possible values for the command are: 1049files and the cdr the corresponding command. Possible values for the
955 `emacs' The file will be visited by the current Emacs process. 1050file identifier are
956 `default' Use the default application for this file type. 1051 \"ext\" A string identifying an extension
957 string A command to be executed by a shell; %s will be replaced 1052 `directory' Matches a directory
958 by the path to the file. 1053 t Default for all remaining files
959 sexp A Lisp form which will be evaluated. The file path will 1054
960 be available in the Lisp variable `file'. 1055Possible values for the command are:
1056 `emacs' The file will be visited by the current Emacs process.
1057 `default' Use the default application for this file type.
1058 string A command to be executed by a shell; %s will be replaced
1059 by the path to the file.
1060 sexp A Lisp form which will be evaluated. The file path will
1061 be available in the Lisp variable `file'.
961For more examples, see the system specific constants 1062For more examples, see the system specific constants
962`org-file-apps-defaults-macosx' 1063`org-file-apps-defaults-macosx'
963`org-file-apps-defaults-windowsnt' 1064`org-file-apps-defaults-windowsnt'
@@ -1085,7 +1186,12 @@ Lisp variable `state'."
1085(defcustom org-log-done nil 1186(defcustom org-log-done nil
1086 "When set, insert a (non-active) time stamp when TODO entry is marked DONE. 1187 "When set, insert a (non-active) time stamp when TODO entry is marked DONE.
1087When the state of an entry is changed from nothing to TODO, remove a previous 1188When the state of an entry is changed from nothing to TODO, remove a previous
1088closing date." 1189closing date.
1190This can also be configured on a per-file basis by adding one of
1191the following lines anywhere in the buffer:
1192
1193 #+STARTUP: logging
1194 #+STARTUP: nologging"
1089 :group 'org-todo 1195 :group 'org-todo
1090 :type 'boolean) 1196 :type 'boolean)
1091 1197
@@ -1110,6 +1216,14 @@ This is the priority an item get if no explicit priority is given."
1110 :tag "Org Time" 1216 :tag "Org Time"
1111 :group 'org) 1217 :group 'org)
1112 1218
1219(defcustom org-insert-labeled-timestamps-at-point nil
1220 "Non-nil means, SCHEDULED and DEADLINE timestamps are inserted at point.
1221When nil, these labeled time stamps are forces into the second line of an
1222entry, just after the headline. When scheduling from the global TODO list,
1223the time stamp will always be forced into the second line."
1224 :group 'org-time
1225 :type 'boolean)
1226
1113(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") 1227(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>")
1114 "Formats for `format-time-string' which are used for time stamps. 1228 "Formats for `format-time-string' which are used for time stamps.
1115It is not recommended to change this constant.") 1229It is not recommended to change this constant.")
@@ -1149,6 +1263,36 @@ moved to the new date."
1149 :tag "Org Tags" 1263 :tag "Org Tags"
1150 :group 'org) 1264 :group 'org)
1151 1265
1266(defcustom org-tag-alist nil
1267 "List of tags allowed in Org-mode files.
1268When this list is nil, Org-mode will base TAG input on what is already in the
1269buffer.
1270The value of this variable is an alist, the car may be (and should) be a
1271character that is used to select that tag through the fast-tag-selection
1272interface. See the manual for details."
1273 :group 'org-tags
1274 :type '(repeat
1275 (choice
1276 (cons (string :tag "Tag name")
1277 (character :tag "Access char"))
1278 (const :tag "Start radio group" (:startgroup))
1279 (const :tag "End radio group" (:endgroup)))))
1280
1281(defcustom org-use-fast-tag-selection 'auto
1282 "Non-nil means, use fast tag selection scheme.
1283This is a special interface to select and deselect tags with single keys.
1284When nil, fast selection is never used.
1285When the symbol `auto', fast selection is used if and only if selection
1286characters for tags have been configured, either through the variable
1287`org-tag-alist' or through a #+TAGS line in the buffer.
1288When t, fast selection is always used and selection keys are assigned
1289automatically if necessary."
1290 :group 'org-tags
1291 :type '(choice
1292 (const :tag "Always" t)
1293 (const :tag "Never" nil)
1294 (const :tag "When selection characters are configured" 'auto)))
1295
1152(defcustom org-tags-column 48 1296(defcustom org-tags-column 48
1153 "The column to which tags should be indented in a headline. 1297 "The column to which tags should be indented in a headline.
1154If this number is positive, it specifies the column. If it is negative, 1298If this number is positive, it specifies the column. If it is negative,
@@ -1234,6 +1378,7 @@ key The key (a single char as a string) to be associated with the command.
1234type The command type, any of the following symbols: 1378type The command type, any of the following symbols:
1235 todo Entries with a specific TODO keyword, in all agenda files. 1379 todo Entries with a specific TODO keyword, in all agenda files.
1236 tags Tags match in all agenda files. 1380 tags Tags match in all agenda files.
1381 tags-todo Tags match in all agenda files, TODO entries only.
1237 todo-tree Sparse tree of specific TODO keyword in *current* file. 1382 todo-tree Sparse tree of specific TODO keyword in *current* file.
1238 tags-tree Sparse tree with all tags matches in *current* file. 1383 tags-tree Sparse tree with all tags matches in *current* file.
1239 occur-tree Occur sparse tree for current file. 1384 occur-tree Occur sparse tree for current file.
@@ -1246,13 +1391,30 @@ match What to search for:
1246 (list (string :tag "Key") 1391 (list (string :tag "Key")
1247 (choice :tag "Type" 1392 (choice :tag "Type"
1248 (const :tag "Tags search in all agenda files" tags) 1393 (const :tag "Tags search in all agenda files" tags)
1394 (const :tag "Tags search of TODO entries, all agenda files" tags-todo)
1249 (const :tag "TODO keyword search in all agenda files" todo) 1395 (const :tag "TODO keyword search in all agenda files" todo)
1250 (const :tag "Tags sparse tree in current buffer" tags-tree) 1396 (const :tag "Tags sparse tree in current buffer" tags-tree)
1251 (const :tag "TODO keyword tree in current buffer" todo-tree) 1397 (const :tag "TODO keyword tree in current buffer" todo-tree)
1252 (const :tag "Occur tree in current buffer" occur-tree)) 1398 (const :tag "Occur tree in current buffer" occur-tree))
1253 (string :tag "Match")))) 1399 (string :tag "Match"))))
1254 1400
1255(defcustom org-agenda-include-all-todo t 1401(defcustom org-agenda-todo-list-sublevels t
1402 "Non-nil means, check also the sublevels of a TODO entry for TODO entries.
1403When nil, the sublevels of a TODO entry are not checked, resulting in
1404potentially much shorter TODO lists."
1405 :group 'org-agenda
1406 :group 'org-todo
1407 :type 'boolean)
1408
1409(defcustom org-agenda-todo-ignore-scheduled nil
1410 "Non-nil means, don't show scheduled entries in the global todo list.
1411The idea behind this is that by scheduling it, you have already taken care
1412of this item."
1413 :group 'org-agenda
1414 :group 'org-todo
1415 :type 'boolean)
1416
1417(defcustom org-agenda-include-all-todo nil
1256 "Non-nil means, the agenda will always contain all TODO entries. 1418 "Non-nil means, the agenda will always contain all TODO entries.
1257When nil, date-less entries will only be shown if `org-agenda' is called 1419When nil, date-less entries will only be shown if `org-agenda' is called
1258with a prefix argument. 1420with a prefix argument.
@@ -1274,7 +1436,7 @@ forth between agenda and calendar."
1274 :group 'org-agenda 1436 :group 'org-agenda
1275 :type 'sexp) 1437 :type 'sexp)
1276 1438
1277(defgroup org-agenda-window-setup nil 1439(defgroup org-agenda-setup nil
1278 "Options concerning setting up the Agenda window in Org Mode." 1440 "Options concerning setting up the Agenda window in Org Mode."
1279 :tag "Org Agenda Window Setup" 1441 :tag "Org Agenda Window Setup"
1280 :group 'org-agenda) 1442 :group 'org-agenda)
@@ -1286,9 +1448,8 @@ Needs to be set before org.el is loaded."
1286 :group 'org-agenda-setup 1448 :group 'org-agenda-setup
1287 :type 'boolean) 1449 :type 'boolean)
1288 1450
1289(defcustom org-select-timeline-window t 1451(defcustom org-agenda-start-with-follow-mode nil
1290 "Non-nil means, after creating a timeline, move cursor into Timeline window. 1452 "The initial value of follwo-mode in a newly created agenda window."
1291When nil, cursor will remain in the current window."
1292 :group 'org-agenda-setup 1453 :group 'org-agenda-setup
1293 :type 'boolean) 1454 :type 'boolean)
1294 1455
@@ -1411,7 +1572,7 @@ categories by priority."
1411(defcustom org-sort-agenda-notime-is-late t 1572(defcustom org-sort-agenda-notime-is-late t
1412 "Non-nil means, items without time are considered late. 1573 "Non-nil means, items without time are considered late.
1413This is only relevant for sorting. When t, items which have no explicit 1574This is only relevant for sorting. When t, items which have no explicit
1414time like 15:30 will be considered as 24:01, i.e. later than any items which 1575time like 15:30 will be considered as 99:01, i.e. later than any items which
1415do have a time. When nil, the default time is before 0:00. You can use this 1576do have a time. When nil, the default time is before 0:00. You can use this
1416option to decide if the schedule for today should come before or after timeless 1577option to decide if the schedule for today should come before or after timeless
1417agenda entries." 1578agenda entries."
@@ -1472,17 +1633,11 @@ See also the variables `org-agenda-remove-times-when-in-prefix' and
1472 :type 'string 1633 :type 'string
1473 :group 'org-agenda-prefix) 1634 :group 'org-agenda-prefix)
1474 1635
1475(defcustom org-timeline-prefix-format " % s"
1476 "Like `org-agenda-prefix-format', but for the timeline of a single file."
1477 :type 'string
1478 :group 'org-agenda-prefix)
1479
1480(defvar org-prefix-format-compiled nil 1636(defvar org-prefix-format-compiled nil
1481 "The compiled version of the most recently used prefix format. 1637 "The compiled version of the most recently used prefix format.
1482Depending on which command was used last, this may be the compiled version 1638Depending on which command was used last, this may be the compiled version
1483of `org-agenda-prefix-format' or `org-timeline-prefix-format'.") 1639of `org-agenda-prefix-format' or `org-timeline-prefix-format'.")
1484 1640
1485;; FIXME: There seem to be situations where this does no work.
1486(defcustom org-agenda-remove-times-when-in-prefix t 1641(defcustom org-agenda-remove-times-when-in-prefix t
1487 "Non-nil means, remove duplicate time specifications in agenda items. 1642 "Non-nil means, remove duplicate time specifications in agenda items.
1488When the format `org-agenda-prefix-format' contains a `%t' specifier, a 1643When the format `org-agenda-prefix-format' contains a `%t' specifier, a
@@ -1510,6 +1665,34 @@ When this is the symbol `prefix', only remove tags when
1510 (const :tag "Never" nil) 1665 (const :tag "Never" nil)
1511 (const :tag "When prefix format contains %T" prefix))) 1666 (const :tag "When prefix format contains %T" prefix)))
1512 1667
1668(defgroup org-agenda-timeline nil
1669 "Options concerning the timeline buffer in Org Mode."
1670 :tag "Org Agenda Timeline"
1671 :group 'org-agenda)
1672
1673(defcustom org-timeline-prefix-format " % s"
1674 "Like `org-agenda-prefix-format', but for the timeline of a single file."
1675 :type 'string
1676 :group 'org-agenda-timeline)
1677
1678(defcustom org-select-timeline-window t
1679 "Non-nil means, after creating a timeline, move cursor into Timeline window.
1680When nil, cursor will remain in the current window."
1681 :group 'org-agenda-timeline
1682 :type 'boolean)
1683
1684(defcustom org-timeline-show-empty-dates 3
1685 "Non-nil means, `org-timeline' also shows dates without an entry.
1686When nil, only the days which actually have entries are shown.
1687When t, all days between the first and the last date are shown.
1688When an integer, show also empty dates, but if there is a gap of more than
1689N days, just insert a special line indicating the size of the gap."
1690 :group 'org-agenda-timeline
1691 :type '(choice
1692 (const :tag "None" nil)
1693 (const :tag "All" t)
1694 (number :tag "at most")))
1695
1513(defgroup org-export nil 1696(defgroup org-export nil
1514 "Options for exporting org-listings." 1697 "Options for exporting org-listings."
1515 :tag "Org Export" 1698 :tag "Org Export"
@@ -1520,6 +1703,23 @@ When this is the symbol `prefix', only remove tags when
1520 :tag "Org Export General" 1703 :tag "Org Export General"
1521 :group 'org-export) 1704 :group 'org-export)
1522 1705
1706(defcustom org-export-publishing-directory "."
1707 "Path to the location where exported files should be located.
1708This path may be relative to the directory where the Org-mode file lives.
1709The default is to put them into the same directory as the Org-mode file.
1710The variable may also be an alist with export types `:html', `:ascii',
1711`:ical', or `:xoxo' and the corresponding directories. If a direcoty path
1712is relative, it is interpreted relative to the directory where the exported
1713Org-mode files lives."
1714 :group 'org-export-general
1715 :type '(choice
1716 (directory)
1717 (repeat
1718 (cons
1719 (choice :tag "Type"
1720 (const :html) (const :ascii) (const :ical) (const :xoxo))
1721 (directory)))))
1722
1523(defcustom org-export-language-setup 1723(defcustom org-export-language-setup
1524 '(("en" "Author" "Date" "Table of Contents") 1724 '(("en" "Author" "Date" "Table of Contents")
1525 ("da" "Ophavsmand" "Dato" "Indhold") 1725 ("da" "Ophavsmand" "Dato" "Indhold")
@@ -1591,6 +1791,21 @@ This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"."
1591 :group 'org-export-general 1791 :group 'org-export-general
1592 :type 'boolean) 1792 :type 'boolean)
1593 1793
1794(defcustom org-export-with-timestamps t
1795 "Nil means, do not export time stamps and associated keywords."
1796 :group 'org-export
1797 :type 'boolean)
1798
1799(defcustom org-export-with-tags t
1800 "Nil means, do not export tags, just remove them from headlines."
1801 :group 'org-export-general
1802 :type 'boolean)
1803
1804(defcustom org-export-with-timestamps t
1805 "Nil means, do not export timestamps and associated keywords."
1806 :group 'org-export-general
1807 :type 'boolean)
1808
1594(defgroup org-export-translation nil 1809(defgroup org-export-translation nil
1595 "Options for translating special ascii sequences for the export backends." 1810 "Options for translating special ascii sequences for the export backends."
1596 :tag "Org Export Translation" 1811 :tag "Org Export Translation"
@@ -1714,6 +1929,22 @@ much faster."
1714 :tag "Org Export ASCII" 1929 :tag "Org Export ASCII"
1715 :group 'org-export) 1930 :group 'org-export)
1716 1931
1932(defcustom org-export-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-)
1933 "Characters for underlining headings in ASCII export.
1934In the given sequence, these characters will be used for level 1, 2, ..."
1935 :group 'org-export-ascii
1936 :type '(repeat character))
1937
1938(defcustom org-export-ascii-bullets '(?* ?+ ?-)
1939 "Bullet characters for headlines converted to lists in ASCII export.
1940The first character is is used for the first lest level generated in this
1941way, and so on. If there are more levels than characters given here,
1942the list will be repeated.
1943Note that plain lists will keep the same bullets as the have in the
1944Org-mode file."
1945 :group 'org-export-ascii
1946 :type '(repeat character))
1947
1717(defcustom org-export-ascii-show-new-buffer t 1948(defcustom org-export-ascii-show-new-buffer t
1718 "Non-nil means, popup buffer containing the exported ASCII text. 1949 "Non-nil means, popup buffer containing the exported ASCII text.
1719Otherwise the buffer will just be saved to a file and stay hidden." 1950Otherwise the buffer will just be saved to a file and stay hidden."
@@ -1725,14 +1956,6 @@ Otherwise the buffer will just be saved to a file and stay hidden."
1725 :tag "Org Export XML" 1956 :tag "Org Export XML"
1726 :group 'org-export) 1957 :group 'org-export)
1727 1958
1728(defcustom org-export-xml-type 'xoxo ;kw, if we have only one.
1729 "The kind of XML to be produced by the XML exporter.
1730Allowed values are:
1731xoxo The XOXO exporter."
1732 :group 'org-export-xml
1733 :type '(choice
1734 (const :tag "XOXO" xoxo)))
1735
1736(defgroup org-export-html nil 1959(defgroup org-export-html nil
1737 "Options specific for HTML export of Org-mode files." 1960 "Options specific for HTML export of Org-mode files."
1738 :tag "Org Export HTML" 1961 :tag "Org Export HTML"
@@ -1745,8 +1968,11 @@ xoxo The XOXO exporter."
1745 font-size: 12pt; 1968 font-size: 12pt;
1746 } 1969 }
1747 .title { text-align: center; } 1970 .title { text-align: center; }
1748 .todo, .deadline { color: red; } 1971 .todo { color: red; }
1749 .done { color: green; } 1972 .done { color: green; }
1973 .timestamp { color: grey }
1974 .timestamp-kwd { color: CadetBlue }
1975 .tag { background-color:lightblue; font-weight:normal }
1750 .target { background-color: lavender; } 1976 .target { background-color: lavender; }
1751 pre { 1977 pre {
1752 border: 1pt solid #AEBDCC; 1978 border: 1pt solid #AEBDCC;
@@ -1796,13 +2022,16 @@ When nil, the links still point to the plain `.org' file."
1796 :group 'org-export-html 2022 :group 'org-export-html
1797 :type 'boolean) 2023 :type 'boolean)
1798 2024
1799(defcustom org-export-html-inline-images t 2025(defcustom org-export-html-inline-images 'maybe
1800 "Non-nil means, inline images into exported HTML pages. 2026 "Non-nil means, inline images into exported HTML pages.
1801The link will still be to the original location of the image file. 2027This is done using an <img> tag. When nil, an anchor with href is used to
1802So if you are moving the page, lets say to your public HTML site, 2028link to the image. If this option is `maybe', then images in links with
1803you will have to move the image and maybe change the link." 2029an empty description will be inlined, while images with a description will
2030be linked only."
1804 :group 'org-export-html 2031 :group 'org-export-html
1805 :type 'boolean) 2032 :type '(choice (const :tag "Never" nil)
2033 (const :tag "Always" t)
2034 (const :tag "When there is no description" maybe)))
1806 2035
1807(defcustom org-export-html-expand t 2036(defcustom org-export-html-expand t
1808 "Non-nil means, for HTML export, treat @<...> as HTML tag. 2037 "Non-nil means, for HTML export, treat @<...> as HTML tag.
@@ -1814,7 +2043,7 @@ This option can also be set with the +OPTIONS line, e.g. \"@:nil\"."
1814 :type 'boolean) 2043 :type 'boolean)
1815 2044
1816(defcustom org-export-html-table-tag 2045(defcustom org-export-html-table-tag
1817 "<table border=1 cellspacing=0 cellpadding=6>" 2046 "<table border=\"1\" cellspacing=\"0\" cellpadding=\"6\">"
1818 "The HTML tag used to start a table. 2047 "The HTML tag used to start a table.
1819This must be a <table> tag, but you may change the options like 2048This must be a <table> tag, but you may change the options like
1820borders and spacing." 2049borders and spacing."
@@ -1829,7 +2058,7 @@ to a file."
1829 :type 'boolean) 2058 :type 'boolean)
1830 2059
1831(defcustom org-export-html-html-helper-timestamp 2060(defcustom org-export-html-html-helper-timestamp
1832 "<br><br><hr><p><!-- hhmts start --> <!-- hhmts end -->\n" 2061 "<br/><br/><hr><p><!-- hhmts start --> <!-- hhmts end --></p>\n"
1833 "The HTML tag used as timestamp delimiter for HTML-helper-mode." 2062 "The HTML tag used as timestamp delimiter for HTML-helper-mode."
1834 :group 'org-export-html 2063 :group 'org-export-html
1835 :type 'string) 2064 :type 'string)
@@ -1847,7 +2076,8 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1847 2076
1848(defcustom org-combined-agenda-icalendar-file "~/org.ics" 2077(defcustom org-combined-agenda-icalendar-file "~/org.ics"
1849 "The file name for the iCalendar file covering all agenda files. 2078 "The file name for the iCalendar file covering all agenda files.
1850This file is created with the command \\[org-export-icalendar-all-agenda-files]." 2079This file is created with the command \\[org-export-icalendar-all-agenda-files].
2080The file name should be absolute."
1851 :group 'org-export-icalendar 2081 :group 'org-export-icalendar
1852 :type 'file) 2082 :type 'file)
1853 2083
@@ -2003,7 +2233,7 @@ color of the frame."
2003 (org-compatible-face 2233 (org-compatible-face
2004 '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) 2234 '((((class color) (min-colors 16) (background light)) (:foreground "Orchid"))
2005 (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) 2235 (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue"))
2006 (((class color) (min-colors 8)) (:foreground "blue")))) ;; FIXME: for dark bg? 2236 (((class color) (min-colors 8)) (:foreground "blue"))))
2007 "Face used for level 7 headlines." 2237 "Face used for level 7 headlines."
2008 :group 'org-faces) 2238 :group 'org-faces)
2009 2239
@@ -2120,11 +2350,21 @@ This face is only used if `org-fontify-done-headline' is set."
2120 "Face for items scheduled previously, and not yet done." 2350 "Face for items scheduled previously, and not yet done."
2121 :group 'org-faces) 2351 :group 'org-faces)
2122 2352
2353(defface org-upcoming-deadline
2354 (org-compatible-face
2355 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
2356 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
2357 (((class color) (min-colors 8) (background light)) (:foreground "red"))
2358 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
2359 (t (:bold t))))
2360 "Face for items scheduled previously, and not yet done."
2361 :group 'org-faces)
2362
2123(defface org-time-grid ;; font-lock-variable-name-face 2363(defface org-time-grid ;; font-lock-variable-name-face
2124 (org-compatible-face 2364 (org-compatible-face
2125 '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) 2365 '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
2126 (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) 2366 (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
2127 (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) ; FIXME: turn off??? 2367 (((class color) (min-colors 8)) (:foreground "yellow" :weight light))))
2128 "Face used for time grids." 2368 "Face used for time grids."
2129 :group 'org-faces) 2369 :group 'org-faces)
2130 2370
@@ -2163,6 +2403,10 @@ This face is only used if `org-fontify-done-headline' is set."
2163(defvar org-todo-line-regexp nil 2403(defvar org-todo-line-regexp nil
2164 "Matches a headline and puts TODO state into group 2 if present.") 2404 "Matches a headline and puts TODO state into group 2 if present.")
2165(make-variable-buffer-local 'org-todo-line-regexp) 2405(make-variable-buffer-local 'org-todo-line-regexp)
2406(defvar org-todo-line-tags-regexp nil
2407 "Matches a headline and puts TODO state into group 2 if present.
2408Also put tags into group 4 if tags are present.")
2409(make-variable-buffer-local 'org-todo-line-tags-regexp)
2166(defvar org-nl-done-regexp nil 2410(defvar org-nl-done-regexp nil
2167 "Matches newline followed by a headline with the DONE keyword.") 2411 "Matches newline followed by a headline with the DONE keyword.")
2168(make-variable-buffer-local 'org-nl-done-regexp) 2412(make-variable-buffer-local 'org-nl-done-regexp)
@@ -2193,21 +2437,46 @@ This face is only used if `org-fontify-done-headline' is set."
2193(defvar org-scheduled-time-regexp nil 2437(defvar org-scheduled-time-regexp nil
2194 "Matches the SCHEDULED keyword together with a time stamp.") 2438 "Matches the SCHEDULED keyword together with a time stamp.")
2195(make-variable-buffer-local 'org-scheduled-time-regexp) 2439(make-variable-buffer-local 'org-scheduled-time-regexp)
2440(defvar org-closed-time-regexp nil
2441 "Matches the CLOSED keyword together with a time stamp.")
2442(make-variable-buffer-local 'org-closed-time-regexp)
2443
2444(defvar org-keyword-time-regexp nil
2445 "Matches any of the 3 keywords, together with the time stamp.")
2446(make-variable-buffer-local 'org-keyword-time-regexp)
2447(defvar org-maybe-keyword-time-regexp nil
2448 "Matches a timestamp, possibly preceeded by a keyword.")
2449(make-variable-buffer-local 'org-keyword-time-regexp)
2450
2451(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t
2452 mouse-map t)
2453 "Properties to remove when a string without properties is wanted.")
2454
2455(defsubst org-match-string-no-properties (num &optional string)
2456 (if (featurep 'xemacs)
2457 (let ((s (match-string num string)))
2458 (remove-text-properties 0 (length s) org-rm-props s)
2459 s)
2460 (match-string-no-properties num string)))
2461
2462(defsubst org-no-properties (s)
2463 (remove-text-properties 0 (length s) org-rm-props s)
2464 s)
2196 2465
2197(defun org-set-regexps-and-options () 2466(defun org-set-regexps-and-options ()
2198 "Precompute regular expressions for current buffer." 2467 "Precompute regular expressions for current buffer."
2199 (when (eq major-mode 'org-mode) 2468 (when (eq major-mode 'org-mode)
2200 (let ((re (org-make-options-regexp 2469 (let ((re (org-make-options-regexp
2201 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" 2470 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO"
2202 "STARTUP" "ARCHIVE"))) 2471 "STARTUP" "ARCHIVE" "TAGS")))
2203 (splitre "[ \t]+") 2472 (splitre "[ \t]+")
2204 kwds int key value cat arch) 2473 kwds int key value cat arch tags)
2205 (save-excursion 2474 (save-excursion
2206 (save-restriction 2475 (save-restriction
2207 (widen) 2476 (widen)
2208 (goto-char (point-min)) 2477 (goto-char (point-min))
2209 (while (re-search-forward re nil t) 2478 (while (re-search-forward re nil t)
2210 (setq key (match-string 1) value (match-string 2)) 2479 (setq key (match-string 1) value (org-match-string-no-properties 2))
2211 (cond 2480 (cond
2212 ((equal key "CATEGORY") 2481 ((equal key "CATEGORY")
2213 (if (string-match "[ \t]+$" value) 2482 (if (string-match "[ \t]+$" value)
@@ -2222,6 +2491,8 @@ This face is only used if `org-fontify-done-headline' is set."
2222 ((equal key "TYP_TODO") 2491 ((equal key "TYP_TODO")
2223 (setq int 'type 2492 (setq int 'type
2224 kwds (append kwds (org-split-string value splitre)))) 2493 kwds (append kwds (org-split-string value splitre))))
2494 ((equal key "TAGS")
2495 (setq tags (append tags (org-split-string value splitre))))
2225 ((equal key "STARTUP") 2496 ((equal key "STARTUP")
2226 (let ((opts (org-split-string value splitre)) 2497 (let ((opts (org-split-string value splitre))
2227 (set '(("fold" org-startup-folded t) 2498 (set '(("fold" org-startup-folded t)
@@ -2235,6 +2506,8 @@ This face is only used if `org-fontify-done-headline' is set."
2235 ("oddeven" org-odd-levels-only nil) 2506 ("oddeven" org-odd-levels-only nil)
2236 ("align" org-startup-align-all-tables t) 2507 ("align" org-startup-align-all-tables t)
2237 ("noalign" org-startup-align-all-tables nil) 2508 ("noalign" org-startup-align-all-tables nil)
2509 ("logging" org-log-done t)
2510 ("nologging" org-log-done nil)
2238 ("dlcheck" org-startup-with-deadline-check t) 2511 ("dlcheck" org-startup-with-deadline-check t)
2239 ("nodlcheck" org-startup-with-deadline-check nil))) 2512 ("nodlcheck" org-startup-with-deadline-check nil)))
2240 l var val) 2513 l var val)
@@ -2250,7 +2523,24 @@ This face is only used if `org-fontify-done-headline' is set."
2250 (and cat (set (make-local-variable 'org-category) cat)) 2523 (and cat (set (make-local-variable 'org-category) cat))
2251 (and kwds (set (make-local-variable 'org-todo-keywords) kwds)) 2524 (and kwds (set (make-local-variable 'org-todo-keywords) kwds))
2252 (and arch (set (make-local-variable 'org-archive-location) arch)) 2525 (and arch (set (make-local-variable 'org-archive-location) arch))
2253 (and int (set (make-local-variable 'org-todo-interpretation) int))) 2526 (and int (set (make-local-variable 'org-todo-interpretation) int))
2527 (when tags
2528 (let (e tg c tgs)
2529 (while (setq e (pop tags))
2530 (cond
2531 ((equal e "{") (push '(:startgroup) tgs))
2532 ((equal e "}") (push '(:endgroup) tgs))
2533 ((string-match "^\\([0-9a-zA-Z_@]+\\)(\\(.\\))$" e)
2534 (push (cons (match-string 1 e)
2535 (string-to-char (match-string 2 e)))
2536 tgs))
2537 (t (push (list e) tgs))))
2538 (set (make-local-variable 'org-tag-alist) nil)
2539 (while (setq e (pop tgs))
2540 (or (and (stringp (car e))
2541 (assoc (car e) org-tag-alist))
2542 (push e org-tag-alist))))))
2543
2254 ;; Compute the regular expressions and other local variables 2544 ;; Compute the regular expressions and other local variables
2255 (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority) 2545 (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority)
2256 org-todo-kwd-max-priority (1- (length org-todo-keywords)) 2546 org-todo-kwd-max-priority (1- (length org-todo-keywords))
@@ -2273,6 +2563,10 @@ This face is only used if `org-fontify-done-headline' is set."
2273 "\\)? *\\(.*\\)") 2563 "\\)? *\\(.*\\)")
2274 org-nl-done-regexp 2564 org-nl-done-regexp
2275 (concat "[\r\n]\\*+[ \t]+" org-done-string "\\>") 2565 (concat "[\r\n]\\*+[ \t]+" org-done-string "\\>")
2566 org-todo-line-tags-regexp
2567 (concat "^\\(\\*+\\)[ \t]*\\("
2568 (mapconcat 'regexp-quote org-todo-keywords "\\|")
2569 "\\)? *\\(.*?\\([ \t]:[a-zA-Z0-9:_@]+:[ \t]*\\)?$\\)")
2276 org-looking-at-done-regexp (concat "^" org-done-string "\\>") 2570 org-looking-at-done-regexp (concat "^" org-done-string "\\>")
2277 org-deadline-regexp (concat "\\<" org-deadline-string) 2571 org-deadline-regexp (concat "\\<" org-deadline-string)
2278 org-deadline-time-regexp 2572 org-deadline-time-regexp
@@ -2282,11 +2576,27 @@ This face is only used if `org-fontify-done-headline' is set."
2282 org-scheduled-regexp 2576 org-scheduled-regexp
2283 (concat "\\<" org-scheduled-string) 2577 (concat "\\<" org-scheduled-string)
2284 org-scheduled-time-regexp 2578 org-scheduled-time-regexp
2285 (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")) 2579 (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")
2580 org-closed-time-regexp
2581 (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]")
2582 org-keyword-time-regexp
2583 (concat "\\<\\(" org-scheduled-string
2584 "\\|" org-deadline-string
2585 "\\|" org-closed-string "\\)"
2586 " *[[<]\\([^]>]+\\)[]>]")
2587 org-maybe-keyword-time-regexp
2588 (concat "\\(\\<\\(" org-scheduled-string
2589 "\\|" org-deadline-string
2590 "\\|" org-closed-string "\\)\\)?"
2591 " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\r\n>]*?[]>]\\)"))
2592
2286 (org-set-font-lock-defaults))) 2593 (org-set-font-lock-defaults)))
2287 2594
2288;; Tell the compiler about dynamically scoped variables, 2595;; Tell the compiler about dynamically scoped variables,
2289;; and variables from other packages 2596;; and variables from other packages
2597(defvar calc-embedded-close-formula) ; defined by the calc package
2598(defvar calc-embedded-open-formula) ; defined by the calc package
2599(defvar font-lock-unfontify-region-function) ; defined by font-lock.el
2290(defvar zmacs-regions) ; XEmacs regions 2600(defvar zmacs-regions) ; XEmacs regions
2291(defvar original-date) ; dynamically scoped in calendar 2601(defvar original-date) ; dynamically scoped in calendar
2292(defvar org-old-auto-fill-inhibit-regexp) ; local variable used by `orgtbl-mode' 2602(defvar org-old-auto-fill-inhibit-regexp) ; local variable used by `orgtbl-mode'
@@ -2298,14 +2608,9 @@ This face is only used if `org-fontify-done-headline' is set."
2298(defvar mark-active) ; Emacs only, not available in XEmacs. 2608(defvar mark-active) ; Emacs only, not available in XEmacs.
2299(defvar timecnt) ; dynamically scoped parameter 2609(defvar timecnt) ; dynamically scoped parameter
2300(defvar levels-open) ; dynamically scoped parameter 2610(defvar levels-open) ; dynamically scoped parameter
2301(defvar title) ; dynamically scoped parameter
2302(defvar author) ; dynamically scoped parameter
2303(defvar email) ; dynamically scoped parameter
2304(defvar text) ; dynamically scoped parameter
2305(defvar entry) ; dynamically scoped parameter 2611(defvar entry) ; dynamically scoped parameter
2306(defvar date) ; dynamically scoped parameter 2612(defvar date) ; dynamically scoped parameter
2307(defvar language) ; dynamically scoped parameter 2613(defvar description) ; dynamically scoped parameter
2308(defvar options) ; dynamically scoped parameter
2309(defvar ans1) ; dynamically scoped parameter 2614(defvar ans1) ; dynamically scoped parameter
2310(defvar ans2) ; dynamically scoped parameter 2615(defvar ans2) ; dynamically scoped parameter
2311(defvar starting-day) ; local variable 2616(defvar starting-day) ; local variable
@@ -2330,6 +2635,9 @@ This face is only used if `org-fontify-done-headline' is set."
2330(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode' 2635(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode'
2331(defvar initial) ; from remember.el, dynamically scoped in `remember-mode' 2636(defvar initial) ; from remember.el, dynamically scoped in `remember-mode'
2332(defvar orgtbl-mode) ; defined later in this file 2637(defvar orgtbl-mode) ; defined later in this file
2638(defvar Info-current-file) ; from info.el
2639(defvar Info-current-node) ; from info.el
2640
2333;;; Define the mode 2641;;; Define the mode
2334 2642
2335(defvar org-mode-map 2643(defvar org-mode-map
@@ -2372,11 +2680,31 @@ can be exported as a structured ASCII or HTML file.
2372The following commands are available: 2680The following commands are available:
2373 2681
2374\\{org-mode-map}" 2682\\{org-mode-map}"
2683
2684 ;; Get rid of Outline menus, they are not needed
2685 ;; Need to do this here because define-derived-mode sets up
2686 ;; the keymap so late.
2687 (if (featurep 'xemacs)
2688 (if org-noutline-p
2689 (progn
2690 (easy-menu-remove outline-mode-menu-heading)
2691 (easy-menu-remove outline-mode-menu-show)
2692 (easy-menu-remove outline-mode-menu-hide))
2693 (delete-menu-item '("Headings"))
2694 (delete-menu-item '("Show"))
2695 (delete-menu-item '("Hide"))
2696 (set-menubar-dirty-flag))
2697 (define-key org-mode-map [menu-bar headings] 'undefined)
2698 (define-key org-mode-map [menu-bar hide] 'undefined)
2699 (define-key org-mode-map [menu-bar show] 'undefined))
2700
2375 (easy-menu-add org-org-menu) 2701 (easy-menu-add org-org-menu)
2376 (easy-menu-add org-tbl-menu) 2702 (easy-menu-add org-tbl-menu)
2377 (org-install-agenda-files-menu) 2703 (org-install-agenda-files-menu)
2378 (if org-descriptive-links (org-add-to-invisibility-spec '(org-link))) 2704 (if org-descriptive-links (org-add-to-invisibility-spec '(org-link)))
2379 (org-add-to-invisibility-spec '(org-cwidth)) 2705 (org-add-to-invisibility-spec '(org-cwidth))
2706 (when (featurep 'xemacs)
2707 (set (make-local-variable 'line-move-ignore-invisible) t))
2380 (setq outline-regexp "\\*+") 2708 (setq outline-regexp "\\*+")
2381 ;;(setq outline-regexp "\\(?:\\*+\\|[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\) \\)") 2709 ;;(setq outline-regexp "\\(?:\\*+\\|[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\) \\)")
2382 (setq outline-level 'org-outline-level) 2710 (setq outline-level 'org-outline-level)
@@ -2405,19 +2733,6 @@ The following commands are available:
2405 (= (point-min) (point-max))) 2733 (= (point-min) (point-max)))
2406 (insert " -*- mode: org -*-\n\n")) 2734 (insert " -*- mode: org -*-\n\n"))
2407 2735
2408 ;; Get rid of Outline menus, they are not needed
2409 ;; Need to do this here because define-derived-mode sets up
2410 ;; the keymap so late.
2411 (if (featurep 'xemacs)
2412 (progn
2413 (delete-menu-item '("Headings"))
2414 (delete-menu-item '("Show"))
2415 (delete-menu-item '("Hide"))
2416 (set-menubar-dirty-flag))
2417 (define-key org-mode-map [menu-bar headings] 'undefined)
2418 (define-key org-mode-map [menu-bar hide] 'undefined)
2419 (define-key org-mode-map [menu-bar show] 'undefined))
2420
2421 (unless org-inhibit-startup 2736 (unless org-inhibit-startup
2422 (if org-startup-align-all-tables 2737 (if org-startup-align-all-tables
2423 (org-table-map-tables 'org-table-align)) 2738 (org-table-map-tables 'org-table-align))
@@ -2430,24 +2745,13 @@ The following commands are available:
2430 (let ((this-command 'org-cycle) (last-command 'org-cycle)) 2745 (let ((this-command 'org-cycle) (last-command 'org-cycle))
2431 (org-cycle '(4)) (org-cycle '(4)))))))) 2746 (org-cycle '(4)) (org-cycle '(4))))))))
2432 2747
2748(defsubst org-call-with-arg (command arg)
2749 "Call COMMAND interactively, but pretend prefix are was ARG."
2750 (let ((current-prefix-arg arg)) (call-interactively command)))
2751
2433(defsubst org-current-line (&optional pos) 2752(defsubst org-current-line (&optional pos)
2434 (+ (if (bolp) 1 0) (count-lines (point-min) (or pos (point))))) 2753 (+ (if (bolp) 1 0) (count-lines (point-min) (or pos (point)))))
2435 2754
2436(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t
2437 mouse-map t)
2438 "Properties to remove when a string without properties is wanted.")
2439
2440(defsubst org-match-string-no-properties (num &optional string)
2441 (if (featurep 'xemacs)
2442 (let ((s (match-string num string)))
2443 (remove-text-properties 0 (length s) org-rm-props s)
2444 s)
2445 (match-string-no-properties num string)))
2446
2447(defsubst org-no-properties (s)
2448 (remove-text-properties 0 (length s) org-rm-props s)
2449 s)
2450
2451(defun org-current-time () 2755(defun org-current-time ()
2452 "Current time, possibly rounded to `org-time-stamp-rounding-minutes'." 2756 "Current time, possibly rounded to `org-time-stamp-rounding-minutes'."
2453 (if (> org-time-stamp-rounding-minutes 0) 2757 (if (> org-time-stamp-rounding-minutes 0)
@@ -2488,7 +2792,7 @@ that will be added to PLIST. Returns the string that was modified."
2488 2792
2489(defconst org-non-link-chars "]\t\n\r<>") 2793(defconst org-non-link-chars "]\t\n\r<>")
2490(defconst org-link-types '("https?" "ftp" "mailto" "file" "news" "bbdb" "vm" 2794(defconst org-link-types '("https?" "ftp" "mailto" "file" "news" "bbdb" "vm"
2491 "wl" "mhe" "rmail" "gnus" "shell")) 2795 "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp"))
2492(defconst org-link-re-with-space 2796(defconst org-link-re-with-space
2493 (concat 2797 (concat
2494 "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):" 2798 "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
@@ -2581,6 +2885,8 @@ that will be added to PLIST. Returns the string that was modified."
2581 (let* ((help (concat "LINK: " 2885 (let* ((help (concat "LINK: "
2582 (org-match-string-no-properties 1))) 2886 (org-match-string-no-properties 1)))
2583 ;; FIXME: above we should remove the escapes. 2887 ;; FIXME: above we should remove the escapes.
2888 ;; but that requires another match, protecting match data,
2889 ;; a lot of overhead for font-lock.
2584 (ip (list 'invisible 'org-link 'intangible t 'rear-nonsticky t 2890 (ip (list 'invisible 'org-link 'intangible t 'rear-nonsticky t
2585 'keymap org-mouse-map 'mouse-face 'highlight 2891 'keymap org-mouse-map 'mouse-face 'highlight
2586 'help-echo help)) 2892 'help-echo help))
@@ -2719,11 +3025,13 @@ between words."
2719 (let* ((em org-fontify-emphasized-text) 3025 (let* ((em org-fontify-emphasized-text)
2720 (lk org-activate-links) 3026 (lk org-activate-links)
2721 (org-font-lock-extra-keywords 3027 (org-font-lock-extra-keywords
3028 ;; Headlines
2722 (list 3029 (list
2723 '("^\\(\\**\\)\\(\\*\\)\\(.*\\)" (1 (org-get-level-face 1)) 3030 '("^\\(\\**\\)\\(\\*\\)\\(.*\\)" (1 (org-get-level-face 1))
2724 (2 (org-get-level-face 2)) (3 (org-get-level-face 3))) 3031 (2 (org-get-level-face 2)) (3 (org-get-level-face 3)))
2725 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" 3032 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
2726 (1 'org-table)) 3033 (1 'org-table))
3034 ;; Links
2727 (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) 3035 (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
2728 (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) 3036 (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t)))
2729 (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) 3037 (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t)))
@@ -2733,27 +3041,34 @@ between words."
2733 (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) 3041 (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
2734 (if org-table-limit-column-width 3042 (if org-table-limit-column-width
2735 '(org-hide-wide-columns (0 nil append))) 3043 '(org-hide-wide-columns (0 nil append)))
3044 ;; TODO lines
2736 (list (concat "^\\*+[ \t]*" org-not-done-regexp) 3045 (list (concat "^\\*+[ \t]*" org-not-done-regexp)
2737 '(1 'org-todo t)) 3046 '(1 'org-todo t))
3047 ;; Priorities
2738 (list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t)) 3048 (list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t))
3049 ;; Special keywords
2739 (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) 3050 (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
2740 (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) 3051 (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
2741 (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) 3052 (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
2742; (if em '("\\(\\W\\|^\\)\\(\\*\\w+\\*\\)\\(\\W\\|$\\)" 2 'bold prepend)) 3053 ;; Emphasis
2743; (if em '("\\(\\W\\|^\\)\\(/\\w+/\\)\\(\\W\\|$\\)" 2 'italic prepend))
2744; (if em '("\\(\\W\\|^\\)\\(_\\w+_\\)\\(\\W\\|$\\)" 2 'underline prepend))
2745 (if em (list org-bold-re 2 ''bold 'prepend)) 3054 (if em (list org-bold-re 2 ''bold 'prepend))
2746 (if em (list org-italic-re 2 ''italic 'prepend)) 3055 (if em (list org-italic-re 2 ''italic 'prepend))
2747 (if em (list org-underline-re 2 ''underline 'prepend)) 3056 (if em (list org-underline-re 2 ''underline 'prepend))
3057 ;; Checkboxes, similar to Frank Ruell's org-checklet.el
3058 '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)"
3059 2 'bold prepend)
3060 ;; COMMENT
2748 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string 3061 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string
2749 "\\|" org-quote-string "\\)\\>") 3062 "\\|" org-quote-string "\\)\\>")
2750 '(1 'org-special-keyword t)) 3063 '(1 'org-special-keyword t))
2751 '("^#.*" (0 'font-lock-comment-face t)) 3064 '("^#.*" (0 'font-lock-comment-face t))
3065 ;; DONE
2752 (if org-fontify-done-headline 3066 (if org-fontify-done-headline
2753 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>") 3067 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>")
2754 '(1 'org-done t) '(2 'org-headline-done t)) 3068 '(1 'org-done t) '(2 'org-headline-done t))
2755 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") 3069 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>")
2756 '(1 'org-done t))) 3070 '(1 'org-done t)))
3071 ;; Table stuff
2757 '("^[ \t]*\\(:.*\\)" (1 'org-table t)) 3072 '("^[ \t]*\\(:.*\\)" (1 'org-table t))
2758 '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t)) 3073 '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t))
2759 '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t)) 3074 '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t))
@@ -2795,7 +3110,11 @@ between words."
2795;;; Visibility cycling 3110;;; Visibility cycling
2796 3111
2797(defvar org-cycle-global-status nil) 3112(defvar org-cycle-global-status nil)
3113(make-variable-buffer-local 'org-cycle-global-status)
2798(defvar org-cycle-subtree-status nil) 3114(defvar org-cycle-subtree-status nil)
3115(make-variable-buffer-local 'org-cycle-subtree-status)
3116
3117;;;###autoload
2799(defun org-cycle (&optional arg) 3118(defun org-cycle (&optional arg)
2800 "Visibility cycling for Org-mode. 3119 "Visibility cycling for Org-mode.
2801 3120
@@ -2825,15 +3144,18 @@ between words."
2825 no headline in line 1, this function will act as if called with prefix arg." 3144 no headline in line 1, this function will act as if called with prefix arg."
2826 (interactive "P") 3145 (interactive "P")
2827 3146
2828 (if (or (and (bobp) (not (looking-at outline-regexp))) 3147 (let* ((outline-regexp
2829 (equal arg '(4))) 3148 (if org-cycle-include-plain-lists
2830 ;; special case: use global cycling 3149 "\\*+\\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) "
2831 (setq arg t)) 3150 outline-regexp))
3151 (bob-special (and org-cycle-global-at-bob (bobp)
3152 (not (looking-at outline-regexp))))
3153 (org-cycle-hook (if bob-special nil org-cycle-hook))
3154 (pos (point)))
2832 3155
2833 (let ((outline-regexp 3156 (if (or bob-special (equal arg '(4)))
2834 (if org-cycle-include-plain-lists 3157 ;; special case: use global cycling
2835 "\\*+\\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " 3158 (setq arg t))
2836 outline-regexp)))
2837 3159
2838 (cond 3160 (cond
2839 3161
@@ -2843,7 +3165,7 @@ between words."
2843 (progn 3165 (progn
2844 (if arg (org-table-edit-field t) 3166 (if arg (org-table-edit-field t)
2845 (org-table-justify-field-maybe) 3167 (org-table-justify-field-maybe)
2846 (org-table-next-field))))) 3168 (call-interactively 'org-table-next-field)))))
2847 3169
2848 ((eq arg t) ;; Global cycling 3170 ((eq arg t) ;; Global cycling
2849 3171
@@ -2853,18 +3175,8 @@ between words."
2853 ;; We just created the overview - now do table of contents 3175 ;; We just created the overview - now do table of contents
2854 ;; This can be slow in very large buffers, so indicate action 3176 ;; This can be slow in very large buffers, so indicate action
2855 (message "CONTENTS...") 3177 (message "CONTENTS...")
2856 (save-excursion 3178 (org-content)
2857 ;; Visit all headings and show their offspring 3179 (message "CONTENTS...done")
2858 (goto-char (point-max))
2859 (catch 'exit
2860 (while (and (progn (condition-case nil
2861 (outline-previous-visible-heading 1)
2862 (error (goto-char (point-min))))
2863 t)
2864 (looking-at outline-regexp))
2865 (show-branches)
2866 (if (bobp) (throw 'exit nil))))
2867 (message "CONTENTS...done"))
2868 (setq org-cycle-global-status 'contents) 3180 (setq org-cycle-global-status 'contents)
2869 (run-hook-with-args 'org-cycle-hook 'contents)) 3181 (run-hook-with-args 'org-cycle-hook 'contents))
2870 3182
@@ -2878,7 +3190,7 @@ between words."
2878 3190
2879 (t 3191 (t
2880 ;; Default action: go to overview 3192 ;; Default action: go to overview
2881 (hide-sublevels 1) 3193 (org-overview)
2882 (message "OVERVIEW") 3194 (message "OVERVIEW")
2883 (setq org-cycle-global-status 'overview) 3195 (setq org-cycle-global-status 'overview)
2884 (run-hook-with-args 'org-cycle-hook 'overview)))) 3196 (run-hook-with-args 'org-cycle-hook 'overview))))
@@ -2908,10 +3220,10 @@ between words."
2908 (outline-next-heading)) 3220 (outline-next-heading))
2909 ;; Find out what to do next and set `this-command' 3221 ;; Find out what to do next and set `this-command'
2910 (cond 3222 (cond
2911 ((= eos eoh) 3223 ((and (= eos eoh)
2912 ;; Nothing is hidden behind this heading 3224 ;; Nothing is hidden behind this heading
2913 (message "EMPTY ENTRY") 3225 (message "EMPTY ENTRY")
2914 (setq org-cycle-subtree-status nil)) 3226 (setq org-cycle-subtree-status nil)))
2915 ((>= eol eos) 3227 ((>= eol eos)
2916 ;; Entire subtree is hidden in one line: open it 3228 ;; Entire subtree is hidden in one line: open it
2917 (org-show-entry) 3229 (org-show-entry)
@@ -2935,8 +3247,12 @@ between words."
2935 3247
2936 ;; TAB emulation 3248 ;; TAB emulation
2937 (buffer-read-only (org-back-to-heading)) 3249 (buffer-read-only (org-back-to-heading))
2938 ((if (and (eq org-cycle-emulate-tab 'white) 3250 ((if (and (memq org-cycle-emulate-tab '(white whitestart))
2939 (save-excursion (beginning-of-line 1) (looking-at "[ \t]+$"))) 3251 (save-excursion (beginning-of-line 1) (looking-at "[ \t]*"))
3252 (or (and (eq org-cycle-emulate-tab 'white)
3253 (= (match-end 0) (point-at-eol)))
3254 (and (eq org-cycle-emulate-tab 'whitestart)
3255 (>= (match-end 0) pos))))
2940 t 3256 t
2941 (eq org-cycle-emulate-tab t)) 3257 (eq org-cycle-emulate-tab t))
2942 (if (and (looking-at "[ \n\r\t]") 3258 (if (and (looking-at "[ \n\r\t]")
@@ -2951,6 +3267,44 @@ between words."
2951 (org-back-to-heading) 3267 (org-back-to-heading)
2952 (org-cycle)))))) 3268 (org-cycle))))))
2953 3269
3270;;;###autoload
3271(defun org-global-cycle ()
3272 "Cycle the global visibility. For details see `org-cycle'."
3273 (interactive)
3274 (org-cycle '(4)))
3275
3276(defun org-overview ()
3277 "Switch to overview mode, shoing only top-level headlines.
3278Really, this shows all headlines with level equal or greater than the level
3279of the first headline in the buffer. This is important, because if the
3280first headline is not level one, then (hide-sublevels 1) gives confusing
3281results."
3282 (interactive)
3283 (hide-sublevels (save-excursion
3284 (goto-char (point-min))
3285 (if (re-search-forward (concat "^" outline-regexp) nil t)
3286 (progn
3287 (goto-char (match-beginning 0))
3288 (funcall outline-level))
3289 1))))
3290
3291;; FIXME: allow an argument to give a limiting level for this.
3292(defun org-content ()
3293 "Show all headlines in the buffer, like a table of contents"
3294 (interactive)
3295 (save-excursion
3296 ;; Visit all headings and show their offspring
3297 (goto-char (point-max))
3298 (catch 'exit
3299 (while (and (progn (condition-case nil
3300 (outline-previous-visible-heading 1)
3301 (error (goto-char (point-min))))
3302 t)
3303 (looking-at outline-regexp))
3304 (show-branches)
3305 (if (bobp) (throw 'exit nil))))))
3306
3307
2954(defun org-optimize-window-after-visibility-change (state) 3308(defun org-optimize-window-after-visibility-change (state)
2955 "Adjust the window after a change in outline visibility. 3309 "Adjust the window after a change in outline visibility.
2956This function is the default value of the hook `org-cycle-hook'." 3310This function is the default value of the hook `org-cycle-hook'."
@@ -3071,7 +3425,6 @@ or nil."
3071 (kill-buffer "*org-goto*") 3425 (kill-buffer "*org-goto*")
3072 org-selected-point)) 3426 org-selected-point))
3073 3427
3074;; FIXME: It may not be a good idea to temper with the prefix argument...
3075(defun org-goto-ret (&optional arg) 3428(defun org-goto-ret (&optional arg)
3076 "Finish `org-goto' by going to the new location." 3429 "Finish `org-goto' by going to the new location."
3077 (interactive "P") 3430 (interactive "P")
@@ -3114,26 +3467,36 @@ or nil."
3114 "To temporarily disable the active region.") 3467 "To temporarily disable the active region.")
3115 3468
3116(defun org-insert-heading (&optional force-heading) 3469(defun org-insert-heading (&optional force-heading)
3117 "Insert a new heading or item with same depth at point." 3470 "Insert a new heading or item with same depth at point.
3471If point is in a plain list and FORCE-HEADING is nil, create a new list item.
3472If point is at the beginning of a headline, insert a sibling before the
3473current headline. If point is in the middle of a headline, split the headline
3474at that position and make the rest of the headline part of the sibling below
3475the current headline."
3118 (interactive "P") 3476 (interactive "P")
3119 (when (or force-heading (not (org-insert-item))) 3477 (if (= (buffer-size) 0)
3120 (let* ((head (save-excursion 3478 (insert "\n* ")
3121 (condition-case nil 3479 (when (or force-heading (not (org-insert-item)))
3122 (org-back-to-heading) 3480 (let* ((head (save-excursion
3123 (error (outline-next-heading))) 3481 (condition-case nil
3124 (prog1 (match-string 0) 3482 (progn
3125 (funcall outline-level))))) 3483 (org-back-to-heading)
3126 (cond 3484 (match-string 0))
3127 ((and (org-on-heading-p) (bolp) 3485 (error "*"))))
3128 (save-excursion (backward-char 1) (not (org-invisible-p)))) 3486 pos)
3129 (open-line 1)) 3487 (cond
3130 ((bolp) nil) 3488 ((and (org-on-heading-p) (bolp)
3131 (t (newline))) 3489 (save-excursion (backward-char 1) (not (org-invisible-p))))
3132 (insert head) 3490 (open-line 1))
3133 (just-one-space) 3491 ((bolp) nil)
3134 (run-hooks 'org-insert-heading-hook)))) 3492 (t (newline)))
3135 3493 (insert head) (just-one-space)
3136(defun org-insert-item () 3494 (setq pos (point))
3495 (end-of-line 1)
3496 (unless (= (point) pos) (just-one-space) (backward-delete-char 1))
3497 (run-hooks 'org-insert-heading-hook)))))
3498
3499(defun org-insert-item (&optional checkbox)
3137 "Insert a new item at the current level. 3500 "Insert a new item at the current level.
3138Return t when things worked, nil when we are not in an item." 3501Return t when things worked, nil when we are not in an item."
3139 (when (save-excursion 3502 (when (save-excursion
@@ -3144,9 +3507,11 @@ Return t when things worked, nil when we are not in an item."
3144 t) 3507 t)
3145 (error nil))) 3508 (error nil)))
3146 (let* ((bul (match-string 0)) 3509 (let* ((bul (match-string 0))
3510 (end (match-end 0))
3147 (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*") 3511 (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")
3148 (match-end 0))) 3512 (match-end 0)))
3149 (eowcol (save-excursion (goto-char eow) (current-column)))) 3513 (eowcol (save-excursion (goto-char eow) (current-column)))
3514 pos)
3150 (cond 3515 (cond
3151 ((and (org-at-item-p) (<= (point) eow)) 3516 ((and (org-at-item-p) (<= (point) eow))
3152 ;; before the bullet 3517 ;; before the bullet
@@ -3155,8 +3520,11 @@ Return t when things worked, nil when we are not in an item."
3155 ((<= (point) eow) 3520 ((<= (point) eow)
3156 (beginning-of-line 1)) 3521 (beginning-of-line 1))
3157 (t (newline))) 3522 (t (newline)))
3158 (insert bul) 3523 (insert bul (if checkbox "[ ]" ""))
3159 (just-one-space)) 3524 (just-one-space)
3525 (setq pos (point))
3526 (end-of-line 1)
3527 (unless (= (point) pos) (just-one-space) (backward-delete-char 1)))
3160 (org-maybe-renumber-ordered-list) 3528 (org-maybe-renumber-ordered-list)
3161 t)) 3529 t))
3162 3530
@@ -3165,16 +3533,19 @@ Return t when things worked, nil when we are not in an item."
3165If the heading has no TODO state, or if the state is DONE, use the first 3533If the heading has no TODO state, or if the state is DONE, use the first
3166state (TODO by default). Also with prefix arg, force first state." 3534state (TODO by default). Also with prefix arg, force first state."
3167 (interactive "P") 3535 (interactive "P")
3168 (org-insert-heading) 3536 (when (not (org-insert-item 'checkbox))
3169 (save-excursion 3537 (org-insert-heading)
3170 (org-back-to-heading) 3538 (save-excursion
3171 (outline-previous-heading) 3539 (org-back-to-heading)
3172 (looking-at org-todo-line-regexp)) 3540 (if org-noutline-p
3173 (if (or arg 3541 (outline-previous-heading)
3174 (not (match-beginning 2)) 3542 (outline-previous-visible-heading t))
3175 (equal (match-string 2) org-done-string)) 3543 (looking-at org-todo-line-regexp))
3176 (insert (car org-todo-keywords) " ") 3544 (if (or arg
3177 (insert (match-string 2) " "))) 3545 (not (match-beginning 2))
3546 (equal (match-string 2) org-done-string))
3547 (insert (car org-todo-keywords) " ")
3548 (insert (match-string 2) " "))))
3178 3549
3179(defun org-promote-subtree () 3550(defun org-promote-subtree ()
3180 "Promote the entire subtree. 3551 "Promote the entire subtree.
@@ -3408,7 +3779,7 @@ If optional TREE is given, use this text instead of the kill ring."
3408 (error 3779 (error
3409 (substitute-command-keys 3780 (substitute-command-keys
3410 "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) 3781 "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway")))
3411 (let* ((txt (or tree (current-kill 0))) 3782 (let* ((txt (or tree (and kill-ring (current-kill 0))))
3412 (^re (concat "^\\(" outline-regexp "\\)")) 3783 (^re (concat "^\\(" outline-regexp "\\)"))
3413 (re (concat "\\(" outline-regexp "\\)")) 3784 (re (concat "\\(" outline-regexp "\\)"))
3414 (^re_ (concat "\\(" outline-regexp "\\)[ \t]*")) 3785 (^re_ (concat "\\(" outline-regexp "\\)[ \t]*"))
@@ -3457,8 +3828,12 @@ If optional TREE is given, use this text instead of the kill ring."
3457 (progn (insert "\n") (backward-char 1))) 3828 (progn (insert "\n") (backward-char 1)))
3458 ;; Paste 3829 ;; Paste
3459 (setq beg (point)) 3830 (setq beg (point))
3831 (if (string-match "[ \t\r\n]+\\'" txt)
3832 (setq txt (replace-match "\n" t t txt)))
3460 (insert txt) 3833 (insert txt)
3461 (setq end (point)) 3834 (setq end (point))
3835 (if (looking-at "[ \t\r\n]+")
3836 (replace-match "\n"))
3462 (goto-char beg) 3837 (goto-char beg)
3463 ;; Shift if necessary 3838 ;; Shift if necessary
3464 (if (= shift 0) 3839 (if (= shift 0)
@@ -3471,7 +3846,8 @@ If optional TREE is given, use this text instead of the kill ring."
3471 (goto-char (point-min)) 3846 (goto-char (point-min))
3472 (message "Pasted at level %d, with shift by %d levels" 3847 (message "Pasted at level %d, with shift by %d levels"
3473 new-level shift1))) 3848 new-level shift1)))
3474 (if (and (eq org-subtree-clip (current-kill 0)) 3849 (if (and kill-ring
3850 (eq org-subtree-clip (current-kill 0))
3475 org-subtree-clip-folded) 3851 org-subtree-clip-folded)
3476 ;; The tree was folded before it was killed/copied 3852 ;; The tree was folded before it was killed/copied
3477 (hide-subtree)))) 3853 (hide-subtree))))
@@ -3483,8 +3859,9 @@ headline level is not the largest headline level in the tree.
3483So this will actually accept several entries of equal levels as well, 3859So this will actually accept several entries of equal levels as well,
3484which is OK for `org-paste-subtree'. 3860which is OK for `org-paste-subtree'.
3485If optional TXT is given, check this string instead of the current kill." 3861If optional TXT is given, check this string instead of the current kill."
3486 (let* ((kill (or txt (current-kill 0) "")) 3862 (let* ((kill (or txt (and kill-ring (current-kill 0)) ""))
3487 (start-level (and (string-match (concat "\\`" outline-regexp) kill) 3863 (start-level (and kill
3864 (string-match (concat "\\`" outline-regexp) kill)
3488 (- (match-end 0) (match-beginning 0)))) 3865 (- (match-end 0) (match-beginning 0))))
3489 (re (concat "^" outline-regexp)) 3866 (re (concat "^" outline-regexp))
3490 (start 1)) 3867 (start 1))
@@ -3510,16 +3887,60 @@ If optional TXT is given, check this string instead of the current kill."
3510 ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") 3887 ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
3511 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))))) 3888 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))))))
3512 3889
3513(defun org-get-indentation () 3890(defun org-at-item-checkbox-p ()
3514 "Get the indentation of the current line, interpreting tabs." 3891 "Is point at a line starting a plain-list item with a checklet?"
3892 (and (org-at-item-p)
3893 (save-excursion
3894 (goto-char (match-end 0))
3895 (skip-chars-forward " \t")
3896 (looking-at "\\[[ X]\\]"))))
3897
3898(defun org-toggle-checkbox ()
3899 "Toggle the checkbox in the current line."
3900 (interactive)
3515 (save-excursion 3901 (save-excursion
3516 (beginning-of-line 1) 3902 (if (org-at-item-checkbox-p)
3517 (skip-chars-forward " \t") 3903 (replace-match (if (equal (match-string 0) "[ ]") "[X]" "[ ]") t t))))
3518 (current-column))) 3904
3905(defun org-get-indentation (&optional line)
3906 "Get the indentation of the current line, interpreting tabs.
3907When LINE is given, assume it represents a line and compute its indentation."
3908 (if line
3909 (if (string-match "^ *" (org-remove-tabs line))
3910 (match-end 0))
3911 (save-excursion
3912 (beginning-of-line 1)
3913 (skip-chars-forward " \t")
3914 (current-column))))
3915
3916(defun org-remove-tabs (s &optional width)
3917 "Replace tabulators in S with spaces.
3918Assumes that s is a single line, starting in column 0."
3919 (setq width (or width tab-width))
3920 (while (string-match "\t" s)
3921 (setq s (replace-match
3922 (make-string
3923 (- (* width (/ (+ (match-beginning 0) width) width))
3924 (match-beginning 0)) ?\ )
3925 t t s)))
3926 s)
3927
3928;; FIXME: document properly.
3929(defun org-fix-indentation (line ind)
3930 "If the current indenation is smaller than ind1, leave it alone.
3931If it is larger than ind, reduce it by ind."
3932 (let* ((l (org-remove-tabs line))
3933 (i (org-get-indentation l))
3934 (i1 (car ind)) (i2 (cdr ind)))
3935 (if (>= i i2) (setq l (substring line i2)))
3936 (if (> i1 0)
3937 (concat (make-string i1 ?\ ) l)
3938 l)))
3519 3939
3520(defun org-beginning-of-item () 3940(defun org-beginning-of-item ()
3521 "Go to the beginning of the current hand-formatted item. 3941 "Go to the beginning of the current hand-formatted item.
3522If the cursor is not in an item, throw an error." 3942If the cursor is not in an item, throw an error."
3943 (interactive)
3523 (let ((pos (point)) 3944 (let ((pos (point))
3524 (limit (save-excursion (org-back-to-heading) 3945 (limit (save-excursion (org-back-to-heading)
3525 (beginning-of-line 2) (point))) 3946 (beginning-of-line 2) (point)))
@@ -3545,6 +3966,7 @@ If the cursor is not in an item, throw an error."
3545(defun org-end-of-item () 3966(defun org-end-of-item ()
3546 "Go to the end of the current hand-formatted item. 3967 "Go to the end of the current hand-formatted item.
3547If the cursor is not in an item, throw an error." 3968If the cursor is not in an item, throw an error."
3969 (interactive)
3548 (let ((pos (point)) 3970 (let ((pos (point))
3549 (limit (save-excursion (outline-next-heading) (point))) 3971 (limit (save-excursion (outline-next-heading) (point)))
3550 (ind (save-excursion 3972 (ind (save-excursion
@@ -3564,11 +3986,47 @@ If the cursor is not in an item, throw an error."
3564 (goto-char pos) 3986 (goto-char pos)
3565 (error "Not in an item")))) 3987 (error "Not in an item"))))
3566 3988
3567(defun org-move-item-down (arg) 3989(defun org-next-item ()
3990 "Move to the beginning of the next item in the current plain list.
3991Error if not at a plain list, or if this is the last item in the list."
3992 (interactive)
3993 (let (beg end ind ind1 (pos (point)) txt)
3994 (org-beginning-of-item)
3995 (setq beg (point))
3996 (setq ind (org-get-indentation))
3997 (org-end-of-item)
3998 (setq end (point))
3999 (setq ind1 (org-get-indentation))
4000 (unless (and (org-at-item-p) (= ind ind1))
4001 (goto-char pos)
4002 (error "On last item"))))
4003
4004(defun org-previous-item ()
4005 "Move to the beginning of the previous item in the current plain list.
4006Error if not at a plain list, or if this is the last item in the list."
4007 (interactive)
4008 (let (beg end ind ind1 (pos (point)) txt)
4009 (org-beginning-of-item)
4010 (setq beg (point))
4011 (setq ind (org-get-indentation))
4012 (goto-char beg)
4013 (catch 'exit
4014 (while t
4015 (beginning-of-line 0)
4016 (if (looking-at "[ \t]*$")
4017 nil
4018 (if (<= (setq ind1 (org-get-indentation)) ind)
4019 (throw 'exit t)))))
4020 (condition-case nil
4021 (org-beginning-of-item)
4022 (error (goto-char pos)
4023 (error "On first item")))))
4024
4025(defun org-move-item-down ()
3568 "Move the plain list item at point down, i.e. swap with following item. 4026 "Move the plain list item at point down, i.e. swap with following item.
3569Subitems (items with larger indentation) are considered part of the item, 4027Subitems (items with larger indentation) are considered part of the item,
3570so this really moves item trees." 4028so this really moves item trees."
3571 (interactive "p") 4029 (interactive)
3572 (let (beg end ind ind1 (pos (point)) txt) 4030 (let (beg end ind ind1 (pos (point)) txt)
3573 (org-beginning-of-item) 4031 (org-beginning-of-item)
3574 (setq beg (point)) 4032 (setq beg (point))
@@ -3647,7 +4105,7 @@ doing the renumbering."
3647 4105
3648(defun org-renumber-ordered-list (arg) 4106(defun org-renumber-ordered-list (arg)
3649 "Renumber an ordered plain list. 4107 "Renumber an ordered plain list.
3650Cursor next to be in the first line of an item, the line that starts 4108Cursor needs to be in the first line of an item, the line that starts
3651with something like \"1.\" or \"2)\"." 4109with something like \"1.\" or \"2)\"."
3652 (interactive "p") 4110 (interactive "p")
3653 (unless (and (org-at-item-p) 4111 (unless (and (org-at-item-p)
@@ -3702,24 +4160,24 @@ with something like \"1.\" or \"2)\"."
3702 (interactive "p") 4160 (interactive "p")
3703 (unless (org-at-item-p) 4161 (unless (org-at-item-p)
3704 (error "Not on an item")) 4162 (error "Not on an item"))
3705 (let (beg end ind ind1) 4163 (save-excursion
3706 (if (memq last-command '(org-shiftmetaright org-shiftmetaleft)) 4164 (let (beg end ind ind1)
4165 (if (memq last-command '(org-shiftmetaright org-shiftmetaleft))
3707 (setq beg org-last-indent-begin-marker 4166 (setq beg org-last-indent-begin-marker
3708 end org-last-indent-end-marker) 4167 end org-last-indent-end-marker)
3709 (org-beginning-of-item) 4168 (org-beginning-of-item)
3710 (setq beg (move-marker org-last-indent-begin-marker (point))) 4169 (setq beg (move-marker org-last-indent-begin-marker (point)))
3711 (org-end-of-item) 4170 (org-end-of-item)
3712 (setq end (move-marker org-last-indent-end-marker (point)))) 4171 (setq end (move-marker org-last-indent-end-marker (point))))
3713 (goto-char beg) 4172 (goto-char beg)
3714 (skip-chars-forward " \t") (setq ind (current-column)) 4173 (skip-chars-forward " \t") (setq ind (current-column))
3715 (if (< (+ arg ind) 0) (error "Cannot outdent beyond margin")) 4174 (if (< (+ arg ind) 0) (error "Cannot outdent beyond margin"))
3716 (while (< (point) end) 4175 (while (< (point) end)
3717 (beginning-of-line 1) 4176 (beginning-of-line 1)
3718 (skip-chars-forward " \t") (setq ind1 (current-column)) 4177 (skip-chars-forward " \t") (setq ind1 (current-column))
3719 (delete-region (point-at-bol) (point)) 4178 (delete-region (point-at-bol) (point))
3720 (indent-to-column (+ ind1 arg)) 4179 (indent-to-column (+ ind1 arg))
3721 (beginning-of-line 2)) 4180 (beginning-of-line 2)))))
3722 (goto-char beg)))
3723 4181
3724;;; Archiving 4182;;; Archiving
3725 4183
@@ -3789,14 +4247,13 @@ heading be marked DONE, and the current time will be added."
3789 (or (bolp) (insert "\n")) 4247 (or (bolp) (insert "\n"))
3790 (insert "\n" heading "\n") 4248 (insert "\n" heading "\n")
3791 (end-of-line 0)) 4249 (end-of-line 0))
3792 ;; Make the heading visible, and the following as well 4250 ;; Make the subtree visible
3793 (let ((org-show-following-heading t)) (org-show-hierarchy-above)) 4251 (show-subtree)
3794 (if (re-search-forward 4252 (org-end-of-subtree t)
3795 (concat "^" (regexp-quote (make-string level ?*)) "[ \t]") 4253 (skip-chars-backward " \t\r\n]")
3796 nil t) 4254 (and (looking-at "[ \t\r\n]*")
3797 (progn (goto-char (match-beginning 0)) (insert "\n") 4255 (replace-match "\n\n")))
3798 (beginning-of-line 0)) 4256 ;; No specific heading, just go to end of file.
3799 (goto-char (point-max)) (insert "\n")))
3800 (goto-char (point-max)) (insert "\n")) 4257 (goto-char (point-max)) (insert "\n"))
3801 ;; Paste 4258 ;; Paste
3802 (org-paste-subtree (1+ level)) 4259 (org-paste-subtree (1+ level))
@@ -3816,7 +4273,7 @@ heading be marked DONE, and the current time will be added."
3816 ;; Here we are back in the original buffer. Everything seems to have 4273 ;; Here we are back in the original buffer. Everything seems to have
3817 ;; worked. So now cut the tree and finish up. 4274 ;; worked. So now cut the tree and finish up.
3818 (let (this-command) (org-cut-subtree)) 4275 (let (this-command) (org-cut-subtree))
3819 (if (looking-at "[ \t]*$") (kill-line)) 4276 (if (and (not (eobp)) (looking-at "[ \t]*$")) (kill-line))
3820 (message "Subtree archived %s" 4277 (message "Subtree archived %s"
3821 (if (eq this-buffer buffer) 4278 (if (eq this-buffer buffer)
3822 (concat "under heading: " heading) 4279 (concat "under heading: " heading)
@@ -3844,6 +4301,7 @@ At all other locations, this simply calls `ispell-complete-word'."
3844 (if (equal (char-before (point)) ?\ ) (backward-char 1)) 4301 (if (equal (char-before (point)) ?\ ) (backward-char 1))
3845 (skip-chars-backward "a-zA-Z0-9_:$") 4302 (skip-chars-backward "a-zA-Z0-9_:$")
3846 (point))) 4303 (point)))
4304 (confirm (lambda (x) (stringp (car x))))
3847 (camel (equal (char-before beg) ?*)) 4305 (camel (equal (char-before beg) ?*))
3848 (tag (equal (char-before beg1) ?:)) 4306 (tag (equal (char-before beg1) ?:))
3849 (texp (equal (char-before beg) ?\\)) 4307 (texp (equal (char-before beg) ?\\))
@@ -3880,10 +4338,10 @@ At all other locations, this simply calls `ispell-complete-word'."
3880 tbl))) 4338 tbl)))
3881 tbl) 4339 tbl)
3882 (tag (setq type :tag beg beg1) 4340 (tag (setq type :tag beg beg1)
3883 (org-get-buffer-tags)) 4341 (or org-tag-alist (org-get-buffer-tags)))
3884 (t (progn (ispell-complete-word arg) (throw 'exit nil))))) 4342 (t (progn (ispell-complete-word arg) (throw 'exit nil)))))
3885 (pattern (buffer-substring-no-properties beg end)) 4343 (pattern (buffer-substring-no-properties beg end))
3886 (completion (try-completion pattern table))) 4344 (completion (try-completion pattern table confirm)))
3887 (cond ((eq completion t) 4345 (cond ((eq completion t)
3888 (if (equal type :opt) 4346 (if (equal type :opt)
3889 (insert (substring (cdr (assoc (upcase pattern) table)) 4347 (insert (substring (cdr (assoc (upcase pattern) table))
@@ -3906,7 +4364,8 @@ At all other locations, this simply calls `ispell-complete-word'."
3906 "Press \\[org-complete] again to insert example settings")))) 4364 "Press \\[org-complete] again to insert example settings"))))
3907 (t 4365 (t
3908 (message "Making completion list...") 4366 (message "Making completion list...")
3909 (let ((list (sort (all-completions pattern table) 'string<))) 4367 (let ((list (sort (all-completions pattern table confirm)
4368 'string<)))
3910 (with-output-to-temp-buffer "*Completions*" 4369 (with-output-to-temp-buffer "*Completions*"
3911 (condition-case nil 4370 (condition-case nil
3912 ;; Protection needed for XEmacs and emacs 21 4371 ;; Protection needed for XEmacs and emacs 21
@@ -3960,44 +4419,44 @@ prefix arg, switch to that state."
3960 (member (member this org-todo-keywords)) 4419 (member (member this org-todo-keywords))
3961 (tail (cdr member)) 4420 (tail (cdr member))
3962 (state (cond 4421 (state (cond
3963 ((equal arg '(4)) 4422 ((equal arg '(4))
3964 ;; Read a state with completion 4423 ;; Read a state with completion
3965 (completing-read "State: " (mapcar (lambda(x) (list x)) 4424 (completing-read "State: " (mapcar (lambda(x) (list x))
3966 org-todo-keywords) 4425 org-todo-keywords)
3967 nil t)) 4426 nil t))
3968 ((eq arg 'right) 4427 ((eq arg 'right)
3969 (if this 4428 (if this
3970 (if tail (car tail) nil) 4429 (if tail (car tail) nil)
3971 (car org-todo-keywords))) 4430 (car org-todo-keywords)))
3972 ((eq arg 'left) 4431 ((eq arg 'left)
3973 (if (equal member org-todo-keywords) 4432 (if (equal member org-todo-keywords)
3974 nil 4433 nil
3975 (if this 4434 (if this
3976 (nth (- (length org-todo-keywords) (length tail) 2) 4435 (nth (- (length org-todo-keywords) (length tail) 2)
3977 org-todo-keywords) 4436 org-todo-keywords)
3978 org-done-string))) 4437 org-done-string)))
3979 (arg 4438 (arg
3980 ;; user requests a specific state 4439 ;; user requests a specific state
3981 (nth (1- (prefix-numeric-value arg)) 4440 (nth (1- (prefix-numeric-value arg))
3982 org-todo-keywords)) 4441 org-todo-keywords))
3983 ((null member) (car org-todo-keywords)) 4442 ((null member) (car org-todo-keywords))
3984 ((null tail) nil) ;; -> first entry 4443 ((null tail) nil) ;; -> first entry
3985 ((eq org-todo-interpretation 'sequence) 4444 ((eq org-todo-interpretation 'sequence)
3986 (car tail)) 4445 (car tail))
3987 ((memq org-todo-interpretation '(type priority)) 4446 ((memq org-todo-interpretation '(type priority))
3988 (if (eq this-command last-command) 4447 (if (eq this-command last-command)
3989 (car tail) 4448 (car tail)
3990 (if (> (length tail) 0) org-done-string nil))) 4449 (if (> (length tail) 0) org-done-string nil)))
3991 (t nil))) 4450 (t nil)))
3992 (next (if state (concat " " state " ") " "))) 4451 (next (if state (concat " " state " ") " ")))
3993 (replace-match next t t) 4452 (replace-match next t t)
3994 (setq org-last-todo-state-is-todo 4453 (setq org-last-todo-state-is-todo
3995 (not (equal state org-done-string))) 4454 (not (equal state org-done-string)))
3996 (when org-log-done 4455 (when org-log-done
3997 (if (equal state org-done-string) 4456 (if (equal state org-done-string)
3998 (org-log-done) 4457 (org-add-planning-info 'closed (current-time) 'scheduled)
3999 (if (not this) 4458 (if (not this)
4000 (org-log-done t)))) 4459 (org-add-planning-info nil nil 'closed))))
4001 ;; Fixup tag positioning 4460 ;; Fixup tag positioning
4002 (and org-auto-align-tags (org-set-tags nil t)) 4461 (and org-auto-align-tags (org-set-tags nil t))
4003 (run-hooks 'org-after-todo-state-change-hook))) 4462 (run-hooks 'org-after-todo-state-change-hook)))
@@ -4067,25 +4526,79 @@ of `org-todo-keywords'."
4067A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down] 4526A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down]
4068to modify it to the correct date." 4527to modify it to the correct date."
4069 (interactive) 4528 (interactive)
4070 (insert 4529 (org-add-planning-info 'deadline nil 'closed))
4071 org-deadline-string " "
4072 (format-time-string (car org-time-stamp-formats)
4073 (org-read-date nil 'to-time)))
4074 (message "%s" (substitute-command-keys
4075 "Use \\[org-timestamp-up-day] and \\[org-timestamp-down-day] to change the date.")))
4076 4530
4077(defun org-schedule () 4531(defun org-schedule ()
4078 "Insert the SCHEDULED: string to schedule a TODO item. 4532 "Insert the SCHEDULED: string to schedule a TODO item.
4079A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down] 4533A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down]
4080to modify it to the correct date." 4534to modify it to the correct date."
4081 (interactive) 4535 (interactive)
4082 (insert 4536 (org-add-planning-info 'scheduled nil 'closed))
4083 org-scheduled-string " " 4537
4084 (format-time-string (car org-time-stamp-formats) 4538(defun org-add-planning-info (what &optional time &rest remove)
4085 (org-read-date nil 'to-time))) 4539 "Insert new timestamp with keyword in the line directly after the headline.
4086 (message "%s" (substitute-command-keys 4540WHAT indicates what kind of time stamp to add. TIME indicated the time to use.
4087 "Use \\[org-timestamp-up-day] and \\[org-timestamp-down-day] to change the date."))) 4541If non is given, the user is prompted for a date.
4088 4542REMOVE indicates what kind of entries to remove. An old WHAT entry will also
4543be removed."
4544 (interactive)
4545 (when what (setq time (or time (org-read-date nil 'to-time))))
4546 (when (and org-insert-labeled-timestamps-at-point
4547 (member what '(scheduled deadline)))
4548 (insert
4549 (if (eq what 'scheduled) org-scheduled-string org-deadline-string)
4550 " "
4551 (format-time-string (car org-time-stamp-formats) time))
4552 (setq what nil))
4553 (save-excursion
4554 (let (beg end col list elt (buffer-invisibility-spec nil) ts)
4555 (org-back-to-heading t)
4556 (setq beg (point))
4557 (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*"))
4558 (goto-char (match-end 1))
4559 (setq col (current-column))
4560 (goto-char (1+ (match-end 0)))
4561 (if (and (not (looking-at outline-regexp))
4562 (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp
4563 "[^\r\n]*")))
4564 (narrow-to-region (match-beginning 0) (match-end 0))
4565 (insert "\n")
4566 (backward-char 1)
4567 (narrow-to-region (point) (point))
4568 (indent-to-column col))
4569 ;; Check if we have to remove something.
4570 (setq list (cons what remove))
4571 (while list
4572 (setq elt (pop list))
4573 (goto-char (point-min))
4574 (when (or (and (eq elt 'scheduled)
4575 (re-search-forward org-scheduled-time-regexp nil t))
4576 (and (eq elt 'deadline)
4577 (re-search-forward org-deadline-time-regexp nil t))
4578 (and (eq elt 'closed)
4579 (re-search-forward org-closed-time-regexp nil t)))
4580 (replace-match "")
4581 (if (looking-at " +") (replace-match ""))))
4582 (goto-char (point-max))
4583 (when what
4584 (insert
4585 (if (not (equal (char-before) ?\ )) " " "")
4586 (cond ((eq what 'scheduled) org-scheduled-string)
4587 ((eq what 'deadline) org-deadline-string)
4588 ((eq what 'closed) org-closed-string))
4589 " ")
4590 (insert
4591 (setq ts
4592 (format-time-string
4593 (if (eq what 'closed)
4594 (concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")
4595 (car org-time-stamp-formats))
4596 time))))
4597 (goto-char (point-min))
4598 (widen)
4599 (if (looking-at "[ \t]+\r?\n")
4600 (replace-match ""))
4601 ts)))
4089 4602
4090(defun org-occur (regexp &optional callback) 4603(defun org-occur (regexp &optional callback)
4091 "Make a compact tree which shows all matches of REGEXP. 4604 "Make a compact tree which shows all matches of REGEXP.
@@ -4100,7 +4613,7 @@ that the match should indeed be shown."
4100 (let ((cnt 0)) 4613 (let ((cnt 0))
4101 (save-excursion 4614 (save-excursion
4102 (goto-char (point-min)) 4615 (goto-char (point-min))
4103 (hide-sublevels 1) 4616 (org-overview)
4104 (while (re-search-forward regexp nil t) 4617 (while (re-search-forward regexp nil t)
4105 (when (or (not callback) 4618 (when (or (not callback)
4106 (save-match-data (funcall callback))) 4619 (save-match-data (funcall callback)))
@@ -4340,7 +4853,7 @@ used to insert the time stamp into the buffer to include the time."
4340 ;; the range start. 4853 ;; the range start.
4341 (if (save-excursion 4854 (if (save-excursion
4342 (re-search-backward 4855 (re-search-backward
4343 (concat org-ts-regexp "--\\=") ; FIXME: exactly two minuses? 4856 (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses
4344 (- (point) 20) t)) 4857 (- (point) 20) t))
4345 (apply 4858 (apply
4346 'encode-time 4859 'encode-time
@@ -4348,8 +4861,8 @@ used to insert the time stamp into the buffer to include the time."
4348 (parse-time-string (match-string 1)))) 4861 (parse-time-string (match-string 1))))
4349 ct)) 4862 ct))
4350 (calendar-move-hook nil) 4863 (calendar-move-hook nil)
4351 (view-calendar-holidays-initially nil)
4352 (view-diary-entries-initially nil) 4864 (view-diary-entries-initially nil)
4865 (view-calendar-holidays-initially nil)
4353 (timestr (format-time-string 4866 (timestr (format-time-string
4354 (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") default-time)) 4867 (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") default-time))
4355 (prompt (format "YYYY-MM-DD [%s]: " timestr)) 4868 (prompt (format "YYYY-MM-DD [%s]: " timestr))
@@ -4761,7 +5274,6 @@ If there is already a time stamp at the cursor position, update it."
4761(defvar org-agenda-type nil) 5274(defvar org-agenda-type nil)
4762(defvar org-agenda-force-single-file nil) 5275(defvar org-agenda-force-single-file nil)
4763 5276
4764;;;###autoload
4765(defun org-agenda-mode () 5277(defun org-agenda-mode ()
4766 "Mode for time-sorted view on action items in Org-mode files. 5278 "Mode for time-sorted view on action items in Org-mode files.
4767 5279
@@ -4778,7 +5290,7 @@ The following commands are available:
4778 (org-add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local) 5290 (org-add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local)
4779 (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local) 5291 (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local)
4780 (unless org-agenda-keep-modes 5292 (unless org-agenda-keep-modes
4781 (setq org-agenda-follow-mode nil 5293 (setq org-agenda-follow-mode org-agenda-start-with-follow-mode
4782 org-agenda-show-log nil)) 5294 org-agenda-show-log nil))
4783 (easy-menu-change 5295 (easy-menu-change
4784 '("Agenda") "Agenda Files" 5296 '("Agenda") "Agenda Files"
@@ -4815,6 +5327,8 @@ The following commands are available:
4815(define-key org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-date-earlier) 5327(define-key org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-date-earlier)
4816 5328
4817(define-key org-agenda-mode-map ">" 'org-agenda-date-prompt) 5329(define-key org-agenda-mode-map ">" 'org-agenda-date-prompt)
5330(define-key org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule)
5331(define-key org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline)
4818(let ((l '(1 2 3 4 5 6 7 8 9 0))) 5332(let ((l '(1 2 3 4 5 6 7 8 9 0)))
4819 (while l (define-key org-agenda-mode-map 5333 (while l (define-key org-agenda-mode-map
4820 (int-to-string (pop l)) 'digit-argument))) 5334 (int-to-string (pop l)) 'digit-argument)))
@@ -4878,10 +5392,12 @@ The following commands are available:
4878 ("Tags" 5392 ("Tags"
4879 ["Show all Tags" org-agenda-show-tags t] 5393 ["Show all Tags" org-agenda-show-tags t]
4880 ["Set Tags" org-agenda-set-tags t]) 5394 ["Set Tags" org-agenda-set-tags t])
4881 ("Reschedule" 5395 ("Schedule"
5396 ["Schedule" org-agenda-schedule t]
5397 ["Set Deadline" org-agenda-deadline t]
5398 "--"
4882 ["Reschedule +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)] 5399 ["Reschedule +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)]
4883 ["Reschedule -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)] 5400 ["Reschedule -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)]
4884 "--"
4885 ["Reschedule to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)]) 5401 ["Reschedule to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)])
4886 ("Priority" 5402 ("Priority"
4887 ["Set Priority" org-agenda-priority t] 5403 ["Set Priority" org-agenda-priority t]
@@ -4945,6 +5461,7 @@ next use of \\[org-agenda]) restricted to the current file."
4945 (interactive "P") 5461 (interactive "P")
4946 (catch 'exit 5462 (catch 'exit
4947 (let ((restrict-ok (and buffer-file-name (eq major-mode 'org-mode))) 5463 (let ((restrict-ok (and buffer-file-name (eq major-mode 'org-mode)))
5464 (bfn buffer-file-name)
4948 (custom org-agenda-custom-commands) 5465 (custom org-agenda-custom-commands)
4949 c entry key type string) 5466 c entry key type string)
4950 (put 'org-agenda-files 'org-restrict nil) 5467 (put 'org-agenda-files 'org-restrict nil)
@@ -4979,7 +5496,7 @@ C Configure your own agenda commands")
4979 (message "") 5496 (message "")
4980 (when (equal c ?1) 5497 (when (equal c ?1)
4981 (if restrict-ok 5498 (if restrict-ok
4982 (put 'org-agenda-files 'org-restrict (list buffer-file-name)) 5499 (put 'org-agenda-files 'org-restrict (list bfn))
4983 (error "Cannot restrict agenda to current buffer")) 5500 (error "Cannot restrict agenda to current buffer"))
4984 (message "Press key for agenda command%s" 5501 (message "Press key for agenda command%s"
4985 (if restrict-ok " (restricted to current file)" "")) 5502 (if restrict-ok " (restricted to current file)" ""))
@@ -4991,18 +5508,16 @@ C Configure your own agenda commands")
4991 ((equal c ?C) (customize-variable 'org-agenda-custom-commands)) 5508 ((equal c ?C) (customize-variable 'org-agenda-custom-commands))
4992 ((equal c ?a) (call-interactively 'org-agenda-list)) 5509 ((equal c ?a) (call-interactively 'org-agenda-list))
4993 ((equal c ?t) (call-interactively 'org-todo-list)) 5510 ((equal c ?t) (call-interactively 'org-todo-list))
4994 ((equal c ?T) 5511 ((equal c ?T) (org-call-with-arg 'org-todo-list (or arg '(4))))
4995 (setq current-prefix-arg (or arg '(4)))
4996 (call-interactively 'org-todo-list))
4997 ((equal c ?m) (call-interactively 'org-tags-view)) 5512 ((equal c ?m) (call-interactively 'org-tags-view))
4998 ((equal c ?M) 5513 ((equal c ?M) (org-call-with-arg 'org-tags-view (or arg '(4))))
4999 (setq current-prefix-arg (or arg '(4)))
5000 (call-interactively 'org-tags-view))
5001 ((setq entry (assoc (char-to-string c) org-agenda-custom-commands)) 5514 ((setq entry (assoc (char-to-string c) org-agenda-custom-commands))
5002 (setq type (nth 1 entry) string (nth 2 entry)) 5515 (setq type (nth 1 entry) string (nth 2 entry))
5003 (cond 5516 (cond
5004 ((eq type 'tags) 5517 ((eq type 'tags)
5005 (org-tags-view current-prefix-arg string)) 5518 (org-tags-view current-prefix-arg string))
5519 ((eq type 'tags-todo)
5520 (org-tags-view '(4) string))
5006 ((eq type 'todo) 5521 ((eq type 'todo)
5007 (org-todo-list string)) 5522 (org-todo-list string))
5008 ((eq type 'tags-tree) 5523 ((eq type 'tags-tree)
@@ -5159,12 +5674,13 @@ dates."
5159 (beg (if (org-region-active-p) (region-beginning) (point-min))) 5674 (beg (if (org-region-active-p) (region-beginning) (point-min)))
5160 (end (if (org-region-active-p) (region-end) (point-max))) 5675 (end (if (org-region-active-p) (region-end) (point-max)))
5161 (day-numbers (org-get-all-dates beg end 'no-ranges 5676 (day-numbers (org-get-all-dates beg end 'no-ranges
5162 t doclosed)) ; always include today 5677 t doclosed ; always include today
5678 org-timeline-show-empty-dates))
5163 (today (time-to-days (current-time))) 5679 (today (time-to-days (current-time)))
5164 (org-respect-restriction t) 5680 (org-respect-restriction t)
5165 (past t) 5681 (past t)
5166 args 5682 args
5167 s e rtn d) 5683 s e rtn d emptyp)
5168 (setq org-agenda-redo-command 5684 (setq org-agenda-redo-command
5169 (list 'progn 5685 (list 'progn
5170 (list 'switch-to-buffer-other-window (current-buffer)) 5686 (list 'switch-to-buffer-other-window (current-buffer))
@@ -5184,28 +5700,35 @@ dates."
5184 (push :timestamp args) 5700 (push :timestamp args)
5185 (if dotodo (push :todo args)) 5701 (if dotodo (push :todo args))
5186 (while (setq d (pop day-numbers)) 5702 (while (setq d (pop day-numbers))
5187 (if (and (>= d today) 5703 (if (and (listp d) (eq (car d) :omitted))
5188 dopast
5189 past)
5190 (progn
5191 (setq past nil)
5192 (insert (make-string 79 ?-) "\n")))
5193 (setq date (calendar-gregorian-from-absolute d))
5194 (setq s (point))
5195 (setq rtn (apply 'org-agenda-get-day-entries
5196 entry date args))
5197 (if (or rtn (equal d today))
5198 (progn 5704 (progn
5199 (insert (calendar-day-name date) " " 5705 (setq s (point))
5200 (number-to-string (extract-calendar-day date)) " " 5706 (insert (format "\n[... %d empty days omitted]\n\n" (cdr d)))
5201 (calendar-month-name (extract-calendar-month date)) " " 5707 (put-text-property s (1- (point)) 'face 'org-level-3))
5202 (number-to-string (extract-calendar-year date)) "\n") 5708 (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil))
5203 (put-text-property s (1- (point)) 'face 5709 (if (and (>= d today)
5204 'org-level-3) 5710 dopast
5205 (if (equal d today) 5711 past)
5206 (put-text-property s (1- (point)) 'org-today t)) 5712 (progn
5207 (insert (org-finalize-agenda-entries rtn) "\n") 5713 (setq past nil)
5208 (put-text-property s (1- (point)) 'day d)))) 5714 (insert (make-string 79 ?-) "\n")))
5715 (setq date (calendar-gregorian-from-absolute d))
5716 (setq s (point))
5717 (setq rtn (and (not emptyp)
5718 (apply 'org-agenda-get-day-entries
5719 entry date args)))
5720 (if (or rtn (equal d today) org-timeline-show-empty-dates)
5721 (progn
5722 (insert (calendar-day-name date) " "
5723 (number-to-string (extract-calendar-day date)) " "
5724 (calendar-month-name (extract-calendar-month date)) " "
5725 (number-to-string (extract-calendar-year date)) "\n")
5726 (put-text-property s (1- (point)) 'face
5727 'org-level-3)
5728 (if (equal d today)
5729 (put-text-property s (1- (point)) 'org-today t))
5730 (and rtn (insert (org-finalize-agenda-entries rtn) "\n"))
5731 (put-text-property s (1- (point)) 'day d)))))
5209 (goto-char (point-min)) 5732 (goto-char (point-min))
5210 (setq buffer-read-only t) 5733 (setq buffer-read-only t)
5211 (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) 5734 (goto-char (or (text-property-any (point-min) (point-max) 'org-today t)
@@ -5432,7 +5955,7 @@ If ERROR is non-nil, throw an error, otherwise just return nil."
5432 (if (memq org-agenda-type types) 5955 (if (memq org-agenda-type types)
5433 t 5956 t
5434 (if error 5957 (if error
5435 (error "Now allowed in %s-type agenda buffers" org-agenda-type) 5958 (error "Not allowed in %s-type agenda buffers" org-agenda-type)
5436 nil))) 5959 nil)))
5437 5960
5438(defun org-agenda-quit () 5961(defun org-agenda-quit ()
@@ -5768,14 +6291,15 @@ Optional argument FILE means, use this file instead of the current."
5768(defun org-file-menu-entry (file) 6291(defun org-file-menu-entry (file)
5769 (vector file (list 'find-file file) t)) 6292 (vector file (list 'find-file file) t))
5770 6293
5771(defun org-get-all-dates (beg end &optional no-ranges force-today inactive) 6294(defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty)
5772 "Return a list of all relevant day numbers from BEG to END buffer positions. 6295 "Return a list of all relevant day numbers from BEG to END buffer positions.
5773If NO-RANGES is non-nil, include only the start and end dates of a range, 6296If NO-RANGES is non-nil, include only the start and end dates of a range,
5774not every single day in the range. If FORCE-TODAY is non-nil, make 6297not every single day in the range. If FORCE-TODAY is non-nil, make
5775sure that TODAY is included in the list. If INACTIVE is non-nil, also 6298sure that TODAY is included in the list. If INACTIVE is non-nil, also
5776inactive time stamps (those in square brackets) are included." 6299inactive time stamps (those in square brackets) are included.
6300When EMPTY is non-nil, also include days without any entries."
5777 (let ((re (if inactive org-ts-regexp-both org-ts-regexp)) 6301 (let ((re (if inactive org-ts-regexp-both org-ts-regexp))
5778 dates date day day1 day2 ts1 ts2) 6302 dates dates1 date day day1 day2 ts1 ts2)
5779 (if force-today 6303 (if force-today
5780 (setq dates (list (time-to-days (current-time))))) 6304 (setq dates (list (time-to-days (current-time)))))
5781 (save-excursion 6305 (save-excursion
@@ -5793,7 +6317,19 @@ inactive time stamps (those in square brackets) are included."
5793 day2 (time-to-days (org-time-string-to-time ts2))) 6317 day2 (time-to-days (org-time-string-to-time ts2)))
5794 (while (< (setq day1 (1+ day1)) day2) 6318 (while (< (setq day1 (1+ day1)) day2)
5795 (or (memq day1 dates) (push day1 dates))))) 6319 (or (memq day1 dates) (push day1 dates)))))
5796 (sort dates '<)))) 6320 (setq dates (sort dates '<))
6321 (when empty
6322 (while (setq day (pop dates))
6323 (setq day2 (car dates))
6324 (push day dates1)
6325 (when (and day2 empty)
6326 (if (or (eq empty t)
6327 (and (numberp empty) (<= (- day2 day) empty)))
6328 (while (< (setq day (1+ day)) day2)
6329 (push (list day) dates1))
6330 (push (cons :omitted (- day2 day)) dates1))))
6331 (setq dates (nreverse dates1)))
6332 dates)))
5797 6333
5798;;;###autoload 6334;;;###autoload
5799(defun org-diary (&rest args) 6335(defun org-diary (&rest args)
@@ -5977,27 +6513,32 @@ the documentation of `org-diary'."
5977 "\\)\\>") 6513 "\\)\\>")
5978 org-not-done-regexp) 6514 org-not-done-regexp)
5979 "[^\n\r]*\\)")) 6515 "[^\n\r]*\\)"))
6516 (sched-re (concat ".*\n?.*?" org-scheduled-time-regexp))
5980 marker priority category tags 6517 marker priority category tags
5981 ee txt) 6518 ee txt)
5982 (goto-char (point-min)) 6519 (goto-char (point-min))
5983 (while (re-search-forward regexp nil t) 6520 (while (re-search-forward regexp nil t)
5984 (goto-char (match-beginning 1)) 6521 (when (not (and org-agenda-todo-ignore-scheduled
5985 (setq marker (org-agenda-new-marker (1+ (match-beginning 0))) 6522 (save-match-data (looking-at sched-re))))
5986 category (org-get-category) 6523 (goto-char (match-beginning 1))
5987 tags (org-get-tags-at (point)) 6524 (setq marker (org-agenda-new-marker (1+ (match-beginning 0)))
5988 txt (org-format-agenda-item "" (match-string 1) category tags) 6525 category (org-get-category)
5989 priority 6526 tags (org-get-tags-at (point))
5990 (+ (org-get-priority txt) 6527 txt (org-format-agenda-item "" (match-string 1) category tags)
5991 (if org-todo-kwd-priority-p 6528 priority
5992 (- org-todo-kwd-max-priority -2 6529 (+ (org-get-priority txt)
5993 (length 6530 (if org-todo-kwd-priority-p
5994 (member (match-string 2) org-todo-keywords))) 6531 (- org-todo-kwd-max-priority -2
5995 1))) 6532 (length
5996 (org-add-props txt props 6533 (member (match-string 2) org-todo-keywords)))
5997 'org-marker marker 'org-hd-marker marker 6534 1)))
5998 'priority priority 'category category) 6535 (org-add-props txt props
5999 (push txt ee) 6536 'org-marker marker 'org-hd-marker marker
6000 (goto-char (match-end 1))) 6537 'priority priority 'category category)
6538 (push txt ee))
6539 (if org-agenda-todo-list-sublevels
6540 (goto-char (match-end 1))
6541 (org-end-of-subtree 'invisible)))
6001 (nreverse ee))) 6542 (nreverse ee)))
6002 6543
6003(defconst org-agenda-no-heading-message 6544(defconst org-agenda-no-heading-message
@@ -6133,7 +6674,7 @@ the documentation of `org-diary'."
6133 (todayp (equal date (calendar-current-date))) ; DATE bound by calendar 6674 (todayp (equal date (calendar-current-date))) ; DATE bound by calendar
6134 (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar 6675 (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
6135 d2 diff pos pos1 category tags 6676 d2 diff pos pos1 category tags
6136 ee txt head) 6677 ee txt head face)
6137 (goto-char (point-min)) 6678 (goto-char (point-min))
6138 (while (re-search-forward regexp nil t) 6679 (while (re-search-forward regexp nil t)
6139 (setq pos (1- (match-beginning 1)) 6680 (setq pos (1- (match-beginning 1))
@@ -6160,20 +6701,16 @@ the documentation of `org-diary'."
6160 (setq txt (org-format-agenda-item 6701 (setq txt (org-format-agenda-item
6161 (format "In %3d d.: " diff) head category tags)))) 6702 (format "In %3d d.: " diff) head category tags))))
6162 (setq txt org-agenda-no-heading-message)) 6703 (setq txt org-agenda-no-heading-message))
6163 (when txt 6704 (when txt
6705 (setq face (cond ((<= diff 0) 'org-warning)
6706 ((<= diff 5) 'org-upcoming-deadline)
6707 (t nil)))
6164 (org-add-props txt props 6708 (org-add-props txt props
6165 'org-marker (org-agenda-new-marker pos) 6709 'org-marker (org-agenda-new-marker pos)
6166 'org-hd-marker (org-agenda-new-marker pos1) 6710 'org-hd-marker (org-agenda-new-marker pos1)
6167 'priority (+ (- 10 diff) (org-get-priority txt)) 6711 'priority (+ (- 10 diff) (org-get-priority txt))
6168 'category category 6712 'category category
6169 'face (cond ((<= diff 0) 'org-warning) 6713 'face face 'undone-face face 'done-face 'org-done)
6170 ((<= diff 5) 'org-scheduled-previously)
6171 (t nil))
6172 'undone-face (cond
6173 ((<= diff 0) 'org-warning)
6174 ((<= diff 5) 'org-scheduled-previously)
6175 (t nil))
6176 'done-face 'org-done)
6177 (push txt ee))))) 6714 (push txt ee)))))
6178 ee)) 6715 ee))
6179 6716
@@ -6351,14 +6888,19 @@ only the correctly processes TXT should be returned - this is used by
6351 t)) 6888 t))
6352 (setq txt (replace-match "" nil nil txt)))) 6889 (setq txt (replace-match "" nil nil txt))))
6353 ;; Normalize the time(s) to 24 hour 6890 ;; Normalize the time(s) to 24 hour
6354 (if s1 (setq s1 (org-get-time-of-day s1 'string))) 6891 (if s1 (setq s1 (org-get-time-of-day s1 'string t)))
6355 (if s2 (setq s2 (org-get-time-of-day s2 'string)))) 6892 (if s2 (setq s2 (org-get-time-of-day s2 'string t))))
6356 6893
6357 (when (and (or (eq org-agenda-remove-tags-when-in-prefix t) 6894 (when (string-match "\\([ \t]+\\)\\(:[a-zA-Z_@0-9:]+:\\)[ \t]*$" txt)
6358 (and org-agenda-remove-tags-when-in-prefix 6895 ;; Tags are in the string
6359 org-prefix-has-tag)) 6896 (if (or (eq org-agenda-remove-tags-when-in-prefix t)
6360 (string-match ":[a-zA-Z_@0-9:]+:[ \t]*$" txt)) 6897 (and org-agenda-remove-tags-when-in-prefix
6361 (setq txt (replace-match "" t t txt))) 6898 org-prefix-has-tag))
6899 (setq txt (replace-match "" t t txt))
6900 (setq txt (replace-match
6901 (concat (make-string (max (- 50 (length txt)) 1) ?\ )
6902 (match-string 2 txt))
6903 t t txt))))
6362 6904
6363 ;; Create the final string 6905 ;; Create the final string
6364 (if noprefix 6906 (if noprefix
@@ -6438,7 +6980,7 @@ The resulting form is returned and stored in the variable
6438 (setq vars (nreverse vars)) 6980 (setq vars (nreverse vars))
6439 (setq org-prefix-format-compiled `(format ,s ,@vars)))) 6981 (setq org-prefix-format-compiled `(format ,s ,@vars))))
6440 6982
6441(defun org-get-time-of-day (s &optional string) 6983(defun org-get-time-of-day (s &optional string mod24)
6442 "Check string S for a time of day. 6984 "Check string S for a time of day.
6443If found, return it as a military time number between 0 and 2400. 6985If found, return it as a military time number between 0 and 2400.
6444If not found, return nil. 6986If not found, return nil.
@@ -6451,16 +6993,19 @@ HH:MM."
6451 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) 6993 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
6452 (string-match 6994 (string-match
6453 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s)) 6995 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
6454 (let* ((t0 (+ (* 100 6996 (let* ((h (string-to-number (match-string 1 s)))
6455 (+ (string-to-number (match-string 1 s)) 6997 (m (if (match-end 3) (string-to-number (match-string 3 s)) 0))
6456 (if (and (match-beginning 4) 6998 (ampm (if (match-end 4) (downcase (match-string 4 s))))
6457 (equal (downcase (match-string 4 s)) "pm")) 6999 (am-p (equal ampm "am"))
6458 12 0))) 7000 (h1 (cond ((not ampm) h)
6459 (if (match-beginning 3) 7001 ((= h 12) (if am-p 0 12))
6460 (string-to-number (match-string 3 s)) 7002 (t (+ h (if am-p 0 12)))))
6461 0))) 7003 (h2 (if (and string mod24 (not (and (= m 0) (= h1 24))))
6462 (t1 (concat " " 7004 (mod h1 24) h1))
6463 (if (< t0 100) "0" "") (if (< t0 10) "0" "") 7005 (t0 (+ (* 100 h2) m))
7006 (t1 (concat (if (>= h1 24) "+" " ")
7007 (if (< t0 100) "0" "")
7008 (if (< t0 10) "0" "")
6464 (int-to-string t0)))) 7009 (int-to-string t0))))
6465 (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) 7010 (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))
6466 7011
@@ -6470,7 +7015,7 @@ HH:MM."
6470 (mapconcat 'identity (sort list 'org-entries-lessp) "\n")) 7015 (mapconcat 'identity (sort list 'org-entries-lessp) "\n"))
6471 7016
6472(defun org-agenda-highlight-todo (x) 7017(defun org-agenda-highlight-todo (x)
6473 (let (re) 7018 (let (re pl)
6474 (if (eq x 'line) 7019 (if (eq x 'line)
6475 (save-excursion 7020 (save-excursion
6476 (beginning-of-line 1) 7021 (beginning-of-line 1)
@@ -6479,8 +7024,9 @@ HH:MM."
6479 (and (looking-at (concat "[ \t]*" re)) 7024 (and (looking-at (concat "[ \t]*" re))
6480 (add-text-properties (match-beginning 0) (match-end 0) 7025 (add-text-properties (match-beginning 0) (match-end 0)
6481 '(face org-todo)))) 7026 '(face org-todo))))
6482 (setq re (get-text-property 0 'org-not-done-regexp x)) 7027 (setq re (get-text-property 0 'org-not-done-regexp x)
6483 (and re (string-match re x) 7028 pl (get-text-property 0 'prefix-length x))
7029 (and re (equal (string-match re x pl) pl)
6484 (add-text-properties (match-beginning 0) (match-end 0) 7030 (add-text-properties (match-beginning 0) (match-end 0)
6485 '(face org-todo) x)) 7031 '(face org-todo) x))
6486 x))) 7032 x)))
@@ -6503,7 +7049,7 @@ HH:MM."
6503 7049
6504(defsubst org-cmp-time (a b) 7050(defsubst org-cmp-time (a b)
6505 "Compare the time-of-day values of strings A and B." 7051 "Compare the time-of-day values of strings A and B."
6506 (let* ((def (if org-sort-agenda-notime-is-late 2401 -1)) 7052 (let* ((def (if org-sort-agenda-notime-is-late 9901 -1))
6507 (ta (or (get-text-property 1 'time-of-day a) def)) 7053 (ta (or (get-text-property 1 'time-of-day a) def))
6508 (tb (or (get-text-property 1 'time-of-day b) def))) 7054 (tb (or (get-text-property 1 'time-of-day b) def)))
6509 (cond ((< ta tb) -1) 7055 (cond ((< ta tb) -1)
@@ -6537,7 +7083,8 @@ and by additional input from the age of a schedules or deadline entry."
6537 (interactive) 7083 (interactive)
6538 (let* ((tags (get-text-property (point-at-bol) 'tags))) 7084 (let* ((tags (get-text-property (point-at-bol) 'tags)))
6539 (if tags 7085 (if tags
6540 (message "Tags are :%s:" (mapconcat 'identity tags ":")) 7086 (message "Tags are :%s:"
7087 (org-no-properties (mapconcat 'identity tags ":")))
6541 (message "No tags associated with this line")))) 7088 (message "No tags associated with this line"))))
6542 7089
6543(defun org-agenda-goto (&optional highlight) 7090(defun org-agenda-goto (&optional highlight)
@@ -6723,7 +7270,7 @@ the same tree node, and the headline of the tree node in the Org-mode file."
6723 (beginning-of-line 1))) 7270 (beginning-of-line 1)))
6724 7271
6725(defun org-get-tags-at (&optional pos) 7272(defun org-get-tags-at (&optional pos)
6726 "Get a list of all headline targs applicable at POS. 7273 "Get a list of all headline tags applicable at POS.
6727POS defaults to point. If tags are inherited, the list contains 7274POS defaults to point. If tags are inherited, the list contains
6728the targets in the same sequence as the headlines appear, i.e. 7275the targets in the same sequence as the headlines appear, i.e.
6729the tags of the current headline come last." 7276the tags of the current headline come last."
@@ -6736,7 +7283,9 @@ the tags of the current headline come last."
6736 (condition-case nil 7283 (condition-case nil
6737 (while t 7284 (while t
6738 (if (looking-at "[^\r\n]+?:\\([a-zA-Z_@0-9:]+\\):[ \t]*\\([\n\r]\\|\\'\\)") 7285 (if (looking-at "[^\r\n]+?:\\([a-zA-Z_@0-9:]+\\):[ \t]*\\([\n\r]\\|\\'\\)")
6739 (setq tags (append (org-split-string (match-string 1) ":") tags))) 7286 (setq tags (append (org-split-string
7287 (org-match-string-no-properties 1) ":")
7288 tags)))
6740 (or org-use-tag-inheritance (error "")) 7289 (or org-use-tag-inheritance (error ""))
6741 (org-up-heading-all 1)) 7290 (org-up-heading-all 1))
6742 (error nil)))) 7291 (error nil))))
@@ -6808,6 +7357,40 @@ be used to request time specification in the time stamp."
6808 (org-time-stamp arg) 7357 (org-time-stamp arg)
6809 (message "Time stamp changed to %s" org-last-changed-timestamp)))) 7358 (message "Time stamp changed to %s" org-last-changed-timestamp))))
6810 7359
7360(defun org-agenda-schedule (arg)
7361 "Schedule the item at point."
7362 (interactive "P")
7363 (org-agenda-check-type t 'agenda 'timeline 'todo 'tags)
7364 (org-agenda-check-no-diary)
7365 (let* ((marker (or (get-text-property (point) 'org-marker)
7366 (org-agenda-error)))
7367 (buffer (marker-buffer marker))
7368 (pos (marker-position marker))
7369 (org-insert-labeled-timestamps-at-point nil)
7370 ts)
7371 (with-current-buffer buffer
7372 (widen)
7373 (goto-char pos)
7374 (setq ts (org-schedule))
7375 (message "Item scheduled for %s" ts))))
7376
7377(defun org-agenda-deadline (arg)
7378 "Schedule the item at point."
7379 (interactive "P")
7380 (org-agenda-check-type t 'agenda 'timeline 'todo 'tags)
7381 (org-agenda-check-no-diary)
7382 (let* ((marker (or (get-text-property (point) 'org-marker)
7383 (org-agenda-error)))
7384 (buffer (marker-buffer marker))
7385 (pos (marker-position marker))
7386 (org-insert-labeled-timestamps-at-point nil)
7387 ts)
7388 (with-current-buffer buffer
7389 (widen)
7390 (goto-char pos)
7391 (setq ts (org-deadline))
7392 (message "Deadline for this item set to %s" ts))))
7393
6811(defun org-get-heading () 7394(defun org-get-heading ()
6812 "Return the heading of the current entry, without the stars." 7395 "Return the heading of the current entry, without the stars."
6813 (save-excursion 7396 (save-excursion
@@ -6980,7 +7563,7 @@ are included in the output."
6980 7563
6981 (save-excursion 7564 (save-excursion
6982 (goto-char (point-min)) 7565 (goto-char (point-min))
6983 (when (eq action 'sparse-tree) (hide-sublevels 1)) 7566 (when (eq action 'sparse-tree) (org-overview))
6984 (while (re-search-forward re nil t) 7567 (while (re-search-forward re nil t)
6985 (setq todo (if (match-end 1) (match-string 2)) 7568 (setq todo (if (match-end 1) (match-string 2))
6986 tags (if (match-end 4) (match-string 4))) 7569 tags (if (match-end 4) (match-string 4)))
@@ -7108,6 +7691,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
7108 (with-current-buffer buffer 7691 (with-current-buffer buffer
7109 (unless (eq major-mode 'org-mode) 7692 (unless (eq major-mode 'org-mode)
7110 (error "Agenda file %s is not in `org-mode'" file)) 7693 (error "Agenda file %s is not in `org-mode'" file))
7694 (setq org-category-table (org-get-category-table))
7111 (save-excursion 7695 (save-excursion
7112 (save-restriction 7696 (save-restriction
7113 (if org-respect-restriction 7697 (if org-respect-restriction
@@ -7139,11 +7723,11 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
7139(defun org-set-tags (&optional arg just-align) 7723(defun org-set-tags (&optional arg just-align)
7140 "Set the tags for the current headline. 7724 "Set the tags for the current headline.
7141With prefix ARG, realign all tags in headings in the current buffer." 7725With prefix ARG, realign all tags in headings in the current buffer."
7142 (interactive) 7726 (interactive "P")
7143 (let* (;(inherit (org-get-inherited-tags)) 7727 (let* ((re (concat "^" outline-regexp))
7144 (re (concat "^" outline-regexp))
7145 (col (current-column)) 7728 (col (current-column))
7146 (current (org-get-tags)) 7729 (current (org-get-tags))
7730 table current-tags inherited-tags ; computed below when needed
7147 tags hd empty invis) 7731 tags hd empty invis)
7148 (if arg 7732 (if arg
7149 (save-excursion 7733 (save-excursion
@@ -7153,16 +7737,23 @@ With prefix ARG, realign all tags in headings in the current buffer."
7153 (message "All tags realigned to column %d" org-tags-column)) 7737 (message "All tags realigned to column %d" org-tags-column))
7154 (if just-align 7738 (if just-align
7155 (setq tags current) 7739 (setq tags current)
7156 (setq org-last-tags-completion-table 7740 (setq table (or org-tag-alist (org-get-buffer-tags))
7157 (or (org-get-buffer-tags) 7741 org-last-tags-completion-table table
7158 org-last-tags-completion-table)) 7742 current-tags (org-split-string current ":")
7159 (setq tags 7743 inherited-tags (nreverse
7160 (let ((org-add-colon-after-tag-completion t)) 7744 (nthcdr (length current-tags)
7161 (completing-read "Tags: " 'org-tags-completion-function 7745 (nreverse (org-get-tags-at))))
7162 nil nil current 'org-tags-history))) 7746 tags
7747 (if (or (eq t org-use-fast-tag-selection)
7748 (and org-use-fast-tag-selection
7749 (delq nil (mapcar 'cdr table))))
7750 (org-fast-tag-selection current-tags inherited-tags table)
7751 (let ((org-add-colon-after-tag-completion t))
7752 (completing-read "Tags: " 'org-tags-completion-function
7753 nil nil current 'org-tags-history))))
7163 (while (string-match "[-+&]+" tags) 7754 (while (string-match "[-+&]+" tags)
7164 (setq tags (replace-match ":" t t tags)))) 7755 (setq tags (replace-match ":" t t tags))))
7165 ;; FIXME: still optimize this by not checking when JUST-ALIGN? 7756
7166 (unless (setq empty (string-match "\\`[\t ]*\\'" tags)) 7757 (unless (setq empty (string-match "\\`[\t ]*\\'" tags))
7167 (unless (string-match ":$" tags) (setq tags (concat tags ":"))) 7758 (unless (string-match ":$" tags) (setq tags (concat tags ":")))
7168 (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) 7759 (unless (string-match "^:" tags) (setq tags (concat ":" tags))))
@@ -7188,7 +7779,8 @@ With prefix ARG, realign all tags in headings in the current buffer."
7188 (move-to-column col)))) 7779 (move-to-column col))))
7189 7780
7190(defun org-tags-completion-function (string predicate &optional flag) 7781(defun org-tags-completion-function (string predicate &optional flag)
7191 (let (s1 s2 rtn (ctable org-last-tags-completion-table)) 7782 (let (s1 s2 rtn (ctable org-last-tags-completion-table)
7783 (confirm (lambda (x) (stringp (car x)))))
7192 (if (string-match "^\\(.*[-+:&|]\\)\\([^-+:&|]*\\)$" string) 7784 (if (string-match "^\\(.*[-+:&|]\\)\\([^-+:&|]*\\)$" string)
7193 (setq s1 (match-string 1 string) 7785 (setq s1 (match-string 1 string)
7194 s2 (match-string 2 string)) 7786 s2 (match-string 2 string))
@@ -7196,7 +7788,7 @@ With prefix ARG, realign all tags in headings in the current buffer."
7196 (cond 7788 (cond
7197 ((eq flag nil) 7789 ((eq flag nil)
7198 ;; try completion 7790 ;; try completion
7199 (setq rtn (try-completion s2 ctable)) 7791 (setq rtn (try-completion s2 ctable confirm))
7200 (if (stringp rtn) 7792 (if (stringp rtn)
7201 (concat s1 s2 (substring rtn (length s2)) 7793 (concat s1 s2 (substring rtn (length s2))
7202 (if (and org-add-colon-after-tag-completion 7794 (if (and org-add-colon-after-tag-completion
@@ -7205,13 +7797,133 @@ With prefix ARG, realign all tags in headings in the current buffer."
7205 ) 7797 )
7206 ((eq flag t) 7798 ((eq flag t)
7207 ;; all-completions 7799 ;; all-completions
7208 (all-completions s2 ctable) 7800 (all-completions s2 ctable confirm)
7209 ) 7801 )
7210 ((eq flag 'lambda) 7802 ((eq flag 'lambda)
7211 ;; exact match? 7803 ;; exact match?
7212 (assoc s2 ctable))) 7804 (assoc s2 ctable)))
7213 )) 7805 ))
7214 7806
7807(defun org-fast-tag-insert (kwd tags face &optional end)
7808 "Insert KDW, and the TAGS, the latter with face FACE. Also inser END."
7809 (insert (format "%-12s" (concat kwd ":"))
7810 (org-add-props (mapconcat 'identity tags " ") nil 'face face)
7811 (or end "")))
7812
7813(defun org-fast-tag-selection (current inherited table)
7814 "Fast tag selection with single keys.
7815CURRENT is the current list of tags in the headline, INHERITED is the
7816list of inherited tags, and TABLE is an alist of tags and corresponding keys,
7817possibly with grouping information.
7818If the keys are nil, a-z are automatically assigned.
7819Returns the new tags string, or nil to not change the current settings."
7820 (let* ((maxlen (apply 'max (mapcar
7821 (lambda (x)
7822 (if (stringp (car x)) (string-width (car x)) 0))
7823 table)))
7824 (fwidth (+ maxlen 3 1 3))
7825 (ncol (/ (- (window-width) 4) fwidth))
7826 (i-face 'org-done)
7827 (c-face 'org-tag)
7828 tg cnt e c char c1 c2 ntable tbl rtn
7829 groups ingroup)
7830 (save-window-excursion
7831 (delete-other-windows)
7832 (split-window-vertically)
7833 (switch-to-buffer-other-window (get-buffer-create " *Org tags*"))
7834 (erase-buffer)
7835 (org-fast-tag-insert "Inherited" inherited i-face "\n")
7836 (org-fast-tag-insert "Current" current c-face "\n\n")
7837 (setq tbl table char ?a cnt 0)
7838 (while (setq e (pop tbl))
7839 (cond
7840 ((equal e '(:startgroup))
7841 (push '() groups) (setq ingroup t)
7842 (when (not (= cnt 0))
7843 (setq cnt 0)
7844 (insert "\n"))
7845 (insert "{ "))
7846 ((equal e '(:endgroup))
7847 (setq ingroup nil cnt 0)
7848 (insert "}\n"))
7849 (t
7850 (setq tg (car e) c2 nil)
7851 (if (cdr e)
7852 (setq c (cdr e))
7853 ;; automatically assign a character.
7854 (setq c1 (string-to-char
7855 (downcase (substring
7856 tg (if (= (string-to-char tg) ?@) 1 0)))))
7857 (if (or (rassoc c1 ntable) (rassoc c1 table))
7858 (while (or (rassoc char ntable) (rassoc char table))
7859 (setq char (1+ char)))
7860 (setq c2 c1))
7861 (setq c (or c2 char)))
7862 (if ingroup (push tg (car groups)))
7863 (setq tg (org-add-props tg nil 'face
7864 (cond
7865 ((member tg current) c-face)
7866 ((member tg inherited) i-face)
7867 (t nil))))
7868 (if (and (= cnt 0) (not ingroup)) (insert " "))
7869 (insert "[" c "] " tg (make-string
7870 (- fwidth 4 (length tg)) ?\ ))
7871 (push (cons tg c) ntable)
7872 (when (= (setq cnt (1+ cnt)) ncol)
7873 (insert "\n")
7874 (if ingroup (insert " "))
7875 (setq cnt 0)))))
7876 (setq ntable (nreverse ntable))
7877 (insert "\n")
7878 (goto-char (point-min))
7879 (if (fboundp 'fit-window-to-buffer) (fit-window-to-buffer))
7880 (setq rtn
7881 (catch 'exit
7882 (while t
7883 (message "[key]:Toggle SPC: clear current RET accept%s"
7884 (if groups " [!] ignore goups" ""))
7885 (setq c (read-char-exclusive))
7886 (cond
7887 ((= c ?\r) (throw 'exit t))
7888 ((= c ?!)
7889 (setq groups nil)
7890 (goto-char (point-min))
7891 (while (re-search-forward "[{}]" nil t) (replace-match " ")))
7892 ((or (= c ?\C-g)
7893 (and (= c ?q) (not (rassoc c ntable))))
7894 (setq quit-flag t))
7895 ((= c ?\ ) (setq current nil))
7896 ((setq e (rassoc c ntable) tg (car e))
7897 (if (member tg current)
7898 (setq current (delete tg current))
7899 (loop for g in groups do
7900 (if (member tg g)
7901 (mapcar (lambda (x)
7902 (setq current (delete x current)))
7903 g)))
7904 (setq current (cons tg current)))))
7905 ;; Create a sorted list
7906 (setq current
7907 (sort current
7908 (lambda (a b)
7909 (assoc b (cdr (memq (assoc a ntable) ntable))))))
7910 (goto-char (point-min))
7911 (beginning-of-line 2)
7912 (delete-region (point) (point-at-eol))
7913 (org-fast-tag-insert "Current" current c-face)
7914 (while (re-search-forward "\\[.\\] \\([a-zA-Z0-9_@]+\\)" nil t)
7915 (setq tg (match-string 1))
7916 (add-text-properties (match-beginning 1) (match-end 1)
7917 (list 'face
7918 (cond
7919 ((member tg current) c-face)
7920 ((member tg inherited) i-face)
7921 (t nil)))))
7922 (goto-char (point-min)))))
7923 (if rtn
7924 (mapconcat 'identity current ":")
7925 nil))))
7926
7215(defun org-get-tags () 7927(defun org-get-tags ()
7216 "Get the TAGS string in the current headline." 7928 "Get the TAGS string in the current headline."
7217 (unless (org-on-heading-p) 7929 (unless (org-on-heading-p)
@@ -7234,6 +7946,50 @@ With prefix ARG, realign all tags in headings in the current buffer."
7234 7946
7235;;; Link Stuff 7947;;; Link Stuff
7236 7948
7949(defvar org-create-file-search-functions nil
7950 "List of functions to construct the right search string for a file link.
7951These functions are called in turn with point at the location to
7952which the link should point.
7953
7954A function in the hook should first test if it would like to
7955handle this file type, for example by checking the major-mode or
7956the file extension. If it decides not to handle this file, it
7957should just return nil to give other functions a chance. If it
7958does handle the file, it must return the search string to be used
7959when following the link. The search string will be part of the
7960file link, given after a double colon, and `org-open-at-point'
7961will automatically search for it. If special measures must be
7962taken to make the search successful, another function should be
7963added to the companion hook `org-execute-file-search-functions',
7964which see.
7965
7966A function in this hook may also use `setq' to set the variable
7967`description' to provide a suggestion for the descriptive text to
7968be used for this link when it gets inserted into an Org-mode
7969buffer with \\[org-insert-link].")
7970
7971(defvar org-execute-file-search-functions nil
7972 "List of functions to execute a file search triggered by a link.
7973
7974Functions added to this hook must accept a single argument, the
7975search string that was part of the file link, the part after the
7976double colon. The function must first check if it would like to
7977handle this search, for example by checking the major-mode or the
7978file extension. If it decides not to handle this search, it
7979should just return nil to give other functions a chance. If it
7980does handle the search, it must return a non-nil value to keep
7981other functions from trying.
7982
7983Each function can access the current prefix argument through the
7984variable `current-prefix-argument'. Note that a single prefix is
7985used to force opening a link in Emacs, so it may be good to only
7986use a numeric or double prefix to guide the search function.
7987
7988In case this is needed, a function in this hook can also restore
7989the window configuration before `org-open-at-point' was called using:
7990
7991 (set-window-configuration org-window-config-before-follow-link)")
7992
7237(defun org-find-file-at-mouse (ev) 7993(defun org-find-file-at-mouse (ev)
7238 "Open file link or URL at mouse." 7994 "Open file link or URL at mouse."
7239 (interactive "e") 7995 (interactive "e")
@@ -7246,6 +8002,10 @@ With prefix ARG, realign all tags in headings in the current buffer."
7246 (mouse-set-point ev) 8002 (mouse-set-point ev)
7247 (org-open-at-point)) 8003 (org-open-at-point))
7248 8004
8005(defvar org-window-config-before-follow-link nil
8006 "The window configuration before following a link.
8007This is saved in case the need arises to restore it.")
8008
7249(defun org-open-at-point (&optional in-emacs) 8009(defun org-open-at-point (&optional in-emacs)
7250 "Open link at or after point. 8010 "Open link at or after point.
7251If there is no link at point, this function will search forward up to 8011If there is no link at point, this function will search forward up to
@@ -7253,6 +8013,7 @@ the end of the current subtree.
7253Normally, files will be opened by an appropriate application. If the 8013Normally, files will be opened by an appropriate application. If the
7254optional argument IN-EMACS is non-nil, Emacs will visit the file." 8014optional argument IN-EMACS is non-nil, Emacs will visit the file."
7255 (interactive "P") 8015 (interactive "P")
8016 (setq org-window-config-before-follow-link (current-window-configuration))
7256 (org-remove-occur-highlights nil nil t) 8017 (org-remove-occur-highlights nil nil t)
7257 (if (org-at-timestamp-p) 8018 (if (org-at-timestamp-p)
7258 (org-agenda-list nil (time-to-days (org-time-string-to-time 8019 (org-agenda-list nil (time-to-days (org-time-string-to-time
@@ -7336,7 +8097,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
7336 (t nil)))) 8097 (t nil))))
7337 8098
7338 ((string= type "file") 8099 ((string= type "file")
7339 (if (string-match "::?\\([0-9]+\\)\\'" path) ;; second : optional 8100 (if (string-match "::\\([0-9]+\\)\\'" path)
7340 (setq line (string-to-number (match-string 1 path)) 8101 (setq line (string-to-number (match-string 1 path))
7341 path (substring path 0 (match-beginning 0))) 8102 path (substring path 0 (match-beginning 0)))
7342 (if (string-match "::\\(.+\\)\\'" path) 8103 (if (string-match "::\\(.+\\)\\'" path)
@@ -7350,6 +8111,9 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
7350 ((string= type "bbdb") 8111 ((string= type "bbdb")
7351 (org-follow-bbdb-link path)) 8112 (org-follow-bbdb-link path))
7352 8113
8114 ((string= type "info")
8115 (org-follow-info-link path))
8116
7353 ((string= type "gnus") 8117 ((string= type "gnus")
7354 (let (group article) 8118 (let (group article)
7355 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) 8119 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
@@ -7397,8 +8161,8 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
7397 (setq cmd (replace-match "<" t t cmd))) 8161 (setq cmd (replace-match "<" t t cmd)))
7398 (while (string-match "@}" cmd) 8162 (while (string-match "@}" cmd)
7399 (setq cmd (replace-match ">" t t cmd))) 8163 (setq cmd (replace-match ">" t t cmd)))
7400 (if (or (not org-confirm-shell-links) 8164 (if (or (not org-confirm-shell-link-function)
7401 (funcall org-confirm-shell-links 8165 (funcall org-confirm-shell-link-function
7402 (format "Execute \"%s\" in shell? " 8166 (format "Execute \"%s\" in shell? "
7403 (org-add-props cmd nil 8167 (org-add-props cmd nil
7404 'face 'org-warning)))) 8168 'face 'org-warning))))
@@ -7407,6 +8171,16 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
7407 (shell-command cmd)) 8171 (shell-command cmd))
7408 (error "Abort")))) 8172 (error "Abort"))))
7409 8173
8174 ((string= type "elisp")
8175 (let ((cmd path))
8176 (if (or (not org-confirm-elisp-link-function)
8177 (funcall org-confirm-elisp-link-function
8178 (format "Execute \"%s\" as elisp? "
8179 (org-add-props cmd nil
8180 'face 'org-warning))))
8181 (message "%s => %s" cmd (eval (read cmd)))
8182 (error "Abort"))))
8183
7410 (t 8184 (t
7411 (browse-url-at-point)))))) 8185 (browse-url-at-point))))))
7412 8186
@@ -7423,73 +8197,77 @@ in all files."
7423 (pos (point)) 8197 (pos (point))
7424 (pre "") (post "") 8198 (pre "") (post "")
7425 words re0 re1 re2 re3 re4 re5 re2a reall camel) 8199 words re0 re1 re2 re3 re4 re5 re2a reall camel)
7426 (cond ((save-excursion 8200 (cond
7427 (goto-char (point-min)) 8201 ;; First check if there are any special
7428 (and 8202 ((run-hook-with-args-until-success 'org-execute-file-search-functions s))
7429 (re-search-forward 8203 ;; Now try the builtin stuff
7430 (concat "<<" (regexp-quote s0) ">>") nil t) 8204 ((save-excursion
7431 (setq pos (match-beginning 0)))) 8205 (goto-char (point-min))
7432 ;; There is an exact target for this 8206 (and
7433 (goto-char pos)) 8207 (re-search-forward
7434 ((string-match "^/\\(.*\\)/$" s) 8208 (concat "<<" (regexp-quote s0) ">>") nil t)
7435 ;; A regular expression 8209 (setq pos (match-beginning 0))))
7436 (cond 8210 ;; There is an exact target for this
7437 ((eq major-mode 'org-mode) 8211 (goto-char pos))
7438 (org-occur (match-string 1 s))) 8212 ((string-match "^/\\(.*\\)/$" s)
7439 ;;((eq major-mode 'dired-mode) 8213 ;; A regular expression
7440 ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *"))) 8214 (cond
7441 (t (org-do-occur (match-string 1 s))))) 8215 ((eq major-mode 'org-mode)
7442 ((or (setq camel (string-match (concat "^" org-camel-regexp "$") s)) 8216 (org-occur (match-string 1 s)))
7443 t) 8217 ;;((eq major-mode 'dired-mode)
7444 ;; A camel or a normal search string 8218 ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *")))
7445 (when (equal (string-to-char s) ?*) 8219 (t (org-do-occur (match-string 1 s)))))
7446 ;; Anchor on headlines, post may include tags. 8220 ((or (setq camel (string-match (concat "^" org-camel-regexp "$") s))
7447 (setq pre "^\\*+[ \t]*\\(\\sw+\\)?[ \t]*" 8221 t)
7448 post "[ \t]*\\([ \t]+:[a-zA-Z_@0-9:+]:[ \t]*\\)?$" 8222 ;; A camel or a normal search string
7449 s (substring s 1))) 8223 (when (equal (string-to-char s) ?*)
7450 (remove-text-properties 8224 ;; Anchor on headlines, post may include tags.
7451 0 (length s) 8225 (setq pre "^\\*+[ \t]*\\(?:\\sw+\\)?[ \t]*"
7452 '(face nil mouse-face nil keymap nil fontified nil) s) 8226 post "[ \t]*\\(?:[ \t]+:[a-zA-Z_@0-9:+]:[ \t]*\\)?$"
7453 ;; Make a series of regular expressions to find a match 8227 s (substring s 1)))
7454 (setq words 8228 (remove-text-properties
7455 (if camel 8229 0 (length s)
7456 (org-camel-to-words s) 8230 '(face nil mouse-face nil keymap nil fontified nil) s)
7457 (org-split-string s "[ \n\r\t]+")) 8231 ;; Make a series of regular expressions to find a match
7458 re0 (concat "<<" (regexp-quote s0) ">>") 8232 (setq words
7459 re2 (concat "\\<" (mapconcat 'downcase words "[ \t]+") "\\>") 8233 (if camel
7460 re2a (concat "\\<" (mapconcat 'downcase words "[ \t\r\n]+") "\\>") 8234 (org-camel-to-words s)
7461 re4 (concat "\\<" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\>") 8235 (org-split-string s "[ \n\r\t]+"))
7462 re1 (concat pre re2 post) 8236 re0 (concat "\\(<<" (regexp-quote s0) ">>\\)")
7463 re3 (concat pre re4 post) 8237 re2 (concat "[ \t\r\n]\\(" (mapconcat 'downcase words "[ \t]+") "\\)[ \t\r\n]")
7464 re5 (concat pre ".*" re4) 8238 re2a (concat "[ \t\r\n]\\(" (mapconcat 'downcase words "[ \t\r\n]+") "\\)[ \t\r\n]")
7465 re2 (concat pre re2) 8239 re4 (concat "[^a-zA-Z_]\\(" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]")
7466 re2a (concat pre re2a) 8240 re1 (concat pre re2 post)
7467 re4 (concat pre re4) 8241 re3 (concat pre re4 post)
7468 reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2 8242 re5 (concat pre ".*" re4)
7469 "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\(" 8243 re2 (concat pre re2)
7470 re5 "\\)" 8244 re2a (concat pre re2a)
7471 )) 8245 re4 (concat pre re4)
7472 (cond 8246 reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2
7473 ((eq type 'org-occur) (org-occur reall)) 8247 "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\("
7474 ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup)) 8248 re5 "\\)"
7475 (t (goto-char (point-min)) 8249 ))
7476 (if (or (org-search-not-link re0 nil t) 8250 (cond
7477 (org-search-not-link re1 nil t) 8251 ((eq type 'org-occur) (org-occur reall))
7478 (org-search-not-link re2 nil t) 8252 ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup))
7479 (org-search-not-link re2a nil t) 8253 (t (goto-char (point-min))
7480 (org-search-not-link re3 nil t) 8254 (if (or (org-search-not-link re0 nil t)
7481 (org-search-not-link re4 nil t) 8255 (org-search-not-link re1 nil t)
7482 (org-search-not-link re5 nil t) 8256 (org-search-not-link re2 nil t)
7483 ) 8257 (org-search-not-link re2a nil t)
7484 (goto-char (match-beginning 0)) 8258 (org-search-not-link re3 nil t)
7485 (goto-char pos) 8259 (org-search-not-link re4 nil t)
7486 (error "No match"))))) 8260 (org-search-not-link re5 nil t)
7487 (t 8261 )
7488 ;; Normal string-search 8262 (goto-char (match-beginning 1))
7489 (goto-char (point-min)) 8263 (goto-char pos)
7490 (if (search-forward s nil t) 8264 (error "No match")))))
7491 (goto-char (match-beginning 0)) 8265 (t
7492 (error "No match")))) 8266 ;; Normal string-search
8267 (goto-char (point-min))
8268 (if (search-forward s nil t)
8269 (goto-char (match-beginning 0))
8270 (error "No match"))))
7493 (and (eq major-mode 'org-mode) (org-show-hierarchy-above)))) 8271 (and (eq major-mode 'org-mode) (org-show-hierarchy-above))))
7494 8272
7495(defun org-search-not-link (&rest args) 8273(defun org-search-not-link (&rest args)
@@ -7609,6 +8387,18 @@ onto the ring."
7609 (delete-window (get-buffer-window "*BBDB*")) 8387 (delete-window (get-buffer-window "*BBDB*"))
7610 (error "No matching BBDB record"))))) 8388 (error "No matching BBDB record")))))
7611 8389
8390
8391(defun org-follow-info-link (name)
8392 "Follow an info file & node link to NAME."
8393 (if (or (string-match "\\(.*\\)::?\\(.*\\)" name)
8394 (string-match "\\(.*\\)" name))
8395 (progn
8396 (require 'info)
8397 (if (match-string 2 name) ; If there isn't a node, choose "Top"
8398 (Info-find-node (match-string 1 name) (match-string 2 name))
8399 (Info-find-node (match-string 1 name) "Top")))
8400 (message (concat "Could not open: " name))))
8401
7612(defun org-follow-gnus-link (&optional group article) 8402(defun org-follow-gnus-link (&optional group article)
7613 "Follow a Gnus link to GROUP and ARTICLE." 8403 "Follow a Gnus link to GROUP and ARTICLE."
7614 (require 'gnus) 8404 (require 'gnus)
@@ -7792,6 +8582,61 @@ folders."
7792 (kill-this-buffer) 8582 (kill-this-buffer)
7793 (error "Message not found")))) 8583 (error "Message not found"))))
7794 8584
8585;; BibTeX links
8586
8587;; Use the custom search meachnism to construct and use search strings for
8588;; file links to BibTeX database entries.
8589
8590(defun org-create-file-search-in-bibtex ()
8591 "Create the search string and description for a BibTeX database entry."
8592 (when (eq major-mode 'bibtex-mode)
8593 ;; yes, we want to construct this search string.
8594 ;; Make a good description for this entry, using names, year and the title
8595 ;; Put it into the `description' variable which is dynamically scoped.
8596 (let ((bibtex-autokey-names 1)
8597 (bibtex-autokey-names-stretch 1)
8598 (bibtex-autokey-name-case-convert-function 'identity)
8599 (bibtex-autokey-name-separator " & ")
8600 (bibtex-autokey-additional-names " et al.")
8601 (bibtex-autokey-year-length 4)
8602 (bibtex-autokey-name-year-separator " ")
8603 (bibtex-autokey-titlewords 3)
8604 (bibtex-autokey-titleword-separator " ")
8605 (bibtex-autokey-titleword-case-convert-function 'identity)
8606 (bibtex-autokey-titleword-length 'infty)
8607 (bibtex-autokey-year-title-separator ": "))
8608 (setq description (bibtex-generate-autokey)))
8609 ;; Now parse the entry, get the key and return it.
8610 (save-excursion
8611 (bibtex-beginning-of-entry)
8612 (cdr (assoc "=key=" (bibtex-parse-entry))))))
8613
8614(defun org-execute-file-search-in-bibtex (s)
8615 "Find the link search string S as a key for a database entry."
8616 (when (eq major-mode 'bibtex-mode)
8617 ;; Yes, we want to do the search in this file.
8618 ;; We construct a regexp that searches for "@entrytype{" followed by the key
8619 (goto-char (point-min))
8620 (and (re-search-forward (concat "@[a-zA-Z]+[ \t\n]*{[ \t\n]*"
8621 (regexp-quote s) "[ \t\n]*,") nil t)
8622 (goto-char (match-beginning 0)))
8623 (if (and (match-beginning 0) (equal current-prefix-arg '(16)))
8624 ;; Use double prefix to indicate that any web link should be browsed
8625 (let ((b (current-buffer)) (p (point)))
8626 ;; Restore the window configuration because we just use the web link
8627 (set-window-configuration org-window-config-before-follow-link)
8628 (save-excursion (set-buffer b) (goto-char p)
8629 (bibtex-url)))
8630 (recenter 0)) ; Move entry start to beginning of window
8631 ;; return t to indicate that the search is done.
8632 t))
8633
8634;; Finally add the functions to the right hooks.
8635(add-hook 'org-create-file-search-functions 'org-create-file-search-in-bibtex)
8636(add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex)
8637
8638;; end of Bibtex link setup
8639
7795(defun org-upgrade-old-links (&optional query-description) 8640(defun org-upgrade-old-links (&optional query-description)
7796 "Transfer old <...> style links to new [[...]] style links. 8641 "Transfer old <...> style links to new [[...]] style links.
7797With arg query-description, ask at each match for a description text to use 8642With arg query-description, ask at each match for a description text to use
@@ -7907,7 +8752,7 @@ For some link types, a prefix arg is interpreted:
7907For links to usenet articles, arg negates `org-usenet-links-prefer-google'. 8752For links to usenet articles, arg negates `org-usenet-links-prefer-google'.
7908For file links, arg negates `org-context-in-file-links'." 8753For file links, arg negates `org-context-in-file-links'."
7909 (interactive "P") 8754 (interactive "P")
7910 (let (link cpltxt desc txt (pos (point))) 8755 (let (link cpltxt desc description search txt (pos (point)))
7911 (cond 8756 (cond
7912 8757
7913 ((eq major-mode 'bbdb-mode) 8758 ((eq major-mode 'bbdb-mode)
@@ -7917,6 +8762,13 @@ For file links, arg negates `org-context-in-file-links'."
7917 (bbdb-record-company (bbdb-current-record)))) 8762 (bbdb-record-company (bbdb-current-record))))
7918 link (org-make-link cpltxt))) 8763 link (org-make-link cpltxt)))
7919 8764
8765 ((eq major-mode 'Info-mode)
8766 (setq link (org-make-link "info:"
8767 (file-name-nondirectory Info-current-file)
8768 ":" Info-current-node))
8769 (setq cpltxt (concat (file-name-nondirectory Info-current-file)
8770 ":" Info-current-node)))
8771
7920 ((eq major-mode 'calendar-mode) 8772 ((eq major-mode 'calendar-mode)
7921 (let ((cd (calendar-cursor-to-date))) 8773 (let ((cd (calendar-cursor-to-date)))
7922 (setq link 8774 (setq link
@@ -8020,6 +8872,12 @@ For file links, arg negates `org-context-in-file-links'."
8020 (setq cpltxt w3m-current-url 8872 (setq cpltxt w3m-current-url
8021 link (org-make-link cpltxt))) 8873 link (org-make-link cpltxt)))
8022 8874
8875 ((setq search (run-hook-with-args-until-success
8876 'org-create-file-search-functions))
8877 (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
8878 "::" search))
8879 (setq cpltxt (or description link)))
8880
8023 ((eq major-mode 'org-mode) 8881 ((eq major-mode 'org-mode)
8024 ;; Just link to current headline 8882 ;; Just link to current headline
8025 (setq cpltxt (concat "file:" 8883 (setq cpltxt (concat "file:"
@@ -8039,12 +8897,13 @@ For file links, arg negates `org-context-in-file-links'."
8039 ((org-region-active-p) 8897 ((org-region-active-p)
8040 (buffer-substring (region-beginning) (region-end))) 8898 (buffer-substring (region-beginning) (region-end)))
8041 (t (buffer-substring (point-at-bol) (point-at-eol))))) 8899 (t (buffer-substring (point-at-bol) (point-at-eol)))))
8042 (setq cpltxt 8900 (when (or (null txt) (string-match "\\S-" txt))
8043 (concat cpltxt "::" 8901 (setq cpltxt
8044 (if org-file-link-context-use-camel-case 8902 (concat cpltxt "::"
8045 (org-make-org-heading-camel txt) 8903 (if org-file-link-context-use-camel-case
8046 (org-make-org-heading-search-string txt))) 8904 (org-make-org-heading-camel txt)
8047 desc "NONE"))) 8905 (org-make-org-heading-search-string txt)))
8906 desc "NONE"))))
8048 (if (string-match "::\\'" cpltxt) 8907 (if (string-match "::\\'" cpltxt)
8049 (setq cpltxt (substring cpltxt 0 -2))) 8908 (setq cpltxt (substring cpltxt 0 -2)))
8050 (setq link (org-make-link cpltxt))) 8909 (setq link (org-make-link cpltxt)))
@@ -8058,12 +8917,14 @@ For file links, arg negates `org-context-in-file-links'."
8058 (setq txt (if (org-region-active-p) 8917 (setq txt (if (org-region-active-p)
8059 (buffer-substring (region-beginning) (region-end)) 8918 (buffer-substring (region-beginning) (region-end))
8060 (buffer-substring (point-at-bol) (point-at-eol)))) 8919 (buffer-substring (point-at-bol) (point-at-eol))))
8061 (setq cpltxt 8920 ;; Only use search option if there is some text.
8062 (concat cpltxt "::" 8921 (when (string-match "\\S-" txt)
8063 (if org-file-link-context-use-camel-case 8922 (setq cpltxt
8064 (org-make-org-heading-camel txt) 8923 (concat cpltxt "::"
8065 (org-make-org-heading-search-string txt))) 8924 (if org-file-link-context-use-camel-case
8066 desc "NONE")) 8925 (org-make-org-heading-camel txt)
8926 (org-make-org-heading-search-string txt)))
8927 desc "NONE")))
8067 (setq link (org-make-link cpltxt))) 8928 (setq link (org-make-link cpltxt)))
8068 8929
8069 ((interactive-p) 8930 ((interactive-p)
@@ -8287,16 +9148,39 @@ is in the current directory or below."
8287 ;; URL-like link, normalize the use of angular brackets. 9148 ;; URL-like link, normalize the use of angular brackets.
8288 (setq link (org-make-link (org-remove-angle-brackets link)))) 9149 (setq link (org-make-link (org-remove-angle-brackets link))))
8289 9150
8290 ;; Check if we are linking to the current file. If yes, simplify the link. 9151 ;; Check if we are linking to the current file with a search option
9152 ;; If yes, simplify the link by using only the search option.
8291 (when (string-match "\\<file:\\(.+?\\)::\\([^>]+\\)" link) 9153 (when (string-match "\\<file:\\(.+?\\)::\\([^>]+\\)" link)
8292 (let* ((path (match-string 1 link)) 9154 (let* ((path (match-string 1 link))
8293 (case-fold-search nil) 9155 (case-fold-search nil)
8294 (search (match-string 2 link))) 9156 (search (match-string 2 link)))
8295 (when (save-match-data 9157 (save-match-data
8296 (equal (file-truename buffer-file-name) 9158 (if (equal (file-truename buffer-file-name) (file-truename path))
8297 (file-truename path))) 9159 ;; We are linking to this same file, with a search option
8298 ;; We are linking to this same file, with a search option 9160 (setq link search)))))
8299 (setq link search)))) 9161
9162 ;; Check if we can/should use a relative path. If yes, simplify the link
9163 (when (string-match "\\<file:\\(.*\\)" link)
9164 (let* ((path (match-string 1 link))
9165 (case-fold-search nil))
9166 (cond
9167 ((eq org-link-file-path-type 'absolute)
9168 (setq path (abbreviate-file-name (expand-file-name path))))
9169 ((eq org-link-file-path-type 'noabbrev)
9170 (setq path (expand-file-name path)))
9171 ((eq org-link-file-path-type 'relative)
9172 (setq path (file-relative-name path)))
9173 (t
9174 (save-match-data
9175 (if (string-match (concat "^" (regexp-quote
9176 (file-name-as-directory
9177 (expand-file-name "."))))
9178 (expand-file-name path))
9179 ;; We are linking a file with relative path name.
9180 (setq path (substring (expand-file-name path)
9181 (match-end 0)))))))
9182 (setq link (concat "file:" path))))
9183
8300 (setq desc (read-string "Description: " desc)) 9184 (setq desc (read-string "Description: " desc))
8301 (unless (string-match "\\S-" desc) (setq desc nil)) 9185 (unless (string-match "\\S-" desc) (setq desc nil))
8302 (if remove (apply 'delete-region remove)) 9186 (if remove (apply 'delete-region remove))
@@ -8329,48 +9213,52 @@ RET on headline -> Store as sublevel entry to current headline
8329 9213
8330;;;###autoload 9214;;;###autoload
8331(defun org-remember-apply-template () 9215(defun org-remember-apply-template ()
8332 "Initialize *remember* buffer with template, invode `org-mode'. 9216 "Initialize *remember* buffer with template, invoke `org-mode'.
8333This function should be placed into `remember-mode-hook' and in fact requires 9217This function should be placed into `remember-mode-hook' and in fact requires
8334to be run from that hook to fucntion properly." 9218to be run from that hook to fucntion properly."
8335 (when org-remember-templates 9219 (if org-remember-templates
8336 (let* ((entry (if (= (length org-remember-templates) 1) 9220
8337 (cdar org-remember-templates) 9221 (let* ((entry (if (= (length org-remember-templates) 1)
8338 (message "Select template: %s" 9222 (cdar org-remember-templates)
8339 (mapconcat 9223 (message "Select template: %s"
8340 (lambda (x) (char-to-string (car x))) 9224 (mapconcat
8341 org-remember-templates " ")) 9225 (lambda (x) (char-to-string (car x)))
8342 (cdr (assoc (read-char-exclusive) org-remember-templates)))) 9226 org-remember-templates " "))
8343 (tpl (if (consp (cdr entry)) (cadr entry) (cdr entry))) 9227 (cdr (assoc (read-char-exclusive) org-remember-templates))))
8344 (file (if (consp (cdr entry)) (nth 2 entry))) 9228 (tpl (car entry))
8345 (v-t (format-time-string (car org-time-stamp-formats) (org-current-time))) 9229 (file (if (consp (cdr entry)) (nth 1 entry)))
8346 (v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time))) 9230 (v-t (format-time-string (car org-time-stamp-formats) (org-current-time)))
8347 (v-u (concat "[" (substring v-t 1 -1) "]")) 9231 (v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time)))
8348 (v-U (concat "[" (substring v-T 1 -1) "]")) 9232 (v-u (concat "[" (substring v-t 1 -1) "]"))
8349 (v-a annotation) ; defined in `remember-mode' 9233 (v-U (concat "[" (substring v-T 1 -1) "]"))
8350 (v-i initial) ; defined in `remember-mode' 9234 (v-a annotation) ; defined in `remember-mode'
8351 (v-n user-full-name) 9235 (v-i initial) ; defined in `remember-mode'
8352 ) 9236 (v-n user-full-name)
8353 (unless tpl (setq tpl "") (message "No template") (ding)) 9237 )
8354 (insert tpl) (goto-char (point-min)) 9238 (unless tpl (setq tpl "") (message "No template") (ding))
8355 (while (re-search-forward "%\\([tTuTai]\\)" nil t) 9239 (insert tpl) (goto-char (point-min))
8356 (when (and initial (equal (match-string 0) "%i")) 9240 (while (re-search-forward "%\\([tTuTai]\\)" nil t)
8357 (save-match-data 9241 (when (and initial (equal (match-string 0) "%i"))
8358 (let* ((lead (buffer-substring 9242 (save-match-data
8359 (point-at-bol) (match-beginning 0)))) 9243 (let* ((lead (buffer-substring
8360 (setq v-i (mapconcat 'identity 9244 (point-at-bol) (match-beginning 0))))
9245 (setq v-i (mapconcat 'identity
8361 (org-split-string initial "\n") 9246 (org-split-string initial "\n")
8362 (concat "\n" lead)))))) 9247 (concat "\n" lead))))))
8363 (replace-match 9248 (replace-match
8364 (or (eval (intern (concat "v-" (match-string 1)))) "") 9249 (or (eval (intern (concat "v-" (match-string 1)))) "")
8365 t t)) 9250 t t))
8366 (let ((org-startup-folded nil) 9251 (let ((org-startup-folded nil)
8367 (org-startup-with-deadline-check nil)) 9252 (org-startup-with-deadline-check nil))
8368 (org-mode)) 9253 (org-mode))
8369 (if (and file (string-match "\\S-" file) (not (file-directory-p file))) 9254 (if (and file (string-match "\\S-" file) (not (file-directory-p file)))
8370 (set (make-local-variable 'org-default-notes-file) file)) 9255 (set (make-local-variable 'org-default-notes-file) file))
8371 (goto-char (point-min)) 9256 (goto-char (point-min))
8372 (if (re-search-forward "%\\?" nil t) (replace-match "")) 9257 (if (re-search-forward "%\\?" nil t) (replace-match "")))
8373 (set (make-local-variable 'org-finish-function) 'remember-buffer)))) 9258 (let ((org-startup-folded nil)
9259 (org-startup-with-deadline-check nil))
9260 (org-mode)))
9261 (set (make-local-variable 'org-finish-function) 'remember-buffer))
8374 9262
8375;;;###autoload 9263;;;###autoload
8376(defun org-remember-handler () 9264(defun org-remember-handler ()
@@ -8439,6 +9327,9 @@ See also the variable `org-reverse-note-order'."
8439 (if (not visiting) 9327 (if (not visiting)
8440 (find-file-noselect file)) 9328 (find-file-noselect file))
8441 (with-current-buffer (get-file-buffer file) 9329 (with-current-buffer (get-file-buffer file)
9330 (save-excursion (and (goto-char (point-min))
9331 (not (re-search-forward "^\\* " nil t))
9332 (insert "\n* Notes\n")))
8442 (setq reversed (org-notes-order-reversed-p)) 9333 (setq reversed (org-notes-order-reversed-p))
8443 (save-excursion 9334 (save-excursion
8444 (save-restriction 9335 (save-restriction
@@ -8717,7 +9608,7 @@ This is being used to correctly align a single field after TAB or RET.")
8717 ;; Check if we have links 9608 ;; Check if we have links
8718 (goto-char beg) 9609 (goto-char beg)
8719 (setq links (re-search-forward org-bracket-link-regexp end t)) 9610 (setq links (re-search-forward org-bracket-link-regexp end t))
8720 ;; Make sure the link properties are right FIXME: Can this be optimized???? 9611 ;; Make sure the link properties are right
8721 (when links (goto-char beg) (while (org-activate-bracket-links end))) 9612 (when links (goto-char beg) (while (org-activate-bracket-links end)))
8722 ;; Check if we are narrowing any columns 9613 ;; Check if we are narrowing any columns
8723 (goto-char beg) 9614 (goto-char beg)
@@ -8866,7 +9757,7 @@ With argument TABLE-TYPE, go to the beginning of a table.el-type table."
8866 (if table-type org-table-any-border-regexp 9757 (if table-type org-table-any-border-regexp
8867 org-table-border-regexp) 9758 org-table-border-regexp)
8868 nil t)) 9759 nil t))
8869 (error "Can't find beginning of table") 9760 (progn (goto-char (point-min)) (point))
8870 (goto-char (match-beginning 0)) 9761 (goto-char (match-beginning 0))
8871 (beginning-of-line 2) 9762 (beginning-of-line 2)
8872 (point)))) 9763 (point))))
@@ -8914,7 +9805,7 @@ Optional argument NEW may specify text to replace the current field content."
8914 n (format f s)) 9805 n (format f s))
8915 (if new 9806 (if new
8916 (if (<= (length new) l) ;; FIXME: length -> str-width? 9807 (if (<= (length new) l) ;; FIXME: length -> str-width?
8917 (setq n (format f new t t)) ;; FIXME: t t? 9808 (setq n (format f new))
8918 (setq n (concat new "|") org-table-may-need-update t))) 9809 (setq n (concat new "|") org-table-may-need-update t)))
8919 (or (equal n o) 9810 (or (equal n o)
8920 (let (org-table-may-need-update) 9811 (let (org-table-may-need-update)
@@ -9213,7 +10104,7 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
9213 "Please position cursor in a data line for column operations"))))) 10104 "Please position cursor in a data line for column operations")))))
9214 10105
9215(defun org-table-delete-column () 10106(defun org-table-delete-column ()
9216 "Delete a column into the table." 10107 "Delete a column from the table."
9217 (interactive) 10108 (interactive)
9218 (if (not (org-at-table-p)) 10109 (if (not (org-at-table-p))
9219 (error "Not at a table")) 10110 (error "Not at a table"))
@@ -9352,7 +10243,7 @@ With prefix ARG, insert above the current line."
9352In particular, this does handle wide and invisible characters." 10243In particular, this does handle wide and invisible characters."
9353 (if (string-match "^[ \t]*|-" s) 10244 (if (string-match "^[ \t]*|-" s)
9354 ;; It's a hline, just map the characters 10245 ;; It's a hline, just map the characters
9355 (setq s (mapcar (lambda (x) (if (member x '(?| ?+)) ?| ?\ )) s)) 10246 (setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s ""))
9356 (while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s) 10247 (while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s)
9357 (setq s (replace-match 10248 (setq s (replace-match
9358 (concat "|" (make-string (org-string-width (match-string 1 s)) 10249 (concat "|" (make-string (org-string-width (match-string 1 s))
@@ -9401,7 +10292,7 @@ also in table column 3. The command will prompt for the sorting method
9401 (lambda (a b) (< (car a) (car b))) 10292 (lambda (a b) (< (car a) (car b)))
9402 (lambda (a b) (string< (car a) (car b))))) 10293 (lambda (a b) (string< (car a) (car b)))))
9403 (setq lns (mapcar (lambda(x) (cons (org-trim (substring x bcol ecol)) x)) 10294 (setq lns (mapcar (lambda(x) (cons (org-trim (substring x bcol ecol)) x))
9404 (split-string (buffer-substring beg end) "\n"))) 10295 (org-split-string (buffer-substring beg end) "\n")))
9405 (if numericp 10296 (if numericp
9406 (setq lns (mapcar (lambda(x) 10297 (setq lns (mapcar (lambda(x)
9407 (cons (string-to-number (car x)) (cdr x))) 10298 (cons (string-to-number (car x)) (cdr x)))
@@ -9937,7 +10828,7 @@ the current column, to avoid unnecessary parsing."
9937 "\n"))) 10828 "\n")))
9938 10829
9939(defun org-table-get-stored-formulas () 10830(defun org-table-get-stored-formulas ()
9940 "Return an alist with the t=stored formulas directly after current table." 10831 "Return an alist with the stored formulas directly after current table."
9941 (interactive) 10832 (interactive)
9942 (let (scol eq eq-alist strings string seen) 10833 (let (scol eq eq-alist strings string seen)
9943 (save-excursion 10834 (save-excursion
@@ -10217,7 +11108,7 @@ not overwrite the stored one."
10217 (org-table-get-formula equation (equal arg '(4))))) 11108 (org-table-get-formula equation (equal arg '(4)))))
10218 (n0 (org-table-current-column)) 11109 (n0 (org-table-current-column))
10219 (modes (copy-sequence org-calc-default-modes)) 11110 (modes (copy-sequence org-calc-default-modes))
10220 n form fmt x ev orig c) 11111 n form fmt x ev orig c lispp)
10221 ;; Parse the format string. Since we have a lot of modes, this is 11112 ;; Parse the format string. Since we have a lot of modes, this is
10222 ;; a lot of work. However, I think calc still uses most of the time. 11113 ;; a lot of work. However, I think calc still uses most of the time.
10223 (if (string-match ";" formula) 11114 (if (string-match ";" formula)
@@ -10252,7 +11143,8 @@ not overwrite the stored one."
10252 (lambda (x) (number-to-string (string-to-number x))) 11143 (lambda (x) (number-to-string (string-to-number x)))
10253 fields))) 11144 fields)))
10254 (setq ndown (1- ndown)) 11145 (setq ndown (1- ndown))
10255 (setq form (copy-sequence formula)) 11146 (setq form (copy-sequence formula)
11147 lispp (equal (substring form 0 2) "'("))
10256 ;; Insert the references to fields in same row 11148 ;; Insert the references to fields in same row
10257 (while (string-match "\\$\\([0-9]+\\)?" form) 11149 (while (string-match "\\$\\([0-9]+\\)?" form)
10258 (setq n (if (match-beginning 1) 11150 (setq n (if (match-beginning 1)
@@ -10262,7 +11154,9 @@ not overwrite the stored one."
10262 (unless x (error "Invalid field specifier \"%s\"" 11154 (unless x (error "Invalid field specifier \"%s\""
10263 (match-string 0 form))) 11155 (match-string 0 form)))
10264 (if (equal x "") (setq x "0")) 11156 (if (equal x "") (setq x "0"))
10265 (setq form (replace-match (concat "(" x ")") t t form))) 11157 (setq form (replace-match
11158 (if lispp x (concat "(" x ")"))
11159 t t form)))
10266 ;; Insert ranges in current column 11160 ;; Insert ranges in current column
10267 (while (string-match "\\&[-I0-9]+" form) 11161 (while (string-match "\\&[-I0-9]+" form)
10268 (setq form (replace-match 11162 (setq form (replace-match
@@ -10270,8 +11164,11 @@ not overwrite the stored one."
10270 (org-table-get-vertical-vector (match-string 0 form) 11164 (org-table-get-vertical-vector (match-string 0 form)
10271 nil n0)) 11165 nil n0))
10272 t t form))) 11166 t t form)))
10273 (setq ev (calc-eval (cons form modes) 11167 (if lispp
10274 (if org-table-formula-numbers-only 'num))) 11168 (setq ev (eval (eval (read form)))
11169 ev (if (numberp ev) (number-to-string ev) ev))
11170 (setq ev (calc-eval (cons form modes)
11171 (if org-table-formula-numbers-only 'num))))
10275 11172
10276 (when org-table-formula-debug 11173 (when org-table-formula-debug
10277 (with-output-to-temp-buffer "*Help*" 11174 (with-output-to-temp-buffer "*Help*"
@@ -10827,6 +11724,109 @@ overwritten, and the table is not marked as requiring realignment."
10827 11724
10828(defconst org-level-max 20) 11725(defconst org-level-max 20)
10829 11726
11727(defvar org-export-html-preamble nil
11728 "Preamble, to be inserted just after <body>. Set by publishing functions.")
11729(defvar org-export-html-postamble nil
11730 "Preamble, to be inserted just before </body>. Set by publishing functions.")
11731(defvar org-export-html-auto-preamble t
11732 "Should default preamble be inserted? Set by publishing functions.")
11733(defvar org-export-html-auto-postamble t
11734 "Should default postamble be inserted? Set by publishing functions.")
11735
11736(defconst org-export-plist-vars
11737 '((:language . org-export-default-language)
11738 (:headline-levels . org-export-headline-levels)
11739 (:section-numbers . org-export-with-section-numbers)
11740 (:table-of-contents . org-export-with-toc)
11741 (:emphasize . org-export-with-emphasize)
11742 (:sub-superscript . org-export-with-sub-superscripts)
11743 (:TeX-macros . org-export-with-TeX-macros)
11744 (:fixed-width . org-export-with-fixed-width)
11745 (:timestamps . org-export-with-timestamps)
11746 (:tables . org-export-with-tables)
11747 (:table-auto-headline . org-export-highlight-first-table-line)
11748 (:style . org-export-html-style)
11749 (:convert-org-links . org-export-html-link-org-files-as-html)
11750 (:inline-images . org-export-html-inline-images)
11751 (:expand-quoted-html . org-export-html-expand)
11752 (:timestamp . org-export-html-with-timestamp)
11753 (:publishing-directory . org-export-publishing-directory)
11754 (:preamble . org-export-html-preamble)
11755 (:postamble . org-export-html-postamble)
11756 (:auto-preamble . org-export-html-auto-preamble)
11757 (:auto-postamble . org-export-html-auto-postamble)
11758 (:author . user-full-name)
11759 (:email . user-mail-address)))
11760
11761(defun org-default-export-plist ()
11762 "Return the property list with default settings for the export variables."
11763 (let ((l org-export-plist-vars) rtn e)
11764 (while (setq e (pop l))
11765 (setq rtn (cons (car e) (cons (symbol-value (cdr e)) rtn))))
11766 rtn))
11767
11768(defun org-infile-export-plist ()
11769 "Return the property list with file-local settings for export."
11770 (save-excursion
11771 (goto-char 0)
11772 (let ((re (org-make-options-regexp
11773 '("TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")))
11774 (text nil)
11775 p key val text options)
11776 (while (re-search-forward re nil t)
11777 (setq key (org-match-string-no-properties 1)
11778 val (org-match-string-no-properties 2))
11779 (cond
11780 ((string-equal key "TITLE") (setq p (plist-put p :title val)))
11781 ((string-equal key "AUTHOR")(setq p (plist-put p :author val)))
11782 ((string-equal key "EMAIL") (setq p (plist-put p :email val)))
11783 ((string-equal key "LANGUAGE") (setq p (plist-put p :language val)))
11784 ((string-equal key "TEXT")
11785 (setq text (if text (concat text "\n" val) val)))
11786 ((string-equal key "OPTIONS") (setq options val))))
11787 (setq p (plist-put p :text text))
11788 (when options
11789 (let ((op '(("H" . :headline-levels)
11790 ("num" . :section-numbers)
11791 ("toc" . :table-of-contents)
11792 ("\\n" . :preserve-breaks)
11793 ("@" . :expand-quoted-html)
11794 (":" . :fixed-width)
11795 ("|" . :tables)
11796 ("^" . :sub-superscript)
11797 ("*" . :emphasize)
11798 ("TeX" . :TeX-macros)))
11799 o)
11800 (while (setq o (pop op))
11801 (if (string-match (concat (regexp-quote (car o))
11802 ":\\([^ \t\n\r;,.]*\\)")
11803 options)
11804 (setq p (plist-put p (cdr o)
11805 (car (read-from-string
11806 (match-string 1 options)))))))))
11807 p)))
11808
11809(defun org-combine-plists (&rest plists)
11810 "Create a single property list from all plists in PLISTS.
11811The process starts by copying the last list, and then setting properties
11812from the other lists. Settings in the first list are the most significant
11813ones and overrule settings in the other lists."
11814 (let ((rtn (copy-sequence (pop plists)))
11815 p v ls)
11816 (while plists
11817 (setq ls (pop plists))
11818 (while ls
11819 (setq p (pop ls) v (pop ls))
11820 (setq rtn (plist-put rtn p v))))
11821 rtn))
11822
11823(defun org-export-directory (type plist)
11824 (let* ((val (plist-get plist :publishing-directory))
11825 (dir (if (listp val)
11826 (or (cdr (assoc type val)) ".")
11827 val)))
11828 dir))
11829
10830(defun org-export-find-first-heading-line (list) 11830(defun org-export-find-first-heading-line (list)
10831 "Remove all lines from LIST which are before the first headline." 11831 "Remove all lines from LIST which are before the first headline."
10832 (let ((orig-list list) 11832 (let ((orig-list list)
@@ -10854,7 +11854,10 @@ overwritten, and the table is not marked as requiring realignment."
10854 ;; an ordinary comment line 11854 ;; an ordinary comment line
10855 ) 11855 )
10856 ((and org-export-table-remove-special-lines 11856 ((and org-export-table-remove-special-lines
10857 (string-match "^[ \t]*| *[!_^] *|" line)) 11857 (string-match "^[ \t]*|" line)
11858 (or (string-match "^[ \t]*| *[!_^] *|" line)
11859 (and (string-match "| *<[0-9]+> *|" line)
11860 (not (string-match "| *[^ <|]" line)))))
10858 ;; a special table line that should be removed 11861 ;; a special table line that should be removed
10859 ) 11862 )
10860 (t (setq rtn (cons line rtn))))) 11863 (t (setq rtn (cons line rtn)))))
@@ -10862,9 +11865,6 @@ overwritten, and the table is not marked as requiring realignment."
10862 11865
10863;; ASCII 11866;; ASCII
10864 11867
10865(defconst org-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-)
10866 "Characters for underlining headings in ASCII export.")
10867
10868(defconst org-html-entities 11868(defconst org-html-entities
10869 '(("nbsp") 11869 '(("nbsp")
10870 ("iexcl") 11870 ("iexcl")
@@ -11266,6 +12266,7 @@ is signaled in this case."
11266 (if org-odd-levels-only (1+ (/ n 2)) n)) 12266 (if org-odd-levels-only (1+ (/ n 2)) n))
11267 12267
11268(defvar org-last-level nil) ; dynamically scoped variable 12268(defvar org-last-level nil) ; dynamically scoped variable
12269(defvar org-ascii-current-indentation nil) ; For communication
11269 12270
11270(defun org-export-as-ascii (arg) 12271(defun org-export-as-ascii (arg)
11271 "Export the outline as a pretty ASCII file. 12272 "Export the outline as a pretty ASCII file.
@@ -11274,7 +12275,9 @@ The prefix ARG specifies how many levels of the outline should become
11274underlined headlines. The default is 3." 12275underlined headlines. The default is 3."
11275 (interactive "P") 12276 (interactive "P")
11276 (setq-default org-todo-line-regexp org-todo-line-regexp) 12277 (setq-default org-todo-line-regexp org-todo-line-regexp)
11277 (let* ((region 12278 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
12279 (org-infile-export-plist)))
12280 (region
11278 (buffer-substring 12281 (buffer-substring
11279 (if (org-region-active-p) (region-beginning) (point-min)) 12282 (if (org-region-active-p) (region-beginning) (point-min))
11280 (if (org-region-active-p) (region-end) (point-max)))) 12283 (if (org-region-active-p) (region-end) (point-max))))
@@ -11283,21 +12286,28 @@ underlined headlines. The default is 3."
11283 (org-split-string 12286 (org-split-string
11284 (org-cleaned-string-for-export region) 12287 (org-cleaned-string-for-export region)
11285 "[\r\n]")))) 12288 "[\r\n]"))))
12289 (org-ascii-current-indentation '(0 . 0))
11286 (org-startup-with-deadline-check nil) 12290 (org-startup-with-deadline-check nil)
11287 (level 0) line txt 12291 (level 0) line txt
11288 (umax nil) 12292 (umax nil)
11289 (case-fold-search nil) 12293 (case-fold-search nil)
11290 (filename (concat (file-name-sans-extension buffer-file-name) 12294 (filename (concat (file-name-as-directory
12295 (org-export-directory :ascii opt-plist))
12296 (file-name-sans-extension
12297 (file-name-nondirectory buffer-file-name))
11291 ".txt")) 12298 ".txt"))
11292 (buffer (find-file-noselect filename)) 12299 (buffer (find-file-noselect filename))
11293 (levels-open (make-vector org-level-max nil)) 12300 (levels-open (make-vector org-level-max nil))
12301 (odd org-odd-levels-only)
11294 (date (format-time-string "%Y/%m/%d" (current-time))) 12302 (date (format-time-string "%Y/%m/%d" (current-time)))
11295 (time (format-time-string "%X" (org-current-time))) 12303 (time (format-time-string "%X" (org-current-time)))
11296 (author user-full-name) 12304 (author (plist-get opt-plist :author))
11297 (title (buffer-name)) 12305 (title (or (plist-get opt-plist :title)
12306 (file-name-sans-extension
12307 (file-name-nondirectory buffer-file-name))))
11298 (options nil) 12308 (options nil)
11299 (email user-mail-address) 12309 (email (plist-get opt-plist :email))
11300 (language org-export-default-language) 12310 (language (plist-get opt-plist :language))
11301 (text nil) 12311 (text nil)
11302 (todo nil) 12312 (todo nil)
11303 (lang-words nil)) 12313 (lang-words nil))
@@ -11307,9 +12317,6 @@ underlined headlines. The default is 3."
11307 12317
11308 (find-file-noselect filename) 12318 (find-file-noselect filename)
11309 12319
11310 ;; Search for the export key lines
11311 (org-parse-key-lines)
11312
11313 (setq lang-words (or (assoc language org-export-language-setup) 12320 (setq lang-words (or (assoc language org-export-language-setup)
11314 (assoc "en" org-export-language-setup))) 12321 (assoc "en" org-export-language-setup)))
11315 (if org-export-ascii-show-new-buffer 12322 (if org-export-ascii-show-new-buffer
@@ -11317,7 +12324,13 @@ underlined headlines. The default is 3."
11317 (set-buffer buffer)) 12324 (set-buffer buffer))
11318 (erase-buffer) 12325 (erase-buffer)
11319 (fundamental-mode) 12326 (fundamental-mode)
11320 (if options (org-parse-export-options options)) 12327 ;; create local variables for all options, to make sure all called
12328 ;; functions get the correct information
12329 (mapcar (lambda (x)
12330 (set (make-local-variable (cdr x))
12331 (plist-get opt-plist (car x))))
12332 org-export-plist-vars)
12333 (set (make-local-variable 'org-odd-levels-only) odd)
11321 (setq umax (if arg (prefix-numeric-value arg) 12334 (setq umax (if arg (prefix-numeric-value arg)
11322 org-export-headline-levels)) 12335 org-export-headline-levels))
11323 12336
@@ -11347,7 +12360,8 @@ underlined headlines. The default is 3."
11347 level (org-tr-level level) 12360 level (org-tr-level level)
11348 txt (match-string 3 line) 12361 txt (match-string 3 line)
11349 todo 12362 todo
11350 (or (and (match-beginning 2) 12363 (or (and org-export-mark-todo-in-toc
12364 (match-beginning 2)
11351 (not (equal (match-string 2 line) 12365 (not (equal (match-string 2 line)
11352 org-done-string))) 12366 org-done-string)))
11353 ; TODO, not DONE 12367 ; TODO, not DONE
@@ -11386,10 +12400,24 @@ underlined headlines. The default is 3."
11386 ;; a Headline 12400 ;; a Headline
11387 (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) 12401 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)))
11388 txt (match-string 2 line)) 12402 txt (match-string 2 line))
11389 (org-ascii-level-start level txt umax)) 12403 (org-ascii-level-start level txt umax lines))
11390 (t (insert line "\n")))) 12404 (t
12405 (insert (org-fix-indentation line org-ascii-current-indentation) "\n"))))
11391 (normal-mode) 12406 (normal-mode)
11392 (save-buffer) 12407 (save-buffer)
12408 ;; remove display and invisible chars
12409 (let (beg end s)
12410 (goto-char (point-min))
12411 (while (setq beg (next-single-property-change (point) 'display))
12412 (setq end (next-single-property-change beg 'display))
12413 (delete-region beg end)
12414 (goto-char beg)
12415 (insert "=>"))
12416 (goto-char (point-min))
12417 (while (setq beg (next-single-property-change (point) 'org-cwidth))
12418 (setq end (next-single-property-change beg 'org-cwidth))
12419 (delete-region beg end)
12420 (goto-char beg)))
11393 (goto-char (point-min)))) 12421 (goto-char (point-min))))
11394 12422
11395(defun org-search-todo-below (line lines level) 12423(defun org-search-todo-below (line lines level)
@@ -11409,8 +12437,6 @@ underlined headlines. The default is 3."
11409 (if (<= lv level) (throw 'exit nil)) 12437 (if (<= lv level) (throw 'exit nil))
11410 (if todo (throw 'exit t)))))))) 12438 (if todo (throw 'exit t))))))))
11411 12439
11412;; FIXME: Try to handle <b> and <i> as faces via text properties.
11413;; We could also implement *bold*,/italic/ and _underline_ for ASCII export
11414(defun org-html-expand-for-ascii (line) 12440(defun org-html-expand-for-ascii (line)
11415 "Handle quoted HTML for ASCII export." 12441 "Handle quoted HTML for ASCII export."
11416 (if org-export-html-expand 12442 (if org-export-html-expand
@@ -11428,51 +12454,80 @@ underlined headlines. The default is 3."
11428 (make-string (string-width s) underline) 12454 (make-string (string-width s) underline)
11429 "\n")))) 12455 "\n"))))
11430 12456
11431(defun org-ascii-level-start (level title umax) 12457(defun org-ascii-level-start (level title umax &optional lines)
11432 "Insert a new level in ASCII export." 12458 "Insert a new level in ASCII export."
11433 (let (char) 12459 (let (char (n (- level umax 1)) (ind 0))
11434 (if (> level umax) 12460 (if (> level umax)
11435 (insert (make-string (* 2 (- level umax 1)) ?\ ) "* " title "\n") 12461 (progn
12462 (insert (make-string (* 2 n) ?\ )
12463 (char-to-string (nth (% n (length org-export-ascii-bullets))
12464 org-export-ascii-bullets))
12465 " " title "\n")
12466 ;; find the indentation of the next non-empty line
12467 (catch 'stop
12468 (while lines
12469 (if (string-match "^\\*" (car lines)) (throw 'stop nil))
12470 (if (string-match "^\\([ \t]*\\)\\S-" (car lines))
12471 (throw 'stop (setq ind (org-get-indentation (car lines)))))
12472 (pop lines)))
12473 (setq org-ascii-current-indentation (cons (* 2 (1+ n)) ind)))
11436 (if (or (not (equal (char-before) ?\n)) 12474 (if (or (not (equal (char-before) ?\n))
11437 (not (equal (char-before (1- (point))) ?\n))) 12475 (not (equal (char-before (1- (point))) ?\n)))
11438 (insert "\n")) 12476 (insert "\n"))
11439 (setq char (nth (- umax level) (reverse org-ascii-underline))) 12477 (setq char (nth (- umax level) (reverse org-export-ascii-underline)))
11440 (if org-export-with-section-numbers 12478 (if org-export-with-section-numbers
11441 (setq title (concat (org-section-number level) " " title))) 12479 (setq title (concat (org-section-number level) " " title)))
11442 (insert title "\n" (make-string (string-width title) char) "\n")))) 12480 (insert title "\n" (make-string (string-width title) char) "\n")
11443 12481 (setq org-ascii-current-indentation '(0 . 0)))))
11444(defun org-export-copy-visible () 12482
11445 "Copy the visible part of the buffer to another buffer, for printing. 12483(defun org-export-visible (type arg)
11446Also removes the first line of the buffer if it specifies a mode, 12484 "Create a copy of the visible part of the current buffer, and export it.
11447and all options lines." 12485The copy is created in a temporary buffer and removed after use.
11448 (interactive) 12486TYPE is the final key (as a string) of the `C-c C-x' key sequence that will
11449 (let* ((filename (concat (file-name-sans-extension buffer-file-name) 12487run the export command - in interactive use, the command prompts for this
11450 ".txt")) 12488key. As a special case, if the you type SPC at the prompt, the temporary
11451 (buffer (find-file-noselect filename)) 12489org-mode file will not be removed but presented to you so that you can
11452 (ore (concat 12490continue to use it. The prefix arg ARG is passed through to the exporting
11453 (org-make-options-regexp 12491command."
11454 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" 12492 (interactive
11455 "STARTUP" "ARCHIVE" 12493 (list (progn
11456 "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")) 12494 (message "Export visible: [a]SCII [h]tml [b]rowse HTML [x]OXO [ ]keep buffer")
11457 (if org-noutline-p "\\(\n\\|$\\)" ""))) 12495 (char-to-string (read-char-exclusive)))
12496 current-prefix-arg))
12497 (if (not (member type '("a" "\C-a" "b" "\C-b" "h" "x" " ")))
12498 (error "Invalid export key"))
12499 (let* ((binding (key-binding (concat "\C-c\C-x" type)))
12500 (keepp (equal type " "))
12501 (file buffer-file-name)
12502 (buffer (get-buffer-create "*Org Export Visible*"))
11458 s e) 12503 s e)
11459 (with-current-buffer buffer 12504 (with-current-buffer buffer (erase-buffer))
11460 (erase-buffer)
11461 (text-mode))
11462 (save-excursion 12505 (save-excursion
11463 (setq s (goto-char (point-min))) 12506 (setq s (goto-char (point-min)))
11464 (while (not (= (point) (point-max))) 12507 (while (not (= (point) (point-max)))
11465 (goto-char (org-find-invisible)) 12508 (goto-char (org-find-invisible))
11466 (append-to-buffer buffer s (point)) 12509 (append-to-buffer buffer s (point))
11467 (setq s (goto-char (org-find-visible))))) 12510 (setq s (goto-char (org-find-visible))))
11468 (switch-to-buffer-other-window buffer) 12511 (goto-char (point-min))
11469 (newline) 12512 (unless keepp
11470 (goto-char (point-min)) 12513 ;; Copy all comment lines to the end, to make sure #+ settings are
11471 (if (looking-at ".*-\\*- mode:.*\n") 12514 ;; still available for the second export step. Kind of a hack, but
11472 (replace-match "")) 12515 ;; does do the trick.
11473 (while (re-search-forward ore nil t) 12516 (if (looking-at "#[^\r\n]*")
11474 (replace-match "")) 12517 (append-to-buffer buffer (match-beginning 0) (1+ (match-end 0))))
11475 (goto-char (point-min)))) 12518 (while (re-search-forward "[\n\r]#[^\n\r]*" nil t)
12519 (append-to-buffer buffer (1+ (match-beginning 0))
12520 (min (point-max) (1+ (match-end 0))))))
12521 (set-buffer buffer)
12522 (let ((buffer-file-name file)
12523 (org-inhibit-startup t))
12524 (org-mode)
12525 (show-all)
12526 (unless keepp (funcall binding arg))))
12527 (if (not keepp)
12528 (kill-buffer buffer)
12529 (switch-to-buffer-other-window buffer)
12530 (goto-char (point-min)))))
11476 12531
11477(defun org-find-visible () 12532(defun org-find-visible ()
11478 (if (featurep 'noutline) 12533 (if (featurep 'noutline)
@@ -11491,6 +12546,7 @@ and all options lines."
11491 (skip-chars-forward "^\r") 12546 (skip-chars-forward "^\r")
11492 (point))) 12547 (point)))
11493 12548
12549
11494;; HTML 12550;; HTML
11495 12551
11496(defun org-get-current-options () 12552(defun org-get-current-options ()
@@ -11506,7 +12562,8 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
11506#+CATEGORY: %s 12562#+CATEGORY: %s
11507#+SEQ_TODO: %s 12563#+SEQ_TODO: %s
11508#+TYP_TODO: %s 12564#+TYP_TODO: %s
11509#+STARTUP: %s %s %s %s %s 12565#+STARTUP: %s %s %s %s %s %s
12566#+TAGS: %s
11510#+ARCHIVE: %s 12567#+ARCHIVE: %s
11511" 12568"
11512 (buffer-name) (user-full-name) user-mail-address org-export-default-language 12569 (buffer-name) (user-full-name) user-mail-address org-export-default-language
@@ -11533,6 +12590,8 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
11533 (if org-odd-levels-only "odd" "oddeven") 12590 (if org-odd-levels-only "odd" "oddeven")
11534 (if org-hide-leading-stars "hidestars" "showstars") 12591 (if org-hide-leading-stars "hidestars" "showstars")
11535 (if org-startup-align-all-tables "align" "noalign") 12592 (if org-startup-align-all-tables "align" "noalign")
12593 (if org-log-done "logging" "nologging")
12594 (if org-tag-alist (mapconcat 'car org-tag-alist " ") "")
11536 org-archive-location 12595 org-archive-location
11537 )) 12596 ))
11538 12597
@@ -11606,16 +12665,23 @@ emacs --batch
11606 --visit=MyFile --funcall org-export-as-html-batch" 12665 --visit=MyFile --funcall org-export-as-html-batch"
11607 (org-export-as-html org-export-headline-levels 'hidden)) 12666 (org-export-as-html org-export-headline-levels 'hidden))
11608 12667
11609(defun org-export-as-html (arg &optional hidden) 12668(defun org-export-as-html (arg &optional hidden ext-plist)
11610 "Export the outline as a pretty HTML file. 12669 "Export the outline as a pretty HTML file.
11611If there is an active region, export only the region. 12670If there is an active region, export only the region.
11612The prefix ARG specifies how many levels of the outline should become 12671The prefix ARG specifies how many levels of the outline should become
11613headlines. The default is 3. Lower levels will become bulleted lists." 12672headlines. The default is 3. Lower levels will become bulleted lists.
12673When HIDDEN is non-nil, don't display the HTML buffer.
12674EXT-PLIST is a property list with external parameters overriding
12675org-mode's default settings, but still inferior to file-local settings."
11614 (interactive "P") 12676 (interactive "P")
11615 (setq-default org-todo-line-regexp org-todo-line-regexp) 12677 (setq-default org-todo-line-regexp org-todo-line-regexp)
11616 (setq-default org-deadline-line-regexp org-deadline-line-regexp) 12678 (setq-default org-deadline-line-regexp org-deadline-line-regexp)
11617 (setq-default org-done-string org-done-string) 12679 (setq-default org-done-string org-done-string)
11618 (let* ((style org-export-html-style) 12680 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
12681 ext-plist
12682 (org-infile-export-plist)))
12683
12684 (style (plist-get opt-plist :style))
11619 (odd org-odd-levels-only) 12685 (odd org-odd-levels-only)
11620 (region-p (org-region-active-p)) 12686 (region-p (org-region-active-p))
11621 (region 12687 (region
@@ -11629,30 +12695,34 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11629 (lines (org-export-find-first-heading-line all_lines)) 12695 (lines (org-export-find-first-heading-line all_lines))
11630 (level 0) (line "") (origline "") txt todo 12696 (level 0) (line "") (origline "") txt todo
11631 (umax nil) 12697 (umax nil)
11632 (filename (concat (file-name-sans-extension buffer-file-name) 12698 (filename (concat (file-name-as-directory
11633 ".html")) 12699 (org-export-directory :html opt-plist))
12700 (file-name-sans-extension
12701 (file-name-nondirectory buffer-file-name))
12702 ".html"))
11634 (buffer (find-file-noselect filename)) 12703 (buffer (find-file-noselect filename))
11635 (levels-open (make-vector org-level-max nil)) 12704 (levels-open (make-vector org-level-max nil))
11636 (date (format-time-string "%Y/%m/%d" (current-time))) 12705 (date (format-time-string "%Y/%m/%d" (current-time)))
11637 (time (format-time-string "%X" (org-current-time))) 12706 (time (format-time-string "%X" (org-current-time)))
11638 (author user-full-name) 12707 (author (plist-get opt-plist :author))
11639 (title (buffer-name)) 12708 (title (or (plist-get opt-plist :title)
11640 (options nil) 12709 (file-name-sans-extension
11641 (quote-re (concat "^\\*+[ \t]*" org-quote-string "\\>")) 12710 (file-name-nondirectory buffer-file-name))))
12711 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
12712 (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)"))
11642 (inquote nil) 12713 (inquote nil)
11643 (infixed nil) 12714 (infixed nil)
11644 (in-local-list nil) 12715 (in-local-list nil)
11645 (local-list-num nil) 12716 (local-list-num nil)
11646 (local-list-indent nil) 12717 (local-list-indent nil)
11647 (llt org-plain-list-ordered-item-terminator) 12718 (llt org-plain-list-ordered-item-terminator)
11648 (email user-mail-address) 12719 (email (plist-get opt-plist :email))
11649 (language org-export-default-language) 12720 (language (plist-get opt-plist :language))
11650 (text nil) 12721 (text (plist-get opt-plist :text))
11651 (lang-words nil) 12722 (lang-words nil)
11652 (target-alist nil) tg 12723 (target-alist nil) tg
11653 (head-count 0) cnt 12724 (head-count 0) cnt
11654 (start 0) 12725 (start 0)
11655 ;; FIXME: The following returns always nil under XEmacs
11656 (coding-system (and (fboundp 'coding-system-get) 12726 (coding-system (and (fboundp 'coding-system-get)
11657 (boundp 'buffer-file-coding-system) 12727 (boundp 'buffer-file-coding-system)
11658 buffer-file-coding-system)) 12728 buffer-file-coding-system))
@@ -11663,15 +12733,14 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11663 table-open type 12733 table-open type
11664 table-buffer table-orig-buffer 12734 table-buffer table-orig-buffer
11665 ind start-is-num starter 12735 ind start-is-num starter
11666 rpl path desc desc1 desc2 link 12736 rpl path desc descp desc1 desc2 link
11667 ) 12737 )
11668 (message "Exporting...") 12738 (message "Exporting...")
11669 12739
11670 (setq org-last-level 1) 12740 (setq org-last-level 1)
11671 (org-init-section-numbers) 12741 (org-init-section-numbers)
11672 12742
11673 ;; Search for the export key lines 12743 ;; Get the language-dependent settings
11674 (org-parse-key-lines)
11675 (setq lang-words (or (assoc language org-export-language-setup) 12744 (setq lang-words (or (assoc language org-export-language-setup)
11676 (assoc "en" org-export-language-setup))) 12745 (assoc "en" org-export-language-setup)))
11677 12746
@@ -11683,38 +12752,46 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11683 (fundamental-mode) 12752 (fundamental-mode)
11684 (let ((case-fold-search nil) 12753 (let ((case-fold-search nil)
11685 (org-odd-levels-only odd)) 12754 (org-odd-levels-only odd))
11686 (if options (org-parse-export-options options)) 12755 ;; create local variables for all options, to make sure all called
12756 ;; functions get the correct information
12757 (mapcar (lambda (x)
12758 (set (make-local-variable (cdr x))
12759 (plist-get opt-plist (car x))))
12760 org-export-plist-vars)
11687 (setq umax (if arg (prefix-numeric-value arg) 12761 (setq umax (if arg (prefix-numeric-value arg)
11688 org-export-headline-levels)) 12762 org-export-headline-levels))
11689 12763
11690 ;; File header 12764 ;; File header
11691 (insert (format 12765 (insert (format
11692 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\" 12766 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
11693 \"http://www.w3.org/TR/REC-html40/loose.dtd\"> 12767 \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
11694<html lang=\"%s\"><head> 12768<html xmlns=\"http://www.w3.org/1999/xhtml\"
12769lang=\"%s\" xml:lang=\"%s\">
12770<head>
11695<title>%s</title> 12771<title>%s</title>
11696<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"> 12772<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>
11697<meta name=generator content=\"Org-mode\"> 12773<meta name=\"generator\" content=\"Org-mode\"/>
11698<meta name=generated content=\"%s %s\"> 12774<meta name=\"generated\" content=\"%s %s\"/>
11699<meta name=author content=\"%s\"> 12775<meta name=\"author\" content=\"%s\"/>
11700%s 12776%s
11701</head><body> 12777</head><body>
11702" 12778"
11703 language (org-html-expand title) (or charset "iso-8859-1") 12779 language language (org-html-expand title) (or charset "iso-8859-1")
11704 date time author style)) 12780 date time author style))
11705 (if title (insert (concat "<H1 class=\"title\">" 12781
11706 (org-html-expand title) "</H1>\n"))) 12782
11707 (if author (insert (concat (nth 1 lang-words) ": " author "\n"))) 12783 (insert (or (plist-get opt-plist :preamble) ""))
11708 (if email (insert (concat "<a href=\"mailto:" email "\">&lt;" 12784
11709 email "&gt;</a>\n"))) 12785 (when (plist-get opt-plist :auto-preamble)
11710 (if (or author email) (insert "<br>\n")) 12786 (if title (insert (concat "<h1 class=\"title\">"
11711 (if (and date time) (insert (concat (nth 2 lang-words) ": " 12787 (org-html-expand title) "</h1>\n")))
11712 date " " time "<br>\n"))) 12788
11713 (if text (insert (concat "<p>\n" (org-html-expand text)))) 12789 (if text (insert "<p>\n" (org-html-expand text) "</p>")))
12790
11714 (if org-export-with-toc 12791 (if org-export-with-toc
11715 (progn 12792 (progn
11716 (insert (format "<H2>%s</H2>\n" (nth 3 lang-words))) 12793 (insert (format "<h2>%s</h2>\n" (nth 3 lang-words)))
11717 (insert "<ul>\n") 12794 (insert "<ul>\n<li>")
11718 (setq lines 12795 (setq lines
11719 (mapcar '(lambda (line) 12796 (mapcar '(lambda (line)
11720 (if (string-match org-todo-line-regexp line) 12797 (if (string-match org-todo-line-regexp line)
@@ -11724,9 +12801,11 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11724 level (org-tr-level level) 12801 level (org-tr-level level)
11725 txt (save-match-data 12802 txt (save-match-data
11726 (org-html-expand 12803 (org-html-expand
11727 (match-string 3 line))) 12804 (org-html-cleanup-toc-line
12805 (match-string 3 line))))
11728 todo 12806 todo
11729 (or (and (match-beginning 2) 12807 (or (and org-export-mark-todo-in-toc
12808 (match-beginning 2)
11730 (not (equal (match-string 2 line) 12809 (not (equal (match-string 2 line)
11731 org-done-string))) 12810 org-done-string)))
11732 ; TODO, not DONE 12811 ; TODO, not DONE
@@ -11744,13 +12823,13 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11744 (progn 12823 (progn
11745 (setq cnt (- level org-last-level)) 12824 (setq cnt (- level org-last-level))
11746 (while (>= (setq cnt (1- cnt)) 0) 12825 (while (>= (setq cnt (1- cnt)) 0)
11747 (insert "<ul>")) 12826 (insert "\n<ul>\n<li>"))
11748 (insert "\n"))) 12827 (insert "\n")))
11749 (if (< level org-last-level) 12828 (if (< level org-last-level)
11750 (progn 12829 (progn
11751 (setq cnt (- org-last-level level)) 12830 (setq cnt (- org-last-level level))
11752 (while (>= (setq cnt (1- cnt)) 0) 12831 (while (>= (setq cnt (1- cnt)) 0)
11753 (insert "</ul>")) 12832 (insert "</li>\n</ul>"))
11754 (insert "\n"))) 12833 (insert "\n")))
11755 ;; Check for targets 12834 ;; Check for targets
11756 (while (string-match org-target-regexp line) 12835 (while (string-match org-target-regexp line)
@@ -11766,8 +12845,8 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11766 (insert 12845 (insert
11767 (format 12846 (format
11768 (if todo 12847 (if todo
11769 "<li><a href=\"#sec-%d\"><span class=\"todo\">%s</span></a>\n" 12848 "</li>\n<li><a href=\"#sec-%d\"><span class=\"todo\">%s</span></a>"
11770 "<li><a href=\"#sec-%d\">%s</a>\n") 12849 "</li>\n<li><a href=\"#sec-%d\">%s</a>")
11771 head-count txt)) 12850 head-count txt))
11772 12851
11773 (setq org-last-level level)) 12852 (setq org-last-level level))
@@ -11776,7 +12855,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11776 lines)) 12855 lines))
11777 (while (> org-last-level 0) 12856 (while (> org-last-level 0)
11778 (setq org-last-level (1- org-last-level)) 12857 (setq org-last-level (1- org-last-level))
11779 (insert "</ul>\n")) 12858 (insert "</li>\n</ul>\n"))
11780 )) 12859 ))
11781 (setq head-count 0) 12860 (setq head-count 0)
11782 (org-init-section-numbers) 12861 (org-init-section-numbers)
@@ -11785,7 +12864,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11785 (catch 'nextline 12864 (catch 'nextline
11786 12865
11787 ;; end of quote section? 12866 ;; end of quote section?
11788 (when (and inquote (string-match "^\\*+" line)) 12867 (when (and inquote (string-match "^\\*+" line))
11789 (insert "</pre>\n") 12868 (insert "</pre>\n")
11790 (setq inquote nil)) 12869 (setq inquote nil))
11791 ;; inside a quote section? 12870 ;; inside a quote section?
@@ -11829,8 +12908,11 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11829 "\" class=\"target\">" (match-string 1 line) "@</a> ") 12908 "\" class=\"target\">" (match-string 1 line) "@</a> ")
11830 t t line))))) 12909 t t line)))))
11831 12910
12911 (setq line (org-html-handle-time-stamps line))
12912
11832 ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;" 12913 ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
11833 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>") 12914 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
12915 ;; Also handle sub_superscripts and checkboxes
11834 (setq line (org-html-expand line)) 12916 (setq line (org-html-expand line))
11835 12917
11836 ;; Format the links 12918 ;; Format the links
@@ -11841,7 +12923,9 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11841 (setq path (match-string 3 line)) 12923 (setq path (match-string 3 line))
11842 (setq desc1 (if (match-end 5) (match-string 5 line)) 12924 (setq desc1 (if (match-end 5) (match-string 5 line))
11843 desc2 (if (match-end 2) (concat type ":" path) path) 12925 desc2 (if (match-end 2) (concat type ":" path) path)
12926 descp (and desc1 (not (equal desc1 desc2)))
11844 desc (or desc1 desc2)) 12927 desc (or desc1 desc2))
12928 ;; FIXME: do we need to unescape here somewhere?
11845 (cond 12929 (cond
11846 ((equal type "internal") 12930 ((equal type "internal")
11847 (setq rpl 12931 (setq rpl
@@ -11861,7 +12945,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11861 (save-match-data 12945 (save-match-data
11862 (if (string-match "::\\(.*\\)" filename) 12946 (if (string-match "::\\(.*\\)" filename)
11863 (setq search (match-string 1 filename) 12947 (setq search (match-string 1 filename)
11864 filename (replace-match "" nil nil filename))) 12948 filename (replace-match "" t nil filename)))
11865 (setq file-is-image-p 12949 (setq file-is-image-p
11866 (string-match (org-image-file-name-regexp) filename)) 12950 (string-match (org-image-file-name-regexp) filename))
11867 (setq thefile (if abs-p (expand-file-name filename) filename)) 12951 (setq thefile (if abs-p (expand-file-name filename) filename))
@@ -11877,12 +12961,18 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11877 (not (string-match "^/.*/$" search))) 12961 (not (string-match "^/.*/$" search)))
11878 (setq thefile (concat thefile "#" 12962 (setq thefile (concat thefile "#"
11879 (org-solidify-link-text 12963 (org-solidify-link-text
11880 (org-link-unescape search))))))) 12964 (org-link-unescape search)))))
11881 (setq rpl (if (and org-export-html-inline-images 12965 (when (string-match "^file:" desc)
11882 file-is-image-p) 12966 (setq desc (replace-match "" t t desc))
12967 (if (string-match "\\.org$" desc)
12968 (setq desc (replace-match "" t t desc))))))
12969 (setq rpl (if (and file-is-image-p
12970 (or (eq t org-export-html-inline-images)
12971 (and org-export-html-inline-images
12972 (not descp))))
11883 (concat "<img src=\"" thefile "\"/>") 12973 (concat "<img src=\"" thefile "\"/>")
11884 (concat "<a href=\"" thefile "\">" desc "</a>"))))) 12974 (concat "<a href=\"" thefile "\">" desc "</a>")))))
11885 ((member type '("bbdb" "vm" "wl" "mhe" "rmail" "gnus" "shell")) 12975 ((member type '("bbdb" "vm" "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp"))
11886 (setq rpl (concat "<i>&lt;" type ":" 12976 (setq rpl (concat "<i>&lt;" type ":"
11887 (save-match-data (org-link-unescape path)) 12977 (save-match-data (org-link-unescape path))
11888 "&gt;</i>")))) 12978 "&gt;</i>"))))
@@ -11894,28 +12984,22 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11894 (if (equal (match-string 2 line) org-done-string) 12984 (if (equal (match-string 2 line) org-done-string)
11895 (setq line (replace-match 12985 (setq line (replace-match
11896 "<span class=\"done\">\\2</span>" 12986 "<span class=\"done\">\\2</span>"
11897 nil nil line 2)) 12987 t nil line 2))
11898 (setq line (replace-match "<span class=\"todo\">\\2</span>" 12988 (setq line (replace-match "<span class=\"todo\">\\2</span>"
11899 nil nil line 2)))) 12989 t nil line 2))))
11900 12990
11901 ;; DEADLINES
11902 (if (string-match org-deadline-line-regexp line)
11903 (progn
11904 (if (save-match-data
11905 (string-match "<a href"
11906 (substring line 0 (match-beginning 0))))
11907 nil ; Don't do the replacement - it is inside a link
11908 (setq line (replace-match "<span class=\"deadline\">\\&</span>"
11909 nil nil line 1)))))
11910 (cond 12991 (cond
11911 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) 12992 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line)
11912 ;; This is a headline 12993 ;; This is a headline
11913 (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) 12994 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)))
11914 txt (match-string 2 line)) 12995 txt (match-string 2 line))
12996 (if (string-match quote-re0 txt)
12997 (setq txt (replace-match "" t t txt)))
11915 (if (<= level umax) (setq head-count (+ head-count 1))) 12998 (if (<= level umax) (setq head-count (+ head-count 1)))
11916 (when in-local-list 12999 (when in-local-list
11917 ;; Close any local lists before inserting a new header line 13000 ;; Close any local lists before inserting a new header line
11918 (while local-list-num 13001 (while local-list-num
13002 (org-close-li)
11919 (insert (if (car local-list-num) "</ol>\n" "</ul>")) 13003 (insert (if (car local-list-num) "</ol>\n" "</ul>"))
11920 (pop local-list-num)) 13004 (pop local-list-num))
11921 (setq local-list-indent nil 13005 (setq local-list-indent nil
@@ -11942,19 +13026,21 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11942 (setq table-open nil 13026 (setq table-open nil
11943 table-buffer (nreverse table-buffer) 13027 table-buffer (nreverse table-buffer)
11944 table-orig-buffer (nreverse table-orig-buffer)) 13028 table-orig-buffer (nreverse table-orig-buffer))
13029 (org-close-par-maybe)
11945 (insert (org-format-table-html table-buffer table-orig-buffer)))) 13030 (insert (org-format-table-html table-buffer table-orig-buffer))))
11946 (t 13031 (t
11947 ;; Normal lines 13032 ;; Normal lines
11948 (when (and (string-match 13033 (when (string-match
11949 (cond 13034 (cond
11950 ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+[.)]\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)") 13035 ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
11951 ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+\\.\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)") 13036 ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
11952 ((= llt ?\)) "^\\( \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+)\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)") 13037 ((= llt ?\)) "^\\( \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
11953 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))) 13038 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))
11954 line)) 13039 line)
11955 (setq ind (org-get-string-indentation line) 13040 (setq ind (org-get-string-indentation line)
11956 start-is-num (match-beginning 4) 13041 start-is-num (match-beginning 4)
11957 starter (if (match-beginning 2) (match-string 2 line)) 13042 starter (if (match-beginning 2)
13043 (substring (match-string 2 line) 0 -1))
11958 line (substring line (match-beginning 5))) 13044 line (substring line (match-beginning 5)))
11959 (unless (string-match "[^ \t]" line) 13045 (unless (string-match "[^ \t]" line)
11960 ;; empty line. Pretend indentation is large. 13046 ;; empty line. Pretend indentation is large.
@@ -11963,6 +13049,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11963 (or (and (= ind (car local-list-indent)) 13049 (or (and (= ind (car local-list-indent))
11964 (not starter)) 13050 (not starter))
11965 (< ind (car local-list-indent)))) 13051 (< ind (car local-list-indent))))
13052 (org-close-li)
11966 (insert (if (car local-list-num) "</ol>\n" "</ul>")) 13053 (insert (if (car local-list-num) "</ol>\n" "</ul>"))
11967 (pop local-list-num) (pop local-list-indent) 13054 (pop local-list-num) (pop local-list-indent)
11968 (setq in-local-list local-list-indent)) 13055 (setq in-local-list local-list-indent))
@@ -11971,23 +13058,76 @@ headlines. The default is 3. Lower levels will become bulleted lists."
11971 (or (not in-local-list) 13058 (or (not in-local-list)
11972 (> ind (car local-list-indent)))) 13059 (> ind (car local-list-indent))))
11973 ;; Start new (level of ) list 13060 ;; Start new (level of ) list
13061 (org-close-par-maybe)
11974 (insert (if start-is-num "<ol>\n<li>\n" "<ul>\n<li>\n")) 13062 (insert (if start-is-num "<ol>\n<li>\n" "<ul>\n<li>\n"))
11975 (push start-is-num local-list-num) 13063 (push start-is-num local-list-num)
11976 (push ind local-list-indent) 13064 (push ind local-list-indent)
11977 (setq in-local-list t)) 13065 (setq in-local-list t))
11978 (starter 13066 (starter
11979 ;; continue current list 13067 ;; continue current list
11980 (insert "<li>\n")))) 13068 (org-close-li)
13069 (insert "<li>\n")))
13070 (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line)
13071 (setq line
13072 (replace-match
13073 (if (equal (match-string 1 line) "X")
13074 "<b>[X]</b>"
13075 "<b>[<span style=\"visibility:hidden;\">X</span>]</b>")
13076 t t line))))
13077
11981 ;; Empty lines start a new paragraph. If hand-formatted lists 13078 ;; Empty lines start a new paragraph. If hand-formatted lists
11982 ;; are not fully interpreted, lines starting with "-", "+", "*" 13079 ;; are not fully interpreted, lines starting with "-", "+", "*"
11983 ;; also start a new paragraph. 13080 ;; also start a new paragraph.
11984 (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (insert "<p>")) 13081 (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par))
11985 (insert line (if org-export-preserve-breaks "<br>\n" "\n")))) 13082
11986 )) 13083 ;; Check if the line break needs to be conserved
13084 (cond
13085 ((string-match "\\\\\\\\[ \t]*$" line)
13086 (setq line (replace-match "<br/>" t t line)))
13087 (org-export-preserve-breaks
13088 (setq line (concat line "<br/>"))))
13089
13090 (insert line "\n")))))
13091
13092 ;; Properly close all local lists and other lists
13093 (when inquote (insert "</pre>\n"))
13094 (when in-local-list
13095 ;; Close any local lists before inserting a new header line
13096 (while local-list-num
13097 (org-close-li)
13098 (insert (if (car local-list-num) "</ol>\n" "</ul>\n"))
13099 (pop local-list-num))
13100 (setq local-list-indent nil
13101 in-local-list nil))
13102 (org-html-level-start 1 nil umax
13103 (and org-export-with-toc (<= level umax))
13104 head-count)
13105
13106 (when (plist-get opt-plist :auto-postamble)
13107 (when author
13108 (insert "<p class=\"author\"> "
13109 (nth 1 lang-words) ": " author "\n")
13110 (when email
13111 (insert "<a href=\"mailto:" email "\">&lt;"
13112 email "&gt;</a>\n"))
13113 (insert "</p>\n"))
13114 (when (and date time)
13115 (insert "<p class=\"date\"> "
13116 (nth 2 lang-words) ": "
13117 date " " time "</p>\n")))
13118
11987 (if org-export-html-with-timestamp 13119 (if org-export-html-with-timestamp
11988 (insert org-export-html-html-helper-timestamp)) 13120 (insert org-export-html-html-helper-timestamp))
13121 (insert (or (plist-get opt-plist :postamble) ""))
11989 (insert "</body>\n</html>\n") 13122 (insert "</body>\n</html>\n")
11990 (normal-mode) 13123 (normal-mode)
13124 ;; remove empty paragraphs and lists
13125 (goto-char (point-min))
13126 (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t)
13127 (replace-match ""))
13128 (goto-char (point-min))
13129 (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t)
13130 (replace-match ""))
11991 (save-buffer) 13131 (save-buffer)
11992 (goto-char (point-min))))) 13132 (goto-char (point-min)))))
11993 13133
@@ -12091,7 +13231,7 @@ But it has the disadvantage, that no cell- or row-spanning is allowed."
12091 fields html empty) 13231 fields html empty)
12092 (setq html (concat org-export-html-table-tag "\n")) 13232 (setq html (concat org-export-html-table-tag "\n"))
12093 (while (setq line (pop lines)) 13233 (while (setq line (pop lines))
12094 (setq empty "&nbsp") 13234 (setq empty "&nbsp;")
12095 (catch 'next-line 13235 (catch 'next-line
12096 (if (string-match "^[ \t]*\\+-" line) 13236 (if (string-match "^[ \t]*\\+-" line)
12097 (progn 13237 (progn
@@ -12117,7 +13257,7 @@ But it has the disadvantage, that no cell- or row-spanning is allowed."
12117 (if field-buffer 13257 (if field-buffer
12118 (setq field-buffer (mapcar 13258 (setq field-buffer (mapcar
12119 (lambda (x) 13259 (lambda (x)
12120 (concat x "<br>" (pop fields))) 13260 (concat x "<br/>" (pop fields)))
12121 field-buffer)) 13261 field-buffer))
12122 (setq field-buffer fields)))) 13262 (setq field-buffer fields))))
12123 (setq html (concat html "</table>\n")) 13263 (setq html (concat html "</table>\n"))
@@ -12140,6 +13280,30 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
12140 (set-buffer " org-tmp2 ") 13280 (set-buffer " org-tmp2 ")
12141 (buffer-substring (point-min) (point-max)))) 13281 (buffer-substring (point-min) (point-max))))
12142 13282
13283(defun org-html-handle-time-stamps (s)
13284 "Format time stamps in string S, or remove them."
13285 (let (r b)
13286 (while (string-match org-maybe-keyword-time-regexp s)
13287 (or b (setq b (substring s 0 (match-beginning 0))))
13288 (if (not org-export-with-timestamps)
13289 (setq r (concat r (substring s 0 (match-beginning 0)))
13290 s (substring s (match-end 0)))
13291 (setq r (concat
13292 r (substring s 0 (match-beginning 0))
13293 (if (match-end 1)
13294 (format "@<span class=\"timestamp-kwd\">%s @</span>"
13295 (match-string 1 s)))
13296 (format " @<span class=\"timestamp\">%s@</span>"
13297 (substring (match-string 3 s) 1 -1)))
13298 s (substring s (match-end 0)))))
13299 ;; Line break of line started and ended with time stamp stuff
13300 (if (not r)
13301 s
13302 (setq r (concat r s))
13303 (unless (string-match "\\S-" (concat b s))
13304 (setq r (concat r "@<br/>")))
13305 r)))
13306
12143(defun org-html-protect (s) 13307(defun org-html-protect (s)
12144 ;; convert & to &amp;, < to &lt; and > to &gt; 13308 ;; convert & to &amp;, < to &lt; and > to &gt;
12145 (let ((start 0)) 13309 (let ((start 0))
@@ -12152,6 +13316,14 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
12152 (setq s (replace-match "&gt;" t t s)))) 13316 (setq s (replace-match "&gt;" t t s))))
12153 s) 13317 s)
12154 13318
13319(defun org-html-cleanup-toc-line (s)
13320 "Remove tags and time staps from lines going into the toc."
13321 (if (string-match " +:[a-zA-Z0-9_@:]+: *$" s)
13322 (setq s (replace-match "" t t s)))
13323 (while (string-match org-maybe-keyword-time-regexp s)
13324 (setq s (replace-match "" t t s)))
13325 s)
13326
12155(defun org-html-expand (string) 13327(defun org-html-expand (string)
12156 "Prepare STRING for HTML export. Applies all active conversions. 13328 "Prepare STRING for HTML export. Applies all active conversions.
12157If there are links in the string, don't modify these." 13329If there are links in the string, don't modify these."
@@ -12170,7 +13342,7 @@ If there are links in the string, don't modify these."
12170 (setq s (org-html-protect s)) 13342 (setq s (org-html-protect s))
12171 (if org-export-html-expand 13343 (if org-export-html-expand
12172 (while (string-match "@&lt;\\([^&]*\\)&gt;" s) 13344 (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
12173 (setq s (replace-match "<\\1>" nil nil s)))) 13345 (setq s (replace-match "<\\1>" t nil s))))
12174 (if org-export-with-emphasize 13346 (if org-export-with-emphasize
12175 (setq s (org-export-html-convert-emphasize s))) 13347 (setq s (org-export-html-convert-emphasize s)))
12176 (if org-export-with-sub-superscripts 13348 (if org-export-with-sub-superscripts
@@ -12239,49 +13411,30 @@ stacked delimiters is N. Escaping delimiters is not possible."
12239 (setq string (replace-match "\\1<u>\\3</u>\\4" t nil string))) 13411 (setq string (replace-match "\\1<u>\\3</u>\\4" t nil string)))
12240 string) 13412 string)
12241 13413
12242(defun org-parse-key-lines () 13414(defvar org-par-open nil)
12243 "Find the special key lines with the information for exporters." 13415(defun org-open-par ()
12244 (save-excursion 13416 "Insert <p>, but first close previous paragraph if any."
12245 (goto-char 0) 13417 (org-close-par-maybe)
12246 (let ((re (org-make-options-regexp 13418 (insert "\n<p>")
12247 '("TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) 13419 (setq org-par-open t))
12248 key) 13420(defun org-close-par-maybe ()
12249 (while (re-search-forward re nil t) 13421 "Close paragraph if there is one open."
12250 (setq key (match-string 1)) 13422 (when org-par-open
12251 (cond ((string-equal key "TITLE") 13423 (insert "</p>")
12252 (setq title (match-string 2))) 13424 (setq org-par-open nil)))
12253 ((string-equal key "AUTHOR") 13425(defun org-close-li ()
12254 (setq author (match-string 2))) 13426 "Close <li> if necessary."
12255 ((string-equal key "EMAIL") 13427 (org-close-par-maybe)
12256 (setq email (match-string 2))) 13428 (insert "</li>\n"))
12257 ((string-equal key "LANGUAGE") 13429; (when (save-excursion
12258 (setq language (match-string 2))) 13430; (re-search-backward "</?\\(ul\\|ol\\|li\\|[hH][0-9]\\)>" nil t))
12259 ((string-equal key "TEXT") 13431; (if (member (match-string 0) '("</ul>" "</ol>" "<li>"))
12260 (setq text (concat text "\n" (match-string 2)))) 13432; (insert "</li>"))))
12261 ((string-equal key "OPTIONS")
12262 (setq options (match-string 2))))))))
12263
12264(defun org-parse-export-options (s)
12265 "Parse the export options line."
12266 (let ((op '(("H" . org-export-headline-levels)
12267 ("num" . org-export-with-section-numbers)
12268 ("toc" . org-export-with-toc)
12269 ("\\n" . org-export-preserve-breaks)
12270 ("@" . org-export-html-expand)
12271 (":" . org-export-with-fixed-width)
12272 ("|" . org-export-with-tables)
12273 ("^" . org-export-with-sub-superscripts)
12274 ("*" . org-export-with-emphasize)
12275 ("TeX" . org-export-with-TeX-macros)))
12276 o)
12277 (while (setq o (pop op))
12278 (if (string-match (concat (regexp-quote (car o)) ":\\([^ \t\n\r;,.]*\\)")
12279 s)
12280 (set (make-local-variable (cdr o))
12281 (car (read-from-string (match-string 1 s))))))))
12282 13433
12283(defun org-html-level-start (level title umax with-toc head-count) 13434(defun org-html-level-start (level title umax with-toc head-count)
12284 "Insert a new level in HTML export." 13435 "Insert a new level in HTML export.
13436When TITLE is nil, just close all open levels."
13437 (org-close-par-maybe)
12285 (let ((l (1+ (max level umax)))) 13438 (let ((l (1+ (max level umax))))
12286 (while (<= l org-level-max) 13439 (while (<= l org-level-max)
12287 (if (aref levels-open (1- l)) 13440 (if (aref levels-open (1- l))
@@ -12289,22 +13442,42 @@ stacked delimiters is N. Escaping delimiters is not possible."
12289 (org-html-level-close l) 13442 (org-html-level-close l)
12290 (aset levels-open (1- l) nil))) 13443 (aset levels-open (1- l) nil)))
12291 (setq l (1+ l))) 13444 (setq l (1+ l)))
12292 (if (> level umax) 13445 (when title
12293 (progn 13446 ;; If title is nil, this means this function is called to close
12294 (if (aref levels-open (1- level)) 13447 ;; all levels, so the rest is done only if title is given
12295 (insert "<li>" title "<p>\n") 13448 (when (string-match "\\(:[a-zA-Z0-9_@:]+:\\)[ \t]*$" title)
12296 (aset levels-open (1- level) t) 13449 (setq title (replace-match
12297 (insert "<ul><li>" title "<p>\n"))) 13450 (if org-export-with-tags
12298 (if org-export-with-section-numbers 13451 (save-match-data
12299 (setq title (concat (org-section-number level) " " title))) 13452 (concat
12300 (setq level (+ level 1)) 13453 "&nbsp;&nbsp;&nbsp;<span class=\"tag\">"
12301 (if with-toc 13454 (mapconcat 'identity (org-split-string
12302 (insert (format "\n<H%d><a name=\"sec-%d\">%s</a></H%d>\n" 13455 (match-string 1 title) ":")
12303 level head-count title level)) 13456 "&nbsp;")
12304 (insert (format "\n<H%d>%s</H%d>\n" level title level)))))) 13457 "</span>"))
13458 "")
13459 t t title)))
13460 (if (> level umax)
13461 (progn
13462 (if (aref levels-open (1- level))
13463 (progn
13464 (org-close-li)
13465 (insert "<li>" title "<br/>\n"))
13466 (aset levels-open (1- level) t)
13467 (org-close-par-maybe)
13468 (insert "<ul>\n<li>" title "<br/>\n")))
13469 (if org-export-with-section-numbers
13470 (setq title (concat (org-section-number level) " " title)))
13471 (setq level (+ level 1))
13472 (if with-toc
13473 (insert (format "\n<h%d><a name=\"sec-%d\">%s</a></h%d>\n"
13474 level head-count title level))
13475 (insert (format "\n<h%d>%s</h%d>\n" level title level)))
13476 (org-open-par)))))
12305 13477
12306(defun org-html-level-close (&rest args) 13478(defun org-html-level-close (&rest args)
12307 "Terminate one level in HTML export." 13479 "Terminate one level in HTML export."
13480 (org-close-li)
12308 (insert "</ul>")) 13481 (insert "</ul>"))
12309 13482
12310;; Variable holding the vector with section numbers 13483;; Variable holding the vector with section numbers
@@ -12348,9 +13521,9 @@ When LEVEL is non-nil, increase section numbers on that level."
12348 (setq idx (1+ idx))) 13521 (setq idx (1+ idx)))
12349 (save-match-data 13522 (save-match-data
12350 (if (string-match "\\`\\([@0]\\.\\)+" string) 13523 (if (string-match "\\`\\([@0]\\.\\)+" string)
12351 (setq string (replace-match "" nil nil string))) 13524 (setq string (replace-match "" t nil string)))
12352 (if (string-match "\\(\\.0\\)+\\'" string) 13525 (if (string-match "\\(\\.0\\)+\\'" string)
12353 (setq string (replace-match "" nil nil string)))) 13526 (setq string (replace-match "" t nil string))))
12354 string)) 13527 string))
12355 13528
12356 13529
@@ -12361,12 +13534,6 @@ file, but with extension `.ics'."
12361 (interactive) 13534 (interactive)
12362 (org-export-icalendar nil buffer-file-name)) 13535 (org-export-icalendar nil buffer-file-name))
12363 13536
12364(defun org-export-as-xml ()
12365 "Export current buffer as XOXO XML buffer."
12366 (interactive)
12367 (cond ((eq org-export-xml-type 'xoxo)
12368 (org-export-as-xoxo (current-buffer)))))
12369
12370(defun org-export-as-xoxo-insert-into (buffer &rest output) 13537(defun org-export-as-xoxo-insert-into (buffer &rest output)
12371 (with-current-buffer buffer 13538 (with-current-buffer buffer
12372 (apply 'insert output))) 13539 (apply 'insert output)))
@@ -12380,8 +13547,13 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
12380 ;; Output everything as XOXO 13547 ;; Output everything as XOXO
12381 (with-current-buffer (get-buffer buffer) 13548 (with-current-buffer (get-buffer buffer)
12382 (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. 13549 (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed.
12383 (let* ((filename (concat (file-name-sans-extension buffer-file-name) 13550 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
12384 ".xml")) 13551 (org-infile-export-plist)))
13552 (filename (concat (file-name-as-directory
13553 (org-export-directory :xoxo opt-plist))
13554 (file-name-sans-extension
13555 (file-name-nondirectory buffer-file-name))
13556 ".html"))
12385 (out (find-file-noselect filename)) 13557 (out (find-file-noselect filename))
12386 (last-level 1) 13558 (last-level 1)
12387 (hanging-li nil)) 13559 (hanging-li nil))
@@ -12464,19 +13636,29 @@ The file is stored under the name `org-combined-agenda-icalendar-file'."
12464If COMBINE is non-nil, combine all calendar entries into a single large 13636If COMBINE is non-nil, combine all calendar entries into a single large
12465file and store it under the name `org-combined-agenda-icalendar-file'." 13637file and store it under the name `org-combined-agenda-icalendar-file'."
12466 (save-excursion 13638 (save-excursion
12467 (let* (file ical-file ical-buffer category started org-agenda-new-buffers) 13639 (let* ((dir (org-export-directory
13640 :ical (list :publishing-directory
13641 org-export-publishing-directory)))
13642 file ical-file ical-buffer category started org-agenda-new-buffers)
13643
12468 (when combine 13644 (when combine
12469 (setq ical-file org-combined-agenda-icalendar-file 13645 (setq ical-file
13646 (if (file-name-absolute-p org-combined-agenda-icalendar-file)
13647 org-combined-agenda-icalendar-file
13648 (expand-file-name org-combined-agenda-icalendar-file dir))
12470 ical-buffer (org-get-agenda-file-buffer ical-file)) 13649 ical-buffer (org-get-agenda-file-buffer ical-file))
12471 (set-buffer ical-buffer) (erase-buffer)) 13650 (set-buffer ical-buffer) (erase-buffer))
12472 (while (setq file (pop files)) 13651 (while (setq file (pop files))
12473 (catch 'nextfile 13652 (catch 'nextfile
12474 (org-check-agenda-file file) 13653 (org-check-agenda-file file)
13654 (set-buffer (org-get-agenda-file-buffer file))
12475 (unless combine 13655 (unless combine
12476 (setq ical-file (concat (file-name-sans-extension file) ".ics")) 13656 (setq ical-file (concat (file-name-as-directory dir)
13657 (file-name-sans-extension
13658 (file-name-nondirectory buffer-file-name))
13659 ".ics"))
12477 (setq ical-buffer (org-get-agenda-file-buffer ical-file)) 13660 (setq ical-buffer (org-get-agenda-file-buffer ical-file))
12478 (set-buffer ical-buffer) (erase-buffer)) 13661 (with-current-buffer ical-buffer (erase-buffer)))
12479 (set-buffer (org-get-agenda-file-buffer file))
12480 (setq category (or org-category 13662 (setq category (or org-category
12481 (file-name-sans-extension 13663 (file-name-sans-extension
12482 (file-name-nondirectory buffer-file-name)))) 13664 (file-name-nondirectory buffer-file-name))))
@@ -12611,6 +13793,7 @@ a time), or the day by one (if it does not contain a time)."
12611 13793
12612;; Make `C-c C-x' a prefix key 13794;; Make `C-c C-x' a prefix key
12613(define-key org-mode-map "\C-c\C-x" (make-sparse-keymap)) 13795(define-key org-mode-map "\C-c\C-x" (make-sparse-keymap))
13796(define-key org-mode-map "\C-c\C-e" (make-sparse-keymap))
12614 13797
12615;; TAB key with modifiers 13798;; TAB key with modifiers
12616(define-key org-mode-map "\C-i" 'org-cycle) 13799(define-key org-mode-map "\C-i" 'org-cycle)
@@ -12708,8 +13891,8 @@ a time), or the day by one (if it does not contain a time)."
12708(define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region) 13891(define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region)
12709(define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii) 13892(define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii)
12710(define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii) 13893(define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii)
12711(define-key org-mode-map "\C-c\C-xv" 'org-export-copy-visible) 13894(define-key org-mode-map "\C-c\C-xv" 'org-export-visible)
12712(define-key org-mode-map "\C-c\C-x\C-v" 'org-export-copy-visible) 13895(define-key org-mode-map "\C-c\C-x\C-v" 'org-export-visible)
12713;; OPML support is only an option for the future 13896;; OPML support is only an option for the future
12714;(define-key org-mode-map "\C-c\C-xo" 'org-export-as-opml) 13897;(define-key org-mode-map "\C-c\C-xo" 'org-export-as-opml)
12715;(define-key org-mode-map "\C-c\C-x\C-o" 'org-export-as-opml) 13898;(define-key org-mode-map "\C-c\C-x\C-o" 'org-export-as-opml)
@@ -12720,8 +13903,8 @@ a time), or the day by one (if it does not contain a time)."
12720(define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template) 13903(define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template)
12721(define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section) 13904(define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section)
12722(define-key org-mode-map "\C-c\C-xh" 'org-export-as-html) 13905(define-key org-mode-map "\C-c\C-xh" 'org-export-as-html)
12723(define-key org-mode-map "\C-c\C-xx" 'org-export-as-xml) 13906(define-key org-mode-map "\C-c\C-xx" 'org-export-as-xoxo)
12724(define-key org-mode-map "\C-c\C-x\C-x" 'org-export-as-xml) 13907(define-key org-mode-map "\C-c\C-x\C-x" 'org-export-as-xoxo)
12725(define-key org-mode-map "\C-c\C-xb" 'org-export-as-html-and-open) 13908(define-key org-mode-map "\C-c\C-xb" 'org-export-as-html-and-open)
12726(define-key org-mode-map "\C-c\C-x\C-b" 'org-export-as-html-and-open) 13909(define-key org-mode-map "\C-c\C-x\C-b" 'org-export-as-html-and-open)
12727 13910
@@ -12730,6 +13913,18 @@ a time), or the day by one (if it does not contain a time)."
12730(define-key org-mode-map "\C-c\C-x\M-w" 'org-copy-special) 13913(define-key org-mode-map "\C-c\C-x\M-w" 'org-copy-special)
12731(define-key org-mode-map "\C-c\C-x\C-y" 'org-paste-special) 13914(define-key org-mode-map "\C-c\C-x\C-y" 'org-paste-special)
12732 13915
13916(define-key org-mode-map "\C-c\C-ef" 'org-publish-current-file)
13917(define-key org-mode-map "\C-c\C-ep" 'org-publish-current-project)
13918(define-key org-mode-map "\C-c\C-ec" 'org-publish)
13919(define-key org-mode-map "\C-c\C-ea" 'org-publish-all)
13920(define-key org-mode-map "\C-c\C-e\C-f" 'org-publish-current-file)
13921(define-key org-mode-map "\C-c\C-e\C-p" 'org-publish-current-project)
13922(define-key org-mode-map "\C-c\C-e\C-c" 'org-publish)
13923(define-key org-mode-map "\C-c\C-e\C-a" 'org-publish-all)
13924
13925(when (featurep 'xemacs)
13926 (define-key org-mode-map 'button3 'popup-mode-menu))
13927
12733(defsubst org-table-p () (org-at-table-p)) 13928(defsubst org-table-p () (org-at-table-p))
12734 13929
12735(defun org-self-insert-command (N) 13930(defun org-self-insert-command (N)
@@ -12803,7 +13998,8 @@ because, in this case the deletion might narrow the column."
12803 (goto-char pos) 13998 (goto-char pos)
12804 ;; noalign: if there were two spaces at the end, this field 13999 ;; noalign: if there were two spaces at the end, this field
12805 ;; does not determine the width of the column. 14000 ;; does not determine the width of the column.
12806 (if noalign (setq org-table-may-need-update c)))) 14001 (if noalign (setq org-table-may-need-update c)))
14002 (delete-char N))
12807 (delete-char N))) 14003 (delete-char N)))
12808 14004
12809;; How to do this: Measure non-white length of current string 14005;; How to do this: Measure non-white length of current string
@@ -12834,12 +14030,13 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
12834 14030
12835(defun org-shifttab () 14031(defun org-shifttab ()
12836 "Global visibility cycling or move to previous table field. 14032 "Global visibility cycling or move to previous table field.
12837Calls `(org-cycle t)' or `org-table-previous-field', depending on context. 14033Calls `org-cycle' with argument t, or `org-table-previous-field', depending
14034on context.
12838See the individual commands for more information." 14035See the individual commands for more information."
12839 (interactive) 14036 (interactive)
12840 (cond 14037 (cond
12841 ((org-at-table-p) (org-table-previous-field)) 14038 ((org-at-table-p) (call-interactively 'org-table-previous-field))
12842 (t (org-cycle '(4))))) 14039 (t (call-interactively 'org-global-cycle))))
12843 14040
12844(defun org-shiftmetaleft () 14041(defun org-shiftmetaleft ()
12845 "Promote subtree or delete table column. 14042 "Promote subtree or delete table column.
@@ -12847,8 +14044,8 @@ Calls `org-promote-subtree' or `org-table-delete-column', depending on context.
12847See the individual commands for more information." 14044See the individual commands for more information."
12848 (interactive) 14045 (interactive)
12849 (cond 14046 (cond
12850 ((org-at-table-p) (org-table-delete-column)) 14047 ((org-at-table-p) (call-interactively 'org-table-delete-column))
12851 ((org-on-heading-p) (org-promote-subtree)) 14048 ((org-on-heading-p) (call-interactively 'org-promote-subtree))
12852 ((org-at-item-p) (call-interactively 'org-outdent-item)) 14049 ((org-at-item-p) (call-interactively 'org-outdent-item))
12853 (t (org-shiftcursor-error)))) 14050 (t (org-shiftcursor-error))))
12854 14051
@@ -12858,8 +14055,8 @@ Calls `org-demote-subtree' or `org-table-insert-column', depending on context.
12858See the individual commands for more information." 14055See the individual commands for more information."
12859 (interactive) 14056 (interactive)
12860 (cond 14057 (cond
12861 ((org-at-table-p) (org-table-insert-column)) 14058 ((org-at-table-p) (call-interactively 'org-table-insert-column))
12862 ((org-on-heading-p) (org-demote-subtree)) 14059 ((org-on-heading-p) (call-interactively 'org-demote-subtree))
12863 ((org-at-item-p) (call-interactively 'org-indent-item)) 14060 ((org-at-item-p) (call-interactively 'org-indent-item))
12864 (t (org-shiftcursor-error)))) 14061 (t (org-shiftcursor-error))))
12865 14062
@@ -12870,9 +14067,9 @@ Calls `org-move-subtree-up' or `org-table-kill-row' or
12870for more information." 14067for more information."
12871 (interactive "P") 14068 (interactive "P")
12872 (cond 14069 (cond
12873 ((org-at-table-p) (org-table-kill-row)) 14070 ((org-at-table-p) (call-interactively 'org-table-kill-row))
12874 ((org-on-heading-p) (org-move-subtree-up arg)) 14071 ((org-on-heading-p) (call-interactively 'org-move-subtree-up))
12875 ((org-at-item-p) (org-move-item-up arg)) 14072 ((org-at-item-p) (call-interactively 'org-move-item-up))
12876 (t (org-shiftcursor-error)))) 14073 (t (org-shiftcursor-error))))
12877(defun org-shiftmetadown (&optional arg) 14074(defun org-shiftmetadown (&optional arg)
12878 "Move subtree down or insert table row. 14075 "Move subtree down or insert table row.
@@ -12881,9 +14078,9 @@ Calls `org-move-subtree-down' or `org-table-insert-row' or
12881commands for more information." 14078commands for more information."
12882 (interactive "P") 14079 (interactive "P")
12883 (cond 14080 (cond
12884 ((org-at-table-p) (org-table-insert-row arg)) 14081 ((org-at-table-p) (call-interactively 'org-table-insert-row))
12885 ((org-on-heading-p) (org-move-subtree-down arg)) 14082 ((org-on-heading-p) (call-interactively 'org-move-subtree-down))
12886 ((org-at-item-p) (org-move-item-down arg)) 14083 ((org-at-item-p) (call-interactively 'org-move-item-down))
12887 (t (org-shiftcursor-error)))) 14084 (t (org-shiftcursor-error))))
12888 14085
12889(defun org-metaleft (&optional arg) 14086(defun org-metaleft (&optional arg)
@@ -12893,9 +14090,10 @@ With no specific context, calls the Emacs default `backward-word'.
12893See the individual commands for more information." 14090See the individual commands for more information."
12894 (interactive "P") 14091 (interactive "P")
12895 (cond 14092 (cond
12896 ((org-at-table-p) (org-table-move-column 'left)) 14093 ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left))
12897 ((or (org-on-heading-p) (org-region-active-p)) (org-do-promote)) 14094 ((or (org-on-heading-p) (org-region-active-p))
12898 (t (backward-word (prefix-numeric-value arg))))) 14095 (call-interactively 'org-do-promote))
14096 (t (call-interactively 'backward-word))))
12899 14097
12900(defun org-metaright (&optional arg) 14098(defun org-metaright (&optional arg)
12901 "Demote subtree or move table column to right. 14099 "Demote subtree or move table column to right.
@@ -12904,9 +14102,10 @@ With no specific context, calls the Emacs default `forward-word'.
12904See the individual commands for more information." 14102See the individual commands for more information."
12905 (interactive "P") 14103 (interactive "P")
12906 (cond 14104 (cond
12907 ((org-at-table-p) (org-table-move-column nil)) 14105 ((org-at-table-p) (call-interactively 'org-table-move-column))
12908 ((or (org-on-heading-p) (org-region-active-p)) (org-do-demote)) 14106 ((or (org-on-heading-p) (org-region-active-p))
12909 (t (forward-word (prefix-numeric-value arg))))) 14107 (call-interactively 'org-do-demote))
14108 (t (call-interactively 'forward-word))))
12910 14109
12911(defun org-metaup (&optional arg) 14110(defun org-metaup (&optional arg)
12912 "Move subtree up or move table row up. 14111 "Move subtree up or move table row up.
@@ -12915,9 +14114,9 @@ Calls `org-move-subtree-up' or `org-table-move-row' or
12915for more information." 14114for more information."
12916 (interactive "P") 14115 (interactive "P")
12917 (cond 14116 (cond
12918 ((org-at-table-p) (org-table-move-row 'up)) 14117 ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up))
12919 ((org-on-heading-p) (org-move-subtree-up arg)) 14118 ((org-on-heading-p) (call-interactively 'org-move-subtree-up))
12920 ((org-at-item-p) (org-move-item-up arg)) 14119 ((org-at-item-p) (call-interactively 'org-move-item-up))
12921 (t (org-shiftcursor-error)))) 14120 (t (org-shiftcursor-error))))
12922 14121
12923(defun org-metadown (&optional arg) 14122(defun org-metadown (&optional arg)
@@ -12927,43 +14126,46 @@ Calls `org-move-subtree-down' or `org-table-move-row' or
12927commands for more information." 14126commands for more information."
12928 (interactive "P") 14127 (interactive "P")
12929 (cond 14128 (cond
12930 ((org-at-table-p) (org-table-move-row nil)) 14129 ((org-at-table-p) (call-interactively 'org-table-move-row))
12931 ((org-on-heading-p) (org-move-subtree-down arg)) 14130 ((org-on-heading-p) (call-interactively 'org-move-subtree-down))
12932 ((org-at-item-p) (org-move-item-down arg)) 14131 ((org-at-item-p) (call-interactively 'org-move-item-down))
12933 (t (org-shiftcursor-error)))) 14132 (t (org-shiftcursor-error))))
12934 14133
12935(defun org-shiftup (&optional arg) 14134(defun org-shiftup (&optional arg)
12936 "Increase item in timestamp or increase priority of current item. 14135 "Increase item in timestamp or increase priority of current headline.
12937Calls `org-timestamp-up' or `org-priority-up', depending on context. 14136Calls `org-timestamp-up' or `org-priority-up', depending on context.
12938See the individual commands for more information." 14137See the individual commands for more information."
12939 (interactive "P") 14138 (interactive "P")
12940 (cond 14139 (cond
12941 ((org-at-timestamp-p) (org-timestamp-up arg)) 14140 ((org-at-timestamp-p) (call-interactively 'org-timestamp-up))
12942 (t (org-priority-up)))) 14141 ((org-on-heading-p) (call-interactively 'org-priority-up))
14142 ((org-at-item-p) (call-interactively 'org-previous-item))
14143 (t (call-interactively 'org-beginning-of-item) (beginning-of-line 1))))
12943 14144
12944(defun org-shiftdown (&optional arg) 14145(defun org-shiftdown (&optional arg)
12945 "Decrease item in timestamp or decrease priority of current item. 14146 "Decrease item in timestamp or decrease priority of current headline.
12946Calls `org-timestamp-down' or `org-priority-down', depending on context. 14147Calls `org-timestamp-down' or `org-priority-down', depending on context.
12947See the individual commands for more information." 14148See the individual commands for more information."
12948 (interactive "P") 14149 (interactive "P")
12949 (cond 14150 (cond
12950 ((org-at-timestamp-p) (org-timestamp-down arg)) 14151 ((org-at-timestamp-p) (call-interactively 'org-timestamp-down))
12951 (t (org-priority-down)))) 14152 ((org-on-heading-p) (call-interactively 'org-priority-down))
14153 (t (call-interactively 'org-next-item))))
12952 14154
12953(defun org-shiftright () 14155(defun org-shiftright ()
12954 "Next TODO keyword or timestamp one day later, depending on context." 14156 "Next TODO keyword or timestamp one day later, depending on context."
12955 (interactive) 14157 (interactive)
12956 (cond 14158 (cond
12957 ((org-at-timestamp-p) (org-timestamp-up-day)) 14159 ((org-at-timestamp-p) (call-interactively 'org-timestamp-up-day))
12958 ((org-on-heading-p) (org-todo 'right)) 14160 ((org-on-heading-p) (org-call-with-arg 'org-todo 'right))
12959 (t (org-shiftcursor-error)))) 14161 (t (org-shiftcursor-error))))
12960 14162
12961(defun org-shiftleft () 14163(defun org-shiftleft ()
12962 "Previous TODO keyword or timestamp one day earlier, depending on context." 14164 "Previous TODO keyword or timestamp one day earlier, depending on context."
12963 (interactive) 14165 (interactive)
12964 (cond 14166 (cond
12965 ((org-at-timestamp-p) (org-timestamp-down-day)) 14167 ((org-at-timestamp-p) (call-interactively 'org-timestamp-down-day))
12966 ((org-on-heading-p) (org-todo 'left)) 14168 ((org-on-heading-p) (org-call-with-arg 'org-todo 'left))
12967 (t (org-shiftcursor-error)))) 14169 (t (org-shiftcursor-error))))
12968 14170
12969(defun org-copy-special () 14171(defun org-copy-special ()
@@ -13028,21 +14230,23 @@ This command does many different things, depending on context:
13028 ((and (local-variable-p 'org-finish-function (current-buffer)) 14230 ((and (local-variable-p 'org-finish-function (current-buffer))
13029 (fboundp org-finish-function)) 14231 (fboundp org-finish-function))
13030 (funcall org-finish-function)) 14232 (funcall org-finish-function))
13031 ((org-on-target-p) (org-update-radio-target-regexp)) 14233 ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp))
13032 ((org-on-heading-p) (org-set-tags arg)) 14234 ((org-on-heading-p) (call-interactively 'org-set-tags))
13033 ((org-at-table.el-p) 14235 ((org-at-table.el-p)
13034 (require 'table) 14236 (require 'table)
13035 (beginning-of-line 1) 14237 (beginning-of-line 1)
13036 (re-search-forward "|" (save-excursion (end-of-line 2) (point))) 14238 (re-search-forward "|" (save-excursion (end-of-line 2) (point)))
13037 (table-recognize-table)) 14239 (call-interactively 'table-recognize-table))
13038 ((org-at-table-p) 14240 ((org-at-table-p)
13039 (org-table-maybe-eval-formula) 14241 (org-table-maybe-eval-formula)
13040 (if arg 14242 (if arg
13041 (org-table-recalculate t) 14243 (call-interactively 'org-table-recalculate)
13042 (org-table-maybe-recalculate-line)) 14244 (org-table-maybe-recalculate-line))
13043 (org-table-align)) 14245 (call-interactively 'org-table-align))
14246 ((org-at-item-checkbox-p)
14247 (call-interactively 'org-toggle-checkbox))
13044 ((org-at-item-p) 14248 ((org-at-item-p)
13045 (org-renumber-ordered-list (prefix-numeric-value arg))) 14249 (call-interactively 'org-renumber-ordered-list))
13046 ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)")) 14250 ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)"))
13047 (cond 14251 (cond
13048 ((equal (match-string 1) "TBLFM") 14252 ((equal (match-string 1) "TBLFM")
@@ -13050,9 +14254,10 @@ This command does many different things, depending on context:
13050 (save-excursion 14254 (save-excursion
13051 (beginning-of-line 1) 14255 (beginning-of-line 1)
13052 (skip-chars-backward " \r\n\t") 14256 (skip-chars-backward " \r\n\t")
13053 (if (org-at-table-p) (org-table-recalculate t)))) 14257 (if (org-at-table-p)
14258 (org-call-with-arg 'org-table-recalculate t))))
13054 (t 14259 (t
13055 (org-mode-restart)))) 14260 (call-interactively 'org-mode-restart))))
13056 (t (error "C-c C-c can do nothing useful at this location."))))) 14261 (t (error "C-c C-c can do nothing useful at this location.")))))
13057 14262
13058(defun org-mode-restart () 14263(defun org-mode-restart ()
@@ -13070,7 +14275,7 @@ See the individual commands for more information."
13070 (cond 14275 (cond
13071 ((org-at-table-p) 14276 ((org-at-table-p)
13072 (org-table-justify-field-maybe) 14277 (org-table-justify-field-maybe)
13073 (org-table-next-row)) 14278 (call-interactively 'org-table-next-row))
13074 (t (newline)))) 14279 (t (newline))))
13075 14280
13076(defun org-meta-return (&optional arg) 14281(defun org-meta-return (&optional arg)
@@ -13080,8 +14285,8 @@ See the individual commands for more information."
13080 (interactive "P") 14285 (interactive "P")
13081 (cond 14286 (cond
13082 ((org-at-table-p) 14287 ((org-at-table-p)
13083 (org-table-wrap-region arg)) 14288 (call-interactively 'org-table-wrap-region))
13084 (t (org-insert-heading arg)))) 14289 (t (call-interactively 'org-insert-heading))))
13085 14290
13086;;; Menu entries 14291;;; Menu entries
13087 14292
@@ -13226,10 +14431,10 @@ See the individual commands for more information."
13226 "--" 14431 "--"
13227 ("Export" 14432 ("Export"
13228 ["ASCII" org-export-as-ascii t] 14433 ["ASCII" org-export-as-ascii t]
13229 ["Extract Visible Text" org-export-copy-visible t] 14434 ["Export visible part..." org-export-visible t]
13230 ["HTML" org-export-as-html t] 14435 ["HTML" org-export-as-html t]
13231 ["HTML and Open" org-export-as-html-and-open t] 14436 ["HTML and Open" org-export-as-html-and-open t]
13232 ["XML (XOXO)" org-export-as-xml t] 14437 ["XOXO" org-export-as-xoxo t]
13233 "--" 14438 "--"
13234 ["iCalendar this file" org-export-icalendar-this-file t] 14439 ["iCalendar this file" org-export-icalendar-this-file t]
13235 ["iCalendar all agenda files" org-export-icalendar-all-agenda-files 14440 ["iCalendar all agenda files" org-export-icalendar-all-agenda-files
@@ -13238,6 +14443,11 @@ See the individual commands for more information."
13238 "--" 14443 "--"
13239 ["Option Template" org-insert-export-options-template t] 14444 ["Option Template" org-insert-export-options-template t]
13240 ["Toggle Fixed Width" org-toggle-fixed-width-section t]) 14445 ["Toggle Fixed Width" org-toggle-fixed-width-section t])
14446 ("Publish"
14447 ["Current File" org-publish-current-file t]
14448 ["Current Project" org-publish-current-project t]
14449 ["Project..." org-publish t]
14450 ["All Projects" org-publish-all t])
13241 "--" 14451 "--"
13242 ("Documentation" 14452 ("Documentation"
13243 ["Show Version" org-version t] 14453 ["Show Version" org-version t]
@@ -13303,6 +14513,100 @@ With optional NODE, go directly to that node."
13303 14513
13304;;; Miscellaneous stuff 14514;;; Miscellaneous stuff
13305 14515
14516(defun org-context ()
14517 "Return a list of contexts of the current cursor position.
14518If several contexts apply, all are returned.
14519Each context entry is a list with a symbol naming the context, and
14520two positions indicating start and end of the context. Possible
14521contexts are:
14522
14523:headline anywhere in a headline
14524:headline-stars on the leading stars in a headline
14525:todo-keyword on a TODO keyword (including DONE) in a headline
14526:tags on the TAGS in a headline
14527:priority on the priority cookie in a headline
14528:item on the first line of a plain list item
14529:checkbox on the checkbox in a plain list item
14530:table in an org-mode table
14531:table-special on a special filed in a table
14532:table-table in a table.el table
14533:link on a hyperline
14534:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE,COMMENT, QUOTE.
14535:target on a <<target>>
14536:radio-target on a <<<radio-target>>>
14537
14538This function expects the position to be visible because it uses font-lock
14539faces as a help to recognize the following contexts: :table-special, :link,
14540and :keyword."
14541 (let* ((f (get-text-property (point) 'face))
14542 (faces (if (listp f) f (list f)))
14543 (p (point)) clist)
14544 ;; First the large context
14545 (cond
14546 ((org-on-heading-p)
14547 (push (list :headline (point-at-bol) (point-at-eol)) clist)
14548 (when (progn
14549 (beginning-of-line 1)
14550 (looking-at org-todo-line-tags-regexp))
14551 (push (org-point-in-group p 1 :headline-stars) clist)
14552 (push (org-point-in-group p 2 :todo-keyword) clist)
14553 (push (org-point-in-group p 4 :tags) clist))
14554 (goto-char p)
14555 (skip-chars-backward "^[\n\r \t") (or (eobp) (backward-char 1))
14556 (if (looking-at "\\[#[A-Z]\\]")
14557 (push (org-point-in-group p 0 :priority) clist)))
14558
14559 ((org-at-item-p)
14560 (push (list :item (point-at-bol)
14561 (save-excursion (org-end-of-item) (point)))
14562 clist)
14563 (and (org-at-item-checkbox-p)
14564 (push (org-point-in-group p 0 :checkbox) clist)))
14565
14566 ((org-at-table-p)
14567 (push (list :table (org-table-begin) (org-table-end)) clist)
14568 (if (memq 'org-formula faces)
14569 (push (list :table-special
14570 (previous-single-property-change p 'face)
14571 (next-single-property-change p 'face)) clist)))
14572 ((org-at-table-p 'any)
14573 (push (list :table-table) clist)))
14574 (goto-char p)
14575
14576 ;; Now the small context
14577 (cond
14578 ((org-at-timestamp-p)
14579 (push (org-point-in-group p 0 :timestamp) clist))
14580 ((memq 'org-link faces)
14581 (push (list :link
14582 (previous-single-property-change p 'face)
14583 (next-single-property-change p 'face)) clist))
14584 ((memq 'org-special-keyword faces)
14585 (push (list :keyword
14586 (previous-single-property-change p 'face)
14587 (next-single-property-change p 'face)) clist))
14588 ((org-on-target-p)
14589 (push (org-point-in-group p 0 :target) clist)
14590 (goto-char (1- (match-beginning 0)))
14591 (if (looking-at org-radio-target-regexp)
14592 (push (org-point-in-group p 0 :radio-target) clist))
14593 (goto-char p)))
14594
14595 (setq clist (nreverse (delq nil clist)))
14596 clist))
14597
14598(defun org-point-in-group (point group &optional context)
14599 "Check if POINT is in match-group GROUP.
14600If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the
14601match. If the match group does ot exist or point is not inside it,
14602return nil."
14603 (and (match-beginning group)
14604 (>= point (match-beginning group))
14605 (<= point (match-end group))
14606 (if context
14607 (list context (match-beginning group) (match-end group))
14608 t)))
14609
13306(defun org-move-line-down (arg) 14610(defun org-move-line-down (arg)
13307 "Move the current line down. With prefix argument, move it past ARG lines." 14611 "Move the current line down. With prefix argument, move it past ARG lines."
13308 (interactive "p") 14612 (interactive "p")
@@ -13331,8 +14635,6 @@ With optional NODE, go directly to that node."
13331 14635
13332;; Paragraph filling stuff. 14636;; Paragraph filling stuff.
13333;; We want this to be just right, so use the full arsenal. 14637;; We want this to be just right, so use the full arsenal.
13334;; FIXME: This very likely does not work correctly for XEmacs, because the
13335;; filladapt package works slightly differently.
13336 14638
13337(defun org-set-autofill-regexps () 14639(defun org-set-autofill-regexps ()
13338 (interactive) 14640 (interactive)
@@ -13451,7 +14753,7 @@ that can be added."
13451;; The following functions capture almost the entire compatibility code 14753;; The following functions capture almost the entire compatibility code
13452;; between the different versions of outline-mode. The only other 14754;; between the different versions of outline-mode. The only other
13453;; places where this is important are the font-lock-keywords, and in 14755;; places where this is important are the font-lock-keywords, and in
13454;; `org-export-copy-visible'. Search for `org-noutline-p' to find them. 14756;; `org-export-visible'. Search for `org-noutline-p' to find them.
13455 14757
13456;; C-a should go to the beginning of a *visible* line, also in the 14758;; C-a should go to the beginning of a *visible* line, also in the
13457;; new outline.el. I guess this should be patched into Emacs? 14759;; new outline.el. I guess this should be patched into Emacs?
@@ -13471,8 +14773,6 @@ to a visible line beginning. This makes the function of C-a more intuitive."
13471 14773
13472(when org-noutline-p 14774(when org-noutline-p
13473 (define-key org-mode-map "\C-a" 'org-beginning-of-line)) 14775 (define-key org-mode-map "\C-a" 'org-beginning-of-line))
13474;; FIXME: should I use substitute-key-definition to reach other bindings
13475;; of beginning-of-line?
13476 14776
13477(defun org-invisible-p () 14777(defun org-invisible-p ()
13478 "Check if point is at a character currently not visible." 14778 "Check if point is at a character currently not visible."
@@ -13503,15 +14803,15 @@ to a visible line beginning. This makes the function of C-a more intuitive."
13503Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." 14803Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
13504 (if org-noutline-p 14804 (if org-noutline-p
13505 (outline-back-to-heading invisible-ok) 14805 (outline-back-to-heading invisible-ok)
13506 (if (and (memq (char-before) '(?\n ?\r)) 14806 (if (and (or (bobp) (memq (char-before) '(?\n ?\r)))
13507 (looking-at outline-regexp)) 14807 (looking-at outline-regexp))
13508 t 14808 t
13509 (if (re-search-backward (concat (if invisible-ok "\\([\r\n]\\|^\\)" "^") 14809 (if (re-search-backward (concat (if invisible-ok "\\([\r\n]\\|^\\)" "^")
13510 outline-regexp) 14810 outline-regexp)
13511 nil t) 14811 nil t)
13512 (if invisible-ok 14812 (if invisible-ok
13513 (progn (goto-char (match-end 1)) 14813 (progn (goto-char (or (match-end 1) (match-beginning 0)))
13514 (looking-at outline-regexp))) 14814 (looking-at outline-regexp)))
13515 (error "Before first heading"))))) 14815 (error "Before first heading")))))
13516 14816
13517(defun org-on-heading-p (&optional invisible-ok) 14817(defun org-on-heading-p (&optional invisible-ok)
@@ -13585,10 +14885,9 @@ When ENTRY is non-nil, show the entire entry."
13585 (if entry 14885 (if entry
13586 (progn 14886 (progn
13587 (org-show-entry) 14887 (org-show-entry)
13588 (save-excursion ;; FIXME: Is this the fix for points in the -| 14888 (save-excursion
13589 ;; middle of text? | 14889 (and (outline-next-heading)
13590 (and (outline-next-heading) ;; | 14890 (org-flag-heading nil))))
13591 (org-flag-heading nil)))) ; show the next heading _|
13592 (outline-flag-region (max 1 (1- (point))) 14891 (outline-flag-region (max 1 (1- (point)))
13593 (save-excursion (outline-end-of-heading) (point)) 14892 (save-excursion (outline-end-of-heading) (point))
13594 (if org-noutline-p 14893 (if org-noutline-p
@@ -13630,7 +14929,7 @@ Show the heading too, if it is currently invisible."
13630 (save-excursion 14929 (save-excursion
13631 (org-back-to-heading t) 14930 (org-back-to-heading t)
13632 (outline-flag-region 14931 (outline-flag-region
13633 (1- (point)) 14932 (max 1 (1- (point)))
13634 (save-excursion 14933 (save-excursion
13635 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) 14934 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move)
13636 (or (match-beginning 1) (point-max))) 14935 (or (match-beginning 1) (point-max)))
@@ -13669,6 +14968,10 @@ Show the heading too, if it is currently invisible."
13669 14968
13670(run-hooks 'org-load-hook) 14969(run-hooks 'org-load-hook)
13671 14970
14971
13672;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd 14972;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
13673;;; org.el ends here 14973;;; org.el ends here
13674 14974
14975
14976
14977
diff --git a/lisp/textmodes/po.el b/lisp/textmodes/po.el
index 07b9ba1a2b1..eac1cb94105 100644
--- a/lisp/textmodes/po.el
+++ b/lisp/textmodes/po.el
@@ -41,15 +41,21 @@
41Contains canonical charset names that don't correspond to coding systems.") 41Contains canonical charset names that don't correspond to coding systems.")
42 42
43(defun po-find-charset (filename) 43(defun po-find-charset (filename)
44 "Return PO charset value for FILENAME." 44 "Return PO charset value for FILENAME.
45If FILENAME is a cons, the cdr part is a buffer that already contains
46the PO file (but not yet decoded)."
45 (let ((charset-regexp 47 (let ((charset-regexp
46 "^\"Content-Type:[ \t]*text/plain;[ \t]*charset=\\(.*\\)\\\\n\"") 48 "^\"Content-Type:[ \t]*text/plain;[ \t]*charset=\\(.*\\)\\\\n\"")
49 (buf (and (consp filename) (cdr filename)))
47 (short-read nil)) 50 (short-read nil))
51 (when buf
52 (set-buffer buf)
53 (goto-char (point-min)))
48 ;; Try the first 4096 bytes. In case we cannot find the charset value 54 ;; Try the first 4096 bytes. In case we cannot find the charset value
49 ;; within the first 4096 bytes (the PO file might start with a long 55 ;; within the first 4096 bytes (the PO file might start with a long
50 ;; comment) try the next 4096 bytes repeatedly until we'll know for sure 56 ;; comment) try the next 4096 bytes repeatedly until we'll know for sure
51 ;; we've checked the empty header entry entirely. 57 ;; we've checked the empty header entry entirely.
52 (while (not (or short-read (re-search-forward "^msgid" nil t))) 58 (while (not (or short-read (re-search-forward "^msgid" nil t) buf))
53 (save-excursion 59 (save-excursion
54 (goto-char (point-max)) 60 (goto-char (point-max))
55 (let ((pair (insert-file-contents-literally filename nil 61 (let ((pair (insert-file-contents-literally filename nil
@@ -57,7 +63,7 @@ Contains canonical charset names that don't correspond to coding systems.")
57 (1- (+ (point) 4096))))) 63 (1- (+ (point) 4096)))))
58 (setq short-read (< (nth 1 pair) 4096))))) 64 (setq short-read (< (nth 1 pair) 4096)))))
59 (cond ((re-search-forward charset-regexp nil t) (match-string 1)) 65 (cond ((re-search-forward charset-regexp nil t) (match-string 1))
60 (short-read nil) 66 ((or short-read buf) nil)
61 ;; We've found the first msgid; maybe, only a part of the msgstr 67 ;; We've found the first msgid; maybe, only a part of the msgstr
62 ;; value was loaded. Load the next 1024 bytes; if charset still 68 ;; value was loaded. Load the next 1024 bytes; if charset still
63 ;; isn't available, give up. 69 ;; isn't available, give up.
@@ -71,10 +77,13 @@ Contains canonical charset names that don't correspond to coding systems.")
71 77
72(defun po-find-file-coding-system-guts (operation filename) 78(defun po-find-file-coding-system-guts (operation filename)
73 "Return a (DECODING . ENCODING) pair for OPERATION on PO file FILENAME. 79 "Return a (DECODING . ENCODING) pair for OPERATION on PO file FILENAME.
74Do so according to FILENAME's declared charset." 80Do so according to FILENAME's declared charset.
81FILENAME may be a cons (NAME . BUFFER). In that case, detect charset
82in BUFFER."
75 (and 83 (and
76 (eq operation 'insert-file-contents) 84 (eq operation 'insert-file-contents)
77 (file-exists-p filename) 85 (or (if (consp filename) (buffer-live-p (cdr filename)))
86 (file-exists-p filename))
78 (with-temp-buffer 87 (with-temp-buffer
79 (let* ((coding-system-for-read 'no-conversion) 88 (let* ((coding-system-for-read 'no-conversion)
80 (charset (or (po-find-charset filename) "ascii")) 89 (charset (or (po-find-charset filename) "ascii"))
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 416a3efb684..18f0c980929 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -49,13 +49,14 @@
49 :type 'integer 49 :type 'integer
50 :group 'sgml) 50 :group 'sgml)
51 51
52(defcustom sgml-transformation 'identity 52(defcustom sgml-transformation-function 'identity
53 "*Default value for `skeleton-transformation' (which see) in SGML mode." 53 "*Default value for `skeleton-transformation-function' in SGML mode."
54 :type 'function 54 :type 'function
55 :group 'sgml) 55 :group 'sgml)
56 56
57(put 'sgml-transformation 'variable-interactive 57(put 'sgml-transformation-function 'variable-interactive
58 "aTransformation function: ") 58 "aTransformation function: ")
59(defvaralias 'sgml-transformation 'sgml-transformation-function)
59 60
60(defcustom sgml-mode-hook nil 61(defcustom sgml-mode-hook nil
61 "Hook run by command `sgml-mode'. 62 "Hook run by command `sgml-mode'.
@@ -333,6 +334,7 @@ an optional alist of possible values."
333 :type '(repeat (cons (string :tag "Tag Name") 334 :type '(repeat (cons (string :tag "Tag Name")
334 (repeat :tag "Tag Rule" sexp))) 335 (repeat :tag "Tag Rule" sexp)))
335 :group 'sgml) 336 :group 'sgml)
337(put 'sgml-tag-alist 'risky-local-variable t)
336 338
337(defcustom sgml-tag-help 339(defcustom sgml-tag-help
338 '(("!" . "Empty declaration for comment") 340 '(("!" . "Empty declaration for comment")
@@ -389,7 +391,7 @@ a DOCTYPE or an XML declaration."
389(defun sgml-mode-facemenu-add-face-function (face end) 391(defun sgml-mode-facemenu-add-face-function (face end)
390 (if (setq face (cdr (assq face sgml-face-tag-alist))) 392 (if (setq face (cdr (assq face sgml-face-tag-alist)))
391 (progn 393 (progn
392 (setq face (funcall skeleton-transformation face)) 394 (setq face (funcall skeleton-transformation-function face))
393 (setq facemenu-end-add-face (concat "</" face ">")) 395 (setq facemenu-end-add-face (concat "</" face ">"))
394 (concat "<" face ">")) 396 (concat "<" face ">"))
395 (error "Face not configured for %s mode" mode-name))) 397 (error "Face not configured for %s mode" mode-name)))
@@ -413,8 +415,8 @@ An argument of N to a tag-inserting command means to wrap it around
413the next N words. In Transient Mark mode, when the mark is active, 415the next N words. In Transient Mark mode, when the mark is active,
414N defaults to -1, which means to wrap it around the current region. 416N defaults to -1, which means to wrap it around the current region.
415 417
416If you like upcased tags, put (setq sgml-transformation 'upcase) in 418If you like upcased tags, put (setq sgml-transformation-function 'upcase)
417your `.emacs' file. 419in your `.emacs' file.
418 420
419Use \\[sgml-validate] to validate your document with an SGML parser. 421Use \\[sgml-validate] to validate your document with an SGML parser.
420 422
@@ -458,7 +460,8 @@ Do \\[describe-key] on the following bindings to discover what they do.
458 (sgml-xml-guess) 460 (sgml-xml-guess)
459 (if sgml-xml-mode 461 (if sgml-xml-mode
460 (setq mode-name "XML") 462 (setq mode-name "XML")
461 (set (make-local-variable 'skeleton-transformation) sgml-transformation)) 463 (set (make-local-variable 'skeleton-transformation-function)
464 sgml-transformation-function))
462 ;; This will allow existing comments within declarations to be 465 ;; This will allow existing comments within declarations to be
463 ;; recognized. 466 ;; recognized.
464 (set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*") 467 (set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*")
@@ -602,9 +605,9 @@ This only works for Latin-1 input."
602 (if sgml-name-8bit-mode "ON" "OFF"))) 605 (if sgml-name-8bit-mode "ON" "OFF")))
603 606
604;; When an element of a skeleton is a string "str", it is passed 607;; When an element of a skeleton is a string "str", it is passed
605;; through skeleton-transformation and inserted. If "str" is to be 608;; through `skeleton-transformation-function' and inserted.
606;; inserted literally, one should obtain it as the return value of a 609;; If "str" is to be inserted literally, one should obtain it as
607;; function, e.g. (identity "str"). 610;; the return value of a function, e.g. (identity "str").
608 611
609(defvar sgml-tag-last nil) 612(defvar sgml-tag-last nil)
610(defvar sgml-tag-history nil) 613(defvar sgml-tag-history nil)
@@ -612,9 +615,10 @@ This only works for Latin-1 input."
612 "Prompt for a tag and insert it, optionally with attributes. 615 "Prompt for a tag and insert it, optionally with attributes.
613Completion and configuration are done according to `sgml-tag-alist'. 616Completion and configuration are done according to `sgml-tag-alist'.
614If you like tags and attributes in uppercase do \\[set-variable] 617If you like tags and attributes in uppercase do \\[set-variable]
615skeleton-transformation RET upcase RET, or put this in your `.emacs': 618`skeleton-transformation-function' RET `upcase' RET, or put this
616 (setq sgml-transformation 'upcase)" 619in your `.emacs':
617 (funcall (or skeleton-transformation 'identity) 620 (setq sgml-transformation-function 'upcase)"
621 (funcall (or skeleton-transformation-function 'identity)
618 (setq sgml-tag-last 622 (setq sgml-tag-last
619 (completing-read 623 (completing-read
620 (if (> (length sgml-tag-last) 0) 624 (if (> (length sgml-tag-last) 0)
@@ -637,7 +641,7 @@ skeleton-transformation RET upcase RET, or put this in your `.emacs':
637 ;; For xhtml's `tr' tag, we should maybe use \n instead. 641 ;; For xhtml's `tr' tag, we should maybe use \n instead.
638 (if (eq v2 t) (setq v2 nil)) 642 (if (eq v2 t) (setq v2 nil))
639 ;; We use `identity' to prevent skeleton from passing 643 ;; We use `identity' to prevent skeleton from passing
640 ;; `str' through skeleton-transformation a second time. 644 ;; `str' through `skeleton-transformation-function' a second time.
641 '(("") v2 _ v2 "</" (identity ',str) ?>)) 645 '(("") v2 _ v2 "</" (identity ',str) ?>))
642 ((eq (car v2) t) 646 ((eq (car v2) t)
643 (cons '("") (cdr v2))) 647 (cons '("") (cdr v2)))
@@ -668,12 +672,12 @@ If QUIET, do not print a message when there are no attributes for TAG."
668 (if (stringp (car alist)) 672 (if (stringp (car alist))
669 (progn 673 (progn
670 (insert (if (eq (preceding-char) ?\s) "" ?\s) 674 (insert (if (eq (preceding-char) ?\s) "" ?\s)
671 (funcall skeleton-transformation (car alist))) 675 (funcall skeleton-transformation-function (car alist)))
672 (sgml-value alist)) 676 (sgml-value alist))
673 (setq i (length alist)) 677 (setq i (length alist))
674 (while (> i 0) 678 (while (> i 0)
675 (insert ?\s) 679 (insert ?\s)
676 (insert (funcall skeleton-transformation 680 (insert (funcall skeleton-transformation-function
677 (setq attribute 681 (setq attribute
678 (skeleton-read '(completing-read 682 (skeleton-read '(completing-read
679 "Attribute: " 683 "Attribute: "
@@ -1979,12 +1983,12 @@ Can be used as a value for `html-mode-hook'."
1979 "\" name=\"" (or v1 (setq v1 (skeleton-read "Name: "))) 1983 "\" name=\"" (or v1 (setq v1 (skeleton-read "Name: ")))
1980 "\" value=\"" str ?\" 1984 "\" value=\"" str ?\"
1981 (when (y-or-n-p "Set \"checked\" attribute? ") 1985 (when (y-or-n-p "Set \"checked\" attribute? ")
1982 (funcall skeleton-transformation 1986 (funcall skeleton-transformation-function
1983 (if sgml-xml-mode " checked=\"checked\"" " checked"))) 1987 (if sgml-xml-mode " checked=\"checked\"" " checked")))
1984 (if sgml-xml-mode " />" ">") 1988 (if sgml-xml-mode " />" ">")
1985 (skeleton-read "Text: " (capitalize str)) 1989 (skeleton-read "Text: " (capitalize str))
1986 (or v2 (setq v2 (if (y-or-n-p "Newline after text? ") 1990 (or v2 (setq v2 (if (y-or-n-p "Newline after text? ")
1987 (funcall skeleton-transformation 1991 (funcall skeleton-transformation-function
1988 (if sgml-xml-mode "<br />" "<br>")) 1992 (if sgml-xml-mode "<br />" "<br>"))
1989 ""))) 1993 "")))
1990 \n)) 1994 \n))
@@ -1999,12 +2003,12 @@ Can be used as a value for `html-mode-hook'."
1999 "\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: "))) 2003 "\" name=\"" (or (car v2) (setcar v2 (skeleton-read "Name: ")))
2000 "\" value=\"" str ?\" 2004 "\" value=\"" str ?\"
2001 (when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? "))) 2005 (when (and (not v1) (setq v1 (y-or-n-p "Set \"checked\" attribute? ")))
2002 (funcall skeleton-transformation 2006 (funcall skeleton-transformation-function
2003 (if sgml-xml-mode " checked=\"checked\"" " checked"))) 2007 (if sgml-xml-mode " checked=\"checked\"" " checked")))
2004 (if sgml-xml-mode " />" ">") 2008 (if sgml-xml-mode " />" ">")
2005 (skeleton-read "Text: " (capitalize str)) 2009 (skeleton-read "Text: " (capitalize str))
2006 (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ") 2010 (or (cdr v2) (setcdr v2 (if (y-or-n-p "Newline after text? ")
2007 (funcall skeleton-transformation 2011 (funcall skeleton-transformation-function
2008 (if sgml-xml-mode "<br />" "<br>")) 2012 (if sgml-xml-mode "<br />" "<br>"))
2009 ""))) 2013 "")))
2010 \n)) 2014 \n))
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 6c9463fe11e..dab08902769 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -6,7 +6,7 @@
6;; Keywords: wp, convenience 6;; Keywords: wp, convenience
7;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com> 7;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com>
8;; Created: Sat Jul 08 2000 13:28:45 (PST) 8;; Created: Sat Jul 08 2000 13:28:45 (PST)
9;; Revised: Sat Aug 06 2005 19:42:54 (CEST) 9;; Revised: Tue May 30 2006 10:01:43 (PDT)
10 10
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12 12
@@ -3104,10 +3104,10 @@ CALS (DocBook DTD):
3104 (cond 3104 (cond
3105 ((eq language 'html) 3105 ((eq language 'html)
3106 (insert (format "<!-- This HTML table template is generated by emacs %s -->\n" emacs-version) 3106 (insert (format "<!-- This HTML table template is generated by emacs %s -->\n" emacs-version)
3107 (format "<TABLE %s>\n" table-html-table-attribute) 3107 (format "<table %s>\n" table-html-table-attribute)
3108 (if (and (stringp caption) 3108 (if (and (stringp caption)
3109 (not (string= caption ""))) 3109 (not (string= caption "")))
3110 (format " <CAPTION>%s</CAPTION>\n" caption) 3110 (format " <caption>%s</caption>\n" caption)
3111 ""))) 3111 "")))
3112 ((eq language 'latex) 3112 ((eq language 'latex)
3113 (insert (format "%% This LaTeX table template is generated by emacs %s\n" emacs-version) 3113 (insert (format "%% This LaTeX table template is generated by emacs %s\n" emacs-version)
@@ -3131,7 +3131,7 @@ CALS (DocBook DTD):
3131 (with-current-buffer dest-buffer 3131 (with-current-buffer dest-buffer
3132 (cond 3132 (cond
3133 ((eq language 'html) 3133 ((eq language 'html)
3134 (insert "</TABLE>\n")) 3134 (insert "</table>\n"))
3135 ((eq language 'latex) 3135 ((eq language 'latex)
3136 (insert "\\end{tabular}\n")) 3136 (insert "\\end{tabular}\n"))
3137 ((eq language 'cals) 3137 ((eq language 'cals)
@@ -3152,7 +3152,7 @@ CALS (DocBook DTD):
3152 (with-current-buffer dest-buffer 3152 (with-current-buffer dest-buffer
3153 (cond 3153 (cond
3154 ((eq language 'html) 3154 ((eq language 'html)
3155 (insert " <TR>\n")) 3155 (insert " <tr>\n"))
3156 ((eq language 'cals) 3156 ((eq language 'cals)
3157 (insert " <row>\n")) 3157 (insert " <row>\n"))
3158 )) 3158 ))
@@ -3160,7 +3160,7 @@ CALS (DocBook DTD):
3160 (with-current-buffer dest-buffer 3160 (with-current-buffer dest-buffer
3161 (cond 3161 (cond
3162 ((eq language 'html) 3162 ((eq language 'html)
3163 (insert " </TR>\n")) 3163 (insert " </tr>\n"))
3164 ((eq language 'cals) 3164 ((eq language 'cals)
3165 (insert " </row>\n") 3165 (insert " </row>\n")
3166 (unless (/= (table-get-source-info 'current-row) table-cals-thead-rows) 3166 (unless (/= (table-get-source-info 'current-row) table-cals-thead-rows)
@@ -3207,7 +3207,7 @@ CALS (DocBook DTD):
3207 'cell-type 3207 'cell-type
3208 (if (or (<= (table-get-source-info 'current-row) table-html-th-rows) 3208 (if (or (<= (table-get-source-info 'current-row) table-html-th-rows)
3209 (<= (table-get-source-info 'current-column) table-html-th-columns)) 3209 (<= (table-get-source-info 'current-column) table-html-th-columns))
3210 "TH" "TD")))) 3210 "th" "td"))))
3211 (if (and table-html-cell-attribute (not (string= table-html-cell-attribute ""))) 3211 (if (and table-html-cell-attribute (not (string= table-html-cell-attribute "")))
3212 (insert " " table-html-cell-attribute)) 3212 (insert " " table-html-cell-attribute))
3213 (if (> colspan 1) (insert (format " colspan=\"%d\"" colspan))) 3213 (if (> colspan 1) (insert (format " colspan=\"%d\"" colspan)))
@@ -3266,7 +3266,7 @@ CALS (DocBook DTD):
3266 (goto-char (point-min)) 3266 (goto-char (point-min))
3267 (while (and (re-search-forward "$" nil t) 3267 (while (and (re-search-forward "$" nil t)
3268 (not (eobp))) 3268 (not (eobp)))
3269 (insert "<BR />") 3269 (insert "<br />")
3270 (forward-char 1))) 3270 (forward-char 1)))
3271 (unless (and table-html-delegate-spacing-to-user-agent 3271 (unless (and table-html-delegate-spacing-to-user-agent
3272 (progn 3272 (progn
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
index a4b67057676..9263c48f18b 100644
--- a/lisp/textmodes/text-mode.el
+++ b/lisp/textmodes/text-mode.el
@@ -33,7 +33,7 @@
33(defcustom text-mode-hook nil 33(defcustom text-mode-hook nil
34 "Normal hook run when entering Text mode and many related modes." 34 "Normal hook run when entering Text mode and many related modes."
35 :type 'hook 35 :type 'hook
36 :options '(turn-on-auto-fill flyspell-mode) 36 :options '(turn-on-auto-fill turn-on-flyspell)
37 :group 'data) 37 :group 'data)
38 38
39(defvar text-mode-variant nil 39(defvar text-mode-variant nil
diff --git a/lisp/tumme.el b/lisp/tumme.el
index 6a53ed16948..d6420bf33d7 100644
--- a/lisp/tumme.el
+++ b/lisp/tumme.el
@@ -84,46 +84,13 @@
84;; USAGE 84;; USAGE
85;; ===== 85;; =====
86;; 86;;
87;; If you plan to use tumme much, setting up key bindings for it in 87;; This information has been moved to the manual. Type `C-h r' to open
88;; dired is a good idea: 88;; the Emacs manual and go to the node Thumbnails by typing `g
89;; Thumbnails RET'.
89;; 90;;
90;; (tumme-setup-dired-keybindings) 91;; Quickstart: M-x tumme RET DIRNAME RET
91;;
92;; Next, do M-x tumme-dired RET. This will ask you for a directory
93;; where image files are stored, setup a useful window configuration
94;; and enable the two special modes that tumme provides. NOTE: If you
95;; do not want tumme to split your windows, call it with a prefix
96;; argument.
97;;
98;; Start viewing thumbnails by doing C-S-n and C-S-p to go up and down
99;; in the dired buffer while at the same time displaying a thumbnail
100;; image. The thumbnail images will be created on the fly, and
101;; cached. This means that the first time you browse your images, it
102;; will be a bit slow because the thumbnails are created. If you want
103;; to avoid this, you can pre-create the thumbnail images by marking
104;; all images in dired (% m \.jpg$ RET) and then do M-x
105;; tumme-create-thumbs.
106;;
107;; Next, try `tumme-display-thumbs' (C-t d). If no file is marked, a
108;; thumbnail for the file at point will show up in
109;; `tumme-thumbnail-buffer'. If one or more files are marked,
110;; thumbnails for those files will be displayed.
111;;
112;; Pressing TAB will switch to the window containing the
113;; `tumme-thumbnail-buffer' buffer. In there you can move between
114;; thumbnail images and display a semi-sized version in an Emacs
115;; buffer (RET), or the original image in an external viewer
116;; (C-RET). By pressing SPC or DEL you will navigate back and fort
117;; while at the same time displaying each image in Emacs. You can also
118;; navigate using arrow keys. Comment a file by pressing "c". Press
119;; TAB to get back to dired.
120;;
121;; While in dired mode, you can tag and comment files, you can tell
122;; `tumme' to mark files with a certain tag (using a regexp) etc.
123;;
124;; The easiest way to see the available commands is to use the Tumme
125;; menus added in tumme-thumbnail-mode and dired-mode.
126;; 92;;
93;; where DIRNAME is a directory containing image files.
127;; 94;;
128;; LIMITATIONS 95;; LIMITATIONS
129;; =========== 96;; ===========
@@ -488,7 +455,7 @@ completely fit)."
488 :type 'integer 455 :type 'integer
489 :group 'tumme) 456 :group 'tumme)
490 457
491(defcustom tumme-track-movement nil 458(defcustom tumme-track-movement t
492 "The current state of the tracking and mirroring. 459 "The current state of the tracking and mirroring.
493For more information, see the documentation for 460For more information, see the documentation for
494`tumme-toggle-movement-tracking'." 461`tumme-toggle-movement-tracking'."
@@ -541,13 +508,13 @@ Used by `tumme-copy-with-exif-file-name'."
541 :group 'tumme) 508 :group 'tumme)
542 509
543(defcustom tumme-show-all-from-dir-max-files 50 510(defcustom tumme-show-all-from-dir-max-files 50
544 "*Maximum number of files to show using`tumme-show-all-from-dir'. 511 "*Maximum number of files to show using `tumme-show-all-from-dir'.
545before warning the user." 512before warning the user."
546 :type 'integer 513 :type 'integer
547 :group 'tumme) 514 :group 'tumme)
548 515
549(defun tumme-dir () 516(defun tumme-dir ()
550 "Return the current thumbnails directory (from `tumme-dir'). 517 "Return the current thumbnails directory (from variable `tumme-dir').
551Create the thumbnails directory if it does not exist." 518Create the thumbnails directory if it does not exist."
552 (let ((tumme-dir (file-name-as-directory 519 (let ((tumme-dir (file-name-as-directory
553 (expand-file-name tumme-dir)))) 520 (expand-file-name tumme-dir))))
@@ -701,7 +668,7 @@ Otherwise, delete overlays."
701 (interactive) 668 (interactive)
702 (dired-next-line 1) 669 (dired-next-line 1)
703 (tumme-display-thumbs 670 (tumme-display-thumbs
704 t (or tumme-append-when-browsing nil)) 671 t (or tumme-append-when-browsing nil) t)
705 (if tumme-dired-disp-props 672 (if tumme-dired-disp-props
706 (tumme-dired-display-properties))) 673 (tumme-dired-display-properties)))
707 674
@@ -710,7 +677,7 @@ Otherwise, delete overlays."
710 (interactive) 677 (interactive)
711 (dired-previous-line 1) 678 (dired-previous-line 1)
712 (tumme-display-thumbs 679 (tumme-display-thumbs
713 t (or tumme-append-when-browsing nil)) 680 t (or tumme-append-when-browsing nil) t)
714 (if tumme-dired-disp-props 681 (if tumme-dired-disp-props
715 (tumme-dired-display-properties))) 682 (tumme-dired-display-properties)))
716 683
@@ -729,7 +696,7 @@ Otherwise, delete overlays."
729 (interactive) 696 (interactive)
730 (dired-mark 1) 697 (dired-mark 1)
731 (tumme-display-thumbs 698 (tumme-display-thumbs
732 t (or tumme-append-when-browsing nil)) 699 t (or tumme-append-when-browsing nil) t)
733 (if tumme-dired-disp-props 700 (if tumme-dired-disp-props
734 (tumme-dired-display-properties))) 701 (tumme-dired-display-properties)))
735 702
@@ -818,7 +785,7 @@ Restore any changes to the window configuration made by calling
818 (message "No saved window configuration"))) 785 (message "No saved window configuration")))
819 786
820;;;###autoload 787;;;###autoload
821(defun tumme-display-thumbs (&optional arg append) 788(defun tumme-display-thumbs (&optional arg append do-not-pop)
822 "Display thumbnails of all marked files, in `tumme-thumbnail-buffer'. 789 "Display thumbnails of all marked files, in `tumme-thumbnail-buffer'.
823If a thumbnail image does not exist for a file, it is created on the 790If a thumbnail image does not exist for a file, it is created on the
824fly. With prefix argument ARG, display only thumbnail for file at 791fly. With prefix argument ARG, display only thumbnail for file at
@@ -830,7 +797,14 @@ you have the dired buffer in the left window and the
830`tumme-thumbnail-buffer' buffer in the right window. 797`tumme-thumbnail-buffer' buffer in the right window.
831 798
832With optional argument APPEND, append thumbnail to thumbnail buffer 799With optional argument APPEND, append thumbnail to thumbnail buffer
833instead of erasing it first." 800instead of erasing it first.
801
802Option argument DO-NOT-POP controls if `pop-to-buffer' should be
803used or not. If non-nil, use `display-buffer' instead of
804`pop-to-buffer'. This is used from functions like
805`tumme-next-line-and-display' and
806`tumme-previous-line-and-display' where we do not want the
807thumbnail buffer to be selected."
834 (interactive "P") 808 (interactive "P")
835 (let ((buf (tumme-create-thumbnail-buffer)) 809 (let ((buf (tumme-create-thumbnail-buffer))
836 curr-file thumb-name files count dired-buf beg) 810 curr-file thumb-name files count dired-buf beg)
@@ -862,8 +836,11 @@ instead of erasing it first."
862 nil) 836 nil)
863 (t 837 (t
864 (tumme-line-up-dynamic)))) 838 (tumme-line-up-dynamic))))
865 (pop-to-buffer tumme-thumbnail-buffer))) 839 (if do-not-pop
840 (display-buffer tumme-thumbnail-buffer)
841 (pop-to-buffer tumme-thumbnail-buffer))))
866 842
843;;;###autoload
867(defun tumme-show-all-from-dir (dir) 844(defun tumme-show-all-from-dir (dir)
868 "Make a preview buffer for all images in DIR and display it. 845 "Make a preview buffer for all images in DIR and display it.
869If the number of files in DIR matching `image-file-name-regexp' 846If the number of files in DIR matching `image-file-name-regexp'
@@ -905,10 +882,9 @@ displayed."
905 (end-of-line) 882 (end-of-line)
906 (setq end (point)) 883 (setq end (point))
907 (beginning-of-line) 884 (beginning-of-line)
908 (if (not (search-forward (format ";%s" tag) end t)) 885 (when (not (search-forward (format ";%s" tag) end t))
909 (progn 886 (end-of-line)
910 (end-of-line) 887 (insert (format ";%s" tag))))
911 (insert (format ";%s" tag)))))
912 (goto-char (point-max)) 888 (goto-char (point-max))
913 (insert (format "\n%s;%s" file tag)))) 889 (insert (format "\n%s;%s" file tag))))
914 files) 890 files)
@@ -927,27 +903,24 @@ displayed."
927 (mapcar 903 (mapcar
928 (lambda (file) 904 (lambda (file)
929 (goto-char (point-min)) 905 (goto-char (point-min))
930 (if (search-forward-regexp 906 (when (search-forward-regexp
931 (format "^%s" file) nil t) 907 (format "^%s" file) nil t)
932 (progn 908 (end-of-line)
933 (end-of-line) 909 (setq end (point))
934 (setq end (point)) 910 (beginning-of-line)
935 (beginning-of-line) 911 (when (search-forward-regexp (format "\\(;%s\\)" tag) end t)
936 (if (search-forward-regexp (format "\\(;%s\\)" tag) end t) 912 (delete-region (match-beginning 1) (match-end 1))
937 (progn 913 ;; Check if file should still be in the database. If
938 (delete-region (match-beginning 1) (match-end 1)) 914 ;; it has no tags or comments, it will be removed.
939 ;; Check if file should still be in the database. If 915 (end-of-line)
940 ;; it has no tags or comments, it will be removed. 916 (setq end (point))
941 (end-of-line) 917 (beginning-of-line)
942 (setq end (point)) 918 (when (not (search-forward ";" end t))
943 (beginning-of-line) 919 (kill-line 1)
944 (if (not (search-forward ";" end t)) 920 ;; If on empty line at end of buffer
945 (progn 921 (when (and (eobp)
946 (kill-line 1) 922 (looking-at "^$"))
947 ;; If on empty line at end of buffer 923 (delete-backward-char 1))))))
948 (if (and (eobp)
949 (looking-at "^$"))
950 (delete-backward-char 1)))))))))
951 files) 924 files)
952 (save-buffer) 925 (save-buffer)
953 (kill-buffer buf)))) 926 (kill-buffer buf))))
@@ -958,17 +931,16 @@ displayed."
958 (let (end buf (tags "")) 931 (let (end buf (tags ""))
959 (setq buf (find-file tumme-db-file)) 932 (setq buf (find-file tumme-db-file))
960 (goto-char (point-min)) 933 (goto-char (point-min))
961 (if (search-forward-regexp 934 (when (search-forward-regexp
962 (format "^%s" file) nil t) 935 (format "^%s" file) nil t)
963 (progn 936 (end-of-line)
964 (end-of-line) 937 (setq end (point))
965 (setq end (point)) 938 (beginning-of-line)
966 (beginning-of-line) 939 (if (search-forward ";" end t)
967 (if (search-forward ";" end t) 940 (if (search-forward "comment:" end t)
968 (if (search-forward "comment:" end t) 941 (if (search-forward ";" end t)
969 (if (search-forward ";" end t) 942 (setq tags (buffer-substring (point) end)))
970 (setq tags (buffer-substring (point) end))) 943 (setq tags (buffer-substring (point) end)))))
971 (setq tags (buffer-substring (point) end))))))
972 (kill-buffer buf) 944 (kill-buffer buf)
973 (split-string tags ";")))) 945 (split-string tags ";"))))
974 946
@@ -976,7 +948,7 @@ displayed."
976(defun tumme-tag-files (arg) 948(defun tumme-tag-files (arg)
977 "Tag marked file(s) in dired. With prefix ARG, tag file at point." 949 "Tag marked file(s) in dired. With prefix ARG, tag file at point."
978 (interactive "P") 950 (interactive "P")
979 (let ((tag (read-string "Tag to add: ")) 951 (let ((tag (read-string "Tags to add (separate tags with a semicolon): "))
980 curr-file files) 952 curr-file files)
981 (if arg 953 (if arg
982 (setq files (dired-get-filename)) 954 (setq files (dired-get-filename))
@@ -986,13 +958,13 @@ displayed."
986(defun tumme-tag-thumbnail () 958(defun tumme-tag-thumbnail ()
987 "Tag current thumbnail." 959 "Tag current thumbnail."
988 (interactive) 960 (interactive)
989 (let ((tag (read-string "Tag to add: "))) 961 (let ((tag (read-string "Tags to add (separate tags with a semicolon): ")))
990 (tumme-write-tag (tumme-original-file-name) tag)) 962 (tumme-write-tag (tumme-original-file-name) tag))
991 (tumme-update-property 963 (tumme-update-property
992 'tags (tumme-list-tags (tumme-original-file-name)))) 964 'tags (tumme-list-tags (tumme-original-file-name))))
993 965
994;;;###autoload 966;;;###autoload
995(defun tumme-tag-remove (arg) 967(defun tumme-delete-tag (arg)
996 "Remove tag for selected file(s). 968 "Remove tag for selected file(s).
997With prefix argument ARG, remove tag from file at point." 969With prefix argument ARG, remove tag from file at point."
998 (interactive "P") 970 (interactive "P")
@@ -1034,17 +1006,16 @@ use only useful if `tumme-track-movement' is nil."
1034 (let ((old-buf (current-buffer)) 1006 (let ((old-buf (current-buffer))
1035 (dired-buf (tumme-associated-dired-buffer)) 1007 (dired-buf (tumme-associated-dired-buffer))
1036 (file-name (tumme-original-file-name))) 1008 (file-name (tumme-original-file-name)))
1037 (if (and dired-buf file-name) 1009 (when (and dired-buf file-name)
1038 (progn 1010 (setq file-name (file-name-nondirectory file-name))
1039 (setq file-name (file-name-nondirectory file-name)) 1011 (set-buffer dired-buf)
1040 (set-buffer dired-buf) 1012 (goto-char (point-min))
1041 (goto-char (point-min)) 1013 (if (not (search-forward file-name nil t))
1042 (if (not (search-forward file-name nil t)) 1014 (message "Could not track file")
1043 (message "Could not track file") 1015 (dired-move-to-filename)
1044 (dired-move-to-filename) 1016 (set-window-point
1045 (set-window-point 1017 (tumme-get-buffer-window dired-buf) (point)))
1046 (tumme-get-buffer-window dired-buf) (point))) 1018 (set-buffer old-buf))))
1047 (set-buffer old-buf)))))
1048 1019
1049(defun tumme-toggle-movement-tracking () 1020(defun tumme-toggle-movement-tracking ()
1050 "Turn on and off `tumme-track-movement'. 1021 "Turn on and off `tumme-track-movement'.
@@ -1063,24 +1034,22 @@ the other way around."
1063 (let ((file (dired-get-filename)) 1034 (let ((file (dired-get-filename))
1064 (old-buf (current-buffer)) 1035 (old-buf (current-buffer))
1065 prop-val found) 1036 prop-val found)
1066 (if (get-buffer tumme-thumbnail-buffer) 1037 (when (get-buffer tumme-thumbnail-buffer)
1067 (progn 1038 (set-buffer tumme-thumbnail-buffer)
1068 (set-buffer tumme-thumbnail-buffer) 1039 (goto-char (point-min))
1069 (goto-char (point-min)) 1040 (while (and (not (eobp))
1070 (while (and (not (eobp)) 1041 (not found))
1071 (not found)) 1042 (if (and (setq prop-val
1072 (if (and (setq prop-val 1043 (get-text-property (point) 'original-file-name))
1073 (get-text-property (point) 'original-file-name)) 1044 (string= prop-val file))
1074 (string= prop-val file)) 1045 (setq found t))
1075 (setq found t)) 1046 (if (not found)
1076 (if (not found) 1047 (forward-char 1)))
1077 (forward-char 1))) 1048 (when found
1078 (if found 1049 (set-window-point
1079 (progn 1050 (tumme-thumbnail-window) (point))
1080 (set-window-point 1051 (tumme-display-thumb-properties))
1081 (tumme-thumbnail-window) (point)) 1052 (set-buffer old-buf))))
1082 (tumme-display-thumb-properties)))
1083 (set-buffer old-buf)))))
1084 1053
1085(defun tumme-dired-next-line (&optional arg) 1054(defun tumme-dired-next-line (&optional arg)
1086 "Call `dired-next-line', then track thumbnail. 1055 "Call `dired-next-line', then track thumbnail.
@@ -1105,29 +1074,27 @@ move ARG lines."
1105 (interactive) 1074 (interactive)
1106 ;; Before we move, make sure that there is an image two positions 1075 ;; Before we move, make sure that there is an image two positions
1107 ;; forward. 1076 ;; forward.
1108 (if (save-excursion 1077 (when (save-excursion
1109 (forward-char 2) 1078 (forward-char 2)
1110 (tumme-image-at-point-p)) 1079 (tumme-image-at-point-p))
1111 (progn 1080 (forward-char)
1112 (forward-char) 1081 (while (and (not (eobp))
1113 (while (and (not (eobp)) 1082 (not (tumme-image-at-point-p)))
1114 (not (tumme-image-at-point-p))) 1083 (forward-char))
1115 (forward-char)) 1084 (if tumme-track-movement
1116 (if tumme-track-movement 1085 (tumme-track-original-file)))
1117 (tumme-track-original-file))))
1118 (tumme-display-thumb-properties)) 1086 (tumme-display-thumb-properties))
1119 1087
1120(defun tumme-backward-char () 1088(defun tumme-backward-char ()
1121 "Move to previous image and display properties." 1089 "Move to previous image and display properties."
1122 (interactive) 1090 (interactive)
1123 (if (not (bobp)) 1091 (when (not (bobp))
1124 (progn 1092 (backward-char)
1125 (backward-char) 1093 (while (and (not (bobp))
1126 (while (and (not (bobp)) 1094 (not (tumme-image-at-point-p)))
1127 (not (tumme-image-at-point-p))) 1095 (backward-char))
1128 (backward-char)) 1096 (if tumme-track-movement
1129 (if tumme-track-movement 1097 (tumme-track-original-file)))
1130 (tumme-track-original-file))))
1131 (tumme-display-thumb-properties)) 1098 (tumme-display-thumb-properties))
1132 1099
1133(defun tumme-next-line () 1100(defun tumme-next-line ()
@@ -1515,9 +1482,9 @@ Note that n, p and <down> and <up> will be hijacked and bound to
1515 1482
1516 (define-key dired-mode-map "\C-td" 'tumme-display-thumbs) 1483 (define-key dired-mode-map "\C-td" 'tumme-display-thumbs)
1517 (define-key dired-mode-map "\C-tt" 'tumme-tag-files) 1484 (define-key dired-mode-map "\C-tt" 'tumme-tag-files)
1518 (define-key dired-mode-map "\C-tr" 'tumme-tag-remove) 1485 (define-key dired-mode-map "\C-tr" 'tumme-delete-tag)
1519 (define-key dired-mode-map [tab] 'tumme-jump-thumbnail-buffer) 1486 (define-key dired-mode-map [tab] 'tumme-jump-thumbnail-buffer)
1520 (define-key dired-mode-map "\C-ti" 'tumme-display-dired-image) 1487 (define-key dired-mode-map "\C-ti" 'tumme-dired-display-image)
1521 (define-key dired-mode-map "\C-tx" 'tumme-dired-display-external) 1488 (define-key dired-mode-map "\C-tx" 'tumme-dired-display-external)
1522 (define-key dired-mode-map "\C-ta" 'tumme-display-thumbs-append) 1489 (define-key dired-mode-map "\C-ta" 'tumme-display-thumbs-append)
1523 (define-key dired-mode-map "\C-t." 'tumme-display-thumb) 1490 (define-key dired-mode-map "\C-t." 'tumme-display-thumb)
@@ -1537,8 +1504,8 @@ Note that n, p and <down> and <up> will be hijacked and bound to
1537 (define-key dired-mode-map [menu-bar tumme tumme-mark-tagged-files] 1504 (define-key dired-mode-map [menu-bar tumme tumme-mark-tagged-files]
1538 '("Mark tagged files" . tumme-mark-tagged-files)) 1505 '("Mark tagged files" . tumme-mark-tagged-files))
1539 1506
1540 (define-key dired-mode-map [menu-bar tumme tumme-tag-remove] 1507 (define-key dired-mode-map [menu-bar tumme tumme-delete-tag]
1541 '("Remove tag from files" . tumme-tag-remove)) 1508 '("Remove tag from files" . tumme-delete-tag))
1542 1509
1543 (define-key dired-mode-map [menu-bar tumme tumme-tag-files] 1510 (define-key dired-mode-map [menu-bar tumme tumme-tag-files]
1544 '("Tag files" . tumme-tag-files)) 1511 '("Tag files" . tumme-tag-files))
@@ -1561,8 +1528,8 @@ Note that n, p and <down> and <up> will be hijacked and bound to
1561 [menu-bar tumme tumme-dired-display-external] 1528 [menu-bar tumme tumme-dired-display-external]
1562 '("Display in external viewer" . tumme-dired-display-external)) 1529 '("Display in external viewer" . tumme-dired-display-external))
1563 (define-key dired-mode-map 1530 (define-key dired-mode-map
1564 [menu-bar tumme tumme-display-dired-image] 1531 [menu-bar tumme tumme-dired-display-image]
1565 '("Display image" . tumme-display-dired-image)) 1532 '("Display image" . tumme-dired-display-image))
1566 (define-key dired-mode-map 1533 (define-key dired-mode-map
1567 [menu-bar tumme tumme-display-thumb] 1534 [menu-bar tumme tumme-display-thumb]
1568 '("Display this thumbnail" . tumme-display-thumb)) 1535 '("Display this thumbnail" . tumme-display-thumb))
@@ -1658,13 +1625,13 @@ Ask user for number of images to show and the delay in between."
1658(defun tumme-display-thumbs-append () 1625(defun tumme-display-thumbs-append ()
1659 "Append thumbnails to `tumme-thumbnail-buffer'." 1626 "Append thumbnails to `tumme-thumbnail-buffer'."
1660 (interactive) 1627 (interactive)
1661 (tumme-display-thumbs nil t)) 1628 (tumme-display-thumbs nil t t))
1662 1629
1663;;;###autoload 1630;;;###autoload
1664(defun tumme-display-thumb () 1631(defun tumme-display-thumb ()
1665 "Shorthard for `tumme-display-thumbs' with prefix argument." 1632 "Shorthard for `tumme-display-thumbs' with prefix argument."
1666 (interactive) 1633 (interactive)
1667 (tumme-display-thumbs t)) 1634 (tumme-display-thumbs t nil t))
1668 1635
1669(defun tumme-line-up () 1636(defun tumme-line-up ()
1670 "Line up thumbnails according to `tumme-thumbs-per-row'. 1637 "Line up thumbnails according to `tumme-thumbs-per-row'.
@@ -1688,11 +1655,10 @@ See also `tumme-line-up-dynamic'."
1688 (insert "\n") 1655 (insert "\n")
1689 (insert " ") 1656 (insert " ")
1690 (setq count (1+ count)) 1657 (setq count (1+ count))
1691 (if (= count (- tumme-thumbs-per-row 1)) 1658 (when (= count (- tumme-thumbs-per-row 1))
1692 (progn 1659 (forward-char)
1693 (forward-char) 1660 (insert "\n")
1694 (insert "\n") 1661 (setq count 0)))))
1695 (setq count 0))))))
1696 (goto-char (point-min)))) 1662 (goto-char (point-min))))
1697 1663
1698(defun tumme-line-up-dynamic () 1664(defun tumme-line-up-dynamic ()
@@ -1786,13 +1752,11 @@ Ask user how many thumbnails should be displayed per row."
1786 1752
1787(defun tumme-display-image (file &optional original-size) 1753(defun tumme-display-image (file &optional original-size)
1788 "Display image FILE in image buffer. 1754 "Display image FILE in image buffer.
1789Use this when you want to display the image, semi sized, in a window 1755Use this when you want to display the image, semi sized, in a new
1790next to the thumbnail window - typically a three-window configuration 1756window. The image is sized to fit the display window (using a
1791with dired to the left, thumbnail window to the upper right and image 1757temporary file, don't worry). Because of this, it will not be as
1792window to the lower right. The image is sized to fit the display 1758quick as opening it directly, but on most modern systems it
1793window (using a temporary file, don't worry). Because of this, it 1759should feel snappy enough.
1794will not be as quick as opening it directly, but on most modern
1795systems it should feel snappy enough.
1796 1760
1797If optional argument ORIGINAL-SIZE is non-nil, display image in its 1761If optional argument ORIGINAL-SIZE is non-nil, display image in its
1798original size." 1762original size."
@@ -1841,12 +1805,13 @@ With prefix argument ARG, display image in its original size."
1841 (display-buffer tumme-display-image-buffer)))))) 1805 (display-buffer tumme-display-image-buffer))))))
1842 1806
1843;;;###autoload 1807;;;###autoload
1844(defun tumme-display-dired-image (&optional arg) 1808(defun tumme-dired-display-image (&optional arg)
1845 "Display current image file. 1809 "Display current image file.
1846See documentation for `tumme-display-image' for more information. 1810See documentation for `tumme-display-image' for more information.
1847With prefix argument ARG, display image in its original size." 1811With prefix argument ARG, display image in its original size."
1848 (interactive "P") 1812 (interactive "P")
1849 (tumme-display-image (dired-get-filename) arg)) 1813 (tumme-display-image (dired-get-filename) arg)
1814 (display-buffer tumme-display-image-buffer))
1850 1815
1851(defun tumme-image-at-point-p () 1816(defun tumme-image-at-point-p ()
1852 "Return true if there is a tumme thumbnail at point." 1817 "Return true if there is a tumme thumbnail at point."
@@ -2122,19 +2087,18 @@ as initial value."
2122 (let (end buf comment-beg comment (base-name (file-name-nondirectory file))) 2087 (let (end buf comment-beg comment (base-name (file-name-nondirectory file)))
2123 (setq buf (find-file tumme-db-file)) 2088 (setq buf (find-file tumme-db-file))
2124 (goto-char (point-min)) 2089 (goto-char (point-min))
2125 (if (search-forward-regexp 2090 (when (search-forward-regexp
2126 (format "^%s" base-name) nil t) 2091 (format "^%s" base-name) nil t)
2127 (progn 2092 (end-of-line)
2128 (end-of-line) 2093 (setq end (point))
2129 (setq end (point)) 2094 (beginning-of-line)
2130 (beginning-of-line) 2095 (cond ((search-forward ";comment:" end t)
2131 (cond ((search-forward ";comment:" end t) 2096 (setq comment-beg (point))
2132 (setq comment-beg (point)) 2097 (if (search-forward ";" end t)
2133 (if (search-forward ";" end t) 2098 (setq comment-end (- (point) 1))
2134 (setq comment-end (- (point) 1)) 2099 (setq comment-end end))
2135 (setq comment-end end)) 2100 (setq comment (buffer-substring
2136 (setq comment (buffer-substring 2101 comment-beg comment-end)))))
2137 comment-beg comment-end))))))
2138 (kill-buffer buf) 2102 (kill-buffer buf)
2139 comment))) 2103 comment)))
2140 2104
diff --git a/lisp/vc.el b/lisp/vc.el
index 61b8aa05a4b..54237800e3c 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -894,10 +894,12 @@ However, before executing BODY, find FILE, and after BODY, save buffer."
894 894
895(defun vc-process-filter (p s) 895(defun vc-process-filter (p s)
896 "An alternative output filter for async process P. 896 "An alternative output filter for async process P.
897The only difference with the default filter is to insert S after markers." 897One difference with the default filter is that this inserts S after markers.
898Another is that undo information is not kept."
898 (with-current-buffer (process-buffer p) 899 (with-current-buffer (process-buffer p)
899 (save-excursion 900 (save-excursion
900 (let ((inhibit-read-only t)) 901 (let ((buffer-undo-list t)
902 (inhibit-read-only t))
901 (goto-char (process-mark p)) 903 (goto-char (process-mark p))
902 (insert s) 904 (insert s)
903 (set-marker (process-mark p) (point)))))) 905 (set-marker (process-mark p) (point))))))
@@ -914,7 +916,8 @@ BUF defaults to \"*vc*\", can be a string and will be created if necessary."
914 (set (make-local-variable 'vc-parent-buffer-name) 916 (set (make-local-variable 'vc-parent-buffer-name)
915 (concat " from " (buffer-name camefrom))) 917 (concat " from " (buffer-name camefrom)))
916 (setq default-directory olddir) 918 (setq default-directory olddir)
917 (let ((inhibit-read-only t)) 919 (let ((buffer-undo-list t)
920 (inhibit-read-only t))
918 (erase-buffer)))) 921 (erase-buffer))))
919 922
920(defun vc-exec-after (code) 923(defun vc-exec-after (code)
@@ -1003,7 +1006,8 @@ that is inserted into the command line before the filename."
1003 (vc-exec-after 1006 (vc-exec-after
1004 `(unless (active-minibuffer-window) 1007 `(unless (active-minibuffer-window)
1005 (message "Running %s in the background... done" ',command)))) 1008 (message "Running %s in the background... done" ',command))))
1006 (setq status (apply 'process-file command nil t nil squeezed)) 1009 (let ((buffer-undo-list t))
1010 (setq status (apply 'process-file command nil t nil squeezed)))
1007 (when (and (not (eq t okstatus)) 1011 (when (and (not (eq t okstatus))
1008 (or (not (integerp status)) 1012 (or (not (integerp status))
1009 (and okstatus (< okstatus status)))) 1013 (and okstatus (< okstatus status))))
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 7f3cbd913ca..449606607f6 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -430,7 +430,7 @@ and:
430 (if buffer-read-only 430 (if buffer-read-only
431 (if (not quiet) 431 (if (not quiet)
432 (message "Can't cleanup: %s is read-only" (buffer-name))) 432 (message "Can't cleanup: %s is read-only" (buffer-name)))
433 (whitespace-cleanup)) 433 (whitespace-cleanup-internal))
434 (let ((whitespace-leading (if whitespace-check-buffer-leading 434 (let ((whitespace-leading (if whitespace-check-buffer-leading
435 (whitespace-buffer-leading) 435 (whitespace-buffer-leading)
436 nil)) 436 nil))
@@ -520,6 +520,11 @@ and:
520 "Cleanup the five different kinds of whitespace problems. 520 "Cleanup the five different kinds of whitespace problems.
521See `whitespace-buffer' docstring for a summary of the problems." 521See `whitespace-buffer' docstring for a summary of the problems."
522 (interactive) 522 (interactive)
523 (if (and transient-mark-mode mark-active)
524 (whitespace-cleanup-region (region-beginning) (region-end))
525 (whitespace-cleanup-internal)))
526
527(defun whitespace-cleanup-internal ()
523 ;; If this buffer really contains a file, then run, else quit. 528 ;; If this buffer really contains a file, then run, else quit.
524 (whitespace-check-whitespace-mode current-prefix-arg) 529 (whitespace-check-whitespace-mode current-prefix-arg)
525 (if (and buffer-file-name whitespace-mode) 530 (if (and buffer-file-name whitespace-mode)
@@ -563,7 +568,7 @@ See `whitespace-buffer' docstring for a summary of the problems."
563 568
564 ;; Call this recursively till everything is taken care of 569 ;; Call this recursively till everything is taken care of
565 (if whitespace-any 570 (if whitespace-any
566 (whitespace-cleanup) 571 (whitespace-cleanup-internal)
567 (progn 572 (progn
568 (if (not whitespace-silent) 573 (if (not whitespace-silent)
569 (message "%s clean" buffer-file-name)) 574 (message "%s clean" buffer-file-name))
@@ -577,7 +582,7 @@ See `whitespace-buffer' docstring for a summary of the problems."
577 (save-excursion 582 (save-excursion
578 (save-restriction 583 (save-restriction
579 (narrow-to-region s e) 584 (narrow-to-region s e)
580 (whitespace-cleanup)) 585 (whitespace-cleanup-internal))
581 (whitespace-buffer t))) 586 (whitespace-buffer t)))
582 587
583(defun whitespace-buffer-leading () 588(defun whitespace-buffer-leading ()
@@ -760,7 +765,7 @@ If timer is not set, then set it to scan the files in
760 (if whitespace-auto-cleanup 765 (if whitespace-auto-cleanup
761 (progn 766 (progn
762 ;;(message "cleaning up whitespace in %s" bufname) 767 ;;(message "cleaning up whitespace in %s" bufname)
763 (whitespace-cleanup)) 768 (whitespace-cleanup-internal))
764 (progn 769 (progn
765 ;;(message "whitespace-buffer %s." (buffer-name)) 770 ;;(message "whitespace-buffer %s." (buffer-name))
766 (whitespace-buffer t)))) 771 (whitespace-buffer t))))
@@ -806,7 +811,7 @@ This is meant to be added buffer-locally to `write-file-functions'."
806 (interactive) 811 (interactive)
807 (let ((werr nil)) 812 (let ((werr nil))
808 (if whitespace-auto-cleanup 813 (if whitespace-auto-cleanup
809 (whitespace-cleanup) 814 (whitespace-cleanup-internal)
810 (setq werr (whitespace-buffer))) 815 (setq werr (whitespace-buffer)))
811 (if (and whitespace-abort-on-error werr) 816 (if (and whitespace-abort-on-error werr)
812 (error (concat "Abort write due to whitespaces in " 817 (error (concat "Abort write due to whitespaces in "
diff --git a/lisp/window.el b/lisp/window.el
index 4d02390be16..ef9dd5d896d 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -597,7 +597,7 @@ in some window."
597 (1+ (vertical-motion (buffer-size) window)))))) 597 (1+ (vertical-motion (buffer-size) window))))))
598 598
599(defun fit-window-to-buffer (&optional window max-height min-height) 599(defun fit-window-to-buffer (&optional window max-height min-height)
600 "Make WINDOW the right size to display its contents exactly. 600 "Make WINDOW the right height to display its contents exactly.
601If WINDOW is omitted or nil, it defaults to the selected window. 601If WINDOW is omitted or nil, it defaults to the selected window.
602If the optional argument MAX-HEIGHT is supplied, it is the maximum height 602If the optional argument MAX-HEIGHT is supplied, it is the maximum height
603 the window is allowed to be, defaulting to the frame height. 603 the window is allowed to be, defaulting to the frame height.
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index a5b6d409b87..693a2d7fa4b 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -256,14 +256,20 @@ STRING is the uri-list as a string. The URIs are separated by \r\n."
256 retval)) 256 retval))
257 257
258(defun x-dnd-handle-file-name (window action string) 258(defun x-dnd-handle-file-name (window action string)
259 "Prepend file:// to file names and call `dnd-handle-one-url'. 259 "Convert file names to URLs and call `dnd-handle-one-url'.
260WINDOW is the window where the drop happened. 260WINDOW is the window where the drop happened.
261STRING is the file names as a string, separated by nulls." 261STRING is the file names as a string, separated by nulls."
262 (let ((uri-list (split-string string "[\0\r\n]" t)) 262 (let ((uri-list (split-string string "[\0\r\n]" t))
263 (coding (and default-enable-multibyte-characters
264 (or file-name-coding-system
265 default-file-name-coding-system)))
263 retval) 266 retval)
264 (dolist (bf uri-list) 267 (dolist (bf uri-list)
265 ;; If one URL is handeled, treat as if the whole drop succeeded. 268 ;; If one URL is handeled, treat as if the whole drop succeeded.
266 (let* ((file-uri (concat "file://" bf)) 269 (if coding (setq bf (encode-coding-string bf coding)))
270 (let* ((file-uri (concat "file://"
271 (mapconcat 'url-hexify-string
272 (split-string bf "/") "/")))
267 (did-action (dnd-handle-one-url window action file-uri))) 273 (did-action (dnd-handle-one-url window action file-uri)))
268 (when did-action (setq retval did-action)))) 274 (when did-action (setq retval did-action))))
269 retval)) 275 retval))