aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog307
-rw-r--r--lisp/allout.el813
-rw-r--r--lisp/avoid.el25
-rw-r--r--lisp/bindings.el102
-rw-r--r--lisp/buff-menu.el8
-rw-r--r--lisp/calendar/timeclock.el16
-rw-r--r--lisp/compare-w.el34
-rw-r--r--lisp/complete.el73
-rw-r--r--lisp/cus-edit.el9
-rw-r--r--lisp/cus-start.el2
-rw-r--r--lisp/cus-theme.el6
-rw-r--r--lisp/emacs-lisp/bindat.el9
-rw-r--r--lisp/emacs-lisp/edebug.el10
-rw-r--r--lisp/erc/ChangeLog38
-rw-r--r--lisp/erc/erc-backend.el15
-rw-r--r--lisp/erc/erc-log.el22
-rw-r--r--lisp/erc/erc-match.el2
-rw-r--r--lisp/erc/erc.el39
-rw-r--r--lisp/eshell/em-glob.el3
-rw-r--r--lisp/facemenu.el71
-rw-r--r--lisp/faces.el2
-rw-r--r--lisp/filesets.el2
-rw-r--r--lisp/font-lock.el32
-rw-r--r--lisp/gnus/ChangeLog24
-rw-r--r--lisp/gnus/compface.el40
-rw-r--r--lisp/gnus/mm-extern.el2
-rw-r--r--lisp/gnus/nnheader.el2
-rw-r--r--lisp/gnus/nnweb.el11
-rw-r--r--lisp/help.el21
-rw-r--r--lisp/info.el2
-rw-r--r--lisp/international/latexenc.el10
-rw-r--r--lisp/international/mule-diag.el30
-rw-r--r--lisp/net/zone-mode.el120
-rw-r--r--lisp/newcomment.el11
-rw-r--r--lisp/pcvs.el2
-rw-r--r--lisp/progmodes/gdb-ui.el170
-rw-r--r--lisp/progmodes/gud.el10
-rw-r--r--lisp/progmodes/sh-script.el13
-rw-r--r--lisp/simple.el30
-rw-r--r--lisp/term/x-win.el9
-rw-r--r--lisp/term/xterm.el31
-rw-r--r--lisp/textmodes/dns-mode.el31
-rw-r--r--lisp/textmodes/org.el577
-rw-r--r--lisp/x-dnd.el6
44 files changed, 1818 insertions, 974 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index dabcdb2f911..53f8448edfc 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,294 @@
12006-08-16 Richard Stallman <rms@gnu.org>
2
3 * term/x-win.el (x-clipboard-yank): Specify * in interactive spec.
4 (special-event-map): Process drag-n-drop events this way.
5
6 * simple.el (move-beginning-of-line): Test whether fields
7 would prevent motion back to line's first visible character.
8 If so, stop where the fields would stop the motion.
9
10 * newcomment.el (comment-indent): Fully update INDENT
11 before checking to see if it will change the text.
12
13 * cus-edit.el (custom-newline): New function.
14 (custom-mode-map): Bind newline to custom-newline.
15
16 * compare-w.el (compare-windows): Factor compare-ignore-whitespace
17 into ignore-whitespace.
18 Check each buffer for its skip-function.
19 Handle compare-windows-skip-whitespace special-case test
20 by returning t from default skip function.
21
222006-08-15 Carsten Dominik <dominik@science.uva.nl>
23
24 * textmodes/org.el (org-clock-special-range,
25 org-clock-update-time-maybe): New functions.
26 (org-stamp-time-of-day-regexp): Allow weekday to be of word chars,
27 not only a-z.
28 (org-agenda-get-blocks): Allow multiple blocks per headline.
29 (org-timestamp-change): Call `org-clock-update-time-maybe'.
30 (org-export-html-title-format)
31 (org-export-html-toplevel-hlevel): New options.
32 (org-export-language-setup): Added support for Czech.
33 (org-mode, org-insert-todo-heading, org-find-visible)
34 (org-find-invisible, org-invisible-p, org-invisible-p2)
35 (org-back-to-heading, org-on-heading-p, org-up-heading-all)
36 (org-show-subtree, org-show-entry, org-make-options-regexp):
37 Removed compatibility support for old outline-mode.
38 (org-check-occur-regexp): Funtion removed.
39 (org-on-heading-p, org-back-to-heading): Made defalias.
40 (org-set-local): New defsubst.
41 (org-set-regexps-and-options, org-mode)
42 (org-set-font-lock-defaults, org-edit-agenda-file-list)
43 (org-timeline, org-agenda-list, org-todo-list, org-tags-view)
44 (org-remember-apply-template, org-table-edit-field)
45 (org-table-edit-formulas, orgtbl-mode, org-export-as-ascii)
46 (org-set-autofill-regexps): Use `org-set-local'.
47 (org-table-eval-formula): Fixed bug with parsing of display flags.
48
492006-08-15 Nick Roberts <nickrob@snap.net.nz>
50
51 * progmodes/gdb-ui.el (gdb-info-stack-custom): Indicate selected
52 frame with fringe arrow. Suggested by Simon Marshall
53 <simon.marshall@misys.com>.
54 (gdb-stack-position): New variable.
55 (gdb-starting, gdb-exited): Reset gdb-stack-position to nil.
56 (gdb-frames-mode): Set gdb-stack-position to nil. Add to
57 overlay-arrow-variable-list
58 (gdb-reset): Delete gdb-stack-position from above list.
59
602006-08-14 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
61
62 * term/x-win.el (menu-bar-edit-menu): Disable paste if buffer is
63 read only.
64
652006-08-13 Romain Francoise <romain@orebokech.com>
66
67 * cus-theme.el (customize-create-theme)
68 (custom-theme-visit-theme): End `y-or-n-p' prompt with a space.
69
70 * filesets.el (filesets-add-buffer): Ditto.
71
72 * pcvs.el (cvs-change-cvsroot): Ditto.
73
742006-08-13 Nick Roberts <nickrob@snap.net.nz>
75
76 * progmodes/gdb-ui.el (gdb-frame-separate-io-buffer)
77 (gdb-use-separate-io-buffer, menu): Avoid using `inferior' in text.
78 (gdb-memory-mode, gdb-locals-watch-map): Don't quote lambda
79 expressions.
80 (gdb-info-breakpoints-custom): Use gdb-breakpoint-regexp.
81 Only search till end of line.
82 Add face to function names in case of no filename.
83 Add face to variable names of watchpoints.
84
852006-08-12 Robert Thorpe <rthorpe@realworldtech.com> (tiny change)
86
87 * cus-start.el <indent-tabs-mode>: Move to the `indent'
88 customization group.
89
902006-08-12 Ken Manheimer <ken.manheimer@gmail.com>
91
92 * allout.el (allout-prior-bindings, allout-added-bindings):
93 Remove, after long deprecation.
94 (allout-beginning-of-line-cycles, allout-end-of-line-cycles):
95 Add customization vars controlling allout-beginning-of-line and
96 allout-end-of-line conveniences.
97 (allout-header-prefix, allout-use-mode-specific-leader)
98 (allout-use-mode-specific-leader, allout-mode-leaders): Revised
99 docstrings.
100 (allout-infer-header-lead): Change to be an alias for
101 allout-infer-header-lead-and-primary-bullet.
102 (allout-infer-header-lead-and-primary-bullet): New version of
103 allout-infer-header-lead which assigns the primary bullet to the
104 same as the header lead, when its being changed.
105 (allout-infer-body-reindent): Apply regexp-quote instead of
106 unconditionally prepending "\\", so that all literal
107 allout-header-prefix and allout-primary-bullet strings are
108 properly handled.
109 (allout-add-resumptions): Add optional qualifier for extending or
110 appending to existing values, rather than replacing them.
111 (allout-view-change-hook): Clarify docstring.
112 (allout-exposure-change-hook): Take explicit arguments, via
113 run-hook-with-args.
114 (allout-structure-added-hook)
115 (allout-structure-deleted-hook)
116 (allout-structure-shifted-hook): New hooks analogous to
117 allout-exposure-change-hook for other kinds of structural outline
118 edits.
119 (allout-encryption-plaintext-sanitization-regexps): New encryption
120 customization variable, by which cooperating modes can provde
121 massage of the plaintext without actually being passed it.
122 (allout-encryption-ciphertext-rejection-regexps)
123 (allout-encryption-ciphertext-rejection-ceiling): New encryption
124 customization variables, by which cooperating modes can prohibit
125 rare but possible ciphertext patterns from fouling their
126 operation, with actually being passed the ciphertext.
127 (allout-mode): Run activation and deactivation hooks after the
128 minor-mode variable has been toggled, to clarify the mode
129 disposition. The new encryption ciphertext rejection variable is
130 used to ensure that the ciphertext does not contain text that
131 would be recognized as outline structural elements by allout.
132 Substite allout-beginning-of-line and allout-end-of-line for
133 conventionall beginning-of-line and end-of-line bindings.
134 If allout-old-style-prefixes is non-nil, don't nullify it on mode
135 activation!
136 (allout-beginning-of-line): Respect `allout-beginning-of-line-cycles'.
137 (allout-end-of-line): Respect `allout-end-of-line-cycles'.
138 (allout-chart-subtree): Implement new mode, charting only the
139 visible items in the subtree, when new 'visible' parameter is
140 non-nil.
141 (allout-end-of-subtree): Properly handle the last item in the
142 buffer.
143 (allout-pre-command-business, allout-command-counter): Increment
144 an advertised counter so that cooperating enhancements can track
145 revisions of items.
146 (allout-open-topic): Run allout-structure-added-hook with suitable
147 arguments.
148 (allout-shift-in): Run allout-structure-shifted-hook with suitable
149 arguments.
150 (allout-shift-out): Fix doubling for negative args and ensure call
151 of allout-structure-shifted-hook by solely using allout-shift-in.
152 (allout-kill-line, allout-kill-topic): Run
153 allout-structure-deleted-hook with suitable arguments.
154 (allout-yank-processing): Run allout-structure-added-hook with
155 proper arguments.
156 (allout-yank): Enclose activity in allout-unprotected.
157 (allout-flag-region): Run allout-exposure-change-hook with
158 suitable arguments, instead of making the callee infer the
159 arguments.
160 (allout-encrypt-string): Support
161 allout-encryption-plaintext-sanitization-regexps,
162 allout-encryption-ciphertext-rejection-regexps, and
163 allout-encryption-ciphertext-rejection-ceiling. Indicate correct
164 en/de cryption mode in symmetric encryption failure message.
165 (allout-obtain-passphrase): Use copy-sequence to get a distinct
166 copy of the passphrase, and don't zero it or we'll corrupt the
167 stashed copy.
168 (allout-create-encryption-passphrase-verifier)
169 (allout-verify-passphrase): Respect the new signature for
170 allout-encrypt-string.
171 (allout-get-configvar-values): Convenience for getting a
172 configuration variable value and handling its absence gracefully.
173
1742006-08-11 Romain Francoise <romain@orebokech.com>
175
176 * obsolete/zone-mode.el: Delete.
177
1782006-08-11 Stefan Monnier <monnier@iro.umontreal.ca>
179
180 * textmodes/dns-mode.el (dns-mode): Use before-save-hook.
181
1822006-08-11 Thien-Thi Nguyen <ttn@gnu.org>
183
184 * emacs-lisp/bindat.el (bindat-ip-to-string):
185 Use `format-network-address' if possible.
186
1872006-08-11 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
188
189 * x-dnd.el (x-dnd-init-frame): Call x-register-dnd-atom.
190
1912006-08-10 Chong Yidong <cyd@stupidchicken.com>
192
193 * emacs-lisp/edebug.el (edebug-recursive-edit): Don't save and
194 restore unread-command-events here.
195 (edebug-display): Do it here, to detect sit-for interruptions.
196
1972006-08-10 Romain Francoise <romain@orebokech.com>
198
199 * textmodes/dns-mode.el: Alias `zone-mode' to `dns-mode'.
200 (dns-mode-soa-auto-increment-serial): New user option.
201 (dns-mode-soa-maybe-increment-serial): New function.
202 (dns-mode): Add the latter to `write-contents-functions'.
203
204 * obsolete/zone-mode.el: Move to obsolete/ from net/.
205 Delete autoload cookies.
206
2072006-08-10 John Wiegley <johnw@newartisans.com>
208
209 * eshell/em-glob.el (eshell-glob-chars-list)
210 (eshell-glob-translate-alist): Add support for [^g] in character globs.
211
2122006-08-10 Richard Stallman <rms@gnu.org>
213
214 * facemenu.el (facemenu-add-face): Pass frame to facemenu-active-faces.
215 (facemenu-set-face): Doc fix.
216 (facemenu-listed-faces): Doc fix.
217
2182006-08-09 Chong Yidong <cyd@stupidchicken.com>
219
220 * avoid.el (mouse-avoidance-animating-pointer): New var.
221 (mouse-avoidance-nudge-mouse): Use it.
222 (mouse-avoidance-banish): Rename from mouse-avoidance-banish-hook.
223 (mouse-avoidance-exile): Rename from mouse-avoidance-exile-hook
224 (mouse-avoidance-fancy): Rename from mouse-avoidance-fancy-hook.
225 Don't activate if currently animating. All callers changed.
226
2272006-08-09 John Wiegley <johnw@newartisans.com>
228
229 * calendar/timeclock.el (timeclock-use-elapsed): Added a new
230 variable, which causes timeclock to report elapsed time worked,
231 instead of just work remaining.
232
2332006-08-09 Kenichi Handa <handa@m17n.org>
234
235 * international/latexenc.el (latexenc-find-file-coding-system):
236 Fix for the case that the 2nd element of arg-list is a cons.
237
2382006-08-08 Chong Yidong <cyd@stupidchicken.com>
239
240 * info.el (Info-fontify-node): Handle preceding `in' for note
241 reference hiding rules.
242
2432006-08-08 Stefan Monnier <monnier@iro.umontreal.ca>
244
245 * progmodes/sh-script.el (sh-quoted-subshell): Make sure we don't
246 mistake a closing " for an opening one.
247
2482006-08-07 Dan Nicolaescu <dann@ics.uci.edu>
249
250 * term/xterm.el (terminal-init-xterm): Add more key bindings.
251
2522006-08-07 Stefan Monnier <monnier@iro.umontreal.ca>
253
254 * complete.el (PC-do-completion): Filter out completions matching
255 completion-ignored-extensions before checking whether there are
256 multiple completions.
257 Don't use `list' unnecessarily when building completion tables.
258
2592006-08-06 Richard Stallman <rms@gnu.org>
260
261 * help.el (describe-mode): Make minor mode list more concise.
262
2632006-08-05 Chong Yidong <cyd@stupidchicken.com>
264
265 * bindings.el: Give mode-line-format, mode-line-modes, and
266 mode-line-position `standard-value' properties.
267
2682006-08-05 Eli Zaretskii <eliz@gnu.org>
269
270 * buff-menu.el (list-buffers-noselect): For Info buffers, use
271 "(file)node" instead of the file name.
272
2732006-08-05 Richard Stallman <rms@gnu.org>
274
275 * faces.el (escape-glyph): Doc fix.
276
2772006-08-04 Kenichi Handa <handa@m17n.org>
278
279 * international/mule-diag.el (describe-font): Improve docstring
280 and error message. Use frame-parameter (not frame-parameters).
281
2822006-08-03 Stefan Monnier <monnier@iro.umontreal.ca>
283
284 * progmodes/gud.el (gdb-script-font-lock-syntactic-keywords):
285 Correctly mark the end-of-docstring char.
286
2872006-08-03 Chong Yidong <cyd@stupidchicken.com>
288
289 * simple.el (line-move-to-column): Constrain move-to-column to
290 current field.
291
12006-08-03 Stefan Monnier <monnier@iro.umontreal.ca> 2922006-08-03 Stefan Monnier <monnier@iro.umontreal.ca>
2 293
3 * font-lock.el (font-lock-beg, font-lock-end) 294 * font-lock.el (font-lock-beg, font-lock-end)
@@ -173,9 +464,9 @@
173 464
1742006-07-26 Mathias Dahl <mathias.dahl@gmail.com> 4652006-07-26 Mathias Dahl <mathias.dahl@gmail.com>
175 466
176 * tumme.el (tumme-backward-image): Add prefix argument. Add error 467 * tumme.el (tumme-backward-image): Add prefix argument. Add error
177 when at first image. 468 when at first image.
178 (tumme-forward-image): Add prefix argument. Add error when at last 469 (tumme-forward-image): Add prefix argument. Add error when at last
179 image. 470 image.
180 471
1812006-07-25 Stefan Monnier <monnier@iro.umontreal.ca> 4722006-07-25 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -239,8 +530,8 @@
2392006-07-24 Daiki Ueno <ueno@unixuser.org> 5302006-07-24 Daiki Ueno <ueno@unixuser.org>
240 531
241 * pgg-def.el (pgg-truncate-key-identifier): Truncate the key ID to 8 532 * pgg-def.el (pgg-truncate-key-identifier): Truncate the key ID to 8
242 letters from the end. Thanks to "David Smith" <davidsmith@acm.org> and 533 letters from the end. Thanks to "David Smith" <davidsmith@acm.org>
243 andreas@altroot.de (Andreas V,Av(Bgele) 534 and andreas@altroot.de (Andreas V,Av(Bgele).
244 535
2452006-07-23 Thien-Thi Nguyen <ttn@gnu.org> 5362006-07-23 Thien-Thi Nguyen <ttn@gnu.org>
246 537
@@ -279,7 +570,7 @@
2792006-07-21 Dan Nicolaescu <dann@ics.uci.edu> 5702006-07-21 Dan Nicolaescu <dann@ics.uci.edu>
280 571
281 * term/xterm.el (terminal-init-xterm): Fix key bindings 572 * term/xterm.el (terminal-init-xterm): Fix key bindings
282 syntax. Bind S-return, C-M-., C-TAB, S-TAB and C-S-TAB. 573 syntax. Bind S-return, C-M-., C-TAB, S-TAB and C-S-TAB.
283 574
2842006-07-21 Eli Zaretskii <eliz@gnu.org> 5752006-07-21 Eli Zaretskii <eliz@gnu.org>
285 576
@@ -315,7 +606,7 @@
315 606
316 * calc.el (calc-previous-alg-entry): Remove variable. 607 * calc.el (calc-previous-alg-entry): Remove variable.
317 608
318 * calc-aent.el (calc-alg-entry-history, calc-quick-calc-history): 609 * calc-aent.el (calc-alg-entry-history, calc-quick-calc-history):
319 New variables. 610 New variables.
320 (calc-alg-entry): Use `calc-alg-entry-history'. 611 (calc-alg-entry): Use `calc-alg-entry-history'.
321 (calc-do-quick-calc): Use `calc-quick-calc-history'. 612 (calc-do-quick-calc): Use `calc-quick-calc-history'.
@@ -639,8 +930,8 @@
639 930
6402006-07-10 Chong Yidong <cyd@stupidchicken.com> 9312006-07-10 Chong Yidong <cyd@stupidchicken.com>
641 932
642 * progmodes/cc-awk.el (defconst): Use eval-and-compile to avoid 933 * progmodes/cc-awk.el (c-awk-escaped-nls*): Use eval-and-compile to
643 compilation error. 934 avoid compilation error.
644 935
645 * subr.el (sit-for): New function. 936 * subr.el (sit-for): New function.
646 937
diff --git a/lisp/allout.el b/lisp/allout.el
index f1f262c70b7..379f664d092 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -213,15 +213,73 @@ just the header."
213(put 'allout-show-bodies 'safe-local-variable 213(put 'allout-show-bodies 'safe-local-variable
214 (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil))))) 214 (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
215 215
216;;;_ = allout-beginning-of-line-cycles
217(defcustom allout-beginning-of-line-cycles t
218 "*If non-nil, \\[allout-beginning-of-line] will cycle through smart-placement options.
219
220Cycling only happens on when the command is repeated, not when it
221follows a different command.
222
223Smart-placement means that repeated calls to this function will
224advance as follows:
225
226 - if the cursor is on a non-headline body line and not on the first column:
227 then it goes to the first column
228 - if the cursor is on the first column of a non-headline body line:
229 then it goes to the start of the headline within the item body
230 - if the cursor is on the headline and not the start of the headline:
231 then it goes to the start of the headline
232 - if the cursor is on the start of the headline:
233 then it goes to the bullet character \(for hotspot navigation\)
234 - if the cursor is on the bullet character:
235 then it goes to the first column of that line \(the headline\)
236 - if the cursor is on the first column of the headline:
237 then it goes to the start of the headline within the item body.
238
239In this fashion, you can use the beginning-of-line command to do
240its normal job and then, when repeated, advance through the
241entry, cycling back to start.
242
243If this configuration variable is nil, then the cursor is just
244advanced to the beginning of the line and remains there on
245repeated calls."
246 :type 'boolean :group 'allout)
247;;;_ = allout-end-of-line-cycles
248(defcustom allout-end-of-line-cycles t
249 "*If non-nil, \\[allout-end-of-line] will cycle through smart-placement options.
250
251Cycling only happens on when the command is repeated, not when it
252follows a different command.
253
254Smart-placement means that repeated calls to this function will
255advance as follows:
256
257 - if the cursor is not on the end-of-line,
258 then it goes to the end-of-line
259 - if the cursor is on the end-of-line but not the end-of-entry,
260 then it goes to the end-of-entry, exposing it if necessary
261 - if the cursor is on the end-of-entry,
262 then it goes to the end of the head line
263
264In this fashion, you can use the end-of-line command to do its
265normal job and then, when repeated, advance through the entry,
266cycling back to start.
267
268If this configuration variable is nil, then the cursor is just
269advanced to the end of the line and remains there on repeated
270calls."
271 :type 'boolean :group 'allout)
272
216;;;_ = allout-header-prefix 273;;;_ = allout-header-prefix
217(defcustom allout-header-prefix "." 274(defcustom allout-header-prefix "."
275;; this string is treated as literal match. it will be `regexp-quote'd, so
276;; one cannot use regular expressions to match varying header prefixes.
218 "*Leading string which helps distinguish topic headers. 277 "*Leading string which helps distinguish topic headers.
219 278
220Outline topic header lines are identified by a leading topic 279Outline topic header lines are identified by a leading topic
221header prefix, which mostly have the value of this var at their front. 280header prefix, which mostly have the value of this var at their front.
222\(Level 1 topics are exceptions. They consist of only a single 281Level 1 topics are exceptions. They consist of only a single
223character, which is typically set to the `allout-primary-bullet'. Many 282character, which is typically set to the `allout-primary-bullet'."
224outlines start at level 2 to avoid this discrepancy."
225 :type 'string 283 :type 'string
226 :group 'allout) 284 :group 'allout)
227(make-variable-buffer-local 'allout-header-prefix) 285(make-variable-buffer-local 'allout-header-prefix)
@@ -300,11 +358,13 @@ strings."
300(defcustom allout-use-mode-specific-leader t 358(defcustom allout-use-mode-specific-leader t
301 "*When non-nil, use mode-specific topic-header prefixes. 359 "*When non-nil, use mode-specific topic-header prefixes.
302 360
303Allout outline mode will use the mode-specific `allout-mode-leaders' 361Allout outline mode will use the mode-specific `allout-mode-leaders' or
304and/or comment-start string, if any, to lead the topic prefix string, 362comment-start string, if any, to lead the topic prefix string, so topic
305so topic headers look like comments in the programming language. 363headers look like comments in the programming language. It will also use
364the comment-start string, with an '_' appended, for `allout-primary-bullet'.
306 365
307String values are used as they stand. 366String values are used as literals, not regular expressions, so
367do not escape any regulare-expression characters.
308 368
309Value t means to first check for assoc value in `allout-mode-leaders' 369Value t means to first check for assoc value in `allout-mode-leaders'
310alist, then use comment-start string, if any, then use default \(`.'). 370alist, then use comment-start string, if any, then use default \(`.').
@@ -313,15 +373,17 @@ alist, then use comment-start string, if any, then use default \(`.').
313Set to the symbol for either of `allout-mode-leaders' or 373Set to the symbol for either of `allout-mode-leaders' or
314`comment-start' to use only one of them, respectively. 374`comment-start' to use only one of them, respectively.
315 375
316Value nil means to always use the default \(`.'). 376Value nil means to always use the default \(`.') and leave
317 377`allout-primary-bullet' unaltered.
318comment-start strings that do not end in spaces are tripled, and an 378
319`_' underscore is tacked on the end, to distinguish them from regular 379comment-start strings that do not end in spaces are tripled in
320comment strings. comment-start strings that do end in spaces are not 380the header-prefix, and an `_' underscore is tacked on the end, to
321tripled, but an underscore is substituted for the space. [This 381distinguish them from regular comment strings. comment-start
322presumes that the space is for appearance, not comment syntax. You 382strings that do end in spaces are not tripled, but an underscore
323can use `allout-mode-leaders' to override this behavior, when 383is substituted for the space. [This presumes that the space is
324incorrect.]" 384for appearance, not comment syntax. You can use
385`allout-mode-leaders' to override this behavior, when
386undesired.]"
325 :type '(choice (const t) (const nil) string 387 :type '(choice (const t) (const nil) string
326 (const allout-mode-leaders) 388 (const allout-mode-leaders)
327 (const comment-start)) 389 (const comment-start))
@@ -334,13 +396,14 @@ incorrect.]"
334(defvar allout-mode-leaders '() 396(defvar allout-mode-leaders '()
335 "Specific allout-prefix leading strings per major modes. 397 "Specific allout-prefix leading strings per major modes.
336 398
337Entries will be used instead or in lieu of mode-specific 399Use this if the mode's comment-start string isn't what you
338comment-start strings. See also `allout-use-mode-specific-leader'. 400prefer, or if the mode lacks a comment-start string. See
401`allout-use-mode-specific-leader' for more details.
339 402
340If you're constructing a string that will comment-out outline 403If you're constructing a string that will comment-out outline
341structuring so it can be included in program code, append an extra 404structuring so it can be included in program code, append an extra
342character, like an \"_\" underscore, to distinguish the lead string 405character, like an \"_\" underscore, to distinguish the lead string
343from regular comments that start at bol.") 406from regular comments that start at the beginning-of-line.")
344 407
345;;;_ = allout-old-style-prefixes 408;;;_ = allout-old-style-prefixes
346(defcustom allout-old-style-prefixes nil 409(defcustom allout-old-style-prefixes nil
@@ -828,9 +891,9 @@ language comments. Returns the leading string."
828 (setq allout-reindent-bodies nil) 891 (setq allout-reindent-bodies nil)
829 (allout-reset-header-lead header-lead) 892 (allout-reset-header-lead header-lead)
830 header-lead) 893 header-lead)
831;;;_ > allout-infer-header-lead () 894;;;_ > allout-infer-header-lead-and-primary-bullet ()
832(defun allout-infer-header-lead () 895(defun allout-infer-header-lead-and-primary-bullet ()
833 "Determine appropriate `allout-header-prefix'. 896 "Determine appropriate `allout-header-prefix' and `allout-primary-bullet'.
834 897
835Works according to settings of: 898Works according to settings of:
836 899
@@ -874,10 +937,14 @@ invoking it directly."
874 "_"))))))) 937 "_")))))))
875 (if (not leader) 938 (if (not leader)
876 nil 939 nil
877 (if (string= leader allout-header-prefix) 940 (setq allout-header-prefix leader)
878 nil ; no change, nothing to do. 941 (if (not allout-old-style-prefixes)
879 (setq allout-header-prefix leader) 942 ;; setting allout-primary-bullet makes the top level topics use -
880 allout-header-prefix)))) 943 ;; actually, be - the special prefix:
944 (setq allout-primary-bullet leader))
945 allout-header-prefix)))
946(defalias 'allout-infer-header-lead
947 'allout-infer-header-lead-and-primary-bullet)
881;;;_ > allout-infer-body-reindent () 948;;;_ > allout-infer-body-reindent ()
882(defun allout-infer-body-reindent () 949(defun allout-infer-body-reindent ()
883 "Determine proper setting for `allout-reindent-bodies'. 950 "Determine proper setting for `allout-reindent-bodies'.
@@ -930,13 +997,13 @@ Works with respect to `allout-plain-bullets-string' and
930 (setq allout-plain-bullets-string-len (length allout-plain-bullets-string)) 997 (setq allout-plain-bullets-string-len (length allout-plain-bullets-string))
931 (setq allout-header-subtraction (1- (length allout-header-prefix))) 998 (setq allout-header-subtraction (1- (length allout-header-prefix)))
932 ;; Produce the new allout-regexp: 999 ;; Produce the new allout-regexp:
933 (setq allout-regexp (concat "\\(\\" 1000 (setq allout-regexp (concat "\\("
934 allout-header-prefix 1001 (regexp-quote allout-header-prefix)
935 "[ \t]*[" 1002 "[ \t]*["
936 allout-bullets-string 1003 allout-bullets-string
937 "]\\)\\|\\" 1004 "]\\)\\|"
938 allout-primary-bullet 1005 (regexp-quote allout-primary-bullet)
939 "+\\|\^l")) 1006 "+\\|\^l"))
940 (setq allout-line-boundary-regexp 1007 (setq allout-line-boundary-regexp
941 (concat "\\(\n\\)\\(" allout-regexp "\\)")) 1008 (concat "\\(\n\\)\\(" allout-regexp "\\)"))
942 (setq allout-bob-regexp 1009 (setq allout-bob-regexp
@@ -965,16 +1032,6 @@ See doc string for allout-keybindings-list for format of binding list."
965 (car (cdr cell))))))) 1032 (car (cdr cell)))))))
966 keymap-list) 1033 keymap-list)
967 map)) 1034 map))
968;;;_ = allout-prior-bindings - being deprecated.
969(defvar allout-prior-bindings nil
970 "Variable for use in V18, with allout-added-bindings, for
971resurrecting, on mode deactivation, bindings that existed before
972activation. Being deprecated.")
973;;;_ = allout-added-bindings - being deprecated
974(defvar allout-added-bindings nil
975 "Variable for use in V18, with allout-prior-bindings, for
976resurrecting, on mode deactivation, bindings that existed before
977activation. Being deprecated.")
978;;;_ : Menu bar 1035;;;_ : Menu bar
979(defvar allout-mode-exposure-menu) 1036(defvar allout-mode-exposure-menu)
980(defvar allout-mode-editing-menu) 1037(defvar allout-mode-editing-menu)
@@ -1050,43 +1107,65 @@ See `allout-add-resumptions' and `allout-do-resumptions'.")
1050(make-variable-buffer-local 'allout-mode-prior-settings) 1107(make-variable-buffer-local 'allout-mode-prior-settings)
1051;;;_ > allout-add-resumptions (&rest pairs) 1108;;;_ > allout-add-resumptions (&rest pairs)
1052(defun allout-add-resumptions (&rest pairs) 1109(defun allout-add-resumptions (&rest pairs)
1053 "Set name/value pairs. 1110 "Set name/value PAIRS.
1054 1111
1055Old settings are preserved for later resumption using `allout-do-resumptions'. 1112Old settings are preserved for later resumption using `allout-do-resumptions'.
1056 1113
1114The new values are set as a buffer local. On resumption, the prior buffer
1115scope of the variable is restored along with its value. If it was a void
1116buffer-local value, then it is left as nil on resumption.
1117
1057The pairs are lists whose car is the name of the variable and car of the 1118The pairs are lists whose car is the name of the variable and car of the
1058cdr is the new value: '(some-var some-value)'. 1119cdr is the new value: '(some-var some-value)'. The pairs can actually be
1120triples, where the third element qualifies the disposition of the setting,
1121as described further below.
1059 1122
1060The new value is set as a buffer local. 1123If the optional third element is the symbol 'extend, then the new value
1124created by `cons'ing the second element of the pair onto the front of the
1125existing value.
1061 1126
1062If the variable was not previously buffer-local, then that is noted and the 1127If the optional third element is the symbol 'append, then the new value is
1063`allout-do-resumptions' will just `kill-local-variable' of that binding. 1128extended from the existing one by `append'ing a list containing the second
1129element of the pair onto the end of the existing value.
1064 1130
1065If it previously was buffer-local, the old value is noted and resurrected 1131Extension, and resumptions in general, should not be used for hook
1066by `allout-do-resumptions'. \(If the local value was previously void, then 1132functions - use the 'local mode of `add-hook' for that, instead.
1067it is left as nil on resumption.\)
1068 1133
1069The settings are stored on `allout-mode-prior-settings'." 1134The settings are stored on `allout-mode-prior-settings'."
1070 (while pairs 1135 (while pairs
1071 (let* ((pair (pop pairs)) 1136 (let* ((pair (pop pairs))
1072 (name (car pair)) 1137 (name (car pair))
1073 (value (cadr pair))) 1138 (value (cadr pair))
1139 (qualifier (if (> (length pair) 2)
1140 (caddr pair)))
1141 prior-value)
1074 (if (not (symbolp name)) 1142 (if (not (symbolp name))
1075 (error "Pair's name, %S, must be a symbol, not %s" 1143 (error "Pair's name, %S, must be a symbol, not %s"
1076 name (type-of name))) 1144 name (type-of name)))
1145 (setq prior-value (condition-case err
1146 (symbol-value name)
1147 (void-variable nil)))
1077 (when (not (assoc name allout-mode-prior-settings)) 1148 (when (not (assoc name allout-mode-prior-settings))
1078 ;; Not already added as a resumption, create the prior setting entry. 1149 ;; Not already added as a resumption, create the prior setting entry.
1079 (if (local-variable-p name) 1150 (if (local-variable-p name)
1080 ;; is already local variable - preserve the prior value: 1151 ;; is already local variable - preserve the prior value:
1081 (push (list name (condition-case err 1152 (push (list name prior-value) allout-mode-prior-settings)
1082 (symbol-value name)
1083 (void-variable nil)))
1084 allout-mode-prior-settings)
1085 ;; wasn't local variable, indicate so for resumption by killing 1153 ;; wasn't local variable, indicate so for resumption by killing
1086 ;; local value, and make it local: 1154 ;; local value, and make it local:
1087 (push (list name) allout-mode-prior-settings) 1155 (push (list name) allout-mode-prior-settings)
1088 (make-local-variable name))) 1156 (make-local-variable name)))
1089 (set name value)))) 1157 (if qualifier
1158 (cond ((eq qualifier 'extend)
1159 (if (not (listp prior-value))
1160 (error "extension of non-list prior value attempted")
1161 (set name (cons value prior-value))))
1162 ((eq qualifier 'append)
1163 (if (not (listp prior-value))
1164 (error "appending of non-list prior value attempted")
1165 (set name (append prior-value (list value)))))
1166 (t (error "unrecognized setting qualifier `%s' encountered"
1167 qualifier)))
1168 (set name value)))))
1090;;;_ > allout-do-resumptions () 1169;;;_ > allout-do-resumptions ()
1091(defun allout-do-resumptions () 1170(defun allout-do-resumptions ()
1092 "Resume all name/value settings registered by `allout-add-resumptions'. 1171 "Resume all name/value settings registered by `allout-add-resumptions'.
@@ -1121,18 +1200,67 @@ their settings before allout-mode was started."
1121 "Symbol for use as allout invisible-text overlay category.") 1200 "Symbol for use as allout invisible-text overlay category.")
1122;;;_ x allout-view-change-hook 1201;;;_ x allout-view-change-hook
1123(defvar allout-view-change-hook nil 1202(defvar allout-view-change-hook nil
1124 "*\(Deprecated\) Hook that's run after allout outline exposure changes. 1203 "*\(Deprecated\) A hook run after allout outline exposure changes.
1125 1204
1126Switch to using `allout-exposure-change-hook' instead. Both 1205Switch to using `allout-exposure-change-hook' instead. Both hooks are
1127variables are currently respected, but this one will be ignored 1206currently respected, but the other conveys the details of the exposure
1128in a subsequent allout version.") 1207change via explicit parameters, and this one will eventually be disabled in
1208a subsequent allout version.")
1129;;;_ = allout-exposure-change-hook 1209;;;_ = allout-exposure-change-hook
1130(defvar allout-exposure-change-hook nil 1210(defvar allout-exposure-change-hook nil
1131 "*Hook that's run after allout outline exposure changes. 1211 "*Hook that's run after allout outline subtree exposure changes.
1212
1213It is run at the conclusion of `allout-flag-region'.
1214
1215Functions on the hook must take three arguments:
1216
1217 - from - integer indicating the point at the start of the change.
1218 - to - integer indicating the point of the end of the change.
1219 - flag - change mode: nil for exposure, otherwise concealment.
1220
1221This hook might be invoked multiple times by a single command.
1222
1223This hook is replacing `allout-view-change-hook', which is being deprecated
1224and eventually will not be invoked.")
1225;;;_ = allout-structure-added-hook
1226(defvar allout-structure-added-hook nil
1227 "*Hook that's run after addition of items to the outline.
1228
1229Functions on the hook should take two arguments:
1230
1231 - new-start - integer indicating the point at the start of the first new item.
1232 - new-end - integer indicating the point of the end of the last new item.
1233
1234Some edits that introduce new items may missed by this hook -
1235specifically edits that native allout routines do not control.
1236
1237This hook might be invoked multiple times by a single command.")
1238;;;_ = allout-structure-deleted-hook
1239(defvar allout-structure-deleted-hook nil
1240 "*Hook that's run after disciplined deletion of subtrees from the outline.
1241
1242Functions on the hook must take two arguments:
1243
1244 - depth - integer indicating the depth of the subtree that was deleted.
1245 - removed-from - integer indicating the point where the subtree was removed.
1246
1247Some edits that remove or invalidate items may missed by this hook -
1248specifically edits that native allout routines do not control.
1132 1249
1133This variable will replace `allout-view-change-hook' in a subsequent allout 1250This hook might be invoked multiple times by a single command.")
1134version, though both are currently respected.") 1251;;;_ = allout-structure-shifted-hook
1252(defvar allout-structure-shifted-hook nil
1253 "*Hook that's run after shifting of items in the outline.
1135 1254
1255Functions on the hook should take two arguments:
1256
1257 - depth-change - integer indicating depth increase, negative for decrease
1258 - start - integer indicating the start point of the shifted parent item.
1259
1260Some edits that shift items can be missed by this hook - specifically edits
1261that native allout routines do not control.
1262
1263This hook might be invoked multiple times by a single command.")
1136;;;_ = allout-outside-normal-auto-fill-function 1264;;;_ = allout-outside-normal-auto-fill-function
1137(defvar allout-outside-normal-auto-fill-function nil 1265(defvar allout-outside-normal-auto-fill-function nil
1138 "Value of normal-auto-fill-function outside of allout mode. 1266 "Value of normal-auto-fill-function outside of allout mode.
@@ -1186,6 +1314,42 @@ state, if file variable adjustments are enabled. See
1186This is used to decrypt the topic that was currently being edited, if it 1314This is used to decrypt the topic that was currently being edited, if it
1187was encrypted automatically as part of a file write or autosave.") 1315was encrypted automatically as part of a file write or autosave.")
1188(make-variable-buffer-local 'allout-after-save-decrypt) 1316(make-variable-buffer-local 'allout-after-save-decrypt)
1317;;;_ = allout-encryption-plaintext-sanitization-regexps
1318(defvar allout-encryption-plaintext-sanitization-regexps nil
1319 "List of regexps whose matches are removed from plaintext before encryption.
1320
1321This is for the sake of removing artifacts, like escapes, that are added on
1322and not actually part of the original plaintext. The removal is done just
1323prior to encryption.
1324
1325Entries must be symbols that are bound to the desired values.
1326
1327Each value can be a regexp or a list with a regexp followed by a
1328substitution string. If it's just a regexp, all its matches are removed
1329before the text is encrypted. If it's a regexp and a substitution, the
1330substition is used against the regexp matches, a la `replace-match'.")
1331(make-variable-buffer-local 'allout-encryption-text-removal-regexps)
1332;;;_ = allout-encryption-ciphertext-rejection-regexps
1333(defvar allout-encryption-ciphertext-rejection-regexps nil
1334 "Variable for regexps matching plaintext to remove before encryption.
1335
1336This is for the sake of redoing encryption in cases where the ciphertext
1337incidentally contains strings that would disrupt mode operation -
1338for example, a line that happens to look like an allout-mode topic prefix.
1339
1340Entries must be symbols that are bound to the desired regexp values.
1341
1342The encryption will be retried up to
1343`allout-encryption-ciphertext-rejection-limit' times, after which an error
1344is raised.")
1345
1346(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-regexps)
1347;;;_ = allout-encryption-ciphertext-rejection-ceiling
1348(defvar allout-encryption-ciphertext-rejection-ceiling 5
1349 "Limit on number of times encryption ciphertext is rejected.
1350
1351See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.")
1352(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-ceiling)
1189;;;_ > allout-mode-p () 1353;;;_ > allout-mode-p ()
1190;; Must define this macro above any uses, or byte compilation will lack 1354;; Must define this macro above any uses, or byte compilation will lack
1191;; proper def, if file isn't loaded - eg, during emacs build! 1355;; proper def, if file isn't loaded - eg, during emacs build!
@@ -1637,16 +1801,15 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1637 (remove-overlays (point-min) (point-max) 1801 (remove-overlays (point-min) (point-max)
1638 'category 'allout-exposure-category) 1802 'category 'allout-exposure-category)
1639 1803
1640 (run-hooks 'allout-mode-deactivate-hook) 1804 (setq allout-mode nil)
1641 (setq allout-mode nil)) 1805 (run-hooks 'allout-mode-deactivate-hook))
1642 1806
1643 ;; Activation: 1807 ;; Activation:
1644 ((not active) 1808 ((not active)
1645 (setq allout-explicitly-deactivated nil) 1809 (setq allout-explicitly-deactivated nil)
1646 (if allout-old-style-prefixes 1810 (if allout-old-style-prefixes
1647 ;; Inhibit all the fancy formatting: 1811 ;; Inhibit all the fancy formatting:
1648 (allout-add-resumptions '((allout-primary-bullet "*") 1812 (allout-add-resumptions '(allout-primary-bullet "*")))
1649 (allout-old-style-prefixes ()))))
1650 1813
1651 (allout-overlay-preparations) ; Doesn't hurt to redo this. 1814 (allout-overlay-preparations) ; Doesn't hurt to redo this.
1652 1815
@@ -1654,15 +1817,28 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1654 (allout-infer-body-reindent) 1817 (allout-infer-body-reindent)
1655 1818
1656 (set-allout-regexp) 1819 (set-allout-regexp)
1820 (allout-add-resumptions
1821 '(allout-encryption-ciphertext-rejection-regexps
1822 allout-line-boundary-regexp
1823 extend)
1824 '(allout-encryption-ciphertext-rejection-regexps
1825 allout-bob-regexp
1826 extend))
1657 1827
1658 ;; Produce map from current version of allout-keybindings-list: 1828 ;; Produce map from current version of allout-keybindings-list:
1659 (setq allout-mode-map 1829 (setq allout-mode-map
1660 (produce-allout-mode-map allout-keybindings-list)) 1830 (produce-allout-mode-map allout-keybindings-list))
1661 (substitute-key-definition 'beginning-of-line 1831 (substitute-key-definition 'beginning-of-line
1662 'move-beginning-of-line 1832 'allout-beginning-of-line
1833 allout-mode-map global-map)
1834 (substitute-key-definition 'move-beginning-of-line
1835 'allout-beginning-of-line
1663 allout-mode-map global-map) 1836 allout-mode-map global-map)
1664 (substitute-key-definition 'end-of-line 1837 (substitute-key-definition 'end-of-line
1665 'move-end-of-line 1838 'allout-end-of-line
1839 allout-mode-map global-map)
1840 (substitute-key-definition 'move-end-of-line
1841 'allout-end-of-line
1666 allout-mode-map global-map) 1842 allout-mode-map global-map)
1667 (produce-allout-mode-menubar-entries) 1843 (produce-allout-mode-menubar-entries)
1668 (fset 'allout-mode-map allout-mode-map) 1844 (fset 'allout-mode-map allout-mode-map)
@@ -1717,8 +1893,8 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1717 (if allout-layout 1893 (if allout-layout
1718 (setq do-layout t)) 1894 (setq do-layout t))
1719 1895
1720 (run-hooks 'allout-mode-hook) 1896 (setq allout-mode t)
1721 (setq allout-mode t)) 1897 (run-hooks 'allout-mode-hook))
1722 1898
1723 ;; Reactivation: 1899 ;; Reactivation:
1724 ((setq do-layout t) 1900 ((setq do-layout t)
@@ -2044,6 +2220,52 @@ Outermost is first."
2044 (while (allout-hidden-p) 2220 (while (allout-hidden-p)
2045 (end-of-line) 2221 (end-of-line)
2046 (if (allout-hidden-p) (forward-char 1))))) 2222 (if (allout-hidden-p) (forward-char 1)))))
2223;;;_ > allout-beginning-of-line ()
2224(defun allout-beginning-of-line ()
2225 "Beginning-of-line with `allout-beginning-of-line-cycles' behavior, if set."
2226
2227 (interactive)
2228
2229 (if (or (not allout-beginning-of-line-cycles)
2230 (not (equal last-command this-command)))
2231 (move-beginning-of-line 1)
2232 (let ((beginning-of-body (save-excursion
2233 (allout-beginning-of-current-entry)
2234 (point))))
2235 (cond ((= (current-column) 0)
2236 (allout-beginning-of-current-entry))
2237 ((< (point) beginning-of-body)
2238 (allout-beginning-of-current-line))
2239 ((= (point) beginning-of-body)
2240 (goto-char (allout-current-bullet-pos)))
2241 (t (allout-beginning-of-current-line)
2242 (if (< (point) beginning-of-body)
2243 ;; we were on the headline after its start:
2244 (allout-beginning-of-current-entry)))))))
2245;;;_ > allout-end-of-line ()
2246(defun allout-end-of-line ()
2247 "End-of-line with `allout-end-of-line-cycles' behavior, if set."
2248
2249 (interactive)
2250
2251 (if (or (not allout-end-of-line-cycles)
2252 (not (equal last-command this-command)))
2253 (allout-end-of-current-line)
2254 (let ((end-of-entry (save-excursion
2255 (allout-end-of-entry)
2256 (point))))
2257 (cond ((not (eolp))
2258 (allout-end-of-current-line))
2259 ((or (allout-hidden-p) (save-excursion
2260 (forward-char -1)
2261 (allout-hidden-p)))
2262 (allout-back-to-current-heading)
2263 (allout-show-current-entry)
2264 (allout-end-of-entry))
2265 ((>= (point) end-of-entry)
2266 (allout-back-to-current-heading)
2267 (allout-end-of-current-line))
2268 (t (allout-end-of-entry))))))
2047;;;_ > allout-next-heading () 2269;;;_ > allout-next-heading ()
2048(defsubst allout-next-heading () 2270(defsubst allout-next-heading ()
2049 "Move to the heading for the topic \(possibly invisible) after this one. 2271 "Move to the heading for the topic \(possibly invisible) after this one.
@@ -2108,13 +2330,17 @@ Return the location of the beginning of the heading, or nil if not found."
2108;;; for assessment or adjustment of the subtree, without redundant 2330;;; for assessment or adjustment of the subtree, without redundant
2109;;; traversal of the structure. 2331;;; traversal of the structure.
2110 2332
2111;;;_ > allout-chart-subtree (&optional levels orig-depth prev-depth) 2333;;;_ > allout-chart-subtree (&optional levels visible orig-depth prev-depth)
2112(defun allout-chart-subtree (&optional levels orig-depth prev-depth) 2334(defun allout-chart-subtree (&optional levels visible orig-depth prev-depth)
2113 "Produce a location \"chart\" of subtopics of the containing topic. 2335 "Produce a location \"chart\" of subtopics of the containing topic.
2114 2336
2115Optional argument LEVELS specifies the depth \(relative to start 2337Optional argument LEVELS specifies the depth \(relative to start
2116depth) for the chart. Subsequent optional args are not for public 2338depth) for the chart.
2117use. 2339
2340When optional argument VISIBLE is non-nil, the chart includes
2341only the visible subelements of the charted subjects.
2342
2343The remaining optional args are not for internal use by the function.
2118 2344
2119Point is left at the end of the subtree. 2345Point is left at the end of the subtree.
2120 2346
@@ -2141,7 +2367,9 @@ starting point, and PREV-DEPTH is depth of prior topic."
2141 ; position to first offspring: 2367 ; position to first offspring:
2142 (progn (setq orig-depth (allout-depth)) 2368 (progn (setq orig-depth (allout-depth))
2143 (or prev-depth (setq prev-depth (1+ orig-depth))) 2369 (or prev-depth (setq prev-depth (1+ orig-depth)))
2144 (allout-next-heading))) 2370 (if visible
2371 (allout-next-visible-heading 1)
2372 (allout-next-heading))))
2145 2373
2146 ;; Loop over the current levels' siblings. Besides being more 2374 ;; Loop over the current levels' siblings. Besides being more
2147 ;; efficient than tail-recursing over a level, it avoids exceeding 2375 ;; efficient than tail-recursing over a level, it avoids exceeding
@@ -2163,8 +2391,12 @@ starting point, and PREV-DEPTH is depth of prior topic."
2163 ;; next heading at lesser depth: 2391 ;; next heading at lesser depth:
2164 (while (and (<= curr-depth 2392 (while (and (<= curr-depth
2165 (allout-recent-depth)) 2393 (allout-recent-depth))
2166 (allout-next-heading)))) 2394 (if visible
2167 (allout-next-heading))) 2395 (allout-next-visible-heading 1)
2396 (allout-next-heading)))))
2397 (if visible
2398 (allout-next-visible-heading 1)
2399 (allout-next-heading))))
2168 2400
2169 ((and (< prev-depth curr-depth) 2401 ((and (< prev-depth curr-depth)
2170 (or (not levels) 2402 (or (not levels)
@@ -2173,8 +2405,9 @@ starting point, and PREV-DEPTH is depth of prior topic."
2173 (setq chart 2405 (setq chart
2174 (cons (allout-chart-subtree (and levels 2406 (cons (allout-chart-subtree (and levels
2175 (1- levels)) 2407 (1- levels))
2176 orig-depth 2408 visible
2177 curr-depth) 2409 orig-depth
2410 curr-depth)
2178 chart)) 2411 chart))
2179 ;; ... then continue with this one. 2412 ;; ... then continue with this one.
2180 ) 2413 )
@@ -2369,7 +2602,9 @@ Returns the value of point."
2369 (while (and (not (eobp)) 2602 (while (and (not (eobp))
2370 (> (allout-recent-depth) level)) 2603 (> (allout-recent-depth) level))
2371 (allout-next-heading)) 2604 (allout-next-heading))
2372 (and (not (eobp)) (forward-char -1)) 2605 (if (eobp)
2606 (allout-end-of-entry)
2607 (forward-char -1))
2373 (if (and (not include-trailing-blank) (= ?\n (preceding-char))) 2608 (if (and (not include-trailing-blank) (= ?\n (preceding-char)))
2374 (forward-char -1)) 2609 (forward-char -1))
2375 (setq allout-recent-end-of-subtree (point)))) 2610 (setq allout-recent-end-of-subtree (point))))
@@ -2675,6 +2910,13 @@ hot-spot operation, where literal characters typed over a topic bullet
2675are mapped to the command of the corresponding control-key on the 2910are mapped to the command of the corresponding control-key on the
2676`allout-mode-map'.") 2911`allout-mode-map'.")
2677(make-variable-buffer-local 'allout-post-goto-bullet) 2912(make-variable-buffer-local 'allout-post-goto-bullet)
2913;;;_ = allout-command-counter
2914(defvar allout-command-counter 0
2915 "Counter that monotonically increases in allout-mode buffers.
2916
2917Set by `allout-pre-command-business', to support allout addons in
2918coordinating with allout activity.")
2919(make-variable-buffer-local 'allout-command-counter)
2678;;;_ > allout-post-command-business () 2920;;;_ > allout-post-command-business ()
2679(defun allout-post-command-business () 2921(defun allout-post-command-business ()
2680 "Outline `post-command-hook' function. 2922 "Outline `post-command-hook' function.
@@ -2692,7 +2934,7 @@ are mapped to the command of the corresponding control-key on the
2692 allout-after-save-decrypt) 2934 allout-after-save-decrypt)
2693 (allout-after-saves-handler)) 2935 (allout-after-saves-handler))
2694 2936
2695 ;; Implement -post-goto-bullet, if set: 2937 ;; Implement allout-post-goto-bullet, if set:
2696 (if (and allout-post-goto-bullet 2938 (if (and allout-post-goto-bullet
2697 (allout-current-bullet-pos)) 2939 (allout-current-bullet-pos))
2698 (progn (goto-char (allout-current-bullet-pos)) 2940 (progn (goto-char (allout-current-bullet-pos))
@@ -2701,7 +2943,9 @@ are mapped to the command of the corresponding control-key on the
2701;;;_ > allout-pre-command-business () 2943;;;_ > allout-pre-command-business ()
2702(defun allout-pre-command-business () 2944(defun allout-pre-command-business ()
2703 "Outline `pre-command-hook' function for outline buffers. 2945 "Outline `pre-command-hook' function for outline buffers.
2704Implements special behavior when cursor is on bullet character. 2946
2947Among other things, implements special behavior when the cursor is on the
2948topic bullet character.
2705 2949
2706When the cursor is on the bullet character, self-insert characters are 2950When the cursor is on the bullet character, self-insert characters are
2707reinterpreted as the corresponding control-character in the 2951reinterpreted as the corresponding control-character in the
@@ -2709,7 +2953,7 @@ reinterpreted as the corresponding control-character in the
2709the cursor which has moved as a result of such reinterpretation is 2953the cursor which has moved as a result of such reinterpretation is
2710positioned on the bullet character of the destination topic. 2954positioned on the bullet character of the destination topic.
2711 2955
2712The upshot is that you can get easy, single (ie, unmodified) key 2956The upshot is that you can get easy, single \(ie, unmodified\) key
2713outline maneuvering operations by positioning the cursor on the bullet 2957outline maneuvering operations by positioning the cursor on the bullet
2714char. When in this mode you can use regular cursor-positioning 2958char. When in this mode you can use regular cursor-positioning
2715command/keystrokes to relocate the cursor off of a bullet character to 2959command/keystrokes to relocate the cursor off of a bullet character to
@@ -2717,6 +2961,9 @@ return to regular interpretation of self-insert characters."
2717 2961
2718 (if (not (allout-mode-p)) 2962 (if (not (allout-mode-p))
2719 nil 2963 nil
2964 ;; Increment allout-command-counter
2965 (setq allout-command-counter (1+ allout-command-counter))
2966 ;; Do hot-spot navigation.
2720 (if (and (eq this-command 'self-insert-command) 2967 (if (and (eq this-command 'self-insert-command)
2721 (eq (point)(allout-current-bullet-pos))) 2968 (eq (point)(allout-current-bullet-pos)))
2722 (allout-hotspot-key-handler)))) 2969 (allout-hotspot-key-handler))))
@@ -2990,6 +3237,8 @@ case.)
2990 3237
2991If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling. 3238If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling.
2992 3239
3240Runs
3241
2993Nuances: 3242Nuances:
2994 3243
2995- Creation of new topics is with respect to the visible topic 3244- Creation of new topics is with respect to the visible topic
@@ -3040,7 +3289,8 @@ Nuances:
3040 allout-numbered-bullet)))) 3289 allout-numbered-bullet))))
3041 (point))) 3290 (point)))
3042 dbl-space 3291 dbl-space
3043 doing-beginning) 3292 doing-beginning
3293 start end)
3044 3294
3045 (if (not opening-on-blank) 3295 (if (not opening-on-blank)
3046 ; Positioning and vertical 3296 ; Positioning and vertical
@@ -3141,8 +3391,10 @@ Nuances:
3141 (not (bolp))) 3391 (not (bolp)))
3142 (forward-char 1)))) 3392 (forward-char 1))))
3143 )) 3393 ))
3394 (setq start (point))
3144 (insert (concat (allout-make-topic-prefix opening-numbered t depth) 3395 (insert (concat (allout-make-topic-prefix opening-numbered t depth)
3145 " ")) 3396 " "))
3397 (setq end (1+ (point)))
3146 3398
3147 (allout-rebullet-heading (and offer-recent-bullet ref-bullet) 3399 (allout-rebullet-heading (and offer-recent-bullet ref-bullet)
3148 depth nil nil t) 3400 depth nil nil t)
@@ -3150,6 +3402,8 @@ Nuances:
3150 (save-excursion (goto-char ref-topic) 3402 (save-excursion (goto-char ref-topic)
3151 (allout-show-children))) 3403 (allout-show-children)))
3152 (end-of-line) 3404 (end-of-line)
3405
3406 (run-hook-with-args 'allout-structure-added-hook start end)
3153 ) 3407 )
3154 ) 3408 )
3155;;;_ > allout-open-subtopic (arg) 3409;;;_ > allout-open-subtopic (arg)
@@ -3548,6 +3802,7 @@ discontinuity. The first topic in the file can be adjusted to any positive
3548depth, however." 3802depth, however."
3549 (interactive "p") 3803 (interactive "p")
3550 (if (> arg 0) 3804 (if (> arg 0)
3805 ;; refuse to create a containment discontinuity:
3551 (save-excursion 3806 (save-excursion
3552 (allout-back-to-current-heading) 3807 (allout-back-to-current-heading)
3553 (if (not (bobp)) 3808 (if (not (bobp))
@@ -3564,7 +3819,20 @@ depth, however."
3564 (1+ predecessor-depth))) 3819 (1+ predecessor-depth)))
3565 (error (concat "Disallowed shift deeper than" 3820 (error (concat "Disallowed shift deeper than"
3566 " containing topic's children."))))))) 3821 " containing topic's children.")))))))
3567 (allout-rebullet-topic arg)) 3822 (let ((where (point))
3823 has-successor)
3824 (if (and (< arg 0)
3825 (allout-current-topic-collapsed-p)
3826 (save-excursion (allout-next-sibling)))
3827 (setq has-successor t))
3828 (allout-rebullet-topic arg)
3829 (when (< arg 0)
3830 (save-excursion
3831 (if (allout-ascend)
3832 (allout-show-children)))
3833 (if has-successor
3834 (allout-show-children)))
3835 (run-hook-with-args 'allout-structure-shifted-hook arg where)))
3568;;;_ > allout-shift-out (arg) 3836;;;_ > allout-shift-out (arg)
3569(defun allout-shift-out (arg) 3837(defun allout-shift-out (arg)
3570 "Decrease depth of current heading and any topics collapsed within it. 3838 "Decrease depth of current heading and any topics collapsed within it.
@@ -3574,9 +3842,7 @@ one level greater than the immediately previous topic, to avoid containment
3574discontinuity. The first topic in the file can be adjusted to any positive 3842discontinuity. The first topic in the file can be adjusted to any positive
3575depth, however." 3843depth, however."
3576 (interactive "p") 3844 (interactive "p")
3577 (if (< arg 0) 3845 (allout-shift-in (* arg -1)))
3578 (allout-shift-in (* arg -1)))
3579 (allout-rebullet-topic (* arg -1)))
3580;;;_ : Surgery (kill-ring) functions with special provisions for outlines: 3846;;;_ : Surgery (kill-ring) functions with special provisions for outlines:
3581;;;_ > allout-kill-line (&optional arg) 3847;;;_ > allout-kill-line (&optional arg)
3582(defun allout-kill-line (&optional arg) 3848(defun allout-kill-line (&optional arg)
@@ -3610,7 +3876,8 @@ depth, however."
3610 (save-excursion ; Renumber subsequent topics if needed: 3876 (save-excursion ; Renumber subsequent topics if needed:
3611 (if (not (looking-at allout-regexp)) 3877 (if (not (looking-at allout-regexp))
3612 (allout-next-heading)) 3878 (allout-next-heading))
3613 (allout-renumber-to-depth depth)))))) 3879 (allout-renumber-to-depth depth)))
3880 (run-hook-with-args 'allout-structure-deleted-hook depth (point)))))
3614;;;_ > allout-kill-topic () 3881;;;_ > allout-kill-topic ()
3615(defun allout-kill-topic () 3882(defun allout-kill-topic ()
3616 "Kill topic together with subtopics. 3883 "Kill topic together with subtopics.
@@ -3656,7 +3923,8 @@ when yank with allout-yank into an outline as a heading."
3656 (allout-unprotected (kill-region beg (point))) 3923 (allout-unprotected (kill-region beg (point)))
3657 (sit-for 0) 3924 (sit-for 0)
3658 (save-excursion 3925 (save-excursion
3659 (allout-renumber-to-depth depth)))) 3926 (allout-renumber-to-depth depth))
3927 (run-hook-with-args 'allout-structure-deleted-hook depth (point))))
3660;;;_ > allout-yank-processing () 3928;;;_ > allout-yank-processing ()
3661(defun allout-yank-processing (&optional arg) 3929(defun allout-yank-processing (&optional arg)
3662 3930
@@ -3683,112 +3951,113 @@ however, are left exactly like normal, non-allout-specific yanks."
3683 ; region around subject: 3951 ; region around subject:
3684 (if (< (allout-mark-marker t) (point)) 3952 (if (< (allout-mark-marker t) (point))
3685 (exchange-point-and-mark)) 3953 (exchange-point-and-mark))
3686 (let* ((inhibit-field-text-motion t) 3954 (allout-unprotected
3687 (subj-beg (point)) 3955 (let* ((subj-beg (point))
3688 (into-bol (bolp)) 3956 (into-bol (bolp))
3689 (subj-end (allout-mark-marker t)) 3957 (subj-end (allout-mark-marker t))
3690 (was-collapsed (get-text-property subj-beg 'allout-was-collapsed)) 3958 (was-collapsed (get-text-property subj-beg 'allout-was-collapsed))
3691 ;; 'resituate' if yanking an entire topic into topic header: 3959 ;; 'resituate' if yanking an entire topic into topic header:
3692 (resituate (and (allout-e-o-prefix-p) 3960 (resituate (and (allout-e-o-prefix-p)
3693 (looking-at (concat "\\(" allout-regexp "\\)")) 3961 (looking-at (concat "\\(" allout-regexp "\\)"))
3694 (allout-prefix-data (match-beginning 1) 3962 (allout-prefix-data (match-beginning 1)
3695 (match-end 1)))) 3963 (match-end 1))))
3696 ;; `rectify-numbering' if resituating (where several topics may 3964 ;; `rectify-numbering' if resituating (where several topics may
3697 ;; be resituating) or yanking a topic into a topic slot (bol): 3965 ;; be resituating) or yanking a topic into a topic slot (bol):
3698 (rectify-numbering (or resituate 3966 (rectify-numbering (or resituate
3699 (and into-bol (looking-at allout-regexp))))) 3967 (and into-bol (looking-at allout-regexp)))))
3700 (if resituate 3968 (if resituate
3701 ; The yanked stuff is a topic: 3969 ; The yanked stuff is a topic:
3702 (let* ((prefix-len (- (match-end 1) subj-beg)) 3970 (let* ((prefix-len (- (match-end 1) subj-beg))
3703 (subj-depth (allout-recent-depth)) 3971 (subj-depth (allout-recent-depth))
3704 (prefix-bullet (allout-recent-bullet)) 3972 (prefix-bullet (allout-recent-bullet))
3705 (adjust-to-depth 3973 (adjust-to-depth
3706 ;; Nil if adjustment unnecessary, otherwise depth to which 3974 ;; Nil if adjustment unnecessary, otherwise depth to which
3707 ;; adjustment should be made: 3975 ;; adjustment should be made:
3708 (save-excursion 3976 (save-excursion
3709 (and (goto-char subj-end) 3977 (and (goto-char subj-end)
3710 (eolp) 3978 (eolp)
3711 (goto-char subj-beg) 3979 (goto-char subj-beg)
3712 (and (looking-at allout-regexp) 3980 (and (looking-at allout-regexp)
3713 (progn 3981 (progn
3714 (beginning-of-line) 3982 (beginning-of-line)
3715 (not (= (point) subj-beg))) 3983 (not (= (point) subj-beg)))
3716 (looking-at allout-regexp) 3984 (looking-at allout-regexp)
3717 (allout-prefix-data (match-beginning 0) 3985 (allout-prefix-data (match-beginning 0)
3718 (match-end 0))) 3986 (match-end 0)))
3719 (allout-recent-depth)))) 3987 (allout-recent-depth))))
3720 (more t)) 3988 (more t))
3721 (setq rectify-numbering allout-numbered-bullet) 3989 (setq rectify-numbering allout-numbered-bullet)
3722 (if adjust-to-depth 3990 (if adjust-to-depth
3723 ; Do the adjustment: 3991 ; Do the adjustment:
3724 (progn 3992 (progn
3725 (message "... yanking") (sit-for 0) 3993 (message "... yanking") (sit-for 0)
3726 (save-restriction 3994 (save-restriction
3727 (narrow-to-region subj-beg subj-end) 3995 (narrow-to-region subj-beg subj-end)
3728 ; Trim off excessive blank 3996 ; Trim off excessive blank
3729 ; line at end, if any: 3997 ; line at end, if any:
3730 (goto-char (point-max)) 3998 (goto-char (point-max))
3731 (if (looking-at "^$") 3999 (if (looking-at "^$")
3732 (allout-unprotected (delete-char -1))) 4000 (allout-unprotected (delete-char -1)))
3733 ; Work backwards, with each 4001 ; Work backwards, with each
3734 ; shallowest level, 4002 ; shallowest level,
3735 ; successively excluding the 4003 ; successively excluding the
3736 ; last processed topic from 4004 ; last processed topic from
3737 ; the narrow region: 4005 ; the narrow region:
3738 (while more 4006 (while more
3739 (allout-back-to-current-heading) 4007 (allout-back-to-current-heading)
3740 ; go as high as we can in each bunch: 4008 ; go as high as we can in each bunch:
3741 (while (allout-ascend-to-depth (1- (allout-depth)))) 4009 (while (allout-ascend-to-depth (1- (allout-depth))))
3742 (save-excursion 4010 (save-excursion
3743 (allout-rebullet-topic-grunt (- adjust-to-depth 4011 (allout-rebullet-topic-grunt (- adjust-to-depth
3744 subj-depth)) 4012 subj-depth))
3745 (allout-depth)) 4013 (allout-depth))
3746 (if (setq more (not (bobp))) 4014 (if (setq more (not (bobp)))
3747 (progn (widen) 4015 (progn (widen)
3748 (forward-char -1) 4016 (forward-char -1)
3749 (narrow-to-region subj-beg (point)))))) 4017 (narrow-to-region subj-beg (point))))))
3750 (message "") 4018 (message "")
3751 ;; Preserve new bullet if it's a distinctive one, otherwise 4019 ;; Preserve new bullet if it's a distinctive one, otherwise
3752 ;; use old one: 4020 ;; use old one:
3753 (if (string-match (regexp-quote prefix-bullet) 4021 (if (string-match (regexp-quote prefix-bullet)
3754 allout-distinctive-bullets-string) 4022 allout-distinctive-bullets-string)
3755 ; Delete from bullet of old to 4023 ; Delete from bullet of old to
3756 ; before bullet of new: 4024 ; before bullet of new:
3757 (progn 4025 (progn
3758 (beginning-of-line) 4026 (beginning-of-line)
3759 (delete-region (point) subj-beg) 4027 (delete-region (point) subj-beg)
3760 (set-marker (allout-mark-marker t) subj-end) 4028 (set-marker (allout-mark-marker t) subj-end)
3761 (goto-char subj-beg) 4029 (goto-char subj-beg)
3762 (allout-end-of-prefix)) 4030 (allout-end-of-prefix))
3763 ; Delete base subj prefix, 4031 ; Delete base subj prefix,
3764 ; leaving old one: 4032 ; leaving old one:
3765 (delete-region (point) (+ (point) 4033 (delete-region (point) (+ (point)
3766 prefix-len 4034 prefix-len
3767 (- adjust-to-depth subj-depth))) 4035 (- adjust-to-depth subj-depth)))
3768 ; and delete residual subj 4036 ; and delete residual subj
3769 ; prefix digits and space: 4037 ; prefix digits and space:
3770 (while (looking-at "[0-9]") (delete-char 1)) 4038 (while (looking-at "[0-9]") (delete-char 1))
3771 (if (looking-at " ") (delete-char 1)))) 4039 (if (looking-at " ") (delete-char 1))))
3772 (exchange-point-and-mark)))) 4040 (exchange-point-and-mark))))
3773 (if rectify-numbering 4041 (if rectify-numbering
3774 (progn 4042 (progn
3775 (save-excursion 4043 (save-excursion
3776 ; Give some preliminary feedback: 4044 ; Give some preliminary feedback:
3777 (message "... reconciling numbers") (sit-for 0) 4045 (message "... reconciling numbers") (sit-for 0)
3778 ; ... and renumber, in case necessary: 4046 ; ... and renumber, in case necessary:
3779 (goto-char subj-beg) 4047 (goto-char subj-beg)
3780 (if (allout-goto-prefix) 4048 (if (allout-goto-prefix)
3781 (allout-rebullet-heading nil ;;; solicit 4049 (allout-rebullet-heading nil ;;; solicit
3782 (allout-depth) ;;; depth 4050 (allout-depth) ;;; depth
3783 nil ;;; number-control 4051 nil ;;; number-control
3784 nil ;;; index 4052 nil ;;; index
3785 t)) 4053 t))
3786 (message "")))) 4054 (message ""))))
3787 (when (and (or into-bol resituate) was-collapsed) 4055 (when (and (or into-bol resituate) was-collapsed)
3788 (remove-text-properties subj-beg (1+ subj-beg) '(allout-was-collapsed)) 4056 (remove-text-properties subj-beg (1+ subj-beg) '(allout-was-collapsed))
3789 (allout-hide-current-subtree)) 4057 (allout-hide-current-subtree))
3790 (if (not resituate) 4058 (if (not resituate)
3791 (exchange-point-and-mark)))) 4059 (exchange-point-and-mark))
4060 (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end))))
3792;;;_ > allout-yank (&optional arg) 4061;;;_ > allout-yank (&optional arg)
3793(defun allout-yank (&optional arg) 4062(defun allout-yank (&optional arg)
3794 "`allout-mode' yank, with depth and numbering adjustment of yanked topics. 4063 "`allout-mode' yank, with depth and numbering adjustment of yanked topics.
@@ -3820,10 +4089,10 @@ works with normal `yank' in non-outline buffers."
3820 4089
3821 (interactive "*P") 4090 (interactive "*P")
3822 (setq this-command 'yank) 4091 (setq this-command 'yank)
3823 (yank arg) 4092 (allout-unprotected
4093 (yank arg))
3824 (if (allout-mode-p) 4094 (if (allout-mode-p)
3825 (allout-yank-processing)) 4095 (allout-yank-processing)))
3826)
3827;;;_ > allout-yank-pop (&optional arg) 4096;;;_ > allout-yank-pop (&optional arg)
3828(defun allout-yank-pop (&optional arg) 4097(defun allout-yank-pop (&optional arg)
3829 "Yank-pop like `allout-yank' when popping to bare outline prefixes. 4098 "Yank-pop like `allout-yank' when popping to bare outline prefixes.
@@ -3882,9 +4151,13 @@ by pops to non-distinctive yanks. Bug..."
3882;;;_ - Fundamental 4151;;;_ - Fundamental
3883;;;_ > allout-flag-region (from to flag) 4152;;;_ > allout-flag-region (from to flag)
3884(defun allout-flag-region (from to flag) 4153(defun allout-flag-region (from to flag)
3885 "Conceal text from FROM to TO if FLAG is non-nil, else reveal it. 4154 "Conceal text between FROM and TO if FLAG is non-nil, else reveal it.
4155
4156Exposure-change hook `allout-exposure-change-hook' is run with the same
4157arguments as this function, after the exposure changes are made. \(The old
4158`allout-view-change-hook' is being deprecated, and eventually will not be
4159invoked.\)"
3886 4160
3887Text is shown if flag is nil and hidden otherwise."
3888 ;; We use outline invisibility spec. 4161 ;; We use outline invisibility spec.
3889 (remove-overlays from to 'category 'allout-exposure-category) 4162 (remove-overlays from to 'category 'allout-exposure-category)
3890 (when flag 4163 (when flag
@@ -3895,7 +4168,7 @@ Text is shown if flag is nil and hidden otherwise."
3895 (while props 4168 (while props
3896 (overlay-put o (pop props) (pop props))))))) 4169 (overlay-put o (pop props) (pop props)))))))
3897 (run-hooks 'allout-view-change-hook) 4170 (run-hooks 'allout-view-change-hook)
3898 (run-hooks 'allout-exposure-change-hook)) 4171 (run-hook-with-args 'allout-exposure-change-hook from to flag))
3899;;;_ > allout-flag-current-subtree (flag) 4172;;;_ > allout-flag-current-subtree (flag)
3900(defun allout-flag-current-subtree (flag) 4173(defun allout-flag-current-subtree (flag)
3901 "Conceal currently-visible topic's subtree if FLAG non-nil, else reveal it." 4174 "Conceal currently-visible topic's subtree if FLAG non-nil, else reveal it."
@@ -4071,10 +4344,12 @@ true, then single-line topics are considered to be collapsed. By
4071default, they are treated as being uncollapsed." 4344default, they are treated as being uncollapsed."
4072 (save-excursion 4345 (save-excursion
4073 (and 4346 (and
4074 (= (progn (allout-back-to-current-heading) 4347 ;; Is the topic all on one line (allowing for trailing blank line)?
4075 (move-end-of-line 1) 4348 (>= (progn (allout-back-to-current-heading)
4076 (point)) 4349 (move-end-of-line 1)
4077 (allout-end-of-current-subtree (not (looking-at "\n\n")))) 4350 (point))
4351 (allout-end-of-current-subtree (not (looking-at "\n\n"))))
4352
4078 (or include-single-liners 4353 (or include-single-liners
4079 (progn (backward-char 1) (allout-hidden-p)))))) 4354 (progn (backward-char 1) (allout-hidden-p))))))
4080;;;_ > allout-hide-current-subtree (&optional just-close) 4355;;;_ > allout-hide-current-subtree (&optional just-close)
@@ -5097,8 +5372,8 @@ See `allout-toggle-current-subtree-encryption' for more details."
5097;;; fetch-pass &optional retried verifying 5372;;; fetch-pass &optional retried verifying
5098;;; passphrase) 5373;;; passphrase)
5099(defun allout-encrypt-string (text decrypt allout-buffer key-type for-key 5374(defun allout-encrypt-string (text decrypt allout-buffer key-type for-key
5100 fetch-pass &optional retried verifying 5375 fetch-pass &optional retried rejected
5101 passphrase) 5376 verifying passphrase)
5102 "Encrypt or decrypt message TEXT. 5377 "Encrypt or decrypt message TEXT.
5103 5378
5104If DECRYPT is true (default false), then decrypt instead of encrypt. 5379If DECRYPT is true (default false), then decrypt instead of encrypt.
@@ -5116,6 +5391,11 @@ that have been solicited in sequence leading to this current call.
5116Optional PASSPHRASE enables explicit delivery of the decryption passphrase, 5391Optional PASSPHRASE enables explicit delivery of the decryption passphrase,
5117for verification purposes. 5392for verification purposes.
5118 5393
5394Optional REJECTED is for internal use - conveys the number of
5395rejections due to matches against
5396`allout-encryption-ciphertext-rejection-regexps', as limited by
5397`allout-encryption-ciphertext-rejection-ceiling'.
5398
5119Returns the resulting string, or nil if the transformation fails." 5399Returns the resulting string, or nil if the transformation fails."
5120 5400
5121 (require 'pgg) 5401 (require 'pgg)
@@ -5141,6 +5421,17 @@ Returns the resulting string, or nil if the transformation fails."
5141 target-prompt-id 5421 target-prompt-id
5142 (or (buffer-file-name allout-buffer) 5422 (or (buffer-file-name allout-buffer)
5143 target-prompt-id)))) 5423 target-prompt-id))))
5424 (strip-plaintext-regexps
5425 (if (not decrypt)
5426 (allout-get-configvar-values
5427 'allout-encryption-plaintext-sanitization-regexps)))
5428 (reject-ciphertext-regexps
5429 (if (not decrypt)
5430 (allout-get-configvar-values
5431 'allout-encryption-ciphertext-rejection-regexps)))
5432 (rejected (or rejected 0))
5433 (rejections-left (- allout-encryption-ciphertext-rejection-ceiling
5434 rejected))
5144 result-text status) 5435 result-text status)
5145 5436
5146 (if (and fetch-pass (not passphrase)) 5437 (if (and fetch-pass (not passphrase))
@@ -5161,10 +5452,19 @@ Returns the resulting string, or nil if the transformation fails."
5161 key-type 5452 key-type
5162 allout-buffer 5453 allout-buffer
5163 retried fetch-pass))) 5454 retried fetch-pass)))
5455
5164 (with-temp-buffer 5456 (with-temp-buffer
5165 5457
5166 (insert text) 5458 (insert text)
5167 5459
5460 (when (and strip-plaintext-regexps (not decrypt))
5461 (dolist (re strip-plaintext-regexps)
5462 (let ((re (if (listp re) (car re) re))
5463 (replacement (if (listp re) (cadr re) "")))
5464 (goto-char (point-min))
5465 (while (re-search-forward re nil t)
5466 (replace-match replacement nil nil)))))
5467
5168 (cond 5468 (cond
5169 5469
5170 ;; symmetric: 5470 ;; symmetric:
@@ -5183,7 +5483,8 @@ Returns the resulting string, or nil if the transformation fails."
5183 (if verifying 5483 (if verifying
5184 (throw 'encryption-failed nil) 5484 (throw 'encryption-failed nil)
5185 (pgg-remove-passphrase-from-cache target-cache-id t) 5485 (pgg-remove-passphrase-from-cache target-cache-id t)
5186 (error "Symmetric-cipher encryption failed - %s" 5486 (error "Symmetric-cipher %scryption failed - %s"
5487 (if decrypt "de" "en")
5187 "try again with different passphrase.")))) 5488 "try again with different passphrase."))))
5188 5489
5189 ;; encrypt 'keypair: 5490 ;; encrypt 'keypair:
@@ -5208,48 +5509,68 @@ Returns the resulting string, or nil if the transformation fails."
5208 (if status 5509 (if status
5209 (pgg-situate-output (point-min) (point-max)) 5510 (pgg-situate-output (point-min) (point-max))
5210 (error (pgg-remove-passphrase-from-cache target-cache-id t) 5511 (error (pgg-remove-passphrase-from-cache target-cache-id t)
5211 (error "decryption failed")))) 5512 (error "decryption failed")))))
5212 )
5213 5513
5214 (setq result-text 5514 (setq result-text
5215 (buffer-substring 1 (- (point-max) (if decrypt 0 1)))) 5515 (buffer-substring 1 (- (point-max) (if decrypt 0 1))))
5216
5217 ;; validate result - non-empty
5218 (cond ((not result-text)
5219 (if verifying
5220 nil
5221 ;; transform was fruitless, retry w/new passphrase.
5222 (pgg-remove-passphrase-from-cache target-cache-id t)
5223 (allout-encrypt-string text allout-buffer decrypt nil
5224 (if retried (1+ retried) 1)
5225 passphrase)))
5226
5227 ;; Barf if encryption yields extraordinary control chars:
5228 ((and (not decrypt)
5229 (string-match "[\C-a\C-k\C-o-\C-z\C-@]"
5230 result-text))
5231 (error (concat "encryption produced unusable"
5232 " non-armored text - reconfigure!")))
5233
5234 ;; valid result and just verifying or non-symmetric:
5235 ((or verifying (not (equal key-type 'symmetric)))
5236 (if (or verifying decrypt)
5237 (pgg-add-passphrase-to-cache target-cache-id
5238 passphrase t))
5239 result-text)
5240
5241 ;; valid result and regular symmetric - "register"
5242 ;; passphrase with mnemonic aids/cache.
5243 (t
5244 (set-buffer allout-buffer)
5245 (if passphrase
5246 (pgg-add-passphrase-to-cache target-cache-id
5247 passphrase t))
5248 (allout-update-passphrase-mnemonic-aids for-key passphrase
5249 allout-buffer)
5250 result-text)
5251 )
5252 ) 5516 )
5517
5518 ;; validate result - non-empty
5519 (cond ((not result-text)
5520 (if verifying
5521 nil
5522 ;; transform was fruitless, retry w/new passphrase.
5523 (pgg-remove-passphrase-from-cache target-cache-id t)
5524 (allout-encrypt-string text decrypt allout-buffer
5525 key-type for-key nil
5526 (if retried (1+ retried) 1)
5527 rejected verifying nil)))
5528
5529 ;; Retry (within limit) if ciphertext contains rejections:
5530 ((and (not decrypt)
5531 ;; Check for disqualification of this ciphertext:
5532 (let ((regexps reject-ciphertext-regexps)
5533 reject-it)
5534 (while (and regexps (not reject-it))
5535 (setq reject-it (string-match (car regexps)
5536 result-text))
5537 (pop regexps))
5538 reject-it))
5539 (setq rejections-left (1- rejections-left))
5540 (if (<= rejections-left 0)
5541 (error (concat "Ciphertext rejected too many times"
5542 " (%s), per `%s'")
5543 allout-encryption-ciphertext-rejection-ceiling
5544 'allout-encryption-ciphertext-rejection-regexps)
5545 (allout-encrypt-string text decrypt allout-buffer
5546 key-type for-key nil
5547 retried (1+ rejected)
5548 verifying passphrase)))
5549 ;; Barf if encryption yields extraordinary control chars:
5550 ((and (not decrypt)
5551 (string-match "[\C-a\C-k\C-o-\C-z\C-@]"
5552 result-text))
5553 (error (concat "Encryption produced non-armored text, which"
5554 "conflicts with allout mode - reconfigure!")))
5555
5556 ;; valid result and just verifying or non-symmetric:
5557 ((or verifying (not (equal key-type 'symmetric)))
5558 (if (or verifying decrypt)
5559 (pgg-add-passphrase-to-cache target-cache-id
5560 passphrase t))
5561 result-text)
5562
5563 ;; valid result and regular symmetric - "register"
5564 ;; passphrase with mnemonic aids/cache.
5565 (t
5566 (set-buffer allout-buffer)
5567 (if passphrase
5568 (pgg-add-passphrase-to-cache target-cache-id
5569 passphrase t))
5570 (allout-update-passphrase-mnemonic-aids for-key passphrase
5571 allout-buffer)
5572 result-text)
5573 )
5253 ) 5574 )
5254 ) 5575 )
5255 ) 5576 )
@@ -5313,7 +5634,6 @@ of the availability of a cached copy."
5313 (pgg-read-passphrase-from-cache cache-id t))) 5634 (pgg-read-passphrase-from-cache cache-id t)))
5314 (got-pass (or cached 5635 (got-pass (or cached
5315 (pgg-read-passphrase full-prompt cache-id t))) 5636 (pgg-read-passphrase full-prompt cache-id t)))
5316
5317 confirmation) 5637 confirmation)
5318 5638
5319 (if (not got-pass) 5639 (if (not got-pass)
@@ -5321,14 +5641,14 @@ of the availability of a cached copy."
5321 5641
5322 ;; Duplicate our handle on the passphrase so it's not clobbered by 5642 ;; Duplicate our handle on the passphrase so it's not clobbered by
5323 ;; deactivate-passwd memory clearing: 5643 ;; deactivate-passwd memory clearing:
5324 (setq got-pass (format "%s" got-pass)) 5644 (setq got-pass (copy-sequence got-pass))
5325 5645
5326 (cond (verifier-string 5646 (cond (verifier-string
5327 (save-window-excursion 5647 (save-window-excursion
5328 (if (allout-encrypt-string verifier-string 'decrypt 5648 (if (allout-encrypt-string verifier-string 'decrypt
5329 allout-buffer 'symmetric 5649 allout-buffer 'symmetric
5330 for-key nil 0 'verifying 5650 for-key nil 0 0 'verifying
5331 got-pass) 5651 (copy-sequence got-pass))
5332 (setq confirmation (format "%s" got-pass)))) 5652 (setq confirmation (format "%s" got-pass))))
5333 5653
5334 (if (and (not confirmation) 5654 (if (and (not confirmation)
@@ -5365,15 +5685,7 @@ of the availability of a cached copy."
5365 ;; recurse to this routine: 5685 ;; recurse to this routine:
5366 (pgg-read-passphrase prompt-sans-hint cache-id t)) 5686 (pgg-read-passphrase prompt-sans-hint cache-id t))
5367 (pgg-remove-passphrase-from-cache cache-id t) 5687 (pgg-remove-passphrase-from-cache cache-id t)
5368 (error "Confirmation failed."))) 5688 (error "Confirmation failed."))))))))
5369 ;; reduce opportunity for memory cherry-picking by zeroing duplicate:
5370 (dotimes (i (length got-pass))
5371 (aset got-pass i 0))
5372 )
5373 )
5374 )
5375 )
5376 )
5377;;;_ > allout-encrypted-topic-p () 5689;;;_ > allout-encrypted-topic-p ()
5378(defun allout-encrypted-topic-p () 5690(defun allout-encrypted-topic-p ()
5379 "True if the current topic is encryptable and encrypted." 5691 "True if the current topic is encryptable and encrypted."
@@ -5426,7 +5738,7 @@ An error is raised if the text is not encrypted."
5426 (dotimes (i (length spew)) 5738 (dotimes (i (length spew))
5427 (aset spew i (1+ (random 254)))) 5739 (aset spew i (1+ (random 254))))
5428 (allout-encrypt-string spew nil (current-buffer) 'symmetric 5740 (allout-encrypt-string spew nil (current-buffer) 'symmetric
5429 nil nil 0 passphrase)) 5741 nil nil 0 0 passphrase))
5430 ) 5742 )
5431;;;_ > allout-update-passphrase-mnemonic-aids (for-key passphrase 5743;;;_ > allout-update-passphrase-mnemonic-aids (for-key passphrase
5432;;; outline-buffer) 5744;;; outline-buffer)
@@ -5505,7 +5817,7 @@ Derived from value of `allout-passphrase-verifier-string'."
5505 allout-passphrase-verifier-string 5817 allout-passphrase-verifier-string
5506 (allout-encrypt-string (allout-get-encryption-passphrase-verifier) 5818 (allout-encrypt-string (allout-get-encryption-passphrase-verifier)
5507 'decrypt allout-buffer 'symmetric 5819 'decrypt allout-buffer 'symmetric
5508 key nil 0 'verifying passphrase) 5820 key nil 0 0 'verifying passphrase)
5509 t))) 5821 t)))
5510;;;_ > allout-next-topic-pending-encryption (&optional except-mark) 5822;;;_ > allout-next-topic-pending-encryption (&optional except-mark)
5511(defun allout-next-topic-pending-encryption (&optional except-mark) 5823(defun allout-next-topic-pending-encryption (&optional except-mark)
@@ -5808,6 +6120,25 @@ If BEG is bigger than END we return 0."
5808 (goto-char (1+ (match-beginning 0))) 6120 (goto-char (1+ (match-beginning 0)))
5809 (setq count (1+ count))) 6121 (setq count (1+ count)))
5810 count)))) 6122 count))))
6123;;;_ > allout-get-configvar-values (varname)
6124(defun allout-get-configvar-values (configvar-name)
6125 "Return a list of values of the symbols in list bound to CONFIGVAR-NAME.
6126
6127The user is prompted for removal of symbols that are unbound, and they
6128otherwise are ignored.
6129
6130CONFIGVAR-NAME should be the name of the configuration variable,
6131not its value."
6132
6133 (let ((configvar-value (symbol-value configvar-name))
6134 got)
6135 (dolist (sym configvar-value)
6136 (if (not (boundp sym))
6137 (if (yes-or-no-p (format "%s entry `%s' is unbound - remove it? "
6138 configvar-name sym))
6139 (delq sym (symbol-value configvar-name)))
6140 (push (symbol-value sym) got)))
6141 (reverse got)))
5811;;;_ > allout-mark-marker to accommodate divergent emacsen: 6142;;;_ > allout-mark-marker to accommodate divergent emacsen:
5812(defun allout-mark-marker (&optional force buffer) 6143(defun allout-mark-marker (&optional force buffer)
5813 "Accommodate the different signature for `mark-marker' across Emacsen. 6144 "Accommodate the different signature for `mark-marker' across Emacsen.
diff --git a/lisp/avoid.el b/lisp/avoid.el
index 1868707720e..b497c2007bd 100644
--- a/lisp/avoid.el
+++ b/lisp/avoid.el
@@ -124,6 +124,7 @@ Only applies in mouse-avoidance-modes `animate' and `jump'."
124(defvar mouse-avoidance-pointer-shapes nil) 124(defvar mouse-avoidance-pointer-shapes nil)
125(defvar mouse-avoidance-n-pointer-shapes 0) 125(defvar mouse-avoidance-n-pointer-shapes 0)
126(defvar mouse-avoidance-old-pointer-shape nil) 126(defvar mouse-avoidance-old-pointer-shape nil)
127(defvar mouse-avoidance-animating-pointer nil)
127 128
128;; This timer is used to run something when Emacs is idle. 129;; This timer is used to run something when Emacs is idle.
129(defvar mouse-avoidance-timer nil) 130(defvar mouse-avoidance-timer nil)
@@ -243,16 +244,19 @@ You can redefine this if you want the mouse banished to a different corner."
243 (+ (cdr mouse-avoidance-state) deltay))) 244 (+ (cdr mouse-avoidance-state) deltay)))
244 (if (or (eq mouse-avoidance-mode 'animate) 245 (if (or (eq mouse-avoidance-mode 'animate)
245 (eq mouse-avoidance-mode 'proteus)) 246 (eq mouse-avoidance-mode 'proteus))
246 (let ((i 0.0)) 247 (let ((i 0.0)
248 (incr (max .1 (/ 1.0 mouse-avoidance-nudge-dist))))
249 (setq mouse-avoidance-animating-pointer t)
247 (while (<= i 1) 250 (while (<= i 1)
248 (mouse-avoidance-set-mouse-position 251 (mouse-avoidance-set-mouse-position
249 (cons (+ (car cur-pos) (round (* i deltax))) 252 (cons (+ (car cur-pos) (round (* i deltax)))
250 (+ (cdr cur-pos) (round (* i deltay))))) 253 (+ (cdr cur-pos) (round (* i deltay)))))
251 (setq i (+ i (max .1 (/ 1.0 mouse-avoidance-nudge-dist)))) 254 (setq i (+ i incr))
252 (if (eq mouse-avoidance-mode 'proteus) 255 (if (eq mouse-avoidance-mode 'proteus)
253 (mouse-avoidance-set-pointer-shape 256 (mouse-avoidance-set-pointer-shape
254 (mouse-avoidance-random-shape))) 257 (mouse-avoidance-random-shape)))
255 (sit-for mouse-avoidance-animation-delay))) 258 (sit-for mouse-avoidance-animation-delay))
259 (setq mouse-avoidance-animating-pointer nil))
256 (mouse-avoidance-set-mouse-position (cons (+ (car (cdr cur)) deltax) 260 (mouse-avoidance-set-mouse-position (cons (+ (car (cdr cur)) deltax)
257 (+ (cdr (cdr cur)) deltay)))))) 261 (+ (cdr (cdr cur)) deltay))))))
258 262
@@ -294,11 +298,11 @@ redefine this function to suit your own tastes."
294 (memq 'drag modifiers) 298 (memq 'drag modifiers)
295 (memq 'down modifiers))))))) 299 (memq 'down modifiers)))))))
296 300
297(defun mouse-avoidance-banish-hook () 301(defun mouse-avoidance-banish ()
298 (if (not (mouse-avoidance-ignore-p)) 302 (if (not (mouse-avoidance-ignore-p))
299 (mouse-avoidance-banish-mouse))) 303 (mouse-avoidance-banish-mouse)))
300 304
301(defun mouse-avoidance-exile-hook () 305(defun mouse-avoidance-exile ()
302 ;; For exile mode, the state is nil when the mouse is in its normal 306 ;; For exile mode, the state is nil when the mouse is in its normal
303 ;; position, and set to the old mouse-position when the mouse is in exile. 307 ;; position, and set to the old mouse-position when the mouse is in exile.
304 (if (not (mouse-avoidance-ignore-p)) 308 (if (not (mouse-avoidance-ignore-p))
@@ -317,9 +321,10 @@ redefine this function to suit your own tastes."
317 ;; but clear state anyway, to be ready for another move 321 ;; but clear state anyway, to be ready for another move
318 (setq mouse-avoidance-state nil)))))) 322 (setq mouse-avoidance-state nil))))))
319 323
320(defun mouse-avoidance-fancy-hook () 324(defun mouse-avoidance-fancy ()
321 ;; Used for the "fancy" modes, ie jump et al. 325 ;; Used for the "fancy" modes, ie jump et al.
322 (if (and (not (mouse-avoidance-ignore-p)) 326 (if (and (not mouse-avoidance-animating-pointer)
327 (not (mouse-avoidance-ignore-p))
323 (mouse-avoidance-too-close-p (mouse-position))) 328 (mouse-avoidance-too-close-p (mouse-position)))
324 (let ((old-pos (mouse-position))) 329 (let ((old-pos (mouse-position)))
325 (mouse-avoidance-nudge-mouse) 330 (mouse-avoidance-nudge-mouse)
@@ -375,14 +380,14 @@ definition of \"random distance\".)"
375 (eq mode 'animate) 380 (eq mode 'animate)
376 (eq mode 'proteus)) 381 (eq mode 'proteus))
377 (setq mouse-avoidance-timer 382 (setq mouse-avoidance-timer
378 (run-with-idle-timer 0.1 t 'mouse-avoidance-fancy-hook)) 383 (run-with-idle-timer 0.1 t 'mouse-avoidance-fancy))
379 (setq mouse-avoidance-mode mode 384 (setq mouse-avoidance-mode mode
380 mouse-avoidance-state (cons 0 0) 385 mouse-avoidance-state (cons 0 0)
381 mouse-avoidance-old-pointer-shape 386 mouse-avoidance-old-pointer-shape
382 (and (boundp 'x-pointer-shape) x-pointer-shape))) 387 (and (boundp 'x-pointer-shape) x-pointer-shape)))
383 ((eq mode 'exile) 388 ((eq mode 'exile)
384 (setq mouse-avoidance-timer 389 (setq mouse-avoidance-timer
385 (run-with-idle-timer 0.1 t 'mouse-avoidance-exile-hook)) 390 (run-with-idle-timer 0.1 t 'mouse-avoidance-exile))
386 (setq mouse-avoidance-mode mode 391 (setq mouse-avoidance-mode mode
387 mouse-avoidance-state nil)) 392 mouse-avoidance-state nil))
388 ((or (eq mode 'banish) 393 ((or (eq mode 'banish)
@@ -390,7 +395,7 @@ definition of \"random distance\".)"
390 (and (null mode) (null mouse-avoidance-mode)) 395 (and (null mode) (null mouse-avoidance-mode))
391 (and mode (> (prefix-numeric-value mode) 0))) 396 (and mode (> (prefix-numeric-value mode) 0)))
392 (setq mouse-avoidance-timer 397 (setq mouse-avoidance-timer
393 (run-with-idle-timer 0.1 t 'mouse-avoidance-banish-hook)) 398 (run-with-idle-timer 0.1 t 'mouse-avoidance-banish))
394 (setq mouse-avoidance-mode 'banish)) 399 (setq mouse-avoidance-mode 'banish))
395 (t (setq mouse-avoidance-mode nil))) 400 (t (setq mouse-avoidance-mode nil)))
396 (force-mode-line-update)) 401 (force-mode-line-update))
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 1accc5b2662..dacde69fa02 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -280,52 +280,62 @@ Keymap to display on minor modes.")
280 ;; mouse-1: select window, mouse-2: delete others, mouse-3: delete, 280 ;; mouse-1: select window, mouse-2: delete others, mouse-3: delete,
281 ;; drag-mouse-1: resize, C-mouse-2: split horizontally" 281 ;; drag-mouse-1: resize, C-mouse-2: split horizontally"
282 "mouse-1: select (drag to resize), mouse-2: delete others, mouse-3: delete this") 282 "mouse-1: select (drag to resize), mouse-2: delete others, mouse-3: delete this")
283 (dashes (propertize "--" 'help-echo help-echo))) 283 (dashes (propertize "--" 'help-echo help-echo))
284 (setq-default mode-line-format 284 (standard-mode-line-format
285 (list 285 (list
286 "%e" 286 "%e"
287 (propertize "-" 'help-echo help-echo) 287 (propertize "-" 'help-echo help-echo)
288 'mode-line-mule-info 288 'mode-line-mule-info
289 'mode-line-modified 289 'mode-line-modified
290 'mode-line-frame-identification 290 'mode-line-frame-identification
291 'mode-line-buffer-identification 291 'mode-line-buffer-identification
292 (propertize " " 'help-echo help-echo) 292 (propertize " " 'help-echo help-echo)
293 'mode-line-position 293 'mode-line-position
294 '(vc-mode vc-mode) 294 '(vc-mode vc-mode)
295 (propertize " " 'help-echo help-echo) 295 (propertize " " 'help-echo help-echo)
296 'mode-line-modes 296 'mode-line-modes
297 `(which-func-mode ("" which-func-format ,dashes)) 297 `(which-func-mode ("" which-func-format ,dashes))
298 `(global-mode-string (,dashes global-mode-string)) 298 `(global-mode-string (,dashes global-mode-string))
299 (propertize "-%-" 'help-echo help-echo))) 299 (propertize "-%-" 'help-echo help-echo)))
300 300 (standard-mode-line-modes
301 (setq-default mode-line-modes 301 (list
302 (list 302 (propertize "%[(" 'help-echo help-echo)
303 (propertize "%[(" 'help-echo help-echo) 303 `(:propertize ("" mode-name)
304 `(:propertize ("" mode-name) 304 help-echo "mouse-1: major mode, mouse-2: major mode help, mouse-3: toggle minor modes"
305 help-echo "mouse-1: major mode, mouse-2: major mode help, mouse-3: toggle minor modes" 305 mouse-face mode-line-highlight
306 mouse-face mode-line-highlight 306 local-map ,mode-line-major-mode-keymap)
307 local-map ,mode-line-major-mode-keymap) 307 '("" mode-line-process)
308 '("" mode-line-process) 308 `(:propertize ("" minor-mode-alist)
309 `(:propertize ("" minor-mode-alist) 309 mouse-face mode-line-highlight
310 mouse-face mode-line-highlight 310 help-echo "mouse-2: minor mode help, mouse-3: toggle minor modes"
311 help-echo "mouse-2: minor mode help, mouse-3: toggle minor modes" 311 local-map ,mode-line-minor-mode-keymap)
312 local-map ,mode-line-minor-mode-keymap) 312 (propertize "%n" 'help-echo "mouse-2: widen"
313 (propertize "%n" 'help-echo "mouse-2: widen" 313 'mouse-face 'mode-line-highlight
314 'mouse-face 'mode-line-highlight 314 'local-map (make-mode-line-mouse-map
315 'local-map (make-mode-line-mouse-map 315 'mouse-2 #'mode-line-widen))
316 'mouse-2 #'mode-line-widen)) 316 (propertize ")%]--" 'help-echo help-echo)))
317 (propertize ")%]--" 'help-echo help-echo))) 317 (standard-mode-line-position
318 318 `((-3 ,(propertize "%p" 'help-echo help-echo))
319 (setq-default mode-line-position 319 (size-indication-mode
320 `((-3 ,(propertize "%p" 'help-echo help-echo)) 320 (8 ,(propertize " of %I" 'help-echo help-echo)))
321 (size-indication-mode 321 (line-number-mode
322 (8 ,(propertize " of %I" 'help-echo help-echo))) 322 ((column-number-mode
323 (line-number-mode 323 (10 ,(propertize " (%l,%c)" 'help-echo help-echo))
324 ((column-number-mode 324 (6 ,(propertize " L%l" 'help-echo help-echo))))
325 (10 ,(propertize " (%l,%c)" 'help-echo help-echo)) 325 ((column-number-mode
326 (6 ,(propertize " L%l" 'help-echo help-echo)))) 326 (5 ,(propertize " C%c" 'help-echo help-echo))))))))
327 ((column-number-mode 327
328 (5 ,(propertize " C%c" 'help-echo help-echo)))))))) 328 (setq-default mode-line-format standard-mode-line-format)
329 (put 'mode-line-format 'standard-value
330 (list `(quote ,standard-mode-line-format)))
331
332 (setq-default mode-line-modes standard-mode-line-modes)
333 (put 'mode-line-modes 'standard-value
334 (list `(quote ,standard-mode-line-modes)))
335
336 (setq-default mode-line-position standard-mode-line-position)
337 (put 'mode-line-position 'standard-value
338 (list `(quote ,standard-mode-line-position))))
329 339
330(defvar mode-line-buffer-identification-keymap nil "\ 340(defvar mode-line-buffer-identification-keymap nil "\
331Keymap for what is displayed by `mode-line-buffer-identification'.") 341Keymap for what is displayed by `mode-line-buffer-identification'.")
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index e9e7e9a2bb8..398b362d4e4 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -117,6 +117,7 @@ file 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 119(defvar Info-current-file) ;; from info.el
120(defvar Info-current-node) ;; from info.el
120 121
121(make-variable-buffer-local 'Buffer-menu-files-only) 122(make-variable-buffer-local 'Buffer-menu-files-only)
122 123
@@ -786,7 +787,12 @@ For more information, see the function `buffer-menu'."
786 ((eq file 'toc) 787 ((eq file 'toc)
787 (setq file "*Info TOC*")) 788 (setq file "*Info TOC*"))
788 ((not (stringp file)) ;; avoid errors 789 ((not (stringp file)) ;; avoid errors
789 (setq file nil)))))) 790 (setq file nil))
791 (t
792 (setq file (concat "("
793 (file-name-nondirectory file)
794 ")"
795 Info-current-node)))))))
790 (push (list buffer bits name (buffer-size) mode file) 796 (push (list buffer bits name (buffer-size) mode file)
791 list)))))) 797 list))))))
792 ;; Preserve the original buffer-list ordering, just in case. 798 ;; Preserve the original buffer-list ordering, just in case.
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index 3f2697509f3..13b3671e16a 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -95,7 +95,7 @@
95 :group 'timeclock) 95 :group 'timeclock)
96 96
97(defcustom timeclock-relative t 97(defcustom timeclock-relative t
98 "*Whether to maken reported time relative to `timeclock-workday'. 98 "*Whether to make reported time relative to `timeclock-workday'.
99For example, if the length of a normal workday is eight hours, and you 99For example, if the length of a normal workday is eight hours, and you
100work four hours on Monday, then the amount of time \"remaining\" on 100work four hours on Monday, then the amount of time \"remaining\" on
101Tuesday is twelve hours -- relative to an averaged work period of 101Tuesday is twelve hours -- relative to an averaged work period of
@@ -251,7 +251,10 @@ each day.")
251This value is not accurate enough to be useful by itself. Rather, 251This value is not accurate enough to be useful by itself. Rather,
252call `timeclock-workday-elapsed', to determine how much time has been 252call `timeclock-workday-elapsed', to determine how much time has been
253worked so far today. Also, if `timeclock-relative' is nil, this value 253worked so far today. Also, if `timeclock-relative' is nil, this value
254will be the same as `timeclock-discrepancy'.") ; ? gm 254will be the same as `timeclock-discrepancy'.")
255
256(defvar timeclock-use-elapsed nil
257 "Non-nil if the modeline should display time elapsed, not remaining.")
255 258
256(defvar timeclock-last-period nil 259(defvar timeclock-last-period nil
257 "Integer representing the number of seconds in the last period. 260 "Integer representing the number of seconds in the last period.
@@ -424,7 +427,9 @@ If SHOW-SECONDS is non-nil, display second resolution.
424If TODAY-ONLY is non-nil, the display will be relative only to time 427If TODAY-ONLY is non-nil, the display will be relative only to time
425worked today, ignoring the time worked on previous days." 428worked today, ignoring the time worked on previous days."
426 (interactive "P") 429 (interactive "P")
427 (let ((remainder (timeclock-workday-remaining)) ; today-only? 430 (let ((remainder (timeclock-workday-remaining
431 (or today-only
432 (not timeclock-relative))))
428 (last-in (equal (car timeclock-last-event) "i")) 433 (last-in (equal (car timeclock-last-event) "i"))
429 status) 434 status)
430 (setq status 435 (setq status
@@ -619,7 +624,10 @@ relative only to the time worked today, and not to past time."
619The value of `timeclock-relative' affects the display as described in 624The value of `timeclock-relative' affects the display as described in
620that variable's documentation." 625that variable's documentation."
621 (interactive) 626 (interactive)
622 (let ((remainder (timeclock-workday-remaining (not timeclock-relative))) 627 (let ((remainder
628 (if timeclock-use-elapsed
629 (timeclock-workday-elapsed)
630 (timeclock-workday-remaining (not timeclock-relative))))
623 (last-in (equal (car timeclock-last-event) "i"))) 631 (last-in (equal (car timeclock-last-event) "i")))
624 (when (and (< remainder 0) 632 (when (and (< remainder 0)
625 (not (and timeclock-day-over 633 (not (and timeclock-day-over
diff --git a/lisp/compare-w.el b/lisp/compare-w.el
index e61f24a0c7c..3aa01424fb5 100644
--- a/lisp/compare-w.el
+++ b/lisp/compare-w.el
@@ -167,16 +167,14 @@ on first call it advances points to the next difference,
167on second call it synchronizes points by skipping the difference, 167on second call it synchronizes points by skipping the difference,
168on third call it again advances points to the next difference and so on." 168on third call it again advances points to the next difference and so on."
169 (interactive "P") 169 (interactive "P")
170 (if compare-ignore-whitespace
171 (setq ignore-whitespace (not ignore-whitespace)))
170 (let* (p1 p2 maxp1 maxp2 b1 b2 w2 172 (let* (p1 p2 maxp1 maxp2 b1 b2 w2
171 (progress 1) 173 (progress 1)
172 (opoint1 (point)) 174 (opoint1 (point))
173 opoint2 175 opoint2
174 (skip-func (if (if ignore-whitespace ; XOR 176 skip-func-1
175 (not compare-ignore-whitespace) 177 skip-func-2
176 compare-ignore-whitespace)
177 (if (stringp compare-windows-whitespace)
178 'compare-windows-skip-whitespace
179 compare-windows-whitespace)))
180 (sync-func (if (stringp compare-windows-sync) 178 (sync-func (if (stringp compare-windows-sync)
181 'compare-windows-sync-regexp 179 'compare-windows-sync-regexp
182 compare-windows-sync))) 180 compare-windows-sync)))
@@ -190,8 +188,19 @@ on third call it again advances points to the next difference and so on."
190 b2 (window-buffer w2)) 188 b2 (window-buffer w2))
191 (setq opoint2 p2) 189 (setq opoint2 p2)
192 (setq maxp1 (point-max)) 190 (setq maxp1 (point-max))
193 (save-excursion 191
194 (set-buffer b2) 192 (setq skip-func-1 (if ignore-whitespace
193 (if (stringp compare-windows-whitespace)
194 (lambda () (compare-windows-skip-whitespace)
195 t)
196 compare-windows-whitespace)))
197
198 (with-current-buffer b2
199 (setq skip-func-2 (if ignore-whitespace
200 (if (stringp compare-windows-whitespace)
201 (lambda () (compare-windows-skip-whitespace)
202 t)
203 compare-windows-whitespace)))
195 (push-mark p2 t) 204 (push-mark p2 t)
196 (setq maxp2 (point-max))) 205 (setq maxp2 (point-max)))
197 (push-mark) 206 (push-mark)
@@ -199,17 +208,16 @@ on third call it again advances points to the next difference and so on."
199 (while (> progress 0) 208 (while (> progress 0)
200 ;; If both windows have whitespace next to point, 209 ;; If both windows have whitespace next to point,
201 ;; optionally skip over it. 210 ;; optionally skip over it.
202 (and skip-func 211 (and skip-func-1
203 (save-excursion 212 (save-excursion
204 (let (p1a p2a w1 w2 result1 result2) 213 (let (p1a p2a w1 w2 result1 result2)
205 (setq result1 (funcall skip-func opoint1)) 214 (setq result1 (funcall skip-func-1 opoint1))
206 (setq p1a (point)) 215 (setq p1a (point))
207 (set-buffer b2) 216 (set-buffer b2)
208 (goto-char p2) 217 (goto-char p2)
209 (setq result2 (funcall skip-func opoint2)) 218 (setq result2 (funcall skip-func-2 opoint2))
210 (setq p2a (point)) 219 (setq p2a (point))
211 (if (or (stringp compare-windows-whitespace) 220 (if (and result1 result2 (eq result1 result2))
212 (and result1 result2 (eq result1 result2)))
213 (setq p1 p1a 221 (setq p1 p1a
214 p2 p2a))))) 222 p2 p2a)))))
215 223
diff --git a/lisp/complete.el b/lisp/complete.el
index c49ad488536..90c1ceceb32 100644
--- a/lisp/complete.el
+++ b/lisp/complete.el
@@ -543,8 +543,8 @@ of `minibuffer-completion-table' and the minibuffer contents.")
543 (let ((compl (all-completions (if env-on 543 (let ((compl (all-completions (if env-on
544 (file-name-nondirectory (substring str 0 p)) 544 (file-name-nondirectory (substring str 0 p))
545 (substring str 0 p)) 545 (substring str 0 p))
546 table 546 table
547 pred))) 547 pred)))
548 (setq p compl) 548 (setq p compl)
549 (while p 549 (while p
550 (and (string-match regex (car p)) 550 (and (string-match regex (car p))
@@ -553,6 +553,34 @@ of `minibuffer-completion-table' and the minibuffer contents.")
553 (setq poss (cons (car p) poss)))) 553 (setq poss (cons (car p) poss))))
554 (setq p (cdr p))))) 554 (setq p (cdr p)))))
555 555
556 ;; Handle completion-ignored-extensions
557 (and filename
558 (not (eq mode 'help))
559 (let ((p2 poss))
560
561 ;; Build a regular expression representing the extensions list
562 (or (equal completion-ignored-extensions PC-ignored-extensions)
563 (setq PC-ignored-regexp
564 (concat "\\("
565 (mapconcat
566 'regexp-quote
567 (setq PC-ignored-extensions
568 completion-ignored-extensions)
569 "\\|")
570 "\\)\\'")))
571
572 ;; Check if there are any without an ignored extension.
573 ;; Also ignore `.' and `..'.
574 (setq p nil)
575 (while p2
576 (or (string-match PC-ignored-regexp (car p2))
577 (string-match "\\(\\`\\|/\\)[.][.]?/?\\'" (car p2))
578 (setq p (cons (car p2) p)))
579 (setq p2 (cdr p2)))
580
581 ;; If there are "good" names, use them
582 (and p (setq poss p))))
583
556 ;; Now we have a list of possible completions 584 ;; Now we have a list of possible completions
557 (cond 585 (cond
558 586
@@ -575,34 +603,6 @@ of `minibuffer-completion-table' and the minibuffer contents.")
575 ((or (cdr (setq helpposs poss)) 603 ((or (cdr (setq helpposs poss))
576 (memq mode '(help word))) 604 (memq mode '(help word)))
577 605
578 ;; Handle completion-ignored-extensions
579 (and filename
580 (not (eq mode 'help))
581 (let ((p2 poss))
582
583 ;; Build a regular expression representing the extensions list
584 (or (equal completion-ignored-extensions PC-ignored-extensions)
585 (setq PC-ignored-regexp
586 (concat "\\("
587 (mapconcat
588 'regexp-quote
589 (setq PC-ignored-extensions
590 completion-ignored-extensions)
591 "\\|")
592 "\\)\\'")))
593
594 ;; Check if there are any without an ignored extension.
595 ;; Also ignore `.' and `..'.
596 (setq p nil)
597 (while p2
598 (or (string-match PC-ignored-regexp (car p2))
599 (string-match "\\(\\`\\|/\\)[.][.]?/?\\'" (car p2))
600 (setq p (cons (car p2) p)))
601 (setq p2 (cdr p2)))
602
603 ;; If there are "good" names, use them
604 (and p (setq poss p))))
605
606 ;; Is the actual string one of the possible completions? 606 ;; Is the actual string one of the possible completions?
607 (setq p (and (not (eq mode 'help)) poss)) 607 (setq p (and (not (eq mode 'help)) poss))
608 (while (and p 608 (while (and p
@@ -623,7 +623,8 @@ of `minibuffer-completion-table' and the minibuffer contents.")
623 623
624 ;; Check if next few letters are the same in all cases 624 ;; Check if next few letters are the same in all cases
625 (if (and (not (eq mode 'help)) 625 (if (and (not (eq mode 'help))
626 (setq prefix (try-completion (PC-chunk-after basestr skip) (mapcar 'list poss)))) 626 (setq prefix (try-completion (PC-chunk-after basestr skip)
627 poss)))
627 (let ((first t) i) 628 (let ((first t) i)
628 ;; Retain capitalization of user input even if 629 ;; Retain capitalization of user input even if
629 ;; completion-ignore-case is set. 630 ;; completion-ignore-case is set.
@@ -669,13 +670,9 @@ of `minibuffer-completion-table' and the minibuffer contents.")
669 (+ beg (length dirname)) end) 670 (+ beg (length dirname)) end)
670 skip) 671 skip)
671 (mapcar 672 (mapcar
672 (function 673 (lambda (x)
673 (lambda (x) 674 (when (string-match skip x)
674 (list 675 (substring x (match-end 0))))
675 (and (string-match skip x)
676 (substring
677 x
678 (match-end 0))))))
679 poss))) 676 poss)))
680 (or (> i 0) (> (length prefix) 0)) 677 (or (> i 0) (> (length prefix) 0))
681 (or (not (eq mode 'word)) 678 (or (not (eq mode 'word))
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 0493dd0894c..609b5572a08 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -4436,6 +4436,7 @@ The format is suitable for use with `easy-menu-define'."
4436 (let ((map (make-keymap))) 4436 (let ((map (make-keymap)))
4437 (set-keymap-parent map widget-keymap) 4437 (set-keymap-parent map widget-keymap)
4438 (define-key map [remap self-insert-command] 'custom-no-edit) 4438 (define-key map [remap self-insert-command] 'custom-no-edit)
4439 (define-key map "\^m" 'custom-newline)
4439 (define-key map " " 'scroll-up) 4440 (define-key map " " 'scroll-up)
4440 (define-key map "\177" 'scroll-down) 4441 (define-key map "\177" 'scroll-down)
4441 (define-key map "\C-c\C-c" 'Custom-set) 4442 (define-key map "\C-c\C-c" 'Custom-set)
@@ -4452,6 +4453,14 @@ The format is suitable for use with `easy-menu-define'."
4452 (interactive "@d") 4453 (interactive "@d")
4453 (error "You can't edit this part of the Custom buffer")) 4454 (error "You can't edit this part of the Custom buffer"))
4454 4455
4456(defun custom-newline (pos &optional event)
4457 "Invoke button at POS, or refuse to allow editing of Custom buffer."
4458 (interactive "@d")
4459 (let ((button (get-char-property pos 'button)))
4460 (if button
4461 (widget-apply-action button event)
4462 (error "You can't edit this part of the Custom buffer"))))
4463
4455(easy-menu-define Custom-mode-menu 4464(easy-menu-define Custom-mode-menu
4456 custom-mode-map 4465 custom-mode-map
4457 "Menu used in customization buffers." 4466 "Menu used in customization buffers."
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index e35a75da598..2fce89c73c2 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -178,7 +178,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
178 ;; fringe.c 178 ;; fringe.c
179 (overflow-newline-into-fringe fringe boolean) 179 (overflow-newline-into-fringe fringe boolean)
180 ;; indent.c 180 ;; indent.c
181 (indent-tabs-mode fill boolean) 181 (indent-tabs-mode indent boolean)
182 ;; keyboard.c 182 ;; keyboard.c
183 (meta-prefix-char keyboard character) 183 (meta-prefix-char keyboard character)
184 (auto-save-interval auto-save integer) 184 (auto-save-interval auto-save integer)
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index 53f530505ae..b4fe1e4b0bf 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -99,7 +99,7 @@ the directory " custom-theme-directory "\n\n")
99 (widget-insert " ") 99 (widget-insert " ")
100 (widget-create 'push-button 100 (widget-create 'push-button
101 :notify (lambda (&rest ignore) 101 :notify (lambda (&rest ignore)
102 (when (y-or-n-p "Discard current changes?") 102 (when (y-or-n-p "Discard current changes? ")
103 (kill-buffer (current-buffer)) 103 (kill-buffer (current-buffer))
104 (customize-create-theme))) 104 (customize-create-theme)))
105 "Reset Buffer") 105 "Reset Buffer")
@@ -137,7 +137,7 @@ the directory " custom-theme-directory "\n\n")
137 (widget-insert "\n") 137 (widget-insert "\n")
138 (widget-create 'push-button 138 (widget-create 'push-button
139 :notify (lambda (&rest ignore) 139 :notify (lambda (&rest ignore)
140 (when (y-or-n-p "Discard current changes?") 140 (when (y-or-n-p "Discard current changes? ")
141 (kill-buffer (current-buffer)) 141 (kill-buffer (current-buffer))
142 (customize-create-theme))) 142 (customize-create-theme)))
143 "Reset Buffer") 143 "Reset Buffer")
@@ -290,7 +290,7 @@ Optional EVENT is the location for the menu."
290(defun custom-theme-visit-theme () 290(defun custom-theme-visit-theme ()
291 (interactive) 291 (interactive)
292 (when (or (null custom-theme-variables) 292 (when (or (null custom-theme-variables)
293 (if (y-or-n-p "Discard current changes?") 293 (if (y-or-n-p "Discard current changes? ")
294 (progn (customize-create-theme) t))) 294 (progn (customize-create-theme) t)))
295 (let ((theme (call-interactively 'custom-theme-merge-theme))) 295 (let ((theme (call-interactively 'custom-theme-merge-theme)))
296 (unless (eq theme 'user) 296 (unless (eq theme 'user)
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index d05eed2c4a2..1b37f3f772f 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -619,9 +619,12 @@ If optional second arg SEP is a string, use that as separator."
619 (bindat-format-vector vect "%02x" (if (stringp sep) sep ":"))) 619 (bindat-format-vector vect "%02x" (if (stringp sep) sep ":")))
620 620
621(defun bindat-ip-to-string (ip) 621(defun bindat-ip-to-string (ip)
622 "Format vector IP as an ip address in dotted notation." 622 "Format vector IP as an ip address in dotted notation.
623 (format "%d.%d.%d.%d" 623The port (if any) is omitted. IP can be a string, as well."
624 (aref ip 0) (aref ip 1) (aref ip 2) (aref ip 3))) 624 (if (vectorp ip)
625 (format-network-address ip t)
626 (format "%d.%d.%d.%d"
627 (aref ip 0) (aref ip 1) (aref ip 2) (aref ip 3))))
625 628
626(provide 'bindat) 629(provide 'bindat)
627 630
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 8645ec5a6ed..5107ee60274 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -2556,6 +2556,7 @@ MSG is printed after `::::} '."
2556 (edebug-outside-buffer (current-buffer)) 2556 (edebug-outside-buffer (current-buffer))
2557 (edebug-outside-point (point)) 2557 (edebug-outside-point (point))
2558 (edebug-outside-mark (edebug-mark)) 2558 (edebug-outside-mark (edebug-mark))
2559 (edebug-outside-unread-command-events unread-command-events)
2559 edebug-outside-windows ; window or screen configuration 2560 edebug-outside-windows ; window or screen configuration
2560 edebug-buffer-points 2561 edebug-buffer-points
2561 2562
@@ -2574,6 +2575,7 @@ MSG is printed after `::::} '."
2574 (overlay-arrow-string overlay-arrow-string) 2575 (overlay-arrow-string overlay-arrow-string)
2575 (cursor-in-echo-area nil) 2576 (cursor-in-echo-area nil)
2576 (default-cursor-in-non-selected-windows t) 2577 (default-cursor-in-non-selected-windows t)
2578 (unread-command-events unread-command-events)
2577 ;; any others?? 2579 ;; any others??
2578 ) 2580 )
2579 (if (not (buffer-name edebug-buffer)) 2581 (if (not (buffer-name edebug-buffer))
@@ -2662,6 +2664,7 @@ MSG is printed after `::::} '."
2662 2664
2663 (t (message ""))) 2665 (t (message "")))
2664 2666
2667 (setq unread-command-events nil)
2665 (if (eq 'after edebug-arg-mode) 2668 (if (eq 'after edebug-arg-mode)
2666 (progn 2669 (progn
2667 ;; Display result of previous evaluation. 2670 ;; Display result of previous evaluation.
@@ -2681,8 +2684,7 @@ MSG is printed after `::::} '."
2681 ((eq edebug-execution-mode 'trace) 2684 ((eq edebug-execution-mode 'trace)
2682 (edebug-sit-for edebug-sit-for-seconds)) ; Force update and pause. 2685 (edebug-sit-for edebug-sit-for-seconds)) ; Force update and pause.
2683 ((eq edebug-execution-mode 'Trace-fast) 2686 ((eq edebug-execution-mode 'Trace-fast)
2684 (edebug-sit-for 0)) ; Force update and continue. 2687 (edebug-sit-for 0))) ; Force update and continue.
2685 )
2686 2688
2687 (unwind-protect 2689 (unwind-protect
2688 (if (or edebug-stop 2690 (if (or edebug-stop
@@ -2778,6 +2780,7 @@ MSG is printed after `::::} '."
2778 (with-timeout-unsuspend edebug-with-timeout-suspend) 2780 (with-timeout-unsuspend edebug-with-timeout-suspend)
2779 ;; Reset global variables to outside values in case they were changed. 2781 ;; Reset global variables to outside values in case they were changed.
2780 (setq 2782 (setq
2783 unread-command-events edebug-outside-unread-command-events
2781 overlay-arrow-position edebug-outside-o-a-p 2784 overlay-arrow-position edebug-outside-o-a-p
2782 overlay-arrow-string edebug-outside-o-a-s 2785 overlay-arrow-string edebug-outside-o-a-s
2783 cursor-in-echo-area edebug-outside-c-i-e-a 2786 cursor-in-echo-area edebug-outside-c-i-e-a
@@ -2868,7 +2871,6 @@ MSG is printed after `::::} '."
2868 2871
2869 (edebug-outside-last-input-event last-input-event) 2872 (edebug-outside-last-input-event last-input-event)
2870 (edebug-outside-last-command-event last-command-event) 2873 (edebug-outside-last-command-event last-command-event)
2871 (edebug-outside-unread-command-events unread-command-events)
2872 (edebug-outside-last-event-frame last-event-frame) 2874 (edebug-outside-last-event-frame last-event-frame)
2873 (edebug-outside-last-nonmenu-event last-nonmenu-event) 2875 (edebug-outside-last-nonmenu-event last-nonmenu-event)
2874 (edebug-outside-track-mouse track-mouse) 2876 (edebug-outside-track-mouse track-mouse)
@@ -2890,7 +2892,6 @@ MSG is printed after `::::} '."
2890 ;; More for Emacs 19 2892 ;; More for Emacs 19
2891 (last-input-event nil) 2893 (last-input-event nil)
2892 (last-command-event nil) 2894 (last-command-event nil)
2893 (unread-command-events nil)
2894 (last-event-frame nil) 2895 (last-event-frame nil)
2895 (last-nonmenu-event nil) 2896 (last-nonmenu-event nil)
2896 (track-mouse nil) 2897 (track-mouse nil)
@@ -2950,7 +2951,6 @@ MSG is printed after `::::} '."
2950 last-command edebug-outside-last-command 2951 last-command edebug-outside-last-command
2951 this-command edebug-outside-this-command 2952 this-command edebug-outside-this-command
2952 unread-command-char edebug-outside-unread-command-char 2953 unread-command-char edebug-outside-unread-command-char
2953 unread-command-events edebug-outside-unread-command-events
2954 current-prefix-arg edebug-outside-current-prefix-arg 2954 current-prefix-arg edebug-outside-current-prefix-arg
2955 last-input-char edebug-outside-last-input-char 2955 last-input-char edebug-outside-last-input-char
2956 last-input-event edebug-outside-last-input-event 2956 last-input-event edebug-outside-last-input-event
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog
index 0129bd43976..72754aa1cd3 100644
--- a/lisp/erc/ChangeLog
+++ b/lisp/erc/ChangeLog
@@ -1,3 +1,41 @@
12006-08-13 Romain Francoise <romain@orebokech.com>
2
3 * erc-match.el (erc-log-matches-make-buffer): End `y-or-n-p'
4 prompt with a space.
5
62006-08-07 Michael Olson <mwolson@gnu.org>
7
8 * erc-backend.el (erc-process-sentinel-1): Use erc-display-message
9 in several places instead of inserting text.
10 (erc-process-sentinel): Move to the input-marker before removing
11 the prompt.
12
13 * erc.el (erc-port): Fix customization options.
14 (erc-display-message): Handle null type explicitly. Previously,
15 this was relying on a chance side-effect. Cosmetic indentation
16 tweak.
17 (english): Add 'finished and 'terminated entries to the catalog.
18 Add initial and terminal newlines to 'disconnected and
19 'disconnected-noreconnect entries. Avoid long lines.
20
212006-08-06 Michael Olson <mwolson@gnu.org>
22
23 * erc.el (erc-arrange-session-in-multiple-windows): Fix bug with
24 multi-tty Emacs.
25 (erc-select-startup-file): Fix bug introduced by recent change.
26
272006-08-05 Michael Olson <mwolson@gnu.org>
28
29 * erc-log.el (erc-log-standardize-name): New function that returns
30 a filename that is safe for use for a log file.
31 (erc-current-logfile): Use it.
32
33 * erc.el (erc-startup-file-list): Search in ~/.emacs.d first,
34 since that is a fairly standard directory.
35 (erc-select-startup-file): Re-write to use
36 convert-standard-filename, which will ensure that MS-DOS systems
37 look for the _ercrc.el file.
38
12006-08-02 Michael Olson <mwolson@gnu.org> 392006-08-02 Michael Olson <mwolson@gnu.org>
2 40
3 * erc.el (erc-version-string): Release ERC 5.1.4. 41 * erc.el (erc-version-string): Release ERC 5.1.4.
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 705ca7a9e63..5acbcb05ab8 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -493,11 +493,7 @@ action."
493 (if erc-server-quitting 493 (if erc-server-quitting
494 ;; normal quit 494 ;; normal quit
495 (progn 495 (progn
496 (let ((string "\n\n*** ERC finished ***\n") 496 (erc-display-message nil 'error (current-buffer) 'finished)
497 (inhibit-read-only t))
498 (erc-put-text-property 0 (length string)
499 'face 'erc-error-face string)
500 (insert string))
501 (when erc-kill-server-buffer-on-quit 497 (when erc-kill-server-buffer-on-quit
502 (set-buffer-modified-p nil) 498 (set-buffer-modified-p nil)
503 (kill-buffer (current-buffer)))) 499 (kill-buffer (current-buffer))))
@@ -519,12 +515,8 @@ action."
519 (erc erc-session-server erc-session-port erc-server-current-nick 515 (erc erc-session-server erc-session-port erc-server-current-nick
520 erc-session-user-full-name t erc-session-password) 516 erc-session-user-full-name t erc-session-password)
521 ;; terminate, do not reconnect 517 ;; terminate, do not reconnect
522 (let ((string (concat "\n\n*** ERC terminated: " event 518 (erc-display-message nil 'error (current-buffer)
523 "\n")) 519 'terminated ?e event))))
524 (inhibit-read-only t))
525 (erc-put-text-property 0 (length string)
526 'face 'erc-error-face string)
527 (insert string)))))
528 520
529(defun erc-process-sentinel (cproc event) 521(defun erc-process-sentinel (cproc event)
530 "Sentinel function for ERC process." 522 "Sentinel function for ERC process."
@@ -545,6 +537,7 @@ action."
545 (run-hook-with-args 'erc-disconnected-hook 537 (run-hook-with-args 'erc-disconnected-hook
546 (erc-current-nick) (system-name) "") 538 (erc-current-nick) (system-name) "")
547 ;; Remove the prompt 539 ;; Remove the prompt
540 (goto-char (or (marker-position erc-input-marker) (point-max)))
548 (forward-line 0) 541 (forward-line 0)
549 (erc-remove-text-properties-region (point) (point-max)) 542 (erc-remove-text-properties-region (point) (point-max))
550 (delete-region (point) (point-max)) 543 (delete-region (point) (point-max))
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index 418e45060bd..2fe29e82fe5 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -71,8 +71,6 @@
71;; markers. 71;; markers.
72 72
73;;; TODO: 73;;; TODO:
74;; * Erc needs a generalised make-safe-file-name function, so that
75;; generated file names don't contain any invalid file characters.
76;; 74;;
77;; * Really, we need to lock the logfiles somehow, so that if a user 75;; * Really, we need to lock the logfiles somehow, so that if a user
78;; is running multiple emacsen and/or on the same channel as more 76;; is running multiple emacsen and/or on the same channel as more
@@ -293,17 +291,27 @@ is writeable (it will be created as necessary) and
293 (funcall erc-enable-logging (or buffer (current-buffer))) 291 (funcall erc-enable-logging (or buffer (current-buffer)))
294 erc-enable-logging))) 292 erc-enable-logging)))
295 293
294(defun erc-log-standardize-name (filename)
295 "Make FILENAME safe to use as the name of an ERC log.
296This will not work with full paths, only names.
297
298Any unsafe characters in the name are replaced with \"!\". The
299filename is downcased."
300 (downcase (erc-replace-regexp-in-string
301 "[/\\]" "!" (convert-standard-filename filename))))
302
296(defun erc-current-logfile (&optional buffer) 303(defun erc-current-logfile (&optional buffer)
297 "Return the logfile to use for BUFFER. 304 "Return the logfile to use for BUFFER.
298If BUFFER is nil, the value of `current-buffer' is used. 305If BUFFER is nil, the value of `current-buffer' is used.
299This is determined by `erc-generate-log-file-name-function'. 306This is determined by `erc-generate-log-file-name-function'.
300The result is converted to lowercase, as IRC is case-insensitive" 307The result is converted to lowercase, as IRC is case-insensitive"
301 (expand-file-name 308 (expand-file-name
302 (downcase (funcall erc-generate-log-file-name-function 309 (erc-log-standardize-name
303 (or buffer (current-buffer)) 310 (funcall erc-generate-log-file-name-function
304 (or (erc-default-target) (buffer-name buffer)) 311 (or buffer (current-buffer))
305 (erc-current-nick) 312 (or (erc-default-target) (buffer-name buffer))
306 erc-session-server erc-session-port)) 313 (erc-current-nick)
314 erc-session-server erc-session-port))
307 erc-log-channels-directory)) 315 erc-log-channels-directory))
308 316
309(defun erc-generate-log-file-name-with-date (buffer &rest ignore) 317(defun erc-generate-log-file-name-with-date (buffer &rest ignore)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index ffbc7482aae..b5dc913a8c4 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -566,7 +566,7 @@ deactivate/activate match logging in the latter. See
566 (unless buffer-already 566 (unless buffer-already
567 (insert " == Type \"q\" to dismiss messages ==\n") 567 (insert " == Type \"q\" to dismiss messages ==\n")
568 (erc-view-mode-enter nil (lambda (buffer) 568 (erc-view-mode-enter nil (lambda (buffer)
569 (when (y-or-n-p "Discard messages?") 569 (when (y-or-n-p "Discard messages? ")
570 (kill-buffer buffer))))) 570 (kill-buffer buffer)))))
571 buffer))) 571 buffer)))
572 572
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 4317b831d56..41d59576251 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -157,8 +157,8 @@ parameters and authentication."
157This can be either a string or a number." 157This can be either a string or a number."
158 :group 'erc 158 :group 'erc
159 :type '(choice (const :tag "None" nil) 159 :type '(choice (const :tag "None" nil)
160 (const :tag "Port number" number) 160 (integer :tag "Port number")
161 (const :tag "Port string" string))) 161 (string :tag "Port string")))
162 162
163(defcustom erc-nick nil 163(defcustom erc-nick nil
164 "Nickname to use if one is not provided. 164 "Nickname to use if one is not provided.
@@ -822,7 +822,8 @@ See `erc-server-flood-margin' for other flood-related parameters.")
822;; Script parameters 822;; Script parameters
823 823
824(defcustom erc-startup-file-list 824(defcustom erc-startup-file-list
825 '("~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc") 825 '("~/.emacs.d/.ercrc.el" "~/.emacs.d/.ercrc"
826 "~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc")
826 "List of files to try for a startup script. 827 "List of files to try for a startup script.
827The first existent and readable one will get executed. 828The first existent and readable one will get executed.
828 829
@@ -2362,6 +2363,8 @@ See also `erc-format-message' and `erc-display-line'."
2362 msg))) 2363 msg)))
2363 (setq string 2364 (setq string
2364 (cond 2365 (cond
2366 ((null type)
2367 string)
2365 ((listp type) 2368 ((listp type)
2366 (mapc (lambda (type) 2369 (mapc (lambda (type)
2367 (setq string 2370 (setq string
@@ -2374,7 +2377,7 @@ See also `erc-format-message' and `erc-display-line'."
2374 (if (not (erc-response-p parsed)) 2377 (if (not (erc-response-p parsed))
2375 (erc-display-line string buffer) 2378 (erc-display-line string buffer)
2376 (unless (member (erc-response.command parsed) erc-hide-list) 2379 (unless (member (erc-response.command parsed) erc-hide-list)
2377 (erc-put-text-property 0 (length string) 'erc-parsed parsed string) 2380 (erc-put-text-property 0 (length string) 'erc-parsed parsed string)
2378 (erc-put-text-property 0 (length string) 'rear-sticky t string) 2381 (erc-put-text-property 0 (length string) 'rear-sticky t string)
2379 (erc-display-line string buffer))))) 2382 (erc-display-line string buffer)))))
2380 2383
@@ -5241,13 +5244,11 @@ If FILE is found, return the path to it."
5241(defun erc-select-startup-file () 5244(defun erc-select-startup-file ()
5242 "Select an ERC startup file. 5245 "Select an ERC startup file.
5243See also `erc-startup-file-list'." 5246See also `erc-startup-file-list'."
5244 (let ((l erc-startup-file-list) 5247 (catch 'found
5245 (f nil)) 5248 (dolist (f erc-startup-file-list)
5246 (while (and (not f) l) 5249 (setq f (convert-standard-filename f))
5247 (if (file-readable-p (car l)) 5250 (when (file-readable-p f)
5248 (setq f (car l))) 5251 (throw 'found f)))))
5249 (setq l (cdr l)))
5250 f))
5251 5252
5252(defun erc-find-script-file (file) 5253(defun erc-find-script-file (file)
5253 "Search for FILE in `default-directory', and any in `erc-script-path'." 5254 "Search for FILE in `default-directory', and any in `erc-script-path'."
@@ -5894,7 +5895,8 @@ All windows are opened in the current frame."
5894 (setq bufs (cdr bufs)) 5895 (setq bufs (cdr bufs))
5895 (while bufs 5896 (while bufs
5896 (split-window) 5897 (split-window)
5897 (switch-to-buffer-other-window (car bufs)) 5898 (other-window 1)
5899 (switch-to-buffer (car bufs))
5898 (setq bufs (cdr bufs)) 5900 (setq bufs (cdr bufs))
5899 (balance-windows))))) 5901 (balance-windows)))))
5900 5902
@@ -5946,12 +5948,17 @@ All windows are opened in the current frame."
5946 (ctcp-request-to . "==> CTCP request from %n (%u@%h) to %t: %r") 5948 (ctcp-request-to . "==> CTCP request from %n (%u@%h) to %t: %r")
5947 (ctcp-too-many . "Too many CTCP queries in single message. Ignoring") 5949 (ctcp-too-many . "Too many CTCP queries in single message. Ignoring")
5948 (flood-ctcp-off . "FLOOD PROTECTION: Automatic CTCP responses turned off.") 5950 (flood-ctcp-off . "FLOOD PROTECTION: Automatic CTCP responses turned off.")
5949 (flood-strict-mode . "FLOOD PROTECTION: Switched to Strict Flood Control mode.") 5951 (flood-strict-mode
5950 (disconnected . "Connection failed! Re-establishing connection...") 5952 . "FLOOD PROTECTION: Switched to Strict Flood Control mode.")
5951 (disconnected-noreconnect . "Connection failed! Not re-establishing connection.") 5953 (disconnected . "\n\nConnection failed! Re-establishing connection...\n")
5954 (disconnected-noreconnect
5955 . "\n\nConnection failed! Not re-establishing connection.\n")
5956 (finished . "\n\n*** ERC finished ***\n")
5957 (terminated . "\n\n*** ERC terminated: %e\n")
5952 (login . "Logging in as \'%n\'...") 5958 (login . "Logging in as \'%n\'...")
5953 (nick-in-use . "%n is in use. Choose new nickname: ") 5959 (nick-in-use . "%n is in use. Choose new nickname: ")
5954 (nick-too-long . "WARNING: Nick length (%i) exceeds max NICKLEN(%l) defined by server") 5960 (nick-too-long
5961 . "WARNING: Nick length (%i) exceeds max NICKLEN(%l) defined by server")
5955 (no-default-channel . "No default channel") 5962 (no-default-channel . "No default channel")
5956 (no-invitation . "You've got no invitation") 5963 (no-invitation . "You've got no invitation")
5957 (no-target . "No target") 5964 (no-target . "No target")
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index 76bde7784dc..c700d5d7f6e 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -97,7 +97,7 @@ This option slows down recursive glob processing by quite a bit."
97 :type 'boolean 97 :type 'boolean
98 :group 'eshell-glob) 98 :group 'eshell-glob)
99 99
100(defcustom eshell-glob-chars-list '(?\] ?\[ ?* ?? ?~ ?\( ?\) ?| ?#) 100(defcustom eshell-glob-chars-list '(?\] ?\[ ?* ?? ?~ ?\( ?\) ?| ?# ?^)
101 "*List of additional characters used in extended globbing." 101 "*List of additional characters used in extended globbing."
102 :type '(repeat character) 102 :type '(repeat character)
103 :group 'eshell-glob) 103 :group 'eshell-glob)
@@ -105,6 +105,7 @@ This option slows down recursive glob processing by quite a bit."
105(defcustom eshell-glob-translate-alist 105(defcustom eshell-glob-translate-alist
106 '((?\] . "]") 106 '((?\] . "]")
107 (?\[ . "[") 107 (?\[ . "[")
108 (?^ . "^")
108 (?? . ".") 109 (?? . ".")
109 (?* . ".*") 110 (?* . ".*")
110 (?~ . "~") 111 (?~ . "~")
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index a8d8ea9a4b5..eaaf4dacd72 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -134,18 +134,24 @@ just before \"Other\" at the end."
134 134
135(defcustom facemenu-listed-faces nil 135(defcustom facemenu-listed-faces nil
136 "*List of faces to include in the Face menu. 136 "*List of faces to include in the Face menu.
137Each element should be a symbol, which is the name of a face. 137Each element should be a symbol, the name of a face.
138The \"basic \" faces in `facemenu-keybindings' are automatically 138The \"basic \" faces in `facemenu-keybindings' are automatically
139added to the Face menu, and are not included in this list. 139added to the Face menu, and need not be in this list.
140 140
141You can set this list before loading facemenu.el, or add a face to it before 141This value takes effect when you load facemenu.el. If the
142creating that face if you want it to be listed. If you change the 142list includes symbols which are not defined as faces, they
143variable so as to eliminate faces that have already been added to the menu, 143are ignored; however, subsequently defining or creating
144call `facemenu-update' to recalculate the menu contents. 144those faces adds them to the menu then. You can call
145 145`facemenu-update' to recalculate the menu contents, such as
146If this variable is t, all faces will be added to the menu. This 146if you change the value of this variable,
147is useful for setting temporarily if you want to add faces to the 147
148menu when they are created." 148If this variable is t, all faces that you apply to text
149using the face menu commands (even by name), and all faces
150that you define or create, are added to the menu. You may
151find it useful to set this variable to t temporarily while
152you define some faces, so that they will be added. However,
153if the value is no longer t and you call `facemenu-update',
154it will remove any faces not explicitly in the list."
149 :type '(choice (const :tag "List all faces" t) 155 :type '(choice (const :tag "List all faces" t)
150 (const :tag "None" nil) 156 (const :tag "None" nil)
151 (repeat symbol)) 157 (repeat symbol))
@@ -320,19 +326,24 @@ variables."
320 326
321;;;###autoload 327;;;###autoload
322(defun facemenu-set-face (face &optional start end) 328(defun facemenu-set-face (face &optional start end)
323 "Add FACE to the region or next character typed. 329 "Apply FACE to the region or next character typed.
324This adds FACE to the top of the face list; any faces lower on the list that 330
325will not show through at all will be removed. 331If the region is active (normally true except in Transient
326 332Mark mode) and nonempty, and there is no prefix argument,
327Interactively, reads the face name with the minibuffer. 333this command applies FACE to the region. Otherwise, it applies FACE
328 334to the faces to use for the next character
329If the region is active (normally true except in Transient Mark mode) 335inserted. (Moving point or switching buffers before typing
330and there is no prefix argument, this command sets the region to the 336a character to insert cancels the specification.)
331requested face. 337
332 338If FACE is `default', to \"apply\" it means clearing
333Otherwise, this command specifies the face for the next character 339the list of faces to be used. For any other value of FACE,
334inserted. Moving point or switching buffers before 340to \"apply\" it means putting FACE at the front of the list
335typing a character to insert cancels the specification." 341of faces to be used, and removing any faces further
342along in the list that would be completely overridden by
343preceding faces (including FACE).
344
345This command can also add FACE to the menu of faces,
346if `facemenu-listed-faces' says to do that."
336 (interactive (list (progn 347 (interactive (list (progn
337 (barf-if-buffer-read-only) 348 (barf-if-buffer-read-only)
338 (read-face-name "Use face")) 349 (read-face-name "Use face"))
@@ -612,7 +623,12 @@ effect. See `facemenu-remove-face-function'."
612 (cons face 623 (cons face
613 (if (listp prev) 624 (if (listp prev)
614 prev 625 prev
615 (list prev))))))) 626 (list prev)))
627 ;; Specify the selected frame
628 ;; because nil would mean to use
629 ;; the new-frame default settings,
630 ;; and those are usually nil.
631 (selected-frame)))))
616 (setq part-start part-end))) 632 (setq part-start part-end)))
617 (setq self-insert-face (if (eq last-command self-insert-face-command) 633 (setq self-insert-face (if (eq last-command self-insert-face-command)
618 (cons face (if (listp self-insert-face) 634 (cons face (if (listp self-insert-face)
@@ -655,9 +671,8 @@ use the selected frame. If t, then the global, non-frame faces are used."
655 (nreverse active-list))) 671 (nreverse active-list)))
656 672
657(defun facemenu-add-new-face (face) 673(defun facemenu-add-new-face (face)
658 "Add FACE (a face) to the Face menu. 674 "Add FACE (a face) to the Face menu if `facemenu-listed-faces' says so.
659 675This is called whenever you create a new face, and at other times."
660This is called whenever you create a new face."
661 (let* (name 676 (let* (name
662 symbol 677 symbol
663 menu docstring 678 menu docstring
diff --git a/lisp/faces.el b/lisp/faces.el
index 4627b5ff594..f2d3e0ddb44 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -2066,7 +2066,7 @@ created."
2066 ;; red4 is too dark, but some say blue is too loud. 2066 ;; red4 is too dark, but some say blue is too loud.
2067 ;; brown seems to work ok. -- rms. 2067 ;; brown seems to work ok. -- rms.
2068 (t :foreground "brown")) 2068 (t :foreground "brown"))
2069 "Face for characters displayed as ^-sequences or \-sequences." 2069 "Face for characters displayed as sequences using `^' or `\\'."
2070 :group 'basic-faces 2070 :group 'basic-faces
2071 :version "22.1") 2071 :version "22.1")
2072 2072
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 4ca5a9d1420..eb8cdb02617 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -1798,7 +1798,7 @@ User will be queried, if no fileset name is provided."
1798 filesets-data nil))) 1798 filesets-data nil)))
1799 (entry (or (assoc name filesets-data) 1799 (entry (or (assoc name filesets-data)
1800 (when (y-or-n-p 1800 (when (y-or-n-p
1801 (format "Fileset %s does not exist. Create it?" 1801 (format "Fileset %s does not exist. Create it? "
1802 name)) 1802 name))
1803 (progn 1803 (progn
1804 (add-to-list 'filesets-data (list name '(:files))) 1804 (add-to-list 'filesets-data (list name '(:files)))
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index b05b7ecc2e6..82f9be4cb4c 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -976,7 +976,7 @@ The value of this variable is used when Font Lock mode is turned on."
976;; multi-line strings and comments; regexps are not appropriate for the job.) 976;; multi-line strings and comments; regexps are not appropriate for the job.)
977 977
978(defvar font-lock-extend-after-change-region-function nil 978(defvar font-lock-extend-after-change-region-function nil
979 "A function that determines the region to fontify after a change. 979 "A function that determines the region to refontify after a change.
980 980
981This variable is either nil, or is a function that determines the 981This variable is either nil, or is a function that determines the
982region to refontify after a change. 982region to refontify after a change.
@@ -985,7 +985,7 @@ Font-lock calls this function after each buffer change.
985 985
986The function is given three parameters, the standard BEG, END, and OLD-LEN 986The function is given three parameters, the standard BEG, END, and OLD-LEN
987from `after-change-functions'. It should return either a cons of the beginning 987from `after-change-functions'. It should return either a cons of the beginning
988and end buffer positions \(in that order) of the region to fontify, or nil 988and end buffer positions \(in that order) of the region to refontify, or nil
989\(which directs the caller to fontify a default region). 989\(which directs the caller to fontify a default region).
990This function should preserve the match-data. 990This function should preserve the match-data.
991The region it returns may start or end in the middle of a line.") 991The region it returns may start or end in the middle of a line.")
@@ -1044,6 +1044,12 @@ a very meaningful entity to highlight.")
1044(defvar font-lock-beg) (defvar font-lock-end) 1044(defvar font-lock-beg) (defvar font-lock-end)
1045(defvar font-lock-extend-region-functions 1045(defvar font-lock-extend-region-functions
1046 '(font-lock-extend-region-wholelines 1046 '(font-lock-extend-region-wholelines
1047 ;; This use of font-lock-multiline property is unreliable but is just
1048 ;; a handy heuristic: in case you don't have a function that does
1049 ;; /identification/ of multiline elements, you may still occasionally
1050 ;; discover them by accident (or you may /identify/ them but not in all
1051 ;; cases), in which case the font-lock-multiline property can help make
1052 ;; sure you will properly *re*identify them during refontification.
1047 font-lock-extend-region-multiline) 1053 font-lock-extend-region-multiline)
1048 "Special hook run just before proceeding to fontify a region. 1054 "Special hook run just before proceeding to fontify a region.
1049This is used to allow major modes to help font-lock find safe buffer positions 1055This is used to allow major modes to help font-lock find safe buffer positions
@@ -1167,6 +1173,13 @@ what properties to clear before refontifying a region.")
1167 1173
1168(defvar jit-lock-start) (defvar jit-lock-end) 1174(defvar jit-lock-start) (defvar jit-lock-end)
1169(defun font-lock-extend-jit-lock-region-after-change (beg end old-len) 1175(defun font-lock-extend-jit-lock-region-after-change (beg end old-len)
1176 "Function meant for `jit-lock-after-change-extend-region-functions'.
1177This function does 2 things:
1178- extend the region so that it not only includes the part that was modified
1179 but also the surrounding text whose highlighting may change as a consequence.
1180- anticipate (part of) the region extension that will happen later in
1181 `font-lock-default-fontify-region', in order to avoid the need for
1182 double-redisplay in `jit-lock-fontify-now'."
1170 (save-excursion 1183 (save-excursion
1171 ;; First extend the region as font-lock-after-change-function would. 1184 ;; First extend the region as font-lock-after-change-function would.
1172 (let ((region (if font-lock-extend-after-change-region-function 1185 (let ((region (if font-lock-extend-after-change-region-function
@@ -1177,6 +1190,16 @@ what properties to clear before refontifying a region.")
1177 end (max jit-lock-end (cdr region)))) 1190 end (max jit-lock-end (cdr region))))
1178 ;; Then extend the region obeying font-lock-multiline properties, 1191 ;; Then extend the region obeying font-lock-multiline properties,
1179 ;; indicating which part of the buffer needs to be refontified. 1192 ;; indicating which part of the buffer needs to be refontified.
1193 ;; !!! This is the *main* user of font-lock-multiline property !!!
1194 ;; font-lock-after-change-function could/should also do that, but it
1195 ;; doesn't need to because font-lock-default-fontify-region does
1196 ;; it anyway. Here OTOH we have no guarantee that
1197 ;; font-lock-default-fontify-region will be executed on this region
1198 ;; any time soon.
1199 ;; Note: contrary to font-lock-default-fontify-region, we do not do
1200 ;; any loop here because we are not looking for a safe spot: we just
1201 ;; mark the text whose appearance may need to change as a result of
1202 ;; the buffer modification.
1180 (when (and (> beg (point-min)) 1203 (when (and (> beg (point-min))
1181 (get-text-property (1- beg) 'font-lock-multiline)) 1204 (get-text-property (1- beg) 'font-lock-multiline))
1182 (setq beg (or (previous-single-property-change 1205 (setq beg (or (previous-single-property-change
@@ -1186,8 +1209,11 @@ what properties to clear before refontifying a region.")
1186 'font-lock-multiline nil) 1209 'font-lock-multiline nil)
1187 (point-max))) 1210 (point-max)))
1188 ;; Finally, pre-enlarge the region to a whole number of lines, to try 1211 ;; Finally, pre-enlarge the region to a whole number of lines, to try
1189 ;; and predict what font-lock-default-fontify-region will do, so as to 1212 ;; and anticipate what font-lock-default-fontify-region will do, so as to
1190 ;; avoid double-redisplay. 1213 ;; avoid double-redisplay.
1214 ;; We could just run `font-lock-extend-region-functions', but since
1215 ;; the only purpose is to avoid the double-redisplay, we prefer to
1216 ;; do here only the part that is cheap and most likely to be useful.
1191 (when (memq 'font-lock-extend-region-wholelines 1217 (when (memq 'font-lock-extend-region-wholelines
1192 font-lock-extend-region-functions) 1218 font-lock-extend-region-functions)
1193 (goto-char beg) 1219 (goto-char beg)
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 750956b9f8b..6ddd513610a 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,27 @@
12006-08-13 Romain Francoise <romain@orebokech.com>
2
3 * mm-extern.el (mm-extern-mail-server): End `y-or-n-p' prompt with a
4 space.
5
62006-08-09 Katsumi Yamaoka <yamaoka@jpl.org>
7
8 * compface.el (uncompface): Use binary rather than raw-text-unix.
9
102006-08-09 Katsumi Yamaoka <yamaoka@jpl.org>
11
12 * compface.el (uncompface): Make sure the eol conversion doesn't take
13 place when communicating with the external programs. Reported by
14 ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
15
162006-07-31 Katsumi Yamaoka <yamaoka@jpl.org>
17
18 * nnheader.el (nnheader-insert-head): Fix typo in comment.
19
202006-07-31 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
21
22 * nnweb.el (nnweb-google-parse-1): Update regexp for author and date.
23 Make it more robust by parsing author and date independently.
24
12006-07-28 Katsumi Yamaoka <yamaoka@jpl.org> 252006-07-28 Katsumi Yamaoka <yamaoka@jpl.org>
2 26
3 * nnheader.el (nnheader-insert-head): Make it work with Mac as well. 27 * nnheader.el (nnheader-insert-head): Make it work with Mac as well.
diff --git a/lisp/gnus/compface.el b/lisp/gnus/compface.el
index f6bd9bfd720..33e05046e84 100644
--- a/lisp/gnus/compface.el
+++ b/lisp/gnus/compface.el
@@ -34,24 +34,28 @@ GNU/Linux system these might be in packages with names like `compface'
34or `faces-xface' and `netpbm' or `libgr-progs', for instance." 34or `faces-xface' and `netpbm' or `libgr-progs', for instance."
35 (with-temp-buffer 35 (with-temp-buffer
36 (insert face) 36 (insert face)
37 (and (eq 0 (apply 'call-process-region (point-min) (point-max) 37 (let ((coding-system-for-read 'raw-text)
38 "uncompface" 38 ;; At least "icontopbm" doesn't work with Windows because
39 'delete '(t nil) nil)) 39 ;; the line-break code is converted into CRLF by default.
40 (progn 40 (coding-system-for-write 'binary))
41 (goto-char (point-min)) 41 (and (eq 0 (apply 'call-process-region (point-min) (point-max)
42 (insert "/* Width=48, Height=48 */\n") 42 "uncompface"
43 ;; I just can't get "icontopbm" to work correctly on its 43 'delete '(t nil) nil))
44 ;; own in XEmacs. And Emacs doesn't understand un-raw pbm 44 (progn
45 ;; files. 45 (goto-char (point-min))
46 (if (not (featurep 'xemacs)) 46 (insert "/* Width=48, Height=48 */\n")
47 (eq 0 (call-process-region (point-min) (point-max) 47 ;; I just can't get "icontopbm" to work correctly on its
48 "icontopbm" 48 ;; own in XEmacs. And Emacs doesn't understand un-raw pbm
49 'delete '(t nil))) 49 ;; files.
50 (shell-command-on-region (point-min) (point-max) 50 (if (not (featurep 'xemacs))
51 "icontopbm | pnmnoraw" 51 (eq 0 (call-process-region (point-min) (point-max)
52 (current-buffer) t) 52 "icontopbm"
53 t)) 53 'delete '(t nil)))
54 (buffer-string)))) 54 (shell-command-on-region (point-min) (point-max)
55 "icontopbm | pnmnoraw"
56 (current-buffer) t)
57 t))
58 (buffer-string)))))
55 59
56(provide 'compface) 60(provide 'compface)
57 61
diff --git a/lisp/gnus/mm-extern.el b/lisp/gnus/mm-extern.el
index c574bd6156e..f4c728541e9 100644
--- a/lisp/gnus/mm-extern.el
+++ b/lisp/gnus/mm-extern.el
@@ -97,7 +97,7 @@
97 (subject (or (cdr (assq 'subject params)) "none")) 97 (subject (or (cdr (assq 'subject params)) "none"))
98 (buf (current-buffer)) 98 (buf (current-buffer))
99 info) 99 info)
100 (if (y-or-n-p (format "Send a request message to %s?" server)) 100 (if (y-or-n-p (format "Send a request message to %s? " server))
101 (save-window-excursion 101 (save-window-excursion
102 (message-mail server subject) 102 (message-mail server subject)
103 (message-goto-body) 103 (message-goto-body)
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 79732cd3d88..82e1d3ab554 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -598,7 +598,7 @@ the line could be found."
598 (nth 1 (mm-insert-file-contents 598 (nth 1 (mm-insert-file-contents
599 file nil beg 599 file nil beg
600 (incf beg nnheader-head-chop-length)))) 600 (incf beg nnheader-head-chop-length))))
601 ;; CRLF of CR might be used for the line-break code. 601 ;; CRLF or CR might be used for the line-break code.
602 (prog1 (not (re-search-forward "\n\r?\n\\|\r\r" nil t)) 602 (prog1 (not (re-search-forward "\n\r?\n\\|\r\r" nil t))
603 (goto-char (point-max))) 603 (goto-char (point-max)))
604 (or (null nnheader-max-head-length) 604 (or (null nnheader-max-head-length)
diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el
index 7c0c8e0e444..d020d533aea 100644
--- a/lisp/gnus/nnweb.el
+++ b/lisp/gnus/nnweb.el
@@ -366,14 +366,15 @@ Valid types include `google', `dejanews', and `gmane'.")
366 (mm-url-decode-entities) 366 (mm-url-decode-entities)
367 (search-backward " - ") 367 (search-backward " - ")
368 (when (looking-at 368 (when (looking-at
369 " - \\([a-zA-Z]+\\) \\([0-9]+\\)\\(?: \\([0-9]\\{4\\}\\)\\)?[^\n]+by ?\n?\\([^<\n]+\\)\n") 369 "\\W+\\(\\w+\\) \\([0-9]+\\)\\(?: \\([0-9]\\{4\\}\\)\\)?")
370 (setq From (match-string 4) 370 (setq Date (format "%s %s 00:00:00 %s"
371 Date (format "%s %s 00:00:00 %s"
372 (match-string 1) 371 (match-string 1)
373 (match-string 2) 372 (match-string 2)
374 (or (match-string 3) 373 (or (match-string 3)
375 (substring (current-time-string) -4))))) 374 (substring (current-time-string) -4))))
376 375 (goto-char (match-end 0)))
376 (when (looking-at "[^b]+by\\W+\\([^<\n]+\\)")
377 (setq From (match-string 1)))
377 (widen) 378 (widen)
378 (forward-line 1) 379 (forward-line 1)
379 (incf i) 380 (incf i)
diff --git a/lisp/help.el b/lisp/help.el
index 4d92f69cebd..db76efb01a0 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -822,16 +822,13 @@ whose documentation describes the minor mode."
822 (sort minor-modes 822 (sort minor-modes
823 (lambda (a b) (string-lessp (cadr a) (cadr b))))) 823 (lambda (a b) (string-lessp (cadr a) (cadr b)))))
824 (when minor-modes 824 (when minor-modes
825 (princ "Summary of minor modes:\n") 825 (princ "Enabled minor modes:\n")
826 (make-local-variable 'help-button-cache) 826 (make-local-variable 'help-button-cache)
827 (with-current-buffer standard-output 827 (with-current-buffer standard-output
828 (dolist (mode minor-modes) 828 (dolist (mode minor-modes)
829 (let ((mode-function (nth 0 mode)) 829 (let ((mode-function (nth 0 mode))
830 (pretty-minor-mode (nth 1 mode)) 830 (pretty-minor-mode (nth 1 mode))
831 (indicator (nth 2 mode))) 831 (indicator (nth 2 mode)))
832 (setq indicator (if (zerop (length indicator))
833 "no indicator"
834 (format "indicator%s" indicator)))
835 (add-text-properties 0 (length pretty-minor-mode) 832 (add-text-properties 0 (length pretty-minor-mode)
836 '(face bold) pretty-minor-mode) 833 '(face bold) pretty-minor-mode)
837 (save-excursion 834 (save-excursion
@@ -840,16 +837,22 @@ whose documentation describes the minor mode."
840 (push (point-marker) help-button-cache) 837 (push (point-marker) help-button-cache)
841 ;; Document the minor modes fully. 838 ;; Document the minor modes fully.
842 (insert pretty-minor-mode) 839 (insert pretty-minor-mode)
843 (princ (format " minor mode (%s):\n" indicator)) 840 (princ (format " minor mode (%s):\n"
841 (if (zerop (length indicator))
842 "no indicator"
843 (format "indicator%s"
844 indicator))))
844 (princ (documentation mode-function))) 845 (princ (documentation mode-function)))
845 (princ " ")
846 (insert-button pretty-minor-mode 846 (insert-button pretty-minor-mode
847 'action (car help-button-cache) 847 'action (car help-button-cache)
848 'follow-link t 848 'follow-link t
849 'help-echo "mouse-2, RET: show full information") 849 'help-echo "mouse-2, RET: show full information")
850 (princ (format " minor mode (%s):\n" indicator))))) 850 (newline)))
851 (princ "\n(Full information about these minor modes 851 (forward-line -1)
852follows the description of the major mode.)\n\n")) 852 (fill-paragraph nil)
853 (forward-line 1))
854
855 (princ "\n(Information about these minor modes follows the major mode info.)\n\n"))
853 ;; Document the major mode. 856 ;; Document the major mode.
854 (let ((mode mode-name)) 857 (let ((mode mode-name))
855 (with-current-buffer standard-output 858 (with-current-buffer standard-output
diff --git a/lisp/info.el b/lisp/info.el
index def9a12ab0f..34509e72f25 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -3806,6 +3806,8 @@ the variable `Info-file-list-for-emacs'."
3806 (setq other-tag 3806 (setq other-tag
3807 (cond ((save-match-data (looking-back "\\<see")) 3807 (cond ((save-match-data (looking-back "\\<see"))
3808 "") 3808 "")
3809 ((save-match-data (looking-back "\\<in"))
3810 "")
3809 ((memq (char-before) '(nil ?\. ?! ??)) 3811 ((memq (char-before) '(nil ?\. ?! ??))
3810 "See ") 3812 "See ")
3811 ((save-match-data 3813 ((save-match-data
diff --git a/lisp/international/latexenc.el b/lisp/international/latexenc.el
index 25d56c1e928..58e8d6c88e8 100644
--- a/lisp/international/latexenc.el
+++ b/lisp/international/latexenc.el
@@ -138,8 +138,14 @@ coding system names is determined from `latex-inputenc-coding-alist'."
138 ((and (require 'code-pages nil t) (coding-system-p sym)) sym) 138 ((and (require 'code-pages nil t) (coding-system-p sym)) sym)
139 (t 'undecided))) 139 (t 'undecided)))
140 ;; else try to find it in the master/main file 140 ;; else try to find it in the master/main file
141 (let ((default-directory (file-name-directory (nth 1 arg-list))) 141
142 latexenc-main-file) 142 ;; Fixme: If the current file is in an archive (e.g. tar,
143 ;; zip), we should find the master file in that archive.
144 ;; But, that is not yet implemented. -- K.Handa
145 (let ((default-directory (if (stringp (nth 1 arg-list))
146 (file-name-directory (nth 1 arg-list))
147 default-directory))
148 latexenc-main-file)
143 ;; Is there a TeX-master or tex-main-file in the local variables 149 ;; Is there a TeX-master or tex-main-file in the local variables
144 ;; section? 150 ;; section?
145 (unless latexenc-dont-use-TeX-master-flag 151 (unless latexenc-dont-use-TeX-master-flag
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index 8b0a25dbae0..d1cc9618175 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -830,18 +830,28 @@ but still contains full information about each coding system."
830 830
831;;;###autoload 831;;;###autoload
832(defun describe-font (fontname) 832(defun describe-font (fontname)
833 "Display information about fonts which partially match FONTNAME." 833 "Display information about a font whose name is FONTNAME.
834 (interactive "sFontname (default current choice for ASCII chars): ") 834The font must be already used by Emacs."
835 (interactive "sFont name (default current choice for ASCII chars): ")
835 (or (and window-system (fboundp 'fontset-list)) 836 (or (and window-system (fboundp 'fontset-list))
836 (error "No fontsets being used")) 837 (error "No fonts being used"))
837 (when (or (not fontname) (= (length fontname) 0)) 838 (let (fontset font-info)
838 (setq fontname (cdr (assq 'font (frame-parameters)))) 839 (when (or (not fontname) (= (length fontname) 0))
839 (if (query-fontset fontname) 840 (setq fontname (frame-parameter nil 'font))
840 (setq fontname 841 ;; Check if FONTNAME is a fontset.
841 (nth 1 (assq 'ascii (aref (fontset-info fontname) 2)))))) 842 (if (query-fontset fontname)
842 (let ((font-info (font-info fontname))) 843 (setq fontset fontname
844 fontname (nth 1 (assq 'ascii
845 (aref (fontset-info fontname) 2))))))
846 (setq font-info (font-info fontname))
843 (if (null font-info) 847 (if (null font-info)
844 (message "No matching font") 848 (if fontset
849 ;; The font should be surely used. So, there's some
850 ;; problem about getting information about it. It is
851 ;; better to print the fontname to show which font has
852 ;; this problem.
853 (message "No information about \"%s\"" fontname)
854 (message "No matching font being used"))
845 (with-output-to-temp-buffer "*Help*" 855 (with-output-to-temp-buffer "*Help*"
846 (describe-font-internal font-info 'verbose))))) 856 (describe-font-internal font-info 'verbose)))))
847 857
diff --git a/lisp/net/zone-mode.el b/lisp/net/zone-mode.el
deleted file mode 100644
index 441ef143f9c..00000000000
--- a/lisp/net/zone-mode.el
+++ /dev/null
@@ -1,120 +0,0 @@
1;;; zone-mode.el --- major mode for editing DNS zone files
2
3;; Copyright (C) 1998, 2002, 2003, 2004, 2005,
4;; 2006 Free Software Foundation, Inc.
5
6;; Author: John Heidemann <johnh@isi.edu>
7;; Keywords: DNS, languages
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;;;
29;;; See the comments in ``define-derived-mode zone-mode''
30;;; (the last function in this file)
31;;; for what this mode is and how to use it automatically.
32;;;
33
34;;;
35;;; Credits:
36;;; Zone-mode was written by John Heidemann <johnh@isi.edu>,
37;;; with bug fixes from Simon Leinen <simon@limmat.switch.ch>.
38;;;
39
40;;; Code:
41
42(defun zone-mode-update-serial ()
43 "Update the serial number in a zone."
44 (interactive)
45 (save-excursion
46 (goto-char (point-min))
47 (while (re-search-forward "\\b\\([0-9]+\\)\\([0-9][0-9]\\)\\([ \t]+;[ \t]+[Ss]erial\\)" (point-max) t)
48 (let* ((old-date (match-string 1))
49 (old-seq (match-string 2))
50 (old-seq-num (string-to-number (match-string 2)))
51 (old-flag (match-string 3))
52 (cur-date (format-time-string "%Y%m%d"))
53 (new-seq
54 (cond
55 ((not (string= old-date cur-date))
56 "00") ;; reset sequence number
57 ((>= old-seq-num 99)
58 (error "Serial number's sequence cannot increment beyond 99"))
59 (t
60 (format "%02d" (1+ old-seq-num)))))
61 (old-serial (concat old-date old-seq))
62 (new-serial (concat cur-date new-seq)))
63 (if (string-lessp new-serial old-serial)
64 (error "Serial numbers want to move backwards from %s to %s" old-serial new-serial)
65 (replace-match (concat cur-date new-seq old-flag) t t))))))
66
67;;;###autoload
68(defun zone-mode-update-serial-hook ()
69 "Update the serial number in a zone if the file was modified."
70 (interactive)
71 (if (buffer-modified-p (current-buffer))
72 (zone-mode-update-serial))
73 nil ;; so we can run from write-file-hooks
74 )
75
76(defvar zone-mode-syntax-table nil
77 "Zone-mode's syntax table.")
78
79(defun zone-mode-load-time-setup ()
80 "Initialize `zone-mode' stuff."
81 (setq zone-mode-syntax-table (make-syntax-table))
82 (modify-syntax-entry ?\; "<" zone-mode-syntax-table)
83 (modify-syntax-entry ?\n ">" zone-mode-syntax-table))
84
85;;;###autoload
86(define-derived-mode zone-mode fundamental-mode "zone"
87 "A mode for editing DNS zone files.
88
89Zone-mode does two things:
90
91 - automatically update the serial number for a zone
92 when saving the file
93
94 - fontification"
95
96 (add-hook 'write-file-functions 'zone-mode-update-serial-hook nil t)
97
98 (if (null zone-mode-syntax-table)
99 (zone-mode-load-time-setup)) ;; should have been run at load-time
100
101 ;; font-lock support:
102 (set-syntax-table zone-mode-syntax-table)
103 (make-local-variable 'comment-start)
104 (setq comment-start ";")
105 (make-local-variable 'comment-start-skip)
106 ;; Look within the line for a ; following an even number of backslashes
107 ;; after either a non-backslash or the line beginning.
108 (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*")
109 (make-local-variable 'comment-column)
110 (setq comment-column 40)
111 (make-local-variable 'font-lock-defaults)
112 (setq font-lock-defaults
113 '(nil nil nil nil beginning-of-line)))
114
115(zone-mode-load-time-setup)
116
117(provide 'zone-mode)
118
119;;; arch-tag: 6a2940ef-fd4f-4de7-b979-b027b09821fe
120;;; zone-mode.el ends here
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index 5dfa1eb8959..358c834de73 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -599,11 +599,16 @@ If CONTINUE is non-nil, use the `comment-continue' markers if any."
599 (if (and other (<= other max) (> other min)) 599 (if (and other (<= other max) (> other min))
600 ;; There is a comment and it's in the range: bingo. 600 ;; There is a comment and it's in the range: bingo.
601 (setq indent other)))))))) 601 (setq indent other))))))))
602 ;; Update INDENT to leave at least one space
603 ;; after other nonwhite text on the line.
604 (save-excursion
605 (skip-chars-backward " \t")
606 (unless (bolp)
607 (setq indent (max indent (1+ (current-column))))))
608 ;; If that's different from comment's current position, change it.
602 (unless (= (current-column) indent) 609 (unless (= (current-column) indent)
603 ;; If that's different from current, change it.
604 (delete-region (point) (progn (skip-chars-backward " \t") (point))) 610 (delete-region (point) (progn (skip-chars-backward " \t") (point)))
605 (indent-to (if (bolp) indent 611 (indent-to indent)))
606 (max indent (1+ (current-column)))))))
607 (goto-char cpos) 612 (goto-char cpos)
608 (set-marker cpos nil)))) 613 (set-marker cpos nil))))
609 614
diff --git a/lisp/pcvs.el b/lisp/pcvs.el
index 89aeef53b80..a9105227bfd 100644
--- a/lisp/pcvs.el
+++ b/lisp/pcvs.el
@@ -2287,7 +2287,7 @@ this file, or a list of arguments to send to the program."
2287 (interactive "DNew repository: ") 2287 (interactive "DNew repository: ")
2288 (if (or (file-directory-p (expand-file-name "CVSROOT" newroot)) 2288 (if (or (file-directory-p (expand-file-name "CVSROOT" newroot))
2289 (y-or-n-p (concat "Warning: no CVSROOT found inside repository." 2289 (y-or-n-p (concat "Warning: no CVSROOT found inside repository."
2290 " Change cvs-cvsroot anyhow?"))) 2290 " Change cvs-cvsroot anyhow? ")))
2291 (setq cvs-cvsroot newroot))) 2291 (setq cvs-cvsroot newroot)))
2292 2292
2293;;;; 2293;;;;
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el
index e6c6380bf88..b5334ba5bc5 100644
--- a/lisp/progmodes/gdb-ui.el
+++ b/lisp/progmodes/gdb-ui.el
@@ -115,6 +115,7 @@ address for root variables.")
115(defvar gdb-main-file nil "Source file from which program execution begins.") 115(defvar gdb-main-file nil "Source file from which program execution begins.")
116(defvar gud-old-arrow nil) 116(defvar gud-old-arrow nil)
117(defvar gdb-overlay-arrow-position nil) 117(defvar gdb-overlay-arrow-position nil)
118(defvar gdb-stack-position nil)
118(defvar gdb-server-prefix nil) 119(defvar gdb-server-prefix nil)
119(defvar gdb-flush-pending-output nil) 120(defvar gdb-flush-pending-output nil)
120(defvar gdb-location-alist nil 121(defvar gdb-location-alist nil
@@ -321,7 +322,7 @@ of the inferior. Non-nil means display the layout shown for
321 :version "22.1") 322 :version "22.1")
322 323
323(defcustom gdb-use-separate-io-buffer nil 324(defcustom gdb-use-separate-io-buffer nil
324 "Non-nil means display output from the inferior in a separate buffer." 325 "Non-nil means display output from the debugged program in a separate buffer."
325 :type 'boolean 326 :type 'boolean
326 :group 'gud 327 :group 'gud
327 :version "22.1") 328 :version "22.1")
@@ -353,14 +354,14 @@ With arg, display additional buffers iff arg is positive."
353 (error nil)))) 354 (error nil))))
354 355
355(defun gdb-use-separate-io-buffer (arg) 356(defun gdb-use-separate-io-buffer (arg)
356 "Toggle separate IO for inferior. 357 "Toggle separate IO for debugged program.
357With arg, use separate IO iff arg is positive." 358With arg, use separate IO iff arg is positive."
358 (interactive "P") 359 (interactive "P")
359 (setq gdb-use-separate-io-buffer 360 (setq gdb-use-separate-io-buffer
360 (if (null arg) 361 (if (null arg)
361 (not gdb-use-separate-io-buffer) 362 (not gdb-use-separate-io-buffer)
362 (> (prefix-numeric-value arg) 0))) 363 (> (prefix-numeric-value arg) 0)))
363 (message (format "Separate inferior IO %sabled" 364 (message (format "Separate IO %sabled"
364 (if gdb-use-separate-io-buffer "en" "dis"))) 365 (if gdb-use-separate-io-buffer "en" "dis")))
365 (if (and gud-comint-buffer 366 (if (and gud-comint-buffer
366 (buffer-name gud-comint-buffer)) 367 (buffer-name gud-comint-buffer))
@@ -1030,7 +1031,7 @@ The key should be one of the cars in `gdb-buffer-rules-assoc'."
1030 (minibuffer . nil))) 1031 (minibuffer . nil)))
1031 1032
1032(defun gdb-frame-separate-io-buffer () 1033(defun gdb-frame-separate-io-buffer ()
1033 "Display IO of inferior in a new frame." 1034 "Display IO of debugged program in a new frame."
1034 (interactive) 1035 (interactive)
1035 (if gdb-use-separate-io-buffer 1036 (if gdb-use-separate-io-buffer
1036 (let ((special-display-regexps (append special-display-regexps '(".*"))) 1037 (let ((special-display-regexps (append special-display-regexps '(".*")))
@@ -1296,6 +1297,7 @@ not GDB."
1296 (setq gud-old-arrow gud-overlay-arrow-position) 1297 (setq gud-old-arrow gud-overlay-arrow-position)
1297 (setq gud-overlay-arrow-position nil) 1298 (setq gud-overlay-arrow-position nil)
1298 (setq gdb-overlay-arrow-position nil) 1299 (setq gdb-overlay-arrow-position nil)
1300 (setq gdb-stack-position nil)
1299 (if gdb-use-separate-io-buffer 1301 (if gdb-use-separate-io-buffer
1300 (setq gdb-output-sink 'inferior)))) 1302 (setq gdb-output-sink 'inferior))))
1301 (t 1303 (t
@@ -1330,6 +1332,7 @@ directives."
1330 (setq gdb-active-process nil) 1332 (setq gdb-active-process nil)
1331 (setq gud-overlay-arrow-position nil) 1333 (setq gud-overlay-arrow-position nil)
1332 (setq gdb-overlay-arrow-position nil) 1334 (setq gdb-overlay-arrow-position nil)
1335 (setq gdb-stack-position nil)
1333 (setq gud-old-arrow nil) 1336 (setq gud-old-arrow nil)
1334 (setq gdb-inferior-status "exited") 1337 (setq gdb-inferior-status "exited")
1335 (gdb-force-mode-line-update 1338 (gdb-force-mode-line-update
@@ -1776,9 +1779,8 @@ static char *magick[] = {
1776 (goto-char (point-min)) 1779 (goto-char (point-min))
1777 (while (< (point) (- (point-max) 1)) 1780 (while (< (point) (- (point-max) 1))
1778 (forward-line 1) 1781 (forward-line 1)
1779 (if (looking-at "[^\t].*?breakpoint") 1782 (if (looking-at gdb-breakpoint-regexp)
1780 (progn 1783 (progn
1781 (looking-at "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)")
1782 (setq bptno (match-string 1)) 1784 (setq bptno (match-string 1))
1783 (setq flag (char-after (match-beginning 2))) 1785 (setq flag (char-after (match-beginning 2)))
1784 (add-text-properties 1786 (add-text-properties
@@ -1786,43 +1788,55 @@ static char *magick[] = {
1786 (if (eq flag ?y) 1788 (if (eq flag ?y)
1787 '(face font-lock-warning-face) 1789 '(face font-lock-warning-face)
1788 '(face font-lock-type-face))) 1790 '(face font-lock-type-face)))
1789 (beginning-of-line) 1791 (let ((bl (point))
1790 (if (re-search-forward " in \\(.*\\) at\\s-+" nil t) 1792 (el (line-end-position)))
1791 (progn 1793 (if (re-search-forward " in \\(.*\\) at\\s-+" el t)
1794 (progn
1795 (add-text-properties
1796 (match-beginning 1) (match-end 1)
1797 '(face font-lock-function-name-face))
1798 (looking-at "\\(\\S-+\\):\\([0-9]+\\)")
1799 (let ((line (match-string 2))
1800 (file (match-string 1)))
1801 (add-text-properties bl el
1802 '(mouse-face highlight
1803 help-echo "mouse-2, RET: visit breakpoint"))
1804 (unless (file-exists-p file)
1805 (setq file (cdr (assoc bptno gdb-location-alist))))
1806 (if (and file
1807 (not (string-equal file "File not found")))
1808 (with-current-buffer
1809 (find-file-noselect file 'nowarn)
1810 (set (make-local-variable 'gud-minor-mode)
1811 'gdba)
1812 (set (make-local-variable 'tool-bar-map)
1813 gud-tool-bar-map)
1814 ;; Only want one breakpoint icon at each
1815 ;; location.
1816 (save-excursion
1817 (goto-line (string-to-number line))
1818 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))
1819 (gdb-enqueue-input
1820 (list
1821 (concat gdb-server-prefix "list "
1822 (match-string-no-properties 1) ":1\n")
1823 'ignore))
1824 (gdb-enqueue-input
1825 (list (concat gdb-server-prefix "info source\n")
1826 `(lambda () (gdb-get-location
1827 ,bptno ,line ,flag)))))))
1828 (if (re-search-forward
1829 "<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>"
1830 el t)
1831 (add-text-properties
1832 (match-beginning 1) (match-end 1)
1833 '(face font-lock-function-name-face))
1834 (end-of-line)
1835 (re-search-backward "\\s-\\(\\S-*\\)"
1836 bl t)
1792 (add-text-properties 1837 (add-text-properties
1793 (match-beginning 1) (match-end 1) 1838 (match-beginning 1) (match-end 1)
1794 '(face font-lock-function-name-face)) 1839 '(face font-lock-variable-name-face)))))))
1795 (looking-at "\\(\\S-+\\):\\([0-9]+\\)")
1796 (let ((line (match-string 2))
1797 (file (match-string 1)))
1798 (add-text-properties (line-beginning-position)
1799 (line-end-position)
1800 '(mouse-face highlight
1801 help-echo "mouse-2, RET: visit breakpoint"))
1802 (unless (file-exists-p file)
1803 (setq file (cdr (assoc bptno gdb-location-alist))))
1804 (if (and file
1805 (not (string-equal file "File not found")))
1806 (with-current-buffer
1807 (find-file-noselect file 'nowarn)
1808 (set (make-local-variable 'gud-minor-mode)
1809 'gdba)
1810 (set (make-local-variable 'tool-bar-map)
1811 gud-tool-bar-map)
1812 ;; Only want one breakpoint icon at each
1813 ;; location.
1814 (save-excursion
1815 (goto-line (string-to-number line))
1816 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))
1817 (gdb-enqueue-input
1818 (list
1819 (concat gdb-server-prefix "list "
1820 (match-string-no-properties 1) ":1\n")
1821 'ignore))
1822 (gdb-enqueue-input
1823 (list (concat gdb-server-prefix "info source\n")
1824 `(lambda () (gdb-get-location
1825 ,bptno ,line ,flag))))))))))
1826 (end-of-line)))))) 1840 (end-of-line))))))
1827 (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) 1841 (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
1828 1842
@@ -2026,8 +2040,14 @@ static char *magick[] = {
2026 (goto-char bl) 2040 (goto-char bl)
2027 (when (looking-at "^#\\([0-9]+\\)") 2041 (when (looking-at "^#\\([0-9]+\\)")
2028 (when (string-equal (match-string 1) gdb-frame-number) 2042 (when (string-equal (match-string 1) gdb-frame-number)
2029 (put-text-property bl (+ bl 4) 2043 (if (> (car (window-fringes)) 0)
2030 'face '(:inverse-video t))) 2044 (progn
2045 (or gdb-stack-position
2046 (setq gdb-stack-position (make-marker)))
2047 (set-marker gdb-stack-position (point)))
2048 (set-marker gdb-stack-position nil)
2049 (put-text-property bl (+ bl 4)
2050 'face '(:inverse-video t))))
2031 (when (re-search-forward 2051 (when (re-search-forward
2032 (concat 2052 (concat
2033 (if (string-equal (match-string 1) "0") "" " in ") 2053 (if (string-equal (match-string 1) "0") "" " in ")
@@ -2098,6 +2118,8 @@ static char *magick[] = {
2098 (kill-all-local-variables) 2118 (kill-all-local-variables)
2099 (setq major-mode 'gdb-frames-mode) 2119 (setq major-mode 'gdb-frames-mode)
2100 (setq mode-name "Frames") 2120 (setq mode-name "Frames")
2121 (setq gdb-stack-position nil)
2122 (add-to-list 'overlay-arrow-variable-list 'gdb-stack-position)
2101 (setq buffer-read-only t) 2123 (setq buffer-read-only t)
2102 (use-local-map gdb-frames-mode-map) 2124 (use-local-map gdb-frames-mode-map)
2103 (run-mode-hooks 'gdb-frames-mode-hook) 2125 (run-mode-hooks 'gdb-frames-mode-hook)
@@ -2549,18 +2571,18 @@ corresponding to the mode line clicked."
2549 'local-map 2571 'local-map
2550 (gdb-make-header-line-mouse-map 2572 (gdb-make-header-line-mouse-map
2551 'mouse-1 2573 'mouse-1
2552 #'(lambda () (interactive) 2574 (lambda () (interactive)
2553 (let ((gdb-memory-address 2575 (let ((gdb-memory-address
2554 ;; Let GDB do the arithmetic. 2576 ;; Let GDB do the arithmetic.
2555 (concat 2577 (concat
2556 gdb-memory-address " - " 2578 gdb-memory-address " - "
2557 (number-to-string 2579 (number-to-string
2558 (* gdb-memory-repeat-count 2580 (* gdb-memory-repeat-count
2559 (cond ((string= gdb-memory-unit "b") 1) 2581 (cond ((string= gdb-memory-unit "b") 1)
2560 ((string= gdb-memory-unit "h") 2) 2582 ((string= gdb-memory-unit "h") 2)
2561 ((string= gdb-memory-unit "w") 4) 2583 ((string= gdb-memory-unit "w") 4)
2562 ((string= gdb-memory-unit "g") 8))))))) 2584 ((string= gdb-memory-unit "g") 8)))))))
2563 (gdb-invalidate-memory))))) 2585 (gdb-invalidate-memory)))))
2564 "|" 2586 "|"
2565 (propertize "+" 2587 (propertize "+"
2566 'face font-lock-warning-face 2588 'face font-lock-warning-face
@@ -2568,9 +2590,9 @@ corresponding to the mode line clicked."
2568 'mouse-face 'mode-line-highlight 2590 'mouse-face 'mode-line-highlight
2569 'local-map (gdb-make-header-line-mouse-map 2591 'local-map (gdb-make-header-line-mouse-map
2570 'mouse-1 2592 'mouse-1
2571 #'(lambda () (interactive) 2593 (lambda () (interactive)
2572 (let ((gdb-memory-address nil)) 2594 (let ((gdb-memory-address nil))
2573 (gdb-invalidate-memory))))) 2595 (gdb-invalidate-memory)))))
2574 "]: " 2596 "]: "
2575 (propertize gdb-memory-address 2597 (propertize gdb-memory-address
2576 'face font-lock-warning-face 2598 'face font-lock-warning-face
@@ -2635,13 +2657,13 @@ corresponding to the mode line clicked."
2635 2657
2636(defvar gdb-locals-watch-map 2658(defvar gdb-locals-watch-map
2637 (let ((map (make-sparse-keymap))) 2659 (let ((map (make-sparse-keymap)))
2638 (define-key map "\r" '(lambda () (interactive) 2660 (define-key map "\r" (lambda () (interactive)
2639 (beginning-of-line) 2661 (beginning-of-line)
2640 (gud-watch))) 2662 (gud-watch)))
2641 (define-key map [mouse-2] '(lambda (event) (interactive "e") 2663 (define-key map [mouse-2] (lambda (event) (interactive "e")
2642 (mouse-set-point event) 2664 (mouse-set-point event)
2643 (beginning-of-line) 2665 (beginning-of-line)
2644 (gud-watch))) 2666 (gud-watch)))
2645 map) 2667 map)
2646 "Keymap to create watch expression of a complex data type local variable.") 2668 "Keymap to create watch expression of a complex data type local variable.")
2647 2669
@@ -2764,7 +2786,7 @@ corresponding to the mode line clicked."
2764 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) 2786 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
2765 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) 2787 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
2766 (define-key menu [inferior] 2788 (define-key menu [inferior]
2767 '(menu-item "Inferior IO" gdb-display-separate-io-buffer 2789 '(menu-item "Separate IO" gdb-display-separate-io-buffer
2768 :enable gdb-use-separate-io-buffer)) 2790 :enable gdb-use-separate-io-buffer))
2769 (define-key menu [memory] '("Memory" . gdb-display-memory-buffer)) 2791 (define-key menu [memory] '("Memory" . gdb-display-memory-buffer))
2770 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) 2792 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
@@ -2783,7 +2805,7 @@ corresponding to the mode line clicked."
2783 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) 2805 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
2784 (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer)) 2806 (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer))
2785 (define-key menu [inferior] 2807 (define-key menu [inferior]
2786 '(menu-item "Inferior IO" gdb-frame-separate-io-buffer 2808 '(menu-item "Separate IO" gdb-frame-separate-io-buffer
2787 :enable gdb-use-separate-io-buffer)) 2809 :enable gdb-use-separate-io-buffer))
2788 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) 2810 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
2789 (define-key menu [disassembly] '("Disassembly" . gdb-frame-assembler-buffer)) 2811 (define-key menu [disassembly] '("Disassembly" . gdb-frame-assembler-buffer))
@@ -2802,9 +2824,9 @@ corresponding to the mode line clicked."
2802 :help "Toggle look for source frame." 2824 :help "Toggle look for source frame."
2803 :button (:toggle . gdb-find-source-frame))) 2825 :button (:toggle . gdb-find-source-frame)))
2804 (define-key menu [gdb-use-separate-io] 2826 (define-key menu [gdb-use-separate-io]
2805 '(menu-item "Separate Inferior IO" gdb-use-separate-io-buffer 2827 '(menu-item "Separate IO" gdb-use-separate-io-buffer
2806 :visible (eq gud-minor-mode 'gdba) 2828 :visible (eq gud-minor-mode 'gdba)
2807 :help "Toggle separate IO for inferior." 2829 :help "Toggle separate IO for debugged program."
2808 :button (:toggle . gdb-use-separate-io-buffer))) 2830 :button (:toggle . gdb-use-separate-io-buffer)))
2809 (define-key menu [gdb-many-windows] 2831 (define-key menu [gdb-many-windows]
2810 '(menu-item "Display Other Windows" gdb-many-windows 2832 '(menu-item "Display Other Windows" gdb-many-windows
@@ -2901,12 +2923,13 @@ Kills the gdb buffers, and resets variables and the source buffers."
2901 (setq gud-minor-mode nil) 2923 (setq gud-minor-mode nil)
2902 (kill-local-variable 'tool-bar-map) 2924 (kill-local-variable 'tool-bar-map)
2903 (kill-local-variable 'gdb-define-alist)))))) 2925 (kill-local-variable 'gdb-define-alist))))))
2904 (when (markerp gdb-overlay-arrow-position) 2926 (setq gdb-overlay-arrow-position nil)
2905 (move-marker gdb-overlay-arrow-position nil)
2906 (setq gdb-overlay-arrow-position nil))
2907 (setq overlay-arrow-variable-list 2927 (setq overlay-arrow-variable-list
2908 (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list)) 2928 (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list))
2909 (setq fringe-indicator-alist '((overlay-arrow . right-triangle))) 2929 (setq fringe-indicator-alist '((overlay-arrow . right-triangle)))
2930 (setq gdb-stack-position nil)
2931 (setq overlay-arrow-variable-list
2932 (delq 'gdb-stack-position overlay-arrow-variable-list))
2910 (if (boundp 'speedbar-frame) (speedbar-timer-fn)) 2933 (if (boundp 'speedbar-frame) (speedbar-timer-fn))
2911 (setq gud-running nil) 2934 (setq gud-running nil)
2912 (setq gdb-active-process nil) 2935 (setq gdb-active-process nil)
@@ -3128,8 +3151,7 @@ BUFFER nil or omitted means use the current buffer."
3128 '((overlay-arrow . hollow-right-triangle)))) 3151 '((overlay-arrow . hollow-right-triangle))))
3129 (or gdb-overlay-arrow-position 3152 (or gdb-overlay-arrow-position
3130 (setq gdb-overlay-arrow-position (make-marker))) 3153 (setq gdb-overlay-arrow-position (make-marker)))
3131 (set-marker gdb-overlay-arrow-position 3154 (set-marker gdb-overlay-arrow-position (point))))))
3132 (point) (current-buffer))))))
3133 ;; remove all breakpoint-icons in assembler buffer before updating. 3155 ;; remove all breakpoint-icons in assembler buffer before updating.
3134 (gdb-remove-breakpoint-icons (point-min) (point-max)))) 3156 (gdb-remove-breakpoint-icons (point-min) (point-max))))
3135 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) 3157 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 97e54135a6f..84b40e8ba80 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -3180,7 +3180,15 @@ class of the file (using s to separate nested class ids)."
3180(defvar gdb-script-font-lock-syntactic-keywords 3180(defvar gdb-script-font-lock-syntactic-keywords
3181 '(("^document\\s-.*\\(\n\\)" (1 "< b")) 3181 '(("^document\\s-.*\\(\n\\)" (1 "< b"))
3182 ;; It would be best to change the \n in front, but it's more difficult. 3182 ;; It would be best to change the \n in front, but it's more difficult.
3183 ("^en\\(d\\)\\>" (1 "> b")))) 3183 ("^end\\>"
3184 (0 (progn
3185 (unless (eq (match-beginning 0) (point-min))
3186 (put-text-property (1- (match-beginning 0)) (match-beginning 0)
3187 'syntax-table (eval-when-compile
3188 (string-to-syntax "> b")))
3189 (put-text-property (1- (match-beginning 0)) (match-end 0)
3190 'font-lock-multiline t)
3191 nil))))))
3184 3192
3185(defun gdb-script-font-lock-syntactic-face (state) 3193(defun gdb-script-font-lock-syntactic-face (state)
3186 (cond 3194 (cond
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index f748bb4b040..a08f999f089 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -986,7 +986,9 @@ subshells can nest."
986 ;; FIXME: This can (and often does) match multiple lines, yet it makes no 986 ;; FIXME: This can (and often does) match multiple lines, yet it makes no
987 ;; effort to handle multiline cases correctly, so it ends up being 987 ;; effort to handle multiline cases correctly, so it ends up being
988 ;; rather flakey. 988 ;; rather flakey.
989 (when (re-search-forward "\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" limit t) 989 (when (and (re-search-forward "\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" limit t)
990 ;; Make sure the " we matched is an opening quote.
991 (eq ?\" (nth 3 (syntax-ppss))))
990 ;; bingo we have a $( or a ` inside a "" 992 ;; bingo we have a $( or a ` inside a ""
991 (let ((char (char-after (point))) 993 (let ((char (char-after (point)))
992 (continue t) 994 (continue t)
@@ -1081,9 +1083,6 @@ This is used to flag quote characters in subshell constructs inside strings
1081 ("\\(\\\\\\)'" 1 ,sh-st-punc) 1083 ("\\(\\\\\\)'" 1 ,sh-st-punc)
1082 ;; Make sure $@ and @? are correctly recognized as sexps. 1084 ;; Make sure $@ and @? are correctly recognized as sexps.
1083 ("\\$\\([?@]\\)" 1 ,sh-st-symbol) 1085 ("\\$\\([?@]\\)" 1 ,sh-st-symbol)
1084 ;; highlight (possibly nested) subshells inside "" quoted regions correctly.
1085 (sh-quoted-subshell
1086 (1 (sh-apply-quoted-subshell) t t))
1087 ;; Find HEREDOC starters and add a corresponding rule for the ender. 1086 ;; Find HEREDOC starters and add a corresponding rule for the ender.
1088 (sh-font-lock-here-doc 1087 (sh-font-lock-here-doc
1089 (2 (sh-font-lock-open-heredoc 1088 (2 (sh-font-lock-open-heredoc
@@ -1093,7 +1092,11 @@ This is used to flag quote characters in subshell constructs inside strings
1093 (and (match-beginning 3) (/= (match-beginning 3) (match-end 3)))) 1092 (and (match-beginning 3) (/= (match-beginning 3) (match-end 3))))
1094 nil t)) 1093 nil t))
1095 ;; Distinguish the special close-paren in `case'. 1094 ;; Distinguish the special close-paren in `case'.
1096 (")" 0 (sh-font-lock-paren (match-beginning 0))))) 1095 (")" 0 (sh-font-lock-paren (match-beginning 0)))
1096 ;; highlight (possibly nested) subshells inside "" quoted regions correctly.
1097 ;; This should be at the very end because it uses syntax-ppss.
1098 (sh-quoted-subshell
1099 (1 (sh-apply-quoted-subshell) t t))))
1097 1100
1098(defun sh-font-lock-syntactic-face-function (state) 1101(defun sh-font-lock-syntactic-face-function (state)
1099 (let ((q (nth 3 state))) 1102 (let ((q (nth 3 state)))
diff --git a/lisp/simple.el b/lisp/simple.el
index 204684a3d5b..86b3af702e4 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -3697,7 +3697,10 @@ because what we really need is for `move-to-column'
3697and `current-column' to be able to ignore invisible text." 3697and `current-column' to be able to ignore invisible text."
3698 (if (zerop col) 3698 (if (zerop col)
3699 (beginning-of-line) 3699 (beginning-of-line)
3700 (move-to-column col)) 3700 (let ((opoint (point)))
3701 (move-to-column col)
3702 ;; move-to-column doesn't respect field boundaries.
3703 (goto-char (constrain-to-field (point) opoint))))
3701 3704
3702 (when (and line-move-ignore-invisible 3705 (when (and line-move-ignore-invisible
3703 (not (bolp)) (line-move-invisible-p (1- (point)))) 3706 (not (bolp)) (line-move-invisible-p (1- (point))))
@@ -3767,7 +3770,8 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
3767 (interactive "p") 3770 (interactive "p")
3768 (or arg (setq arg 1)) 3771 (or arg (setq arg 1))
3769 3772
3770 (let ((orig (point))) 3773 (let ((orig (point))
3774 start first-vis first-vis-field-value)
3771 3775
3772 ;; Move by lines, if ARG is not 1 (the default). 3776 ;; Move by lines, if ARG is not 1 (the default).
3773 (if (/= arg 1) 3777 (if (/= arg 1)
@@ -3778,10 +3782,24 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
3778 (while (and (not (bobp)) (line-move-invisible-p (1- (point)))) 3782 (while (and (not (bobp)) (line-move-invisible-p (1- (point))))
3779 (goto-char (previous-char-property-change (point))) 3783 (goto-char (previous-char-property-change (point)))
3780 (skip-chars-backward "^\n")) 3784 (skip-chars-backward "^\n"))
3781 3785 (setq start (point))
3782 ;; Take care of fields. 3786
3783 (goto-char (constrain-to-field (point) orig 3787 ;; Now find first visible char in the line
3784 (/= arg 1) t nil)))) 3788 (while (and (not (eobp)) (line-move-invisible-p (point)))
3789 (goto-char (next-char-property-change (point))))
3790 (setq first-vis (point))
3791
3792 ;; See if fields would stop us from reaching FIRST-VIS.
3793 (setq first-vis-field-value
3794 (constrain-to-field first-vis orig (/= arg 1) t nil))
3795
3796 (goto-char (if (/= first-vis-field-value first-vis)
3797 ;; If yes, obey them.
3798 first-vis-field-value
3799 ;; Otherwise, move to START with attention to fields.
3800 ;; (It is possible that fields never matter in this case.)
3801 (constrain-to-field (point) orig
3802 (/= arg 1) t nil)))))
3785 3803
3786 3804
3787;;; Many people have said they rarely use this feature, and often type 3805;;; Many people have said they rarely use this feature, and often type
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 21515e02612..9229ec549e6 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -2484,7 +2484,7 @@ order until succeed.")
2484;; Override Paste so it looks at CLIPBOARD first. 2484;; Override Paste so it looks at CLIPBOARD first.
2485(defun x-clipboard-yank () 2485(defun x-clipboard-yank ()
2486 "Insert the clipboard contents, or the last stretch of killed text." 2486 "Insert the clipboard contents, or the last stretch of killed text."
2487 (interactive) 2487 (interactive "*")
2488 (let ((clipboard-text (x-selection-value 'CLIPBOARD)) 2488 (let ((clipboard-text (x-selection-value 'CLIPBOARD))
2489 (x-select-enable-clipboard t)) 2489 (x-select-enable-clipboard t))
2490 (if (and clipboard-text (> (length clipboard-text) 0)) 2490 (if (and clipboard-text (> (length clipboard-text) 0))
@@ -2492,12 +2492,13 @@ order until succeed.")
2492 (yank))) 2492 (yank)))
2493 2493
2494(define-key menu-bar-edit-menu [paste] 2494(define-key menu-bar-edit-menu [paste]
2495 (cons "Paste" (cons "Paste text from clipboard or kill ring" 2495 '(menu-item "Paste" x-clipboard-yank
2496 'x-clipboard-yank))) 2496 :enable (not buffer-read-only)
2497 :help "Paste (yank) text most recently cut/copied"))
2497 2498
2498;; Initiate drag and drop 2499;; Initiate drag and drop
2499(add-hook 'after-make-frame-functions 'x-dnd-init-frame) 2500(add-hook 'after-make-frame-functions 'x-dnd-init-frame)
2500(global-set-key [drag-n-drop] 'x-dnd-handle-drag-n-drop-event) 2501(define-key special-event-map [drag-n-drop] 'x-dnd-handle-drag-n-drop-event)
2501 2502
2502;; Let F10 do menu bar navigation. 2503;; Let F10 do menu bar navigation.
2503(and (fboundp 'menu-bar-open) 2504(and (fboundp 'menu-bar-open)
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index 7622f23752b..9ea51a2f774 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -228,8 +228,37 @@
228 (define-key map "\e[4~" [select]) 228 (define-key map "\e[4~" [select])
229 (define-key map "\e[29~" [print]) 229 (define-key map "\e[29~" [print])
230 230
231 ;; These keys are available in xterm starting from version 214 231 ;; These keys are available in xterm starting from version 216
232 ;; if the modifyOtherKeys resource is set to 1. 232 ;; if the modifyOtherKeys resource is set to 1.
233
234 (define-key map "\e[27;5;39~" [?\C-\'])
235 (define-key map "\e[27;5;45~" [?\C--])
236
237 (define-key map "\e[27;5;48~" [?\C-0])
238 (define-key map "\e[27;5;49~" [?\C-1])
239 ;; Not all C-DIGIT keys have a distinct binding.
240 (define-key map "\e[27;5;57~" [?\C-9])
241
242 (define-key map "\e[27;5;59~" [?\C-\;])
243 (define-key map "\e[27;5;61~" [?\C-=])
244
245
246 (define-key map "\e[27;6;33~" [?\C-!])
247 (define-key map "\e[27;6;34~" [?\C-\"])
248 (define-key map "\e[27;6;35~" [?\C-#])
249 (define-key map "\e[27;6;36~" [?\C-$])
250 (define-key map "\e[27;6;37~" [?\C-%])
251 (define-key map "\e[27;6;38~" [(C-&)])
252 (define-key map "\e[27;6;40~" [?\C-(])
253 (define-key map "\e[27;6;41~" [?\C-)])
254 (define-key map "\e[27;6;42~" [?\C-*])
255 (define-key map "\e[27;6;43~" [?\C-+])
256
257 (define-key map "\e[27;6;58~" [?\C-:])
258 (define-key map "\e[27;6;60~" [?\C-<])
259 (define-key map "\e[27;6;62~" [?\C->])
260 (define-key map "\e[27;6;63~" [(C-\?)])
261
233 (define-key map "\e[27;5;9~" [C-tab]) 262 (define-key map "\e[27;5;9~" [C-tab])
234 (define-key map "\e[27;5;13~" [C-return]) 263 (define-key map "\e[27;5;13~" [C-return])
235 (define-key map "\e[27;5;44~" [?\C-,]) 264 (define-key map "\e[27;5;44~" [?\C-,])
diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el
index a323d4c4468..21fe137118f 100644
--- a/lisp/textmodes/dns-mode.el
+++ b/lisp/textmodes/dns-mode.el
@@ -90,6 +90,18 @@
90 :type 'sexp 90 :type 'sexp
91 :group 'dns-mode) 91 :group 'dns-mode)
92 92
93(defcustom dns-mode-soa-auto-increment-serial t
94 "Whether to increment the SOA serial number automatically.
95
96If this variable is t, the serial number is incremented upon each save of
97the file. If it is `ask', Emacs asks for confirmation whether it should
98increment the serial upon saving. If nil, serials must be incremented
99manually with \\[dns-mode-soa-increment-serial]."
100 :type '(choice (const :tag "Always" t)
101 (const :tag "Ask" ask)
102 (const :tag "Never" nil))
103 :group 'dns-mode)
104
93;; Syntax table. 105;; Syntax table.
94 106
95(defvar dns-mode-syntax-table 107(defvar dns-mode-syntax-table
@@ -135,8 +147,12 @@ Turning on DNS mode runs `dns-mode-hook'."
135 (unless (featurep 'xemacs) 147 (unless (featurep 'xemacs)
136 (set (make-local-variable 'font-lock-defaults) 148 (set (make-local-variable 'font-lock-defaults)
137 '(dns-mode-font-lock-keywords nil nil ((?_ . "w"))))) 149 '(dns-mode-font-lock-keywords nil nil ((?_ . "w")))))
150 (add-hook 'before-save-hook 'dns-mode-soa-maybe-increment-serial
151 nil t)
138 (easy-menu-add dns-mode-menu dns-mode-map)) 152 (easy-menu-add dns-mode-menu dns-mode-map))
139 153
154;;;###autoload (defalias 'zone-mode 'dns-mode)
155
140;; Tools. 156;; Tools.
141 157
142;;;###autoload 158;;;###autoload
@@ -192,6 +208,21 @@ Turning on DNS mode runs `dns-mode-hook'."
192 (message "Replaced old serial %s with %s" serial new)) 208 (message "Replaced old serial %s with %s" serial new))
193 (error "Cannot locate serial number in SOA record")))))) 209 (error "Cannot locate serial number in SOA record"))))))
194 210
211(defun dns-mode-soa-maybe-increment-serial ()
212 "Increment SOA serial if needed.
213
214This function is run from `before-save-hook'."
215 (when (and (buffer-modified-p)
216 dns-mode-soa-auto-increment-serial
217 (or (eq dns-mode-soa-auto-increment-serial t)
218 (y-or-n-p "Increment SOA serial? ")))
219 ;; If `dns-mode-soa-increment-serial' signals an error saving will
220 ;; fail but that probably means that the serial should be fixed to
221 ;; comply with the RFC anyway! -rfr
222 (progn (dns-mode-soa-increment-serial)
223 ;; We return nil in case this is used in write-contents-functions.
224 nil)))
225
195;;;###autoload(add-to-list 'auto-mode-alist '("\\.soa\\'" . dns-mode)) 226;;;###autoload(add-to-list 'auto-mode-alist '("\\.soa\\'" . dns-mode))
196 227
197(provide 'dns-mode) 228(provide 'dns-mode)
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el
index 4cda0d6b3a0..1fcac6855d9 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.43 8;; Version: 4.44
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -90,10 +90,12 @@
90;; 90;;
91;; Recent changes 91;; Recent changes
92;; -------------- 92;; --------------
93;; Version 4.43 93;; Version 4.44
94;; - Big fixes 94;; - Clock table can be done for a limited time interval.
95;; - Obsolete support for the old outline mode has been removed.
96;; - Bug fixes and code cleaning.
95;; 97;;
96;; Version 4.42 98;; Version 4.43
97;; - Bug fixes 99;; - Bug fixes
98;; - `s' key in the agenda saves all org-mode buffers. 100;; - `s' key in the agenda saves all org-mode buffers.
99;; 101;;
@@ -212,16 +214,13 @@
212 214
213;;; Customization variables 215;;; Customization variables
214 216
215(defvar org-version "4.43" 217(defvar org-version "4.44"
216 "The version number of the file org.el.") 218 "The version number of the file org.el.")
217(defun org-version () 219(defun org-version ()
218 (interactive) 220 (interactive)
219 (message "Org-mode version %s" org-version)) 221 (message "Org-mode version %s" org-version))
220 222
221;; The following constant is for compatibility with different versions 223;; Compatibility constants
222;; of outline.el.
223(defconst org-noutline-p (featurep 'noutline)
224 "Are we using the new outline mode?")
225(defconst org-xemacs-p (featurep 'xemacs)) ; not used by org.el itself 224(defconst org-xemacs-p (featurep 'xemacs)) ; not used by org.el itself
226(defconst org-format-transports-properties-p 225(defconst org-format-transports-properties-p
227 (let ((x "a")) 226 (let ((x "a"))
@@ -1132,7 +1131,7 @@ files and the cdr the corresponding command. Possible values for the
1132file identifier are 1131file identifier are
1133 \"ext\" A string identifying an extension 1132 \"ext\" A string identifying an extension
1134 `directory' Matches a directory 1133 `directory' Matches a directory
1135 `remote' Matches a remove file, accessible through tramp or efs. 1134 `remote' Matches a remote file, accessible through tramp or efs.
1136 Remote files most likely should be visited through emacs 1135 Remote files most likely should be visited through emacs
1137 because external applications cannot handle such paths. 1136 because external applications cannot handle such paths.
1138 t Default for all remaining files 1137 t Default for all remaining files
@@ -1831,6 +1830,7 @@ Org-mode files lives."
1831 1830
1832(defcustom org-export-language-setup 1831(defcustom org-export-language-setup
1833 '(("en" "Author" "Date" "Table of Contents") 1832 '(("en" "Author" "Date" "Table of Contents")
1833 ("cs" "Autor" "Datum" "Obsah")
1834 ("da" "Ophavsmand" "Dato" "Indhold") 1834 ("da" "Ophavsmand" "Dato" "Indhold")
1835 ("de" "Autor" "Datum" "Inhaltsverzeichnis") 1835 ("de" "Autor" "Datum" "Inhaltsverzeichnis")
1836 ("es" "Autor" "Fecha" "\xccndice") 1836 ("es" "Autor" "Fecha" "\xccndice")
@@ -2150,6 +2150,16 @@ you can \"misuse\" it to add arbitrary text to the header."
2150 :group 'org-export-html 2150 :group 'org-export-html
2151 :type 'string) 2151 :type 'string)
2152 2152
2153(defcustom org-export-html-title-format "<h1 class=\"title\">%s</h1>\n"
2154 "Format for typesetting the document title in HTML export."
2155 :group 'org-export-html
2156 :type 'string)
2157
2158(defcustom org-export-html-toplevel-hlevel 2
2159 "The <H> level for level 1 headings in HTML export."
2160 :group 'org-export-html
2161 :type 'string)
2162
2153(defcustom org-export-html-link-org-files-as-html t 2163(defcustom org-export-html-link-org-files-as-html t
2154 "Non-nil means, make file links to `file.org' point to `file.html'. 2164 "Non-nil means, make file links to `file.org' point to `file.html'.
2155When org-mode is exporting an org-mode file to HTML, links to 2165When org-mode is exporting an org-mode file to HTML, links to
@@ -2694,6 +2704,10 @@ Also put tags into group 4 if tags are present.")
2694 (remove-text-properties 0 (length s) org-rm-props s) 2704 (remove-text-properties 0 (length s) org-rm-props s)
2695 s) 2705 s)
2696 2706
2707(defsubst org-set-local (var value)
2708 "Make VAR local in current buffer and set it to VALUE."
2709 (set (make-variable-buffer-local var) value))
2710
2697(defsubst org-mode-p () 2711(defsubst org-mode-p ()
2698 "Check if the current buffer is in Org-mode." 2712 "Check if the current buffer is in Org-mode."
2699 (eq major-mode 'org-mode)) 2713 (eq major-mode 'org-mode))
@@ -2703,7 +2717,7 @@ Also put tags into group 4 if tags are present.")
2703 (when (org-mode-p) 2717 (when (org-mode-p)
2704 (let ((re (org-make-options-regexp 2718 (let ((re (org-make-options-regexp
2705 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" 2719 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO"
2706 "STARTUP" "ARCHIVE" "TAGS"))) 2720 "STARTUP" "ARCHIVE" "TAGS" "CALC")))
2707 (splitre "[ \t]+") 2721 (splitre "[ \t]+")
2708 kwds int key value cat arch tags) 2722 kwds int key value cat arch tags)
2709 (save-excursion 2723 (save-excursion
@@ -2755,10 +2769,10 @@ Also put tags into group 4 if tags are present.")
2755 (remove-text-properties 0 (length arch) 2769 (remove-text-properties 0 (length arch)
2756 '(face t fontified t) arch))) 2770 '(face t fontified t) arch)))
2757 ))) 2771 )))
2758 (and cat (set (make-local-variable 'org-category) cat)) 2772 (and cat (org-set-local 'org-category cat))
2759 (and kwds (set (make-local-variable 'org-todo-keywords) kwds)) 2773 (and kwds (org-set-local 'org-todo-keywords kwds))
2760 (and arch (set (make-local-variable 'org-archive-location) arch)) 2774 (and arch (org-set-local 'org-archive-location arch))
2761 (and int (set (make-local-variable 'org-todo-interpretation) int)) 2775 (and int (org-set-local 'org-todo-interpretation int))
2762 (when tags 2776 (when tags
2763 (let (e tgs) 2777 (let (e tgs)
2764 (while (setq e (pop tags)) 2778 (while (setq e (pop tags))
@@ -2770,7 +2784,7 @@ Also put tags into group 4 if tags are present.")
2770 (string-to-char (match-string 2 e))) 2784 (string-to-char (match-string 2 e)))
2771 tgs)) 2785 tgs))
2772 (t (push (list e) tgs)))) 2786 (t (push (list e) tgs))))
2773 (set (make-local-variable 'org-tag-alist) nil) 2787 (org-set-local 'org-tag-alist nil)
2774 (while (setq e (pop tgs)) 2788 (while (setq e (pop tgs))
2775 (or (and (stringp (car e)) 2789 (or (and (stringp (car e))
2776 (assoc (car e) org-tag-alist)) 2790 (assoc (car e) org-tag-alist))
@@ -2928,15 +2942,11 @@ The following commands are available:
2928 ;; Need to do this here because define-derived-mode sets up 2942 ;; Need to do this here because define-derived-mode sets up
2929 ;; the keymap so late. 2943 ;; the keymap so late.
2930 (if (featurep 'xemacs) 2944 (if (featurep 'xemacs)
2931 (if org-noutline-p 2945 (progn
2932 (progn 2946 ;; Assume this is Greg's port, it used easymenu
2933 (easy-menu-remove outline-mode-menu-heading) 2947 (easy-menu-remove outline-mode-menu-heading)
2934 (easy-menu-remove outline-mode-menu-show) 2948 (easy-menu-remove outline-mode-menu-show)
2935 (easy-menu-remove outline-mode-menu-hide)) 2949 (easy-menu-remove outline-mode-menu-hide))
2936 (delete-menu-item '("Headings"))
2937 (delete-menu-item '("Show"))
2938 (delete-menu-item '("Hide"))
2939 (set-menubar-dirty-flag))
2940 (define-key org-mode-map [menu-bar headings] 'undefined) 2950 (define-key org-mode-map [menu-bar headings] 'undefined)
2941 (define-key org-mode-map [menu-bar hide] 'undefined) 2951 (define-key org-mode-map [menu-bar hide] 'undefined)
2942 (define-key org-mode-map [menu-bar show] 'undefined)) 2952 (define-key org-mode-map [menu-bar show] 'undefined))
@@ -2947,7 +2957,7 @@ The following commands are available:
2947 (if org-descriptive-links (org-add-to-invisibility-spec '(org-link))) 2957 (if org-descriptive-links (org-add-to-invisibility-spec '(org-link)))
2948 (org-add-to-invisibility-spec '(org-cwidth)) 2958 (org-add-to-invisibility-spec '(org-cwidth))
2949 (when (featurep 'xemacs) 2959 (when (featurep 'xemacs)
2950 (set (make-local-variable 'line-move-ignore-invisible) t)) 2960 (org-set-local 'line-move-ignore-invisible t))
2951 (setq outline-regexp "\\*+") 2961 (setq outline-regexp "\\*+")
2952 ;;(setq outline-regexp "\\(?:\\*+\\|[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\) \\)") 2962 ;;(setq outline-regexp "\\(?:\\*+\\|[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\) \\)")
2953 (setq outline-level 'org-outline-level) 2963 (setq outline-level 'org-outline-level)
@@ -2958,12 +2968,14 @@ The following commands are available:
2958 4 (string-to-vector org-ellipsis)) 2968 4 (string-to-vector org-ellipsis))
2959 (setq buffer-display-table org-display-table)) 2969 (setq buffer-display-table org-display-table))
2960 (org-set-regexps-and-options) 2970 (org-set-regexps-and-options)
2971 ;; Calc embedded
2972 (org-set-local 'calc-embedded-open-mode "# ")
2961 (modify-syntax-entry ?# "<") 2973 (modify-syntax-entry ?# "<")
2962 (if org-startup-truncated (setq truncate-lines t)) 2974 (if org-startup-truncated (setq truncate-lines t))
2963 (set (make-local-variable 'font-lock-unfontify-region-function) 2975 (org-set-local 'font-lock-unfontify-region-function
2964 'org-unfontify-region) 2976 'org-unfontify-region)
2965 ;; Activate before-change-function 2977 ;; Activate before-change-function
2966 (set (make-local-variable 'org-table-may-need-update) t) 2978 (org-set-local 'org-table-may-need-update t)
2967 (org-add-hook 'before-change-functions 'org-before-change-function nil 2979 (org-add-hook 'before-change-functions 'org-before-change-function nil
2968 'local) 2980 'local)
2969 ;; Check for running clock before killing a buffer 2981 ;; Check for running clock before killing a buffer
@@ -3107,7 +3119,7 @@ that will be added to PLIST. Returns the string that was modified."
3107 org-ts-regexp "\\)?") 3119 org-ts-regexp "\\)?")
3108 "Regular expression matching a time stamp or time stamp range.") 3120 "Regular expression matching a time stamp or time stamp range.")
3109 3121
3110(defvar org-§emph-face nil) 3122(defvar org-§emph-face nil)
3111 3123
3112(defun org-do-emphasis-faces (limit) 3124(defun org-do-emphasis-faces (limit)
3113 "Run through the buffer and add overlays to links." 3125 "Run through the buffer and add overlays to links."
@@ -3340,10 +3352,9 @@ between words."
3340 ))) 3352 )))
3341 (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) 3353 (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
3342 ;; Now set the full font-lock-keywords 3354 ;; Now set the full font-lock-keywords
3343 (set (make-local-variable 'org-font-lock-keywords) 3355 (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords)
3344 org-font-lock-extra-keywords) 3356 (org-set-local 'font-lock-defaults
3345 (set (make-local-variable 'font-lock-defaults) 3357 '(org-font-lock-keywords t nil nil backward-paragraph))
3346 '(org-font-lock-keywords t nil nil backward-paragraph))
3347 (kill-local-variable 'font-lock-keywords) nil)) 3358 (kill-local-variable 'font-lock-keywords) nil))
3348 3359
3349(defvar org-m nil) 3360(defvar org-m nil)
@@ -3812,9 +3823,7 @@ state (TODO by default). Also with prefix arg, force first state."
3812 (org-insert-heading) 3823 (org-insert-heading)
3813 (save-excursion 3824 (save-excursion
3814 (org-back-to-heading) 3825 (org-back-to-heading)
3815 (if org-noutline-p 3826 (outline-previous-heading)
3816 (outline-previous-heading)
3817 (outline-previous-visible-heading t))
3818 (looking-at org-todo-line-regexp)) 3827 (looking-at org-todo-line-regexp))
3819 (if (or arg 3828 (if (or arg
3820 (not (match-beginning 2)) 3829 (not (match-beginning 2))
@@ -4703,7 +4712,7 @@ the children that do not contain any open TODO items."
4703 (pc '(:org-comment t)) 4712 (pc '(:org-comment t))
4704 (pall '(:org-archived t :org-comment t)) 4713 (pall '(:org-archived t :org-comment t))
4705 (rea (concat ":" org-archive-tag ":")) 4714 (rea (concat ":" org-archive-tag ":"))
4706 bmp file re) 4715 bmp file re)
4707 (save-excursion 4716 (save-excursion
4708 (while (setq file (pop files)) 4717 (while (setq file (pop files))
4709 (org-check-agenda-file file) 4718 (org-check-agenda-file file)
@@ -4775,7 +4784,7 @@ If not found, stay at current position and return nil."
4775 pos)) 4784 pos))
4776 4785
4777(defconst org-dblock-start-re 4786(defconst org-dblock-start-re
4778 "^#\\+BEGIN:[ \t]+\\(\\S-+\\)[ \t]+\\(.*\\)" 4787 "^#\\+BEGIN:[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?"
4779 "Matches the startline of a dynamic block, with parameters.") 4788 "Matches the startline of a dynamic block, with parameters.")
4780 4789
4781(defconst org-dblock-end-re "^#\\+END\\([: \t\r\n]\\|$\\)" 4790(defconst org-dblock-end-re "^#\\+END\\([: \t\r\n]\\|$\\)"
@@ -4803,7 +4812,7 @@ the property list including an extra property :name with the block name."
4803 (let* ((begdel (1+ (match-end 0))) 4812 (let* ((begdel (1+ (match-end 0)))
4804 (name (match-string 1)) 4813 (name (match-string 1))
4805 (params (append (list :name name) 4814 (params (append (list :name name)
4806 (read (concat "(" (match-string 2) ")"))))) 4815 (read (concat "(" (match-string 3) ")")))))
4807 (unless (re-search-forward org-dblock-end-re nil t) 4816 (unless (re-search-forward org-dblock-end-re nil t)
4808 (error "Dynamic block not terminated")) 4817 (error "Dynamic block not terminated"))
4809 (delete-region begdel (match-beginning 0)) 4818 (delete-region begdel (match-beginning 0))
@@ -5200,7 +5209,6 @@ If CALLBACK is non-nil, it is a function which is called to confirm
5200that the match should indeed be shown." 5209that the match should indeed be shown."
5201 (interactive "sRegexp: ") 5210 (interactive "sRegexp: ")
5202 (org-remove-occur-highlights nil nil t) 5211 (org-remove-occur-highlights nil nil t)
5203 (setq regexp (org-check-occur-regexp regexp))
5204 (let ((cnt 0)) 5212 (let ((cnt 0))
5205 (save-excursion 5213 (save-excursion
5206 (goto-char (point-min)) 5214 (goto-char (point-min))
@@ -5625,56 +5633,58 @@ next column.
5625For time difference computation, a year is assumed to be exactly 365 5633For time difference computation, a year is assumed to be exactly 365
5626days in order to avoid rounding problems." 5634days in order to avoid rounding problems."
5627 (interactive "P") 5635 (interactive "P")
5628 (save-excursion 5636 (or
5629 (unless (org-at-date-range-p) 5637 (org-clock-update-time-maybe)
5630 (goto-char (point-at-bol)) 5638 (save-excursion
5631 (re-search-forward org-tr-regexp (point-at-eol) t)) 5639 (unless (org-at-date-range-p)
5632 (if (not (org-at-date-range-p)) 5640 (goto-char (point-at-bol))
5633 (error "Not at a time-stamp range, and none found in current line"))) 5641 (re-search-forward org-tr-regexp (point-at-eol) t))
5634 (let* ((ts1 (match-string 1)) 5642 (if (not (org-at-date-range-p))
5635 (ts2 (match-string 2)) 5643 (error "Not at a time-stamp range, and none found in current line")))
5636 (havetime (or (> (length ts1) 15) (> (length ts2) 15))) 5644 (let* ((ts1 (match-string 1))
5637 (match-end (match-end 0)) 5645 (ts2 (match-string 2))
5638 (time1 (org-time-string-to-time ts1)) 5646 (havetime (or (> (length ts1) 15) (> (length ts2) 15)))
5639 (time2 (org-time-string-to-time ts2)) 5647 (match-end (match-end 0))
5640 (t1 (time-to-seconds time1)) 5648 (time1 (org-time-string-to-time ts1))
5641 (t2 (time-to-seconds time2)) 5649 (time2 (org-time-string-to-time ts2))
5642 (diff (abs (- t2 t1))) 5650 (t1 (time-to-seconds time1))
5643 (negative (< (- t2 t1) 0)) 5651 (t2 (time-to-seconds time2))
5644 ;; (ys (floor (* 365 24 60 60))) 5652 (diff (abs (- t2 t1)))
5645 (ds (* 24 60 60)) 5653 (negative (< (- t2 t1) 0))
5646 (hs (* 60 60)) 5654 ;; (ys (floor (* 365 24 60 60)))
5647 (fy "%dy %dd %02d:%02d") 5655 (ds (* 24 60 60))
5648 (fy1 "%dy %dd") 5656 (hs (* 60 60))
5649 (fd "%dd %02d:%02d") 5657 (fy "%dy %dd %02d:%02d")
5650 (fd1 "%dd") 5658 (fy1 "%dy %dd")
5651 (fh "%02d:%02d") 5659 (fd "%dd %02d:%02d")
5652 y d h m align) 5660 (fd1 "%dd")
5653 (if havetime 5661 (fh "%02d:%02d")
5654 (setq ; y (floor (/ diff ys)) diff (mod diff ys) 5662 y d h m align)
5655 y 0 5663 (if havetime
5656 d (floor (/ diff ds)) diff (mod diff ds) 5664 (setq ; y (floor (/ diff ys)) diff (mod diff ys)
5657 h (floor (/ diff hs)) diff (mod diff hs) 5665 y 0
5658 m (floor (/ diff 60))) 5666 d (floor (/ diff ds)) diff (mod diff ds)
5659 (setq ; y (floor (/ diff ys)) diff (mod diff ys) 5667 h (floor (/ diff hs)) diff (mod diff hs)
5660 y 0 5668 m (floor (/ diff 60)))
5661 d (floor (+ (/ diff ds) 0.5)) 5669 (setq ; y (floor (/ diff ys)) diff (mod diff ys)
5662 h 0 m 0)) 5670 y 0
5663 (if (not to-buffer) 5671 d (floor (+ (/ diff ds) 0.5))
5664 (message (org-make-tdiff-string y d h m)) 5672 h 0 m 0))
5665 (when (org-at-table-p) 5673 (if (not to-buffer)
5666 (goto-char match-end) 5674 (message (org-make-tdiff-string y d h m))
5667 (setq align t) 5675 (when (org-at-table-p)
5668 (and (looking-at " *|") (goto-char (match-end 0)))) 5676 (goto-char match-end)
5669 (if (looking-at 5677 (setq align t)
5670 "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") 5678 (and (looking-at " *|") (goto-char (match-end 0))))
5671 (replace-match "")) 5679 (if (looking-at
5672 (if negative (insert " -")) 5680 "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]")
5673 (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m)) 5681 (replace-match ""))
5674 (if (> d 0) (insert " " (format (if havetime fd fd1) d h m)) 5682 (if negative (insert " -"))
5675 (insert " " (format fh h m)))) 5683 (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m))
5676 (if align (org-table-align)) 5684 (if (> d 0) (insert " " (format (if havetime fd fd1) d h m))
5677 (message "Time difference inserted")))) 5685 (insert " " (format fh h m))))
5686 (if align (org-table-align))
5687 (message "Time difference inserted")))))
5678 5688
5679(defun org-make-tdiff-string (y d h m) 5689(defun org-make-tdiff-string (y d h m)
5680 (let ((fmt "") 5690 (let ((fmt "")
@@ -5817,6 +5827,7 @@ in the timestamp determines what will be changed."
5817 (setcar (nthcdr 2 time0) (or (nth 1 time0) 0)) 5827 (setcar (nthcdr 2 time0) (or (nth 1 time0) 0))
5818 (setq time (apply 'encode-time time0)))) 5828 (setq time (apply 'encode-time time0))))
5819 (insert (setq org-last-changed-timestamp (format-time-string fmt time))) 5829 (insert (setq org-last-changed-timestamp (format-time-string fmt time)))
5830 (org-clock-update-time-maybe)
5820 (goto-char pos) 5831 (goto-char pos)
5821 ;; Try to recenter the calendar window, if any 5832 ;; Try to recenter the calendar window, if any
5822 (if (and org-calendar-follow-timestamp-change 5833 (if (and org-calendar-follow-timestamp-change
@@ -5937,18 +5948,19 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
5937 "Holds the file total time in minutes, after a call to `org-clock-sum'.") 5948 "Holds the file total time in minutes, after a call to `org-clock-sum'.")
5938 (make-variable-buffer-local 'org-clock-file-total-minutes) 5949 (make-variable-buffer-local 'org-clock-file-total-minutes)
5939 5950
5940(defun org-clock-sum () 5951(defun org-clock-sum (&optional tstart tend)
5941 "Sum the times for each subtree. 5952 "Sum the times for each subtree.
5942Puts the resulting times in minutes as a text property on each headline." 5953Puts the resulting times in minutes as a text property on each headline."
5943 (interactive) 5954 (interactive)
5944 (let* ((bmp (buffer-modified-p)) 5955 (let* ((bmp (buffer-modified-p))
5945 (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" 5956 (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"
5946 org-clock-string 5957 org-clock-string
5947 ".*=>[ \t]*\\([0-9]+\\):\\([0-9]+\\)[ \t]*$")) 5958 "[ \t]*\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)"))
5948 (lmax 30) 5959 (lmax 30)
5949 (ltimes (make-vector lmax 0)) 5960 (ltimes (make-vector lmax 0))
5950 (t1 0) 5961 (t1 0)
5951 (level 0) 5962 (level 0)
5963 ts te dt
5952 time) 5964 time)
5953 (remove-text-properties (point-min) (point-max) '(:org-clock-minutes t)) 5965 (remove-text-properties (point-min) (point-max) '(:org-clock-minutes t))
5954 (save-excursion 5966 (save-excursion
@@ -5956,8 +5968,16 @@ Puts the resulting times in minutes as a text property on each headline."
5956 (while (re-search-backward re nil t) 5968 (while (re-search-backward re nil t)
5957 (if (match-end 2) 5969 (if (match-end 2)
5958 ;; A time 5970 ;; A time
5959 (setq t1 (+ t1 (* 60 (string-to-number (match-string 2))) 5971 (setq ts (match-string 2)
5960 (string-to-number (match-string 3)))) 5972 te (match-string 3)
5973 ts (time-to-seconds
5974 (apply 'encode-time (org-parse-time-string ts)))
5975 te (time-to-seconds
5976 (apply 'encode-time (org-parse-time-string te)))
5977 ts (if tstart (max ts tstart) ts)
5978 te (if tend (min te tend) te)
5979 dt (- te ts)
5980 t1 (if (> dt 0) (+ t1 (floor (/ dt 60))) t1))
5961 ;; A headline 5981 ;; A headline
5962 (setq level (- (match-end 1) (match-beginning 1))) 5982 (setq level (- (match-end 1) (match-beginning 1)))
5963 (when (or (> t1 0) (> (aref ltimes level) 0)) 5983 (when (or (> t1 0) (> (aref ltimes level) 0))
@@ -6069,26 +6089,112 @@ The BEGIN line can contain parameters. Allowed are:
6069 (interactive) 6089 (interactive)
6070 (org-remove-clock-overlays) 6090 (org-remove-clock-overlays)
6071 (unless (org-find-dblock "clocktable") 6091 (unless (org-find-dblock "clocktable")
6072 (org-create-dblock (list :name "clocktable" 6092 (org-create-dblock (list :name "clocktable"
6073 :maxlevel 2 :emphasize nil))) 6093 :maxlevel 2 :emphasize nil)))
6074 (org-update-dblock)) 6094 (org-update-dblock))
6075 6095
6096(defun org-clock-update-time-maybe ()
6097 "If this is a CLOCK line, update it and return t.
6098Otherwise, return nil."
6099 (interactive)
6100 (save-excursion
6101 (beginning-of-line 1)
6102 (skip-chars-forward " \t")
6103 (when (looking-at org-clock-string)
6104 (let ((re (concat "[ \t]*" org-clock-string
6105 " *[[<]\\([^]>]+\\)[]>]-+[[<]\\([^]>]+\\)[]>]"
6106 "\\([ \t]*=>.*\\)?"))
6107 ts te h m s)
6108 (if (not (looking-at re))
6109 nil
6110 (and (match-end 3) (delete-region (match-beginning 3) (match-end 3)))
6111 (end-of-line 1)
6112 (setq ts (match-string 1)
6113 te (match-string 2))
6114 (setq s (- (time-to-seconds
6115 (apply 'encode-time (org-parse-time-string te)))
6116 (time-to-seconds
6117 (apply 'encode-time (org-parse-time-string ts))))
6118 h (floor (/ s 3600))
6119 s (- s (* 3600 h))
6120 m (floor (/ s 60))
6121 s (- s (* 60 s)))
6122 (insert " => " (format "%2d:%02d" h m))
6123 t)))))
6124
6125(defun org-clock-special-range (key &optional time as-strings)
6126 "Return two times bordering a special time range.
6127Key is a symbol specifying the range and can be one of `today', `yesterday',
6128`thisweek', `lastweek', `thismonth', `lastmonth', `thisyear', `lastyear'.
6129A week starts Monday 0:00 and ends Sunday 24:00.
6130The range is determined relative to TIME. TIME defaults to the current time.
6131The return value is a cons cell with two internal times like the ones
6132returned by `current time' or `encode-time'. if AS-STRINGS is non-nil,
6133the returned times will be formatted strings."
6134 (let* ((tm (decode-time (or time (current-time))))
6135 (s 0) (m (nth 1 tm)) (h (nth 2 tm))
6136 (d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm))
6137 (dow (nth 6 tm))
6138 s1 m1 h1 d1 month1 y1 diff ts te fm)
6139 (cond
6140 ((eq key 'today)
6141 (setq h 0 m 0 h1 24 m1 0))
6142 ((eq key 'yesterday)
6143 (setq d (1- d) h 0 m 0 h1 24 m1 0))
6144 ((eq key 'thisweek)
6145 (setq diff (if (= dow 0) 6 (1- dow))
6146 m 0 h 0 d (- d diff) d1 (+ 7 d)))
6147 ((eq key 'lastweek)
6148 (setq diff (+ 7 (if (= dow 0) 6 (1- dow)))
6149 m 0 h 0 d (- d diff) d1 (+ 7 d)))
6150 ((eq key 'thismonth)
6151 (setq d 1 h 0 m 0 d1 1 month1 (1+ month) h1 0 m1 0))
6152 ((eq key 'lastmonth)
6153 (setq d 1 h 0 m 0 d1 1 month (1- month) month1 (1+ month) h1 0 m1 0))
6154 ((eq key 'thisyear)
6155 (setq m 0 h 0 d 1 month 1 y1 (1+ y)))
6156 ((eq key 'lastyear)
6157 (setq m 0 h 0 d 1 month 1 y (1- y) y1 (1+ y)))
6158 (t (error "No such time block %s" key)))
6159 (setq ts (encode-time s m h d month y)
6160 te (encode-time (or s1 s) (or m1 m) (or h1 h)
6161 (or d1 d) (or month1 month) (or y1 y)))
6162 (setq fm (cdr org-time-stamp-formats))
6163 (if as-strings
6164 (cons (format-time-string fm ts) (format-time-string fm te))
6165 (cons ts te))))
6166
6076(defun org-dblock-write:clocktable (params) 6167(defun org-dblock-write:clocktable (params)
6077 "Write the standard clocktable." 6168 "Write the standard clocktable."
6078 (let ((hlchars '((1 . "*") (2 . ?/))) 6169 (let ((hlchars '((1 . "*") (2 . ?/)))
6079 (emph nil) 6170 (emph nil)
6080 (ins (make-marker)) 6171 (ins (make-marker))
6081 ipos time h m p level hlc hdl maxlevel) 6172 ipos time h m p level hlc hdl maxlevel
6173 ts te cc block)
6082 (setq maxlevel (or (plist-get params :maxlevel) 3) 6174 (setq maxlevel (or (plist-get params :maxlevel) 3)
6083 emph (plist-get params :emphasize)) 6175 emph (plist-get params :emphasize)
6176 ts (plist-get params :tstart)
6177 te (plist-get params :tend)
6178 block (plist-get params :block))
6179 (when block
6180 (setq cc (org-clock-special-range block nil t)
6181 ts (car cc) te (cdr cc)))
6182 (if ts (setq ts (time-to-seconds
6183 (apply 'encode-time (org-parse-time-string ts)))))
6184 (if te (setq te (time-to-seconds
6185 (apply 'encode-time (org-parse-time-string te)))))
6084 (move-marker ins (point)) 6186 (move-marker ins (point))
6085 (setq ipos (point)) 6187 (setq ipos (point))
6086 (insert-before-markers "Clock summary at [" 6188 (insert-before-markers "Clock summary at ["
6087 (substring 6189 (substring
6088 (format-time-string (cdr org-time-stamp-formats)) 6190 (format-time-string (cdr org-time-stamp-formats))
6089 1 -1) 6191 1 -1)
6090 "]\n|L|Headline|Time|\n") 6192 "]."
6091 (org-clock-sum) 6193 (if block
6194 (format " Considered range is /%s/." block)
6195 "")
6196 "\n\n|L|Headline|Time|\n")
6197 (org-clock-sum ts te)
6092 (setq h (/ org-clock-file-total-minutes 60) 6198 (setq h (/ org-clock-file-total-minutes 60)
6093 m (- org-clock-file-total-minutes (* 60 h))) 6199 m (- org-clock-file-total-minutes (* 60 h)))
6094 (insert-before-markers "|-\n|0|" "*Total file time*| " 6200 (insert-before-markers "|-\n|0|" "*Total file time*| "
@@ -6475,7 +6581,7 @@ the buffer and restores the previous window configuration."
6475 (if (stringp org-agenda-files) 6581 (if (stringp org-agenda-files)
6476 (let ((cw (current-window-configuration))) 6582 (let ((cw (current-window-configuration)))
6477 (find-file org-agenda-files) 6583 (find-file org-agenda-files)
6478 (set (make-local-variable 'org-window-configuration) cw) 6584 (org-set-local 'org-window-configuration cw)
6479 (org-add-hook 'after-save-hook 6585 (org-add-hook 'after-save-hook
6480 (lambda () 6586 (lambda ()
6481 (set-window-configuration 6587 (set-window-configuration
@@ -6603,7 +6709,7 @@ dates."
6603 (setq buffer-read-only nil) 6709 (setq buffer-read-only nil)
6604 (erase-buffer) 6710 (erase-buffer)
6605 (org-agenda-mode) (setq buffer-read-only nil) 6711 (org-agenda-mode) (setq buffer-read-only nil)
6606 (set (make-local-variable 'org-agenda-type) 'timeline) 6712 (org-set-local 'org-agenda-type 'timeline)
6607 (if doclosed (push :closed args)) 6713 (if doclosed (push :closed args))
6608 (push :timestamp args) 6714 (push :timestamp args)
6609 (if dotodo (push :todo args)) 6715 (if dotodo (push :todo args))
@@ -6701,9 +6807,9 @@ NDAYS defaults to `org-agenda-ndays'."
6701 (setq buffer-read-only nil) 6807 (setq buffer-read-only nil)
6702 (erase-buffer) 6808 (erase-buffer)
6703 (org-agenda-mode) (setq buffer-read-only nil) 6809 (org-agenda-mode) (setq buffer-read-only nil)
6704 (set (make-local-variable 'org-agenda-type) 'agenda) 6810 (org-set-local 'org-agenda-type 'agenda)
6705 (set (make-local-variable 'starting-day) (car day-numbers)) 6811 (org-set-local 'starting-day (car day-numbers))
6706 (set (make-local-variable 'include-all-loc) include-all) 6812 (org-set-local 'include-all-loc include-all)
6707 (when (and (or include-all org-agenda-include-all-todo) 6813 (when (and (or include-all org-agenda-include-all-todo)
6708 (member today day-numbers)) 6814 (member today day-numbers))
6709 (setq files thefiles 6815 (setq files thefiles
@@ -6812,11 +6918,11 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
6812 (setq buffer-read-only nil) 6918 (setq buffer-read-only nil)
6813 (erase-buffer) 6919 (erase-buffer)
6814 (org-agenda-mode) (setq buffer-read-only nil) 6920 (org-agenda-mode) (setq buffer-read-only nil)
6815 (set (make-local-variable 'org-agenda-type) 'todo) 6921 (org-set-local 'org-agenda-type 'todo)
6816 (set (make-local-variable 'last-arg) arg) 6922 (org-set-local 'last-arg arg)
6817 (set (make-local-variable 'org-todo-keywords) kwds) 6923 (org-set-local 'org-todo-keywords kwds)
6818 (set (make-local-variable 'org-agenda-redo-command) 6924 (org-set-local 'org-agenda-redo-command
6819 '(org-todo-list (or current-prefix-arg last-arg) t)) 6925 '(org-todo-list (or current-prefix-arg last-arg) t))
6820 (setq files (org-agenda-files) 6926 (setq files (org-agenda-files)
6821 rtnall nil) 6927 rtnall nil)
6822 (org-prepare-agenda-buffers files) 6928 (org-prepare-agenda-buffers files)
@@ -7704,11 +7810,12 @@ the documentation of `org-diary'."
7704 (abbreviate-file-name buffer-file-name)))) 7810 (abbreviate-file-name buffer-file-name))))
7705 (regexp org-tr-regexp) 7811 (regexp org-tr-regexp)
7706 (d0 (calendar-absolute-from-gregorian date)) 7812 (d0 (calendar-absolute-from-gregorian date))
7707 marker hdmarker ee txt d1 d2 s1 s2 timestr category tags) 7813 marker hdmarker ee txt d1 d2 s1 s2 timestr category tags pos)
7708 (goto-char (point-min)) 7814 (goto-char (point-min))
7709 (while (re-search-forward regexp nil t) 7815 (while (re-search-forward regexp nil t)
7710 (catch :skip 7816 (catch :skip
7711 (org-agenda-skip) 7817 (org-agenda-skip)
7818 (setq pos (point))
7712 (setq timestr (match-string 0) 7819 (setq timestr (match-string 0)
7713 s1 (match-string 1) 7820 s1 (match-string 1)
7714 s2 (match-string 2) 7821 s2 (match-string 2)
@@ -7736,7 +7843,8 @@ the documentation of `org-diary'."
7736 'org-marker marker 'org-hd-marker hdmarker 7843 'org-marker marker 'org-hd-marker hdmarker
7737 'priority (org-get-priority txt) 'category category) 7844 'priority (org-get-priority txt) 'category category)
7738 (push txt ee))) 7845 (push txt ee)))
7739 (outline-next-heading))) 7846 (goto-char pos)))
7847; (outline-next-heading))) ;FIXME: correct to be removed??????
7740 ;; Sort the entries by expiration date. 7848 ;; Sort the entries by expiration date.
7741 (nreverse ee))) 7849 (nreverse ee)))
7742 7850
@@ -7757,7 +7865,7 @@ groups carry important information:
7757 7865
7758(defconst org-stamp-time-of-day-regexp 7866(defconst org-stamp-time-of-day-regexp
7759 (concat 7867 (concat
7760 "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +[a-zA-Z]+ +\\)" 7868 "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +\\sw+ +\\)"
7761 "\\([012][0-9]:[0-5][0-9]\\)>" 7869 "\\([012][0-9]:[0-5][0-9]\\)>"
7762 "\\(--?" 7870 "\\(--?"
7763 "<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?") 7871 "<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?")
@@ -8620,10 +8728,10 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
8620 (setq buffer-read-only nil) 8728 (setq buffer-read-only nil)
8621 (erase-buffer) 8729 (erase-buffer)
8622 (org-agenda-mode) (setq buffer-read-only nil) 8730 (org-agenda-mode) (setq buffer-read-only nil)
8623 (set (make-local-variable 'org-agenda-type) 'tags) 8731 (org-set-local 'org-agenda-type 'tags)
8624 (set (make-local-variable 'org-agenda-redo-command) 8732 (org-set-local 'org-agenda-redo-command
8625 (list 'org-tags-view (list 'quote todo-only) 8733 (list 'org-tags-view (list 'quote todo-only)
8626 (list 'if 'current-prefix-arg nil match) t)) 8734 (list 'if 'current-prefix-arg nil match) t))
8627 (setq files (org-agenda-files) 8735 (setq files (org-agenda-files)
8628 rtnall nil) 8736 rtnall nil)
8629 (org-prepare-agenda-buffers files) 8737 (org-prepare-agenda-buffers files)
@@ -10234,13 +10342,13 @@ to be run from that hook to fucntion properly."
10234 (org-startup-with-deadline-check nil)) 10342 (org-startup-with-deadline-check nil))
10235 (org-mode)) 10343 (org-mode))
10236 (if (and file (string-match "\\S-" file) (not (file-directory-p file))) 10344 (if (and file (string-match "\\S-" file) (not (file-directory-p file)))
10237 (set (make-local-variable 'org-default-notes-file) file)) 10345 (org-set-local 'org-default-notes-file file))
10238 (goto-char (point-min)) 10346 (goto-char (point-min))
10239 (if (re-search-forward "%\\?" nil t) (replace-match ""))) 10347 (if (re-search-forward "%\\?" nil t) (replace-match "")))
10240 (let ((org-startup-folded nil) 10348 (let ((org-startup-folded nil)
10241 (org-startup-with-deadline-check nil)) 10349 (org-startup-with-deadline-check nil))
10242 (org-mode))) 10350 (org-mode)))
10243 (set (make-local-variable 'org-finish-function) 'remember-buffer)) 10351 (org-set-local 'org-finish-function 'remember-buffer))
10244 10352
10245;;;###autoload 10353;;;###autoload
10246(defun org-remember-handler () 10354(defun org-remember-handler ()
@@ -11492,10 +11600,10 @@ it can be edited in place."
11492 '(invisible t org-cwidth t display t 11600 '(invisible t org-cwidth t display t
11493 intangible t)) 11601 intangible t))
11494 (goto-char p) 11602 (goto-char p)
11495 (set (make-local-variable 'org-finish-function) 11603 (org-set-local 'org-finish-function
11496 'org-table-finish-edit-field) 11604 'org-table-finish-edit-field)
11497 (set (make-local-variable 'org-window-configuration) cw) 11605 (org-set-local 'org-window-configuration cw)
11498 (set (make-local-variable 'org-field-marker) pos) 11606 (org-set-local 'org-field-marker pos)
11499 (message "Edit and finish with C-c C-c")))) 11607 (message "Edit and finish with C-c C-c"))))
11500 11608
11501(defun org-table-finish-edit-field () 11609(defun org-table-finish-edit-field ()
@@ -12098,10 +12206,11 @@ not overwrite the stored one."
12098 (setq formula (car tmp) 12206 (setq formula (car tmp)
12099 fmt (concat (cdr (assoc "%" org-table-local-parameters)) 12207 fmt (concat (cdr (assoc "%" org-table-local-parameters))
12100 (nth 1 tmp))) 12208 (nth 1 tmp)))
12101 (while (string-match "[pnfse]\\(-?[0-9]+\\)" fmt) 12209 (while (string-match "\\([pnfse]\\)\\(-?[0-9]+\\)" fmt)
12102 (setq c (string-to-char (match-string 1 fmt)) 12210 (setq c (string-to-char (match-string 1 fmt))
12103 n (string-to-number (or (match-string 1 fmt) ""))) 12211 n (string-to-number (match-string 2 fmt)))
12104 (if (= c ?p) (setq modes (org-set-calc-mode 'calc-internal-prec n)) 12212 (if (= c ?p)
12213 (setq modes (org-set-calc-mode 'calc-internal-prec n))
12105 (setq modes (org-set-calc-mode 12214 (setq modes (org-set-calc-mode
12106 'calc-float-format 12215 'calc-float-format
12107 (list (cdr (assoc c '((?n . float) (?f . fix) 12216 (list (cdr (assoc c '((?n . float) (?f . fix)
@@ -12314,8 +12423,8 @@ Parameters get priority."
12314 (switch-to-buffer-other-window "*Edit Formulas*") 12423 (switch-to-buffer-other-window "*Edit Formulas*")
12315 (erase-buffer) 12424 (erase-buffer)
12316 (fundamental-mode) 12425 (fundamental-mode)
12317 (set (make-local-variable 'org-pos) pos) 12426 (org-set-local 'org-pos pos)
12318 (set (make-local-variable 'org-window-configuration) wc) 12427 (org-set-local 'org-window-configuration wc)
12319 (use-local-map org-edit-formulas-map) 12428 (use-local-map org-edit-formulas-map)
12320 (setq s "# Edit formulas and finish with `C-c C-c'. 12429 (setq s "# Edit formulas and finish with `C-c C-c'.
12321# Use `C-u C-c C-c' to also appy them immediately to the entire table. 12430# Use `C-u C-c C-c' to also appy them immediately to the entire table.
@@ -12481,15 +12590,15 @@ table editor in arbitrary modes.")
12481 (let ((c (assq 'orgtbl-mode minor-mode-map-alist))) 12590 (let ((c (assq 'orgtbl-mode minor-mode-map-alist)))
12482 (and c (setq minor-mode-map-alist 12591 (and c (setq minor-mode-map-alist
12483 (cons c (delq c minor-mode-map-alist))))) 12592 (cons c (delq c minor-mode-map-alist)))))
12484 (set (make-local-variable (quote org-table-may-need-update)) t) 12593 (org-set-local (quote org-table-may-need-update) t)
12485 (org-add-hook 'before-change-functions 'org-before-change-function 12594 (org-add-hook 'before-change-functions 'org-before-change-function
12486 nil 'local) 12595 nil 'local)
12487 (set (make-local-variable 'org-old-auto-fill-inhibit-regexp) 12596 (org-set-local 'org-old-auto-fill-inhibit-regexp
12488 auto-fill-inhibit-regexp) 12597 auto-fill-inhibit-regexp)
12489 (set (make-local-variable 'auto-fill-inhibit-regexp) 12598 (org-set-local 'auto-fill-inhibit-regexp
12490 (if auto-fill-inhibit-regexp 12599 (if auto-fill-inhibit-regexp
12491 (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp) 12600 (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp)
12492 "[ \t]*|")) 12601 "[ \t]*|"))
12493 (org-add-to-invisibility-spec '(org-cwidth)) 12602 (org-add-to-invisibility-spec '(org-cwidth))
12494 (easy-menu-add orgtbl-mode-menu) 12603 (easy-menu-add orgtbl-mode-menu)
12495 (run-hooks 'orgtbl-mode-hook)) 12604 (run-hooks 'orgtbl-mode-hook))
@@ -13388,7 +13497,7 @@ underlined headlines. The default is 3."
13388 (set (make-local-variable (cdr x)) 13497 (set (make-local-variable (cdr x))
13389 (plist-get opt-plist (car x)))) 13498 (plist-get opt-plist (car x))))
13390 org-export-plist-vars) 13499 org-export-plist-vars)
13391 (set (make-local-variable 'org-odd-levels-only) odd) 13500 (org-set-local 'org-odd-levels-only odd)
13392 (setq umax (if arg (prefix-numeric-value arg) 13501 (setq umax (if arg (prefix-numeric-value arg)
13393 org-export-headline-levels)) 13502 org-export-headline-levels))
13394 13503
@@ -13594,22 +13703,15 @@ command."
13594 (goto-char (point-min))))) 13703 (goto-char (point-min)))))
13595 13704
13596(defun org-find-visible () 13705(defun org-find-visible ()
13597 (if (featurep 'noutline) 13706 (let ((s (point)))
13598 (let ((s (point))) 13707 (while (and (not (= (point-max) (setq s (next-overlay-change s))))
13599 (while (and (not (= (point-max) (setq s (next-overlay-change s)))) 13708 (get-char-property s 'invisible)))
13600 (get-char-property s 'invisible))) 13709 s))
13601 s)
13602 (skip-chars-forward "^\n")
13603 (point)))
13604(defun org-find-invisible () 13710(defun org-find-invisible ()
13605 (if (featurep 'noutline) 13711 (let ((s (point)))
13606 (let ((s (point))) 13712 (while (and (not (= (point-max) (setq s (next-overlay-change s))))
13607 (while (and (not (= (point-max) (setq s (next-overlay-change s)))) 13713 (not (get-char-property s 'invisible))))
13608 (not (get-char-property s 'invisible)))) 13714 s))
13609 s)
13610 (skip-chars-forward "^\r")
13611 (point)))
13612
13613 13715
13614;; HTML 13716;; HTML
13615 13717
@@ -13859,14 +13961,16 @@ lang=\"%s\" xml:lang=\"%s\">
13859 (insert (or (plist-get opt-plist :preamble) "")) 13961 (insert (or (plist-get opt-plist :preamble) ""))
13860 13962
13861 (when (plist-get opt-plist :auto-preamble) 13963 (when (plist-get opt-plist :auto-preamble)
13862 (if title (insert (concat "<h1 class=\"title\">" 13964 (if title (insert (format org-export-html-title-format
13863 (org-html-expand title) "</h1>\n"))) 13965 (org-html-expand title))))
13864
13865 (if text (insert "<p>\n" (org-html-expand text) "</p>"))) 13966 (if text (insert "<p>\n" (org-html-expand text) "</p>")))
13866 13967
13867 (if org-export-with-toc 13968 (if org-export-with-toc
13868 (progn 13969 (progn
13869 (insert (format "<h2>%s</h2>\n" (nth 3 lang-words))) 13970 (insert (format "<h%d>%s</h%d>\n"
13971 org-export-html-toplevel-hlevel
13972 (nth 3 lang-words)
13973 org-export-html-toplevel-hlevel))
13870 (insert "<ul>\n<li>") 13974 (insert "<ul>\n<li>")
13871 (setq lines 13975 (setq lines
13872 (mapcar '(lambda (line) 13976 (mapcar '(lambda (line)
@@ -14553,7 +14657,7 @@ When TITLE is nil, just close all open levels."
14553 (insert "<ul>\n<li>" title "<br/>\n"))) 14657 (insert "<ul>\n<li>" title "<br/>\n")))
14554 (if org-export-with-section-numbers 14658 (if org-export-with-section-numbers
14555 (setq title (concat (org-section-number level) " " title))) 14659 (setq title (concat (org-section-number level) " " title)))
14556 (setq level (+ level 1)) 14660 (setq level (+ level org-export-html-toplevel-hlevel -1))
14557 (if with-toc 14661 (if with-toc
14558 (insert (format "\n<h%d><a name=\"sec-%d\">%s</a></h%d>\n" 14662 (insert (format "\n<h%d><a name=\"sec-%d\">%s</a></h%d>\n"
14559 level head-count title level)) 14663 level head-count title level))
@@ -15763,6 +15867,10 @@ See the individual commands for more information."
15763 "--" 15867 "--"
15764 ("TODO Lists" 15868 ("TODO Lists"
15765 ["TODO/DONE/-" org-todo t] 15869 ["TODO/DONE/-" org-todo t]
15870 ("Select keyword"
15871 ["Next keyword" org-shiftright (org-on-heading-p)]
15872 ["Previous keyword" org-shiftleft (org-on-heading-p)]
15873 ["Complete Keyword" org-complete (assq :todo-keyword (org-context))])
15766 ["Show TODO Tree" org-show-todo-tree t] 15874 ["Show TODO Tree" org-show-todo-tree t]
15767 ["Global TODO list" org-todo-list t] 15875 ["Global TODO list" org-todo-list t]
15768 "--" 15876 "--"
@@ -16042,31 +16150,32 @@ return nil."
16042 ;; In the paragraph separator we include headlines, because filling 16150 ;; In the paragraph separator we include headlines, because filling
16043 ;; text in a line directly attached to a headline would otherwise 16151 ;; text in a line directly attached to a headline would otherwise
16044 ;; fill the headline as well. 16152 ;; fill the headline as well.
16045 (set (make-local-variable 'comment-start-skip) "^#+[ \t]*") 16153 (org-set-local 'comment-start-skip "^#+[ \t]*")
16046 (set (make-local-variable 'paragraph-separate) "\f\\|\\*\\|[ ]*$\\|[ \t]*[:|]") 16154 (org-set-local 'paragraph-separate "\f\\|\\*\\|[ ]*$\\|[ \t]*[:|]")
16047 ;; The paragraph starter includes hand-formatted lists. 16155 ;; The paragraph starter includes hand-formatted lists.
16048 (set (make-local-variable 'paragraph-start) 16156 (org-set-local 'paragraph-start
16049 "\f\\|[ ]*$\\|\\([*\f]+\\)\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]") 16157 "\f\\|[ ]*$\\|\\([*\f]+\\)\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]")
16050 ;; Inhibit auto-fill for headers, tables and fixed-width lines. 16158 ;; Inhibit auto-fill for headers, tables and fixed-width lines.
16051 ;; But only if the user has not turned off tables or fixed-width regions 16159 ;; But only if the user has not turned off tables or fixed-width regions
16052 (set (make-local-variable 'auto-fill-inhibit-regexp) 16160 (org-set-local
16053 (concat "\\*\\|#" 16161 'auto-fill-inhibit-regexp
16054 "\\|[ \t]*" org-keyword-time-regexp 16162 (concat "\\*\\|#"
16055 (if (or org-enable-table-editor org-enable-fixed-width-editor) 16163 "\\|[ \t]*" org-keyword-time-regexp
16056 (concat 16164 (if (or org-enable-table-editor org-enable-fixed-width-editor)
16057 "\\|[ \t]*[" 16165 (concat
16058 (if org-enable-table-editor "|" "") 16166 "\\|[ \t]*["
16059 (if org-enable-fixed-width-editor ":" "") 16167 (if org-enable-table-editor "|" "")
16060 "]")))) 16168 (if org-enable-fixed-width-editor ":" "")
16169 "]"))))
16061 ;; We use our own fill-paragraph function, to make sure that tables 16170 ;; We use our own fill-paragraph function, to make sure that tables
16062 ;; and fixed-width regions are not wrapped. That function will pass 16171 ;; and fixed-width regions are not wrapped. That function will pass
16063 ;; through to `fill-paragraph' when appropriate. 16172 ;; through to `fill-paragraph' when appropriate.
16064 (set (make-local-variable 'fill-paragraph-function) 'org-fill-paragraph) 16173 (org-set-local 'fill-paragraph-function 'org-fill-paragraph)
16065 ;; Adaptive filling: To get full control, first make sure that 16174 ; Adaptive filling: To get full control, first make sure that
16066 ;; `adaptive-fill-regexp' never matches. Then install our own matcher. 16175 ;; `adaptive-fill-regexp' never matches. Then install our own matcher.
16067 (set (make-local-variable 'adaptive-fill-regexp) "\000") 16176 (org-set-local 'adaptive-fill-regexp "\000")
16068 (set (make-local-variable 'adaptive-fill-function) 16177 (org-set-local 'adaptive-fill-function
16069 'org-adaptive-fill-function)) 16178 'org-adaptive-fill-function))
16070 16179
16071(defun org-fill-paragraph (&optional justify) 16180(defun org-fill-paragraph (&optional justify)
16072 "Re-align a table, pass through to fill-paragraph if no table." 16181 "Re-align a table, pass through to fill-paragraph if no table."
@@ -16145,18 +16254,7 @@ that can be added."
16145 t) 16254 t)
16146 "\\'")))) 16255 "\\'"))))
16147 16256
16148;; Functions needed for compatibility with old outline.el. 16257;; Functions extending outline functionality
16149
16150;; Programming for the old outline.el (that uses selective display
16151;; instead of `invisible' text properties) is a nightmare, mostly
16152;; because regular expressions can no longer be anchored at
16153;; beginning/end of line. Therefore a number of function need special
16154;; treatment when the old outline.el is being used.
16155
16156;; The following functions capture almost the entire compatibility code
16157;; between the different versions of outline-mode. The only other
16158;; places where this is important are the font-lock-keywords, and in
16159;; `org-export-visible'. Search for `org-noutline-p' to find them.
16160 16258
16161;; C-a should go to the beginning of a *visible* line, also in the 16259;; C-a should go to the beginning of a *visible* line, also in the
16162;; new outline.el. I guess this should be patched into Emacs? 16260;; new outline.el. I guess this should be patched into Emacs?
@@ -16174,60 +16272,26 @@ to a visible line beginning. This makes the function of C-a more intuitive."
16174 (beginning-of-line 1)) 16272 (beginning-of-line 1))
16175 (forward-char 1)))) 16273 (forward-char 1))))
16176 16274
16177(when org-noutline-p 16275(define-key org-mode-map "\C-a" 'org-beginning-of-line)
16178 (define-key org-mode-map "\C-a" 'org-beginning-of-line))
16179 16276
16180(defun org-invisible-p () 16277(defun org-invisible-p ()
16181 "Check if point is at a character currently not visible." 16278 "Check if point is at a character currently not visible."
16182 (if org-noutline-p 16279 ;; Early versions of noutline don't have `outline-invisible-p'.
16183 ;; Early versions of noutline don't have `outline-invisible-p'. 16280 (if (fboundp 'outline-invisible-p)
16184 (if (fboundp 'outline-invisible-p) 16281 (outline-invisible-p)
16185 (outline-invisible-p) 16282 (get-char-property (point) 'invisible)))
16186 (get-char-property (point) 'invisible))
16187 (save-excursion
16188 (skip-chars-backward "^\r\n")
16189 (equal (char-before) ?\r))))
16190 16283
16191(defun org-invisible-p2 () 16284(defun org-invisible-p2 ()
16192 "Check if point is at a character currently not visible." 16285 "Check if point is at a character currently not visible."
16193 (save-excursion 16286 (save-excursion
16194 (if org-noutline-p 16287 (if (and (eolp) (not (bobp))) (backward-char 1))
16195 (progn 16288 ;; Early versions of noutline don't have `outline-invisible-p'.
16196 (if (and (eolp) (not (bobp))) (backward-char 1)) 16289 (if (fboundp 'outline-invisible-p)
16197 ;; Early versions of noutline don't have `outline-invisible-p'. 16290 (outline-invisible-p)
16198 (if (fboundp 'outline-invisible-p) 16291 (get-char-property (point) 'invisible))))
16199 (outline-invisible-p) 16292
16200 (get-char-property (point) 'invisible))) 16293(defalias 'org-back-to-heading 'outline-back-to-heading)
16201 (skip-chars-backward "^\r\n") 16294(defalias 'org-on-heading-p 'outline-on-heading-p)
16202 (equal (char-before) ?\r))))
16203
16204(defun org-back-to-heading (&optional invisible-ok)
16205 "Move to previous heading line, or beg of this line if it's a heading.
16206Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
16207 (if org-noutline-p
16208 (outline-back-to-heading invisible-ok)
16209 (if (and (or (bobp) (memq (char-before) '(?\n ?\r)))
16210 (looking-at outline-regexp))
16211 t
16212 (if (re-search-backward (concat (if invisible-ok "\\([\r\n]\\|^\\)" "^")
16213 outline-regexp)
16214 nil t)
16215 (if invisible-ok
16216 (progn (goto-char (or (match-end 1) (match-beginning 0)))
16217 (looking-at outline-regexp)))
16218 (error "Before first heading")))))
16219
16220(defun org-on-heading-p (&optional invisible-ok)
16221 "Return t if point is on a (visible) heading line.
16222If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
16223 (if org-noutline-p
16224 (outline-on-heading-p 'invisible-ok)
16225 (save-excursion
16226 (skip-chars-backward "^\n\r")
16227 (and (looking-at outline-regexp)
16228 (or invisible-ok
16229 (bobp)
16230 (equal (char-before) ?\n))))))
16231 16295
16232(defun org-on-target-p () 16296(defun org-on-target-p ()
16233 (let ((pos (point))) 16297 (let ((pos (point)))
@@ -16243,47 +16307,20 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
16243 "Move to the heading line of which the present line is a subheading. 16307 "Move to the heading line of which the present line is a subheading.
16244This function considers both visible and invisible heading lines. 16308This function considers both visible and invisible heading lines.
16245With argument, move up ARG levels." 16309With argument, move up ARG levels."
16246 (if org-noutline-p 16310 (if (fboundp 'outline-up-heading-all)
16247 (if (fboundp 'outline-up-heading-all) 16311 (outline-up-heading-all arg) ; emacs 21 version of outline.el
16248 (outline-up-heading-all arg) ; emacs 21 version of outline.el 16312 (outline-up-heading arg t))) ; emacs 22 version of outline.el
16249 (outline-up-heading arg t)) ; emacs 22 version of outline.el
16250 (org-back-to-heading t)
16251 (looking-at outline-regexp)
16252 (if (<= (- (match-end 0) (match-beginning 0)) arg)
16253 (error "Cannot move up %d levels" arg)
16254 (re-search-backward
16255 (concat "[\n\r]" (regexp-quote
16256 (make-string (- (match-end 0) (match-beginning 0) arg)
16257 ?*))
16258 "[^*]"))
16259 (forward-char 1))))
16260 16313
16261(defun org-show-hidden-entry () 16314(defun org-show-hidden-entry ()
16262 "Show an entry where even the heading is hidden." 16315 "Show an entry where even the heading is hidden."
16263 (save-excursion 16316 (save-excursion
16264 (if (not org-noutline-p)
16265 (progn
16266 (org-back-to-heading t)
16267 (org-flag-heading nil)))
16268 (org-show-entry))) 16317 (org-show-entry)))
16269 16318
16270(defun org-check-occur-regexp (regexp)
16271 "If REGEXP starts with \"^\", modify it to check for \\r as well.
16272Of course, only for the old outline mode."
16273 (if org-noutline-p
16274 regexp
16275 (if (string-match "^\\^" regexp)
16276 (concat "[\n\r]" (substring regexp 1))
16277 regexp)))
16278
16279(defun org-flag-heading (flag &optional entry) 16319(defun org-flag-heading (flag &optional entry)
16280 "Flag the current heading. FLAG non-nil means make invisible. 16320 "Flag the current heading. FLAG non-nil means make invisible.
16281When ENTRY is non-nil, show the entire entry." 16321When ENTRY is non-nil, show the entire entry."
16282 (save-excursion 16322 (save-excursion
16283 (org-back-to-heading t) 16323 (org-back-to-heading t)
16284 (if (not org-noutline-p)
16285 ;; Make the current headline visible
16286 (outline-flag-region (max 1 (1- (point))) (point) (if flag ?\r ?\n)))
16287 ;; Check if we should show the entire entry 16324 ;; Check if we should show the entire entry
16288 (if entry 16325 (if entry
16289 (progn 16326 (progn
@@ -16293,9 +16330,7 @@ When ENTRY is non-nil, show the entire entry."
16293 (org-flag-heading nil)))) 16330 (org-flag-heading nil))))
16294 (outline-flag-region (max 1 (1- (point))) 16331 (outline-flag-region (max 1 (1- (point)))
16295 (save-excursion (outline-end-of-heading) (point)) 16332 (save-excursion (outline-end-of-heading) (point))
16296 (if org-noutline-p 16333 flag))))
16297 flag
16298 (if flag ?\r ?\n))))))
16299 16334
16300(defun org-end-of-subtree (&optional invisible-OK) 16335(defun org-end-of-subtree (&optional invisible-OK)
16301 ;; This is an exact copy of the original function, but it uses 16336 ;; This is an exact copy of the original function, but it uses
@@ -16324,7 +16359,7 @@ When ENTRY is non-nil, show the entire entry."
16324 (point) 16359 (point)
16325 (save-excursion 16360 (save-excursion
16326 (outline-end-of-subtree) (outline-next-heading) (point)) 16361 (outline-end-of-subtree) (outline-next-heading) (point))
16327 (if org-noutline-p nil ?\n))) 16362 nil))
16328 16363
16329(defun org-show-entry () 16364(defun org-show-entry ()
16330 "Show the body directly following this heading. 16365 "Show the body directly following this heading.
@@ -16337,16 +16372,16 @@ Show the heading too, if it is currently invisible."
16337 (save-excursion 16372 (save-excursion
16338 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) 16373 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move)
16339 (or (match-beginning 1) (point-max))) 16374 (or (match-beginning 1) (point-max)))
16340 (if org-noutline-p nil ?\n)))) 16375 nil)))
16341 16376
16342(defun org-make-options-regexp (kwds) 16377(defun org-make-options-regexp (kwds)
16343 "Make a regular expression for keyword lines." 16378 "Make a regular expression for keyword lines."
16344 (concat 16379 (concat
16345 (if org-noutline-p "^" "[\n\r]") 16380 "^"
16346 "#?[ \t]*\\+\\(" 16381 "#?[ \t]*\\+\\("
16347 (mapconcat 'regexp-quote kwds "\\|") 16382 (mapconcat 'regexp-quote kwds "\\|")
16348 "\\):[ \t]*" 16383 "\\):[ \t]*"
16349 (if org-noutline-p "\\(.+\\)" "\\([^\n\r]+\\)"))) 16384 "\\(.+\\)"))
16350 16385
16351;; Make `bookmark-jump' show the jump location if it was hidden. 16386;; Make `bookmark-jump' show the jump location if it was hidden.
16352(eval-after-load "bookmark" 16387(eval-after-load "bookmark"
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 693a2d7fa4b..81fe9a8e868 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -121,6 +121,12 @@ any protocol specific data.")
121 121
122(defun x-dnd-init-frame (&optional frame) 122(defun x-dnd-init-frame (&optional frame)
123 "Setup drag and drop for FRAME (i.e. create appropriate properties)." 123 "Setup drag and drop for FRAME (i.e. create appropriate properties)."
124 (x-register-dnd-atom "DndProtocol" frame)
125 (x-register-dnd-atom "_MOTIF_DRAG_AND_DROP_MESSAGE" frame)
126 (x-register-dnd-atom "XdndEnter" frame)
127 (x-register-dnd-atom "XdndPosition" frame)
128 (x-register-dnd-atom "XdndLeave" frame)
129 (x-register-dnd-atom "XdndDrop" frame)
124 (x-dnd-init-xdnd-for-frame frame) 130 (x-dnd-init-xdnd-for-frame frame)
125 (x-dnd-init-motif-for-frame frame)) 131 (x-dnd-init-motif-for-frame frame))
126 132