aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorKaroly Lorentey2005-04-04 16:43:15 +0000
committerKaroly Lorentey2005-04-04 16:43:15 +0000
commitee00ea6e18c2aeae86e262fae703f67f4705032a (patch)
tree9e7fc6bfb33de2b2f861589a2f7674ad35de85a8 /lisp
parent4a932511428a2b61ec51deebd6e16ec1efbda800 (diff)
parent8c6ef2ca34c444c1dea1f11b999b4b2ec16cdea3 (diff)
downloademacs-ee00ea6e18c2aeae86e262fae703f67f4705032a.tar.gz
emacs-ee00ea6e18c2aeae86e262fae703f67f4705032a.zip
Merged from miles@gnu.org--gnu-2005 (patch 45-55, 214-231)
Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-214 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-215 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-216 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-217 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-218 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-219 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-220 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-221 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-222 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-223 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-224 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-225 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-226 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-227 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-228 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-229 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-230 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-231 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-45 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-46 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-47 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-48 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-49 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-50 Update from CVS: texi Makefile.in CVS keyw cruft * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-51 Update from CVS: ChangeLog tweaks * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-52 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-53 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-54 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-55 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-324
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog509
-rw-r--r--lisp/add-log.el14
-rw-r--r--lisp/autorevert.el6
-rw-r--r--lisp/battery.el2
-rw-r--r--lisp/bookmark.el12
-rw-r--r--lisp/calc/calc-embed.el56
-rw-r--r--lisp/calc/calc-graph.el14
-rw-r--r--lisp/calc/calc-help.el10
-rw-r--r--lisp/calc/calc-lang.el12
-rw-r--r--lisp/calc/calc.el123
-rw-r--r--lisp/calendar/appt.el9
-rw-r--r--lisp/calendar/cal-china.el4
-rw-r--r--lisp/calendar/cal-coptic.el4
-rw-r--r--lisp/calendar/cal-french.el4
-rw-r--r--lisp/calendar/cal-hebrew.el4
-rw-r--r--lisp/calendar/cal-islam.el4
-rw-r--r--lisp/calendar/cal-iso.el4
-rw-r--r--lisp/calendar/cal-julian.el4
-rw-r--r--lisp/calendar/cal-mayan.el4
-rw-r--r--lisp/calendar/cal-persia.el4
-rw-r--r--lisp/calendar/cal-x.el13
-rw-r--r--lisp/calendar/calendar.el8
-rw-r--r--lisp/calendar/holidays.el4
-rw-r--r--lisp/calendar/lunar.el4
-rw-r--r--lisp/calendar/solar.el4
-rw-r--r--lisp/calendar/time-date.el4
-rw-r--r--lisp/complete.el5
-rw-r--r--lisp/desktop.el6
-rw-r--r--lisp/diff-mode.el10
-rw-r--r--lisp/dired.el2
-rw-r--r--lisp/ediff-hook.el16
-rw-r--r--lisp/emacs-lisp/autoload.el2
-rw-r--r--lisp/emacs-lisp/debug.el100
-rw-r--r--lisp/emacs-lisp/easy-mmode.el16
-rw-r--r--lisp/emacs-lisp/eldoc.el5
-rw-r--r--lisp/emulation/cua-base.el3
-rw-r--r--lisp/files.el43
-rw-r--r--lisp/filesets.el70
-rw-r--r--lisp/font-core.el2
-rw-r--r--lisp/font-lock.el2
-rw-r--r--lisp/generic-x.el99
-rw-r--r--lisp/generic.el74
-rw-r--r--lisp/gnus/ChangeLog112
-rw-r--r--lisp/gnus/gnus-group.el6
-rw-r--r--lisp/gnus/gnus-srvr.el19
-rw-r--r--lisp/gnus/gnus-sum.el2
-rw-r--r--lisp/gnus/message.el3
-rw-r--r--lisp/gnus/mm-util.el30
-rw-r--r--lisp/gnus/rfc2047.el641
-rw-r--r--lisp/hl-line.el4
-rw-r--r--lisp/ido.el30
-rw-r--r--lisp/iimage.el9
-rw-r--r--lisp/info.el8
-rw-r--r--lisp/international/characters.el4
-rw-r--r--lisp/international/encoded-kb.el2
-rw-r--r--lisp/international/mule-cmds.el3
-rw-r--r--lisp/international/mule-util.el1
-rw-r--r--lisp/international/mule.el1
-rw-r--r--lisp/kmacro.el11
-rw-r--r--lisp/language/thai-util.el51
-rw-r--r--lisp/language/thai-word.el54
-rw-r--r--lisp/language/thai.el7
-rw-r--r--lisp/longlines.el393
-rw-r--r--lisp/mail/rmail.el49
-rw-r--r--lisp/mail/supercite.el17
-rw-r--r--lisp/master.el24
-rw-r--r--lisp/menu-bar.el18
-rw-r--r--lisp/mouse.el28
-rw-r--r--lisp/msb.el6
-rw-r--r--lisp/obsolete/iso-acc.el (renamed from lisp/international/iso-acc.el)5
-rw-r--r--lisp/pcvs.el128
-rw-r--r--lisp/progmodes/compile.el9
-rw-r--r--lisp/progmodes/cwarn.el4
-rw-r--r--lisp/progmodes/f90.el29
-rw-r--r--lisp/progmodes/flymake.el4
-rw-r--r--lisp/progmodes/fortran.el183
-rw-r--r--lisp/progmodes/glasses.el4
-rw-r--r--lisp/progmodes/gud.el22
-rw-r--r--lisp/progmodes/hideif.el4
-rw-r--r--lisp/progmodes/python.el44
-rw-r--r--lisp/progmodes/scheme.el4
-rw-r--r--lisp/progmodes/tcl.el10
-rw-r--r--lisp/progmodes/which-func.el7
-rw-r--r--lisp/ps-mule.el39
-rw-r--r--lisp/ps-print.el21
-rw-r--r--lisp/register.el6
-rw-r--r--lisp/reveal.el5
-rw-r--r--lisp/simple.el64
-rw-r--r--lisp/smerge-mode.el4
-rw-r--r--lisp/startup.el31
-rw-r--r--lisp/textmodes/bibtex.el123
-rw-r--r--lisp/textmodes/enriched.el4
-rw-r--r--lisp/textmodes/fill.el13
-rw-r--r--lisp/textmodes/org.el453
-rw-r--r--lisp/textmodes/refill.el4
-rw-r--r--lisp/textmodes/sgml-mode.el2
-rw-r--r--lisp/textmodes/tex-mode.el13
-rw-r--r--lisp/tooltip.el24
-rw-r--r--lisp/url/ChangeLog4
-rw-r--r--lisp/url/url-handlers.el4
-rw-r--r--lisp/url/vc-dav.el8
-rw-r--r--lisp/vc-hooks.el4
-rw-r--r--lisp/vc.el8
-rw-r--r--lisp/wdired.el3
-rw-r--r--lisp/window.el21
-rw-r--r--lisp/xt-mouse.el7
106 files changed, 3098 insertions, 1052 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ac6f62b9a40..d5a58deb7e4 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,482 @@
12005-04-04 Lute Kamstra <lute@gnu.org>
2
3 * autorevert.el (auto-revert-mode): Specify :group.
4 * battery.el (display-battery-mode): Specify :group.
5 * diff-mode.el (diff-minor-mode): Specify :group.
6 * font-core.el (font-lock-mode): Specify :group.
7 * hl-line.el (hl-line-mode): Specify :group.
8 * iimage.el (iimage): New customization group.
9 (iimage-mode): Specify :group.
10 * longlines.el (longlines-mode): Specify :group.
11 * master.el: Don't require easy-mmode.
12 (master): New customization group.
13 (master-mode): Specify :group.
14 * msb.el (msb-mode): Specify :group.
15 * reveal.el (reveal-mode): Specify :group.
16 * simple.el (next-error-follow-minor-mode): Specify :group.
17 * smerge-mode.el (smerge-mode): Specify :group.
18 * emacs-lisp/eldoc.el (eldoc-mode): Specify :group.
19 * emulation/cua-base.el (cua-mode): Specify :group.
20 * international/encoded-kb.el (encoded-kbd-mode): Specify :group.
21 * language/thai-util.el (thai-auto-composition-mode)
22 (thai-word-mode): Specify :group.
23 * mail/supercite.el (sc-minor-mode): Specify :group.
24 * progmodes/cwarn.el (cwarn-mode): Specify :group.
25 * progmodes/flymake.el (flymake-mode): Specify :group.
26 * progmodes/glasses.el (glasses-mode): Specify :group.
27 * progmodes/hideif.el (hide-ifdef-mode): Specify :group.
28 * textmodes/enriched.el (enriched-mode): Specify :group.
29 * textmodes/refill.el (refill-mode): Specify :group.
30
31 * add-log.el (change-log-font-lock-keywords): Names in
32 parenthesized lists can contain spaces.
33
342005-04-04 Thien-Thi Nguyen <ttn@gnu.org>
35
36 * startup.el (fancy-splash-text): Shorten default text of
37 "Emacs Tutorial" line. Also, if the current language env
38 indicates an available tutorial file other than TUTORIAL,
39 extract its title and append it to the line in parentheses.
40 (fancy-splash-insert): If arg is a thunk, funcall it.
41
422005-04-04 Jay Belanger <belanger@truman.edu>
43
44 * calc.el (calc-language-alist): Add tags to customization type.
45
462005-04-03 Luc Teirlinck <teirllm@auburn.edu>
47
48 * xt-mouse.el (xterm-mouse-mode): Add explicit Custom group, mouse.
49 Doc fix.
50
512005-04-03 Marcelo Toledo <marcelo@marcelotoledo.org>
52
53 * add-log.el (change-log-font-lock-keywords): The manual
54 describing a Change Log entry, says: (...) "Aside from these
55 header lines, every line in the change log starts with a space or
56 a tab.". The font-lock was not highlighting lines started with
57 spaces, added support for it.
58
592005-04-03 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
60
61 * textmodes/bibtex.el (bibtex-url): Use format to generate the url.
62 (bibtex-generate-url-list): Update docstring accordingly. Put the
63 complex example in the docstring.
64 (bibtex-font-lock-url): Use pop.
65
662005-04-03 Stefan Monnier <monnier@iro.umontreal.ca>
67
68 * progmodes/tcl.el (tcl-set-font-lock-keywords): Use new \_< ops.
69
70 * pcvs.el (cvs-checkout): Prompt for cvsroot as well.
71
722005-04-03 Glenn Morris <gmorris@ast.cam.ac.uk>
73
74 * filesets.el (filesets-set-default): Doc fix.
75
762005-04-03 Lute Kamstra <lute@gnu.org>
77
78 * generic.el (define-generic-mode): Add argument to specify
79 keywords for defcustom.
80 (default-generic-mode): Specify :group.
81
82 * generic-x.el: Specify :group for all generic modes.
83
84 * desktop.el (desktop-no-desktop-file-hook)
85 (desktop-after-read-hook): Fix docstring.
86
872005-04-02 Luc Teirlinck <teirllm@auburn.edu>
88
89 * simple.el (visible-mode): Use explicit :group keyword.
90 This changes the group of `visible-mode-hook' from paren-blinking
91 to editing-basics.
92
932005-04-02 Sergey Poznyakoff <gray@Mirddin.farlep.net> (tiny change)
94
95 * mail/rmail.el (rmail-parse-url): Bugfix. Parse traditional
96 mailbox specifications as well as URLs.
97 (rmail-insert-inbox-text): Remove unused conditional branches.
98
992005-04-01 Jay Belanger <belanger@truman.edu>
100
101 * calc/calc-graph.el (calc-gnuplot-name, calc-gnuplot-plot-command)
102 (calc-gnuplot-print-command): Move definitions to calc.el.
103
104 * calc/calc-embed.el (calc-embedded-announce-formula)
105 (calc-embedded-open-formula, calc-embedded-close-formula)
106 (calc-embedded-open-word, calc-embedded-close-word)
107 (calc-embedded-open-plain, calc-embedded-close-plain)
108 (calc-embedded-open-new-formula, calc-embedded-close-new-formula)
109 (calc-embedded-open-mode, calc-embedded-close-mode):
110 Move definitions to calc.el.
111
112 * calc/calc.el (calc-settings-file, calc-language-alist):
113 Make customizable.
114 (calc-embedded-announce-formula, calc-embedded-open-formula)
115 (calc-embedded-close-formula, calc-embedded-open-word)
116 (calc-embedded-close-word, calc-embedded-open-plain)
117 (calc-embedded-close-plain, calc-embedded-open-new-formula)
118 (calc-embedded-close-new-formula, calc-embedded-open-mode)
119 (calc-embedded-close-mode, calc-gnuplot-name)
120 (calc-gnuplot-plot-command, calc-gnuplot-print-command): Move here
121 from other files and make customizable.
122
1232005-04-01 Stefan Monnier <monnier@iro.umontreal.ca>
124
125 * pcvs.el (cvs-temp-buffer, cvs-mode-kill-process, cvs-buffer-check):
126 Use buffer-live-p.
127 (cvs-mode-run): Don't call cvs-update-header here.
128 (cvs-run-process): Call cvs-update-header.
129 Use process properties for cvs-postprocess and cvs-buffer so that
130 the sentinel can behave better if the temp buffer is killed.
131 Use a pipe rather than a tty, to better handle unexpected prompts.
132 (cvs-sentinel): Rewrite. Call cvs-update-header.
133
1342005-04-01 Andre Spiegel <spiegel@gnu.org>
135
136 * vc-hooks.el (vc-workfile-unchanged-p): Disable mtime check when
137 we go via Tramp or Ange-FTP. Suggested by Kai Grossjohann.
138
1392005-03-31 Stefan Monnier <monnier@iro.umontreal.ca>
140
141 * generic.el (define-generic-mode): Add indentation rule.
142
1432005-03-31 Luc Teirlinck <teirllm@auburn.edu>
144
145 * files.el (mode-require-final-newline): Make Custom correctly
146 report a nil value and allow to set it to nil via Custom.
147 Doc fix.
148
1492005-04-01 Kenichi Handa <handa@m17n.org>
150
151 * international/characters.el: Enable the correct case setting for
152 dotless-i and dotted-I.
153
1542005-04-01 Kim F. Storm <storm@cua.dk>
155
156 * ido.el (ido-file-internal): Fall back to non-ido command if
157 initial directory is on slow ftp (or tramp) host.
158
1592005-03-31 Richard M. Stallman <rms@gnu.org>
160
161 * emacs-lisp/autoload.el (make-autoload):
162 Handle define-global-minor-mode.
163
164 * emacs-lisp/easy-mmode.el (define-global-minor-mode):
165 Rename from easy-mmode-define-global-mode.
166 (easy-mmode-define-global-mode): Alias for define-global-minor-mode.
167
168 * progmodes/scheme.el (scheme-mode-syntax-table):
169 Update syntax of | and # for two-character comment syntax.
170
1712005-03-31 Lute Kamstra <lute@gnu.org>
172
173 * emacs-lisp/easy-mmode.el (easy-mmode-define-global-mode)
174 (define-minor-mode): Call custom-current-group at load-time.
175
176 * generic.el (define-generic-mode): Add debug declaration.
177 Add defcustom for the mode hook.
178 (generic-mode-internal): Use run-mode-hooks.
179
1802005-03-31 Kim F. Storm <storm@cua.dk>
181
182 * mouse.el (mouse-1-click-follows-link): Increase to 450 ms.
183 (mouse-fixup-help-message): New defun called by show_help_echo
184 to fixup mouse-2 prefix in help messages when applicable.
185
186 * tooltip.el (tooltip-show-help-function): Don't fixup message here.
187
1882005-03-31 Kenichi Handa <handa@m17n.org>
189
190 * language/thai-word.el (thai-find-word-ends): Pay attention to
191 the case that we reach the end of buffer.
192
193 * textmodes/fill.el (fill-text-properties-at): New function.
194 (fill-newline): Use fill-text-properties-at instead of
195 text-properties-at.
196
1972005-03-31 Karl Berry <karl@freefriends.org>
198
199 * textmodes/tex-mode.el (tex-compile): shell-quote-argument,
200 not comint-quote-filename.
201
2022005-03-31 Olive Lin <olive.lin@versateladsl.be> (tiny change)
203
204 * textmodes/tex-mode.el (tex-start-tex) shell-quote-argument,
205 not comint-quote-filename.
206
2072005-03-31 Thien-Thi Nguyen <ttn@gnu.org>
208
209 * help-fns.el (help-with-tutorial): Revert last change.
210
2112005-03-31 Kim F. Storm <storm@cua.dk>
212
213 * emulation/cua-base.el (cua-scroll-down): Add CUA property.
214
2152005-03-30 Paul Eggert <eggert@cs.ucla.edu>
216
217 * calendar/cal-china.el: Update reference to "Calendrical
218 Calculations" book; there's a new edition.
219 * calendar/cal-coptic.el: Likewise.
220 * calendar/cal-french.el: Likewise.
221 * calendar/cal-hebrew.el: Likewise.
222 * calendar/cal-islam.el: Likewise.
223 * calendar/cal-iso.el: Likewise.
224 * calendar/cal-julian.el: Likewise.
225 * calendar/cal-mayan.el: Likewise.
226 * calendar/cal-persia.el: Likewise.
227 * calendar/calendar.el: Likewise.
228 * calendar/holidays.el: Likewise.
229 * calendar/lunar.el: Likewise.
230 * calendar/solar.el: Likewise.
231
232 * calendar/calendar.el (calendar-day-abbrev-array): Remove trailing
233 white space from doc string.
234
2352005-03-30 Jay Belanger <belanger@truman.edu>
236
237 * calc/calc-help.el (calc-full-help): Remove email address.
238
2392005-03-30 Thien-Thi Nguyen <ttn@gnu.org>
240
241 * help-fns.el (help-with-tutorial): Delete title line.
242
2432005-03-30 Glenn Morris <gmorris@ast.cam.ac.uk>
244
245 * calendar/cal-x.el (calendar-one-frame-setup)
246 (calendar-only-one-frame-setup, calendar-two-frame-setup): Use t
247 rather than 'symbol for set-window-dedicated-p.
248
249 * calendar/appt.el (appt-buffer-name): Make it a constant.
250 (appt-add): Doc fix.
251
252 * filesets.el (filesets-menu-path, filesets-menu-before)
253 (filesets-menu-in-menu): Doc fix. Now valid in GNU Emacs.
254 (filesets-menu-cache-file): Use directory ~/.emacs.d.
255 (filesets-add-submenu): Delete and use add-submenu instead.
256
2572005-03-30 Carsten Dominik <dominik@science.uva.nl>
258
259 * org.el (org-agenda-phases-of-moon, org-agenda-sunrise-sunset)
260 (org-agenda-convert-date, org-agenda-goto-calendar): New commands.
261 (org-diary-default-entry): New function.
262 (org-get-entries-from-diary): Better parsing of diary entries.
263 (org-agenda-check-no-diary): New function.
264 ("diary-lib"): Advice to function `add-to-diary-list', to allow
265 linking to diary entries.
266 (org-agenda-execute-calendar-command): New function.
267 (org-agenda): Improve visible section in window.
268 Use `org-fit-agenda-window'.
269 (org-fit-agenda-window): New option.
270 (org-move-subtree-down): Better handling of empty lines
271 at end of subtree.
272 (org-cycle): Numeric prefix is interpreted now as show-subtree N
273 levels up.
274 (org-fontify-done-headline): New option.
275 (org-headline-done-face): New face.
276 (org-set-font-lock-defaults): Use `org-headline-done-face'.
277 (org-table-copy-down): Rename from `org-table-copy-from-above'.
278 When current field is non-empty, it is copied to next row.
279 (org-table-copy-from-above): Fix bug which made it
280 impossible to copy fields containing only a single non-white character.
281
2822005-03-30 Kim F. Storm <storm@cua.dk>
283
284 * kmacro.el (kmacro-end-macro): Isearch may store this command
285 into the macro -- so ignore it when executing keyboard macro.
286
2872005-03-30 Nick Roberts <nickrob@snap.net.nz>
288
289 * tooltip.el (tooltip-gud-display): Use gud-overlay-arrow-position.
290
2912005-03-29 Kenichi Handa <handa@m17n.org>
292
293 * language/thai.el ("Thai"): Set setup-function and exit-function
294 for Thai language environment.
295
296 * language/thai-util.el: Require thai-word.
297 (thai-word-mode-map): New variable.
298 (thai-word-mode): New minor mode.
299 (setup-thai-language-environment-internal): New function.
300 (exit-thai-language-environment-internal): New function.
301
302 * language/thai-word.el (thai-word-table): Declare it by defvar,
303 use dolist to initialize it.
304 (thai-kill-word, thai-backward-kill-word, thai-transpose-words)
305 (thai-fill-find-break-point): New functions.
306
3072005-03-29 Richard M. Stallman <rms@gnu.org>
308
309 * simple.el (idle-update-delay): Move definition up.
310 (set-mark): Doc fix.
311
3122005-03-29 Chong Yidong <cyd@stupidchicken.com>
313
314 * longlines.el: New file.
315
316 * simple.el (buffer-substring-filters): New variable.
317 (filter-buffer-substring): New function.
318 (kill-region, copy-region-as-kill): Use it.
319
320 * register.el (copy-to-register, append-to-register)
321 (prepend-to-register): Use filter-buffer-substring.
322
3232005-03-30 Nick Roberts <nickrob@snap.net.nz>
324
325 * progmodes/gud.el (gdb): (Re)-initialise gud-filter-pending-text.
326 (gud-filter-pending-text): Move in front of gdb.
327 (gud-overlay-arrow-position): New variable.
328 (gud-sentinel, gud-display-line): Use it in place of
329 overlay-arrow-position.
330
3312005-03-29 Glenn Morris <gmorris@ast.cam.ac.uk>
332
333 * progmodes/fortran.el (fortran-if-indent): Doc fix.
334 (fortran-font-lock-keywords-2): Add "where", "elsewhere".
335 (fortran-font-lock-keywords-4): New variable.
336 (fortran-blocks-re, fortran-end-block-re)
337 (fortran-start-block-re): New constants, for hideshow.
338 (hs-special-modes-alist): Add a Fortran entry.
339 (fortran-mode-map): Bind fortran-end-of-block,
340 fortran-beginning-of-block to \M-\C-n, \M-\C-p.
341 (fortran-mode): Doc fix. Add fortran-font-lock-keywords-4.
342 (fortran-looking-at-if-then, fortran-end-of-block)
343 (fortran-beginning-of-block): New functions, for hideshow.
344
345 * progmodes/f90.el (f90-end-block-re, f90-start-block-re): Doc
346 fix. Tweak regexp.
347 (f90-beginning-of-block): Push mark first.
348
3492005-03-29 Jay Belanger <belanger@truman.edu>
350
351 * calc/calc.el: Update copyright date.
352 (calc-version): Increase to 2.1.
353 (calc-version-date): Remove.
354
355 * calc/calc-help.el: Update copyright date.
356 (calc-full-help): Remove reference to calc-version-date.
357 Update copyright date.
358
3592005-03-29 Stefan Monnier <monnier@iro.umontreal.ca>
360
361 * vc.el (vc-do-command): Use a pipe for async processes, so password
362 prompts don't show up at places where the user can't reply.
363
3642005-03-29 Olive Lin <olive.lin@versateladsl.be> (tiny change)
365
366 * textmodes/tex-mode.el (tex-send-command): shell-quote-argument
367 on the file name we pass to the inferior shell.
368
3692005-03-29 Stephan Stahl <stahl@eos.franken.de> (tiny change)
370
371 * progmodes/which-func.el (which-function): Be robust in the face of an
372 imenu--make-index-alist failure.
373
3742005-03-29 Stefan Monnier <monnier@iro.umontreal.ca>
375
376 * reveal.el (reveal-mode-map): Don't override C-a and C-e.
377
378 * progmodes/python.el (python-preoutput-filter): Fix last change.
379
3802005-03-29 Lute Kamstra <lute@gnu.org>
381
382 * emacs-lisp/debug.el (debug-on-entry): Handle autoloaded
383 functions and compiled macros.
384 (debug-convert-byte-code): Handle macros too.
385 (debug-on-entry-1): Don't signal an error when trying to clear a
386 function that is not set to debug on entry.
387
3882005-03-29 Jay Belanger <belanger@truman.edu>
389
390 * calc/calc-lang.el: Add functions to math-function-table
391 properties of tex and math.
392
3932005-03-29 Kenichi Handa <handa@m17n.org>
394
395 * ps-mule.el (ps-mule-plot-string): Translate characters by
396 ps-print-translation-table.
397 (ps-mule-begin-job): Call find-charset-region/string with
398 ps-print-translation-table.
399 (ps-mule-printable-p): Return t if CHARSET is ascii or latin-iso8859-1.
400
401 * ps-print.el (ps-print-translation-table): New variable.
402 (ps-plot-region): Translate characters by ps-print-translation-table.
403
4042005-03-29 Juri Linkov <juri@jurta.org>
405
406 * simple.el (next-error-highlight-timer): New variable.
407
408 * progmodes/compile.el (compilation-goto-locus):
409 Use `next-error-highlight-timer' instead of `sit-for'.
410
4112005-03-28 Stefan Monnier <monnier@iro.umontreal.ca>
412
413 * mail/supercite.el (sc-mail-field): Use assoc-string.
414 (sc-get-address): Simplify regexps.
415
416 * files.el (minibuffer-with-setup-hook): New macro.
417 (find-file-read-args): Use it to avoid let-binding
418 minibuffer-with-setup-hook (which breaks turning on/off
419 file-name-shadow-mode while in the prompt).
420
421 * complete.el (PC-read-include-file-name-internal): Use test-completion.
422
4232005-03-28 Luc Teirlinck <teirllm@auburn.edu>
424
425 * font-lock.el: Bind `font-lock-fontify-block' to M-o M-o.
426
4272005-03-28 Stefan Monnier <monnier@iro.umontreal.ca>
428
429 * window.el (window-buffer-height): Use count-screen-lines.
430
431 * progmodes/python.el (python-preoutput-leftover): New var.
432 (python-preoutput-filter): Use it.
433 (python-send-receive): Loop until all the result has been received.
434
4352005-03-28 Juri Linkov <juri@jurta.org>
436
437 * dired.el (dired-mode-map): Add ellipsis to "Compare directories".
438
439 * menu-bar.el (menu-bar-file-menu): Remove ellipsis from
440 "Recover Crashed Session".
441 (menu-bar-search-menu): Add ellipsis to "Search tagged files".
442 (menu-bar-replace-menu): Add ellipsis to "Replace in tagged files".
443 (menu-bar-goto-menu): Add ellipsis to "Set Tags File Name".
444 (menu-bar-goto-menu): Add ellipsis to "Tags Apropos".
445 (menu-bar-options-menu): Add ellipsis to "Set Font/Fontset".
446 (menu-bar-manuals-menu): Add ellipsis to "Find Command in Manual".
447 (menu-bar-manuals-menu): Add ellipsis to "Find Key in Manual".
448 (menu-bar-help-menu): Remove ellipsis from "Find Emacs Packages".
449
450 * ediff-hook.el (menu-bar-ediff-misc-menu, ediff-misc-menu):
451 Remove ellipsis from "Ediff Manual", "Customize Ediff", "List
452 Ediff Sessions", "Toggle use of separate control buffer frame",
453 "Use separate frame for Ediff control buffer".
454
455 * bookmark.el (menu-bar-bookmark-map): Add ellipsis to "Jump to
456 Bookmark", "Set Bookmark", "Insert Contents", "Insert Location",
457 "Rename Bookmark", "Delete Bookmark".
458
459 * info.el (Info-mode-menu): Remove ellipsis from "Index".
460 Add ellipsis to "Lookup a String", "Lookup a string in all indices".
461 Add `:active Info-index-alternatives' to "Next Matching Item".
462
463 * wdired.el (wdired-change-to-wdired-mode):
464 Mention `wdired-abort-changes' key in the initial message.
465
466 * international/mule.el (auto-coding-alist): Associate non-ascii
467 image filename extensions with `no-conversion'.
468
4692005-03-27 Stefan Monnier <monnier@iro.umontreal.ca>
470
471 * international/iso-acc.el:
472 * obsolete/iso-acc.el: Move iso-acc to the obsolete subdir.
473
4742005-03-26 Luc Teirlinck <teirllm@auburn.edu>
475
476 * textmodes/sgml-mode.el (html-mode): Doc update.
477
478 * autorevert.el (auto-revert-check-vc-info): Minor doc fix.
479
12005-03-26 Dan Nicolaescu <dann@ics.uci.edu> 4802005-03-26 Dan Nicolaescu <dann@ics.uci.edu>
2 481
3 * term.el (term-move-columns): Fix face after extending a line. 482 * term.el (term-move-columns): Fix face after extending a line.
@@ -345,8 +824,7 @@
345 824
3462005-03-21 Lute Kamstra <lute@gnu.org> 8252005-03-21 Lute Kamstra <lute@gnu.org>
347 826
348 * generic.el: Fix commentary section. Don't require cl for 827 * generic.el: Fix commentary section. Don't require cl for compilation.
349 compilation.
350 (generic-mode-list): Add autoload cookie. 828 (generic-mode-list): Add autoload cookie.
351 (generic-use-find-file-hook, generic-lines-to-scan) 829 (generic-use-find-file-hook, generic-lines-to-scan)
352 (generic-find-file-regexp, generic-ignore-files-regexp) 830 (generic-find-file-regexp, generic-ignore-files-regexp)
@@ -396,20 +874,27 @@
396 874
397 * tramp-smb.el (all): Remove debug construct for 875 * tramp-smb.el (all): Remove debug construct for
398 `with-parsed-tramp-file-name'. 876 `with-parsed-tramp-file-name'.
399 (tramp-smb-prompt): Prompt can contain spaces inside directory 877 (tramp-smb-prompt): Prompt can contain spaces inside directory names.
400 names.
401 (tramp-smb-handle-delete-directory, tramp-smb-handle-delete-file): 878 (tramp-smb-handle-delete-directory, tramp-smb-handle-delete-file):
402 No error message if DIRECTORY or FILENAME doesn't exist. 879 No error message if DIRECTORY or FILENAME doesn't exist.
403 (tramp-smb-open-connection): Check existence of 880 (tramp-smb-open-connection): Check existence of
404 `tramp-smb-program'. 881 `tramp-smb-program'.
405 882
8832005-03-20 Stefan Monnier <monnier@iro.umontreal.ca>
884
885 * progmodes/perl-mode.el (perl-font-lock-syntactic-face-function):
886 Properly handle the case where the `m' or `s' command's argument is not
887 yet terminated.
888 (perl-indent-new-calculate): New function.
889 (perl-indent-line): Use it.
890
4062005-03-20 Miles Bader <miles@gnu.org> 8912005-03-20 Miles Bader <miles@gnu.org>
407 892
408 * progmodes/gdb-ui.el (gdb-put-breakpoint-icon): Use breakpoint faces 893 * progmodes/gdb-ui.el (gdb-put-breakpoint-icon): Use breakpoint faces
409 in text-mode too. Change to new face names. 894 in text-mode too. Change to new face names.
410 (breakpoint-enabled): Renamed from `breakpoint-enabled-bitmap-face'. 895 (breakpoint-enabled): Rename from `breakpoint-enabled-bitmap-face'.
411 Add `:weight bold' attribute. 896 Add `:weight bold' attribute.
412 (breakpoint-disabled): Renamed from `breakpoint-disabled-bitmap-face'. 897 (breakpoint-disabled): Rename from `breakpoint-disabled-bitmap-face'.
413 898
4142005-03-19 Juri Linkov <juri@jurta.org> 8992005-03-19 Juri Linkov <juri@jurta.org>
415 900
@@ -426,8 +911,7 @@
426 911
4272005-03-19 Yoichi NAKAYAMA <yoichi@geiin.org> (tiny changes) 9122005-03-19 Yoichi NAKAYAMA <yoichi@geiin.org> (tiny changes)
428 913
429 * finder.el (finder-current-item): Throw an error on an empty 914 * finder.el (finder-current-item): Throw an error on an empty line.
430 line.
431 915
432 * man.el (Man-follow-manual-reference): If current-word returns 916 * man.el (Man-follow-manual-reference): If current-word returns
433 nil, use "". 917 nil, use "".
@@ -466,8 +950,8 @@
466 950
4672005-03-19 Vinicius Jose Latorre <viniciusjl@ig.com.br> 9512005-03-19 Vinicius Jose Latorre <viniciusjl@ig.com.br>
468 952
469 * ps-print.el (ps-generate-string-list, ps-generate-header-line): Use 953 * ps-print.el (ps-generate-string-list, ps-generate-header-line):
470 functionp instead of symbolp and fboundp. Reported by Drkm 954 Use functionp instead of symbolp and fboundp. Reported by Drkm
471 <darkman_spam@yahoo.fr>. 955 <darkman_spam@yahoo.fr>.
472 (ps-print-version): New version 6.6.6. 956 (ps-print-version): New version 6.6.6.
473 957
@@ -2290,7 +2774,7 @@
2290 * simple.el (eval-expression-print-format): Avoid warning 2774 * simple.el (eval-expression-print-format): Avoid warning
2291 about edebug-active. 2775 about edebug-active.
2292 2776
22932005-01-15 "James R. Van Zandt" <jrvz@comcast.net> (Tiny change) 27772005-01-15 James R. Van Zandt <jrvz@comcast.net> (Tiny change)
2294 2778
2295 * progmodes/sh-script.el: Code copied from make-mode.el 2779 * progmodes/sh-script.el: Code copied from make-mode.el
2296 with small changes, 2780 with small changes,
@@ -7012,8 +7496,7 @@
7012 7496
70132004-09-21 Kenichi Handa <handa@m17n.org> 74972004-09-21 Kenichi Handa <handa@m17n.org>
7014 7498
7015 * descr-text.el (describe-char): Checking of quail activation 7499 * descr-text.el (describe-char): Checking of quail activation fixed.
7016 fixed.
7017 7500
70182004-09-21 Jay Belanger <belanger@truman.edu> 75012004-09-21 Jay Belanger <belanger@truman.edu>
7019 7502
diff --git a/lisp/add-log.el b/lisp/add-log.el
index 7706a697755..126e7ecbaa5 100644
--- a/lisp/add-log.el
+++ b/lisp/add-log.el
@@ -1,7 +1,7 @@
1;;; add-log.el --- change log maintenance commands for Emacs 1;;; add-log.el --- change log maintenance commands for Emacs
2 2
3;; Copyright (C) 1985, 86, 88, 93, 94, 97, 98, 2000, 03, 2004 3;; Copyright (C) 1985, 1986, 1988, 1993, 1994, 1997, 1998, 2000, 2003,
4;; Free Software Foundation, Inc. 4;; 2004, 2005 Free Software Foundation, Inc.
5 5
6;; Maintainer: FSF 6;; Maintainer: FSF
7;; Keywords: tools 7;; Keywords: tools
@@ -225,20 +225,20 @@ Note: The search is conducted only within 10%, at the beginning of the file."
225 (2 'change-log-email-face))) 225 (2 'change-log-email-face)))
226 ;; 226 ;;
227 ;; File names. 227 ;; File names.
228 ("^\t\\* \\([^ ,:([\n]+\\)" 228 ("^\\(?: +\\|\t\\)\\* \\([^ ,:([\n]+\\)"
229 (1 'change-log-file-face) 229 (1 'change-log-file-face)
230 ;; Possibly further names in a list: 230 ;; Possibly further names in a list:
231 ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file-face)) 231 ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file-face))
232 ;; Possibly a parenthesized list of names: 232 ;; Possibly a parenthesized list of names:
233 ("\\= (\\([^() ,\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" 233 ("\\= (\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)"
234 nil nil (1 'change-log-list-face)) 234 nil nil (1 'change-log-list-face))
235 ("\\=, *\\([^() ,\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" 235 ("\\=, *\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)"
236 nil nil (1 'change-log-list-face))) 236 nil nil (1 'change-log-list-face)))
237 ;; 237 ;;
238 ;; Function or variable names. 238 ;; Function or variable names.
239 ("^\t(\\([^() ,\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" 239 ("^\t(\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)"
240 (1 'change-log-list-face) 240 (1 'change-log-list-face)
241 ("\\=, *\\([^() ,\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" nil nil 241 ("\\=, *\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" nil nil
242 (1 'change-log-list-face))) 242 (1 'change-log-list-face)))
243 ;; 243 ;;
244 ;; Conditionals. 244 ;; Conditionals.
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index d4a3d10d167..36b5a6f5a37 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -1,6 +1,6 @@
1;;; autorevert.el --- revert buffers when files on disk change 1;;; autorevert.el --- revert buffers when files on disk change
2 2
3;; Copyright (C) 1997, 1998, 1999, 2001, 2004 Free Software Foundation, Inc. 3;; Copyright (C) 1997, 1998, 1999, 2001, 2004, 2005 Free Software Foundation, Inc.
4 4
5;; Author: Anders Lindgren <andersl@andersl.com> 5;; Author: Anders Lindgren <andersl@andersl.com>
6;; Keywords: convenience 6;; Keywords: convenience
@@ -246,7 +246,7 @@ This currently works by automatically updating the version
246control info every `auto-revert-interval' seconds. Nevertheless, 246control info every `auto-revert-interval' seconds. Nevertheless,
247it should not cause excessive CPU usage on a reasonably fast 247it should not cause excessive CPU usage on a reasonably fast
248machine, if it does not apply to too many version controlled 248machine, if it does not apply to too many version controlled
249buffers. CPU usage depends on the version control system" 249buffers. CPU usage depends on the version control system."
250 :group 'auto-revert 250 :group 'auto-revert
251 :type 'boolean 251 :type 'boolean
252 :version "22.1") 252 :version "22.1")
@@ -290,7 +290,7 @@ This is a minor mode that affects only the current buffer.
290Use `global-auto-revert-mode' to automatically revert all buffers. 290Use `global-auto-revert-mode' to automatically revert all buffers.
291Use `auto-revert-tail-mode' if you know that the file will only grow 291Use `auto-revert-tail-mode' if you know that the file will only grow
292without being changed in the part that is already in the buffer." 292without being changed in the part that is already in the buffer."
293 nil auto-revert-mode-text nil 293 :group 'auto-revert :lighter auto-revert-mode-text
294 (if auto-revert-mode 294 (if auto-revert-mode
295 (if (not (memq (current-buffer) auto-revert-buffer-list)) 295 (if (not (memq (current-buffer) auto-revert-buffer-list))
296 (push (current-buffer) auto-revert-buffer-list)) 296 (push (current-buffer) auto-revert-buffer-list))
diff --git a/lisp/battery.el b/lisp/battery.el
index 69bd68bb0b9..42ceec0c90c 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -114,7 +114,7 @@ The text being displayed in the mode line is controlled by the variables
114`battery-mode-line-format' and `battery-status-function'. 114`battery-mode-line-format' and `battery-status-function'.
115The mode line will be updated automatically every `battery-update-interval' 115The mode line will be updated automatically every `battery-update-interval'
116seconds." 116seconds."
117 :global t 117 :global t :group 'battery
118 (setq battery-mode-line-string "") 118 (setq battery-mode-line-string "")
119 (or global-mode-string (setq global-mode-string '(""))) 119 (or global-mode-string (setq global-mode-string '("")))
120 (and battery-update-timer (cancel-timer battery-update-timer)) 120 (and battery-update-timer (cancel-timer battery-update-timer))
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 949434baffb..869896b087a 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -2111,12 +2111,12 @@ strings returned are not."
2111 (define-key map [write] '("Save Bookmarks As..." . bookmark-write)) 2111 (define-key map [write] '("Save Bookmarks As..." . bookmark-write))
2112 (define-key map [save] '("Save Bookmarks" . bookmark-save)) 2112 (define-key map [save] '("Save Bookmarks" . bookmark-save))
2113 (define-key map [edit] '("Edit Bookmark List" . bookmark-bmenu-list)) 2113 (define-key map [edit] '("Edit Bookmark List" . bookmark-bmenu-list))
2114 (define-key map [delete] '("Delete Bookmark" . bookmark-delete)) 2114 (define-key map [delete] '("Delete Bookmark..." . bookmark-delete))
2115 (define-key map [rename] '("Rename Bookmark" . bookmark-rename)) 2115 (define-key map [rename] '("Rename Bookmark..." . bookmark-rename))
2116 (define-key map [locate] '("Insert Location" . bookmark-locate)) 2116 (define-key map [locate] '("Insert Location..." . bookmark-locate))
2117 (define-key map [insert] '("Insert Contents" . bookmark-insert)) 2117 (define-key map [insert] '("Insert Contents..." . bookmark-insert))
2118 (define-key map [set] '("Set Bookmark" . bookmark-set)) 2118 (define-key map [set] '("Set Bookmark..." . bookmark-set))
2119 (define-key map [jump] '("Jump to Bookmark" . bookmark-jump)) 2119 (define-key map [jump] '("Jump to Bookmark..." . bookmark-jump))
2120 map)) 2120 map))
2121 2121
2122;;;###autoload 2122;;;###autoload
diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el
index 2d2f66b1ebf..4f45419c136 100644
--- a/lisp/calc/calc-embed.el
+++ b/lisp/calc/calc-embed.el
@@ -1,6 +1,6 @@
1;;; calc-embed.el --- embed Calc in a buffer 1;;; calc-embed.el --- embed Calc in a buffer
2 2
3;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. 3;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2005 Free Software Foundation, Inc.
4 4
5;; Author: David Gillespie <daveg@synaptics.com> 5;; Author: David Gillespie <daveg@synaptics.com>
6;; Maintainer: Jay Belanger <belanger@truman.edu> 6;; Maintainer: Jay Belanger <belanger@truman.edu>
@@ -48,48 +48,18 @@
48(defvar calc-embedded-some-active nil) 48(defvar calc-embedded-some-active nil)
49(make-variable-buffer-local 'calc-embedded-some-active) 49(make-variable-buffer-local 'calc-embedded-some-active)
50 50
51(defvar calc-embedded-open-formula "\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin[^{].*\n\\|^\\\\begin{.*[^x]}.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n" 51;; The following variables are customizable and defined in calc.el.
52 "*A regular expression for the opening delimiter of a formula used by 52(defvar calc-embedded-announce-formula)
53calc-embedded.") 53(defvar calc-embedded-open-formula)
54 54(defvar calc-embedded-close-formula)
55(defvar calc-embedded-close-formula "\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end[^{].*\n\\|^\\\\end{.*[^x]}.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n" 55(defvar calc-embedded-open-word)
56 "*A regular expression for the closing delimiter of a formula used by 56(defvar calc-embedded-close-word)
57calc-embedded.") 57(defvar calc-embedded-open-plain)
58 58(defvar calc-embedded-close-plain)
59(defvar calc-embedded-open-word "^\\|[^-+0-9.eE]" 59(defvar calc-embedded-open-new-formula)
60 "*A regular expression for the opening delimiter of a formula used by 60(defvar calc-embedded-close-new-formula)
61calc-embedded-word.") 61(defvar calc-embedded-open-mode)
62 62(defvar calc-embedded-close-mode)
63(defvar calc-embedded-close-word "$\\|[^-+0-9.eE]"
64 "*A regular expression for the closing delimiter of a formula used by
65calc-embedded-word.")
66
67(defvar calc-embedded-open-plain "%%% "
68 "*A string which is the opening delimiter for a \"plain\" formula.
69If calc-show-plain mode is enabled, this is inserted at the front of
70each formula.")
71
72(defvar calc-embedded-close-plain " %%%\n"
73 "*A string which is the closing delimiter for a \"plain\" formula.
74See calc-embedded-open-plain.")
75
76(defvar calc-embedded-open-new-formula "\n\n"
77 "*A string which is inserted at front of formula by calc-embedded-new-formula.")
78
79(defvar calc-embedded-close-new-formula "\n\n"
80 "*A string which is inserted at end of formula by calc-embedded-new-formula.")
81
82(defvar calc-embedded-announce-formula "%Embed\n\\(% .*\n\\)*"
83 "*A regular expression which is sure to be followed by a calc-embedded formula." )
84
85(defvar calc-embedded-open-mode "% "
86 "*A string which should precede calc-embedded mode annotations.
87This is not required to be present for user-written mode annotations.")
88
89(defvar calc-embedded-close-mode "\n"
90 "*A string which should follow calc-embedded mode annotations.
91This is not required to be present for user-written mode annotations.")
92
93 63
94(defconst calc-embedded-mode-vars '(("precision" . calc-internal-prec) 64(defconst calc-embedded-mode-vars '(("precision" . calc-internal-prec)
95 ("word-size" . calc-word-size) 65 ("word-size" . calc-word-size)
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index 662de5db867..6a58a6215fa 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -1,6 +1,6 @@
1;;; calc-graph.el --- graph output functions for Calc 1;;; calc-graph.el --- graph output functions for Calc
2 2
3;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. 3;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2005 Free Software Foundation, Inc.
4 4
5;; Author: David Gillespie <daveg@synaptics.com> 5;; Author: David Gillespie <daveg@synaptics.com>
6;; Maintainer: Jay Belanger <belanger@truman.edu> 6;; Maintainer: Jay Belanger <belanger@truman.edu>
@@ -33,14 +33,10 @@
33 33
34;;; Graphics 34;;; Graphics
35 35
36(defvar calc-gnuplot-name "gnuplot" 36;; The following three variables are customizable and defined in calc.el.
37 "*Name of GNUPLOT program, for calc-graph features.") 37(defvar calc-gnuplot-name)
38 38(defvar calc-gnuplot-plot-command)
39(defvar calc-gnuplot-plot-command nil 39(defvar calc-gnuplot-print-command)
40 "*Name of command for displaying GNUPLOT output; %s = file name to print.")
41
42(defvar calc-gnuplot-print-command "lp %s"
43 "*Name of command for printing GNUPLOT output; %s = file name to print.")
44 40
45(defvar calc-gnuplot-tempfile "calc") 41(defvar calc-gnuplot-tempfile "calc")
46 42
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el
index dc7f0b17c1d..46b8cec2ac6 100644
--- a/lisp/calc/calc-help.el
+++ b/lisp/calc/calc-help.el
@@ -1,6 +1,6 @@
1;;; calc-help.el --- help display functions for Calc, 1;;; calc-help.el --- help display functions for Calc,
2 2
3;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2004 3;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2004, 2005
4;; Free Software Foundation, Inc. 4;; Free Software Foundation, Inc.
5 5
6;; Author: David Gillespie <daveg@synaptics.com> 6;; Author: David Gillespie <daveg@synaptics.com>
@@ -409,10 +409,10 @@ C-w Describe how there is no warranty for Calc."
409(defun calc-full-help () 409(defun calc-full-help ()
410 (interactive) 410 (interactive)
411 (with-output-to-temp-buffer "*Help*" 411 (with-output-to-temp-buffer "*Help*"
412 (princ (format "GNU Emacs Calculator version %s of %s.\n" 412 (princ (format "GNU Emacs Calculator version %s.\n"
413 calc-version calc-version-date)) 413 calc-version))
414 (princ " By Dave Gillespie, daveg@synaptics.com.\n") 414 (princ " By Dave Gillespie.\n")
415 (princ " Copyright (C) 1990, 1993 Free Software Foundation, Inc.\n\n") 415 (princ " Copyright (C) 2005 Free Software Foundation, Inc.\n\n")
416 (princ "Type `h s' for a more detailed summary.\n") 416 (princ "Type `h s' for a more detailed summary.\n")
417 (princ "Or type `h i' to read the full Calc manual on-line.\n\n") 417 (princ "Or type `h i' to read the full Calc manual on-line.\n\n")
418 (princ "Basic keys:\n") 418 (princ "Basic keys:\n")
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el
index 2e5737349bc..9510507e276 100644
--- a/lisp/calc/calc-lang.el
+++ b/lisp/calc/calc-lang.el
@@ -388,6 +388,9 @@
388 ( \\arg . calcFunc-arg ) 388 ( \\arg . calcFunc-arg )
389 ( \\cos . calcFunc-cos ) 389 ( \\cos . calcFunc-cos )
390 ( \\cosh . calcFunc-cosh ) 390 ( \\cosh . calcFunc-cosh )
391 ( \\cot . calcFunc-cot )
392 ( \\coth . calcFunc-coth )
393 ( \\csc . calcFunc-csc )
391 ( \\det . calcFunc-det ) 394 ( \\det . calcFunc-det )
392 ( \\exp . calcFunc-exp ) 395 ( \\exp . calcFunc-exp )
393 ( \\gcd . calcFunc-gcd ) 396 ( \\gcd . calcFunc-gcd )
@@ -395,10 +398,11 @@
395 ( \\log . calcFunc-log10 ) 398 ( \\log . calcFunc-log10 )
396 ( \\max . calcFunc-max ) 399 ( \\max . calcFunc-max )
397 ( \\min . calcFunc-min ) 400 ( \\min . calcFunc-min )
398 ( \\tan . calcFunc-tan ) 401 ( \\sec . calcFunc-sec )
399 ( \\sin . calcFunc-sin ) 402 ( \\sin . calcFunc-sin )
400 ( \\sinh . calcFunc-sinh ) 403 ( \\sinh . calcFunc-sinh )
401 ( \\sqrt . calcFunc-sqrt ) 404 ( \\sqrt . calcFunc-sqrt )
405 ( \\tan . calcFunc-tan )
402 ( \\tanh . calcFunc-tanh ) 406 ( \\tanh . calcFunc-tanh )
403 ( \\phi . calcFunc-totient ) 407 ( \\phi . calcFunc-totient )
404 ( \\mu . calcFunc-moebius ))) 408 ( \\mu . calcFunc-moebius )))
@@ -686,6 +690,10 @@
686 ( Conjugate . calcFunc-conj ) 690 ( Conjugate . calcFunc-conj )
687 ( Cos . calcFunc-cos ) 691 ( Cos . calcFunc-cos )
688 ( Cosh . calcFunc-cosh ) 692 ( Cosh . calcFunc-cosh )
693 ( Cot . calcFunc-cot )
694 ( Coth . calcFunc-coth )
695 ( Csc . calcFunc-csc )
696 ( Csch . calcFunc-csch )
689 ( D . calcFunc-deriv ) 697 ( D . calcFunc-deriv )
690 ( Dt . calcFunc-tderiv ) 698 ( Dt . calcFunc-tderiv )
691 ( Det . calcFunc-det ) 699 ( Det . calcFunc-det )
@@ -708,6 +716,8 @@
708 ( Random . calcFunc-random ) 716 ( Random . calcFunc-random )
709 ( Round . calcFunc-round ) 717 ( Round . calcFunc-round )
710 ( Re . calcFunc-re ) 718 ( Re . calcFunc-re )
719 ( Sec . calcFunc-sec )
720 ( Sech . calcFunc-sech )
711 ( Sign . calcFunc-sign ) 721 ( Sign . calcFunc-sign )
712 ( Sin . calcFunc-sin ) 722 ( Sin . calcFunc-sin )
713 ( Sinh . calcFunc-sinh ) 723 ( Sinh . calcFunc-sinh )
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 24336ad9333..ceee013e493 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1,6 +1,7 @@
1;;; calc.el --- the GNU Emacs calculator 1;;; calc.el --- the GNU Emacs calculator
2 2
3;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. 3;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005
4;; Free Software Foundation, Inc.
4 5
5;; Author: David Gillespie <daveg@synaptics.com> 6;; Author: David Gillespie <daveg@synaptics.com>
6;; Maintainer: Jay Belanger <belanger@truman.edu> 7;; Maintainer: Jay Belanger <belanger@truman.edu>
@@ -205,9 +206,122 @@
205 206
206(require 'calc-macs) 207(require 'calc-macs)
207 208
209(defgroup calc nil
210 "GNU Calc"
211 :prefix "calc-"
212 :tag "Calc")
213
208;;;###autoload 214;;;###autoload
209(defvar calc-settings-file (convert-standard-filename "~/.calc.el") 215(defcustom calc-settings-file
210 "*File in which to record permanent settings.") 216 (convert-standard-filename "~/.calc.el")
217 "*File in which to record permanent settings."
218 :group 'calc
219 :type '(file))
220
221(defcustom calc-language-alist
222 '((latex-mode . latex)
223 (tex-mode . tex)
224 (plain-tex-mode . tex)
225 (context-mode . tex)
226 (nroff-mode . eqn)
227 (pascal-mode . pascal)
228 (c-mode . c)
229 (c++-mode . c)
230 (fortran-mode . fortran)
231 (f90-mode . fortran))
232 "*Alist of major modes with appropriate Calc languages."
233 :group 'calc
234 :type '(alist :key-type (symbol :tag "Major mode")
235 :value-type (symbol :tag "Calc language")))
236
237(defcustom calc-embedded-announce-formula
238 "%Embed\n\\(% .*\n\\)*"
239 "*A regular expression which is sure to be followed by a calc-embedded formula."
240 :group 'calc
241 :type '(regexp))
242
243(defcustom calc-embedded-open-formula
244 "\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin[^{].*\n\\|^\\\\begin{.*[^x]}.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n"
245 "*A regular expression for the opening delimiter of a formula used by calc-embedded."
246 :group 'calc
247 :type '(regexp))
248
249(defcustom calc-embedded-close-formula
250 "\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end[^{].*\n\\|^\\\\end{.*[^x]}.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n"
251 "*A regular expression for the closing delimiter of a formula used by calc-embedded."
252 :group 'calc
253 :type '(regexp))
254
255(defcustom calc-embedded-open-word
256 "^\\|[^-+0-9.eE]"
257 "*A regular expression for the opening delimiter of a formula used by calc-embedded-word."
258 :group 'calc
259 :type '(regexp))
260
261(defcustom calc-embedded-close-word
262 "$\\|[^-+0-9.eE]"
263 "*A regular expression for the closing delimiter of a formula used by calc-embedded-word."
264 :group 'calc
265 :type '(regexp))
266
267(defcustom calc-embedded-open-plain
268 "%%% "
269 "*A string which is the opening delimiter for a \"plain\" formula.
270If calc-show-plain mode is enabled, this is inserted at the front of
271each formula."
272 :group 'calc
273 :type '(string))
274
275(defcustom calc-embedded-close-plain
276 " %%%\n"
277 "*A string which is the closing delimiter for a \"plain\" formula.
278See calc-embedded-open-plain."
279 :group 'calc
280 :type '(string))
281
282(defcustom calc-embedded-open-new-formula
283 "\n\n"
284 "*A string which is inserted at front of formula by calc-embedded-new-formula."
285 :group 'calc
286 :type '(string))
287
288(defcustom calc-embedded-close-new-formula
289 "\n\n"
290 "*A string which is inserted at end of formula by calc-embedded-new-formula."
291 :group 'calc
292 :type '(string))
293
294(defcustom calc-embedded-open-mode
295 "% "
296 "*A string which should precede calc-embedded mode annotations.
297This is not required to be present for user-written mode annotations."
298 :group 'calc
299 :type '(string))
300
301(defcustom calc-embedded-close-mode
302 "\n"
303 "*A string which should follow calc-embedded mode annotations.
304This is not required to be present for user-written mode annotations."
305 :group 'calc
306 :type '(string))
307
308(defcustom calc-gnuplot-name
309 "gnuplot"
310 "*Name of GNUPLOT program, for calc-graph features."
311 :group 'calc
312 :type '(string))
313
314(defcustom calc-gnuplot-plot-command
315 nil
316 "*Name of command for displaying GNUPLOT output; %s = file name to print."
317 :group 'calc
318 :type '(choice (string) (sexp)))
319
320(defcustom calc-gnuplot-print-command
321 "lp %s"
322 "*Name of command for printing GNUPLOT output; %s = file name to print."
323 :group 'calc
324 :type '(choice (string) (sexp)))
211 325
212(defvar calc-bug-address "belanger@truman.edu" 326(defvar calc-bug-address "belanger@truman.edu"
213 "Address of the author of Calc, for use by `report-calc-bug'.") 327 "Address of the author of Calc, for use by `report-calc-bug'.")
@@ -656,8 +770,7 @@ If nil, selections displayed but ignored.")
656(put 'math-underflow 'error-conditions '(error math-underflow calc-error)) 770(put 'math-underflow 'error-conditions '(error math-underflow calc-error))
657(put 'math-underflow 'error-message "Floating-point underflow occurred") 771(put 'math-underflow 'error-message "Floating-point underflow occurred")
658 772
659(defconst calc-version "2.02g") 773(defconst calc-version "2.1")
660(defconst calc-version-date "Mon Nov 19 2001")
661(defvar calc-trail-pointer nil) ; "Current" entry in trail buffer. 774(defvar calc-trail-pointer nil) ; "Current" entry in trail buffer.
662(defvar calc-trail-overlay nil) ; Value of overlay-arrow-string. 775(defvar calc-trail-overlay nil) ; Value of overlay-arrow-string.
663(defvar calc-undo-list nil) ; List of previous operations for undo. 776(defvar calc-undo-list nil) ; List of previous operations for undo.
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index e11129414d3..8ace0be910b 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -1,9 +1,9 @@
1;;; appt.el --- appointment notification functions 1;;; appt.el --- appointment notification functions
2 2
3;; Copyright (C) 1989, 1990, 1994, 1998, 2004 Free Software Foundation, Inc. 3;; Copyright (C) 1989, 1990, 1994, 1998, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Neil Mager <neilm@juliet.ll.mit.edu> 5;; Author: Neil Mager <neilm@juliet.ll.mit.edu>
6;; Maintainer: FSF 6;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk>
7;; Keywords: calendar 7;; Keywords: calendar
8 8
9;; This file is part of GNU Emacs. 9;; This file is part of GNU Emacs.
@@ -181,7 +181,7 @@ Only relevant if reminders are being displayed in a window."
181 181
182;;; Internal variables below this point. 182;;; Internal variables below this point.
183 183
184(defvar appt-buffer-name " *appt-buf*" 184(defconst appt-buffer-name " *appt-buf*"
185 "Name of the appointments buffer.") 185 "Name of the appointments buffer.")
186 186
187(defvar appt-time-msg-list nil 187(defvar appt-time-msg-list nil
@@ -486,9 +486,8 @@ Usually just deletes the appointment buffer."
486 486
487;;;###autoload 487;;;###autoload
488(defun appt-add (new-appt-time new-appt-msg) 488(defun appt-add (new-appt-time new-appt-msg)
489 "Add an appointment for the day at NEW-APPT-TIME and issue message NEW-APPT-MSG. 489 "Add an appointment for today at NEW-APPT-TIME with message NEW-APPT-MSG.
490The time should be in either 24 hour format or am/pm format." 490The time should be in either 24 hour format or am/pm format."
491
492 (interactive "sTime (hh:mm[am/pm]): \nsMessage: ") 491 (interactive "sTime (hh:mm[am/pm]): \nsMessage: ")
493 (unless (string-match "[0-9]?[0-9][:.][0-9][0-9]\\(am\\|pm\\)?" 492 (unless (string-match "[0-9]?[0-9][:.][0-9][0-9]\\(am\\|pm\\)?"
494 new-appt-time) 493 new-appt-time)
diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el
index 6e506b93f7d..303193e3d73 100644
--- a/lisp/calendar/cal-china.el
+++ b/lisp/calendar/cal-china.el
@@ -38,8 +38,8 @@
38;; The date of Chinese New Year is correct from 1644-2051. 38;; The date of Chinese New Year is correct from 1644-2051.
39 39
40;; Technical details of all the calendrical calculations can be found in 40;; Technical details of all the calendrical calculations can be found in
41;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, 41;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
42;; Cambridge University Press (1997). 42;; and Nachum Dershowitz, Cambridge University Press (2001).
43 43
44;; Comments, corrections, and improvements should be sent to 44;; Comments, corrections, and improvements should be sent to
45;; Edward M. Reingold Department of Computer Science 45;; Edward M. Reingold Department of Computer Science
diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el
index df1201a23c4..2aa111f2109 100644
--- a/lisp/calendar/cal-coptic.el
+++ b/lisp/calendar/cal-coptic.el
@@ -29,8 +29,8 @@
29;; diary.el that deal with the Coptic and Ethiopic calendars. 29;; diary.el that deal with the Coptic and Ethiopic calendars.
30 30
31;; Technical details of all the calendrical calculations can be found in 31;; Technical details of all the calendrical calculations can be found in
32;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, 32;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
33;; Cambridge University Press (1997). 33;; and Nachum Dershowitz, Cambridge University Press (2001).
34 34
35;; Comments, corrections, and improvements should be sent to 35;; Comments, corrections, and improvements should be sent to
36;; Edward M. Reingold Department of Computer Science 36;; Edward M. Reingold Department of Computer Science
diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el
index d988b008f53..c42e415eb25 100644
--- a/lisp/calendar/cal-french.el
+++ b/lisp/calendar/cal-french.el
@@ -29,8 +29,8 @@
29;; diary.el that deal with the French Revolutionary calendar. 29;; diary.el that deal with the French Revolutionary calendar.
30 30
31;; Technical details of the French Revolutionary calendar can be found in 31;; Technical details of the French Revolutionary calendar can be found in
32;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, 32;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
33;; Cambridge University Press (1997), and in 33;; and Nachum Dershowitz, Cambridge University Press (2001), and in
34;; ``Calendrical Calculations, Part II: Three Historical Calendars'' by 34;; ``Calendrical Calculations, Part II: Three Historical Calendars'' by
35;; E. M. Reingold, N. Dershowitz, and S. M. Clamen, Software--Practice and 35;; E. M. Reingold, N. Dershowitz, and S. M. Clamen, Software--Practice and
36;; Experience, Volume 23, Number 4 (April, 1993), pages 383-404. 36;; Experience, Volume 23, Number 4 (April, 1993), pages 383-404.
diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el
index 776868159be..f66b4966e57 100644
--- a/lisp/calendar/cal-hebrew.el
+++ b/lisp/calendar/cal-hebrew.el
@@ -30,8 +30,8 @@
30;; diary.el that deal with the Hebrew calendar. 30;; diary.el that deal with the Hebrew calendar.
31 31
32;; Technical details of all the calendrical calculations can be found in 32;; Technical details of all the calendrical calculations can be found in
33;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, 33;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
34;; Cambridge University Press (1997). 34;; and Nachum Dershowitz, Cambridge University Press (2001).
35 35
36;; Comments, corrections, and improvements should be sent to 36;; Comments, corrections, and improvements should be sent to
37;; Edward M. Reingold Department of Computer Science 37;; Edward M. Reingold Department of Computer Science
diff --git a/lisp/calendar/cal-islam.el b/lisp/calendar/cal-islam.el
index 8dcf5c29b1f..1ac6f0677b1 100644
--- a/lisp/calendar/cal-islam.el
+++ b/lisp/calendar/cal-islam.el
@@ -29,8 +29,8 @@
29;; diary.el that deal with the Islamic calendar. 29;; diary.el that deal with the Islamic calendar.
30 30
31;; Technical details of all the calendrical calculations can be found in 31;; Technical details of all the calendrical calculations can be found in
32;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, 32;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
33;; Cambridge University Press (1997). 33;; and Nachum Dershowitz, Cambridge University Press (2001).
34 34
35;; Comments, corrections, and improvements should be sent to 35;; Comments, corrections, and improvements should be sent to
36;; Edward M. Reingold Department of Computer Science 36;; Edward M. Reingold Department of Computer Science
diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el
index 058bdf071d7..8a40442e4fe 100644
--- a/lisp/calendar/cal-iso.el
+++ b/lisp/calendar/cal-iso.el
@@ -30,8 +30,8 @@
30;; diary.el that deal with the ISO calendar. 30;; diary.el that deal with the ISO calendar.
31 31
32;; Technical details of all the calendrical calculations can be found in 32;; Technical details of all the calendrical calculations can be found in
33;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, 33;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
34;; Cambridge University Press (1997). 34;; and Nachum Dershowitz, Cambridge University Press (2001).
35 35
36;; Comments, corrections, and improvements should be sent to 36;; Comments, corrections, and improvements should be sent to
37;; Edward M. Reingold Department of Computer Science 37;; Edward M. Reingold Department of Computer Science
diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el
index 67fb8515b24..2b7278f8ea6 100644
--- a/lisp/calendar/cal-julian.el
+++ b/lisp/calendar/cal-julian.el
@@ -29,8 +29,8 @@
29;; diary.el that deal with the Julian calendar. 29;; diary.el that deal with the Julian calendar.
30 30
31;; Technical details of all the calendrical calculations can be found in 31;; Technical details of all the calendrical calculations can be found in
32;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, 32;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
33;; Cambridge University Press (1997). 33;; and Nachum Dershowitz, Cambridge University Press (2001).
34 34
35;; Comments, corrections, and improvements should be sent to 35;; Comments, corrections, and improvements should be sent to
36;; Edward M. Reingold Department of Computer Science 36;; Edward M. Reingold Department of Computer Science
diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el
index c2c3e027c4b..92bbb5df23e 100644
--- a/lisp/calendar/cal-mayan.el
+++ b/lisp/calendar/cal-mayan.el
@@ -44,8 +44,8 @@
44;; Comments, improvements, and bug reports should be sent to Reingold. 44;; Comments, improvements, and bug reports should be sent to Reingold.
45 45
46;; Technical details of the Mayan calendrical calculations can be found in 46;; Technical details of the Mayan calendrical calculations can be found in
47;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, 47;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
48;; Cambridge University Press (1997), and in 48;; and Nachum Dershowitz, Cambridge University Press (2001), and in
49;; ``Calendrical Calculations, Part II: Three Historical Calendars'' 49;; ``Calendrical Calculations, Part II: Three Historical Calendars''
50;; by E. M. Reingold, N. Dershowitz, and S. M. Clamen, 50;; by E. M. Reingold, N. Dershowitz, and S. M. Clamen,
51;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993), 51;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993),
diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el
index ff09c14b47d..dcbbcbd637e 100644
--- a/lisp/calendar/cal-persia.el
+++ b/lisp/calendar/cal-persia.el
@@ -29,8 +29,8 @@
29;; diary.el that deal with the Persian calendar. 29;; diary.el that deal with the Persian calendar.
30 30
31;; Technical details of all the calendrical calculations can be found in 31;; Technical details of all the calendrical calculations can be found in
32;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, 32;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
33;; Cambridge University Press (1997). 33;; and Nachum Dershowitz, Cambridge University Press (2001).
34 34
35;; Comments, corrections, and improvements should be sent to 35;; Comments, corrections, and improvements should be sent to
36;; Edward M. Reingold Department of Computer Science 36;; Edward M. Reingold Department of Computer Science
diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el
index 97fbb72af61..03b485a438a 100644
--- a/lisp/calendar/cal-x.el
+++ b/lisp/calendar/cal-x.el
@@ -1,9 +1,10 @@
1;;; cal-x.el --- calendar windows in dedicated frames in X 1;;; cal-x.el --- calendar windows in dedicated frames in X
2 2
3;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. 3;; Copyright (C) 1994, 1995, 2005 Free Software Foundation, Inc.
4 4
5;; Author: Michael Kifer <kifer@cs.sunysb.edu> 5;; Author: Michael Kifer <kifer@cs.sunysb.edu>
6;; Edward M. Reingold <reingold@cs.uiuc.edu> 6;; Edward M. Reingold <reingold@cs.uiuc.edu>
7;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk>
7;; Keywords: calendar 8;; Keywords: calendar
8;; Human-Keywords: calendar, dedicated frames, X Window System 9;; Human-Keywords: calendar, dedicated frames, X Window System
9 10
@@ -88,7 +89,7 @@ This function requires a display capable of multiple frames, else
88 (frame-parameters calendar-frame)))) 89 (frame-parameters calendar-frame))))
89 (iconify-or-deiconify-frame)) 90 (iconify-or-deiconify-frame))
90 (calendar-basic-setup arg) 91 (calendar-basic-setup arg)
91 (set-window-dedicated-p (selected-window) 'calendar) 92 (set-window-dedicated-p (selected-window) t)
92 (set-window-dedicated-p 93 (set-window-dedicated-p
93 (display-buffer 94 (display-buffer
94 (if (not (memq 'fancy-diary-display diary-display-hook)) 95 (if (not (memq 'fancy-diary-display diary-display-hook))
@@ -96,7 +97,7 @@ This function requires a display capable of multiple frames, else
96 (if (not (bufferp (get-buffer fancy-diary-buffer))) 97 (if (not (bufferp (get-buffer fancy-diary-buffer)))
97 (make-fancy-diary-buffer)) 98 (make-fancy-diary-buffer))
98 fancy-diary-buffer)) 99 fancy-diary-buffer))
99 'diary)))))) 100 t))))))
100 101
101(defun calendar-only-one-frame-setup (&optional arg) 102(defun calendar-only-one-frame-setup (&optional arg)
102 "Start calendar and display it in a dedicated frame. 103 "Start calendar and display it in a dedicated frame.
@@ -117,7 +118,7 @@ This function requires a display capable of multiple frames, else
117 (frame-parameters calendar-frame)))) 118 (frame-parameters calendar-frame))))
118 (iconify-or-deiconify-frame)) 119 (iconify-or-deiconify-frame))
119 (calendar-basic-setup arg) 120 (calendar-basic-setup arg)
120 (set-window-dedicated-p (selected-window) 'calendar)))))) 121 (set-window-dedicated-p (selected-window) t))))))
121 122
122(defun calendar-two-frame-setup (&optional arg) 123(defun calendar-two-frame-setup (&optional arg)
123 "Start calendar and diary in separate, dedicated frames. 124 "Start calendar and diary in separate, dedicated frames.
@@ -139,7 +140,7 @@ This function requires a display capable of multiple frames, else
139 (frame-parameters calendar-frame)))) 140 (frame-parameters calendar-frame))))
140 (iconify-or-deiconify-frame)) 141 (iconify-or-deiconify-frame))
141 (display-buffer calendar-buffer) 142 (display-buffer calendar-buffer)
142 (set-window-dedicated-p (selected-window) 'calendar) 143 (set-window-dedicated-p (selected-window) t)
143 (setq diary-frame (make-frame diary-frame-parameters)) 144 (setq diary-frame (make-frame diary-frame-parameters))
144 (run-hooks 'calendar-after-frame-setup-hooks) 145 (run-hooks 'calendar-after-frame-setup-hooks)
145 (select-frame diary-frame) 146 (select-frame diary-frame)
@@ -154,7 +155,7 @@ This function requires a display capable of multiple frames, else
154 (if (not (bufferp (get-buffer fancy-diary-buffer))) 155 (if (not (bufferp (get-buffer fancy-diary-buffer)))
155 (make-fancy-diary-buffer)) 156 (make-fancy-diary-buffer))
156 fancy-diary-buffer)) 157 fancy-diary-buffer))
157 'diary))))) 158 t)))))
158 159
159;; Formerly (get-file-buffer diary-file) was added to the list here, 160;; Formerly (get-file-buffer diary-file) was added to the list here,
160;; but that isn't clean, and the value could even be nil. 161;; but that isn't clean, and the value could even be nil.
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 89d32c4952b..5fc23a15cc9 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -75,13 +75,13 @@
75;; solar.el Sunrise/sunset, equinoxes/solstices 75;; solar.el Sunrise/sunset, equinoxes/solstices
76 76
77;; Technical details of all the calendrical calculations can be found in 77;; Technical details of all the calendrical calculations can be found in
78;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, 78;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
79;; Cambridge University Press (1997). 79;; and Nachum Dershowitz, Cambridge University Press (2001).
80 80
81;; An earlier version of the technical details appeared in 81;; An earlier version of the technical details appeared in
82;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, 82;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
83;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990), 83;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990),
84;; pages 899-928. ``Calendrical Calculations, Part II: Three Historical 84;; pages 899-928, and in ``Calendrical Calculations, Part II: Three Historical
85;; Calendars'' by E. M. Reingold, N. Dershowitz, and S. M. Clamen, 85;; Calendars'' by E. M. Reingold, N. Dershowitz, and S. M. Clamen,
86;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993), 86;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993),
87;; pages 383-404. 87;; pages 383-404.
@@ -2763,7 +2763,7 @@ in `calendar-day-name-array'. These abbreviations may be used
2763instead of the full names in the diary file. Do not include a 2763instead of the full names in the diary file. Do not include a
2764trailing `.' in the strings specified in this variable, though 2764trailing `.' in the strings specified in this variable, though
2765you may use such in the diary file. If any element of this array 2765you may use such in the diary file. If any element of this array
2766is nil, then the abbreviation will be constructed as the first 2766is nil, then the abbreviation will be constructed as the first
2767`calendar-abbrev-length' characters of the corresponding full name.") 2767`calendar-abbrev-length' characters of the corresponding full name.")
2768 2768
2769(defvar calendar-month-name-array 2769(defvar calendar-month-name-array
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
index 4493bd02a9c..6596657d454 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -30,8 +30,8 @@
30;; in calendar.el. 30;; in calendar.el.
31 31
32;; Technical details of all the calendrical calculations can be found in 32;; Technical details of all the calendrical calculations can be found in
33;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, 33;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
34;; Cambridge University Press (1997). 34;; and Nachum Dershowitz, Cambridge University Press (2001).
35 35
36;; An earlier version of the technical details appeared in 36;; An earlier version of the technical details appeared in
37;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, 37;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el
index 7efed3ff275..057419969fc 100644
--- a/lisp/calendar/lunar.el
+++ b/lisp/calendar/lunar.el
@@ -38,8 +38,8 @@
38;; person rewrite the code for the lunar calculations in this file! 38;; person rewrite the code for the lunar calculations in this file!
39 39
40;; Technical details of all the calendrical calculations can be found in 40;; Technical details of all the calendrical calculations can be found in
41;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, 41;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
42;; Cambridge University Press (1997). 42;; and Nachum Dershowitz, Cambridge University Press (2001).
43 43
44;; Comments, corrections, and improvements should be sent to 44;; Comments, corrections, and improvements should be sent to
45;; Edward M. Reingold Department of Computer Science 45;; Edward M. Reingold Department of Computer Science
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index 8a514fa6415..57a6c6a40a8 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -48,8 +48,8 @@
48;; 1951--2050. For other years the times will be within +/- 1 minute. 48;; 1951--2050. For other years the times will be within +/- 1 minute.
49 49
50;; Technical details of all the calendrical calculations can be found in 50;; Technical details of all the calendrical calculations can be found in
51;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, 51;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
52;; Cambridge University Press (1997). 52;; and Nachum Dershowitz, Cambridge University Press (2001).
53 53
54;; Comments, corrections, and improvements should be sent to 54;; Comments, corrections, and improvements should be sent to
55;; Edward M. Reingold Department of Computer Science 55;; Edward M. Reingold Department of Computer Science
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index a4acb8b9291..7160d26ef42 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -1,5 +1,5 @@
1;;; time-date.el --- date and time handling functions 1;;; time-date.el --- Date and time handling functions
2;; Copyright (C) 1998, 1999, 2000, 2004, 2005 Free Software Foundation, Inc. 2;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2004, 2005 Free Software Foundation, Inc.
3 3
4;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 4;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5;; Masanobu Umeda <umerin@mse.kyutech.ac.jp> 5;; Masanobu Umeda <umerin@mse.kyutech.ac.jp>
diff --git a/lisp/complete.el b/lisp/complete.el
index 337af81de71..60bddd01f17 100644
--- a/lisp/complete.el
+++ b/lisp/complete.el
@@ -937,12 +937,11 @@ absolute rather than relative to some directory on the SEARCH-PATH."
937 ((not completion-table) nil) 937 ((not completion-table) nil)
938 ((eq action nil) (try-completion str2 completion-table nil)) 938 ((eq action nil) (try-completion str2 completion-table nil))
939 ((eq action t) (all-completions str2 completion-table nil)) 939 ((eq action t) (all-completions str2 completion-table nil))
940 ((eq action 'lambda) 940 ((eq action 'lambda) (test-completion str2 completion-table nil))))
941 (eq (try-completion str2 completion-table nil) t))))
942 (funcall PC-old-read-file-name-internal string dir action))) 941 (funcall PC-old-read-file-name-internal string dir action)))
943 942
944 943
945(provide 'complete) 944(provide 'complete)
946 945
947;;; arch-tag: fc7e2768-ff44-4e22-b579-4d825b968458 946;; arch-tag: fc7e2768-ff44-4e22-b579-4d825b968458
948;;; complete.el ends here 947;;; complete.el ends here
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 6ec81fcac70..ed663d375d5 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -1,6 +1,6 @@
1;;; desktop.el --- save partial status of Emacs when killed 1;;; desktop.el --- save partial status of Emacs when killed
2 2
3;; Copyright (C) 1993, 1994, 1995, 1997, 2000, 2001 3;; Copyright (C) 1993, 1994, 1995, 1997, 2000, 2001, 2005
4;; Free Software Foundation, Inc. 4;; Free Software Foundation, Inc.
5 5
6;; Author: Morten Welinder <terra@diku.dk> 6;; Author: Morten Welinder <terra@diku.dk>
@@ -158,14 +158,14 @@ If nil, just print error messages in the message buffer."
158 158
159(defcustom desktop-no-desktop-file-hook nil 159(defcustom desktop-no-desktop-file-hook nil
160 "Normal hook run when `desktop-read' can't find a desktop file. 160 "Normal hook run when `desktop-read' can't find a desktop file.
161May e.g. be used to show a dired buffer." 161May be used to show a dired buffer."
162 :type 'hook 162 :type 'hook
163 :group 'desktop 163 :group 'desktop
164 :version "22.1") 164 :version "22.1")
165 165
166(defcustom desktop-after-read-hook nil 166(defcustom desktop-after-read-hook nil
167 "Normal hook run after a successful `desktop-read'. 167 "Normal hook run after a successful `desktop-read'.
168May e.g. be used to show a buffer list." 168May be used to show a buffer list."
169 :type 'hook 169 :type 'hook
170 :group 'desktop 170 :group 'desktop
171 :version "22.1") 171 :version "22.1")
diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el
index c945a6a7221..d69685ac86f 100644
--- a/lisp/diff-mode.el
+++ b/lisp/diff-mode.el
@@ -1,7 +1,7 @@
1;;; diff-mode.el --- a mode for viewing/editing context diffs 1;;; diff-mode.el --- a mode for viewing/editing context diffs
2 2
3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
4;; Free Software Foundation, Inc. 4;; Free Software Foundation, Inc.
5 5
6;; Author: Stefan Monnier <monnier@cs.yale.edu> 6;; Author: Stefan Monnier <monnier@cs.yale.edu>
7;; Keywords: convenience patch diff 7;; Keywords: convenience patch diff
@@ -263,7 +263,7 @@ when editing big diffs)."
263 (save-excursion 263 (save-excursion
264 (while (re-search-backward re start t) 264 (while (re-search-backward re start t)
265 (replace-match "" t t))))))) 265 (replace-match "" t t)))))))
266 266
267 267
268(defvar diff-font-lock-keywords 268(defvar diff-font-lock-keywords
269 `(("^\\(@@ -[0-9,]+ \\+[0-9,]+ @@\\)\\(.*\\)$" ;unified 269 `(("^\\(@@ -[0-9,]+ \\+[0-9,]+ @@\\)\\(.*\\)$" ;unified
@@ -484,7 +484,7 @@ If the OLD prefix arg is passed, tell the file NAME of the old file."
484 (let ((fs (diff-hunk-file-names old))) 484 (let ((fs (diff-hunk-file-names old)))
485 (unless fs (error "No file name to look for")) 485 (unless fs (error "No file name to look for"))
486 (push (cons fs name) diff-remembered-files-alist))) 486 (push (cons fs name) diff-remembered-files-alist)))
487 487
488(defun diff-hunk-file-names (&optional old) 488(defun diff-hunk-file-names (&optional old)
489 "Give the list of file names textually mentioned for the current hunk." 489 "Give the list of file names textually mentioned for the current hunk."
490 (save-excursion 490 (save-excursion
@@ -952,7 +952,7 @@ a diff with \\[diff-reverse-direction]."
952(define-minor-mode diff-minor-mode 952(define-minor-mode diff-minor-mode
953 "Minor mode for viewing/editing context diffs. 953 "Minor mode for viewing/editing context diffs.
954\\{diff-minor-mode-map}" 954\\{diff-minor-mode-map}"
955 nil " Diff" nil 955 :group 'diff-mode :lighter " Diff"
956 ;; FIXME: setup font-lock 956 ;; FIXME: setup font-lock
957 ;; setup change hooks 957 ;; setup change hooks
958 (if (not diff-update-on-the-fly) 958 (if (not diff-update-on-the-fly)
diff --git a/lisp/dired.el b/lisp/dired.el
index b42d4f8cece..8ee19486a7e 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1252,7 +1252,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
1252 '("--")) 1252 '("--"))
1253 1253
1254 (define-key map [menu-bar immediate compare-directories] 1254 (define-key map [menu-bar immediate compare-directories]
1255 '(menu-item "Compare directories" dired-compare-directories 1255 '(menu-item "Compare directories..." dired-compare-directories
1256 :help "Mark files with different attributes in two dired buffers")) 1256 :help "Mark files with different attributes in two dired buffers"))
1257 (define-key map [menu-bar immediate backup-diff] 1257 (define-key map [menu-bar immediate backup-diff]
1258 '(menu-item "Compare with Backup" dired-backup-diff 1258 '(menu-item "Compare with Backup" dired-backup-diff
diff --git a/lisp/ediff-hook.el b/lisp/ediff-hook.el
index 7ea6f24d7bb..5394923aa36 100644
--- a/lisp/ediff-hook.el
+++ b/lisp/ediff-hook.el
@@ -131,10 +131,10 @@
131 )) 131 ))
132 (defvar ediff-misc-menu 132 (defvar ediff-misc-menu
133 '("Ediff Miscellanea" 133 '("Ediff Miscellanea"
134 ["Ediff Manual..." ediff-documentation t] 134 ["Ediff Manual" ediff-documentation t]
135 ["Customize Ediff..." ediff-customize t] 135 ["Customize Ediff" ediff-customize t]
136 ["List Ediff Sessions..." ediff-show-registry t] 136 ["List Ediff Sessions" ediff-show-registry t]
137 ["Use separate frame for Ediff control buffer..." 137 ["Use separate frame for Ediff control buffer"
138 ediff-toggle-multiframe 138 ediff-toggle-multiframe
139 :style toggle 139 :style toggle
140 :selected (if (and (featurep 'ediff-util) 140 :selected (if (and (featurep 'ediff-util)
@@ -242,14 +242,14 @@
242 242
243 ;; define ediff miscellanea 243 ;; define ediff miscellanea
244 (define-key menu-bar-ediff-misc-menu [emultiframe] 244 (define-key menu-bar-ediff-misc-menu [emultiframe]
245 '("Toggle use of separate control buffer frame..." 245 '("Toggle use of separate control buffer frame"
246 . ediff-toggle-multiframe)) 246 . ediff-toggle-multiframe))
247 (define-key menu-bar-ediff-misc-menu [eregistry] 247 (define-key menu-bar-ediff-misc-menu [eregistry]
248 '("List Ediff Sessions..." . ediff-show-registry)) 248 '("List Ediff Sessions" . ediff-show-registry))
249 (define-key menu-bar-ediff-misc-menu [ediff-cust] 249 (define-key menu-bar-ediff-misc-menu [ediff-cust]
250 '("Customize Ediff..." . ediff-customize)) 250 '("Customize Ediff" . ediff-customize))
251 (define-key menu-bar-ediff-misc-menu [ediff-doc] 251 (define-key menu-bar-ediff-misc-menu [ediff-doc]
252 '("Ediff Manual..." . ediff-documentation)) 252 '("Ediff Manual" . ediff-documentation))
253 ) 253 )
254 254
255 ) ; emacs case 255 ) ; emacs case
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 0a75a43827e..68d1287d98c 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -72,7 +72,7 @@ or macro definition or a defcustom)."
72 (let ((car (car-safe form)) expand) 72 (let ((car (car-safe form)) expand)
73 (cond 73 (cond
74 ;; For complex cases, try again on the macro-expansion. 74 ;; For complex cases, try again on the macro-expansion.
75 ((and (memq car '(easy-mmode-define-global-mode 75 ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode
76 easy-mmode-define-minor-mode define-minor-mode)) 76 easy-mmode-define-minor-mode define-minor-mode))
77 (setq expand (let ((load-file-name file)) (macroexpand form))) 77 (setq expand (let ((load-file-name file)) (macroexpand form)))
78 (eq (car expand) 'progn) 78 (eq (car expand) 'progn)
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 1e45439658c..2149cba8720 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -632,24 +632,31 @@ which must be written in Lisp, not predefined.
632Use \\[cancel-debug-on-entry] to cancel the effect of this command. 632Use \\[cancel-debug-on-entry] to cancel the effect of this command.
633Redefining FUNCTION also cancels it." 633Redefining FUNCTION also cancels it."
634 (interactive "aDebug on entry (to function): ") 634 (interactive "aDebug on entry (to function): ")
635 ;; Handle a function that has been aliased to some other function. 635 (when (and (subrp (symbol-function function))
636 (if (and (subrp (symbol-function function)) 636 (eq (cdr (subr-arity (symbol-function function))) 'unevalled))
637 (eq (cdr (subr-arity (symbol-function function))) 'unevalled)) 637 (error "Function %s is a special form" function))
638 (error "Function %s is a special form" function)) 638 (if (or (symbolp (symbol-function function))
639 (if (or (symbolp (symbol-function function))
640 (subrp (symbol-function function))) 639 (subrp (symbol-function function)))
641 ;; Create a wrapper in which we can then add the necessary debug call. 640 ;; The function is built-in or aliased to another function.
641 ;; Create a wrapper in which we can add the debug call.
642 (fset function `(lambda (&rest debug-on-entry-args) 642 (fset function `(lambda (&rest debug-on-entry-args)
643 ,(interactive-form (symbol-function function)) 643 ,(interactive-form (symbol-function function))
644 (apply ',(symbol-function function) 644 (apply ',(symbol-function function)
645 debug-on-entry-args)))) 645 debug-on-entry-args)))
646 (or (consp (symbol-function function)) 646 (when (eq (car-safe (symbol-function function)) 'autoload)
647 (debug-convert-byte-code function)) 647 ;; The function is autoloaded. Load its real definition.
648 (or (consp (symbol-function function)) 648 (load (cadr (symbol-function function)) nil noninteractive nil t))
649 (error "Definition of %s is not a list" function)) 649 (when (or (not (consp (symbol-function function)))
650 (and (eq (car (symbol-function function)) 'macro)
651 (not (consp (cdr (symbol-function function))))))
652 ;; The function is byte-compiled. Create a wrapper in which
653 ;; we can add the debug call.
654 (debug-convert-byte-code function)))
655 (unless (consp (symbol-function function))
656 (error "Definition of %s is not a list" function))
650 (fset function (debug-on-entry-1 function t)) 657 (fset function (debug-on-entry-1 function t))
651 (or (memq function debug-function-list) 658 (unless (memq function debug-function-list)
652 (push function debug-function-list)) 659 (push function debug-function-list))
653 function) 660 function)
654 661
655;;;###autoload 662;;;###autoload
@@ -664,45 +671,52 @@ If argument is nil or an empty string, cancel for all functions."
664 (if name (intern name))))) 671 (if name (intern name)))))
665 (if (and function (not (string= function ""))) 672 (if (and function (not (string= function "")))
666 (progn 673 (progn
667 (let ((f (debug-on-entry-1 function nil))) 674 (let ((defn (debug-on-entry-1 function nil)))
668 (condition-case nil 675 (condition-case nil
669 (if (and (equal (nth 1 f) '(&rest debug-on-entry-args)) 676 (when (and (equal (nth 1 defn) '(&rest debug-on-entry-args))
670 (eq (car (nth 3 f)) 'apply)) 677 (eq (car (nth 3 defn)) 'apply))
671 ;; `f' is a wrapper introduced in debug-on-entry. 678 ;; `defn' is a wrapper introduced in debug-on-entry.
672 ;; Get rid of it since we don't need it any more. 679 ;; Get rid of it since we don't need it any more.
673 (setq f (nth 1 (nth 1 (nth 3 f))))) 680 (setq defn (nth 1 (nth 1 (nth 3 defn)))))
674 (error nil)) 681 (error nil))
675 (fset function f)) 682 (fset function defn))
676 (setq debug-function-list (delq function debug-function-list)) 683 (setq debug-function-list (delq function debug-function-list))
677 function) 684 function)
678 (message "Cancelling debug-on-entry for all functions") 685 (message "Cancelling debug-on-entry for all functions")
679 (mapcar 'cancel-debug-on-entry debug-function-list))) 686 (mapcar 'cancel-debug-on-entry debug-function-list)))
680 687
681(defun debug-convert-byte-code (function) 688(defun debug-convert-byte-code (function)
682 (let ((defn (symbol-function function))) 689 (let* ((defn (symbol-function function))
683 (if (not (consp defn)) 690 (macro (eq (car-safe defn) 'macro)))
684 ;; Assume a compiled code object. 691 (when macro (setq defn (cdr defn)))
685 (let* ((contents (append defn nil)) 692 (unless (consp defn)
686 (body 693 ;; Assume a compiled code object.
687 (list (list 'byte-code (nth 1 contents) 694 (let* ((contents (append defn nil))
688 (nth 2 contents) (nth 3 contents))))) 695 (body
689 (if (nthcdr 5 contents) 696 (list (list 'byte-code (nth 1 contents)
690 (setq body (cons (list 'interactive (nth 5 contents)) body))) 697 (nth 2 contents) (nth 3 contents)))))
691 (if (nth 4 contents) 698 (if (nthcdr 5 contents)
692 ;; Use `documentation' here, to get the actual string, 699 (setq body (cons (list 'interactive (nth 5 contents)) body)))
693 ;; in case the compiled function has a reference 700 (if (nth 4 contents)
694 ;; to the .elc file. 701 ;; Use `documentation' here, to get the actual string,
695 (setq body (cons (documentation function) body))) 702 ;; in case the compiled function has a reference
696 (fset function (cons 'lambda (cons (car contents) body))))))) 703 ;; to the .elc file.
704 (setq body (cons (documentation function) body)))
705 (setq defn (cons 'lambda (cons (car contents) body))))
706 (when macro (setq defn (cons 'macro defn)))
707 (fset function defn))))
697 708
698(defun debug-on-entry-1 (function flag) 709(defun debug-on-entry-1 (function flag)
699 (let* ((defn (symbol-function function)) 710 (let* ((defn (symbol-function function))
700 (tail defn)) 711 (tail defn))
701 (if (subrp tail) 712 (when (eq (car-safe tail) 'macro)
702 (error "%s is a built-in function" function) 713 (setq tail (cdr tail)))
703 (if (eq (car tail) 'macro) (setq tail (cdr tail))) 714 (if (not (eq (car-safe tail) 'lambda))
704 (if (eq (car tail) 'lambda) (setq tail (cdr tail)) 715 ;; Only signal an error when we try to set debug-on-entry.
705 (error "%s not user-defined Lisp function" function)) 716 ;; When we try to clear debug-on-entry, we are now done.
717 (when flag
718 (error "%s is not a user-defined Lisp function" function))
719 (setq tail (cdr tail))
706 ;; Skip the docstring. 720 ;; Skip the docstring.
707 (when (and (stringp (cadr tail)) (cddr tail)) 721 (when (and (stringp (cadr tail)) (cddr tail))
708 (setq tail (cdr tail))) 722 (setq tail (cdr tail)))
@@ -713,8 +727,8 @@ If argument is nil or an empty string, cancel for all functions."
713 ;; Add/remove debug statement as needed. 727 ;; Add/remove debug statement as needed.
714 (if flag 728 (if flag
715 (setcdr tail (cons '(implement-debug-on-entry) (cdr tail))) 729 (setcdr tail (cons '(implement-debug-on-entry) (cdr tail)))
716 (setcdr tail (cddr tail)))) 730 (setcdr tail (cddr tail)))))
717 defn))) 731 defn))
718 732
719(defun debugger-list-functions () 733(defun debugger-list-functions ()
720 "Display a list of all the functions now set to debug on entry." 734 "Display a list of all the functions now set to debug on entry."
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index b6b91710ed4..a96b1741139 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -1,6 +1,7 @@
1;;; easy-mmode.el --- easy definition for major and minor modes 1;;; easy-mmode.el --- easy definition for major and minor modes
2 2
3;; Copyright (C) 1997,2000,01,02,03,2004 Free Software Foundation, Inc. 3;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004, 2005
4;; Free Software Foundation, Inc.
4 5
5;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr> 6;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr>
6;; Maintainer: Stefan Monnier <monnier@gnu.org> 7;; Maintainer: Stefan Monnier <monnier@gnu.org>
@@ -152,8 +153,8 @@ For example, you could write
152 (unless group 153 (unless group
153 ;; We might as well provide a best-guess default group. 154 ;; We might as well provide a best-guess default group.
154 (setq group 155 (setq group
155 `(:group ',(or (custom-current-group) 156 `(:group (or (custom-current-group)
156 (intern (replace-regexp-in-string 157 ',(intern (replace-regexp-in-string
157 "-mode\\'" "" mode-name)))))) 158 "-mode\\'" "" mode-name))))))
158 159
159 `(progn 160 `(progn
@@ -253,8 +254,9 @@ With zero or negative ARG turn mode off.
253;;; 254;;;
254 255
255;;;###autoload 256;;;###autoload
256(defmacro easy-mmode-define-global-mode (global-mode mode turn-on 257(defalias 'easy-mmode-define-global-mode 'define-global-minor-mode)
257 &rest keys) 258;;;###autoload
259(defmacro define-global-minor-mode (global-mode mode turn-on &rest keys)
258 "Make GLOBAL-MODE out of the buffer-local minor MODE. 260 "Make GLOBAL-MODE out of the buffer-local minor MODE.
259TURN-ON is a function that will be called with no args in every buffer 261TURN-ON is a function that will be called with no args in every buffer
260 and that should try to turn MODE on if applicable for that buffer. 262 and that should try to turn MODE on if applicable for that buffer.
@@ -278,8 +280,8 @@ KEYS is a list of CL-style keyword arguments:
278 (unless group 280 (unless group
279 ;; We might as well provide a best-guess default group. 281 ;; We might as well provide a best-guess default group.
280 (setq group 282 (setq group
281 `(:group ',(or (custom-current-group) 283 `(:group (or (custom-current-group)
282 (intern (replace-regexp-in-string 284 ',(intern (replace-regexp-in-string
283 "-mode\\'" "" (symbol-name mode))))))) 285 "-mode\\'" "" (symbol-name mode)))))))
284 286
285 `(progn 287 `(progn
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index bc868759d92..f31dafb7b11 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -1,6 +1,7 @@
1;;; eldoc.el --- show function arglist or variable docstring in echo area 1;;; eldoc.el --- show function arglist or variable docstring in echo area
2 2
3;; Copyright (C) 1996, 97, 98, 99, 2000, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2003, 2005
4;; Free Software Foundation, Inc.
4 5
5;; Author: Noah Friedman <friedman@splode.com> 6;; Author: Noah Friedman <friedman@splode.com>
6;; Maintainer: friedman@splode.com 7;; Maintainer: friedman@splode.com
@@ -150,7 +151,7 @@ If point is over a documented variable, print that variable's docstring
150instead. 151instead.
151 152
152With prefix ARG, turn ElDoc mode on if and only if ARG is positive." 153With prefix ARG, turn ElDoc mode on if and only if ARG is positive."
153 nil eldoc-minor-mode-string nil 154 :group 'eldoc :lighter eldoc-minor-mode-string
154 (setq eldoc-last-message nil) 155 (setq eldoc-last-message nil)
155 (if eldoc-mode 156 (if eldoc-mode
156 (progn 157 (progn
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index d72dc91ad2b..8852999db2d 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -1016,7 +1016,7 @@ If ARG is the atom `-', scroll upward by nearly full screen."
1016 (scroll-down arg) 1016 (scroll-down arg)
1017 (beginning-of-buffer (goto-char (point-min))))))) 1017 (beginning-of-buffer (goto-char (point-min)))))))
1018 1018
1019(put 'cua-scroll-up 'CUA 'move) 1019(put 'cua-scroll-down 'CUA 'move)
1020 1020
1021;;; Cursor indications 1021;;; Cursor indications
1022 1022
@@ -1307,6 +1307,7 @@ highlight the region using `transient-mark-mode'), and typed text replaces
1307the active selection. C-z, C-x, C-c, and C-v will undo, cut, copy, and 1307the active selection. C-z, C-x, C-c, and C-v will undo, cut, copy, and
1308paste (in addition to the normal emacs bindings)." 1308paste (in addition to the normal emacs bindings)."
1309 :global t 1309 :global t
1310 :group 'cua
1310 :set-after '(cua-enable-modeline-indications cua-use-hyper-key) 1311 :set-after '(cua-enable-modeline-indications cua-use-hyper-key)
1311 :require 'cua-base 1312 :require 'cua-base
1312 :link '(emacs-commentary-link "cua-base.el") 1313 :link '(emacs-commentary-link "cua-base.el")
diff --git a/lisp/files.el b/lisp/files.el
index dbc43e4a5a9..4551e6ddb66 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -291,7 +291,7 @@ from `mode-require-final-newline'."
291 :group 'editing-basics) 291 :group 'editing-basics)
292 292
293(defcustom mode-require-final-newline t 293(defcustom mode-require-final-newline t
294 "*Whether to add a newline at the end of the file, in certain major modes. 294 "*Whether to add a newline at end of file, in certain major modes.
295Those modes set `require-final-newline' to this value when you enable them. 295Those modes set `require-final-newline' to this value when you enable them.
296They do so because they are used for files that are supposed 296They do so because they are used for files that are supposed
297to end in newlines, and the question is how to arrange that. 297to end in newlines, and the question is how to arrange that.
@@ -299,10 +299,16 @@ to end in newlines, and the question is how to arrange that.
299A value of t means do this only when the file is about to be saved. 299A value of t means do this only when the file is about to be saved.
300A value of `visit' means do this right after the file is visited. 300A value of `visit' means do this right after the file is visited.
301A value of `visit-save' means do it at both of those times. 301A value of `visit-save' means do it at both of those times.
302Any other non-nil value means ask user whether to add a newline, when saving." 302Any other non-nil value means ask user whether to add a newline, when saving.
303nil means don't add newlines.
304
305You will have to be careful if you set this to nil: you will have
306to remember to manually add a final newline whenever you finish a
307file that really needs one."
303 :type '(choice (const :tag "When visiting" visit) 308 :type '(choice (const :tag "When visiting" visit)
304 (const :tag "When saving" t) 309 (const :tag "When saving" t)
305 (const :tag "When visiting or saving" visit-save) 310 (const :tag "When visiting or saving" visit-save)
311 (const :tag "Never" nil)
306 (other :tag "Ask" ask)) 312 (other :tag "Ask" ask))
307 :group 'editing-basics 313 :group 'editing-basics
308 :version "22.1") 314 :version "22.1")
@@ -928,20 +934,31 @@ documentation for additional customization information."
928(defvar find-file-default nil 934(defvar find-file-default nil
929 "Used within `find-file-read-args'.") 935 "Used within `find-file-read-args'.")
930 936
937(defmacro minibuffer-with-setup-hook (fun &rest body)
938 "Add FUN to `minibuffer-setup-hook' while executing BODY.
939BODY should use the minibuffer at most once.
940Recursive uses of the minibuffer will not be affected."
941 (declare (indent 1) (debug t))
942 (let ((hook (make-symbol "setup-hook")))
943 `(let ((,hook
944 (lambda ()
945 ;; Clear out this hook so it does not interfere
946 ;; with any recursive minibuffer usage.
947 (remove-hook 'minibuffer-setup-hook ,hook)
948 (,fun))))
949 (unwind-protect
950 (progn
951 (add-hook 'minibuffer-setup-hook ,hook)
952 ,@body)
953 (remove-hook 'minibuffer-setup-hook ,hook)))))
954
931(defun find-file-read-args (prompt mustmatch) 955(defun find-file-read-args (prompt mustmatch)
932 (list (let ((find-file-default 956 (list (let ((find-file-default
933 (and buffer-file-name 957 (and buffer-file-name
934 (abbreviate-file-name buffer-file-name))) 958 (abbreviate-file-name buffer-file-name))))
935 (munge-default-fun 959 (minibuffer-with-setup-hook
936 (lambda () 960 (lambda () (setq minibuffer-default find-file-default))
937 (setq minibuffer-default find-file-default) 961 (read-file-name prompt nil default-directory mustmatch)))
938 ;; Clear out this hook so it does not interfere
939 ;; with any recursive minibuffer usage.
940 (pop minibuffer-setup-hook)))
941 (minibuffer-setup-hook
942 minibuffer-setup-hook))
943 (add-hook 'minibuffer-setup-hook munge-default-fun)
944 (read-file-name prompt nil default-directory mustmatch))
945 t)) 962 t))
946 963
947(defun find-file (filename &optional wildcards) 964(defun find-file (filename &optional wildcards)
diff --git a/lisp/filesets.el b/lisp/filesets.el
index faba379db03..5a4dd7bda9a 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -1,6 +1,6 @@
1;;; filesets.el --- handle group of files 1;;; filesets.el --- handle group of files
2 2
3;; Copyright (C) 2002 Free Software Foundation, Inc. 3;; Copyright (C) 2002, 2005 Free Software Foundation, Inc.
4 4
5;; Author: Thomas Link <t.link@gmx.at> 5;; Author: Thomas Link <t.link@gmx.at>
6;; Maintainer: FSF 6;; Maintainer: FSF
@@ -250,8 +250,15 @@ key is supported."
250; (customize-set-variable var val)) 250; (customize-set-variable var val))
251; (filesets-build-menu)) 251; (filesets-build-menu))
252 252
253;; It seems this is a workaround for the XEmacs issue described in the
254;; doc-string of filesets-menu-ensure-use-cached. Under Emacs this is
255;; essentially just `set-default'.
253(defun filesets-set-default (sym val &optional init-flag) 256(defun filesets-set-default (sym val &optional init-flag)
254 "Set-default wrapper function used in conjunction with `defcustom'." 257 "Set-default wrapper function used in conjunction with `defcustom'.
258If SYM is in the list `filesets-ignore-next-set-default', delete
259it from that list, and return nil. Otherwise, set the value of
260SYM to VAL and return t. If INIT-FLAG is non-nil, set with
261`custom-initialize-set', otherwise with `set-default'."
255 (let ((ignore-flag (member sym filesets-ignore-next-set-default))) 262 (let ((ignore-flag (member sym filesets-ignore-next-set-default)))
256 (if ignore-flag 263 (if ignore-flag
257 (setq filesets-ignore-next-set-default 264 (setq filesets-ignore-next-set-default
@@ -304,31 +311,26 @@ key is supported."
304 :type 'sexp 311 :type 'sexp
305 :group 'filesets) 312 :group 'filesets)
306 313
307(if filesets-running-xemacs 314(defcustom filesets-menu-path nil
308 (progn 315 "*The menu under which the filesets menu should be inserted.
309 (defcustom filesets-menu-path nil 316See `add-submenu' for documentation."
310 "*The menu under which the filesets menu should be inserted. 317 :set (function filesets-set-default)
311XEmacs specific; see `add-submenu' for documentation." 318 :type 'sexp
312 :set (function filesets-set-default) 319 :group 'filesets)
313 :type 'sexp 320
314 :group 'filesets) 321(defcustom filesets-menu-before "File"
315 322 "*The name of a menu before which this menu should be added.
316 (defcustom filesets-menu-before "File" 323See `add-submenu' for documentation."
317 "*The name of a menu before which this menu should be added. 324 :set (function filesets-set-default)
318XEmacs specific; see `add-submenu' for documentation." 325 :type 'sexp
319 :set (function filesets-set-default) 326 :group 'filesets)
320 :type 'sexp 327
321 :group 'filesets) 328(defcustom filesets-menu-in-menu nil
322 329 "*Use that instead of `current-menubar' as the menu to change.
323 (defcustom filesets-menu-in-menu nil 330See `add-submenu' for documentation."
324 "*Use that instead of `current-menubar' as the menu to change. 331 :set (function filesets-set-default)
325XEmacs specific; see `add-submenu' for documentation." 332 :type 'sexp
326 :set (function filesets-set-default) 333 :group 'filesets)
327 :type 'sexp
328 :group 'filesets))
329 (defvar filesets-menu-path nil)
330 (defvar filesets-menu-before nil)
331 (defvar filesets-menu-in-menu nil))
332 334
333(defcustom filesets-menu-shortcuts-flag t 335(defcustom filesets-menu-shortcuts-flag t
334 "*Non-nil means to prepend menus with hopefully unique shortcuts." 336 "*Non-nil means to prepend menus with hopefully unique shortcuts."
@@ -351,7 +353,7 @@ XEmacs specific; see `add-submenu' for documentation."
351(defcustom filesets-menu-cache-file 353(defcustom filesets-menu-cache-file
352 (if filesets-running-xemacs 354 (if filesets-running-xemacs
353 "~/.xemacs/filesets-cache.el" 355 "~/.xemacs/filesets-cache.el"
354 "~/.filesets-cache.el") 356 "~/.emacs.d/filesets-cache.el")
355 "*File to be used for saving the filesets menu between sessions. 357 "*File to be used for saving the filesets menu between sessions.
356Set this to \"\", to disable caching of menus. 358Set this to \"\", to disable caching of menus.
357Don't forget to check out `filesets-menu-ensure-use-cached'." 359Don't forget to check out `filesets-menu-ensure-use-cached'."
@@ -1070,9 +1072,7 @@ defined in `filesets-ingroup-patterns'."
1070;;; Emacs compatibility 1072;;; Emacs compatibility
1071(eval-and-compile 1073(eval-and-compile
1072 (if filesets-running-xemacs 1074 (if filesets-running-xemacs
1073 (progn 1075 (fset 'filesets-error 'error)
1074 (fset 'filesets-error 'error)
1075 (fset 'filesets-add-submenu 'add-submenu))
1076 1076
1077 (require 'easymenu) 1077 (require 'easymenu)
1078 1078
@@ -1080,12 +1080,6 @@ defined in `filesets-ingroup-patterns'."
1080 "`error' wrapper." 1080 "`error' wrapper."
1081 (error (mapconcat 'identity args " "))) 1081 (error (mapconcat 'identity args " ")))
1082 1082
1083 ;; This should work for 21.1 Emacs
1084 (defun filesets-add-submenu (menu-path submenu &optional
1085 before in-menu)
1086 "`easy-menu-define' wrapper."
1087 (easy-menu-define
1088 filesets-submenu global-map "Filesets menu" submenu))
1089 )) 1083 ))
1090 1084
1091(defun filesets-filter-dir-names (lst &optional negative) 1085(defun filesets-filter-dir-names (lst &optional negative)
@@ -2339,7 +2333,7 @@ bottom up, set `filesets-submenus' to nil, first.)"
2339 (filesets-menu-cache-file-save-maybe))) 2333 (filesets-menu-cache-file-save-maybe)))
2340 (let ((cb (current-buffer))) 2334 (let ((cb (current-buffer)))
2341 (when (not (member cb filesets-updated-buffers)) 2335 (when (not (member cb filesets-updated-buffers))
2342 (filesets-add-submenu 2336 (add-submenu
2343 filesets-menu-path 2337 filesets-menu-path
2344 `(,filesets-menu-name 2338 `(,filesets-menu-name
2345 ("# Filesets" 2339 ("# Filesets"
diff --git a/lisp/font-core.el b/lisp/font-core.el
index ea1880baac7..5bf30d4d6c5 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -148,7 +148,7 @@ buffer local value for `font-lock-defaults', via its mode hook.
148The above is the default behavior of `font-lock-mode'; you may specify 148The above is the default behavior of `font-lock-mode'; you may specify
149your own function which is called when `font-lock-mode' is toggled via 149your own function which is called when `font-lock-mode' is toggled via
150`font-lock-function'. " 150`font-lock-function'. "
151 nil nil nil 151 :group 'font-lock
152 ;; Don't turn on Font Lock mode if we don't have a display (we're running a 152 ;; Don't turn on Font Lock mode if we don't have a display (we're running a
153 ;; batch job) or if the buffer is invisible (the name starts with a space). 153 ;; batch job) or if the buffer is invisible (the name starts with a space).
154 (when (or noninteractive (eq (aref (buffer-name) 0) ?\ )) 154 (when (or noninteractive (eq (aref (buffer-name) 0) ?\ ))
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 2cdda321092..38d3b94bccf 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1097,7 +1097,7 @@ delimit the region to fontify."
1097 ((error quit) (message "Fontifying block...%s" error-data))))))) 1097 ((error quit) (message "Fontifying block...%s" error-data)))))))
1098 1098
1099(if (boundp 'facemenu-keymap) 1099(if (boundp 'facemenu-keymap)
1100 (define-key facemenu-keymap "\M-g" 'font-lock-fontify-block)) 1100 (define-key facemenu-keymap "\M-o" 'font-lock-fontify-block))
1101 1101
1102;;; End of Fontification functions. 1102;;; End of Fontification functions.
1103 1103
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index d39edbb7ef6..019456aae6b 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -170,7 +170,8 @@ generic-x to enable the specified modes."
170 '((nil "^\\([-A-Za-z0-9_]+\\)" 1) 170 '((nil "^\\([-A-Za-z0-9_]+\\)" 1)
171 ("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1) 171 ("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1)
172 ("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1)))))) 172 ("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1))))))
173 "Generic mode for Apache or HTTPD configuration files.")) 173 "Generic mode for Apache or HTTPD configuration files."
174 :group 'generic-x))
174 175
175(when (memq 'apache-log-generic-mode generic-extras-enable-list) 176(when (memq 'apache-log-generic-mode generic-extras-enable-list)
176 177
@@ -183,7 +184,8 @@ generic-x to enable the specified modes."
183 (2 font-lock-variable-name-face))) 184 (2 font-lock-variable-name-face)))
184 '("access_log\\'") 185 '("access_log\\'")
185 nil 186 nil
186 "Mode for Apache log files")) 187 "Mode for Apache log files"
188 :group 'generic-x))
187 189
188;;; Samba 190;;; Samba
189(when (memq 'samba-generic-mode generic-extras-enable-list) 191(when (memq 'samba-generic-mode generic-extras-enable-list)
@@ -197,7 +199,8 @@ generic-x to enable the specified modes."
197 (2 font-lock-type-face))) 199 (2 font-lock-type-face)))
198 '("smb\\.conf\\'") 200 '("smb\\.conf\\'")
199 '(generic-bracket-support) 201 '(generic-bracket-support)
200 "Generic mode for Samba configuration files.")) 202 "Generic mode for Samba configuration files."
203 :group 'generic-x))
201 204
202;;; Fvwm 205;;; Fvwm
203;; This is pretty basic. Also, modes for other window managers could 206;; This is pretty basic. Also, modes for other window managers could
@@ -222,7 +225,8 @@ generic-x to enable the specified modes."
222 nil 225 nil
223 '("\\.fvwmrc\\'" "\\.fvwm2rc\\'") 226 '("\\.fvwmrc\\'" "\\.fvwm2rc\\'")
224 nil 227 nil
225 "Generic mode for FVWM configuration files.")) 228 "Generic mode for FVWM configuration files."
229 :group 'generic-x))
226 230
227;;; X Resource 231;;; X Resource
228;; I'm pretty sure I've seen an actual mode to do this, but I don't 232;; I'm pretty sure I've seen an actual mode to do this, but I don't
@@ -235,7 +239,8 @@ generic-x to enable the specified modes."
235 '(("^\\([^:\n]+:\\)" 1 font-lock-variable-name-face)) 239 '(("^\\([^:\n]+:\\)" 1 font-lock-variable-name-face))
236 '("\\.Xdefaults\\'" "\\.Xresources\\'" "\\.Xenvironment\\'" "\\.ad\\'") 240 '("\\.Xdefaults\\'" "\\.Xresources\\'" "\\.Xenvironment\\'" "\\.ad\\'")
237 nil 241 nil
238 "Generic mode for X Resource configuration files.")) 242 "Generic mode for X Resource configuration files."
243 :group 'generic-x))
239 244
240;;; Hosts 245;;; Hosts
241(when (memq 'hosts-generic-mode generic-extras-enable-list) 246(when (memq 'hosts-generic-mode generic-extras-enable-list)
@@ -246,7 +251,8 @@ generic-x to enable the specified modes."
246 '(("\\([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+\\)" 1 font-lock-constant-face)) 251 '(("\\([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+\\)" 1 font-lock-constant-face))
247 '("[hH][oO][sS][tT][sS]\\'") 252 '("[hH][oO][sS][tT][sS]\\'")
248 nil 253 nil
249 "Generic mode for HOSTS files.")) 254 "Generic mode for HOSTS files."
255 :group 'generic-x))
250 256
251;;; Windows INF files 257;;; Windows INF files
252(when (memq 'inf-generic-mode generic-extras-enable-list) 258(when (memq 'inf-generic-mode generic-extras-enable-list)
@@ -257,7 +263,8 @@ generic-x to enable the specified modes."
257 '(("^\\(\\[.*\\]\\)" 1 font-lock-constant-face)) 263 '(("^\\(\\[.*\\]\\)" 1 font-lock-constant-face))
258 '("\\.[iI][nN][fF]\\'") 264 '("\\.[iI][nN][fF]\\'")
259 '(generic-bracket-support) 265 '(generic-bracket-support)
260 "Generic mode for MS-Windows INF files.")) 266 "Generic mode for MS-Windows INF files."
267 :group 'generic-x))
261 268
262;;; Windows INI files 269;;; Windows INI files
263;; Should define escape character as well! 270;; Should define escape character as well!
@@ -277,7 +284,8 @@ generic-x to enable the specified modes."
277 (setq imenu-generic-expression 284 (setq imenu-generic-expression
278 '((nil "^\\[\\(.*\\)\\]" 1) 285 '((nil "^\\[\\(.*\\)\\]" 1)
279 ("*Variables*" "^\\s-*\\([^=]+\\)\\s-*=" 1)))))) 286 ("*Variables*" "^\\s-*\\([^=]+\\)\\s-*=" 1))))))
280 "Generic mode for MS-Windows INI files.")) 287 "Generic mode for MS-Windows INI files."
288 :group 'generic-x))
281 289
282;;; Windows REG files 290;;; Windows REG files
283;;; Unfortunately, Windows 95 and Windows NT have different REG file syntax! 291;;; Unfortunately, Windows 95 and Windows NT have different REG file syntax!
@@ -294,7 +302,8 @@ generic-x to enable the specified modes."
294 (lambda () 302 (lambda ()
295 (setq imenu-generic-expression 303 (setq imenu-generic-expression
296 '((nil "^\\s-*\\(.*\\)\\s-*=" 1)))))) 304 '((nil "^\\s-*\\(.*\\)\\s-*=" 1))))))
297 "Generic mode for MS-Windows Registry files.")) 305 "Generic mode for MS-Windows Registry files."
306 :group 'generic-x))
298 307
299;;; DOS/Windows BAT files 308;;; DOS/Windows BAT files
300(when (memq 'bat-generic-mode generic-extras-enable-list) 309(when (memq 'bat-generic-mode generic-extras-enable-list)
@@ -368,7 +377,8 @@ generic-x to enable the specified modes."
368 "\\`[cC][oO][nN][fF][iI][gG]\\." 377 "\\`[cC][oO][nN][fF][iI][gG]\\."
369 "\\`[aA][uU][tT][oO][eE][xX][eE][cC]\\.") 378 "\\`[aA][uU][tT][oO][eE][xX][eE][cC]\\.")
370 '(generic-bat-mode-setup-function) 379 '(generic-bat-mode-setup-function)
371 "Generic mode for MS-Windows BAT files.") 380 "Generic mode for MS-Windows BAT files."
381 :group 'generic-x)
372 382
373(defvar bat-generic-mode-syntax-table nil 383(defvar bat-generic-mode-syntax-table nil
374 "Syntax table in use in bat-generic-mode buffers.") 384 "Syntax table in use in bat-generic-mode buffers.")
@@ -446,7 +456,8 @@ generic-x to enable the specified modes."
446 (lambda () 456 (lambda ()
447 (setq imenu-generic-expression 457 (setq imenu-generic-expression
448 '((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1)))))) 458 '((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1))))))
449 "Mode for Mailagent rules files.")) 459 "Mode for Mailagent rules files."
460 :group 'generic-x))
450 461
451;; Solaris/Sys V prototype files 462;; Solaris/Sys V prototype files
452(when (memq 'prototype-generic-mode generic-extras-enable-list) 463(when (memq 'prototype-generic-mode generic-extras-enable-list)
@@ -469,7 +480,8 @@ generic-x to enable the specified modes."
469 (2 font-lock-variable-name-face))) 480 (2 font-lock-variable-name-face)))
470 '("prototype\\'") 481 '("prototype\\'")
471 nil 482 nil
472 "Mode for Sys V prototype files.")) 483 "Mode for Sys V prototype files."
484 :group 'generic-x))
473 485
474;; Solaris/Sys V pkginfo files 486;; Solaris/Sys V pkginfo files
475(when (memq 'pkginfo-generic-mode generic-extras-enable-list) 487(when (memq 'pkginfo-generic-mode generic-extras-enable-list)
@@ -482,7 +494,8 @@ generic-x to enable the specified modes."
482 (2 font-lock-variable-name-face))) 494 (2 font-lock-variable-name-face)))
483 '("pkginfo\\'") 495 '("pkginfo\\'")
484 nil 496 nil
485 "Mode for Sys V pkginfo files.")) 497 "Mode for Sys V pkginfo files."
498 :group 'generic-x))
486 499
487;; Javascript mode 500;; Javascript mode
488;; Includes extra keywords from Armando Singer [asinger@MAIL.COLGATE.EDU] 501;; Includes extra keywords from Armando Singer [asinger@MAIL.COLGATE.EDU]
@@ -559,7 +572,8 @@ generic-x to enable the specified modes."
559 (setq imenu-generic-expression 572 (setq imenu-generic-expression
560 '((nil "^function\\s-+\\([A-Za-z0-9_]+\\)" 1) 573 '((nil "^function\\s-+\\([A-Za-z0-9_]+\\)" 1)
561 ("*Variables*" "^var\\s-+\\([A-Za-z0-9_]+\\)" 1)))))) 574 ("*Variables*" "^var\\s-+\\([A-Za-z0-9_]+\\)" 1))))))
562 "Mode for JavaScript files.") 575 "Mode for JavaScript files."
576 :group 'generic-x)
563 577
564;; VRML files 578;; VRML files
565(define-generic-mode vrml-generic-mode 579(define-generic-mode vrml-generic-mode
@@ -610,7 +624,8 @@ generic-x to enable the specified modes."
610 ("*Definitions*" 624 ("*Definitions*"
611 "DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{" 625 "DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{"
612 1)))))) 626 1))))))
613 "Generic Mode for VRML files.") 627 "Generic Mode for VRML files."
628 :group 'generic-x)
614 629
615;; Java Manifests 630;; Java Manifests
616(define-generic-mode java-manifest-generic-mode 631(define-generic-mode java-manifest-generic-mode
@@ -629,7 +644,8 @@ generic-x to enable the specified modes."
629 (2 font-lock-constant-face))) 644 (2 font-lock-constant-face)))
630 '("[mM][aA][nN][iI][fF][eE][sS][tT]\\.[mM][fF]\\'") 645 '("[mM][aA][nN][iI][fF][eE][sS][tT]\\.[mM][fF]\\'")
631 nil 646 nil
632 "Mode for Java Manifest files") 647 "Mode for Java Manifest files"
648 :group 'generic-x)
633 649
634;; Java properties files 650;; Java properties files
635(define-generic-mode java-properties-generic-mode 651(define-generic-mode java-properties-generic-mode
@@ -659,7 +675,8 @@ generic-x to enable the specified modes."
659 (lambda () 675 (lambda ()
660 (setq imenu-generic-expression 676 (setq imenu-generic-expression
661 '((nil "^\\([^#! \t\n\r=:]+\\)" 1)))))) 677 '((nil "^\\([^#! \t\n\r=:]+\\)" 1))))))
662 "Mode for Java properties files.") 678 "Mode for Java properties files."
679 :group 'generic-x)
663 680
664;; C shell alias definitions 681;; C shell alias definitions
665(when (memq 'alias-generic-mode generic-extras-enable-list) 682(when (memq 'alias-generic-mode generic-extras-enable-list)
@@ -677,7 +694,8 @@ generic-x to enable the specified modes."
677 (lambda () 694 (lambda ()
678 (setq imenu-generic-expression 695 (setq imenu-generic-expression
679 '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2)))))) 696 '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2))))))
680 "Mode for C Shell alias files.")) 697 "Mode for C Shell alias files."
698 :group 'generic-x))
681 699
682;;; Windows RC files 700;;; Windows RC files
683;; Contributed by ACorreir@pervasive-sw.com (Alfred Correira) 701;; Contributed by ACorreir@pervasive-sw.com (Alfred Correira)
@@ -769,7 +787,8 @@ generic-x to enable the specified modes."
769 (2 font-lock-variable-name-face nil t)))) 787 (2 font-lock-variable-name-face nil t))))
770 '("\\.[rR][cC]$") 788 '("\\.[rR][cC]$")
771 nil 789 nil
772 "Generic mode for MS-Windows Resource files.")) 790 "Generic mode for MS-Windows Resource files."
791 :group 'generic-x))
773 792
774;; InstallShield RUL files 793;; InstallShield RUL files
775;; Contributed by Alfred.Correira@Pervasive.Com 794;; Contributed by Alfred.Correira@Pervasive.Com
@@ -1389,7 +1408,8 @@ generic-x to enable the specified modes."
1389 font-lock-variable-name-face "[^_]" "[^_]"))) ; is this face the best choice? 1408 font-lock-variable-name-face "[^_]" "[^_]"))) ; is this face the best choice?
1390 '("\\.[rR][uU][lL]$") 1409 '("\\.[rR][uU][lL]$")
1391 '(generic-rul-mode-setup-function) 1410 '(generic-rul-mode-setup-function)
1392 "Generic mode for InstallShield RUL files.") 1411 "Generic mode for InstallShield RUL files."
1412 :group 'generic-x)
1393 1413
1394(define-skeleton rul-if 1414(define-skeleton rul-if
1395 "Insert an if statement." 1415 "Insert an if statement."
@@ -1437,7 +1457,8 @@ generic-x to enable the specified modes."
1437 (2 font-lock-variable-name-face))) 1457 (2 font-lock-variable-name-face)))
1438 '("\\.mailrc\\'") 1458 '("\\.mailrc\\'")
1439 nil 1459 nil
1440 "Mode for mailrc files.") 1460 "Mode for mailrc files."
1461 :group 'generic-x)
1441 1462
1442;; Inetd.conf 1463;; Inetd.conf
1443(when (memq 'inetd-conf-generic-mode generic-extras-enable-list) 1464(when (memq 'inetd-conf-generic-mode generic-extras-enable-list)
@@ -1457,7 +1478,8 @@ generic-x to enable the specified modes."
1457 (function 1478 (function
1458 (lambda () 1479 (lambda ()
1459 (setq imenu-generic-expression 1480 (setq imenu-generic-expression
1460 '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))) 1481 '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))
1482 :group 'generic-x))
1461 1483
1462;; Services 1484;; Services
1463(when (memq 'etc-services-generic-mode generic-extras-enable-list) 1485(when (memq 'etc-services-generic-mode generic-extras-enable-list)
@@ -1475,7 +1497,8 @@ generic-x to enable the specified modes."
1475 (function 1497 (function
1476 (lambda () 1498 (lambda ()
1477 (setq imenu-generic-expression 1499 (setq imenu-generic-expression
1478 '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))) 1500 '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))
1501 :group 'generic-x))
1479 1502
1480;; Password and Group files 1503;; Password and Group files
1481(when (memq 'etc-passwd-generic-mode generic-extras-enable-list) 1504(when (memq 'etc-passwd-generic-mode generic-extras-enable-list)
@@ -1517,7 +1540,8 @@ generic-x to enable the specified modes."
1517 (function 1540 (function
1518 (lambda () 1541 (lambda ()
1519 (setq imenu-generic-expression 1542 (setq imenu-generic-expression
1520 '((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))))) 1543 '((nil "^\\([-A-Za-z0-9_]+\\):" 1))))))
1544 :group 'generic-x))
1521 1545
1522;; Fstab 1546;; Fstab
1523(when (memq 'etc-fstab-generic-mode generic-extras-enable-list) 1547(when (memq 'etc-fstab-generic-mode generic-extras-enable-list)
@@ -1567,7 +1591,8 @@ generic-x to enable the specified modes."
1567 (function 1591 (function
1568 (lambda () 1592 (lambda ()
1569 (setq imenu-generic-expression 1593 (setq imenu-generic-expression
1570 '((nil "^\\([/-A-Za-z0-9_]+\\)\\s-+" 1)))))))) 1594 '((nil "^\\([/-A-Za-z0-9_]+\\)\\s-+" 1))))))
1595 :group 'generic-x))
1571 1596
1572;; From Jacques Duthen <jacques.duthen@sncf.fr> 1597;; From Jacques Duthen <jacques.duthen@sncf.fr>
1573(eval-when-compile 1598(eval-when-compile
@@ -1609,7 +1634,8 @@ generic-x to enable the specified modes."
1609 nil ;; no auto-mode-alist 1634 nil ;; no auto-mode-alist
1610 ;; '(show-tabs-generic-mode-hook-fun) 1635 ;; '(show-tabs-generic-mode-hook-fun)
1611 nil 1636 nil
1612 "Generic mode to show tabs and trailing spaces") 1637 "Generic mode to show tabs and trailing spaces"
1638 :group 'generic-x)
1613 1639
1614;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1640;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1615;; DNS modes 1641;; DNS modes
@@ -1630,7 +1656,8 @@ generic-x to enable the specified modes."
1630 ;; List of additional automode-alist expressions 1656 ;; List of additional automode-alist expressions
1631 '("/etc/named.boot\\'") 1657 '("/etc/named.boot\\'")
1632 ;; List of set up functions to call 1658 ;; List of set up functions to call
1633 nil) 1659 nil
1660 :group 'generic-x)
1634 1661
1635(define-generic-mode named-database-generic-mode 1662(define-generic-mode named-database-generic-mode
1636 ;; List of comment characters 1663 ;; List of comment characters
@@ -1643,7 +1670,8 @@ generic-x to enable the specified modes."
1643 ;; List of additional automode-alist expressions 1670 ;; List of additional automode-alist expressions
1644 nil 1671 nil
1645 ;; List of set up functions to call 1672 ;; List of set up functions to call
1646 nil) 1673 nil
1674 :group 'generic-x)
1647 1675
1648(defvar named-database-time-string "%Y%m%d%H" 1676(defvar named-database-time-string "%Y%m%d%H"
1649 "Timestring for named serial numbers.") 1677 "Timestring for named serial numbers.")
@@ -1663,7 +1691,8 @@ generic-x to enable the specified modes."
1663 ;; List of additional automode-alist expressions 1691 ;; List of additional automode-alist expressions
1664 '("/etc/resolv[e]?.conf\\'") 1692 '("/etc/resolv[e]?.conf\\'")
1665 ;; List of set up functions to call 1693 ;; List of set up functions to call
1666 nil) 1694 nil
1695 :group 'generic-x)
1667 1696
1668;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1697;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1669;; Modes for spice and common electrical engineering circuit netlist formats 1698;; Modes for spice and common electrical engineering circuit netlist formats
@@ -1705,7 +1734,8 @@ generic-x to enable the specified modes."
1705 (function 1734 (function
1706 (lambda() 1735 (lambda()
1707 (setq font-lock-defaults '(generic-font-lock-keywords nil t))))) 1736 (setq font-lock-defaults '(generic-font-lock-keywords nil t)))))
1708 "Generic mode for SPICE circuit netlist files.") 1737 "Generic mode for SPICE circuit netlist files."
1738 :group 'generic-x)
1709 1739
1710(define-generic-mode ibis-generic-mode 1740(define-generic-mode ibis-generic-mode
1711 '(?|) 1741 '(?|)
@@ -1714,7 +1744,8 @@ generic-x to enable the specified modes."
1714 ("\\(\\(_\\|\\w\\)+\\)\\s-*=" 1 font-lock-variable-name-face)) 1744 ("\\(\\(_\\|\\w\\)+\\)\\s-*=" 1 font-lock-variable-name-face))
1715 '("\\.[iI][bB][sS]\\'") 1745 '("\\.[iI][bB][sS]\\'")
1716 '(generic-bracket-support) 1746 '(generic-bracket-support)
1717 "Generic mode for IBIS circuit netlist files.") 1747 "Generic mode for IBIS circuit netlist files."
1748 :group 'generic-x)
1718 1749
1719(define-generic-mode astap-generic-mode 1750(define-generic-mode astap-generic-mode
1720 nil 1751 nil
@@ -1749,7 +1780,8 @@ generic-x to enable the specified modes."
1749 (function 1780 (function
1750 (lambda() 1781 (lambda()
1751 (setq font-lock-defaults '(generic-font-lock-keywords nil t))))) 1782 (setq font-lock-defaults '(generic-font-lock-keywords nil t)))))
1752 "Generic mode for ASTAP circuit netlist files.") 1783 "Generic mode for ASTAP circuit netlist files."
1784 :group 'generic-x)
1753 1785
1754(define-generic-mode etc-modules-conf-generic-mode 1786(define-generic-mode etc-modules-conf-generic-mode
1755 ;; List of comment characters 1787 ;; List of comment characters
@@ -1791,7 +1823,8 @@ generic-x to enable the specified modes."
1791 ;; List of additional automode-alist expressions 1823 ;; List of additional automode-alist expressions
1792 '("/etc/modules.conf" "/etc/conf.modules") 1824 '("/etc/modules.conf" "/etc/conf.modules")
1793 ;; List of set up functions to call 1825 ;; List of set up functions to call
1794 nil) 1826 nil
1827 :group 'generic-x)
1795 1828
1796(provide 'generic-x) 1829(provide 'generic-x)
1797 1830
diff --git a/lisp/generic.el b/lisp/generic.el
index e20f73688c7..e170d05e0f3 100644
--- a/lisp/generic.el
+++ b/lisp/generic.el
@@ -185,7 +185,8 @@ the regexp in `generic-find-file-regexp'. If the value is nil,
185;;;###autoload 185;;;###autoload
186(defmacro define-generic-mode (mode comment-list keyword-list 186(defmacro define-generic-mode (mode comment-list keyword-list
187 font-lock-list auto-mode-list 187 font-lock-list auto-mode-list
188 function-list &optional docstring) 188 function-list &optional docstring
189 &rest custom-keyword-args)
189 "Create a new generic mode MODE. 190 "Create a new generic mode MODE.
190 191
191MODE is the name of the command for the generic mode; it need not 192MODE is the name of the command for the generic mode; it need not
@@ -216,59 +217,90 @@ as soon as `define-generic-mode' is called.
216FUNCTION-LIST is a list of functions to call to do some 217FUNCTION-LIST is a list of functions to call to do some
217additional setup. 218additional setup.
218 219
220The optional CUSTOM-KEYWORD-ARGS are pairs of keywords and
221values. They will be passed to the generated `defcustom' form of
222the mode hook variable MODE-hook. You can specify keyword
223arguments without specifying a docstring.
224
219See the file generic-x.el for some examples of `define-generic-mode'." 225See the file generic-x.el for some examples of `define-generic-mode'."
220 (let* ((name-unquoted (if (eq (car-safe mode) 'quote) ; Backward compatibility. 226 (declare (debug (sexp def-form def-form def-form form def-form
221 (eval mode) 227 &optional stringp))
222 mode)) 228 (indent 1))
223 (name-string (symbol-name name-unquoted)) 229
230 ;; Backward compatibility.
231 (when (eq (car-safe mode) 'quote)
232 (setq mode (eval mode)))
233
234 (when (and docstring (not (stringp docstring)))
235 ;; DOCSTRING is not a string so we assume that it's actually the
236 ;; first keyword of CUSTOM-KEYWORD-ARGS.
237 (push docstring custom-keyword-args)
238 (setq docstring nil))
239
240 (let* ((mode-name (symbol-name mode))
224 (pretty-name (capitalize (replace-regexp-in-string 241 (pretty-name (capitalize (replace-regexp-in-string
225 "-mode\\'" "" name-string)))) 242 "-mode\\'" "" mode-name)))
243 (mode-hook (intern (concat mode-name "-hook"))))
244
245 (unless (plist-get custom-keyword-args :group)
246 (setq custom-keyword-args
247 (plist-put custom-keyword-args
248 :group `(or (custom-current-group)
249 ',(intern (replace-regexp-in-string
250 "-mode\\'" "" mode-name))))))
226 251
227 `(progn 252 `(progn
228 ;; Add a new entry. 253 ;; Add a new entry.
229 (add-to-list 'generic-mode-list ,name-string) 254 (add-to-list 'generic-mode-list ,mode-name)
230 255
231 ;; Add it to auto-mode-alist 256 ;; Add it to auto-mode-alist
232 (dolist (re ,auto-mode-list) 257 (dolist (re ,auto-mode-list)
233 (add-to-list 'auto-mode-alist (cons re ',name-unquoted))) 258 (add-to-list 'auto-mode-alist (cons re ',mode)))
259
260 (defcustom ,mode-hook nil
261 ,(concat "Hook run when entering " pretty-name " mode.")
262 :type 'hook
263 ,@custom-keyword-args)
234 264
235 (defun ,name-unquoted () 265 (defun ,mode ()
236 ,(or docstring 266 ,(or docstring
237 (concat pretty-name " mode.\n" 267 (concat pretty-name " mode.\n"
238 "This a generic mode defined with `define-generic-mode'.")) 268 "This a generic mode defined with `define-generic-mode'."))
239 (interactive) 269 (interactive)
240 (generic-mode-internal ',name-unquoted ,comment-list ,keyword-list 270 (generic-mode-internal ',mode ,comment-list ,keyword-list
241 ,font-lock-list ,function-list))))) 271 ,font-lock-list ,function-list)))))
242 272
243;;;###autoload 273;;;###autoload
244(defun generic-mode-internal (mode comments keywords font-lock-list funs) 274(defun generic-mode-internal (mode comment-list keyword-list
275 font-lock-list function-list)
245 "Go into the generic mode MODE." 276 "Go into the generic mode MODE."
246 (let* ((modename (symbol-name mode)) 277 (let* ((mode-name (symbol-name mode))
247 (generic-mode-hooks (intern (concat modename "-hook")))
248 (pretty-name (capitalize (replace-regexp-in-string 278 (pretty-name (capitalize (replace-regexp-in-string
249 "-mode\\'" "" modename)))) 279 "-mode\\'" "" mode-name)))
280 (mode-hook (intern (concat mode-name "-hook"))))
250 281
251 (kill-all-local-variables) 282 (kill-all-local-variables)
252 283
253 (setq major-mode mode 284 (setq major-mode mode
254 mode-name pretty-name) 285 mode-name pretty-name)
255 286
256 (generic-mode-set-comments comments) 287 (generic-mode-set-comments comment-list)
257 288
258 ;; Font-lock functionality. 289 ;; Font-lock functionality.
259 ;; Font-lock-defaults is always set even if there are no keywords 290 ;; Font-lock-defaults is always set even if there are no keywords
260 ;; or font-lock expressions, so comments can be highlighted. 291 ;; or font-lock expressions, so comments can be highlighted.
261 (setq generic-font-lock-keywords 292 (setq generic-font-lock-keywords
262 (append 293 (append
263 (when keywords 294 (when keyword-list
264 (list (generic-make-keywords-list keywords font-lock-keyword-face))) 295 (list (generic-make-keywords-list keyword-list
296 font-lock-keyword-face)))
265 font-lock-list)) 297 font-lock-list))
266 (setq font-lock-defaults '(generic-font-lock-keywords nil)) 298 (setq font-lock-defaults '(generic-font-lock-keywords nil))
267 299
268 ;; Call a list of functions 300 ;; Call a list of functions
269 (mapcar 'funcall funs) 301 (mapcar 'funcall function-list)
270 302
271 (run-hooks generic-mode-hooks))) 303 (run-mode-hooks mode-hook)))
272 304
273;;;###autoload 305;;;###autoload
274(defun generic-mode (mode) 306(defun generic-mode (mode)
@@ -359,7 +391,7 @@ Some generic modes are defined in `generic-x.el'."
359 imenu-case-fold-search t)) 391 imenu-case-fold-search t))
360 392
361;; This generic mode is always defined 393;; This generic mode is always defined
362(define-generic-mode default-generic-mode (list ?#) nil nil nil nil) 394(define-generic-mode default-generic-mode (list ?#) nil nil nil nil :group 'generic)
363 395
364;; A more general solution would allow us to enter generic-mode for 396;; A more general solution would allow us to enter generic-mode for
365;; *any* comment character, but would require us to synthesize a new 397;; *any* comment character, but would require us to synthesize a new
@@ -392,7 +424,7 @@ This hook will be installed if the variable
392 424
393(defun generic-mode-ini-file-find-file-hook () 425(defun generic-mode-ini-file-find-file-hook ()
394 "Hook function to enter Default-Generic mode automatically for INI files. 426 "Hook function to enter Default-Generic mode automatically for INI files.
395Done if the first few lines of a file in Fundamental mode look like an 427Done if the first few lines of a file in Fundamental mode look like an
396INI file. This hook is NOT installed by default." 428INI file. This hook is NOT installed by default."
397 (and (eq major-mode 'fundamental-mode) 429 (and (eq major-mode 'fundamental-mode)
398 (save-excursion 430 (save-excursion
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 5d15a6f9646..b19598eb3ab 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,99 @@
12005-04-03 Katsumi Yamaoka <yamaoka@jpl.org>
2
3 * gnus-sum.el (gnus-summary-make-menu-bar): Fix an
4 "unrecognised menu descriptor" error.
5
62005-03-25 Katsumi Yamaoka <yamaoka@jpl.org>
7
8 * message.el (message-resend): Bind rfc2047-encode-encoded-words.
9
10 * mm-util.el (mm-replace-in-string): New function.
11 (mm-xemacs-find-mime-charset-1): Ignore errors while loading
12 latin-unity, which cannot be used with XEmacs 21.1.
13
14 * rfc2047.el (rfc2047-encode-function-alist): Rename from
15 rfc2047-encoding-function-alist in order to avoid conflicting with
16 the old version.
17 (rfc2047-encode-message-header): Remove useless goto-char.
18 (rfc2047-encodable-p): Don't move point.
19 (rfc2047-syntax-table): Treat `(' and `)' as is.
20 (rfc2047-encode-region): Concatenate words containing non-ASCII
21 characters in structured fields; don't encode space-delimited
22 ASCII words even in unstructured fields; don't break words at
23 char-category boundaries; encode encoded words in structured
24 fields; treat text within parentheses as special; show the
25 original text when error has occurred; move point to the end of
26 the region after encoding, suggested by IRIE Tetsuya
27 <irie@t.email.ne.jp>; treat backslash-quoted characters as
28 non-special; check carefully whether to encode special characters;
29 fix some kind of misconfigured headers; signal a real error if
30 debug-on-quit or debug-on-error is non-nil; don't infloop,
31 suggested by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>; assume
32 the close parenthesis may be included in the encoded word; encode
33 bogus delimiters.
34 (rfc2047-encode-string): Use mm-with-multibyte-buffer.
35 (rfc2047-encode-max-chars): New variable.
36 (rfc2047-encode-1): New function.
37 (rfc2047-encode): Use it; encode text so that it occupies the
38 maximum width within 76-column; work correctly on Q encoding for
39 iso-2022-* charsets; fold the line before encoding; don't append a
40 space if the encoded word includes close parenthesis.
41 (rfc2047-fold-region): Use existing whitespace for LWSP; make it
42 sure not to break a line just after the header name.
43 (rfc2047-b-encode-region): Remove.
44 (rfc2047-b-encode-string): New function.
45 (rfc2047-q-encode-region): Remove.
46 (rfc2047-q-encode-string): New function.
47 (rfc2047-encode-parameter): New function.
48 (rfc2047-encoded-word-regexp): Don't use shy group.
49 (rfc2047-decode-region): Follow rfc2047-encoded-word-regexp change.
50 (rfc2047-parse-and-decode): Ditto.
51 (rfc2047-decode): Treat the ascii coding-system as raw-text by
52 default.
53
542005-03-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
55
56 * rfc2047.el (rfc2047-encode-encoded-words): New variable.
57 (rfc2047-field-value): Strip props.
58 (rfc2047-encode-message-header): Disabled header folding -- not
59 all headers can be folded, and this should be done by the message
60 composition mode. Probably. I think.
61 (rfc2047-encodable-p): Say that =? needs encoding.
62 (rfc2047-encode-region): Encode =? strings.
63
642005-03-25 Jesper Harder <harder@ifa.au.dk>
65
66 * rfc2047.el (rfc2047-encoded-word-regexp): Support RFC 2231
67 language tags; remove unnecessary '+'. Reported by Stefan Wiens
68 <s.wi@gmx.net>.
69 (rfc2047-decode-string): Don't cons a string unnecessarily.
70 (rfc2047-parse-and-decode, rfc2047-decode): Use a character for
71 the encoding to avoid consing a string.
72 (rfc2047-decode): Use mm-subst-char-in-string instead of
73 mm-replace-chars-in-string.
74
752005-03-25 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
76
77 * rfc2047.el (rfc2047-encode): Use uppercase letters to specify
78 encodings of MIME-encoded words, in order to improve
79 interoperability with several broken MUAs.
80
812005-03-21 Reiner Steib <Reiner.Steib@gmx.de>
82
83 * gnus-srvr.el (gnus-browse-select-group): Add NUMBER argument and
84 pass it to `gnus-browse-read-group'.
85 (gnus-browse-read-group): Add NUMBER argument and pass it to
86 `gnus-group-read-ephemeral-group'.
87
88 * gnus-group.el (gnus-group-read-ephemeral-group): Add NUMBER
89 argument and pass it to `gnus-group-read-group'.
90
912005-03-19 Aidan Kehoe <kehoea@parhasard.net>
92
93 * mm-util.el (mm-xemacs-find-mime-charset): Only call
94 mm-xemacs-find-mime-charset-1 if we have the mule feature
95 available at runtime.
96
12005-03-25 Werner Lemberg <wl@gnu.org> 972005-03-25 Werner Lemberg <wl@gnu.org>
2 98
3 * nnmaildir.el: Replace `illegal' with `invalid'. 99 * nnmaildir.el: Replace `illegal' with `invalid'.
@@ -618,7 +714,7 @@
618 unless plugged. Disable the agent so that an open failure causes 714 unless plugged. Disable the agent so that an open failure causes
619 an error. 715 an error.
620 716
6212004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Reiner Steib <Reiner.Steib@gmx.de> 7172004-10-18 Reiner Steib <Reiner.Steib@gmx.de>
622 718
623 * gnus-agent.el (gnus-agent-fetched-hook): Add :version. 719 * gnus-agent.el (gnus-agent-fetched-hook): Add :version.
624 (gnus-agent-go-online): Change :version. 720 (gnus-agent-go-online): Change :version.
@@ -660,21 +756,21 @@
660 (gnus-convert-mark-converter-prompt) 756 (gnus-convert-mark-converter-prompt)
661 (gnus-convert-converter-needs-prompt): Fix use of property list. 757 (gnus-convert-converter-needs-prompt): Fix use of property list.
662 758
6632004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org> 7592004-10-18 Katsumi Yamaoka <yamaoka@jpl.org>
664 760
665 * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote. 761 * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote.
666 762
6672004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org> 7632004-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
668 764
669 * gnus-start.el (gnus-get-unread-articles-in-group): Don't do 765 * gnus-start.el (gnus-get-unread-articles-in-group): Don't do
670 stuff for non-living groups. 766 stuff for non-living groups.
671 767
6722004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org> 7682004-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
673 769
674 * gnus-agent.el (gnus-agent-synchronize-flags): Default to nil. 770 * gnus-agent.el (gnus-agent-synchronize-flags): Default to nil.
675 (gnus-agent-regenerate-group): Using nil messages aren't valid. 771 (gnus-agent-regenerate-group): Using nil messages aren't valid.
676 772
6772004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org> 7732004-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
678 774
679 * gnus-agent.el (gnus-agent-read-agentview): 775 * gnus-agent.el (gnus-agent-read-agentview):
680 Inline gnus-uncompress-range. 776 Inline gnus-uncompress-range.
@@ -691,7 +787,7 @@
691 message-send-mail-function. The change makes the agent real-time 787 message-send-mail-function. The change makes the agent real-time
692 responsive to user changes to message-send-mail-function. 788 responsive to user changes to message-send-mail-function.
693 789
6942004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Reiner Steib <Reiner.Steib@gmx.de> 7902004-10-18 Reiner Steib <Reiner.Steib@gmx.de>
695 791
696 * gnus-start.el (gnus-get-unread-articles): Fix last commit. 792 * gnus-start.el (gnus-get-unread-articles): Fix last commit.
697 793
@@ -732,12 +828,12 @@
732 828
733 * gnus-util.el (gnus-rename-file): New function. 829 * gnus-util.el (gnus-rename-file): New function.
734 830
7352004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org> 8312004-10-18 Katsumi Yamaoka <yamaoka@jpl.org>
736 832
737 * gnus-agent.el (gnus-agent-regenerate-group): Activate the group 833 * gnus-agent.el (gnus-agent-regenerate-group): Activate the group
738 when the group's active is not available. 834 when the group's active is not available.
739 835
7402004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org> 8362004-10-18 Katsumi Yamaoka <yamaoka@jpl.org>
741 837
742 * gnus-agent.el (gnus-agent-read-agentview): Add a missing arg to 838 * gnus-agent.el (gnus-agent-read-agentview): Add a missing arg to
743 error. 839 error.
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 767bdacb78e..6d38626998c 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1984,7 +1984,8 @@ confirmation is required."
1984(defun gnus-group-read-ephemeral-group (group method &optional activate 1984(defun gnus-group-read-ephemeral-group (group method &optional activate
1985 quit-config request-only 1985 quit-config request-only
1986 select-articles 1986 select-articles
1987 parameters) 1987 parameters
1988 number)
1988 "Read GROUP from METHOD as an ephemeral group. 1989 "Read GROUP from METHOD as an ephemeral group.
1989If ACTIVATE, request the group first. 1990If ACTIVATE, request the group first.
1990If QUIT-CONFIG, use that window configuration when exiting from the 1991If QUIT-CONFIG, use that window configuration when exiting from the
@@ -1992,6 +1993,7 @@ ephemeral group.
1992If REQUEST-ONLY, don't actually read the group; just request it. 1993If REQUEST-ONLY, don't actually read the group; just request it.
1993If SELECT-ARTICLES, only select those articles. 1994If SELECT-ARTICLES, only select those articles.
1994If PARAMETERS, use those as the group parameters. 1995If PARAMETERS, use those as the group parameters.
1996If NUMBER, fetch this number of articles.
1995 1997
1996Return the name of the group if selection was successful." 1998Return the name of the group if selection was successful."
1997 (interactive 1999 (interactive
@@ -2039,7 +2041,7 @@ Return the name of the group if selection was successful."
2039 (when (let ((gnus-large-newsgroup gnus-large-ephemeral-newsgroup) 2041 (when (let ((gnus-large-newsgroup gnus-large-ephemeral-newsgroup)
2040 (gnus-fetch-old-headers 2042 (gnus-fetch-old-headers
2041 gnus-fetch-old-ephemeral-headers)) 2043 gnus-fetch-old-ephemeral-headers))
2042 (gnus-group-read-group t t group select-articles)) 2044 (gnus-group-read-group (or number t) t group select-articles))
2043 group) 2045 group)
2044 ;;(error nil) 2046 ;;(error nil)
2045 (quit 2047 (quit
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index e8c7d354145..7b3c033fddb 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -851,23 +851,26 @@ buffer.
851 (setq buffer-read-only t) 851 (setq buffer-read-only t)
852 (gnus-run-hooks 'gnus-browse-mode-hook)) 852 (gnus-run-hooks 'gnus-browse-mode-hook))
853 853
854(defun gnus-browse-read-group (&optional no-article) 854(defun gnus-browse-read-group (&optional no-article number)
855 "Enter the group at the current line." 855 "Enter the group at the current line.
856 (interactive) 856If NUMBER, fetch this number of articles."
857 (interactive "P")
857 (let ((group (gnus-browse-group-name))) 858 (let ((group (gnus-browse-group-name)))
858 (if (or (not (gnus-get-info group)) 859 (if (or (not (gnus-get-info group))
859 (gnus-ephemeral-group-p group)) 860 (gnus-ephemeral-group-p group))
860 (unless (gnus-group-read-ephemeral-group 861 (unless (gnus-group-read-ephemeral-group
861 group gnus-browse-current-method nil 862 group gnus-browse-current-method nil
862 (cons (current-buffer) 'browse)) 863 (cons (current-buffer) 'browse)
864 nil nil nil number)
863 (error "Couldn't enter %s" group)) 865 (error "Couldn't enter %s" group))
864 (unless (gnus-group-read-group nil no-article group) 866 (unless (gnus-group-read-group nil no-article group)
865 (error "Couldn't enter %s" group))))) 867 (error "Couldn't enter %s" group)))))
866 868
867(defun gnus-browse-select-group () 869(defun gnus-browse-select-group (&optional number)
868 "Select the current group." 870 "Select the current group.
869 (interactive) 871If NUMBER, fetch this number of articles."
870 (gnus-browse-read-group 'no)) 872 (interactive "P")
873 (gnus-browse-read-group 'no number))
871 874
872(defun gnus-browse-next-group (n) 875(defun gnus-browse-next-group (n)
873 "Go to the next group." 876 "Go to the next group."
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index ea8f7e063fe..8d6a5f951b5 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -2250,7 +2250,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2250 ,@(if (featurep 'xemacs) '(t) 2250 ,@(if (featurep 'xemacs) '(t)
2251 '(:help "Generate and print a PostScript image"))]) 2251 '(:help "Generate and print a PostScript image"))])
2252 ("Copy, move,... (Backend)" 2252 ("Copy, move,... (Backend)"
2253 ,@(if (featurep 'xemacs) '(t) 2253 ,@(if (featurep 'xemacs) nil
2254 '(:help "Copying, moving, expiring articles...")) 2254 '(:help "Copying, moving, expiring articles..."))
2255 ["Respool article..." gnus-summary-respool-article t] 2255 ["Respool article..." gnus-summary-respool-article t]
2256 ["Move article..." gnus-summary-move-article 2256 ["Move article..." gnus-summary-move-article
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index de56fe2be96..9edbce2620e 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -6364,7 +6364,8 @@ Optional DIGEST will use digest to forward."
6364 (replace-match "X-From-Line: ")) 6364 (replace-match "X-From-Line: "))
6365 ;; Send it. 6365 ;; Send it.
6366 (let ((message-inhibit-body-encoding t) 6366 (let ((message-inhibit-body-encoding t)
6367 message-required-mail-headers) 6367 message-required-mail-headers
6368 rfc2047-encode-encoded-words)
6368 (message-send-mail)) 6369 (message-send-mail))
6369 (kill-buffer (current-buffer))) 6370 (kill-buffer (current-buffer)))
6370 (message "Resending message to %s...done" address))) 6371 (message "Resending message to %s...done" address)))
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 5b4200d6d52..3be6444f18f 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -86,6 +86,32 @@
86 (multibyte-char-to-unibyte . identity)))) 86 (multibyte-char-to-unibyte . identity))))
87 87
88(eval-and-compile 88(eval-and-compile
89 (cond
90 ((fboundp 'replace-in-string)
91 (defalias 'mm-replace-in-string 'replace-in-string))
92 ((fboundp 'replace-regexp-in-string)
93 (defun mm-replace-in-string (string regexp newtext &optional literal)
94 "Replace all matches for REGEXP with NEWTEXT in STRING.
95If LITERAL is non-nil, insert NEWTEXT literally. Return a new
96string containing the replacements.
97
98This is a compatibility function for different Emacsen."
99 (replace-regexp-in-string regexp newtext string nil literal)))
100 (t
101 (defun mm-replace-in-string (string regexp newtext &optional literal)
102 "Replace all matches for REGEXP with NEWTEXT in STRING.
103If LITERAL is non-nil, insert NEWTEXT literally. Return a new
104string containing the replacements.
105
106This is a compatibility function for different Emacsen."
107 (let ((start 0) tail)
108 (while (string-match regexp string start)
109 (setq tail (- (length string) (match-end 0)))
110 (setq string (replace-match newtext nil literal string))
111 (setq start (- (length string) tail))))
112 string))))
113
114(eval-and-compile
89 (defalias 'mm-char-or-char-int-p 115 (defalias 'mm-char-or-char-int-p
90 (cond 116 (cond
91 ((fboundp 'char-or-char-int-p) 'char-or-char-int-p) 117 ((fboundp 'char-or-char-int-p) 'char-or-char-int-p)
@@ -606,7 +632,7 @@ But this is very much a corner case, so don't worry about it."
606 632
607 ;; Load the Latin Unity library, if available. 633 ;; Load the Latin Unity library, if available.
608 (when (and (not (featurep 'latin-unity)) (locate-library "latin-unity")) 634 (when (and (not (featurep 'latin-unity)) (locate-library "latin-unity"))
609 (require 'latin-unity)) 635 (ignore-errors (require 'latin-unity)))
610 636
611 ;; Now, can we use it? 637 ;; Now, can we use it?
612 (if (featurep 'latin-unity) 638 (if (featurep 'latin-unity)
@@ -651,7 +677,7 @@ But this is very much a corner case, so don't worry about it."
651 677
652(defmacro mm-xemacs-find-mime-charset (begin end) 678(defmacro mm-xemacs-find-mime-charset (begin end)
653 (when (featurep 'xemacs) 679 (when (featurep 'xemacs)
654 `(mm-xemacs-find-mime-charset-1 ,begin ,end))) 680 `(and (featurep 'mule) (mm-xemacs-find-mime-charset-1 ,begin ,end))))
655 681
656(defun mm-find-mime-charset-region (b e &optional hack-charsets) 682(defun mm-find-mime-charset-region (b e &optional hack-charsets)
657 "Return the MIME charsets needed to encode the region between B and E. 683 "Return the MIME charsets needed to encode the region between B and E.
diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el
index 6086f422abd..538e22e0f88 100644
--- a/lisp/gnus/rfc2047.el
+++ b/lisp/gnus/rfc2047.el
@@ -119,12 +119,15 @@ The values can be:
119Valid encodings are nil, `Q' and `B'. These indicate binary (no) encoding, 119Valid encodings are nil, `Q' and `B'. These indicate binary (no) encoding,
120quoted-printable and base64 respectively.") 120quoted-printable and base64 respectively.")
121 121
122(defvar rfc2047-encoding-function-alist 122(defvar rfc2047-encode-function-alist
123 '((Q . rfc2047-q-encode-region) 123 '((Q . rfc2047-q-encode-string)
124 (B . rfc2047-b-encode-region) 124 (B . rfc2047-b-encode-string)
125 (nil . ignore)) 125 (nil . identity))
126 "Alist of RFC2047 encodings to encoding functions.") 126 "Alist of RFC2047 encodings to encoding functions.")
127 127
128(defvar rfc2047-encode-encoded-words t
129 "Whether encoded words should be encoded again.")
130
128;;; 131;;;
129;;; Functions for encoding RFC2047 messages 132;;; Functions for encoding RFC2047 messages
130;;; 133;;;
@@ -166,7 +169,7 @@ This is either `base64' or `quoted-printable'."
166 (save-restriction 169 (save-restriction
167 (rfc2047-narrow-to-field) 170 (rfc2047-narrow-to-field)
168 (re-search-forward ":[ \t\n]*" nil t) 171 (re-search-forward ":[ \t\n]*" nil t)
169 (buffer-substring (point) (point-max))))) 172 (buffer-substring-no-properties (point) (point-max)))))
170 173
171(defvar rfc2047-encoding-type 'address-mime 174(defvar rfc2047-encoding-type 'address-mime
172 "The type of encoding done by `rfc2047-encode-region'. 175 "The type of encoding done by `rfc2047-encode-region'.
@@ -186,24 +189,25 @@ Should be called narrowed to the head of the message."
186 (rfc2047-narrow-to-field) 189 (rfc2047-narrow-to-field)
187 (if (not (rfc2047-encodable-p)) 190 (if (not (rfc2047-encodable-p))
188 (prog1 191 (prog1
189 (if (and (eq (mm-body-7-or-8) '8bit) 192 (if (and (eq (mm-body-7-or-8) '8bit)
190 (mm-multibyte-p) 193 (mm-multibyte-p)
191 (mm-coding-system-p 194 (mm-coding-system-p
192 (car message-posting-charset))) 195 (car message-posting-charset)))
193 ;; 8 bit must be decoded. 196 ;; 8 bit must be decoded.
194 (mm-encode-coding-region 197 (mm-encode-coding-region
195 (point-min) (point-max) 198 (point-min) (point-max)
196 (mm-charset-to-coding-system 199 (mm-charset-to-coding-system
197 (car message-posting-charset)))) 200 (car message-posting-charset))))
198 ;; No encoding necessary, but folding is nice 201 ;; No encoding necessary, but folding is nice
199 (rfc2047-fold-region 202 (when nil
200 (save-excursion 203 (rfc2047-fold-region
201 (goto-char (point-min)) 204 (save-excursion
202 (skip-chars-forward "^:") 205 (goto-char (point-min))
203 (when (looking-at ": ") 206 (skip-chars-forward "^:")
204 (forward-char 2)) 207 (when (looking-at ": ")
205 (point)) 208 (forward-char 2))
206 (point-max))) 209 (point))
210 (point-max))))
207 ;; We found something that may perhaps be encoded. 211 ;; We found something that may perhaps be encoded.
208 (setq method nil 212 (setq method nil
209 alist rfc2047-header-encoding-alist) 213 alist rfc2047-header-encoding-alist)
@@ -213,7 +217,6 @@ Should be called narrowed to the head of the message."
213 (eq (car elem) t)) 217 (eq (car elem) t))
214 (setq alist nil 218 (setq alist nil
215 method (cdr elem)))) 219 method (cdr elem))))
216 (goto-char (point-min))
217 (re-search-forward "^[^:]+: *" nil t) 220 (re-search-forward "^[^:]+: *" nil t)
218 (cond 221 (cond
219 ((eq method 'address-mime) 222 ((eq method 'address-mime)
@@ -267,8 +270,13 @@ The buffer may be narrowed."
267 (require 'message) ; for message-posting-charset 270 (require 'message) ; for message-posting-charset
268 (let ((charsets 271 (let ((charsets
269 (mm-find-mime-charset-region (point-min) (point-max)))) 272 (mm-find-mime-charset-region (point-min) (point-max))))
270 (and charsets 273 (goto-char (point-min))
271 (not (equal charsets (list (car message-posting-charset))))))) 274 (or (and rfc2047-encode-encoded-words
275 (prog1
276 (search-forward "=?" nil t)
277 (goto-char (point-min))))
278 (and charsets
279 (not (equal charsets (list (car message-posting-charset))))))))
272 280
273;; Use this syntax table when parsing into regions that may need 281;; Use this syntax table when parsing into regions that may need
274;; encoding. Double quotes are string delimiters, backslash is 282;; encoding. Double quotes are string delimiters, backslash is
@@ -292,8 +300,8 @@ The buffer may be narrowed."
292 table)))) 300 table))))
293 (modify-syntax-entry ?\\ "\\" table) 301 (modify-syntax-entry ?\\ "\\" table)
294 (modify-syntax-entry ?\" "\"" table) 302 (modify-syntax-entry ?\" "\"" table)
295 (modify-syntax-entry ?\( "." table) 303 (modify-syntax-entry ?\( "(" table)
296 (modify-syntax-entry ?\) "." table) 304 (modify-syntax-entry ?\) ")" table)
297 (modify-syntax-entry ?\< "." table) 305 (modify-syntax-entry ?\< "." table)
298 (modify-syntax-entry ?\> "." table) 306 (modify-syntax-entry ?\> "." table)
299 (modify-syntax-entry ?\[ "." table) 307 (modify-syntax-entry ?\[ "." table)
@@ -310,183 +318,341 @@ By default, the region is treated as containing RFC2822 addresses.
310Dynamically bind `rfc2047-encoding-type' to change that." 318Dynamically bind `rfc2047-encoding-type' to change that."
311 (save-restriction 319 (save-restriction
312 (narrow-to-region b e) 320 (narrow-to-region b e)
313 (if (eq 'mime rfc2047-encoding-type) 321 (let ((encodable-regexp (if rfc2047-encode-encoded-words
314 ;; Simple case. Treat as single word after any initial ASCII 322 "[^\000-\177]+\\|=\\?"
315 ;; part and before any tailing ASCII part. The leading ASCII 323 "[^\000-\177]+"))
316 ;; is relevant for instance in Subject headers with `Re:' for 324 start ; start of current token
317 ;; interoperability with non-MIME clients, and we might as 325 end begin csyntax
318 ;; well avoid the tail too. 326 ;; Whether there's an encoded word before the current token,
319 (progn 327 ;; either immediately or separated by space.
320 (goto-char (point-min)) 328 last-encoded
321 ;; Does it need encoding? 329 (orig-text (buffer-substring-no-properties b e)))
322 (skip-chars-forward "\000-\177") 330 (if (eq 'mime rfc2047-encoding-type)
323 (unless (eobp) 331 ;; Simple case. Continuous words in which all those contain
324 (skip-chars-backward "^ \n") ; beginning of space-delimited word 332 ;; non-ASCII characters are encoded collectively. Encoding
325 (rfc2047-encode (point) (progn 333 ;; ASCII words, including `Re:' used in Subject headers, is
326 (goto-char e) 334 ;; avoided for interoperability with non-MIME clients and
327 (skip-chars-backward "\000-\177") 335 ;; for making it easy to find keywords.
328 (skip-chars-forward "^ \n") 336 (progn
329 ;; end of space-delimited word 337 (goto-char (point-min))
330 (point))))) 338 (while (progn (skip-chars-forward " \t\n")
331 ;; `address-mime' case -- take care of quoted words, comments. 339 (not (eobp)))
332 (with-syntax-table rfc2047-syntax-table 340 (setq start (point))
333 (let ((start) ; start of current token 341 (while (and (looking-at "[ \t\n]*\\([^ \t\n]+\\)")
334 end ; end of current token 342 (progn
335 ;; Whether there's an encoded word before the current 343 (setq end (match-end 0))
336 ;; token, either immediately or separated by space. 344 (re-search-forward encodable-regexp end t)))
337 last-encoded) 345 (goto-char end))
346 (if (> (point) start)
347 (rfc2047-encode start (point))
348 (goto-char end))))
349 ;; `address-mime' case -- take care of quoted words, comments.
350 (with-syntax-table rfc2047-syntax-table
338 (goto-char (point-min)) 351 (goto-char (point-min))
339 (condition-case nil ; in case of unbalanced quotes 352 (condition-case err ; in case of unbalanced quotes
340 ;; Look for rfc2822-style: sequences of atoms, quoted 353 ;; Look for rfc2822-style: sequences of atoms, quoted
341 ;; strings, specials, whitespace. (Specials mustn't be 354 ;; strings, specials, whitespace. (Specials mustn't be
342 ;; encoded.) 355 ;; encoded.)
343 (while (not (eobp)) 356 (while (not (eobp))
344 (setq start (point))
345 ;; Skip whitespace. 357 ;; Skip whitespace.
346 (unless (= 0 (skip-chars-forward " \t\n")) 358 (skip-chars-forward " \t\n")
347 (setq start (point))) 359 (setq start (point))
348 (cond 360 (cond
349 ((not (char-after))) ; eob 361 ((not (char-after))) ; eob
350 ;; else token start 362 ;; else token start
351 ((eq ?\" (char-syntax (char-after))) 363 ((eq ?\" (setq csyntax (char-syntax (char-after))))
352 ;; Quoted word. 364 ;; Quoted word.
353 (forward-sexp) 365 (forward-sexp)
354 (setq end (point)) 366 (setq end (point))
355 ;; Does it need encoding? 367 ;; Does it need encoding?
356 (goto-char start) 368 (goto-char start)
357 (skip-chars-forward "\000-\177" end) 369 (if (re-search-forward encodable-regexp end 'move)
358 (if (= end (point)) 370 ;; It needs encoding. Strip the quotes first,
359 (setq last-encoded nil) 371 ;; since encoded words can't occur in quotes.
360 ;; It needs encoding. Strip the quotes first, 372 (progn
361 ;; since encoded words can't occur in quotes. 373 (goto-char end)
362 (goto-char end) 374 (delete-backward-char 1)
363 (delete-backward-char 1) 375 (goto-char start)
364 (goto-char start) 376 (delete-char 1)
365 (delete-char 1) 377 (when last-encoded
366 (when last-encoded 378 ;; There was a preceding quoted word. We need
367 ;; There was a preceding quoted word. We need 379 ;; to include any separating whitespace in this
368 ;; to include any separating whitespace in this 380 ;; word to avoid it getting lost.
369 ;; word to avoid it getting lost. 381 (skip-chars-backward " \t")
370 (skip-chars-backward " \t") 382 ;; A space is needed between the encoded words.
371 ;; A space is needed between the encoded words. 383 (insert ? )
372 (insert ? ) 384 (setq start (point)
373 (setq start (point) 385 end (1+ end)))
374 end (1+ end))) 386 ;; Adjust the end position for the deleted quotes.
375 ;; Adjust the end position for the deleted quotes. 387 (rfc2047-encode start (- end 2))
376 (rfc2047-encode start (- end 2)) 388 (setq last-encoded t)) ; record that it was encoded
377 (setq last-encoded t))) ; record that it was encoded 389 (setq last-encoded nil)))
378 ((eq ?. (char-syntax (char-after))) 390 ((eq ?. csyntax)
379 ;; Skip other delimiters, but record that they've 391 ;; Skip other delimiters, but record that they've
380 ;; potentially separated quoted words. 392 ;; potentially separated quoted words.
381 (forward-char) 393 (forward-char)
382 (setq last-encoded nil)) 394 (setq last-encoded nil))
395 ((eq ?\) csyntax)
396 (error "Unbalanced parentheses"))
397 ((eq ?\( csyntax)
398 ;; Look for the end of parentheses.
399 (forward-list)
400 ;; Encode text as an unstructured field.
401 (let ((rfc2047-encoding-type 'mime))
402 (rfc2047-encode-region (1+ start) (1- (point))))
403 (skip-chars-forward ")"))
383 (t ; normal token/whitespace sequence 404 (t ; normal token/whitespace sequence
384 ;; Find the end. 405 ;; Find the end.
385 (forward-word 1) 406 ;; Skip one ASCII word, or encode continuous words
386 (skip-chars-backward " \t") 407 ;; in which all those contain non-ASCII characters.
408 (setq end nil)
409 (while (not (or end (eobp)))
410 (when (looking-at "[\000-\177]+")
411 (setq begin (point)
412 end (match-end 0))
413 (when (progn
414 (while (and (or (re-search-forward
415 "[ \t\n]\\|\\Sw" end 'move)
416 (setq end nil))
417 (eq ?\\ (char-syntax (char-before))))
418 ;; Skip backslash-quoted characters.
419 (forward-char))
420 end)
421 (setq end (match-beginning 0))
422 (if rfc2047-encode-encoded-words
423 (progn
424 (goto-char begin)
425 (when (search-forward "=?" end 'move)
426 (goto-char (match-beginning 0))
427 (setq end nil)))
428 (goto-char end))))
429 ;; Where the value nil of `end' means there may be
430 ;; text to have to be encoded following the point.
431 ;; Otherwise, the point reached to the end of ASCII
432 ;; words separated by whitespace or a special char.
433 (unless end
434 (when (looking-at encodable-regexp)
435 (goto-char (setq begin (match-end 0)))
436 (while (and (looking-at "[ \t\n]+\\([^ \t\n]+\\)")
437 (setq end (match-end 0))
438 (progn
439 (while (re-search-forward
440 encodable-regexp end t))
441 (< begin (point)))
442 (goto-char begin)
443 (or (not (re-search-forward "\\Sw" end t))
444 (progn
445 (goto-char (match-beginning 0))
446 nil)))
447 (goto-char end))
448 (when (looking-at "[^ \t\n]+")
449 (setq end (match-end 0))
450 (if (re-search-forward "\\Sw+" end t)
451 ;; There are special characters better
452 ;; to be encoded so that MTAs may parse
453 ;; them safely.
454 (cond ((= end (point)))
455 ((looking-at (concat "\\sw*\\("
456 encodable-regexp
457 "\\)"))
458 (setq end nil))
459 (t
460 (goto-char (1- (match-end 0)))
461 (unless (= (point) (match-beginning 0))
462 ;; Separate encodable text and
463 ;; delimiter.
464 (insert " "))))
465 (goto-char end)
466 (skip-chars-forward " \t\n")
467 (if (and (looking-at "[^ \t\n]+")
468 (string-match encodable-regexp
469 (match-string 0)))
470 (setq end nil)
471 (goto-char end)))))))
472 (skip-chars-backward " \t\n")
387 (setq end (point)) 473 (setq end (point))
388 ;; Deal with encoding and leading space as for
389 ;; quoted words.
390 (goto-char start) 474 (goto-char start)
391 (skip-chars-forward "\000-\177" end) 475 (if (re-search-forward encodable-regexp end 'move)
392 (if (= end (point)) 476 (progn
393 (setq last-encoded nil) 477 (unless (memq (char-before start) '(nil ?\t ? ))
394 (when last-encoded 478 (if (progn
395 (goto-char start) 479 (goto-char start)
396 (skip-chars-backward " \t") 480 (skip-chars-backward "^ \t\n")
397 (insert ? ) 481 (and (looking-at "\\Sw+")
398 (setq start (point) 482 (= (match-end 0) start)))
399 end (1+ end))) 483 ;; Also encode bogus delimiters.
400 (rfc2047-encode start end) 484 (setq start (point))
401 (setq last-encoded t))))) 485 ;; Separate encodable text and delimiter.
486 (goto-char start)
487 (insert " ")
488 (setq start (1+ start)
489 end (1+ end))))
490 (rfc2047-encode start end)
491 (setq last-encoded t))
492 (setq last-encoded nil)))))
402 (error 493 (error
403 (error "Invalid data for rfc2047 encoding: %s" 494 (if (or debug-on-quit debug-on-error)
404 (buffer-substring b e))))))) 495 (signal (car err) (cdr err))
405 (rfc2047-fold-region b (point)))) 496 (error "Invalid data for rfc2047 encoding: %s"
497 (mm-replace-in-string orig-text "[ \t\n]+" " "))))))))
498 (rfc2047-fold-region b (point))
499 (goto-char (point-max))))
406 500
407(defun rfc2047-encode-string (string) 501(defun rfc2047-encode-string (string)
408 "Encode words in STRING. 502 "Encode words in STRING.
409By default, the string is treated as containing addresses (see 503By default, the string is treated as containing addresses (see
410`rfc2047-encoding-type')." 504`rfc2047-encoding-type')."
411 (with-temp-buffer 505 (mm-with-multibyte-buffer
412 (insert string) 506 (insert string)
413 (rfc2047-encode-region (point-min) (point-max)) 507 (rfc2047-encode-region (point-min) (point-max))
414 (buffer-string))) 508 (buffer-string)))
415 509
510(defvar rfc2047-encode-max-chars 76
511 "Maximum characters of each header line that contain encoded-words.
512If it is nil, encoded-words will not be folded. Too small value may
513cause an error. Don't change this for no particular reason.")
514
515(defun rfc2047-encode-1 (column string cs encoder start crest tail
516 &optional eword)
517 "Subroutine used by `rfc2047-encode'."
518 (cond ((string-equal string "")
519 (or eword ""))
520 ((not rfc2047-encode-max-chars)
521 (concat start
522 (funcall encoder (if cs
523 (mm-encode-coding-string string cs)
524 string))
525 "?="))
526 ((>= column rfc2047-encode-max-chars)
527 (when eword
528 (cond ((string-match "\n[ \t]+\\'" eword)
529 ;; Reomove a superfluous empty line.
530 (setq eword (substring eword 0 (match-beginning 0))))
531 ((string-match "(+\\'" eword)
532 ;; Break the line before the open parenthesis.
533 (setq crest (concat crest (match-string 0 eword))
534 eword (substring eword 0 (match-beginning 0))))))
535 (rfc2047-encode-1 (length crest) string cs encoder start " " tail
536 (concat eword "\n" crest)))
537 (t
538 (let ((index 0)
539 (limit (1- (length string)))
540 (prev "")
541 next len)
542 (while (and prev
543 (<= index limit))
544 (setq next (concat start
545 (funcall encoder
546 (if cs
547 (mm-encode-coding-string
548 (substring string 0 (1+ index))
549 cs)
550 (substring string 0 (1+ index))))
551 "?=")
552 len (+ column (length next)))
553 (if (> len rfc2047-encode-max-chars)
554 (setq next prev
555 prev nil)
556 (if (or (< index limit)
557 (<= (+ len (or (string-match "\n" tail)
558 (length tail)))
559 rfc2047-encode-max-chars))
560 (setq prev next
561 index (1+ index))
562 (if (string-match "\\`)+" tail)
563 ;; Break the line after the close parenthesis.
564 (setq tail (concat (substring tail 0 (match-end 0))
565 "\n "
566 (substring tail (match-end 0)))
567 prev next
568 index (1+ index))
569 (setq next prev
570 prev nil)))))
571 (if (> index limit)
572 (concat eword next tail)
573 (if (= 0 index)
574 (if (and eword
575 (string-match "(+\\'" eword))
576 (setq crest (concat crest (match-string 0 eword))
577 eword (substring eword 0 (match-beginning 0)))
578 (setq eword (concat eword next)))
579 (setq crest " "
580 eword (concat eword next)))
581 (when (string-match "\n[ \t]+\\'" eword)
582 ;; Reomove a superfluous empty line.
583 (setq eword (substring eword 0 (match-beginning 0))))
584 (rfc2047-encode-1 (length crest) (substring string index)
585 cs encoder start " " tail
586 (concat eword "\n" crest)))))))
587
416(defun rfc2047-encode (b e) 588(defun rfc2047-encode (b e)
417 "Encode the word(s) in the region B to E. 589 "Encode the word(s) in the region B to E.
418By default, the region is treated as containing addresses (see 590Point moves to the end of the region."
419`rfc2047-encoding-type')." 591 (let ((mime-charset (or (mm-find-mime-charset-region b e) (list 'us-ascii)))
420 (let* ((mime-charset (mm-find-mime-charset-region b e)) 592 cs encoding tail crest eword)
421 (cs (if (> (length mime-charset) 1) 593 (cond ((> (length mime-charset) 1)
422 ;; Fixme: Instead of this, try to break region into 594 (error "Can't rfc2047-encode `%s'"
423 ;; parts that can be encoded separately. 595 (buffer-substring-no-properties b e)))
424 (error "Can't rfc2047-encode `%s'" 596 ((= (length mime-charset) 1)
425 (buffer-substring b e)) 597 (setq mime-charset (car mime-charset)
426 (setq mime-charset (car mime-charset)) 598 cs (mm-charset-to-coding-system mime-charset))
427 (mm-charset-to-coding-system mime-charset))) 599 (unless (and (mm-multibyte-p)
428 ;; Fixme: Better, calculate the number of non-ASCII 600 (mm-coding-system-p cs))
429 ;; characters, at least for 8-bit charsets. 601 (setq cs nil))
430 (encoding (or (cdr (assq mime-charset 602 (save-restriction
603 (narrow-to-region b e)
604 (setq encoding
605 (or (cdr (assq mime-charset
431 rfc2047-charset-encoding-alist)) 606 rfc2047-charset-encoding-alist))
432 ;; For the charsets that don't have a preferred 607 ;; For the charsets that don't have a preferred
433 ;; encoding, choose the one that's shorter. 608 ;; encoding, choose the one that's shorter.
434 (save-restriction 609 (if (eq (rfc2047-qp-or-base64) 'base64)
435 (narrow-to-region b e) 610 'B
436 (if (eq (rfc2047-qp-or-base64) 'base64) 611 'Q)))
437 'B 612 (widen)
438 'Q)))) 613 (goto-char e)
439 (start (concat 614 (skip-chars-forward "^ \t\n")
440 "=?" (downcase (symbol-name mime-charset)) "?" 615 ;; `tail' may contain a close parenthesis.
441 (downcase (symbol-name encoding)) "?")) 616 (setq tail (buffer-substring-no-properties e (point)))
442 (factor (case mime-charset 617 (goto-char b)
443 ((iso-8859-5 iso-8859-7 iso-8859-8 koi8-r) 1) 618 (setq b (point-marker)
444 ((big5 gb2312 euc-kr) 2) 619 e (set-marker (make-marker) e))
445 (utf-8 4) 620 (rfc2047-fold-region (rfc2047-point-at-bol) b)
446 (t 8))) 621 (goto-char b)
447 (pre (- b (save-restriction 622 (skip-chars-backward "^ \t\n")
448 (widen) 623 (unless (= 0 (skip-chars-backward " \t"))
449 (rfc2047-point-at-bol)))) 624 ;; `crest' may contain whitespace and an open parenthesis.
450 ;; encoded-words must not be longer than 75 characters, 625 (setq crest (buffer-substring-no-properties (point) b)))
451 ;; including charset, encoding etc. This leaves us with 626 (setq eword (rfc2047-encode-1
452 ;; 75 - (length start) - 2 - 2 characters. The last 2 is for 627 (- b (rfc2047-point-at-bol))
453 ;; possible base64 padding. In the worst case (iso-2022-*) 628 (mm-replace-in-string
454 ;; each character expands to 8 bytes which is expanded by a 629 (buffer-substring-no-properties b e)
455 ;; factor of 4/3 by base64 encoding. 630 "\n\\([ \t]?\\)" "\\1")
456 (length (floor (- 75 (length start) 4) (* factor (/ 4.0 3.0)))) 631 cs
457 ;; Limit line length to 76 characters. 632 (or (cdr (assq encoding
458 (length1 (max 1 (floor (- 76 (length start) 4 pre) 633 rfc2047-encode-function-alist))
459 (* factor (/ 4.0 3.0))))) 634 'identity)
460 (first t)) 635 (concat "=?" (downcase (symbol-name mime-charset))
461 (if mime-charset 636 "?" (upcase (symbol-name encoding)) "?")
462 (save-restriction 637 (or crest " ")
463 (narrow-to-region b e) 638 tail))
464 (when (eq encoding 'B) 639 (delete-region (if (eq (aref eword 0) ?\n)
465 ;; break into lines before encoding 640 (if (bolp)
466 (goto-char (point-min)) 641 ;; The line was folded before encoding.
467 (while (not (eobp)) 642 (1- (point))
468 (if first 643 (point))
469 (progn 644 (goto-char b))
470 (goto-char (min (point-max) (+ length1 (point)))) 645 (+ e (length tail)))
471 (setq first nil)) 646 ;; `eword' contains `crest' and `tail'.
472 (goto-char (min (point-max) (+ length (point))))) 647 (insert eword)
473 (unless (eobp) 648 (set-marker b nil)
474 (insert ?\n))) 649 (set-marker e nil)
475 (setq first t)) 650 (unless (or (/= 0 (length tail))
476 (if (and (mm-multibyte-p) 651 (eobp)
477 (mm-coding-system-p cs)) 652 (looking-at "[ \t\n)]"))
478 (mm-encode-coding-region (point-min) (point-max) cs)) 653 (insert " "))))
479 (funcall (cdr (assq encoding rfc2047-encoding-function-alist)) 654 (t
480 (point-min) (point-max)) 655 (goto-char e)))))
481 (goto-char (point-min))
482 (while (not (eobp))
483 (unless first
484 (insert ? ))
485 (setq first nil)
486 (insert start)
487 (end-of-line)
488 (insert "?=")
489 (forward-line 1))))))
490 656
491(defun rfc2047-fold-field () 657(defun rfc2047-fold-field ()
492 "Fold the current header field." 658 "Fold the current header field."
@@ -512,6 +678,7 @@ By default, the region is treated as containing addresses (see
512 (goto-char (or break qword-break)) 678 (goto-char (or break qword-break))
513 (setq break nil 679 (setq break nil
514 qword-break nil) 680 qword-break nil)
681 (skip-chars-backward " \t")
515 (if (looking-at "[ \t]") 682 (if (looking-at "[ \t]")
516 (insert ?\n) 683 (insert ?\n)
517 (insert "\n ")) 684 (insert "\n "))
@@ -533,10 +700,8 @@ By default, the region is treated as containing addresses (see
533 (forward-char 1)) 700 (forward-char 1))
534 ((memq (char-after) '(? ?\t)) 701 ((memq (char-after) '(? ?\t))
535 (skip-chars-forward " \t") 702 (skip-chars-forward " \t")
536 (if first 703 (unless first ;; Don't break just after the header name.
537 ;; Don't break just after the header name. 704 (setq break (point))))
538 (setq first nil)
539 (setq break (1- (point)))))
540 ((not break) 705 ((not break)
541 (if (not (looking-at "=\\?[^=]")) 706 (if (not (looking-at "=\\?[^=]"))
542 (if (eq (char-after) ?=) 707 (if (eq (char-after) ?=)
@@ -547,15 +712,17 @@ By default, the region is treated as containing addresses (see
547 (setq qword-break (point))) 712 (setq qword-break (point)))
548 (skip-chars-forward "^ \t\n\r"))) 713 (skip-chars-forward "^ \t\n\r")))
549 (t 714 (t
550 (skip-chars-forward "^ \t\n\r")))) 715 (skip-chars-forward "^ \t\n\r")))
716 (setq first nil))
551 (when (and (or break qword-break) 717 (when (and (or break qword-break)
552 (> (- (point) bol) 76)) 718 (> (- (point) bol) 76))
553 (goto-char (or break qword-break)) 719 (goto-char (or break qword-break))
554 (setq break nil 720 (setq break nil
555 qword-break nil) 721 qword-break nil)
556 (if (looking-at "[ \t]") 722 (if (or (> 0 (skip-chars-backward " \t"))
557 (insert ?\n) 723 (looking-at "[ \t]"))
558 (insert "\n ")) 724 (insert ?\n)
725 (insert "\n "))
559 (setq bol (1- (point))) 726 (setq bol (1- (point)))
560 ;; Don't break before the first non-LWSP characters. 727 ;; Don't break before the first non-LWSP characters.
561 (skip-chars-forward " \t") 728 (skip-chars-forward " \t")
@@ -590,48 +757,48 @@ By default, the region is treated as containing addresses (see
590 (setq eol (rfc2047-point-at-eol)) 757 (setq eol (rfc2047-point-at-eol))
591 (forward-line 1))))) 758 (forward-line 1)))))
592 759
593(defun rfc2047-b-encode-region (b e) 760(defun rfc2047-b-encode-string (string)
594 "Base64-encode the header contained in region B to E." 761 "Base64-encode the header contained in STRING."
595 (save-restriction 762 (base64-encode-string string t))
596 (narrow-to-region (goto-char b) e) 763
597 (while (not (eobp)) 764(defun rfc2047-q-encode-string (string)
598 (base64-encode-region (point) (progn (end-of-line) (point)) t) 765 "Quoted-printable-encode the header in STRING."
599 (if (and (bolp) (eolp)) 766 (mm-with-unibyte-buffer
600 (delete-backward-char 1)) 767 (insert string)
601 (forward-line)))) 768 (quoted-printable-encode-region
602 769 (point-min) (point-max) nil
603(defun rfc2047-q-encode-region (b e) 770 ;; = (\075), _ (\137), ? (\077) are used in the encoded word.
604 "Quoted-printable-encode the header in region B to E." 771 ;; Avoid using 8bit characters.
605 (save-excursion 772 ;; This list excludes `especials' (see the RFC2047 syntax),
606 (save-restriction 773 ;; meaning that some characters in non-structured fields will
607 (narrow-to-region (goto-char b) e) 774 ;; get encoded when they con't need to be. The following is
608 (let ((bol (save-restriction 775 ;; what it used to be.
609 (widen) 776 ;;; ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?"
610 (rfc2047-point-at-bol)))) 777 ;;; "\010\012\014\040-\074\076\100-\136\140-\177")
611 (quoted-printable-encode-region 778 "-\b\n\f !#-'*+0-9A-Z\\^`-~\d")
612 b e nil 779 (subst-char-in-region (point-min) (point-max) ? ?_)
613 ;; = (\075), _ (\137), ? (\077) are used in the encoded word. 780 (buffer-string)))
614 ;; Avoid using 8bit characters. 781
615 ;; This list excludes `especials' (see the RFC2047 syntax), 782(defun rfc2047-encode-parameter (param value)
616 ;; meaning that some characters in non-structured fields will 783 "Return and PARAM=VALUE string encoded in the RFC2047-like style.
617 ;; get encoded when they con't need to be. The following is 784This is a replacement for the `rfc2231-encode-string' function.
618 ;; what it used to be. 785
619;;; ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?" 786When attaching files as MIME parts, we should use the RFC2231 encoding
620;;; "\010\012\014\040-\074\076\100-\136\140-\177") 787to specify the file names containing non-ASCII characters. However,
621 "-\b\n\f !#-'*+0-9A-Z\\^`-~\d") 788many mail softwares don't support it in practice and recipients won't
622 (subst-char-in-region (point-min) (point-max) ? ?_) 789be able to extract files with correct names. Instead, the RFC2047-like
623 ;; The size of QP encapsulation is about 20, so set limit to 790encoding is acceptable generally. This function provides the very
624 ;; 56=76-20. 791RFC2047-like encoding, resigning to such a regrettable trend. To use
625 (unless (< (- (point-max) (point-min)) 56) 792it, put the following line in your ~/.gnus.el file:
626 ;; Don't break if it could fit in one line. 793
627 ;; Let rfc2047-encode-region break it later. 794\(defalias 'mail-header-encode-parameter 'rfc2047-encode-parameter)
628 (goto-char (1+ (point-min))) 795"
629 (while (and (not (bobp)) (not (eobp))) 796 (let* ((rfc2047-encoding-type 'mime)
630 (goto-char (min (point-max) (+ 56 bol))) 797 (rfc2047-encode-max-chars nil)
631 (search-backward "=" (- (point) 2) t) 798 (string (rfc2047-encode-string value)))
632 (unless (or (bobp) (eobp)) 799 (if (string-match (concat "[" ietf-drums-tspecials "]") string)
633 (insert ?\n) 800 (format "%s=%S" param string)
634 (setq bol (point))))))))) 801 (concat param "=" string))))
635 802
636;;; 803;;;
637;;; Functions for decoding RFC2047 messages 804;;; Functions for decoding RFC2047 messages
@@ -639,8 +806,8 @@ By default, the region is treated as containing addresses (see
639 806
640(eval-and-compile 807(eval-and-compile
641 (defconst rfc2047-encoded-word-regexp 808 (defconst rfc2047-encoded-word-regexp
642 "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\ 809 "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(\\*[^?]+\\)?\
643\\?\\([!->@-~ +]*\\)\\?=")) 810\\?\\(B\\|Q\\)\\?\\([!->@-~ ]*\\)\\?="))
644 811
645(defvar rfc2047-quote-decoded-words-containing-tspecials nil 812(defvar rfc2047-quote-decoded-words-containing-tspecials nil
646 "If non-nil, quote decoded words containing special characters.") 813 "If non-nil, quote decoded words containing special characters.")
@@ -671,7 +838,7 @@ By default, the region is treated as containing addresses (see
671 "\\(\n?[ \t]\\)+" 838 "\\(\n?[ \t]\\)+"
672 "\\(" rfc2047-encoded-word-regexp "\\)")) 839 "\\(" rfc2047-encoded-word-regexp "\\)"))
673 nil t) 840 nil t)
674 (delete-region (goto-char (match-end 1)) (match-beginning 6))) 841 (delete-region (goto-char (match-end 1)) (match-beginning 7)))
675 ;; Decode the encoded words. 842 ;; Decode the encoded words.
676 (setq b (goto-char (point-min))) 843 (setq b (goto-char (point-min)))
677 (while (re-search-forward rfc2047-encoded-word-regexp nil t) 844 (while (re-search-forward rfc2047-encoded-word-regexp nil t)
@@ -774,7 +941,20 @@ By default, the region is treated as containing addresses (see
774 mail-parse-charset 941 mail-parse-charset
775 (not (eq mail-parse-charset 'us-ascii)) 942 (not (eq mail-parse-charset 'us-ascii))
776 (not (eq mail-parse-charset 'gnus-decoded))) 943 (not (eq mail-parse-charset 'gnus-decoded)))
777 (mm-decode-coding-string string mail-parse-charset) 944 ;; `decode-coding-string' in Emacs offers a third optional
945 ;; arg NOCOPY to avoid consing a new string if the decoding
946 ;; is "trivial". Unfortunately it currently doesn't
947 ;; consider anything else than a `nil' coding system
948 ;; trivial.
949 ;; `rfc2047-decode-string' is called multiple times for each
950 ;; article during summary buffer generation, and we really
951 ;; want to avoid unnecessary consing. So we bypass
952 ;; `decode-coding-string' if the string is purely ASCII.
953 (if (and (fboundp 'detect-coding-string)
954 ;; string is purely ASCII
955 (eq (detect-coding-string string t) 'undecided))
956 string
957 (mm-decode-coding-string string mail-parse-charset))
778 (mm-string-as-multibyte string))))) 958 (mm-string-as-multibyte string)))))
779 959
780(defun rfc2047-parse-and-decode (word) 960(defun rfc2047-parse-and-decode (word)
@@ -787,8 +967,8 @@ decodable."
787 (condition-case nil 967 (condition-case nil
788 (rfc2047-decode 968 (rfc2047-decode
789 (match-string 1 word) 969 (match-string 1 word)
790 (upcase (match-string 2 word)) 970 (string-to-char (match-string 3 word))
791 (match-string 3 word)) 971 (match-string 4 word))
792 (error word)) 972 (error word))
793 word))) ; un-decodable 973 word))) ; un-decodable
794 974
@@ -809,7 +989,7 @@ decodable."
809 989
810(defun rfc2047-decode (charset encoding string) 990(defun rfc2047-decode (charset encoding string)
811 "Decode STRING from the given MIME CHARSET in the given ENCODING. 991 "Decode STRING from the given MIME CHARSET in the given ENCODING.
812Valid ENCODINGs are \"B\" and \"Q\". 992Valid ENCODINGs are the characters \"B\" and \"Q\".
813If your Emacs implementation can't decode CHARSET, return nil." 993If your Emacs implementation can't decode CHARSET, return nil."
814 (if (stringp charset) 994 (if (stringp charset)
815 (setq charset (intern (downcase charset)))) 995 (setq charset (intern (downcase charset))))
@@ -824,18 +1004,17 @@ If your Emacs implementation can't decode CHARSET, return nil."
824 (memq 'gnus-unknown mail-parse-ignored-charsets)) 1004 (memq 'gnus-unknown mail-parse-ignored-charsets))
825 (setq cs (mm-charset-to-coding-system mail-parse-charset))) 1005 (setq cs (mm-charset-to-coding-system mail-parse-charset)))
826 (when cs 1006 (when cs
827 (when (and (eq cs 'ascii) 1007 (when (eq cs 'ascii)
828 mail-parse-charset) 1008 (setq cs (or mail-parse-charset 'raw-text)))
829 (setq cs mail-parse-charset))
830 (mm-decode-coding-string 1009 (mm-decode-coding-string
831 (cond 1010 (cond
832 ((equal "B" encoding) 1011 ((char-equal ?B encoding)
833 (base64-decode-string 1012 (base64-decode-string
834 (rfc2047-pad-base64 string))) 1013 (rfc2047-pad-base64 string)))
835 ((equal "Q" encoding) 1014 ((char-equal ?Q encoding)
836 (quoted-printable-decode-string 1015 (quoted-printable-decode-string
837 (mm-replace-chars-in-string string ?_ ? ))) 1016 (mm-subst-char-in-string ?_ ? string t)))
838 (t (error "Invalid encoding: %s" encoding))) 1017 (t (error "Invalid encoding: %c" encoding)))
839 cs)))) 1018 cs))))
840 1019
841(provide 'rfc2047) 1020(provide 'rfc2047)
diff --git a/lisp/hl-line.el b/lisp/hl-line.el
index a3e786dd801..e553636674b 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -1,6 +1,6 @@
1;;; hl-line.el --- highlight the current line 1;;; hl-line.el --- highlight the current line
2 2
3;; Copyright (C) 1998, 2000, 2001, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 1998, 2000, 2001, 2003, 2005 Free Software Foundation, Inc.
4 4
5;; Author: Dave Love <fx@gnu.org> 5;; Author: Dave Love <fx@gnu.org>
6;; Maintainer: FSF 6;; Maintainer: FSF
@@ -113,7 +113,7 @@ When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the
113line about point in the selected window only. In this case, it 113line about point in the selected window only. In this case, it
114uses the function `hl-line-unhighlight' on `pre-command-hook' in 114uses the function `hl-line-unhighlight' on `pre-command-hook' in
115addition to `hl-line-highlight' on `post-command-hook'." 115addition to `hl-line-highlight' on `post-command-hook'."
116 nil nil nil 116 :group 'hl-line
117 (if hl-line-mode 117 (if hl-line-mode
118 (progn 118 (progn
119 ;; In case `kill-all-local-variables' is called. 119 ;; In case `kill-all-local-variables' is called.
diff --git a/lisp/ido.el b/lisp/ido.el
index 86a88d0d491..ddeecbb9b69 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1935,19 +1935,21 @@ If INITIAL is non-nil, it specifies the initial input string."
1935 ;; Internal function for ido-find-file and friends 1935 ;; Internal function for ido-find-file and friends
1936 (unless item 1936 (unless item
1937 (setq item 'file)) 1937 (setq item 'file))
1938 (let* ((ido-current-directory (ido-expand-directory default)) 1938 (let ((ido-current-directory (ido-expand-directory default))
1939 (ido-directory-nonreadable (ido-nonreadable-directory-p ido-current-directory)) 1939 (ido-context-switch-command switch-cmd)
1940 (ido-directory-too-big (and (not ido-directory-nonreadable) 1940 ido-directory-nonreadable ido-directory-too-big
1941 (ido-directory-too-big-p ido-current-directory))) 1941 filename)
1942 (ido-context-switch-command switch-cmd) 1942
1943 filename) 1943 (if (or (not ido-mode) (ido-is-slow-ftp-host))
1944 1944 (setq filename t
1945 (cond 1945 ido-exit 'fallback)
1946 ((or (not ido-mode) (ido-is-slow-ftp-host)) 1946 (setq ido-directory-nonreadable
1947 (setq filename t 1947 (ido-nonreadable-directory-p ido-current-directory)
1948 ido-exit 'fallback)) 1948 ido-directory-too-big
1949 1949 (and (not ido-directory-nonreadable)
1950 ((and (eq item 'file) 1950 (ido-directory-too-big-p ido-current-directory))))
1951
1952 (when (and (eq item 'file)
1951 (or ido-use-url-at-point ido-use-filename-at-point)) 1953 (or ido-use-url-at-point ido-use-filename-at-point))
1952 (let (fn d) 1954 (let (fn d)
1953 (require 'ffap) 1955 (require 'ffap)
@@ -1966,7 +1968,7 @@ If INITIAL is non-nil, it specifies the initial input string."
1966 (setq d (file-name-directory fn)) 1968 (setq d (file-name-directory fn))
1967 (file-directory-p d)) 1969 (file-directory-p d))
1968 (setq ido-current-directory d) 1970 (setq ido-current-directory d)
1969 (setq initial (file-name-nondirectory fn))))))) 1971 (setq initial (file-name-nondirectory fn))))))
1970 1972
1971 (let (ido-saved-vc-hb 1973 (let (ido-saved-vc-hb
1972 (vc-handled-backends (and (boundp 'vc-handled-backends) vc-handled-backends)) 1974 (vc-handled-backends (and (boundp 'vc-handled-backends) vc-handled-backends))
diff --git a/lisp/iimage.el b/lisp/iimage.el
index 9b183ebb01d..32f6aef9abd 100644
--- a/lisp/iimage.el
+++ b/lisp/iimage.el
@@ -1,6 +1,6 @@
1;;; iimage.el --- Inline image minor mode. 1;;; iimage.el --- Inline image minor mode.
2 2
3;; Copyright (C) 2004 Free Software Foundation 3;; Copyright (C) 2004, 2005 Free Software Foundation
4 4
5;; Author: KOSEKI Yoshinori <kose@meadowy.org> 5;; Author: KOSEKI Yoshinori <kose@meadowy.org>
6;; Maintainer: KOSEKI Yoshinori <kose@meadowy.org> 6;; Maintainer: KOSEKI Yoshinori <kose@meadowy.org>
@@ -51,6 +51,11 @@
51(eval-when-compile 51(eval-when-compile
52 (require 'image-file)) 52 (require 'image-file))
53 53
54(defgroup iimage nil
55 "Support for inline images."
56 :version "22.1"
57 :group 'image)
58
54(defconst iimage-version "1.1") 59(defconst iimage-version "1.1")
55(defvar iimage-mode nil) 60(defvar iimage-mode nil)
56(defvar iimage-mode-map nil) 61(defvar iimage-mode-map nil)
@@ -137,7 +142,7 @@ With numeric ARG, display the images if and only if ARG is positive."
137;;;###autoload 142;;;###autoload
138(define-minor-mode iimage-mode 143(define-minor-mode iimage-mode
139 "Toggle inline image minor mode." 144 "Toggle inline image minor mode."
140 nil " iImg" iimage-mode-map 145 :group 'iimage :lighter " iImg" :keymap iimage-mode-map
141 (run-hooks 'iimage-mode-hook) 146 (run-hooks 'iimage-mode-hook)
142 (iimage-mode-buffer iimage-mode)) 147 (iimage-mode-buffer iimage-mode))
143 148
diff --git a/lisp/info.el b/lisp/info.el
index 870e1ad89f6..cefe603a400 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -3026,12 +3026,12 @@ if point is in a menu item description, follow that menu item."
3026 :help "Go to menu of visited nodes"] 3026 :help "Go to menu of visited nodes"]
3027 ["Table of Contents" Info-toc 3027 ["Table of Contents" Info-toc
3028 :help "Go to table of contents"] 3028 :help "Go to table of contents"]
3029 ("Index..." 3029 ("Index"
3030 ["Lookup a String" Info-index 3030 ["Lookup a String..." Info-index
3031 :help "Look for a string in the index items"] 3031 :help "Look for a string in the index items"]
3032 ["Next Matching Item" Info-index-next 3032 ["Next Matching Item" Info-index-next :active Info-index-alternatives
3033 :help "Look for another occurrence of previous item"] 3033 :help "Look for another occurrence of previous item"]
3034 ["Lookup a string in all indices" info-apropos 3034 ["Lookup a string in all indices..." info-apropos
3035 :help "Look for a string in the indices of all manuals"]) 3035 :help "Look for a string in the indices of all manuals"])
3036 ["Edit" Info-edit :help "Edit contents of this node" 3036 ["Edit" Info-edit :help "Edit contents of this node"
3037 :active Info-enable-edit] 3037 :active Info-enable-edit]
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index 727c9e6b9ff..77eb49807c0 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -884,8 +884,8 @@
884 (set-case-syntax-pair 884 (set-case-syntax-pair
885 (decode-char 'ucs (1- c)) (decode-char 'ucs c) tbl)) 885 (decode-char 'ucs (1- c)) (decode-char 'ucs c) tbl))
886 (setq c (1+ c))) 886 (setq c (1+ c)))
887 ;;(set-downcase-syntax ?$,1 P(B ?i tbl) 887 (set-downcase-syntax ?$,1 P(B ?i tbl)
888 ;;(set-upcase-syntax ?I ?$,1 Q(B tbl) 888 (set-upcase-syntax ?I ?$,1 Q(B tbl)
889 (set-case-syntax-pair ?$,1 R(B ?$,1 S(B tbl) 889 (set-case-syntax-pair ?$,1 R(B ?$,1 S(B tbl)
890 (set-case-syntax-pair ?$,1 T(B ?$,1 U(B tbl) 890 (set-case-syntax-pair ?$,1 T(B ?$,1 U(B tbl)
891 (set-case-syntax-pair ?$,1 V(B ?$,1 W(B tbl) 891 (set-case-syntax-pair ?$,1 V(B ?$,1 W(B tbl)
diff --git a/lisp/international/encoded-kb.el b/lisp/international/encoded-kb.el
index aa6d35c340f..fdb35b34533 100644
--- a/lisp/international/encoded-kb.el
+++ b/lisp/international/encoded-kb.el
@@ -269,7 +269,7 @@ automatically.
269In Encoded-kbd mode, a text sent from keyboard is accepted 269In Encoded-kbd mode, a text sent from keyboard is accepted
270as a multilingual text encoded in a coding system set by 270as a multilingual text encoded in a coding system set by
271\\[set-keyboard-coding-system]." 271\\[set-keyboard-coding-system]."
272 :global t 272 :global t :group 'keyboard :group 'mule
273 273
274 (if encoded-kbd-mode 274 (if encoded-kbd-mode
275 ;; We are turning on Encoded-kbd mode. 275 ;; We are turning on Encoded-kbd mode.
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 86665d31ba8..5e9f3014dc2 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -384,6 +384,7 @@ See also `coding-category-list' and `coding-system-category'."
384 ;; CODING-SYSTEM is no-conversion or undecided. 384 ;; CODING-SYSTEM is no-conversion or undecided.
385 (error "Can't prefer the coding system `%s'" coding-system)) 385 (error "Can't prefer the coding system `%s'" coding-system))
386 (set coding-category (or base coding-system)) 386 (set coding-category (or base coding-system))
387 ;; Changing the binding of a coding category requires this call.
387 (update-coding-systems-internal) 388 (update-coding-systems-internal)
388 (or (eq coding-category (car coding-category-list)) 389 (or (eq coding-category (car coding-category-list))
389 ;; We must change the order. 390 ;; We must change the order.
@@ -1691,6 +1692,7 @@ The default status is as follows:
1691 coding-category-ccl 1692 coding-category-ccl
1692 coding-category-binary)) 1693 coding-category-binary))
1693 1694
1695 ;; Changing the binding of a coding category requires this call.
1694 (update-coding-systems-internal) 1696 (update-coding-systems-internal)
1695 1697
1696 (set-default-coding-systems nil) 1698 (set-default-coding-systems nil)
@@ -1904,6 +1906,7 @@ of `buffer-file-coding-system' set by this function."
1904 (while priority 1906 (while priority
1905 (set (car categories) (car priority)) 1907 (set (car categories) (car priority))
1906 (setq priority (cdr priority) categories (cdr categories))) 1908 (setq priority (cdr priority) categories (cdr categories)))
1909 ;; Changing the binding of a coding category requires this call.
1907 (update-coding-systems-internal))))) 1910 (update-coding-systems-internal)))))
1908 1911
1909(defsubst princ-list (&rest args) 1912(defsubst princ-list (&rest args)
diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el
index 7c51409422b..8ac56b4bd65 100644
--- a/lisp/international/mule-util.el
+++ b/lisp/international/mule-util.el
@@ -327,6 +327,7 @@ coding systems ordered by priority."
327 (mapc (function (lambda (x) (set (car x) (cdr x)))) 327 (mapc (function (lambda (x) (set (car x) (cdr x))))
328 prio-list) 328 prio-list)
329 (set-coding-priority (mapcar #'car prio-list)) 329 (set-coding-priority (mapcar #'car prio-list))
330 ;; Changing the binding of a coding category requires this call.
330 (update-coding-systems-internal) 331 (update-coding-systems-internal)
331 (detect-coding-region ,from ,to)) 332 (detect-coding-region ,from ,to))
332 ;; We must restore the internal database. 333 ;; We must restore the internal database.
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 1ec546e22fd..49635652bb2 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -1546,6 +1546,7 @@ text, and convert it in the temporary buffer. Otherwise, convert in-place."
1546 ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|[JEW]AR\\|XPI\\)\\'" . no-conversion) 1546 ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|[JEW]AR\\|XPI\\)\\'" . no-conversion)
1547 ("\\.\\(sx[dmicw]\\|tar\\|tgz\\)\\'" . no-conversion) 1547 ("\\.\\(sx[dmicw]\\|tar\\|tgz\\)\\'" . no-conversion)
1548 ("\\.\\(gz\\|Z\\|bz\\|bz2\\|gpg\\)\\'" . no-conversion) 1548 ("\\.\\(gz\\|Z\\|bz\\|bz2\\|gpg\\)\\'" . no-conversion)
1549 ("\\.\\(jpe?g\\|png\\|gif\\|tiff?\\|p[bpgn]m\\)\\'" . no-conversion)
1549 ("/#[^/]+#\\'" . emacs-mule)) 1550 ("/#[^/]+#\\'" . emacs-mule))
1550 "Alist of filename patterns vs corresponding coding systems. 1551 "Alist of filename patterns vs corresponding coding systems.
1551Each element looks like (REGEXP . CODING-SYSTEM). 1552Each element looks like (REGEXP . CODING-SYSTEM).
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index c6a97bb3d34..20816fc7fea 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -614,10 +614,13 @@ With numeric arg, repeat macro now that many times,
614counting the definition just completed as the first repetition. 614counting the definition just completed as the first repetition.
615An argument of zero means repeat until error." 615An argument of zero means repeat until error."
616 (interactive "P") 616 (interactive "P")
617 (end-kbd-macro arg #'kmacro-loop-setup-function) 617 ;; Isearch may push the kmacro-end-macro key sequence onto the macro.
618 (when (and last-kbd-macro (= (length last-kbd-macro) 0)) 618 ;; Just ignore it when executing the macro.
619 (message "Ignore empty macro") 619 (unless executing-kbd-macro
620 (kmacro-pop-ring))) 620 (end-kbd-macro arg #'kmacro-loop-setup-function)
621 (when (and last-kbd-macro (= (length last-kbd-macro) 0))
622 (message "Ignore empty macro")
623 (kmacro-pop-ring))))
621 624
622 625
623;;;###autoload 626;;;###autoload
diff --git a/lisp/language/thai-util.el b/lisp/language/thai-util.el
index 09f84d6fad6..dea05a4c948 100644
--- a/lisp/language/thai-util.el
+++ b/lisp/language/thai-util.el
@@ -1,10 +1,9 @@
1;;; thai-util.el --- utilities for Thai -*- coding: iso-2022-7bit; -*- 1;;; thai-util.el --- utilities for Thai -*- coding: iso-2022-7bit; -*-
2 2
3;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. 3;; Copyright (C) 1995, 1997, 1998, 1999, 2000, 2001, 2005
4;; Licensed to the Free Software Foundation.
5;; Copyright (C) 2005
6;; National Institute of Advanced Industrial Science and Technology (AIST) 4;; National Institute of Advanced Industrial Science and Technology (AIST)
7;; Registration Number H14PRO021 5;; Registration Number H14PRO021
6;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
8 7
9;; Keywords: mule, multilingual, thai 8;; Keywords: mule, multilingual, thai
10 9
@@ -279,7 +278,7 @@ if necessary."
279 278
280(defun thai-compose-syllable (beg end &optional category-set string) 279(defun thai-compose-syllable (beg end &optional category-set string)
281 (or category-set 280 (or category-set
282 (setq category-set 281 (setq category-set
283 (char-category-set (if string (aref string beg) (char-after beg))))) 282 (char-category-set (if string (aref string beg) (char-after beg)))))
284 (if (aref category-set ?c) 283 (if (aref category-set ?c)
285 ;; Starting with a consonant. We do relative composition. 284 ;; Starting with a consonant. We do relative composition.
@@ -288,9 +287,9 @@ if necessary."
288 (compose-region beg end)) 287 (compose-region beg end))
289 ;; Vowel tone sequence. 288 ;; Vowel tone sequence.
290 (if string 289 (if string
291 (compose-string string beg end (list (aref string beg) '(Bc . Bc) 290 (compose-string string beg end (list (aref string beg) '(Bc . Bc)
292 (aref string (1+ beg)))) 291 (aref string (1+ beg))))
293 (compose-region beg end (list (char-after beg) '(Bc . Bc) 292 (compose-region beg end (list (char-after beg) '(Bc . Bc)
294 (char-after (1+ beg)))))) 293 (char-after (1+ beg))))))
295 (- end beg)) 294 (- end beg))
296 295
@@ -348,7 +347,7 @@ The return value is number of composed characters."
348 (if string 347 (if string
349 (if (eq (string-match thai-composition-pattern string from) from) 348 (if (eq (string-match thai-composition-pattern string from) from)
350 (thai-compose-syllable from (match-end 0) nil string)) 349 (thai-compose-syllable from (match-end 0) nil string))
351 (if (save-excursion 350 (if (save-excursion
352 (goto-char from) 351 (goto-char from)
353 (and (looking-at thai-composition-pattern) 352 (and (looking-at thai-composition-pattern)
354 (setq to (match-end 0)))) 353 (setq to (match-end 0))))
@@ -376,12 +375,48 @@ The return value is number of composed characters."
376;;;###autoload 375;;;###autoload
377(define-minor-mode thai-auto-composition-mode 376(define-minor-mode thai-auto-composition-mode
378 "Minor mode for automatically correct Thai character composition." 377 "Minor mode for automatically correct Thai character composition."
379 nil nil nil 378 :group 'mule
380 (cond ((null thai-auto-composition-mode) 379 (cond ((null thai-auto-composition-mode)
381 (remove-hook 'after-change-functions 'thai-auto-composition)) 380 (remove-hook 'after-change-functions 'thai-auto-composition))
382 (t 381 (t
383 (add-hook 'after-change-functions 'thai-auto-composition)))) 382 (add-hook 'after-change-functions 'thai-auto-composition))))
384 383
384;; Thai-word-mode requires functions in the feature `thai-word'.
385(require 'thai-word)
386
387(defvar thai-word-mode-map
388 (let ((map (make-sparse-keymap)))
389 (define-key map [remap forward-word] 'thai-forward-word)
390 (define-key map [remap backward-word] 'thai-backward-word)
391 (define-key map [remap kill-word] 'thai-kill-word)
392 (define-key map [remap backward-kill-word] 'thai-backward-kill-word)
393 (define-key map [remap transpose-words] 'thai-transpose-words)
394 map)
395 "Keymap for `thai-word-mode'.")
396
397(define-minor-mode thai-word-mode
398 "Minor mode to make word-oriented commands aware of Thai words.
399The commands affected are \\[forward-word], \\[backward-word], \\[kill-word], \\[backward-kill-word], \\[transpose-words], and \\[fill-paragraph]."
400 :global t :group 'mule
401 (cond (thai-word-mode
402 ;; This enables linebreak between Thai characters.
403 (modify-category-entry (make-char 'thai-tis620) ?|)
404 ;; This enables linebreak at a Thai word boundary.
405 (put-charset-property 'thai-tis620 'fill-find-break-point-function
406 'thai-fill-find-break-point))
407 (t
408 (modify-category-entry (make-char 'thai-tis620) ?| nil t)
409 (put-charset-property 'thai-tis620 'fill-find-break-point-function
410 nil))))
411
412;; Function to call on entering the Thai language environment.
413(defun setup-thai-language-environment-internal ()
414 (thai-word-mode 1))
415
416;; Function to call on exiting the Thai language environment.
417(defun exit-thai-language-environment-internal ()
418 (thai-word-mode -1))
419
385;; 420;;
386(provide 'thai-util) 421(provide 'thai-util)
387 422
diff --git a/lisp/language/thai-word.el b/lisp/language/thai-word.el
index 82f6fcdea6a..2548a44ea80 100644
--- a/lisp/language/thai-word.el
+++ b/lisp/language/thai-word.el
@@ -1,7 +1,8 @@
1;;; thai-word.el -- find Thai word boundaries 1;;; thai-word.el -- find Thai word boundaries
2 2
3;; Copyright (C) 2000, 2001, 2002, 2003, 2004 3;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005
4;; Electrotechnical Laboratory, JAPAN. 4;; National Institute of Advanced Industrial Science and Technology (AIST)
5;; Registration Number H14PRO021
5 6
6;; Author: Kenichi HANDA <handa@etl.go.jp> 7;; Author: Kenichi HANDA <handa@etl.go.jp>
7 8
@@ -72,13 +73,10 @@
72;; which means that you can easily index the list character by 73;; which means that you can easily index the list character by
73;; character. 74;; character.
74 75
75(defconst thai-word-table nil) 76(defvar thai-word-table
76 77 (let ((table (list 'thai-words)))
77 78 (dolist (elt
78;; Set up `thai-word-table'. 79 ;;; The following is indented as this to minimize this file size.
79
80(let
81 ((l
82 '("¡¡" 80 '("¡¡"
83 "¡¡Å" 81 "¡¡Å"
84 "¡¡Ø¸Àѳ±ì" 82 "¡¡Ø¸Àѳ±ì"
@@ -10732,11 +10730,10 @@
10732 "äÎâ¡ÃÁÔàµÍÃì" 10730 "äÎâ¡ÃÁÔàµÍÃì"
10733 "äÎâ´Ã¤ÒÃìºÍ¹" 10731 "äÎâ´Ã¤ÒÃìºÍ¹"
10734 "äÎâÅ" 10732 "äÎâÅ"
10735 ))) 10733 ))
10736 (setq thai-word-table (list 'thai-words)) 10734 (set-nested-alist elt 1 table))
10737 (while l 10735 table)
10738 (set-nested-alist (car l) 1 thai-word-table) 10736 "Nested alist of Thai words.")
10739 (setq l (cdr l))))
10740 10737
10741 10738
10742(defun thai-update-word-table (file &optional append) 10739(defun thai-update-word-table (file &optional append)
@@ -10783,7 +10780,7 @@ the current word list."
10783 ;; character by character. 10780 ;; character by character.
10784 (while this 10781 (while this
10785 (setq pos (1+ pos) 10782 (setq pos (1+ pos)
10786 char (char-after pos) 10783 char (or (char-after pos) 0)
10787 category-set (char-category-set char)) 10784 category-set (char-category-set char))
10788 ;; If the current sequence is recorded in `thai-word-table' 10785 ;; If the current sequence is recorded in `thai-word-table'
10789 ;; (i.e. (car THIS) is 1) and the following Thai character is 10786 ;; (i.e. (car THIS) is 1) and the following Thai character is
@@ -11042,6 +11039,33 @@ If COUNT is negative, move point forward (- COUNT) words."
11042 (thai-forward-word (- count))) 11039 (thai-forward-word (- count)))
11043 11040
11044 11041
11042(defun thai-kill-word (arg)
11043 "Like kill-word but pay attention to Thai word boundaries.
11044With argument, do this that many times."
11045 (interactive "p")
11046 (kill-region (point) (progn (thai-forward-word arg) (point))))
11047
11048
11049(defun thai-backward-kill-word (arg)
11050 "Like backward-kill-word but pay attention to Thai word boundaries."
11051 (interactive "p")
11052 (thai-kill-word (- arg)))
11053
11054
11055(defun thai-transpose-words (arg)
11056 "Like transpose-words but pay attention to Thai word boundaries."
11057 (interactive "*p")
11058 (transpose-subr 'thai-forward-word arg))
11059
11060(defun thai-fill-find-break-point (linebeg)
11061 "Go to a line breaking position near point considering Thai word boundaries."
11062 (let ((pos (point)))
11063 (thai-forward-word -1)
11064 (when (<= (point) linebeg)
11065 (goto-char pos)
11066 (thai-forward-word 1))
11067 (kinsoku linebeg)))
11068
11045(provide 'thai-word) 11069(provide 'thai-word)
11046 11070
11047 11071
diff --git a/lisp/language/thai.el b/lisp/language/thai.el
index 6b5df5c08b6..c14d0005a72 100644
--- a/lisp/language/thai.el
+++ b/lisp/language/thai.el
@@ -1,10 +1,9 @@
1;;; thai.el --- support for Thai -*- coding: iso-2022-7bit; no-byte-compile: t -*- 1;;; thai.el --- support for Thai -*- coding: iso-2022-7bit; no-byte-compile: t -*-
2 2
3;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. 3;; Copyright (C) 1995, 1997, 1998, 1999, 2000, 2002, 2005
4;; Licensed to the Free Software Foundation.
5;; Copyright (C) 2005
6;; National Institute of Advanced Industrial Science and Technology (AIST) 4;; National Institute of Advanced Industrial Science and Technology (AIST)
7;; Registration Number H14PRO021 5;; Registration Number H14PRO021
6;; Copyright (C) 1997, 1998, 2000, 2001, 2002 Free Software Foundation, Inc.
8 7
9;; Keywords: multilingual, Thai 8;; Keywords: multilingual, Thai
10 9
@@ -53,6 +52,8 @@
53 (input-method . "thai-kesmanee") 52 (input-method . "thai-kesmanee")
54 (unibyte-display . thai-tis620) 53 (unibyte-display . thai-tis620)
55 (features thai-util) 54 (features thai-util)
55 (setup-function . setup-thai-language-environment-internal)
56 (exit-function . exit-thai-language-environment-internal)
56 (sample-text 57 (sample-text
57 . (thai-compose-string 58 . (thai-compose-string
58 (copy-sequence "Thai (,T@RIRd7B(B) ,TJ0GQ1J04U1$0CQ1:(B, ,TJ0GQ1J04U10$h1P(B"))) 59 (copy-sequence "Thai (,T@RIRd7B(B) ,TJ0GQ1J04U1$0CQ1:(B, ,TJ0GQ1J04U10$h1P(B")))
diff --git a/lisp/longlines.el b/lisp/longlines.el
new file mode 100644
index 00000000000..ebfb7a660b0
--- /dev/null
+++ b/lisp/longlines.el
@@ -0,0 +1,393 @@
1;;; longlines.el --- automatically wrap long lines
2
3;; Copyright (C) 2000, 2001, 2004, 2005 by Free Software Foundation, Inc.
4
5;; Authors: Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
6;; Alex Schroeder <alex@gnu.org>
7;; Chong Yidong <cyd@stupidchicken.com>
8;; Maintainer: Chong Yidong <cyd@stupidchicken.com>
9;; Keywords: convenience
10
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs is free software; you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation; either version 2, or (at your option)
16;; any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs; see the file COPYING. If not, write to the
25;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26;; Boston, MA 02111-1307, USA.
27
28;;; Commentary:
29
30;; Some text editors save text files with long lines, and they
31;; automatically break these lines at whitespace, without actually
32;; inserting any newline characters. When doing `M-q' in Emacs, you
33;; are inserting newline characters. Longlines mode provides a file
34;; format which wraps the long lines when reading a file and unwraps
35;; the lines when saving the file. It can also wrap and unwrap
36;; automatically as editing takes place.
37
38;; Special thanks to Rod Smith for many useful bug reports.
39
40;;; Code:
41
42(require 'easy-mmode)
43
44(defgroup longlines nil
45 "Automatic wrapping of long lines when loading files."
46 :group 'fill)
47
48(defcustom longlines-auto-wrap t
49 "*Non-nil means long lines are automatically wrapped after each command.
50Otherwise, you can perform filling using `fill-paragraph' or
51`auto-fill-mode'. In any case, the soft newlines will be removed
52when the file is saved to disk."
53 :group 'longlines
54 :type 'boolean)
55
56(defcustom longlines-wrap-follows-window-size nil
57 "*Non-nil means wrapping and filling happen at the edge of the window.
58Otherwise, `fill-column' is used, regardless of the window size. This
59does not work well when the buffer is displayed in multiple windows
60with differing widths."
61 :group 'longlines
62 :type 'boolean)
63
64(defcustom longlines-show-hard-newlines nil
65 "*Non-nil means each hard newline is marked with a symbol.
66You can also enable the display temporarily, using the command
67`longlines-show-hard-newlines'"
68 :group 'longlines
69 :type 'boolean)
70
71(defcustom longlines-show-effect (propertize "|\n" 'face 'escape-glyph)
72 "*A string to display when showing hard newlines.
73This is used when `longlines-show-hard-newlines' is on."
74 :group 'longlines
75 :type 'string)
76
77;; Internal variables
78
79(defvar longlines-wrap-beg nil)
80(defvar longlines-wrap-end nil)
81(defvar longlines-wrap-point nil)
82(defvar longlines-showing nil)
83
84(make-variable-buffer-local 'longlines-wrap-beg)
85(make-variable-buffer-local 'longlines-wrap-end)
86(make-variable-buffer-local 'longlines-wrap-point)
87(make-variable-buffer-local 'longlines-showing)
88
89;; Mode
90
91;;;###autoload
92(define-minor-mode longlines-mode
93 "Toggle Long Lines mode.
94In Long Lines mode, long lines are wrapped if they extend beyond
95`fill-column'. The soft newlines used for line wrapping will not
96show up when the text is yanked or saved to disk.
97
98If `longlines-auto-wrap' is non-nil, lines are automatically
99wrapped whenever the buffer is changed. You can always call
100`fill-paragraph' to fill individual paragraphs.
101
102If `longlines-show-hard-newlines' is non-nil, hard newlines will
103be marked by a symbol."
104 :group 'longlines :lighter " ll"
105 (if longlines-mode
106 ;; Turn on longlines mode
107 (progn
108 (use-hard-newlines 1 'never)
109 (set (make-local-variable 'require-final-newline) nil)
110 (add-to-list 'buffer-file-format 'longlines)
111 (add-hook 'change-major-mode-hook 'longlines-mode-off nil t)
112 (make-local-variable 'buffer-substring-filters)
113 (add-to-list 'buffer-substring-filters 'longlines-encode-string)
114 (when longlines-wrap-follows-window-size
115 (set (make-local-variable 'fill-column)
116 (- (window-width) window-min-width))
117 (add-hook 'window-configuration-change-hook
118 'longlines-window-change-function nil t))
119 (let ((buffer-undo-list t)
120 (mod (buffer-modified-p)))
121 ;; Turning off undo is OK since (spaces + newlines) is
122 ;; conserved, except for a corner case in
123 ;; longlines-wrap-lines that we'll never encounter from here
124 (longlines-decode-region (point-min) (point-max))
125 (longlines-wrap-region (point-min) (point-max))
126 (set-buffer-modified-p mod))
127 (when (and longlines-show-hard-newlines
128 (not longlines-showing))
129 (longlines-show-hard-newlines))
130 (when longlines-auto-wrap
131 (auto-fill-mode 0)
132 (add-hook 'after-change-functions
133 'longlines-after-change-function nil t)
134 (add-hook 'post-command-hook
135 'longlines-post-command-function nil t)))
136 ;; Turn off longlines mode
137 (setq buffer-file-format (delete 'longlines buffer-file-format))
138 (if longlines-showing
139 (longlines-unshow-hard-newlines))
140 (let ((buffer-undo-list t))
141 (longlines-encode-region (point-min) (point-max)))
142 (remove-hook 'change-major-mode-hook 'longlines-mode-off t)
143 (remove-hook 'before-kill-functions 'longlines-encode-region t)
144 (remove-hook 'after-change-functions 'longlines-after-change-function t)
145 (remove-hook 'post-command-hook 'longlines-post-command-function t)
146 (remove-hook 'window-configuration-change-hook
147 'longlines-window-change-function t)
148 (kill-local-variable 'fill-column)))
149
150(defun longlines-mode-off ()
151 "Turn off longlines mode.
152This function exists to be called by `change-major-mode-hook' when the
153major mode changes."
154 (longlines-mode 0))
155
156;; Showing the effect of hard newlines in the buffer
157
158(defface longlines-visible-face
159 '((t (:background "red")))
160 "Face used to make hard newlines visible in `longlines-mode'.")
161
162(defun longlines-show-hard-newlines (&optional arg)
163 "Make hard newlines visible by adding a face.
164With optional argument ARG, make the hard newlines invisible again."
165 (interactive "P")
166 (let ((buffer-undo-list t)
167 (mod (buffer-modified-p)))
168 (if arg
169 (longlines-unshow-hard-newlines)
170 (setq longlines-showing t)
171 (longlines-show-region (point-min) (point-max)))
172 (set-buffer-modified-p mod)))
173
174(defun longlines-show-region (beg end)
175 "Make hard newlines between BEG and END visible."
176 (let* ((pmin (min beg end))
177 (pmax (max beg end))
178 (pos (text-property-any pmin pmax 'hard t)))
179 (while pos
180 (put-text-property pos (1+ pos) 'display
181 (copy-sequence longlines-show-effect))
182 (setq pos (text-property-any (1+ pos) pmax 'hard t)))))
183
184(defun longlines-unshow-hard-newlines ()
185 "Make hard newlines invisible again."
186 (interactive)
187 (setq longlines-showing nil)
188 (let ((pos (text-property-any (point-min) (point-max) 'hard t)))
189 (while pos
190 (remove-text-properties pos (1+ pos) '(display))
191 (setq pos (text-property-any (1+ pos) (point-max) 'hard t)))))
192
193;; Wrapping the paragraphs.
194
195(defun longlines-wrap-region (beg end)
196 "Wrap each successive line, starting with the line before BEG.
197Stop when we reach lines after END that don't need wrapping, or the
198end of the buffer."
199 (setq longlines-wrap-point (point))
200 (goto-char beg)
201 (forward-line -1)
202 ;; Two successful longlines-wrap-line's in a row mean successive
203 ;; lines don't need wrapping.
204 (while (null (and (longlines-wrap-line)
205 (or (eobp)
206 (and (>= (point) end)
207 (longlines-wrap-line))))))
208 (goto-char longlines-wrap-point))
209
210(defun longlines-wrap-line ()
211 "If the current line needs to be wrapped, wrap it and return nil.
212If wrapping is performed, point remains on the line. If the line does
213not need to be wrapped, move point to the next line and return t."
214 (if (longlines-set-breakpoint)
215 (progn (backward-char 1)
216 (delete-char 1)
217 (insert-char ?\n 1)
218 nil)
219 (if (longlines-merge-lines-p)
220 (progn (end-of-line)
221 (delete-char 1)
222 ;; After certain commands (e.g. kill-line), there may be two
223 ;; successive soft newlines in the buffer. In this case, we
224 ;; replace these two newlines by a single space. Unfortunately,
225 ;; this breaks the conservation of (spaces + newlines), so we
226 ;; have to fiddle with longlines-wrap-point.
227 (if (or (bolp) (eolp))
228 (if (> longlines-wrap-point (point))
229 (setq longlines-wrap-point
230 (1- longlines-wrap-point)))
231 (insert-char ? 1))
232 nil)
233 (forward-line 1)
234 t)))
235
236(defun longlines-set-breakpoint ()
237 "Place point where we should break the current line, and return t.
238If the line should not be broken, return nil; point remains on the
239line."
240 (move-to-column fill-column)
241 (if (and (re-search-forward "[^ ]" (line-end-position) 1)
242 (> (current-column) fill-column))
243 ;; This line is too long. Can we break it?
244 (or (longlines-find-break-backward)
245 (progn (move-to-column fill-column)
246 (longlines-find-break-forward)))))
247
248(defun longlines-find-break-backward ()
249 "Move point backward to the first available breakpoint and return t.
250If no breakpoint is found, return nil."
251 (and (search-backward " " (line-beginning-position) 1)
252 (save-excursion
253 (skip-chars-backward " " (line-beginning-position))
254 (null (bolp)))
255 (progn (forward-char 1)
256 (if (and fill-nobreak-predicate
257 (run-hook-with-args-until-success
258 'fill-nobreak-predicate))
259 (progn (skip-chars-backward " " (line-beginning-position))
260 (longlines-find-break-backward))
261 t))))
262
263(defun longlines-find-break-forward ()
264 "Move point forward to the first available breakpoint and return t.
265If no break point is found, return nil."
266 (and (search-forward " " (line-end-position) 1)
267 (progn (skip-chars-forward " " (line-end-position))
268 (null (eolp)))
269 (if (and fill-nobreak-predicate
270 (run-hook-with-args-until-success
271 'fill-nobreak-predicate))
272 (longlines-find-break-forward)
273 t)))
274
275(defun longlines-merge-lines-p ()
276 "Return t if part of the next line can fit onto the current line.
277Otherwise, return nil. Text cannot be moved across hard newlines."
278 (save-excursion
279 (end-of-line)
280 (and (null (eobp))
281 (null (get-text-property (point) 'hard))
282 (let ((space (- fill-column (current-column))))
283 (forward-line 1)
284 (if (eq (char-after) ? )
285 t ; We can always merge some spaces
286 (<= (if (search-forward " " (line-end-position) 1)
287 (current-column)
288 (1+ (current-column)))
289 space))))))
290
291(defun longlines-decode-region (beg end)
292 "Turn all newlines between BEG and END into hard newlines."
293 (save-excursion
294 (goto-char (min beg end))
295 (while (search-forward "\n" (max beg end) t)
296 (set-hard-newline-properties
297 (match-beginning 0) (match-end 0)))))
298
299(defun longlines-encode-region (beg end &optional buffer)
300 "Replace each soft newline between BEG and END with exactly one space.
301Hard newlines are left intact. The optional argument BUFFER exists for
302compatibility with `format-alist', and is ignored."
303 (save-excursion
304 (let ((mod (buffer-modified-p)))
305 (goto-char (min beg end))
306 (while (search-forward "\n" (max (max beg end)) t)
307 (unless (get-text-property (match-beginning 0) 'hard)
308 (replace-match " ")))
309 (set-buffer-modified-p mod)
310 end)))
311
312(defun longlines-encode-string (string)
313 "Return a copy of STRING with each soft newline replaced by a space.
314Hard newlines are left intact."
315 (let* ((str (copy-sequence string))
316 (pos (string-match "\n" str)))
317 (while pos
318 (if (null (get-text-property pos 'hard str))
319 (aset str pos ? ))
320 (setq pos (string-match "\n" str (1+ pos))))
321 str))
322
323;; Auto wrap
324
325(defun longlines-auto-wrap (&optional arg)
326 "Turn on automatic line wrapping, and wrap the entire buffer.
327With optional argument ARG, turn off line wrapping."
328 (interactive "P")
329 (remove-hook 'after-change-functions 'longlines-after-change-function t)
330 (remove-hook 'post-command-hook 'longlines-post-command-function t)
331 (if arg
332 (progn (setq longlines-auto-wrap nil)
333 (message "Auto wrap disabled."))
334 (setq longlines-auto-wrap t)
335 (add-hook 'after-change-functions
336 'longlines-after-change-function nil t)
337 (add-hook 'post-command-hook
338 'longlines-post-command-function nil t)
339 (let ((mod (buffer-modified-p)))
340 (longlines-wrap-region (point-min) (point-max))
341 (set-buffer-modified-p mod))
342 (message "Auto wrap enabled.")))
343
344(defun longlines-after-change-function (beg end len)
345 "Update `longlines-wrap-beg' and `longlines-wrap-end'.
346This is called by `after-change-functions' to keep track of the region
347that has changed."
348 (unless undo-in-progress
349 (setq longlines-wrap-beg
350 (if longlines-wrap-beg (min longlines-wrap-beg beg) beg))
351 (setq longlines-wrap-end
352 (if longlines-wrap-end (max longlines-wrap-end end) end))))
353
354(defun longlines-post-command-function ()
355 "Perform line wrapping on the parts of the buffer that have changed.
356This is called by `post-command-hook' after each command."
357 (when longlines-wrap-beg
358 (cond ((or (eq this-command 'yank)
359 (eq this-command 'yank-pop))
360 (longlines-decode-region (point) (mark t))
361 (if longlines-showing
362 (longlines-show-region (point) (mark t))))
363 ((and (eq this-command 'newline) longlines-showing)
364 (save-excursion
365 (if (search-backward "\n" nil t)
366 (longlines-show-region
367 (match-beginning 0) (match-end 0))))))
368 (unless (or (eq this-command 'fill-paragraph)
369 (eq this-command 'fill-region))
370 (longlines-wrap-region longlines-wrap-beg longlines-wrap-end))
371 (setq longlines-wrap-beg nil)
372 (setq longlines-wrap-end nil)))
373
374(defun longlines-window-change-function ()
375 "Re-wrap the buffer if the window width has changed.
376This is called by `window-size-change-functions'."
377 (when (/= fill-column (- (window-width) window-min-width))
378 (setq fill-column (- (window-width) window-min-width))
379 (let ((mod (buffer-modified-p)))
380 (longlines-wrap-region (point-min) (point-max))
381 (set-buffer-modified-p mod))))
382
383;; Loading and saving
384
385(add-to-list
386 'format-alist
387 (list 'longlines "Automatically wrap long lines." nil
388 'longlines-decode-region 'longlines-encode-region t nil))
389
390(provide 'longlines)
391
392;; arch-tag: 3489d225-5506-47b9-8659-d8807b77c624
393;;; longlines.el ends here
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 559963589a1..de88b37d91e 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -1622,13 +1622,15 @@ a remote mailbox, PASSWORD is the password if it should be
1622supplied as a separate argument to `movemail' or nil otherwise, GOT-PASSWORD 1622supplied as a separate argument to `movemail' or nil otherwise, GOT-PASSWORD
1623is non-nil if the user has supplied the password interactively. 1623is non-nil if the user has supplied the password interactively.
1624" 1624"
1625 (if (string-match "^\\([^:]+\\)://\\(\\([^:@]+\\)\\(:\\([^@]+\\)\\)?@\\)?.*" file) 1625 (cond
1626 ((string-match "^\\([^:]+\\)://\\(\\([^:@]+\\)\\(:\\([^@]+\\)\\)?@\\)?.*" file)
1626 (let (got-password supplied-password 1627 (let (got-password supplied-password
1627 (proto (match-string 1 file)) 1628 (proto (match-string 1 file))
1628 (user (match-string 3 file)) 1629 (user (match-string 3 file))
1629 (pass (match-string 5 file)) 1630 (pass (match-string 5 file))
1630 (host (substring file (or (match-end 2) 1631 (host (substring file (or (match-end 2)
1631 (+ 3 (match-end 1)))))) 1632 (+ 3 (match-end 1))))))
1633
1632 (if (not pass) 1634 (if (not pass)
1633 (when rmail-remote-password-required 1635 (when rmail-remote-password-required
1634 (setq got-password (not (rmail-have-password))) 1636 (setq got-password (not (rmail-have-password)))
@@ -1645,8 +1647,22 @@ is non-nil if the user has supplied the password interactively.
1645 (list file 1647 (list file
1646 (or (string-equal proto "pop") (string-equal proto "imap")) 1648 (or (string-equal proto "pop") (string-equal proto "imap"))
1647 supplied-password 1649 supplied-password
1648 got-password))) 1650 got-password))))
1649 (list file nil nil nil))) 1651
1652 ((string-match "^po:\\([^:]+\\)\\(:\\(.*\\)\\)?" file)
1653 (let (got-password supplied-password
1654 (proto "pop")
1655 (user (match-string 1 file))
1656 (host (match-string 3 file)))
1657
1658 (when rmail-remote-password-required
1659 (setq got-password (not (rmail-have-password)))
1660 (setq supplied-password (rmail-get-remote-password nil)))
1661
1662 (list file "pop" supplied-password got-password)))
1663
1664 (t
1665 (list file nil nil nil))))
1650 1666
1651(defun rmail-insert-inbox-text (files renamep) 1667(defun rmail-insert-inbox-text (files renamep)
1652 ;; Detect a locked file now, so that we avoid moving mail 1668 ;; Detect a locked file now, so that we avoid moving mail
@@ -1686,15 +1702,7 @@ is non-nil if the user has supplied the password interactively.
1686 (expand-file-name buffer-file-name)))) 1702 (expand-file-name buffer-file-name))))
1687 ;; Always use movemail to rename the file, 1703 ;; Always use movemail to rename the file,
1688 ;; since there can be mailboxes in various directories. 1704 ;; since there can be mailboxes in various directories.
1689 (setq movemail t) 1705 (if (not popmail)
1690;;; ;; If getting from mail spool directory,
1691;;; ;; use movemail to move rather than just renaming,
1692;;; ;; so as to interlock with the mailer.
1693;;; (setq movemail (string= file
1694;;; (file-truename
1695;;; (concat rmail-spool-directory
1696;;; (file-name-nondirectory file)))))
1697 (if (and movemail (not popmail))
1698 (progn 1706 (progn
1699 ;; On some systems, /usr/spool/mail/foo is a directory 1707 ;; On some systems, /usr/spool/mail/foo is a directory
1700 ;; and the actual inbox is /usr/spool/mail/foo/foo. 1708 ;; and the actual inbox is /usr/spool/mail/foo/foo.
@@ -1716,23 +1724,6 @@ is non-nil if the user has supplied the password interactively.
1716 ((or (file-exists-p tofile) (and (not popmail) 1724 ((or (file-exists-p tofile) (and (not popmail)
1717 (not (file-exists-p file)))) 1725 (not (file-exists-p file))))
1718 nil) 1726 nil)
1719 ((and (not movemail) (not popmail))
1720 ;; Try copying. If that fails (perhaps no space) and
1721 ;; we're allowed to blow away the inbox, rename instead.
1722 (if rmail-preserve-inbox
1723 (copy-file file tofile nil)
1724 (condition-case nil
1725 (copy-file file tofile nil)
1726 (error
1727 ;; Third arg is t so we can replace existing file TOFILE.
1728 (rename-file file tofile t))))
1729 ;; Make the real inbox file empty.
1730 ;; Leaving it deleted could cause lossage
1731 ;; because mailers often won't create the file.
1732 (if (not rmail-preserve-inbox)
1733 (condition-case ()
1734 (write-region (point) (point) file)
1735 (file-error nil))))
1736 (t 1727 (t
1737 (with-temp-buffer 1728 (with-temp-buffer
1738 (let ((errors (current-buffer))) 1729 (let ((errors (current-buffer)))
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index 3f24c952d89..6b769f53801 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -838,7 +838,7 @@ error occurs."
838 "Return the mail header field value associated with FIELD. 838 "Return the mail header field value associated with FIELD.
839If there was no mail header with FIELD as its key, return the value of 839If there was no mail header with FIELD as its key, return the value of
840`sc-mumble'. FIELD is case insensitive." 840`sc-mumble'. FIELD is case insensitive."
841 (or (cdr (assoc (downcase field) sc-mail-info)) sc-mumble)) 841 (or (cdr (assoc-string field sc-mail-info 'case-fold)) sc-mumble))
842 842
843(defun sc-mail-field-query (arg) 843(defun sc-mail-field-query (arg)
844 "View the value of a mail field. 844 "View the value of a mail field.
@@ -916,8 +916,8 @@ Match addresses of the style ``<name[stuff]>.''"
916 "Get the full email address path from FROM. 916 "Get the full email address path from FROM.
917AUTHOR is the author's name (which is removed from the address)." 917AUTHOR is the author's name (which is removed from the address)."
918 (let ((eos (length from))) 918 (let ((eos (length from)))
919 (if (string-match (concat "\\(^\\|^\"\\)" author 919 (if (string-match (concat "\\`\"?" (regexp-quote author)
920 "\\(\\s +\\|\"\\s +\\)") from 0) 920 "\"?\\s +") from 0)
921 (let ((address (substring from (match-end 0) eos))) 921 (let ((address (substring from (match-end 0) eos)))
922 (if (and (= (aref address 0) ?<) 922 (if (and (= (aref address 0) ?<)
923 (= (aref address (1- (length address))) ?>)) 923 (= (aref address (1- (length address))) ?>))
@@ -1866,10 +1866,11 @@ Note on function names in this list: all functions of the form
1866 1866
1867(define-minor-mode sc-minor-mode 1867(define-minor-mode sc-minor-mode
1868 "Supercite minor mode." 1868 "Supercite minor mode."
1869 nil (" SC" (sc-auto-fill-region-p 1869 :group 'supercite
1870 (":f" (sc-fixup-whitespace-p "w")) 1870 :lighter (" SC" (sc-auto-fill-region-p
1871 (sc-fixup-whitespace-p ":w"))) 1871 (":f" (sc-fixup-whitespace-p "w"))
1872 `((,sc-mode-map-prefix . ,sc-mode-map))) 1872 (sc-fixup-whitespace-p ":w")))
1873 :keymap `((,sc-mode-map-prefix . ,sc-mode-map)))
1873 1874
1874;;;###autoload 1875;;;###autoload
1875(defun sc-cite-original () 1876(defun sc-cite-original ()
@@ -2054,5 +2055,5 @@ more information. Info node `(SC)Top'."
2054(provide 'supercite) 2055(provide 'supercite)
2055(run-hooks 'sc-load-hook) 2056(run-hooks 'sc-load-hook)
2056 2057
2057;;; arch-tag: a5d5bfa6-3bd5-4414-8c65-0afc83e45cd3 2058;; arch-tag: a5d5bfa6-3bd5-4414-8c65-0afc83e45cd3
2058;;; supercite.el ends here 2059;;; supercite.el ends here
diff --git a/lisp/master.el b/lisp/master.el
index ce4144f087c..b9908e82b55 100644
--- a/lisp/master.el
+++ b/lisp/master.el
@@ -1,6 +1,6 @@
1;;; master.el --- make a buffer the master over another buffer 1;;; master.el --- make a buffer the master over another buffer
2 2
3;; Copyright (C) 1999, 2000, 2001 Alexander Schroeder 3;; Copyright (C) 1999, 2000, 2001, 2005 Alexander Schroeder
4 4
5;; Author: Alex Schroeder <alex@gnu.org> 5;; Author: Alex Schroeder <alex@gnu.org>
6;; Maintainer: Alex Schroeder <alex@gnu.org> 6;; Maintainer: Alex Schroeder <alex@gnu.org>
@@ -55,7 +55,10 @@
55 55
56;;; Code: 56;;; Code:
57 57
58(require 'easy-mmode) 58(defgroup master nil
59 "Support for master/slave relationships between buffers."
60 :version "22.1"
61 :group 'convenience)
59 62
60;; Variables that don't need initialization. 63;; Variables that don't need initialization.
61 64
@@ -83,16 +86,13 @@ following commands:
83The slave buffer is stored in the buffer-local variable `master-of'. 86The slave buffer is stored in the buffer-local variable `master-of'.
84You can set this variable using `master-set-slave'. You can show 87You can set this variable using `master-set-slave'. You can show
85yourself the value of `master-of' by calling `master-show-slave'." 88yourself the value of `master-of' by calling `master-show-slave'."
86 ;; The initial value. 89 :group 'master
87 nil 90 :keymap
88 ;; The indicator for the mode line. 91 '(("\C-c\C-n" . master-says-scroll-up)
89 nil 92 ("\C-c\C-p" . master-says-scroll-down)
90 ;; The minor mode bindings. 93 ("\C-c<" . master-says-beginning-of-buffer)
91 '(("\C-c\C-n" . master-says-scroll-up) 94 ("\C-c>" . master-says-end-of-buffer)
92 ("\C-c\C-p" . master-says-scroll-down) 95 ("\C-c\C-l" . master-says-recenter)))
93 ("\C-c<" . master-says-beginning-of-buffer)
94 ("\C-c>" . master-says-end-of-buffer)
95 ("\C-c\C-l" . master-says-recenter)))
96 96
97;; Initialize Master mode by setting a slave buffer. 97;; Initialize Master mode by setting a slave buffer.
98 98
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index d988cae1260..273d4739b4d 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -136,7 +136,7 @@ A large number or nil slows down menu responsiveness."
136 '(menu-item "--")) 136 '(menu-item "--"))
137 137
138(define-key menu-bar-file-menu [recover-session] 138(define-key menu-bar-file-menu [recover-session]
139 '(menu-item "Recover Crashed Session..." recover-session 139 '(menu-item "Recover Crashed Session" recover-session
140 :enable (and auto-save-list-file-prefix 140 :enable (and auto-save-list-file-prefix
141 (file-directory-p 141 (file-directory-p
142 (file-name-directory auto-save-list-file-prefix)) 142 (file-name-directory auto-save-list-file-prefix))
@@ -298,7 +298,7 @@ A large number or nil slows down menu responsiveness."
298 '(menu-item "Continue Tags Search" tags-loop-continue 298 '(menu-item "Continue Tags Search" tags-loop-continue
299 :help "Continue last tags search operation")) 299 :help "Continue last tags search operation"))
300(define-key menu-bar-search-menu [tags-srch] 300(define-key menu-bar-search-menu [tags-srch]
301 '(menu-item "Search tagged files" tags-search 301 '(menu-item "Search tagged files..." tags-search
302 :help "Search for a regexp in all tagged files")) 302 :help "Search for a regexp in all tagged files"))
303(define-key menu-bar-search-menu [separator-tag-search] 303(define-key menu-bar-search-menu [separator-tag-search]
304 '(menu-item "--")) 304 '(menu-item "--"))
@@ -342,7 +342,7 @@ A large number or nil slows down menu responsiveness."
342 '(menu-item "Continue Replace" tags-loop-continue 342 '(menu-item "Continue Replace" tags-loop-continue
343 :help "Continue last tags replace operation")) 343 :help "Continue last tags replace operation"))
344(define-key menu-bar-replace-menu [tags-repl] 344(define-key menu-bar-replace-menu [tags-repl]
345 '(menu-item "Replace in tagged files" tags-query-replace 345 '(menu-item "Replace in tagged files..." tags-query-replace
346 :help "Interactively replace a regexp in all tagged files")) 346 :help "Interactively replace a regexp in all tagged files"))
347(define-key menu-bar-replace-menu [separator-replace-tags] 347(define-key menu-bar-replace-menu [separator-replace-tags]
348 '(menu-item "--")) 348 '(menu-item "--"))
@@ -377,14 +377,14 @@ A large number or nil slows down menu responsiveness."
377(defvar menu-bar-goto-menu (make-sparse-keymap "Go To")) 377(defvar menu-bar-goto-menu (make-sparse-keymap "Go To"))
378 378
379(define-key menu-bar-goto-menu [set-tags-name] 379(define-key menu-bar-goto-menu [set-tags-name]
380 '(menu-item "Set Tags File Name" visit-tags-table 380 '(menu-item "Set Tags File Name..." visit-tags-table
381 :help "Tell Tags commands which tag table file to use")) 381 :help "Tell Tags commands which tag table file to use"))
382 382
383(define-key menu-bar-goto-menu [separator-tag-file] 383(define-key menu-bar-goto-menu [separator-tag-file]
384 '(menu-item "--")) 384 '(menu-item "--"))
385 385
386(define-key menu-bar-goto-menu [apropos-tags] 386(define-key menu-bar-goto-menu [apropos-tags]
387 '(menu-item "Tags Apropos" tags-apropos 387 '(menu-item "Tags Apropos..." tags-apropos
388 :help "Find function/variables whose names match regexp")) 388 :help "Find function/variables whose names match regexp"))
389(define-key menu-bar-goto-menu [next-tag-otherw] 389(define-key menu-bar-goto-menu [next-tag-otherw]
390 '(menu-item "Next Tag in Other Window" 390 '(menu-item "Next Tag in Other Window"
@@ -673,7 +673,7 @@ by \"Save Options\" in Custom buffers.")
673 '("--")) 673 '("--"))
674 674
675(define-key menu-bar-options-menu [mouse-set-font] 675(define-key menu-bar-options-menu [mouse-set-font]
676 '(menu-item "Set Font/Fontset" mouse-set-font 676 '(menu-item "Set Font/Fontset..." mouse-set-font
677 :visible (display-multi-font-p) 677 :visible (display-multi-font-p)
678 :help "Select a font from list of known fonts/fontsets")) 678 :help "Select a font from list of known fonts/fontsets"))
679 679
@@ -1332,10 +1332,10 @@ key (or menu-item)"))
1332(define-key menu-bar-manuals-menu [sep3] 1332(define-key menu-bar-manuals-menu [sep3]
1333 '("--")) 1333 '("--"))
1334(define-key menu-bar-manuals-menu [command] 1334(define-key menu-bar-manuals-menu [command]
1335 '(menu-item "Find Command in Manual" Info-goto-emacs-command-node 1335 '(menu-item "Find Command in Manual..." Info-goto-emacs-command-node
1336 :help "Display manual section that describes a command")) 1336 :help "Display manual section that describes a command"))
1337(define-key menu-bar-manuals-menu [key] 1337(define-key menu-bar-manuals-menu [key]
1338 '(menu-item "Find Key in Manual" Info-goto-emacs-key-command-node 1338 '(menu-item "Find Key in Manual..." Info-goto-emacs-key-command-node
1339 :help "Display manual section that describes a key")) 1339 :help "Display manual section that describes a key"))
1340 1340
1341(define-key menu-bar-help-menu [eliza] 1341(define-key menu-bar-help-menu [eliza]
@@ -1369,7 +1369,7 @@ key (or menu-item)"))
1369(define-key menu-bar-help-menu [sep2] 1369(define-key menu-bar-help-menu [sep2]
1370 '("--")) 1370 '("--"))
1371(define-key menu-bar-help-menu [finder-by-keyword] 1371(define-key menu-bar-help-menu [finder-by-keyword]
1372 '(menu-item "Find Emacs Packages..." finder-by-keyword 1372 '(menu-item "Find Emacs Packages" finder-by-keyword
1373 :help "Find packages and features by keyword")) 1373 :help "Find packages and features by keyword"))
1374(define-key menu-bar-help-menu [manuals] 1374(define-key menu-bar-help-menu [manuals]
1375 (list 'menu-item "More Manuals" menu-bar-manuals-menu 1375 (list 'menu-item "More Manuals" menu-bar-manuals-menu
diff --git a/lisp/mouse.el b/lisp/mouse.el
index fdc99205780..a409efadeca 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -49,7 +49,7 @@
49 :version "22.1" 49 :version "22.1"
50 :group 'mouse) 50 :group 'mouse)
51 51
52(defcustom mouse-1-click-follows-link 350 52(defcustom mouse-1-click-follows-link 450
53 "Non-nil means that clicking Mouse-1 on a link follows the link. 53 "Non-nil means that clicking Mouse-1 on a link follows the link.
54 54
55With the default setting, an ordinary Mouse-1 click on a link 55With the default setting, an ordinary Mouse-1 click on a link
@@ -837,6 +837,29 @@ at the same position."
837 (funcall action pos)) 837 (funcall action pos))
838 (t action))))))) 838 (t action)))))))
839 839
840(defun mouse-fixup-help-message (msg)
841 "Fix help message MSG for `mouse-1-click-follows-link'."
842 (let (mp pos)
843 (if (and mouse-1-click-follows-link
844 (stringp msg)
845 (save-match-data
846 (string-match "^mouse-2" msg))
847 (setq mp (mouse-pixel-position))
848 (consp (setq pos (cdr mp)))
849 (car pos) (>= (car pos) 0)
850 (cdr pos) (>= (cdr pos) 0)
851 (setq pos (posn-at-x-y (car pos) (cdr pos) (car mp)))
852 (windowp (posn-window pos)))
853 (with-current-buffer (window-buffer (posn-window pos))
854 (if (mouse-on-link-p pos)
855 (setq msg (concat
856 (cond
857 ((eq mouse-1-click-follows-link 'double) "double-")
858 ((and (integerp mouse-1-click-follows-link)
859 (< mouse-1-click-follows-link 0)) "Long ")
860 (t ""))
861 "mouse-1" (substring msg 7)))))))
862 msg)
840 863
841(defun mouse-drag-region-1 (start-event) 864(defun mouse-drag-region-1 (start-event)
842 (mouse-minibuffer-check start-event) 865 (mouse-minibuffer-check start-event)
@@ -886,6 +909,7 @@ at the same position."
886 (track-mouse 909 (track-mouse
887 (while (progn 910 (while (progn
888 (setq event (read-event)) 911 (setq event (read-event))
912 (setq mve (cons event (and (boundp 'mve) mve)))
889 (or (mouse-movement-p event) 913 (or (mouse-movement-p event)
890 (memq (car-safe event) '(switch-frame select-window)))) 914 (memq (car-safe event) '(switch-frame select-window))))
891 (if (memq (car-safe event) '(switch-frame select-window)) 915 (if (memq (car-safe event) '(switch-frame select-window))
@@ -997,7 +1021,7 @@ at the same position."
997 (= (window-start start-window) 1021 (= (window-start start-window)
998 start-window-start))) 1022 start-window-start)))
999 (if (and on-link 1023 (if (and on-link
1000 (not end-point) 1024 (or (not end-point) (= end-point start-point))
1001 (consp event) 1025 (consp event)
1002 (or remap-double-click 1026 (or remap-double-click
1003 (and 1027 (and
diff --git a/lisp/msb.el b/lisp/msb.el
index 2ab7fe5491d..0bcdad314a6 100644
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -1,7 +1,7 @@
1;;; msb.el --- customizable buffer-selection with multiple menus 1;;; msb.el --- customizable buffer-selection with multiple menus
2 2
3;; Copyright (C) 1993, 94, 95, 97, 98, 99, 2000, 2001, 2003 3;; Copyright (C) 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2003,
4;; Free Software Foundation, Inc. 4;; 2005 Free Software Foundation, Inc.
5 5
6;; Author: Lars Lindberg <lars.lindberg@home.se> 6;; Author: Lars Lindberg <lars.lindberg@home.se>
7;; Maintainer: FSF 7;; Maintainer: FSF
@@ -1141,7 +1141,7 @@ variable `msb-menu-cond'."
1141With arg, turn Msb mode on if and only if arg is positive. 1141With arg, turn Msb mode on if and only if arg is positive.
1142This mode overrides the binding(s) of `mouse-buffer-menu' to provide a 1142This mode overrides the binding(s) of `mouse-buffer-menu' to provide a
1143different buffer menu using the function `msb'." 1143different buffer menu using the function `msb'."
1144 :global t 1144 :global t :group 'msb
1145 (if msb-mode 1145 (if msb-mode
1146 (progn 1146 (progn
1147 (add-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers) 1147 (add-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers)
diff --git a/lisp/international/iso-acc.el b/lisp/obsolete/iso-acc.el
index 6c94f4aa562..740fa942c13 100644
--- a/lisp/international/iso-acc.el
+++ b/lisp/obsolete/iso-acc.el
@@ -1,6 +1,7 @@
1;;; iso-acc.el --- minor mode providing electric accent keys 1;;; iso-acc.el --- minor mode providing electric accent keys
2 2
3;; Copyright (C) 1993, 1994, 1996, 2001 Free Software Foundation, Inc. 3;; Copyright (C) 1993, 1994, 1996, 2001, 2002, 2005
4;; Free Software Foundation, Inc.
4 5
5;; Author: Johan Vromans 6;; Author: Johan Vromans
6;; Maintainer: FSF 7;; Maintainer: FSF
@@ -487,5 +488,5 @@ Noninteractively, this operates on text from START to END."
487 488
488(add-hook 'minibuffer-setup-hook 'iso-acc-minibuf-setup) 489(add-hook 'minibuffer-setup-hook 'iso-acc-minibuf-setup)
489 490
490;;; arch-tag: 149ff409-7c3e-4574-9b5d-ac038939c0a6 491;; arch-tag: 149ff409-7c3e-4574-9b5d-ac038939c0a6
491;;; iso-acc.el ends here 492;;; iso-acc.el ends here
diff --git a/lisp/pcvs.el b/lisp/pcvs.el
index b00de07e50f..e7139d9cfba 100644
--- a/lisp/pcvs.el
+++ b/lisp/pcvs.el
@@ -358,7 +358,7 @@ from the current buffer."
358 (dir default-directory) 358 (dir default-directory)
359 (buf (cond 359 (buf (cond
360 (name (cvs-get-buffer-create name)) 360 (name (cvs-get-buffer-create name))
361 ((and (bufferp cvs-temp-buffer) (buffer-name cvs-temp-buffer)) 361 ((and (bufferp cvs-temp-buffer) (buffer-live-p cvs-temp-buffer))
362 cvs-temp-buffer) 362 cvs-temp-buffer)
363 (t 363 (t
364 (set (make-local-variable 'cvs-temp-buffer) 364 (set (make-local-variable 'cvs-temp-buffer)
@@ -528,39 +528,49 @@ If non-nil, NEW means to create a new buffer no matter what."
528 (files (nth 1 dir+files+rest)) 528 (files (nth 1 dir+files+rest))
529 (rest (nth 2 dir+files+rest))) 529 (rest (nth 2 dir+files+rest)))
530 530
531 ;; setup the (current) process buffer
532 (set (make-local-variable 'cvs-postprocess)
533 (if (null rest)
534 ;; this is the last invocation
535 postprocess
536 ;; else, we have to register ourselves to be rerun on the rest
537 `(cvs-run-process ',args ',rest ',postprocess ',single-dir)))
538 (add-hook 'kill-buffer-hook 531 (add-hook 'kill-buffer-hook
539 (lambda () 532 (lambda ()
540 (let ((proc (get-buffer-process (current-buffer)))) 533 (let ((proc (get-buffer-process (current-buffer))))
541 (when (processp proc) 534 (when (processp proc)
542 (set-process-filter proc nil) 535 (set-process-filter proc nil)
543 (set-process-sentinel proc nil) 536 ;; Abort postprocessing but leave the sentinel so it
544 (delete-process proc)))) 537 ;; will update the list of running procs.
538 (process-put proc 'cvs-postprocess nil)
539 (interrupt-process proc))))
545 nil t) 540 nil t)
546 541
547 ;; create the new process and setup the procbuffer correspondingly 542 ;; create the new process and setup the procbuffer correspondingly
548 (let* ((args (append (cvs-flags-query 'cvs-cvs-flags nil 'noquery) 543 (let* ((msg (cvs-header-msg args fis))
544 (args (append (cvs-flags-query 'cvs-cvs-flags nil 'noquery)
549 (if cvs-cvsroot (list "-d" cvs-cvsroot)) 545 (if cvs-cvsroot (list "-d" cvs-cvsroot))
550 args 546 args
551 files)) 547 files))
552 ;; If process-connection-type is nil and the repository 548 ;; If process-connection-type is nil and the repository
553 ;; is accessed via SSH, a bad interaction between libc, 549 ;; is accessed via SSH, a bad interaction between libc,
554 ;; CVS and SSH can lead to garbled output. 550 ;; CVS and SSH can lead to garbled output.
555 ;; It might be a glibc-specific problem (but it also happens 551 ;; It might be a glibc-specific problem (but it can also happens
556 ;; under Mac OS X, it seems). 552 ;; under Mac OS X, it seems).
557 ;; Until the problem is cleared, we'll use a pty rather than 553 ;; It seems that using a pty can help circumvent the problem,
558 ;; a pipe. 554 ;; but at the cost of screwing up when the process thinks it
559 ;; (process-connection-type nil) ; Use a pipe, not a pty. 555 ;; can ask for user input (such as password or host-key
556 ;; confirmation). A better workaround is to set CVS_RSH to
557 ;; an appropriate script, or to use a later version of CVS.
558 (process-connection-type nil) ; Use a pipe, not a pty.
560 (process 559 (process
561 ;; the process will be run in the selected dir 560 ;; the process will be run in the selected dir
562 (let ((default-directory (cvs-expand-dir-name dir))) 561 (let ((default-directory (cvs-expand-dir-name dir)))
563 (apply 'start-process "cvs" procbuf cvs-program args)))) 562 (apply 'start-process "cvs" procbuf cvs-program args))))
563 ;; setup the process.
564 (process-put process 'cvs-buffer cvs-buffer)
565 (with-current-buffer cvs-buffer (cvs-update-header msg 'add))
566 (process-put process 'cvs-header msg)
567 (process-put
568 process 'cvs-postprocess
569 (if (null rest)
570 ;; this is the last invocation
571 postprocess
572 ;; else, we have to register ourselves to be rerun on the rest
573 `(cvs-run-process ',args ',rest ',postprocess ',single-dir)))
564 (set-process-sentinel process 'cvs-sentinel) 574 (set-process-sentinel process 'cvs-sentinel)
565 (set-process-filter process 'cvs-update-filter) 575 (set-process-filter process 'cvs-update-filter)
566 (set-marker (process-mark process) (point-max)) 576 (set-marker (process-mark process) (point-max))
@@ -636,33 +646,35 @@ If non-nil, NEW means to create a new buffer no matter what."
636This is responsible for parsing the output from the cvs update when 646This is responsible for parsing the output from the cvs update when
637it is finished." 647it is finished."
638 (when (memq (process-status proc) '(signal exit)) 648 (when (memq (process-status proc) '(signal exit))
639 (if (null (buffer-name (process-buffer proc))) 649 (let ((cvs-postproc (process-get proc 'cvs-postprocess))
640 ;;(set-process-buffer proc nil) 650 (cvs-buf (process-get proc 'cvs-buffer)))
641 (error "cvs' process buffer was killed") 651 ;; Since the buffer and mode line will show that the
642 (let* ((obuf (current-buffer)) 652 ;; process is dead, we can delete it now. Otherwise it
643 (procbuffer (process-buffer proc))) 653 ;; will stay around until M-x list-processes.
644 (set-buffer (with-current-buffer procbuffer cvs-buffer)) 654 (process-put proc 'postprocess nil)
645 (setq cvs-mode-line-process (symbol-name (process-status proc))) 655 (delete-process proc)
646 (force-mode-line-update) 656 ;; Don't do anything if the main buffer doesn't exist any more.
647 (set-buffer procbuffer) 657 (when (buffer-live-p cvs-buf)
648 (let ((cvs-postproc cvs-postprocess)) 658 (with-current-buffer cvs-buf
649 ;; Since the buffer and mode line will show that the 659 (cvs-update-header (process-get proc 'cvs-header) nil)
650 ;; process is dead, we can delete it now. Otherwise it 660 (setq cvs-mode-line-process (symbol-name (process-status proc)))
651 ;; will stay around until M-x list-processes. 661 (force-mode-line-update)
652 (delete-process proc) 662 (when cvs-postproc
653 (setq cvs-postprocess nil) 663 (if (null (buffer-live-p (process-buffer proc)))
654 ;; do the postprocessing like parsing and such 664 ;;(set-process-buffer proc nil)
655 (save-excursion (eval cvs-postproc)) 665 (error "cvs' process buffer was killed")
656 ;; check whether something is left 666 (with-current-buffer (process-buffer proc)
657 (unless cvs-postprocess 667 ;; do the postprocessing like parsing and such
658 ;; IIRC, we enable undo again once the process is finished 668 (save-excursion (eval cvs-postproc))
659 ;; for cases where the output was inserted in *vc-diff* or 669 ;; check whether something is left
660 ;; in a file-like buffer. -stef 670 (unless (get-buffer-process (current-buffer))
661 (buffer-enable-undo) 671 ;; IIRC, we enable undo again once the process is finished
662 (with-current-buffer cvs-buffer 672 ;; for cases where the output was inserted in *vc-diff* or
663 (message "CVS process has completed in %s" (buffer-name))))) 673 ;; in a file-like buffer. --Stef
664 ;; This might not even be necessary 674 (buffer-enable-undo)
665 (set-buffer obuf))))) 675 (with-current-buffer cvs-buffer
676 (message "CVS process has completed in %s"
677 (buffer-name))))))))))))
666 678
667(defun cvs-parse-process (dcd &optional subdir old-fis) 679(defun cvs-parse-process (dcd &optional subdir old-fis)
668 "Parse the output of a cvs process. 680 "Parse the output of a cvs process.
@@ -770,7 +782,7 @@ before calling the real function `" (symbol-name fun-1) "'.\n")
770(defun-cvs-mode cvs-mode-kill-process () 782(defun-cvs-mode cvs-mode-kill-process ()
771 "Kill the temporary buffer and associated process." 783 "Kill the temporary buffer and associated process."
772 (interactive) 784 (interactive)
773 (when (and (bufferp cvs-temp-buffer) (buffer-name cvs-temp-buffer)) 785 (when (and (bufferp cvs-temp-buffer) (buffer-live-p cvs-temp-buffer))
774 (let ((proc (get-buffer-process cvs-temp-buffer))) 786 (let ((proc (get-buffer-process cvs-temp-buffer)))
775 (when proc (delete-process proc))))) 787 (when proc (delete-process proc)))))
776 788
@@ -906,23 +918,28 @@ This usually doesn't really work but is a handy initval in a prompt."
906;;;; 918;;;;
907 919
908;;;###autoload 920;;;###autoload
909(defun cvs-checkout (modules dir flags) 921(defun cvs-checkout (modules dir flags &optional root)
910 "Run a 'cvs checkout MODULES' in DIR. 922 "Run a 'cvs checkout MODULES' in DIR.
911Feed the output to a *cvs* buffer, display it in the current window, 923Feed the output to a *cvs* buffer, display it in the current window,
912and run `cvs-mode' on it. 924and run `cvs-mode' on it.
913 925
914With a prefix argument, prompt for cvs FLAGS to use." 926With a prefix argument, prompt for cvs FLAGS to use."
915 (interactive 927 (interactive
916 (list (cvs-string->strings (read-string "Module(s): " (cvs-get-module))) 928 (let ((root (cvs-get-cvsroot)))
917 (read-directory-name "CVS Checkout Directory: " 929 (if (or (null root) current-prefix-arg)
918 nil default-directory nil) 930 (setq root (read-string "CVS Root: ")))
919 (cvs-add-branch-prefix 931 (list (cvs-string->strings (read-string "Module(s): " (cvs-get-module)))
920 (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags")))) 932 (read-directory-name "CVS Checkout Directory: "
933 nil default-directory nil)
934 (cvs-add-branch-prefix
935 (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags"))
936 root)))
921 (when (eq flags t) 937 (when (eq flags t)
922 (setf flags (cvs-flags-query 'cvs-checkout-flags nil 'noquery))) 938 (setf flags (cvs-flags-query 'cvs-checkout-flags nil 'noquery)))
923 (cvs-cmd-do "checkout" (or dir default-directory) 939 (let ((cvs-cvsroot root))
924 (append flags modules) nil 'new 940 (cvs-cmd-do "checkout" (or dir default-directory)
925 :noexist t)) 941 (append flags modules) nil 'new
942 :noexist t)))
926 943
927(defun-cvs-mode (cvs-mode-checkout . NOARGS) (dir) 944(defun-cvs-mode (cvs-mode-checkout . NOARGS) (dir)
928 "Run cvs checkout against the current branch. 945 "Run cvs checkout against the current branch.
@@ -1133,7 +1150,7 @@ Full documentation is in the Texinfo file."
1133 (eq (ewoc-buffer cvs-cookies) buf) 1150 (eq (ewoc-buffer cvs-cookies) buf)
1134 (setq check 'cvs-temp-buffer) 1151 (setq check 'cvs-temp-buffer)
1135 (or (null cvs-temp-buffer) 1152 (or (null cvs-temp-buffer)
1136 (null (buffer-name cvs-temp-buffer)) 1153 (null (buffer-live-p cvs-temp-buffer))
1137 (and (eq (with-current-buffer cvs-temp-buffer cvs-buffer) buf) 1154 (and (eq (with-current-buffer cvs-temp-buffer cvs-buffer) buf)
1138 (equal (with-current-buffer cvs-temp-buffer 1155 (equal (with-current-buffer cvs-temp-buffer
1139 default-directory) 1156 default-directory)
@@ -1822,11 +1839,6 @@ POSTPROC is a list of expressions to be evaluated at the very end (after
1822 ;; absence of `cvs update' output has a specific meaning. 1839 ;; absence of `cvs update' output has a specific meaning.
1823 (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." "")))))) 1840 (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." ""))))))
1824 (push `(cvs-parse-process ',dont-change-disc nil ',old-fis) postproc))) 1841 (push `(cvs-parse-process ',dont-change-disc nil ',old-fis) postproc)))
1825 (let ((msg (cvs-header-msg args fis)))
1826 (cvs-update-header msg 'add)
1827 (push `(with-current-buffer cvs-buffer
1828 (cvs-update-header ',msg nil))
1829 postproc))
1830 (setq postproc (if (cdr postproc) (cons 'progn postproc) (car postproc))) 1842 (setq postproc (if (cdr postproc) (cons 'progn postproc) (car postproc)))
1831 (with-current-buffer buf 1843 (with-current-buffer buf
1832 (let ((inhibit-read-only t)) (erase-buffer)) 1844 (let ((inhibit-read-only t)) (erase-buffer))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 457177d7c4c..bafc901d3d1 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -1613,6 +1613,8 @@ and overlay is highlighted between MK and END-MK."
1613 (compilation-set-window-height w) 1613 (compilation-set-window-height w)
1614 1614
1615 (when highlight-regexp 1615 (when highlight-regexp
1616 (if (timerp next-error-highlight-timer)
1617 (cancel-timer next-error-highlight-timer))
1616 (unless compilation-highlight-overlay 1618 (unless compilation-highlight-overlay
1617 (setq compilation-highlight-overlay 1619 (setq compilation-highlight-overlay
1618 (make-overlay (point-min) (point-min))) 1620 (make-overlay (point-min) (point-min)))
@@ -1632,8 +1634,11 @@ and overlay is highlighted between MK and END-MK."
1632 (move-overlay compilation-highlight-overlay 1634 (move-overlay compilation-highlight-overlay
1633 (point) end (current-buffer))) 1635 (point) end (current-buffer)))
1634 (if (numberp next-error-highlight) 1636 (if (numberp next-error-highlight)
1635 (sit-for next-error-highlight)) 1637 (setq next-error-highlight-timer
1636 (if (not (eq next-error-highlight t)) 1638 (run-at-time next-error-highlight nil 'delete-overlay
1639 compilation-highlight-overlay)))
1640 (if (not (or (eq next-error-highlight t)
1641 (numberp next-error-highlight)))
1637 (delete-overlay compilation-highlight-overlay)))))) 1642 (delete-overlay compilation-highlight-overlay))))))
1638 (when (and (eq next-error-highlight 'fringe-arrow)) 1643 (when (and (eq next-error-highlight 'fringe-arrow))
1639 (set (make-local-variable 'overlay-arrow-position) 1644 (set (make-local-variable 'overlay-arrow-position)
diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el
index b16381cd2c7..9dfd4dd9e26 100644
--- a/lisp/progmodes/cwarn.el
+++ b/lisp/progmodes/cwarn.el
@@ -1,6 +1,6 @@
1;;; cwarn.el --- highlight suspicious C and C++ constructions 1;;; cwarn.el --- highlight suspicious C and C++ constructions
2 2
3;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. 3;; Copyright (C) 1999, 2000, 2001, 2005 Free Software Foundation, Inc.
4 4
5;; Author: Anders Lindgren <andersl@andersl.com> 5;; Author: Anders Lindgren <andersl@andersl.com>
6;; Keywords: c, languages, faces 6;; Keywords: c, languages, faces
@@ -193,7 +193,7 @@ be included in the variable `cwarn-configuration'. By default C and
193C++ modes are included. 193C++ modes are included.
194 194
195With ARG, turn CWarn mode on if and only if arg is positive." 195With ARG, turn CWarn mode on if and only if arg is positive."
196 nil cwarn-mode-text nil 196 :group 'cwarn :lighter cwarn-mode-text
197 (cwarn-font-lock-keywords cwarn-mode) 197 (cwarn-font-lock-keywords cwarn-mode)
198 (if font-lock-mode (font-lock-fontify-buffer))) 198 (if font-lock-mode (font-lock-fontify-buffer)))
199 199
diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el
index fdb7fffac6c..4c8b847b7cd 100644
--- a/lisp/progmodes/f90.el
+++ b/lisp/progmodes/f90.el
@@ -597,41 +597,32 @@ characters long.")
597 597
598;; Hideshow support. 598;; Hideshow support.
599(defconst f90-end-block-re 599(defconst f90-end-block-re
600 (concat "^[ \t0-9]*\\<end\\>[ \t]*" 600 (concat "^[ \t0-9]*\\<end[ \t]*"
601 (regexp-opt '("do" "if" "forall" "function" "interface" 601 (regexp-opt '("do" "if" "forall" "function" "interface"
602 "module" "program" "select" "subroutine" 602 "module" "program" "select" "subroutine"
603 "type" "where" ) t) 603 "type" "where" ) t)
604 "[ \t]*\\sw*") 604 "[ \t]*\\sw*")
605 "Regexp matching the end of a \"block\" of F90 code. 605 "Regexp matching the end of an F90 \"block\", from the line start.
606Used in the F90 entry in `hs-special-modes-alist'.") 606Used in the F90 entry in `hs-special-modes-alist'.")
607 607
608;; Ignore the fact that FUNCTION, SUBROUTINE, WHERE, FORALL have a 608;; Ignore the fact that FUNCTION, SUBROUTINE, WHERE, FORALL have a
609;; following "(". DO, CASE, IF can have labels; IF must be 609;; following "(". DO, CASE, IF can have labels.
610;; accompanied by THEN.
611;; A big problem is that many of these statements can be broken over
612;; lines, even with embedded comments. We only try to handle this for
613;; IF ... THEN statements, assuming and hoping it will be less common
614;; for other constructs. We match up to one new-line, provided ")
615;; THEN" appears on one line. Matching on just ") THEN" is no good,
616;; since that includes ELSE branches.
617;; For a fully accurate solution, hideshow would probably have to be
618;; modified to allow functions as well as regexps to be used to
619;; specify block start and end positions.
620(defconst f90-start-block-re 610(defconst f90-start-block-re
621 (concat 611 (concat
622 "^[ \t0-9]*" ; statement number 612 "^[ \t0-9]*" ; statement number
623 "\\(\\(" 613 "\\(\\("
624 "\\(\\sw+[ \t]*:[ \t]*\\)?" ; structure label 614 "\\(\\sw+[ \t]*:[ \t]*\\)?" ; structure label
625 "\\(do\\|select[ \t]*case\\|if[ \t]*(.*\n?.*)[ \t]*then\\|" 615 "\\(do\\|select[ \t]*case\\|"
616 ;; See comments in fortran-start-block-re for the problems of IF.
617 "if[ \t]*(\\(.*\\|"
618 ".*\n\\([^if]*\\([^i].\\|.[^f]\\|.\\>\\)\\)\\)\\<then\\|"
626 ;; Distinguish WHERE block from isolated WHERE. 619 ;; Distinguish WHERE block from isolated WHERE.
627 "\\(where\\|forall\\)[ \t]*(.*)[ \t]*\\(!\\|$\\)\\)\\)" 620 "\\(where\\|forall\\)[ \t]*(.*)[ \t]*\\(!\\|$\\)\\)\\)"
628 "\\|" 621 "\\|"
629 "program\\|interface\\|module\\|type\\|function\\|subroutine" 622 "program\\|interface\\|module\\|type\\|function\\|subroutine"
630 ;; ") THEN" at line end. Problem - also does ELSE.
631;;; "\\|.*)[ \t]*then[ \t]*\\($\\|!\\)"
632 "\\)" 623 "\\)"
633 "[ \t]*") 624 "[ \t]*")
634 "Regexp matching the start of a \"block\" of F90 code. 625 "Regexp matching the start of an F90 \"block\", from the line start.
635A simple regexp cannot do this in fully correct fashion, so this 626A simple regexp cannot do this in fully correct fashion, so this
636tries to strike a compromise between complexity and flexibility. 627tries to strike a compromise between complexity and flexibility.
637Used in the F90 entry in `hs-special-modes-alist'.") 628Used in the F90 entry in `hs-special-modes-alist'.")
@@ -1305,12 +1296,12 @@ Checks for consistency of block types and labels (if present).
1305Does not check the outermost block, because it may be incomplete. 1296Does not check the outermost block, because it may be incomplete.
1306Interactively, pushes mark before moving point." 1297Interactively, pushes mark before moving point."
1307 (interactive "p") 1298 (interactive "p")
1299 (if (interactive-p) (push-mark (point) t))
1308 (and num (< num 0) (f90-end-of-block (- num))) 1300 (and num (< num 0) (f90-end-of-block (- num)))
1309 (let ((case-fold-search t) 1301 (let ((case-fold-search t)
1310 (count (or num 1)) 1302 (count (or num 1))
1311 end-list end-this end-type end-label 1303 end-list end-this end-type end-label
1312 start-this start-type start-label) 1304 start-this start-type start-label)
1313 (if (interactive-p) (push-mark (point) t))
1314 (beginning-of-line) ; probably want this 1305 (beginning-of-line) ; probably want this
1315 (while (and (> count 0) (re-search-backward f90-blocks-re nil 'move)) 1306 (while (and (> count 0) (re-search-backward f90-blocks-re nil 'move))
1316 (beginning-of-line) 1307 (beginning-of-line)
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 70150111a86..7067ddca21c 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -964,7 +964,7 @@ Convert it to flymake internal format."
964 (if (consp file) (setq file (car file))) 964 (if (consp file) (setq file (car file)))
965 (if (consp line) (setq line (car line))) 965 (if (consp line) (setq line (car line)))
966 (if (consp col) (setq col (car col))) 966 (if (consp col) (setq col (car col)))
967 967
968 (when (not (functionp line)) 968 (when (not (functionp line))
969 (setq converted-list (cons (list regexp file line col) converted-list))))) 969 (setq converted-list (cons (list regexp file line col) converted-list)))))
970 converted-list)) 970 converted-list))
@@ -1508,7 +1508,7 @@ Return first 'INCLUDE-DIRS/REL-FILE-NAME' that exists, or just REL-FILE-NAME if
1508 "Minor mode to do on-the-fly syntax checking. 1508 "Minor mode to do on-the-fly syntax checking.
1509When called interactively, toggles the minor mode. 1509When called interactively, toggles the minor mode.
1510With arg, turn Flymake mode on if and only if arg is positive." 1510With arg, turn Flymake mode on if and only if arg is positive."
1511 :lighter flymake-mode-line 1511 :group 'flymake :lighter flymake-mode-line
1512 (if flymake-mode 1512 (if flymake-mode
1513 (if (flymake-can-syntax-check-file (buffer-file-name)) 1513 (if (flymake-can-syntax-check-file (buffer-file-name))
1514 (flymake-mode-on) 1514 (flymake-mode-on)
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index 768012c736c..30e1977d28d 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -1,7 +1,7 @@
1;;; fortran.el --- Fortran mode for GNU Emacs 1;;; fortran.el --- Fortran mode for GNU Emacs
2 2
3;; Copyright (c) 1986, 93, 94, 95, 97, 98, 99, 2000, 01, 03, 04 3;; Copyright (C) 1986, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001,
4;; Free Software Foundation, Inc. 4;; 2003, 2004, 2005 Free Software Foundation, Inc.
5 5
6;; Author: Michael D. Prange <prange@erl.mit.edu> 6;; Author: Michael D. Prange <prange@erl.mit.edu>
7;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk> 7;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk>
@@ -95,7 +95,7 @@ with a character in column 6."
95 :group 'fortran-indent) 95 :group 'fortran-indent)
96 96
97(defcustom fortran-if-indent 3 97(defcustom fortran-if-indent 3
98 "*Extra indentation applied to IF blocks." 98 "*Extra indentation applied to IF, SELECT CASE and WHERE blocks."
99 :type 'integer 99 :type 'integer
100 :group 'fortran-indent) 100 :group 'fortran-indent)
101 101
@@ -321,7 +321,8 @@ program\\|subroutine\\)\\>[ \t]*\\(\\sw+\\)?"
321 "while" "inquire" "stop" "return" 321 "while" "inquire" "stop" "return"
322 "include" "open" "close" "read" 322 "include" "open" "close" "read"
323 "write" "format" "print" "select" "case" 323 "write" "format" "print" "select" "case"
324 "cycle" "exit" "rewind" "backspace") 324 "cycle" "exit" "rewind" "backspace"
325 "where" "elsewhere")
325 'paren) "\\>") 326 'paren) "\\>")
326 ;; Builtin operators. 327 ;; Builtin operators.
327 (concat "\\." (regexp-opt 328 (concat "\\." (regexp-opt
@@ -370,6 +371,29 @@ program\\|subroutine\\)\\>[ \t]*\\(\\sw+\\)?"
370 fortran-font-lock-keywords-2))) 371 fortran-font-lock-keywords-2)))
371 "Gaudy level highlighting for Fortran mode.") 372 "Gaudy level highlighting for Fortran mode.")
372 373
374(defvar fortran-font-lock-keywords-4
375 (append fortran-font-lock-keywords-3
376 (list (list
377 (concat "\\<"
378 (regexp-opt
379 '("int" "ifix" "idint" "real" "float" "sngl"
380 "dble" "cmplx" "ichar" "char" "aint" "dint"
381 "anint" "dnint" "nint" "idnint" "iabs" "abs"
382 "dabs" "cabs" "mod" "amod" "dmod" "isign"
383 "sign" "dsign" "idim" "dim" "ddim" "dprod"
384 "max" "max0" "amax1" "dmax1" "amax0" "max1"
385 "min0" "amin1" "dmin1" "amin0" "min1" "len"
386 "index" "lge" "lgt" "lle" "llt" "aimag"
387 "conjg" "sqrt" "dsqrt" "csqrt" "exp" "dexp"
388 "cexp" "log" "alog" "dlog" "clog" "log10"
389 "alog10" "dlog10" "sin" "dsin" "csin" "cos"
390 "dcos" "ccos" "tan" "dtan" "asin" "dasin"
391 "acos" "dacos" "atan" "datan" "atan2" "datan2"
392 "sinh" "dsinh" "cosh" "dcosh" "tanh" "dtanh")
393 'paren) "[ \t]*(") '(1 font-lock-builtin-face))))
394 "Maximum highlighting for Fortran mode.
395Consists of level 3 plus all other intrinsics not already highlighted.")
396
373;; Comments are real pain in Fortran because there is no way to 397;; Comments are real pain in Fortran because there is no way to
374;; represent the standard comment syntax in an Emacs syntax table. 398;; represent the standard comment syntax in an Emacs syntax table.
375;; (We can do so for F90-style). Therefore an unmatched quote in a 399;; (We can do so for F90-style). Therefore an unmatched quote in a
@@ -409,6 +433,64 @@ These get fixed-format comments fontified.")
409 "Value for `imenu-generic-expression' in Fortran mode.") 433 "Value for `imenu-generic-expression' in Fortran mode.")
410 434
411 435
436;; Hideshow support.
437(defconst fortran-blocks-re
438 (concat "block[ \t]*data\\|select[ \t]*case\\|"
439 (regexp-opt '("do" "if" "interface" "function" "map" "program"
440 "structure" "subroutine" "union" "where")))
441 "Regexp potentially indicating the start or end of a Fortran \"block\".
442Omits naked END statements, and DO-loops closed by anything other
443than ENDDO.")
444
445(defconst fortran-end-block-re
446 ;; Do-loops terminated by things other than ENDDO cannot be handled
447 ;; with a regexp. This omission does not seem to matter to hideshow...
448 (concat "^[ \t0-9]*\\<end[ \t]*\\("
449 fortran-blocks-re
450 ;; Naked END statement.
451 "\\|!\\|$\\)")
452 "Regexp matching the end of a Fortran \"block\", from the line start.
453Note that only ENDDO is handled for the end of a DO-loop. Used
454in the Fortran entry in `hs-special-modes-alist'.")
455
456(defconst fortran-start-block-re
457 (concat
458 "^[ \t0-9]*\\(" ; statement number
459 ;; Structure label for DO, IF, SELECT, WHERE.
460 "\\(\\(\\sw+[ \t]*:[ \t]*\\)?"
461 ;; IF blocks are a nuisance:
462 ;; IF ( ... ) foo is not a block, but a single statement.
463 ;; IF ( ... ) THEN can be split over multiple lines.
464 ;; [So can, eg, a DO WHILE (... ), but that is less common, I hope.]
465 ;; The regexp below allows for it to be split over at most 2 lines.
466 ;; That leads to the problem of not matching two consecutive IF
467 ;; statements as one, eg:
468 ;; IF ( ... ) foo
469 ;; IF ( ... ) THEN
470 ;; It simply is not possible to do this in a 100% correct fashion
471 ;; using a regexp - see the functions fortran-end-if,
472 ;; fortran-beginning-if for the hoops we have to go through.
473 ;; An alternative is to match on THEN at a line end, eg:
474 ;; ".*)[ \t]*then[ \t]*\\($\\|!\\)"
475 ;; This would also match ELSE branches, though. This does not seem
476 ;; right to me, because then one has neighbouring blocks that are
477 ;; not nested in each other.
478 "\\(if[ \t]*(\\(.*\\|"
479 ".*\n\\([^if]*\\([^i].\\|.[^f]\\|.\\>\\)\\)\\)\\<then\\|"
480 "do\\|select[ \t]*case\\|where\\)\\)\\|"
481 (regexp-opt '("interface" "function" "map" "program"
482 "structure" "subroutine" "union"))
483 "\\|block[ \t]*data\\)[ \t]*")
484 "Regexp matching the start of a Fortran \"block\", from the line start.
485A simple regexp cannot do this in fully correct fashion, so this
486tries to strike a compromise between complexity and flexibility.
487Used in the Fortran entry in `hs-special-modes-alist'.")
488
489(add-to-list 'hs-special-modes-alist
490 `(fortran-mode ,fortran-start-block-re ,fortran-end-block-re
491 "^[cC*!]" fortran-end-of-block nil))
492
493
412(defvar fortran-mode-syntax-table 494(defvar fortran-mode-syntax-table
413 (let ((table (make-syntax-table))) 495 (let ((table (make-syntax-table)))
414 ;; We might like `;' to be punctuation (g77 multi-statement 496 ;; We might like `;' to be punctuation (g77 multi-statement
@@ -422,7 +504,8 @@ These get fixed-format comments fontified.")
422 (modify-syntax-entry ?/ "." table) 504 (modify-syntax-entry ?/ "." table)
423 (modify-syntax-entry ?\' "\"" table) 505 (modify-syntax-entry ?\' "\"" table)
424 (modify-syntax-entry ?\" "\"" table) 506 (modify-syntax-entry ?\" "\"" table)
425 ;; Consistent with GNU Fortran -- see the manual. 507 ;; Consistent with GNU Fortran's default -- see the manual.
508 ;; The F77 standard imposes no rule on this issue.
426 (modify-syntax-entry ?\\ "\\" table) 509 (modify-syntax-entry ?\\ "\\" table)
427 ;; This might be better as punctuation, as for C, but this way you 510 ;; This might be better as punctuation, as for C, but this way you
428 ;; can treat floating-point numbers as symbols. 511 ;; can treat floating-point numbers as symbols.
@@ -446,6 +529,8 @@ These get fixed-format comments fontified.")
446 (define-key map "\C-c;" 'fortran-comment-region) 529 (define-key map "\C-c;" 'fortran-comment-region)
447 (define-key map "\M-;" 'fortran-indent-comment) 530 (define-key map "\M-;" 'fortran-indent-comment)
448 (define-key map "\M-\n" 'fortran-split-line) 531 (define-key map "\M-\n" 'fortran-split-line)
532 (define-key map "\M-\C-n" 'fortran-end-of-block)
533 (define-key map "\M-\C-p" 'fortran-beginning-of-block)
449 (define-key map "\M-\C-q" 'fortran-indent-subprogram) 534 (define-key map "\M-\C-q" 'fortran-indent-subprogram)
450 (define-key map "\C-c\C-w" 'fortran-window-create-momentarily) 535 (define-key map "\C-c\C-w" 'fortran-window-create-momentarily)
451 (define-key map "\C-c\C-r" 'fortran-column-ruler) 536 (define-key map "\C-c\C-r" 'fortran-column-ruler)
@@ -606,7 +691,7 @@ Key definitions:
606 691
607Variables controlling indentation style and extra features: 692Variables controlling indentation style and extra features:
608 693
609`comment-start' 694`fortran-comment-line-start'
610 To use comments starting with `!', set this to the string \"!\". 695 To use comments starting with `!', set this to the string \"!\".
611`fortran-do-indent' 696`fortran-do-indent'
612 Extra indentation within DO blocks (default 3). 697 Extra indentation within DO blocks (default 3).
@@ -696,7 +781,8 @@ with no args, if that value is non-nil."
696 '((fortran-font-lock-keywords 781 '((fortran-font-lock-keywords
697 fortran-font-lock-keywords-1 782 fortran-font-lock-keywords-1
698 fortran-font-lock-keywords-2 783 fortran-font-lock-keywords-2
699 fortran-font-lock-keywords-3) 784 fortran-font-lock-keywords-3
785 fortran-font-lock-keywords-4)
700 nil t ((?/ . "$/") ("_$" . "w")) 786 nil t ((?/ . "$/") ("_$" . "w"))
701 fortran-beginning-of-subprogram)) 787 fortran-beginning-of-subprogram))
702 (set (make-local-variable 'font-lock-syntactic-keywords) 788 (set (make-local-variable 'font-lock-syntactic-keywords)
@@ -1059,6 +1145,84 @@ Directive lines are treated as comments."
1059 (if (not not-last-statement) 1145 (if (not not-last-statement)
1060 'last-statement))) 1146 'last-statement)))
1061 1147
1148(defun fortran-looking-at-if-then ()
1149 "Return non-nil if at the start of a line with an IF ... THEN statement."
1150 ;; cf f90-looking-at-if-then.
1151 (let ((p (point))
1152 (i (fortran-beginning-if)))
1153 (if i
1154 (save-excursion
1155 (goto-char i)
1156 (beginning-of-line)
1157 (= (point) p)))))
1158
1159;; Used in hs-special-modes-alist.
1160(defun fortran-end-of-block (&optional num)
1161 "Move point forward to the end of the current code block.
1162With optional argument NUM, go forward that many balanced blocks.
1163If NUM is negative, go backward to the start of a block. Does
1164not check for consistency of block types. Interactively, pushes
1165mark before moving point."
1166 (interactive "p")
1167 (if (interactive-p) (push-mark (point) t))
1168 (and num (< num 0) (fortran-beginning-of-block (- num)))
1169 (let ((case-fold-search t)
1170 (count (or num 1)))
1171 (end-of-line)
1172 (while (and (> count 0)
1173 (re-search-forward
1174 (concat "\\(" fortran-blocks-re
1175 (if fortran-check-all-num-for-matching-do
1176 "\\|^[ \t]*[0-9]+" "")
1177 "\\|continue\\|end\\)\\>")
1178 nil 'move))
1179 (beginning-of-line)
1180 (if (if (looking-at (concat "^[0-9 \t]*" fortran-if-start-re))
1181 (fortran-looking-at-if-then)
1182 (looking-at fortran-start-block-re))
1183 (setq count (1+ count))
1184 (if (or (looking-at fortran-end-block-re)
1185 (and (or (looking-at "^[0-9 \t]*continue")
1186 (and fortran-check-all-num-for-matching-do
1187 (looking-at "[ \t]*[0-9]+")))
1188 (fortran-check-for-matching-do)))
1189 (setq count (1- count))))
1190 (end-of-line))
1191 (if (> count 0) (error "Missing block end"))))
1192
1193(defun fortran-beginning-of-block (&optional num)
1194 "Move point backwards to the start of the current code block.
1195With optional argument NUM, go backward that many balanced
1196blocks. If NUM is negative, go forward to the end of a block.
1197Does not check for consistency of block types. Interactively,
1198pushes mark before moving point."
1199 (interactive "p")
1200 (if (interactive-p) (push-mark (point) t))
1201 (and num (< num 0) (fortran-end-of-block (- num)))
1202 (let ((case-fold-search t)
1203 (count (or num 1)))
1204 (beginning-of-line)
1205 (while (and (> count 0)
1206 (re-search-backward
1207 (concat "\\(" fortran-blocks-re
1208 (if fortran-check-all-num-for-matching-do
1209 "\\|^[ \t]*[0-9]+" "")
1210 "\\|continue\\|end\\)\\>")
1211 nil 'move))
1212 (beginning-of-line)
1213 (if (if (looking-at (concat "^[0-9 \t]*" fortran-if-start-re))
1214 (fortran-looking-at-if-then)
1215 (looking-at fortran-start-block-re))
1216 (setq count (1- count))
1217 (if (or (looking-at fortran-end-block-re)
1218 (and (or (looking-at "^[0-9 \t]*continue")
1219 (and fortran-check-all-num-for-matching-do
1220 (looking-at "[ \t]*[0-9]+")))
1221 (fortran-check-for-matching-do)))
1222 (setq count (1+ count)))))
1223 ;; Includes an un-named main program block.
1224 (if (> count 0) (error "Missing block start"))))
1225
1062 1226
1063(defun fortran-blink-match (regex keyword find-begin) 1227(defun fortran-blink-match (regex keyword find-begin)
1064 "From a line matching REGEX, blink matching KEYWORD statement line. 1228 "From a line matching REGEX, blink matching KEYWORD statement line.
@@ -1679,8 +1843,9 @@ If ALL is nil, only match comments that start in column > 0."
1679 (1+ (point))))) 1843 (1+ (point)))))
1680 (if (re-search-forward "\\S\"\\s\"\\S\"" eol t) 1844 (if (re-search-forward "\\S\"\\s\"\\S\"" eol t)
1681 (backward-char 2)) 1845 (backward-char 2))
1682 ;; If the current string is longer than 72 - 6 chars, 1846 ;; If the current string is longer than (fill-column
1683 ;; break it at the fill column (else infinite loop). 1847 ;; - 6) chars, break it at the fill column (else
1848 ;; infinite loop).
1684 (if (> (- (point) start) 1849 (if (> (- (point) start)
1685 (- fill-column 6 fortran-continuation-indent)) 1850 (- fill-column 6 fortran-continuation-indent))
1686 fcpoint 1851 fcpoint
diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el
index dea40b8db19..7aff14ec608 100644
--- a/lisp/progmodes/glasses.el
+++ b/lisp/progmodes/glasses.el
@@ -1,6 +1,6 @@
1;;; glasses.el --- make cantReadThis readable 1;;; glasses.el --- make cantReadThis readable
2 2
3;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. 3;; Copyright (C) 1999, 2000, 2001, 2005 Free Software Foundation, Inc.
4 4
5;; Author: Milan Zamazal <pdm@zamazal.org> 5;; Author: Milan Zamazal <pdm@zamazal.org>
6;; Maintainer: Milan Zamazal <pdm@zamazal.org> 6;; Maintainer: Milan Zamazal <pdm@zamazal.org>
@@ -251,7 +251,7 @@ recognized according to the current value of the variable `glasses-separator'."
251 "Minor mode for making identifiers likeThis readable. 251 "Minor mode for making identifiers likeThis readable.
252When this mode is active, it tries to add virtual separators (like underscores) 252When this mode is active, it tries to add virtual separators (like underscores)
253at places they belong to." 253at places they belong to."
254 nil " o^o" nil 254 :group 'glasses :lighter " o^o"
255 (save-excursion 255 (save-excursion
256 (save-restriction 256 (save-restriction
257 (widen) 257 (widen)
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 0988599ed54..1f9284db9cb 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -531,6 +531,9 @@ off the specialized speedbar mode."
531 531
532(defvar gdb-first-prompt t) 532(defvar gdb-first-prompt t)
533 533
534(defvar gud-filter-pending-text nil
535 "Non-nil means this is text that has been saved for later in `gud-filter'.")
536
534;;;###autoload 537;;;###autoload
535(defun gdb (command-line) 538(defun gdb (command-line)
536 "Run gdb on program FILE in buffer *gud-FILE*. 539 "Run gdb on program FILE in buffer *gud-FILE*.
@@ -562,6 +565,7 @@ and source-file directory for your debugger."
562 (setq comint-prompt-regexp "^(.*gdb[+]?) *") 565 (setq comint-prompt-regexp "^(.*gdb[+]?) *")
563 (setq paragraph-start comint-prompt-regexp) 566 (setq paragraph-start comint-prompt-regexp)
564 (setq gdb-first-prompt t) 567 (setq gdb-first-prompt t)
568 (setq gud-filter-pending-text nil)
565 (run-hooks 'gdb-mode-hook)) 569 (run-hooks 'gdb-mode-hook))
566 570
567;; One of the nice features of GDB is its impressive support for 571;; One of the nice features of GDB is its impressive support for
@@ -2445,9 +2449,6 @@ comint mode, which see."
2445 "Non-nil means don't process anything from the debugger right now. 2449 "Non-nil means don't process anything from the debugger right now.
2446It is saved for when this flag is not set.") 2450It is saved for when this flag is not set.")
2447 2451
2448(defvar gud-filter-pending-text nil
2449 "Non-nil means this is text that has been saved for later in `gud-filter'.")
2450
2451;; These functions are responsible for inserting output from your debugger 2452;; These functions are responsible for inserting output from your debugger
2452;; into the buffer. The hard work is done by the method that is 2453;; into the buffer. The hard work is done by the method that is
2453;; the value of gud-marker-filter. 2454;; the value of gud-marker-filter.
@@ -2516,19 +2517,22 @@ It is saved for when this flag is not set.")
2516 (gud-filter proc "")))))) 2517 (gud-filter proc ""))))))
2517 2518
2518(defvar gud-minor-mode-type nil) 2519(defvar gud-minor-mode-type nil)
2520(defvar gud-overlay-arrow-position nil)
2521(put 'gud-overlay-arrow-position 'overlay-arrow-string "=>")
2522(add-to-list 'overlay-arrow-variable-list 'gud-overlay-arrow-position)
2519 2523
2520(defun gud-sentinel (proc msg) 2524(defun gud-sentinel (proc msg)
2521 (cond ((null (buffer-name (process-buffer proc))) 2525 (cond ((null (buffer-name (process-buffer proc)))
2522 ;; buffer killed 2526 ;; buffer killed
2523 ;; Stop displaying an arrow in a source file. 2527 ;; Stop displaying an arrow in a source file.
2524 (setq overlay-arrow-position nil) 2528 (setq gud-overlay-arrow-position nil)
2525 (set-process-buffer proc nil) 2529 (set-process-buffer proc nil)
2526 (if (memq gud-minor-mode-type '(gdbmi gdba)) 2530 (if (memq gud-minor-mode-type '(gdbmi gdba))
2527 (gdb-reset) 2531 (gdb-reset)
2528 (gud-reset))) 2532 (gud-reset)))
2529 ((memq (process-status proc) '(signal exit)) 2533 ((memq (process-status proc) '(signal exit))
2530 ;; Stop displaying an arrow in a source file. 2534 ;; Stop displaying an arrow in a source file.
2531 (setq overlay-arrow-position nil) 2535 (setq gud-overlay-arrow-position nil)
2532 (with-current-buffer gud-comint-buffer 2536 (with-current-buffer gud-comint-buffer
2533 (if (memq gud-minor-mode-type '(gdbmi gdba)) 2537 (if (memq gud-minor-mode-type '(gdbmi gdba))
2534 (gdb-reset) 2538 (gdb-reset)
@@ -2611,13 +2615,13 @@ Obeying it means displaying in another window the specified file and line."
2611 (goto-line line) 2615 (goto-line line)
2612 (setq pos (point)) 2616 (setq pos (point))
2613 (setq overlay-arrow-string "=>") 2617 (setq overlay-arrow-string "=>")
2614 (or overlay-arrow-position 2618 (or gud-overlay-arrow-position
2615 (setq overlay-arrow-position (make-marker))) 2619 (setq gud-overlay-arrow-position (make-marker)))
2616 (set-marker overlay-arrow-position (point) (current-buffer))) 2620 (set-marker gud-overlay-arrow-position (point) (current-buffer)))
2617 (cond ((or (< pos (point-min)) (> pos (point-max))) 2621 (cond ((or (< pos (point-min)) (> pos (point-max)))
2618 (widen) 2622 (widen)
2619 (goto-char pos)))) 2623 (goto-char pos))))
2620 (if window (set-window-point window overlay-arrow-position)))))) 2624 (if window (set-window-point window gud-overlay-arrow-position))))))
2621 2625
2622;; The gud-call function must do the right thing whether its invoking 2626;; The gud-call function must do the right thing whether its invoking
2623;; keystroke is from the GUD buffer itself (via major-mode binding) 2627;; keystroke is from the GUD buffer itself (via major-mode binding)
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index da6b6f772b6..23031c5bcda 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -1,6 +1,6 @@
1;;; hideif.el --- hides selected code within ifdef 1;;; hideif.el --- hides selected code within ifdef
2 2
3;; Copyright (C) 1988,1994,2001, 2002 Free Software Foundation, Inc. 3;; Copyright (C) 1988, 1994, 2001, 2002, 2005 Free Software Foundation, Inc.
4 4
5;; Author: Daniel LaLiberte <liberte@holonexus.org> 5;; Author: Daniel LaLiberte <liberte@holonexus.org>
6;; Maintainer: FSF 6;; Maintainer: FSF
@@ -197,7 +197,7 @@ how the hiding is done:
197 After `show-ifdefs', read-only status is restored to previous value. 197 After `show-ifdefs', read-only status is restored to previous value.
198 198
199\\{hide-ifdef-mode-map}" 199\\{hide-ifdef-mode-map}"
200 nil " Ifdef" nil 200 :group 'hide-ifdef :lighter " Ifdef"
201 (if hide-ifdef-mode 201 (if hide-ifdef-mode
202 (progn 202 (progn
203 ;; inherit global values 203 ;; inherit global values
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 20af0aaf96e..5073f2bc23a 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -1098,28 +1098,40 @@ Don't save anything for STR matching `inferior-python-filter-regexp'."
1098(defvar python-preoutput-continuation nil 1098(defvar python-preoutput-continuation nil
1099 "If non-nil, funcall this when `python-preoutput-filter' sees `_emacs_ok'.") 1099 "If non-nil, funcall this when `python-preoutput-filter' sees `_emacs_ok'.")
1100 1100
1101(defvar python-preoutput-leftover nil)
1102
1101;; Using this stops us getting lines in the buffer like 1103;; Using this stops us getting lines in the buffer like
1102;; >>> ... ... >>> 1104;; >>> ... ... >>>
1103;; Also look for (and delete) an `_emacs_ok' string and call 1105;; Also look for (and delete) an `_emacs_ok' string and call
1104;; `python-preoutput-continuation' if we get it. 1106;; `python-preoutput-continuation' if we get it.
1105(defun python-preoutput-filter (s) 1107(defun python-preoutput-filter (s)
1106 "`comint-preoutput-filter-functions' function: ignore prompts not at bol." 1108 "`comint-preoutput-filter-functions' function: ignore prompts not at bol."
1109 (when python-preoutput-leftover
1110 (setq s (concat python-preoutput-leftover s))
1111 (setq python-preoutput-leftover nil))
1107 (cond ((and (string-match (rx (and string-start (repeat 3 (any ".>")) 1112 (cond ((and (string-match (rx (and string-start (repeat 3 (any ".>"))
1108 " " string-end)) 1113 " " string-end))
1109 s) 1114 s)
1110 (/= (let ((inhibit-field-text-motion t)) 1115 (/= (let ((inhibit-field-text-motion t))
1111 (line-beginning-position)) 1116 (line-beginning-position))
1112 (point))) 1117 (point)))
1113 "") 1118 "")
1114 ((string= s "_emacs_ok\n") 1119 ((string= s "_emacs_ok\n")
1115 (when python-preoutput-continuation 1120 (when python-preoutput-continuation
1116 (funcall python-preoutput-continuation) 1121 (funcall python-preoutput-continuation)
1117 (setq python-preoutput-continuation nil)) 1122 (setq python-preoutput-continuation nil))
1118 "") 1123 "")
1119 ((string-match "_emacs_out \\(.*\\)\n" s) 1124 ((string-match "_emacs_out \\(.*\\)\n" s)
1120 (setq python-preoutput-result (match-string 1 s)) 1125 (setq python-preoutput-result (match-string 1 s))
1126 "")
1127 ((string-match ".*\n" s)
1128 s)
1129 ((or (eq t (compare-strings s nil nil "_emacs_ok\n" nil (length s)))
1130 (let ((end (min (length "_emacs_out ") (length s))))
1131 (eq t (compare-strings s nil end "_emacs_out " nil end))))
1132 (setq python-preoutput-leftover s)
1121 "") 1133 "")
1122 (t s))) 1134 (t s)))
1123 1135
1124;;;###autoload 1136;;;###autoload
1125(defun run-python (&optional cmd noshow) 1137(defun run-python (&optional cmd noshow)
@@ -1359,7 +1371,9 @@ The result is what follows `_emacs_out' in the output (or nil)."
1359 (let ((proc (python-proc))) 1371 (let ((proc (python-proc)))
1360 (python-send-string string) 1372 (python-send-string string)
1361 (setq python-preoutput-result nil) 1373 (setq python-preoutput-result nil)
1362 (accept-process-output proc 5) 1374 (while (progn
1375 (accept-process-output proc 5)
1376 python-preoutput-leftover))
1363 python-preoutput-result)) 1377 python-preoutput-result))
1364 1378
1365;; Fixme: try to make it work with point in the arglist. Also, is 1379;; Fixme: try to make it work with point in the arglist. Also, is
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index d9ffea852d1..c792b59ad87 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -90,7 +90,7 @@
90 (modify-syntax-entry ?\] ")[ " st) 90 (modify-syntax-entry ?\] ")[ " st)
91 (modify-syntax-entry ?{ "(} " st) 91 (modify-syntax-entry ?{ "(} " st)
92 (modify-syntax-entry ?} "){ " st) 92 (modify-syntax-entry ?} "){ " st)
93 (modify-syntax-entry ?\| " 23" st) 93 (modify-syntax-entry ?\| "\" 23b" st)
94 94
95 ;; Other atom delimiters 95 ;; Other atom delimiters
96 (modify-syntax-entry ?\( "() " st) 96 (modify-syntax-entry ?\( "() " st)
@@ -103,7 +103,7 @@
103 ;; Special characters 103 ;; Special characters
104 (modify-syntax-entry ?, "' " st) 104 (modify-syntax-entry ?, "' " st)
105 (modify-syntax-entry ?@ "' " st) 105 (modify-syntax-entry ?@ "' " st)
106 (modify-syntax-entry ?# "' 14" st) 106 (modify-syntax-entry ?# "' 14bn" st)
107 (modify-syntax-entry ?\\ "\\ " st) 107 (modify-syntax-entry ?\\ "\\ " st)
108 st)) 108 st))
109 109
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index 4dba6b61a56..24ae19b0ad4 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -1,6 +1,7 @@
1;;; tcl.el --- Tcl code editing commands for Emacs 1;;; tcl.el --- Tcl code editing commands for Emacs
2 2
3;; Copyright (C) 1994,98,1999,2000,01,02,2003,2004 Free Software Foundation, Inc. 3;; Copyright (C) 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
4;; Free Software Foundation, Inc.
4 5
5;; Maintainer: FSF 6;; Maintainer: FSF
6;; Author: Tom Tromey <tromey@redhat.com> 7;; Author: Tom Tromey <tromey@redhat.com>
@@ -469,10 +470,7 @@ Uses variables `tcl-proc-regexp' and `tcl-keyword-list'."
469 ;; Keywords. Only recognized if surrounded by whitespace. 470 ;; Keywords. Only recognized if surrounded by whitespace.
470 ;; FIXME consider using "not word or symbol", not 471 ;; FIXME consider using "not word or symbol", not
471 ;; "whitespace". 472 ;; "whitespace".
472 (cons (concat "\\(\\s-\\|^\\)" 473 (cons (concat "\\_<" (regexp-opt tcl-keyword-list t) "\\_>")
473 ;; FIXME Use regexp-quote?
474 (regexp-opt tcl-keyword-list t)
475 "\\(\\s-\\|$\\)")
476 2)))) 474 2))))
477 475
478(if tcl-proc-regexp 476(if tcl-proc-regexp
@@ -1507,5 +1505,5 @@ The first line is assumed to look like \"#!.../program ...\"."
1507 1505
1508(provide 'tcl) 1506(provide 'tcl)
1509 1507
1510;;; arch-tag: 8a032554-c3ef-422e-b84c-acec0522179d 1508;; arch-tag: 8a032554-c3ef-422e-b84c-acec0522179d
1511;;; tcl.el ends here 1509;;; tcl.el ends here
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index dae5722d430..d329e234025 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -1,6 +1,7 @@
1;;; which-func.el --- print current function in mode line 1;;; which-func.el --- print current function in mode line
2 2
3;; Copyright (C) 1994, 1997, 1998, 2001, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 1994, 1997, 1998, 2001, 2003, 2005
4;; Free Software Foundation, Inc.
4 5
5;; Author: Alex Rezinsky <alexr@msil.sps.mot.com> 6;; Author: Alex Rezinsky <alexr@msil.sps.mot.com>
6;; (doesn't seem to be responsive any more) 7;; (doesn't seem to be responsive any more)
@@ -251,7 +252,7 @@ If no function name is found, return nil."
251 (when (and (null name) 252 (when (and (null name)
252 (boundp 'imenu--index-alist) (null imenu--index-alist) 253 (boundp 'imenu--index-alist) (null imenu--index-alist)
253 (null which-function-imenu-failed)) 254 (null which-function-imenu-failed))
254 (imenu--make-index-alist) 255 (imenu--make-index-alist t)
255 (unless imenu--index-alist 256 (unless imenu--index-alist
256 (make-local-variable 'which-function-imenu-failed) 257 (make-local-variable 'which-function-imenu-failed)
257 (setq which-function-imenu-failed t))) 258 (setq which-function-imenu-failed t)))
@@ -291,5 +292,5 @@ If no function name is found, return nil."
291 292
292(provide 'which-func) 293(provide 'which-func)
293 294
294;;; arch-tag: fa8a55c7-bfe3-4ffc-95ab-01bf21796827 295;; arch-tag: fa8a55c7-bfe3-4ffc-95ab-01bf21796827
295;;; which-func.el ends here 296;;; which-func.el ends here
diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el
index 6f14538ff4d..ba858959cc3 100644
--- a/lisp/ps-mule.el
+++ b/lisp/ps-mule.el
@@ -511,7 +511,10 @@ element of the list."
511 511
512(defsubst ps-mule-printable-p (charset) 512(defsubst ps-mule-printable-p (charset)
513 "Non-nil if characters in CHARSET is printable." 513 "Non-nil if characters in CHARSET is printable."
514 (ps-mule-get-font-spec charset 'normal)) 514 ;; ASCII and Latin-1 are always printable.
515 (or (eq charset 'ascii)
516 (eq charset 'latin-iso8859-1)
517 (ps-mule-get-font-spec charset 'normal)))
515 518
516(defconst ps-mule-external-libraries 519(defconst ps-mule-external-libraries
517 '((builtin nil nil 520 '((builtin nil nil
@@ -824,7 +827,9 @@ Returns the value:
824 827
825Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of 828Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
826the sequence." 829the sequence."
827 (setq ps-mule-current-charset (charset-after from)) 830 (let ((ch (char-after from)))
831 (setq ps-mule-current-charset
832 (char-charset (or (aref ps-print-translation-table ch) ch))))
828 (let* ((wrappoint (ps-mule-find-wrappoint 833 (let* ((wrappoint (ps-mule-find-wrappoint
829 from to (ps-avg-char-width 'ps-font-for-text))) 834 from to (ps-avg-char-width 'ps-font-for-text)))
830 (to (car wrappoint)) 835 (to (car wrappoint))
@@ -832,6 +837,10 @@ the sequence."
832 (ps-font-alist 'ps-font-for-text)))) 837 (ps-font-alist 'ps-font-for-text))))
833 (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type)) 838 (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type))
834 (string (buffer-substring-no-properties from to))) 839 (string (buffer-substring-no-properties from to)))
840 (dotimes (i (length string))
841 (let ((ch (aref ps-print-translation-table (aref string i))))
842 (if ch
843 (aset string i ch))))
835 (cond 844 (cond
836 ((= from to) 845 ((= from to)
837 ;; We can't print any more characters in the current line. 846 ;; We can't print any more characters in the current line.
@@ -1393,6 +1402,7 @@ FONTTAG should be a string \"/h0\" or \"/h1\"."
1393(defun ps-mule-show-warning (charsets from to header-footer-list) 1402(defun ps-mule-show-warning (charsets from to header-footer-list)
1394 (let ((table (make-category-table)) 1403 (let ((table (make-category-table))
1395 (buf (current-buffer)) 1404 (buf (current-buffer))
1405 (max-unprintable-chars 15)
1396 char-pos-list) 1406 char-pos-list)
1397 (define-category ?u "Unprintable charset" table) 1407 (define-category ?u "Unprintable charset" table)
1398 (dolist (cs charsets) 1408 (dolist (cs charsets)
@@ -1400,19 +1410,22 @@ FONTTAG should be a string \"/h0\" or \"/h1\"."
1400 (with-category-table table 1410 (with-category-table table
1401 (save-excursion 1411 (save-excursion
1402 (goto-char from) 1412 (goto-char from)
1403 (while (and (< (length char-pos-list) 20) 1413 (while (and (<= (length char-pos-list) max-unprintable-chars)
1404 (re-search-forward "\\cu" to t)) 1414 (re-search-forward "\\cu" to t))
1405 (push (cons (preceding-char) (1- (point))) char-pos-list)) 1415 (push (cons (preceding-char) (1- (point))) char-pos-list))))
1406 (setq char-pos-list (nreverse char-pos-list))))
1407 (with-output-to-temp-buffer "*Warning*" 1416 (with-output-to-temp-buffer "*Warning*"
1408 (with-current-buffer standard-output 1417 (with-current-buffer standard-output
1409 (when char-pos-list 1418 (when char-pos-list
1410 (let ((func #'(lambda (buf pos) 1419 (let ((func #'(lambda (buf pos)
1411 (when (buffer-live-p buf) 1420 (when (buffer-live-p buf)
1412 (pop-to-buffer buf) 1421 (pop-to-buffer buf)
1413 (goto-char pos))))) 1422 (goto-char pos))))
1423 (more nil))
1424 (if (>= (length char-pos-list) max-unprintable-chars)
1425 (setq char-pos-list (cdr char-pos-list)
1426 more t))
1414 (insert "These characters in the buffer can't be printed:\n") 1427 (insert "These characters in the buffer can't be printed:\n")
1415 (dolist (elt char-pos-list) 1428 (dolist (elt (nreverse char-pos-list))
1416 (insert " ") 1429 (insert " ")
1417 (insert-text-button (string (car elt)) 1430 (insert-text-button (string (car elt))
1418 :type 'help-xref 1431 :type 'help-xref
@@ -1421,8 +1434,10 @@ FONTTAG should be a string \"/h0\" or \"/h1\"."
1421 'help-function func 1434 'help-function func
1422 'help-args (list buf (cdr elt))) 1435 'help-args (list buf (cdr elt)))
1423 (insert ",")) 1436 (insert ","))
1424 ;; Delete the last comma. 1437 (if more
1425 (delete-char -1) 1438 (insert " and more...")
1439 ;; Delete the last comma.
1440 (delete-char -1))
1426 (insert "\nClick them to jump to the buffer position,\n" 1441 (insert "\nClick them to jump to the buffer position,\n"
1427 (substitute-command-keys "\ 1442 (substitute-command-keys "\
1428or \\[universal-argument] \\[what-cursor-position] will give information about them.\n")))) 1443or \\[universal-argument] \\[what-cursor-position] will give information about them.\n"))))
@@ -1469,13 +1484,15 @@ This checks if all multi-byte characters in the region are printable or not."
1469 (setq ps-mule-charset-list 1484 (setq ps-mule-charset-list
1470 (delq 'ascii (delq 'eight-bit-control 1485 (delq 'ascii (delq 'eight-bit-control
1471 (delq 'eight-bit-graphic 1486 (delq 'eight-bit-graphic
1472 (find-charset-region from to)))) 1487 (find-charset-region
1488 from to ps-print-translation-table))))
1473 ps-mule-header-charsets 1489 ps-mule-header-charsets
1474 (delq 'ascii (delq 'eight-bit-control 1490 (delq 'ascii (delq 'eight-bit-control
1475 (delq 'eight-bit-graphic 1491 (delq 'eight-bit-graphic
1476 (find-charset-string 1492 (find-charset-string
1477 (mapconcat 1493 (mapconcat
1478 'identity header-footer-list "")))))) 1494 'identity header-footer-list "")
1495 ps-print-translation-table)))))
1479 (dolist (cs ps-mule-charset-list) 1496 (dolist (cs ps-mule-charset-list)
1480 (or (ps-mule-printable-p cs) 1497 (or (ps-mule-printable-p cs)
1481 (push cs unprintable-charsets))) 1498 (push cs unprintable-charsets)))
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 726b0e4402c..b47ea3d4f89 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -6150,6 +6150,19 @@ XSTART YSTART are the relative position for the first page in a sheet.")
6150 6150
6151(defvar ps-current-effect 0) 6151(defvar ps-current-effect 0)
6152 6152
6153(defvar ps-print-translation-table
6154 (let ((tbl (make-char-table 'translation-table nil)))
6155 (if (and (boundp 'ucs-mule-8859-to-mule-unicode)
6156 (char-table-p ucs-mule-8859-to-mule-unicode))
6157 (map-char-table
6158 #'(lambda (k v)
6159 (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v))
6160 (aset tbl k v)))
6161 ucs-mule-8859-to-mule-unicode))
6162 tbl)
6163 "Translation table for PostScript printing.
6164The default value is a table that translates non-Latin-1 Latin characters
6165to the equivalent Latin-1 characters.")
6153 6166
6154(defun ps-plot-region (from to font &optional fg-color bg-color effects) 6167(defun ps-plot-region (from to font &optional fg-color bg-color effects)
6155 (or (equal font ps-current-font) 6168 (or (equal font ps-current-font)
@@ -6240,11 +6253,17 @@ XSTART YSTART are the relative position for the first page in a sheet.")
6240 (ps-plot 'ps-mule-plot-composition match-point (point) bg-color)) 6253 (ps-plot 'ps-mule-plot-composition match-point (point) bg-color))
6241 6254
6242 ((> match 255) ; a multi-byte character 6255 ((> match 255) ; a multi-byte character
6256 (setq match (or (aref ps-print-translation-table match) match))
6243 (let* ((charset (char-charset match)) 6257 (let* ((charset (char-charset match))
6244 (composition (ps-e-find-composition match-point to)) 6258 (composition (ps-e-find-composition match-point to))
6245 (stop (if (nth 2 composition) (car composition) to))) 6259 (stop (if (nth 2 composition) (car composition) to)))
6246 (or (eq charset 'composition) 6260 (or (eq charset 'composition)
6247 (while (and (< (point) stop) (eq (charset-after) charset)) 6261 (while (and (< (point) stop)
6262 (let ((ch (following-char)))
6263 (setq ch
6264 (or (aref ps-print-translation-table ch)
6265 ch))
6266 (eq (char-charset ch) charset)))
6248 (forward-char 1))) 6267 (forward-char 1)))
6249 (ps-plot 'ps-mule-plot-string match-point (point) bg-color))) 6268 (ps-plot 'ps-mule-plot-string match-point (point) bg-color)))
6250 ; characters from ^@ to ^_ and 6269 ; characters from ^@ to ^_ and
diff --git a/lisp/register.el b/lisp/register.el
index 253207c3140..eaa53446c56 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -277,7 +277,7 @@ Interactively, second arg is non-nil if prefix arg is supplied."
277Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. 277Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
278START and END are buffer positions indicating what to copy." 278START and END are buffer positions indicating what to copy."
279 (interactive "cCopy to register: \nr\nP") 279 (interactive "cCopy to register: \nr\nP")
280 (set-register register (buffer-substring start end)) 280 (set-register register (filter-buffer-substring start end))
281 (if delete-flag (delete-region start end))) 281 (if delete-flag (delete-region start end)))
282 282
283(defun append-to-register (register start end &optional delete-flag) 283(defun append-to-register (register start end &optional delete-flag)
@@ -289,7 +289,7 @@ START and END are buffer positions indicating what to append."
289 (or (stringp (get-register register)) 289 (or (stringp (get-register register))
290 (error "Register does not contain text")) 290 (error "Register does not contain text"))
291 (set-register register (concat (get-register register) 291 (set-register register (concat (get-register register)
292 (buffer-substring start end))) 292 (filter-buffer-substring start end)))
293 (if delete-flag (delete-region start end))) 293 (if delete-flag (delete-region start end)))
294 294
295(defun prepend-to-register (register start end &optional delete-flag) 295(defun prepend-to-register (register start end &optional delete-flag)
@@ -300,7 +300,7 @@ START and END are buffer positions indicating what to prepend."
300 (interactive "cPrepend to register: \nr\nP") 300 (interactive "cPrepend to register: \nr\nP")
301 (or (stringp (get-register register)) 301 (or (stringp (get-register register))
302 (error "Register does not contain text")) 302 (error "Register does not contain text"))
303 (set-register register (concat (buffer-substring start end) 303 (set-register register (concat (filter-buffer-substring start end)
304 (get-register register))) 304 (get-register register)))
305 (if delete-flag (delete-region start end))) 305 (if delete-flag (delete-region start end)))
306 306
diff --git a/lisp/reveal.el b/lisp/reveal.el
index eb6b4519f38..97411fc1669 100644
--- a/lisp/reveal.el
+++ b/lisp/reveal.el
@@ -163,8 +163,8 @@
163 (let ((map (make-sparse-keymap))) 163 (let ((map (make-sparse-keymap)))
164 ;; Override the default move-beginning-of-line and move-end-of-line 164 ;; Override the default move-beginning-of-line and move-end-of-line
165 ;; which skips valuable invisible text. 165 ;; which skips valuable invisible text.
166 (define-key map [?\C-a] 'beginning-of-line) 166 (define-key map [remap move-beginning-of-line] 'beginning-of-line)
167 (define-key map [?\C-e] 'end-of-line) 167 (define-key map [remap move-end-of-line] 'end-of-line)
168 map)) 168 map))
169 169
170;;;###autoload 170;;;###autoload
@@ -175,6 +175,7 @@ Reveal mode renders invisible text around point visible again.
175Interactively, with no prefix argument, toggle the mode. 175Interactively, with no prefix argument, toggle the mode.
176With universal prefix ARG (or if ARG is nil) turn mode on. 176With universal prefix ARG (or if ARG is nil) turn mode on.
177With zero or negative ARG turn mode off." 177With zero or negative ARG turn mode off."
178 :group 'reveal
178 :lighter (global-reveal-mode nil " Reveal") 179 :lighter (global-reveal-mode nil " Reveal")
179 :keymap reveal-mode-map 180 :keymap reveal-mode-map
180 (if reveal-mode 181 (if reveal-mode
diff --git a/lisp/simple.el b/lisp/simple.el
index 20563dc5433..22716a819f4 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -35,6 +35,13 @@
35 (autoload 'widget-convert "wid-edit") 35 (autoload 'widget-convert "wid-edit")
36 (autoload 'shell-mode "shell")) 36 (autoload 'shell-mode "shell"))
37 37
38(defcustom idle-update-delay 0.5
39 "*Idle time delay before updating various things on the screen.
40Various Emacs features that update auxiliary information when point moves
41wait this many seconds after Emacs becomes idle before doing an update."
42 :type 'number
43 :group 'display
44 :version "22.1")
38 45
39(defgroup killing nil 46(defgroup killing nil
40 "Killing and yanking commands." 47 "Killing and yanking commands."
@@ -105,6 +112,8 @@ If `fringe-arrow', indicate the locus by the fringe arrow."
105 :group 'next-error 112 :group 'next-error
106 :version "22.1") 113 :version "22.1")
107 114
115(defvar next-error-highlight-timer nil)
116
108(defvar next-error-last-buffer nil 117(defvar next-error-last-buffer nil
109 "The most recent next-error buffer. 118 "The most recent next-error buffer.
110A buffer becomes most recent when its compilation, grep, or 119A buffer becomes most recent when its compilation, grep, or
@@ -293,7 +302,7 @@ select the source buffer."
293When turned on, cursor motion in the compilation, grep, occur or diff 302When turned on, cursor motion in the compilation, grep, occur or diff
294buffer causes automatic display of the corresponding source code 303buffer causes automatic display of the corresponding source code
295location." 304location."
296 nil " Fol" nil 305 :group 'next-error :init-value " Fol"
297 (if (not next-error-follow-minor-mode) 306 (if (not next-error-follow-minor-mode)
298 (remove-hook 'post-command-hook 'next-error-follow-mode-post-command-hook t) 307 (remove-hook 'post-command-hook 'next-error-follow-mode-post-command-hook t)
299 (add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t) 308 (add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t)
@@ -2216,6 +2225,42 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]."
2216 (reset-this-command-lengths) 2225 (reset-this-command-lengths)
2217 (restore-overriding-map)) 2226 (restore-overriding-map))
2218 2227
2228(defvar buffer-substring-filters nil
2229 "List of filter functions for `filter-buffer-substring'.
2230Each function must accept a single argument, a string, and return
2231a string. The buffer substring is passed to the first function
2232in the list, and the return value of each function is passed to
2233the next. The return value of the last function is used as the
2234return value of `filter-buffer-substring'.
2235
2236If this variable is nil, no filtering is performed.")
2237
2238(defun filter-buffer-substring (beg end &optional delete)
2239 "Return the buffer substring between BEG and END, after filtering.
2240The buffer substring is passed through each of the filter
2241functions in `buffer-substring-filters', and the value from the
2242last filter function is returned. If `buffer-substring-filters'
2243is nil, the buffer substring is returned unaltered.
2244
2245If DELETE is non-nil, the text between BEG and END is deleted
2246from the buffer.
2247
2248Point is temporarily set to BEG before caling
2249`buffer-substring-filters', in case the functions need to know
2250where the text came from.
2251
2252This function should be used instead of `buffer-substring' or
2253`delete-and-extract-region' when you want to allow filtering to
2254take place. For example, major or minor modes can use
2255`buffer-substring-filters' to extract characters that are special
2256to a buffer, and should not be copied into other buffers."
2257 (save-excursion
2258 (goto-char beg)
2259 (let ((string (if delete (delete-and-extract-region beg end)
2260 (buffer-substring beg end))))
2261 (dolist (filter buffer-substring-filters string)
2262 (setq string (funcall filter string))))))
2263
2219;;;; Window system cut and paste hooks. 2264;;;; Window system cut and paste hooks.
2220 2265
2221(defvar interprogram-cut-function nil 2266(defvar interprogram-cut-function nil
@@ -2396,7 +2441,7 @@ specifies the yank-handler text property to be set on the killed
2396text. See `insert-for-yank'." 2441text. See `insert-for-yank'."
2397 (interactive "r") 2442 (interactive "r")
2398 (condition-case nil 2443 (condition-case nil
2399 (let ((string (delete-and-extract-region beg end))) 2444 (let ((string (filter-buffer-substring beg end t)))
2400 (when string ;STRING is nil if BEG = END 2445 (when string ;STRING is nil if BEG = END
2401 ;; Add that string to the kill ring, one way or another. 2446 ;; Add that string to the kill ring, one way or another.
2402 (if (eq last-command 'kill-region) 2447 (if (eq last-command 'kill-region)
@@ -2432,8 +2477,8 @@ If `interprogram-cut-function' is non-nil, also save the text for a window
2432system cut and paste." 2477system cut and paste."
2433 (interactive "r") 2478 (interactive "r")
2434 (if (eq last-command 'kill-region) 2479 (if (eq last-command 'kill-region)
2435 (kill-append (buffer-substring beg end) (< end beg)) 2480 (kill-append (filter-buffer-substring beg end) (< end beg))
2436 (kill-new (buffer-substring beg end))) 2481 (kill-new (filter-buffer-substring beg end)))
2437 (if transient-mark-mode 2482 (if transient-mark-mode
2438 (setq deactivate-mark t)) 2483 (setq deactivate-mark t))
2439 nil) 2484 nil)
@@ -2958,7 +3003,7 @@ the user to see that the mark has moved, and you want the previous
2958mark position to be lost. 3003mark position to be lost.
2959 3004
2960Normally, when a new mark is set, the old one should go on the stack. 3005Normally, when a new mark is set, the old one should go on the stack.
2961This is why most applications should use push-mark, not set-mark. 3006This is why most applications should use `push-mark', not `set-mark'.
2962 3007
2963Novice Emacs Lisp programmers often try to use the mark for the wrong 3008Novice Emacs Lisp programmers often try to use the mark for the wrong
2964purposes. The mark saves a location for the user's convenience. 3009purposes. The mark saves a location for the user's convenience.
@@ -5186,14 +5231,6 @@ See also `normal-erase-is-backspace'."
5186 (message "Delete key deletes %s" 5231 (message "Delete key deletes %s"
5187 (if normal-erase-is-backspace "forward" "backward")))) 5232 (if normal-erase-is-backspace "forward" "backward"))))
5188 5233
5189(defcustom idle-update-delay 0.5
5190 "*Idle time delay before updating various things on the screen.
5191Various Emacs features that update auxiliary information when point moves
5192wait this many seconds after Emacs becomes idle before doing an update."
5193 :type 'number
5194 :group 'display
5195 :version "22.1")
5196
5197(defvar vis-mode-saved-buffer-invisibility-spec nil 5234(defvar vis-mode-saved-buffer-invisibility-spec nil
5198 "Saved value of `buffer-invisibility-spec' when Visible mode is on.") 5235 "Saved value of `buffer-invisibility-spec' when Visible mode is on.")
5199 5236
@@ -5205,6 +5242,7 @@ Enabling Visible mode makes all invisible text temporarily visible.
5205Disabling Visible mode turns off that effect. Visible mode 5242Disabling Visible mode turns off that effect. Visible mode
5206works by saving the value of `buffer-invisibility-spec' and setting it to nil." 5243works by saving the value of `buffer-invisibility-spec' and setting it to nil."
5207 :lighter " Vis" 5244 :lighter " Vis"
5245 :group 'editing-basics
5208 (when (local-variable-p 'vis-mode-saved-buffer-invisibility-spec) 5246 (when (local-variable-p 'vis-mode-saved-buffer-invisibility-spec)
5209 (setq buffer-invisibility-spec vis-mode-saved-buffer-invisibility-spec) 5247 (setq buffer-invisibility-spec vis-mode-saved-buffer-invisibility-spec)
5210 (kill-local-variable 'vis-mode-saved-buffer-invisibility-spec)) 5248 (kill-local-variable 'vis-mode-saved-buffer-invisibility-spec))
diff --git a/lisp/smerge-mode.el b/lisp/smerge-mode.el
index 35903dcf749..d6a93a935d6 100644
--- a/lisp/smerge-mode.el
+++ b/lisp/smerge-mode.el
@@ -1,6 +1,6 @@
1;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts 1;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts
2 2
3;; Copyright (C) 1999, 2000, 01, 03, 2004 Free Software Foundation, Inc. 3;; Copyright (C) 1999, 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
4 4
5;; Author: Stefan Monnier <monnier@cs.yale.edu> 5;; Author: Stefan Monnier <monnier@cs.yale.edu>
6;; Keywords: revision-control merge diff3 cvs conflict 6;; Keywords: revision-control merge diff3 cvs conflict
@@ -667,7 +667,7 @@ buffer names."
667(define-minor-mode smerge-mode 667(define-minor-mode smerge-mode
668 "Minor mode to simplify editing output from the diff3 program. 668 "Minor mode to simplify editing output from the diff3 program.
669\\{smerge-mode-map}" 669\\{smerge-mode-map}"
670 nil " SMerge" nil 670 :group 'smerge :lighter " SMerge"
671 (when (and (boundp 'font-lock-mode) font-lock-mode) 671 (when (and (boundp 'font-lock-mode) font-lock-mode)
672 (set (make-local-variable 'font-lock-multiline) t) 672 (set (make-local-variable 'font-lock-multiline) t)
673 (save-excursion 673 (save-excursion
diff --git a/lisp/startup.el b/lisp/startup.el
index aa7a16d1356..e3c2617c420 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1008,8 +1008,27 @@ If this is nil, no message will be displayed."
1008using the mouse.\n\n" 1008using the mouse.\n\n"
1009 :face (variable-pitch :weight bold) 1009 :face (variable-pitch :weight bold)
1010 "Important Help menu items:\n" 1010 "Important Help menu items:\n"
1011 :face variable-pitch "\ 1011 :face variable-pitch
1012Emacs Tutorial\tLearn-by-doing tutorial for using Emacs efficiently 1012 (lambda ()
1013 (let* ((en "TUTORIAL")
1014 (tut (or (get-language-info current-language-environment
1015 'tutorial)
1016 en))
1017 (title (with-temp-buffer
1018 (insert-file-contents
1019 (expand-file-name tut data-directory)
1020 nil 0 256)
1021 (search-forward ".")
1022 (buffer-substring (point-min) (1- (point))))))
1023 ;; If there is a specific tutorial for the current language
1024 ;; environment and it is not English, append its title.
1025 (concat
1026 "Emacs Tutorial\tLearn how to use Emacs efficiently"
1027 (if (string= en tut)
1028 ""
1029 (concat " (" title ")"))
1030 "\n")))
1031 :face variable-pitch "\
1013Emacs FAQ\tFrequently asked questions and answers 1032Emacs FAQ\tFrequently asked questions and answers
1014Read the Emacs Manual\tView the Emacs manual using Info 1033Read the Emacs Manual\tView the Emacs manual using Info
1015\(Non)Warranty\tGNU Emacs comes with " 1034\(Non)Warranty\tGNU Emacs comes with "
@@ -1073,14 +1092,18 @@ Values less than 60 seconds are ignored."
1073 1092
1074(defun fancy-splash-insert (&rest args) 1093(defun fancy-splash-insert (&rest args)
1075 "Insert text into the current buffer, with faces. 1094 "Insert text into the current buffer, with faces.
1076Arguments from ARGS should be either strings or pairs `:face FACE', 1095Arguments from ARGS should be either strings, functions called
1096with no args that return a string, or pairs `:face FACE',
1077where FACE is a valid face specification, as it can be used with 1097where FACE is a valid face specification, as it can be used with
1078`put-text-properties'." 1098`put-text-properties'."
1079 (let ((current-face nil)) 1099 (let ((current-face nil))
1080 (while args 1100 (while args
1081 (if (eq (car args) :face) 1101 (if (eq (car args) :face)
1082 (setq args (cdr args) current-face (car args)) 1102 (setq args (cdr args) current-face (car args))
1083 (insert (propertize (car args) 1103 (insert (propertize (let ((it (car args)))
1104 (if (functionp it)
1105 (funcall it)
1106 it))
1084 'face current-face 1107 'face current-face
1085 'help-echo fancy-splash-help-echo))) 1108 'help-echo fancy-splash-help-echo)))
1086 (setq args (cdr args))))) 1109 (setq args (cdr args)))))
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index fc677b3de44..3e5b77d8baa 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -1,6 +1,6 @@
1;;; bibtex.el --- BibTeX mode for GNU Emacs 1;;; bibtex.el --- BibTeX mode for GNU Emacs
2 2
3;; Copyright (C) 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2003, 2004 3;; Copyright (C) 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2003, 2004, 2005
4;; Free Software Foundation, Inc. 4;; Free Software Foundation, Inc.
5 5
6;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de> 6;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de>
@@ -784,41 +784,56 @@ Used by `bibtex-complete-crossref-cleanup' and `bibtex-copy-summary-as-kill'."
784 (function :tag "Personalized function"))) 784 (function :tag "Personalized function")))
785 785
786(defcustom bibtex-generate-url-list 786(defcustom bibtex-generate-url-list
787 '((("url" . ".*:.*")) 787 '((("url" . ".*:.*")))
788 ;; Example of a complex setup.
789 (("journal" . "\\<\\(PR[ABCDEL]?\\|RMP\\)\\>")
790 "http://link.aps.org/abstract/"
791 ("journal" ".*" downcase)
792 "/v"
793 ("volume" ".*" 0)
794 "/p"
795 ("pages" "\\`\\([0-9]+\\)" 1)))
796 "List of schemes for generating the URL of a BibTeX entry. 788 "List of schemes for generating the URL of a BibTeX entry.
797These schemes are used by `bibtex-url'. 789These schemes are used by `bibtex-url'.
798 790
799Each scheme is of the form ((FIELD . REGEXP) STEP...). 791Each scheme should have one of these forms:
800 792
801FIELD is a field name as returned by `bibtex-parse-entry'. 793 ((FIELD . REGEXP))
802REGEXP is matched against the text of FIELD. If the match succeeds, then 794 ((FIELD . REGEXP) STEP...)
803this scheme is used. If no STEPs are specified the matched text is used 795 ((FIELD . REGEXP) STRING STEP...)
804as the URL, otherwise the URL is built by concatenating the STEPs.
805
806A STEP can be a string or a list (FIELD REGEXP REPLACE) in which case
807the text of FIELD is matched against REGEXP, and is replaced with REPLACE.
808REPLACE can be a string, or a number (which selects the corresponding submatch)
809or a function called with the field's text as argument and with the
810`match-data' properly set.
811 796
812Case is always ignored. Always remove the field delimiters." 797FIELD is a field name as returned by `bibtex-parse-entry'.
798REGEXP is matched against the text of FIELD. If the match succeeds,
799then this scheme is used. If no STRING and STEPs are specified
800the matched text is used as the URL, otherwise the URL is built
801by evaluating STEPs. If no STRING is specified the STEPs must result
802in strings which are concatenated. Otherwise the resulting objects
803are passed through `format' using STRING as format control string.
804
805A STEP is a list (FIELD REGEXP REPLACE). The text of FIELD
806is matched against REGEXP, and is replaced with REPLACE.
807REPLACE can be a string, or a number (which selects the corresponding
808submatch), or a function called with the field's text as argument
809and with the `match-data' properly set.
810
811Case is always ignored. Always remove the field delimiters.
812
813The following is a complex example, see http://link.aps.org/linkfaq.html.
814
815 (((\"journal\" . \"\\\\=<\\(PR[ABCDEL]?\\|RMP\\)\\\\=>\")
816 \"http://link.aps.org/abstract/%s/v%s/p%s\"
817 (\"journal\" \".*\" downcase)
818 (\"volume\" \".*\" 0)
819 (\"pages\" \"\\`[A-Z]?[0-9]+\" 0)))"
813 :group 'bibtex 820 :group 'bibtex
814 :type '(repeat 821 :type '(repeat
815 (list :tag "Scheme" 822 (cons :tag "Scheme"
816 (cons :tag "Matcher" :extra-offset 4 823 (cons :tag "Matcher" :extra-offset 4
817 (string :tag "BibTeX field") 824 (string :tag "BibTeX field")
818 (regexp :tag "Regexp")) 825 (regexp :tag "Regexp"))
819 (repeat :tag "Steps to generate URL" :inline t 826 (choice
820 (choice 827 (const :tag "Take match as is" nil)
821 (string :tag "Literal text") 828 (cons :tag "Formatted"
829 (string :tag "Format control string")
830 (repeat :tag "Steps to generate URL"
831 (list (string :tag "BibTeX field")
832 (regexp :tag "Regexp")
833 (choice (string :tag "Replacement")
834 (integer :tag "Sub-match")
835 (function :tag "Filter")))))
836 (repeat :tag "Concatenated"
822 (list (string :tag "BibTeX field") 837 (list (string :tag "BibTeX field")
823 (regexp :tag "Regexp") 838 (regexp :tag "Regexp")
824 (choice (string :tag "Replacement") 839 (choice (string :tag "Replacement")
@@ -2662,11 +2677,10 @@ begins at the beginning of a line. We use this function for font-locking."
2662 (let ((lst bibtex-generate-url-list) url) 2677 (let ((lst bibtex-generate-url-list) url)
2663 (goto-char start) 2678 (goto-char start)
2664 (while (and (not found) 2679 (while (and (not found)
2665 (setq url (caar lst))) 2680 (setq url (car (pop lst))))
2666 (setq found (and (bibtex-string= field (car url)) 2681 (setq found (and (bibtex-string= field (car url))
2667 (re-search-forward (cdr url) end t) 2682 (re-search-forward (cdr url) end t)
2668 (>= (match-beginning 0) pnt)) 2683 (>= (match-beginning 0) pnt)))))
2669 lst (cdr lst))))
2670 (goto-char end)) 2684 (goto-char end))
2671 (if found (bibtex-button (match-beginning 0) (match-end 0) 2685 (if found (bibtex-button (match-beginning 0) (match-end 0)
2672 'bibtex-url (match-beginning 0))) 2686 'bibtex-url (match-beginning 0)))
@@ -4283,39 +4297,36 @@ The URL is generated using the schemes defined in `bibtex-generate-url-list'
4283 ;; Always ignore case, 4297 ;; Always ignore case,
4284 (case-fold-search t) 4298 (case-fold-search t)
4285 (lst bibtex-generate-url-list) 4299 (lst bibtex-generate-url-list)
4286 field url scheme) 4300 field url scheme obj fmt)
4287 (while (setq scheme (pop lst)) 4301 (while (setq scheme (pop lst))
4288 (when (and (setq field (cdr (assoc-string (caar scheme) 4302 (when (and (setq field (cdr (assoc-string (caar scheme)
4289 fields-alist t))) 4303 fields-alist t)))
4290 ;; Always remove field delimiters 4304 ;; Always remove field delimiters
4291 (progn (setq field (bibtex-remove-delimiters-string field)) 4305 (progn (setq field (bibtex-remove-delimiters-string field))
4292 (string-match (cdar scheme) field))) 4306 (string-match (cdar scheme) field)))
4293 (setq lst nil) 4307 (setq lst nil
4294 (if (null (cdr scheme)) 4308 scheme (cdr scheme)
4295 (setq url (match-string 0 field))) 4309 url (if (null scheme) (match-string 0 field)
4296 (dolist (step (cdr scheme)) 4310 (if (stringp (car scheme))
4297 (cond ((stringp step) 4311 (setq fmt (pop scheme)))
4298 (setq url (concat url step))) 4312 (dolist (step scheme)
4299 ((setq field (cdr (assoc-string (car step) fields-alist t))) 4313 ;; Always remove field delimiters
4300 ;; Always remove field delimiters 4314 (setq field (bibtex-remove-delimiters-string
4301 (setq field (bibtex-remove-delimiters-string field)) 4315 (cdr (assoc-string (car step) fields-alist t))))
4302 (if (string-match (nth 1 step) field) 4316 (if (string-match (nth 1 step) field)
4303 (setq field (cond 4317 (setq field (cond ((functionp (nth 2 step))
4304 ((functionp (nth 2 step)) 4318 (funcall (nth 2 step) field))
4305 (funcall (nth 2 step) field)) 4319 ((numberp (nth 2 step))
4306 ((numberp (nth 2 step)) 4320 (match-string (nth 2 step) field))
4307 (match-string (nth 2 step) field)) 4321 (t
4308 (t 4322 (replace-match (nth 2 step) t nil field))))
4309 (replace-match (nth 2 step) t nil field)))) 4323 ;; If the scheme is set up correctly,
4310 ;; If the scheme is set up correctly, 4324 ;; we should never reach this point
4311 ;; we should never reach this point 4325 (error "Match failed: %s" field))
4312 (error "Match failed: %s" field)) 4326 (push field obj))
4313 (setq url (concat url field))) 4327 (if fmt (apply 'format fmt (nreverse obj))
4314 ;; If the scheme is set up correctly, 4328 (apply 'concat (nreverse obj)))))
4315 ;; we should never reach this point 4329 (browse-url (message "%s" url))))
4316 (t (error "Step failed: %s" step))))
4317 (message "%s" url)
4318 (browse-url url)))
4319 (unless url (message "No URL known."))))) 4330 (unless url (message "No URL known.")))))
4320 4331
4321 4332
diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el
index 71bb6cf137d..b1b5abc488f 100644
--- a/lisp/textmodes/enriched.el
+++ b/lisp/textmodes/enriched.el
@@ -1,6 +1,6 @@
1;;; enriched.el --- read and save files in text/enriched format 1;;; enriched.el --- read and save files in text/enriched format
2 2
3;; Copyright (c) 1994, 1995, 1996, 2002, 2004 Free Software Foundation, Inc. 3;; Copyright (c) 1994, 1995, 1996, 2002, 2004, 2005 Free Software Foundation, Inc.
4 4
5;; Author: Boris Goldowsky <boris@gnu.org> 5;; Author: Boris Goldowsky <boris@gnu.org>
6;; Keywords: wp, faces 6;; Keywords: wp, faces
@@ -183,7 +183,7 @@ etc/enriched.doc in the Emacs distribution directory.
183Commands: 183Commands:
184 184
185\\{enriched-mode-map}" 185\\{enriched-mode-map}"
186 nil " Enriched" nil 186 :group 'enriched :lighter " Enriched"
187 (cond ((null enriched-mode) 187 (cond ((null enriched-mode)
188 ;; Turn mode off 188 ;; Turn mode off
189 (setq buffer-file-format (delq 'text/enriched buffer-file-format)) 189 (setq buffer-file-format (delq 'text/enriched buffer-file-format))
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index ccd7f21f502..c41145befc8 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -539,6 +539,17 @@ The break position will be always after LINEBEG and generally before point."
539 ;; Make sure we take SOMETHING after the fill prefix if any. 539 ;; Make sure we take SOMETHING after the fill prefix if any.
540 (fill-find-break-point linebeg))))) 540 (fill-find-break-point linebeg)))))
541 541
542;; Like text-properties-at but don't include `composition' property.
543(defun fill-text-properties-at (pos)
544 (let ((l (text-properties-at pos))
545 prop-list)
546 (while l
547 (unless (eq (car l) 'composition)
548 (setq prop-list
549 (cons (car l) (cons (cadr l) prop-list))))
550 (setq l (cddr l)))
551 prop-list))
552
542(defun fill-newline () 553(defun fill-newline ()
543 ;; Replace whitespace here with one newline, then 554 ;; Replace whitespace here with one newline, then
544 ;; indent to left margin. 555 ;; indent to left margin.
@@ -546,7 +557,7 @@ The break position will be always after LINEBEG and generally before point."
546 (insert ?\n) 557 (insert ?\n)
547 ;; Give newline the properties of the space(s) it replaces 558 ;; Give newline the properties of the space(s) it replaces
548 (set-text-properties (1- (point)) (point) 559 (set-text-properties (1- (point)) (point)
549 (text-properties-at (point))) 560 (fill-text-properties-at (point)))
550 (and (looking-at "\\( [ \t]*\\)\\(\\c|\\)?") 561 (and (looking-at "\\( [ \t]*\\)\\(\\c|\\)?")
551 (or (aref (char-category-set (or (char-before (1- (point))) ?\000)) ?|) 562 (or (aref (char-category-set (or (char-before (1- (point))) ?\000)) ?|)
552 (match-end 2)) 563 (match-end 2))
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el
index ab45434526a..86406d37475 100644
--- a/lisp/textmodes/org.el
+++ b/lisp/textmodes/org.el
@@ -1,14 +1,14 @@
1;; org.el --- Outline-based notes management and organizer 1;; org.el --- Outline-based notes management and organizer
2;; Carstens outline-mode for keeping track of everything. 2;; Carstens outline-mode for keeping track of everything.
3;; Copyright (c) 2003, 2004, 2005 Free Software Foundation 3;; Copyright (c) 2004, 2005 Free Software Foundation
4 4;;
5;; Author: Carsten Dominik <dominik at science dot uva dot nl> 5;; Author: Carsten Dominik <dominik at science dot uva dot nl>
6;; Keywords: outlines, hypermedia, calendar 6;; Keywords: outlines, hypermedia, calendar
7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ 7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
8;; Version: 3.04 8;; Version: 3.05
9 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11 11;;
12;; GNU Emacs 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)
@@ -75,10 +75,18 @@
75;; ------------- 75;; -------------
76;; The documentation of Org-mode can be found in the TeXInfo file. 76;; The documentation of Org-mode can be found in the TeXInfo file.
77;; This distribution also contains a PDF version of it. At the homepage 77;; This distribution also contains a PDF version of it. At the homepage
78;; of Org-mode, you can find and read online the same text as HTML. 78;; of Org-mode, you can read online the same text online as HTML.
79;; 79;;
80;; Changes: 80;; Changes:
81;; ------- 81;; -------
82;; Version 3.05
83;; - Agenda entries from the diary are linked to the diary file, so
84;; adding and editing diary entries can be done directly from the agenda.
85;; - Many calendar/diary commands available directly from agenda.
86;; - Field copying in tables with S-RET does increment.
87;; - C-c C-x C-v extracts the visible part of the buffer for printing.
88;; - Moving subtrees up and down preserves the whitespace at the tree end.
89;;
82;; Version 3.04 90;; Version 3.04
83;; - Table editor optimized to need fewer realignments, and to keep 91;; - Table editor optimized to need fewer realignments, and to keep
84;; table shape when typing in fields. 92;; table shape when typing in fields.
@@ -213,7 +221,7 @@
213 221
214;;; Customization variables 222;;; Customization variables
215 223
216(defvar org-version "3.04" 224(defvar org-version "3.05"
217 "The version number of the file org.el.") 225 "The version number of the file org.el.")
218(defun org-version () 226(defun org-version ()
219 (interactive) 227 (interactive)
@@ -241,7 +249,13 @@
241 :group 'org) 249 :group 'org)
242 250
243(defcustom org-startup-folded t 251(defcustom org-startup-folded t
244 "Non-nil means, entering Org-mode will switch to OVERVIEW." 252 "Non-nil means, entering Org-mode will switch to OVERVIEW.
253This can also be configured on a per-file basis by adding one of
254the following lines anywhere in the buffer:
255
256 #+STARTUP: fold
257 #+STARTUP: nofold
258"
245 :group 'org-startup 259 :group 'org-startup
246 :type 'boolean) 260 :type 'boolean)
247 261
@@ -255,7 +269,13 @@ uninteresting. Also tables look terrible when wrapped."
255(defcustom org-startup-with-deadline-check nil 269(defcustom org-startup-with-deadline-check nil
256 "Non-nil means, entering Org-mode will run the deadline check. 270 "Non-nil means, entering Org-mode will run the deadline check.
257This means, if you start editing an org file, you will get an 271This means, if you start editing an org file, you will get an
258immediate reminder of any due deadlines." 272immediate reminder of any due deadlines.
273This can also be configured on a per-file basis by adding one of
274the following lines anywhere in the buffer:
275
276 #+STARTUP: dlcheck
277 #+STARTUP: nodlcheck
278"
259 :group 'org-startup 279 :group 'org-startup
260 :type 'boolean) 280 :type 'boolean)
261 281
@@ -534,6 +554,11 @@ When nil, cursor will remain in the current window."
534 :group 'org-agenda 554 :group 'org-agenda
535 :type 'boolean) 555 :type 'boolean)
536 556
557(defcustom org-fit-agenda-window t
558 "Non-nil means, change windo size of agenda to fit content."
559 :group 'org-agenda
560 :type 'boolean)
561
537(defcustom org-agenda-show-all-dates t 562(defcustom org-agenda-show-all-dates t
538 "Non-nil means, `org-agenda' shows every day in the selected range. 563 "Non-nil means, `org-agenda' shows every day in the selected range.
539When nil, only the days which actually have entries are shown." 564When nil, only the days which actually have entries are shown."
@@ -892,7 +917,7 @@ slight (in fact: unnoticable) speed impact for normal typing. Org-mode is
892very good at guessing when a re-align will be necessary, but you can always 917very good at guessing when a re-align will be necessary, but you can always
893force one with `C-c C-c'. 918force one with `C-c C-c'.
894 919
895I you would like to use the optimized version in Org-mode, but the un-optimized 920If you would like to use the optimized version in Org-mode, but the un-optimized
896version in OrgTbl-mode, see the variable `orgtbl-optimized'. 921version in OrgTbl-mode, see the variable `orgtbl-optimized'.
897 922
898This variable can be used to turn on and off the table editor during a session, 923This variable can be used to turn on and off the table editor during a session,
@@ -971,6 +996,11 @@ line will be formatted with <th> tags."
971 :group 'org-table 996 :group 'org-table
972 :type 'boolean) 997 :type 'boolean)
973 998
999(defcustom org-table-copy-increment t
1000 "Non-nil means, increment when copying current field with \\[org-table-copy-down]."
1001 :group 'org-table
1002 :type 'boolean)
1003
974(defcustom org-table-tab-recognizes-table.el t 1004(defcustom org-table-tab-recognizes-table.el t
975 "Non-nil means, TAB will automatically notice a table.el table. 1005 "Non-nil means, TAB will automatically notice a table.el table.
976When it sees such a table, it moves point into it and - if necessary - 1006When it sees such a table, it moves point into it and - if necessary -
@@ -1260,7 +1290,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1260 "Face used for level 7 headlines." 1290 "Face used for level 7 headlines."
1261 :group 'org-faces) 1291 :group 'org-faces)
1262 1292
1263(defface org-level-8-face ;;font-lock-string-face 1293(defface org-level-8-face ;; font-lock-string-face
1264 '((((type tty) (class color)) (:foreground "green")) 1294 '((((type tty) (class color)) (:foreground "green"))
1265 (((class color) (background light)) (:foreground "RosyBrown")) 1295 (((class color) (background light)) (:foreground "RosyBrown"))
1266 (((class color) (background dark)) (:foreground "LightSalmon")) 1296 (((class color) (background dark)) (:foreground "LightSalmon"))
@@ -1276,8 +1306,24 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1276 "Face for deadlines and TODO keyords." 1306 "Face for deadlines and TODO keyords."
1277 :group 'org-faces) 1307 :group 'org-faces)
1278 1308
1279;; Inheritance does not work for xemacs, unfortunately. 1309(defcustom org-fontify-done-headline nil
1280;; We just copy the definitions and waste some space.... 1310 "Non-nil means, change the face of a headline if it is marked DONE.
1311Normally, only the TODO/DONE keyword indicates the state of a headline.
1312When this is non-nil, the headline after the keyword is set to the
1313`org-headline-done-face' as an additional indication."
1314 :group 'org-faces
1315 :type 'boolean)
1316
1317(defface org-headline-done-face ;; font-lock-string-face
1318 '((((type tty) (class color)) (:foreground "green"))
1319 (((class color) (background light)) (:foreground "RosyBrown"))
1320 (((class color) (background dark)) (:foreground "LightSalmon"))
1321 (t (:italic t)))
1322 "Face used to indicate that a headline is DONE. See also the variable
1323`org-fontify-done-headline'."
1324 :group 'org-faces)
1325
1326;; Inheritance does not yet work for xemacs. So we just copy...
1281 1327
1282(defface org-deadline-announce-face 1328(defface org-deadline-announce-face
1283 '((((type tty) (class color)) (:foreground "blue" :weight bold)) 1329 '((((type tty) (class color)) (:foreground "blue" :weight bold))
@@ -1341,11 +1387,11 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1341 )) 1387 ))
1342(defvar org-n-levels (length org-level-faces)) 1388(defvar org-n-levels (length org-level-faces))
1343 1389
1344
1345;; Tell the compiler about dynamically scoped variables, 1390;; Tell the compiler about dynamically scoped variables,
1346;; and variables from other packages 1391;; and variables from other packages
1347(eval-when-compile 1392(eval-when-compile
1348 (defvar zmacs-regions) 1393 (defvar zmacs-regions)
1394 (defvar original-date)
1349 (defvar org-transient-mark-mode) 1395 (defvar org-transient-mark-mode)
1350 (defvar org-old-auto-fill-inhibit-regexp) 1396 (defvar org-old-auto-fill-inhibit-regexp)
1351 (defvar orgtbl-mode-menu) 1397 (defvar orgtbl-mode-menu)
@@ -1521,8 +1567,11 @@ The following commands are available:
1521 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>") 1567 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>")
1522 '(1 'org-warning-face t)) 1568 '(1 'org-warning-face t))
1523 '("^#.*" (0 'font-lock-comment-face t)) 1569 '("^#.*" (0 'font-lock-comment-face t))
1524 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") 1570 (if org-fontify-done-headline
1525 '(1 'org-done-face t)) 1571 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>")
1572 '(1 'org-done-face t) '(2 'org-headline-done-face t))
1573 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>")
1574 '(1 'org-done-face t)))
1526 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" 1575 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
1527 (1 'org-table-face t)) 1576 (1 'org-table-face t))
1528 '("^[ \t]*\\(:.*\\)" (1 'org-table-face t))))) 1577 '("^[ \t]*\\(:.*\\)" (1 'org-table-face t)))))
@@ -1563,7 +1612,7 @@ The following commands are available:
1563(defvar org-cycle-global-status nil) 1612(defvar org-cycle-global-status nil)
1564(defvar org-cycle-subtree-status nil) 1613(defvar org-cycle-subtree-status nil)
1565(defun org-cycle (&optional arg) 1614(defun org-cycle (&optional arg)
1566 "Visibility cycling for org-mode. 1615 "Visibility cycling for Org-mode.
1567 1616
1568- When this function is called with a prefix argument, rotate the entire 1617- When this function is called with a prefix argument, rotate the entire
1569 buffer through 3 states (global cycling) 1618 buffer through 3 states (global cycling)
@@ -1579,6 +1628,9 @@ The following commands are available:
1579 zoom in further. 1628 zoom in further.
1580 3. SUBTREE: Show the entire subtree, including body text. 1629 3. SUBTREE: Show the entire subtree, including body text.
1581 1630
1631- When there is a numeric prefix, go ARG levels up and do a `show-subtree',
1632 keeping cursor position.
1633
1582- When point is not at the beginning of a headline, execute 1634- When point is not at the beginning of a headline, execute
1583 `indent-relative', like TAB normally does. See the option 1635 `indent-relative', like TAB normally does. See the option
1584 `org-cycle-emulate-tab' for details. 1636 `org-cycle-emulate-tab' for details.
@@ -1587,8 +1639,9 @@ The following commands are available:
1587 no headline in line 1, this function will act as if called with prefix arg." 1639 no headline in line 1, this function will act as if called with prefix arg."
1588 (interactive "P") 1640 (interactive "P")
1589 1641
1590 (if (and (bobp) (not (looking-at outline-regexp))) 1642 (if (or (and (bobp) (not (looking-at outline-regexp)))
1591 ; special case: use global cycling 1643 (equal arg '(4)))
1644 ;; special case: use global cycling
1592 (setq arg t)) 1645 (setq arg t))
1593 1646
1594 (cond 1647 (cond
@@ -1600,7 +1653,7 @@ The following commands are available:
1600 (org-table-justify-field-maybe) 1653 (org-table-justify-field-maybe)
1601 (org-table-next-field)))) 1654 (org-table-next-field))))
1602 1655
1603 (arg ;; Global cycling 1656 ((eq arg t) ;; Global cycling
1604 1657
1605 (cond 1658 (cond
1606 ((and (eq last-command this-command) 1659 ((and (eq last-command this-command)
@@ -1621,18 +1674,27 @@ The following commands are available:
1621 (if (bobp) (throw 'exit nil)))) 1674 (if (bobp) (throw 'exit nil))))
1622 (message "CONTENTS...done")) 1675 (message "CONTENTS...done"))
1623 (setq org-cycle-global-status 'contents)) 1676 (setq org-cycle-global-status 'contents))
1677
1624 ((and (eq last-command this-command) 1678 ((and (eq last-command this-command)
1625 (eq org-cycle-global-status 'contents)) 1679 (eq org-cycle-global-status 'contents))
1626 ;; We just showed the table of contents - now show everything 1680 ;; We just showed the table of contents - now show everything
1627 (show-all) 1681 (show-all)
1628 (message "SHOW ALL") 1682 (message "SHOW ALL")
1629 (setq org-cycle-global-status 'all)) 1683 (setq org-cycle-global-status 'all))
1684
1630 (t 1685 (t
1631 ;; Default action: go to overview 1686 ;; Default action: go to overview
1632 (hide-sublevels 1) 1687 (hide-sublevels 1)
1633 (message "OVERVIEW") 1688 (message "OVERVIEW")
1634 (setq org-cycle-global-status 'overview)))) 1689 (setq org-cycle-global-status 'overview))))
1635 1690
1691 ((integerp arg)
1692 ;; Show-subtree, ARG levels up from here.
1693 (save-excursion
1694 (org-back-to-heading)
1695 (outline-up-heading arg)
1696 (show-subtree)))
1697
1636 ((save-excursion (beginning-of-line 1) (looking-at outline-regexp)) 1698 ((save-excursion (beginning-of-line 1) (looking-at outline-regexp))
1637 ;; At a heading: rotate between three different views 1699 ;; At a heading: rotate between three different views
1638 (org-back-to-heading) 1700 (org-back-to-heading)
@@ -1970,7 +2032,7 @@ is changed at all."
1970 (save-excursion (outline-end-of-heading) 2032 (save-excursion (outline-end-of-heading)
1971 (setq folded (org-invisible-p))) 2033 (setq folded (org-invisible-p)))
1972 (outline-end-of-subtree)) 2034 (outline-end-of-subtree))
1973 (if (equal (char-after) ?\n) (forward-char 1)) 2035 (outline-next-heading)
1974 (setq end (point)) 2036 (setq end (point))
1975 ;; Find insertion point, with error handling 2037 ;; Find insertion point, with error handling
1976 (goto-char beg) 2038 (goto-char beg)
@@ -1982,7 +2044,10 @@ is changed at all."
1982 (if (> arg 0) 2044 (if (> arg 0)
1983 ;; Moving forward - still need to move over subtree 2045 ;; Moving forward - still need to move over subtree
1984 (progn (outline-end-of-subtree) 2046 (progn (outline-end-of-subtree)
1985 (if (equal (char-after) ?\n) (forward-char 1)))) 2047 (outline-next-heading)
2048 (if (not (or (looking-at (concat "^" outline-regexp))
2049 (bolp)))
2050 (newline))))
1986 (move-marker ins-point (point)) 2051 (move-marker ins-point (point))
1987 (setq txt (buffer-substring beg end)) 2052 (setq txt (buffer-substring beg end))
1988 (delete-region beg end) 2053 (delete-region beg end)
@@ -1993,7 +2058,7 @@ is changed at all."
1993 2058
1994(defvar org-subtree-clip "" 2059(defvar org-subtree-clip ""
1995 "Clipboard for cut and paste of subtrees. 2060 "Clipboard for cut and paste of subtrees.
1996This is actually only a cpoy of the kill, because we use the normal kill 2061This is actually only a copy of the kill, because we use the normal kill
1997ring. We need it to check if the kill was created by `org-copy-subtree'.") 2062ring. We need it to check if the kill was created by `org-copy-subtree'.")
1998 2063
1999(defvar org-subtree-clip-folded nil 2064(defvar org-subtree-clip-folded nil
@@ -2906,6 +2971,14 @@ The following commands are available:
2906(define-key org-agenda-mode-map "p" 'org-agenda-priority) 2971(define-key org-agenda-mode-map "p" 'org-agenda-priority)
2907(define-key org-agenda-mode-map "," 'org-agenda-priority) 2972(define-key org-agenda-mode-map "," 'org-agenda-priority)
2908(define-key org-agenda-mode-map "i" 'org-agenda-diary-entry) 2973(define-key org-agenda-mode-map "i" 'org-agenda-diary-entry)
2974(define-key org-agenda-mode-map "c" 'org-agenda-goto-calendar)
2975(define-key org-agenda-mode-map "C" 'org-agenda-convert-date)
2976(define-key org-agenda-mode-map "m" 'org-agenda-phases-of-moon)
2977(define-key org-agenda-mode-map "M" 'org-agenda-phases-of-moon)
2978(define-key org-agenda-mode-map "s" 'org-agenda-sunrise-sunset)
2979(define-key org-agenda-mode-map "S" 'org-agenda-sunrise-sunset)
2980(define-key org-agenda-mode-map "h" 'org-agenda-holidays)
2981(define-key org-agenda-mode-map "H" 'org-agenda-holidays)
2909(define-key org-agenda-mode-map "+" 'org-agenda-priority-up) 2982(define-key org-agenda-mode-map "+" 'org-agenda-priority-up)
2910(define-key org-agenda-mode-map "-" 'org-agenda-priority-down) 2983(define-key org-agenda-mode-map "-" 'org-agenda-priority-down)
2911(define-key org-agenda-mode-map [(right)] 'org-agenda-later) 2984(define-key org-agenda-mode-map [(right)] 'org-agenda-later)
@@ -2951,6 +3024,12 @@ The following commands are available:
2951 :style toggle :selected org-agenda-include-diary :active t] 3024 :style toggle :selected org-agenda-include-diary :active t]
2952 "--" 3025 "--"
2953 ["New Diary Entry" org-agenda-diary-entry t] 3026 ["New Diary Entry" org-agenda-diary-entry t]
3027 ("Calendar commands"
3028 ["Goto calendar" org-agenda-goto-calendar t]
3029 ["Phases of the Moon" org-agenda-phases-of-moon t]
3030 ["Sunrise/Sunset" org-agenda-sunrise-sunset t]
3031 ["Holidays" org-agenda-holidays t]
3032 ["Convert" org-agenda-convert-date t])
2954 "--" 3033 "--"
2955 ["Quit" org-agenda-quit t] 3034 ["Quit" org-agenda-quit t]
2956 ["Exit and Release Buffers" org-agenda-exit t] 3035 ["Exit and Release Buffers" org-agenda-exit t]
@@ -3110,7 +3189,7 @@ NDAYS defaults to `org-agenda-ndays'."
3110 (d (- nt n1))) 3189 (d (- nt n1)))
3111 (- sd (+ (if (< d 0) 7 0) d))))) 3190 (- sd (+ (if (< d 0) 7 0) d)))))
3112 (day-numbers (list start)) 3191 (day-numbers (list start))
3113 s e rtn rtnall file date d start-pos) 3192 s e rtn rtnall file date d start-pos end-pos)
3114 (setq org-agenda-redo-command 3193 (setq org-agenda-redo-command
3115 (list 'org-agenda include-all start-day ndays)) 3194 (list 'org-agenda include-all start-day ndays))
3116 ;; Make the list of days 3195 ;; Make the list of days
@@ -3146,7 +3225,9 @@ NDAYS defaults to `org-agenda-ndays'."
3146 s (point)) 3225 s (point))
3147 (if (or (= d today) 3226 (if (or (= d today)
3148 (and (not start-pos) (= d sd))) 3227 (and (not start-pos) (= d sd)))
3149 (setq start-pos (point))) 3228 (setq start-pos (point))
3229 (if (and start-pos (not end-pos))
3230 (setq end-pos (point))))
3150 (setq files org-agenda-files 3231 (setq files org-agenda-files
3151 rtnall nil) 3232 rtnall nil)
3152 (while (setq file (pop files)) 3233 (while (setq file (pop files))
@@ -3173,6 +3254,17 @@ NDAYS defaults to `org-agenda-ndays'."
3173 (put-text-property s (1- (point)) 'day d)))) 3254 (put-text-property s (1- (point)) 'day d))))
3174 (goto-char (point-min)) 3255 (goto-char (point-min))
3175 (setq buffer-read-only t) 3256 (setq buffer-read-only t)
3257 (if org-fit-agenda-window
3258 (fit-window-to-buffer nil (/ (* (frame-height) 3) 4)
3259 (/ (frame-height) 2)))
3260 (unless (and (pos-visible-in-window-p (point-min))
3261 (pos-visible-in-window-p (point-max)))
3262 (goto-char (1- (point-max)))
3263 (recenter -1)
3264 (if (not (pos-visible-in-window-p (or start-pos 1)))
3265 (progn
3266 (goto-char (or start-pos 1))
3267 (recenter 1))))
3176 (goto-char (or start-pos 1)) 3268 (goto-char (or start-pos 1))
3177 (if (not org-select-agenda-window) (select-window win)) 3269 (if (not org-select-agenda-window) (select-window win))
3178 (message ""))) 3270 (message "")))
@@ -3285,10 +3377,10 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3285 "Set the mode name to indicate all the small mode seetings." 3377 "Set the mode name to indicate all the small mode seetings."
3286 (setq mode-name 3378 (setq mode-name
3287 (concat "Org-Agenda" 3379 (concat "Org-Agenda"
3288 (if (equal org-agenda-ndays 1) " Day" "") 3380 (if (equal org-agenda-ndays 1) " Day" "")
3289 (if (equal org-agenda-ndays 7) " Week" "") 3381 (if (equal org-agenda-ndays 7) " Week" "")
3290 (if org-agenda-follow-mode " Follow" "") 3382 (if org-agenda-follow-mode " Follow" "")
3291 (if org-agenda-include-diary " Diary" ""))) 3383 (if org-agenda-include-diary " Diary" "")))
3292 (force-mode-line-update)) 3384 (force-mode-line-update))
3293 3385
3294(defun org-agenda-post-command-hook () 3386(defun org-agenda-post-command-hook ()
@@ -3299,26 +3391,33 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3299(defun org-get-entries-from-diary (date) 3391(defun org-get-entries-from-diary (date)
3300 "Get the (emacs calendar) diary entries for DATE." 3392 "Get the (emacs calendar) diary entries for DATE."
3301 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") 3393 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*")
3302 (diary-display-hook '(sort-diary-entries fancy-diary-display)) 3394 (diary-display-hook '(fancy-diary-display))
3395 (list-diary-entries-hook
3396 (cons 'org-diary-default-entry list-diary-entries-hook))
3303 entries 3397 entries
3304 (disable-org-agenda t)) 3398 (disable-org-diary t))
3305 (save-excursion 3399 (save-excursion
3306 (save-window-excursion 3400 (save-window-excursion
3307 (list-diary-entries date 1))) 3401 (list-diary-entries date 1)))
3308 (if (not (get-buffer fancy-diary-buffer)) 3402 (if (not (get-buffer fancy-diary-buffer))
3309 (setq entries nil) 3403 (setq entries nil)
3310 (save-excursion 3404 (save-excursion
3311 (set-buffer fancy-diary-buffer) 3405 (switch-to-buffer fancy-diary-buffer)
3312 (setq buffer-read-only nil) 3406 (setq buffer-read-only nil)
3313 (if (= (point-max) 1) 3407 (if (= (point-max) 1)
3314 ;; No entries 3408 ;; No entries
3315 (setq entries nil) 3409 (setq entries nil)
3316 ;; Omit the date 3410 ;; Omit the date and other unnecessary stuff
3317 (beginning-of-line 3) 3411 (org-agenda-cleanup-fancy-diary)
3318 (delete-region (point-min) (point)) 3412 ;; Add prefix to each line and extend the text properties
3413 (goto-char (point-min))
3319 (while (and (re-search-forward "^" nil t) (not (eobp))) 3414 (while (and (re-search-forward "^" nil t) (not (eobp)))
3320 (replace-match " Diary: ")) 3415 (replace-match " Diary: ")
3321 (setq entries (buffer-substring (point-min) (- (point-max) 1)))) 3416 (add-text-properties (point-at-bol) (point)
3417 (text-properties-at (point))))
3418 (if (= (point-max) 1)
3419 (setq entries nil)
3420 (setq entries (buffer-substring (point-min) (- (point-max) 1)))))
3322 (set-buffer-modified-p nil) 3421 (set-buffer-modified-p nil)
3323 (kill-buffer fancy-diary-buffer))) 3422 (kill-buffer fancy-diary-buffer)))
3324 (when entries 3423 (when entries
@@ -3337,6 +3436,49 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3337 x) 3436 x)
3338 entries))))) 3437 entries)))))
3339 3438
3439(defun org-agenda-cleanup-fancy-diary ()
3440 "Remove unwanted stuff in buffer created by fancy-diary-display.
3441This gets rid of the date, the underline under the date, and
3442the dummy entry installed by org-mode to ensure non-empty diary for each
3443date."
3444 (goto-char (point-min))
3445 (if (looking-at ".*?:[ \t]*")
3446 (progn
3447 (replace-match "")
3448 (re-search-forward "\n=+$" nil t)
3449 (replace-match "")
3450 (while (re-search-backward "^ +" nil t) (replace-match "")))
3451 (re-search-forward "\n=+$" nil t)
3452 (delete-region (point-min) (min (point-max) (1+ (match-end 0)))))
3453 (if (re-search-forward "^Org-mode dummy\n?" nil t)
3454 (replace-match "")))
3455
3456;; Advise the add-to-diary-list function to allow org to jump to
3457;; diary entires. Wrapped into eval-after-load to avoid loading
3458;; advice unnecessarily
3459(eval-after-load "diary-lib"
3460 '(defadvice add-to-diary-list (before org-mark-diary-entry activate)
3461 "Make the position visible."
3462 (if (and (boundp 'disable-org-diary) ;; called from org-agenda
3463 (stringp string)
3464 (buffer-file-name))
3465 (add-text-properties
3466 0 (length string)
3467 (list 'mouse-face 'highlight
3468 'keymap org-agenda-keymap
3469 'help-echo
3470 (format
3471 "mouse-2 or RET jump to diary file %s"
3472 (abbreviate-file-name (buffer-file-name)))
3473 'org-agenda-diary-link t
3474 'org-marker (org-agenda-new-marker (point-at-bol)))
3475 string))))
3476
3477(defun org-diary-default-entry ()
3478 "Add a dummy entry to the diary.
3479Needed to avoid empty dates which mess up holiday display."
3480 (add-to-diary-list original-date "Org-mode dummy" ""))
3481
3340(defun org-add-file (&optional file) 3482(defun org-add-file (&optional file)
3341 "Add current file to the list of files in variable `org-agenda-files'. 3483 "Add current file to the list of files in variable `org-agenda-files'.
3342These are the files which are being checked for agenda entries. 3484These are the files which are being checked for agenda entries.
@@ -3468,7 +3610,7 @@ function from a program - use `org-agenda-get-day-entries' instead."
3468 file rtn results) 3610 file rtn results)
3469 ;; If this is called during org-agenda, don't return any entries to 3611 ;; If this is called during org-agenda, don't return any entries to
3470 ;; the calendar. Org Agenda will list these entries itself. 3612 ;; the calendar. Org Agenda will list these entries itself.
3471 (if (boundp 'disable-org-agenda) (setq files nil)) 3613 (if (boundp 'disable-org-diary) (setq files nil))
3472 (while (setq file (pop files)) 3614 (while (setq file (pop files))
3473 (setq rtn (apply 'org-agenda-get-day-entries file date args)) 3615 (setq rtn (apply 'org-agenda-get-day-entries file date args))
3474 (setq results (append results rtn))) 3616 (setq results (append results rtn)))
@@ -3864,7 +4006,6 @@ and by additional input from the age of a schedules or deadline entry."
3864 (let* ((pri (get-text-property (point-at-bol) 'priority))) 4006 (let* ((pri (get-text-property (point-at-bol) 'priority)))
3865 (message "Priority is %d" (if pri pri -1000)))) 4007 (message "Priority is %d" (if pri pri -1000))))
3866 4008
3867
3868(defun org-agenda-goto () 4009(defun org-agenda-goto ()
3869 "Go to the Org-mode file which contains the item at point." 4010 "Go to the Org-mode file which contains the item at point."
3870 (interactive) 4011 (interactive)
@@ -3875,10 +4016,11 @@ and by additional input from the age of a schedules or deadline entry."
3875 (switch-to-buffer-other-window buffer) 4016 (switch-to-buffer-other-window buffer)
3876 (widen) 4017 (widen)
3877 (goto-char pos) 4018 (goto-char pos)
3878 (org-show-hidden-entry) 4019 (when (eq major-mode 'org-mode)
3879 (save-excursion 4020 (org-show-hidden-entry)
3880 (and (outline-next-heading) 4021 (save-excursion
3881 (org-flag-heading nil))))) ; show the next heading 4022 (and (outline-next-heading)
4023 (org-flag-heading nil)))))) ; show the next heading
3882 4024
3883(defun org-agenda-switch-to () 4025(defun org-agenda-switch-to ()
3884 "Go to the Org-mode file which contains the item at point." 4026 "Go to the Org-mode file which contains the item at point."
@@ -3891,10 +4033,11 @@ and by additional input from the age of a schedules or deadline entry."
3891 (delete-other-windows) 4033 (delete-other-windows)
3892 (widen) 4034 (widen)
3893 (goto-char pos) 4035 (goto-char pos)
3894 (org-show-hidden-entry) 4036 (when (eq major-mode 'org-mode)
3895 (save-excursion 4037 (org-show-hidden-entry)
3896 (and (outline-next-heading) 4038 (save-excursion
3897 (org-flag-heading nil))))) ; show the next heading 4039 (and (outline-next-heading)
4040 (org-flag-heading nil)))))) ; show the next heading
3898 4041
3899(defun org-agenda-goto-mouse (ev) 4042(defun org-agenda-goto-mouse (ev)
3900 "Go to the Org-mode file which contains the deadline at the mouse click." 4043 "Go to the Org-mode file which contains the deadline at the mouse click."
@@ -3923,12 +4066,18 @@ and by additional input from the age of a schedules or deadline entry."
3923 (mouse-set-point ev) 4066 (mouse-set-point ev)
3924 (org-agenda-show)) 4067 (org-agenda-show))
3925 4068
4069(defun org-agenda-check-no-diary ()
4070 "Check if the entry is a diary link and abort if yes."
4071 (if (get-text-property (point) 'org-agenda-diary-link)
4072 (org-agenda-error)))
4073
3926(defun org-agenda-error () 4074(defun org-agenda-error ()
3927 (error "Command not allowed in this line.")) 4075 (error "Command not allowed in this line."))
3928 4076
3929(defun org-agenda-todo () 4077(defun org-agenda-todo ()
3930 "Cycle TODO state of line at point, also in Org-mode file." 4078 "Cycle TODO state of line at point, also in Org-mode file."
3931 (interactive) 4079 (interactive)
4080 (org-agenda-check-no-diary)
3932 (let* ((props (text-properties-at (point))) 4081 (let* ((props (text-properties-at (point)))
3933 (col (current-column)) 4082 (col (current-column))
3934 (marker (or (get-text-property (point) 'org-marker) 4083 (marker (or (get-text-property (point) 'org-marker)
@@ -3971,6 +4120,7 @@ and by additional input from the age of a schedules or deadline entry."
3971(defun org-agenda-priority (&optional force-direction) 4120(defun org-agenda-priority (&optional force-direction)
3972 "Set the priority of line at point, also in Org-mode file." 4121 "Set the priority of line at point, also in Org-mode file."
3973 (interactive) 4122 (interactive)
4123 (org-agenda-check-no-diary)
3974 (let* ((props (text-properties-at (point))) 4124 (let* ((props (text-properties-at (point)))
3975 (col (current-column)) 4125 (col (current-column))
3976 (marker (or (get-text-property (point) 'org-marker) 4126 (marker (or (get-text-property (point) 'org-marker)
@@ -4003,6 +4153,7 @@ and by additional input from the age of a schedules or deadline entry."
4003(defun org-agenda-date-later (arg &optional what) 4153(defun org-agenda-date-later (arg &optional what)
4004 "Change the date of this item to one day later." 4154 "Change the date of this item to one day later."
4005 (interactive "p") 4155 (interactive "p")
4156 (org-agenda-check-no-diary)
4006 (let* ((marker (or (get-text-property (point) 'org-marker) 4157 (let* ((marker (or (get-text-property (point) 'org-marker)
4007 (org-agenda-error))) 4158 (org-agenda-error)))
4008 (buffer (marker-buffer marker)) 4159 (buffer (marker-buffer marker))
@@ -4022,8 +4173,9 @@ and by additional input from the age of a schedules or deadline entry."
4022 (org-agenda-date-later (- arg) what)) 4173 (org-agenda-date-later (- arg) what))
4023 4174
4024(defun org-agenda-date-today (arg) 4175(defun org-agenda-date-today (arg)
4025 "Change the date of this item to one day later." 4176 "Change the date of this item to today."
4026 (interactive "p") 4177 (interactive "p")
4178 (org-agenda-check-no-diary)
4027 (let* ((marker (or (get-text-property (point) 'org-marker) 4179 (let* ((marker (or (get-text-property (point) 'org-marker)
4028 (org-agenda-error))) 4180 (org-agenda-error)))
4029 (buffer (marker-buffer marker)) 4181 (buffer (marker-buffer marker))
@@ -4084,7 +4236,91 @@ All the standard commands work: block, weekly etc"
4084 (get-text-property point 'day)))) 4236 (get-text-property point 'day))))
4085 (call-interactively cmd)) 4237 (call-interactively cmd))
4086 (fset 'calendar-cursor-to-date oldf))))) 4238 (fset 'calendar-cursor-to-date oldf)))))
4087 4239
4240
4241(defun org-agenda-execute-calendar-command (cmd)
4242 "Execute a calendar command from the agenda, with the date associated to
4243the cursor position."
4244 (require 'diary-lib)
4245 (unless (get-text-property (point) 'day)
4246 (error "Don't know which date to use for calendar command"))
4247 (let* ((oldf (symbol-function 'calendar-cursor-to-date))
4248 (point (point))
4249 (mark (or (mark t) (point)))
4250 (date (calendar-gregorian-from-absolute
4251 (get-text-property point 'day)))
4252 (displayed-day (extract-calendar-day date))
4253 (displayed-month (extract-calendar-month date))
4254 (displayed-year (extract-calendar-year date)))
4255 (unwind-protect
4256 (progn
4257 (fset 'calendar-cursor-to-date
4258 (lambda (&optional error)
4259 (calendar-gregorian-from-absolute
4260 (get-text-property point 'day))))
4261 (call-interactively cmd))
4262 (fset 'calendar-cursor-to-date oldf))))
4263
4264(defun org-agenda-phases-of-moon ()
4265 "Display the phases of the moon for 3 month around cursor date."
4266 (interactive)
4267 (org-agenda-execute-calendar-command 'calendar-phases-of-moon))
4268
4269(defun org-agenda-holidays ()
4270 "Display the holidays for 3 month around cursor date."
4271 (interactive)
4272 (org-agenda-execute-calendar-command 'list-calendar-holidays))
4273
4274(defun org-agenda-sunrise-sunset (arg)
4275 "Display sunrise and sunset for the cursor date.
4276Latitude and longitude can be specified with the variables
4277`calendar-latitude' and `calendar-longitude'. When called with prefix
4278argument, location will be prompted for."
4279 (interactive "P")
4280 (let ((calendar-longitude (if arg nil calendar-longitude))
4281 (calendar-latitude (if arg nil calendar-latitude))
4282 (calendar-location-name nil))
4283 (org-agenda-execute-calendar-command 'calendar-sunrise-sunset)))
4284
4285(defun org-agenda-goto-calendar ()
4286 "Open the Emacs calendar with the date at the cursor."
4287 (interactive)
4288 (let* ((day (or (get-text-property (point) 'day)
4289 (error "Don't know which date to open in calendar")))
4290 (date (calendar-gregorian-from-absolute day)))
4291 (calendar)
4292 (calendar-goto-date date)))
4293
4294(defun org-agenda-convert-date ()
4295 (interactive)
4296 (let ((day (get-text-property (point) 'day))
4297 date s)
4298 (unless day
4299 (error "Don't know which date to convert"))
4300 (setq date (calendar-gregorian-from-absolute day))
4301 (require 'cal-julian)
4302 (require 'cal-hebrew)
4303 (require 'cal-islam)
4304 (require 'cal-french)
4305 (require 'cal-mayan)
4306 (require 'cal-coptic)
4307 (require 'cal-persia)
4308 (require 'cal-china)
4309 (setq s (concat
4310 "Gregorian: " (calendar-date-string date) "\n"
4311 "Julian: " (calendar-julian-date-string date) "\n"
4312 "Astronomic: " (calendar-astro-date-string date) " (at noon UTC)\n"
4313 "Hebrew: " (calendar-hebrew-date-string date) "\n"
4314 "Islamic: " (calendar-islamic-date-string date) "\n"
4315 "French: " (calendar-french-date-string date) "\n"
4316 "Maya: " (calendar-mayan-date-string date) "\n"
4317 "Coptic: " (calendar-coptic-date-string date) "\n"
4318 "Persian: " (calendar-persian-date-string date) "\n"
4319 "Chineese: " (calendar-chinese-date-string date) "\n"))
4320 (with-output-to-temp-buffer "*Dates*"
4321 (princ s))
4322 (fit-window-to-buffer (get-buffer-window "*Dates*"))))
4323
4088;;; Link Stuff 4324;;; Link Stuff
4089 4325
4090(defun org-find-file-at-mouse (ev) 4326(defun org-find-file-at-mouse (ev)
@@ -5087,14 +5323,23 @@ Before doing so, re-align the table if necessary."
5087 (skip-chars-backward "^|\n\r") 5323 (skip-chars-backward "^|\n\r")
5088 (if (looking-at " ") (forward-char 1))))) 5324 (if (looking-at " ") (forward-char 1)))))
5089 5325
5090(defun org-table-copy-from-above (n) 5326(defun org-table-copy-down (n)
5091 "Copy into the current column the nearest non-empty field from above. 5327 "Copy a field down in the current column.
5092With prefix argument N, take the Nth non-empty field." 5328If the field at the cursor is empty, copy into it the content of the nearest
5329non-empty field above. With argument N, use the Nth non-empty field.
5330If the current fields is not empty, it is copied down to the next row, and
5331the cursor is moved with it. Therefore, repeating this command causes the
5332column to be filled row-by-row.
5333If the variable `org-table-copy-increment' is non-nil and the field is an
5334integer, it will be incremented while copying."
5093 (interactive "p") 5335 (interactive "p")
5094 (let ((colpos (org-table-current-column)) 5336 (let* ((colpos (org-table-current-column))
5095 (beg (org-table-begin)) 5337 (field (org-table-get-field))
5096 txt) 5338 (non-empty (string-match "[^ \t]" field))
5339 (beg (org-table-begin))
5340 txt)
5097 (org-table-check-inside-data-field) 5341 (org-table-check-inside-data-field)
5342 (if non-empty (progn (org-table-next-row) (org-table-blank-field)))
5098 (if (save-excursion 5343 (if (save-excursion
5099 (setq txt 5344 (setq txt
5100 (catch 'exit 5345 (catch 'exit
@@ -5103,10 +5348,13 @@ With prefix argument N, take the Nth non-empty field."
5103 beg t)) 5348 beg t))
5104 (org-table-goto-column colpos t) 5349 (org-table-goto-column colpos t)
5105 (if (and (looking-at 5350 (if (and (looking-at
5106 "|[ \t]*\\([^| \t][^|]*[^| \t]\\)[ \t]*|") 5351 "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
5107 (= (setq n (1- n)) 0)) 5352 (= (setq n (1- n)) 0))
5108 (throw 'exit (match-string 1))))))) 5353 (throw 'exit (match-string 1)))))))
5109 (progn 5354 (progn
5355 (if (and org-table-copy-increment
5356 (string-match "^[0-9]+$" txt))
5357 (setq txt (format "%d" (+ (string-to-int txt) 1))))
5110 (insert txt) 5358 (insert txt)
5111 (org-table-align)) 5359 (org-table-align))
5112 (error "No non-empty field found")))) 5360 (error "No non-empty field found"))))
@@ -6039,7 +6287,7 @@ table editor iin arbitrary modes.")
6039 ([(shift tab)] org-table-previous-field) 6287 ([(shift tab)] org-table-previous-field)
6040 ("\C-c\C-c" org-table-align) 6288 ("\C-c\C-c" org-table-align)
6041 ([(return)] org-table-next-row) 6289 ([(return)] org-table-next-row)
6042 ([(shift return)] org-table-copy-from-above) 6290 ([(shift return)] org-table-copy-down)
6043 ([(meta return)] org-table-wrap-region) 6291 ([(meta return)] org-table-wrap-region)
6044 ("\C-c\C-q" org-table-wrap-region) 6292 ("\C-c\C-q" org-table-wrap-region)
6045 ("\C-c?" org-table-current-column) 6293 ("\C-c?" org-table-current-column)
@@ -6157,7 +6405,7 @@ a reduced column width."
6157 "--" 6405 "--"
6158 ["Blank field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"] 6406 ["Blank field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"]
6159 ["Copy field from above" 6407 ["Copy field from above"
6160 org-table-copy-from-above :active (org-at-table-p) :keys "S-RET"] 6408 org-table-copy-down :active (org-at-table-p) :keys "S-RET"]
6161 "--" 6409 "--"
6162 ("Column" 6410 ("Column"
6163 ["Move column left" org-metaleft :active (org-at-table-p) :keys "M-<left>"] 6411 ["Move column left" org-metaleft :active (org-at-table-p) :keys "M-<left>"]
@@ -6678,7 +6926,57 @@ underlined headlines. The default is 3."
6678 (setq char (nth (- umax level) (reverse org-ascii-underline))) 6926 (setq char (nth (- umax level) (reverse org-ascii-underline)))
6679 (if org-export-with-section-numbers 6927 (if org-export-with-section-numbers
6680 (setq title (concat (org-section-number level) " " title))) 6928 (setq title (concat (org-section-number level) " " title)))
6681 (insert title "\n" (make-string (length title) char) "\n")))) 6929 (insert title "\n" (make-string (string-width title) char) "\n"))))
6930
6931(defun org-export-copy-visible (&optional arg)
6932 "Copy the visible part of the buffer to another buffer, for printing.
6933Also removes the first line of the buffer it is specifies a mode,
6934and all options lines."
6935 (interactive "P")
6936 (let* ((filename (concat (file-name-sans-extension (buffer-file-name))
6937 ".txt"))
6938 (buffer (find-file-noselect filename))
6939 (ore (concat
6940 (org-make-options-regexp
6941 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" "STARTUP"
6942 "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))
6943 (if org-noutline-p "\\(\n\\|$\\)" "")))
6944 s e)
6945 (save-excursion
6946 (set-buffer buffer)
6947 (erase-buffer)
6948 (text-mode))
6949 (save-excursion
6950 (setq s (goto-char (point-min)))
6951 (while (not (= (point) (point-max)))
6952 (goto-char (org-find-invisible))
6953 (append-to-buffer buffer s (point))
6954 (setq s (goto-char (org-find-visible)))))
6955 (switch-to-buffer-other-window buffer)
6956 (newline)
6957 (goto-char (point-min))
6958 (if (looking-at ".*-\\*- mode:.*\n")
6959 (replace-match ""))
6960 (while (re-search-forward ore nil t)
6961 (replace-match ""))
6962 (goto-char (point-min))))
6963
6964(defun org-find-visible ()
6965 (if (featurep 'noutline)
6966 (let ((s (point)))
6967 (while (and (not (= (point-max) (setq s (next-overlay-change s))))
6968 (get-char-property s 'invisible)))
6969 s)
6970 (skip-chars-forward "^\n")
6971 (point)))
6972(defun org-find-invisible ()
6973 (if (featurep 'noutline)
6974 (let ((s (point)))
6975 (while (and (not (= (point-max) (setq s (next-overlay-change s))))
6976 (not (get-char-property s 'invisible))))
6977 s)
6978 (skip-chars-forward "^\r")
6979 (point)))
6682 6980
6683;; HTML 6981;; HTML
6684 6982
@@ -7423,7 +7721,7 @@ When LEVEL is non-nil, increase section numbers on that level."
7423(define-key org-mode-map [(shift tab)] 'org-shifttab) 7721(define-key org-mode-map [(shift tab)] 'org-shifttab)
7424(define-key org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) 7722(define-key org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c)
7425(define-key org-mode-map [(return)] 'org-return) 7723(define-key org-mode-map [(return)] 'org-return)
7426(define-key org-mode-map [(shift return)] 'org-table-copy-from-above) 7724(define-key org-mode-map [(shift return)] 'org-table-copy-down)
7427(define-key org-mode-map [(meta return)] 'org-meta-return) 7725(define-key org-mode-map [(meta return)] 'org-meta-return)
7428(define-key org-mode-map [(control up)] 'org-move-line-up) 7726(define-key org-mode-map [(control up)] 'org-move-line-up)
7429(define-key org-mode-map [(control down)] 'org-move-line-down) 7727(define-key org-mode-map [(control down)] 'org-move-line-down)
@@ -7436,6 +7734,10 @@ When LEVEL is non-nil, increase section numbers on that level."
7436(define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region) 7734(define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region)
7437(define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii) 7735(define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii)
7438(define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii) 7736(define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii)
7737(define-key org-mode-map "\C-c\C-xv" 'org-export-copy-visible)
7738(define-key org-mode-map "\C-c\C-x\C-v" 'org-export-copy-visible)
7739(define-key org-mode-map "\C-c\C-xo" 'org-export-as-opml)
7740(define-key org-mode-map "\C-c\C-x\C-o" 'org-export-as-opml)
7439(define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template) 7741(define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template)
7440(define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section) 7742(define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section)
7441(define-key org-mode-map "\C-c\C-xh" 'org-export-as-html) 7743(define-key org-mode-map "\C-c\C-xh" 'org-export-as-html)
@@ -7444,7 +7746,7 @@ When LEVEL is non-nil, increase section numbers on that level."
7444 7746
7445;; FIXME: Do we really need to save match data in these commands? 7747;; FIXME: Do we really need to save match data in these commands?
7446;; I would like to remove it in order to minimize impact. 7748;; I would like to remove it in order to minimize impact.
7447;; Self-insert already does not preserve it. How much resources does this take??? 7749;; Self-insert already does not preserve it. How much resources used by this???
7448 7750
7449(defsubst org-table-p () 7751(defsubst org-table-p ()
7450 (if (and (eq major-mode 'org-mode) font-lock-mode) 7752 (if (and (eq major-mode 'org-mode) font-lock-mode)
@@ -7469,28 +7771,7 @@ overwritten, and the table is not marked as requiring realignment."
7469 7771
7470;; FIXME: 7772;; FIXME:
7471;; The following two functions might still be optimized to trigger 7773;; The following two functions might still be optimized to trigger
7472;; re-alignment less frequently. Right now they raise the flag each time 7774;; re-alignment less frequently.
7473;; (through before-change-functions). Here is how this could be minimized:
7474;; Basically, check if the non-white field width before deletion is
7475;; equal to the column width. If yes, the delete should trigger a
7476;; re-align. I have not implemented this so far because it is not so
7477;; easy, requires grabbing the field etc. So it may finally have some
7478;; impact on typing performance which we don't want.
7479
7480;; The defsubst is only a draft, untested...
7481
7482;; Maybe it is not so important to get rid of realigns - maybe the most
7483;; important aspect is to keep the table look noce as long as possible,
7484;; which is already achieved...
7485
7486;(defsubst org-check-delete-triggers-realign ()
7487; (let ((pos (point)))
7488; (skip-chars-backward "^|\n")
7489; (and (looking-at " *\\(.*?\\) *|")
7490; (= (nth (1- (org-table-current-column))
7491; org-table-last-column-widths)
7492; (- (match-end 1) (match-beginning 1)))
7493; (setq org-table-may-need-update t))))
7494 7775
7495(defun org-delete-backward-char (N) 7776(defun org-delete-backward-char (N)
7496 "Like `delete-backward-char', insert whitespace at field end in tables. 7777 "Like `delete-backward-char', insert whitespace at field end in tables.
@@ -7769,7 +8050,7 @@ the automatic table editor has been turned off."
7769 ["Next row" org-return (org-at-table-p)] 8050 ["Next row" org-return (org-at-table-p)]
7770 "--" 8051 "--"
7771 ["Blank field" org-table-blank-field (org-at-table-p)] 8052 ["Blank field" org-table-blank-field (org-at-table-p)]
7772 ["Copy field from above" org-table-copy-from-above (org-at-table-p)] 8053 ["Copy field from above" org-table-copy-down (org-at-table-p)]
7773 "--" 8054 "--"
7774 ("Column" 8055 ("Column"
7775 ["Move column left" org-metaleft (org-at-table-p)] 8056 ["Move column left" org-metaleft (org-at-table-p)]
@@ -7807,8 +8088,10 @@ the automatic table editor has been turned off."
7807 "--" 8088 "--"
7808 ("Export" 8089 ("Export"
7809 ["ASCII" org-export-as-ascii t] 8090 ["ASCII" org-export-as-ascii t]
8091 ["Extract visible text" org-export-copy-visible t]
7810 ["HTML" org-export-as-html t] 8092 ["HTML" org-export-as-html t]
7811 ["HTML, and open" org-export-as-html-and-open t] 8093 ["HTML, and open" org-export-as-html-and-open t]
8094 ["OPML" org-export-as-opml nil]
7812 "--" 8095 "--"
7813 ["Option template" org-insert-export-options-template t] 8096 ["Option template" org-insert-export-options-template t]
7814 ["Toggle fixed width" org-toggle-fixed-width-section t]) 8097 ["Toggle fixed width" org-toggle-fixed-width-section t])
@@ -8098,3 +8381,5 @@ When ENTRY is non-nil, show the entire entry."
8098 8381
8099;;; org.el ends here 8382;;; org.el ends here
8100 8383
8384
8385
diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el
index 9979f4a3e27..d5f3b19cc9c 100644
--- a/lisp/textmodes/refill.el
+++ b/lisp/textmodes/refill.el
@@ -221,7 +221,9 @@ With prefix arg, turn Refill mode on iff arg is positive.
221When Refill mode is on, the current paragraph will be formatted when 221When Refill mode is on, the current paragraph will be formatted when
222changes are made within it. Self-inserting characters only cause 222changes are made within it. Self-inserting characters only cause
223refilling if they would cause auto-filling." 223refilling if they would cause auto-filling."
224 nil " Refill" '(("\177" . backward-delete-char-untabify)) 224 :group 'refill
225 :lighter " Refill"
226 :keymap '(("\177" . backward-delete-char-untabify))
225 ;; Remove old state if necessary 227 ;; Remove old state if necessary
226 (when refill-ignorable-overlay 228 (when refill-ignorable-overlay
227 (delete-overlay refill-ignorable-overlay) 229 (delete-overlay refill-ignorable-overlay)
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 6fcf5869143..c4019d39fe5 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -1804,7 +1804,7 @@ have <h1>Very Major Headlines</h1> through <h6>Very Minor Headlines</h6>
1804 1804
1805<p>Paragraphs only need an opening tag. Line breaks and multiple spaces are 1805<p>Paragraphs only need an opening tag. Line breaks and multiple spaces are
1806ignored unless the text is <pre>preformatted.</pre> Text can be marked as 1806ignored unless the text is <pre>preformatted.</pre> Text can be marked as
1807<b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal M-g or 1807<b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal M-o or
1808Edit/Text Properties/Face commands. 1808Edit/Text Properties/Face commands.
1809 1809
1810Pages can have <a name=\"SOMENAME\">named points</a> and can link other points 1810Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 7e5d9fee78b..cc9ed23c6be 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -1562,8 +1562,9 @@ Return the process in which TeX is running."
1562 (concat 1562 (concat
1563 (if file 1563 (if file
1564 (if star (concat (substring cmd 0 star) 1564 (if star (concat (substring cmd 0 star)
1565 file (substring cmd (1+ star))) 1565 (shell-quote-argument file)
1566 (concat cmd " " file)) 1566 (substring cmd (1+ star)))
1567 (concat cmd " " (shell-quote-argument file)))
1567 cmd) 1568 cmd)
1568 (if background "&" "")))) 1569 (if background "&" ""))))
1569 ;; Switch to buffer before checking for subproc output in it. 1570 ;; Switch to buffer before checking for subproc output in it.
@@ -1886,8 +1887,8 @@ FILE is typically the output DVI or PDF file."
1886 (prog1 (file-name-directory (expand-file-name file)) 1887 (prog1 (file-name-directory (expand-file-name file))
1887 (setq file (file-name-nondirectory file)))) 1888 (setq file (file-name-nondirectory file))))
1888 (root (file-name-sans-extension file)) 1889 (root (file-name-sans-extension file))
1889 (fspec (list (cons ?r (comint-quote-filename root)) 1890 (fspec (list (cons ?r (shell-quote-argument root))
1890 (cons ?f (comint-quote-filename file)))) 1891 (cons ?f (shell-quote-argument file))))
1891 (default (tex-compile-default fspec))) 1892 (default (tex-compile-default fspec)))
1892 (list default-directory 1893 (list default-directory
1893 (completing-read 1894 (completing-read
@@ -1908,14 +1909,14 @@ FILE is typically the output DVI or PDF file."
1908 (compile-command 1909 (compile-command
1909 (if star 1910 (if star
1910 (concat (substring command 0 star) 1911 (concat (substring command 0 star)
1911 (comint-quote-filename file) 1912 (shell-quote-argument file)
1912 (substring command (1+ star))) 1913 (substring command (1+ star)))
1913 (concat command " " 1914 (concat command " "
1914 tex-start-options 1915 tex-start-options
1915 (if (< 0 (length tex-start-commands)) 1916 (if (< 0 (length tex-start-commands))
1916 (concat 1917 (concat
1917 (shell-quote-argument tex-start-commands) " ")) 1918 (shell-quote-argument tex-start-commands) " "))
1918 (comint-quote-filename file))))) 1919 (shell-quote-argument file)))))
1919 (tex-send-tex-command compile-command dir))) 1920 (tex-send-tex-command compile-command dir)))
1920 1921
1921(defun tex-send-tex-command (cmd &optional dir) 1922(defun tex-send-tex-command (cmd &optional dir)
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index 6ed93a0e99e..59f82c12e31 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -130,7 +130,7 @@ position to pop up the tooltip."
130 130
131(defcustom tooltip-gud-display 131(defcustom tooltip-gud-display
132 '((eq (tooltip-event-buffer tooltip-gud-event) 132 '((eq (tooltip-event-buffer tooltip-gud-event)
133 (marker-buffer overlay-arrow-position))) 133 (marker-buffer gud-overlay-arrow-position)))
134 "List of forms determining where GUD tooltips are displayed. 134 "List of forms determining where GUD tooltips are displayed.
135 135
136Forms in the list are combined with AND. The default is to display 136Forms in the list are combined with AND. The default is to display
@@ -469,27 +469,7 @@ This function must return nil if it doesn't handle EVENT."
469(defun tooltip-show-help-function (msg) 469(defun tooltip-show-help-function (msg)
470 "Function installed as `show-help-function'. 470 "Function installed as `show-help-function'.
471MSG is either a help string to display, or nil to cancel the display." 471MSG is either a help string to display, or nil to cancel the display."
472 (let ((previous-help tooltip-help-message) 472 (let ((previous-help tooltip-help-message))
473 mp pos)
474 (if (and mouse-1-click-follows-link
475 (stringp msg)
476 (save-match-data
477 (string-match "^mouse-2" msg))
478 (setq mp (mouse-pixel-position))
479 (consp (setq pos (cdr mp)))
480 (car pos) (>= (car pos) 0)
481 (cdr pos) (>= (cdr pos) 0)
482 (setq pos (posn-at-x-y (car pos) (cdr pos) (car mp)))
483 (windowp (posn-window pos)))
484 (with-current-buffer (window-buffer (posn-window pos))
485 (if (mouse-on-link-p pos)
486 (setq msg (concat
487 (cond
488 ((eq mouse-1-click-follows-link 'double) "double-")
489 ((and (integerp mouse-1-click-follows-link)
490 (< mouse-1-click-follows-link 0)) "Long ")
491 (t ""))
492 "mouse-1" (substring msg 7))))))
493 (setq tooltip-help-message msg) 473 (setq tooltip-help-message msg)
494 (cond ((null msg) 474 (cond ((null msg)
495 ;; Cancel display. This also cancels a delayed tip, if 475 ;; Cancel display. This also cancels a delayed tip, if
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 5a3bf23529c..82b7f64dc01 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,7 @@
12005-04-04 Lute Kamstra <lute@gnu.org>
2
3 * url-handlers.el (url-handler-mode): Specify :group.
4
12005-02-26 James Cloos <cloos@jhcloos.com> (tiny change) 52005-02-26 James Cloos <cloos@jhcloos.com> (tiny change)
2 6
3 * url-history.el (url-have-visited-url): Don't barf if 7 * url-history.el (url-have-visited-url): Don't barf if
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index f90f21a3dbe..68bf0ec7ab5 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -1,6 +1,6 @@
1;;; url-handlers.el --- file-name-handler stuff for URL loading 1;;; url-handlers.el --- file-name-handler stuff for URL loading
2 2
3;; Copyright (c) 1996, 1997, 1998, 1999, 2004 Free Software Foundation, Inc. 3;; Copyright (c) 1996, 1997, 1998, 1999, 2004, 2005 Free Software Foundation, Inc.
4 4
5;; Keywords: comm, data, processes, hypermedia 5;; Keywords: comm, data, processes, hypermedia
6 6
@@ -106,7 +106,7 @@ particularly bad at this\).")
106;;;###autoload 106;;;###autoload
107(define-minor-mode url-handler-mode 107(define-minor-mode url-handler-mode
108 "Use URL to handle URL-like file names." 108 "Use URL to handle URL-like file names."
109 :global t 109 :global t :group 'url
110 (if (not (boundp 'file-name-handler-alist)) 110 (if (not (boundp 'file-name-handler-alist))
111 ;; Can't be turned ON anyway. 111 ;; Can't be turned ON anyway.
112 (setq url-handler-mode nil) 112 (setq url-handler-mode nil)
diff --git a/lisp/url/vc-dav.el b/lisp/url/vc-dav.el
index e0e32f5da1a..3bf03165564 100644
--- a/lisp/url/vc-dav.el
+++ b/lisp/url/vc-dav.el
@@ -21,6 +21,11 @@
21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22;; Boston, MA 02111-1307, USA. 22;; Boston, MA 02111-1307, USA.
23 23
24
25;;; Commentary:
26
27;;; Code:
28
24(require 'url) 29(require 'url)
25(require 'url-dav) 30(require 'url-dav)
26 31
@@ -175,4 +180,5 @@ It should return a status of either 0 (no differences found), or
175 180
176(provide 'vc-dav) 181(provide 'vc-dav)
177 182
178;;; arch-tag: 0a0fb9fe-8190-4c0a-a179-5c291d3a467e 183;; arch-tag: 0a0fb9fe-8190-4c0a-a179-5c291d3a467e
184;;; vc-dav.el ends here
diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el
index 81a18eadd87..52b4659cec6 100644
--- a/lisp/vc-hooks.el
+++ b/lisp/vc-hooks.el
@@ -481,7 +481,9 @@ and does not employ any heuristic at all."
481 "Return non-nil if FILE has not changed since the last checkout." 481 "Return non-nil if FILE has not changed since the last checkout."
482 (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) 482 (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
483 (lastmod (nth 5 (file-attributes file)))) 483 (lastmod (nth 5 (file-attributes file))))
484 (if checkout-time 484 (if (and checkout-time
485 ;; Tramp and Ange-FTP return this when they don't know the time.
486 (not (equal lastmod '(0 0))))
485 (equal checkout-time lastmod) 487 (equal checkout-time lastmod)
486 (let ((unchanged (vc-call workfile-unchanged-p file))) 488 (let ((unchanged (vc-call workfile-unchanged-p file)))
487 (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0)) 489 (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0))
diff --git a/lisp/vc.el b/lisp/vc.el
index 2e241e67f48..ce4cb2d36c8 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -1,7 +1,7 @@
1;;; vc.el --- drive a version-control system from within Emacs 1;;; vc.el --- drive a version-control system from within Emacs
2 2
3;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 3;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998,
4;; 2000, 2001, 2003, 2004 Free Software Foundation, Inc. 4;; 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
5 5
6;; Author: FSF (see below for full credits) 6;; Author: FSF (see below for full credits)
7;; Maintainer: Andre Spiegel <spiegel@gnu.org> 7;; Maintainer: Andre Spiegel <spiegel@gnu.org>
@@ -962,8 +962,10 @@ that is inserted into the command line before the filename."
962 ;; start-process does not support remote execution 962 ;; start-process does not support remote execution
963 (setq okstatus nil)) 963 (setq okstatus nil))
964 (if (eq okstatus 'async) 964 (if (eq okstatus 'async)
965 (let ((proc (apply 'start-process command (current-buffer) command 965 (let ((proc
966 squeezed))) 966 (let ((process-connection-type nil))
967 (apply 'start-process command (current-buffer) command
968 squeezed))))
967 (unless (active-minibuffer-window) 969 (unless (active-minibuffer-window)
968 (message "Running %s in the background..." command)) 970 (message "Running %s in the background..." command))
969 ;;(set-process-sentinel proc (lambda (p msg) (delete-process p))) 971 ;;(set-process-sentinel proc (lambda (p msg) (delete-process p)))
diff --git a/lisp/wdired.el b/lisp/wdired.el
index 92d7a81627a..a4119343600 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -330,7 +330,8 @@ See `wdired-mode'."
330 (set-buffer-modified-p nil) 330 (set-buffer-modified-p nil)
331 (setq buffer-undo-list nil) 331 (setq buffer-undo-list nil)
332 (run-hooks 'wdired-mode-hook) 332 (run-hooks 'wdired-mode-hook)
333 (message (substitute-command-keys "Press \\[wdired-finish-edit] when finished"))) 333 (message (substitute-command-keys "Press \\[wdired-finish-edit] when finished \
334or \\[wdired-abort-changes] to abort changes")))
334 335
335 336
336;; Protect the buffer so only the filenames can be changed, and put 337;; Protect the buffer so only the filenames can be changed, and put
diff --git a/lisp/window.el b/lisp/window.el
index 5768436eaae..b4fd664a43c 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -397,20 +397,13 @@ lines than are actually needed in the case where some error may be present."
397 397
398(defun window-buffer-height (window) 398(defun window-buffer-height (window)
399 "Return the height (in screen lines) of the buffer that WINDOW is displaying." 399 "Return the height (in screen lines) of the buffer that WINDOW is displaying."
400 (save-excursion 400 (with-current-buffer (window-buffer window)
401 (set-buffer (window-buffer window)) 401 (max 1
402 (goto-char (point-min)) 402 (count-screen-lines (point-min) (point-max)
403 (let ((ignore-final-newline 403 ;; If buffer ends with a newline, ignore it when
404 ;; If buffer ends with a newline, ignore it when counting height 404 ;; counting height unless point is after it.
405 ;; unless point is after it. 405 (eobp)
406 (and (not (eobp)) (eq ?\n (char-after (1- (point-max))))))) 406 window))))
407 (+ 1 (nth 2 (compute-motion (point-min)
408 '(0 . 0)
409 (- (point-max) (if ignore-final-newline 1 0))
410 (cons 0 100000000)
411 nil
412 nil
413 window))))))
414 407
415(defun count-screen-lines (&optional beg end count-final-newline window) 408(defun count-screen-lines (&optional beg end count-final-newline window)
416 "Return the number of screen lines in the region. 409 "Return the number of screen lines in the region.
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index 131f95db7d0..4f7e19623fe 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -155,8 +155,11 @@
155 "Toggle XTerm mouse mode. 155 "Toggle XTerm mouse mode.
156With prefix arg, turn XTerm mouse mode on iff arg is positive. 156With prefix arg, turn XTerm mouse mode on iff arg is positive.
157 157
158Turn it on to use emacs mouse commands, and off to use xterm mouse commands." 158Turn it on to use Emacs mouse commands, and off to use xterm mouse commands.
159 nil " Mouse" nil :global t 159This works in terminal emulators compatible with xterm. Only single clicks
160are supported. When turned on, the normal xterm mouse functionality is still
161available by holding down the SHIFT key while pressing the mouse button."
162 nil " Mouse" nil :global t :group 'mouse
160 (if xterm-mouse-mode 163 (if xterm-mouse-mode
161 ;; Turn it on 164 ;; Turn it on
162 (unless window-system 165 (unless window-system