aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorKaroly Lorentey2006-10-14 16:56:21 +0000
committerKaroly Lorentey2006-10-14 16:56:21 +0000
commit3f87f67ee215ffeecbd2f53bd7f342cdf03f47df (patch)
tree16f2af9111af08a94d608d96a957f5c3ec5effcc /lisp
parent350e4fb815d7413ef6d339dd664014706f742927 (diff)
parent7a210b69c7f92650c524766d1b9d3f3eefdd67c7 (diff)
downloademacs-3f87f67ee215ffeecbd2f53bd7f342cdf03f47df.tar.gz
emacs-3f87f67ee215ffeecbd2f53bd7f342cdf03f47df.zip
Merged from emacs@sv.gnu.org
Patches applied: * emacs@sv.gnu.org/emacs--devo--0--patch-371 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-372 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-373 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-374 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-375 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-376 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-377 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-378 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-379 Merge from erc--emacs--21 * emacs@sv.gnu.org/emacs--devo--0--patch-380 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-381 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-382 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-383 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-384 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-385 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-386 Update from erc--emacs--22 * emacs@sv.gnu.org/emacs--devo--0--patch-387 Fix ERC bug introduced in last patch * emacs@sv.gnu.org/emacs--devo--0--patch-388 Update from erc--emacs--22 * emacs@sv.gnu.org/emacs--devo--0--patch-389 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-390 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-391 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-392 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-393 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-394 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-395 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-396 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-397 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-398 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-399 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-400 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-401 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-402 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-403 Rcirc update from Ryan Yeske * emacs@sv.gnu.org/emacs--devo--0--patch-404 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-405 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-406 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-407 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-408 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-409 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-410 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-411 Miscellaneous tq-related fixes. * emacs@sv.gnu.org/emacs--devo--0--patch-412 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-121 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-122 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-123 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-124 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-125 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-126 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-127 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-581
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog728
-rw-r--r--lisp/allout.el813
-rw-r--r--lisp/avoid.el25
-rw-r--r--lisp/bindings.el175
-rw-r--r--lisp/buff-menu.el8
-rw-r--r--lisp/calendar/timeclock.el16
-rw-r--r--lisp/compare-w.el36
-rw-r--r--lisp/complete.el79
-rw-r--r--lisp/cus-edit.el10
-rw-r--r--lisp/cus-start.el4
-rw-r--r--lisp/cus-theme.el6
-rw-r--r--lisp/ediff-mult.el13
-rw-r--r--lisp/edmacro.el1
-rw-r--r--lisp/emacs-lisp/bindat.el9
-rw-r--r--lisp/emacs-lisp/checkdoc.el34
-rw-r--r--lisp/emacs-lisp/edebug.el10
-rw-r--r--lisp/emacs-lisp/timer.el25
-rw-r--r--lisp/emacs-lisp/tq.el60
-rw-r--r--lisp/emulation/viper-cmd.el81
-rw-r--r--lisp/emulation/viper-ex.el8
-rw-r--r--lisp/emulation/viper-init.el5
-rw-r--r--lisp/emulation/viper-util.el27
-rw-r--r--lisp/emulation/viper.el19
-rw-r--r--lisp/erc/ChangeLog75
-rw-r--r--lisp/erc/erc-backend.el26
-rw-r--r--lisp/erc/erc-log.el41
-rw-r--r--lisp/erc/erc-match.el2
-rw-r--r--lisp/erc/erc-spelling.el14
-rw-r--r--lisp/erc/erc.el51
-rw-r--r--lisp/eshell/em-glob.el3
-rw-r--r--lisp/facemenu.el71
-rw-r--r--lisp/faces.el2
-rw-r--r--lisp/files.el20
-rw-r--r--lisp/filesets.el2
-rw-r--r--lisp/font-core.el28
-rw-r--r--lisp/font-lock.el177
-rw-r--r--lisp/format.el76
-rw-r--r--lisp/frame.el72
-rw-r--r--lisp/gnus/ChangeLog44
-rw-r--r--lisp/gnus/compface.el40
-rw-r--r--lisp/gnus/gnus-util.el11
-rw-r--r--lisp/gnus/gnus.el9
-rw-r--r--lisp/gnus/mm-extern.el2
-rw-r--r--lisp/gnus/nnheader.el20
-rw-r--r--lisp/gnus/nnweb.el11
-rw-r--r--lisp/help.el21
-rw-r--r--lisp/ido.el68
-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/jit-lock.el210
-rw-r--r--lisp/kmacro.el2
-rw-r--r--lisp/loadhist.el4
-rw-r--r--lisp/longlines.el11
-rw-r--r--lisp/mouse.el2
-rw-r--r--lisp/net/rcirc.el81
-rw-r--r--lisp/net/zone-mode.el120
-rw-r--r--lisp/newcomment.el19
-rw-r--r--lisp/pcvs-parse.el3
-rw-r--r--lisp/pcvs-util.el4
-rw-r--r--lisp/pcvs.el2
-rw-r--r--lisp/progmodes/gdb-ui.el278
-rw-r--r--lisp/progmodes/grep.el122
-rw-r--r--lisp/progmodes/gud.el10
-rw-r--r--lisp/progmodes/python.el1540
-rw-r--r--lisp/progmodes/sh-script.el13
-rw-r--r--lisp/progmodes/vhdl-mode.el6
-rw-r--r--lisp/rect.el7
-rw-r--r--lisp/simple.el34
-rw-r--r--lisp/startup.el185
-rw-r--r--lisp/t-mouse.el4
-rw-r--r--lisp/term/mac-win.el11
-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.el578
-rw-r--r--lisp/tumme.el68
-rw-r--r--lisp/url/ChangeLog17
-rw-r--r--lisp/url/url-handlers.el2
-rw-r--r--lisp/url/url-util.el42
-rw-r--r--lisp/wdired.el4
-rw-r--r--lisp/whitespace.el13
-rw-r--r--lisp/window.el7
-rw-r--r--lisp/x-dnd.el9
84 files changed, 4396 insertions, 2203 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 30aee0030ba..187f2ff3fae 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,707 @@
12006-08-27 Michael Olson <mwolson@gnu.org>
2
3 * emacs-lisp/tq.el: Small grammar fix in comments.
4 (tq-enqueue): Check for existence of queue rather than the
5 head queue item's question, which was a no-op.
6 (tq-filter, tq-process-buffer): Make sure the process buffer
7 exists before making it the current buffer.
8
92006-08-27 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
10
11 * term/mac-win.el (mac-apple-event-map): Rename hicommand to hi-command.
12 (mac-dnd-drop-data): Apply 2006-08-22 change for x-dnd-drop-data.
13 (special-event-map): Apply 2006-08-16 change for x-win.el.
14
152006-08-26 Stefan Monnier <monnier@iro.umontreal.ca>
16
17 * progmodes/python.el (python-send-receive): Wait in the
18 process's buffer so as to check the right buffer-local variables.
19
202006-08-25 Stefan Monnier <monnier@iro.umontreal.ca>
21
22 * emacs-lisp/checkdoc.el: Remove * in defcustoms.
23 (defgroup checkdoc): Move to beginning.
24
25 * progmodes/python.el (python-preoutput-skip-next-prompt): New var.
26 (python-preoutput-continuation): Remove.
27 (python-preoutput-filter): Simplify correspondingly.
28 Remove handling of _emacs_ok. Make sure we skip _emacs_out's prompts.
29 Loop around to catch embedded _emacs_out output.
30 (run-python): Send the import&print command on a single line.
31 (python-send-command): Send command&print on a single line.
32 (python-send-string): Only add double \n if needed.
33 (python-send-receive): Loop until the result comes.
34 (python-mode-running): Defvar it.
35 (python-setup-brm): Remove unused var `menu'.
36 Only bind py-mode-map and `features' around brm-init.
37 (python-calculate-indentation): Remove unused var `point'.
38 (python-beginning-of-defun): Remove unused var `def-line'.
39
402006-08-25 Richard Stallman <rms@gnu.org>
41
42 * kmacro.el (kmacro-repeat-on-last-key): Doc fix.
43
442006-08-25 Michael Kifer <kifer@cs.stonybrook.edu>
45
46 * viper.el (viper-set-hooks): Use frame bindings for
47 viper-vi-state-cursor-color.
48 (viper-non-hook-settings): Don't set default
49 mode-line-buffer-identification.
50
51 * viper-util.el (viper-set-cursor-color-according-to-state): New fun.
52 (viper-set-cursor-color-according-to-state)
53 (viper-get-saved-cursor-color-in-replace-mode)
54 (viper-get-saved-cursor-color-in-insert-mode): Make conditional on
55 viper-emacs-state-cursor-color.
56
57 * viper-cmd.el (viper-envelop-ESC-key): Bug fix.
58 (viper-undo): Use point if undo-beg-posn is nil.
59 (viper-insert-state-post-command-sentinel, viper-change-state-to-emacs)
60 (viper-after-change-undo-hook): Don't use
61 viper-emacs-state-cursor-color by default.
62 (viper-undo): More sensible positioning after undo.
63
64 * viper-ex.el (ex-splice-args-in-1-letr-cmd): Get rid of caddr.
65 (viper-emacs-state-cursor-color): Default to nil, since this feature
66 doesn't work well yet.
67
68 * ediff-mult.el (ediff-intersect-directories)
69 (ediff-get-directory-files-under-revision, ediff-dir-diff-copy-file):
70 always expand filenames.
71
722006-08-24 Stefan Monnier <monnier@iro.umontreal.ca>
73
74 * tumme.el: Remove * in defcustoms's docstrings.
75
762006-08-24 Chong Yidong <cyd@stupidchicken.com>
77
78 * emacs-lisp/timer.el (timer-set-idle-time, run-with-idle-timer):
79 Accept internal time format for SECS arg.
80 (timer-relative-time): Doc fix.
81
82 * jit-lock.el: "Stealth fontification by requeuing timers" patch,
83 adapted from Martin Rudalics.
84 (jit-lock-stealth-repeat-timer, jit-lock-stealth-buffers): New vars.
85 (jit-lock-mode): Create jit-lock-stealth-repeat-timer.
86 (jit-lock-stealth-fontify): Reschedule as a idle timer instead of
87 using sit-for.
88
892006-08-24 Francesc Rocher <francesc.rocher@gmail.com>
90
91 * cus-start.el (all): Add `overline-margin' and
92 `x-underline-at-descent-line'.
93
942006-08-24 Kim F. Storm <storm@cua.dk>
95
96 * progmodes/grep.el (grep-find-use-xargs): Use explicit value `exec'
97 to mean "use find -exec"; nil now unambiguously means auto-detect.
98 (grep-compute-defaults): Set grep-find-use-xargs to `exec' if not `gnu'.
99 Use shell-quote-argument to build grep-find-command and grep-find-template.
100 (rgrep): Use shell-quote-argument to properly quote arguments to find.
101 Reported by Tom Seddon.
102
1032006-08-23 Chong Yidong <cyd@stupidchicken.com>
104
105 * startup.el (fancy-splash-head): Give instructions for dismissing
106 the splash screen for default startup too.
107 (display-startup-echo-area-message, fancy-splash-screens)
108 (use-fancy-splash-screens-p): New arg hide-on-input. If nil, show
109 all splash text at once and keep the splash buffer around.
110 (command-line-1): Give display-startup-echo-area-message a t arg.
111
1122006-08-23 Carsten Dominik <dominik@science.uva.nl>
113
114 * textmodes/org.el (org-follow-gnus-link): Make sure the dedicated
115 gnus frame is selected.
116
1172006-08-23 Nick Roberts <nickrob@snap.net.nz>
118
119 * progmodes/gdb-ui.el (gdb-starting): Reset gdb-signalled to nil.
120
1212006-08-22 Kim F. Storm <storm@cua.dk>
122
123 * ido.el (ido-set-matches-1): Fix full matching for subdirs.
124 Add suffix matching for subdirs.
125
1262006-08-22 Jorgen Schaefer <forcer@forcix.cx> (tiny change)
127
128 * x-dnd.el (x-dnd-drop-data): Don't call goto-char if
129 mouse-yank-at-point is non-nil.
130
1312006-08-22 Nick Roberts <nickrob@snap.net.nz>
132
133 * progmodes/gdb-ui.el (gdb-frame-memory-buffer): Make frame
134 a bit wider and remove fringes to fit initial output on line.
135
1362006-08-21 Stefan Monnier <monnier@iro.umontreal.ca>
137
138 * frame.el (blink-cursor-end): Only ignore the error we care about.
139 (blink-cursor-mode): Use blink-cursor-end to simplify the code.
140
1412006-08-21 Richard Stallman <rms@gnu.org>
142
143 * whitespace.el (whitespace-cleanup): Doc fix.
144
1452006-08-20 Ryan Yeske <rcyeske@gmail.com>
146
147 * net/rcirc.el (rcirc-show-maximum-output): New var.
148 (rcirc-buffer-process): If no buffer argument is supplied, use
149 current-buffer.
150 (rcirc-complete-nick): Complete to the last completed nick first.
151 (rcirc-mode): Preserve the value of `rcirc-urls' across
152 connections. Setup scroll function.
153 (rcirc-scroll-to-bottom): New function.
154 (rcirc-print): Use nick syntax around regexp work.
155 Notice dim-nicks speaking only if they say our nick.
156 (rcirc-update-activity-string): Do not show the modeline indicator
157 if there are no live rcirc processes.
158 (rcirc-cmd-ignore): Ignore case.
159 (rcirc-browse-url-at-point): Fix off-by-one error.
160
1612006-08-20 Stefan Monnier <monnier@iro.umontreal.ca>
162
163 * progmodes/python.el: Remove * in defcustom docstrings.
164 (run-python, python-proc, python-try-complete): Use derived-mode-p.
165 (python-mode): Set tab-width and indent-tabs-mode.
166
1672006-08-20 Dave Love <fx@gnu.org>
168
169 * progmodes/python.el: Update to Dave Love's latest version.
170 (python-font-lock-keywords, python-mode): Don't use
171 font-lock-syntax-table, but match symbol elements explicitly instead.
172 (python-mode-map): Add help, and a few more key bindings.
173 (python-skip-comments/blanks): Move out of comments as well.
174 (python-continuation-line-p): Behave better with unbalanced parens.
175 (python-blank-line-p): New fun.
176 (python-open-block-statement-p): Don't use a heuristic.
177 (python-outdent-p): Better handle blocks-in-the-same-line.
178 (python-calculate-indentation): Misc improvements.
179 (python-comment-indent): Remove.
180 (python-block-pairs): New var.
181 (python-first-word): New fun.
182 (python-indentation-levels): Handle more common cases.
183 (python-indent-line-1): Add `leave' argument.
184 (python-indent-region): New fun.
185 (python-skip-out): New fun.
186 (python-beginning-of-statement, python-end-of-statement): Use it.
187 (python-next-statement): Return correct count even at eob.
188 (python-end-of-block): Fix paren-typo.
189 (python-imenu-create-index): Add module variables.
190 (run-python): Add `new' arg.
191 Check we're at a prompt before returning.
192 (python-send-command): Move to end of buffer.
193 Wait for prompt to return.
194 (python-set-proc): New fun.
195 (python-imports): New var.
196 (python-describe-symbol): Use it. Adjust to new interface of `ehelp'.
197 (python-eldoc-function): Try to move out of arg list.
198 (python-outline-level): Offset by 1.
199 (python-find-imports): New fun.
200 (python-symbol-completions): Use python-imports.
201 (python-module-path, ffap-alist): Add support for ffap.
202 (python-skeletons, python-mode-abbrev-table, def-python-skeleton)
203 (pythin-insert-*, python-default-template, python-expand-template):
204 Add templates/skeletons.
205 (python-setup-brm): Support for Bicycle Repair Man.
206 (python-abbrev-syntax-table): New var.
207 (python-abbrev-pc-hook, python-pea-hook): New funs.
208
2092006-08-20 Chong Yidong <cyd@stupidchicken.com>
210
211 * frame.el (blink-cursor-start): Set timer first.
212 (blink-cursor-end): Ignore timer cancelling errors.
213 Suggested by Ken Manheimer.
214
2152006-08-20 Juanma Barranquero <lekktu@gmail.com>
216
217 * newcomment.el (comment-box): Call `comment-normalize-vars'.
218 Add autoload cookie.
219
2202006-08-20 Richard Stallman <rms@gnu.org>
221
222 * simple.el (line-number-at-pos): Doc fix.
223
224 * emacs-lisp/timer.el (run-with-idle-timer): Pass t to
225 timer-activate-when-idle, so timer can run before Emacs becomes
226 non-idle again.
227
2282006-08-18 Yoni Rabkin Katzenell <yoni-r@actcom.com> (tiny change)
229
230 * whitespace.el (whitespace-cleanup-internal): New optional arg
231 REGION-ONLY. If it's non-nil, modify the message to the user
232 accordingly.
233 (whitespace-cleanup-region): Call whitespace-cleanup-internal with
234 a non-nil argument.
235
2362006-08-18 Gustav H,Ae(Bllberg <gustav@gmail.com> (tiny change)
237
238 * rect.el (spaces-string): Simplify and add doc string.
239
2402006-08-17 Romain Francoise <romain@orebokech.com>
241
242 * progmodes/gdb-ui.el (gdb-edit-locals-value): Balance parens.
243
2442006-08-17 Richard Stallman <rms@gnu.org>
245
246 * compare-w.el (compare-windows): lambda's take an arg and pass
247 it to compare-windows-skip-whitespace.
248
2492006-08-17 Martin Rudalics <rudalics@gmx.at>
250
251 * jit-lock.el (jit-lock-fontify-now): Protect the modified status of
252 the right buffer.
253
2542006-08-17 Stefan Monnier <monnier@iro.umontreal.ca>
255
256 * pcvs-parse.el (cvs-parse-table): Accept the new `...' format for
257 removed files.
258
2592006-08-17 Nick Roberts <nickrob@snap.net.nz>
260
261 * progmodes/gdb-ui.el (gdb-locals-watch-map)
262 (gdb-locals-watch-map-1): Suppress keymap first.
263 (gdb-edit-locals-map-1): New variable.
264 (gdb-edit-locals-value): New function.
265 (gdb-stack-list-locals-handler): Use them.
266
2672006-08-16 Stefan Monnier <monnier@iro.umontreal.ca>
268
269 * mouse.el (global-map): Allow yanking with mouse-2 at a spot whose
270 cursor would normally be drawn in the fringe.
271
272 * font-lock.el (font-lock-extend-region-wholelines): Fix up typo.
273 Reported by Martin Rudalics <rudalics@gmx.at>.
274
2752006-08-16 Richard Stallman <rms@gnu.org>
276
277 * term/x-win.el (x-clipboard-yank): Specify * in interactive spec.
278 (special-event-map): Process drag-n-drop events this way.
279
280 * simple.el (move-beginning-of-line): Test whether fields
281 would prevent motion back to line's first visible character.
282 If so, stop where the fields would stop the motion.
283
284 * newcomment.el (comment-indent): Fully update INDENT
285 before checking to see if it will change the text.
286
287 * cus-edit.el (custom-newline): New function.
288 (custom-mode-map): Bind newline to custom-newline.
289
290 * compare-w.el (compare-windows): Factor compare-ignore-whitespace
291 into ignore-whitespace.
292 Check each buffer for its skip-function.
293 Handle compare-windows-skip-whitespace special-case test
294 by returning t from default skip function.
295
2962006-08-15 Carsten Dominik <dominik@science.uva.nl>
297
298 * textmodes/org.el (org-clock-special-range)
299 (org-clock-update-time-maybe): New functions.
300 (org-stamp-time-of-day-regexp): Allow weekday to be of word chars,
301 not only a-z.
302 (org-agenda-get-blocks): Allow multiple blocks per headline.
303 (org-timestamp-change): Call `org-clock-update-time-maybe'.
304 (org-export-html-title-format)
305 (org-export-html-toplevel-hlevel): New options.
306 (org-export-language-setup): Add support for Czech.
307 (org-mode, org-insert-todo-heading, org-find-visible)
308 (org-find-invisible, org-invisible-p, org-invisible-p2)
309 (org-back-to-heading, org-on-heading-p, org-up-heading-all)
310 (org-show-subtree, org-show-entry, org-make-options-regexp):
311 Remove compatibility support for old outline-mode.
312 (org-check-occur-regexp): Funtion removed.
313 (org-on-heading-p, org-back-to-heading): Made defalias.
314 (org-set-local): New defsubst.
315 (org-set-regexps-and-options, org-mode)
316 (org-set-font-lock-defaults, org-edit-agenda-file-list)
317 (org-timeline, org-agenda-list, org-todo-list, org-tags-view)
318 (org-remember-apply-template, org-table-edit-field)
319 (org-table-edit-formulas, orgtbl-mode, org-export-as-ascii)
320 (org-set-autofill-regexps): Use `org-set-local'.
321 (org-table-eval-formula): Fix bug with parsing of display flags.
322
3232006-08-15 Nick Roberts <nickrob@snap.net.nz>
324
325 * progmodes/gdb-ui.el (gdb-info-stack-custom): Indicate selected
326 frame with fringe arrow. Suggested by Simon Marshall
327 <simon.marshall@misys.com>.
328 (gdb-stack-position): New variable.
329 (gdb-starting, gdb-exited): Reset gdb-stack-position to nil.
330 (gdb-frames-mode): Set gdb-stack-position to nil.
331 Add to overlay-arrow-variable-list
332 (gdb-reset): Delete gdb-stack-position from above list.
333
3342006-08-14 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
335
336 * term/x-win.el (menu-bar-edit-menu): Disable paste if buffer is
337 read only.
338
3392006-08-13 Romain Francoise <romain@orebokech.com>
340
341 * cus-theme.el (customize-create-theme)
342 (custom-theme-visit-theme): End `y-or-n-p' prompt with a space.
343
344 * filesets.el (filesets-add-buffer): Ditto.
345
346 * pcvs.el (cvs-change-cvsroot): Ditto.
347
3482006-08-13 Nick Roberts <nickrob@snap.net.nz>
349
350 * progmodes/gdb-ui.el (gdb-frame-separate-io-buffer)
351 (gdb-use-separate-io-buffer, menu): Avoid using `inferior' in text.
352 (gdb-memory-mode, gdb-locals-watch-map): Don't quote lambda
353 expressions.
354 (gdb-info-breakpoints-custom): Use gdb-breakpoint-regexp.
355 Only search till end of line.
356 Add face to function names in case of no filename.
357 Add face to variable names of watchpoints.
358
3592006-08-12 Robert Thorpe <rthorpe@realworldtech.com> (tiny change)
360
361 * cus-start.el <indent-tabs-mode>: Move to the `indent'
362 customization group.
363
3642006-08-12 Ken Manheimer <ken.manheimer@gmail.com>
365
366 * allout.el (allout-prior-bindings, allout-added-bindings):
367 Remove, after long deprecation.
368 (allout-beginning-of-line-cycles, allout-end-of-line-cycles):
369 Add customization vars controlling allout-beginning-of-line and
370 allout-end-of-line conveniences.
371 (allout-header-prefix, allout-use-mode-specific-leader)
372 (allout-use-mode-specific-leader, allout-mode-leaders):
373 Revise docstrings.
374 (allout-infer-header-lead): Change to be an alias for
375 allout-infer-header-lead-and-primary-bullet.
376 (allout-infer-header-lead-and-primary-bullet): New version of
377 allout-infer-header-lead which assigns the primary bullet to the
378 same as the header lead, when its being changed.
379 (allout-infer-body-reindent): Apply regexp-quote instead of
380 unconditionally prepending "\\", so that all literal
381 allout-header-prefix and allout-primary-bullet strings are
382 properly handled.
383 (allout-add-resumptions): Add optional qualifier for extending or
384 appending to existing values, rather than replacing them.
385 (allout-view-change-hook): Clarify docstring.
386 (allout-exposure-change-hook): Take explicit arguments, via
387 run-hook-with-args.
388 (allout-structure-added-hook)
389 (allout-structure-deleted-hook)
390 (allout-structure-shifted-hook): New hooks analogous to
391 allout-exposure-change-hook for other kinds of structural outline
392 edits.
393 (allout-encryption-plaintext-sanitization-regexps): New encryption
394 customization variable, by which cooperating modes can provde
395 massage of the plaintext without actually being passed it.
396 (allout-encryption-ciphertext-rejection-regexps)
397 (allout-encryption-ciphertext-rejection-ceiling): New encryption
398 customization variables, by which cooperating modes can prohibit
399 rare but possible ciphertext patterns from fouling their
400 operation, with actually being passed the ciphertext.
401 (allout-mode): Run activation and deactivation hooks after the
402 minor-mode variable has been toggled, to clarify the mode
403 disposition. The new encryption ciphertext rejection variable is
404 used to ensure that the ciphertext does not contain text that
405 would be recognized as outline structural elements by allout.
406 Substite allout-beginning-of-line and allout-end-of-line for
407 conventionall beginning-of-line and end-of-line bindings.
408 If allout-old-style-prefixes is non-nil, don't nullify it on mode
409 activation!
410 (allout-beginning-of-line): Respect `allout-beginning-of-line-cycles'.
411 (allout-end-of-line): Respect `allout-end-of-line-cycles'.
412 (allout-chart-subtree): Implement new mode, charting only the
413 visible items in the subtree, when new 'visible' parameter is non-nil.
414 (allout-end-of-subtree): Properly handle the last item in the buffer.
415 (allout-pre-command-business, allout-command-counter):
416 Increment an advertised counter so that cooperating enhancements can
417 track revisions of items.
418 (allout-open-topic): Run allout-structure-added-hook with suitable
419 arguments.
420 (allout-shift-in): Run allout-structure-shifted-hook with suitable
421 arguments.
422 (allout-shift-out): Fix doubling for negative args and ensure call
423 of allout-structure-shifted-hook by solely using allout-shift-in.
424 (allout-kill-line, allout-kill-topic):
425 Run allout-structure-deleted-hook with suitable arguments.
426 (allout-yank-processing): Run allout-structure-added-hook with
427 proper arguments.
428 (allout-yank): Enclose activity in allout-unprotected.
429 (allout-flag-region): Run allout-exposure-change-hook with
430 suitable arguments, instead of making the callee infer the arguments.
431 (allout-encrypt-string):
432 Support allout-encryption-plaintext-sanitization-regexps,
433 allout-encryption-ciphertext-rejection-regexps, and
434 allout-encryption-ciphertext-rejection-ceiling. Indicate correct
435 en/de cryption mode in symmetric encryption failure message.
436 (allout-obtain-passphrase): Use copy-sequence to get a distinct
437 copy of the passphrase, and don't zero it or we'll corrupt the
438 stashed copy.
439 (allout-create-encryption-passphrase-verifier)
440 (allout-verify-passphrase): Respect the new signature for
441 allout-encrypt-string.
442 (allout-get-configvar-values): Convenience for getting a
443 configuration variable value and handling its absence gracefully.
444
4452006-08-11 Romain Francoise <romain@orebokech.com>
446
447 * obsolete/zone-mode.el: Delete.
448
4492006-08-11 Stefan Monnier <monnier@iro.umontreal.ca>
450
451 * textmodes/dns-mode.el (dns-mode): Use before-save-hook.
452
4532006-08-11 Thien-Thi Nguyen <ttn@gnu.org>
454
455 * emacs-lisp/bindat.el (bindat-ip-to-string):
456 Use `format-network-address' if possible.
457
4582006-08-11 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
459
460 * x-dnd.el (x-dnd-init-frame): Call x-register-dnd-atom.
461
4622006-08-10 Chong Yidong <cyd@stupidchicken.com>
463
464 * emacs-lisp/edebug.el (edebug-recursive-edit): Don't save and
465 restore unread-command-events here.
466 (edebug-display): Do it here, to detect sit-for interruptions.
467
4682006-08-10 Romain Francoise <romain@orebokech.com>
469
470 * textmodes/dns-mode.el: Alias `zone-mode' to `dns-mode'.
471 (dns-mode-soa-auto-increment-serial): New user option.
472 (dns-mode-soa-maybe-increment-serial): New function.
473 (dns-mode): Add the latter to `write-contents-functions'.
474
475 * obsolete/zone-mode.el: Move to obsolete/ from net/.
476 Delete autoload cookies.
477
4782006-08-10 John Wiegley <johnw@newartisans.com>
479
480 * eshell/em-glob.el (eshell-glob-chars-list)
481 (eshell-glob-translate-alist): Add support for [^g] in character globs.
482
4832006-08-10 Richard Stallman <rms@gnu.org>
484
485 * facemenu.el (facemenu-add-face): Pass frame to facemenu-active-faces.
486 (facemenu-set-face): Doc fix.
487 (facemenu-listed-faces): Doc fix.
488
4892006-08-09 Chong Yidong <cyd@stupidchicken.com>
490
491 * avoid.el (mouse-avoidance-animating-pointer): New var.
492 (mouse-avoidance-nudge-mouse): Use it.
493 (mouse-avoidance-banish): Rename from mouse-avoidance-banish-hook.
494 (mouse-avoidance-exile): Rename from mouse-avoidance-exile-hook
495 (mouse-avoidance-fancy): Rename from mouse-avoidance-fancy-hook.
496 Don't activate if currently animating. All callers changed.
497
4982006-08-09 John Wiegley <johnw@newartisans.com>
499
500 * calendar/timeclock.el (timeclock-use-elapsed): Added a new
501 variable, which causes timeclock to report elapsed time worked,
502 instead of just work remaining.
503
5042006-08-09 Kenichi Handa <handa@m17n.org>
505
506 * international/latexenc.el (latexenc-find-file-coding-system):
507 Fix for the case that the 2nd element of arg-list is a cons.
508
5092006-08-08 Chong Yidong <cyd@stupidchicken.com>
510
511 * info.el (Info-fontify-node): Handle preceding `in' for note
512 reference hiding rules.
513
5142006-08-08 Stefan Monnier <monnier@iro.umontreal.ca>
515
516 * progmodes/sh-script.el (sh-quoted-subshell): Make sure we don't
517 mistake a closing " for an opening one.
518
5192006-08-07 Dan Nicolaescu <dann@ics.uci.edu>
520
521 * term/xterm.el (terminal-init-xterm): Add more key bindings.
522
5232006-08-07 Stefan Monnier <monnier@iro.umontreal.ca>
524
525 * complete.el (PC-do-completion): Filter out completions matching
526 completion-ignored-extensions before checking whether there are
527 multiple completions.
528 Don't use `list' unnecessarily when building completion tables.
529
5302006-08-06 Richard Stallman <rms@gnu.org>
531
532 * help.el (describe-mode): Make minor mode list more concise.
533
5342006-08-05 Chong Yidong <cyd@stupidchicken.com>
535
536 * bindings.el: Give mode-line-format, mode-line-modes, and
537 mode-line-position `standard-value' properties.
538
5392006-08-05 Eli Zaretskii <eliz@gnu.org>
540
541 * buff-menu.el (list-buffers-noselect): For Info buffers, use
542 "(file)node" instead of the file name.
543
5442006-08-05 Richard Stallman <rms@gnu.org>
545
546 * faces.el (escape-glyph): Doc fix.
547
5482006-08-04 Kenichi Handa <handa@m17n.org>
549
550 * international/mule-diag.el (describe-font): Improve docstring
551 and error message. Use frame-parameter (not frame-parameters).
552
5532006-08-03 Stefan Monnier <monnier@iro.umontreal.ca>
554
555 * progmodes/gud.el (gdb-script-font-lock-syntactic-keywords):
556 Correctly mark the end-of-docstring char.
557
5582006-08-03 Chong Yidong <cyd@stupidchicken.com>
559
560 * simple.el (line-move-to-column): Constrain move-to-column to
561 current field.
562
5632006-08-03 Stefan Monnier <monnier@iro.umontreal.ca>
564
565 * font-lock.el (font-lock-beg, font-lock-end)
566 (font-lock-extend-region-functions): New vars.
567 (font-lock-extend-region-multiline)
568 (font-lock-extend-region-wholelines): New functions.
569 (font-lock-default-fontify-region): Use them.
570 (font-lock-extend-jit-lock-region-after-change): Only round up
571 if font-lock-default-fontify-region will do it as well.
572
573 * font-lock.el (font-lock-extend-after-change-region-function):
574 Rename from font-lock-extend-region-function.
575 (font-lock-extend-region): Remove by inlining at call sites.
576 (font-lock-after-change-function): Don't needlessly round up to a whole
577 number of lines.
578 (font-lock-extend-jit-lock-region-after-change): Be more careful about
579 the boundary conditions and the interactions between the various ways
580 to extend the region.
581
5822006-08-02 Stefan Monnier <monnier@iro.umontreal.ca>
583
584 * jit-lock.el (jit-lock-fontify-now): Preserve the buffer's
585 modification status when forcing the second redisplay.
586
5872006-08-03 Kim F. Storm <storm@cua.dk>
588
589 * edmacro.el (edmacro-fix-menu-commands): Ignore switch-frame.
590
5912006-08-02 Stefan Monnier <monnier@iro.umontreal.ca>
592
593 * pcvs-util.el (cvs-get-buffer-create): Obey `noreuse' even if `name'
594 doesn't look like a file name.
595
596 * complete.el (PC-expand-many-files): Avoid signalling an error when
597 the current directory doesn't exist. Reported by Micha,Ak(Bl Cadilhac.
598
5992006-08-02 Andreas Schwab <schwab@suse.de>
600
601 * bindings.el (mode-line-format): Simplify reference to vc-mode.
602
6032006-08-02 Nick Roberts <nickrob@snap.net.nz>
604
605 * bindings.el (map): Make mode-line-buffer-identification-keymap
606 before defining propertized-buffer-identification.
607
6082006-08-01 Richard Stallman <rms@gnu.org>
609
610 * bindings.el (mode-line-format): Adjust spacing around vc-mode.
611
6122006-08-02 Nick Roberts <nickrob@snap.net.nz>
613
614 * progmodes/gdb-ui.el (gdb-find-source-frame): Make nil the
615 default value.
616 (gdb-find-source-frame): New function.
617 (menu): Add to menu bar.
618
6192006-08-01 Stefan Monnier <monnier@iro.umontreal.ca>
620
621 * font-core.el (font-lock-extend-region-function)
622 (font-lock-extend-region): Move to font-lock.el.
623
624 * font-lock.el (font-lock-extend-region-function)
625 (font-lock-extend-region): Move from font-core.el. Simplify.
626
627 * jit-lock.el (jit-lock-fontify-now): Cause a second redisplay
628 if needed.
629 (jit-lock-start, jit-lock-end): New dynamic scoped vars.
630 (jit-lock-after-change-extend-region-functions): New hook.
631 (jit-lock-after-change): Use it instead of hard-coding font-lock code.
632
633 * font-lock.el (font-lock-extend-jit-lock-region-after-change): New fun.
634 (font-lock-turn-on-thing-lock): Use it.
635
636 * longlines.el (longlines-show-region): Make it work on read-only
637 buffers as well.
638
6392006-08-01 Nick Roberts <nickrob@snap.net.nz>
640
641 * progmodes/gdb-ui.el (gdb-set-hollow): Check for gud-last-last-frame.
642
6432006-07-31 Richard Stallman <rms@gnu.org>
644
645 * progmodes/vhdl-mode.el (vhdl-speedbar-display-directory)
646 (vhdl-speedbar-display-projects): Update old obsolete
647 speedbar variable names.
648
6492006-07-31 Nick Roberts <nickrob@snap.net.nz>
650
651 * progmodes/gdb-ui.el (gdb-find-source-frame): New option.
652 (gdb-stopped): Use it.
653
654 * t-mouse.el (t-mouse-mode): Use set-process-query-on-exit-flag.
655
6562006-07-29 Chong Yidong <cyd@stupidchicken.com>
657
658 * loadhist.el (unload-feature): Handle new `(t . SYMBOL)' format
659 for load-history elements.
660
6612006-07-29 Eli Zaretskii <eliz@gnu.org>
662
663 * files.el (convert-standard-filename): For Cygwin, replace
664 characters not allowed in Windows file names.
665 (make-auto-save-file-name): Add Cygwin to the list of systems
666 where the auto-save file name needs to be run through
667 convert-standard-filename.
668
6692006-07-29 Lennart Borgman <lennart.borgman.073@student.lu.se>
670
671 * window.el (bw-get-tree): Don't integerp subtree if it's nil.
672
6732006-07-28 Richard Stallman <rms@gnu.org>
674
675 * bindings.el (mode-line-frame-identification)
676 (propertized-buffer-identification): Centralize the code
677 to initialize the variable.
678
679 * progmodes/grep.el (grep-default-command): Catch errors from
680 wildcard-to-regexp.
681
6822006-07-29 Kim F. Storm <storm@cua.dk>
683
684 * progmodes/grep.el (grep-tag-default): New function.
685 (grep-default-command, grep-read-regexp): Use it.
686 (grep-read-files): Use car of grep-files-history or grep-files-aliases
687 as default if nothing else applies.
688
6892006-07-28 Bill Atkins <atkinw@rpi.edu> (tiny change)
690
691 * wdired.el (wdired-change-to-wdired-mode, wdired-change-to-dired-mode):
692 Throw error if buffer is not in Dired and Wdired mode, respectively.
693
6942006-07-28 Chong Yidong <cyd@stupidchicken.com>
695
696 * cus-edit.el (custom-no-edit): Revert 2006-07-27 change, so that
697 self-insert-command keys don't activate buttons.
698 (custom-mode-map): Just don't bind "\C-m" to `custom-no-edit'.
699
7002006-07-29 Nick Roberts <nickrob@snap.net.nz>
701
702 * progmodes/gdb-ui.el (gdb-info-breakpoints-custom): Use different
703 faces for enable character.
704
12006-07-28 Nick Roberts <nickrob@snap.net.nz> 7052006-07-28 Nick Roberts <nickrob@snap.net.nz>
2 706
3 * Makefile.in (recompile): Update comment to reflect change 707 * Makefile.in (recompile): Update comment to reflect change
@@ -31,9 +735,9 @@
31 735
322006-07-26 Mathias Dahl <mathias.dahl@gmail.com> 7362006-07-26 Mathias Dahl <mathias.dahl@gmail.com>
33 737
34 * tumme.el (tumme-backward-image): Add prefix argument. Add error 738 * tumme.el (tumme-backward-image): Add prefix argument. Add error
35 when at first image. 739 when at first image.
36 (tumme-forward-image): Add prefix argument. Add error when at last 740 (tumme-forward-image): Add prefix argument. Add error when at last
37 image. 741 image.
38 742
392006-07-25 Stefan Monnier <monnier@iro.umontreal.ca> 7432006-07-25 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -45,10 +749,10 @@
45 749
46 * tumme.el (tumme-track-original-file): Add `buffer-live-p' check. 750 * tumme.el (tumme-track-original-file): Add `buffer-live-p' check.
47 (tumme-format-properties-string): Handle empty `buf'. 751 (tumme-format-properties-string): Handle empty `buf'.
48 (tumme-get-comment): Change variable names inside `let'. Add 752 (tumme-get-comment): Change variable names inside `let'.
49 missing `let' variable that cause font-lock problems. 753 Add missing `let' variable that cause font-lock problems.
50 (tumme-write-comments): Change variable names inside `let'. Add 754 (tumme-write-comments): Change variable names inside `let'.
51 missing `let' variable that cause font-lock problems. 755 Add missing `let' variable that cause font-lock problems.
52 (tumme-forward-image): Rename from `tumme-forward-char'. 756 (tumme-forward-image): Rename from `tumme-forward-char'.
53 (tumme-backward-image): Rename from `tumme-backward-char'. 757 (tumme-backward-image): Rename from `tumme-backward-char'.
54 758
@@ -97,8 +801,8 @@
972006-07-24 Daiki Ueno <ueno@unixuser.org> 8012006-07-24 Daiki Ueno <ueno@unixuser.org>
98 802
99 * pgg-def.el (pgg-truncate-key-identifier): Truncate the key ID to 8 803 * pgg-def.el (pgg-truncate-key-identifier): Truncate the key ID to 8
100 letters from the end. Thanks to "David Smith" <davidsmith@acm.org> and 804 letters from the end. Thanks to "David Smith" <davidsmith@acm.org>
101 andreas@altroot.de (Andreas V,Av(Bgele) 805 and andreas@altroot.de (Andreas V,Av(Bgele).
102 806
1032006-07-23 Thien-Thi Nguyen <ttn@gnu.org> 8072006-07-23 Thien-Thi Nguyen <ttn@gnu.org>
104 808
@@ -137,7 +841,7 @@
1372006-07-21 Dan Nicolaescu <dann@ics.uci.edu> 8412006-07-21 Dan Nicolaescu <dann@ics.uci.edu>
138 842
139 * term/xterm.el (terminal-init-xterm): Fix key bindings 843 * term/xterm.el (terminal-init-xterm): Fix key bindings
140 syntax. Bind S-return, C-M-., C-TAB, S-TAB and C-S-TAB. 844 syntax. Bind S-return, C-M-., C-TAB, S-TAB and C-S-TAB.
141 845
1422006-07-21 Eli Zaretskii <eliz@gnu.org> 8462006-07-21 Eli Zaretskii <eliz@gnu.org>
143 847
@@ -173,7 +877,7 @@
173 877
174 * calc.el (calc-previous-alg-entry): Remove variable. 878 * calc.el (calc-previous-alg-entry): Remove variable.
175 879
176 * calc-aent.el (calc-alg-entry-history, calc-quick-calc-history): 880 * calc-aent.el (calc-alg-entry-history, calc-quick-calc-history):
177 New variables. 881 New variables.
178 (calc-alg-entry): Use `calc-alg-entry-history'. 882 (calc-alg-entry): Use `calc-alg-entry-history'.
179 (calc-do-quick-calc): Use `calc-quick-calc-history'. 883 (calc-do-quick-calc): Use `calc-quick-calc-history'.
@@ -497,8 +1201,8 @@
497 1201
4982006-07-10 Chong Yidong <cyd@stupidchicken.com> 12022006-07-10 Chong Yidong <cyd@stupidchicken.com>
499 1203
500 * progmodes/cc-awk.el (defconst): Use eval-and-compile to avoid 1204 * progmodes/cc-awk.el (c-awk-escaped-nls*): Use eval-and-compile to
501 compilation error. 1205 avoid compilation error.
502 1206
503 * subr.el (sit-for): New function. 1207 * subr.el (sit-for): New function.
504 1208
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 eea9184cee4..9671bf26f25 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -215,14 +215,6 @@ mnemonics of the following coding systems:
215 215
216(make-variable-buffer-local 'mode-line-mule-info) 216(make-variable-buffer-local 'mode-line-mule-info)
217 217
218(defvar mode-line-buffer-identification (purecopy '("%12b")) "\
219Mode-line control for identifying the buffer being displayed.
220Its default value is (\"%12b\").
221Major modes that edit things other than ordinary files may change this
222\(e.g. Info, Dired,...)")
223
224(make-variable-buffer-local 'mode-line-buffer-identification)
225
226(defvar mode-line-frame-identification '(window-system " " "-%F ") 218(defvar mode-line-frame-identification '(window-system " " "-%F ")
227 "Mode-line control to describe the current frame.") 219 "Mode-line control to describe the current frame.")
228 220
@@ -294,56 +286,102 @@ Keymap to display on minor modes.")
294 ;; mouse-1: select window, mouse-2: delete others, mouse-3: delete, 286 ;; mouse-1: select window, mouse-2: delete others, mouse-3: delete,
295 ;; drag-mouse-1: resize, C-mouse-2: split horizontally" 287 ;; drag-mouse-1: resize, C-mouse-2: split horizontally"
296 "mouse-1: select (drag to resize), mouse-2: delete others, mouse-3: delete this") 288 "mouse-1: select (drag to resize), mouse-2: delete others, mouse-3: delete this")
297 (dashes (propertize "--" 'help-echo help-echo))) 289 (dashes (propertize "--" 'help-echo help-echo))
298 (setq-default mode-line-format 290 (standard-mode-line-format
299 (list 291 (list
300 "%e" 292 "%e"
301 (propertize "-" 'help-echo help-echo) 293 (propertize "-" 'help-echo help-echo)
302 'mode-line-mule-info 294 'mode-line-mule-info
303 'mode-line-client 295 'mode-line-client
304 'mode-line-modified 296 'mode-line-modified
305 'mode-line-frame-identification 297 'mode-line-frame-identification
306 'mode-line-buffer-identification 298 'mode-line-buffer-identification
307 (propertize " " 'help-echo help-echo) 299 (propertize " " 'help-echo help-echo)
308 'mode-line-position 300 'mode-line-position
309 `(vc-mode ("" vc-mode ,(propertize " " 'help-echo help-echo))) 301 '(vc-mode vc-mode)
310 'mode-line-modes 302 (propertize " " 'help-echo help-echo)
311 `(which-func-mode ("" which-func-format ,dashes)) 303 'mode-line-modes
312 `(global-mode-string (,dashes global-mode-string)) 304 `(which-func-mode ("" which-func-format ,dashes))
313 (propertize "-%-" 'help-echo help-echo))) 305 `(global-mode-string (,dashes global-mode-string))
314 306 (propertize "-%-" 'help-echo help-echo)))
315 (setq-default mode-line-modes 307 (standard-mode-line-modes
316 (list 308 (list
317 (propertize "%[(" 'help-echo help-echo) 309 (propertize "%[(" 'help-echo help-echo)
318 `(:propertize ("" mode-name) 310 `(:propertize ("" mode-name)
319 help-echo "mouse-1: major mode, mouse-2: major mode help, mouse-3: toggle minor modes" 311 help-echo "mouse-1: major mode, mouse-2: major mode help, mouse-3: toggle minor modes"
320 mouse-face mode-line-highlight 312 mouse-face mode-line-highlight
321 local-map ,mode-line-major-mode-keymap) 313 local-map ,mode-line-major-mode-keymap)
322 '("" mode-line-process) 314 '("" mode-line-process)
323 `(:propertize ("" minor-mode-alist) 315 `(:propertize ("" minor-mode-alist)
324 mouse-face mode-line-highlight 316 mouse-face mode-line-highlight
325 help-echo "mouse-2: minor mode help, mouse-3: toggle minor modes" 317 help-echo "mouse-2: minor mode help, mouse-3: toggle minor modes"
326 local-map ,mode-line-minor-mode-keymap) 318 local-map ,mode-line-minor-mode-keymap)
327 (propertize "%n" 'help-echo "mouse-2: widen" 319 (propertize "%n" 'help-echo "mouse-2: widen"
328 'mouse-face 'mode-line-highlight 320 'mouse-face 'mode-line-highlight
329 'local-map (make-mode-line-mouse-map 321 'local-map (make-mode-line-mouse-map
330 'mouse-2 #'mode-line-widen)) 322 'mouse-2 #'mode-line-widen))
331 (propertize ")%]--" 'help-echo help-echo))) 323 (propertize ")%]--" 'help-echo help-echo)))
332 324
333 (setq-default mode-line-position 325 (standard-mode-line-position
334 `((-3 ,(propertize "%p" 'help-echo help-echo)) 326 `((-3 ,(propertize "%p" 'help-echo help-echo))
335 (size-indication-mode 327 (size-indication-mode
336 (8 ,(propertize " of %I" 'help-echo help-echo))) 328 (8 ,(propertize " of %I" 'help-echo help-echo)))
337 (line-number-mode 329 (line-number-mode
338 ((column-number-mode 330 ((column-number-mode
339 (10 ,(propertize " (%l,%c)" 'help-echo help-echo)) 331 (10 ,(propertize " (%l,%c)" 'help-echo help-echo))
340 (6 ,(propertize " L%l" 'help-echo help-echo)))) 332 (6 ,(propertize " L%l" 'help-echo help-echo))))
341 ((column-number-mode 333 ((column-number-mode
342 (5 ,(propertize " C%c" 'help-echo help-echo)))))))) 334 (5 ,(propertize " C%c" 'help-echo help-echo))))))))
335
336 (setq-default mode-line-format standard-mode-line-format)
337 (put 'mode-line-format 'standard-value
338 (list `(quote ,standard-mode-line-format)))
339
340 (setq-default mode-line-modes standard-mode-line-modes)
341 (put 'mode-line-modes 'standard-value
342 (list `(quote ,standard-mode-line-modes)))
343
344 (setq-default mode-line-position standard-mode-line-position)
345 (put 'mode-line-position 'standard-value
346 (list `(quote ,standard-mode-line-position))))
343 347
344(defvar mode-line-buffer-identification-keymap nil "\ 348(defvar mode-line-buffer-identification-keymap nil "\
345Keymap for what is displayed by `mode-line-buffer-identification'.") 349Keymap for what is displayed by `mode-line-buffer-identification'.")
346 350
351;; Add menu of buffer operations to the buffer identification part
352;; of the mode line.or header line.
353;
354(let ((map (make-sparse-keymap)))
355 ;; Bind down- events so that the global keymap won't ``shine
356 ;; through''.
357 (define-key map [mode-line mouse-1] 'mode-line-previous-buffer)
358 (define-key map [header-line down-mouse-1] 'ignore)
359 (define-key map [header-line mouse-1] 'mode-line-previous-buffer)
360 (define-key map [header-line down-mouse-3] 'ignore)
361 (define-key map [mode-line mouse-3] 'mode-line-next-buffer)
362 (define-key map [header-line down-mouse-3] 'ignore)
363 (define-key map [header-line mouse-3] 'mode-line-next-buffer)
364 (setq mode-line-buffer-identification-keymap map))
365
366(defun propertized-buffer-identification (fmt)
367 "Return a list suitable for `mode-line-buffer-identification'.
368FMT is a format specifier such as \"%12b\". This function adds
369text properties for face, help-echo, and local-map to it."
370 (list (propertize fmt
371 'face 'mode-line-buffer-id
372 'help-echo
373 (purecopy "mouse-1: previous buffer, mouse-3: next buffer")
374 'mouse-face 'mode-line-highlight
375 'local-map mode-line-buffer-identification-keymap)))
376
377(defvar mode-line-buffer-identification (propertized-buffer-identification "%12b") "\
378Mode-line control for identifying the buffer being displayed.
379Its default value is (\"%12b\") with some text properties added.
380Major modes that edit things other than ordinary files may change this
381\(e.g. Info, Dired,...)")
382
383(make-variable-buffer-local 'mode-line-buffer-identification)
384
347(defun unbury-buffer () "\ 385(defun unbury-buffer () "\
348Switch to the last buffer in the buffer list." 386Switch to the last buffer in the buffer list."
349 (interactive) 387 (interactive)
@@ -449,35 +487,6 @@ Menu of mode operations in the mode line.")
449 (let ((indicator (car (nth 4 (car (cdr event)))))) 487 (let ((indicator (car (nth 4 (car (cdr event))))))
450 (describe-minor-mode-from-indicator indicator))) 488 (describe-minor-mode-from-indicator indicator)))
451 489
452;; Add menu of buffer operations to the buffer identification part
453;; of the mode line.or header line.
454;
455(let ((map (make-sparse-keymap)))
456 ;; Bind down- events so that the global keymap won't ``shine
457 ;; through''.
458 (define-key map [mode-line mouse-1] 'mode-line-previous-buffer)
459 (define-key map [header-line down-mouse-1] 'ignore)
460 (define-key map [header-line mouse-1] 'mode-line-previous-buffer)
461 (define-key map [header-line down-mouse-3] 'ignore)
462 (define-key map [mode-line mouse-3] 'mode-line-next-buffer)
463 (define-key map [header-line down-mouse-3] 'ignore)
464 (define-key map [header-line mouse-3] 'mode-line-next-buffer)
465 (setq mode-line-buffer-identification-keymap map))
466
467(defun propertized-buffer-identification (fmt)
468 "Return a list suitable for `mode-line-buffer-identification'.
469FMT is a format specifier such as \"%12b\". This function adds
470text properties for face, help-echo, and local-map to it."
471 (list (propertize fmt
472 'face 'mode-line-buffer-id
473 'help-echo
474 (purecopy "mouse-1: previous buffer, mouse-3: next buffer")
475 'mouse-face 'mode-line-highlight
476 'local-map mode-line-buffer-identification-keymap)))
477
478(setq-default mode-line-buffer-identification
479 (propertized-buffer-identification "%12b"))
480
481(defvar minor-mode-alist nil "\ 490(defvar minor-mode-alist nil "\
482Alist saying how to show minor modes in the mode line. 491Alist saying how to show minor modes in the mode line.
483Each element looks like (VARIABLE STRING); 492Each element looks like (VARIABLE STRING);
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..8dc0ac1e330 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,21 @@ 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 (pos)
195 (compare-windows-skip-whitespace pos)
196 t)
197 compare-windows-whitespace)))
198
199 (with-current-buffer b2
200 (setq skip-func-2 (if ignore-whitespace
201 (if (stringp compare-windows-whitespace)
202 (lambda (pos)
203 (compare-windows-skip-whitespace pos)
204 t)
205 compare-windows-whitespace)))
195 (push-mark p2 t) 206 (push-mark p2 t)
196 (setq maxp2 (point-max))) 207 (setq maxp2 (point-max)))
197 (push-mark) 208 (push-mark)
@@ -199,17 +210,16 @@ on third call it again advances points to the next difference and so on."
199 (while (> progress 0) 210 (while (> progress 0)
200 ;; If both windows have whitespace next to point, 211 ;; If both windows have whitespace next to point,
201 ;; optionally skip over it. 212 ;; optionally skip over it.
202 (and skip-func 213 (and skip-func-1
203 (save-excursion 214 (save-excursion
204 (let (p1a p2a w1 w2 result1 result2) 215 (let (p1a p2a w1 w2 result1 result2)
205 (setq result1 (funcall skip-func opoint1)) 216 (setq result1 (funcall skip-func-1 opoint1))
206 (setq p1a (point)) 217 (setq p1a (point))
207 (set-buffer b2) 218 (set-buffer b2)
208 (goto-char p2) 219 (goto-char p2)
209 (setq result2 (funcall skip-func opoint2)) 220 (setq result2 (funcall skip-func-2 opoint2))
210 (setq p2a (point)) 221 (setq p2a (point))
211 (if (or (stringp compare-windows-whitespace) 222 (if (and result1 result2 (eq result1 result2))
212 (and result1 result2 (eq result1 result2)))
213 (setq p1 p1a 223 (setq p1 p1a
214 p2 p2a))))) 224 p2 p2a)))))
215 225
diff --git a/lisp/complete.el b/lisp/complete.el
index ca6231893c3..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))
@@ -811,6 +808,12 @@ or properties are considered."
811(defun PC-expand-many-files (name) 808(defun PC-expand-many-files (name)
812 (with-current-buffer (generate-new-buffer " *Glob Output*") 809 (with-current-buffer (generate-new-buffer " *Glob Output*")
813 (erase-buffer) 810 (erase-buffer)
811 (when (and (file-name-absolute-p name)
812 (not (file-directory-p default-directory)))
813 ;; If the current working directory doesn't exist `shell-command'
814 ;; signals an error. So if the file names we're looking for don't
815 ;; depend on the working directory, switch to a valid directory first.
816 (setq default-directory "/"))
814 (shell-command (concat "echo " name) t) 817 (shell-command (concat "echo " name) t)
815 (goto-char (point-min)) 818 (goto-char (point-min))
816 ;; CSH-style shells were known to output "No match", whereas 819 ;; CSH-style shells were known to output "No match", whereas
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 15f43080aff..609b5572a08 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -4435,9 +4435,8 @@ The format is suitable for use with `easy-menu-define'."
4435 ;; Actually, this misfeature of dense keymaps was fixed on 2001-11-26. 4435 ;; Actually, this misfeature of dense keymaps was fixed on 2001-11-26.
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] 4438 (define-key map [remap self-insert-command] 'custom-no-edit)
4439 'custom-no-edit) 4439 (define-key map "\^m" 'custom-newline)
4440 (define-key map "\^m" 'custom-no-edit)
4441 (define-key map " " 'scroll-up) 4440 (define-key map " " 'scroll-up)
4442 (define-key map "\177" 'scroll-down) 4441 (define-key map "\177" 'scroll-down)
4443 (define-key map "\C-c\C-c" 'Custom-set) 4442 (define-key map "\C-c\C-c" 'Custom-set)
@@ -4452,6 +4451,11 @@ The format is suitable for use with `easy-menu-define'."
4452(defun custom-no-edit (pos &optional event) 4451(defun custom-no-edit (pos &optional event)
4453 "Invoke button at POS, or refuse to allow editing of Custom buffer." 4452 "Invoke button at POS, or refuse to allow editing of Custom buffer."
4454 (interactive "@d") 4453 (interactive "@d")
4454 (error "You can't edit this part of the Custom buffer"))
4455
4456(defun custom-newline (pos &optional event)
4457 "Invoke button at POS, or refuse to allow editing of Custom buffer."
4458 (interactive "@d")
4455 (let ((button (get-char-property pos 'button))) 4459 (let ((button (get-char-property pos 'button)))
4456 (if button 4460 (if button
4457 (widget-apply-action button event) 4461 (widget-apply-action button event)
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index cceed27951e..b59cb57aaf6 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -175,7 +175,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
175 ;; fringe.c 175 ;; fringe.c
176 (overflow-newline-into-fringe fringe boolean) 176 (overflow-newline-into-fringe fringe boolean)
177 ;; indent.c 177 ;; indent.c
178 (indent-tabs-mode fill boolean) 178 (indent-tabs-mode indent boolean)
179 ;; keyboard.c 179 ;; keyboard.c
180 (meta-prefix-char keyboard character) 180 (meta-prefix-char keyboard character)
181 (auto-save-interval auto-save integer) 181 (auto-save-interval auto-save integer)
@@ -360,6 +360,7 @@ since it could result in memory overflow and make Emacs crash."
360 (other :tag "Unlimited" t))) 360 (other :tag "Unlimited" t)))
361 (unibyte-display-via-language-environment mule boolean) 361 (unibyte-display-via-language-environment mule boolean)
362 (blink-cursor-alist cursor alist "22.1") 362 (blink-cursor-alist cursor alist "22.1")
363 (overline-margin display integer "22.1")
363 ;; xfaces.c 364 ;; xfaces.c
364 (scalable-fonts-allowed display boolean) 365 (scalable-fonts-allowed display boolean)
365 ;; xfns.c 366 ;; xfns.c
@@ -371,6 +372,7 @@ since it could result in memory overflow and make Emacs crash."
371 ;; xterm.c 372 ;; xterm.c
372 (mouse-autoselect-window display boolean "21.3") 373 (mouse-autoselect-window display boolean "21.3")
373 (x-use-underline-position-properties display boolean "21.3") 374 (x-use-underline-position-properties display boolean "21.3")
375 (x-underline-at-descent-line display boolean "22.1")
374 (x-stretch-cursor display boolean "21.1"))) 376 (x-stretch-cursor display boolean "21.1")))
375 this symbol group type standard version native-p 377 this symbol group type standard version native-p
376 ;; This function turns a value 378 ;; This function turns a value
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/ediff-mult.el b/lisp/ediff-mult.el
index 71859a5d4c5..b33ad7c1859 100644
--- a/lisp/ediff-mult.el
+++ b/lisp/ediff-mult.el
@@ -648,8 +648,8 @@ behavior."
648 (mapcar 648 (mapcar
649 (lambda (elt) 649 (lambda (elt)
650 (ediff-make-new-meta-list-element 650 (ediff-make-new-meta-list-element
651 (concat auxdir1 elt) 651 (expand-file-name (concat auxdir1 elt))
652 (concat auxdir2 elt) 652 (expand-file-name (concat auxdir2 elt))
653 (if lis3 653 (if lis3
654 (progn 654 (progn
655 ;; The following is done because: In merging with 655 ;; The following is done because: In merging with
@@ -660,7 +660,7 @@ behavior."
660 ;; the second case, we insert nil. 660 ;; the second case, we insert nil.
661 (setq elt (ediff-add-slash-if-directory auxdir3 elt)) 661 (setq elt (ediff-add-slash-if-directory auxdir3 elt))
662 (if (file-exists-p (concat auxdir3 elt)) 662 (if (file-exists-p (concat auxdir3 elt))
663 (concat auxdir3 elt)))))) 663 (expand-file-name (concat auxdir3 elt)))))))
664 common))) 664 common)))
665 ;; return result 665 ;; return result
666 (cons common-part difflist) 666 (cons common-part difflist)
@@ -716,7 +716,7 @@ behavior."
716 auxdir1 nil nil 716 auxdir1 nil nil
717 merge-autostore-dir nil) 717 merge-autostore-dir nil)
718 (mapcar (lambda (elt) (ediff-make-new-meta-list-element 718 (mapcar (lambda (elt) (ediff-make-new-meta-list-element
719 (concat auxdir1 elt) nil nil)) 719 (expand-file-name (concat auxdir1 elt)) nil nil))
720 common)) 720 common))
721 )) 721 ))
722 722
@@ -1338,7 +1338,10 @@ Useful commands:
1338 ;; update ediff-meta-list by direct modification 1338 ;; update ediff-meta-list by direct modification
1339 (nconc meta-list 1339 (nconc meta-list
1340 (list (ediff-make-new-meta-list-element 1340 (list (ediff-make-new-meta-list-element
1341 otherfile1 otherfile2 otherfile3))) 1341 (expand-file-name otherfile1)
1342 (expand-file-name otherfile2)
1343 (if otherfile3
1344 (expand-file-name otherfile3)))))
1342 ) 1345 )
1343 (ediff-update-meta-buffer meta-buf 'must-redraw) 1346 (ediff-update-meta-buffer meta-buf 'must-redraw)
1344 )) 1347 ))
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 86bf29f0381..3b562bbdbdf 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -670,6 +670,7 @@ This function assumes that the events can be stored in a string."
670 (cond ((atom ev) 670 (cond ((atom ev)
671 (push ev result)) 671 (push ev result))
672 ((eq (car ev) 'help-echo)) 672 ((eq (car ev) 'help-echo))
673 ((eq (car ev) 'switch-frame))
673 ((equal ev '(menu-bar)) 674 ((equal ev '(menu-bar))
674 (push 'menu-bar result)) 675 (push 'menu-bar result))
675 ((equal (cadadr ev) '(menu-bar)) 676 ((equal (cadadr ev) '(menu-bar))
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/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index bbeea5d703d..68603c905a5 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -193,8 +193,14 @@
193(defvar compilation-error-regexp-alist) 193(defvar compilation-error-regexp-alist)
194(defvar compilation-mode-font-lock-keywords) 194(defvar compilation-mode-font-lock-keywords)
195 195
196(defgroup checkdoc nil
197 "Support for doc string checking in Emacs Lisp."
198 :prefix "checkdoc"
199 :group 'lisp
200 :version "20.3")
201
196(defcustom checkdoc-autofix-flag 'semiautomatic 202(defcustom checkdoc-autofix-flag 'semiautomatic
197 "*Non-nil means attempt auto-fixing of doc strings. 203 "Non-nil means attempt auto-fixing of doc strings.
198If this value is the symbol `query', then the user is queried before 204If this value is the symbol `query', then the user is queried before
199any change is made. If the value is `automatic', then all changes are 205any change is made. If the value is `automatic', then all changes are
200made without asking unless the change is very-complex. If the value 206made without asking unless the change is very-complex. If the value
@@ -208,37 +214,39 @@ The value `never' is the same as nil, never ask or change anything."
208 (other :tag "semiautomatic" semiautomatic))) 214 (other :tag "semiautomatic" semiautomatic)))
209 215
210(defcustom checkdoc-bouncy-flag t 216(defcustom checkdoc-bouncy-flag t
211 "*Non-nil means to \"bounce\" to auto-fix locations. 217 "Non-nil means to \"bounce\" to auto-fix locations.
212Setting this to nil will silently make fixes that require no user 218Setting this to nil will silently make fixes that require no user
213interaction. See `checkdoc-autofix-flag' for auto-fixing details." 219interaction. See `checkdoc-autofix-flag' for auto-fixing details."
214 :group 'checkdoc 220 :group 'checkdoc
215 :type 'boolean) 221 :type 'boolean)
216 222
217(defcustom checkdoc-force-docstrings-flag t 223(defcustom checkdoc-force-docstrings-flag t
218 "*Non-nil means that all checkable definitions should have documentation. 224 "Non-nil means that all checkable definitions should have documentation.
219Style guide dictates that interactive functions MUST have documentation, 225Style guide dictates that interactive functions MUST have documentation,
220and that it's good but not required practice to make non user visible items 226and that it's good but not required practice to make non user visible items
221have doc strings." 227have doc strings."
222 :group 'checkdoc 228 :group 'checkdoc
223 :type 'boolean) 229 :type 'boolean)
230(put 'checkdoc-force-docstrings-flag 'safe-local-variable 'booleanp)
224 231
225(defcustom checkdoc-force-history-flag t 232(defcustom checkdoc-force-history-flag t
226 "*Non-nil means that files should have a History section or ChangeLog file. 233 "Non-nil means that files should have a History section or ChangeLog file.
227This helps document the evolution of, and recent changes to, the package." 234This helps document the evolution of, and recent changes to, the package."
228 :group 'checkdoc 235 :group 'checkdoc
229 :type 'boolean) 236 :type 'boolean)
230 237
231(defcustom checkdoc-permit-comma-termination-flag nil 238(defcustom checkdoc-permit-comma-termination-flag nil
232 "*Non-nil means the first line of a docstring may end with a comma. 239 "Non-nil means the first line of a docstring may end with a comma.
233Ordinarily, a full sentence is required. This may be misleading when 240Ordinarily, a full sentence is required. This may be misleading when
234there is a substantial caveat to the one-line description -- the comma 241there is a substantial caveat to the one-line description -- the comma
235should be used when the first part could stand alone as a sentence, but 242should be used when the first part could stand alone as a sentence, but
236it indicates that a modifying clause follows." 243it indicates that a modifying clause follows."
237 :group 'checkdoc 244 :group 'checkdoc
238 :type 'boolean) 245 :type 'boolean)
246(put 'checkdoc-permit-comma-termination-flag 'safe-local-variable 'booleanp)
239 247
240(defcustom checkdoc-spellcheck-documentation-flag nil 248(defcustom checkdoc-spellcheck-documentation-flag nil
241 "*Non-nil means run Ispell on text based on value. 249 "Non-nil means run Ispell on text based on value.
242This is automatically set to nil if Ispell does not exist on your 250This is automatically set to nil if Ispell does not exist on your
243system. Possible values are: 251system. Possible values are:
244 252
@@ -259,14 +267,14 @@ system. Possible values are:
259 "List of words that are correct when spell-checking Lisp documentation.") 267 "List of words that are correct when spell-checking Lisp documentation.")
260 268
261(defcustom checkdoc-max-keyref-before-warn 10 269(defcustom checkdoc-max-keyref-before-warn 10
262 "*The number of \\ [command-to-keystroke] tokens allowed in a doc string. 270 "The number of \\ [command-to-keystroke] tokens allowed in a doc string.
263Any more than this and a warning is generated suggesting that the construct 271Any more than this and a warning is generated suggesting that the construct
264\\ {keymap} be used instead." 272\\ {keymap} be used instead."
265 :group 'checkdoc 273 :group 'checkdoc
266 :type 'integer) 274 :type 'integer)
267 275
268(defcustom checkdoc-arguments-in-order-flag t 276(defcustom checkdoc-arguments-in-order-flag t
269 "*Non-nil means warn if arguments appear out of order. 277 "Non-nil means warn if arguments appear out of order.
270Setting this to nil will mean only checking that all the arguments 278Setting this to nil will mean only checking that all the arguments
271appear in the proper form in the documentation, not that they are in 279appear in the proper form in the documentation, not that they are in
272the same order as they appear in the argument list. No mention is 280the same order as they appear in the argument list. No mention is
@@ -298,7 +306,7 @@ problem discovered. This is useful for adding additional checks.")
298A search leaves the cursor in front of the parameter list.") 306A search leaves the cursor in front of the parameter list.")
299 307
300(defcustom checkdoc-verb-check-experimental-flag t 308(defcustom checkdoc-verb-check-experimental-flag t
301 "*Non-nil means to attempt to check the voice of the doc string. 309 "Non-nil means to attempt to check the voice of the doc string.
302This check keys off some words which are commonly misused. See the 310This check keys off some words which are commonly misused. See the
303variable `checkdoc-common-verbs-wrong-voice' if you wish to add your own." 311variable `checkdoc-common-verbs-wrong-voice' if you wish to add your own."
304 :group 'checkdoc 312 :group 'checkdoc
@@ -2633,12 +2641,6 @@ function called to create the messages."
2633 (setq checkdoc-pending-errors nil) 2641 (setq checkdoc-pending-errors nil)
2634 nil))) 2642 nil)))
2635 2643
2636(defgroup checkdoc nil
2637 "Support for doc string checking in Emacs Lisp."
2638 :prefix "checkdoc"
2639 :group 'lisp
2640 :version "20.3")
2641
2642(custom-add-option 'emacs-lisp-mode-hook 2644(custom-add-option 'emacs-lisp-mode-hook
2643 (lambda () (checkdoc-minor-mode 1))) 2645 (lambda () (checkdoc-minor-mode 1)))
2644 2646
@@ -2650,5 +2652,5 @@ function called to create the messages."
2650 2652
2651(provide 'checkdoc) 2653(provide 'checkdoc)
2652 2654
2653;;; arch-tag: c49a7ec8-3bb7-46f2-bfbc-d5f26e033b26 2655;; arch-tag: c49a7ec8-3bb7-46f2-bfbc-d5f26e033b26
2654;;; checkdoc.el ends here 2656;;; checkdoc.el ends here
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/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index a98dd60fc21..82eac50c874 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -60,14 +60,22 @@ fire repeatedly that many seconds apart."
60 60
61(defun timer-set-idle-time (timer secs &optional repeat) 61(defun timer-set-idle-time (timer secs &optional repeat)
62 "Set the trigger idle time of TIMER to SECS. 62 "Set the trigger idle time of TIMER to SECS.
63SECS may be an integer, floating point number, or the internal
64time format (HIGH LOW USECS) returned by, e.g., `current-idle-time'.
63If optional third argument REPEAT is non-nil, make the timer 65If optional third argument REPEAT is non-nil, make the timer
64fire each time Emacs is idle for that many seconds." 66fire each time Emacs is idle for that many seconds."
65 (or (timerp timer) 67 (or (timerp timer)
66 (error "Invalid timer")) 68 (error "Invalid timer"))
67 (aset timer 1 0) 69 (if (consp secs)
68 (aset timer 2 0) 70 (progn (aset timer 1 (car secs))
69 (aset timer 3 0) 71 (aset timer 2 (if (consp (cdr secs)) (car (cdr secs)) (cdr secs)))
70 (timer-inc-time timer secs) 72 (aset timer 3 (or (and (consp (cdr secs)) (consp (cdr (cdr secs)))
73 (nth 2 secs))
74 0)))
75 (aset timer 1 0)
76 (aset timer 2 0)
77 (aset timer 3 0)
78 (timer-inc-time timer secs))
71 (aset timer 4 repeat) 79 (aset timer 4 repeat)
72 timer) 80 timer)
73 81
@@ -104,7 +112,7 @@ of SECS seconds since the epoch. SECS may be a fraction."
104 112
105(defun timer-relative-time (time secs &optional usecs) 113(defun timer-relative-time (time secs &optional usecs)
106 "Advance TIME by SECS seconds and optionally USECS microseconds. 114 "Advance TIME by SECS seconds and optionally USECS microseconds.
107SECS may be a fraction." 115SECS may be either an integer or a floating point number."
108 (let ((high (car time)) 116 (let ((high (car time))
109 (low (if (consp (cdr time)) (nth 1 time) (cdr time))) 117 (low (if (consp (cdr time)) (nth 1 time) (cdr time)))
110 (micro (if (numberp (car-safe (cdr-safe (cdr time)))) 118 (micro (if (numberp (car-safe (cdr-safe (cdr time))))
@@ -412,7 +420,10 @@ This function is for compatibility; see also `run-with-timer'."
412(defun run-with-idle-timer (secs repeat function &rest args) 420(defun run-with-idle-timer (secs repeat function &rest args)
413 "Perform an action the next time Emacs is idle for SECS seconds. 421 "Perform an action the next time Emacs is idle for SECS seconds.
414The action is to call FUNCTION with arguments ARGS. 422The action is to call FUNCTION with arguments ARGS.
415SECS may be an integer or a floating point number. 423SECS may be an integer, a floating point number, or the internal
424time format (HIGH LOW USECS) returned by, e.g., `current-idle-time'.
425If Emacs is currently idle, and has been idle for N seconds (N < SECS),
426then it will call FUNCTION in SECS - N seconds from now.
416 427
417If REPEAT is non-nil, do the action each time Emacs has been idle for 428If REPEAT is non-nil, do the action each time Emacs has been idle for
418exactly SECS seconds (that is, only once for each time Emacs becomes idle). 429exactly SECS seconds (that is, only once for each time Emacs becomes idle).
@@ -425,7 +436,7 @@ This function returns a timer object which you can use in `cancel-timer'."
425 (let ((timer (timer-create))) 436 (let ((timer (timer-create)))
426 (timer-set-function timer function args) 437 (timer-set-function timer function args)
427 (timer-set-idle-time timer secs repeat) 438 (timer-set-idle-time timer secs repeat)
428 (timer-activate-when-idle timer) 439 (timer-activate-when-idle timer t)
429 timer)) 440 timer))
430 441
431(defun with-timeout-handler (tag) 442(defun with-timeout-handler (tag)
diff --git a/lisp/emacs-lisp/tq.el b/lisp/emacs-lisp/tq.el
index 2126d7663fc..1e1e143f0f0 100644
--- a/lisp/emacs-lisp/tq.el
+++ b/lisp/emacs-lisp/tq.el
@@ -66,7 +66,7 @@
66;; regexp: regular expression that matches the end of a response from 66;; regexp: regular expression that matches the end of a response from
67;; the process 67;; the process
68(defun tq-queue-head-regexp (tq) (car (cdr (car (tq-queue tq))))) 68(defun tq-queue-head-regexp (tq) (car (cdr (car (tq-queue tq)))))
69;; closure: additional data to pass to function 69;; closure: additional data to pass to the function
70(defun tq-queue-head-closure (tq) (car (cdr (cdr (car (tq-queue tq)))))) 70(defun tq-queue-head-closure (tq) (car (cdr (cdr (car (tq-queue tq))))))
71;; fn: function to call upon receiving a complete response from the 71;; fn: function to call upon receiving a complete response from the
72;; process 72;; process
@@ -119,7 +119,7 @@ If DELAY-QUESTION is non-nil, delay sending this question until
119the process has finished replying to any previous questions. 119the process has finished replying to any previous questions.
120This produces more reliable results with some processes." 120This produces more reliable results with some processes."
121 (let ((sendp (or (not delay-question) 121 (let ((sendp (or (not delay-question)
122 (not (tq-queue-head-question tq))))) 122 (not (tq-queue tq)))))
123 (tq-queue-add tq (unless sendp question) regexp closure fn) 123 (tq-queue-add tq (unless sendp question) regexp closure fn)
124 (when sendp 124 (when sendp
125 (process-send-string (tq-process tq) question)))) 125 (process-send-string (tq-process tq) question))))
@@ -131,35 +131,39 @@ This produces more reliable results with some processes."
131 131
132(defun tq-filter (tq string) 132(defun tq-filter (tq string)
133 "Append STRING to the TQ's buffer; then process the new data." 133 "Append STRING to the TQ's buffer; then process the new data."
134 (with-current-buffer (tq-buffer tq) 134 (let ((buffer (tq-buffer tq)))
135 (goto-char (point-max)) 135 (when (buffer-live-p buffer)
136 (insert string) 136 (with-current-buffer buffer
137 (tq-process-buffer tq))) 137 (goto-char (point-max))
138 (insert string)
139 (tq-process-buffer tq)))))
138 140
139(defun tq-process-buffer (tq) 141(defun tq-process-buffer (tq)
140 "Check TQ's buffer for the regexp at the head of the queue." 142 "Check TQ's buffer for the regexp at the head of the queue."
141 (set-buffer (tq-buffer tq)) 143 (let ((buffer (tq-buffer tq)))
142 (if (= 0 (buffer-size)) () 144 (when (buffer-live-p buffer)
143 (if (tq-queue-empty tq) 145 (set-buffer buffer)
144 (let ((buf (generate-new-buffer "*spurious*"))) 146 (if (= 0 (buffer-size)) ()
145 (copy-to-buffer buf (point-min) (point-max)) 147 (if (tq-queue-empty tq)
146 (delete-region (point-min) (point)) 148 (let ((buf (generate-new-buffer "*spurious*")))
147 (pop-to-buffer buf nil) 149 (copy-to-buffer buf (point-min) (point-max))
148 (error "Spurious communication from process %s, see buffer %s" 150 (delete-region (point-min) (point))
149 (process-name (tq-process tq)) 151 (pop-to-buffer buf nil)
150 (buffer-name buf))) 152 (error "Spurious communication from process %s, see buffer %s"
151 (goto-char (point-min)) 153 (process-name (tq-process tq))
152 (if (re-search-forward (tq-queue-head-regexp tq) nil t) 154 (buffer-name buf)))
153 (let ((answer (buffer-substring (point-min) (point)))) 155 (goto-char (point-min))
154 (delete-region (point-min) (point)) 156 (if (re-search-forward (tq-queue-head-regexp tq) nil t)
155 (unwind-protect 157 (let ((answer (buffer-substring (point-min) (point))))
156 (condition-case nil 158 (delete-region (point-min) (point))
157 (funcall (tq-queue-head-fn tq) 159 (unwind-protect
158 (tq-queue-head-closure tq) 160 (condition-case nil
159 answer) 161 (funcall (tq-queue-head-fn tq)
160 (error nil)) 162 (tq-queue-head-closure tq)
161 (tq-queue-pop tq)) 163 answer)
162 (tq-process-buffer tq)))))) 164 (error nil))
165 (tq-queue-pop tq))
166 (tq-process-buffer tq))))))))
163 167
164(provide 'tq) 168(provide 'tq)
165 169
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index 0dce3b94ff0..af757a2a55c 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -46,6 +46,8 @@
46(defvar mark-even-if-inactive) 46(defvar mark-even-if-inactive)
47(defvar init-message) 47(defvar init-message)
48(defvar initial) 48(defvar initial)
49(defvar undo-beg-posn)
50(defvar undo-end-posn)
49 51
50;; loading happens only in non-interactive compilation 52;; loading happens only in non-interactive compilation
51;; in order to spare non-viperized emacs from being viperized 53;; in order to spare non-viperized emacs from being viperized
@@ -196,7 +198,7 @@
196 (viper-save-cursor-color 'before-insert-mode)) 198 (viper-save-cursor-color 'before-insert-mode))
197 ;; set insert mode cursor color 199 ;; set insert mode cursor color
198 (viper-change-cursor-color viper-insert-state-cursor-color))) 200 (viper-change-cursor-color viper-insert-state-cursor-color)))
199 (if (eq viper-current-state 'emacs-state) 201 (if (and viper-emacs-state-cursor-color (eq viper-current-state 'emacs-state))
200 (let ((has-saved-cursor-color-in-emacs-mode 202 (let ((has-saved-cursor-color-in-emacs-mode
201 (stringp (viper-get-saved-cursor-color-in-emacs-mode)))) 203 (stringp (viper-get-saved-cursor-color-in-emacs-mode))))
202 (or has-saved-cursor-color-in-emacs-mode 204 (or has-saved-cursor-color-in-emacs-mode
@@ -722,12 +724,13 @@
722 (viper-set-replace-overlay (point-min) (point-min))) 724 (viper-set-replace-overlay (point-min) (point-min)))
723 (viper-hide-replace-overlay) 725 (viper-hide-replace-overlay)
724 726
725 (let ((has-saved-cursor-color-in-emacs-mode 727 (if viper-emacs-state-cursor-color
726 (stringp (viper-get-saved-cursor-color-in-emacs-mode)))) 728 (let ((has-saved-cursor-color-in-emacs-mode
727 (or has-saved-cursor-color-in-emacs-mode 729 (stringp (viper-get-saved-cursor-color-in-emacs-mode))))
728 (string= (viper-get-cursor-color) viper-emacs-state-cursor-color) 730 (or has-saved-cursor-color-in-emacs-mode
729 (viper-save-cursor-color 'before-emacs-mode)) 731 (string= (viper-get-cursor-color) viper-emacs-state-cursor-color)
730 (viper-change-cursor-color viper-emacs-state-cursor-color)) 732 (viper-save-cursor-color 'before-emacs-mode))
733 (viper-change-cursor-color viper-emacs-state-cursor-color)))
731 734
732 (viper-change-state 'emacs-state) 735 (viper-change-state 'emacs-state)
733 736
@@ -1030,10 +1033,13 @@ as a Meta key and any number of multiple escapes is allowed."
1030 (inhibit-quit t)) 1033 (inhibit-quit t))
1031 (if (viper-ESC-event-p event) 1034 (if (viper-ESC-event-p event)
1032 (progn 1035 (progn
1033 ;; Emacs 22.50.8 introduced a bug, which makes even a single ESC into 1036 ;; Some versions of Emacs (eg., 22.50.8 have a bug, which makes even
1034 ;; a fast keyseq. To guard against this, we added a check if there 1037 ;; a single ESC into ;; a fast keyseq. To guard against this, we
1035 ;; are other events as well 1038 ;; added a check if there are other events as well. Keep the next
1036 (if (and (viper-fast-keysequence-p) unread-command-events) 1039 ;; line for the next time the bug reappears, so that will remember to
1040 ;; report it.
1041 ;;(if (and (viper-fast-keysequence-p) unread-command-events)
1042 (if (viper-fast-keysequence-p) ;; for Emacsen without the above bug
1037 (progn 1043 (progn
1038 (let (minor-mode-map-alist emulation-mode-map-alists) 1044 (let (minor-mode-map-alist emulation-mode-map-alists)
1039 (viper-set-unread-command-events event) 1045 (viper-set-unread-command-events event)
@@ -1744,12 +1750,14 @@ invokes the command before that, etc."
1744 1750
1745;; Hook used in viper-undo 1751;; Hook used in viper-undo
1746(defun viper-after-change-undo-hook (beg end len) 1752(defun viper-after-change-undo-hook (beg end len)
1747 (setq undo-beg-posn beg 1753 (if undo-in-progress
1748 undo-end-posn (or end beg)) 1754 (setq undo-beg-posn beg
1749 ;; some other hooks may be changing various text properties in 1755 undo-end-posn (or end beg))
1750 ;; the buffer in response to 'undo'; so remove this hook to avoid 1756 ;; some other hooks may be changing various text properties in
1751 ;; its repeated invocation 1757 ;; the buffer in response to 'undo'; so remove this hook to avoid
1752 (remove-hook 'viper-undo-functions 'viper-after-change-undo-hook 'local)) 1758 ;; its repeated invocation
1759 (remove-hook 'viper-undo-functions 'viper-after-change-undo-hook 'local)
1760 ))
1753 1761
1754(defun viper-undo () 1762(defun viper-undo ()
1755 "Undo previous change." 1763 "Undo previous change."
@@ -1764,25 +1772,29 @@ invokes the command before that, etc."
1764 1772
1765 (undo-start) 1773 (undo-start)
1766 (undo-more 2) 1774 (undo-more 2)
1767 (setq undo-beg-posn (or undo-beg-posn before-undo-pt) 1775 ;;(setq undo-beg-posn (or undo-beg-posn (point))
1768 undo-end-posn (or undo-end-posn undo-beg-posn)) 1776 ;; undo-end-posn (or undo-end-posn (point)))
1777 ;;(setq undo-beg-posn (or undo-beg-posn before-undo-pt)
1778 ;; undo-end-posn (or undo-end-posn undo-beg-posn))
1769 1779
1770 (goto-char undo-beg-posn) 1780 (if (and undo-beg-posn undo-end-posn)
1771 (sit-for 0)
1772 (if (and viper-keep-point-on-undo
1773 (pos-visible-in-window-p before-undo-pt))
1774 (progn 1781 (progn
1775 (push-mark (point-marker) t) 1782 (goto-char undo-beg-posn)
1776 (viper-sit-for-short 300) 1783 (sit-for 0)
1777 (goto-char undo-end-posn) 1784 (if (and viper-keep-point-on-undo
1778 (viper-sit-for-short 300) 1785 (pos-visible-in-window-p before-undo-pt))
1779 (if (and (> (viper-chars-in-region undo-beg-posn before-undo-pt) 1) 1786 (progn
1780 (> (viper-chars-in-region undo-end-posn before-undo-pt) 1)) 1787 (push-mark (point-marker) t)
1781 (goto-char before-undo-pt) 1788 (viper-sit-for-short 300)
1782 (goto-char undo-beg-posn))) 1789 (goto-char undo-end-posn)
1783 (push-mark before-undo-pt t)) 1790 (viper-sit-for-short 300)
1791 (if (pos-visible-in-window-p undo-beg-posn)
1792 (goto-char before-undo-pt)
1793 (goto-char undo-beg-posn)))
1794 (push-mark before-undo-pt t))
1795 ))
1796
1784 (if (and (eolp) (not (bolp))) (backward-char 1)) 1797 (if (and (eolp) (not (bolp))) (backward-char 1))
1785 ;;(if (not modified) (set-buffer-modified-p t))
1786 ) 1798 )
1787 (setq this-command 'viper-undo)) 1799 (setq this-command 'viper-undo))
1788 1800
@@ -3952,7 +3964,8 @@ Null string will repeat previous search."
3952 (let ((val (viper-p-val arg)) 3964 (let ((val (viper-p-val arg))
3953 (com (viper-getcom arg)) 3965 (com (viper-getcom arg))
3954 debug-on-error) 3966 debug-on-error)
3955 (if (null viper-s-string) (error viper-NoPrevSearch)) 3967 (if (or (null viper-s-string) (string= viper-s-string ""))
3968 (error viper-NoPrevSearch))
3956 (viper-search viper-s-string viper-s-forward arg) 3969 (viper-search viper-s-string viper-s-forward arg)
3957 (if com 3970 (if com
3958 (progn 3971 (progn
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index e2824246fad..f9f08034582 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -208,12 +208,12 @@
208 208
209;; If this is a one-letter magic command, splice in args. 209;; If this is a one-letter magic command, splice in args.
210(defun ex-splice-args-in-1-letr-cmd (key list) 210(defun ex-splice-args-in-1-letr-cmd (key list)
211 (let ((onelet (ex-cmd-is-one-letter (assoc (substring key 0 1) list)))) 211 (let ((oneletter (ex-cmd-is-one-letter (assoc (substring key 0 1) list))))
212 (if onelet 212 (if oneletter
213 (list key 213 (list key
214 (append (cadr onelet) 214 (append (cadr oneletter)
215 (if (< 1 (length key)) (list (substring key 1)))) 215 (if (< 1 (length key)) (list (substring key 1))))
216 (caddr onelet))) 216 (car (cdr (cdr oneletter))) ))
217 )) 217 ))
218 218
219 219
diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el
index 80938b0282a..465f6e5cfb8 100644
--- a/lisp/emulation/viper-init.el
+++ b/lisp/emulation/viper-init.el
@@ -434,7 +434,10 @@ delete the text being replaced, as in standard Vi."
434(if (fboundp 'make-variable-frame-local) 434(if (fboundp 'make-variable-frame-local)
435 (make-variable-frame-local 'viper-insert-state-cursor-color)) 435 (make-variable-frame-local 'viper-insert-state-cursor-color))
436 436
437(defcustom viper-emacs-state-cursor-color "Magenta" 437;; viper-emacs-state-cursor-color doesn't work well. Causes cursor colors to be
438;; confused in some cases. So, this var is nulled for now.
439;; (defcustom viper-emacs-state-cursor-color "Magenta"
440(defcustom viper-emacs-state-cursor-color nil
438 "Cursor color when Viper is in emacs state." 441 "Cursor color when Viper is in emacs state."
439 :type 'string 442 :type 'string
440 :group 'viper) 443 :group 'viper)
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index 252088a476d..fe179be9cd1 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -137,10 +137,10 @@
137 (x-display-color-p) ; emacs 137 (x-display-color-p) ; emacs
138 )) 138 ))
139 139
140(defsubst viper-get-cursor-color () 140(defun viper-get-cursor-color (&optional frame)
141 (viper-cond-compile-for-xemacs-or-emacs 141 (viper-cond-compile-for-xemacs-or-emacs
142 (color-instance-name 142 (color-instance-name
143 (frame-property (selected-frame) 'cursor-color)) ; xemacs 143 (frame-property (or frame (selected-frame)) 'cursor-color)) ; xemacs
144 (cdr (assoc 'cursor-color (frame-parameters))) ; emacs 144 (cdr (assoc 'cursor-color (frame-parameters))) ; emacs
145 )) 145 ))
146 146
@@ -152,18 +152,31 @@
152 152
153 153
154;; cursor colors 154;; cursor colors
155(defun viper-change-cursor-color (new-color) 155(defun viper-change-cursor-color (new-color &optional frame)
156 (if (and (viper-window-display-p) (viper-color-display-p) 156 (if (and (viper-window-display-p) (viper-color-display-p)
157 (stringp new-color) (viper-color-defined-p new-color) 157 (stringp new-color) (viper-color-defined-p new-color)
158 (not (string= new-color (viper-get-cursor-color)))) 158 (not (string= new-color (viper-get-cursor-color))))
159 (viper-cond-compile-for-xemacs-or-emacs 159 (viper-cond-compile-for-xemacs-or-emacs
160 (set-frame-property 160 (set-frame-property
161 (selected-frame) 'cursor-color (make-color-instance new-color)) 161 (or frame (selected-frame))
162 'cursor-color (make-color-instance new-color))
162 (modify-frame-parameters 163 (modify-frame-parameters
163 (selected-frame) (list (cons 'cursor-color new-color))) 164 (or frame (selected-frame))
165 (list (cons 'cursor-color new-color)))
164 ) 166 )
165 )) 167 ))
166 168
169(defun viper-set-cursor-color-according-to-state (&optional frame)
170 (cond ((eq viper-current-state 'replace-state)
171 (viper-change-cursor-color viper-replace-state-cursor-color frame))
172 ((and (eq viper-current-state 'emacs-state)
173 viper-emacs-state-cursor-color)
174 (viper-change-cursor-color viper-emacs-state-cursor-color frame))
175 ((eq viper-current-state 'insert-state)
176 (viper-change-cursor-color viper-insert-state-cursor-color frame))
177 (t
178 (viper-change-cursor-color viper-vi-state-cursor-color frame))))
179
167;; By default, saves current frame cursor color in the 180;; By default, saves current frame cursor color in the
168;; viper-saved-cursor-color-in-replace-mode property of viper-replace-overlay 181;; viper-saved-cursor-color-in-replace-mode property of viper-replace-overlay
169(defun viper-save-cursor-color (before-which-mode) 182(defun viper-save-cursor-color (before-which-mode)
@@ -191,7 +204,7 @@
191 (if viper-emacs-p 'frame-parameter 'frame-property) 204 (if viper-emacs-p 'frame-parameter 'frame-property)
192 (selected-frame) 205 (selected-frame)
193 'viper-saved-cursor-color-in-replace-mode) 206 'viper-saved-cursor-color-in-replace-mode)
194 (if (eq viper-current-state 'emacs-mode) 207 (if (and (eq viper-current-state 'emacs-mode) viper-emacs-state-cursor-color)
195 viper-emacs-state-cursor-color 208 viper-emacs-state-cursor-color
196 viper-vi-state-cursor-color))) 209 viper-vi-state-cursor-color)))
197 210
@@ -201,7 +214,7 @@
201 (if viper-emacs-p 'frame-parameter 'frame-property) 214 (if viper-emacs-p 'frame-parameter 'frame-property)
202 (selected-frame) 215 (selected-frame)
203 'viper-saved-cursor-color-in-insert-mode) 216 'viper-saved-cursor-color-in-insert-mode)
204 (if (eq viper-current-state 'emacs-mode) 217 (if (and (eq viper-current-state 'emacs-mode) viper-emacs-state-cursor-color)
205 viper-emacs-state-cursor-color 218 viper-emacs-state-cursor-color
206 viper-vi-state-cursor-color))) 219 viper-vi-state-cursor-color)))
207 220
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 8f858526da3..0ba7bdd041a 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -534,10 +534,6 @@ If Viper is enabled, turn it off. Otherwise, turn it on."
534(defun viper-mode () 534(defun viper-mode ()
535 "Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Viper'." 535 "Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Viper'."
536 (interactive) 536 (interactive)
537 (if (null viper-vi-state-cursor-color)
538 (modify-frame-parameters
539 (selected-frame)
540 (list (cons 'viper-vi-state-cursor-color (viper-get-cursor-color)))))
541 (if (not noninteractive) 537 (if (not noninteractive)
542 (progn 538 (progn
543 ;; if the user requested viper-mode explicitly 539 ;; if the user requested viper-mode explicitly
@@ -618,7 +614,8 @@ This startup message appears whenever you load Viper, unless you type `y' now."
618 614
619 (or (memq major-mode viper-emacs-state-mode-list) ; don't switch to Vi 615 (or (memq major-mode viper-emacs-state-mode-list) ; don't switch to Vi
620 (memq major-mode viper-insert-state-mode-list) ; don't switch 616 (memq major-mode viper-insert-state-mode-list) ; don't switch
621 (viper-change-state-to-vi))))) 617 (viper-change-state-to-vi))
618 )))
622 619
623 620
624;; Apply a little heuristic to invoke vi state on major-modes 621;; Apply a little heuristic to invoke vi state on major-modes
@@ -862,8 +859,11 @@ It also can't undo some Viper settings."
862 ;; info about the display and windows until emacs initialization is complete 859 ;; info about the display and windows until emacs initialization is complete
863 ;; So do it via the window-setup-hook 860 ;; So do it via the window-setup-hook
864 (add-hook 'window-setup-hook 861 (add-hook 'window-setup-hook
865 '(lambda () 862 '(lambda ()
866 (setq viper-vi-state-cursor-color (viper-get-cursor-color)))) 863 (modify-frame-parameters
864 (selected-frame)
865 (list (cons 'viper-vi-state-cursor-color
866 (viper-get-cursor-color))))))
867 867
868 ;; Tell vc-diff to put *vc* in Vi mode 868 ;; Tell vc-diff to put *vc* in Vi mode
869 (if (featurep 'vc) 869 (if (featurep 'vc)
@@ -903,7 +903,6 @@ It also can't undo some Viper settings."
903 903
904 (defadvice set-cursor-color (after viper-set-cursor-color-ad activate) 904 (defadvice set-cursor-color (after viper-set-cursor-color-ad activate)
905 "Change cursor color in VI state." 905 "Change cursor color in VI state."
906 ;;(setq viper-vi-state-cursor-color (ad-get-arg 0))
907 (modify-frame-parameters 906 (modify-frame-parameters
908 (selected-frame) 907 (selected-frame)
909 (list (cons 'viper-vi-state-cursor-color (ad-get-arg 0)))) 908 (list (cons 'viper-vi-state-cursor-color (ad-get-arg 0))))
@@ -1008,8 +1007,8 @@ It also can't undo some Viper settings."
1008;; these are primarily advices and Vi-ish variable settings 1007;; these are primarily advices and Vi-ish variable settings
1009(defun viper-non-hook-settings () 1008(defun viper-non-hook-settings ()
1010 1009
1011 ;; Viper changes the default mode-line-buffer-identification 1010 ;;;; Viper changes the default mode-line-buffer-identification
1012 (setq-default mode-line-buffer-identification '(" %b")) 1011 ;;(setq-default mode-line-buffer-identification '(" %b"))
1013 1012
1014 ;; setup emacs-supported vi-style feel 1013 ;; setup emacs-supported vi-style feel
1015 (setq next-line-add-newlines nil 1014 (setq next-line-add-newlines nil
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog
index 216d14d0aa6..72754aa1cd3 100644
--- a/lisp/erc/ChangeLog
+++ b/lisp/erc/ChangeLog
@@ -1,3 +1,78 @@
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
392006-08-02 Michael Olson <mwolson@gnu.org>
40
41 * erc.el (erc-version-string): Release ERC 5.1.4.
42
43 * Makefile, NEWS, erc.texi: Update for the 5.1.4 release.
44
45 * erc.el (erc-active-buffer): Fix bug that caused messages to go
46 to the wrong buffer. Thanks to offby1 for the report.
47
48 * erc-backend.el (erc-coding-system-for-target): Handle case where
49 target is nil. Thanks to Kai Fan for the patch.
50
512006-07-29 Michael Olson <mwolson@gnu.org>
52
53 * erc-log.el (erc-log-setup-logging): Don't offer to save the
54 buffer. It will be saved automatically killed. Thanks to Johan
55 Bockgård and Tassilo Horn for pointing this out.
56
572006-07-27 Johan Bockgård <bojohan@users.sourceforge.net>
58
59 * erc.el (define-erc-module): Make find-function and find-variable
60 find the names constructed by `define-erc-module' in Emacs 22.
61
622006-07-14 Michael Olson <mwolson@gnu.org>
63
64 * erc-log.el (log): Make sure that we enable logging on
65 already-opened buffers as well, in case the user toggles this
66 module after loading ERC. Also be sure to remove logging ability
67 from all ERC buffers when the module is disabled.
68 (erc-log-setup-logging): Set buffer-file-name to nil rather than
69 the empty string. This should fix some errors that occur when
70 quitting Emacs without first killing all ERC buffers.
71 (erc-log-disable-logging): New function that removes the logging
72 ability from the current buffer.
73
74 * erc-spelling.el (spelling): Use dolist and buffer-live-p.
75
12006-07-12 Michael Olson <mwolson@gnu.org> 762006-07-12 Michael Olson <mwolson@gnu.org>
2 77
3 * erc-match.el (erc-log-matches): Bind inhibit-read-only rather 78 * erc-match.el (erc-log-matches): Bind inhibit-read-only rather
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 7dce9e4bf01..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))
@@ -563,11 +556,12 @@ action."
563 "Return the coding system or cons cell appropriate for TARGET. 556 "Return the coding system or cons cell appropriate for TARGET.
564This is determined via `erc-encoding-coding-alist' or 557This is determined via `erc-encoding-coding-alist' or
565`erc-server-coding-system'." 558`erc-server-coding-system'."
566 (or (let ((case-fold-search t)) 559 (or (when target
567 (catch 'match 560 (let ((case-fold-search t))
568 (dolist (pat erc-encoding-coding-alist) 561 (catch 'match
569 (when (string-match (car pat) target) 562 (dolist (pat erc-encoding-coding-alist)
570 (throw 'match (cdr pat)))))) 563 (when (string-match (car pat) target)
564 (throw 'match (cdr pat)))))))
571 (and (functionp erc-server-coding-system) 565 (and (functionp erc-server-coding-system)
572 (funcall erc-server-coding-system)) 566 (funcall erc-server-coding-system))
573 erc-server-coding-system)) 567 erc-server-coding-system))
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index b316a8588bd..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
@@ -218,7 +216,10 @@ also be a predicate function. To only log when you are not set away, use:
218 (add-hook 'erc-quit-hook 'erc-conditional-save-queries) 216 (add-hook 'erc-quit-hook 'erc-conditional-save-queries)
219 (add-hook 'erc-part-hook 'erc-conditional-save-buffer) 217 (add-hook 'erc-part-hook 'erc-conditional-save-buffer)
220 ;; append, so that 'erc-initialize-log-marker runs first 218 ;; append, so that 'erc-initialize-log-marker runs first
221 (add-hook 'erc-connect-pre-hook 'erc-log-setup-logging 'append)) 219 (add-hook 'erc-connect-pre-hook 'erc-log-setup-logging 'append)
220 (dolist (buffer (erc-buffer-list))
221 (when (buffer-live-p buffer)
222 (with-current-buffer buffer (erc-log-setup-logging)))))
222 ;; disable 223 ;; disable
223 ((remove-hook 'erc-insert-post-hook 'erc-save-buffer-in-logs) 224 ((remove-hook 'erc-insert-post-hook 'erc-save-buffer-in-logs)
224 (remove-hook 'erc-send-post-hook 'erc-save-buffer-in-logs) 225 (remove-hook 'erc-send-post-hook 'erc-save-buffer-in-logs)
@@ -226,7 +227,10 @@ also be a predicate function. To only log when you are not set away, use:
226 (remove-hook 'erc-kill-channel-hook 'erc-save-buffer-in-logs) 227 (remove-hook 'erc-kill-channel-hook 'erc-save-buffer-in-logs)
227 (remove-hook 'erc-quit-hook 'erc-conditional-save-queries) 228 (remove-hook 'erc-quit-hook 'erc-conditional-save-queries)
228 (remove-hook 'erc-part-hook 'erc-conditional-save-buffer) 229 (remove-hook 'erc-part-hook 'erc-conditional-save-buffer)
229 (remove-hook 'erc-connect-pre-hook 'erc-log-setup-logging))) 230 (remove-hook 'erc-connect-pre-hook 'erc-log-setup-logging)
231 (dolist (buffer (erc-buffer-list))
232 (when (buffer-live-p buffer)
233 (with-current-buffer buffer (erc-log-disable-logging))))))
230 234
231(define-key erc-mode-map "\C-c\C-l" 'erc-save-buffer-in-logs) 235(define-key erc-mode-map "\C-c\C-l" 'erc-save-buffer-in-logs)
232 236
@@ -236,8 +240,7 @@ also be a predicate function. To only log when you are not set away, use:
236This function is destined to be run from `erc-connect-pre-hook'." 240This function is destined to be run from `erc-connect-pre-hook'."
237 (when (erc-logging-enabled) 241 (when (erc-logging-enabled)
238 (auto-save-mode -1) 242 (auto-save-mode -1)
239 (setq buffer-offer-save t 243 (setq buffer-file-name nil)
240 buffer-file-name "")
241 (set (make-local-variable 'write-file-functions) 244 (set (make-local-variable 'write-file-functions)
242 '(erc-save-buffer-in-logs)) 245 '(erc-save-buffer-in-logs))
243 (when erc-log-insert-log-on-open 246 (when erc-log-insert-log-on-open
@@ -245,6 +248,12 @@ This function is destined to be run from `erc-connect-pre-hook'."
245 (move-marker erc-last-saved-position 248 (move-marker erc-last-saved-position
246 (1- (point-max))))))) 249 (1- (point-max)))))))
247 250
251(defun erc-log-disable-logging ()
252 "Disable logging in the current buffer."
253 (when (erc-logging-enabled)
254 (setq buffer-offer-save nil
255 erc-enable-logging nil)))
256
248(defun erc-log-all-but-server-buffers (buffer) 257(defun erc-log-all-but-server-buffers (buffer)
249 "Returns t if logging should be enabled in BUFFER. 258 "Returns t if logging should be enabled in BUFFER.
250Returns nil iff `erc-server-buffer-p' returns t." 259Returns nil iff `erc-server-buffer-p' returns t."
@@ -282,17 +291,27 @@ is writeable (it will be created as necessary) and
282 (funcall erc-enable-logging (or buffer (current-buffer))) 291 (funcall erc-enable-logging (or buffer (current-buffer)))
283 erc-enable-logging))) 292 erc-enable-logging)))
284 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
285(defun erc-current-logfile (&optional buffer) 303(defun erc-current-logfile (&optional buffer)
286 "Return the logfile to use for BUFFER. 304 "Return the logfile to use for BUFFER.
287If BUFFER is nil, the value of `current-buffer' is used. 305If BUFFER is nil, the value of `current-buffer' is used.
288This is determined by `erc-generate-log-file-name-function'. 306This is determined by `erc-generate-log-file-name-function'.
289The result is converted to lowercase, as IRC is case-insensitive" 307The result is converted to lowercase, as IRC is case-insensitive"
290 (expand-file-name 308 (expand-file-name
291 (downcase (funcall erc-generate-log-file-name-function 309 (erc-log-standardize-name
292 (or buffer (current-buffer)) 310 (funcall erc-generate-log-file-name-function
293 (or (erc-default-target) (buffer-name buffer)) 311 (or buffer (current-buffer))
294 (erc-current-nick) 312 (or (erc-default-target) (buffer-name buffer))
295 erc-session-server erc-session-port)) 313 (erc-current-nick)
314 erc-session-server erc-session-port))
296 erc-log-channels-directory)) 315 erc-log-channels-directory))
297 316
298(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-spelling.el b/lisp/erc/erc-spelling.el
index 3cbc786274d..7ed0f510539 100644
--- a/lisp/erc/erc-spelling.el
+++ b/lisp/erc/erc-spelling.el
@@ -40,15 +40,13 @@
40 ;; Use erc-connect-pre-hook instead of erc-mode-hook as pre-hook is 40 ;; Use erc-connect-pre-hook instead of erc-mode-hook as pre-hook is
41 ;; called AFTER the server buffer is initialized. 41 ;; called AFTER the server buffer is initialized.
42 ((add-hook 'erc-connect-pre-hook 'erc-spelling-init) 42 ((add-hook 'erc-connect-pre-hook 'erc-spelling-init)
43 (mapc (lambda (buffer) 43 (dolist (buffer (erc-buffer-list))
44 (when buffer 44 (when (buffer-live-p buffer)
45 (with-current-buffer buffer (erc-spelling-init)))) 45 (with-current-buffer buffer (erc-spelling-init)))))
46 (erc-buffer-list)))
47 ((remove-hook 'erc-connect-pre-hook 'erc-spelling-init) 46 ((remove-hook 'erc-connect-pre-hook 'erc-spelling-init)
48 (mapc (lambda (buffer) 47 (dolist (buffer (erc-buffer-list))
49 (when buffer 48 (when (buffer-live-p buffer)
50 (with-current-buffer buffer (flyspell-mode 0)))) 49 (with-current-buffer buffer (flyspell-mode 0))))))
51 (erc-buffer-list))))
52 50
53(defcustom erc-spelling-dictionaries nil 51(defcustom erc-spelling-dictionaries nil
54 "An alist mapping buffer names to dictionaries. 52 "An alist mapping buffer names to dictionaries.
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index fd5a49eae4b..41d59576251 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -67,7 +67,7 @@
67 67
68;;; Code: 68;;; Code:
69 69
70(defconst erc-version-string "Version 5.1.3" 70(defconst erc-version-string "Version 5.1.4"
71 "ERC version. This is used by function `erc-version'.") 71 "ERC version. This is used by function `erc-version'.")
72 72
73(eval-when-compile (require 'cl)) 73(eval-when-compile (require 'cl))
@@ -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
@@ -1243,7 +1244,11 @@ With arg, turn ERC %S mode on if and only if arg is positive.
1243 (format "erc-%s-mode" 1244 (format "erc-%s-mode"
1244 (downcase (symbol-name alias))))) 1245 (downcase (symbol-name alias)))))
1245 (quote 1246 (quote
1246 ,mode)))))) 1247 ,mode)))
1248 ;; For find-function and find-variable.
1249 (put ',mode 'definition-name ',name)
1250 (put ',enable 'definition-name ',name)
1251 (put ',disable 'definition-name ',name))))
1247 1252
1248(put 'define-erc-module 'doc-string-elt 3) 1253(put 'define-erc-module 'doc-string-elt 3)
1249 1254
@@ -1388,8 +1393,8 @@ server buffer")
1388Defaults to the server buffer." 1393Defaults to the server buffer."
1389 (with-current-buffer (erc-server-buffer) 1394 (with-current-buffer (erc-server-buffer)
1390 (if (buffer-live-p erc-active-buffer) 1395 (if (buffer-live-p erc-active-buffer)
1391 erc-active-buffer) 1396 erc-active-buffer
1392 (setq erc-active-buffer (current-buffer)))) 1397 (setq erc-active-buffer (current-buffer)))))
1393 1398
1394(defun erc-set-active-buffer (buffer) 1399(defun erc-set-active-buffer (buffer)
1395 "Set the value of `erc-active-buffer' to BUFFER." 1400 "Set the value of `erc-active-buffer' to BUFFER."
@@ -2358,6 +2363,8 @@ See also `erc-format-message' and `erc-display-line'."
2358 msg))) 2363 msg)))
2359 (setq string 2364 (setq string
2360 (cond 2365 (cond
2366 ((null type)
2367 string)
2361 ((listp type) 2368 ((listp type)
2362 (mapc (lambda (type) 2369 (mapc (lambda (type)
2363 (setq string 2370 (setq string
@@ -2370,7 +2377,7 @@ See also `erc-format-message' and `erc-display-line'."
2370 (if (not (erc-response-p parsed)) 2377 (if (not (erc-response-p parsed))
2371 (erc-display-line string buffer) 2378 (erc-display-line string buffer)
2372 (unless (member (erc-response.command parsed) erc-hide-list) 2379 (unless (member (erc-response.command parsed) erc-hide-list)
2373 (erc-put-text-property 0 (length string) 'erc-parsed parsed string) 2380 (erc-put-text-property 0 (length string) 'erc-parsed parsed string)
2374 (erc-put-text-property 0 (length string) 'rear-sticky t string) 2381 (erc-put-text-property 0 (length string) 'rear-sticky t string)
2375 (erc-display-line string buffer))))) 2382 (erc-display-line string buffer)))))
2376 2383
@@ -5237,13 +5244,11 @@ If FILE is found, return the path to it."
5237(defun erc-select-startup-file () 5244(defun erc-select-startup-file ()
5238 "Select an ERC startup file. 5245 "Select an ERC startup file.
5239See also `erc-startup-file-list'." 5246See also `erc-startup-file-list'."
5240 (let ((l erc-startup-file-list) 5247 (catch 'found
5241 (f nil)) 5248 (dolist (f erc-startup-file-list)
5242 (while (and (not f) l) 5249 (setq f (convert-standard-filename f))
5243 (if (file-readable-p (car l)) 5250 (when (file-readable-p f)
5244 (setq f (car l))) 5251 (throw 'found f)))))
5245 (setq l (cdr l)))
5246 f))
5247 5252
5248(defun erc-find-script-file (file) 5253(defun erc-find-script-file (file)
5249 "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'."
@@ -5890,7 +5895,8 @@ All windows are opened in the current frame."
5890 (setq bufs (cdr bufs)) 5895 (setq bufs (cdr bufs))
5891 (while bufs 5896 (while bufs
5892 (split-window) 5897 (split-window)
5893 (switch-to-buffer-other-window (car bufs)) 5898 (other-window 1)
5899 (switch-to-buffer (car bufs))
5894 (setq bufs (cdr bufs)) 5900 (setq bufs (cdr bufs))
5895 (balance-windows))))) 5901 (balance-windows)))))
5896 5902
@@ -5942,12 +5948,17 @@ All windows are opened in the current frame."
5942 (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")
5943 (ctcp-too-many . "Too many CTCP queries in single message. Ignoring") 5949 (ctcp-too-many . "Too many CTCP queries in single message. Ignoring")
5944 (flood-ctcp-off . "FLOOD PROTECTION: Automatic CTCP responses turned off.") 5950 (flood-ctcp-off . "FLOOD PROTECTION: Automatic CTCP responses turned off.")
5945 (flood-strict-mode . "FLOOD PROTECTION: Switched to Strict Flood Control mode.") 5951 (flood-strict-mode
5946 (disconnected . "Connection failed! Re-establishing connection...") 5952 . "FLOOD PROTECTION: Switched to Strict Flood Control mode.")
5947 (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")
5948 (login . "Logging in as \'%n\'...") 5958 (login . "Logging in as \'%n\'...")
5949 (nick-in-use . "%n is in use. Choose new nickname: ") 5959 (nick-in-use . "%n is in use. Choose new nickname: ")
5950 (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")
5951 (no-default-channel . "No default channel") 5962 (no-default-channel . "No default channel")
5952 (no-invitation . "You've got no invitation") 5963 (no-invitation . "You've got no invitation")
5953 (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 f501e0054d1..c893e47ca79 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -2075,7 +2075,7 @@ terminal type to a different value."
2075 ;; red4 is too dark, but some say blue is too loud. 2075 ;; red4 is too dark, but some say blue is too loud.
2076 ;; brown seems to work ok. -- rms. 2076 ;; brown seems to work ok. -- rms.
2077 (t :foreground "brown")) 2077 (t :foreground "brown"))
2078 "Face for characters displayed as ^-sequences or \-sequences." 2078 "Face for characters displayed as sequences using `^' or `\\'."
2079 :group 'basic-faces 2079 :group 'basic-faces
2080 :version "22.1") 2080 :version "22.1")
2081 2081
diff --git a/lisp/files.el b/lisp/files.el
index 2b1446683be..e099d30a01f 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -540,13 +540,21 @@ is a valid DOS file name, but c:/bar/c:/foo is not.
540 540
541This function's standard definition is trivial; it just returns 541This function's standard definition is trivial; it just returns
542the argument. However, on Windows and DOS, replace invalid 542the argument. However, on Windows and DOS, replace invalid
543characters. On DOS, make sure to obey the 8.3 limitations. On 543characters. On DOS, make sure to obey the 8.3 limitations.
544Windows, turn Cygwin names into native names, and also turn 544In the native Windows build, turn Cygwin names into native names,
545slashes into backslashes if the shell requires it (see 545and also turn slashes into backslashes if the shell requires it (see
546`w32-shell-dos-semantics'). 546`w32-shell-dos-semantics').
547 547
548See Info node `(elisp)Standard File Names' for more details." 548See Info node `(elisp)Standard File Names' for more details."
549 filename) 549 (if (eq system-type 'cygwin)
550 (let ((name (copy-sequence filename))
551 (start 0))
552 ;; Replace invalid filename characters with !
553 (while (string-match "[?*:<>|\"\000-\037]" name start)
554 (aset name (match-beginning 0) ?!)
555 (setq start (match-end 0)))
556 name)
557 filename))
550 558
551(defun read-directory-name (prompt &optional dir default-dirname mustmatch initial) 559(defun read-directory-name (prompt &optional dir default-dirname mustmatch initial)
552 "Read directory name, prompting with PROMPT and completing in directory DIR. 560 "Read directory name, prompting with PROMPT and completing in directory DIR.
@@ -4369,7 +4377,7 @@ See also `auto-save-file-name-p'."
4369 "#"))) 4377 "#")))
4370 ;; Make sure auto-save file names don't contain characters 4378 ;; Make sure auto-save file names don't contain characters
4371 ;; invalid for the underlying filesystem. 4379 ;; invalid for the underlying filesystem.
4372 (if (and (memq system-type '(ms-dos windows-nt)) 4380 (if (and (memq system-type '(ms-dos windows-nt cygwin))
4373 ;; Don't modify remote (ange-ftp) filenames 4381 ;; Don't modify remote (ange-ftp) filenames
4374 (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" result))) 4382 (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" result)))
4375 (convert-standard-filename result) 4383 (convert-standard-filename result)
@@ -4404,7 +4412,7 @@ See also `auto-save-file-name-p'."
4404 ((file-writable-p default-directory) default-directory) 4412 ((file-writable-p default-directory) default-directory)
4405 ((file-writable-p "/var/tmp/") "/var/tmp/") 4413 ((file-writable-p "/var/tmp/") "/var/tmp/")
4406 ("~/"))))) 4414 ("~/")))))
4407 (if (and (memq system-type '(ms-dos windows-nt)) 4415 (if (and (memq system-type '(ms-dos windows-nt cygwin))
4408 ;; Don't modify remote (ange-ftp) filenames 4416 ;; Don't modify remote (ange-ftp) filenames
4409 (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" fname))) 4417 (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" fname)))
4410 ;; The call to convert-standard-filename is in case 4418 ;; The call to convert-standard-filename is in case
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-core.el b/lisp/font-core.el
index d2cb8dccd10..85bbf60f0d9 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -83,34 +83,6 @@ where MAJOR-MODE is a symbol and FONT-LOCK-DEFAULTS is a list of default
83settings. See the variable `font-lock-defaults', which takes precedence.") 83settings. See the variable `font-lock-defaults', which takes precedence.")
84(make-obsolete-variable 'font-lock-defaults-alist 'font-lock-defaults) 84(make-obsolete-variable 'font-lock-defaults-alist 'font-lock-defaults)
85 85
86(defvar font-lock-extend-region-function nil
87 "A function that determines the region to fontify after a change.
88
89This buffer-local variable is either nil, or is a function that determines the
90region to fontify. It is usually set by the major mode. The currently active
91font-lock after-change function calls this function after each buffer change.
92
93The function is given three parameters, the standard BEG, END, and OLD-LEN
94from after-change-functions. It should return either a cons of the beginning
95and end buffer positions \(in that order) of the region to fontify, or nil
96\(which directs the caller to fontify a default region). This function need
97not preserve point or the match-data, but must preserve the current
98restriction. The region it returns may start or end in the middle of a
99line.")
100(make-variable-buffer-local 'font-lock-extend-region-function)
101
102(defun font-lock-extend-region (beg end old-len)
103 "Determine the region to fontify after a buffer change.
104
105BEG END and OLD-LEN are the standard parameters from after-change-functions.
106The return value is either nil \(which directs the caller to chose the region
107itself), or a cons of the beginning and end \(in that order) of the region.
108The region returned may start or end in the middle of a line."
109 (if font-lock-extend-region-function
110 (save-match-data
111 (save-excursion
112 (funcall font-lock-extend-region-function beg end old-len)))))
113
114(defvar font-lock-function 'font-lock-default-function 86(defvar font-lock-function 'font-lock-default-function
115 "A function which is called when `font-lock-mode' is toggled. 87 "A function which is called when `font-lock-mode' is toggled.
116It will be passed one argument, which is the current value of 88It will be passed one argument, which is the current value of
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index f001a0bfaac..093780c3914 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -893,7 +893,11 @@ The value of this variable is used when Font Lock mode is turned on."
893 (set (make-local-variable 'font-lock-fontified) t) 893 (set (make-local-variable 'font-lock-fontified) t)
894 ;; Use jit-lock. 894 ;; Use jit-lock.
895 (jit-lock-register 'font-lock-fontify-region 895 (jit-lock-register 'font-lock-fontify-region
896 (not font-lock-keywords-only)))))) 896 (not font-lock-keywords-only))
897 ;; Tell jit-lock how we extend the region to refontify.
898 (add-hook 'jit-lock-after-change-extend-region-functions
899 'font-lock-extend-jit-lock-region-after-change
900 nil t)))))
897 901
898(defun font-lock-turn-off-thing-lock () 902(defun font-lock-turn-off-thing-lock ()
899 (cond ((and (boundp 'fast-lock-mode) fast-lock-mode) 903 (cond ((and (boundp 'fast-lock-mode) fast-lock-mode)
@@ -971,6 +975,21 @@ The value of this variable is used when Font Lock mode is turned on."
971;; directives correctly and cleanly. (It is the same problem as fontifying 975;; directives correctly and cleanly. (It is the same problem as fontifying
972;; 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.)
973 977
978(defvar font-lock-extend-after-change-region-function nil
979 "A function that determines the region to refontify after a change.
980
981This variable is either nil, or is a function that determines the
982region to refontify after a change.
983It is usually set by the major mode via `font-lock-defaults'.
984Font-lock calls this function after each buffer change.
985
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
988and end buffer positions \(in that order) of the region to refontify, or nil
989\(which directs the caller to fontify a default region).
990This function should preserve the match-data.
991The region it returns may start or end in the middle of a line.")
992
974(defun font-lock-fontify-buffer () 993(defun font-lock-fontify-buffer ()
975 "Fontify the current buffer the way the function `font-lock-mode' would." 994 "Fontify the current buffer the way the function `font-lock-mode' would."
976 (interactive) 995 (interactive)
@@ -1021,6 +1040,59 @@ The value of this variable is used when Font Lock mode is turned on."
1021Useful for things like RMAIL and Info where the whole buffer is not 1040Useful for things like RMAIL and Info where the whole buffer is not
1022a very meaningful entity to highlight.") 1041a very meaningful entity to highlight.")
1023 1042
1043
1044(defvar font-lock-beg) (defvar font-lock-end)
1045(defvar font-lock-extend-region-functions
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.
1053 font-lock-extend-region-multiline)
1054 "Special hook run just before proceeding to fontify a region.
1055This is used to allow major modes to help font-lock find safe buffer positions
1056as beginning and end of the fontified region. Its most common use is to solve
1057the problem of /identification/ of multiline elements by providing a function
1058that tries to find such elements and move the boundaries such that they do
1059not fall in the middle of one.
1060Each function is called with no argument; it is expected to adjust the
1061dynamically bound variables `font-lock-beg' and `font-lock-end'; and return
1062non-nil iff it did make such an adjustment.
1063These functions are run in turn repeatedly until they all return nil.
1064Put first the functions more likely to cause a change and cheaper to compute.")
1065;; Mark it as a special hook which doesn't use any global setting
1066;; (i.e. doesn't obey the element t in the buffer-local value).
1067(make-variable-buffer-local 'font-lock-extend-region-functions)
1068
1069(defun font-lock-extend-region-multiline ()
1070 "Move fontification boundaries away from any `font-lock-multiline' property."
1071 (let ((changed nil))
1072 (when (and (> font-lock-beg (point-min))
1073 (get-text-property (1- font-lock-beg) 'font-lock-multiline))
1074 (setq changed t)
1075 (setq font-lock-beg (or (previous-single-property-change
1076 font-lock-beg 'font-lock-multiline)
1077 (point-min))))
1078 ;;
1079 (when (get-text-property font-lock-end 'font-lock-multiline)
1080 (setq changed t)
1081 (setq font-lock-end (or (text-property-any font-lock-end (point-max)
1082 'font-lock-multiline nil)
1083 (point-max))))
1084 changed))
1085
1086
1087(defun font-lock-extend-region-wholelines ()
1088 "Move fontification boundaries to beginning of lines."
1089 (let ((changed nil))
1090 (goto-char font-lock-beg)
1091 (unless (bolp) (setq changed t font-lock-beg (line-beginning-position)))
1092 (goto-char font-lock-end)
1093 (unless (bolp) (setq changed t font-lock-end (line-beginning-position 2)))
1094 changed))
1095
1024(defun font-lock-default-fontify-region (beg end loudly) 1096(defun font-lock-default-fontify-region (beg end loudly)
1025 (save-buffer-state 1097 (save-buffer-state
1026 ((parse-sexp-lookup-properties 1098 ((parse-sexp-lookup-properties
@@ -1032,24 +1104,21 @@ a very meaningful entity to highlight.")
1032 ;; Use the fontification syntax table, if any. 1104 ;; Use the fontification syntax table, if any.
1033 (when font-lock-syntax-table 1105 (when font-lock-syntax-table
1034 (set-syntax-table font-lock-syntax-table)) 1106 (set-syntax-table font-lock-syntax-table))
1035 (goto-char beg) 1107 ;; Extend the region to fontify so that it starts and ends at
1036 (setq beg (line-beginning-position)) 1108 ;; safe places.
1037 ;; check to see if we should expand the beg/end area for 1109 (let ((funs font-lock-extend-region-functions)
1038 ;; proper multiline matches 1110 (font-lock-beg beg)
1039 (when (and (> beg (point-min)) 1111 (font-lock-end end))
1040 (get-text-property (1- beg) 'font-lock-multiline)) 1112 (while funs
1041 ;; We are just after or in a multiline match. 1113 (setq funs (if (or (not (funcall (car funs)))
1042 (setq beg (or (previous-single-property-change 1114 (eq funs font-lock-extend-region-functions))
1043 beg 'font-lock-multiline) 1115 (cdr funs)
1044 (point-min))) 1116 ;; If there's been a change, we should go through
1045 (goto-char beg) 1117 ;; the list again since this new position may
1046 (setq beg (line-beginning-position))) 1118 ;; warrant a different answer from one of the fun
1047 (setq end (or (text-property-any end (point-max) 1119 ;; we've already seen.
1048 'font-lock-multiline nil) 1120 font-lock-extend-region-functions)))
1049 (point-max))) 1121 (setq beg font-lock-beg end font-lock-end))
1050 (goto-char end)
1051 ;; Round up to a whole line.
1052 (unless (bolp) (setq end (line-beginning-position 2)))
1053 ;; Now do the fontification. 1122 ;; Now do the fontification.
1054 (font-lock-unfontify-region beg end) 1123 (font-lock-unfontify-region beg end)
1055 (when font-lock-syntactic-keywords 1124 (when font-lock-syntactic-keywords
@@ -1083,19 +1152,77 @@ what properties to clear before refontifying a region.")
1083 1152
1084;; Called when any modification is made to buffer text. 1153;; Called when any modification is made to buffer text.
1085(defun font-lock-after-change-function (beg end old-len) 1154(defun font-lock-after-change-function (beg end old-len)
1086 (let ((inhibit-point-motion-hooks t) 1155 (save-excursion
1087 (inhibit-quit t) 1156 (let ((inhibit-point-motion-hooks t)
1088 (region (font-lock-extend-region beg end old-len))) 1157 (inhibit-quit t)
1089 (save-excursion 1158 (region (if font-lock-extend-after-change-region-function
1159 (funcall font-lock-extend-after-change-region-function
1160 beg end old-len))))
1090 (save-match-data 1161 (save-match-data
1091 (if region 1162 (if region
1092 ;; Fontify the region the major mode has specified. 1163 ;; Fontify the region the major mode has specified.
1093 (setq beg (car region) end (cdr region)) 1164 (setq beg (car region) end (cdr region))
1094 ;; Fontify the whole lines which enclose the region. 1165 ;; Fontify the whole lines which enclose the region.
1095 (setq beg (progn (goto-char beg) (line-beginning-position)) 1166 ;; Actually, this is not needed because
1096 end (progn (goto-char end) (line-beginning-position 2)))) 1167 ;; font-lock-default-fontify-region already rounds up to a whole
1168 ;; number of lines.
1169 ;; (setq beg (progn (goto-char beg) (line-beginning-position))
1170 ;; end (progn (goto-char end) (line-beginning-position 2)))
1171 )
1097 (font-lock-fontify-region beg end))))) 1172 (font-lock-fontify-region beg end)))))
1098 1173
1174(defvar jit-lock-start) (defvar jit-lock-end)
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'."
1183 (save-excursion
1184 ;; First extend the region as font-lock-after-change-function would.
1185 (let ((region (if font-lock-extend-after-change-region-function
1186 (funcall font-lock-extend-after-change-region-function
1187 beg end old-len))))
1188 (if region
1189 (setq beg (min jit-lock-start (car region))
1190 end (max jit-lock-end (cdr region))))
1191 ;; Then extend the region obeying font-lock-multiline properties,
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.
1203 (when (and (> beg (point-min))
1204 (get-text-property (1- beg) 'font-lock-multiline))
1205 (setq beg (or (previous-single-property-change
1206 beg 'font-lock-multiline)
1207 (point-min))))
1208 (setq end (or (text-property-any end (point-max)
1209 'font-lock-multiline nil)
1210 (point-max)))
1211 ;; Finally, pre-enlarge the region to a whole number of lines, to try
1212 ;; and anticipate what font-lock-default-fontify-region will do, so as to
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.
1217 (when (memq 'font-lock-extend-region-wholelines
1218 font-lock-extend-region-functions)
1219 (goto-char beg)
1220 (forward-line 0)
1221 (setq jit-lock-start (min jit-lock-start (point)))
1222 (goto-char end)
1223 (forward-line 1)
1224 (setq jit-lock-end (max jit-lock-end (point)))))))
1225
1099(defun font-lock-fontify-block (&optional arg) 1226(defun font-lock-fontify-block (&optional arg)
1100 "Fontify some lines the way `font-lock-fontify-buffer' would. 1227 "Fontify some lines the way `font-lock-fontify-buffer' would.
1101The lines could be a function or paragraph, or a specified number of lines. 1228The lines could be a function or paragraph, or a specified number of lines.
diff --git a/lisp/format.el b/lisp/format.el
index 58c69575d36..66eca0c2ac2 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -117,17 +117,17 @@ DOC-STR should be a single line providing more information about the
117 117
118REGEXP is a regular expression to match against the beginning of the file; 118REGEXP is a regular expression to match against the beginning of the file;
119 it should match only files in that format. Use nil to avoid 119 it should match only files in that format. Use nil to avoid
120 matching at all for formats for which this isn't appropriate to 120 matching at all for formats for which it isn't appropriate to
121 require explicit encoding/decoding. 121 require explicit encoding/decoding.
122 122
123FROM-FN is called to decode files in that format; it gets two args, BEGIN 123FROM-FN is called to decode files in that format; it takes two args, BEGIN
124 and END, and can make any modifications it likes, returning the new 124 and END, and can make any modifications it likes, returning the new
125 end. It must make sure that the beginning of the file no longer 125 end. It must make sure that the beginning of the file no longer
126 matches REGEXP, or else it will get called again. 126 matches REGEXP, or else it will get called again.
127 Alternatively, FROM-FN can be a string, which specifies a shell command 127 Alternatively, FROM-FN can be a string, which specifies a shell command
128 (including options) to be used as a filter to perform the conversion. 128 (including options) to be used as a filter to perform the conversion.
129 129
130TO-FN is called to encode a region into that format; it is passed three 130TO-FN is called to encode a region into that format; it takes three
131 arguments: BEGIN, END, and BUFFER. BUFFER is the original buffer that 131 arguments: BEGIN, END, and BUFFER. BUFFER is the original buffer that
132 the data being written came from, which the function could use, for 132 the data being written came from, which the function could use, for
133 example, to find the values of local variables. TO-FN should either 133 example, to find the values of local variables. TO-FN should either
@@ -142,7 +142,7 @@ MODIFY, if non-nil, means the TO-FN wants to modify the region. If nil,
142 142
143MODE-FN, if specified, is called when visiting a file with that format. 143MODE-FN, if specified, is called when visiting a file with that format.
144 It is called with a single positive argument, on the assumption 144 It is called with a single positive argument, on the assumption
145 that it turns on some Emacs mode. 145 that this would turn on some minor mode.
146 146
147PRESERVE, if non-nil, means that `format-write-file' should not remove 147PRESERVE, if non-nil, means that `format-write-file' should not remove
148 this format from `buffer-file-formats'.") 148 this format from `buffer-file-formats'.")
@@ -150,8 +150,8 @@ PRESERVE, if non-nil, means that `format-write-file' should not remove
150;;; Basic Functions (called from Lisp) 150;;; Basic Functions (called from Lisp)
151 151
152(defun format-encode-run-method (method from to &optional buffer) 152(defun format-encode-run-method (method from to &optional buffer)
153 "Translate using function or shell script METHOD the text from FROM to TO. 153 "Translate using METHOD the text from FROM to TO.
154If METHOD is a string, it is a shell command; 154If METHOD is a string, it is a shell command (including options);
155otherwise, it should be a Lisp function. 155otherwise, it should be a Lisp function.
156BUFFER should be the buffer that the output originally came from." 156BUFFER should be the buffer that the output originally came from."
157 (if (stringp method) 157 (if (stringp method)
@@ -173,9 +173,9 @@ BUFFER should be the buffer that the output originally came from."
173 (funcall method from to buffer))) 173 (funcall method from to buffer)))
174 174
175(defun format-decode-run-method (method from to &optional buffer) 175(defun format-decode-run-method (method from to &optional buffer)
176 "Decode using function or shell script METHOD the text from FROM to TO. 176 "Decode using METHOD the text from FROM to TO.
177If METHOD is a string, it is a shell command; otherwise, it should be 177If METHOD is a string, it is a shell command (including options); otherwise,
178a Lisp function. Decoding is done for the given BUFFER." 178it should be a Lisp function. Decoding is done for the given BUFFER."
179 (if (stringp method) 179 (if (stringp method)
180 (let ((error-buff (get-buffer-create "*Format Errors*")) 180 (let ((error-buff (get-buffer-create "*Format Errors*"))
181 (coding-system-for-write 'no-conversion) 181 (coding-system-for-write 'no-conversion)
@@ -200,15 +200,15 @@ a Lisp function. Decoding is done for the given BUFFER."
200 200
201(defun format-annotate-function (format from to orig-buf format-count) 201(defun format-annotate-function (format from to orig-buf format-count)
202 "Return annotations for writing region as FORMAT. 202 "Return annotations for writing region as FORMAT.
203FORMAT is a symbol naming one of the formats defined in `format-alist', 203FORMAT is a symbol naming one of the formats defined in `format-alist'.
204it must be a single symbol, not a list like `buffer-file-format'. 204It must be a single symbol, not a list like `buffer-file-format'.
205FROM and TO delimit the region to be operated on in the current buffer. 205FROM and TO delimit the region to be operated on in the current buffer.
206ORIG-BUF is the original buffer that the data came from. 206ORIG-BUF is the original buffer that the data came from.
207 207
208FORMAT-COUNT is an integer specifying how many times this function has 208FORMAT-COUNT is an integer specifying how many times this function has
209been called in the process of decoding ORIG-BUF. 209been called in the process of decoding ORIG-BUF.
210 210
211This function works like a function on `write-region-annotate-functions': 211This function works like a function in `write-region-annotate-functions':
212it either returns a list of annotations, or returns with a different buffer 212it either returns a list of annotations, or returns with a different buffer
213current, which contains the modified text to write. In the latter case, 213current, which contains the modified text to write. In the latter case,
214this function's value is nil. 214this function's value is nil.
@@ -253,7 +253,7 @@ If optional third arg VISIT-FLAG is true, set `buffer-file-format'
253to the reverted list of formats used, and call any mode functions defined 253to the reverted list of formats used, and call any mode functions defined
254for those formats. 254for those formats.
255 255
256Returns the new length of the decoded region. 256Return the new length of the decoded region.
257 257
258For most purposes, consider using `format-decode-region' instead." 258For most purposes, consider using `format-decode-region' instead."
259 (let ((mod (buffer-modified-p)) 259 (let ((mod (buffer-modified-p))
@@ -312,9 +312,9 @@ For most purposes, consider using `format-decode-region' instead."
312 312
313(defun format-decode-buffer (&optional format) 313(defun format-decode-buffer (&optional format)
314 "Translate the buffer from some FORMAT. 314 "Translate the buffer from some FORMAT.
315If the format is not specified, this function attempts to guess. 315If the format is not specified, attempt a regexp-based guess.
316`buffer-file-format' is set to the format used, and any mode-functions 316Set `buffer-file-format' to the format used, and call any
317for the format are called." 317format-specific mode functions."
318 (interactive 318 (interactive
319 (list (format-read "Translate buffer from format (default guess): "))) 319 (list (format-read "Translate buffer from format (default guess): ")))
320 (save-excursion 320 (save-excursion
@@ -343,7 +343,7 @@ formats defined in `format-alist', or a list of such symbols."
343 343
344(defun format-encode-region (beg end &optional format) 344(defun format-encode-region (beg end &optional format)
345 "Translate the region into some FORMAT. 345 "Translate the region into some FORMAT.
346FORMAT defaults to `buffer-file-format', it is a symbol naming 346FORMAT defaults to `buffer-file-format'. It is a symbol naming
347one of the formats defined in `format-alist', or a list of such symbols." 347one of the formats defined in `format-alist', or a list of such symbols."
348 (interactive 348 (interactive
349 (list (region-beginning) (region-end) 349 (list (region-beginning) (region-end)
@@ -374,9 +374,9 @@ Make buffer visit that file and set the format as the default for future
374saves. If the buffer is already visiting a file, you can specify a directory 374saves. If the buffer is already visiting a file, you can specify a directory
375name as FILENAME, to write a file of the same old name in that directory. 375name as FILENAME, to write a file of the same old name in that directory.
376 376
377If optional third arg CONFIRM is non-nil, this function asks for 377If optional third arg CONFIRM is non-nil, ask for confirmation before
378confirmation before overwriting an existing file. Interactively, 378overwriting an existing file. Interactively, confirmation is required
379confirmation is required unless you supply a prefix argument." 379unless you supply a prefix argument."
380 (interactive 380 (interactive
381 ;; Same interactive spec as write-file, plus format question. 381 ;; Same interactive spec as write-file, plus format question.
382 (let* ((file (if buffer-file-name 382 (let* ((file (if buffer-file-name
@@ -419,7 +419,7 @@ If FORMAT is nil then do not do any format conversion."
419 "Insert the contents of file FILENAME using data format FORMAT. 419 "Insert the contents of file FILENAME using data format FORMAT.
420If FORMAT is nil then do not do any format conversion. 420If FORMAT is nil then do not do any format conversion.
421The optional third and fourth arguments BEG and END specify 421The optional third and fourth arguments BEG and END specify
422the part of the file to read. 422the part (in bytes) of the file to read.
423 423
424The return value is like the value of `insert-file-contents': 424The return value is like the value of `insert-file-contents':
425a list (ABSOLUTE-FILE-NAME SIZE)." 425a list (ABSOLUTE-FILE-NAME SIZE)."
@@ -456,10 +456,10 @@ Formats are defined in `format-alist'. Optional arg is the PROMPT to use."
456(defun format-replace-strings (alist &optional reverse beg end) 456(defun format-replace-strings (alist &optional reverse beg end)
457 "Do multiple replacements on the buffer. 457 "Do multiple replacements on the buffer.
458ALIST is a list of (FROM . TO) pairs, which should be proper arguments to 458ALIST is a list of (FROM . TO) pairs, which should be proper arguments to
459`search-forward' and `replace-match' respectively. 459`search-forward' and `replace-match', respectively.
460Optional 2nd arg REVERSE, if non-nil, means the pairs are (TO . FROM), so that 460Optional second arg REVERSE, if non-nil, means the pairs are (TO . FROM),
461you can use the same list in both directions if it contains only literal 461so that you can use the same list in both directions if it contains only
462strings. 462literal strings.
463Optional args BEG and END specify a region of the buffer on which to operate." 463Optional args BEG and END specify a region of the buffer on which to operate."
464 (save-excursion 464 (save-excursion
465 (save-restriction 465 (save-restriction
@@ -497,7 +497,7 @@ the value of `foo'."
497 497
498(defun format-make-relatively-unique (a b) 498(defun format-make-relatively-unique (a b)
499 "Delete common elements of lists A and B, return as pair. 499 "Delete common elements of lists A and B, return as pair.
500Compares using `equal'." 500Compare using `equal'."
501 (let* ((acopy (copy-sequence a)) 501 (let* ((acopy (copy-sequence a))
502 (bcopy (copy-sequence b)) 502 (bcopy (copy-sequence b))
503 (tail acopy)) 503 (tail acopy))
@@ -511,9 +511,9 @@ Compares using `equal'."
511 511
512(defun format-common-tail (a b) 512(defun format-common-tail (a b)
513 "Given two lists that have a common tail, return it. 513 "Given two lists that have a common tail, return it.
514Compares with `equal', and returns the part of A that is equal to the 514Compare with `equal', and return the part of A that is equal to the
515equivalent part of B. If even the last items of the two are not equal, 515equivalent part of B. If even the last items of the two are not equal,
516returns nil." 516return nil."
517 (let ((la (length a)) 517 (let ((la (length a))
518 (lb (length b))) 518 (lb (length b)))
519 ;; Make sure they are the same length 519 ;; Make sure they are the same length
@@ -534,9 +534,9 @@ A proper list is a list ending with a nil cdr, not with an atom "
534 (null list))) 534 (null list)))
535 535
536(defun format-reorder (items order) 536(defun format-reorder (items order)
537 "Arrange ITEMS to following partial ORDER. 537 "Arrange ITEMS to follow partial ORDER.
538Elements of ITEMS equal to elements of ORDER will be rearranged to follow the 538Elements of ITEMS equal to elements of ORDER will be rearranged
539ORDER. Unmatched items will go last." 539to follow the ORDER. Unmatched items will go last."
540 (if order 540 (if order
541 (let ((item (member (car order) items))) 541 (let ((item (member (car order) items)))
542 (if item 542 (if item
@@ -793,7 +793,7 @@ yet known.
793;; next-single-property-change instead of text-property-not-all, but then 793;; next-single-property-change instead of text-property-not-all, but then
794;; we have to see if we passed TO. 794;; we have to see if we passed TO.
795(defun format-property-increment-region (from to prop delta default) 795(defun format-property-increment-region (from to prop delta default)
796 "Over the region between FROM and TO increment property PROP by amount DELTA. 796 "In the region from FROM to TO increment property PROP by amount DELTA.
797DELTA may be negative. If property PROP is nil anywhere 797DELTA may be negative. If property PROP is nil anywhere
798in the region, it is treated as though it were DEFAULT." 798in the region, it is treated as though it were DEFAULT."
799 (let ((cur from) val newval next) 799 (let ((cur from) val newval next)
@@ -810,7 +810,7 @@ in the region, it is treated as though it were DEFAULT."
810 810
811(defun format-insert-annotations (list &optional offset) 811(defun format-insert-annotations (list &optional offset)
812 "Apply list of annotations to buffer as `write-region' would. 812 "Apply list of annotations to buffer as `write-region' would.
813Inserts each element of the given LIST of buffer annotations at its 813Insert each element of the given LIST of buffer annotations at its
814appropriate place. Use second arg OFFSET if the annotations' locations are 814appropriate place. Use second arg OFFSET if the annotations' locations are
815not relative to the beginning of the buffer: annotations will be inserted 815not relative to the beginning of the buffer: annotations will be inserted
816at their location-OFFSET+1 \(ie, the offset is treated as the position of 816at their location-OFFSET+1 \(ie, the offset is treated as the position of
@@ -834,7 +834,7 @@ property is the name of the annotation that you want to use, as it is for the
834 834
835(defun format-annotate-region (from to translations format-fn ignore) 835(defun format-annotate-region (from to translations format-fn ignore)
836 "Generate annotations for text properties in the region. 836 "Generate annotations for text properties in the region.
837Searches for changes between FROM and TO, and describes them with a list of 837Search for changes between FROM and TO, and describe them with a list of
838annotations as defined by alist TRANSLATIONS and FORMAT-FN. IGNORE lists text 838annotations as defined by alist TRANSLATIONS and FORMAT-FN. IGNORE lists text
839properties not to consider; any text properties that are neither ignored nor 839properties not to consider; any text properties that are neither ignored nor
840listed in TRANSLATIONS are warned about. 840listed in TRANSLATIONS are warned about.
@@ -975,9 +975,9 @@ either strings, or lists of the form (PARAMETER VALUE)."
975 "Return annotations for property PROP changing from OLD to NEW. 975 "Return annotations for property PROP changing from OLD to NEW.
976These are searched for in the translations alist TRANSLATIONS 976These are searched for in the translations alist TRANSLATIONS
977 (see `format-annotate-region' for the format). 977 (see `format-annotate-region' for the format).
978If NEW does not appear in the list, but there is a default function, then that 978If NEW does not appear in the list, but there is a default function,
979function is called. 979then call that function.
980Returns a cons of the form (CLOSE . OPEN) 980Return a cons of the form (CLOSE . OPEN)
981where CLOSE is a list of annotations to close 981where CLOSE is a list of annotations to close
982and OPEN is a list of annotations to open. 982and OPEN is a list of annotations to open.
983 983
@@ -1016,7 +1016,7 @@ either strings, or lists of the form (PARAMETER VALUE)."
1016 (format-annotate-atomic-property-change prop-alist old new))))) 1016 (format-annotate-atomic-property-change prop-alist old new)))))
1017 1017
1018(defun format-annotate-atomic-property-change (prop-alist old new) 1018(defun format-annotate-atomic-property-change (prop-alist old new)
1019 "Internal function annotate a single property change. 1019 "Internal function to annotate a single property change.
1020PROP-ALIST is the relevant element of a TRANSLATIONS list. 1020PROP-ALIST is the relevant element of a TRANSLATIONS list.
1021OLD and NEW are the values." 1021OLD and NEW are the values."
1022 (let (num-ann) 1022 (let (num-ann)
diff --git a/lisp/frame.el b/lisp/frame.el
index e965007c8b0..1ad42e387a8 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1362,49 +1362,19 @@ The function `blink-cursor-start' is called when the timer fires.")
1362This timer calls `blink-cursor-timer-function' every 1362This timer calls `blink-cursor-timer-function' every
1363`blink-cursor-interval' seconds.") 1363`blink-cursor-interval' seconds.")
1364 1364
1365(define-minor-mode blink-cursor-mode
1366 "Toggle blinking cursor mode.
1367With a numeric argument, turn blinking cursor mode on iff ARG is positive.
1368When blinking cursor mode is enabled, the cursor of the selected
1369window blinks.
1370
1371Note that this command is effective only when Emacs
1372displays through a window system, because then Emacs does its own
1373cursor display. On a text-only terminal, this is not implemented."
1374 :init-value (not (or noninteractive
1375 no-blinking-cursor
1376 (eq system-type 'ms-dos)
1377 (not (memq initial-window-system '(x w32 mac)))))
1378 :initialize 'custom-initialize-safe-default
1379 :group 'cursor
1380 :global t
1381 (if blink-cursor-idle-timer (cancel-timer blink-cursor-idle-timer))
1382 (if blink-cursor-timer (cancel-timer blink-cursor-timer))
1383 (setq blink-cursor-idle-timer nil
1384 blink-cursor-timer nil)
1385 (if blink-cursor-mode
1386 (progn
1387 ;; Hide the cursor.
1388 ;;(internal-show-cursor nil nil)
1389 (setq blink-cursor-idle-timer
1390 (run-with-idle-timer blink-cursor-delay
1391 blink-cursor-delay
1392 'blink-cursor-start)))
1393 (internal-show-cursor nil t)))
1394
1395(define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1")
1396
1397(defun blink-cursor-start () 1365(defun blink-cursor-start ()
1398 "Timer function called from the timer `blink-cursor-idle-timer'. 1366 "Timer function called from the timer `blink-cursor-idle-timer'.
1399This starts the timer `blink-cursor-timer', which makes the cursor blink 1367This starts the timer `blink-cursor-timer', which makes the cursor blink
1400if appropriate. It also arranges to cancel that timer when the next 1368if appropriate. It also arranges to cancel that timer when the next
1401command starts, by installing a pre-command hook." 1369command starts, by installing a pre-command hook."
1402 (when (null blink-cursor-timer) 1370 (when (null blink-cursor-timer)
1403 (add-hook 'pre-command-hook 'blink-cursor-end) 1371 ;; Set up the timer first, so that if this signals an error,
1404 (internal-show-cursor nil nil) 1372 ;; blink-cursor-end is not added to pre-command-hook.
1405 (setq blink-cursor-timer 1373 (setq blink-cursor-timer
1406 (run-with-timer blink-cursor-interval blink-cursor-interval 1374 (run-with-timer blink-cursor-interval blink-cursor-interval
1407 'blink-cursor-timer-function)))) 1375 'blink-cursor-timer-function))
1376 (add-hook 'pre-command-hook 'blink-cursor-end)
1377 (internal-show-cursor nil nil)))
1408 1378
1409(defun blink-cursor-timer-function () 1379(defun blink-cursor-timer-function ()
1410 "Timer function of timer `blink-cursor-timer'." 1380 "Timer function of timer `blink-cursor-timer'."
@@ -1417,10 +1387,38 @@ When run, it cancels the timer `blink-cursor-timer' and removes
1417itself as a pre-command hook." 1387itself as a pre-command hook."
1418 (remove-hook 'pre-command-hook 'blink-cursor-end) 1388 (remove-hook 'pre-command-hook 'blink-cursor-end)
1419 (internal-show-cursor nil t) 1389 (internal-show-cursor nil t)
1420 (cancel-timer blink-cursor-timer) 1390 (when blink-cursor-timer
1421 (setq blink-cursor-timer nil)) 1391 (cancel-timer blink-cursor-timer)
1392 (setq blink-cursor-timer nil)))
1422 1393
1394(define-minor-mode blink-cursor-mode
1395 "Toggle blinking cursor mode.
1396With a numeric argument, turn blinking cursor mode on iff ARG is positive.
1397When blinking cursor mode is enabled, the cursor of the selected
1398window blinks.
1423 1399
1400Note that this command is effective only when Emacs
1401displays through a window system, because then Emacs does its own
1402cursor display. On a text-only terminal, this is not implemented."
1403 :init-value (not (or noninteractive
1404 no-blinking-cursor
1405 (eq system-type 'ms-dos)
1406 (not (memq window-system '(x w32 mac)))))
1407 :initialize 'custom-initialize-safe-default
1408 :group 'cursor
1409 :global t
1410 (if blink-cursor-idle-timer (cancel-timer blink-cursor-idle-timer))
1411 (setq blink-cursor-idle-timer nil)
1412 (blink-cursor-end)
1413 (when blink-cursor-mode
1414 ;; Hide the cursor.
1415 ;;(internal-show-cursor nil nil)
1416 (setq blink-cursor-idle-timer
1417 (run-with-idle-timer blink-cursor-delay
1418 blink-cursor-delay
1419 'blink-cursor-start))))
1420
1421(define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1")
1424 1422
1425;; Hourglass pointer 1423;; Hourglass pointer
1426 1424
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index beccd918c3e..6927e3bfbac 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,47 @@
12006-08-23 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
2
3 [ Backported bug fix from No Gnus. ]
4
5 * gnus.el (gnus-find-method-for-group): On killed/unknown groups, try
6 looking up the method using GROUP's prefix before inventing a new one.
7 It is used on killed/unknown groups in various places where returning
8 an all-new method isn't expected by the caller.
9
10 * gnus-util.el (gnus-group-server): Copy required macro from No Gnus.
11
122006-08-13 Romain Francoise <romain@orebokech.com>
13
14 * mm-extern.el (mm-extern-mail-server): End `y-or-n-p' prompt with a
15 space.
16
172006-08-09 Katsumi Yamaoka <yamaoka@jpl.org>
18
19 * compface.el (uncompface): Use binary rather than raw-text-unix.
20
212006-08-09 Katsumi Yamaoka <yamaoka@jpl.org>
22
23 * compface.el (uncompface): Make sure the eol conversion doesn't take
24 place when communicating with the external programs. Reported by
25 ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
26
272006-07-31 Katsumi Yamaoka <yamaoka@jpl.org>
28
29 * nnheader.el (nnheader-insert-head): Fix typo in comment.
30
312006-07-31 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
32
33 * nnweb.el (nnweb-google-parse-1): Update regexp for author and date.
34 Make it more robust by parsing author and date independently.
35
362006-07-28 Katsumi Yamaoka <yamaoka@jpl.org>
37
38 * nnheader.el (nnheader-insert-head): Make it work with Mac as well.
39
402006-07-27 Katsumi Yamaoka <yamaoka@jpl.org>
41
42 * nnheader.el (nnheader-insert-head): Make it work even if the file
43 uses CRLF for the line-break code.
44
12006-07-19 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 452006-07-19 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
2 46
3 * mm-url.el (mm-url-insert-file-contents): Inhibit Connection: close 47 * mm-url.el (mm-url-insert-file-contents): Inhibit Connection: close
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/gnus-util.el b/lisp/gnus/gnus-util.el
index 6b525fc490c..6f706fabce5 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -607,6 +607,17 @@ If N, return the Nth ancestor instead."
607 (substring gname (match-end 0)) 607 (substring gname (match-end 0))
608 gname))) 608 gname)))
609 609
610(defmacro gnus-group-server (group)
611 "Find the server name of a foreign newsgroup.
612For example, (gnus-group-server \"nnimap+yxa:INBOX.foo\") would
613yield \"nnimap:yxa\"."
614 `(let ((gname ,group))
615 (if (string-match "^\\([^:+]+\\)\\(?:\\+\\([^:]*\\)\\)?:" gname)
616 (format "%s:%s" (match-string 1 gname) (or
617 (match-string 2 gname)
618 ""))
619 (format "%s:%s" (car gnus-select-method) (cadr gnus-select-method)))))
620
610(defun gnus-make-sort-function (funs) 621(defun gnus-make-sort-function (funs)
611 "Return a composite sort condition based on the functions in FUNS." 622 "Return a composite sort condition based on the functions in FUNS."
612 (cond 623 (cond
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 7a04c61151a..8554b1332f1 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -4079,8 +4079,13 @@ If NEWSGROUP is nil, return the global kill file name instead."
4079 (or gnus-override-method 4079 (or gnus-override-method
4080 (and (not group) 4080 (and (not group)
4081 gnus-select-method) 4081 gnus-select-method)
4082 (and (not (gnus-group-entry group)) ;; a new group 4082 (and (not (gnus-group-entry group))
4083 (gnus-group-name-to-method group)) 4083 ;; Killed or otherwise unknown group.
4084 (or
4085 ;; If we know a virtual server by that name, return its method.
4086 (gnus-server-to-method (gnus-group-server group))
4087 ;; Guess a new method as last resort.
4088 (gnus-group-name-to-method group)))
4084 (let ((info (or info (gnus-get-info group))) 4089 (let ((info (or info (gnus-get-info group)))
4085 method) 4090 method)
4086 (if (or (not info) 4091 (if (or (not info)
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 d564d42414e..82e1d3ab554 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -586,17 +586,27 @@ the line could be found."
586 (if (eq nnheader-max-head-length t) 586 (if (eq nnheader-max-head-length t)
587 ;; Just read the entire file. 587 ;; Just read the entire file.
588 (nnheader-insert-file-contents file) 588 (nnheader-insert-file-contents file)
589 ;; Read 1K blocks until we find a separator. 589 ;; Read blocks of the size specified by `nnheader-head-chop-length'
590 ;; until we find a separator.
590 (let ((beg 0) 591 (let ((beg 0)
591 format-alist) 592 (start (point))
593 ;; Use `binary' to prevent the contents from being decoded,
594 ;; or it will change the number of characters that
595 ;; `insert-file-contents' returns.
596 (coding-system-for-read 'binary))
592 (while (and (eq nnheader-head-chop-length 597 (while (and (eq nnheader-head-chop-length
593 (nth 1 (nnheader-insert-file-contents 598 (nth 1 (mm-insert-file-contents
594 file nil beg 599 file nil beg
595 (incf beg nnheader-head-chop-length)))) 600 (incf beg nnheader-head-chop-length))))
596 (prog1 (not (search-forward "\n\n" nil t)) 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))
597 (goto-char (point-max))) 603 (goto-char (point-max)))
598 (or (null nnheader-max-head-length) 604 (or (null nnheader-max-head-length)
599 (< beg nnheader-max-head-length)))))) 605 (< beg nnheader-max-head-length))))
606 ;; Finally decode the contents.
607 (when (mm-coding-system-p nnheader-file-coding-system)
608 (mm-decode-coding-region start (point-max)
609 nnheader-file-coding-system))))
600 t)) 610 t))
601 611
602(defun nnheader-article-p () 612(defun nnheader-article-p ()
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/ido.el b/lisp/ido.el
index be1cba62f27..2d531728b67 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1840,6 +1840,7 @@ If INITIAL is non-nil, it specifies the initial input string."
1840 (and d (cdr d))))))) 1840 (and d (cdr d)))))))
1841 (if (member ido-default-item ido-ignore-item-temp-list) 1841 (if (member ido-default-item ido-ignore-item-temp-list)
1842 (setq ido-default-item nil)) 1842 (setq ido-default-item nil))
1843 (ido-trace "new default" ido-default-item)
1843 (setq ido-set-default-item nil)) 1844 (setq ido-set-default-item nil))
1844 1845
1845 (if ido-process-ignore-lists-inhibit 1846 (if ido-process-ignore-lists-inhibit
@@ -3528,37 +3529,40 @@ for first matching file."
3528 (let* ((case-fold-search ido-case-fold) 3529 (let* ((case-fold-search ido-case-fold)
3529 (slash (and (not ido-enable-prefix) (ido-final-slash ido-text))) 3530 (slash (and (not ido-enable-prefix) (ido-final-slash ido-text)))
3530 (text (if slash (substring ido-text 0 -1) ido-text)) 3531 (text (if slash (substring ido-text 0 -1) ido-text))
3531 (rexq (concat (if ido-enable-regexp text (regexp-quote text)) (if slash ".*/" ""))) 3532 (rex0 (if ido-enable-regexp text (regexp-quote text)))
3533 (rexq (concat rex0 (if slash ".*/" "")))
3532 (re (if ido-enable-prefix (concat "\\`" rexq) rexq)) 3534 (re (if ido-enable-prefix (concat "\\`" rexq) rexq))
3533 (full-re (and do-full (not ido-enable-regexp) (not (string-match "\$\\'" re)) 3535 (full-re (and do-full (not ido-enable-regexp) (not (string-match "\$\\'" rex0))
3534 (concat "\\`" re "\\'"))) 3536 (concat "\\`" rex0 (if slash "/" "") "\\'")))
3537 (suffix-re (and do-full slash
3538 (not ido-enable-regexp) (not (string-match "\$\\'" rex0))
3539 (concat rex0 "/\\'")))
3535 (prefix-re (and full-re (not ido-enable-prefix) 3540 (prefix-re (and full-re (not ido-enable-prefix)
3536 (concat "\\`" rexq))) 3541 (concat "\\`" rexq)))
3537 (non-prefix-dot (or (not ido-enable-dot-prefix) 3542 (non-prefix-dot (or (not ido-enable-dot-prefix)
3538 (not ido-process-ignore-lists) 3543 (not ido-process-ignore-lists)
3539 ido-enable-prefix 3544 ido-enable-prefix
3540 (= (length ido-text) 0))) 3545 (= (length ido-text) 0)))
3541 3546 full-matches suffix-matches prefix-matches matches)
3542 full-matches
3543 prefix-matches
3544 matches)
3545 (setq ido-incomplete-regexp nil) 3547 (setq ido-incomplete-regexp nil)
3546 (condition-case error 3548 (condition-case error
3547 (mapcar 3549 (mapcar
3548 (lambda (item) 3550 (lambda (item)
3549 (let ((name (ido-name item))) 3551 (let ((name (ido-name item)))
3550 (if (and (or non-prefix-dot 3552 (if (and (or non-prefix-dot
3551 (if (= (aref ido-text 0) ?.) 3553 (if (= (aref ido-text 0) ?.)
3552 (= (aref name 0) ?.) 3554 (= (aref name 0) ?.)
3553 (/= (aref name 0) ?.))) 3555 (/= (aref name 0) ?.)))
3554 (string-match re name)) 3556 (string-match re name))
3555 (cond 3557 (cond
3556 ((and full-re (string-match full-re name)) 3558 ((and full-re (string-match full-re name))
3557 (setq full-matches (cons item full-matches))) 3559 (setq full-matches (cons item full-matches)))
3558 ((and prefix-re (string-match prefix-re name)) 3560 ((and suffix-re (string-match suffix-re name))
3559 (setq prefix-matches (cons item prefix-matches))) 3561 (setq suffix-matches (cons item suffix-matches)))
3560 (t (setq matches (cons item matches)))))) 3562 ((and prefix-re (string-match prefix-re name))
3561 t) 3563 (setq prefix-matches (cons item prefix-matches)))
3564 (t (setq matches (cons item matches))))))
3565 t)
3562 items) 3566 items)
3563 (invalid-regexp 3567 (invalid-regexp
3564 (setq ido-incomplete-regexp t 3568 (setq ido-incomplete-regexp t
@@ -3566,10 +3570,15 @@ for first matching file."
3566 ;; special-case single match, and handle appropriately 3570 ;; special-case single match, and handle appropriately
3567 ;; elsewhere. 3571 ;; elsewhere.
3568 matches (cdr error)))) 3572 matches (cdr error))))
3569 (if prefix-matches 3573 (when prefix-matches
3570 (setq matches (nconc prefix-matches matches))) 3574 (ido-trace "prefix match" prefix-matches)
3571 (if full-matches 3575 (setq matches (nconc prefix-matches matches)))
3572 (setq matches (nconc full-matches matches))) 3576 (when suffix-matches
3577 (ido-trace "suffix match" (list text suffix-re suffix-matches))
3578 (setq matches (nconc suffix-matches matches)))
3579 (when full-matches
3580 (ido-trace "full match" (list text full-re full-matches))
3581 (setq matches (nconc full-matches matches)))
3573 (when (and (null matches) 3582 (when (and (null matches)
3574 ido-enable-flex-matching 3583 ido-enable-flex-matching
3575 (> (length ido-text) 1) 3584 (> (length ido-text) 1)
@@ -4096,12 +4105,13 @@ For details of keybindings, do `\\[describe-function] ido-find-file'."
4096 try-single-dir-match 4105 try-single-dir-match
4097 refresh) 4106 refresh)
4098 4107
4099 (ido-trace "\nexhibit" this-command) 4108 (when ido-trace-enable
4100 (ido-trace "dir" ido-current-directory) 4109 (ido-trace "\nexhibit" this-command)
4101 (ido-trace "contents" contents) 4110 (ido-trace "dir" ido-current-directory)
4102 (ido-trace "list" ido-cur-list) 4111 (ido-trace "contents" contents)
4103 (ido-trace "matches" ido-matches) 4112 (ido-trace "list" ido-cur-list)
4104 (ido-trace "rescan" ido-rescan) 4113 (ido-trace "matches" ido-matches)
4114 (ido-trace "rescan" ido-rescan))
4105 4115
4106 (save-excursion 4116 (save-excursion
4107 (goto-char (point-max)) 4117 (goto-char (point-max))
diff --git a/lisp/info.el b/lisp/info.el
index 87327d8656b..dc08557e28d 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -3805,6 +3805,8 @@ the variable `Info-file-list-for-emacs'."
3805 (setq other-tag 3805 (setq other-tag
3806 (cond ((save-match-data (looking-back "\\<see")) 3806 (cond ((save-match-data (looking-back "\\<see"))
3807 "") 3807 "")
3808 ((save-match-data (looking-back "\\<in"))
3809 "")
3808 ((memq (char-before) '(nil ?\. ?! ??)) 3810 ((memq (char-before) '(nil ?\. ?! ??))
3809 "See ") 3811 "See ")
3810 ((save-match-data 3812 ((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 0a2e5a7c325..57b77249ba8 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -1039,18 +1039,28 @@ but still contains full information about each coding system."
1039 1039
1040;;;###autoload 1040;;;###autoload
1041(defun describe-font (fontname) 1041(defun describe-font (fontname)
1042 "Display information about fonts which partially match FONTNAME." 1042 "Display information about a font whose name is FONTNAME.
1043 (interactive "sFontname (default current choice for ASCII chars): ") 1043The font must be already used by Emacs."
1044 (interactive "sFont name (default current choice for ASCII chars): ")
1044 (or (and window-system (fboundp 'fontset-list)) 1045 (or (and window-system (fboundp 'fontset-list))
1045 (error "No fontsets being used")) 1046 (error "No fonts being used"))
1046 (when (or (not fontname) (= (length fontname) 0)) 1047 (let (fontset font-info)
1047 (setq fontname (cdr (assq 'font (frame-parameters)))) 1048 (when (or (not fontname) (= (length fontname) 0))
1048 (if (query-fontset fontname) 1049 (setq fontname (frame-parameter nil 'font))
1049 (setq fontname 1050 ;; Check if FONTNAME is a fontset.
1050 (nth 1 (assq 'ascii (aref (fontset-info fontname) 2)))))) 1051 (if (query-fontset fontname)
1051 (let ((font-info (font-info fontname))) 1052 (setq fontset fontname
1053 fontname (nth 1 (assq 'ascii
1054 (aref (fontset-info fontname) 2))))))
1055 (setq font-info (font-info fontname))
1052 (if (null font-info) 1056 (if (null font-info)
1053 (message "No matching font") 1057 (if fontset
1058 ;; The font should be surely used. So, there's some
1059 ;; problem about getting information about it. It is
1060 ;; better to print the fontname to show which font has
1061 ;; this problem.
1062 (message "No information about \"%s\"" fontname)
1063 (message "No matching font being used"))
1054 (with-output-to-temp-buffer "*Help*" 1064 (with-output-to-temp-buffer "*Help*"
1055 (describe-font-internal font-info 'verbose))))) 1065 (describe-font-internal font-info 'verbose)))))
1056 1066
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index 0e131b665ef..89959ad8525 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -31,6 +31,8 @@
31 31
32 32
33(eval-when-compile 33(eval-when-compile
34 (require 'cl)
35
34 (defmacro with-buffer-unmodified (&rest body) 36 (defmacro with-buffer-unmodified (&rest body)
35 "Eval BODY, preserving the current buffer's modified state." 37 "Eval BODY, preserving the current buffer's modified state."
36 (declare (debug t)) 38 (declare (debug t))
@@ -169,6 +171,8 @@ If nil, contextual fontification is disabled.")
169 171
170(defvar jit-lock-stealth-timer nil 172(defvar jit-lock-stealth-timer nil
171 "Timer for stealth fontification in Just-in-time Lock mode.") 173 "Timer for stealth fontification in Just-in-time Lock mode.")
174(defvar jit-lock-stealth-repeat-timer nil
175 "Timer for repeated stealth fontification in Just-in-time Lock mode.")
172(defvar jit-lock-context-timer nil 176(defvar jit-lock-context-timer nil
173 "Timer for context fontification in Just-in-time Lock mode.") 177 "Timer for context fontification in Just-in-time Lock mode.")
174(defvar jit-lock-defer-timer nil 178(defvar jit-lock-defer-timer nil
@@ -176,6 +180,8 @@ If nil, contextual fontification is disabled.")
176 180
177(defvar jit-lock-defer-buffers nil 181(defvar jit-lock-defer-buffers nil
178 "List of buffers with pending deferred fontification.") 182 "List of buffers with pending deferred fontification.")
183(defvar jit-lock-stealth-buffers nil
184 "List of buffers that are being fontified stealthily.")
179 185
180;;; JIT lock mode 186;;; JIT lock mode
181 187
@@ -223,6 +229,13 @@ the variable `jit-lock-stealth-nice'."
223 (run-with-idle-timer jit-lock-stealth-time t 229 (run-with-idle-timer jit-lock-stealth-time t
224 'jit-lock-stealth-fontify))) 230 'jit-lock-stealth-fontify)))
225 231
232 ;; Create, but do not activate, the idle timer for repeated
233 ;; stealth fontification.
234 (when (and jit-lock-stealth-time (null jit-lock-stealth-repeat-timer))
235 (setq jit-lock-stealth-repeat-timer (timer-create))
236 (timer-set-function jit-lock-stealth-repeat-timer
237 'jit-lock-stealth-fontify '(t)))
238
226 ;; Init deferred fontification timer. 239 ;; Init deferred fontification timer.
227 (when (and jit-lock-defer-time (null jit-lock-defer-timer)) 240 (when (and jit-lock-defer-time (null jit-lock-defer-timer))
228 (setq jit-lock-defer-timer 241 (setq jit-lock-defer-timer
@@ -331,7 +344,7 @@ Defaults to the whole buffer. END can be out of bounds."
331 ;; from the end of a buffer to its start, can do repeated 344 ;; from the end of a buffer to its start, can do repeated
332 ;; `parse-partial-sexp' starting from `point-min', which can 345 ;; `parse-partial-sexp' starting from `point-min', which can
333 ;; take a long time in a large buffer. 346 ;; take a long time in a large buffer.
334 (let (next) 347 (let ((orig-start start) next)
335 (save-match-data 348 (save-match-data
336 ;; Fontify chunks beginning at START. The end of a 349 ;; Fontify chunks beginning at START. The end of a
337 ;; chunk is either `end', or the start of a region 350 ;; chunk is either `end', or the start of a region
@@ -374,6 +387,26 @@ Defaults to the whole buffer. END can be out of bounds."
374 (quit (put-text-property start next 'fontified nil) 387 (quit (put-text-property start next 'fontified nil)
375 (funcall 'signal (car err) (cdr err)))) 388 (funcall 'signal (car err) (cdr err))))
376 389
390 ;; The redisplay engine has already rendered the buffer up-to
391 ;; `orig-start' and won't notice if the above jit-lock-functions
392 ;; changed the appearance of any part of the buffer prior
393 ;; to that. So if `start' is before `orig-start', we need to
394 ;; cause a new redisplay cycle after this one so that any changes
395 ;; are properly reflected on screen.
396 ;; To make such repeated redisplay happen less often, we can
397 ;; eagerly extend the refontified region with
398 ;; jit-lock-after-change-extend-region-functions.
399 (when (< start orig-start)
400 (lexical-let ((start start)
401 (orig-start orig-start)
402 (buf (current-buffer)))
403 (run-with-timer
404 0 nil (lambda ()
405 (with-current-buffer buf
406 (with-buffer-prepared-for-jit-lock
407 (put-text-property start orig-start
408 'fontified t)))))))
409
377 ;; Find the start of the next chunk, if any. 410 ;; Find the start of the next chunk, if any.
378 (setq start (text-property-any next end 'fontified nil)))))))) 411 (setq start (text-property-any next end 'fontified nil))))))))
379 412
@@ -421,71 +454,55 @@ Value is nil if there is nothing more to fontify."
421 (t next)))) 454 (t next))))
422 result)))) 455 result))))
423 456
424 457(defun jit-lock-stealth-fontify (&optional repeat)
425(defun jit-lock-stealth-fontify ()
426 "Fontify buffers stealthily. 458 "Fontify buffers stealthily.
427This functions is called after Emacs has been idle for 459This function is called repeatedly after Emacs has become idle for
428`jit-lock-stealth-time' seconds." 460`jit-lock-stealth-time' seconds. Optional argument REPEAT is expected
429 ;; I used to check `inhibit-read-only' here, but I can't remember why. -stef 461non-nil in a repeated invocation of this function."
462 ;; Cancel timer for repeated invocations.
463 (unless repeat
464 (cancel-timer jit-lock-stealth-repeat-timer))
430 (unless (or executing-kbd-macro 465 (unless (or executing-kbd-macro
431 memory-full 466 memory-full
432 (window-minibuffer-p (selected-window))) 467 (window-minibuffer-p (selected-window))
433 (let ((buffers (buffer-list)) 468 ;; For first invocation set up `jit-lock-stealth-buffers'.
434 (outer-buffer (current-buffer)) 469 ;; In repeated invocations it's already been set up.
470 (null (if repeat
471 jit-lock-stealth-buffers
472 (setq jit-lock-stealth-buffers (buffer-list)))))
473 (let ((buffer (car jit-lock-stealth-buffers))
474 (delay 0)
435 minibuffer-auto-raise 475 minibuffer-auto-raise
436 message-log-max) 476 message-log-max
437 (with-local-quit 477 start)
438 (while (and buffers (not (input-pending-p))) 478 (if (and jit-lock-stealth-load
439 (with-current-buffer (pop buffers) 479 (> (car (load-average)) jit-lock-stealth-load))
440 (when jit-lock-mode 480 ;; Wait a little if load is too high.
441 ;; This is funny. Calling sit-for with 3rd arg non-nil 481 (setq delay jit-lock-stealth-time)
442 ;; so that it doesn't redisplay, internally calls 482 (if (buffer-live-p buffer)
443 ;; wait_reading_process_input also with a parameter 483 (with-current-buffer buffer
444 ;; saying "don't redisplay." Since this function here 484 (if (and jit-lock-mode
445 ;; is called periodically, this effectively leads to 485 (setq start (jit-lock-stealth-chunk-start (point))))
446 ;; process output not being redisplayed at all because 486 ;; Fontify one block of at most `jit-lock-chunk-size'
447 ;; redisplay_internal is never called. (That didn't 487 ;; characters.
448 ;; work in the old redisplay either.) So, we learn that 488 (with-temp-message (if jit-lock-stealth-verbose
449 ;; we mustn't call sit-for that way here. But then, we 489 (concat "JIT stealth lock "
450 ;; have to be cautious not to call sit-for in a widened 490 (buffer-name)))
451 ;; buffer, since this could display hidden parts of that 491 (jit-lock-fontify-now start
452 ;; buffer. This explains the seemingly weird use of 492 (+ start jit-lock-chunk-size))
453 ;; save-restriction/widen here. 493 ;; Run again after `jit-lock-stealth-nice' seconds.
454 494 (setq delay (or jit-lock-stealth-nice 0)))
455 (with-temp-message (if jit-lock-stealth-verbose 495 ;; Nothing to fontify here. Remove this buffer from
456 (concat "JIT stealth lock " 496 ;; `jit-lock-stealth-buffers' and run again immediately.
457 (buffer-name))) 497 (setq jit-lock-stealth-buffers (cdr jit-lock-stealth-buffers))))
458 498 ;; Buffer is no longer live. Remove it from
459 ;; In the following code, the `sit-for' calls cause a 499 ;; `jit-lock-stealth-buffers' and run again immediately.
460 ;; redisplay, so it's required that the 500 (setq jit-lock-stealth-buffers (cdr jit-lock-stealth-buffers))))
461 ;; buffer-modified flag of a buffer that is displayed 501 ;; Call us again.
462 ;; has the right value---otherwise the mode line of 502 (when jit-lock-stealth-buffers
463 ;; an unmodified buffer would show a `*'. 503 (timer-set-idle-time jit-lock-stealth-repeat-timer (current-idle-time))
464 (let (start 504 (timer-inc-time jit-lock-stealth-repeat-timer delay)
465 (nice (or jit-lock-stealth-nice 0)) 505 (timer-activate-when-idle jit-lock-stealth-repeat-timer t)))))
466 (point (point-min)))
467 (while (and (setq start
468 (jit-lock-stealth-chunk-start point))
469 ;; In case sit-for runs any timers,
470 ;; give them the expected current buffer.
471 (with-current-buffer outer-buffer
472 (sit-for nice)))
473
474 ;; fontify a block.
475 (jit-lock-fontify-now start (+ start jit-lock-chunk-size))
476 ;; If stealth jit-locking is done backwards, this leads to
477 ;; excessive O(n^2) refontification. -stef
478 ;; (when (>= jit-lock-context-unfontify-pos start)
479 ;; (setq jit-lock-context-unfontify-pos end))
480
481 ;; Wait a little if load is too high.
482 (when (and jit-lock-stealth-load
483 (> (car (load-average)) jit-lock-stealth-load))
484 ;; In case sit-for runs any timers,
485 ;; give them the expected current buffer.
486 (with-current-buffer outer-buffer
487 (sit-for (or jit-lock-stealth-time 30))))))))))))))
488
489 506
490 507
491;;; Deferred fontification. 508;;; Deferred fontification.
@@ -548,6 +565,19 @@ This functions is called after Emacs has been idle for
548 '(fontified nil jit-lock-defer-multiline nil))) 565 '(fontified nil jit-lock-defer-multiline nil)))
549 (setq jit-lock-context-unfontify-pos (point-max))))))))) 566 (setq jit-lock-context-unfontify-pos (point-max)))))))))
550 567
568(defvar jit-lock-start) (defvar jit-lock-end) ; Dynamically scoped variables.
569(defvar jit-lock-after-change-extend-region-functions nil
570 "Hook that can extend the text to refontify after a change.
571This is run after every buffer change. The functions are called with
572the three arguments of `after-change-functions': START END OLD-LEN.
573The extended region to refontify is returned indirectly by modifying
574the variables `jit-lock-start' and `jit-lock-end'.
575
576Note that extending the region this way is not strictly necessary, except
577that the nature of the redisplay code tends to otherwise leave some of
578the rehighlighted text displayed with the old highlight until the next
579redisplay (see comment about repeated redisplay in `jit-lock-fontify-now').")
580
551(defun jit-lock-after-change (start end old-len) 581(defun jit-lock-after-change (start end old-len)
552 "Mark the rest of the buffer as not fontified after a change. 582 "Mark the rest of the buffer as not fontified after a change.
553Installed on `after-change-functions'. 583Installed on `after-change-functions'.
@@ -557,44 +587,24 @@ This function ensures that lines following the change will be refontified
557in case the syntax of those lines has changed. Refontification 587in case the syntax of those lines has changed. Refontification
558will take place when text is fontified stealthily." 588will take place when text is fontified stealthily."
559 (when (and jit-lock-mode (not memory-full)) 589 (when (and jit-lock-mode (not memory-full))
560 (let ((region (font-lock-extend-region start end old-len))) 590 (let ((jit-lock-start start)
561 (save-excursion 591 (jit-lock-end end))
562 (with-buffer-prepared-for-jit-lock 592 (with-buffer-prepared-for-jit-lock
563 ;; It's important that the `fontified' property be set from the 593 (run-hook-with-args 'jit-lock-after-change-extend-region-functions
564 ;; beginning of the line, else font-lock will properly change the 594 start end old-len)
565 ;; text's face, but the display will have been done already and will 595 ;; Make sure we change at least one char (in case of deletions).
566 ;; be inconsistent with the buffer's content. 596 (setq jit-lock-end (min (max jit-lock-end (1+ start)) (point-max)))
567 ;; 597 ;; Request refontification.
568 ;; FIXME!!! (Alan Mackenzie, 2006-03-14): If start isn't at a BOL, 598 (put-text-property jit-lock-start jit-lock-end 'fontified nil))
569 ;; expanding the region to BOL might mis-fontify, should the BOL not 599 ;; Mark the change for deferred contextual refontification.
570 ;; be at a "safe" position. 600 (when jit-lock-context-unfontify-pos
571 (setq start (if region 601 (setq jit-lock-context-unfontify-pos
572 (car region) 602 ;; Here we use `start' because nothing guarantees that the
573 (goto-char start) 603 ;; text between start and end will be otherwise refontified:
574 (line-beginning-position))) 604 ;; usually it will be refontified by virtue of being
575 605 ;; displayed, but if it's outside of any displayed area in the
576 ;; If we're in text that matches a multi-line font-lock pattern, 606 ;; buffer, only jit-lock-context-* will re-fontify it.
577 ;; make sure the whole text will be redisplayed. 607 (min jit-lock-context-unfontify-pos jit-lock-start))))))
578 ;; I'm not sure this is ever necessary and/or sufficient. -stef
579 (when (get-text-property start 'font-lock-multiline)
580 (setq start (or (previous-single-property-change
581 start 'font-lock-multiline)
582 (point-min))))
583
584 (if region (setq end (cdr region)))
585 ;; Make sure we change at least one char (in case of deletions).
586 (setq end (min (max end (1+ start)) (point-max)))
587 ;; Request refontification.
588 (put-text-property start end 'fontified nil))
589 ;; Mark the change for deferred contextual refontification.
590 (when jit-lock-context-unfontify-pos
591 (setq jit-lock-context-unfontify-pos
592 ;; Here we use `start' because nothing guarantees that the
593 ;; text between start and end will be otherwise refontified:
594 ;; usually it will be refontified by virtue of being
595 ;; displayed, but if it's outside of any displayed area in the
596 ;; buffer, only jit-lock-context-* will re-fontify it.
597 (min jit-lock-context-unfontify-pos start)))))))
598 608
599(provide 'jit-lock) 609(provide 'jit-lock)
600 610
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index d3db76fcc8a..2d1f5f33847 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -409,7 +409,7 @@ Optional arg EMPTY is message to print if no macros are defined."
409 409
410 410
411(defun kmacro-repeat-on-last-key (keys) 411(defun kmacro-repeat-on-last-key (keys)
412 "Process kmacro commands keys immidiately after cycling the ring." 412 "Process kmacro commands keys immediately after cycling the ring."
413 (setq keys (vconcat keys)) 413 (setq keys (vconcat keys))
414 (let ((n (1- (length keys))) 414 (let ((n (1- (length keys)))
415 cmd done repeat) 415 cmd done repeat)
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 635059f93e5..61f15c8ef1c 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -222,8 +222,8 @@ such as redefining an Emacs function."
222 (if aload 222 (if aload
223 (fset fun (cons 'autoload aload)) 223 (fset fun (cons 'autoload aload))
224 (fmakunbound fun)))))) 224 (fmakunbound fun))))))
225 (require nil) 225 ((t require) nil)
226 (t (message "Unexpected element %s in load-history" x))) 226 (t (message "Unexpected element %s in load-history" x)))
227 ;; Kill local values as much as possible. 227 ;; Kill local values as much as possible.
228 (dolist (buf (buffer-list)) 228 (dolist (buf (buffer-list))
229 (with-current-buffer buf 229 (with-current-buffer buf
diff --git a/lisp/longlines.el b/lisp/longlines.el
index 9da3de217ab..77e0b415344 100644
--- a/lisp/longlines.el
+++ b/lisp/longlines.el
@@ -44,7 +44,7 @@
44 :group 'fill) 44 :group 'fill)
45 45
46(defcustom longlines-auto-wrap t 46(defcustom longlines-auto-wrap t
47 "*Non-nil means long lines are automatically wrapped after each command. 47 "Non-nil means long lines are automatically wrapped after each command.
48Otherwise, you can perform filling using `fill-paragraph' or 48Otherwise, you can perform filling using `fill-paragraph' or
49`auto-fill-mode'. In any case, the soft newlines will be removed 49`auto-fill-mode'. In any case, the soft newlines will be removed
50when the file is saved to disk." 50when the file is saved to disk."
@@ -52,7 +52,7 @@ when the file is saved to disk."
52 :type 'boolean) 52 :type 'boolean)
53 53
54(defcustom longlines-wrap-follows-window-size nil 54(defcustom longlines-wrap-follows-window-size nil
55 "*Non-nil means wrapping and filling happen at the edge of the window. 55 "Non-nil means wrapping and filling happen at the edge of the window.
56Otherwise, `fill-column' is used, regardless of the window size. This 56Otherwise, `fill-column' is used, regardless of the window size. This
57does not work well when the buffer is displayed in multiple windows 57does not work well when the buffer is displayed in multiple windows
58with differing widths." 58with differing widths."
@@ -60,7 +60,7 @@ with differing widths."
60 :type 'boolean) 60 :type 'boolean)
61 61
62(defcustom longlines-show-hard-newlines nil 62(defcustom longlines-show-hard-newlines nil
63 "*Non-nil means each hard newline is marked on the screen. 63 "Non-nil means each hard newline is marked on the screen.
64\(The variable `longlines-show-effect' controls what they look like.) 64\(The variable `longlines-show-effect' controls what they look like.)
65You can also enable the display temporarily, using the command 65You can also enable the display temporarily, using the command
66`longlines-show-hard-newlines'" 66`longlines-show-hard-newlines'"
@@ -68,7 +68,7 @@ You can also enable the display temporarily, using the command
68 :type 'boolean) 68 :type 'boolean)
69 69
70(defcustom longlines-show-effect (propertize "|\n" 'face 'escape-glyph) 70(defcustom longlines-show-effect (propertize "|\n" 'face 'escape-glyph)
71 "*A string to display when showing hard newlines. 71 "A string to display when showing hard newlines.
72This is used when `longlines-show-hard-newlines' is on." 72This is used when `longlines-show-hard-newlines' is on."
73 :group 'longlines 73 :group 'longlines
74 :type 'string) 74 :type 'string)
@@ -202,7 +202,8 @@ With optional argument ARG, make the hard newlines invisible again."
202 "Make hard newlines between BEG and END visible." 202 "Make hard newlines between BEG and END visible."
203 (let* ((pmin (min beg end)) 203 (let* ((pmin (min beg end))
204 (pmax (max beg end)) 204 (pmax (max beg end))
205 (pos (text-property-not-all pmin pmax 'hard nil))) 205 (pos (text-property-not-all pmin pmax 'hard nil))
206 (inhibit-read-only t))
206 (while pos 207 (while pos
207 (put-text-property pos (1+ pos) 'display 208 (put-text-property pos (1+ pos) 'display
208 (copy-sequence longlines-show-effect)) 209 (copy-sequence longlines-show-effect))
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 043c78578db..4e11b1d4c96 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -2398,6 +2398,8 @@ and selects that window."
2398(global-set-key [right-fringe mouse-1] 'mouse-set-point) 2398(global-set-key [right-fringe mouse-1] 'mouse-set-point)
2399 2399
2400(global-set-key [mouse-2] 'mouse-yank-at-click) 2400(global-set-key [mouse-2] 'mouse-yank-at-click)
2401;; Allow yanking also when the corresponding cursor is "in the fringe".
2402(global-set-key [right-fringe mouse-2] [mouse-2])
2401(global-set-key [mouse-3] 'mouse-save-then-kill) 2403(global-set-key [mouse-3] 'mouse-save-then-kill)
2402 2404
2403;; By binding these to down-going events, we let the user use the up-going 2405;; By binding these to down-going events, we let the user use the up-going
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 1f051ffa9f2..c34ac7dcf78 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -40,6 +40,8 @@
40;; Open a new irc connection with: 40;; Open a new irc connection with:
41;; M-x irc RET 41;; M-x irc RET
42 42
43;;; Todo:
44
43;;; Code: 45;;; Code:
44 46
45(require 'ring) 47(require 'ring)
@@ -140,6 +142,10 @@ number. If zero or nil, no truncating is done."
140 (integer :tag "Number of lines")) 142 (integer :tag "Number of lines"))
141 :group 'rcirc) 143 :group 'rcirc)
142 144
145(defcustom rcirc-show-maximum-output t
146 "*If non-nil, scroll buffer to keep the point at the bottom of
147the window.")
148
143(defcustom rcirc-authinfo nil 149(defcustom rcirc-authinfo nil
144 "List of authentication passwords. 150 "List of authentication passwords.
145Each element of the list is a list with a SERVER-REGEXP string 151Each element of the list is a list with a SERVER-REGEXP string
@@ -297,6 +303,7 @@ and the cdr part is used for encoding."
297 303
298(defvar rcirc-urls nil 304(defvar rcirc-urls nil
299 "List of urls seen in the current buffer.") 305 "List of urls seen in the current buffer.")
306(put 'rcirc-urls 'permanent-local t)
300 307
301(defvar rcirc-keepalive-seconds 60 308(defvar rcirc-keepalive-seconds 60
302 "Number of seconds between keepalive pings. 309 "Number of seconds between keepalive pings.
@@ -539,7 +546,10 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
539(defun rcirc-buffer-process (&optional buffer) 546(defun rcirc-buffer-process (&optional buffer)
540 "Return the process associated with channel BUFFER. 547 "Return the process associated with channel BUFFER.
541With no argument or nil as argument, use the current buffer." 548With no argument or nil as argument, use the current buffer."
542 (get-buffer-process (or buffer rcirc-server-buffer))) 549 (get-buffer-process (if buffer
550 (with-current-buffer buffer
551 rcirc-server-buffer)
552 rcirc-server-buffer)))
543 553
544(defun rcirc-server-name (process) 554(defun rcirc-server-name (process)
545 "Return PROCESS server name, given by the 001 response." 555 "Return PROCESS server name, given by the 001 response."
@@ -601,10 +611,11 @@ If NOTICEP is non-nil, send a notice instead of privmsg."
601 611
602(defvar rcirc-nick-completions nil) 612(defvar rcirc-nick-completions nil)
603(defvar rcirc-nick-completion-start-offset nil) 613(defvar rcirc-nick-completion-start-offset nil)
614
604(defun rcirc-complete-nick () 615(defun rcirc-complete-nick ()
605 "Cycle through nick completions from list of nicks in channel." 616 "Cycle through nick completions from list of nicks in channel."
606 (interactive) 617 (interactive)
607 (if (eq last-command 'rcirc-complete-nick) 618 (if (eq last-command this-command)
608 (setq rcirc-nick-completions 619 (setq rcirc-nick-completions
609 (append (cdr rcirc-nick-completions) 620 (append (cdr rcirc-nick-completions)
610 (list (car rcirc-nick-completions)))) 621 (list (car rcirc-nick-completions))))
@@ -626,9 +637,10 @@ If NOTICEP is non-nil, send a notice instead of privmsg."
626 rcirc-target)))))) 637 rcirc-target))))))
627 (let ((completion (car rcirc-nick-completions))) 638 (let ((completion (car rcirc-nick-completions)))
628 (when completion 639 (when completion
640 (rcirc-put-nick-channel (rcirc-buffer-process) completion rcirc-target)
629 (delete-region (+ rcirc-prompt-end-marker 641 (delete-region (+ rcirc-prompt-end-marker
630 rcirc-nick-completion-start-offset) 642 rcirc-nick-completion-start-offset)
631 (point)) 643 (point))
632 (insert (concat completion 644 (insert (concat completion
633 (if (= (+ rcirc-prompt-end-marker 645 (if (= (+ rcirc-prompt-end-marker
634 rcirc-nick-completion-start-offset) 646 rcirc-nick-completion-start-offset)
@@ -709,7 +721,6 @@ If NOTICEP is non-nil, send a notice instead of privmsg."
709 (make-local-variable 'rcirc-short-buffer-name) 721 (make-local-variable 'rcirc-short-buffer-name)
710 (setq rcirc-short-buffer-name nil) 722 (setq rcirc-short-buffer-name nil)
711 (make-local-variable 'rcirc-urls) 723 (make-local-variable 'rcirc-urls)
712 (setq rcirc-urls nil)
713 (setq use-hard-newlines t) 724 (setq use-hard-newlines t)
714 725
715 (make-local-variable 'rcirc-decode-coding-system) 726 (make-local-variable 'rcirc-decode-coding-system)
@@ -742,6 +753,9 @@ If NOTICEP is non-nil, send a notice instead of privmsg."
742 (make-local-variable 'kill-buffer-hook) 753 (make-local-variable 'kill-buffer-hook)
743 (add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook) 754 (add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook)
744 755
756 (make-local-variable 'window-scroll-functions)
757 (add-hook 'window-scroll-functions 'rcirc-scroll-to-bottom)
758
745 ;; add to buffer list, and update buffer abbrevs 759 ;; add to buffer list, and update buffer abbrevs
746 (when target ; skip server buffer 760 (when target ; skip server buffer
747 (let ((buffer (current-buffer))) 761 (let ((buffer (current-buffer)))
@@ -1144,6 +1158,15 @@ is found by looking up RESPONSE in `rcirc-response-formats'."
1144(make-variable-buffer-local 'rcirc-last-sender) 1158(make-variable-buffer-local 'rcirc-last-sender)
1145(defvar rcirc-gray-toggle nil) 1159(defvar rcirc-gray-toggle nil)
1146(make-variable-buffer-local 'rcirc-gray-toggle) 1160(make-variable-buffer-local 'rcirc-gray-toggle)
1161
1162(defun rcirc-scroll-to-bottom (window display-start)
1163 "Scroll window to show maximum output if `rcirc-show-maximum-output' is
1164non-nil."
1165 (when rcirc-show-maximum-output
1166 (with-selected-window window
1167 (when (>= (window-point) rcirc-prompt-end-marker)
1168 (recenter -1)))))
1169
1147(defun rcirc-print (process sender response target text &optional activity) 1170(defun rcirc-print (process sender response target text &optional activity)
1148 "Print TEXT in the buffer associated with TARGET. 1171 "Print TEXT in the buffer associated with TARGET.
1149Format based on SENDER and RESPONSE. If ACTIVITY is non-nil, 1172Format based on SENDER and RESPONSE. If ACTIVITY is non-nil,
@@ -1240,16 +1263,19 @@ record activity."
1240 ;; record modeline activity 1263 ;; record modeline activity
1241 (when activity 1264 (when activity
1242 (let ((nick-match 1265 (let ((nick-match
1243 (string-match (concat "\\b" 1266 (with-syntax-table rcirc-nick-syntax-table
1244 (regexp-quote (rcirc-nick process)) 1267 (string-match (concat "\\b"
1245 "\\b") 1268 (regexp-quote (rcirc-nick process))
1246 text))) 1269 "\\b")
1270 text))))
1247 (when (if rcirc-ignore-buffer-activity-flag 1271 (when (if rcirc-ignore-buffer-activity-flag
1248 ;; - Always notice when our nick is mentioned 1272 ;; - Always notice when our nick is mentioned
1249 nick-match 1273 nick-match
1250 ;; - Never bother us if a dim-nick spoke 1274 ;; - unless our nick is mentioned, don't bother us
1251 (not (and rcirc-dim-nick-regexp sender 1275 ;; - with dim-nicks
1252 (string-match rcirc-dim-nick-regexp sender)))) 1276 (or nick-match
1277 (not (and rcirc-dim-nick-regexp sender
1278 (string-match rcirc-dim-nick-regexp sender)))))
1253 (rcirc-record-activity 1279 (rcirc-record-activity
1254 (current-buffer) 1280 (current-buffer)
1255 (when (or nick-match (and (not (rcirc-channel-p rcirc-target)) 1281 (when (or nick-match (and (not (rcirc-channel-p rcirc-target))
@@ -1504,18 +1530,20 @@ activity. Only run if the buffer is not visible and
1504 (lopri (car pair)) 1530 (lopri (car pair))
1505 (hipri (cdr pair))) 1531 (hipri (cdr pair)))
1506 (setq rcirc-activity-string 1532 (setq rcirc-activity-string
1507 (if (or hipri lopri) 1533 (cond ((or hipri lopri)
1508 (concat "-" 1534 (concat "-"
1509 (and hipri "[") 1535 (and hipri "[")
1510 (rcirc-activity-string hipri) 1536 (rcirc-activity-string hipri)
1511 (and hipri lopri ",") 1537 (and hipri lopri ",")
1512 (and lopri 1538 (and lopri
1513 (concat "(" 1539 (concat "("
1514 (rcirc-activity-string lopri) 1540 (rcirc-activity-string lopri)
1515 ")")) 1541 ")"))
1516 (and hipri "]") 1542 (and hipri "]")
1517 "-") 1543 "-"))
1518 "-[]-")))) 1544 ((not (null (rcirc-process-list)))
1545 "-[]-")
1546 (t "")))))
1519 1547
1520(defun rcirc-activity-string (buffers) 1548(defun rcirc-activity-string (buffers)
1521 (mapconcat (lambda (b) 1549 (mapconcat (lambda (b)
@@ -1771,7 +1799,7 @@ nicks when no NICK is given. When listing ignored nicks, the
1771ones added to the list automatically are marked with an asterisk." 1799ones added to the list automatically are marked with an asterisk."
1772 (interactive "sToggle ignoring of nick: ") 1800 (interactive "sToggle ignoring of nick: ")
1773 (when (not (string= "" nick)) 1801 (when (not (string= "" nick))
1774 (if (member nick rcirc-ignore-list) 1802 (if (member-ignore-case nick rcirc-ignore-list)
1775 (setq rcirc-ignore-list (delete nick rcirc-ignore-list)) 1803 (setq rcirc-ignore-list (delete nick rcirc-ignore-list))
1776 (setq rcirc-ignore-list (cons nick rcirc-ignore-list)))) 1804 (setq rcirc-ignore-list (cons nick rcirc-ignore-list))))
1777 (rcirc-print process (rcirc-nick process) "IGNORE" target 1805 (rcirc-print process (rcirc-nick process) "IGNORE" target
@@ -1800,6 +1828,7 @@ ones added to the list automatically are marked with an asterisk."
1800 "://") 1828 "://")
1801 "www.") 1829 "www.")
1802 (1+ (char "-a-zA-Z0-9_.")) 1830 (1+ (char "-a-zA-Z0-9_."))
1831 (1+ (char "-a-zA-Z0-9_"))
1803 (optional ":" (1+ (char "0-9")))) 1832 (optional ":" (1+ (char "0-9"))))
1804 (and (1+ (char "-a-zA-Z0-9_.")) 1833 (and (1+ (char "-a-zA-Z0-9_."))
1805 (or ".com" ".net" ".org") 1834 (or ".com" ".net" ".org")
@@ -1823,7 +1852,7 @@ ones added to the list automatically are marked with an asterisk."
1823(defun rcirc-browse-url-at-point (point) 1852(defun rcirc-browse-url-at-point (point)
1824 "Send URL at point to `browse-url'." 1853 "Send URL at point to `browse-url'."
1825 (interactive "d") 1854 (interactive "d")
1826 (let ((beg (previous-single-property-change point 'mouse-face)) 1855 (let ((beg (previous-single-property-change (1+ point) 'mouse-face))
1827 (end (next-single-property-change point 'mouse-face))) 1856 (end (next-single-property-change point 'mouse-face)))
1828 (browse-url (buffer-substring-no-properties beg end)))) 1857 (browse-url (buffer-substring-no-properties beg end))))
1829 1858
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..0cf0160afb1 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -299,7 +299,7 @@ the variables are properly set."
299 (substring comment-start 1))) 299 (substring comment-start 1)))
300 ;; Hasn't been necessary yet. 300 ;; Hasn't been necessary yet.
301 ;; (unless (string-match comment-start-skip comment-continue) 301 ;; (unless (string-match comment-start-skip comment-continue)
302 ;; (kill-local-variable 'comment-continue)) 302 ;; (kill-local-variable 'comment-continue))
303 ) 303 )
304 ;; comment-skip regexps 304 ;; comment-skip regexps
305 (unless (and comment-start-skip 305 (unless (and comment-start-skip
@@ -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
@@ -764,7 +769,7 @@ comment markers."
764 (box-equal nil)) ;Whether we might be using `=' for boxes. 769 (box-equal nil)) ;Whether we might be using `=' for boxes.
765 (save-restriction 770 (save-restriction
766 (narrow-to-region spt ept) 771 (narrow-to-region spt ept)
767 772
768 ;; Remove the comment-start. 773 ;; Remove the comment-start.
769 (goto-char ipt) 774 (goto-char ipt)
770 (skip-syntax-backward " ") 775 (skip-syntax-backward " ")
@@ -793,7 +798,7 @@ comment markers."
793 ;; If there's something left but it doesn't look like 798 ;; If there's something left but it doesn't look like
794 ;; a comment-start any more, just remove it. 799 ;; a comment-start any more, just remove it.
795 (delete-region (point-min) (point)))) 800 (delete-region (point-min) (point))))
796 801
797 ;; Remove the end-comment (and leading padding and such). 802 ;; Remove the end-comment (and leading padding and such).
798 (goto-char (point-max)) (comment-enter-backward) 803 (goto-char (point-max)) (comment-enter-backward)
799 ;; Check for special `=' used sometimes in comment-box. 804 ;; Check for special `=' used sometimes in comment-box.
@@ -1057,11 +1062,13 @@ The strings used as comment starts are built from
1057 lines 1062 lines
1058 (nth 3 style)))))) 1063 (nth 3 style))))))
1059 1064
1065;;;###autoload
1060(defun comment-box (beg end &optional arg) 1066(defun comment-box (beg end &optional arg)
1061 "Comment out the BEG .. END region, putting it inside a box. 1067 "Comment out the BEG .. END region, putting it inside a box.
1062The numeric prefix ARG specifies how many characters to add to begin- and 1068The numeric prefix ARG specifies how many characters to add to begin- and
1063end- comment markers additionally to what `comment-add' already specifies." 1069end- comment markers additionally to what `comment-add' already specifies."
1064 (interactive "*r\np") 1070 (interactive "*r\np")
1071 (comment-normalize-vars)
1065 (let ((comment-style (if (cadr (assoc comment-style comment-styles)) 1072 (let ((comment-style (if (cadr (assoc comment-style comment-styles))
1066 'box-multi 'box))) 1073 'box-multi 'box)))
1067 (comment-region beg end (+ comment-add arg)))) 1074 (comment-region beg end (+ comment-add arg))))
diff --git a/lisp/pcvs-parse.el b/lisp/pcvs-parse.el
index 0193939606c..bd493126532 100644
--- a/lisp/pcvs-parse.el
+++ b/lisp/pcvs-parse.el
@@ -285,7 +285,8 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
285 (and 285 (and
286 (cvs-or 286 (cvs-or
287 (cvs-match "warning: \\(.*\\) is not (any longer) pertinent$" (file 1)) 287 (cvs-match "warning: \\(.*\\) is not (any longer) pertinent$" (file 1))
288 (cvs-match "\\(.*\\) is no longer in the repository$" (file 1))) 288 (cvs-match "`\\(.*\\)' is no longer in the repository$" (file 1))
289 (cvs-match "\\(.*\\) is no longer in the repository$" (file 1)))
289 (cvs-parsed-fileinfo 290 (cvs-parsed-fileinfo
290 (if dont-change-disc '(NEED-UPDATE . REMOVED) 'DEAD) file)) 291 (if dont-change-disc '(NEED-UPDATE . REMOVED) 'DEAD) file))
291 292
diff --git a/lisp/pcvs-util.el b/lisp/pcvs-util.el
index cb18fc83d59..84ce2e117b9 100644
--- a/lisp/pcvs-util.el
+++ b/lisp/pcvs-util.el
@@ -126,7 +126,9 @@ with `create-file-buffer' and will probably get another name than NAME.
126In such a case, the search for another buffer with the same name doesn't 126In such a case, the search for another buffer with the same name doesn't
127use the buffer name but the buffer's `list-buffers-directory' variable. 127use the buffer name but the buffer's `list-buffers-directory' variable.
128If NOREUSE is non-nil, always return a new buffer." 128If NOREUSE is non-nil, always return a new buffer."
129 (or (and (not (file-name-absolute-p name)) (get-buffer-create name)) 129 (or (and (not (file-name-absolute-p name))
130 (if noreuse (generate-new-buffer name)
131 (get-buffer-create name)))
130 (unless noreuse 132 (unless noreuse
131 (dolist (buf (buffer-list)) 133 (dolist (buf (buffer-list))
132 (with-current-buffer buf 134 (with-current-buffer buf
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 dca6fa16df0..f45bb2fe524 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
@@ -314,14 +315,14 @@ Also display the main routine in the disassembly buffer if present."
314 "Nil means just pop up the GUD buffer unless `gdb-show-main' is t. 315 "Nil means just pop up the GUD buffer unless `gdb-show-main' is t.
315In this case it starts with two windows: one displaying the GUD 316In this case it starts with two windows: one displaying the GUD
316buffer and the other with the source file with the main routine 317buffer and the other with the source file with the main routine
317of the inferior. Non-nil means display the layout shown for 318of the debugged program. Non-nil means display the layout shown for
318`gdba'." 319`gdba'."
319 :type 'boolean 320 :type 'boolean
320 :group 'gud 321 :group 'gud
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))
@@ -383,8 +384,7 @@ With arg, use separate IO iff arg is positive."
383 (list t nil) nil "-c" 384 (list t nil) nil "-c"
384 (concat gdb-cpp-define-alist-program " " 385 (concat gdb-cpp-define-alist-program " "
385 gdb-cpp-define-alist-flags))))) 386 gdb-cpp-define-alist-flags)))))
386 (define-list (split-string output "\n" t)) 387 (define-list (split-string output "\n" t)) (name))
387 (name))
388 (setq gdb-define-alist nil) 388 (setq gdb-define-alist nil)
389 (dolist (define define-list) 389 (dolist (define define-list)
390 (setq name (nth 1 (split-string define "[( ]"))) 390 (setq name (nth 1 (split-string define "[( ]")))
@@ -1030,7 +1030,7 @@ The key should be one of the cars in `gdb-buffer-rules-assoc'."
1030 (minibuffer . nil))) 1030 (minibuffer . nil)))
1031 1031
1032(defun gdb-frame-separate-io-buffer () 1032(defun gdb-frame-separate-io-buffer ()
1033 "Display IO of inferior in a new frame." 1033 "Display IO of debugged program in a new frame."
1034 (interactive) 1034 (interactive)
1035 (if gdb-use-separate-io-buffer 1035 (if gdb-use-separate-io-buffer
1036 (let ((special-display-regexps (append special-display-regexps '(".*"))) 1036 (let ((special-display-regexps (append special-display-regexps '(".*")))
@@ -1290,12 +1290,14 @@ not GDB."
1290 (progn 1290 (progn
1291 (setq gud-running t) 1291 (setq gud-running t)
1292 (setq gdb-inferior-status "running") 1292 (setq gdb-inferior-status "running")
1293 (setq gdb-signalled nil)
1293 (gdb-force-mode-line-update 1294 (gdb-force-mode-line-update
1294 (propertize gdb-inferior-status 'face font-lock-type-face)) 1295 (propertize gdb-inferior-status 'face font-lock-type-face))
1295 (gdb-remove-text-properties) 1296 (gdb-remove-text-properties)
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
@@ -1358,6 +1361,23 @@ directives."
1358 :type 'boolean 1361 :type 'boolean
1359 :version "22.1") 1362 :version "22.1")
1360 1363
1364(defcustom gdb-find-source-frame nil
1365 "Non-nil means try to find a source frame further up stack e.g after signal."
1366 :group 'gud
1367 :type 'boolean
1368 :version "22.1")
1369
1370(defun gdb-find-source-frame (arg)
1371 "Toggle trying to find a source frame further up stack.
1372With arg, look for a source frame further up stack iff arg is positive."
1373 (interactive "P")
1374 (setq gdb-find-source-frame
1375 (if (null arg)
1376 (not gdb-find-source-frame)
1377 (> (prefix-numeric-value arg) 0)))
1378 (message (format "Looking for source frame %sabled"
1379 (if gdb-find-source-frame "en" "dis"))))
1380
1361(defun gdb-stopped (ignored) 1381(defun gdb-stopped (ignored)
1362 "An annotation handler for `stopped'. 1382 "An annotation handler for `stopped'.
1363It is just like `gdb-stopping', except that if we already set the output 1383It is just like `gdb-stopping', except that if we already set the output
@@ -1371,14 +1391,15 @@ sink to `user' in `gdb-stopping', that is fine."
1371 (if gdb-same-frame 1391 (if gdb-same-frame
1372 (gdb-display-gdb-buffer) 1392 (gdb-display-gdb-buffer)
1373 (gdb-frame-gdb-buffer)) 1393 (gdb-frame-gdb-buffer))
1394 (if gdb-find-source-frame
1374 ;;Try to find source further up stack e.g after signal. 1395 ;;Try to find source further up stack e.g after signal.
1375 (setq gdb-look-up-stack 1396 (setq gdb-look-up-stack
1376 (if (gdb-get-buffer 'gdb-stack-buffer) 1397 (if (gdb-get-buffer 'gdb-stack-buffer)
1377 'keep 1398 'keep
1378 (progn 1399 (progn
1379 (gdb-get-buffer-create 'gdb-stack-buffer) 1400 (gdb-get-buffer-create 'gdb-stack-buffer)
1380 (gdb-invalidate-frames) 1401 (gdb-invalidate-frames)
1381 'delete))))) 1402 'delete))))))
1382 (unless (member gdb-inferior-status '("exited" "signal")) 1403 (unless (member gdb-inferior-status '("exited" "signal"))
1383 (setq gdb-inferior-status "stopped") 1404 (setq gdb-inferior-status "stopped")
1384 (gdb-force-mode-line-update 1405 (gdb-force-mode-line-update
@@ -1754,52 +1775,69 @@ static char *magick[] = {
1754 (gdb-remove-breakpoint-icons (point-min) (point-max))))) 1775 (gdb-remove-breakpoint-icons (point-min) (point-max)))))
1755 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) 1776 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
1756 (save-excursion 1777 (save-excursion
1778 (let ((buffer-read-only nil))
1757 (goto-char (point-min)) 1779 (goto-char (point-min))
1758 (while (< (point) (- (point-max) 1)) 1780 (while (< (point) (- (point-max) 1))
1759 (forward-line 1) 1781 (forward-line 1)
1760 (if (looking-at "[^\t].*?breakpoint") 1782 (if (looking-at gdb-breakpoint-regexp)
1761 (progn 1783 (progn
1762 (looking-at "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)")
1763 (setq bptno (match-string 1)) 1784 (setq bptno (match-string 1))
1764 (setq flag (char-after (match-beginning 2))) 1785 (setq flag (char-after (match-beginning 2)))
1765 (beginning-of-line) 1786 (add-text-properties
1766 (if (re-search-forward " in \\(.*\\) at\\s-+" nil t) 1787 (match-beginning 2) (match-end 2)
1767 (progn 1788 (if (eq flag ?y)
1768 (let ((buffer-read-only nil)) 1789 '(face font-lock-warning-face)
1769 (add-text-properties (match-beginning 1) (match-end 1) 1790 '(face font-lock-type-face)))
1770 '(face font-lock-function-name-face))) 1791 (let ((bl (point))
1771 (looking-at "\\(\\S-+\\):\\([0-9]+\\)") 1792 (el (line-end-position)))
1772 (let ((line (match-string 2)) (buffer-read-only nil) 1793 (if (re-search-forward " in \\(.*\\) at\\s-+" el t)
1773 (file (match-string 1))) 1794 (progn
1774 (add-text-properties (line-beginning-position) 1795 (add-text-properties
1775 (line-end-position) 1796 (match-beginning 1) (match-end 1)
1776 '(mouse-face highlight 1797 '(face font-lock-function-name-face))
1777 help-echo "mouse-2, RET: visit breakpoint")) 1798 (looking-at "\\(\\S-+\\):\\([0-9]+\\)")
1778 (unless (file-exists-p file) 1799 (let ((line (match-string 2))
1779 (setq file (cdr (assoc bptno gdb-location-alist)))) 1800 (file (match-string 1)))
1780 (if (and file 1801 (add-text-properties bl el
1781 (not (string-equal file "File not found"))) 1802 '(mouse-face highlight
1782 (with-current-buffer 1803 help-echo "mouse-2, RET: visit breakpoint"))
1783 (find-file-noselect file 'nowarn) 1804 (unless (file-exists-p file)
1784 (set (make-local-variable 'gud-minor-mode) 1805 (setq file (cdr (assoc bptno gdb-location-alist))))
1785 'gdba) 1806 (if (and file
1786 (set (make-local-variable 'tool-bar-map) 1807 (not (string-equal file "File not found")))
1787 gud-tool-bar-map) 1808 (with-current-buffer
1788 ;; Only want one breakpoint icon at each 1809 (find-file-noselect file 'nowarn)
1789 ;; location. 1810 (set (make-local-variable 'gud-minor-mode)
1790 (save-excursion 1811 'gdba)
1791 (goto-line (string-to-number line)) 1812 (set (make-local-variable 'tool-bar-map)
1792 (gdb-put-breakpoint-icon (eq flag ?y) bptno))) 1813 gud-tool-bar-map)
1793 (gdb-enqueue-input 1814 ;; Only want one breakpoint icon at each
1794 (list 1815 ;; location.
1795 (concat gdb-server-prefix "list " 1816 (save-excursion
1796 (match-string-no-properties 1) ":1\n") 1817 (goto-line (string-to-number line))
1797 'ignore)) 1818 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))
1798 (gdb-enqueue-input 1819 (gdb-enqueue-input
1799 (list (concat gdb-server-prefix "info source\n") 1820 (list
1800 `(lambda () (gdb-get-location 1821 (concat gdb-server-prefix "list "
1801 ,bptno ,line ,flag)))))))))) 1822 (match-string-no-properties 1) ":1\n")
1802 (end-of-line))))) 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)
1837 (add-text-properties
1838 (match-beginning 1) (match-end 1)
1839 '(face font-lock-variable-name-face)))))))
1840 (end-of-line))))))
1803 (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) 1841 (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
1804 1842
1805(defun gdb-mouse-set-clear-breakpoint (event) 1843(defun gdb-mouse-set-clear-breakpoint (event)
@@ -2002,8 +2040,14 @@ static char *magick[] = {
2002 (goto-char bl) 2040 (goto-char bl)
2003 (when (looking-at "^#\\([0-9]+\\)") 2041 (when (looking-at "^#\\([0-9]+\\)")
2004 (when (string-equal (match-string 1) gdb-frame-number) 2042 (when (string-equal (match-string 1) gdb-frame-number)
2005 (put-text-property bl (+ bl 4) 2043 (if (> (car (window-fringes)) 0)
2006 '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))))
2007 (when (re-search-forward 2051 (when (re-search-forward
2008 (concat 2052 (concat
2009 (if (string-equal (match-string 1) "0") "" " in ") 2053 (if (string-equal (match-string 1) "0") "" " in ")
@@ -2036,9 +2080,10 @@ static char *magick[] = {
2036 (setq gdb-look-up-stack nil)) 2080 (setq gdb-look-up-stack nil))
2037 2081
2038(defun gdb-set-hollow () 2082(defun gdb-set-hollow ()
2039 (with-current-buffer (gud-find-file (car gud-last-last-frame)) 2083 (if gud-last-last-frame
2040 (setq fringe-indicator-alist 2084 (with-current-buffer (gud-find-file (car gud-last-last-frame))
2041 '((overlay-arrow . hollow-right-triangle))))) 2085 (setq fringe-indicator-alist
2086 '((overlay-arrow . hollow-right-triangle))))))
2042 2087
2043(defun gdb-stack-buffer-name () 2088(defun gdb-stack-buffer-name ()
2044 (with-current-buffer gud-comint-buffer 2089 (with-current-buffer gud-comint-buffer
@@ -2073,6 +2118,8 @@ static char *magick[] = {
2073 (kill-all-local-variables) 2118 (kill-all-local-variables)
2074 (setq major-mode 'gdb-frames-mode) 2119 (setq major-mode 'gdb-frames-mode)
2075 (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)
2076 (setq buffer-read-only t) 2123 (setq buffer-read-only t)
2077 (use-local-map gdb-frames-mode-map) 2124 (use-local-map gdb-frames-mode-map)
2078 (run-mode-hooks 'gdb-frames-mode-hook) 2125 (run-mode-hooks 'gdb-frames-mode-hook)
@@ -2524,18 +2571,18 @@ corresponding to the mode line clicked."
2524 'local-map 2571 'local-map
2525 (gdb-make-header-line-mouse-map 2572 (gdb-make-header-line-mouse-map
2526 'mouse-1 2573 'mouse-1
2527 #'(lambda () (interactive) 2574 (lambda () (interactive)
2528 (let ((gdb-memory-address 2575 (let ((gdb-memory-address
2529 ;; Let GDB do the arithmetic. 2576 ;; Let GDB do the arithmetic.
2530 (concat 2577 (concat
2531 gdb-memory-address " - " 2578 gdb-memory-address " - "
2532 (number-to-string 2579 (number-to-string
2533 (* gdb-memory-repeat-count 2580 (* gdb-memory-repeat-count
2534 (cond ((string= gdb-memory-unit "b") 1) 2581 (cond ((string= gdb-memory-unit "b") 1)
2535 ((string= gdb-memory-unit "h") 2) 2582 ((string= gdb-memory-unit "h") 2)
2536 ((string= gdb-memory-unit "w") 4) 2583 ((string= gdb-memory-unit "w") 4)
2537 ((string= gdb-memory-unit "g") 8))))))) 2584 ((string= gdb-memory-unit "g") 8)))))))
2538 (gdb-invalidate-memory))))) 2585 (gdb-invalidate-memory)))))
2539 "|" 2586 "|"
2540 (propertize "+" 2587 (propertize "+"
2541 'face font-lock-warning-face 2588 'face font-lock-warning-face
@@ -2543,9 +2590,9 @@ corresponding to the mode line clicked."
2543 'mouse-face 'mode-line-highlight 2590 'mouse-face 'mode-line-highlight
2544 'local-map (gdb-make-header-line-mouse-map 2591 'local-map (gdb-make-header-line-mouse-map
2545 'mouse-1 2592 'mouse-1
2546 #'(lambda () (interactive) 2593 (lambda () (interactive)
2547 (let ((gdb-memory-address nil)) 2594 (let ((gdb-memory-address nil))
2548 (gdb-invalidate-memory))))) 2595 (gdb-invalidate-memory)))))
2549 "]: " 2596 "]: "
2550 (propertize gdb-memory-address 2597 (propertize gdb-memory-address
2551 'face font-lock-warning-face 2598 'face font-lock-warning-face
@@ -2592,8 +2639,11 @@ corresponding to the mode line clicked."
2592(defun gdb-frame-memory-buffer () 2639(defun gdb-frame-memory-buffer ()
2593 "Display memory contents in a new frame." 2640 "Display memory contents in a new frame."
2594 (interactive) 2641 (interactive)
2595 (let ((special-display-regexps (append special-display-regexps '(".*"))) 2642 (let* ((special-display-regexps (append special-display-regexps '(".*")))
2596 (special-display-frame-alist gdb-frame-parameters)) 2643 (special-display-frame-alist
2644 (cons '(left-fringe . 0)
2645 (cons '(right-fringe . 0)
2646 (cons '(width . 83) gdb-frame-parameters)))))
2597 (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer)))) 2647 (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer))))
2598 2648
2599 2649
@@ -2610,13 +2660,14 @@ corresponding to the mode line clicked."
2610 2660
2611(defvar gdb-locals-watch-map 2661(defvar gdb-locals-watch-map
2612 (let ((map (make-sparse-keymap))) 2662 (let ((map (make-sparse-keymap)))
2613 (define-key map "\r" '(lambda () (interactive) 2663 (suppress-keymap map)
2614 (beginning-of-line) 2664 (define-key map "\r" (lambda () (interactive)
2615 (gud-watch))) 2665 (beginning-of-line)
2616 (define-key map [mouse-2] '(lambda (event) (interactive "e") 2666 (gud-watch)))
2617 (mouse-set-point event) 2667 (define-key map [mouse-2] (lambda (event) (interactive "e")
2618 (beginning-of-line) 2668 (mouse-set-point event)
2619 (gud-watch))) 2669 (beginning-of-line)
2670 (gud-watch)))
2620 map) 2671 map)
2621 "Keymap to create watch expression of a complex data type local variable.") 2672 "Keymap to create watch expression of a complex data type local variable.")
2622 2673
@@ -2739,7 +2790,7 @@ corresponding to the mode line clicked."
2739 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) 2790 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
2740 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) 2791 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
2741 (define-key menu [inferior] 2792 (define-key menu [inferior]
2742 '(menu-item "Inferior IO" gdb-display-separate-io-buffer 2793 '(menu-item "Separate IO" gdb-display-separate-io-buffer
2743 :enable gdb-use-separate-io-buffer)) 2794 :enable gdb-use-separate-io-buffer))
2744 (define-key menu [memory] '("Memory" . gdb-display-memory-buffer)) 2795 (define-key menu [memory] '("Memory" . gdb-display-memory-buffer))
2745 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) 2796 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
@@ -2758,7 +2809,7 @@ corresponding to the mode line clicked."
2758 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) 2809 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
2759 (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer)) 2810 (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer))
2760 (define-key menu [inferior] 2811 (define-key menu [inferior]
2761 '(menu-item "Inferior IO" gdb-frame-separate-io-buffer 2812 '(menu-item "Separate IO" gdb-frame-separate-io-buffer
2762 :enable gdb-use-separate-io-buffer)) 2813 :enable gdb-use-separate-io-buffer))
2763 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) 2814 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
2764 (define-key menu [disassembly] '("Disassembly" . gdb-frame-assembler-buffer)) 2815 (define-key menu [disassembly] '("Disassembly" . gdb-frame-assembler-buffer))
@@ -2771,10 +2822,15 @@ corresponding to the mode line clicked."
2771 (define-key gud-menu-map [ui] 2822 (define-key gud-menu-map [ui]
2772 `(menu-item (if (eq gud-minor-mode 'gdba) "GDB-UI" "GDB-MI") 2823 `(menu-item (if (eq gud-minor-mode 'gdba) "GDB-UI" "GDB-MI")
2773 ,menu :visible (memq gud-minor-mode '(gdbmi gdba)))) 2824 ,menu :visible (memq gud-minor-mode '(gdbmi gdba))))
2825 (define-key menu [gdb-find-source-frame]
2826 '(menu-item "Look For Source Frame" gdb-find-source-frame
2827 :visible (eq gud-minor-mode 'gdba)
2828 :help "Toggle look for source frame."
2829 :button (:toggle . gdb-find-source-frame)))
2774 (define-key menu [gdb-use-separate-io] 2830 (define-key menu [gdb-use-separate-io]
2775 '(menu-item "Separate inferior IO" gdb-use-separate-io-buffer 2831 '(menu-item "Separate IO" gdb-use-separate-io-buffer
2776 :visible (eq gud-minor-mode 'gdba) 2832 :visible (eq gud-minor-mode 'gdba)
2777 :help "Toggle separate IO for inferior." 2833 :help "Toggle separate IO for debugged program."
2778 :button (:toggle . gdb-use-separate-io-buffer))) 2834 :button (:toggle . gdb-use-separate-io-buffer)))
2779 (define-key menu [gdb-many-windows] 2835 (define-key menu [gdb-many-windows]
2780 '(menu-item "Display Other Windows" gdb-many-windows 2836 '(menu-item "Display Other Windows" gdb-many-windows
@@ -2871,12 +2927,13 @@ Kills the gdb buffers, and resets variables and the source buffers."
2871 (setq gud-minor-mode nil) 2927 (setq gud-minor-mode nil)
2872 (kill-local-variable 'tool-bar-map) 2928 (kill-local-variable 'tool-bar-map)
2873 (kill-local-variable 'gdb-define-alist)))))) 2929 (kill-local-variable 'gdb-define-alist))))))
2874 (when (markerp gdb-overlay-arrow-position) 2930 (setq gdb-overlay-arrow-position nil)
2875 (move-marker gdb-overlay-arrow-position nil)
2876 (setq gdb-overlay-arrow-position nil))
2877 (setq overlay-arrow-variable-list 2931 (setq overlay-arrow-variable-list
2878 (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list)) 2932 (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list))
2879 (setq fringe-indicator-alist '((overlay-arrow . right-triangle))) 2933 (setq fringe-indicator-alist '((overlay-arrow . right-triangle)))
2934 (setq gdb-stack-position nil)
2935 (setq overlay-arrow-variable-list
2936 (delq 'gdb-stack-position overlay-arrow-variable-list))
2880 (if (boundp 'speedbar-frame) (speedbar-timer-fn)) 2937 (if (boundp 'speedbar-frame) (speedbar-timer-fn))
2881 (setq gud-running nil) 2938 (setq gud-running nil)
2882 (setq gdb-active-process nil) 2939 (setq gdb-active-process nil)
@@ -3098,8 +3155,7 @@ BUFFER nil or omitted means use the current buffer."
3098 '((overlay-arrow . hollow-right-triangle)))) 3155 '((overlay-arrow . hollow-right-triangle))))
3099 (or gdb-overlay-arrow-position 3156 (or gdb-overlay-arrow-position
3100 (setq gdb-overlay-arrow-position (make-marker))) 3157 (setq gdb-overlay-arrow-position (make-marker)))
3101 (set-marker gdb-overlay-arrow-position 3158 (set-marker gdb-overlay-arrow-position (point))))))
3102 (point) (current-buffer))))))
3103 ;; remove all breakpoint-icons in assembler buffer before updating. 3159 ;; remove all breakpoint-icons in assembler buffer before updating.
3104 (gdb-remove-breakpoint-icons (point-min) (point-max)))) 3160 (gdb-remove-breakpoint-icons (point-min) (point-max))))
3105 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) 3161 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
@@ -3460,10 +3516,32 @@ in_scope=\"\\(.*?\\)\".*?}")
3460 3516
3461(defvar gdb-locals-watch-map-1 3517(defvar gdb-locals-watch-map-1
3462 (let ((map (make-sparse-keymap))) 3518 (let ((map (make-sparse-keymap)))
3519 (suppress-keymap map)
3520 (define-key map "\r" 'gud-watch)
3463 (define-key map [mouse-2] 'gud-watch) 3521 (define-key map [mouse-2] 'gud-watch)
3464 map) 3522 map)
3465 "Keymap to create watch expression of a complex data type local variable.") 3523 "Keymap to create watch expression of a complex data type local variable.")
3466 3524
3525(defvar gdb-edit-locals-map-1
3526 (let ((map (make-sparse-keymap)))
3527 (suppress-keymap map)
3528 (define-key map "\r" 'gdb-edit-locals-value)
3529 (define-key map [mouse-2] 'gdb-edit-locals-value)
3530 map)
3531 "Keymap to edit value of a simple data type local variable.")
3532
3533(defun gdb-edit-locals-value (&optional event)
3534 "Assign a value to a variable displayed in the locals buffer."
3535 (interactive (list last-input-event))
3536 (save-excursion
3537 (if event (posn-set-point (event-end event)))
3538 (beginning-of-line)
3539 (let* ((var (current-word))
3540 (value (read-string (format "New value (%s): " var))))
3541 (gdb-enqueue-input
3542 (list (concat gdb-server-prefix"set variable " var " = " value "\n")
3543 'ignore)))))
3544
3467;; Dont display values of arrays or structures. 3545;; Dont display values of arrays or structures.
3468;; These can be expanded using gud-watch. 3546;; These can be expanded using gud-watch.
3469(defun gdb-stack-list-locals-handler () 3547(defun gdb-stack-list-locals-handler ()
@@ -3491,20 +3569,26 @@ in_scope=\"\\(.*?\\)\".*?}")
3491 (let* ((window (get-buffer-window buf 0)) 3569 (let* ((window (get-buffer-window buf 0))
3492 (start (window-start window)) 3570 (start (window-start window))
3493 (p (window-point window)) 3571 (p (window-point window))
3494 (buffer-read-only nil)) 3572 (buffer-read-only nil) (name) (value))
3495 (erase-buffer) 3573 (erase-buffer)
3496 (dolist (local locals-list) 3574 (dolist (local locals-list)
3497 (setq name (car local)) 3575 (setq name (car local))
3498 (if (or (not (nth 2 local)) 3576 (setq value (nth 2 local))
3499 (string-match "^\\0x" (nth 2 local))) 3577 (if (or (not value)
3578 (string-match "^\\0x" value))
3500 (add-text-properties 0 (length name) 3579 (add-text-properties 0 (length name)
3501 `(mouse-face highlight 3580 `(mouse-face highlight
3502 help-echo "mouse-2: create watch expression" 3581 help-echo "mouse-2: create watch expression"
3503 local-map ,gdb-locals-watch-map-1) 3582 local-map ,gdb-locals-watch-map-1)
3504 name)) 3583 name)
3584 (add-text-properties 0 (length value)
3585 `(mouse-face highlight
3586 help-echo "mouse-2: edit value"
3587 local-map ,gdb-edit-locals-map-1)
3588 value))
3505 (insert 3589 (insert
3506 (concat name "\t" (nth 1 local) 3590 (concat name "\t" (nth 1 local)
3507 "\t" (nth 2 local) "\n"))) 3591 "\t" value "\n")))
3508 (set-window-start window start) 3592 (set-window-start window start)
3509 (set-window-point window p)))))))) 3593 (set-window-point window p))))))))
3510 3594
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index e7d85910a63..48692f9742f 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -335,7 +335,7 @@ This variable's value takes effect when `grep-compute-defaults' is called.")
335(defvar grep-find-use-xargs nil 335(defvar grep-find-use-xargs nil
336 "Whether \\[grep-find] uses the `xargs' utility by default. 336 "Whether \\[grep-find] uses the `xargs' utility by default.
337 337
338If nil, it uses `find -exec'; if `gnu', it uses `find -print0' and `xargs -0'; 338If `exec', it uses `find -exec'; if `gnu', it uses `find -print0' and `xargs -0';
339if not nil and not `gnu', it uses `find -print' and `xargs'. 339if not nil and not `gnu', it uses `find -print' and `xargs'.
340 340
341This variable's value takes effect when `grep-compute-defaults' is called.") 341This variable's value takes effect when `grep-compute-defaults' is called.")
@@ -419,21 +419,29 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
419 (format "%s <C> %s <R> <F>" grep-program grep-options))) 419 (format "%s <C> %s <R> <F>" grep-program grep-options)))
420 (unless grep-find-use-xargs 420 (unless grep-find-use-xargs
421 (setq grep-find-use-xargs 421 (setq grep-find-use-xargs
422 (if (and 422 (cond
423 (grep-probe find-program `(nil nil nil ,null-device "-print0")) 423 ((and
424 (grep-probe "xargs" `(nil nil nil "-0" "-e" "echo"))) 424 (grep-probe find-program `(nil nil nil ,null-device "-print0"))
425 'gnu))) 425 (grep-probe "xargs" `(nil nil nil "-0" "-e" "echo")))
426 'gnu)
427 (t
428 'exec))))
426 (unless grep-find-command 429 (unless grep-find-command
427 (setq grep-find-command 430 (setq grep-find-command
428 (cond ((eq grep-find-use-xargs 'gnu) 431 (cond ((eq grep-find-use-xargs 'gnu)
429 (format "%s . -type f -print0 | xargs -0 -e %s" 432 (format "%s . -type f -print0 | xargs -0 -e %s"
430 find-program grep-command)) 433 find-program grep-command))
431 (grep-find-use-xargs 434 ((eq grep-find-use-xargs 'exec)
435 (let ((cmd0 (format "%s . -type f -exec %s"
436 find-program grep-command)))
437 (cons
438 (format "%s {} %s %s"
439 cmd0 null-device
440 (shell-quote-argument ";"))
441 (1+ (length cmd0)))))
442 (t
432 (format "%s . -type f -print | xargs %s" 443 (format "%s . -type f -print | xargs %s"
433 find-program grep-command)) 444 find-program grep-command)))))
434 (t (cons (format "%s . -type f -exec %s {} %s \\;"
435 find-program grep-command null-device)
436 (+ 22 (length grep-command)))))))
437 (unless grep-find-template 445 (unless grep-find-template
438 (setq grep-find-template 446 (setq grep-find-template
439 (let ((gcmd (format "%s <C> %s <R>" 447 (let ((gcmd (format "%s <C> %s <R>"
@@ -441,11 +449,13 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
441 (cond ((eq grep-find-use-xargs 'gnu) 449 (cond ((eq grep-find-use-xargs 'gnu)
442 (format "%s . <X> -type f <F> -print0 | xargs -0 -e %s" 450 (format "%s . <X> -type f <F> -print0 | xargs -0 -e %s"
443 find-program gcmd)) 451 find-program gcmd))
444 (grep-find-use-xargs 452 ((eq grep-find-use-xargs 'exec)
453 (format "%s . <X> -type f <F> -exec %s {} %s %s"
454 find-program gcmd null-device
455 (shell-quote-argument ";")))
456 (t
445 (format "%s . <X> -type f <F> -print | xargs %s" 457 (format "%s . <X> -type f <F> -print | xargs %s"
446 find-program gcmd)) 458 find-program gcmd))))))))
447 (t (format "%s . <X> -type f <F> -exec %s {} %s \\;"
448 find-program gcmd null-device))))))))
449 (unless (or (not grep-highlight-matches) (eq grep-highlight-matches t)) 459 (unless (or (not grep-highlight-matches) (eq grep-highlight-matches t))
450 (setq grep-highlight-matches 460 (setq grep-highlight-matches
451 (with-temp-buffer 461 (with-temp-buffer
@@ -455,34 +465,48 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
455 (search-forward "--color" nil t)) 465 (search-forward "--color" nil t))
456 t))))) 466 t)))))
457 467
468(defun grep-tag-default ()
469 (or (and transient-mark-mode mark-active
470 (/= (point) (mark))
471 (buffer-substring-no-properties (point) (mark)))
472 (funcall (or find-tag-default-function
473 (get major-mode 'find-tag-default-function)
474 'find-tag-default))
475 ""))
476
458(defun grep-default-command () 477(defun grep-default-command ()
459 (let ((tag-default 478 "Compute the default grep command for C-u M-x grep to offer."
460 (shell-quote-argument 479 (let ((tag-default (shell-quote-argument (grep-tag-default)))
461 (or (funcall (or find-tag-default-function 480 ;; This a regexp to match single shell arguments.
462 (get major-mode 'find-tag-default-function) 481 ;; Could someone please add comments explaining it?
463 'find-tag-default))
464 "")))
465 (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)") 482 (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)")
466 (grep-default (or (car grep-history) grep-command))) 483 (grep-default (or (car grep-history) grep-command)))
467 ;; Replace the thing matching for with that around cursor. 484 ;; In the default command, find the arg that specifies the pattern.
468 (when (or (string-match 485 (when (or (string-match
469 (concat "[^ ]+\\s +\\(?:-[^ ]+\\s +\\)*" 486 (concat "[^ ]+\\s +\\(?:-[^ ]+\\s +\\)*"
470 sh-arg-re "\\(\\s +\\(\\S +\\)\\)?") 487 sh-arg-re "\\(\\s +\\(\\S +\\)\\)?")
471 grep-default) 488 grep-default)
472 ;; If the string is not yet complete. 489 ;; If the string is not yet complete.
473 (string-match "\\(\\)\\'" grep-default)) 490 (string-match "\\(\\)\\'" grep-default))
474 (unless (or (not (stringp buffer-file-name)) 491 ;; Maybe we will replace the pattern with the default tag.
475 (when (match-beginning 2) 492 ;; But first, maybe replace the file name pattern.
476 (save-match-data 493 (condition-case nil
477 (string-match 494 (unless (or (not (stringp buffer-file-name))
478 (wildcard-to-regexp 495 (when (match-beginning 2)
479 (file-name-nondirectory 496 (save-match-data
480 (match-string 3 grep-default))) 497 (string-match
481 (file-name-nondirectory buffer-file-name))))) 498 (wildcard-to-regexp
482 (setq grep-default (concat (substring grep-default 499 (file-name-nondirectory
483 0 (match-beginning 2)) 500 (match-string 3 grep-default)))
484 " *." 501 (file-name-nondirectory buffer-file-name)))))
485 (file-name-extension buffer-file-name)))) 502 (setq grep-default (concat (substring grep-default
503 0 (match-beginning 2))
504 " *."
505 (file-name-extension buffer-file-name))))
506 ;; In case wildcard-to-regexp gets an error
507 ;; from invalid data.
508 (error nil))
509 ;; Now replace the pattern with the default tag.
486 (replace-match tag-default t t grep-default 1)))) 510 (replace-match tag-default t t grep-default 1))))
487 511
488 512
@@ -590,15 +614,11 @@ substitution string. Note dynamic scoping of variables.")
590 614
591(defun grep-read-regexp () 615(defun grep-read-regexp ()
592 "Read regexp arg for interactive grep." 616 "Read regexp arg for interactive grep."
593 (let ((default 617 (let ((default (grep-tag-default)))
594 (or (funcall (or find-tag-default-function
595 (get major-mode 'find-tag-default-function)
596 'find-tag-default))
597 "")))
598 (read-string 618 (read-string
599 (concat "Search for" 619 (concat "Search for"
600 (if (and default (> (length default) 0)) 620 (if (and default (> (length default) 0))
601 (format " (default %s): " default) ": ")) 621 (format " (default \"%s\"): " default) ": "))
602 nil 'grep-regexp-history default))) 622 nil 'grep-regexp-history default)))
603 623
604(defun grep-read-files (regexp) 624(defun grep-read-files (regexp)
@@ -620,7 +640,9 @@ substitution string. Note dynamic scoping of variables.")
620 (cdr alias))) 640 (cdr alias)))
621 (and fn 641 (and fn
622 (let ((ext (file-name-extension fn))) 642 (let ((ext (file-name-extension fn)))
623 (and ext (concat "*." ext)))))) 643 (and ext (concat "*." ext))))
644 (car grep-files-history)
645 (car (car grep-files-aliases))))
624 (files (read-string 646 (files (read-string
625 (concat "Search for \"" regexp 647 (concat "Search for \"" regexp
626 "\" in files" 648 "\" in files"
@@ -724,18 +746,26 @@ This command shares argument histories with \\[lgrep] and \\[grep-find]."
724 (let ((command (grep-expand-template 746 (let ((command (grep-expand-template
725 grep-find-template 747 grep-find-template
726 regexp 748 regexp
727 (concat "\\( -name " 749 (concat (shell-quote-argument "(")
750 " -name "
728 (mapconcat #'shell-quote-argument 751 (mapconcat #'shell-quote-argument
729 (split-string files) 752 (split-string files)
730 " -o -name ") 753 " -o -name ")
731 " \\)") 754 " "
755 (shell-quote-argument ")"))
732 dir 756 dir
733 (and grep-find-ignored-directories 757 (and grep-find-ignored-directories
734 (concat "\\( -path '*/" 758 (concat (shell-quote-argument "(")
735 (mapconcat #'identity 759 ;; we should use shell-quote-argument here
760 " -path "
761 (mapconcat #'(lambda (dir)
762 (shell-quote-argument
763 (concat "*/" dir)))
736 grep-find-ignored-directories 764 grep-find-ignored-directories
737 "' -o -path '*/") 765 " -o -path ")
738 "' \\) -prune -o "))))) 766 " "
767 (shell-quote-argument ")")
768 " -prune -o ")))))
739 (when command 769 (when command
740 (if current-prefix-arg 770 (if current-prefix-arg
741 (setq command 771 (setq command
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/python.el b/lisp/progmodes/python.el
index 9636f7eaeae..c38a6e82f83 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -9,19 +9,19 @@
9 9
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11 11
12;; This file is free software; you can redistribute it and/or modify 12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by 13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option) 14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version. 15;; any later version.
16 16
17;; This file is distributed in the hope that it will be useful, 17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details. 20;; GNU General Public License for more details.
21 21
22;; You should have received a copy of the GNU General Public License 22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, write to 23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25;; Boston, MA 02110-1301, USA. 25;; Boston, MA 02110-1301, USA.
26 26
27;;; Commentary: 27;;; Commentary:
@@ -32,41 +32,44 @@
32;; maintained with Python. That isn't covered by an FSF copyright 32;; maintained with Python. That isn't covered by an FSF copyright
33;; assignment, unlike this code, and seems not to be well-maintained 33;; assignment, unlike this code, and seems not to be well-maintained
34;; for Emacs (though I've submitted fixes). This mode is rather 34;; for Emacs (though I've submitted fixes). This mode is rather
35;; simpler and is, perhaps, better in other ways. In particular, 35;; simpler and is better in other ways. In particular, using the
36;; using the syntax functions with text properties maintained by 36;; syntax functions with text properties maintained by font-lock makes
37;; font-lock should make it more correct with arbitrary string and 37;; it more correct with arbitrary string and comment contents.
38;; comment contents.
39 38
40;; This doesn't implement all the facilities of python-mode.el. Some 39;; This doesn't implement all the facilities of python-mode.el. Some
41;; just need doing, e.g. catching exceptions in the inferior Python 40;; just need doing, e.g. catching exceptions in the inferior Python
42;; buffer (but see M-x pdb for debugging). [Actually, the use of 41;; buffer (but see M-x pdb for debugging). [Actually, the use of
43;; `compilation-minor-mode' now is probably enough for that.] Others 42;; `compilation-shell-minor-mode' now is probably enough for that.]
44;; don't seem appropriate. For instance, `forward-into-nomenclature' 43;; Others don't seem appropriate. For instance,
45;; should be done separately, since it's not specific to Python, and 44;; `forward-into-nomenclature' should be done separately, since it's
46;; I've installed a minor mode to do the job properly in Emacs 22. 45;; not specific to Python, and I've installed a minor mode to do the
46;; job properly in Emacs 23. [CC mode 5.31 contains an incompatible
47;; feature, `c-subword-mode' which is intended to have a similar
48;; effect, but actually only affects word-oriented keybindings.]
49
47;; Other things seem more natural or canonical here, e.g. the 50;; Other things seem more natural or canonical here, e.g. the
48;; {beginning,end}-of-defun implementation dealing with nested 51;; {beginning,end}-of-defun implementation dealing with nested
49;; definitions, and the inferior mode following `cmuscheme'. The 52;; definitions, and the inferior mode following `cmuscheme'. (The
50;; inferior mode can find the source of errors from 53;; inferior mode can find the source of errors from
51;; `python-send-region' & al via `compilation-minor-mode'. Successive 54;; `python-send-region' & al via `compilation-shell-minor-mode'.)
52;; TABs cycle between possible indentations for the line. There is 55;; There is (limited) symbol completion using lookup in Python and
53;; symbol completion using lookup in Python. 56;; Eldoc support also using the inferior process. Successive TABs
57;; cycle between possible indentations for the line.
54 58
55;; Even where it has similar facilities, this is incompatible with 59;; Even where it has similar facilities, this mode is incompatible
56;; python-mode.el in various respects. For instance, various key 60;; with python-mode.el in some respects. For instance, various key
57;; bindings are changed to obey Emacs conventions, and things like 61;; bindings are changed to obey Emacs conventions.
58;; marking blocks and `beginning-of-defun' behave differently.
59 62
60;; TODO: See various Fixmes below. 63;; TODO: See various Fixmes below.
61 64
62;;; Code: 65;;; Code:
63 66
64;; It's messy to autoload the relevant comint functions so that comint
65;; is only required when inferior Python is used.
66(require 'comint)
67(eval-when-compile 67(eval-when-compile
68 (require 'cl)
68 (require 'compile) 69 (require 'compile)
69 (autoload 'info-lookup-maybe-add-help "info-look")) 70 (require 'comint))
71
72(autoload 'comint-mode "comint")
70 73
71(defgroup python nil 74(defgroup python nil
72 "Silly walks in the Python language." 75 "Silly walks in the Python language."
@@ -84,31 +87,37 @@
84;;;; Font lock 87;;;; Font lock
85 88
86(defvar python-font-lock-keywords 89(defvar python-font-lock-keywords
87 `(,(rx (and word-start 90 `(,(rx symbol-start
88 ;; From v 2.3 reference. 91 ;; From v 2.4 reference.
89 ;; def and class dealt with separately below 92 ;; def and class dealt with separately below
90 (or "and" "assert" "break" "continue" "del" "elif" "else" 93 (or "and" "assert" "break" "continue" "del" "elif" "else"
91 "except" "exec" "finally" "for" "from" "global" "if" 94 "except" "exec" "finally" "for" "from" "global" "if"
92 "import" "in" "is" "lambda" "not" "or" "pass" "print" 95 "import" "in" "is" "lambda" "not" "or" "pass" "print"
93 "raise" "return" "try" "while" "yield" 96 "raise" "return" "try" "while" "yield"
94 ;; Future keywords 97 ;; Future keywords
95 "as" "None") 98 "as" "None")
96 word-end)) 99 symbol-end)
97 (,(rx (and word-start (group "class") (1+ space) (group (1+ word)))) 100 ;; Definitions
98 (1 font-lock-keyword-face) (2 font-lock-type-face)) 101 (,(rx symbol-start (group "class") (1+ space) (group (1+ (or word ?_))))
99 (,(rx (and word-start (group "def") (1+ space) (group (1+ word)))) 102 (1 font-lock-keyword-face) (2 font-lock-type-face))
100 (1 font-lock-keyword-face) (2 font-lock-function-name-face)))) 103 (,(rx symbol-start (group "def") (1+ space) (group (1+ (or word ?_))))
104 (1 font-lock-keyword-face) (2 font-lock-function-name-face))
105 ;; Top-level assignments are worth highlighting.
106 (,(rx line-start (group (1+ (or word ?_))) (0+ space) "=")
107 (1 font-lock-variable-name-face))
108 (,(rx "@" (1+ (or word ?_))) ; decorators
109 (0 font-lock-preprocessor-face))))
101 110
102(defconst python-font-lock-syntactic-keywords 111(defconst python-font-lock-syntactic-keywords
103 ;; Make outer chars of matching triple-quote sequences into generic 112 ;; Make outer chars of matching triple-quote sequences into generic
104 ;; string delimiters. Fixme: Is there a better way? 113 ;; string delimiters. Fixme: Is there a better way?
105 `((,(rx (and (or line-start buffer-start (not (syntax escape))) ; avoid escaped 114 `((,(rx (or line-start buffer-start
106 ; leading quote 115 (not (syntax escape))) ; avoid escaped leading quote
107 (group (optional (any "uUrR"))) ; prefix gets syntax property 116 (group (optional (any "uUrR"))) ; prefix gets syntax property
108 (optional (any "rR")) ; possible second prefix 117 (optional (any "rR")) ; possible second prefix
109 (group (syntax string-quote)) ; maybe gets property 118 (group (syntax string-quote)) ; maybe gets property
110 (backref 2) ; per first quote 119 (backref 2) ; per first quote
111 (group (backref 2)))) ; maybe gets property 120 (group (backref 2))) ; maybe gets property
112 (1 (python-quote-syntax 1)) 121 (1 (python-quote-syntax 1))
113 (2 (python-quote-syntax 2)) 122 (2 (python-quote-syntax 2))
114 (3 (python-quote-syntax 3))) 123 (3 (python-quote-syntax 3)))
@@ -132,6 +141,8 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)."
132 ;; x = ''' """ ' a 141 ;; x = ''' """ ' a
133 ;; ''' 142 ;; '''
134 ;; x '"""' x """ \"""" x 143 ;; x '"""' x """ \"""" x
144 ;; Fixme: """""" goes wrong (due to syntax-ppss not getting the string
145 ;; fence context).
135 (save-excursion 146 (save-excursion
136 (goto-char (match-beginning 0)) 147 (goto-char (match-beginning 0))
137 (cond 148 (cond
@@ -140,19 +151,17 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)."
140 (let ((syntax (syntax-ppss))) 151 (let ((syntax (syntax-ppss)))
141 (when (eq t (nth 3 syntax)) ; after unclosed fence 152 (when (eq t (nth 3 syntax)) ; after unclosed fence
142 (goto-char (nth 8 syntax)) ; fence position 153 (goto-char (nth 8 syntax)) ; fence position
143 ;; Skip any prefix. 154 (skip-chars-forward "uUrR") ; skip any prefix
144 (if (memq (char-after) '(?u ?U ?R ?r))
145 (skip-chars-forward "uUrR"))
146 ;; Is it a matching sequence? 155 ;; Is it a matching sequence?
147 (if (eq (char-after) (char-after (match-beginning 2))) 156 (if (eq (char-after) (char-after (match-beginning 2)))
148 (eval-when-compile (string-to-syntax "|")))))) 157 (eval-when-compile (string-to-syntax "|"))))))
149 ;; Consider property for initial char, accounting for prefixes. 158 ;; Consider property for initial char, accounting for prefixes.
150 ((or (and (= n 2) ; not prefix 159 ((or (and (= n 2) ; leading quote (not prefix)
151 (= (match-beginning 1) (match-end 1))) ; prefix is null 160 (= (match-beginning 1) (match-end 1))) ; prefix is null
152 (and (= n 1) ; prefix 161 (and (= n 1) ; prefix
153 (/= (match-beginning 1) (match-end 1)))) ; non-empty 162 (/= (match-beginning 1) (match-end 1)))) ; non-empty
154 (unless (eq 'string (syntax-ppss-context (syntax-ppss))) 163 (unless (eq 'string (syntax-ppss-context (syntax-ppss)))
155 (eval-when-compile (string-to-syntax "|")))) 164 (eval-when-compile (string-to-syntax "|"))))
156 ;; Otherwise (we're in a non-matching string) the property is 165 ;; Otherwise (we're in a non-matching string) the property is
157 ;; nil, which is OK. 166 ;; nil, which is OK.
158 ))) 167 )))
@@ -204,23 +213,37 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)."
204 (define-key map "\C-c\C-l" 'python-load-file) ; a la cmuscheme 213 (define-key map "\C-c\C-l" 'python-load-file) ; a la cmuscheme
205 (substitute-key-definition 'complete-symbol 'python-complete-symbol 214 (substitute-key-definition 'complete-symbol 'python-complete-symbol
206 map global-map) 215 map global-map)
207 ;; Fixme: Add :help to menu. 216 (define-key map "\C-c\C-i" 'python-find-imports)
217 (define-key map "\C-c\C-t" 'python-expand-template)
208 (easy-menu-define python-menu map "Python Mode menu" 218 (easy-menu-define python-menu map "Python Mode menu"
209 '("Python" 219 `("Python"
210 ["Shift region left" python-shift-left :active mark-active] 220 :help "Python-specific Features"
211 ["Shift region right" python-shift-right :active mark-active] 221 ["Shift region left" python-shift-left :active mark-active
222 :help "Shift by a single indentation step"]
223 ["Shift region right" python-shift-right :active mark-active
224 :help "Shift by a single indentation step"]
212 "-" 225 "-"
213 ["Mark block" python-mark-block] 226 ["Mark block" python-mark-block
227 :help "Mark innermost block around point"]
214 ["Mark def/class" mark-defun 228 ["Mark def/class" mark-defun
215 :help "Mark innermost definition around point"] 229 :help "Mark innermost definition around point"]
216 "-" 230 "-"
217 ["Start of block" python-beginning-of-block] 231 ["Start of block" python-beginning-of-block
218 ["End of block" python-end-of-block] 232 :help "Go to start of innermost definition around point"]
233 ["End of block" python-end-of-block
234 :help "Go to end of innermost definition around point"]
219 ["Start of def/class" beginning-of-defun 235 ["Start of def/class" beginning-of-defun
220 :help "Go to start of innermost definition around point"] 236 :help "Go to start of innermost definition around point"]
221 ["End of def/class" end-of-defun 237 ["End of def/class" end-of-defun
222 :help "Go to end of innermost definition around point"] 238 :help "Go to end of innermost definition around point"]
223 "-" 239 "-"
240 ("Templates..."
241 :help "Expand templates for compound statements"
242 :filter (lambda (&rest junk)
243 (mapcar (lambda (elt)
244 (vector (car elt) (cdr elt) t))
245 python-skeletons))) ; defined later
246 "-"
224 ["Start interpreter" run-python 247 ["Start interpreter" run-python
225 :help "Run `inferior' Python in separate buffer"] 248 :help "Run `inferior' Python in separate buffer"]
226 ["Import/reload file" python-load-file 249 ["Import/reload file" python-load-file
@@ -233,12 +256,23 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)."
233 :help "Evaluate current definition in inferior Python session"] 256 :help "Evaluate current definition in inferior Python session"]
234 ["Switch to interpreter" python-switch-to-python 257 ["Switch to interpreter" python-switch-to-python
235 :help "Switch to inferior Python buffer"] 258 :help "Switch to inferior Python buffer"]
259 ["Set default process" python-set-proc
260 :help "Make buffer's inferior process the default"
261 :active (buffer-live-p python-buffer)]
236 ["Check file" python-check :help "Run pychecker"] 262 ["Check file" python-check :help "Run pychecker"]
237 ["Debugger" pdb :help "Run pdb under GUD"] 263 ["Debugger" pdb :help "Run pdb under GUD"]
238 "-" 264 "-"
239 ["Help on symbol" python-describe-symbol 265 ["Help on symbol" python-describe-symbol
240 :help "Use pydoc on symbol at point"])) 266 :help "Use pydoc on symbol at point"]
267 ["Complete symbol" python-complete-symbol
268 :help "Complete (qualified) symbol before point"]
269 ["Update imports" python-find-imports
270 :help "Update list of top-level imports for completion"]))
241 map)) 271 map))
272;; Fixme: add toolbar stuff for useful things like symbol help, send
273;; region, at least. (Shouldn't be specific to Python, obviously.)
274;; eric has items including: (un)indent, (un)comment, restart script,
275;; run script, debug script; also things for profiling, unit testing.
242 276
243(defvar python-mode-syntax-table 277(defvar python-mode-syntax-table
244 (let ((table (make-syntax-table))) 278 (let ((table (make-syntax-table)))
@@ -263,7 +297,8 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)."
263 297
264(defsubst python-in-string/comment () 298(defsubst python-in-string/comment ()
265 "Return non-nil if point is in a Python literal (a comment or string)." 299 "Return non-nil if point is in a Python literal (a comment or string)."
266 (syntax-ppss-context (syntax-ppss))) 300 ;; We don't need to save the match data.
301 (nth 8 (syntax-ppss)))
267 302
268(defconst python-space-backslash-table 303(defconst python-space-backslash-table
269 (let ((table (copy-syntax-table python-mode-syntax-table))) 304 (let ((table (copy-syntax-table python-mode-syntax-table)))
@@ -273,13 +308,21 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)."
273 308
274(defun python-skip-comments/blanks (&optional backward) 309(defun python-skip-comments/blanks (&optional backward)
275 "Skip comments and blank lines. 310 "Skip comments and blank lines.
276BACKWARD non-nil means go backwards, otherwise go forwards. Backslash is 311BACKWARD non-nil means go backwards, otherwise go forwards.
277treated as whitespace so that continued blank lines are skipped. 312Backslash is treated as whitespace so that continued blank lines
278Doesn't move out of comments -- should be outside or at end of line." 313are skipped. Doesn't move out of comments -- should be outside
279 (with-syntax-table python-space-backslash-table 314or at end of line."
280 (forward-comment (if backward 315 (let ((arg (if backward
281 most-negative-fixnum 316 ;; If we're in a comment (including on the trailing
282 most-positive-fixnum)))) 317 ;; newline), forward-comment doesn't move backwards out
318 ;; of it. Don't set the syntax table round this bit!
319 (let ((syntax (syntax-ppss)))
320 (if (nth 4 syntax)
321 (goto-char (nth 8 syntax)))
322 (- (point-max)))
323 (point-max))))
324 (with-syntax-table python-space-backslash-table
325 (forward-comment arg))))
283 326
284(defun python-backslash-continuation-line-p () 327(defun python-backslash-continuation-line-p ()
285 "Non-nil if preceding line ends with backslash that is not in a comment." 328 "Non-nil if preceding line ends with backslash that is not in a comment."
@@ -289,12 +332,17 @@ Doesn't move out of comments -- should be outside or at end of line."
289(defun python-continuation-line-p () 332(defun python-continuation-line-p ()
290 "Return non-nil if current line continues a previous one. 333 "Return non-nil if current line continues a previous one.
291The criteria are that the previous line ends in a backslash outside 334The criteria are that the previous line ends in a backslash outside
292comments and strings, or that the bracket/paren nesting depth is nonzero." 335comments and strings, or that point is within brackets/parens."
293 (or (and (eq ?\\ (char-before (line-end-position 0))) 336 (or (python-backslash-continuation-line-p)
294 (not (syntax-ppss-context (syntax-ppss)))) 337 (let ((depth (syntax-ppss-depth
295 (< 0 (syntax-ppss-depth 338 (save-excursion ; syntax-ppss with arg changes point
296 (save-excursion ; syntax-ppss with arg changes point 339 (syntax-ppss (line-beginning-position))))))
297 (syntax-ppss (line-beginning-position))))))) 340 (or (> depth 0)
341 (if (< depth 0) ; Unbalanced brackets -- act locally
342 (save-excursion
343 (condition-case ()
344 (progn (backward-up-list) t) ; actually within brackets
345 (error nil))))))))
298 346
299(defun python-comment-line-p () 347(defun python-comment-line-p ()
300 "Return non-nil iff current line has only a comment." 348 "Return non-nil iff current line has only a comment."
@@ -304,6 +352,12 @@ comments and strings, or that the bracket/paren nesting depth is nonzero."
304 (back-to-indentation) 352 (back-to-indentation)
305 (looking-at (rx (or (syntax comment-start) line-end)))))) 353 (looking-at (rx (or (syntax comment-start) line-end))))))
306 354
355(defun python-blank-line-p ()
356 "Return non-nil iff current line is blank."
357 (save-excursion
358 (beginning-of-line)
359 (looking-at "\\s-*$")))
360
307(defun python-beginning-of-string () 361(defun python-beginning-of-string ()
308 "Go to beginning of string around point. 362 "Go to beginning of string around point.
309Do nothing if not in string." 363Do nothing if not in string."
@@ -316,83 +370,70 @@ Do nothing if not in string."
316BOS non-nil means point is known to be at beginning of statement." 370BOS non-nil means point is known to be at beginning of statement."
317 (save-excursion 371 (save-excursion
318 (unless bos (python-beginning-of-statement)) 372 (unless bos (python-beginning-of-statement))
319 (and (not (python-comment-line-p)) 373 (looking-at (rx (and (or "if" "else" "elif" "while" "for" "def"
320 (re-search-forward (rx (and ?: (0+ space) 374 "class" "try" "except" "finally")
321 (optional (and (syntax comment-start) 375 symbol-end)))))
322 (0+ not-newline)))
323 line-end))
324 (save-excursion (python-end-of-statement))
325 t)
326 (not (progn (goto-char (match-beginning 0))
327 (python-in-string/comment))))))
328 376
329(defun python-close-block-statement-p (&optional bos) 377(defun python-close-block-statement-p (&optional bos)
330 "Return non-nil if current line is a statement closing a block. 378 "Return non-nil if current line is a statement closing a block.
331BOS non-nil means point is at beginning of statement. 379BOS non-nil means point is at beginning of statement.
332The criteria are that the line isn't a comment or in string and starts with 380The criteria are that the line isn't a comment or in string and
333keyword `raise', `break', `continue' or `pass'." 381 starts with keyword `raise', `break', `continue' or `pass'."
334 (save-excursion 382 (save-excursion
335 (unless bos (python-beginning-of-statement)) 383 (unless bos (python-beginning-of-statement))
336 (back-to-indentation) 384 (back-to-indentation)
337 (looking-at (rx (and (or "return" "raise" "break" "continue" "pass") 385 (looking-at (rx (or "return" "raise" "break" "continue" "pass")
338 symbol-end))))) 386 symbol-end))))
339 387
340(defun python-outdent-p () 388(defun python-outdent-p ()
341 "Return non-nil if current line should outdent a level." 389 "Return non-nil if current line should outdent a level."
342 (save-excursion 390 (save-excursion
343 (back-to-indentation) 391 (back-to-indentation)
344 (and (looking-at (rx (and (or (and (or "else" "finally") symbol-end) 392 (and (looking-at (rx (and (or "else" "finally" "except" "elif")
345 (and (or "except" "elif") symbol-end 393 symbol-end)))
346 (1+ (not (any ?:))))) 394 (not (python-in-string/comment))
347 (optional space) ":" (optional space)
348 (or (syntax comment-start) line-end))))
349 (progn (end-of-line)
350 (not (python-in-string/comment)))
351 ;; Ensure there's a previous statement and move to it. 395 ;; Ensure there's a previous statement and move to it.
352 (zerop (python-previous-statement)) 396 (zerop (python-previous-statement))
353 (not (python-close-block-statement-p t)) 397 (not (python-close-block-statement-p t))
354 ;; Fixme: check this 398 ;; Fixme: check this
355 (not (looking-at (rx (and (or (and (or "if" "elif" "except" 399 (not (python-open-block-statement-p)))))
356 "for" "while")
357 symbol-end (1+ (not (any ?:))))
358 (and "try" symbol-end))
359 (optional space) ":" (optional space)
360 (or (syntax comment-start) line-end)))))
361 (progn (end-of-line)
362 (not (python-in-string/comment))))))
363 400
364;;;; Indentation. 401;;;; Indentation.
365 402
366(defcustom python-indent 4 403(defcustom python-indent 4
367 "*Number of columns for a unit of indentation in Python mode. 404 "Number of columns for a unit of indentation in Python mode.
368See also `\\[python-guess-indent]'" 405See also `\\[python-guess-indent]'"
369 :group 'python 406 :group 'python
370 :type 'integer) 407 :type 'integer)
371 408
372(defcustom python-guess-indent t 409(defcustom python-guess-indent t
373 "*Non-nil means Python mode guesses `python-indent' for the buffer." 410 "Non-nil means Python mode guesses `python-indent' for the buffer."
374 :type 'boolean 411 :type 'boolean
375 :group 'python) 412 :group 'python)
376 413
377(defcustom python-indent-string-contents t 414(defcustom python-indent-string-contents t
378 "*Non-nil means indent contents of multi-line strings together. 415 "Non-nil means indent contents of multi-line strings together.
379This means indent them the same as the preceding non-blank line. 416This means indent them the same as the preceding non-blank line.
380Otherwise indent them to column zero." 417Otherwise preserve their indentation.
418
419This only applies to `doc' strings, i.e. those that form statements;
420the indentation is preserved in others."
381 :type '(choice (const :tag "Align with preceding" t) 421 :type '(choice (const :tag "Align with preceding" t)
382 (const :tag "Indent to column 0" nil)) 422 (const :tag "Preserve indentation" nil))
383 :group 'python) 423 :group 'python)
384 424
385(defcustom python-honour-comment-indentation nil 425(defcustom python-honour-comment-indentation nil
386 "Non-nil means indent relative to preceding comment line. 426 "Non-nil means indent relative to preceding comment line.
387Only do this for comments where the leading comment character is followed 427Only do this for comments where the leading comment character is
388by space. This doesn't apply to comment lines, which are always indented 428followed by space. This doesn't apply to comment lines, which
389in lines with preceding comments." 429are always indented in lines with preceding comments."
390 :type 'boolean 430 :type 'boolean
391 :group 'python) 431 :group 'python)
392 432
393(defcustom python-continuation-offset 4 433(defcustom python-continuation-offset 4
394 "*Number of columns of additional indentation for continuation lines. 434 "Number of columns of additional indentation for continuation lines.
395Continuation lines follow a backslash-terminated line starting a statement." 435Continuation lines follow a backslash-terminated line starting a
436statement."
396 :group 'python 437 :group 'python
397 :type 'integer) 438 :type 'integer)
398 439
@@ -406,9 +447,9 @@ Set `python-indent' locally to the value guessed."
406 (goto-char (point-min)) 447 (goto-char (point-min))
407 (let (done indent) 448 (let (done indent)
408 (while (and (not done) (not (eobp))) 449 (while (and (not done) (not (eobp)))
409 (when (and (re-search-forward (rx (and ?: (0+ space) 450 (when (and (re-search-forward (rx ?: (0+ space)
410 (or (syntax comment-start) 451 (or (syntax comment-start)
411 line-end))) 452 line-end))
412 nil 'move) 453 nil 'move)
413 (python-open-block-statement-p)) 454 (python-open-block-statement-p))
414 (save-excursion 455 (save-excursion
@@ -425,8 +466,21 @@ Set `python-indent' locally to the value guessed."
425 (setq indent-tabs-mode nil))) 466 (setq indent-tabs-mode nil)))
426 indent))))) 467 indent)))))
427 468
469;; Alist of possible indentations and start of statement they would
470;; close. Used in indentation cycling (below).
471(defvar python-indent-list nil
472 "Internal use.")
473;; Length of the above
474(defvar python-indent-list-length nil
475 "Internal use.")
476;; Current index into the alist.
477(defvar python-indent-index nil
478 "Internal use.")
479
428(defun python-calculate-indentation () 480(defun python-calculate-indentation ()
429 "Calculate Python indentation for line at point." 481 "Calculate Python indentation for line at point."
482 (setq python-indent-list nil
483 python-indent-list-length 1)
430 (save-excursion 484 (save-excursion
431 (beginning-of-line) 485 (beginning-of-line)
432 (let ((syntax (syntax-ppss)) 486 (let ((syntax (syntax-ppss))
@@ -434,17 +488,25 @@ Set `python-indent' locally to the value guessed."
434 (cond 488 (cond
435 ((eq 'string (syntax-ppss-context syntax)) ; multi-line string 489 ((eq 'string (syntax-ppss-context syntax)) ; multi-line string
436 (if (not python-indent-string-contents) 490 (if (not python-indent-string-contents)
437 0 491 (current-indentation)
438 (save-excursion 492 ;; Only respect `python-indent-string-contents' in doc
493 ;; strings (defined as those which form statements).
494 (if (not (save-excursion
495 (python-beginning-of-statement)
496 (looking-at (rx (or (syntax string-delimiter)
497 (syntax string-quote))))))
498 (current-indentation)
439 ;; Find indentation of preceding non-blank line within string. 499 ;; Find indentation of preceding non-blank line within string.
440 (setq start (nth 8 syntax)) 500 (setq start (nth 8 syntax))
441 (forward-line -1) 501 (forward-line -1)
442 (while (and (< start (point)) (looking-at "\\s-*$")) 502 (while (and (< start (point)) (looking-at "\\s-*$"))
443 (forward-line -1)) 503 (forward-line -1))
444 (current-indentation)))) 504 (current-indentation))))
445 ((python-continuation-line-p) 505 ((python-continuation-line-p) ; after backslash, or bracketed
446 (let ((point (point)) 506 (let ((point (point))
447 (open-start (cadr syntax))) 507 (open-start (cadr syntax))
508 (backslash (python-backslash-continuation-line-p))
509 (colon (eq ?: (char-before (1- (line-beginning-position))))))
448 (if open-start 510 (if open-start
449 ;; Inside bracketed expression. 511 ;; Inside bracketed expression.
450 (progn 512 (progn
@@ -458,7 +520,11 @@ Set `python-indent' locally to the value guessed."
458 (backward-sexp) 520 (backward-sexp)
459 (< (point) point)) 521 (< (point) point))
460 (error nil)))) 522 (error nil))))
461 (current-column) 523 ;; Extra level if we're backslash-continued or
524 ;; following a key.
525 (if (or backslash colon)
526 (+ python-indent (current-column))
527 (current-column))
462 ;; Otherwise indent relative to statement start, one 528 ;; Otherwise indent relative to statement start, one
463 ;; level per bracketing level. 529 ;; level per bracketing level.
464 (goto-char (1+ open-start)) 530 (goto-char (1+ open-start))
@@ -472,112 +538,153 @@ Set `python-indent' locally to the value guessed."
472 (current-indentation) 538 (current-indentation)
473 ;; First continuation line. Indent one step, with an 539 ;; First continuation line. Indent one step, with an
474 ;; extra one if statement opens a block. 540 ;; extra one if statement opens a block.
475 (save-excursion 541 (python-beginning-of-statement)
476 (python-beginning-of-statement) 542 (+ (current-indentation) python-continuation-offset
477 (+ (current-indentation) python-continuation-offset 543 (if (python-open-block-statement-p t)
478 (if (python-open-block-statement-p t) 544 python-indent
479 python-indent 545 0))))))
480 0)))))))
481 ((bobp) 0) 546 ((bobp) 0)
482 ;; Fixme: Like python-mode.el; not convinced by this. 547 ;; Fixme: Like python-mode.el; not convinced by this.
483 ((looking-at (rx (and (0+ space) (syntax comment-start) 548 ((looking-at (rx (0+ space) (syntax comment-start)
484 (not (any " \t\n"))))) ; non-indentable comment 549 (not (any " \t\n")))) ; non-indentable comment
485 (current-indentation)) 550 (current-indentation))
486 (t (let ((point (point))) 551 (t (if python-honour-comment-indentation
487 (if python-honour-comment-indentation 552 ;; Back over whitespace, newlines, non-indentable comments.
488 ;; Back over whitespace, newlines, non-indentable comments. 553 (catch 'done
489 (catch 'done 554 (while t
490 (while t 555 (if (cond ((bobp))
491 (if (cond ((bobp)) 556 ;; not at comment start
492 ;; not at comment start 557 ((not (forward-comment -1))
493 ((not (forward-comment -1)) 558 (python-beginning-of-statement)
494 (python-beginning-of-statement) 559 t)
495 t) 560 ;; trailing comment
496 ;; trailing comment 561 ((/= (current-column) (current-indentation))
497 ((/= (current-column) (current-indentation)) 562 (python-beginning-of-statement)
498 (python-beginning-of-statement) 563 t)
499 t) 564 ;; indentable comment like python-mode.el
500 ;; indentable comment like python-mode.el 565 ((and (looking-at (rx (syntax comment-start)
501 ((and (looking-at (rx (and (syntax comment-start) 566 (or space line-end)))
502 (or space line-end)))) 567 (/= 0 (current-column)))))
503 (/= 0 (current-column))))) 568 (throw 'done t)))))
504 (throw 'done t)))) 569 (python-indentation-levels)
505 ;; Else back over all comments. 570 ;; Prefer to indent comments with an immediately-following
506 (python-skip-comments/blanks t) 571 ;; statement, e.g.
507 (python-beginning-of-statement)) 572 ;; ...
508 ;; don't lose on bogus outdent 573 ;; # ...
509 (max 0 (+ (current-indentation) 574 ;; def ...
510 (or (cond ((python-open-block-statement-p t) 575 (when (and (> python-indent-list-length 1)
511 python-indent) 576 (python-comment-line-p))
512 ((python-close-block-statement-p t) 577 (forward-line)
513 (- python-indent))) 578 (unless (python-comment-line-p)
514 (progn (goto-char point) 579 (let ((elt (assq (current-indentation) python-indent-list)))
515 (if (python-outdent-p) 580 (setq python-indent-list
516 (- python-indent))) 581 (nconc (delete elt python-indent-list)
517 0))))))))) 582 (list elt))))))
518 583 (caar (last python-indent-list)))))))
519(defun python-comment-indent ()
520 "`comment-indent-function' for Python."
521 ;; If previous non-blank line was a comment, use its indentation.
522 ;; FIXME: This seems unnecessary since the default code delegates to
523 ;; indent-according-to-mode. --Stef
524 (unless (bobp)
525 (save-excursion
526 (forward-comment -1)
527 (if (eq ?# (char-after)) (current-column)))))
528 584
529;;;; Cycling through the possible indentations with successive TABs. 585;;;; Cycling through the possible indentations with successive TABs.
530 586
531;; These don't need to be buffer-local since they're only relevant 587;; These don't need to be buffer-local since they're only relevant
532;; during a cycle. 588;; during a cycle.
533 589
534;; Alist of possible indentations and start of statement they would close.
535(defvar python-indent-list nil
536 "Internal use.")
537;; Length of the above
538(defvar python-indent-list-length nil
539 "Internal use.")
540;; Current index into the alist.
541(defvar python-indent-index nil
542 "Internal use.")
543
544(defun python-initial-text () 590(defun python-initial-text ()
545 "Text of line following indentation and ignoring any trailing comment." 591 "Text of line following indentation and ignoring any trailing comment."
546 (buffer-substring (+ (line-beginning-position) (current-indentation)) 592 (save-excursion
547 (save-excursion 593 (buffer-substring (progn
548 (end-of-line) 594 (back-to-indentation)
549 (forward-comment -1) 595 (point))
550 (point)))) 596 (progn
597 (end-of-line)
598 (forward-comment -1)
599 (point)))))
600
601(defconst python-block-pairs
602 '(("else" "if" "elif" "while" "for" "try" "except")
603 ("elif" "if" "elif")
604 ("except" "try" "except")
605 ("finally" "try"))
606 "Alist of keyword matches.
607The car of an element is a keyword introducing a statement which
608can close a block opened by a keyword in the cdr.")
609
610(defun python-first-word ()
611 "Return first word (actually symbol) on the line."
612 (save-excursion
613 (back-to-indentation)
614 (current-word t)))
551 615
552(defun python-indentation-levels () 616(defun python-indentation-levels ()
553 "Return a list of possible indentations for this line. 617 "Return a list of possible indentations for this line.
618It is assumed not to be a continuation line or in a multi-line string.
554Includes the default indentation and those which would close all 619Includes the default indentation and those which would close all
555enclosing blocks. Assumes the line has already been indented per 620enclosing blocks. Elements of the list are actually pairs:
556`python-indent-line'. Elements of the list are actually pairs:
557\(INDENTATION . TEXT), where TEXT is the initial text of the 621\(INDENTATION . TEXT), where TEXT is the initial text of the
558corresponding block opening (or nil)." 622corresponding block opening (or nil)."
559 (save-excursion 623 (save-excursion
560 (let ((levels (list (cons (current-indentation) 624 (let ((initial "")
561 (save-excursion 625 levels indent)
562 (if (python-beginning-of-block) 626 ;; Only one possibility immediately following a block open
563 (python-initial-text))))))) 627 ;; statement, assuming it doesn't have a `suite' on the same line.
564 ;; Only one possibility if we immediately follow a block open or 628 (cond
565 ;; are in a continuation line. 629 ((save-excursion (and (python-previous-statement)
566 (unless (or (python-continuation-line-p) 630 (python-open-block-statement-p t)
567 (save-excursion (and (python-previous-statement) 631 (setq indent (current-indentation))
568 (python-open-block-statement-p t)))) 632 ;; Check we don't have something like:
569 (while (python-beginning-of-block) 633 ;; if ...: ...
570 (push (cons (current-indentation) (python-initial-text)) 634 (if (progn (python-end-of-statement)
571 levels))) 635 (python-skip-comments/blanks t)
572 levels))) 636 (eq ?: (char-before)))
637 (setq indent (+ python-indent indent)))))
638 (push (cons indent initial) levels))
639 ;; Only one possibility for comment line immediately following
640 ;; another.
641 ((save-excursion
642 (when (python-comment-line-p)
643 (forward-line -1)
644 (if (python-comment-line-p)
645 (push (cons (current-indentation) initial) levels)))))
646 ;; Fixme: Maybe have a case here which indents (only) first
647 ;; line after a lambda.
648 (t
649 (let ((start (car (assoc (python-first-word) python-block-pairs))))
650 (python-previous-statement)
651 ;; Is this a valid indentation for the line of interest?
652 (unless (or (if start ; potentially only outdentable
653 ;; Check for things like:
654 ;; if ...: ...
655 ;; else ...:
656 ;; where the second line need not be outdented.
657 (not (member (python-first-word)
658 (cdr (assoc start
659 python-block-pairs)))))
660 ;; Not sensible to indent to the same level as
661 ;; previous `return' &c.
662 (python-close-block-statement-p))
663 (push (cons (current-indentation) (python-initial-text))
664 levels))
665 (while (python-beginning-of-block)
666 (when (or (not start)
667 (member (python-first-word)
668 (cdr (assoc start python-block-pairs))))
669 (push (cons (current-indentation) (python-initial-text))
670 levels))))))
671 (prog1 (or levels (setq levels '((0 . ""))))
672 (setq python-indent-list levels
673 python-indent-list-length (length python-indent-list))))))
573 674
574;; This is basically what `python-indent-line' would be if we didn't 675;; This is basically what `python-indent-line' would be if we didn't
575;; do the cycling. 676;; do the cycling.
576(defun python-indent-line-1 () 677(defun python-indent-line-1 (&optional leave)
577 "Subroutine of `python-indent-line'." 678 "Subroutine of `python-indent-line'.
679Does non-repeated indentation. LEAVE non-nil means leave
680indentation if it is valid, i.e. one of the positions returned by
681`python-calculate-indentation'."
578 (let ((target (python-calculate-indentation)) 682 (let ((target (python-calculate-indentation))
579 (pos (- (point-max) (point)))) 683 (pos (- (point-max) (point))))
580 (if (= target (current-indentation)) 684 (if (or (= target (current-indentation))
685 ;; Maybe keep a valid indentation.
686 (and leave python-indent-list
687 (assq (current-indentation) python-indent-list)))
581 (if (< (current-column) (current-indentation)) 688 (if (< (current-column) (current-indentation))
582 (back-to-indentation)) 689 (back-to-indentation))
583 (beginning-of-line) 690 (beginning-of-line)
@@ -589,29 +696,41 @@ corresponding block opening (or nil)."
589(defun python-indent-line () 696(defun python-indent-line ()
590 "Indent current line as Python code. 697 "Indent current line as Python code.
591When invoked via `indent-for-tab-command', cycle through possible 698When invoked via `indent-for-tab-command', cycle through possible
592indentations for current line. The cycle is broken by a command different 699indentations for current line. The cycle is broken by a command
593from `indent-for-tab-command', i.e. successive TABs do the cycling." 700different from `indent-for-tab-command', i.e. successive TABs do
701the cycling."
594 (interactive) 702 (interactive)
595 ;; Don't do extra work if invoked via `indent-region', for instance. 703 (if (and (eq this-command 'indent-for-tab-command)
596 (if (not (eq this-command 'indent-for-tab-command)) 704 (eq last-command this-command))
597 (python-indent-line-1) 705 (if (= 1 python-indent-list-length)
598 (if (eq last-command this-command) 706 (message "Sole indentation")
599 (if (= 1 python-indent-list-length) 707 (progn (setq python-indent-index
600 (message "Sole indentation") 708 (% (1+ python-indent-index) python-indent-list-length))
601 (progn (setq python-indent-index (% (1+ python-indent-index) 709 (beginning-of-line)
602 python-indent-list-length)) 710 (delete-horizontal-space)
603 (beginning-of-line) 711 (indent-to (car (nth python-indent-index python-indent-list)))
604 (delete-horizontal-space) 712 (if (python-block-end-p)
605 (indent-to (car (nth python-indent-index python-indent-list))) 713 (let ((text (cdr (nth python-indent-index
606 (if (python-block-end-p) 714 python-indent-list))))
607 (let ((text (cdr (nth python-indent-index 715 (if text
608 python-indent-list)))) 716 (message "Closes: %s" text))))))
609 (if text 717 (python-indent-line-1)
610 (message "Closes: %s" text)))))) 718 (setq python-indent-index (1- python-indent-list-length))))
611 (python-indent-line-1) 719
612 (setq python-indent-list (python-indentation-levels) 720(defun python-indent-region (start end)
613 python-indent-list-length (length python-indent-list) 721 "`indent-region-function' for Python.
614 python-indent-index (1- python-indent-list-length))))) 722Leaves validly-indented lines alone, i.e. doesn't indent to
723another valid position."
724 (save-excursion
725 (goto-char end)
726 (setq end (point-marker))
727 (goto-char start)
728 (or (bolp) (forward-line 1))
729 (while (< (point) end)
730 (or (and (bolp) (eolp))
731 (python-indent-line-1 t))
732 (forward-line 1))
733 (move-marker end nil)))
615 734
616(defun python-block-end-p () 735(defun python-block-end-p ()
617 "Non-nil if this is a line in a statement closing a block, 736 "Non-nil if this is a line in a statement closing a block,
@@ -622,40 +741,41 @@ or a blank line indented to where it would close a block."
622 (save-excursion 741 (save-excursion
623 (python-previous-statement) 742 (python-previous-statement)
624 (current-indentation)))))) 743 (current-indentation))))))
625
626;; Fixme: Define an indent-region-function. It should probably leave
627;; lines alone if the indentation is already at one of the allowed
628;; levels. Otherwise, M-C-\ typically keeps indenting more deeply
629;; down a function.
630 744
631;;;; Movement. 745;;;; Movement.
632 746
747;; Fixme: Define {for,back}ward-sexp-function? Maybe skip units like
748;; block, statement, depending on context.
749
633(defun python-beginning-of-defun () 750(defun python-beginning-of-defun ()
634 "`beginning-of-defun-function' for Python. 751 "`beginning-of-defun-function' for Python.
635Finds beginning of innermost nested class or method definition. 752Finds beginning of innermost nested class or method definition.
636Returns the name of the definition found at the end, or nil if reached 753Returns the name of the definition found at the end, or nil if
637start of buffer." 754reached start of buffer."
638 (let ((ci (current-indentation)) 755 (let ((ci (current-indentation))
639 (def-re (rx (and line-start (0+ space) (or "def" "class") 756 (def-re (rx line-start (0+ space) (or "def" "class") (1+ space)
640 (1+ space) 757 (group (1+ (or word (syntax symbol))))))
641 (group (1+ (or word (syntax symbol))))))) 758 found lep) ;; def-line
642 found lep def-line)
643 (if (python-comment-line-p) 759 (if (python-comment-line-p)
644 (setq ci most-positive-fixnum)) 760 (setq ci most-positive-fixnum))
645 (while (and (not (bobp)) (not found)) 761 (while (and (not (bobp)) (not found))
646 ;; Treat bol at beginning of function as outside function so 762 ;; Treat bol at beginning of function as outside function so
647 ;; that successive C-M-a makes progress backwards. 763 ;; that successive C-M-a makes progress backwards.
648 (setq def-line (looking-at def-re)) 764 ;;(setq def-line (looking-at def-re))
649 (unless (bolp) (end-of-line)) 765 (unless (bolp) (end-of-line))
650 (setq lep (line-end-position)) 766 (setq lep (line-end-position))
651 (if (and (re-search-backward def-re nil 'move) 767 (if (and (re-search-backward def-re nil 'move)
652 ;; Must be less indented or matching top level, or 768 ;; Must be less indented or matching top level, or
653 ;; equally indented if we started on a definition line. 769 ;; equally indented if we started on a definition line.
654 (let ((in (current-indentation))) 770 (let ((in (current-indentation)))
655 (or (and (zerop ci) (zerop in)) 771 (or (and (zerop ci) (zerop in))
656 (= lep (line-end-position)) ; on initial line 772 (= lep (line-end-position)) ; on initial line
657 (and def-line (= in ci)) 773 ;; Not sure why it was like this -- fails in case of
658 (< in ci))) 774 ;; last internal function followed by first
775 ;; non-def statement of the main body.
776 ;;(and def-line (= in ci))
777 (= in ci)
778 (< in ci)))
659 (not (python-in-string/comment))) 779 (not (python-in-string/comment)))
660 (setq found t))))) 780 (setq found t)))))
661 781
@@ -663,7 +783,7 @@ start of buffer."
663 "`end-of-defun-function' for Python. 783 "`end-of-defun-function' for Python.
664Finds end of innermost nested class or method definition." 784Finds end of innermost nested class or method definition."
665 (let ((orig (point)) 785 (let ((orig (point))
666 (pattern (rx (and line-start (0+ space) (or "def" "class") space)))) 786 (pattern (rx line-start (0+ space) (or "def" "class") space)))
667 ;; Go to start of current block and check whether it's at top 787 ;; Go to start of current block and check whether it's at top
668 ;; level. If it is, and not a block start, look forward for 788 ;; level. If it is, and not a block start, look forward for
669 ;; definition statement. 789 ;; definition statement.
@@ -692,8 +812,9 @@ Finds end of innermost nested class or method definition."
692 (python-end-of-block) 812 (python-end-of-block)
693 ;; Count trailing space in defun (but not trailing comments). 813 ;; Count trailing space in defun (but not trailing comments).
694 (skip-syntax-forward " >") 814 (skip-syntax-forward " >")
695 (beginning-of-line)) 815 (unless (eobp) ; e.g. missing final newline
696 ;; Catch pathological case like this, where the beginning-of-defun 816 (beginning-of-line)))
817 ;; Catch pathological cases like this, where the beginning-of-defun
697 ;; skips to a definition we're not in: 818 ;; skips to a definition we're not in:
698 ;; if ...: 819 ;; if ...:
699 ;; ... 820 ;; ...
@@ -706,26 +827,43 @@ Finds end of innermost nested class or method definition."
706 827
707(defun python-beginning-of-statement () 828(defun python-beginning-of-statement ()
708 "Go to start of current statement. 829 "Go to start of current statement.
709Accounts for continuation lines, multi-line strings, and multi-line bracketed 830Accounts for continuation lines, multi-line strings, and
710expressions." 831multi-line bracketed expressions."
711 (beginning-of-line) 832 (beginning-of-line)
712 (python-beginning-of-string) 833 (python-beginning-of-string)
713 (catch 'foo 834 (while (python-continuation-line-p)
714 (while (python-continuation-line-p) 835 (beginning-of-line)
715 (beginning-of-line) 836 (if (python-backslash-continuation-line-p)
716 (if (python-backslash-continuation-line-p) 837 (progn
838 (forward-line -1)
717 (while (python-backslash-continuation-line-p) 839 (while (python-backslash-continuation-line-p)
718 (forward-line -1)) 840 (forward-line -1)))
719 (python-beginning-of-string) 841 (python-beginning-of-string)
720 ;; Skip forward out of nested brackets. 842 (python-skip-out)))
721 (condition-case () ; beware invalid syntax
722 (let ((depth (syntax-ppss-depth (syntax-ppss))))
723 ;; Beware negative depths.
724 (if (> depth 0) (backward-up-list depth))
725 t)
726 (error (throw 'foo nil))))))
727 (back-to-indentation)) 843 (back-to-indentation))
728 844
845(defun python-skip-out (&optional forward syntax)
846 "Skip out of any nested brackets.
847Skip forward if FORWARD is non-nil, else backward.
848If SYNTAX is non-nil it is the state returned by `syntax-ppss' at point.
849Return non-nil iff skipping was done."
850 (let ((depth (syntax-ppss-depth (or syntax (syntax-ppss))))
851 (forward (if forward -1 1)))
852 (unless (zerop depth)
853 (if (> depth 0)
854 ;; Skip forward out of nested brackets.
855 (condition-case () ; beware invalid syntax
856 (progn (backward-up-list (* forward depth)) t)
857 (error nil))
858 ;; Invalid syntax (too many closed brackets).
859 ;; Skip out of as many as possible.
860 (let (done)
861 (while (condition-case ()
862 (progn (backward-up-list forward)
863 (setq done t))
864 (error nil)))
865 done)))))
866
729(defun python-end-of-statement () 867(defun python-end-of-statement ()
730 "Go to the end of the current statement and return point. 868 "Go to the end of the current statement and return point.
731Usually this is the start of the next line, but if this is a 869Usually this is the start of the next line, but if this is a
@@ -745,13 +883,7 @@ On a comment line, go to end of line."
745 (condition-case () ; beware invalid syntax 883 (condition-case () ; beware invalid syntax
746 (progn (forward-sexp) t) 884 (progn (forward-sexp) t)
747 (error (end-of-line)))) 885 (error (end-of-line))))
748 ((> (syntax-ppss-depth s) 0) 886 ((python-skip-out t s))))
749 ;; Skip forward out of nested brackets.
750 (condition-case () ; beware invalid syntax
751 (progn (backward-up-list
752 (- (syntax-ppss-depth s)))
753 t)
754 (error (end-of-line))))))
755 (end-of-line)) 887 (end-of-line))
756 (unless comment 888 (unless comment
757 (eq ?\\ (char-before)))) ; Line continued? 889 (eq ?\\ (char-before)))) ; Line continued?
@@ -785,7 +917,8 @@ Return count of statements left to move."
785 (while (and (> count 0) (not (eobp))) 917 (while (and (> count 0) (not (eobp)))
786 (python-end-of-statement) 918 (python-end-of-statement)
787 (python-skip-comments/blanks) 919 (python-skip-comments/blanks)
788 (setq count (1- count))) 920 (unless (eobp)
921 (setq count (1- count))))
789 count)) 922 count))
790 923
791(defun python-beginning-of-block (&optional arg) 924(defun python-beginning-of-block (&optional arg)
@@ -802,7 +935,8 @@ Otherwise return non-nil."
802 ((< arg 0) (python-end-of-block (- arg))) 935 ((< arg 0) (python-end-of-block (- arg)))
803 (t 936 (t
804 (let ((point (point))) 937 (let ((point (point)))
805 (if (python-comment-line-p) 938 (if (or (python-comment-line-p)
939 (python-blank-line-p))
806 (python-skip-comments/blanks t)) 940 (python-skip-comments/blanks t))
807 (python-beginning-of-statement) 941 (python-beginning-of-statement)
808 (let ((ci (current-indentation))) 942 (let ((ci (current-indentation)))
@@ -830,32 +964,31 @@ Otherwise return non-nil."
830 964
831(defun python-end-of-block (&optional arg) 965(defun python-end-of-block (&optional arg)
832 "Go to end of current block. 966 "Go to end of current block.
833With numeric arg, do it that many times. If ARG is negative, call 967With numeric arg, do it that many times. If ARG is negative,
834`python-beginning-of-block' instead. 968call `python-beginning-of-block' instead.
835If current statement is in column zero and doesn't open a block, don't 969If current statement is in column zero and doesn't open a block,
836move and return nil. Otherwise return t." 970don't move and return nil. Otherwise return t."
837 (interactive "p") 971 (interactive "p")
838 (unless arg (setq arg 1)) 972 (unless arg (setq arg 1))
839 (if (< arg 0) 973 (if (< arg 0)
840 (python-beginning-of-block (- arg))) 974 (python-beginning-of-block (- arg))
841 (while (and (> arg 0) 975 (while (and (> arg 0)
842 (let* ((point (point)) 976 (let* ((point (point))
843 (_ (if (python-comment-line-p) 977 (_ (if (python-comment-line-p)
844 (python-skip-comments/blanks t))) 978 (python-skip-comments/blanks t)))
845 (ci (current-indentation)) 979 (ci (current-indentation))
846 (open (python-open-block-statement-p))) 980 (open (python-open-block-statement-p)))
847 (if (and (zerop ci) (not open)) 981 (if (and (zerop ci) (not open))
848 (not (goto-char point)) 982 (not (goto-char point))
849 (catch 'done 983 (catch 'done
850 (while (zerop (python-next-statement)) 984 (while (zerop (python-next-statement))
851 (when (or (and open (<= (current-indentation) ci)) 985 (when (or (and open (<= (current-indentation) ci))
852 (< (current-indentation) ci)) 986 (< (current-indentation) ci))
853 (python-skip-comments/blanks t) 987 (python-skip-comments/blanks t)
854 (beginning-of-line 2) 988 (beginning-of-line 2)
855 (throw 'done t))) 989 (throw 'done t)))))))
856 (not (goto-char point)))))) 990 (setq arg (1- arg)))
857 (setq arg (1- arg))) 991 (zerop arg)))
858 (zerop arg))
859 992
860;;;; Imenu. 993;;;; Imenu.
861 994
@@ -868,14 +1001,23 @@ The nested menus are headed by an item referencing the outer
868definition; it has a space prepended to the name so that it sorts 1001definition; it has a space prepended to the name so that it sorts
869first with `imenu--sort-by-name' (though, unfortunately, sub-menus 1002first with `imenu--sort-by-name' (though, unfortunately, sub-menus
870precede it)." 1003precede it)."
871 (unless (boundp 'python-recursing) ; dynamically bound below 1004 (unless (boundp 'python-recursing) ; dynamically bound below
872 (goto-char (point-min))) ; normal call from Imenu 1005 ;; Normal call from Imenu.
873 (let (index-alist ; accumulated value to return 1006 (goto-char (point-min))
874 name) 1007 ;; Without this, we can get an infloop if the buffer isn't all
1008 ;; fontified. I guess this is really a bug in syntax.el. OTOH,
1009 ;; _with_ this, imenu doesn't immediately work; I can't figure out
1010 ;; what's going on, but it must be something to do with timers in
1011 ;; font-lock.
1012 ;; This can't be right, especially not when jit-lock is not used. --Stef
1013 ;; (unless (get-text-property (1- (point-max)) 'fontified)
1014 ;; (font-lock-fontify-region (point-min) (point-max)))
1015 )
1016 (let (index-alist) ; accumulated value to return
875 (while (re-search-forward 1017 (while (re-search-forward
876 (rx (and line-start (0+ space) ; leading space 1018 (rx line-start (0+ space) ; leading space
877 (or (group "def") (group "class")) ; type 1019 (or (group "def") (group "class")) ; type
878 (1+ space) (group (1+ (or word ?_))))) ; name 1020 (1+ space) (group (1+ (or word ?_)))) ; name
879 nil t) 1021 nil t)
880 (unless (python-in-string/comment) 1022 (unless (python-in-string/comment)
881 (let ((pos (match-beginning 0)) 1023 (let ((pos (match-beginning 0))
@@ -890,7 +1032,22 @@ precede it)."
890 (progn (push (cons (concat " " name) pos) sublist) 1032 (progn (push (cons (concat " " name) pos) sublist)
891 (push (cons name sublist) index-alist)) 1033 (push (cons name sublist) index-alist))
892 (push (cons name pos) index-alist))))))) 1034 (push (cons name pos) index-alist)))))))
893 (nreverse index-alist))) 1035 (unless (boundp 'python-recursing)
1036 ;; Look for module variables.
1037 (let (vars)
1038 (goto-char (point-min))
1039 (while (re-search-forward
1040 (rx line-start (group (1+ (or word ?_))) (0+ space) "=")
1041 nil t)
1042 (unless (python-in-string/comment)
1043 (push (cons (match-string 1) (match-beginning 1))
1044 vars)))
1045 (setq index-alist (nreverse index-alist))
1046 (if vars
1047 (push (cons "Module variables"
1048 (nreverse vars))
1049 index-alist))))
1050 index-alist))
894 1051
895;;;; `Electric' commands. 1052;;;; `Electric' commands.
896 1053
@@ -910,20 +1067,26 @@ just insert a single colon."
910 1067
911(defun python-backspace (arg) 1068(defun python-backspace (arg)
912 "Maybe delete a level of indentation on the current line. 1069 "Maybe delete a level of indentation on the current line.
913If not at the end of line's indentation, or on a comment line, just call 1070Do so if point is at the end of the line's indentation.
914`backward-delete-char-untabify'. With ARG, repeat that many times." 1071Otherwise just call `backward-delete-char-untabify'.
1072Repeat ARG times."
915 (interactive "*p") 1073 (interactive "*p")
916 (if (or (/= (current-indentation) (current-column)) 1074 (if (or (/= (current-indentation) (current-column))
917 (bolp) 1075 (bolp)
918 (python-continuation-line-p)) 1076 (python-continuation-line-p))
919 (backward-delete-char-untabify arg) 1077 (backward-delete-char-untabify arg)
920 (let ((indent 0)) 1078 ;; Look for the largest valid indentation which is smaller than
921 (save-excursion 1079 ;; the current indentation.
922 (while (and (> arg 0) (python-beginning-of-block)) 1080 (let ((indent 0)
923 (setq arg (1- arg))) 1081 (ci (current-indentation))
924 (when (zerop arg) 1082 (indents (python-indentation-levels))
925 (setq indent (current-indentation)) 1083 initial)
926 (message "Closes %s" (python-initial-text)))) 1084 (dolist (x indents)
1085 (if (< (car x) ci)
1086 (setq indent (max indent (car x)))))
1087 (setq initial (cdr (assq indent indents)))
1088 (if (> (length initial) 0)
1089 (message "Closes %s" initial))
927 (delete-horizontal-space) 1090 (delete-horizontal-space)
928 (indent-to indent)))) 1091 (indent-to indent))))
929(put 'python-backspace 'delete-selection 'supersede) 1092(put 'python-backspace 'delete-selection 'supersede)
@@ -931,7 +1094,7 @@ If not at the end of line's indentation, or on a comment line, just call
931;;;; pychecker 1094;;;; pychecker
932 1095
933(defcustom python-check-command "pychecker --stdlib" 1096(defcustom python-check-command "pychecker --stdlib"
934 "*Command used to check a Python file." 1097 "Command used to check a Python file."
935 :type 'string 1098 :type 'string
936 :group 'python) 1099 :group 'python)
937 1100
@@ -963,66 +1126,54 @@ See `python-check-command' for the default."
963;; Fixme: Make sure we can work with IPython. 1126;; Fixme: Make sure we can work with IPython.
964 1127
965(defcustom python-python-command "python" 1128(defcustom python-python-command "python"
966 "*Shell command to run Python interpreter. 1129 "Shell command to run Python interpreter.
967Any arguments can't contain whitespace. 1130Any arguments can't contain whitespace.
968Note that IPython may not work properly; it must at least be used with the 1131Note that IPython may not work properly; it must at least be used
969`-cl' flag, i.e. use `ipython -cl'." 1132with the `-cl' flag, i.e. use `ipython -cl'."
970 :group 'python 1133 :group 'python
971 :type 'string) 1134 :type 'string)
972 1135
973(defcustom python-jython-command "jython" 1136(defcustom python-jython-command "jython"
974 "*Shell command to run Jython interpreter. 1137 "Shell command to run Jython interpreter.
975Any arguments can't contain whitespace." 1138Any arguments can't contain whitespace."
976 :group 'python 1139 :group 'python
977 :type 'string) 1140 :type 'string)
978 1141
979(defvar python-command python-python-command 1142(defvar python-command python-python-command
980 "Actual command used to run Python. 1143 "Actual command used to run Python.
981May be `python-python-command' or `python-jython-command'. 1144May be `python-python-command' or `python-jython-command', possibly
982Additional arguments are added when the command is used by `run-python' 1145modified by the user. Additional arguments are added when the command
983et al.") 1146is used by `run-python' et al.")
984 1147
985(defvar python-buffer nil 1148(defvar python-buffer nil
986 "The current python process buffer." 1149 "*The current python process buffer.
987 ;; Fixme: a single process is currently assumed, so that this doc 1150
988 ;; is misleading. 1151Commands that send text from source buffers to Python processes have
989 1152to choose a process to send to. This is determined by buffer-local
990;; "*The current python process buffer. 1153value of `python-buffer'. If its value in the current buffer,
991;; To run multiple Python processes, start the first with \\[run-python]. 1154i.e. both any local value and the default one, is nil, `run-python'
992;; It will be in a buffer named *Python*. Rename that with 1155and commands that send to the Python process will start a new process.
993;; \\[rename-buffer]. Now start a new process with \\[run-python]. It 1156
994;; will be in a new buffer, named *Python*. Switch between the different 1157Whenever \\[run-python] starts a new process, it resets the default
995;; process buffers with \\[switch-to-buffer]. 1158value of `python-buffer' to be the new process's buffer and sets the
996 1159buffer-local value similarly if the current buffer is in Python mode
997;; Commands that send text from source buffers to Python processes have 1160or Inferior Python mode, so that source buffer stays associated with a
998;; to choose a process to send to. This is determined by global variable 1161specific sub-process.
999;; `python-buffer'. Suppose you have three inferior Pythons running: 1162
1000;; Buffer Process 1163Use \\[python-set-proc] to set the default value from a buffer with a
1001;; foo python 1164local value.")
1002;; bar python<2> 1165(make-variable-buffer-local 'python-buffer)
1003;; *Python* python<3>
1004;; If you do a \\[python-send-region-and-go] command on some Python source
1005;; code, what process does it go to?
1006
1007;; - In a process buffer (foo, bar, or *Python*), send it to that process.
1008;; - In some other buffer (e.g. a source file), send it to the process
1009;; attached to `python-buffer'.
1010;; Process selection is done by function `python-proc'.
1011
1012;; Whenever \\[run-python] starts a new process, it resets `python-buffer'
1013;; to be the new process's buffer. If you only run one process, this will
1014;; do the right thing. If you run multiple processes, you can change
1015;; `python-buffer' to another process buffer with \\[set-variable]."
1016 )
1017 1166
1018(defconst python-compilation-regexp-alist 1167(defconst python-compilation-regexp-alist
1019 ;; FIXME: maybe these should move to compilation-error-regexp-alist-alist. 1168 ;; FIXME: maybe these should move to compilation-error-regexp-alist-alist.
1020 `((,(rx (and line-start (1+ (any " \t")) "File \"" 1169 ;; The first already is (for CAML), but the second isn't. Anyhow,
1021 (group (1+ (not (any "\"<")))) ; avoid `<stdin>' &c 1170 ;; these are specific to the inferior buffer. -- fx
1022 "\", line " (group (1+ digit)))) 1171 `((,(rx line-start (1+ (any " \t")) "File \""
1172 (group (1+ (not (any "\"<")))) ; avoid `<stdin>' &c
1173 "\", line " (group (1+ digit)))
1023 1 2) 1174 1 2)
1024 (,(rx (and " in file " (group (1+ not-newline)) " on line " 1175 (,(rx " in file " (group (1+ not-newline)) " on line "
1025 (group (1+ digit)))) 1176 (group (1+ digit)))
1026 1 2)) 1177 1 2))
1027 "`compilation-error-regexp-alist' for inferior Python.") 1178 "`compilation-error-regexp-alist' for inferior Python.")
1028 1179
@@ -1040,9 +1191,9 @@ et al.")
1040 ;; (define-key map "\C-c\C-f" 'python-describe-symbol) 1191 ;; (define-key map "\C-c\C-f" 'python-describe-symbol)
1041 map)) 1192 map))
1042 1193
1043;; Fixme: This should inherit some stuff from python-mode, but I'm not 1194;; Fixme: This should inherit some stuff from `python-mode', but I'm
1044;; sure how much: at least some keybindings, like C-c C-f; syntax?; 1195;; not sure how much: at least some keybindings, like C-c C-f;
1045;; font-locking, e.g. for triple-quoted strings? 1196;; syntax?; font-locking, e.g. for triple-quoted strings?
1046(define-derived-mode inferior-python-mode comint-mode "Inferior Python" 1197(define-derived-mode inferior-python-mode comint-mode "Inferior Python"
1047 "Major mode for interacting with an inferior Python process. 1198 "Major mode for interacting with an inferior Python process.
1048A Python process can be started with \\[run-python]. 1199A Python process can be started with \\[run-python].
@@ -1050,14 +1201,15 @@ A Python process can be started with \\[run-python].
1050Hooks `comint-mode-hook' and `inferior-python-mode-hook' are run in 1201Hooks `comint-mode-hook' and `inferior-python-mode-hook' are run in
1051that order. 1202that order.
1052 1203
1053You can send text to the inferior Python process from other buffers containing 1204You can send text to the inferior Python process from other buffers
1054Python source. 1205containing Python source.
1055 * `python-switch-to-python' switches the current buffer to the Python 1206 * \\[python-switch-to-python] switches the current buffer to the Python
1056 process buffer. 1207 process buffer.
1057 * `python-send-region' sends the current region to the Python process. 1208 * \\[python-send-region] sends the current region to the Python process.
1058 * `python-send-region-and-go' switches to the Python process buffer 1209 * \\[python-send-region-and-go] switches to the Python process buffer
1059 after sending the text. 1210 after sending the text.
1060For running multiple processes in multiple buffers, see `python-buffer'. 1211For running multiple processes in multiple buffers, see `run-python' and
1212`python-buffer'.
1061 1213
1062\\{inferior-python-mode-map}" 1214\\{inferior-python-mode-map}"
1063 :group 'python 1215 :group 'python
@@ -1069,13 +1221,13 @@ For running multiple processes in multiple buffers, see `python-buffer'.
1069 ;; Still required by `comint-redirect-send-command', for instance 1221 ;; Still required by `comint-redirect-send-command', for instance
1070 ;; (and we need to match things like `>>> ... >>> '): 1222 ;; (and we need to match things like `>>> ... >>> '):
1071 (set (make-local-variable 'comint-prompt-regexp) 1223 (set (make-local-variable 'comint-prompt-regexp)
1072 (rx (and line-start (1+ (and (repeat 3 (any ">.")) ?\s))))) 1224 (rx line-start (1+ (and (repeat 3 (any ">.")) " "))))
1073 (set (make-local-variable 'compilation-error-regexp-alist) 1225 (set (make-local-variable 'compilation-error-regexp-alist)
1074 python-compilation-regexp-alist) 1226 python-compilation-regexp-alist)
1075 (compilation-shell-minor-mode 1)) 1227 (compilation-shell-minor-mode 1))
1076 1228
1077(defcustom inferior-python-filter-regexp "\\`\\s-*\\S-?\\S-?\\s-*\\'" 1229(defcustom inferior-python-filter-regexp "\\`\\s-*\\S-?\\S-?\\s-*\\'"
1078 "*Input matching this regexp is not saved on the history list. 1230 "Input matching this regexp is not saved on the history list.
1079Default ignores all inputs of 0, 1, or 2 non-blank characters." 1231Default ignores all inputs of 0, 1, or 2 non-blank characters."
1080 :type 'regexp 1232 :type 'regexp
1081 :group 'python) 1233 :group 'python)
@@ -1098,98 +1250,134 @@ Don't save anything for STR matching `inferior-python-filter-regexp'."
1098(defvar python-preoutput-result nil 1250(defvar python-preoutput-result nil
1099 "Data from last `_emacs_out' line seen by the preoutput filter.") 1251 "Data from last `_emacs_out' line seen by the preoutput filter.")
1100 1252
1101(defvar python-preoutput-continuation nil
1102 "If non-nil, funcall this when `python-preoutput-filter' sees `_emacs_ok'.")
1103
1104(defvar python-preoutput-leftover nil) 1253(defvar python-preoutput-leftover nil)
1254(defvar python-preoutput-skip-next-prompt nil)
1105 1255
1106;; Using this stops us getting lines in the buffer like 1256;; Using this stops us getting lines in the buffer like
1107;; >>> ... ... >>> 1257;; >>> ... ... >>>
1108;; Also look for (and delete) an `_emacs_ok' string and call
1109;; `python-preoutput-continuation' if we get it.
1110(defun python-preoutput-filter (s) 1258(defun python-preoutput-filter (s)
1111 "`comint-preoutput-filter-functions' function: ignore prompts not at bol." 1259 "`comint-preoutput-filter-functions' function: ignore prompts not at bol."
1112 (when python-preoutput-leftover 1260 (when python-preoutput-leftover
1113 (setq s (concat python-preoutput-leftover s)) 1261 (setq s (concat python-preoutput-leftover s))
1114 (setq python-preoutput-leftover nil)) 1262 (setq python-preoutput-leftover nil))
1115 (cond ((and (string-match (rx (and string-start (repeat 3 (any ".>")) 1263 (let ((start 0)
1116 " " string-end)) 1264 (res ""))
1117 s) 1265 ;; First process whole lines.
1118 (/= (let ((inhibit-field-text-motion t)) 1266 (while (string-match "\n" s start)
1119 (line-beginning-position)) 1267 (let ((line (substring s start (setq start (match-end 0)))))
1120 (point))) 1268 ;; Skip prompt if needed.
1121 "") 1269 (when (and python-preoutput-skip-next-prompt
1122 ((string= s "_emacs_ok\n") 1270 (string-match comint-prompt-regexp line))
1123 (when python-preoutput-continuation 1271 (setq python-preoutput-skip-next-prompt nil)
1124 (funcall python-preoutput-continuation) 1272 (setq line (substring line (match-end 0))))
1125 (setq python-preoutput-continuation nil)) 1273 ;; Recognize special _emacs_out lines.
1126 "") 1274 (if (and (string-match "\\`_emacs_out \\(.*\\)\n\\'" line)
1127 ((string-match "_emacs_out \\(.*\\)\n" s) 1275 (local-variable-p 'python-preoutput-result))
1128 (setq python-preoutput-result (match-string 1 s)) 1276 (progn
1129 "") 1277 (setq python-preoutput-result (match-string 1 line))
1130 ((string-match ".*\n" s) 1278 (set (make-local-variable 'python-preoutput-skip-next-prompt) t))
1131 s) 1279 (setq res (concat res line)))))
1132 ((or (eq t (compare-strings s nil nil "_emacs_ok\n" nil (length s))) 1280 ;; Then process the remaining partial line.
1133 (let ((end (min (length "_emacs_out ") (length s)))) 1281 (unless (zerop start) (setq s (substring s start)))
1134 (eq t (compare-strings s nil end "_emacs_out " nil end)))) 1282 (cond ((and (string-match comint-prompt-regexp s)
1135 (setq python-preoutput-leftover s) 1283 ;; Drop this prompt if it follows an _emacs_out...
1136 "") 1284 (or python-preoutput-skip-next-prompt
1137 (t s))) 1285 ;; ... or if it's not gonna be inserted at BOL.
1286 ;; Maybe we could be more selective here.
1287 (if (zerop (length res))
1288 (not (bolp))
1289 (string-match res ".\\'"))))
1290 ;; The need for this seems to be system-dependent:
1291 ;; What is this all about, exactly? --Stef
1292 ;; (if (and (eq ?. (aref s 0)))
1293 ;; (accept-process-output (get-buffer-process (current-buffer)) 1))
1294 (setq python-preoutput-skip-next-prompt nil)
1295 res)
1296 ((let ((end (min (length "_emacs_out ") (length s))))
1297 (eq t (compare-strings s nil end "_emacs_out " nil end)))
1298 ;; The leftover string is a prefix of _emacs_out so we don't know
1299 ;; yet whether it's an _emacs_out or something else: wait until we
1300 ;; get more output so we can resolve this ambiguity.
1301 (set (make-local-variable 'python-preoutput-leftover) s)
1302 res)
1303 (t (concat res s)))))
1304
1305(autoload 'comint-check-proc "comint")
1138 1306
1139;;;###autoload 1307;;;###autoload
1140(defun run-python (&optional cmd noshow) 1308(defun run-python (&optional cmd noshow new)
1141 "Run an inferior Python process, input and output via buffer *Python*. 1309 "Run an inferior Python process, input and output via buffer *Python*.
1142CMD is the Python command to run. NOSHOW non-nil means don't show the 1310CMD is the Python command to run. NOSHOW non-nil means don't show the
1143buffer automatically. 1311buffer automatically.
1144If there is a process already running in `*Python*', switch to 1312
1145that buffer. Interactively, a prefix arg allows you to edit the initial 1313Normally, if there is a process already running in `python-buffer',
1146command line (default is `python-command'); `-i' etc. args will be added 1314switch to that buffer. Interactively, a prefix arg allows you to edit
1147to this as appropriate. Runs the hook `inferior-python-mode-hook' 1315the initial command line (default is `python-command'); `-i' etc. args
1148\(after the `comint-mode-hook' is run). 1316will be added to this as appropriate. A new process is started if:
1149\(Type \\[describe-mode] in the process buffer for a list of commands.)" 1317one isn't running attached to `python-buffer', or interactively the
1150 (interactive (list (if current-prefix-arg 1318default `python-command', or argument NEW is non-nil. See also the
1151 (read-string "Run Python: " python-command) 1319documentation for `python-buffer'.
1152 python-command))) 1320
1321Runs the hook `inferior-python-mode-hook' \(after the
1322`comint-mode-hook' is run). \(Type \\[describe-mode] in the process
1323buffer for a list of commands.)"
1324 (interactive (if current-prefix-arg
1325 (list (read-string "Run Python: " python-command) nil t)
1326 (list python-command)))
1153 (unless cmd (setq cmd python-python-command)) 1327 (unless cmd (setq cmd python-python-command))
1154 (setq python-command cmd) 1328 (setq python-command cmd)
1155 ;; Fixme: Consider making `python-buffer' buffer-local as a buffer 1329 ;; Fixme: Consider making `python-buffer' buffer-local as a buffer
1156 ;; (not a name) in Python buffers from which `run-python' &c is 1330 ;; (not a name) in Python buffers from which `run-python' &c is
1157 ;; invoked. Would support multiple processes better. 1331 ;; invoked. Would support multiple processes better.
1158 (unless (comint-check-proc python-buffer) 1332 (when (or new (not (comint-check-proc python-buffer)))
1159 (let* ((cmdlist (append (python-args-to-list cmd) '("-i"))) 1333 (save-current-buffer
1160 (path (getenv "PYTHONPATH")) 1334 (let* ((cmdlist (append (python-args-to-list cmd) '("-i")))
1161 (process-environment ; to import emacs.py 1335 (path (getenv "PYTHONPATH"))
1162 (cons (concat "PYTHONPATH=" data-directory 1336 (process-environment ; to import emacs.py
1163 (if path (concat ":" path))) 1337 (cons (concat "PYTHONPATH=" data-directory
1164 process-environment))) 1338 (if path (concat ":" path)))
1165 (set-buffer (apply 'make-comint "Python" (car cmdlist) nil 1339 process-environment)))
1166 (cdr cmdlist))) 1340 (set-buffer (apply 'make-comint-in-buffer "Python"
1167 (setq python-buffer (buffer-name))) 1341 (generate-new-buffer "*Python*")
1168 (inferior-python-mode) 1342 (car cmdlist) nil (cdr cmdlist)))
1169 ;; Load function defintions we need. 1343 (setq-default python-buffer (current-buffer))
1170 ;; Before the preoutput function was used, this was done via -c in 1344 (setq python-buffer (current-buffer)))
1171 ;; cmdlist, but that loses the banner and doesn't run the startup 1345 (accept-process-output (get-buffer-process python-buffer) 5)
1172 ;; file. The code might be inline here, but there's enough that it 1346 (inferior-python-mode)))
1173 ;; seems worth putting in a separate file, and it's probably cleaner 1347 (if (derived-mode-p 'python-mode)
1174 ;; to put it in a module. 1348 (setq python-buffer (default-value 'python-buffer))) ; buffer-local
1175 (python-send-string "import emacs")) 1349 ;; Load function definitions we need.
1176 (unless noshow (pop-to-buffer python-buffer))) 1350 ;; Before the preoutput function was used, this was done via -c in
1351 ;; cmdlist, but that loses the banner and doesn't run the startup
1352 ;; file. The code might be inline here, but there's enough that it
1353 ;; seems worth putting in a separate file, and it's probably cleaner
1354 ;; to put it in a module.
1355 ;; Ensure we're at a prompt before doing anything else.
1356 (python-send-receive "import emacs; print '_emacs_out ()'")
1357 ;; Without this, help output goes into the inferior python buffer if
1358 ;; the process isn't already running.
1359 (sit-for 1 t) ;Should we use accept-process-output instead? --Stef
1360 (unless noshow (pop-to-buffer python-buffer t)))
1177 1361
1178;; Fixme: We typically lose if the inferior isn't in the normal REPL, 1362;; Fixme: We typically lose if the inferior isn't in the normal REPL,
1179;; e.g. prompt is `help> '. Probably raise an error if the form of 1363;; e.g. prompt is `help> '. Probably raise an error if the form of
1180;; the prompt is unexpected; actually, it needs to be `>>> ', not 1364;; the prompt is unexpected. Actually, it needs to be `>>> ', not
1181;; `... ', i.e. we're not inputting a block &c. However, this may not 1365;; `... ', i.e. we're not inputting a block &c. However, this may not
1182;; be the place to do it, e.g. we might actually want to send commands 1366;; be the place to check it, e.g. we might actually want to send
1183;; having set up such a state. 1367;; commands having set up such a state.
1184 1368
1185(defun python-send-command (command) 1369(defun python-send-command (command)
1186 "Like `python-send-string' but resets `compilation-minor-mode'." 1370 "Like `python-send-string' but resets `compilation-shell-minor-mode'.
1187 (goto-char (point-max)) 1371COMMAND should be a single statement."
1372 (assert (not (string-match "\n" command)))
1188 (let ((end (marker-position (process-mark (python-proc))))) 1373 (let ((end (marker-position (process-mark (python-proc)))))
1374 (with-current-buffer python-buffer (goto-char (point-max)))
1189 (compilation-forget-errors) 1375 (compilation-forget-errors)
1190 (python-send-string command) 1376 ;; Must wait until this has completed before re-setting variables below.
1191 (set-marker compilation-parsing-end end) 1377 (python-send-receive (concat command "; print '_emacs_out ()'"))
1192 (setq compilation-last-buffer (current-buffer)))) 1378 (with-current-buffer python-buffer
1379 (set-marker compilation-parsing-end end)
1380 (setq compilation-last-buffer (current-buffer)))))
1193 1381
1194(defun python-send-region (start end) 1382(defun python-send-region (start end)
1195 "Send the region to the inferior Python process." 1383 "Send the region to the inferior Python process."
@@ -1202,8 +1390,8 @@ to this as appropriate. Runs the hook `inferior-python-mode-hook'
1202 ;; filter). This function also catches exceptions and truncates 1390 ;; filter). This function also catches exceptions and truncates
1203 ;; tracebacks not to mention the frame of the function itself. 1391 ;; tracebacks not to mention the frame of the function itself.
1204 ;; 1392 ;;
1205 ;; The compilation-minor-mode parsing takes care of relating the 1393 ;; The `compilation-shell-minor-mode' parsing takes care of relating
1206 ;; reference to the temporary file to the source. 1394 ;; the reference to the temporary file to the source.
1207 ;; 1395 ;;
1208 ;; Fixme: Write a `coding' header to the temp file if the region is 1396 ;; Fixme: Write a `coding' header to the temp file if the region is
1209 ;; non-ASCII. 1397 ;; non-ASCII.
@@ -1220,18 +1408,22 @@ to this as appropriate. Runs the hook `inferior-python-mode-hook'
1220 (set-marker orig-start (line-beginning-position 0))) 1408 (set-marker orig-start (line-beginning-position 0)))
1221 (write-region "if True:\n" nil f nil 'nomsg)) 1409 (write-region "if True:\n" nil f nil 'nomsg))
1222 (write-region start end f t 'nomsg) 1410 (write-region start end f t 'nomsg)
1223 (with-current-buffer (process-buffer (python-proc)) ;Runs python if needed. 1411 (python-send-command command)
1224 (python-send-command command) 1412 (with-current-buffer (process-buffer (python-proc))
1225 ;; Tell compile.el to redirect error locations in file `f' to 1413 ;; Tell compile.el to redirect error locations in file `f' to
1226 ;; positions past marker `orig-start'. It has to be done *after* 1414 ;; positions past marker `orig-start'. It has to be done *after*
1227 ;; python-send-command's call to compilation-forget-errors. 1415 ;; `python-send-command''s call to `compilation-forget-errors'.
1228 (compilation-fake-loc orig-start f)))) 1416 (compilation-fake-loc orig-start f))))
1229 1417
1230(defun python-send-string (string) 1418(defun python-send-string (string)
1231 "Evaluate STRING in inferior Python process." 1419 "Evaluate STRING in inferior Python process."
1232 (interactive "sPython command: ") 1420 (interactive "sPython command: ")
1233 (comint-send-string (python-proc) string) 1421 (comint-send-string (python-proc) string)
1234 (comint-send-string (python-proc) "\n\n")) 1422 (comint-send-string (python-proc)
1423 ;; If the string is single-line or if it ends with \n,
1424 ;; only add a single \n, otherwise add 2, so as to
1425 ;; make sure we terminate the multiline instruction.
1426 (if (string-match "\n.+\\'" string) "\n\n" "\n")))
1235 1427
1236(defun python-send-buffer () 1428(defun python-send-buffer ()
1237 "Send the current buffer to the inferior Python process." 1429 "Send the current buffer to the inferior Python process."
@@ -1247,10 +1439,10 @@ to this as appropriate. Runs the hook `inferior-python-mode-hook'
1247 (progn (end-of-defun) (point))))) 1439 (progn (end-of-defun) (point)))))
1248 1440
1249(defun python-switch-to-python (eob-p) 1441(defun python-switch-to-python (eob-p)
1250 "Switch to the Python process buffer. 1442 "Switch to the Python process buffer, maybe starting new process.
1251With prefix arg, position cursor at end of buffer." 1443With prefix arg, position cursor at end of buffer."
1252 (interactive "P") 1444 (interactive "P")
1253 (pop-to-buffer (process-buffer (python-proc))) ;Runs python if needed. 1445 (pop-to-buffer (process-buffer (python-proc)) t) ;Runs python if needed.
1254 (when eob-p 1446 (when eob-p
1255 (push-mark) 1447 (push-mark)
1256 (goto-char (point-max)))) 1448 (goto-char (point-max))))
@@ -1263,10 +1455,10 @@ Then switch to the process buffer."
1263 (python-switch-to-python t)) 1455 (python-switch-to-python t))
1264 1456
1265(defcustom python-source-modes '(python-mode jython-mode) 1457(defcustom python-source-modes '(python-mode jython-mode)
1266 "*Used to determine if a buffer contains Python source code. 1458 "Used to determine if a buffer contains Python source code.
1267If it's loaded into a buffer that is in one of these major modes, it's 1459If a file is loaded into a buffer that is in one of these major modes,
1268considered a Python source file by `python-load-file'. 1460it is considered Python source by `python-load-file', which uses the
1269Used by these commands to determine defaults." 1461value to determine defaults."
1270 :type '(repeat function) 1462 :type '(repeat function)
1271 :group 'python) 1463 :group 'python)
1272 1464
@@ -1274,6 +1466,8 @@ Used by these commands to determine defaults."
1274 "Caches (directory . file) pair used in the last `python-load-file' command. 1466 "Caches (directory . file) pair used in the last `python-load-file' command.
1275Used for determining the default in the next one.") 1467Used for determining the default in the next one.")
1276 1468
1469(autoload 'comint-get-source "comint")
1470
1277(defun python-load-file (file-name) 1471(defun python-load-file (file-name)
1278 "Load a Python file FILE-NAME into the inferior Python process. 1472 "Load a Python file FILE-NAME into the inferior Python process.
1279If the file has extension `.py' import or reload it as a module. 1473If the file has extension `.py' import or reload it as a module.
@@ -1297,17 +1491,27 @@ module-qualified names."
1297 (format "execfile(%S)" file-name))) 1491 (format "execfile(%S)" file-name)))
1298 (message "%s loaded" file-name))) 1492 (message "%s loaded" file-name)))
1299 1493
1300;; Fixme: If we need to start the process, wait until we've got the OK
1301;; from the startup.
1302(defun python-proc () 1494(defun python-proc ()
1303 "Return the current Python process. 1495 "Return the current Python process.
1304See variable `python-buffer'. Starts a new process if necessary." 1496See variable `python-buffer'. Starts a new process if necessary."
1305 (or (if python-buffer 1497 ;; Fixme: Maybe should look for another active process if there
1306 (get-buffer-process (if (eq major-mode 'inferior-python-mode) 1498 ;; isn't one for `python-buffer'.
1307 (current-buffer) 1499 (unless (comint-check-proc python-buffer)
1308 python-buffer))) 1500 (run-python nil t))
1309 (progn (run-python nil t) 1501 (get-buffer-process (or (if (derived-mode-p 'inferior-python-mode)
1310 (python-proc)))) 1502 (current-buffer)
1503 python-buffer))))
1504
1505(defun python-set-proc ()
1506 "Set the default value of `python-buffer' to correspond to this buffer.
1507If the current buffer has a local value of `python-buffer', set the
1508default (global) value to that. The associated Python process is
1509the one that gets input from \\[python-send-region] et al when used
1510in a buffer that doesn't have a local value of `python-buffer'."
1511 (interactive)
1512 (if (local-variable-p 'python-buffer)
1513 (setq-default python-buffer python-buffer)
1514 (error "No local value of `python-buffer'")))
1311 1515
1312;;;; Context-sensitive help. 1516;;;; Context-sensitive help.
1313 1517
@@ -1322,16 +1526,22 @@ Otherwise inherits from `python-mode-syntax-table'.")
1322(defvar view-return-to-alist) 1526(defvar view-return-to-alist)
1323(eval-when-compile (autoload 'help-buffer "help-fns")) 1527(eval-when-compile (autoload 'help-buffer "help-fns"))
1324 1528
1529(defvar python-imports) ; forward declaration
1530
1325;; Fixme: Should this actually be used instead of info-look, i.e. be 1531;; Fixme: Should this actually be used instead of info-look, i.e. be
1326;; bound to C-h S? Can we use other pydoc stuff before python 2.2? 1532;; bound to C-h S? [Probably not, since info-look may work in cases
1533;; where this doesn't.]
1327(defun python-describe-symbol (symbol) 1534(defun python-describe-symbol (symbol)
1328 "Get help on SYMBOL using `help'. 1535 "Get help on SYMBOL using `help'.
1329Interactively, prompt for symbol. 1536Interactively, prompt for symbol.
1330 1537
1331Symbol may be anything recognized by the interpreter's `help' command -- 1538Symbol may be anything recognized by the interpreter's `help'
1332e.g. `CALLS' -- not just variables in scope. 1539command -- e.g. `CALLS' -- not just variables in scope in the
1333This only works for Python version 2.2 or newer since earlier interpreters 1540interpreter. This only works for Python version 2.2 or newer
1334don't support `help'." 1541since earlier interpreters don't support `help'.
1542
1543In some cases where this doesn't find documentation, \\[info-lookup-symbol]
1544will."
1335 ;; Note that we do this in the inferior process, not a separate one, to 1545 ;; Note that we do this in the inferior process, not a separate one, to
1336 ;; ensure the environment is appropriate. 1546 ;; ensure the environment is appropriate.
1337 (interactive 1547 (interactive
@@ -1343,53 +1553,65 @@ don't support `help'."
1343 "Describe symbol: ") 1553 "Describe symbol: ")
1344 nil nil symbol)))) 1554 nil nil symbol))))
1345 (if (equal symbol "") (error "No symbol")) 1555 (if (equal symbol "") (error "No symbol"))
1346 (let* ((func `(lambda () 1556 ;; Ensure we have a suitable help buffer.
1347 (comint-redirect-send-command 1557 ;; Fixme: Maybe process `Related help topics' a la help xrefs and
1348 (format "emacs.ehelp(%S, globals(), locals())\n" ,symbol) 1558 ;; allow C-c C-f in help buffer.
1349 "*Help*" nil)))) 1559 (let ((temp-buffer-show-hook ; avoid xref stuff
1350 ;; Ensure we have a suitable help buffer. 1560 (lambda ()
1351 ;; Fixme: Maybe process `Related help topics' a la help xrefs and 1561 (toggle-read-only 1)
1352 ;; allow C-c C-f in help buffer. 1562 (setq view-return-to-alist
1353 (let ((temp-buffer-show-hook ; avoid xref stuff 1563 (list (cons (selected-window) help-return-method))))))
1354 (lambda () 1564 (with-output-to-temp-buffer (help-buffer)
1355 (toggle-read-only 1) 1565 (with-current-buffer standard-output
1356 (setq view-return-to-alist 1566 ;; Fixme: Is this actually useful?
1357 (list (cons (selected-window) help-return-method)))))) 1567 (help-setup-xref (list 'python-describe-symbol symbol) (interactive-p))
1358 (help-setup-xref (list 'python-describe-symbol symbol) (interactive-p)) 1568 (set (make-local-variable 'comint-redirect-subvert-readonly) t)
1359 (with-output-to-temp-buffer (help-buffer) 1569 (print-help-return-message))))
1360 (with-current-buffer standard-output 1570 (comint-redirect-send-command-to-process (format "emacs.ehelp(%S, %s)"
1361 (set (make-local-variable 'comint-redirect-subvert-readonly) t) 1571 symbol python-imports)
1362 (print-help-return-message)))) 1572 "*Help*" (python-proc) nil nil))
1363 (if (and python-buffer (get-buffer python-buffer))
1364 (with-current-buffer python-buffer
1365 (funcall func))
1366 (setq python-preoutput-continuation func)
1367 (run-python nil t))))
1368 1573
1369(add-to-list 'debug-ignored-errors "^No symbol") 1574(add-to-list 'debug-ignored-errors "^No symbol")
1370 1575
1371(defun python-send-receive (string) 1576(defun python-send-receive (string)
1372 "Send STRING to inferior Python (if any) and return result. 1577 "Send STRING to inferior Python (if any) and return result.
1373The result is what follows `_emacs_out' in the output (or nil)." 1578The result is what follows `_emacs_out' in the output."
1579 (python-send-string string)
1374 (let ((proc (python-proc))) 1580 (let ((proc (python-proc)))
1375 (python-send-string string) 1581 (with-current-buffer (process-buffer proc)
1376 (setq python-preoutput-result nil) 1582 (set (make-local-variable 'python-preoutput-result) nil)
1377 (while (progn 1583 (while (progn
1378 (accept-process-output proc 5) 1584 (accept-process-output proc 5)
1379 python-preoutput-leftover)) 1585 (null python-preoutput-result)))
1380 python-preoutput-result)) 1586 (prog1 python-preoutput-result
1381 1587 (kill-local-variable 'python-preoutput-result)))))
1382;; Fixme: try to make it work with point in the arglist. Also, is 1588
1383;; there anything reasonable we can do with random methods? 1589;; Fixme: Is there anything reasonable we can do with random methods?
1384;; (Currently only works with functions.) 1590;; (Currently only works with functions.)
1385(defun python-eldoc-function () 1591(defun python-eldoc-function ()
1386 "`eldoc-print-current-symbol-info' for Python. 1592 "`eldoc-print-current-symbol-info' for Python.
1387Only works when point is in a function name, not its arglist, for instance. 1593Only works when point is in a function name, not its arg list, for
1388Assumes an inferior Python is running." 1594instance. Assumes an inferior Python is running."
1389 (let ((symbol (with-syntax-table python-dotty-syntax-table 1595 (let ((symbol (with-syntax-table python-dotty-syntax-table
1390 (current-word)))) 1596 (current-word))))
1391 (when symbol 1597 ;; First try the symbol we're on.
1392 (python-send-receive (format "emacs.eargs(%S)" symbol))))) 1598 (or (and symbol
1599 (python-send-receive (format "emacs.eargs(%S, %s)"
1600 symbol python-imports)))
1601 ;; Try moving to symbol before enclosing parens.
1602 (let ((s (syntax-ppss)))
1603 (unless (zerop (car s))
1604 (when (eq ?\( (char-after (nth 1 s)))
1605 (save-excursion
1606 (goto-char (nth 1 s))
1607 (skip-syntax-backward "-")
1608 (let ((point (point)))
1609 (skip-chars-backward "a-zA-Z._")
1610 (if (< (point) point)
1611 (python-send-receive
1612 (format "emacs.eargs(%S, %s)"
1613 (buffer-substring-no-properties (point) point)
1614 python-imports)))))))))))
1393 1615
1394;;;; Info-look functionality. 1616;;;; Info-look functionality.
1395 1617
@@ -1443,7 +1665,7 @@ Used with `eval-after-load'."
1443 ("(python-lib)Miscellaneous Index" nil "")))))) 1665 ("(python-lib)Miscellaneous Index" nil ""))))))
1444(eval-after-load "info-look" '(python-after-info-look)) 1666(eval-after-load "info-look" '(python-after-info-look))
1445 1667
1446;;;; Miscellancy. 1668;;;; Miscellany.
1447 1669
1448(defcustom python-jython-packages '("java" "javax" "org" "com") 1670(defcustom python-jython-packages '("java" "javax" "org" "com")
1449 "Packages implying `jython-mode'. 1671 "Packages implying `jython-mode'.
@@ -1473,8 +1695,8 @@ The criterion is either a match for `jython-mode' via
1473 (jython-mode) 1695 (jython-mode)
1474 (if (catch 'done 1696 (if (catch 'done
1475 (while (re-search-forward 1697 (while (re-search-forward
1476 (rx (and line-start (or "import" "from") (1+ space) 1698 (rx line-start (or "import" "from") (1+ space)
1477 (group (1+ (not (any " \t\n.")))))) 1699 (group (1+ (not (any " \t\n.")))))
1478 (+ (point-min) 10000) ; Probably not worth customizing. 1700 (+ (point-min) 10000) ; Probably not worth customizing.
1479 t) 1701 t)
1480 (if (member (match-string 1) python-jython-packages) 1702 (if (member (match-string 1) python-jython-packages)
@@ -1562,7 +1784,7 @@ END lie."
1562 "`outline-level' function for Python mode. 1784 "`outline-level' function for Python mode.
1563The level is the number of `python-indent' steps of indentation 1785The level is the number of `python-indent' steps of indentation
1564of current line." 1786of current line."
1565 (/ (current-indentation) python-indent)) 1787 (1+ (/ (current-indentation) python-indent)))
1566 1788
1567;; Fixme: Consider top-level assignments, imports, &c. 1789;; Fixme: Consider top-level assignments, imports, &c.
1568(defun python-current-defun () 1790(defun python-current-defun ()
@@ -1577,10 +1799,8 @@ of current line."
1577 (python-beginning-of-block) 1799 (python-beginning-of-block)
1578 (end-of-line) 1800 (end-of-line)
1579 (beginning-of-defun) 1801 (beginning-of-defun)
1580 (if (looking-at (rx (and (0+ space) (or "def" "class") (1+ space) 1802 (if (looking-at (rx (0+ space) (or "def" "class") (1+ space)
1581 (group (1+ (or word (syntax symbol)))) 1803 (group (1+ (or word (syntax symbol))))))
1582 ;; Greediness makes this unnecessary? --Stef
1583 symbol-end)))
1584 (push (match-string 1) accum))) 1804 (push (match-string 1) accum)))
1585 (if accum (mapconcat 'identity accum "."))))) 1805 (if accum (mapconcat 'identity accum ".")))))
1586 1806
@@ -1593,17 +1813,68 @@ Uses `python-beginning-of-block', `python-end-of-block'."
1593 (push-mark (point) nil t) 1813 (push-mark (point) nil t)
1594 (python-end-of-block) 1814 (python-end-of-block)
1595 (exchange-point-and-mark)) 1815 (exchange-point-and-mark))
1816
1817;; Fixme: Provide a find-function-like command to find source of a
1818;; definition (separate from BicycleRepairMan). Complicated by
1819;; finding the right qualified name.
1596 1820
1597;;;; Completion. 1821;;;; Completion.
1598 1822
1823(defvar python-imports nil
1824 "String of top-level import statements updated by `python-find-imports'.")
1825(make-variable-buffer-local 'python-imports)
1826
1827;; Fixme: Should font-lock try to run this when it deals with an import?
1828;; Maybe not a good idea if it gets run multiple times when the
1829;; statement is being edited, and is more likely to end up with
1830;; something syntactically incorrect.
1831;; However, what we should do is to trundle up the block tree from point
1832;; to extract imports that appear to be in scope, and add those.
1833(defun python-find-imports ()
1834 "Find top-level imports, updating `python-imports'."
1835 (interactive)
1836 (save-excursion
1837 (let (lines)
1838 (goto-char (point-min))
1839 (while (re-search-forward "^import\\>\\|^from\\>" nil t)
1840 (unless (syntax-ppss-context (syntax-ppss))
1841 (push (buffer-substring (line-beginning-position)
1842 (line-beginning-position 2))
1843 lines)))
1844 (setq python-imports
1845 (if lines
1846 (apply #'concat
1847;; This is probably best left out since you're unlikely to need the
1848;; doc for a function in the buffer and the import will lose if the
1849;; Python sub-process' working directory isn't the same as the
1850;; buffer's.
1851;; (if buffer-file-name
1852;; (concat
1853;; "import "
1854;; (file-name-sans-extension
1855;; (file-name-nondirectory buffer-file-name))))
1856 (nreverse lines))
1857 "None"))
1858 (when lines
1859 (set-text-properties 0 (length python-imports) nil python-imports)
1860 ;; The output ends up in the wrong place if the string we
1861 ;; send contains newlines (from the imports).
1862 (setq python-imports
1863 (replace-regexp-in-string "\n" "\\n"
1864 (format "%S" python-imports) t t))))))
1865
1866;; Fixme: This fails the first time if the sub-process isn't already
1867;; running. Presumably a timing issue with i/o to the process.
1599(defun python-symbol-completions (symbol) 1868(defun python-symbol-completions (symbol)
1600 "Return a list of completions of the string SYMBOL from Python process. 1869 "Return a list of completions of the string SYMBOL from Python process.
1601The list is sorted." 1870The list is sorted.
1871Uses `python-imports' to load modules against which to complete."
1602 (when symbol 1872 (when symbol
1603 (let ((completions 1873 (let ((completions
1604 (condition-case () 1874 (condition-case ()
1605 (car (read-from-string (python-send-receive 1875 (car (read-from-string
1606 (format "emacs.complete(%S)" symbol)))) 1876 (python-send-receive
1877 (format "emacs.complete(%S,%s)" symbol python-imports))))
1607 (error nil)))) 1878 (error nil))))
1608 (sort 1879 (sort
1609 ;; We can get duplicates from the above -- don't know why. 1880 ;; We can get duplicates from the above -- don't know why.
@@ -1615,15 +1886,12 @@ The list is sorted."
1615 (let ((end (point)) 1886 (let ((end (point))
1616 (start (save-excursion 1887 (start (save-excursion
1617 (and (re-search-backward 1888 (and (re-search-backward
1618 (rx (and (or buffer-start (regexp "[^[:alnum:]._]")) 1889 (rx (or buffer-start (regexp "[^[:alnum:]._]"))
1619 (group (1+ (regexp "[[:alnum:]._]"))) 1890 (group (1+ (regexp "[[:alnum:]._]"))) point)
1620 point))
1621 nil t) 1891 nil t)
1622 (match-beginning 1))))) 1892 (match-beginning 1)))))
1623 (if start (buffer-substring-no-properties start end)))) 1893 (if start (buffer-substring-no-properties start end))))
1624 1894
1625;; Fixme: We should have an abstraction of this sort of thing in the
1626;; core.
1627(defun python-complete-symbol () 1895(defun python-complete-symbol ()
1628 "Perform completion on the Python symbol preceding point. 1896 "Perform completion on the Python symbol preceding point.
1629Repeating the command scrolls the completion window." 1897Repeating the command scrolls the completion window."
@@ -1658,11 +1926,9 @@ Repeating the command scrolls the completion window."
1658 (display-completion-list completions symbol)) 1926 (display-completion-list completions symbol))
1659 (message "Making completion list...%s" "done")))))))) 1927 (message "Making completion list...%s" "done"))))))))
1660 1928
1661(eval-when-compile (require 'hippie-exp))
1662
1663(defun python-try-complete (old) 1929(defun python-try-complete (old)
1664 "Completion function for Python for use with `hippie-expand'." 1930 "Completion function for Python for use with `hippie-expand'."
1665 (when (eq major-mode 'python-mode) ; though we only add it locally 1931 (when (derived-mode-p 'python-mode) ; though we only add it locally
1666 (unless old 1932 (unless old
1667 (let ((symbol (python-partial-symbol))) 1933 (let ((symbol (python-partial-symbol)))
1668 (he-init-string (- (point) (length symbol)) (point)) 1934 (he-init-string (- (point) (length symbol)) (point))
@@ -1680,16 +1946,212 @@ Repeating the command scrolls the completion window."
1680 (if old (he-reset-string)) 1946 (if old (he-reset-string))
1681 nil))) 1947 nil)))
1682 1948
1949;;;; FFAP support
1950
1951(defun python-module-path (module)
1952 "Function for `ffap-alist' to return path to MODULE."
1953 (python-send-receive (format "emacs.modpath (%S)" module)))
1954
1955(eval-after-load "ffap"
1956 '(push '(python-mode . python-module-path) ffap-alist))
1957
1958;;;; Skeletons
1959
1960(defvar python-skeletons nil
1961 "Alist of named skeletons for Python mode.
1962Elements are of the form (NAME . EXPANDER-FUNCTION).")
1963
1964(defvar python-mode-abbrev-table nil
1965 "Abbrev table for Python mode.
1966The default contents correspond to the elements of `python-skeletons'.")
1967(define-abbrev-table 'python-mode-abbrev-table ())
1968
1969(eval-when-compile
1970 ;; Define a user-level skeleton and add it to `python-skeletons' and
1971 ;; the abbrev table.
1972(defmacro def-python-skeleton (name &rest elements)
1973 (let* ((name (symbol-name name))
1974 (function (intern (concat "python-insert-" name))))
1975 `(progn
1976 (add-to-list 'python-skeletons ',(cons name function))
1977 (define-abbrev python-mode-abbrev-table ,name "" ',function nil t)
1978 (define-skeleton ,function
1979 ,(format "Insert Python \"%s\" template." name)
1980 ,@elements)))))
1981(put 'def-python-skeleton 'lisp-indent-function 2)
1982
1983;; From `skeleton-further-elements':
1984;; `<': outdent a level;
1985;; `^': delete indentation on current line and also previous newline.
1986;; Not quote like `delete-indentation'. Assumes point is at
1987;; beginning of indentation.
1988
1989(def-python-skeleton if
1990 "Condition: "
1991 "if " str ":" \n
1992 > _ \n
1993 ("other condition, %s: "
1994 < ; Avoid wrong indentation after block opening.
1995 "elif " str ":" \n
1996 > _ \n nil)
1997 (python-else) | ^)
1998
1999(define-skeleton python-else
2000 "Auxiliary skeleton."
2001 nil
2002 (unless (eq ?y (read-char "Add `else' clause? (y for yes or RET for no) "))
2003 (signal 'quit t))
2004 < "else:" \n
2005 > _ \n)
2006
2007(def-python-skeleton while
2008 "Condition: "
2009 "while " str ":" \n
2010 > _ \n
2011 (python-else) | ^)
2012
2013(def-python-skeleton for
2014 "Target, %s: "
2015 "for " str " in " (skeleton-read "Expression, %s: ") ":" \n
2016 > _ \n
2017 (python-else) | ^)
2018
2019(def-python-skeleton try/except
2020 nil
2021 "try:" \n
2022 > _ \n
2023 ("Exception, %s: "
2024 < "except " str (python-target) ":" \n
2025 > _ \n nil)
2026 < "except:" \n
2027 > _ \n
2028 (python-else) | ^)
2029
2030(define-skeleton python-target
2031 "Auxiliary skeleton."
2032 "Target, %s: " ", " str | -2)
2033
2034(def-python-skeleton try/finally
2035 nil
2036 "try:" \n
2037 > _ \n
2038 < "finally:" \n
2039 > _ \n)
2040
2041(def-python-skeleton def
2042 "Name: "
2043 "def " str " (" ("Parameter, %s: " (unless (equal ?\( (char-before)) ", ")
2044 str) "):" \n
2045 "\"\"\"" @ " \"\"\"" \n ; Fixme: syntaxification wrong for """"""
2046 > _ \n)
2047
2048(def-python-skeleton class
2049 "Name: "
2050 "class " str " (" ("Inheritance, %s: "
2051 (unless (equal ?\( (char-before)) ", ")
2052 str)
2053 & ")" | -2 ; close list or remove opening
2054 ":" \n
2055 "\"\"\"" @ " \"\"\"" \n
2056 > _ \n)
2057
2058(defvar python-default-template "if"
2059 "Default template to expand by `python-insert-template'.
2060Updated on each expansion.")
2061
2062(defun python-expand-template (name)
2063 "Expand template named NAME.
2064Interactively, prompt for the name with completion."
2065 (interactive
2066 (list (completing-read (format "Template to expand (default %s): "
2067 python-default-template)
2068 python-skeletons nil t)))
2069 (if (equal "" name)
2070 (setq name python-default-template)
2071 (setq python-default-template name))
2072 (let ((func (cdr (assoc name python-skeletons))))
2073 (if func
2074 (funcall func)
2075 (error "Undefined template: %s" name))))
2076
2077;;;; Bicycle Repair Man support
2078
2079(autoload 'pymacs-load "pymacs" nil t)
2080(autoload 'brm-init "bikemacs")
2081
2082;; I'm not sure how useful BRM really is, and it's certainly dangerous
2083;; the way it modifies files outside Emacs... Also note that the
2084;; current BRM loses with tabs used for indentation -- I submitted a
2085;; fix <URL:http://www.loveshack.ukfsn.org/emacs/bikeemacs.py.diff>.
2086(defun python-setup-brm ()
2087 "Set up Bicycle Repair Man refactoring tool (if available).
2088
2089Note that the `refactoring' features change files independently of
2090Emacs and may modify and save the contents of the current buffer
2091without confirmation."
2092 (interactive)
2093 (condition-case data
2094 (unless (fboundp 'brm-rename)
2095 (pymacs-load "bikeemacs" "brm-") ; first line of normal recipe
2096 (let ((py-mode-map (make-sparse-keymap)) ; it assumes this
2097 (features (cons 'python-mode features))) ; and requires this
2098 (brm-init)) ; second line of normal recipe
2099 (remove-hook 'python-mode-hook ; undo this from `brm-init'
2100 '(lambda () (easy-menu-add brm-menu)))
2101 (easy-menu-define
2102 python-brm-menu python-mode-map
2103 "Bicycle Repair Man"
2104 '("BicycleRepairMan"
2105 :help "Interface to navigation and refactoring tool"
2106 "Queries"
2107 ["Find References" brm-find-references
2108 :help "Find references to name at point in compilation buffer"]
2109 ["Find Definition" brm-find-definition
2110 :help "Find definition of name at point"]
2111 "-"
2112 "Refactoring"
2113 ["Rename" brm-rename
2114 :help "Replace name at point with a new name everywhere"]
2115 ["Extract Method" brm-extract-method
2116 :active (and mark-active (not buffer-read-only))
2117 :help "Replace statements in region with a method"]
2118 ["Extract Local Variable" brm-extract-local-variable
2119 :active (and mark-active (not buffer-read-only))
2120 :help "Replace expression in region with an assignment"]
2121 ["Inline Local Variable" brm-inline-local-variable
2122 :help
2123 "Substitute uses of variable at point with its definition"]
2124 ;; Fixme: Should check for anything to revert.
2125 ["Undo Last Refactoring" brm-undo :help ""])))
2126 (error (error "Bicyclerepairman setup failed: %s" data))))
2127
1683;;;; Modes. 2128;;;; Modes.
1684 2129
1685(defvar outline-heading-end-regexp) 2130(defvar outline-heading-end-regexp)
1686(defvar eldoc-documentation-function) 2131(defvar eldoc-documentation-function)
1687 2132
2133;; Stuff to allow expanding abbrevs with non-word constituents.
2134(defun python-abbrev-pc-hook ()
2135 "Set the syntax table before possibly expanding abbrevs."
2136 (remove-hook 'post-command-hook 'python-abbrev-pc-hook t)
2137 (set-syntax-table python-mode-syntax-table))
2138
2139(defvar python-abbrev-syntax-table
2140 (copy-syntax-table python-mode-syntax-table)
2141 "Syntax table used when expanding abbrevs.")
2142
2143(defun python-pea-hook ()
2144 "Reset the syntax table after possibly expanding abbrevs."
2145 (set-syntax-table python-abbrev-syntax-table)
2146 (add-hook 'post-command-hook 'python-abbrev-pc-hook nil t))
2147(modify-syntax-entry ?/ "w" python-abbrev-syntax-table)
2148
2149(defvar python-mode-running) ;Dynamically scoped var.
2150
1688;;;###autoload 2151;;;###autoload
1689(define-derived-mode python-mode fundamental-mode "Python" 2152(define-derived-mode python-mode fundamental-mode "Python"
1690 "Major mode for editing Python files. 2153 "Major mode for editing Python files.
1691Turns on Font Lock mode unconditionally since it is required for correct 2154Font Lock mode is currently required for correct parsing of the source.
1692parsing of the source.
1693See also `jython-mode', which is actually invoked if the buffer appears to 2155See also `jython-mode', which is actually invoked if the buffer appears to
1694contain Jython code. See also `run-python' and associated Python mode 2156contain Jython code. See also `run-python' and associated Python mode
1695commands for running Python under Emacs. 2157commands for running Python under Emacs.
@@ -1703,21 +2165,27 @@ the end of definitions at that level, when they move up a level.
1703Colon is electric: it outdents the line if appropriate, e.g. for 2165Colon is electric: it outdents the line if appropriate, e.g. for
1704an else statement. \\[python-backspace] at the beginning of an indented statement 2166an else statement. \\[python-backspace] at the beginning of an indented statement
1705deletes a level of indentation to close the current block; otherwise it 2167deletes a level of indentation to close the current block; otherwise it
1706deletes a charcter backward. TAB indents the current line relative to 2168deletes a character backward. TAB indents the current line relative to
1707the preceding code. Successive TABs, with no intervening command, cycle 2169the preceding code. Successive TABs, with no intervening command, cycle
1708through the possibilities for indentation on the basis of enclosing blocks. 2170through the possibilities for indentation on the basis of enclosing blocks.
1709 2171
1710\\[fill-paragraph] fills comments and multiline strings appropriately, but has no 2172\\[fill-paragraph] fills comments and multi-line strings appropriately, but has no
1711effect outside them. 2173effect outside them.
1712 2174
1713Supports Eldoc mode (only for functions, using a Python process), 2175Supports Eldoc mode (only for functions, using a Python process),
1714Info-Look and Imenu. In Outline minor mode, `class' and `def' 2176Info-Look and Imenu. In Outline minor mode, `class' and `def'
1715lines count as headers. 2177lines count as headers. Symbol completion is available in the
2178same way as in the Python shell using the `rlcompleter' module
2179and this is added to the Hippie Expand functions locally if
2180Hippie Expand mode is turned on. Completion of symbols of the
2181form x.y only works if the components are literal
2182module/attribute names, not variables. An abbrev table is set up
2183with skeleton expansions for compound statement templates.
1716 2184
1717\\{python-mode-map}" 2185\\{python-mode-map}"
1718 :group 'python 2186 :group 'python
1719 (set (make-local-variable 'font-lock-defaults) 2187 (set (make-local-variable 'font-lock-defaults)
1720 '(python-font-lock-keywords nil nil ((?_ . "w")) nil 2188 '(python-font-lock-keywords nil nil nil nil
1721 (font-lock-syntactic-keywords 2189 (font-lock-syntactic-keywords
1722 . python-font-lock-syntactic-keywords) 2190 . python-font-lock-syntactic-keywords)
1723 ;; This probably isn't worth it. 2191 ;; This probably isn't worth it.
@@ -1726,15 +2194,17 @@ lines count as headers.
1726 )) 2194 ))
1727 (set (make-local-variable 'parse-sexp-lookup-properties) t) 2195 (set (make-local-variable 'parse-sexp-lookup-properties) t)
1728 (set (make-local-variable 'comment-start) "# ") 2196 (set (make-local-variable 'comment-start) "# ")
1729 (set (make-local-variable 'comment-indent-function) #'python-comment-indent)
1730 (set (make-local-variable 'indent-line-function) #'python-indent-line) 2197 (set (make-local-variable 'indent-line-function) #'python-indent-line)
2198 (set (make-local-variable 'indent-region-function) #'python-indent-region)
1731 (set (make-local-variable 'paragraph-start) "\\s-*$") 2199 (set (make-local-variable 'paragraph-start) "\\s-*$")
1732 (set (make-local-variable 'fill-paragraph-function) 'python-fill-paragraph) 2200 (set (make-local-variable 'fill-paragraph-function) 'python-fill-paragraph)
1733 (set (make-local-variable 'require-final-newline) mode-require-final-newline) 2201 (set (make-local-variable 'require-final-newline) mode-require-final-newline)
1734 (set (make-local-variable 'add-log-current-defun-function) 2202 (set (make-local-variable 'add-log-current-defun-function)
1735 #'python-current-defun) 2203 #'python-current-defun)
1736 ;; Fixme: Generalize to do all blocks? 2204 (set (make-local-variable 'outline-regexp)
1737 (set (make-local-variable 'outline-regexp) "\\s-*\\(def\\|class\\)\\>") 2205 (rx (* space) (or "class" "def" "elif" "else" "except" "finally"
2206 "for" "if" "try" "while")
2207 symbol-end))
1738 (set (make-local-variable 'outline-heading-end-regexp) ":\\s-*\n") 2208 (set (make-local-variable 'outline-heading-end-regexp) ":\\s-*\n")
1739 (set (make-local-variable 'outline-level) #'python-outline-level) 2209 (set (make-local-variable 'outline-level) #'python-outline-level)
1740 (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil) 2210 (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)
@@ -1746,30 +2216,45 @@ lines count as headers.
1746 (set (make-local-variable 'eldoc-documentation-function) 2216 (set (make-local-variable 'eldoc-documentation-function)
1747 #'python-eldoc-function) 2217 #'python-eldoc-function)
1748 (add-hook 'eldoc-mode-hook 2218 (add-hook 'eldoc-mode-hook
1749 '(lambda () (run-python nil t)) nil t) ; need it running 2219 (lambda () (run-python nil t)) ; need it running
1750 (unless (assoc 'python-mode hs-special-modes-alist) 2220 nil t)
1751 (setq 2221 ;; Fixme: should be in hideshow. This seems to be of limited use
1752 hs-special-modes-alist 2222 ;; since it isn't (can't be) indentation-based. Also hide-level
1753 (cons (list 2223 ;; doesn't seem to work properly.
1754 'python-mode "^\\s-*def\\>" nil "#" 2224 (add-to-list 'hs-special-modes-alist
1755 (lambda (arg)(python-end-of-defun)(skip-chars-backward " \t\n")) 2225 `(python-mode "^\\s-*def\\>" nil "#"
1756 nil) 2226 ,(lambda (arg)
1757 hs-special-modes-alist))) 2227 (python-end-of-defun)
2228 (skip-chars-backward " \t\n"))
2229 nil))
2230 (set (make-local-variable 'skeleton-further-elements)
2231 '((< '(backward-delete-char-untabify (min python-indent
2232 (current-column))))
2233 (^ '(- (1+ (current-indentation))))))
2234 (add-hook 'pre-abbrev-expand-hook 'python-pea-hook nil t)
1758 (if (featurep 'hippie-exp) 2235 (if (featurep 'hippie-exp)
1759 (set (make-local-variable 'hippie-expand-try-functions-list) 2236 (set (make-local-variable 'hippie-expand-try-functions-list)
1760 (cons 'python-try-complete hippie-expand-try-functions-list))) 2237 (cons 'python-try-complete hippie-expand-try-functions-list)))
2238 ;; Python defines TABs as being 8-char wide.
2239 (set (make-local-variable 'tab-width) 8)
1761 (when python-guess-indent (python-guess-indent)) 2240 (when python-guess-indent (python-guess-indent))
2241 ;; Let's make it harder for the user to shoot himself in the foot.
2242 (unless (= tab-width python-indent)
2243 (setq indent-tabs-mode nil))
1762 (set (make-local-variable 'python-command) python-python-command) 2244 (set (make-local-variable 'python-command) python-python-command)
2245 (python-find-imports)
1763 (unless (boundp 'python-mode-running) ; kill the recursion from jython-mode 2246 (unless (boundp 'python-mode-running) ; kill the recursion from jython-mode
1764 (let ((python-mode-running t)) 2247 (let ((python-mode-running t))
1765 (python-maybe-jython)))) 2248 (python-maybe-jython))))
1766 2249
1767(custom-add-option 'python-mode-hook 'imenu-add-menubar-index) 2250(custom-add-option 'python-mode-hook 'imenu-add-menubar-index)
1768(custom-add-option 'python-mode-hook 2251(custom-add-option 'python-mode-hook
1769 '(lambda () 2252 (lambda ()
1770 "Turn on Indent Tabs mode." 2253 "Turn off Indent Tabs mode."
1771 (set (make-local-variable 'indent-tabs-mode) t))) 2254 (set (make-local-variable 'indent-tabs-mode) nil)))
1772(custom-add-option 'python-mode-hook 'turn-on-eldoc-mode) 2255(custom-add-option 'python-mode-hook 'turn-on-eldoc-mode)
2256(custom-add-option 'python-mode-hook 'abbrev-mode)
2257(custom-add-option 'python-mode-hook 'python-setup-brm)
1773 2258
1774;;;###autoload 2259;;;###autoload
1775(define-derived-mode jython-mode python-mode "Jython" 2260(define-derived-mode jython-mode python-mode "Jython"
@@ -1780,5 +2265,6 @@ Runs `jython-mode-hook' after `python-mode-hook'."
1780 (set (make-local-variable 'python-command) python-jython-command)) 2265 (set (make-local-variable 'python-command) python-jython-command))
1781 2266
1782(provide 'python) 2267(provide 'python)
2268(provide 'python-21)
1783;; arch-tag: 6fce1d99-a704-4de9-ba19-c6e4912b0554 2269;; arch-tag: 6fce1d99-a704-4de9-ba19-c6e4912b0554
1784;;; python.el ends here 2270;;; python.el ends here
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 6098c8be067..f828c36917b 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/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 987b37cf2c2..cf887394e6b 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -14112,8 +14112,8 @@ if required."
14112(defun vhdl-speedbar-display-directory (directory depth &optional rescan) 14112(defun vhdl-speedbar-display-directory (directory depth &optional rescan)
14113 "Display directory and hierarchy information in speedbar." 14113 "Display directory and hierarchy information in speedbar."
14114 (setq vhdl-speedbar-show-projects nil) 14114 (setq vhdl-speedbar-show-projects nil)
14115 (setq speedbar-ignored-path-regexp 14115 (setq speedbar-ignored-directory-regexp
14116 (speedbar-extension-list-to-regex speedbar-ignored-path-expressions)) 14116 (speedbar-extension-list-to-regex speedbar-ignored-directory-expressions))
14117 (setq directory (abbreviate-file-name (file-name-as-directory directory))) 14117 (setq directory (abbreviate-file-name (file-name-as-directory directory)))
14118 (setq speedbar-last-selected-file nil) 14118 (setq speedbar-last-selected-file nil)
14119 (speedbar-with-writable 14119 (speedbar-with-writable
@@ -14133,7 +14133,7 @@ if required."
14133(defun vhdl-speedbar-display-projects (project depth &optional rescan) 14133(defun vhdl-speedbar-display-projects (project depth &optional rescan)
14134 "Display projects and hierarchy information in speedbar." 14134 "Display projects and hierarchy information in speedbar."
14135 (setq vhdl-speedbar-show-projects t) 14135 (setq vhdl-speedbar-show-projects t)
14136 (setq speedbar-ignored-path-regexp ".") 14136 (setq speedbar-ignored-directory-regexp ".")
14137 (setq speedbar-last-selected-file nil) 14137 (setq speedbar-last-selected-file nil)
14138 (setq vhdl-speedbar-last-selected-project nil) 14138 (setq vhdl-speedbar-last-selected-project nil)
14139 (speedbar-with-writable 14139 (speedbar-with-writable
diff --git a/lisp/rect.el b/lisp/rect.el
index be3a65ccd6a..9515733ef2b 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -181,12 +181,9 @@ the function is called."
181 181
182;; this one is untouched --dv 182;; this one is untouched --dv
183(defun spaces-string (n) 183(defun spaces-string (n)
184 "Returns a string with N spaces."
184 (if (<= n 8) (aref spaces-strings n) 185 (if (<= n 8) (aref spaces-strings n)
185 (let ((val "")) 186 (make-string n ? )))
186 (while (> n 8)
187 (setq val (concat " " val)
188 n (- n 8)))
189 (concat val (aref spaces-strings n)))))
190 187
191;;;###autoload 188;;;###autoload
192(defun delete-rectangle (start end &optional fill) 189(defun delete-rectangle (start end &optional fill)
diff --git a/lisp/simple.el b/lisp/simple.el
index 67cd341bf1f..f07006b5cc8 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -887,7 +887,9 @@ and the greater of them is not at the start of a line."
887 887
888(defun line-number-at-pos (&optional pos) 888(defun line-number-at-pos (&optional pos)
889 "Return (narrowed) buffer line number at position POS. 889 "Return (narrowed) buffer line number at position POS.
890If POS is nil, use current buffer location." 890If POS is nil, use current buffer location.
891Counting starts at (point-min), so the value refers
892to the contents of the accessible portion of the buffer."
891 (let ((opoint (or pos (point))) start) 893 (let ((opoint (or pos (point))) start)
892 (save-excursion 894 (save-excursion
893 (goto-char (point-min)) 895 (goto-char (point-min))
@@ -3689,7 +3691,10 @@ because what we really need is for `move-to-column'
3689and `current-column' to be able to ignore invisible text." 3691and `current-column' to be able to ignore invisible text."
3690 (if (zerop col) 3692 (if (zerop col)
3691 (beginning-of-line) 3693 (beginning-of-line)
3692 (move-to-column col)) 3694 (let ((opoint (point)))
3695 (move-to-column col)
3696 ;; move-to-column doesn't respect field boundaries.
3697 (goto-char (constrain-to-field (point) opoint))))
3693 3698
3694 (when (and line-move-ignore-invisible 3699 (when (and line-move-ignore-invisible
3695 (not (bolp)) (line-move-invisible-p (1- (point)))) 3700 (not (bolp)) (line-move-invisible-p (1- (point))))
@@ -3759,7 +3764,8 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
3759 (interactive "p") 3764 (interactive "p")
3760 (or arg (setq arg 1)) 3765 (or arg (setq arg 1))
3761 3766
3762 (let ((orig (point))) 3767 (let ((orig (point))
3768 start first-vis first-vis-field-value)
3763 3769
3764 ;; Move by lines, if ARG is not 1 (the default). 3770 ;; Move by lines, if ARG is not 1 (the default).
3765 (if (/= arg 1) 3771 (if (/= arg 1)
@@ -3770,10 +3776,24 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
3770 (while (and (not (bobp)) (line-move-invisible-p (1- (point)))) 3776 (while (and (not (bobp)) (line-move-invisible-p (1- (point))))
3771 (goto-char (previous-char-property-change (point))) 3777 (goto-char (previous-char-property-change (point)))
3772 (skip-chars-backward "^\n")) 3778 (skip-chars-backward "^\n"))
3773 3779 (setq start (point))
3774 ;; Take care of fields. 3780
3775 (goto-char (constrain-to-field (point) orig 3781 ;; Now find first visible char in the line
3776 (/= arg 1) t nil)))) 3782 (while (and (not (eobp)) (line-move-invisible-p (point)))
3783 (goto-char (next-char-property-change (point))))
3784 (setq first-vis (point))
3785
3786 ;; See if fields would stop us from reaching FIRST-VIS.
3787 (setq first-vis-field-value
3788 (constrain-to-field first-vis orig (/= arg 1) t nil))
3789
3790 (goto-char (if (/= first-vis-field-value first-vis)
3791 ;; If yes, obey them.
3792 first-vis-field-value
3793 ;; Otherwise, move to START with attention to fields.
3794 ;; (It is possible that fields never matter in this case.)
3795 (constrain-to-field (point) orig
3796 (/= arg 1) t nil)))))
3777 3797
3778 3798
3779;;; Many people have said they rarely use this feature, and often type 3799;;; Many people have said they rarely use this feature, and often type
diff --git a/lisp/startup.el b/lisp/startup.el
index 5a6b4089770..b96503603c2 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1249,11 +1249,16 @@ where FACE is a valid face specification, as it can be used with
1249 "GNU Emacs is one component of the GNU/Linux operating system." 1249 "GNU Emacs is one component of the GNU/Linux operating system."
1250 "GNU Emacs is one component of the GNU operating system.")) 1250 "GNU Emacs is one component of the GNU operating system."))
1251 (insert "\n") 1251 (insert "\n")
1252 (unless (equal (buffer-name fancy-splash-outer-buffer) "*scratch*") 1252 (if fancy-splash-outer-buffer
1253 (fancy-splash-insert :face 'variable-pitch 1253 (fancy-splash-insert
1254 (substitute-command-keys 1254 :face 'variable-pitch
1255 "Type \\[recenter] to begin editing your file.\n")))) 1255 (substitute-command-keys
1256 1256 (concat
1257 "Type \\[recenter] to begin editing"
1258 (if (equal (buffer-name fancy-splash-outer-buffer)
1259 "*scratch*")
1260 ".\n"
1261 " your file.\n"))))))
1257 1262
1258(defun fancy-splash-tail () 1263(defun fancy-splash-tail ()
1259 "Insert the tail part of the splash screen into the current buffer." 1264 "Insert the tail part of the splash screen into the current buffer."
@@ -1333,55 +1338,74 @@ mouse."
1333 (if (frame-live-p frame) 1338 (if (frame-live-p frame)
1334 (run-at-time 0 nil 'fancy-splash-exit))) 1339 (run-at-time 0 nil 'fancy-splash-exit)))
1335 1340
1336(defun fancy-splash-screens () 1341(defun fancy-splash-screens (&optional hide-on-input)
1337 "Display fancy splash screens when Emacs starts." 1342 "Display fancy splash screens when Emacs starts."
1338 (setq fancy-splash-help-echo (startup-echo-area-message)) 1343 (setq fancy-splash-help-echo (startup-echo-area-message))
1339 (let ((old-hourglass display-hourglass) 1344 (if hide-on-input
1340 (fancy-splash-outer-buffer (current-buffer)) 1345 (let ((old-hourglass display-hourglass)
1341 splash-buffer 1346 (fancy-splash-outer-buffer (current-buffer))
1342 (old-minor-mode-map-alist minor-mode-map-alist) 1347 splash-buffer
1343 (old-emulation-mode-map-alists emulation-mode-map-alists) 1348 (old-minor-mode-map-alist minor-mode-map-alist)
1344 (frame (fancy-splash-frame)) 1349 (old-emulation-mode-map-alists emulation-mode-map-alists)
1345 timer) 1350 (frame (fancy-splash-frame))
1346 (save-selected-window 1351 timer)
1347 (select-frame frame) 1352 (save-selected-window
1348 (switch-to-buffer "GNU Emacs") 1353 (select-frame frame)
1349 (setq tab-width 20) 1354 (switch-to-buffer "GNU Emacs")
1350 (setq splash-buffer (current-buffer)) 1355 (setq tab-width 20)
1351 (catch 'stop-splashing 1356 (setq splash-buffer (current-buffer))
1352 (unwind-protect 1357 (catch 'stop-splashing
1353 (let* ((map (make-sparse-keymap)) 1358 (unwind-protect
1354 (overriding-local-map map) 1359 (let* ((map (make-sparse-keymap))
1355 ;; Catch if our frame is deleted; the delete-frame 1360 (overriding-local-map map)
1356 ;; event is unreliable and is handled by 1361 ;; Catch if our frame is deleted; the delete-frame
1357 ;; `special-event-map' anyway. 1362 ;; event is unreliable and is handled by
1358 (delete-frame-functions (cons 'fancy-splash-delete-frame 1363 ;; `special-event-map' anyway.
1359 delete-frame-functions))) 1364 (delete-frame-functions (cons 'fancy-splash-delete-frame
1360 (define-key map [t] 'fancy-splash-default-action) 1365 delete-frame-functions)))
1361 (define-key map [mouse-movement] 'ignore) 1366 (define-key map [t] 'fancy-splash-default-action)
1362 (define-key map [mode-line t] 'ignore) 1367 (define-key map [mouse-movement] 'ignore)
1363 (define-key map [select-window] 'ignore) 1368 (define-key map [mode-line t] 'ignore)
1364 (setq cursor-type nil 1369 (define-key map [select-window] 'ignore)
1365 display-hourglass nil 1370 (setq cursor-type nil
1366 minor-mode-map-alist nil 1371 display-hourglass nil
1367 emulation-mode-map-alists nil 1372 minor-mode-map-alist nil
1368 buffer-undo-list t 1373 emulation-mode-map-alists nil
1369 mode-line-format (propertize "---- %b %-" 1374 buffer-undo-list t
1370 'face 'mode-line-buffer-id) 1375 mode-line-format (propertize "---- %b %-"
1371 fancy-splash-stop-time (+ (float-time) 1376 'face 'mode-line-buffer-id)
1372 fancy-splash-max-time) 1377 fancy-splash-stop-time (+ (float-time)
1373 timer (run-with-timer 0 fancy-splash-delay 1378 fancy-splash-max-time)
1374 #'fancy-splash-screens-1 1379 timer (run-with-timer 0 fancy-splash-delay
1375 splash-buffer)) 1380 #'fancy-splash-screens-1
1376 (recursive-edit)) 1381 splash-buffer))
1377 (cancel-timer timer) 1382 (recursive-edit))
1378 (setq display-hourglass old-hourglass 1383 (cancel-timer timer)
1379 minor-mode-map-alist old-minor-mode-map-alist 1384 (setq display-hourglass old-hourglass
1380 emulation-mode-map-alists old-emulation-mode-map-alists) 1385 minor-mode-map-alist old-minor-mode-map-alist
1381 (kill-buffer splash-buffer) 1386 emulation-mode-map-alists old-emulation-mode-map-alists)
1382 (when (frame-live-p frame) 1387 (kill-buffer splash-buffer)
1383 (select-frame frame) 1388 (when (frame-live-p frame)
1384 (switch-to-buffer fancy-splash-outer-buffer))))))) 1389 (select-frame frame)
1390 (switch-to-buffer fancy-splash-outer-buffer))))))
1391 ;; If hide-on-input is non-nil, don't hide the buffer on input.
1392 (if (or (window-minibuffer-p)
1393 (window-dedicated-p (selected-window)))
1394 (pop-to-buffer (current-buffer))
1395 (switch-to-buffer "GNU Emacs"))
1396 (erase-buffer)
1397 (if pure-space-overflow
1398 (insert "\
1399Warning Warning!!! Pure space overflow !!!Warning Warning
1400\(See the node Pure Storage in the Lisp manual for details.)\n"))
1401 (let (fancy-splash-outer-buffer)
1402 (fancy-splash-head)
1403 (dolist (text fancy-splash-text)
1404 (apply #'fancy-splash-insert text))
1405 (fancy-splash-tail)
1406 (set-buffer-modified-p nil)
1407 (goto-char (point-min)))))
1408
1385 1409
1386(defun fancy-splash-frame () 1410(defun fancy-splash-frame ()
1387 "Return the frame to use for the fancy splash screen. 1411 "Return the frame to use for the fancy splash screen.
@@ -1412,14 +1436,16 @@ we put it on this frame."
1412 (> window-height (+ image-height 19))))))) 1436 (> window-height (+ image-height 19)))))))
1413 1437
1414 1438
1415(defun normal-splash-screen () 1439(defun normal-splash-screen (&optional hide-on-input)
1416 "Display splash screen when Emacs starts." 1440 "Display splash screen when Emacs starts."
1417 (let ((prev-buffer (current-buffer))) 1441 (let ((prev-buffer (current-buffer)))
1418 (unwind-protect 1442 (unwind-protect
1419 (with-current-buffer (get-buffer-create "GNU Emacs") 1443 (with-current-buffer (get-buffer-create "GNU Emacs")
1444 (erase-buffer)
1420 (set (make-local-variable 'tab-width) 8) 1445 (set (make-local-variable 'tab-width) 8)
1421 (set (make-local-variable 'mode-line-format) 1446 (if hide-on-input
1422 (propertize "---- %b %-" 'face 'mode-line-buffer-id)) 1447 (set (make-local-variable 'mode-line-format)
1448 (propertize "---- %b %-" 'face 'mode-line-buffer-id)))
1423 1449
1424 (if pure-space-overflow 1450 (if pure-space-overflow
1425 (insert "\ 1451 (insert "\
@@ -1435,9 +1461,13 @@ Warning Warning!!! Pure space overflow !!!Warning Warning
1435 ", one component of the GNU/Linux operating system.\n" 1461 ", one component of the GNU/Linux operating system.\n"
1436 ", a part of the GNU operating system.\n")) 1462 ", a part of the GNU operating system.\n"))
1437 1463
1438 (unless (equal (buffer-name prev-buffer) "*scratch*") 1464 (if hide-on-input
1439 (insert (substitute-command-keys 1465 (insert (substitute-command-keys
1440 "\nType \\[recenter] to begin editing your file.\n"))) 1466 (concat
1467 "\nType \\[recenter] to begin editing"
1468 (if (equal (buffer-name prev-buffer) "*scratch*")
1469 ".\n"
1470 " your file.\n")))))
1441 1471
1442 (if (display-mouse-p) 1472 (if (display-mouse-p)
1443 ;; The user can use the mouse to activate menus 1473 ;; The user can use the mouse to activate menus
@@ -1548,20 +1578,23 @@ Type \\[describe-distribution] for information on getting the latest version."))
1548 "type M-x recover-session RET\nto recover" 1578 "type M-x recover-session RET\nto recover"
1549 " the files you were editing.")) 1579 " the files you were editing."))
1550 1580
1551 ;; Display the input that we set up in the buffer. 1581 ;; Display the input that we set up in the buffer.
1552 (set-buffer-modified-p nil) 1582 (set-buffer-modified-p nil)
1553 (goto-char (point-min)) 1583 (goto-char (point-min))
1554 (if (or (window-minibuffer-p) 1584 (if (or (window-minibuffer-p)
1555 (window-dedicated-p (selected-window))) 1585 (window-dedicated-p (selected-window)))
1556 ;; There's no point is using pop-to-buffer since creating 1586 ;; If hide-on-input is nil, creating a new frame will
1557 ;; a new frame will generate enough events that the 1587 ;; generate enough events that the subsequent `sit-for'
1558 ;; subsequent `sit-for' will immediately return anyway. 1588 ;; will immediately return anyway.
1559 nil ;; (pop-to-buffer (current-buffer)) 1589 (pop-to-buffer (current-buffer))
1560 (save-window-excursion 1590 (if hide-on-input
1561 (switch-to-buffer (current-buffer)) 1591 (save-window-excursion
1562 (sit-for 120)))) 1592 (switch-to-buffer (current-buffer))
1563 ;; Unwind ... ensure splash buffer is killed 1593 (sit-for 120))
1564 (kill-buffer "GNU Emacs")))) 1594 (switch-to-buffer (current-buffer)))))
1595 ;; Unwind ... ensure splash buffer is killed
1596 (if hide-on-input
1597 (kill-buffer "GNU Emacs")))))
1565 1598
1566 1599
1567(defun startup-echo-area-message () 1600(defun startup-echo-area-message ()
@@ -1615,7 +1648,7 @@ Type \\[describe-distribution] for information on getting the latest version."))
1615 (message "%s" (startup-echo-area-message)))))) 1648 (message "%s" (startup-echo-area-message))))))
1616 1649
1617 1650
1618(defun display-splash-screen () 1651(defun display-splash-screen (&optional hide-on-input)
1619 "Display splash screen according to display. 1652 "Display splash screen according to display.
1620Fancy splash screens are used on graphic displays, 1653Fancy splash screens are used on graphic displays,
1621normal otherwise." 1654normal otherwise."
@@ -1623,8 +1656,8 @@ normal otherwise."
1623 ;; Prevent recursive calls from server-process-filter. 1656 ;; Prevent recursive calls from server-process-filter.
1624 (if (not (get-buffer "GNU Emacs")) 1657 (if (not (get-buffer "GNU Emacs"))
1625 (if (use-fancy-splash-screens-p) 1658 (if (use-fancy-splash-screens-p)
1626 (fancy-splash-screens) 1659 (fancy-splash-screens hide-on-input)
1627 (normal-splash-screen)))) 1660 (normal-splash-screen hide-on-input))))
1628 1661
1629(defun command-line-1 (command-line-args-left) 1662(defun command-line-1 (command-line-args-left)
1630 (display-startup-echo-area-message) 1663 (display-startup-echo-area-message)
@@ -1888,7 +1921,7 @@ normal otherwise."
1888 ;; If user typed input during all that work, 1921 ;; If user typed input during all that work,
1889 ;; abort the startup screen. Otherwise, display it now. 1922 ;; abort the startup screen. Otherwise, display it now.
1890 (unless (input-pending-p) 1923 (unless (input-pending-p)
1891 (display-splash-screen)))) 1924 (display-splash-screen t))))
1892 1925
1893 1926
1894(defun command-line-normalize-file-name (file) 1927(defun command-line-normalize-file-name (file)
diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el
index 17d486749b3..06b77840c0d 100644
--- a/lisp/t-mouse.el
+++ b/lisp/t-mouse.el
@@ -292,9 +292,7 @@ Turn it on to use emacs mouse commands, and off to use t-mouse commands."
292 "-f"))) 292 "-f")))
293 (setq t-mouse-filter-accumulator "") 293 (setq t-mouse-filter-accumulator "")
294 (set-process-filter t-mouse-process 't-mouse-process-filter) 294 (set-process-filter t-mouse-process 't-mouse-process-filter)
295; use commented line instead for emacs 21.4 onwards 295 (set-process-query-on-exit-flag t-mouse-process nil)))
296 (process-kill-without-query t-mouse-process)))
297; (set-process-query-on-exit-flag t-mouse-process nil)))
298 ;; Turn it off 296 ;; Turn it off
299 (setq mouse-position-function nil) 297 (setq mouse-position-function nil)
300 (delete-process t-mouse-process) 298 (delete-process t-mouse-process)
diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el
index c66c59a0889..9e3393b04a1 100644
--- a/lisp/term/mac-win.el
+++ b/lisp/term/mac-win.el
@@ -1539,7 +1539,7 @@ in `selection-converter-alist', which see."
1539(put 'autosave-now 'mac-apple-event-id "asav") ; kAEAutosaveNow 1539(put 'autosave-now 'mac-apple-event-id "asav") ; kAEAutosaveNow
1540;; kAEInternetEventClass 1540;; kAEInternetEventClass
1541(put 'get-url 'mac-apple-event-id "GURL") ; kAEGetURL 1541(put 'get-url 'mac-apple-event-id "GURL") ; kAEGetURL
1542;; Converted HICommand events 1542;; Converted HI command events
1543(put 'about 'mac-apple-event-id "abou") ; kHICommandAbout 1543(put 'about 'mac-apple-event-id "abou") ; kHICommandAbout
1544 1544
1545(defmacro mac-event-spec (event) 1545(defmacro mac-event-spec (event)
@@ -1739,7 +1739,7 @@ Currently the `mailto' scheme is supported."
1739 1739
1740(define-key mac-apple-event-map [internet-event get-url] 'mac-ae-get-url) 1740(define-key mac-apple-event-map [internet-event get-url] 'mac-ae-get-url)
1741 1741
1742(define-key mac-apple-event-map [hicommand about] 'display-splash-screen) 1742(define-key mac-apple-event-map [hi-command about] 'display-splash-screen)
1743 1743
1744;;; Converted Carbon Events 1744;;; Converted Carbon Events
1745(defun mac-handle-toolbar-switch-mode (event) 1745(defun mac-handle-toolbar-switch-mode (event)
@@ -2208,7 +2208,8 @@ See also `mac-dnd-known-types'."
2208 ;; If dropping in an ordinary window which we could use, 2208 ;; If dropping in an ordinary window which we could use,
2209 ;; let dnd-open-file-other-window specify what to do. 2209 ;; let dnd-open-file-other-window specify what to do.
2210 (progn 2210 (progn
2211 (goto-char (posn-point (event-start event))) 2211 (when (not mouse-yank-at-point)
2212 (goto-char (posn-point (event-start event))))
2212 (funcall handler window action data)) 2213 (funcall handler window action data))
2213 ;; If we can't display the file here, 2214 ;; If we can't display the file here,
2214 ;; make a new window for it. 2215 ;; make a new window for it.
@@ -2561,8 +2562,8 @@ ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
2561 2562
2562;; Initiate drag and drop 2563;; Initiate drag and drop
2563 2564
2564(global-set-key [drag-n-drop] 'mac-dnd-handle-drag-n-drop-event) 2565(define-key special-event-map [drag-n-drop] 'mac-dnd-handle-drag-n-drop-event)
2565(global-set-key [M-drag-n-drop] 'mac-dnd-handle-drag-n-drop-event) 2566(define-key special-event-map [M-drag-n-drop] 'mac-dnd-handle-drag-n-drop-event)
2566 2567
2567 2568
2568;;;; Non-toolkit Scroll bars 2569;;;; Non-toolkit Scroll bars
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 9730aca9b9d..fe774a4125f 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -2386,7 +2386,7 @@ order until succeed.")
2386 2386
2387(defun x-clipboard-yank () 2387(defun x-clipboard-yank ()
2388 "Insert the clipboard contents, or the last stretch of killed text." 2388 "Insert the clipboard contents, or the last stretch of killed text."
2389 (interactive) 2389 (interactive "*")
2390 (let ((clipboard-text (x-selection-value 'CLIPBOARD)) 2390 (let ((clipboard-text (x-selection-value 'CLIPBOARD))
2391 (x-select-enable-clipboard t)) 2391 (x-select-enable-clipboard t))
2392 (if (and clipboard-text (> (length clipboard-text) 0)) 2392 (if (and clipboard-text (> (length clipboard-text) 0))
@@ -2518,8 +2518,9 @@ order until succeed.")
2518 2518
2519 ;; Override Paste so it looks at CLIPBOARD first. 2519 ;; Override Paste so it looks at CLIPBOARD first.
2520 (define-key menu-bar-edit-menu [paste] 2520 (define-key menu-bar-edit-menu [paste]
2521 (cons "Paste" (cons "Paste text from clipboard or kill ring" 2521 '(menu-item "Paste" x-clipboard-yank
2522 'x-clipboard-yank))) 2522 :enable (not buffer-read-only)
2523 :help "Paste (yank) text most recently cut/copied"))
2523 2524
2524 (setq x-initialized t)) 2525 (setq x-initialized t))
2525 2526
@@ -2531,7 +2532,7 @@ order until succeed.")
2531 2532
2532;; Initiate drag and drop 2533;; Initiate drag and drop
2533(add-hook 'after-make-frame-functions 'x-dnd-init-frame) 2534(add-hook 'after-make-frame-functions 'x-dnd-init-frame)
2534(global-set-key [drag-n-drop] 'x-dnd-handle-drag-n-drop-event) 2535(define-key special-event-map [drag-n-drop] 'x-dnd-handle-drag-n-drop-event)
2535 2536
2536;; arch-tag: f1501302-db8b-4d95-88e3-116697d89f78 2537;; arch-tag: f1501302-db8b-4d95-88e3-116697d89f78
2537;;; x-win.el ends here 2538;;; x-win.el ends here
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index 9c4b8b1190b..2e498a8de86 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -159,8 +159,37 @@
159(define-key xterm-function-map "\e[4~" [select]) 159(define-key xterm-function-map "\e[4~" [select])
160(define-key xterm-function-map "\e[29~" [print]) 160(define-key xterm-function-map "\e[29~" [print])
161 161
162;; These keys are available in xterm starting from version 214 162;; These keys are available in xterm starting from version 216
163;; if the modifyOtherKeys resource is set to 1. 163;; if the modifyOtherKeys resource is set to 1.
164
165(define-key xterm-function-map "\e[27;5;39~" [?\C-\'])
166(define-key xterm-function-map "\e[27;5;45~" [?\C--])
167
168(define-key xterm-function-map "\e[27;5;48~" [?\C-0])
169(define-key xterm-function-map "\e[27;5;49~" [?\C-1])
170;; Not all C-DIGIT keys have a distinct binding.
171(define-key xterm-function-map "\e[27;5;57~" [?\C-9])
172
173(define-key xterm-function-map "\e[27;5;59~" [?\C-\;])
174(define-key xterm-function-map "\e[27;5;61~" [?\C-=])
175
176
177(define-key xterm-function-map "\e[27;6;33~" [?\C-!])
178(define-key xterm-function-map "\e[27;6;34~" [?\C-\"])
179(define-key xterm-function-map "\e[27;6;35~" [?\C-#])
180(define-key xterm-function-map "\e[27;6;36~" [?\C-$])
181(define-key xterm-function-map "\e[27;6;37~" [?\C-%])
182(define-key xterm-function-map "\e[27;6;38~" [(C-&)])
183(define-key xterm-function-map "\e[27;6;40~" [?\C-(])
184(define-key xterm-function-map "\e[27;6;41~" [?\C-)])
185(define-key xterm-function-map "\e[27;6;42~" [?\C-*])
186(define-key xterm-function-map "\e[27;6;43~" [?\C-+])
187
188(define-key xterm-function-map "\e[27;6;58~" [?\C-:])
189(define-key xterm-function-map "\e[27;6;60~" [?\C-<])
190(define-key xterm-function-map "\e[27;6;62~" [?\C->])
191(define-key xterm-function-map "\e[27;6;63~" [(C-\?)])
192
164(define-key xterm-function-map "\e[27;5;9~" [C-tab]) 193(define-key xterm-function-map "\e[27;5;9~" [C-tab])
165(define-key xterm-function-map "\e[27;5;13~" [C-return]) 194(define-key xterm-function-map "\e[27;5;13~" [C-return])
166(define-key xterm-function-map "\e[27;5;44~" [?\C-,]) 195(define-key xterm-function-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..ecbcd86d043 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)
@@ -9359,6 +9467,7 @@ onto the ring."
9359 "Follow a Gnus link to GROUP and ARTICLE." 9467 "Follow a Gnus link to GROUP and ARTICLE."
9360 (require 'gnus) 9468 (require 'gnus)
9361 (funcall (cdr (assq 'gnus org-link-frame-setup))) 9469 (funcall (cdr (assq 'gnus org-link-frame-setup)))
9470 (if gnus-other-frame-object (select-frame gnus-other-frame-object))
9362 (if group (gnus-fetch-group group)) 9471 (if group (gnus-fetch-group group))
9363 (if article 9472 (if article
9364 (or (gnus-summary-goto-article article nil 'force) 9473 (or (gnus-summary-goto-article article nil 'force)
@@ -10234,13 +10343,13 @@ to be run from that hook to fucntion properly."
10234 (org-startup-with-deadline-check nil)) 10343 (org-startup-with-deadline-check nil))
10235 (org-mode)) 10344 (org-mode))
10236 (if (and file (string-match "\\S-" file) (not (file-directory-p file))) 10345 (if (and file (string-match "\\S-" file) (not (file-directory-p file)))
10237 (set (make-local-variable 'org-default-notes-file) file)) 10346 (org-set-local 'org-default-notes-file file))
10238 (goto-char (point-min)) 10347 (goto-char (point-min))
10239 (if (re-search-forward "%\\?" nil t) (replace-match ""))) 10348 (if (re-search-forward "%\\?" nil t) (replace-match "")))
10240 (let ((org-startup-folded nil) 10349 (let ((org-startup-folded nil)
10241 (org-startup-with-deadline-check nil)) 10350 (org-startup-with-deadline-check nil))
10242 (org-mode))) 10351 (org-mode)))
10243 (set (make-local-variable 'org-finish-function) 'remember-buffer)) 10352 (org-set-local 'org-finish-function 'remember-buffer))
10244 10353
10245;;;###autoload 10354;;;###autoload
10246(defun org-remember-handler () 10355(defun org-remember-handler ()
@@ -11492,10 +11601,10 @@ it can be edited in place."
11492 '(invisible t org-cwidth t display t 11601 '(invisible t org-cwidth t display t
11493 intangible t)) 11602 intangible t))
11494 (goto-char p) 11603 (goto-char p)
11495 (set (make-local-variable 'org-finish-function) 11604 (org-set-local 'org-finish-function
11496 'org-table-finish-edit-field) 11605 'org-table-finish-edit-field)
11497 (set (make-local-variable 'org-window-configuration) cw) 11606 (org-set-local 'org-window-configuration cw)
11498 (set (make-local-variable 'org-field-marker) pos) 11607 (org-set-local 'org-field-marker pos)
11499 (message "Edit and finish with C-c C-c")))) 11608 (message "Edit and finish with C-c C-c"))))
11500 11609
11501(defun org-table-finish-edit-field () 11610(defun org-table-finish-edit-field ()
@@ -12098,10 +12207,11 @@ not overwrite the stored one."
12098 (setq formula (car tmp) 12207 (setq formula (car tmp)
12099 fmt (concat (cdr (assoc "%" org-table-local-parameters)) 12208 fmt (concat (cdr (assoc "%" org-table-local-parameters))
12100 (nth 1 tmp))) 12209 (nth 1 tmp)))
12101 (while (string-match "[pnfse]\\(-?[0-9]+\\)" fmt) 12210 (while (string-match "\\([pnfse]\\)\\(-?[0-9]+\\)" fmt)
12102 (setq c (string-to-char (match-string 1 fmt)) 12211 (setq c (string-to-char (match-string 1 fmt))
12103 n (string-to-number (or (match-string 1 fmt) ""))) 12212 n (string-to-number (match-string 2 fmt)))
12104 (if (= c ?p) (setq modes (org-set-calc-mode 'calc-internal-prec n)) 12213 (if (= c ?p)
12214 (setq modes (org-set-calc-mode 'calc-internal-prec n))
12105 (setq modes (org-set-calc-mode 12215 (setq modes (org-set-calc-mode
12106 'calc-float-format 12216 'calc-float-format
12107 (list (cdr (assoc c '((?n . float) (?f . fix) 12217 (list (cdr (assoc c '((?n . float) (?f . fix)
@@ -12314,8 +12424,8 @@ Parameters get priority."
12314 (switch-to-buffer-other-window "*Edit Formulas*") 12424 (switch-to-buffer-other-window "*Edit Formulas*")
12315 (erase-buffer) 12425 (erase-buffer)
12316 (fundamental-mode) 12426 (fundamental-mode)
12317 (set (make-local-variable 'org-pos) pos) 12427 (org-set-local 'org-pos pos)
12318 (set (make-local-variable 'org-window-configuration) wc) 12428 (org-set-local 'org-window-configuration wc)
12319 (use-local-map org-edit-formulas-map) 12429 (use-local-map org-edit-formulas-map)
12320 (setq s "# Edit formulas and finish with `C-c C-c'. 12430 (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. 12431# Use `C-u C-c C-c' to also appy them immediately to the entire table.
@@ -12481,15 +12591,15 @@ table editor in arbitrary modes.")
12481 (let ((c (assq 'orgtbl-mode minor-mode-map-alist))) 12591 (let ((c (assq 'orgtbl-mode minor-mode-map-alist)))
12482 (and c (setq minor-mode-map-alist 12592 (and c (setq minor-mode-map-alist
12483 (cons c (delq c minor-mode-map-alist))))) 12593 (cons c (delq c minor-mode-map-alist)))))
12484 (set (make-local-variable (quote org-table-may-need-update)) t) 12594 (org-set-local (quote org-table-may-need-update) t)
12485 (org-add-hook 'before-change-functions 'org-before-change-function 12595 (org-add-hook 'before-change-functions 'org-before-change-function
12486 nil 'local) 12596 nil 'local)
12487 (set (make-local-variable 'org-old-auto-fill-inhibit-regexp) 12597 (org-set-local 'org-old-auto-fill-inhibit-regexp
12488 auto-fill-inhibit-regexp) 12598 auto-fill-inhibit-regexp)
12489 (set (make-local-variable 'auto-fill-inhibit-regexp) 12599 (org-set-local 'auto-fill-inhibit-regexp
12490 (if auto-fill-inhibit-regexp 12600 (if auto-fill-inhibit-regexp
12491 (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp) 12601 (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp)
12492 "[ \t]*|")) 12602 "[ \t]*|"))
12493 (org-add-to-invisibility-spec '(org-cwidth)) 12603 (org-add-to-invisibility-spec '(org-cwidth))
12494 (easy-menu-add orgtbl-mode-menu) 12604 (easy-menu-add orgtbl-mode-menu)
12495 (run-hooks 'orgtbl-mode-hook)) 12605 (run-hooks 'orgtbl-mode-hook))
@@ -13388,7 +13498,7 @@ underlined headlines. The default is 3."
13388 (set (make-local-variable (cdr x)) 13498 (set (make-local-variable (cdr x))
13389 (plist-get opt-plist (car x)))) 13499 (plist-get opt-plist (car x))))
13390 org-export-plist-vars) 13500 org-export-plist-vars)
13391 (set (make-local-variable 'org-odd-levels-only) odd) 13501 (org-set-local 'org-odd-levels-only odd)
13392 (setq umax (if arg (prefix-numeric-value arg) 13502 (setq umax (if arg (prefix-numeric-value arg)
13393 org-export-headline-levels)) 13503 org-export-headline-levels))
13394 13504
@@ -13594,22 +13704,15 @@ command."
13594 (goto-char (point-min))))) 13704 (goto-char (point-min)))))
13595 13705
13596(defun org-find-visible () 13706(defun org-find-visible ()
13597 (if (featurep 'noutline) 13707 (let ((s (point)))
13598 (let ((s (point))) 13708 (while (and (not (= (point-max) (setq s (next-overlay-change s))))
13599 (while (and (not (= (point-max) (setq s (next-overlay-change s)))) 13709 (get-char-property s 'invisible)))
13600 (get-char-property s 'invisible))) 13710 s))
13601 s)
13602 (skip-chars-forward "^\n")
13603 (point)))
13604(defun org-find-invisible () 13711(defun org-find-invisible ()
13605 (if (featurep 'noutline) 13712 (let ((s (point)))
13606 (let ((s (point))) 13713 (while (and (not (= (point-max) (setq s (next-overlay-change s))))
13607 (while (and (not (= (point-max) (setq s (next-overlay-change s)))) 13714 (not (get-char-property s 'invisible))))
13608 (not (get-char-property s 'invisible)))) 13715 s))
13609 s)
13610 (skip-chars-forward "^\r")
13611 (point)))
13612
13613 13716
13614;; HTML 13717;; HTML
13615 13718
@@ -13859,14 +13962,16 @@ lang=\"%s\" xml:lang=\"%s\">
13859 (insert (or (plist-get opt-plist :preamble) "")) 13962 (insert (or (plist-get opt-plist :preamble) ""))
13860 13963
13861 (when (plist-get opt-plist :auto-preamble) 13964 (when (plist-get opt-plist :auto-preamble)
13862 (if title (insert (concat "<h1 class=\"title\">" 13965 (if title (insert (format org-export-html-title-format
13863 (org-html-expand title) "</h1>\n"))) 13966 (org-html-expand title))))
13864
13865 (if text (insert "<p>\n" (org-html-expand text) "</p>"))) 13967 (if text (insert "<p>\n" (org-html-expand text) "</p>")))
13866 13968
13867 (if org-export-with-toc 13969 (if org-export-with-toc
13868 (progn 13970 (progn
13869 (insert (format "<h2>%s</h2>\n" (nth 3 lang-words))) 13971 (insert (format "<h%d>%s</h%d>\n"
13972 org-export-html-toplevel-hlevel
13973 (nth 3 lang-words)
13974 org-export-html-toplevel-hlevel))
13870 (insert "<ul>\n<li>") 13975 (insert "<ul>\n<li>")
13871 (setq lines 13976 (setq lines
13872 (mapcar '(lambda (line) 13977 (mapcar '(lambda (line)
@@ -14553,7 +14658,7 @@ When TITLE is nil, just close all open levels."
14553 (insert "<ul>\n<li>" title "<br/>\n"))) 14658 (insert "<ul>\n<li>" title "<br/>\n")))
14554 (if org-export-with-section-numbers 14659 (if org-export-with-section-numbers
14555 (setq title (concat (org-section-number level) " " title))) 14660 (setq title (concat (org-section-number level) " " title)))
14556 (setq level (+ level 1)) 14661 (setq level (+ level org-export-html-toplevel-hlevel -1))
14557 (if with-toc 14662 (if with-toc
14558 (insert (format "\n<h%d><a name=\"sec-%d\">%s</a></h%d>\n" 14663 (insert (format "\n<h%d><a name=\"sec-%d\">%s</a></h%d>\n"
14559 level head-count title level)) 14664 level head-count title level))
@@ -15763,6 +15868,10 @@ See the individual commands for more information."
15763 "--" 15868 "--"
15764 ("TODO Lists" 15869 ("TODO Lists"
15765 ["TODO/DONE/-" org-todo t] 15870 ["TODO/DONE/-" org-todo t]
15871 ("Select keyword"
15872 ["Next keyword" org-shiftright (org-on-heading-p)]
15873 ["Previous keyword" org-shiftleft (org-on-heading-p)]
15874 ["Complete Keyword" org-complete (assq :todo-keyword (org-context))])
15766 ["Show TODO Tree" org-show-todo-tree t] 15875 ["Show TODO Tree" org-show-todo-tree t]
15767 ["Global TODO list" org-todo-list t] 15876 ["Global TODO list" org-todo-list t]
15768 "--" 15877 "--"
@@ -16042,31 +16151,32 @@ return nil."
16042 ;; In the paragraph separator we include headlines, because filling 16151 ;; In the paragraph separator we include headlines, because filling
16043 ;; text in a line directly attached to a headline would otherwise 16152 ;; text in a line directly attached to a headline would otherwise
16044 ;; fill the headline as well. 16153 ;; fill the headline as well.
16045 (set (make-local-variable 'comment-start-skip) "^#+[ \t]*") 16154 (org-set-local 'comment-start-skip "^#+[ \t]*")
16046 (set (make-local-variable 'paragraph-separate) "\f\\|\\*\\|[ ]*$\\|[ \t]*[:|]") 16155 (org-set-local 'paragraph-separate "\f\\|\\*\\|[ ]*$\\|[ \t]*[:|]")
16047 ;; The paragraph starter includes hand-formatted lists. 16156 ;; The paragraph starter includes hand-formatted lists.
16048 (set (make-local-variable 'paragraph-start) 16157 (org-set-local 'paragraph-start
16049 "\f\\|[ ]*$\\|\\([*\f]+\\)\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]") 16158 "\f\\|[ ]*$\\|\\([*\f]+\\)\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]")
16050 ;; Inhibit auto-fill for headers, tables and fixed-width lines. 16159 ;; 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 16160 ;; But only if the user has not turned off tables or fixed-width regions
16052 (set (make-local-variable 'auto-fill-inhibit-regexp) 16161 (org-set-local
16053 (concat "\\*\\|#" 16162 'auto-fill-inhibit-regexp
16054 "\\|[ \t]*" org-keyword-time-regexp 16163 (concat "\\*\\|#"
16055 (if (or org-enable-table-editor org-enable-fixed-width-editor) 16164 "\\|[ \t]*" org-keyword-time-regexp
16056 (concat 16165 (if (or org-enable-table-editor org-enable-fixed-width-editor)
16057 "\\|[ \t]*[" 16166 (concat
16058 (if org-enable-table-editor "|" "") 16167 "\\|[ \t]*["
16059 (if org-enable-fixed-width-editor ":" "") 16168 (if org-enable-table-editor "|" "")
16060 "]")))) 16169 (if org-enable-fixed-width-editor ":" "")
16170 "]"))))
16061 ;; We use our own fill-paragraph function, to make sure that tables 16171 ;; We use our own fill-paragraph function, to make sure that tables
16062 ;; and fixed-width regions are not wrapped. That function will pass 16172 ;; and fixed-width regions are not wrapped. That function will pass
16063 ;; through to `fill-paragraph' when appropriate. 16173 ;; through to `fill-paragraph' when appropriate.
16064 (set (make-local-variable 'fill-paragraph-function) 'org-fill-paragraph) 16174 (org-set-local 'fill-paragraph-function 'org-fill-paragraph)
16065 ;; Adaptive filling: To get full control, first make sure that 16175 ; Adaptive filling: To get full control, first make sure that
16066 ;; `adaptive-fill-regexp' never matches. Then install our own matcher. 16176 ;; `adaptive-fill-regexp' never matches. Then install our own matcher.
16067 (set (make-local-variable 'adaptive-fill-regexp) "\000") 16177 (org-set-local 'adaptive-fill-regexp "\000")
16068 (set (make-local-variable 'adaptive-fill-function) 16178 (org-set-local 'adaptive-fill-function
16069 'org-adaptive-fill-function)) 16179 'org-adaptive-fill-function))
16070 16180
16071(defun org-fill-paragraph (&optional justify) 16181(defun org-fill-paragraph (&optional justify)
16072 "Re-align a table, pass through to fill-paragraph if no table." 16182 "Re-align a table, pass through to fill-paragraph if no table."
@@ -16145,18 +16255,7 @@ that can be added."
16145 t) 16255 t)
16146 "\\'")))) 16256 "\\'"))))
16147 16257
16148;; Functions needed for compatibility with old outline.el. 16258;; 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 16259
16161;; C-a should go to the beginning of a *visible* line, also in the 16260;; 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? 16261;; new outline.el. I guess this should be patched into Emacs?
@@ -16174,60 +16273,26 @@ to a visible line beginning. This makes the function of C-a more intuitive."
16174 (beginning-of-line 1)) 16273 (beginning-of-line 1))
16175 (forward-char 1)))) 16274 (forward-char 1))))
16176 16275
16177(when org-noutline-p 16276(define-key org-mode-map "\C-a" 'org-beginning-of-line)
16178 (define-key org-mode-map "\C-a" 'org-beginning-of-line))
16179 16277
16180(defun org-invisible-p () 16278(defun org-invisible-p ()
16181 "Check if point is at a character currently not visible." 16279 "Check if point is at a character currently not visible."
16182 (if org-noutline-p 16280 ;; Early versions of noutline don't have `outline-invisible-p'.
16183 ;; Early versions of noutline don't have `outline-invisible-p'. 16281 (if (fboundp 'outline-invisible-p)
16184 (if (fboundp 'outline-invisible-p) 16282 (outline-invisible-p)
16185 (outline-invisible-p) 16283 (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 16284
16191(defun org-invisible-p2 () 16285(defun org-invisible-p2 ()
16192 "Check if point is at a character currently not visible." 16286 "Check if point is at a character currently not visible."
16193 (save-excursion 16287 (save-excursion
16194 (if org-noutline-p 16288 (if (and (eolp) (not (bobp))) (backward-char 1))
16195 (progn 16289 ;; Early versions of noutline don't have `outline-invisible-p'.
16196 (if (and (eolp) (not (bobp))) (backward-char 1)) 16290 (if (fboundp 'outline-invisible-p)
16197 ;; Early versions of noutline don't have `outline-invisible-p'. 16291 (outline-invisible-p)
16198 (if (fboundp 'outline-invisible-p) 16292 (get-char-property (point) 'invisible))))
16199 (outline-invisible-p) 16293
16200 (get-char-property (point) 'invisible))) 16294(defalias 'org-back-to-heading 'outline-back-to-heading)
16201 (skip-chars-backward "^\r\n") 16295(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 16296
16232(defun org-on-target-p () 16297(defun org-on-target-p ()
16233 (let ((pos (point))) 16298 (let ((pos (point)))
@@ -16243,47 +16308,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. 16308 "Move to the heading line of which the present line is a subheading.
16244This function considers both visible and invisible heading lines. 16309This function considers both visible and invisible heading lines.
16245With argument, move up ARG levels." 16310With argument, move up ARG levels."
16246 (if org-noutline-p 16311 (if (fboundp 'outline-up-heading-all)
16247 (if (fboundp 'outline-up-heading-all) 16312 (outline-up-heading-all arg) ; emacs 21 version of outline.el
16248 (outline-up-heading-all arg) ; emacs 21 version of outline.el 16313 (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 16314
16261(defun org-show-hidden-entry () 16315(defun org-show-hidden-entry ()
16262 "Show an entry where even the heading is hidden." 16316 "Show an entry where even the heading is hidden."
16263 (save-excursion 16317 (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))) 16318 (org-show-entry)))
16269 16319
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) 16320(defun org-flag-heading (flag &optional entry)
16280 "Flag the current heading. FLAG non-nil means make invisible. 16321 "Flag the current heading. FLAG non-nil means make invisible.
16281When ENTRY is non-nil, show the entire entry." 16322When ENTRY is non-nil, show the entire entry."
16282 (save-excursion 16323 (save-excursion
16283 (org-back-to-heading t) 16324 (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 16325 ;; Check if we should show the entire entry
16288 (if entry 16326 (if entry
16289 (progn 16327 (progn
@@ -16293,9 +16331,7 @@ When ENTRY is non-nil, show the entire entry."
16293 (org-flag-heading nil)))) 16331 (org-flag-heading nil))))
16294 (outline-flag-region (max 1 (1- (point))) 16332 (outline-flag-region (max 1 (1- (point)))
16295 (save-excursion (outline-end-of-heading) (point)) 16333 (save-excursion (outline-end-of-heading) (point))
16296 (if org-noutline-p 16334 flag))))
16297 flag
16298 (if flag ?\r ?\n))))))
16299 16335
16300(defun org-end-of-subtree (&optional invisible-OK) 16336(defun org-end-of-subtree (&optional invisible-OK)
16301 ;; This is an exact copy of the original function, but it uses 16337 ;; This is an exact copy of the original function, but it uses
@@ -16324,7 +16360,7 @@ When ENTRY is non-nil, show the entire entry."
16324 (point) 16360 (point)
16325 (save-excursion 16361 (save-excursion
16326 (outline-end-of-subtree) (outline-next-heading) (point)) 16362 (outline-end-of-subtree) (outline-next-heading) (point))
16327 (if org-noutline-p nil ?\n))) 16363 nil))
16328 16364
16329(defun org-show-entry () 16365(defun org-show-entry ()
16330 "Show the body directly following this heading. 16366 "Show the body directly following this heading.
@@ -16337,16 +16373,16 @@ Show the heading too, if it is currently invisible."
16337 (save-excursion 16373 (save-excursion
16338 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) 16374 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move)
16339 (or (match-beginning 1) (point-max))) 16375 (or (match-beginning 1) (point-max)))
16340 (if org-noutline-p nil ?\n)))) 16376 nil)))
16341 16377
16342(defun org-make-options-regexp (kwds) 16378(defun org-make-options-regexp (kwds)
16343 "Make a regular expression for keyword lines." 16379 "Make a regular expression for keyword lines."
16344 (concat 16380 (concat
16345 (if org-noutline-p "^" "[\n\r]") 16381 "^"
16346 "#?[ \t]*\\+\\(" 16382 "#?[ \t]*\\+\\("
16347 (mapconcat 'regexp-quote kwds "\\|") 16383 (mapconcat 'regexp-quote kwds "\\|")
16348 "\\):[ \t]*" 16384 "\\):[ \t]*"
16349 (if org-noutline-p "\\(.+\\)" "\\([^\n\r]+\\)"))) 16385 "\\(.+\\)"))
16350 16386
16351;; Make `bookmark-jump' show the jump location if it was hidden. 16387;; Make `bookmark-jump' show the jump location if it was hidden.
16352(eval-after-load "bookmark" 16388(eval-after-load "bookmark"
diff --git a/lisp/tumme.el b/lisp/tumme.el
index 3bd1d41886e..788a29958a8 100644
--- a/lisp/tumme.el
+++ b/lisp/tumme.el
@@ -172,12 +172,12 @@
172 :group 'multimedia) 172 :group 'multimedia)
173 173
174(defcustom tumme-dir "~/.emacs.d/tumme/" 174(defcustom tumme-dir "~/.emacs.d/tumme/"
175 "*Directory where thumbnail images are stored." 175 "Directory where thumbnail images are stored."
176 :type 'string 176 :type 'string
177 :group 'tumme) 177 :group 'tumme)
178 178
179(defcustom tumme-thumbnail-storage 'use-tumme-dir 179(defcustom tumme-thumbnail-storage 'use-tumme-dir
180 "*How to store tumme's thumbnail files. 180 "How to store tumme's thumbnail files.
181Tumme can store thumbnail files in one of two ways and this is 181Tumme can store thumbnail files in one of two ways and this is
182controlled by this variable. \"Use tumme dir\" means that the 182controlled by this variable. \"Use tumme dir\" means that the
183thumbnails are stored in a central directory. \"Per directory\" 183thumbnails are stored in a central directory. \"Per directory\"
@@ -193,17 +193,17 @@ that allows sharing of thumbnails across different programs."
193 :group 'tumme) 193 :group 'tumme)
194 194
195(defcustom tumme-db-file "~/.emacs.d/tumme/.tumme_db" 195(defcustom tumme-db-file "~/.emacs.d/tumme/.tumme_db"
196 "*Database file where file names and their associated tags are stored." 196 "Database file where file names and their associated tags are stored."
197 :type 'string 197 :type 'string
198 :group 'tumme) 198 :group 'tumme)
199 199
200(defcustom tumme-temp-image-file "~/.emacs.d/tumme/.tumme_temp" 200(defcustom tumme-temp-image-file "~/.emacs.d/tumme/.tumme_temp"
201 "*Name of temporary image file used by various commands." 201 "Name of temporary image file used by various commands."
202 :type 'string 202 :type 'string
203 :group 'tumme) 203 :group 'tumme)
204 204
205(defcustom tumme-gallery-dir "~/.emacs.d/tumme/.tumme_gallery" 205(defcustom tumme-gallery-dir "~/.emacs.d/tumme/.tumme_gallery"
206 "*Directory to store generated gallery html pages. 206 "Directory to store generated gallery html pages.
207This path needs to be \"shared\" to the public so that it can access 207This path needs to be \"shared\" to the public so that it can access
208the index.html page that tumme creates." 208the index.html page that tumme creates."
209 :type 'string 209 :type 'string
@@ -211,7 +211,7 @@ the index.html page that tumme creates."
211 211
212(defcustom tumme-gallery-image-root-url 212(defcustom tumme-gallery-image-root-url
213"http://your.own.server/tummepics" 213"http://your.own.server/tummepics"
214 "*URL where the full size images are to be found. 214 "URL where the full size images are to be found.
215Note that this path has to be configured in your web server. Tumme 215Note that this path has to be configured in your web server. Tumme
216expects to find pictures in this directory." 216expects to find pictures in this directory."
217 :type 'string 217 :type 'string
@@ -219,7 +219,7 @@ expects to find pictures in this directory."
219 219
220(defcustom tumme-gallery-thumb-image-root-url 220(defcustom tumme-gallery-thumb-image-root-url
221"http://your.own.server/tummethumbs" 221"http://your.own.server/tummethumbs"
222 "*URL where the thumbnail images are to be found. 222 "URL where the thumbnail images are to be found.
223Note that this path has to be configured in your web server. Tumme 223Note that this path has to be configured in your web server. Tumme
224expects to find pictures in this directory." 224expects to find pictures in this directory."
225 :type 'string 225 :type 'string
@@ -227,14 +227,14 @@ expects to find pictures in this directory."
227 227
228(defcustom tumme-cmd-create-thumbnail-program 228(defcustom tumme-cmd-create-thumbnail-program
229 "convert" 229 "convert"
230 "*Executable used to create thumbnail. 230 "Executable used to create thumbnail.
231Used together with `tumme-cmd-create-thumbnail-options'." 231Used together with `tumme-cmd-create-thumbnail-options'."
232 :type 'string 232 :type 'string
233 :group 'tumme) 233 :group 'tumme)
234 234
235(defcustom tumme-cmd-create-thumbnail-options 235(defcustom tumme-cmd-create-thumbnail-options
236 "%p -size %wx%h \"%f\" -resize %wx%h +profile \"*\" jpeg:\"%t\"" 236 "%p -size %wx%h \"%f\" -resize %wx%h +profile \"*\" jpeg:\"%t\""
237 "*Format of command used to create thumbnail image. 237 "Format of command used to create thumbnail image.
238Available options are %p which is replaced by 238Available options are %p which is replaced by
239`tumme-cmd-create-thumbnail-program', %w which is replaced by 239`tumme-cmd-create-thumbnail-program', %w which is replaced by
240`tumme-thumb-width', %h which is replaced by `tumme-thumb-height', 240`tumme-thumb-width', %h which is replaced by `tumme-thumb-height',
@@ -245,14 +245,14 @@ which is replaced by the file name of the thumbnail file."
245 245
246(defcustom tumme-cmd-create-temp-image-program 246(defcustom tumme-cmd-create-temp-image-program
247 "convert" 247 "convert"
248 "*Executable used to create temporary image. 248 "Executable used to create temporary image.
249Used together with `tumme-cmd-create-temp-image-options'." 249Used together with `tumme-cmd-create-temp-image-options'."
250 :type 'string 250 :type 'string
251 :group 'tumme) 251 :group 'tumme)
252 252
253(defcustom tumme-cmd-create-temp-image-options 253(defcustom tumme-cmd-create-temp-image-options
254 "%p -size %wx%h \"%f\" -resize %wx%h +profile \"*\" jpeg:\"%t\"" 254 "%p -size %wx%h \"%f\" -resize %wx%h +profile \"*\" jpeg:\"%t\""
255 "*Format of command used to create temporary image for display window. 255 "Format of command used to create temporary image for display window.
256Available options are %p which is replaced by 256Available options are %p which is replaced by
257`tumme-cmd-create-temp-image-program', %w and %h which is replaced by 257`tumme-cmd-create-temp-image-program', %w and %h which is replaced by
258the calculated max size for width and height in the image display window, 258the calculated max size for width and height in the image display window,
@@ -262,13 +262,13 @@ is replaced by the file name of the temporary file."
262 :group 'tumme) 262 :group 'tumme)
263 263
264(defcustom tumme-cmd-pngnq-program (executable-find "pngnq") 264(defcustom tumme-cmd-pngnq-program (executable-find "pngnq")
265 "*The file name of the `pngnq' program. 265 "The file name of the `pngnq' program.
266It quantizes colors of PNG images down to 256 colors." 266It quantizes colors of PNG images down to 256 colors."
267 :type '(choice (const :tag "Not Set" nil) string) 267 :type '(choice (const :tag "Not Set" nil) string)
268 :group 'tumme) 268 :group 'tumme)
269 269
270(defcustom tumme-cmd-pngcrush-program (executable-find "pngcrush") 270(defcustom tumme-cmd-pngcrush-program (executable-find "pngcrush")
271 "*The file name of the `pngcrush' program. 271 "The file name of the `pngcrush' program.
272It optimizes the compression of PNG images. Also it adds PNG textual chunks 272It optimizes the compression of PNG images. Also it adds PNG textual chunks
273with the information required by the Thumbnail Managing Standard." 273with the information required by the Thumbnail Managing Standard."
274 :type '(choice (const :tag "Not Set" nil) string) 274 :type '(choice (const :tag "Not Set" nil) string)
@@ -305,20 +305,20 @@ with the information required by the Thumbnail Managing Standard."
305 "-text b \"Thumb::URI\" \"file://%f\" " 305 "-text b \"Thumb::URI\" \"file://%f\" "
306 "%q %t" 306 "%q %t"
307 " ; rm %q"))) 307 " ; rm %q")))
308 "*Command to create thumbnails according to the Thumbnail Managing Standard." 308 "Command to create thumbnails according to the Thumbnail Managing Standard."
309 :type 'string 309 :type 'string
310 :group 'tumme) 310 :group 'tumme)
311 311
312(defcustom tumme-cmd-rotate-thumbnail-program 312(defcustom tumme-cmd-rotate-thumbnail-program
313 "mogrify" 313 "mogrify"
314 "*Executable used to rotate thumbnail. 314 "Executable used to rotate thumbnail.
315Used together with `tumme-cmd-rotate-thumbnail-options'." 315Used together with `tumme-cmd-rotate-thumbnail-options'."
316 :type 'string 316 :type 'string
317 :group 'tumme) 317 :group 'tumme)
318 318
319(defcustom tumme-cmd-rotate-thumbnail-options 319(defcustom tumme-cmd-rotate-thumbnail-options
320 "%p -rotate %d \"%t\"" 320 "%p -rotate %d \"%t\""
321 "*Format of command used to rotate thumbnail image. 321 "Format of command used to rotate thumbnail image.
322Available options are %p which is replaced by 322Available options are %p which is replaced by
323`tumme-cmd-rotate-thumbnail-program', %d which is replaced by the 323`tumme-cmd-rotate-thumbnail-program', %d which is replaced by the
324number of (positive) degrees to rotate the image, normally 90 or 270 324number of (positive) degrees to rotate the image, normally 90 or 270
@@ -329,14 +329,14 @@ of the thumbnail file."
329 329
330(defcustom tumme-cmd-rotate-original-program 330(defcustom tumme-cmd-rotate-original-program
331 "jpegtran" 331 "jpegtran"
332 "*Executable used to rotate original image. 332 "Executable used to rotate original image.
333Used together with `tumme-cmd-rotate-original-options'." 333Used together with `tumme-cmd-rotate-original-options'."
334 :type 'string 334 :type 'string
335 :group 'tumme) 335 :group 'tumme)
336 336
337(defcustom tumme-cmd-rotate-original-options 337(defcustom tumme-cmd-rotate-original-options
338 "%p -rotate %d -copy all \"%o\" > %t" 338 "%p -rotate %d -copy all \"%o\" > %t"
339 "*Format of command used to rotate original image. 339 "Format of command used to rotate original image.
340Available options are %p which is replaced by 340Available options are %p which is replaced by
341`tumme-cmd-rotate-original-program', %d which is replaced by the 341`tumme-cmd-rotate-original-program', %d which is replaced by the
342number of (positive) degrees to rotate the image, normally 90 or 342number of (positive) degrees to rotate the image, normally 90 or
@@ -348,7 +348,7 @@ original image file name and %t which is replaced by
348 348
349(defcustom tumme-temp-rotate-image-file 349(defcustom tumme-temp-rotate-image-file
350 "~/.emacs.d/tumme/.tumme_rotate_temp" 350 "~/.emacs.d/tumme/.tumme_rotate_temp"
351 "*Temporary file for rotate operations." 351 "Temporary file for rotate operations."
352 :type 'string 352 :type 'string
353 :group 'tumme) 353 :group 'tumme)
354 354
@@ -361,14 +361,14 @@ original file with `tumme-temp-rotate-image-file'."
361 361
362(defcustom tumme-cmd-write-exif-data-program 362(defcustom tumme-cmd-write-exif-data-program
363 "exiftool" 363 "exiftool"
364 "*Program used to write EXIF data to image. 364 "Program used to write EXIF data to image.
365Used together with `tumme-cmd-write-exif-data-options'." 365Used together with `tumme-cmd-write-exif-data-options'."
366 :type 'string 366 :type 'string
367 :group 'tumme) 367 :group 'tumme)
368 368
369(defcustom tumme-cmd-write-exif-data-options 369(defcustom tumme-cmd-write-exif-data-options
370 "%p -%t=\"%v\" \"%f\"" 370 "%p -%t=\"%v\" \"%f\""
371 "*Format of command used to write EXIF data. 371 "Format of command used to write EXIF data.
372Available options are %p which is replaced by 372Available options are %p which is replaced by
373`tumme-cmd-write-exif-data-program', %f which is replaced by the 373`tumme-cmd-write-exif-data-program', %f which is replaced by the
374image file name, %t which is replaced by the tag name and %v 374image file name, %t which is replaced by the tag name and %v
@@ -378,14 +378,14 @@ which is replaced by the tag value."
378 378
379(defcustom tumme-cmd-read-exif-data-program 379(defcustom tumme-cmd-read-exif-data-program
380 "exiftool" 380 "exiftool"
381 "*Program used to read EXIF data to image. 381 "Program used to read EXIF data to image.
382Used together with `tumme-cmd-read-exif-data-program-options'." 382Used together with `tumme-cmd-read-exif-data-program-options'."
383 :type 'string 383 :type 'string
384 :group 'tumme) 384 :group 'tumme)
385 385
386(defcustom tumme-cmd-read-exif-data-options 386(defcustom tumme-cmd-read-exif-data-options
387 "%p -s -s -s -%t \"%f\"" 387 "%p -s -s -s -%t \"%f\""
388 "*Format of command used to read EXIF data. 388 "Format of command used to read EXIF data.
389Available options are %p which is replaced by 389Available options are %p which is replaced by
390`tumme-cmd-write-exif-data-options', %f which is replaced 390`tumme-cmd-write-exif-data-options', %f which is replaced
391by the image file name and %t which is replaced by the tag name." 391by the image file name and %t which is replaced by the tag name."
@@ -394,7 +394,7 @@ by the image file name and %t which is replaced by the tag name."
394 394
395(defcustom tumme-gallery-hidden-tags 395(defcustom tumme-gallery-hidden-tags
396 (list "private" "hidden" "pending") 396 (list "private" "hidden" "pending")
397 "*List of \"hidden\" tags. 397 "List of \"hidden\" tags.
398Used by `tumme-gallery-generate' to leave out \"hidden\" images." 398Used by `tumme-gallery-generate' to leave out \"hidden\" images."
399 :type '(repeat string) 399 :type '(repeat string)
400 :group 'tumme) 400 :group 'tumme)
@@ -416,18 +416,18 @@ This is the default size for both `tumme-thumb-width' and `tumme-thumb-height'."
416 :group 'tumme) 416 :group 'tumme)
417 417
418(defcustom tumme-thumb-relief 2 418(defcustom tumme-thumb-relief 2
419 "*Size of button-like border around thumbnails." 419 "Size of button-like border around thumbnails."
420 :type 'integer 420 :type 'integer
421 :group 'tumme) 421 :group 'tumme)
422 422
423(defcustom tumme-thumb-margin 2 423(defcustom tumme-thumb-margin 2
424 "*Size of the margin around thumbnails. 424 "Size of the margin around thumbnails.
425This is where you see the cursor." 425This is where you see the cursor."
426 :type 'integer 426 :type 'integer
427 :group 'tumme) 427 :group 'tumme)
428 428
429(defcustom tumme-line-up-method 'dynamic 429(defcustom tumme-line-up-method 'dynamic
430 "*Default method for line-up of thumbnails in thumbnail buffer. 430 "Default method for line-up of thumbnails in thumbnail buffer.
431Used by `tumme-display-thumbs' and other functions that needs to 431Used by `tumme-display-thumbs' and other functions that needs to
432line-up thumbnails. Dynamic means to use the available width of the 432line-up thumbnails. Dynamic means to use the available width of the
433window containing the thumbnail buffer, Fixed means to use 433window containing the thumbnail buffer, Fixed means to use
@@ -441,19 +441,19 @@ line-up means that no automatic line-up will be done."
441 :group 'tumme) 441 :group 'tumme)
442 442
443(defcustom tumme-thumbs-per-row 3 443(defcustom tumme-thumbs-per-row 3
444 "*Number of thumbnails to display per row in thumb buffer." 444 "Number of thumbnails to display per row in thumb buffer."
445 :type 'integer 445 :type 'integer
446 :group 'tumme) 446 :group 'tumme)
447 447
448(defcustom tumme-display-window-width-correction 1 448(defcustom tumme-display-window-width-correction 1
449 "*Number to be used to correct image display window width. 449 "Number to be used to correct image display window width.
450Change if the default (1) does not work (i.e. if the image does not 450Change if the default (1) does not work (i.e. if the image does not
451completely fit)." 451completely fit)."
452 :type 'integer 452 :type 'integer
453 :group 'tumme) 453 :group 'tumme)
454 454
455(defcustom tumme-display-window-height-correction 0 455(defcustom tumme-display-window-height-correction 0
456 "*Number to be used to correct image display window height. 456 "Number to be used to correct image display window height.
457Change if the default (0) does not work (i.e. if the image does not 457Change if the default (0) does not work (i.e. if the image does not
458completely fit)." 458completely fit)."
459 :type 'integer 459 :type 'integer
@@ -487,7 +487,7 @@ dired and you might want to turn it off."
487 :group 'tumme) 487 :group 'tumme)
488 488
489(defcustom tumme-display-properties-format "%b: %f (%t): %c" 489(defcustom tumme-display-properties-format "%b: %f (%t): %c"
490 "*Display format for thumbnail properties. 490 "Display format for thumbnail properties.
491%b is replaced with associated dired buffer name, %f with file name 491%b is replaced with associated dired buffer name, %f with file name
492\(without path) of original image file, %t with the list of tags and %c 492\(without path) of original image file, %t with the list of tags and %c
493with the comment." 493with the comment."
@@ -500,20 +500,20 @@ with the comment."
500 (cond ((executable-find "display")) 500 (cond ((executable-find "display"))
501 ((executable-find "xli")) 501 ((executable-find "xli"))
502 ((executable-find "qiv") "qiv -t")) 502 ((executable-find "qiv") "qiv -t"))
503 "*Name of external viewer. 503 "Name of external viewer.
504Including parameters. Used when displaying original image from 504Including parameters. Used when displaying original image from
505`tumme-thumbnail-mode'." 505`tumme-thumbnail-mode'."
506 :type 'string 506 :type 'string
507 :group 'tumme) 507 :group 'tumme)
508 508
509(defcustom tumme-main-image-directory "~/pics/" 509(defcustom tumme-main-image-directory "~/pics/"
510 "*Name of main image directory, if any. 510 "Name of main image directory, if any.
511Used by `tumme-copy-with-exif-file-name'." 511Used by `tumme-copy-with-exif-file-name'."
512 :type 'string 512 :type 'string
513 :group 'tumme) 513 :group 'tumme)
514 514
515(defcustom tumme-show-all-from-dir-max-files 50 515(defcustom tumme-show-all-from-dir-max-files 50
516 "*Maximum number of files to show using `tumme-show-all-from-dir'. 516 "Maximum number of files to show using `tumme-show-all-from-dir'.
517before warning the user." 517before warning the user."
518 :type 'integer 518 :type 'integer
519 :group 'tumme) 519 :group 'tumme)
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 901fac01208..e4b54f9fc92 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,20 @@
12006-08-25 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * url-handlers.el (url-file-local-copy): Tell url-copy-file that the
4 dest file will already exist.
5
62006-07-31 Stefan Monnier <monnier@iro.umontreal.ca>
7
8 * url-util.el (url-hexify-string): Only utf-8 encode if it's
9 a multibyte string.
10 (url-normalize-url): Remove unused var `grok'.
11 (url-truncate-url-for-viewing): Remove unused var `tail'.
12
132006-07-30 Thien-Thi Nguyen <ttn@gnu.org>
14
15 * url-util.el (url-hexify-string): Rewrite.
16 Suggested by David Smith <davidsmith@acm.org>.
17
12006-07-12 Michael Olson <mwolson@gnu.org> 182006-07-12 Michael Olson <mwolson@gnu.org>
2 19
3 * url-irc.el (url-irc-erc): Call erc-handle-irc-url. 20 * url-irc.el (url-irc-erc): Call erc-handle-irc-url.
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 6c6d85a1e03..97d10003620 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -213,7 +213,7 @@ A prefix arg makes KEEP-TIME non-nil."
213Returns the name of the local copy, or nil, if FILE is directly 213Returns the name of the local copy, or nil, if FILE is directly
214accessible." 214accessible."
215 (let ((filename (make-temp-file "url"))) 215 (let ((filename (make-temp-file "url")))
216 (url-copy-file url filename) 216 (url-copy-file url filename 'ok-if-already-exists)
217 filename)) 217 filename))
218 218
219(defun url-insert (buffer &optional beg end) 219(defun url-insert (buffer &optional beg end)
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index f33a58950fc..0aeb141c017 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -163,7 +163,7 @@ Also replaces the \" character, so that the result may be safely used as
163(defun url-normalize-url (url) 163(defun url-normalize-url (url)
164 "Return a 'normalized' version of URL. 164 "Return a 'normalized' version of URL.
165Strips out default port numbers, etc." 165Strips out default port numbers, etc."
166 (let (type data grok retval) 166 (let (type data retval)
167 (setq data (url-generic-parse-url url) 167 (setq data (url-generic-parse-url url)
168 type (url-type data)) 168 type (url-type data))
169 (if (member type '("www" "about" "mailto" "info")) 169 (if (member type '("www" "about" "mailto" "info"))
@@ -352,17 +352,31 @@ forbidden in URL encoding."
352This is taken from RFC 2396.") 352This is taken from RFC 2396.")
353 353
354;;;###autoload 354;;;###autoload
355(defun url-hexify-string (str) 355(defun url-hexify-string (string)
356 "Escape characters in a string." 356 "Return a new string that is STRING URI-encoded.
357 (mapconcat 357First, STRING is converted to utf-8, if necessary. Then, for each
358 (lambda (char) 358character in the utf-8 string, those found in `url-unreserved-chars'
359 ;; Fixme: use a char table instead. 359are left as-is, all others are represented as a three-character
360 (if (not (memq char url-unreserved-chars)) 360string: \"%\" followed by two lowercase hex digits."
361 (if (> char 255) 361 ;; To go faster and avoid a lot of consing, we could do:
362 (error "Hexifying multibyte character %s" str) 362 ;;
363 (format "%%%02X" char)) 363 ;; (defconst url-hexify-table
364 (char-to-string char))) 364 ;; (let ((map (make-vector 256 nil)))
365 str "")) 365 ;; (dotimes (byte 256) (aset map byte
366 ;; (if (memq byte url-unreserved-chars)
367 ;; (char-to-string byte)
368 ;; (format "%%%02x" byte))))
369 ;; map))
370 ;;
371 ;; (mapconcat (curry 'aref url-hexify-table) ...)
372 (mapconcat (lambda (byte)
373 (if (memq byte url-unreserved-chars)
374 (char-to-string byte)
375 (format "%%%02x" byte)))
376 (if (multibyte-string-p string)
377 (encode-coding-string string 'utf-8)
378 string)
379 ""))
366 380
367;;;###autoload 381;;;###autoload
368(defun url-file-extension (fname &optional x) 382(defun url-file-extension (fname &optional x)
@@ -389,7 +403,6 @@ then return the basename of the file with the extension stripped off."
389WIDTH defaults to the current frame width." 403WIDTH defaults to the current frame width."
390 (let* ((fr-width (or width (frame-width))) 404 (let* ((fr-width (or width (frame-width)))
391 (str-width (length url)) 405 (str-width (length url))
392 (tail (file-name-nondirectory url))
393 (fname nil) 406 (fname nil)
394 (modified 0) 407 (modified 0)
395 (urlobj nil)) 408 (urlobj nil))
@@ -397,8 +410,7 @@ WIDTH defaults to the current frame width."
397 (if (and (>= str-width fr-width) 410 (if (and (>= str-width fr-width)
398 (string-match "?" url)) 411 (string-match "?" url))
399 (setq url (concat (substring url 0 (match-beginning 0)) "?...") 412 (setq url (concat (substring url 0 (match-beginning 0)) "?...")
400 str-width (length url) 413 str-width (length url)))
401 tail (file-name-nondirectory url)))
402 (if (< str-width fr-width) 414 (if (< str-width fr-width)
403 nil ; Hey, we are done! 415 nil ; Hey, we are done!
404 (setq urlobj (url-generic-parse-url url) 416 (setq urlobj (url-generic-parse-url url)
diff --git a/lisp/wdired.el b/lisp/wdired.el
index 1363181524c..bc70e0ddcfd 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -238,6 +238,8 @@ in disk.
238 238
239See `wdired-mode'." 239See `wdired-mode'."
240 (interactive) 240 (interactive)
241 (or (eq major-mode 'dired-mode)
242 (error "Not a Dired buffer"))
241 (set (make-local-variable 'wdired-old-content) 243 (set (make-local-variable 'wdired-old-content)
242 (buffer-substring (point-min) (point-max))) 244 (buffer-substring (point-min) (point-max)))
243 (set (make-local-variable 'wdired-old-point) (point)) 245 (set (make-local-variable 'wdired-old-point) (point))
@@ -328,6 +330,8 @@ non-nil means return old filename."
328 330
329(defun wdired-change-to-dired-mode () 331(defun wdired-change-to-dired-mode ()
330 "Change the mode back to dired." 332 "Change the mode back to dired."
333 (or (eq major-mode 'wdired-mode)
334 (error "Not a Wdired buffer"))
331 (let ((inhibit-read-only t)) 335 (let ((inhibit-read-only t))
332 (remove-text-properties (point-min) (point-max) 336 (remove-text-properties (point-min) (point-max)
333 '(read-only nil local-map nil))) 337 '(read-only nil local-map nil)))
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 449606607f6..bb829278ef3 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -518,13 +518,15 @@ and:
518;;;###autoload 518;;;###autoload
519(defun whitespace-cleanup () 519(defun whitespace-cleanup ()
520 "Cleanup the five different kinds of whitespace problems. 520 "Cleanup the five different kinds of whitespace problems.
521It normally applies to the whole buffer, but in Transient Mark mode
522when the mark is active it applies to the region.
521See `whitespace-buffer' docstring for a summary of the problems." 523See `whitespace-buffer' docstring for a summary of the problems."
522 (interactive) 524 (interactive)
523 (if (and transient-mark-mode mark-active) 525 (if (and transient-mark-mode mark-active)
524 (whitespace-cleanup-region (region-beginning) (region-end)) 526 (whitespace-cleanup-region (region-beginning) (region-end))
525 (whitespace-cleanup-internal))) 527 (whitespace-cleanup-internal)))
526 528
527(defun whitespace-cleanup-internal () 529(defun whitespace-cleanup-internal (&optional region-only)
528 ;; If this buffer really contains a file, then run, else quit. 530 ;; If this buffer really contains a file, then run, else quit.
529 (whitespace-check-whitespace-mode current-prefix-arg) 531 (whitespace-check-whitespace-mode current-prefix-arg)
530 (if (and buffer-file-name whitespace-mode) 532 (if (and buffer-file-name whitespace-mode)
@@ -569,9 +571,12 @@ See `whitespace-buffer' docstring for a summary of the problems."
569 ;; Call this recursively till everything is taken care of 571 ;; Call this recursively till everything is taken care of
570 (if whitespace-any 572 (if whitespace-any
571 (whitespace-cleanup-internal) 573 (whitespace-cleanup-internal)
574 ;; if we are done, talk to the user
572 (progn 575 (progn
573 (if (not whitespace-silent) 576 (unless whitespace-silent
574 (message "%s clean" buffer-file-name)) 577 (if region-only
578 (message "The region is now clean")
579 (message "%s is now clean" buffer-file-name)))
575 (whitespace-update-modeline))) 580 (whitespace-update-modeline)))
576 (setq tab-width whitespace-tabwith-saved)))) 581 (setq tab-width whitespace-tabwith-saved))))
577 582
@@ -582,7 +587,7 @@ See `whitespace-buffer' docstring for a summary of the problems."
582 (save-excursion 587 (save-excursion
583 (save-restriction 588 (save-restriction
584 (narrow-to-region s e) 589 (narrow-to-region s e)
585 (whitespace-cleanup-internal)) 590 (whitespace-cleanup-internal t))
586 (whitespace-buffer t))) 591 (whitespace-buffer t)))
587 592
588(defun whitespace-buffer-leading () 593(defun whitespace-buffer-leading ()
diff --git a/lisp/window.el b/lisp/window.el
index 2ae1a2c9e79..7810ba4c5be 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -246,9 +246,10 @@ then the smallest tree containing that window is returned."
246 (windowp window-or-frame)) 246 (windowp window-or-frame))
247 (error "Not a frame or window: %s" window-or-frame))) 247 (error "Not a frame or window: %s" window-or-frame)))
248 (let ((subtree (bw-find-tree-sub window-or-frame))) 248 (let ((subtree (bw-find-tree-sub window-or-frame)))
249 (if (integerp subtree) 249 (when subtree
250 nil 250 (if (integerp subtree)
251 (bw-get-tree-1 subtree)))) 251 nil
252 (bw-get-tree-1 subtree)))))
252 253
253(defun bw-get-tree-1 (split) 254(defun bw-get-tree-1 (split)
254 (if (windowp split) 255 (if (windowp split)
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 04ef4f0b6dc..717fcf207da 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -122,6 +122,12 @@ any protocol specific data.")
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 (when (eq 'x (window-system frame)) 124 (when (eq 'x (window-system frame))
125 (x-register-dnd-atom "DndProtocol" frame)
126 (x-register-dnd-atom "_MOTIF_DRAG_AND_DROP_MESSAGE" frame)
127 (x-register-dnd-atom "XdndEnter" frame)
128 (x-register-dnd-atom "XdndPosition" frame)
129 (x-register-dnd-atom "XdndLeave" frame)
130 (x-register-dnd-atom "XdndDrop" frame)
125 (x-dnd-init-xdnd-for-frame frame) 131 (x-dnd-init-xdnd-for-frame frame)
126 (x-dnd-init-motif-for-frame frame))) 132 (x-dnd-init-motif-for-frame frame)))
127 133
@@ -320,7 +326,8 @@ nil if not."
320 ;; If dropping in an ordinary window which we could use, 326 ;; If dropping in an ordinary window which we could use,
321 ;; let dnd-open-file-other-window specify what to do. 327 ;; let dnd-open-file-other-window specify what to do.
322 (progn 328 (progn
323 (goto-char (posn-point (event-start event))) 329 (when (not mouse-yank-at-point)
330 (goto-char (posn-point (event-start event))))
324 (funcall handler window action data)) 331 (funcall handler window action data))
325 ;; If we can't display the file here, 332 ;; If we can't display the file here,
326 ;; make a new window for it. 333 ;; make a new window for it.