aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorMiles Bader2008-01-30 07:57:28 +0000
committerMiles Bader2008-01-30 07:57:28 +0000
commitd235ca2ff8fab139ce797757fcb159d1e28fa7e0 (patch)
tree96c5cd1a06a0d9dc26e8470c6eabfc032c0046f3 /lisp
parent3709a060f679dba14df71ae64a0035fa2b5b3106 (diff)
parent02cbe062bee38a6705bafb1699d77e3c44cfafcf (diff)
downloademacs-d235ca2ff8fab139ce797757fcb159d1e28fa7e0.tar.gz
emacs-d235ca2ff8fab139ce797757fcb159d1e28fa7e0.zip
Merge from emacs--devo--0
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-324
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog1349
-rw-r--r--lisp/ChangeLog.1212
-rw-r--r--lisp/ChangeLog.62
-rw-r--r--lisp/ChangeLog.unicode5
-rw-r--r--lisp/abbrev.el4
-rw-r--r--lisp/add-log.el48
-rw-r--r--lisp/allout.el451
-rw-r--r--lisp/ansi-color.el2
-rw-r--r--lisp/arc-mode.el5
-rw-r--r--lisp/blank-mode.el1726
-rw-r--r--lisp/button.el2
-rw-r--r--lisp/calc/calc-menu.el2
-rw-r--r--lisp/calc/calc-nlfit.el2
-rw-r--r--lisp/calendar/cal-menu.el3
-rw-r--r--lisp/calendar/icalendar.el380
-rw-r--r--lisp/comint.el7
-rw-r--r--lisp/cus-edit.el265
-rw-r--r--lisp/cus-start.el27
-rw-r--r--lisp/custom.el4
-rw-r--r--lisp/delsel.el20
-rw-r--r--lisp/diff-mode.el6
-rw-r--r--lisp/doc-view.el203
-rw-r--r--lisp/ediff-diff.el2
-rw-r--r--lisp/ediff-util.el10
-rw-r--r--lisp/ediff-wind.el5
-rw-r--r--lisp/ediff.el5
-rw-r--r--lisp/emacs-lisp/avl-tree.el2
-rw-r--r--lisp/emacs-lisp/check-declare.el2
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el112
-rw-r--r--lisp/emacs-lisp/cl-macs.el11
-rw-r--r--lisp/emacs-lisp/easymenu.el65
-rw-r--r--lisp/emacs-lisp/find-func.el24
-rw-r--r--lisp/emulation/crisp.el2
-rw-r--r--lisp/emulation/tpu-edt.el6
-rw-r--r--lisp/emulation/viper-cmd.el15
-rw-r--r--lisp/emulation/viper-ex.el8
-rw-r--r--lisp/emulation/viper-keym.el3
-rw-r--r--lisp/emulation/viper-util.el5
-rw-r--r--lisp/emulation/viper.el7
-rw-r--r--lisp/erc/ChangeLog1088
-rw-r--r--lisp/erc/ChangeLog.07839
-rw-r--r--lisp/erc/erc-backend.el102
-rw-r--r--lisp/erc/erc-button.el26
-rw-r--r--lisp/erc/erc-compat.el47
-rw-r--r--lisp/erc/erc-dcc.el133
-rw-r--r--lisp/erc/erc-goodies.el82
-rw-r--r--lisp/erc/erc-list.el229
-rw-r--r--lisp/erc/erc-networks.el16
-rw-r--r--lisp/erc/erc-page.el8
-rw-r--r--lisp/erc/erc-replace.el11
-rw-r--r--lisp/erc/erc-services.el26
-rw-r--r--lisp/erc/erc-track.el135
-rw-r--r--lisp/erc/erc-xdcc.el13
-rw-r--r--lisp/erc/erc.el150
-rw-r--r--lisp/ffap.el40
-rw-r--r--lisp/files.el7
-rw-r--r--lisp/frame.el4
-rw-r--r--lisp/fringe.el23
-rw-r--r--lisp/gnus/ChangeLog119
-rw-r--r--lisp/gnus/ecomplete.el2
-rw-r--r--lisp/gnus/gnus-art.el143
-rw-r--r--lisp/gnus/gnus-bookmark.el2
-rw-r--r--lisp/gnus/gnus-group.el92
-rw-r--r--lisp/gnus/gnus-registry.el231
-rw-r--r--lisp/gnus/gnus-sum.el4
-rw-r--r--lisp/gnus/mail-source.el2
-rw-r--r--lisp/gnus/message.el2
-rw-r--r--lisp/gnus/mm-decode.el5
-rw-r--r--lisp/gnus/mml.el9
-rw-r--r--lisp/gnus/nnmail.el27
-rw-r--r--lisp/gnus/sieve.el18
-rw-r--r--lisp/gnus/spam-wash.el2
-rw-r--r--lisp/help.el2
-rw-r--r--lisp/ibuf-ext.el31
-rw-r--r--lisp/ibuffer.el64
-rw-r--r--lisp/icomplete.el3
-rw-r--r--lisp/image-mode.el82
-rw-r--r--lisp/isearch-multi.el2
-rw-r--r--lisp/ldefs-boot.el470
-rw-r--r--lisp/linum.el196
-rw-r--r--lisp/loadhist.el4
-rw-r--r--lisp/log-edit.el22
-rw-r--r--lisp/longlines.el12
-rw-r--r--lisp/lpr.el2
-rw-r--r--lisp/ls-lisp.el7
-rw-r--r--lisp/mail/hashcash.el2
-rw-r--r--lisp/mail/rmail.el145
-rw-r--r--lisp/mb-depth.el2
-rw-r--r--lisp/md4.el2
-rw-r--r--lisp/mh-e/ChangeLog5
-rw-r--r--lisp/mh-e/mh-mime.el13
-rw-r--r--lisp/net/dbus.el185
-rw-r--r--lisp/net/hmac-def.el2
-rw-r--r--lisp/net/hmac-md5.el2
-rw-r--r--lisp/net/imap.el20
-rw-r--r--lisp/net/ntlm.el2
-rw-r--r--lisp/net/sasl-cram.el2
-rw-r--r--lisp/net/sasl-digest.el2
-rw-r--r--lisp/net/sasl-ntlm.el2
-rw-r--r--lisp/net/sasl.el2
-rw-r--r--lisp/net/tramp-cache.el2
-rw-r--r--lisp/net/tramp-cmds.el2
-rw-r--r--lisp/net/tramp-compat.el2
-rw-r--r--lisp/net/tramp-fish.el2
-rw-r--r--lisp/net/tramp-gw.el2
-rw-r--r--lisp/net/tramp.el148
-rw-r--r--lisp/net/trampver.el7
-rw-r--r--lisp/nxml/nxml-enc.el2
-rw-r--r--lisp/nxml/nxml-glyph.el2
-rw-r--r--lisp/nxml/nxml-maint.el2
-rw-r--r--lisp/nxml/nxml-mode.el21
-rw-r--r--lisp/nxml/nxml-ns.el2
-rw-r--r--lisp/nxml/nxml-outln.el2
-rw-r--r--lisp/nxml/nxml-parse.el2
-rw-r--r--lisp/nxml/nxml-rap.el2
-rw-r--r--lisp/nxml/nxml-uchnm.el19
-rw-r--r--lisp/nxml/nxml-util.el2
-rw-r--r--lisp/nxml/rng-cmpct.el2
-rw-r--r--lisp/nxml/rng-dt.el2
-rw-r--r--lisp/nxml/rng-loc.el2
-rw-r--r--lisp/nxml/rng-maint.el2
-rw-r--r--lisp/nxml/rng-match.el2
-rw-r--r--lisp/nxml/rng-nxml.el17
-rw-r--r--lisp/nxml/rng-parse.el2
-rw-r--r--lisp/nxml/rng-pttrn.el2
-rw-r--r--lisp/nxml/rng-uri.el2
-rw-r--r--lisp/nxml/rng-util.el2
-rw-r--r--lisp/nxml/rng-valid.el2
-rw-r--r--lisp/nxml/rng-xsd.el2
-rw-r--r--lisp/nxml/xmltok.el2
-rw-r--r--lisp/nxml/xsd-regexp.el2
-rw-r--r--lisp/obsolete/whitespace.el (renamed from lisp/whitespace.el)10
-rw-r--r--lisp/outline.el4
-rw-r--r--lisp/password-cache.el2
-rw-r--r--lisp/pcvs-defs.el8
-rw-r--r--lisp/pcvs.el2
-rw-r--r--lisp/play/blackbox.el2
-rw-r--r--lisp/play/bubbles.el2
-rw-r--r--lisp/progmodes/ada-mode.el7
-rw-r--r--lisp/progmodes/ada-xref.el2
-rw-r--r--lisp/progmodes/cc-awk.el2
-rw-r--r--lisp/progmodes/cc-cmds.el6
-rw-r--r--lisp/progmodes/cc-defs.el4
-rw-r--r--lisp/progmodes/cc-engine.el27
-rw-r--r--lisp/progmodes/cc-langs.el8
-rw-r--r--lisp/progmodes/cc-styles.el15
-rw-r--r--lisp/progmodes/cc-vars.el58
-rw-r--r--lisp/progmodes/compile.el3
-rw-r--r--lisp/progmodes/ebrowse.el24
-rw-r--r--lisp/progmodes/etags.el10
-rw-r--r--lisp/progmodes/f90.el6
-rw-r--r--lisp/progmodes/gdb-ui.el19
-rw-r--r--lisp/progmodes/hideif.el94
-rw-r--r--lisp/progmodes/pascal.el4
-rw-r--r--lisp/progmodes/python.el13
-rw-r--r--lisp/progmodes/sh-script.el1
-rw-r--r--lisp/progmodes/verilog-mode.el1062
-rw-r--r--lisp/progmodes/vhdl-mode.el2
-rw-r--r--lisp/repeat.el43
-rw-r--r--lisp/replace.el16
-rw-r--r--lisp/server.el131
-rw-r--r--lisp/smerge-mode.el44
-rw-r--r--lisp/subr.el59
-rw-r--r--lisp/t-mouse.el6
-rw-r--r--lisp/tar-mode.el3
-rw-r--r--lisp/term/w32console.el2
-rw-r--r--lisp/textmodes/bibtex.el263
-rw-r--r--lisp/textmodes/ispell.el4
-rw-r--r--lisp/textmodes/org-export-latex.el1065
-rw-r--r--lisp/textmodes/org-mouse.el1110
-rw-r--r--lisp/textmodes/org-publish.el21
-rw-r--r--lisp/textmodes/org.el3491
-rw-r--r--lisp/textmodes/reftex-index.el10
-rw-r--r--lisp/textmodes/reftex-toc.el10
-rw-r--r--lisp/textmodes/remember.el4
-rw-r--r--lisp/textmodes/sgml-mode.el2
-rw-r--r--lisp/url/ChangeLog13
-rw-r--r--lisp/url/url-auth.el51
-rw-r--r--lisp/url/url-handlers.el8
-rw-r--r--lisp/url/url-parse.el6
-rw-r--r--lisp/vc-arch.el8
-rw-r--r--lisp/vc-cvs.el2
-rw-r--r--lisp/vc-hg.el49
-rw-r--r--lisp/vc-svn.el40
-rw-r--r--lisp/vc.el435
-rw-r--r--lisp/view.el56
-rw-r--r--lisp/wdired.el6
-rw-r--r--lisp/winner.el2
-rw-r--r--lisp/woman.el6
189 files changed, 13286 insertions, 5072 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index bb1d32d66bf..d99acacccf2 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,7 +1,1291 @@
12008-01-17 Mark A. Hershberger <mah@everybody.org> 12008-01-30 Richard Stallman <rms@gnu.org>
2 2
3 * xml.el (xml-escape-string): Don't do any encoding changes on the 3 * progmodes/etags.el (tags-query-replace): Delete unused optional args.
4 string. 4 Doc fix.
5
6 * files.el (hack-local-variables): Don't query about fake variables.
7
82008-01-30 Markus Triska <markus.triska@gmx.at>
9
10 * linum.el: New file.
11
122008-01-29 Michael Albinus <michael.albinus@gmx.de>
13
14 * net/tramp.el (tramp-methods): Use "-H" option for "sudo". Suggested
15 by Trent W. Buck <trentbuck@gmail.com>. Make ("%h") a single
16 element in "plinkx".
17 (tramp-handle-shell-command): Reuse "*Async Shell Command*" or
18 "*Shell Command Output*" buffers. Check, whether there is already
19 an asynchronous process running. Display always the buffer of the
20 asynchronous process.
21 (tramp-compute-multi-hops): Adapt error message.
22
232008-01-29 Alan Mackenzie <acm@muc.de>
24
25 * progmodes/cc-langs.el (c-specifier-key): Exclude "template"
26 from this regexp; part of same fix as next change to cc-engine.el.
27
28 * progmodes/cc-engine.el (c-guess-basic-syntax, CASE 5A.5): Anchor
29 the "{" of a template function correctly on "template", not the
30 following "<".
31
32 * progmodes/cc-defs.el (c-version): Increase to 5.31.5.
33
342008-01-29 Tassilo Horn <tassilo@member.fsf.org>
35
36 * doc-view.el (doc-view-mode): Adapt to i-m-current-[vh]scroll
37 being an alist now.
38
39 * image-mode.el (image-mode-current-vscroll)
40 (image-mode-current-hscroll): Add doc strings.
41 (image-set-window-vscroll, image-set-window-hscroll)
42 (image-reset-current-vhscroll, image-mode): Adapt to
43 i-m-current-[vh]scroll being an alist now.
44
452008-01-29 Martin Rudalics <rudalics@gmx.at>
46
47 * emacs-lisp/find-func.el (find-function-search-for-symbol):
48 Strip extension from .emacs.el to make sure symbol is searched
49 in .emacs too.
50
512008-01-29 Tassilo Horn <tassilo@member.fsf.org>
52
53 * doc-view.el (doc-view-mode): Use facilities below to
54 restore [vh]scroll when switching buffers.
55
56 * image-mode.el (image-mode-current-vscroll)
57 (image-mode-current-hscroll): New variables.
58 (image-set-window-hscroll, image-set-window-vscroll): New
59 functions.
60 (image-forward-hscroll, image-next-line, image-bol, image-eol)
61 (image-bob, image-eob): Use them.
62 (image-reset-current-vhscroll): New function.
63 (image-mode): Make new variables buffer-local and reset [vh]scroll
64 on window configuration changes.
65
662008-01-27 Nick Roberts <nickrob@snap.net.nz>
67
68 * progmodes/gdb-ui.el (gdb-create-define-alist): Don't call
69 gdb-cpp-define-alist-program if file is nil (currently only
70 " *partial-output-...").
71
722008-01-27 Richard Stallman <rms@gnu.org>
73
74 * allout.el: Many doc fixes.
75 (allout-encrypt-string): Fix error message.
76
772008-01-26 Eli Zaretskii <eliz@gnu.org>
78
79 * progmodes/etags.el (tags-query-replace): Doc fix.
80
812008-01-25 Juanma Barranquero <lekktu@gmail.com>
82
83 * allout.el (allout-unload-function): New function.
84
852008-01-25 Juanma Barranquero <lekktu@gmail.com>
86
87 * allout.el (allout-prefix-data): Doc fix.
88 (allout-show-current-subtree): Reflow docstring.
89 (allout-use-mode-specific-leader, allout-use-hanging-indents)
90 (produce-allout-mode-map, allout-overlay-interior-modification-handler)
91 (allout-next-heading, allout-previous-heading, allout-rebullet-heading)
92 (allout-rebullet-topic, allout-rebullet-topic-grunt, allout-kill-topic)
93 (allout-copy-topic-as-kill, allout-listify-exposed)
94 (allout-process-exposed, allout-encrypted-key-info)
95 (allout-update-passphrase-mnemonic-aids)
96 (allout-next-topic-pending-encryption)
97 (allout-tests-globally-true): Fix typos in docstrings.
98
992008-01-23 Jason Rumney <jasonr@gnu.org>
100
101 * lpr.el (printer-name): Do not set on MS Windows.
102
1032008-01-28 Michael Albinus <michael.albinus@gmx.de>
104
105 * net/tramp.el (tramp-handle-shell-command): Use "/bin/sh -c" for
106 the command.
107
1082008-01-28 Vinicius Jose Latorre <viniciusjl@ig.com.br>
109
110 * whitespace.el: Moved to obsolete dir.
111
112 * blank-mode.el: New version 9.2. Replace whitespace funs by aliases
113 in blank-mode.
114 (whitespace-buffer): New fun.
115 (whitespace-region): Alias for whitespace-buffer, because there is no
116 blank-region fun.
117 (whitespace-cleanup): Alias for blank-cleanup.
118 (whitespace-cleanup-region): Alias for blank-cleanup-region.
119
1202008-01-27 Juanma Barranquero <lekktu@gmail.com>
121
122 * server.el (server-log-time-function): Doc fix.
123 (server-buffer): Fix typo in docstring.
124
1252008-01-27 Martin Rudalics <rudalics@gmx.at>
126
127 * view.el (view-buffer): Explain in doc-string why exit-action
128 should not be set to kill-buffer.
129
130 * arc-mode.el (archive-extract):
131 * tar-mode.el (tar-extract): Use kill-buffer-if-not-modified as
132 exit-action when viewing the buffer.
133
1342008-01-27 Dan Nicolaescu <dann@ics.uci.edu>
135
136 * add-log.el (change-log-search-file-name): Work harder to find
137 the correct file name.
138 (change-log-find-file): Fix typo.
139 (change-log-start-entry-re): Move definition earlier.
140
1412007-01-27 Jan Nieuwenhuizen <janneke@gnu.org>
142
143 * add-log.el (change-log-search-file-name, change-log-find-file):
144 New function.
145 (change-log-font-lock-keywords): Move file name matching ...
146 (change-log-file-names-re): ... here. New defconst.
147 (change-log-mode-map): New binding C-c C-f to change-log-find-file.
148
1492008-01-27 Alan Mackenzie <acm@muc.de>
150
151 * progmodes/cc-awk.el, progmodes/cc-engine.el: Correct typos,
152 enhance comments.
153
1542008-01-27 Michael Albinus <michael.albinus@gmx.de>
155
156 * net/tramp.el (tramp-compute-multi-hops): In case of su(do)?
157 methods, the host name must be a local host.
158
1592008-01-27 Dan Nicolaescu <dann@ics.uci.edu>
160
161 * vc.el: Add TODO item about not defaulting to RCS.
162
163 * server.el (server-process-filter): Check for non-nil before
164 calling file-directory-p.
165
1662008-01-27 Alan Mackenzie <acm@muc.de>
167
168 * progmodes/cc-vars.el (c-hanging-braces-alist): New element for
169 arglist-cont-nonempty.
170
171 * progmodes/cc-cmds.el (c-brace-newlines): Determine the newlines
172 for a brace with syntax arglist-cont-nonempty.
173
174 * progmodes/cc-styles.el (c-style-alist): Add elements for
175 arglist-cont-nonempty into 5 styles (gnu, ellemtel, linux, python,
176 awk).
177
1782008-01-27 Thien-Thi Nguyen <ttn@gnuvola.org>
179
180 * button.el (define-button-type): Clarify type of NAME in docstring.
181
1822008-01-26 Stefan Monnier <monnier@iro.umontreal.ca>
183
184 * server.el (server-buffer): New const.
185 (server-log): New var.
186 (server-log): Use them.
187 (server-process-filter): (Try to) run the continuation in the same cwd
188 as the client's.
189
1902008-01-26 Alan Mackenzie <acm@muc.de>
191
192 * progmodes/cc-defs.el (c-save-buffer-state):
193 Bind buffer-file-name and buffer-file-truename to nil, to prevent
194 primitives generating "buffer is read only" messages.
195
1962008-01-20 Ulf Jasper <ulf.jasper@web.de>
197
198 * icalendar.el (icalendar-version): Increase to "0.17".
199 (icalendar-import-format): Doc fix. Allow function type.
200 (icalendar--read-element): Doc fix.
201 (icalendar--parse-summary-and-rest): Doc fix. Handle function
202 type icalendar-import-format. Make regexps non-greedy.
203 (icalendar--format-ical-event): Handle function type
204 icalendar-import-format.
205 (icalendar-import-format-sample): New function.
206
2072008-01-26 Thien-Thi Nguyen <ttn@gnuvola.org>
208
209 * vc.el (vc-exec-after): For mode-line-process highlighting, if
210 `compile' is not available, fall back to font-lock-warning-face.
211
2122008-01-26 Phil Sung <psung@mit.edu> (tiny change)
213
214 * wdired.el (wdired-get-filename): Change `(1+ beg)' to `beg' so
215 that the filename end is found even when the filename is empty.
216 Fixes error and spurious newlines when marking files for deletion.
217
2182008-01-26 Martin Rudalics <rudalics@gmx.at>
219
220 * subr.el (find-tag-default): Simplify using exclusively
221 skip-syntax-backward/-forward.
222
2232008-01-26 Michael Albinus <michael.albinus@gmx.de>
224
225 * vc.el (vc-directory, vc-update-change-log): Remove check for
226 Tramp. Both functions work for it, though pretty slow
227 (`vc-directory'). Maybe the implementation can be optimized.
228
229 * net/tramp.el (tramp-dissect-file-name): Raise an error when
230 Tramp 2.0 syntax is used.
231 Suggested by Trent W. Buck <trentbuck@gmail.com>.
232
2332008-01-26 Eli Zaretskii <eliz@gnu.org>
234
235 * ls-lisp.el (ls-lisp-insert-directory): If -n switch is used,
236 invoke directory-files-and-attributes with last argument `integer'
237 instead of `string'.
238 (insert-directory): Add -n to the list of supported switches
239 mentioned in the doc string.
240
2412008-01-26 Vinicius Jose Latorre <viniciusjl@ig.com.br>
242
243 * blank-mode.el: New version 9.1. Handle "long" line tail
244 visualization. Doc fix.
245 (blank-line-length): Rename to blank-line-column.
246 (blank-chars-value-list, blank-toggle-option-alist, blank-help-text):
247 Initialization fix.
248 (blank-replace-spaces-by-tabs): New fun.
249 (blank-cleanup, blank-cleanup-region, blank-color-on): Code fix.
250
2512008-01-25 Richard Stallman <rms@gnu.org>
252
253 * subr.el (add-hook): Implement `permanent-local-hook' property.
254
255 * loadhist.el (file-provides, file-requires): Push the filename right.
256
2572008-01-25 Martin Rudalics <rudalics@gmx.at>
258
259 * emacs-lisp/find-func.el (find-library): Wrap search for
260 library name in condition-case to avoid reporting a scan-error.
261
2622008-01-25 Juanma Barranquero <lekktu@gmail.com>
263
264 * server.el (server-process-filter): Don't force
265 the authentication string to be followed by "\n".
266
2672008-01-25 Vinicius Jose Latorre <viniciusjl@ig.com.br>
268
269 * blank-mode.el: New version 9.0. New commands to clean up some blank
270 problems like trailing blanks. New faces and regexp for visualizing
271 the blank problems. Doc fix.
272 (blank-chars, blank-global-modes, blank-chars-value-list)
273 (blank-toggle-option-alist, blank-help-text): Initialization fix.
274 (blank-indentation, blank-empty, blank-space-after-tab): New faces.
275 (blank-indentation, blank-empty, blank-space-after-tab)
276 (blank-indentation-regexp, blank-empty-at-bob-regexp)
277 (blank-empty-at-eob-regexp, blank-space-after-tab-regexp): New options.
278 (blank-cleanup, blank-cleanup-region): New commands.
279 (blank-color-on): Code fix.
280
2812008-01-25 Dan Nicolaescu <dann@ics.uci.edu>
282
283 * ibuffer.el (ibuffer-default-sorting-mode): Add option to sort by
284 file name.
285 (ibuffer-mode-map): Add binding to sort by file name.
286 (ibuffer-filename/process-header-map): New variable.
287 (filename-and-process): Add a header that sorts by file name.
288 (ibuffer-mode): Mention sorting by file name.
289
290 * ibuf-ext.el (filename/process): New sorter.
291
2922008-01-25 Sven Joachim <svenjoac@gmx.de>
293
294 * view.el (kill-buffer-if-not-modified): Don't pass t to
295 buffer-modified-p.
296
2972008-01-24 Michael Albinus <michael.albinus@gmx.de>
298
299 * net/tramp.el (tramp-do-copy-or-rename-file): Flush the cache of
300 the source file in case of `rename'.
301 Reported by Pete Forman <pete.forman@westerngeco.com>.
302
3032008-01-24 Ken Manheimer <ken.manheimer@gmail.com>
304
305 * allout.el (allout-keybindings-list): In initial setting, express
306 meta-prefixed allout keys as vectors instead of strings, since the
307 string form is interpreted in some cases as composed key
308 modifiers, eg, accented keys.
309
310 (allout-line-boundary-regexp): Clarify description.
311
312 (set-allout-regexp): Repair the expressions so that the formfeed
313 part is identified as one of the top-level groups, and is
314 included in all the forms, not just the -line-boundary-regexp one.
315
316 (allout-prefix-data): Incorporate information from the various
317 allout regexp's formfeed alternative group, when present.
318
319 (allout-write-file-hook-handler): Rectify mangling of the error
320 handling. It was broken in 2007-12-06T19:56:41Z!deego@gnufans.org, where an `error'
321 condition-case handler was apparently reformatted as if it was a
322 call to the error function. An apparent repair attempt in version
323 1.101 situated the original body of the error handling code as
324 bogus condition-case handlers. I've returned to just about the
325 working code that was originally there, removing an unnecessary -
326 but benign - enclosing 'progn'. \(Automated or cursory code fixes
327 often aren't.)
328
329 (allout-region-active-p): Fallback to value of mark-active if
330 neither use-region-p nor region-active-p are present, for
331 compatability with current and recent emacs major releases.
332
3332008-01-24 Dan Nicolaescu <dann@ics.uci.edu>
334
335 * textmodes/reftex-toc.el (reftex-toc-next, reftex-toc-previous)
336 (reftex-toc-restore-region):
337 * textmodes/reftex-index.el (reftex-index-initialize-phrases-buffer)
338 (reftex-index-phrases-apply-to-region):
339 * textmodes/ispell.el (ispell-word):
340 * progmodes/vhdl-mode.el (vhdl-keep-region-active):
341 * progmodes/pascal.el (pascal-mark-defun):
342 * progmodes/f90.el (f90-mark-subprogram, f90-indent-region)
343 (f90-fill-region):
344 * emulation/tpu-edt.el (tpu-set-mark):
345 * emulation/crisp.el (crisp-region-active):
346 * winner.el (winner-active-region):
347 * ansi-color.el (ansi-color-set-extent-face): Use featurep instead
348 of bound tests in order to resolve conditionals at compile time.
349
3502008-01-24 Juanma Barranquero <lekktu@gmail.com>
351
352 * delsel.el (delsel-unload-function): Don't use `remprop'; it is
353 not autoloaded, and we wouldn't want to load CL just to unload
354 delsel.el anyway. Suggested by Martin Rudalics <rudalics@gmx.at>.
355
3562008-01-24 Martin Rudalics <rudalics@gmx.at>
357
358 * delsel.el (delete-selection-pre-hook): Avoid clearing out
359 pre-command-hook when text is read-only.
360
3612008-01-24 Thien-Thi Nguyen <ttn@gnuvola.org>
362
363 * vc.el (vc-process-filter): Do nothing if buffer not live.
364 (vc-diff-finish): Rename from vc-diff-sentinel.
365 No longer take REV1-NAME and REV2-NAME.
366 Instead, take BUFFER-NAME. Do nothing if buffer not live.
367 Don't do window resize if no window displays buffer.
368 (vc-diff-internal): Use vc-diff-finish.
369
370 * vc.el (vc-next-action): Fix two instances of "free-var file" bug:
371 In both cases, convert single call to one wrapped in dolist.
372
3732008-01-24 Dan Nicolaescu <dann@ics.uci.edu>
374
375 * vc.el: Add a TODO item about missing files.
376 (vc-exec-after): Add a tooltip to the new mode-line item.
377
3782008-01-24 Glenn Morris <rgm@gnu.org>
379
380 * t-mouse.el (gpm-mouse-start): Declare as a function.
381
3822008-01-23 Michael Albinus <michael.albinus@gmx.de>
383
384 * net/tramp.el (tramp-remote-process-environment): Set "LC_ALL=C".
385 (tramp-end-of-output): Add `tramp-rsh-end-of-line' into the regexp.
386 (tramp-find-shell, tramp-open-connection-setup-interactive-shell):
387 Don't send `tramp-rsh-end-of-line' additionally, when setting the
388 prompt.
389 (tramp-wait-for-output): Distinguish different prompt formats.
390 (tramp-get-test-nt-command): Don't check for "\n" in the prompt.
391 (tramp-local-host-p): Check whether temp directory is writable.
392
3932008-01-23 Dan Nicolaescu <dann@ics.uci.edu>
394
395 * vc.el: Add TODO items.
396
3972008-01-23 Carsten Dominik <dominik@science.uva.nl>
398
399 * replace.el (occur-mode-find-occurrence-hook): New hook that can
400 be used to reveal or highlight the location of a match.
401 (occur-mode-goto-occurrence, occur-mode-goto-occurrence-other-window)
402 (occur-mode-display-occurrence): Run `occur-mode-find-occurrence-hook'.
403
4042008-01-23 Martin Rudalics <rudalics@gmx.at>
405
406 * progmodes/hideif.el (hide-ifdef-shadow): Add version number
407 for defcustom.
408 (hide-ifdef-shadow): Add version number for defface.
409
4102008-01-23 Glenn Morris <rgm@gnu.org>
411
412 * textmodes/org.el (org-export-latex-cleaned-string): Fix declaration.
413
4142008-01-23 Dan Nicolaescu <dann@ics.uci.edu>
415
416 * progmodes/sh-script.el (sh-basic-offset):
417 * progmodes/cc-vars.el (c-syntactic-indentation)
418 (c-syntactic-indentation-in-macros): Mark as safe.
419
4202008-01-23 Richard Stallman <rms@gnu.org>
421
422 * icomplete.el (icomplete-get-keys):
423 Look up KEYS using all maps in proper buffer.
424
4252008-01-23 Juanma Barranquero <lekktu@gmail.com>
426
427 * frame.el (display-mm-height, display-mm-width):
428 * whitespace.el (whitespace-check-leading-whitespace)
429 (whitespace-check-trailing-whitespace)
430 (whitespace-check-spacetab-whitespace)
431 (whitespace-check-indent-whitespace)
432 (whitespace-check-ateol-whitespace):
433 * progmodes/ada-xref.el (ada-convert-file-name): Fix typo in docstring.
434
4352008-01-23 Dan Nicolaescu <dann@ics.uci.edu>
436
437 * vc-arch.el (vc-arch-delete-rej-if-obsolete): Remove the
438 after-save-hook so that it is not called multiple times.
439
440 * vc-svn.el (vc-svn-resolve-when-done): Likewise.
441
4422008-01-23 Eli Zaretskii <eliz@gnu.org>
443
444 * view.el (view-file-other-window, view-file-other-frame):
445 Don't kill the buffer if it is modified. Doc fixes.
446 (kill-buffer-if-not-modified): New function.
447 (view-file): Don't kill the buffer if it is modified.
448
449 * progmodes/ebrowse.el (ebrowse-view-file-other-window): Delete.
450 (ebrowse-view/find-file-and-search-pattern):
451 Call view-file-other-window instead of ebrowse-view-file-other-window.
452 (ebrowse-view-file-other-frame): Don't call
453 current-window-configuration. Fix second argument in the call to
454 view-mode-enter. Doc fix.
455
4562008-01-23 Richard Stallman <rms@gnu.org>
457
458 * subr.el (atomic-change-group): Prevent undo list truncation.
459
4602008-01-23 Dan Nicolaescu <dann@ics.uci.edu>
461
462 * files.el (safe-local-eval-forms):
463 Mark (add-hook 'write-file-hooks 'time-stamp) as safe.
464
4652008-01-23 Nick Roberts <nickrob@snap.net.nz>
466
467 * comint.el (comint-insert-input): Set point first.
468
469 * progmodes/gdb-ui.el (gdb-dequeue-input): Make doubly sure
470 session doesn't hang because gdb-pending-triggers is non-nil.
471 (gdb-frame-handler): Use buffer-file-name instead of
472 buffer-name in case of duplicate file names.
473
4742008-01-23 Dan Nicolaescu <dann@ics.uci.edu>
475
476 * progmodes/verilog-mode.el (verilog-mode-map): Don't bind C-M-a,
477 C-M-e and C-M-h for emacs, they work by default.
478 (verilog-emacs-features): Remove.
479 (verilog-setup-dual-comments, verilog-populate-syntax-table):
480 Remove. Move syntax table initialization ...
481 (verilog-mode-syntax-table): ... here.
482 (verilog-mode): Don't initialize the syntax table here.
483 (verilog-mark-defun): Only do something useful for XEmacs, Emacs
484 does not need it.
485
4862008-01-23 Wilson Snyder <wsnyder@wsnyder.org>
487
488 * progmodes/verilog-mode.el (verilog-booleanp): New function for
489 backward compatibility. Replace all uses of booleanp with
490 verilog-booleanp.
491
4922008-01-23 Dan Nicolaescu <dann@ics.uci.edu>
493
494 * vc-hg.el (vc-hg-diff): Don't pass an empty string.
495
4962008-01-23 Wilson Snyder <wsnyder@wsnyder.org>
497
498 * progmodes/verilog-mode.el (top-level): Fix spacing.
499 (verilog-mode-version, verilog-mode-release-date):
500 Update version number.
501 (verilog-mode-release-emacs): New variable.
502 (compile-command, reporter-prompt-for-summary-p):
503 Define for byte compiler.
504 (verilog-startup-message-lines, verilog-startup-message-displayed)
505 (verilog-display-startup-message): Remove.
506 (verilog-highlight-p1800-keywords): Improve docstring.
507 (sigs-in, sigs-out, got-sig, got-rvalue, uses-delayed)
508 (vector-skip-list): Only defvar at compile time.
509 (verilog-highlight-translate-off, verilog-indent-level)
510 (verilog-indent-level-module, verilog-indent-level-declaration)
511 (verilog-indent-declaration-macros, verilog-indent-lists)
512 (verilog-indent-level-behavioral, verilog-indent-level-directive)
513 (verilog-cexp-indent, verilog-case-indent, verilog-auto-newline)
514 (verilog-auto-indent-on-newline, verilog-tab-always-indent)
515 (verilog-tab-to-comment, verilog-indent-begin-after-if)
516 (verilog-align-ifelse, verilog-minimum-comment-distance)
517 (verilog-auto-lineup, verilog-highlight-p1800-keywords)
518 (verilog-auto-endcomments, verilog-auto-read-includes)
519 (verilog-auto-star-expand, verilog-auto-star-save)
520 (verilog-library-flags, verilog-library-directories)
521 (verilog-library-files, verilog-library-extensions)
522 (verilog-active-low-regexp, verilog-auto-sense-include-inputs)
523 (verilog-auto-sense-defines-constant, verilog-auto-reset-widths)
524 (verilog-assignment-delay, verilog-auto-inst-vector)
525 (verilog-auto-inst-template-numbers, verilog-auto-input-ignore-regexp)
526 (verilog-auto-inout-ignore-regexp, verilog-auto-output-ignore-regexp)
527 (verilog-auto-unused-ignore-regexp, verilog-typedef-regexp):
528 Add safe-local-variable properties.
529 (verilog-statement-menu, verilog-company, verilog-re-search-forward)
530 (verilog-re-search-backward, verilog-error-regexp-add)
531 (verilog-end-block-re, verilog-emacs-features)
532 (verilog-populate-syntax-table, verilog-setup-dual-comments)
533 (verilog-type-font-keywords, verilog-inside-comment-p)
534 (electric-verilog-backward-sexp, verilog-backward-sexp)
535 (verilog-forward-sexp, verilog-font-lock-init, verilog-mode)
536 (electric-verilog-terminate-line, electric-verilog-semi)
537 (electric-verilog-tab, verilog-insert-1, verilog-insert-indices)
538 (verilog-generate-numbers, verilog-comment-region, verilog-label-be)
539 (verilog-beg-of-statement, verilog-in-case-region-p)
540 (verilog-in-struct-region-p, verilog-in-generate-region-p)
541 (verilog-in-fork-region-p, verilog-backward-case-item)
542 (verilog-set-auto-endcomments, verilog-get-expr)
543 (verilog-expand-vector-internal, verilog-surelint-off)
544 (verilog-batch-execute-func, verilog-calculate-indent)
545 (verilog-calc-1, verilog-calculate-indent-directive)
546 (verilog-leap-to-head, verilog-continued-line)
547 (verilog-backward-token, verilog-backward-syntactic-ws)
548 (verilog-forward-syntactic-ws, verilog-backward-ws&directives)
549 (verilog-forward-ws&directives, verilog-at-constraint-p)
550 (verilog-skip-backward-comments, verilog-indent-line-relative)
551 (verilog-do-indent, verilog-indent-comment, verilog-more-comment)
552 (verilog-pretty-declarations, verilog-pretty-expr)
553 (verilog-just-one-space, verilog-indent-declaration)
554 (verilog-get-completion-decl, verilog-goto-defun, verilog-showscopes)
555 (verilog-header, verilog-signals-combine-bus, verilog-read-decls)
556 (verilog-read-always-signals-recurse, verilog-read-instants)
557 (verilog-read-auto-template, verilog-set-define)
558 (verilog-read-defines, verilog-read-signals, verilog-getopt)
559 (verilog-is-number, verilog-expand-dirnames, verilog-modi-lookup)
560 (verilog-modi-cache-results, verilog-insert-one-definition)
561 (verilog-make-width-expression, verilog-delete-autos-lined)
562 (verilog-auto-save-check, verilog-auto-arg, verilog-auto-inst-port)
563 (verilog-auto-inst, verilog-auto-inst-param, verilog-auto-reg)
564 (verilog-auto-reg-input, verilog-auto-wire, verilog-auto-output)
565 (verilog-auto-output-every, verilog-auto-input, verilog-auto-inout)
566 (verilog-auto-inout-module, verilog-auto-sense, verilog-auto-reset)
567 (verilog-auto-tieoff, verilog-auto-unused, verilog-auto-ascii-enum)
568 (verilog-auto, verilog-sk-define-signal, verilog-mode-mouse-map)
569 (verilog-load-file-at-mouse, verilog-load-file-at-point)
570 (verilog-library-files): Cleanup spacing of )'s they should not be
571 on unique lines. Fix checkdoc warnings.
572
5732008-01-22 Glenn Morris <rgm@gnu.org>
574
575 * progmodes/hideif.el (hide-ifdef-initially, hide-ifdef-read-only)
576 (hide-ifdef-lines, hide-ifdef-shadow): Remove autoload cookies
577 from defcustoms.
578 (hide-ifdef-shadow): Remove autoload cookie from defface.
579
580 * vc.el (vc-diff-sentinel): Do not write a footer if there were
581 differences.
582
5832008-01-21 Reiner Steib <Reiner.Steib@gmx.de>
584
585 * pcvs-defs.el (cvs-menu): Improve cvs-mode-find-file,
586 cvs-mode-find-file-other-window. Add cvs-mode-diff-yesterday and
587 manual entry.
588
5892008-01-21 Michael Albinus <michael.albinus@gmx.de>
590
591 * net/dbus.el (dbus-ignore-errors): New macro.
592 (dbus-unregister-object): New defun. Moved from dbusbind.c.
593 (dbus-handle-event, dbus-list-activatable-names, dbus-list-names)
594 (dbus-list-queued-owners, dbus-get-name-owner, dbus-introspect)
595 (dbus-get-signatures): Apply `dbus-ignore-errors'.
596
5972008-01-21 Martin Rudalics <rudalics@gmx.at>
598
599 * outline.el (outline-up-heading): Fix check for top level to
600 avoid infinite looping in hide-other.
601
6022008-01-21 Thien-Thi Nguyen <ttn@gnuvola.org>
603
604 * vc.el (vc-process-sentinel): After calling the previous
605 sentinel, do nothing if the process' buffer is not live.
606
6072008-01-21 Vinicius Jose Latorre <viniciusjl@ig.com.br>
608
609 * blank-mode.el: Fix a problem of cleaning blank faces when turning off
610 blank-mode in some buffers (like *info* buffers). Reported by Juanma
611 Barranquero <lekktu@gmail.com>. Eliminate `-face' suffix of all
612 blank-mode faces. Doc fix. New version 8.1.
613 (blank-turn-on, blank-turn-off): Replace (and CONDITION BODY) by (when
614 CONDITION BODY).
615 (blank-space-face): Face/option name replaced by blank-space.
616 (blank-hspace-face): Face/option name replaced by blank-hspace.
617 (blank-tab-face): Face/option name replaced by blank-tab.
618 (blank-newline-face): Face/option name replaced by blank-newline.
619 (blank-trailing-face): Face/option name replaced by blank-trailing.
620 (blank-line-face): Face/option name replaced by blank-line.
621 (blank-space-before-tab-face): Face/option name replaced by
622 blank-space-before-tab.
623 (blank-color-on, blank-color-off, blank-display-char-on): Fix code.
624
6252008-01-21 Juanma Barranquero <lekktu@gmail.com>
626
627 * blank-mode.el (blank-style, blank-chars, blank-hspace-regexp)
628 (blank-space-regexp, blank-tab-regexp, blank-trailing-regexp)
629 (blank-space-before-tab-regexp, blank-global-modes, blank-mode)
630 (global-blank-mode): Doc fixes.
631 (blank, blank-space-face, blank-hspace-face, blank-tab-face)
632 (blank-newline-face, blank-trailing-face, blank-line-face)
633 (blank-space-before-tab-face, blank-display-mappings)
634 (blank-chars-value-list, blank-style-value-list, blank-toggle-options)
635 (global-blank-toggle-options, blank-help-text, blank-interactive-char)
636 (blank-turn-on, blank-turn-off, blank-color-on, blank-color-off):
637 Fix typos in docstrings.
638
6392008-01-21 Juanma Barranquero <lekktu@gmail.com>
640
641 * server.el (server-log-time-function): New variable.
642 (server-log): Use it.
643
6442008-01-21 Glenn Morris <rgm@gnu.org>
645
646 * progmodes/hideif.el: Move defcustoms and defface to start of file.
647
648 * textmodes/org.el (org-entry-properties): Let-bind `clocksum'.
649
6502008-01-21 Juanma Barranquero <lekktu@gmail.com>
651
652 * textmodes/org.el (org-unmodified, org-cycle-emulate-tab)
653 (org-descriptive-links, org-link-file-path-type)
654 (org-remember-use-refile-when-interactive)
655 (org-agenda-skip-timestamp-if-done, org-agenda-scheduled-leaders)
656 (org-export-ascii-bullets, org-agenda-deadline-faces)
657 (turn-on-orgstruct++, orgtbl-to-texinfo, org-mhe-get-header)
658 (org-batch-agenda, org-batch-agenda-csv, org-fix-agenda-info)
659 (org-kill-note-or-show-branches): Fix typos in docstrings.
660
6612008-01-20 Thien-Thi Nguyen <ttn@gnuvola.org>
662
663 * vc.el (vc-process-sentinel): Set mode-line-process.
664 (vc-exec-after): Likewise, for the `run' process status.
665
6662008-01-20 Stefan Monnier <monnier@iro.umontreal.ca>
667
668 * ibuffer.el (ibuffer-mode): Fix last change.
669
6702008-01-20 Dan Nicolaescu <dann@ics.uci.edu>
671
672 * vc-hg.el (vc-hg-registered):
673 * vc-svn.el (vc-svn-registered): Make it work for non-existent files.
674
6752008-01-20 Martin Rudalics <rudalics@gmx.at>
676
677 * repeat.el (repeat-undo-count): New variable.
678 (repeat): For self-insertions make undo boundary only after 20
679 repetitions. Inhibit point recording unless repeat-repeat-char is nil.
680
6812008-01-19 Reiner Steib <Reiner.Steib@gmx.de>
682
683 * net/imap.el (imap-ping-server): New variable.
684 (imap-opened): On add extra ping if imap-ping-server is non-nil.
685 (imap-ping-server): Minor doc string fixes.
686
6872008-01-19 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change)
688
689 * net/imap.el (imap-ping-server): New function.
690 (imap-opened): Call imap-ping-server.
691
6922008-01-20 Glenn Morris <rgm@gnu.org>
693
694 * progmodes/python.el: Quote all calls to "auxiliary skeleton"s to
695 prevent infloops.
696
6972008-01-20 Martin Svenson <phromo@gmail.com> (tiny change)
698
699 * progmodes/python.el (python-imports): Default to "None".
700
7012008-01-19 Tom Tromey <tromey@redhat.com>
702
703 * vc-svn.el (vc-svn-after-dir-status): New function.
704 (vc-svn-dir-status): Run svn asynchronously.
705
7062008-01-19 Martin Rudalics <rudalics@gmx.at>
707
708 * progmodes/hideif.el (hide-ifdef-shadow): New option.
709 (hide-ifdef-shadow): New face.
710 (hide-ifdef-toggle-shadowing): New function to toggle between
711 shadowing and making code invisible.
712 (hide-ifdef-mode-submap): Add binding for hide-ifdef-toggle-shadowing.
713 (hide-ifdef-mode-menu): Add entry for hide-ifdef-toggle-shadowing.
714 (hide-ifdef-region-internal): Give new overlay hide-ifdef
715 property. Shadow text when hide-ifdef-shadow is non-nil.
716 (hif-show-ifdef-region): Remove overlays with hide-ifdef property set.
717 (hif-hide-line): Use when instead of if.
718 (hide-ifdef-initially, hide-ifdef-read-only, hide-ifdef-lines):
719 Remove unneeded * from doc-strings.
720
7212008-01-19 Stefan Monnier <monnier@iro.umontreal.ca>
722
723 * doc-view.el (doc-view-goto-page): Don't move point any more, now that
724 the hscroll behavior was fixed.
725 (doc-view-mode): Disable auto-hscroll-mode.
726
7272008-01-18 Tom Tromey <tromey@redhat.com>
728
729 * vc-svn.el (vc-svn-dir-status): New function.
730
7312008-01-18 Dan Nicolaescu <dann@ics.uci.edu>
732
733 * vc.el: Make vc-status asynchronous.
734 (vc-update-vc-status-buffer): New function broken out of ...
735 (vc-status-refresh): ... here. Pass vc-update-vc-status-buffer to
736 the dir-status backend function.
737
738 * vc-hg.el (vc-hg-dir-status): Compute the status asynchronously.
739 Move the output processing to ...
740 (vc-hg-after-dir-status): ... here. Call the function passed as
741 an argument with the results.
742
7432008-01-18 Stefan Monnier <monnier@iro.umontreal.ca>
744
745 * doc-view.el (doc-view-pdf/ps->png): Make sure we a have a valid cwd.
746 (doc-view-insert-image): Do something if the image is missing.
747 (doc-view-mode): Don't use file-remote-p.
748
7492008-01-18 Bastien Guerry <Bastien.Guerry@ens.fr>
750
751 * textmodes/org-export-latex.el (org-export-latex-cleaned-string): Fix.
752 (org-export-latex-special-chars): Convert "..." in \ldots
753 and skip tables.
754 (org-export-latex-fontify-headline): Change parameter name.
755 (org-export-as-latex): Handle export of subtrees.
756 (org-export-latex-make-header): New argument TITLE.
757 (org-export-latex-content): New argument EXCLUDE-LIST.
758 (org-list-parse-list): New name for org-export-latex-parse-list.
759 (org-export-latex-make-header): New name for
760 org-export-latex-make-preamble.
761 (org-list-to-generic): New name of org-export-list-to-generic.
762 (org-list-to-latex): New name of org-export-list-to-latex.
763 (org-list-item-begin, org-list-end, org-list-insert-radio-list)
764 (org-list-send-list, org-list-to-texinfo)
765 (org-list-to-html): New functions.
766 (org-export-latex-tables-column-borders)
767 (org-export-latex-default-class, org-export-latex-classes)
768 (org-export-latex-classes-sectioning)
769 (org-list-radio-list-templates): New options.
770 (org-export-latex-header): New variable.
771 (org-latex-entities): New constant.
772 (org-export-latex-default-sectioning, org-export-latex-preamble)
773 (org-export-latex-prepare-text-option)
774 (org-export-latex-get-sectioning): Remove.
775
7762008-01-18 Carsten Dominik <dominik@science.uva.nl>
777
778 * textmodes/org-publish.el (org-publish-current-project):
779 Fix bug with forcing publication.
780
781 * textmodes/org.el (org-export-with-special-strings): New option.
782 (org-export-html-convert-special-strings): New function.
783 (org-html-do-expand): `org-export-html-convert-special-strings'
784 added to the list of conversion.
785 (org-infile-export-plist, org-get-current-options): Add support
786 for "-" in the #+OPTION line to let user switch on/off special
787 strings conversion.
788 (org-export-plist-vars): New :html-table-tag property.
789 (org-export-as-html, org-format-org-table-html)
790 (org-format-table-table-html) Use the :html-table-tag property
791 instead of the `org-export-html-table-tag' global value.
792 (org-additional-option-like-keywords): Add "TBLFM".
793 (org-entry-properties): Include the CLOCKSUM special property.
794 (org-columns-edit-value): Do not allow to edit the special
795 CLOCKSUM property.
796 (org-flag-drawer): Use the original value of `outline-regexp'.
797 (org-remember-handler): Add invisible-ok flag to call to
798 `org-end-of-subtree'.
799 (org-agenda-highlight-todo): Respect
800 `org-agenda-todo-keyword-format'.
801 (org-agenda-todo-keyword-format): New option.
802 (org-infile-export-plist): No restriction while searching for options.
803 (org-remember-handler): Remove comments at the end of the buffer.
804 (org-remember-use-refile-when-interactive): New option.
805 (org-table-sort-lines): Make sure sorting works on link
806 descritions only, and ignores the link.
807 (org-sort-entries-or-items): Make sure the end of the subtree is
808 included.
809 (org-refile-use-outline-path): New allowed values `file' and
810 `full-file-path'.
811 (org-get-refile-targets): Respect new values for
812 `org-refile-use-outline-path'.
813 (org-agenda-get-restriction-and-command): DEL goes back to initial list.
814 (org-export-as-xoxo): Restore point when done.
815 (org-open-file): Allow multiple %s in command.
816 (org-clock-in-switch-to-state): New option.
817 (org-first-list-item-p): New function.
818 (org-last-remember-storage-locations): New variable.
819 (org-get-refile-targets): Interpret the new maxlevel setting.
820 (org-refile-targets): New option `:maxlevel'.
821 (org-copy-subtree): Include empty lines before but not after subtree.
822 (org-back-over-empty-lines, org-skip-whitespace): New functions.
823 (org-move-item-down, org-move-item-up): Include empty lines before
824 but not after item.
825 (org-first-sibling-p): New function.
826 (org-remember-apply-template): Defaults, completions and history
827 for template prompts. Also, interpret new `%!' escape.
828 (org-context-choices): New constant.
829 (org-bound-and-true-p): New macro.
830 (org-imenu-depth): New option.
831 (org-imenu-markers): New variable.
832 (org-imenu-new-marker, org-imenu-get-tree)
833 (org-speedbar-set-agenda-restriction): New functions.
834 (org-agenda-set-restriction-lock)
835 (org-agenda-remove-restriction-lock)
836 (org-agenda-maybe-redo): New functions.
837 (org-agenda-restriction-lock): New face.
838 (org-agenda-restriction-lock-overlay)
839 (org-speedbar-restriction-lock-overlay): New variables.
840 (org-open-at-point): Remove obsolete way to do redirection in
841 shell links.
842 (org-imenu-and-speedbar): New customization group.
843 (org-entry-properties): Return keyword-less time strings.
844 (org-clock-heading-function): New option.
845 (org-clock-in): Use `org-clock-heading-function'.
846 (org-calendar-holiday): Try to use `calendar-check-holidays'
847 instead of the obsolete `check-calendar-holidays'.
848 (org-export-html-special-string-regexps): New constant.
849 (org-massive-special-regexp): New variable.
850 (org-compute-latex-and-specials-regexp)
851 (org-do-latex-and-special-faces): New functions.
852 (org-latex-and-export-specials): New face.
853 (org-highlight-latex-fragments-and-specials): New option.
854 (org-link-escape-chars): Use characters instead of strings.
855 (org-link-escape-chars-browser, org-link-escape)
856 (org-link-unescape): Use characters instead of strings.
857 (org-export-html-convert-sub-super, org-html-do-expand): Check for
858 protected text.
859 (org-emphasis-alist): Additional `verbatim' flag.
860 (org-set-emph-re): Handle the verbatim flag and compute
861 `org-verbatim-re'.
862 (org-cleaned-string-for-export): Protect verbatim elements.
863 (org-verbatim-re): New variable.
864 (org-hide-emphasis-markers): New option.
865 (org-additional-option-like-keywords): Add new keywords.
866 (org-get-entry): Rename from `org-get-cleaned-entry'.
867 (org-icalendar-cleanup-string): New function for quoting icalendar text.
868 (org-agenda-skip-scheduled-if-done): New option.
869 (org-agenda-get-scheduled, org-agenda-get-blocks): Use
870 `org-agenda-skip-scheduled-if-done'.
871 (org-prepare-agenda-buffers): Allow buffers as arguments.
872 (org-entry-properties): Add CATEGORY as a special property.
873 (org-use-property-inheritance): Allow a list of properties as a value.
874 (org-eval-in-calendar): No longer update the prompt.
875 (org-read-date-popup-calendar): Rename from
876 `org-popup-calendar-for-date-prompt'.
877 (org-read-date-display-live): New variable.
878 (org-read-date-display): New function.
879 (org-read-date-analyze): New function.
880 (org-remember-apply-template): Define `remember-finalize' if it is
881 not yet defined.
882 (org-remember-insinuate): New function.
883 (org-read-date-prefer-future): New option.
884 (org-read-date): Respect the setting of
885 `org-read-date-prefer-future'. Use `org-read-date-analyze'.
886 (org-set-font-lock-defaults): Use `org-archive-tag' instead of a
887 hardcoded string.
888 (org-remember-apply-template): Use `remember-finalize' instead of
889 `remember-buffer'.
890 (org-columns-compute, org-column-number-to-string)
891 (org-columns-uncompile-format, org-columns-compile-format)
892 (org-columns-compile-format): Handle printf format specifier.
893 (org-columns-new, org-column-number-to-string)
894 (org-columns-uncompile-format, org-columns-compile-format):
895 Support for new currency summary type.
896 (org-tree-to-indirect-buffer): Do not kill old buffer when
897 `org-indirect-buffer-display' is `new-frame'.
898 (org-indirect-buffer-display): Document that `new-frame' leads to
899 indiret buffer proliferation.
900 (org-agenda-list): Use `org-extend-today-until'.
901 (org-extend-today-until): New option.
902 (org-format-org-table-html): Use lower-case for <col> tag.
903 (org-agenda-execute): New command.
904 (org-agenda-mode-map): Keybindings of "g" "G", "e" modified.
905 (org-select-remember-template): New function.
906 (org-remember-apply-template): Use `org-select-remember-template'.
907 (org-go-to-remember-target): New function.
908
9092008-01-18 Dan Nicolaescu <dann@ics.uci.edu>
910
911 * vc.el: Add a TODO note about vc-state.
912 (vc-next-action): Register 'unregistered and 'ignored files.
913 Use when and unless instead of if where appropriate.
914 (vc-start-entry): Fix typo.
915 (vc-status): Autoload it.
916
9172008-01-18 Glenn Morris <rgm@gnu.org>
918
919 * ffap.el (ffap-alist): Remove space from RFC regexp.
920
9212008-01-18 Richard Stallman <rms@gnu.org>
922
923 * custom.el (custom-theme-recalc-face): Use face-spec-set rather
924 than face-spec-recalc.
925
9262008-01-18 Glenn Morris <rgm@gnu.org>
927
928 * ibuffer.el (ibuffer-mode): Fix typo in previous change.
929
9302008-01-17 Vinicius Jose Latorre <viniciusjl@ig.com.br>
931 Miles Bader <miles@gnu.org>
932
933 * blank-mode.el: New file. Minor mode to visualise (HARD) SPACE,
934 TAB, NEWLINE. Miles Bader <miles@gnu.org> wrote the original code
935 for handling display table (via visws.el package), his code was
936 modified, but the main idea was kept.
937
9382008-01-17 Glenn Morris <rgm@gnu.org>
939
940 * ibuf-ext.el (ibuffer-auto-mode, ibuffer-save-filter-groups)
941 (ibuffer-save-filters): Remove calls to deleted
942 ibuffer-update-mode-name.
943
9442008-01-16 Martin Rudalics <rudalics@gmx.at>
945
946 * longlines.el (longlines-mode, longlines-show-region)
947 (longlines-unshow-hard-newlines): Bind buffer-file-name and
948 buffer-file-truename to nil while modifying buffer.
949
950 * cus-edit.el (custom-reset-standard-variables-list)
951 (custom-reset-standard-faces-list): New variables.
952 (custom-reset-standard-save-and-update): New function.
953 (Custom-save): Apply custom-mark-to-save before and
954 custom-state-set-and-redraw after saving options.
955 (Custom-reset-standard): Apply custom-mark-to-reset-standard to
956 options and call custom-reset-standard-save-and-update.
957 (custom-variable, custom-face, custom-group): Provide new
958 entries for custom-mark-to-save, custom-mark-to-reset-standard,
959 and custom-state-set-and-redraw.
960 (custom-variable-mark-to-save)
961 (custom-variable-state-set-and-redraw)
962 (custom-variable-mark-to-reset-standard)
963 (custom-face-mark-to-save, custom-face-state-set-and-redraw)
964 (custom-face-mark-to-reset-standard)
965 (custom-group-mark-to-save, custom-group-state-set-and-redraw)
966 (custom-group-mark-to-reset-standard): New functions.
967 (custom-variable-save): Move save, state-set, and redraw
968 functionality to custom-variable-mark-to-save.
969 (custom-face-save): Move save, state-set, and redraw
970 functionality to custom-face-mark-to-save.
971 (custom-group-save): Move save, state-set, and redraw
972 functionality to custom-group-mark-to-save.
973 (custom-variable-reset-standard, custom-face-reset-standard)
974 (custom-group-reset-standard): Move save, state-set, and redraw
975 functionality to custom-reset-standard-save-and-update.
976
977 (custom-buffer-create-internal): Fix text in verbose help.
978 (custom-face-value-create): Indent doc-strings of faces like
979 those of variables.
980
9812008-01-16 Stefan Monnier <monnier@iro.umontreal.ca>
982
983 * server.el (server-process-filter): Replace lineno and columnnno
984 which defaulted to 1&0 with filepos which defaults to nil.
985 (server-goto-line-column): Only receive the filepos.
986 Only move if filepos is non-nil.
987 (server-visit-files): Slight restructure to consolidate two calls to
988 server-goto-line-column into just one.
989
990 * nxml/nxml-mode.el (nxml-mode): Use mode-line-process to indicate
991 the use of degraded mode.
992 (nxml-degrade): Don't change mode-name.
993
994 * nxml/rng-nxml.el (rng-nxml-mode-init):
995 Don't overwrite mode-line-process.
996
997 * ibuffer.el (mode): Pass the buffer to format-mode-line.
998 (ibuffer-update-mode-name): Remove.
999 (ibuffer-redisplay, ibuffer-update, ibuffer-mode): Don't call it.
1000 (ibuffer-mode): Use mode-line-process instead.
1001
1002 * ibuf-ext.el (ibuffer-auto-update-changed, ibuffer-auto-mode):
1003 Use derived-mode-p.
1004 (ibuffer-mark-by-mode-regexp): Pass the buffer to format-mode-line.
1005
1006 * help.el (describe-mode): Pass the right buffer to format-mode-line.
1007
10082008-01-16 Glenn Morris <rgm@gnu.org>
1009
1010 * comint.el (comint-regexp-arg): Fix no-input case.
1011
10122008-01-16 Dan Nicolaescu <dann@ics.uci.edu>
1013
1014 * smerge-mode.el (smerge-start-session): Rename from smerge-auto.
1015 * pcvs.el (cvs-revert-if-needed):
1016 * vc.el (vc-maybe-resolve-conflicts): Rename callers.
1017
1018 * vc-svn.el (vc-svn-find-file-hook):
1019 * vc-arch.el (vc-arch-find-file-hook): Undo previous change.
1020
10212008-01-16 Ulf Jasper <ulf.jasper@web.de>
1022
1023 * calendar/icalendar.el (icalendar-version): Increase to 0.16.
1024 (icalendar-export-file, icalendar-import-file):
1025 Restore significant trailing whitespace in `interactive' prompts.
1026
10272008-01-16 Tom Tromey <tromey@redhat.com>
1028
1029 * calendar/icalendar.el (icalendar--convert-tz-offset)
1030 (icalendar--parse-vtimezone, icalendar--convert-all-timezones)
1031 (icalendar--find-time-zone): New functions.
1032 (icalendar--decode-isodatetime): Add `zone' argument, passed to
1033 `decode-time'. Doc fix.
1034 (icalendar--convert-ical-to-diary): Compute zone-map.
1035 Pass timezone to icalendar--decode-isodatetime.
1036
10372008-01-16 Alan Mackenzie <acm@muc.de>
1038
1039 * progmodes/cc-vars.el (c-constant-symbol): Put this defun inside
1040 an eval-and-compile, so as to permit byte-compiling (e.g. in
1041 bootstrap).
1042
10432008-01-15 Stefan Monnier <monnier@iro.umontreal.ca>
1044
1045 * emacs-lisp/easymenu.el (easy-menu-avoid-duplicate-keys): New var.
1046 (easy-menu-create-menu, easy-menu-convert-item-1): Use it to avoid
1047 using the same key for different menu entries.
1048
1049 * smerge-mode.el (smerge-refine): Also work on "same change conflicts".
1050 (smerge-makeup-conflict): New command.
1051
10522008-01-15 Thien-Thi Nguyen <ttn@gnuvola.org>
1053
1054 * log-edit.el (log-edit): Doc fix.
1055
10562008-01-15 Glenn Morris <rgm@gnu.org>
1057
1058 * diff-mode.el (diff-end-of-hunk): Revert 2008-01-08 change.
1059
10602008-01-14 Alan Mackenzie <acm@muc.de>
1061
1062 * progmodes/cc-vars.el (c-constant-symbol): New function which
1063 supersedes c-const-symbol. During a customize-.. call it enables
1064 an element of (e.g.) c-hanging-braces alist to have its name
1065 displayed, even when the default value of c-h-b etc. doesn't
1066 include the elemnt. Replace uses of the old function by the new.
1067
1068 * progmodes/cc-vars.el (c-hanging-braces-alist): Remove the
1069 obscure non-working fragment ":value c-".
1070
10712008-01-14 Stefan Monnier <monnier@iro.umontreal.ca>
1072
1073 * abbrev.el (clear-abbrev-table): Can't pass a symbol to intern.
1074
10752008-01-14 Michael Albinus <michael.albinus@gmx.de>
1076
1077 * net/tramp.el (tramp-local-host-p): Use `tramp-file-name-host'
1078 instead of `tramp-file-name-real-host'.
1079
1080 * net/trampver.el: Update release number.
1081
10822008-01-14 Alan Mackenzie <acm@muc.de>
1083
1084 * progmodes/cc-engine.el (c-guess-basic-syntax): Prevent a macro
1085 call inside a struct being recognised as a K&R argument.
1086
10872008-01-14 Stefan Monnier <monnier@iro.umontreal.ca>
1088
1089 * progmodes/compile.el (compilation-error-regexp-alist-alist):
1090 Accept "fatal error" from MSFT.
1091 Reported by Jared Finder <jfinder@crypticstudios.com>.
1092
10932008-01-14 Dan Nicolaescu <dann@ics.uci.edu>
1094
1095 * smerge-mode.el (smerge-auto): New function.
1096 * vc-svn.el (vc-svn-find-file-hook):
1097 * vc-arch.el (vc-arch-find-file-hook):
1098 * pcvs.el (cvs-revert-if-needed):
1099 * vc.el (vc-maybe-resolve-conflicts): Use it instead of vc-mode.
1100 (top-level): Add a Todo list.
1101
11022008-01-13 Dan Nicolaescu <dann@ics.uci.edu>
1103
1104 * vc.el (vc-update): Resolve conflicts if necessary instead of
1105 just updating the buffer.
1106
1107 * vc-cvs.el (vc-cvs-merge-news): Ignore the error status of the
1108 update command so that we can parse the output.
1109
11102008-01-13 Martin Rudalics <rudalics@gmx.at>
1111
1112 * mail/rmail.el (rmail-convert-to-babyl-format):
1113 Remove save-excursion to avoid infinite looping.
1114 Reported by: dnz <dnz@bk.ru>.
1115
11162008-01-12 Glenn Morris <rgm@gnu.org>
1117
1118 * woman.el (woman-parse-numeric-arg): Change handling of `==':
1119 can be interned without a function definition.
1120
11212008-01-12 Jason Rumney <jasonr@gnu.org>
1122
1123 * nxml/nxml-mode.el (nxml-enable-unicode-char-name-sets)
1124 (rng-nxml-mode-init): Declare.
1125
11262008-01-11 Jason Rumney <jasonr@gnu.org>
1127
1128 * nxml/rng-nxml.el (rng-preferred-prefix-alist): Add some defaults.
1129 (rng-preferred-prefix-alist-default): Remove.
1130
1131 * nxml/nxml-uchnm.el (nxml-internal-unicode-char-name-sets-enabled):
1132 Rename from nxml-enable-unicode-char-name-sets-flag.
1133 (nxml-enable-unicode-char-name-sets-1): Merge into
1134 nxml-enable-unicode-char-name-sets.
1135 (nxml-enable-unicode-char-name-sets): Don't unconditionally set
1136 nxml-char-name-ignore-case here.
1137
1138 * nxml/nxml-mode.el (nxml-mode): Call rng-nxml-mode-init directly.
1139 Update doc string and commentary.
1140 (nxml-char-name-ignore-case): Change default value.
1141 (nxml-mode): Call nxml-enable-unicode-char-name-sets directly.
1142
11432008-01-11 Martin Rudalics <rudalics@gmx.at>
1144
1145 * cus-start.el (all): Add missing version entries.
1146
11472008-01-11 Glenn Morris <rgm@gnu.org>
1148
1149 * language/china-util.el (big5-to-flat-code, flat-code-to-big5)
1150 (euc-to-flat-code, flat-code-to-euc):
1151 * textmodes/org.el (elmo-msgdb-overview-get-entity)
1152 (wl-summary-buffer-msgdb): Declare as funtions.
1153
11542008-01-10 Martin Rudalics <rudalics@gmx.at>
1155
1156 * progmodes/ada-mode.el (ada-set-syntax-table-properties):
1157 Bind buffer-file-name and buffer-file-truename.
1158
1159 * fringe.el (fringe-mode-explicit): New variable.
1160 (set-fringe-mode): Don't alter default-frame-alist when just
1161 loading this file.
1162
11632008-01-10 Tassilo Horn <tassilo@member.fsf.org>
1164
1165 * doc-view.el (doc-view-buffer-file-name): New variable.
1166 (doc-view-convert-current-doc, doc-view-search)
1167 (doc-view-current-cache-dir, doc-view-initiate-display)
1168 (doc-view-mode): Use it.
1169 (doc-view-bookmark-make-cell): Use variable buffer-file-name
1170 instead of function.
1171
11722008-01-10 Dan Nicolaescu <dann@ics.uci.edu>
1173
1174 * vc-svn.el (vc-svn-registered): Return the correct value for
1175 ignored and unregistered files.
1176
11772008-01-10 Tassilo Horn <tassilo@member.fsf.org>
1178
1179 * doc-view.el (tramp): Require tramp because we use tramp-tramp-file-p.
1180
11812008-01-10 Tom Tromey <tromey@redhat.com>
1182
1183 * vc.el (vc-status-unmark-all-files): New function.
1184 (vc-status-unmark-all-files): Likewise.
1185 (vc-status-mode-map): Add bindings.
1186
11872008-01-10 Michael Kifer <kifer@cs.stonybrook.edu>
1188
1189 * ediff*.el: Uncomment declare-function.
1190
1191 * viper*.el: Uncomment declare-function.
1192
11932008-01-09 Tassilo Horn <tassilo@member.fsf.org>
1194
1195 * doc-view.el (doc-view-mode): Support tramp, compressed files and
1196 files inside archives uniformly.
1197
11982008-01-09 Eric S. Raymond <esr@snark.thyrsus.com>
1199
1200 * testmodes/sgml-mode.el (sgml-tag-syntax-table): Initialize this
1201 constant with a computation on sgml-specials rather than a literal
1202 list. Without this change the syntax table is generated
1203 incorrectly, and the mode will think it's in a comment following
1204 any instance of the string "--".
1205
12062008-01-09 Tassilo Horn <tassilo@member.fsf.org>
1207
1208 * doc-view.el (doc-view-mode-p): Add EPS as supported type.
1209 (doc-view-mode): Support document files inside archives.
1210
12112008-01-09 Dan Nicolaescu <dann@ics.uci.edu>
1212
1213 * vc.el (vc-deduce-fileset): Return the currently selected file if
1214 no files are selected when using vc-status.
1215
12162008-01-09 Michael Kifer <kifer@cs.stonybrook.edu>
1217
1218 * ediff*.el: Comment out declare-function. "make bootstrap"
1219 stops with an error and Emacs does not compile with those things in.
1220 Besides, declare-function is not defined in XEmacs.
1221
1222 * ediff-util (eqiff-quit): Autoraise minibuffer.
1223
1224 * ediff-diff (ediff-convert-fine-diffs-to-overlays): Make it a defun.
1225
1226 * viper*.el: Comment out declare-function -- not defined in XEmacs.
1227
1228 * viper-ex.el (viper-info-on-file): Take care of indirect buffers.
1229
1230 * viper.el (viper-set-hooks, set-cursor-color):
1231 Set viper-vi-state-cursor-color.
1232
12332008-01-09 Tom Tromey <tromey@redhat.com>
1234
1235 * vc.el (vc-status-headers): Rename from vc-status-insert-headers.
1236 Just return header.
1237 (vc-status-move-to-goal-column): New function.
1238 (vc-status-mode-map): Define more keys.
1239 (vc-status-mode): Use vc-status-refresh. Now 'special.
1240 (vc-status-refresh): New function.
1241 (vc-status-next-line): Likewise.
1242 (vc-status-previous-line): Likewise.
1243 (vc-status-mark-file): Use vc-status-next-line.
1244 (vc-status-unmark-file): Use vc-status-previous-line.
1245 (vc-status-unmark-file-up): New function.
1246 (vc-status-register): Likewise.
1247 (vc-status-find-file): Likewise.
1248 (vc-status-find-file-other-window): Likewise.
1249 (vc-status-current-file): Likewise.
1250 (vc-ensure-vc-buffer): Understand vc-status mode.
1251
1252 * vc-hg.el (vc-hg-dir-status): Don't pass -A to "hg status".
1253
12542008-01-09 Glenn Morris <rgm@gnu.org>
1255
1256 * ffap.el (ffap-string-at-point-mode-alist): Add `\' to file
1257 entry, for Windows.
1258
12592008-01-09 Tom Tromey <tromey@redhat.com>
1260
1261 * play/blackbox.el (blackbox-mode-map): Add `q' and [return] bindings.
1262
12632008-01-09 Vinicius Jose Latorre <viniciusjl@ig.com.br>
1264
1265 * ps-print.el: Some face attributes (like :strike-through) were not
1266 being recognised. Reported by Leo <sdl.web@gmail.com>.
1267 (ps-print-version): New version 6.8.2.
1268 (ps-face-strikout-p, ps-face-overline-p, ps-face-box-p): New funs.
1269 (ps-screen-to-bit-face): Fix code.
1270
12712008-01-09 Stefan Monnier <monnier@iro.umontreal.ca>
1272
1273 * ffap.el (ffap-read-file-or-url): Don't use let-binding to temporarily
1274 add a file-name handler.
1275
12762008-01-08 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
1277
1278 * textmodes/bibtex.el (bibtex-initialize): New autoloaded command.
1279 Rename from function bibtex-files-expand. New optional arg select.
1280 (bibtex-flash-head): Allow blink-matching-delay being zero.
1281 (bibtex-clean-entry): Use atomic-change-group.
1282 (bibtex-format-entry): Check presence of required fields only
1283 after formatting of fields. Use member-ignore-case. Do not use
1284 bibtex-parse-entry. Do not use booktitle field to set a missing title.
1285 (bibtex-autofill-entry): Do not call undo-boundary.
1286 (bibtex-lessp): Handle crossref keys that point to another bibtex file.
1287 (bibtex-sort-buffer, bibtex-prepare-new-entry, bibtex-validate):
1288 Parse keys if necessary.
5 1289
62008-01-08 Nick Roberts <nickrob@snap.net.nz> 12902008-01-08 Nick Roberts <nickrob@snap.net.nz>
7 1291
@@ -10,8 +1294,8 @@
10 1294
112008-01-08 Nick Roberts <nickrob@snap.net.nz> 12952008-01-08 Nick Roberts <nickrob@snap.net.nz>
12 1296
13 * progmodes/gdb-ui.el (gud-gdb-command-name): Explain 1297 * progmodes/gdb-ui.el (gud-gdb-command-name):
14 "--annotate=3" option is necessary for the Graphical Interface. 1298 Explain "--annotate=3" option is necessary for the Graphical Interface.
15 1299
162008-01-08 Nick Roberts <nickrob@snap.net.nz> 13002008-01-08 Nick Roberts <nickrob@snap.net.nz>
17 1301
@@ -79,10 +1363,8 @@
79 1363
80 * time-stamp.el (time-stamp-time-zone): 1364 * time-stamp.el (time-stamp-time-zone):
81 * whitespace.el (whitespace-check-buffer-leading) 1365 * whitespace.el (whitespace-check-buffer-leading)
82 (whitespace-check-buffer-trailing) 1366 (whitespace-check-buffer-trailing, whitespace-check-buffer-indent)
83 (whitespace-check-buffer-indent) 1367 (whitespace-check-buffer-spacetab, whitespace-check-buffer-ateol):
84 (whitespace-check-buffer-spacetab)
85 (whitespace-check-buffer-ateol):
86 * progmodes/sh-script.el (sh-indentation): 1368 * progmodes/sh-script.el (sh-indentation):
87 * textmodes/ispell.el (ispell-local-pdict): 1369 * textmodes/ispell.el (ispell-local-pdict):
88 Add safe-local-variable properties. 1370 Add safe-local-variable properties.
@@ -212,8 +1494,7 @@
212 * vc-arch.el (vc-arch-root): Only set a property if the file is 1494 * vc-arch.el (vc-arch-root): Only set a property if the file is
213 managed by this backend. 1495 managed by this backend.
214 1496
215 * vc-hg.el (vc-hg-state): Support the new status code for 1497 * vc-hg.el (vc-hg-state): Support the new status code for up-to-date.
216 up-to-date.
217 1498
2182008-01-04 Tassilo Horn <tassilo@member.fsf.org> 14992008-01-04 Tassilo Horn <tassilo@member.fsf.org>
219 1500
@@ -223,8 +1504,8 @@
223 1504
224 * doc-view.el (doc-view-scroll-up-or-next-page) 1505 * doc-view.el (doc-view-scroll-up-or-next-page)
225 (doc-view-scroll-down-or-previous-page): Use image-scroll-up and 1506 (doc-view-scroll-down-or-previous-page): Use image-scroll-up and
226 image-scroll-down instead of the non-image equivalents. Don't 1507 image-scroll-down instead of the non-image equivalents.
227 rely on a signalled condition but switch pages when scrolling 1508 Don't rely on a signalled condition but switch pages when scrolling
228 doesn't change the vertical position anymore. 1509 doesn't change the vertical position anymore.
229 (doc-view-mode-map): Remap scroll-{up,down} to 1510 (doc-view-mode-map): Remap scroll-{up,down} to
230 image-scroll-{up,down}. 1511 image-scroll-{up,down}.
@@ -242,7 +1523,8 @@
242 * bs.el (bs--sort-by-mode, bs--get-mode-name): 1523 * bs.el (bs--sort-by-mode, bs--get-mode-name):
243 * imenu.el (imenu-add-to-menubar): 1524 * imenu.el (imenu-add-to-menubar):
244 * makesum.el (make-command-summary): 1525 * makesum.el (make-command-summary):
245 * mouse.el (mouse-major-mode-menu, mouse-popup-menubar, mouse-buffer-menu): 1526 * mouse.el (mouse-major-mode-menu, mouse-popup-menubar)
1527 (mouse-buffer-menu):
246 * msb.el (msb--mode-menu-cond): 1528 * msb.el (msb--mode-menu-cond):
247 * calc/calc-embed.el (calc-do-embedded): 1529 * calc/calc-embed.el (calc-do-embedded):
248 * emacs-lisp/helper.el (Helper-describe-mode): 1530 * emacs-lisp/helper.el (Helper-describe-mode):
@@ -257,7 +1539,8 @@
257 * progmodes/ada-xref.el (ada-prj-find-prj-file): 1539 * progmodes/ada-xref.el (ada-prj-find-prj-file):
258 * progmodes/ada-mode.el (comment-region): 1540 * progmodes/ada-mode.el (comment-region):
259 * calendar/todo-mode.el (todo-insert-item): 1541 * calendar/todo-mode.el (todo-insert-item):
260 * bookmark.el (bookmark-buffer-name): Test major-mode rather than mode-name. 1542 * bookmark.el (bookmark-buffer-name):
1543 Test major-mode rather than mode-name.
261 1544
2622008-01-04 Richard Stallman <rms@gnu.org> 15452008-01-04 Richard Stallman <rms@gnu.org>
263 1546
@@ -328,13 +1611,13 @@
328 * progmodes/grep.el (grep-find-ignored-directories): 1611 * progmodes/grep.el (grep-find-ignored-directories):
329 Initialize from the value of vc-directory-exclusion-list. 1612 Initialize from the value of vc-directory-exclusion-list.
330 1613
331 * vc-hooks (vc-directory-exclusion-list): Include "_darcs", 1614 * vc-hooks (vc-directory-exclusion-list): Include "_darcs",
332 even though we don't have a back end for darcs yet. 1615 even though we don't have a back end for darcs yet.
333 1616
3342008-01-02 Karl Fogel <kfogel@red-bean.com> 16172008-01-02 Karl Fogel <kfogel@red-bean.com>
335 1618
336 Change a return type, for greater extensibility. See 1619 Change a return type, for greater extensibility.
337 http://lists.gnu.org/archive/html/emacs-devel/2007-12/msg01077.html 1620 See http://lists.gnu.org/archive/html/emacs-devel/2007-12/msg01077.html
338 and its thread for discussion leading to this change. 1621 and its thread for discussion leading to this change.
339 1622
340 * emacs-cvs/lisp/bookmark.el: 1623 * emacs-cvs/lisp/bookmark.el:
@@ -396,10 +1679,10 @@
396 1679
3972008-01-01 Eric S. Raymond <esr@snark.thyrsus.com> 16802008-01-01 Eric S. Raymond <esr@snark.thyrsus.com>
398 1681
399 * vc-svn.el (vc-svn-parse-status): Set the 'unregisted property 1682 * vc-svn.el (vc-svn-parse-status): Set the `unregisted' property
400 correctly. 1683 correctly.
401 1684
402 * vc.el (vc-dired-hook): Speed tuning. Replace a vc-backend call 1685 * vc.el (vc-dired-hook): Speed tuning. Replace a vc-backend call
403 with vc-state. 1686 with vc-state.
404 (vc-next-action): Fix vc-transfer-file call. 1687 (vc-next-action): Fix vc-transfer-file call.
405 1688
@@ -889,6 +2172,12 @@
889 * newcomment.el (comment-region-default): Don't triple the 2172 * newcomment.el (comment-region-default): Don't triple the
890 comment starter if the first region line isn't indented enough. 2173 comment starter if the first region line isn't indented enough.
891 2174
21752007-12-21 Teodor Zlatanov <tzz@lifelogs.com>
2176
2177 * net/imap.el (imap-authenticate): Use current-buffer instead of
2178 buffer, for the cases where imap-authenticate is called with a nil
2179 buffer parameter.
2180
8922007-12-21 Martin Rudalics <rudalics@gmx.at> 21812007-12-21 Martin Rudalics <rudalics@gmx.at>
893 2182
894 * autoinsert.el (auto-insert-alist): Remove nonsensical precision 2183 * autoinsert.el (auto-insert-alist): Remove nonsensical precision
@@ -1579,6 +2868,12 @@
1579 * textmodes/reftex-toc.el (reftex-make-separate-toc-frame): 2868 * textmodes/reftex-toc.el (reftex-make-separate-toc-frame):
1580 Try x-focus-frame before focus-frame. Only try focus-frame on XEmacs. 2869 Try x-focus-frame before focus-frame. Only try focus-frame on XEmacs.
1581 2870
28712007-12-03 Nathan J. Williams <nathanw@MIT.EDU> (tiny change)
2872
2873 * net/imap.el (imap-mailbox-status-asynch): Upcase STATUS items.
2874 (imap-parse-status): Upcase status-att for servers that sends them
2875 lower-case (e.g., MS Exchange 2007).
2876
15822007-12-03 Karl Fogel <kfogel@red-bean.com> 28772007-12-03 Karl Fogel <kfogel@red-bean.com>
1583 2878
1584 * saveplace.el (save-place-quiet): Remove, reverting 2007-12-02T19:54:46Z!kfogel@red-bean.com. 2879 * saveplace.el (save-place-quiet): Remove, reverting 2007-12-02T19:54:46Z!kfogel@red-bean.com.
@@ -4771,7 +6066,7 @@
4771 Require tramp-cmds.el. 6066 Require tramp-cmds.el.
4772 (tramp-make-tramp-temp-file): We can get rid of DONT-CREATE. 6067 (tramp-make-tramp-temp-file): We can get rid of DONT-CREATE.
4773 (tramp-handle-file-name-all-completions): Expand DIRECTORY. 6068 (tramp-handle-file-name-all-completions): Expand DIRECTORY.
4774 (tramp-do-copy-or-rename-file-directly): Make more rigid checks. 6069 (tramp-do-copy-or-rename-file-directly): Make more rigid checks.
4775 (tramp-do-copy-or-rename-file-out-of-band) 6070 (tramp-do-copy-or-rename-file-out-of-band)
4776 (tramp-maybe-open-connection): Use `make-temp-name'. This is 6071 (tramp-maybe-open-connection): Use `make-temp-name'. This is
4777 possible, because we don't need to create the temporary file, but 6072 possible, because we don't need to create the temporary file, but
@@ -7117,18 +8412,6 @@
7117 * net/browse-url.el (browse-url-encode-url): Use copy-sequence. 8412 * net/browse-url.el (browse-url-encode-url): Use copy-sequence.
7118 Reported by Jan Dj,Ad(Brv <jan.h.d@swipnet.se>. 8413 Reported by Jan Dj,Ad(Brv <jan.h.d@swipnet.se>.
7119 8414
71202007-09-10 Stefan Monnier <monnier@iro.umontreal.ca>
7121
7122 * progmodes/python.el: Merge changes from Dave Love's v2007-Sep-10.
7123 (python-font-lock-keywords): Update to the 2.5 version of the language.
7124 (python-quote-syntax): Let-bind font-lock-syntactic-keywords to nil.
7125 (python-backspace): Only behave funny in code.
7126 (python-compilation-regexp-alist): Add PDB stack trace regexp.
7127 (inferior-python-mode): Add PDB prompt regexp.
7128 (python-fill-paragraph): Refine the fenced-string regexp.
7129 (python-find-imports): Handle imports spanning several lines.
7130 (python-mode): Add `class' to hideshow support.
7131
71322007-09-10 Dave Love <fx@gnu.org> 84152007-09-10 Dave Love <fx@gnu.org>
7133 8416
7134 * outline.el (outline-4, outline-5, outline-7): 8417 * outline.el (outline-4, outline-5, outline-7):
diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12
index cb4924a8930..aab55a53678 100644
--- a/lisp/ChangeLog.12
+++ b/lisp/ChangeLog.12
@@ -250,7 +250,7 @@
2502007-04-15 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> 2502007-04-15 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
251 251
252 * textmodes/bibtex.el (bibtex-field-list): Use functionp. 252 * textmodes/bibtex.el (bibtex-field-list): Use functionp.
253 (bibtex-make-field): Check that INIT is a string. Use functionp. 253 (bibtex-make-field): Check that INIT is a string. Use functionp.
254 254
2552007-04-14 Glenn Morris <rgm@gnu.org> 2552007-04-14 Glenn Morris <rgm@gnu.org>
256 256
@@ -1214,7 +1214,7 @@
1214 * progmodes/idlw-help.el (idlwave-do-context-help1): Don't visit 1214 * progmodes/idlw-help.el (idlwave-do-context-help1): Don't visit
1215 special help topics for keywords. 1215 special help topics for keywords.
1216 (idlwave-help-assistant-command): Include ".exe" for ms-dos 1216 (idlwave-help-assistant-command): Include ".exe" for ms-dos
1217 etc. Assistant command. 1217 etc. Assistant command.
1218 1218
12192007-03-08 Chong Yidong <cyd@stupidchicken.com> 12192007-03-08 Chong Yidong <cyd@stupidchicken.com>
1220 1220
@@ -2133,7 +2133,7 @@
2133 (newsticker--decode-iso8601-date): Bugfix for datestrings without 2133 (newsticker--decode-iso8601-date): Bugfix for datestrings without
2134 days. 2134 days.
2135 (newsticker--buffer-do-insert-text): Fix. 2135 (newsticker--buffer-do-insert-text): Fix.
2136 (newsticker--buffer-insert-enclosure): Fix. length might be missing. 2136 (newsticker--buffer-insert-enclosure): Fix. Length might be missing.
2137 (newsticker--buffer-make-item-completely-visible): 2137 (newsticker--buffer-make-item-completely-visible):
2138 `switch-to-buffer' not necessary. 2138 `switch-to-buffer' not necessary.
2139 2139
@@ -5365,7 +5365,7 @@
5365 After 5.3, 5.4: 5365 After 5.3, 5.4:
5366 (cperl-facemenu-add-face-function): Add docs, fix U<>. 5366 (cperl-facemenu-add-face-function): Add docs, fix U<>.
5367 Copyright message updated. 5367 Copyright message updated.
5368 (cperl-init-faces): Work around a bug in `font-lock'. May slow 5368 (cperl-init-faces): Work around a bug in `font-lock'. May slow
5369 facification down a bit. 5369 facification down a bit.
5370 Misprint for my|our|local for old `font-lock' 5370 Misprint for my|our|local for old `font-lock'
5371 "our" was not fontified same as "my|local". 5371 "our" was not fontified same as "my|local".
@@ -5881,7 +5881,7 @@
5881 5881
58822006-09-26 Vinicius Jose Latorre <viniciusjl@ig.com.br> 58822006-09-26 Vinicius Jose Latorre <viniciusjl@ig.com.br>
5883 5883
5884 * progmodes/ebnf2ps.el: Doc fix. Implement arrow spacing and scaling. 5884 * progmodes/ebnf2ps.el: Doc fix. Implement arrow spacing and scaling.
5885 (ebnf-version): New version 4.3. 5885 (ebnf-version): New version 4.3.
5886 (ebnf-arrow-extra-width, ebnf-arrow-scale): New options. 5886 (ebnf-arrow-extra-width, ebnf-arrow-scale): New options.
5887 (ebnf-prologue): Adjust PostScript programming. 5887 (ebnf-prologue): Adjust PostScript programming.
@@ -33349,7 +33349,7 @@ See ChangeLog.11 for earlier changes.
33349;; add-log-time-zone-rule: t 33349;; add-log-time-zone-rule: t
33350;; End: 33350;; End:
33351 33351
33352 Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc. 33352 Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
33353 33353
33354 This file is part of GNU Emacs. 33354 This file is part of GNU Emacs.
33355 33355
diff --git a/lisp/ChangeLog.6 b/lisp/ChangeLog.6
index 781122dcb29..2fff1f9a85f 100644
--- a/lisp/ChangeLog.6
+++ b/lisp/ChangeLog.6
@@ -2769,7 +2769,7 @@
2769 (gnus-request-accept-article): Make sure there's a newline at the 2769 (gnus-request-accept-article): Make sure there's a newline at the
2770 end of the buffer. 2770 end of the buffer.
2771 (gnus-adjust-marked-articles): Don't remove illegal ticked 2771 (gnus-adjust-marked-articles): Don't remove illegal ticked
2772 articles (for forwards compatability). 2772 articles (for forwards compatibility).
2773 2773
27741996-02-03 Lars Magne Ingebrigtsen <larsi@aegir.ifi.uio.no> 27741996-02-03 Lars Magne Ingebrigtsen <larsi@aegir.ifi.uio.no>
2775 2775
diff --git a/lisp/ChangeLog.unicode b/lisp/ChangeLog.unicode
index 3a6c726ec60..39bab4abebc 100644
--- a/lisp/ChangeLog.unicode
+++ b/lisp/ChangeLog.unicode
@@ -8,6 +8,11 @@
8 8
9 * international/characters.el (script-list): Add cham. 9 * international/characters.el (script-list): Add cham.
10 10
112008-01-17 Mark A. Hershberger <mah@everybody.org>
12
13 * xml.el (xml-escape-string): Don't do any encoding changes on the
14 string.
15
112008-01-16 Kenichi Handa <handa@ni.aist.go.jp> 162008-01-16 Kenichi Handa <handa@ni.aist.go.jp>
12 17
13 * language/ind-util.el (in-is13194-post-read-conversion): Delete 18 * language/ind-util.el (in-is13194-post-read-conversion): Delete
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index ff99430e027..5cdd2d0aa8f 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -524,7 +524,9 @@ the current abbrev table before abbrev lookup happens."
524 (aset table i 0)) 524 (aset table i 0))
525 ;; Preserve the table's properties. 525 ;; Preserve the table's properties.
526 (assert sym) 526 (assert sym)
527 (intern sym table) 527 (let ((newsym (intern "" table)))
528 (set newsym nil) ; Make sure it won't be confused for an abbrev.
529 (setplist newsym (symbol-plist sym)))
528 (abbrev-table-put table :abbrev-table-modiff 530 (abbrev-table-put table :abbrev-table-modiff
529 (1+ (abbrev-table-get table :abbrev-table-modiff))))) 531 (1+ (abbrev-table-get table :abbrev-table-modiff)))))
530 532
diff --git a/lisp/add-log.el b/lisp/add-log.el
index a52aa519819..c9fdb34bc9a 100644
--- a/lisp/add-log.el
+++ b/lisp/add-log.el
@@ -240,8 +240,11 @@ Note: The search is conducted only within 10%, at the beginning of the file."
240;; backward-compatibility alias 240;; backward-compatibility alias
241(put 'change-log-acknowledgement-face 'face-alias 'change-log-acknowledgement) 241(put 'change-log-acknowledgement-face 'face-alias 'change-log-acknowledgement)
242 242
243(defconst change-log-file-names-re "^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)")
244(defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*")
245
243(defvar change-log-font-lock-keywords 246(defvar change-log-font-lock-keywords
244 '(;; 247 `(;;
245 ;; Date lines, new (2000-01-01) and old (Sat Jan 1 00:00:00 2000) styles. 248 ;; Date lines, new (2000-01-01) and old (Sat Jan 1 00:00:00 2000) styles.
246 ;; Fixme: this regepx is just an approximate one and may match 249 ;; Fixme: this regepx is just an approximate one and may match
247 ;; wrongly with a non-date line existing as a random note. In 250 ;; wrongly with a non-date line existing as a random note. In
@@ -255,7 +258,7 @@ Note: The search is conducted only within 10%, at the beginning of the file."
255 (2 'change-log-email))) 258 (2 'change-log-email)))
256 ;; 259 ;;
257 ;; File names. 260 ;; File names.
258 ("^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)" 261 (,change-log-file-names-re
259 (2 'change-log-file) 262 (2 'change-log-file)
260 ;; Possibly further names in a list: 263 ;; Possibly further names in a list:
261 ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file)) 264 ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file))
@@ -287,10 +290,49 @@ Note: The search is conducted only within 10%, at the beginning of the file."
287 3 'change-log-acknowledgement)) 290 3 'change-log-acknowledgement))
288 "Additional expressions to highlight in Change Log mode.") 291 "Additional expressions to highlight in Change Log mode.")
289 292
293(defun change-log-search-file-name (where)
294 "Return the file-name for the change under point."
295 (save-excursion
296 (goto-char where)
297 (beginning-of-line 1)
298 (if (looking-at change-log-start-entry-re)
299 ;; We are at the start of an entry, search forward for a file
300 ;; name.
301 (progn
302 (re-search-forward change-log-file-names-re nil t)
303 (match-string 2))
304 (if (looking-at change-log-file-names-re)
305 ;; We found a file name.
306 (match-string 2)
307 ;; Look backwards for either a file name or the log entry start.
308 (if (re-search-backward
309 (concat "\\(" change-log-start-entry-re
310 "\\)\\|\\("
311 change-log-file-names-re "\\)") nil t)
312 (if (match-beginning 1)
313 ;; We got the start of the entry, look forward for a
314 ;; file name.
315 (progn
316 (re-search-forward change-log-file-names-re nil t)
317 (match-string 2))
318 (match-string 4))
319 ;; We must be before any file name, look forward.
320 (re-search-forward change-log-file-names-re nil t)
321 (match-string 2))))))
322
323(defun change-log-find-file ()
324 "Visit the file for the change under point."
325 (interactive)
326 (let ((file (change-log-search-file-name (point))))
327 (if (and file (file-exists-p file))
328 (find-file file)
329 (message "No such file or directory: %s" file))))
330
290(defvar change-log-mode-map 331(defvar change-log-mode-map
291 (let ((map (make-sparse-keymap))) 332 (let ((map (make-sparse-keymap)))
292 (define-key map [?\C-c ?\C-p] 'add-log-edit-prev-comment) 333 (define-key map [?\C-c ?\C-p] 'add-log-edit-prev-comment)
293 (define-key map [?\C-c ?\C-n] 'add-log-edit-next-comment) 334 (define-key map [?\C-c ?\C-n] 'add-log-edit-next-comment)
335 (define-key map [?\C-c ?\C-f] 'change-log-find-file)
294 map) 336 map)
295 "Keymap for Change Log major mode.") 337 "Keymap for Change Log major mode.")
296 338
@@ -1101,8 +1143,6 @@ Has a preference of looking backwards."
1101 (change-log-get-method-definition-1 "")) 1143 (change-log-get-method-definition-1 ""))
1102 (concat change-log-get-method-definition-md "]")))))) 1144 (concat change-log-get-method-definition-md "]"))))))
1103 1145
1104(defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*")
1105
1106(defun change-log-sortable-date-at () 1146(defun change-log-sortable-date-at ()
1107 "Return date of log entry in a consistent form for sorting. 1147 "Return date of log entry in a consistent form for sorting.
1108Point is assumed to be at the start of the entry." 1148Point is assumed to be at the start of the entry."
diff --git a/lisp/allout.el b/lisp/allout.el
index 48371938242..a259723d5ba 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -5,7 +5,7 @@
5 5
6;; Author: Ken Manheimer <ken dot manheimer at gmail dot com> 6;; Author: Ken Manheimer <ken dot manheimer at gmail dot com>
7;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> 7;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com>
8;; Created: Dec 1991 - first release to usenet 8;; Created: Dec 1991 -- first release to usenet
9;; Version: 2.2.1 9;; Version: 2.2.1
10;; Keywords: outlines wp languages 10;; Keywords: outlines wp languages
11;; Website: http://myriadicity.net/Sundry/EmacsAllout 11;; Website: http://myriadicity.net/Sundry/EmacsAllout
@@ -36,11 +36,11 @@
36;; - Topic-oriented editing including coherent topic and subtopic 36;; - Topic-oriented editing including coherent topic and subtopic
37;; creation, promotion, demotion, cut/paste across depths, etc. 37;; creation, promotion, demotion, cut/paste across depths, etc.
38;; - Incremental search with dynamic exposure and reconcealment of text 38;; - Incremental search with dynamic exposure and reconcealment of text
39;; - Customizable bullet format - enables programming-language specific 39;; - Customizable bullet format -- enables programming-language specific
40;; outlining, for code-folding editing. (Allout code itself is to try it; 40;; outlining, for code-folding editing. (Allout code itself is to try it;
41;; formatted as an outline - do ESC-x eval-buffer in allout.el; but 41;; formatted as an outline -- do ESC-x eval-buffer in allout.el; but
42;; emacs local file variables need to be enabled when the 42;; emacs local file variables need to be enabled when the
43;; file was visited - see `enable-local-variables'.) 43;; file was visited -- see `enable-local-variables'.)
44;; - Configurable per-file initial exposure settings 44;; - Configurable per-file initial exposure settings
45;; - Symmetric-key and key-pair topic encryption, plus symmetric passphrase 45;; - Symmetric-key and key-pair topic encryption, plus symmetric passphrase
46;; mnemonic support, with verification against an established passphrase 46;; mnemonic support, with verification against an established passphrase
@@ -53,7 +53,7 @@
53;; exposure control (see the allout-mode docstring) 53;; exposure control (see the allout-mode docstring)
54;; - Easy rendering of exposed portions into numbered, latex, indented, etc 54;; - Easy rendering of exposed portions into numbered, latex, indented, etc
55;; outline styles 55;; outline styles
56;; - Careful attention to whitespace - enabling blank lines between items 56;; - Careful attention to whitespace -- enabling blank lines between items
57;; and maintenance of hanging indentation (in paragraph auto-fill and 57;; and maintenance of hanging indentation (in paragraph auto-fill and
58;; across topic promotion and demotion) of topic bodies consistent with 58;; across topic promotion and demotion) of topic bodies consistent with
59;; indentation of their topic header. 59;; indentation of their topic header.
@@ -76,7 +76,7 @@
76;; `allout-mode' as a minor mode. (It has changed since allout 76;; `allout-mode' as a minor mode. (It has changed since allout
77;; 3.x, for those of you that depend on the old method.) 77;; 3.x, for those of you that depend on the old method.)
78;; 78;;
79;; Note - the lines beginning with `;;;_' are outline topic headers. 79;; Note -- the lines beginning with `;;;_' are outline topic headers.
80;; Just `ESC-x eval-buffer' to give it a whirl. 80;; Just `ESC-x eval-buffer' to give it a whirl.
81 81
82;; ken manheimer (ken dot manheimer at gmail dot com) 82;; ken manheimer (ken dot manheimer at gmail dot com)
@@ -117,12 +117,12 @@ Default is '\C-c<space>'; just '\C-c' is more short-and-sweet, if you're
117willing to let allout use a bunch of \C-c keybindings." 117willing to let allout use a bunch of \C-c keybindings."
118 :type 'string 118 :type 'string
119 :group 'allout) 119 :group 'allout)
120
120;;;_ = allout-keybindings-list 121;;;_ = allout-keybindings-list
121;;; You have to reactivate allout-mode - `(allout-mode t)' - to 122;;; You have to reactivate allout-mode -- `(allout-mode t)' -- to
122;;; institute changes to this var. 123;;; institute changes to this var.
123(defvar allout-keybindings-list () 124(defvar allout-keybindings-list ()
124 "*List of `allout-mode' key / function bindings, for `allout-mode-map'. 125 "*List of `allout-mode' key / function bindings, for `allout-mode-map'.
125
126String or vector key will be prefaced with `allout-command-prefix', 126String or vector key will be prefaced with `allout-command-prefix',
127unless optional third, non-nil element is present.") 127unless optional third, non-nil element is present.")
128(setq allout-keybindings-list 128(setq allout-keybindings-list
@@ -155,11 +155,11 @@ unless optional third, non-nil element is present.")
155 ("*" allout-rebullet-current-heading) 155 ("*" allout-rebullet-current-heading)
156 ("#" allout-number-siblings) 156 ("#" allout-number-siblings)
157 ("\C-k" allout-kill-line t) 157 ("\C-k" allout-kill-line t)
158 ("\M-k" allout-copy-line-as-kill t) 158 ([?\M-k] allout-copy-line-as-kill t)
159 ("\C-y" allout-yank t) 159 ("\C-y" allout-yank t)
160 ("\M-y" allout-yank-pop t) 160 ([?\M-y] allout-yank-pop t)
161 ("\C-k" allout-kill-topic) 161 ("\C-k" allout-kill-topic)
162 ("\M-k" allout-copy-topic-as-kill) 162 ([?\M-k] allout-copy-topic-as-kill)
163 ; Miscellaneous commands: 163 ; Miscellaneous commands:
164 ;([?\C-\ ] allout-mark-topic) 164 ;([?\C-\ ] allout-mark-topic)
165 ("@" allout-resolve-xref) 165 ("@" allout-resolve-xref)
@@ -170,7 +170,7 @@ unless optional third, non-nil element is present.")
170 170
171;;;_ = allout-auto-activation 171;;;_ = allout-auto-activation
172(defcustom allout-auto-activation nil 172(defcustom allout-auto-activation nil
173 "*Regulates auto-activation modality of allout outlines - see `allout-init'. 173 "*Regulates auto-activation modality of allout outlines -- see `allout-init'.
174 174
175Setq-default by `allout-init' to regulate whether or not allout 175Setq-default by `allout-init' to regulate whether or not allout
176outline mode is automatically activated when the buffer-specific 176outline mode is automatically activated when the buffer-specific
@@ -212,35 +212,35 @@ value will automatically trigger `allout-mode', provided
212 212
213The types of elements in the layout specification are: 213The types of elements in the layout specification are:
214 214
215 integer - dictate the relative depth to open the corresponding topic(s), 215 INTEGER -- dictate the relative depth to open the corresponding topic(s),
216 where: 216 where:
217 - negative numbers force the topic to be closed before opening 217 -- negative numbers force the topic to be closed before opening
218 to the absolute value of the number, so all siblings are open 218 to the absolute value of the number, so all siblings are open
219 only to that level. 219 only to that level.
220 - positive numbers open to the relative depth indicated by the 220 -- positive numbers open to the relative depth indicated by the
221 number, but do not force already opened subtopics to be closed. 221 number, but do not force already opened subtopics to be closed.
222 - 0 means to close topic - hide all subitems. 222 -- 0 means to close topic -- hide all subitems.
223 : - repeat spec - apply the preceeding element to all siblings at 223 : -- repeat spec -- apply the preceeding element to all siblings at
224 current level, *up to* those siblings that would be covered by specs 224 current level, *up to* those siblings that would be covered by specs
225 following the `:' on the list. Ie, apply to all topics at level but 225 following the `:' on the list. Ie, apply to all topics at level but
226 trailing ones accounted for by trailing specs. (Only the first of 226 trailing ones accounted for by trailing specs. (Only the first of
227 multiple colons at the same level is honored - later ones are ignored.) 227 multiple colons at the same level is honored -- later ones are ignored.)
228 * - completely exposes the topic, including bodies 228 * -- completely exposes the topic, including bodies
229 + - exposes all subtopics, but not the bodies 229 + -- exposes all subtopics, but not the bodies
230 - - exposes the body of the corresponding topic, but not subtopics 230 - -- exposes the body of the corresponding topic, but not subtopics
231 list - a nested layout spec, to be applied intricately to its 231 LIST -- a nested layout spec, to be applied intricately to its
232 corresponding item(s) 232 corresponding item(s)
233 233
234Examples: 234Examples:
235 '(-2 : 0) 235 (-2 : 0)
236 Collapse the top-level topics to show their children and 236 Collapse the top-level topics to show their children and
237 grandchildren, but completely collapse the final top-level topic. 237 grandchildren, but completely collapse the final top-level topic.
238 '(-1 () : 1 0) 238 (-1 () : 1 0)
239 Close the first topic so only the immediate subtopics are shown, 239 Close the first topic so only the immediate subtopics are shown,
240 leave the subsequent topics exposed as they are until the second 240 leave the subsequent topics exposed as they are until the second
241 second to last topic, which is exposed at least one level, and 241 second to last topic, which is exposed at least one level, and
242 completely close the last topic. 242 completely close the last topic.
243 '(-2 : -1 *) 243 (-2 : -1 *)
244 Expose children and grandchildren of all topics at current 244 Expose children and grandchildren of all topics at current
245 level except the last two; expose children of the second to 245 level except the last two; expose children of the second to
246 last and completely expose the last one, including its subtopics. 246 last and completely expose the last one, including its subtopics.
@@ -283,7 +283,7 @@ else allout's special hanging-indent maintaining auto-fill function,
283(defcustom allout-use-hanging-indents t 283(defcustom allout-use-hanging-indents t
284 "*If non-nil, topic body text auto-indent defaults to indent of the header. 284 "*If non-nil, topic body text auto-indent defaults to indent of the header.
285Ie, it is indented to be just past the header prefix. This is 285Ie, it is indented to be just past the header prefix. This is
286relevant mostly for use with indented-text-mode, or other situations 286relevant mostly for use with `indented-text-mode', or other situations
287where auto-fill occurs." 287where auto-fill occurs."
288 :type 'boolean 288 :type 'boolean
289 :group 'allout) 289 :group 'allout)
@@ -360,7 +360,7 @@ repeated calls."
360Cycling only happens on when the command is repeated, not when it 360Cycling only happens on when the command is repeated, not when it
361follows a different command. 361follows a different command.
362 362
363Smart-placement means that repeated calls to this function will 363Smart placement means that repeated calls to this function will
364advance as follows: 364advance as follows:
365 365
366 - if the cursor is not on the end-of-line, 366 - if the cursor is not on the end-of-line,
@@ -442,25 +442,25 @@ persistent until deliberately changed. Their significance is
442purely by convention, however. Some conventions suggest 442purely by convention, however. Some conventions suggest
443themselves: 443themselves:
444 444
445 `(' - open paren - an aside or incidental point 445 `(' - open paren -- an aside or incidental point
446 `?' - question mark - uncertain or outright question 446 `?' - question mark -- uncertain or outright question
447 `!' - exclamation point/bang - emphatic 447 `!' - exclamation point/bang -- emphatic
448 `[' - open square bracket - meta-note, about item instead of item's subject 448 `[' - open square bracket -- meta-note, about item instead of item's subject
449 `\"' - double quote - a quotation or other citation 449 `\"' - double quote -- a quotation or other citation
450 `=' - equal sign - an assignement, equating a name with some connotation 450 `=' - equal sign -- an assignement, equating a name with some connotation
451 `^' - carat - relates to something above 451 `^' - carat -- relates to something above
452 452
453Some are more elusive, but their rationale may be recognizable: 453Some are more elusive, but their rationale may be recognizable:
454 454
455 `+' - plus - pending consideration, completion 455 `+' - plus -- pending consideration, completion
456 `_' - underscore - done, completed 456 `_' - underscore -- done, completed
457 `&' - ampersand - addendum, furthermore 457 `&' - ampersand -- addendum, furthermore
458 458
459\(Some other non-plain bullets have special meaning to the 459\(Some other non-plain bullets have special meaning to the
460software. By default: 460software. By default:
461 461
462 `~' marks encryptable topics - see `allout-topic-encryption-bullet' 462 `~' marks encryptable topics -- see `allout-topic-encryption-bullet'
463 `#' marks auto-numbered bullets - see `allout-numbered-bullet'.) 463 `#' marks auto-numbered bullets -- see `allout-numbered-bullet'.)
464 464
465See `allout-plain-bullets-string' for the standard, alternating 465See `allout-plain-bullets-string' for the standard, alternating
466bullets. 466bullets.
@@ -502,7 +502,7 @@ comment-start strings that do not end in spaces are tripled in
502the header-prefix, and an `_' underscore is tacked on the end, to 502the header-prefix, and an `_' underscore is tacked on the end, to
503distinguish them from regular comment strings. comment-start 503distinguish them from regular comment strings. comment-start
504strings that do end in spaces are not tripled, but an underscore 504strings that do end in spaces are not tripled, but an underscore
505is substituted for the space. [This presumes that the space is 505is substituted for the space. [This presumes that the space is
506for appearance, not comment syntax. You can use 506for appearance, not comment syntax. You can use
507`allout-mode-leaders' to override this behavior, when 507`allout-mode-leaders' to override this behavior, when
508undesired.]" 508undesired.]"
@@ -543,7 +543,7 @@ are always respected by the topic maneuvering functions."
543;;;###autoload 543;;;###autoload
544(put 'allout-old-style-prefixes 'safe-local-variable 544(put 'allout-old-style-prefixes 'safe-local-variable
545 (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil))))) 545 (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
546;;;_ = allout-stylish-prefixes - alternating bullets 546;;;_ = allout-stylish-prefixes -- alternating bullets
547(defcustom allout-stylish-prefixes t 547(defcustom allout-stylish-prefixes t
548 "*Do fancy stuff with topic prefix bullets according to level, etc. 548 "*Do fancy stuff with topic prefix bullets according to level, etc.
549 549
@@ -707,9 +707,9 @@ variable for details about allout ajustment of file variables."
707(defcustom allout-passphrase-hint-handling 'always 707(defcustom allout-passphrase-hint-handling 'always
708 "*Dictate outline encryption passphrase reminder handling: 708 "*Dictate outline encryption passphrase reminder handling:
709 709
710 always - always show reminder when prompting 710 always -- always show reminder when prompting
711 needed - show reminder on passphrase entry failure 711 needed -- show reminder on passphrase entry failure
712 disabled - never present or adjust reminder 712 disabled -- never present or adjust reminder
713 713
714See the docstring for the `allout-enable-file-variable-adjustment' 714See the docstring for the `allout-enable-file-variable-adjustment'
715variable for details about allout ajustment of file variables." 715variable for details about allout ajustment of file variables."
@@ -732,7 +732,7 @@ mostly covers both deliberate file writes and auto-saves.
732 can continue editing but the copy on the file system will be 732 can continue editing but the copy on the file system will be
733 encrypted.) 733 encrypted.)
734 Auto-saves will use the \"All except current topic\" mode if this 734 Auto-saves will use the \"All except current topic\" mode if this
735 one is selected, to avoid practical difficulties - see below. 735 one is selected, to avoid practical difficulties -- see below.
736 - All except current topic: skip the topic currently being edited, even if 736 - All except current topic: skip the topic currently being edited, even if
737 it's pending encryption. This may expose the current topic on the 737 it's pending encryption. This may expose the current topic on the
738 file sytem, but avoids the nuisance of prompts for the encryption 738 file sytem, but avoids the nuisance of prompts for the encryption
@@ -790,7 +790,7 @@ For details, see `allout-toggle-current-subtree-encryption's docstring."
790 :group 'allout) 790 :group 'allout)
791(make-variable-buffer-local 'allout-enable-file-variable-adjustment) 791(make-variable-buffer-local 'allout-enable-file-variable-adjustment)
792 792
793;;;_* CODE - no user customizations below. 793;;;_* CODE -- no user customizations below.
794 794
795;;;_ #1 Internal Outline Formatting and Configuration 795;;;_ #1 Internal Outline Formatting and Configuration
796;;;_ : Version 796;;;_ : Version
@@ -810,7 +810,7 @@ For details, see `allout-toggle-current-subtree-encryption's docstring."
810(defvar allout-mode nil "Allout outline mode minor-mode flag.") 810(defvar allout-mode nil "Allout outline mode minor-mode flag.")
811(make-variable-buffer-local 'allout-mode) 811(make-variable-buffer-local 'allout-mode)
812;;;_ = allout-layout nil 812;;;_ = allout-layout nil
813(defvar allout-layout nil ; LEAVE GLOBAL VALUE NIL - see docstring. 813(defvar allout-layout nil ; LEAVE GLOBAL VALUE NIL -- see docstring.
814 "Buffer-specific setting for allout layout. 814 "Buffer-specific setting for allout layout.
815 815
816In buffers where this is non-nil (and if `allout-init' has been run, to 816In buffers where this is non-nil (and if `allout-init' has been run, to
@@ -854,7 +854,7 @@ by `set-allout-regexp'.")
854(defvar allout-bullets-string "" 854(defvar allout-bullets-string ""
855 "A string dictating the valid set of outline topic bullets. 855 "A string dictating the valid set of outline topic bullets.
856 856
857This var should *not* be set by the user - it is set by `set-allout-regexp', 857This var should *not* be set by the user -- it is set by `set-allout-regexp',
858and is produced from the elements of `allout-plain-bullets-string' 858and is produced from the elements of `allout-plain-bullets-string'
859and `allout-distinctive-bullets-string'.") 859and `allout-distinctive-bullets-string'.")
860(make-variable-buffer-local 'allout-bullets-string) 860(make-variable-buffer-local 'allout-bullets-string)
@@ -886,7 +886,7 @@ topic prefix to be matched.")
886(make-variable-buffer-local 'allout-depth-one-regexp) 886(make-variable-buffer-local 'allout-depth-one-regexp)
887;;;_ = allout-line-boundary-regexp 887;;;_ = allout-line-boundary-regexp
888(defvar allout-line-boundary-regexp () 888(defvar allout-line-boundary-regexp ()
889 "`allout-regexp' with outline style beginning-of-line anchor. 889 "`allout-regexp' prepended with a newline for the search target.
890 890
891This is properly set by `set-allout-regexp'.") 891This is properly set by `set-allout-regexp'.")
892(make-variable-buffer-local 'allout-line-boundary-regexp) 892(make-variable-buffer-local 'allout-line-boundary-regexp)
@@ -970,7 +970,7 @@ invoking it directly."
970 comment-start 970 comment-start
971 t))) 971 t)))
972 allout-use-mode-specific-leader 972 allout-use-mode-specific-leader
973 ;; Oops - garbled value, equate with effect of 't: 973 ;; Oops -- garbled value, equate with effect of t:
974 t))) 974 t)))
975 (leader 975 (leader
976 (cond 976 (cond
@@ -998,8 +998,8 @@ invoking it directly."
998 nil 998 nil
999 (setq allout-header-prefix leader) 999 (setq allout-header-prefix leader)
1000 (if (not allout-old-style-prefixes) 1000 (if (not allout-old-style-prefixes)
1001 ;; setting allout-primary-bullet makes the top level topics use - 1001 ;; setting allout-primary-bullet makes the top level topics use --
1002 ;; actually, be - the special prefix: 1002 ;; actually, be -- the special prefix:
1003 (setq allout-primary-bullet leader)) 1003 (setq allout-primary-bullet leader))
1004 allout-header-prefix))) 1004 allout-header-prefix)))
1005(defalias 'allout-infer-header-lead 1005(defalias 'allout-infer-header-lead
@@ -1058,7 +1058,7 @@ Also refresh various data structures that hinge on the regexp."
1058 (setq allout-plain-bullets-string-len (length allout-plain-bullets-string)) 1058 (setq allout-plain-bullets-string-len (length allout-plain-bullets-string))
1059 (setq allout-header-subtraction (1- (length allout-header-prefix))) 1059 (setq allout-header-subtraction (1- (length allout-header-prefix)))
1060 1060
1061 (let (new-part old-part) 1061 (let (new-part old-part formfeed-part)
1062 (setq new-part (concat "\\(" 1062 (setq new-part (concat "\\("
1063 (regexp-quote allout-header-prefix) 1063 (regexp-quote allout-header-prefix)
1064 "[ \t]*" 1064 "[ \t]*"
@@ -1072,18 +1072,26 @@ Also refresh various data structures that hinge on the regexp."
1072 "\\)" 1072 "\\)"
1073 "+" 1073 "+"
1074 " ?[^" allout-primary-bullet "]") 1074 " ?[^" allout-primary-bullet "]")
1075 formfeed-part "\\(\^L\\)"
1076
1075 allout-regexp (concat new-part 1077 allout-regexp (concat new-part
1076 "\\|" 1078 "\\|"
1077 old-part 1079 old-part
1078 "\\|\^l") 1080 "\\|"
1081 formfeed-part)
1079 1082
1080 allout-line-boundary-regexp (concat "\n" new-part 1083 allout-line-boundary-regexp (concat "\n" new-part
1081 "\\|" 1084 "\\|"
1082 "\n" old-part) 1085 "\n" old-part
1086 "\\|"
1087 "\n" formfeed-part)
1083 1088
1084 allout-bob-regexp (concat "\\`" new-part 1089 allout-bob-regexp (concat "\\`" new-part
1085 "\\|" 1090 "\\|"
1086 "\\`" old-part)) 1091 "\\`" old-part
1092 "\\|"
1093 "\\`" formfeed-part
1094 ))
1087 1095
1088 (setq allout-depth-specific-regexp 1096 (setq allout-depth-specific-regexp
1089 (concat "\\(^\\|\\`\\)" 1097 (concat "\\(^\\|\\`\\)"
@@ -1140,10 +1148,10 @@ Also refresh various data structures that hinge on the regexp."
1140(defvar allout-mode-map nil "Keybindings for (allout) outline minor mode.") 1148(defvar allout-mode-map nil "Keybindings for (allout) outline minor mode.")
1141;;;_ > produce-allout-mode-map (keymap-alist &optional base-map) 1149;;;_ > produce-allout-mode-map (keymap-alist &optional base-map)
1142(defun produce-allout-mode-map (keymap-list &optional base-map) 1150(defun produce-allout-mode-map (keymap-list &optional base-map)
1143 "Produce keymap for use as allout-mode-map, from KEYMAP-LIST. 1151 "Produce keymap for use as `allout-mode-map', from KEYMAP-LIST.
1144 1152
1145Built on top of optional BASE-MAP, or empty sparse map if none specified. 1153Built on top of optional BASE-MAP, or empty sparse map if none specified.
1146See doc string for allout-keybindings-list for format of binding list." 1154See doc string for `allout-keybindings-list' for format of binding list."
1147 (let ((map (or base-map (make-sparse-keymap))) 1155 (let ((map (or base-map (make-sparse-keymap)))
1148 (pref (list allout-command-prefix))) 1156 (pref (list allout-command-prefix)))
1149 (mapc (function 1157 (mapc (function
@@ -1255,7 +1263,7 @@ extended from the existing one by `append'ing a list containing the second
1255element of the pair onto the end of the existing value. 1263element of the pair onto the end of the existing value.
1256 1264
1257Extension, and resumptions in general, should not be used for hook 1265Extension, and resumptions in general, should not be used for hook
1258functions - use the 'local mode of `add-hook' for that, instead. 1266functions -- use the 'local mode of `add-hook' for that, instead.
1259 1267
1260The settings are stored on `allout-mode-prior-settings'." 1268The settings are stored on `allout-mode-prior-settings'."
1261 (while pairs 1269 (while pairs
@@ -1274,7 +1282,7 @@ The settings are stored on `allout-mode-prior-settings'."
1274 (when (not (assoc name allout-mode-prior-settings)) 1282 (when (not (assoc name allout-mode-prior-settings))
1275 ;; Not already added as a resumption, create the prior setting entry. 1283 ;; Not already added as a resumption, create the prior setting entry.
1276 (if (local-variable-p name) 1284 (if (local-variable-p name)
1277 ;; is already local variable - preserve the prior value: 1285 ;; is already local variable -- preserve the prior value:
1278 (push (list name prior-value) allout-mode-prior-settings) 1286 (push (list name prior-value) allout-mode-prior-settings)
1279 ;; wasn't local variable, indicate so for resumption by killing 1287 ;; wasn't local variable, indicate so for resumption by killing
1280 ;; local value, and make it local: 1288 ;; local value, and make it local:
@@ -1340,9 +1348,9 @@ It is run at the conclusion of `allout-flag-region'.
1340 1348
1341Functions on the hook must take three arguments: 1349Functions on the hook must take three arguments:
1342 1350
1343 - from - integer indicating the point at the start of the change. 1351 - FROM -- integer indicating the point at the start of the change.
1344 - to - integer indicating the point of the end of the change. 1352 - TO -- integer indicating the point of the end of the change.
1345 - flag - change mode: nil for exposure, otherwise concealment. 1353 - FLAG -- change mode: nil for exposure, otherwise concealment.
1346 1354
1347This hook might be invoked multiple times by a single command. 1355This hook might be invoked multiple times by a single command.
1348 1356
@@ -1354,10 +1362,10 @@ and eventually will not be invoked.")
1354 1362
1355Functions on the hook should take two arguments: 1363Functions on the hook should take two arguments:
1356 1364
1357 - new-start - integer indicating the point at the start of the first new item. 1365 - NEW-START -- integer indicating position of start of the first new item.
1358 - new-end - integer indicating the point of the end of the last new item. 1366 - NEW-END -- integer indicating position of end of the last new item.
1359 1367
1360Some edits that introduce new items may missed by this hook - 1368Some edits that introduce new items may missed by this hook:
1361specifically edits that native allout routines do not control. 1369specifically edits that native allout routines do not control.
1362 1370
1363This hook might be invoked multiple times by a single command.") 1371This hook might be invoked multiple times by a single command.")
@@ -1367,10 +1375,10 @@ This hook might be invoked multiple times by a single command.")
1367 1375
1368Functions on the hook must take two arguments: 1376Functions on the hook must take two arguments:
1369 1377
1370 - depth - integer indicating the depth of the subtree that was deleted. 1378 - DEPTH -- integer indicating the depth of the subtree that was deleted.
1371 - removed-from - integer indicating the point where the subtree was removed. 1379 - REMOVED-FROM -- integer indicating the point where the subtree was removed.
1372 1380
1373Some edits that remove or invalidate items may missed by this hook - 1381Some edits that remove or invalidate items may missed by this hook:
1374specifically edits that native allout routines do not control. 1382specifically edits that native allout routines do not control.
1375 1383
1376This hook might be invoked multiple times by a single command.") 1384This hook might be invoked multiple times by a single command.")
@@ -1380,10 +1388,10 @@ This hook might be invoked multiple times by a single command.")
1380 1388
1381Functions on the hook should take two arguments: 1389Functions on the hook should take two arguments:
1382 1390
1383 - depth-change - integer indicating depth increase, negative for decrease 1391 - DEPTH-CHANGE -- integer indicating depth increase, negative for decrease
1384 - start - integer indicating the start point of the shifted parent item. 1392 - START -- integer indicating the start point of the shifted parent item.
1385 1393
1386Some edits that shift items can be missed by this hook - specifically edits 1394Some edits that shift items can be missed by this hook: specifically edits
1387that native allout routines do not control. 1395that native allout routines do not control.
1388 1396
1389This hook might be invoked multiple times by a single command.") 1397This hook might be invoked multiple times by a single command.")
@@ -1460,7 +1468,7 @@ substition is used against the regexp matches, a la `replace-match'.")
1460 "Variable for regexps matching plaintext to remove before encryption. 1468 "Variable for regexps matching plaintext to remove before encryption.
1461 1469
1462This is for the sake of redoing encryption in cases where the ciphertext 1470This is for the sake of redoing encryption in cases where the ciphertext
1463incidentally contains strings that would disrupt mode operation - 1471incidentally contains strings that would disrupt mode operation --
1464for example, a line that happens to look like an allout-mode topic prefix. 1472for example, a line that happens to look like an allout-mode topic prefix.
1465 1473
1466Entries must be symbols that are bound to the desired regexp values. 1474Entries must be symbols that are bound to the desired regexp values.
@@ -1478,7 +1486,7 @@ See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.")
1478(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-ceiling) 1486(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-ceiling)
1479;;;_ > allout-mode-p () 1487;;;_ > allout-mode-p ()
1480;; Must define this macro above any uses, or byte compilation will lack 1488;; Must define this macro above any uses, or byte compilation will lack
1481;; proper def, if file isn't loaded - eg, during emacs build! 1489;; proper def, if file isn't loaded -- eg, during emacs build!
1482(defmacro allout-mode-p () 1490(defmacro allout-mode-p ()
1483 "Return t if `allout-mode' is active in current buffer." 1491 "Return t if `allout-mode' is active in current buffer."
1484 'allout-mode) 1492 'allout-mode)
@@ -1501,13 +1509,12 @@ See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.")
1501 (condition-case failure 1509 (condition-case failure
1502 (setq allout-after-save-decrypt 1510 (setq allout-after-save-decrypt
1503 (allout-encrypt-decrypted except-mark)) 1511 (allout-encrypt-decrypted except-mark))
1504 (message "allout-write-file-hook-handler suppressing error %s" 1512 (error (message
1505 failure) 1513 "allout-write-file-hook-handler suppressing error %s"
1506 (sit-for 2) 1514 failure)
1507 (error "allout-write-file-hook-handler suppressing error %s" 1515 (sit-for 2)))))
1508 failure))))
1509 )) 1516 ))
1510 nil) 1517 nil)
1511;;;_ > allout-auto-save-hook-handler () 1518;;;_ > allout-auto-save-hook-handler ()
1512(defun allout-auto-save-hook-handler () 1519(defun allout-auto-save-hook-handler ()
1513 "Implement `allout-encrypt-unencrypted-on-saves' policy for auto save." 1520 "Implement `allout-encrypt-unencrypted-on-saves' policy for auto save."
@@ -1653,9 +1660,9 @@ the following two lines in your Emacs init file:
1653 (put 'allout-exposure-category 'invisible 'allout) 1660 (put 'allout-exposure-category 'invisible 'allout)
1654 (put 'allout-exposure-category 'evaporate t) 1661 (put 'allout-exposure-category 'evaporate t)
1655 ;; XXX We use isearch-open-invisible *and* isearch-mode-end-hook. The 1662 ;; XXX We use isearch-open-invisible *and* isearch-mode-end-hook. The
1656 ;; latter would be sufficient, but it seems that a separate behavior - 1663 ;; latter would be sufficient, but it seems that a separate behavior --
1657 ;; the _transient_ opening of invisible text during isearch - is keyed to 1664 ;; the _transient_ opening of invisible text during isearch -- is keyed to
1658 ;; presence of the isearch-open-invisible property - even though this 1665 ;; presence of the isearch-open-invisible property -- even though this
1659 ;; property controls the isearch _arrival_ behavior. This is the case at 1666 ;; property controls the isearch _arrival_ behavior. This is the case at
1660 ;; least in emacs 21, 22.0, and xemacs 21.4. 1667 ;; least in emacs 21, 22.0, and xemacs 21.4.
1661 (put 'allout-exposure-category 'isearch-open-invisible 1668 (put 'allout-exposure-category 'isearch-open-invisible
@@ -1709,7 +1716,7 @@ variable. We recommend customizing `allout-command-prefix' to use just
1709`\\C-c' as the command prefix, if the allout bindings don't conflict with 1716`\\C-c' as the command prefix, if the allout bindings don't conflict with
1710any personal bindings you have on \\C-c. In any case, outline structure 1717any personal bindings you have on \\C-c. In any case, outline structure
1711navigation and authoring is simplified by positioning the cursor on an 1718navigation and authoring is simplified by positioning the cursor on an
1712item's bullet character, the \"hot-spot\" - then you can invoke allout 1719item's bullet character, the \"hot-spot\" -- then you can invoke allout
1713commands with just the un-prefixed, un-control-shifted command letters. 1720commands with just the un-prefixed, un-control-shifted command letters.
1714This is described further in the HOT-SPOT Operation section. 1721This is described further in the HOT-SPOT Operation section.
1715 1722
@@ -1730,7 +1737,7 @@ This is described further in the HOT-SPOT Operation section.
1730\\[allout-backward-current-level] `allout-backward-current-level' 1737\\[allout-backward-current-level] `allout-backward-current-level'
1731\\[allout-end-of-entry] `allout-end-of-entry' 1738\\[allout-end-of-entry] `allout-end-of-entry'
1732\\[allout-beginning-of-current-entry] `allout-beginning-of-current-entry' (alternately, goes to hot-spot) 1739\\[allout-beginning-of-current-entry] `allout-beginning-of-current-entry' (alternately, goes to hot-spot)
1733\\[allout-beginning-of-line] `allout-beginning-of-line' - like regular beginning-of-line, but 1740\\[allout-beginning-of-line] `allout-beginning-of-line' -- like regular beginning-of-line, but
1734 if immediately repeated cycles to the beginning of the current item 1741 if immediately repeated cycles to the beginning of the current item
1735 and then to the hot-spot (if `allout-beginning-of-line-cycles' is set). 1742 and then to the hot-spot (if `allout-beginning-of-line-cycles' is set).
1736 1743
@@ -1748,9 +1755,9 @@ This is described further in the HOT-SPOT Operation section.
1748\\[allout-rebullet-current-heading] `allout-rebullet-current-heading' Prompt for alternate bullet for 1755\\[allout-rebullet-current-heading] `allout-rebullet-current-heading' Prompt for alternate bullet for
1749 current topic 1756 current topic
1750\\[allout-rebullet-topic] `allout-rebullet-topic' Reconcile bullets of topic and 1757\\[allout-rebullet-topic] `allout-rebullet-topic' Reconcile bullets of topic and
1751 its' offspring - distinctive bullets are not changed, others 1758 its' offspring -- distinctive bullets are not changed, others
1752 are alternated according to nesting depth. 1759 are alternated according to nesting depth.
1753\\[allout-number-siblings] `allout-number-siblings' Number bullets of topic and siblings - 1760\\[allout-number-siblings] `allout-number-siblings' Number bullets of topic and siblings --
1754 the offspring are not affected. 1761 the offspring are not affected.
1755 With repeat count, revoke numbering. 1762 With repeat count, revoke numbering.
1756 1763
@@ -1779,7 +1786,7 @@ M-x outlineify-sticky Activate outline mode for current buffer,
1779\\[allout-copy-exposed-to-buffer] `allout-copy-exposed-to-buffer' 1786\\[allout-copy-exposed-to-buffer] `allout-copy-exposed-to-buffer'
1780 Duplicate outline, sans concealed text, to 1787 Duplicate outline, sans concealed text, to
1781 buffer with name derived from derived from that 1788 buffer with name derived from derived from that
1782 of current buffer - \"*BUFFERNAME exposed*\". 1789 of current buffer -- \"*BUFFERNAME exposed*\".
1783\\[allout-flatten-exposed-to-buffer] `allout-flatten-exposed-to-buffer' 1790\\[allout-flatten-exposed-to-buffer] `allout-flatten-exposed-to-buffer'
1784 Like above 'copy-exposed', but convert topic 1791 Like above 'copy-exposed', but convert topic
1785 prefixes to section.subsection... numeric 1792 prefixes to section.subsection... numeric
@@ -1848,7 +1855,7 @@ without changes to the allout core. Here are key ones:
1848 1855
1849 Terminology 1856 Terminology
1850 1857
1851Topic hierarchy constituents - TOPICS and SUBTOPICS: 1858Topic hierarchy constituents -- TOPICS and SUBTOPICS:
1852 1859
1853ITEM: A unitary outline element, including the HEADER and ENTRY text. 1860ITEM: A unitary outline element, including the HEADER and ENTRY text.
1854TOPIC: An ITEM and any ITEMs contained within it, ie having greater DEPTH 1861TOPIC: An ITEM and any ITEMs contained within it, ie having greater DEPTH
@@ -1956,7 +1963,7 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
1956 1963
1957 (cond 1964 (cond
1958 1965
1959 ;; Provision for v19.18, 19.19 bug - 1966 ;; Provision for v19.18, 19.19 bug --
1960 ;; Emacs v 19.18, 19.19 file-var code invokes prop-line-designated 1967 ;; Emacs v 19.18, 19.19 file-var code invokes prop-line-designated
1961 ;; modes twice when file is visited. We have to avoid toggling mode 1968 ;; modes twice when file is visited. We have to avoid toggling mode
1962 ;; off on second invocation, so we detect it as best we can, and 1969 ;; off on second invocation, so we detect it as best we can, and
@@ -2101,7 +2108,7 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
2101 (progn 2108 (progn
2102 (apply 'allout-expose-topic (list use-layout)) 2109 (apply 'allout-expose-topic (list use-layout))
2103 (message "Adjusting '%s' exposure... done." (buffer-name))) 2110 (message "Adjusting '%s' exposure... done." (buffer-name)))
2104 ;; Problem applying exposure - notify user, but don't 2111 ;; Problem applying exposure -- notify user, but don't
2105 ;; interrupt, eg, file visit: 2112 ;; interrupt, eg, file visit:
2106 (error (message "%s" (car (cdr err))) 2113 (error (message "%s" (car (cdr err)))
2107 (sit-for 1)))))) 2114 (sit-for 1))))))
@@ -2136,6 +2143,16 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
2136;;;_ > allout-minor-mode 2143;;;_ > allout-minor-mode
2137(defalias 'allout-minor-mode 'allout-mode) 2144(defalias 'allout-minor-mode 'allout-mode)
2138 2145
2146;;;_ > allout-unload-function
2147(defun allout-unload-function ()
2148 "Unload the allout outline library."
2149 (save-current-buffer
2150 (dolist (buffer (buffer-list))
2151 (set-buffer buffer)
2152 (when allout-mode (allout-mode -1))))
2153 ;; continue standard unloading
2154 nil)
2155
2139;;;_ - Position Assessment 2156;;;_ - Position Assessment
2140;;;_ > allout-hidden-p (&optional pos) 2157;;;_ > allout-hidden-p (&optional pos)
2141(defsubst allout-hidden-p (&optional pos) 2158(defsubst allout-hidden-p (&optional pos)
@@ -2158,10 +2175,10 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
2158 "Get confirmation before making arbitrary changes to invisible text. 2175 "Get confirmation before making arbitrary changes to invisible text.
2159 2176
2160We expose the invisible text and ask for confirmation. Refusal or 2177We expose the invisible text and ask for confirmation. Refusal or
2161keyboard-quit abandons the changes, with keyboard-quit additionally 2178`keyboard-quit' abandons the changes, with keyboard-quit additionally
2162reclosing the opened text. 2179reclosing the opened text.
2163 2180
2164No confirmation is necessary when inhibit-read-only is set - eg, allout 2181No confirmation is necessary when `inhibit-read-only' is set -- eg, allout
2165internal functions use this feature cohesively bunch changes." 2182internal functions use this feature cohesively bunch changes."
2166 2183
2167 (when (and (not inhibit-read-only) (not after)) 2184 (when (and (not inhibit-read-only) (not after))
@@ -2199,7 +2216,7 @@ internal functions use this feature cohesively bunch changes."
2199(defun allout-before-change-handler (beg end) 2216(defun allout-before-change-handler (beg end)
2200 "Protect against changes to invisible text. 2217 "Protect against changes to invisible text.
2201 2218
2202See allout-overlay-interior-modification-handler for details." 2219See `allout-overlay-interior-modification-handler' for details."
2203 2220
2204 (if (and (allout-mode-p) undo-in-progress (allout-hidden-p)) 2221 (if (and (allout-mode-p) undo-in-progress (allout-hidden-p))
2205 (allout-show-to-offshoot)) 2222 (allout-show-to-offshoot))
@@ -2224,7 +2241,7 @@ function can also be used as an `isearch-mode-end-hook'."
2224 (if (and (allout-mode-p) (allout-hidden-p)) 2241 (if (and (allout-mode-p) (allout-hidden-p))
2225 (allout-show-to-offshoot))) 2242 (allout-show-to-offshoot)))
2226 2243
2227;;;_ #3 Internal Position State-Tracking - "allout-recent-*" funcs 2244;;;_ #3 Internal Position State-Tracking -- "allout-recent-*" funcs
2228;;; All the basic outline functions that directly do string matches to 2245;;; All the basic outline functions that directly do string matches to
2229;;; evaluate heading prefix location set the variables 2246;;; evaluate heading prefix location set the variables
2230;;; `allout-recent-prefix-beginning' and `allout-recent-prefix-end' 2247;;; `allout-recent-prefix-beginning' and `allout-recent-prefix-end'
@@ -2252,10 +2269,12 @@ function can also be used as an `isearch-mode-end-hook'."
2252(defsubst allout-prefix-data () 2269(defsubst allout-prefix-data ()
2253 "Register allout-prefix state data. 2270 "Register allout-prefix state data.
2254 2271
2255For reference by `allout-recent' funcs. Returns BEGINNING." 2272For reference by `allout-recent' funcs. Return
2256 (setq allout-recent-prefix-end (or (match-end 1) (match-end 2)) 2273the new value of `allout-recent-prefix-beginning'."
2274 (setq allout-recent-prefix-end (or (match-end 1) (match-end 2) (match-end 3))
2257 allout-recent-prefix-beginning (or (match-beginning 1) 2275 allout-recent-prefix-beginning (or (match-beginning 1)
2258 (match-beginning 2)) 2276 (match-beginning 2)
2277 (match-beginning 3))
2259 allout-recent-depth (max 1 (- allout-recent-prefix-end 2278 allout-recent-depth (max 1 (- allout-recent-prefix-end
2260 allout-recent-prefix-beginning 2279 allout-recent-prefix-beginning
2261 allout-header-subtraction))) 2280 allout-header-subtraction)))
@@ -2306,7 +2325,7 @@ to return the current depth of the most recently matched topic."
2306(defsubst allout-do-doublecheck () 2325(defsubst allout-do-doublecheck ()
2307 "True if current item conditions qualify for checking on topic aberrance." 2326 "True if current item conditions qualify for checking on topic aberrance."
2308 (and 2327 (and
2309 ;; presume integrity of outline and yanked content during yank - necessary, 2328 ;; presume integrity of outline and yanked content during yank -- necessary
2310 ;; to allow for level disparity of yank location and yanked text: 2329 ;; to allow for level disparity of yank location and yanked text:
2311 (not allout-inhibit-aberrance-doublecheck) 2330 (not allout-inhibit-aberrance-doublecheck)
2312 ;; allout-doublecheck-at-and-shallower is ceiling for doublecheck: 2331 ;; allout-doublecheck-at-and-shallower is ceiling for doublecheck:
@@ -2344,12 +2363,12 @@ exceeds the topic by more than one."
2344 (allout-prefix-data) 2363 (allout-prefix-data)
2345 (goto-char allout-recent-prefix-beginning) 2364 (goto-char allout-recent-prefix-beginning)
2346 (cond 2365 (cond
2347 ;; sibling - continue: 2366 ;; sibling -- continue:
2348 ((eq allout-recent-depth depth)) 2367 ((eq allout-recent-depth depth))
2349 ;; first offspring is excessive - aberrant: 2368 ;; first offspring is excessive -- aberrant:
2350 ((> allout-recent-depth (1+ depth)) 2369 ((> allout-recent-depth (1+ depth))
2351 (setq done t aberrant t)) 2370 (setq done t aberrant t))
2352 ;; next non-sibling is lower-depth - not aberrant: 2371 ;; next non-sibling is lower-depth -- not aberrant:
2353 (t (setq done t)))))) 2372 (t (setq done t))))))
2354 (if aberrant 2373 (if aberrant
2355 aberrant 2374 aberrant
@@ -2384,6 +2403,8 @@ Actually, returns prefix beginning point."
2384(defun allout-depth () 2403(defun allout-depth ()
2385 "Return depth of topic most immediately containing point. 2404 "Return depth of topic most immediately containing point.
2386 2405
2406Does not do doublecheck for aberrant topic header.
2407
2387Return zero if point is not within any topic. 2408Return zero if point is not within any topic.
2388 2409
2389Like `allout-current-depth', but respects hidden as well as visible topics." 2410Like `allout-current-depth', but respects hidden as well as visible topics."
@@ -2490,7 +2511,7 @@ Outermost is first."
2490;;;_ > allout-end-of-current-line () 2511;;;_ > allout-end-of-current-line ()
2491(defun allout-end-of-current-line () 2512(defun allout-end-of-current-line ()
2492 "Move to the end of line, past concealed text if any." 2513 "Move to the end of line, past concealed text if any."
2493 ;; XXX This is for symmetry with `allout-beginning-of-current-line' - 2514 ;; XXX This is for symmetry with `allout-beginning-of-current-line' --
2494 ;; `move-end-of-line' doesn't suffer the same problem as 2515 ;; `move-end-of-line' doesn't suffer the same problem as
2495 ;; `move-beginning-of-line'. 2516 ;; `move-beginning-of-line'.
2496 (let ((inhibit-field-text-motion t)) 2517 (let ((inhibit-field-text-motion t))
@@ -2564,7 +2585,7 @@ Outermost is first."
2564 2585
2565Returns the location of the heading, or nil if none found. 2586Returns the location of the heading, or nil if none found.
2566 2587
2567We skip anomolous low-level topics, a la `allout-aberrant-container-p'." 2588We skip anomalous low-level topics, a la `allout-aberrant-container-p'."
2568 (save-match-data 2589 (save-match-data
2569 2590
2570 (if (looking-at allout-regexp) 2591 (if (looking-at allout-regexp)
@@ -2572,10 +2593,14 @@ We skip anomolous low-level topics, a la `allout-aberrant-container-p'."
2572 2593
2573 (when (re-search-forward allout-line-boundary-regexp nil 0) 2594 (when (re-search-forward allout-line-boundary-regexp nil 0)
2574 (allout-prefix-data) 2595 (allout-prefix-data)
2596 (goto-char allout-recent-prefix-beginning)
2597 (while (not (bolp))
2598 (forward-char -1))
2575 (and (allout-do-doublecheck) 2599 (and (allout-do-doublecheck)
2576 ;; this will set allout-recent-* on the first non-aberrant topic, 2600 ;; this will set allout-recent-* on the first non-aberrant topic,
2577 ;; whether it's the current one or one that disqualifies it: 2601 ;; whether it's the current one or one that disqualifies it:
2578 (allout-aberrant-container-p)) 2602 (allout-aberrant-container-p))
2603 ;; this may or may not be the same as above depending on doublecheck:
2579 (goto-char allout-recent-prefix-beginning)))) 2604 (goto-char allout-recent-prefix-beginning))))
2580;;;_ > allout-this-or-next-heading 2605;;;_ > allout-this-or-next-heading
2581(defun allout-this-or-next-heading () 2606(defun allout-this-or-next-heading ()
@@ -2589,7 +2614,7 @@ We skip anomolous low-level topics, a la `allout-aberrant-container-p'."
2589 2614
2590Return the location of the beginning of the heading, or nil if not found. 2615Return the location of the beginning of the heading, or nil if not found.
2591 2616
2592We skip anomolous low-level topics, a la `allout-aberrant-container-p'." 2617We skip anomalous low-level topics, a la `allout-aberrant-container-p'."
2593 2618
2594 (if (bobp) 2619 (if (bobp)
2595 nil 2620 nil
@@ -2687,9 +2712,9 @@ starting point, and PREV-DEPTH is depth of prior topic."
2687 ;; Register this one and move on: 2712 ;; Register this one and move on:
2688 (setq chart (cons allout-recent-prefix-beginning chart)) 2713 (setq chart (cons allout-recent-prefix-beginning chart))
2689 (if (and levels (<= levels 1)) 2714 (if (and levels (<= levels 1))
2690 ;; At depth limit - skip sublevels: 2715 ;; At depth limit -- skip sublevels:
2691 (or (allout-next-sibling curr-depth) 2716 (or (allout-next-sibling curr-depth)
2692 ;; or no more siblings - proceed to 2717 ;; or no more siblings -- proceed to
2693 ;; next heading at lesser depth: 2718 ;; next heading at lesser depth:
2694 (while (and (<= curr-depth 2719 (while (and (<= curr-depth
2695 allout-recent-depth) 2720 allout-recent-depth)
@@ -2762,7 +2787,7 @@ start point."
2762 (let ((further (allout-chart-to-reveal here (if (null depth) 2787 (let ((further (allout-chart-to-reveal here (if (null depth)
2763 depth 2788 depth
2764 (1- depth))))) 2789 (1- depth)))))
2765 ;; We're on the start of a subtree - recurse with it, if there's 2790 ;; We're on the start of a subtree -- recurse with it, if there's
2766 ;; more depth to go: 2791 ;; more depth to go:
2767 (if further (setq result (append further result))) 2792 (if further (setq result (append further result)))
2768 (setq chart (cdr chart))) 2793 (setq chart (cdr chart)))
@@ -3150,7 +3175,7 @@ situation."
3150 (progn (goto-char start-point) 3175 (progn (goto-char start-point)
3151 nil) 3176 nil)
3152 ;; rationale: if any intervening items were at a lower depth, we 3177 ;; rationale: if any intervening items were at a lower depth, we
3153 ;; would now be on the first offspring at the target depth - ie, 3178 ;; would now be on the first offspring at the target depth -- ie,
3154 ;; the preceeding item (per the search direction) must be at a 3179 ;; the preceeding item (per the search direction) must be at a
3155 ;; lesser depth. that's all we need to check. 3180 ;; lesser depth. that's all we need to check.
3156 (if backward (allout-next-heading) (allout-previous-heading)) 3181 (if backward (allout-next-heading) (allout-previous-heading))
@@ -3228,7 +3253,7 @@ Move to buffer limit in indicated direction if headings are exhausted."
3228 (allout-aberrant-container-p)) 3253 (allout-aberrant-container-p))
3229 ;; skip this aberrant prospective header line: 3254 ;; skip this aberrant prospective header line:
3230 t 3255 t
3231 ;; this prospective headerline qualifies - register: 3256 ;; this prospective headerline qualifies -- register:
3232 (setq got allout-recent-prefix-beginning) 3257 (setq got allout-recent-prefix-beginning)
3233 ;; and break the loop: 3258 ;; and break the loop:
3234 nil))))) 3259 nil)))))
@@ -3396,7 +3421,7 @@ Returns the qualifying command, if any, else nil."
3396 (>= 122 key-num)) ; "z" 3421 (>= 122 key-num)) ; "z"
3397 (- key-num 96) key-num))) 3422 (- key-num 96) key-num)))
3398 t)))) 3423 t))))
3399 ;; Qualified as an allout command - do hot-spot operation. 3424 ;; Qualified as an allout command -- do hot-spot operation.
3400 (setq allout-post-goto-bullet t) 3425 (setq allout-post-goto-bullet t)
3401 ;; accept-defaults nil, or else we'll get allout-item-icon-key-handler. 3426 ;; accept-defaults nil, or else we'll get allout-item-icon-key-handler.
3402 (setq mapped-binding (key-binding (char-to-string key-num)))) 3427 (setq mapped-binding (key-binding (char-to-string key-num))))
@@ -3498,7 +3523,7 @@ Second arg NEW indicates that a new topic is being opened after the
3498topic at point, if non-nil. Default bullet for new topics, eg, may 3523topic at point, if non-nil. Default bullet for new topics, eg, may
3499be set (contingent to other args) to numbered bullets if previous 3524be set (contingent to other args) to numbered bullets if previous
3500sibling is one. The implication otherwise is that the current topic 3525sibling is one. The implication otherwise is that the current topic
3501is being adjusted - shifted or rebulleted - and we don't consider 3526is being adjusted -- shifted or rebulleted -- and we don't consider
3502bullet or previous sibling. 3527bullet or previous sibling.
3503 3528
3504Third arg DEPTH forces the topic prefix to that depth, regardless of 3529Third arg DEPTH forces the topic prefix to that depth, regardless of
@@ -3544,11 +3569,11 @@ index for each successive sibling)."
3544 ;; Getting value for bullet char is practically the whole job: 3569 ;; Getting value for bullet char is practically the whole job:
3545 3570
3546 (cond 3571 (cond
3547 ; Simplest situation - level 1: 3572 ; Simplest situation -- level 1:
3548 ((<= depth 1) (setq header-lead "") allout-primary-bullet) 3573 ((<= depth 1) (setq header-lead "") allout-primary-bullet)
3549 ; Simple, too: all asterisks: 3574 ; Simple, too: all asterisks:
3550 (allout-old-style-prefixes 3575 (allout-old-style-prefixes
3551 ;; Cheat - make body the whole thing, null out header-lead and 3576 ;; Cheat -- make body the whole thing, null out header-lead and
3552 ;; bullet-char: 3577 ;; bullet-char:
3553 (setq body (make-string depth 3578 (setq body (make-string depth
3554 (string-to-char allout-primary-bullet))) 3579 (string-to-char allout-primary-bullet)))
@@ -3626,8 +3651,8 @@ index for each successive sibling)."
3626 "Open a new topic at depth DEPTH. 3651 "Open a new topic at depth DEPTH.
3627 3652
3628New topic is situated after current one, unless optional flag BEFORE 3653New topic is situated after current one, unless optional flag BEFORE
3629is non-nil, or unless current line is completely empty - lacking even 3654is non-nil, or unless current line is completely empty -- lacking even
3630whitespace - in which case open is done on the current line. 3655whitespace -- in which case open is done on the current line.
3631 3656
3632When adding an offspring, it will be added immediately after the parent if 3657When adding an offspring, it will be added immediately after the parent if
3633the other offspring are exposed, or after the last child if the offspring 3658the other offspring are exposed, or after the last child if the offspring
@@ -3692,7 +3717,7 @@ Nuances:
3692 3717
3693 (if (not opening-on-blank) 3718 (if (not opening-on-blank)
3694 ; Positioning and vertical 3719 ; Positioning and vertical
3695 ; padding - only if not 3720 ; padding -- only if not
3696 ; opening-on-blank: 3721 ; opening-on-blank:
3697 (progn 3722 (progn
3698 (goto-char ref-topic) 3723 (goto-char ref-topic)
@@ -3743,7 +3768,7 @@ Nuances:
3743 (open-line 1))) 3768 (open-line 1)))
3744 (allout-end-of-current-subtree) 3769 (allout-end-of-current-subtree)
3745 (if (looking-at "\n\n") (forward-char 1)))) 3770 (if (looking-at "\n\n") (forward-char 1))))
3746 ;; Going inwards - double-space if first offspring is 3771 ;; Going inwards -- double-space if first offspring is
3747 ;; double-spaced, otherwise snug up. 3772 ;; double-spaced, otherwise snug up.
3748 (allout-end-of-entry) 3773 (allout-end-of-entry)
3749 (if (eobp) 3774 (if (eobp)
@@ -3753,7 +3778,7 @@ Nuances:
3753 (backward-char 1) 3778 (backward-char 1)
3754 (if (bolp) 3779 (if (bolp)
3755 ;; Blank lines between current header body and next 3780 ;; Blank lines between current header body and next
3756 ;; header - get to last substantive (non-white-space) 3781 ;; header -- get to last substantive (non-white-space)
3757 ;; line in body: 3782 ;; line in body:
3758 (progn (setq dbl-space t) 3783 (progn (setq dbl-space t)
3759 (re-search-backward "[^ \t\n]" nil t))) 3784 (re-search-backward "[^ \t\n]" nil t)))
@@ -3900,9 +3925,9 @@ Note that refill of indented paragraphs is not done."
3900 (not (looking-at allout-regexp))) 3925 (not (looking-at allout-regexp)))
3901 (if (> 0 (setq excess (- (- old-indent-end old-indent-begin) 3926 (if (> 0 (setq excess (- (- old-indent-end old-indent-begin)
3902 old-margin))) 3927 old-margin)))
3903 ;; Text starts left of old margin - don't adjust: 3928 ;; Text starts left of old margin -- don't adjust:
3904 nil 3929 nil
3905 ;; Text was hanging at or right of old left margin - 3930 ;; Text was hanging at or right of old left margin --
3906 ;; reindent it, preserving its existing indentation 3931 ;; reindent it, preserving its existing indentation
3907 ;; beyond the old margin: 3932 ;; beyond the old margin:
3908 (delete-region old-indent-begin old-indent-end) 3933 (delete-region old-indent-begin old-indent-end)
@@ -3963,9 +3988,9 @@ Third arg NUMBER-CONTROL can force the prefix to or away from
3963numbered form. It has effect only if `allout-numbered-bullet' is 3988numbered form. It has effect only if `allout-numbered-bullet' is
3964non-nil and soliciting was not explicitly invoked (via first arg). 3989non-nil and soliciting was not explicitly invoked (via first arg).
3965Its effect, numbering or denumbering, then depends on the setting 3990Its effect, numbering or denumbering, then depends on the setting
3966of the forth arg, INDEX. 3991of the fourth arg, INDEX.
3967 3992
3968If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the 3993If NUMBER-CONTROL is non-nil and fourth arg INDEX is nil, then the
3969prefix of the topic is forced to be non-numbered. Null index and 3994prefix of the topic is forced to be non-numbered. Null index and
3970non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and 3995non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and
3971non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil 3996non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil
@@ -4050,7 +4075,7 @@ this function."
4050 4075
4051Descends into invisible as well as visible topics, however. 4076Descends into invisible as well as visible topics, however.
4052 4077
4053When optional sans-offspring is non-nil, subtopics are not 4078When optional SANS-OFFSPRING is non-nil, subtopics are not
4054shifted. (Shifting a topic outwards without shifting its 4079shifted. (Shifting a topic outwards without shifting its
4055offspring is disallowed, since this would create a \"containment 4080offspring is disallowed, since this would create a \"containment
4056discontinuity\", where the depth difference between a topic and 4081discontinuity\", where the depth difference between a topic and
@@ -4095,7 +4120,7 @@ Finally, if optional SANS-OFFSPRING is non-nil then the offspring
4095are not shifted. (Shifting a topic outwards without shifting 4120are not shifted. (Shifting a topic outwards without shifting
4096its offspring is disallowed, since this would create a 4121its offspring is disallowed, since this would create a
4097\"containment discontinuity\", where the depth difference between 4122\"containment discontinuity\", where the depth difference between
4098a topic and its immediate offspring is greater than one..)" 4123a topic and its immediate offspring is greater than one.)"
4099 4124
4100 ;; XXX the recursion here is peculiar, and in general the routine may 4125 ;; XXX the recursion here is peculiar, and in general the routine may
4101 ;; need simplification with refactoring. 4126 ;; need simplification with refactoring.
@@ -4160,7 +4185,7 @@ a topic and its immediate offspring is greater than one..)"
4160 nil)))) ;;; do-successors 4185 nil)))) ;;; do-successors
4161 4186
4162 ((< starting-depth new-depth) 4187 ((< starting-depth new-depth)
4163 ;; Rare case - subtopic more than one level deeper than parent. 4188 ;; Rare case -- subtopic more than one level deeper than parent.
4164 ;; Treat this one at an even deeper level: 4189 ;; Treat this one at an even deeper level:
4165 (allout-rebullet-topic-grunt relative-depth 4190 (allout-rebullet-topic-grunt relative-depth
4166 new-depth 4191 new-depth
@@ -4222,7 +4247,7 @@ Returns final depth."
4222(defun allout-number-siblings (&optional denumber) 4247(defun allout-number-siblings (&optional denumber)
4223 "Assign numbered topic prefix to this topic and its siblings. 4248 "Assign numbered topic prefix to this topic and its siblings.
4224 4249
4225With universal argument, denumber - assign default bullet to this 4250With universal argument, denumber -- assign default bullet to this
4226topic and its siblings. 4251topic and its siblings.
4227 4252
4228With repeated universal argument (`^U^U'), solicit bullet for each 4253With repeated universal argument (`^U^U'), solicit bullet for each
@@ -4381,7 +4406,7 @@ Trailing whitespace is killed with a topic if that whitespace:
4381 previous one. 4406 previous one.
4382 4407
4383Topic exposure is marked with text-properties, to be used by 4408Topic exposure is marked with text-properties, to be used by
4384allout-yank-processing for exposure recovery." 4409`allout-yank-processing' for exposure recovery."
4385 4410
4386 (interactive) 4411 (interactive)
4387 (let* ((inhibit-field-text-motion t) 4412 (let* ((inhibit-field-text-motion t)
@@ -4412,7 +4437,7 @@ allout-yank-processing for exposure recovery."
4412 (run-hook-with-args 'allout-structure-deleted-hook depth (point)))) 4437 (run-hook-with-args 'allout-structure-deleted-hook depth (point))))
4413;;;_ > allout-copy-topic-as-kill () 4438;;;_ > allout-copy-topic-as-kill ()
4414(defun allout-copy-topic-as-kill () 4439(defun allout-copy-topic-as-kill ()
4415 "Like allout-kill-topic, but save to kill ring instead of deleting." 4440 "Like `allout-kill-topic', but save to kill ring instead of deleting."
4416 (interactive) 4441 (interactive)
4417 (let ((buffer-read-only t)) 4442 (let ((buffer-read-only t))
4418 (condition-case nil 4443 (condition-case nil
@@ -4437,7 +4462,7 @@ allout-yank-processing for exposure recovery."
4437 'invisible 4462 'invisible
4438 nil end)))) 4463 nil end))))
4439 (if (or (not next) (eq prev next)) 4464 (if (or (not next) (eq prev next))
4440 ;; still not at start of hidden area - must not be any left. 4465 ;; still not at start of hidden area -- must not be any left.
4441 (setq done t) 4466 (setq done t)
4442 (goto-char next) 4467 (goto-char next)
4443 (setq prev next) 4468 (setq prev next)
@@ -4478,7 +4503,7 @@ allout-yank-processing for exposure recovery."
4478 'allout-was-hidden 4503 'allout-was-hidden
4479 nil end))) 4504 nil end)))
4480 (if (or (not next) (eq prev next)) 4505 (if (or (not next) (eq prev next))
4481 ;; no more or not advancing - must not be any left. 4506 ;; no more or not advancing -- must not be any left.
4482 (setq done t) 4507 (setq done t)
4483 (goto-char next) 4508 (goto-char next)
4484 (setq prev next) 4509 (setq prev next)
@@ -4533,10 +4558,9 @@ however, are left exactly like normal, non-allout-specific yanks."
4533 ;; `rectify-numbering' if resituating (where several topics may 4558 ;; `rectify-numbering' if resituating (where several topics may
4534 ;; be resituating) or yanking a topic into a topic slot (bol): 4559 ;; be resituating) or yanking a topic into a topic slot (bol):
4535 (rectify-numbering (or resituate 4560 (rectify-numbering (or resituate
4536 (and into-bol 4561 (and into-bol (looking-at allout-regexp)))))
4537 (looking-at allout-regexp)))))
4538 (if resituate 4562 (if resituate
4539 ;; Yanking a topic into the start of a topic - reconcile to fit: 4563 ;; Yanking a topic into the start of a topic -- reconcile to fit:
4540 (let* ((inhibit-field-text-motion t) 4564 (let* ((inhibit-field-text-motion t)
4541 (prefix-len (if (not (match-end 1)) 4565 (prefix-len (if (not (match-end 1))
4542 1 4566 1
@@ -4676,7 +4700,7 @@ works with normal `yank' in non-outline buffers."
4676 4700
4677Adapts level of popped topics to level of fresh prefix. 4701Adapts level of popped topics to level of fresh prefix.
4678 4702
4679Note - prefix changes to distinctive bullets will stick, if followed 4703Note -- prefix changes to distinctive bullets will stick, if followed
4680by pops to non-distinctive yanks. Bug..." 4704by pops to non-distinctive yanks. Bug..."
4681 4705
4682 (interactive "*p") 4706 (interactive "*p")
@@ -4695,7 +4719,7 @@ by pops to non-distinctive yanks. Bug..."
4695 (interactive) 4719 (interactive)
4696 (if (not allout-file-xref-bullet) 4720 (if (not allout-file-xref-bullet)
4697 (error 4721 (error
4698 "Outline cross references disabled - no `allout-file-xref-bullet'") 4722 "Outline cross references disabled -- no `allout-file-xref-bullet'")
4699 (if (not (string= (allout-current-bullet) allout-file-xref-bullet)) 4723 (if (not (string= (allout-current-bullet) allout-file-xref-bullet))
4700 (error "Current heading lacks cross-reference bullet `%s'" 4724 (error "Current heading lacks cross-reference bullet `%s'"
4701 allout-file-xref-bullet) 4725 allout-file-xref-bullet)
@@ -4919,16 +4943,16 @@ Useful for coherently exposing to a random point in a hidden region."
4919 ))) 4943 )))
4920;;;_ > allout-show-current-subtree (&optional arg) 4944;;;_ > allout-show-current-subtree (&optional arg)
4921(defun allout-show-current-subtree (&optional arg) 4945(defun allout-show-current-subtree (&optional arg)
4922 "Show everything within the current topic. With a repeat-count, 4946 "Show everything within the current topic.
4923expose this topic and its siblings." 4947With a repeat-count, expose this topic and its siblings."
4924 (interactive "P") 4948 (interactive "P")
4925 (save-excursion 4949 (save-excursion
4926 (if (<= (allout-current-depth) 0) 4950 (if (<= (allout-current-depth) 0)
4927 ;; Outside any topics - try to get to the first: 4951 ;; Outside any topics -- try to get to the first:
4928 (if (not (allout-next-heading)) 4952 (if (not (allout-next-heading))
4929 (error "No topics") 4953 (error "No topics")
4930 ;; got to first, outermost topic - set to expose it and siblings: 4954 ;; got to first, outermost topic -- set to expose it and siblings:
4931 (message "Above outermost topic - exposing all.") 4955 (message "Above outermost topic -- exposing all.")
4932 (allout-flag-region (point-min)(point-max) nil)) 4956 (allout-flag-region (point-min)(point-max) nil))
4933 (allout-beginning-of-current-line) 4957 (allout-beginning-of-current-line)
4934 (if (not arg) 4958 (if (not arg)
@@ -4966,7 +4990,7 @@ siblings, even if the target topic is already closed."
4966 4990
4967 (interactive) 4991 (interactive)
4968 (let* ((from (point)) 4992 (let* ((from (point))
4969 (sibs-msg "Top-level topic already closed - closing siblings...") 4993 (sibs-msg "Top-level topic already closed -- closing siblings...")
4970 (current-exposed (not (allout-current-topic-collapsed-p t)))) 4994 (current-exposed (not (allout-current-topic-collapsed-p t))))
4971 (cond (current-exposed (allout-flag-current-subtree t)) 4995 (cond (current-exposed (allout-flag-current-subtree t))
4972 (just-close nil) 4996 (just-close nil)
@@ -5065,13 +5089,13 @@ Simple (numeric and null-list) specs are interpreted as follows:
5065 that level. 5089 that level.
5066 - positive numbers open to the relative depth indicated by the 5090 - positive numbers open to the relative depth indicated by the
5067 number, but do not force already opened subtopics to be closed. 5091 number, but do not force already opened subtopics to be closed.
5068 - 0 means to close topic - hide all offspring. 5092 - 0 means to close topic -- hide all offspring.
5069 : - `repeat' 5093 : - `repeat'
5070 apply prior element to all siblings at current level, *up to* 5094 apply prior element to all siblings at current level, *up to*
5071 those siblings that would be covered by specs following the `:' 5095 those siblings that would be covered by specs following the `:'
5072 on the list. Ie, apply to all topics at level but the last 5096 on the list. Ie, apply to all topics at level but the last
5073 ones. (Only first of multiple colons at same level is 5097 ones. (Only first of multiple colons at same level is
5074 respected - subsequent ones are discarded.) 5098 respected -- subsequent ones are discarded.)
5075 * - completely opens the topic, including bodies. 5099 * - completely opens the topic, including bodies.
5076 + - shows all the sub headers, but not the bodies 5100 + - shows all the sub headers, but not the bodies
5077 - - exposes the body of the corresponding topic. 5101 - - exposes the body of the corresponding topic.
@@ -5119,11 +5143,11 @@ Examples:
5119 ;; Expand the `repeat' spec to an explicit version, 5143 ;; Expand the `repeat' spec to an explicit version,
5120 ;; w.r.t. remaining siblings: 5144 ;; w.r.t. remaining siblings:
5121 (let ((residue ; = # of sibs not covered by remaining spec 5145 (let ((residue ; = # of sibs not covered by remaining spec
5122 ;; Dang - could be nice to make use of the chart, sigh: 5146 ;; Dang, could be nice to make use of the chart, sigh:
5123 (- (length (allout-chart-siblings)) 5147 (- (length (allout-chart-siblings))
5124 (length spec)))) 5148 (length spec))))
5125 (if (< 0 residue) 5149 (if (< 0 residue)
5126 ;; Some residue - cover it with prev-elem: 5150 ;; Some residue -- cover it with prev-elem:
5127 (setq spec (append (make-list residue prev-elem) 5151 (setq spec (append (make-list residue prev-elem)
5128 spec))))))) 5152 spec)))))))
5129 ((numberp curr-elem) 5153 ((numberp curr-elem)
@@ -5257,7 +5281,7 @@ Examples:
5257 (error "allout-new-exposure: Can't find any outline topics")) 5281 (error "allout-new-exposure: Can't find any outline topics"))
5258 (list 'allout-expose-topic (list 'quote spec)))) 5282 (list 'allout-expose-topic (list 'quote spec))))
5259 5283
5260;;;_ #7 Systematic outline presentation - copying, printing, flattening 5284;;;_ #7 Systematic outline presentation -- copying, printing, flattening
5261 5285
5262;;;_ - Mapping and processing of topics 5286;;;_ - Mapping and processing of topics
5263;;;_ ( See also Subtree Charting, in Navigation code.) 5287;;;_ ( See also Subtree Charting, in Navigation code.)
@@ -5345,12 +5369,12 @@ the subject region.
5345 5369
5346Optional START and END indicate bounds of region. 5370Optional START and END indicate bounds of region.
5347 5371
5348optional arg, FORMAT, designates an alternate presentation form for 5372Optional arg, FORMAT, designates an alternate presentation form for
5349the prefix: 5373the prefix:
5350 5374
5351 list - Present prefix as numeric section.subsection..., starting with 5375 list -- Present prefix as numeric section.subsection..., starting with
5352 section indicated by the list, innermost nesting first. 5376 section indicated by the list, innermost nesting first.
5353 `indent' (symbol) - Convert header prefixes to all white space, 5377 `indent' (symbol) -- Convert header prefixes to all white space,
5354 except for distinctive bullets. 5378 except for distinctive bullets.
5355 5379
5356The elements of the list produced are lists that represents a topic 5380The elements of the list produced are lists that represents a topic
@@ -5375,7 +5399,7 @@ header and body. The elements of that list are:
5375 (beginning-of-line) 5399 (beginning-of-line)
5376 ;; Goto initial topic, and register preceeding stuff, if any: 5400 ;; Goto initial topic, and register preceeding stuff, if any:
5377 (if (> (allout-goto-prefix-doublechecked) start) 5401 (if (> (allout-goto-prefix-doublechecked) start)
5378 ;; First topic follows beginning point - register preliminary stuff: 5402 ;; First topic follows beginning point -- register preliminary stuff:
5379 (setq result (list (list 0 "" nil 5403 (setq result (list (list 0 "" nil
5380 (buffer-substring start (1- (point))))))) 5404 (buffer-substring start (1- (point)))))))
5381 (while (and (not done) 5405 (while (and (not done)
@@ -5443,7 +5467,7 @@ header and body. The elements of that list are:
5443 (cond ((= new-depth depth) 5467 (cond ((= new-depth depth)
5444 (setq format (cons (1+ (car format)) 5468 (setq format (cons (1+ (car format))
5445 (cdr format)))) 5469 (cdr format))))
5446 ((> new-depth depth) ; descending - assume by 1: 5470 ((> new-depth depth) ; descending -- assume by 1:
5447 (setq format (cons 1 format))) 5471 (setq format (cons 1 format)))
5448 (t 5472 (t
5449 ; Pop the residue: 5473 ; Pop the residue:
@@ -5459,10 +5483,10 @@ header and body. The elements of that list are:
5459 (nreverse result)))) 5483 (nreverse result))))
5460;;;_ > allout-region-active-p () 5484;;;_ > allout-region-active-p ()
5461(defmacro allout-region-active-p () 5485(defmacro allout-region-active-p ()
5462 (if (fboundp 'use-region-p) 5486 (cond ((fboundp 'use-region-p) '(use-region-p))
5463 '(use-region-p) 5487 ((fboundp 'region-active-p) '(region-active-p))
5464 '(region-active-p))) 5488 (t 'mark-active)))
5465;;;_ > allout-process-exposed (&optional func from to frombuf 5489;;_ > allout-process-exposed (&optional func from to frombuf
5466;;; tobuf format) 5490;;; tobuf format)
5467(defun allout-process-exposed (&optional func from to frombuf tobuf 5491(defun allout-process-exposed (&optional func from to frombuf tobuf
5468 format start-num) 5492 format start-num)
@@ -5474,12 +5498,12 @@ Apply FUNCTION to exposed portions FROM position TO position in buffer
5474FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an 5498FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an
5475alternate presentation form: 5499alternate presentation form:
5476 5500
5477 `flat' - Present prefix as numeric section.subsection..., starting with 5501 `flat' -- Present prefix as numeric section.subsection..., starting with
5478 section indicated by the start-num, innermost nesting first. 5502 section indicated by the START-NUM, innermost nesting first.
5479 X`flat-indented' - Prefix is like `flat' for first topic at each 5503 X`flat-indented' -- Prefix is like `flat' for first topic at each
5480 X level, but subsequent topics have only leaf topic 5504 X level, but subsequent topics have only leaf topic
5481 X number, padded with blanks to line up with first. 5505 X number, padded with blanks to line up with first.
5482 `indent' (symbol) - Convert header prefixes to all white space, 5506 `indent' (symbol) -- Convert header prefixes to all white space,
5483 except for distinctive bullets. 5507 except for distinctive bullets.
5484 5508
5485Defaults: 5509Defaults:
@@ -5499,19 +5523,19 @@ Defaults:
5499 (setq from (point-min) to (point-max)))) 5523 (setq from (point-min) to (point-max))))
5500 (if frombuf 5524 (if frombuf
5501 (if (not (bufferp frombuf)) 5525 (if (not (bufferp frombuf))
5502 ;; Specified but not a buffer - get it: 5526 ;; Specified but not a buffer -- get it:
5503 (let ((got (get-buffer frombuf))) 5527 (let ((got (get-buffer frombuf)))
5504 (if (not got) 5528 (if (not got)
5505 (error (concat "allout-process-exposed: source buffer " 5529 (error (concat "allout-process-exposed: source buffer "
5506 frombuf 5530 frombuf
5507 " not found.")) 5531 " not found."))
5508 (setq frombuf got)))) 5532 (setq frombuf got))))
5509 ;; not specified - default it: 5533 ;; not specified -- default it:
5510 (setq frombuf (current-buffer))) 5534 (setq frombuf (current-buffer)))
5511 (if tobuf 5535 (if tobuf
5512 (if (not (bufferp tobuf)) 5536 (if (not (bufferp tobuf))
5513 (setq tobuf (get-buffer-create tobuf))) 5537 (setq tobuf (get-buffer-create tobuf)))
5514 ;; not specified - default it: 5538 ;; not specified -- default it:
5515 (setq tobuf (concat "*" (buffer-name frombuf) " exposed*"))) 5539 (setq tobuf (concat "*" (buffer-name frombuf) " exposed*")))
5516 (if (listp format) 5540 (if (listp format)
5517 (nreverse format)) 5541 (nreverse format))
@@ -5598,7 +5622,7 @@ alternate presentation format for the outline:
5598(defun allout-flatten-exposed-to-buffer (&optional arg tobuf) 5622(defun allout-flatten-exposed-to-buffer (&optional arg tobuf)
5599 "Present numeric outline of outline's exposed portions in another buffer. 5623 "Present numeric outline of outline's exposed portions in another buffer.
5600 5624
5601The resulting outline is not compatible with outline mode - use 5625The resulting outline is not compatible with outline mode -- use
5602`allout-copy-exposed-to-buffer' if you want that. 5626`allout-copy-exposed-to-buffer' if you want that.
5603 5627
5604Use `allout-indented-exposed-to-buffer' for indented presentation. 5628Use `allout-indented-exposed-to-buffer' for indented presentation.
@@ -5614,7 +5638,7 @@ used verbatim."
5614(defun allout-indented-exposed-to-buffer (&optional arg tobuf) 5638(defun allout-indented-exposed-to-buffer (&optional arg tobuf)
5615 "Present indented outline of outline's exposed portions in another buffer. 5639 "Present indented outline of outline's exposed portions in another buffer.
5616 5640
5617The resulting outline is not compatible with outline mode - use 5641The resulting outline is not compatible with outline mode -- use
5618`allout-copy-exposed-to-buffer' if you want that. 5642`allout-copy-exposed-to-buffer' if you want that.
5619 5643
5620Use `allout-flatten-exposed-to-buffer' for numeric sectional presentation. 5644Use `allout-flatten-exposed-to-buffer' for numeric sectional presentation.
@@ -5843,7 +5867,7 @@ encryption are encrypted. See allout-encrypt-unencrypted-on-saves for
5843auto-encryption specifics. 5867auto-encryption specifics.
5844 5868
5845\*NOTE WELL* that automatic encryption that happens during saves will 5869\*NOTE WELL* that automatic encryption that happens during saves will
5846default to symmetric encryption - you must deliberately (re)encrypt key-pair 5870default to symmetric encryption -- you must deliberately (re)encrypt key-pair
5847encrypted topics if you want them to continue to use the key-pair cipher. 5871encrypted topics if you want them to continue to use the key-pair cipher.
5848 5872
5849Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be 5873Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be
@@ -5930,7 +5954,7 @@ See `allout-toggle-current-subtree-encryption' for more details."
5930 subtree-end)) 5954 subtree-end))
5931 (subtree-end-char (char-after (1- subtree-end))) 5955 (subtree-end-char (char-after (1- subtree-end)))
5932 (subtree-trailing-char (char-after subtree-end)) 5956 (subtree-trailing-char (char-after subtree-end))
5933 ;; kluge - result-text needs to be nil, but we also want to 5957 ;; kluge -- result-text needs to be nil, but we also want to
5934 ;; check for the error condition 5958 ;; check for the error condition
5935 (result-text (if (or (string= "" subject-text) 5959 (result-text (if (or (string= "" subject-text)
5936 (string= "\n" subject-text)) 5960 (string= "\n" subject-text))
@@ -6017,18 +6041,19 @@ If DECRYPT is true (default false), then decrypt instead of encrypt.
6017 6041
6018FETCH-PASS (default false) forces fresh prompting for the passphrase. 6042FETCH-PASS (default false) forces fresh prompting for the passphrase.
6019 6043
6020KEY-TYPE indicates whether to use a 'symmetric or 'keypair cipher. 6044KEY-TYPE, either `symmetric' or `keypair', specifies which type
6045of cypher to use.
6021 6046
6022FOR-KEY is human readable identification of the first of the user's 6047FOR-KEY is human readable identification of the first of the user's
6023eligible secret keys a keypair decryption targets, or else nil. 6048eligible secret keys a keypair decryption targets, or else nil.
6024 6049
6025Optional RETRIED is for internal use - conveys the number of failed keys 6050Optional RETRIED is for internal use -- conveys the number of failed keys
6026that have been solicited in sequence leading to this current call. 6051that have been solicited in sequence leading to this current call.
6027 6052
6028Optional PASSPHRASE enables explicit delivery of the decryption passphrase, 6053Optional PASSPHRASE enables explicit delivery of the decryption passphrase,
6029for verification purposes. 6054for verification purposes.
6030 6055
6031Optional REJECTED is for internal use - conveys the number of 6056Optional REJECTED is for internal use -- conveys the number of
6032rejections due to matches against 6057rejections due to matches against
6033`allout-encryption-ciphertext-rejection-regexps', as limited by 6058`allout-encryption-ciphertext-rejection-regexps', as limited by
6034`allout-encryption-ciphertext-rejection-ceiling'. 6059`allout-encryption-ciphertext-rejection-ceiling'.
@@ -6126,15 +6151,15 @@ Returns the resulting string, or nil if the transformation fails."
6126 6151
6127 (if status 6152 (if status
6128 (pgg-situate-output (point-min) (point-max)) 6153 (pgg-situate-output (point-min) (point-max))
6129 ;; failed - handle passphrase caching 6154 ;; failed -- handle passphrase caching
6130 (if verifying 6155 (if verifying
6131 (throw 'encryption-failed nil) 6156 (throw 'encryption-failed nil)
6132 (pgg-remove-passphrase-from-cache target-cache-id t) 6157 (pgg-remove-passphrase-from-cache target-cache-id t)
6133 (error "Symmetric-cipher %scryption failed - %s" 6158 (error "Symmetric-cipher %scryption failed -- %s"
6134 (if decrypt "de" "en") 6159 (if decrypt "de" "en")
6135 "try again with different passphrase.")))) 6160 "try again with different passphrase"))))
6136 6161
6137 ;; encrypt 'keypair: 6162 ;; encrypt `keypair':
6138 ((not decrypt) 6163 ((not decrypt)
6139 6164
6140 (setq status 6165 (setq status
@@ -6147,7 +6172,7 @@ Returns the resulting string, or nil if the transformation fails."
6147 (error (pgg-remove-passphrase-from-cache target-cache-id t) 6172 (error (pgg-remove-passphrase-from-cache target-cache-id t)
6148 (error "encryption failed")))) 6173 (error "encryption failed"))))
6149 6174
6150 ;; decrypt 'keypair: 6175 ;; decrypt `keypair':
6151 (t 6176 (t
6152 6177
6153 (setq status 6178 (setq status
@@ -6163,7 +6188,7 @@ Returns the resulting string, or nil if the transformation fails."
6163 1 (- (point-max) (if decrypt 0 1)))) 6188 1 (- (point-max) (if decrypt 0 1))))
6164 ) 6189 )
6165 6190
6166 ;; validate result - non-empty 6191 ;; validate result -- non-empty
6167 (cond ((not result-text) 6192 (cond ((not result-text)
6168 (if verifying 6193 (if verifying
6169 nil 6194 nil
@@ -6199,7 +6224,7 @@ Returns the resulting string, or nil if the transformation fails."
6199 (string-match "[\C-a\C-k\C-o-\C-z\C-@]" 6224 (string-match "[\C-a\C-k\C-o-\C-z\C-@]"
6200 result-text)) 6225 result-text))
6201 (error (concat "Encryption produced non-armored text, which" 6226 (error (concat "Encryption produced non-armored text, which"
6202 "conflicts with allout mode - reconfigure!"))) 6227 "conflicts with allout mode -- reconfigure!")))
6203 6228
6204 ;; valid result and just verifying or non-symmetric: 6229 ;; valid result and just verifying or non-symmetric:
6205 ((or verifying (not (equal key-type 'symmetric))) 6230 ((or verifying (not (equal key-type 'symmetric)))
@@ -6208,7 +6233,7 @@ Returns the resulting string, or nil if the transformation fails."
6208 passphrase t)) 6233 passphrase t))
6209 result-text) 6234 result-text)
6210 6235
6211 ;; valid result and regular symmetric - "register" 6236 ;; valid result and regular symmetric -- "register"
6212 ;; passphrase with mnemonic aids/cache. 6237 ;; passphrase with mnemonic aids/cache.
6213 (t 6238 (t
6214 (set-buffer allout-buffer) 6239 (set-buffer allout-buffer)
@@ -6239,7 +6264,7 @@ CACHE-ID is the cache id of the key for the passphrase.
6239 6264
6240PROMPT-ID is the id for use when prompting the user. 6265PROMPT-ID is the id for use when prompting the user.
6241 6266
6242KEY-TYPE is either 'symmetric or 'keypair. 6267KEY-TYPE is either `symmetric' or `keypair'.
6243 6268
6244ALLOUT-BUFFER is the buffer containing the entry being en/decrypted. 6269ALLOUT-BUFFER is the buffer containing the entry being en/decrypted.
6245 6270
@@ -6302,7 +6327,7 @@ of the availability of a cached copy."
6302 (if (and (not confirmation) 6327 (if (and (not confirmation)
6303 (if (yes-or-no-p 6328 (if (yes-or-no-p
6304 (concat "Passphrase differs from established" 6329 (concat "Passphrase differs from established"
6305 " - use new one instead? ")) 6330 " -- use new one instead? "))
6306 ;; deactivate password for subsequent 6331 ;; deactivate password for subsequent
6307 ;; confirmation: 6332 ;; confirmation:
6308 (progn 6333 (progn
@@ -6312,11 +6337,11 @@ of the availability of a cached copy."
6312 t)) 6337 t))
6313 (progn (pgg-remove-passphrase-from-cache cache-id t) 6338 (progn (pgg-remove-passphrase-from-cache cache-id t)
6314 (error "Wrong passphrase.")))) 6339 (error "Wrong passphrase."))))
6315 ;; No verifier string - force confirmation by repetition of 6340 ;; No verifier string -- force confirmation by repetition of
6316 ;; (new) passphrase: 6341 ;; (new) passphrase:
6317 ((or fetch-pass (not cached)) 6342 ((or fetch-pass (not cached))
6318 (pgg-remove-passphrase-from-cache cache-id t)))) 6343 (pgg-remove-passphrase-from-cache cache-id t))))
6319 ;; confirmation vs new input - doing pgg-read-passphrase will do the 6344 ;; confirmation vs new input -- doing pgg-read-passphrase will do the
6320 ;; right thing, in either case: 6345 ;; right thing, in either case:
6321 (if (not confirmation) 6346 (if (not confirmation)
6322 (setq confirmation 6347 (setq confirmation
@@ -6327,7 +6352,7 @@ of the availability of a cached copy."
6327 (if (equal got-pass confirmation) 6352 (if (equal got-pass confirmation)
6328 confirmation 6353 confirmation
6329 (if (yes-or-no-p (concat "spelling of original and" 6354 (if (yes-or-no-p (concat "spelling of original and"
6330 " confirmation differ - retry? ")) 6355 " confirmation differ -- retry? "))
6331 (progn (setq retried (if retried (1+ retried) 1)) 6356 (progn (setq retried (if retried (1+ retried) 1))
6332 (pgg-remove-passphrase-from-cache cache-id t) 6357 (pgg-remove-passphrase-from-cache cache-id t)
6333 ;; recurse to this routine: 6358 ;; recurse to this routine:
@@ -6349,10 +6374,10 @@ of the availability of a cached copy."
6349(defun allout-encrypted-key-info (text) 6374(defun allout-encrypted-key-info (text)
6350 "Return a pair of the key type and identity of a recipient's secret key. 6375 "Return a pair of the key type and identity of a recipient's secret key.
6351 6376
6352The key type is one of 'symmetric or 'keypair. 6377The key type is one of `symmetric' or `keypair'.
6353 6378
6354if 'keypair, and some of the user's secret keys are among those for which 6379If `keypair', and some of the user's secret keys are among those for which
6355the message was encoded, return the identity of the first. otherwise, 6380the message was encoded, return the identity of the first. Otherwise,
6356return nil for the second item of the pair. 6381return nil for the second item of the pair.
6357 6382
6358An error is raised if the text is not encrypted." 6383An error is raised if the text is not encrypted."
@@ -6397,7 +6422,7 @@ An error is raised if the text is not encrypted."
6397See `allout-passphrase-verifier-string' and `allout-passphrase-hint-string' 6422See `allout-passphrase-verifier-string' and `allout-passphrase-hint-string'
6398settings. 6423settings.
6399 6424
6400PASSPHRASE is the passphrase being mnemonicized 6425PASSPHRASE is the passphrase being mnemonicized.
6401 6426
6402OUTLINE-BUFFER is the buffer of the outline being adjusted. 6427OUTLINE-BUFFER is the buffer of the outline being adjusted.
6403 6428
@@ -6475,7 +6500,7 @@ EXCEPT-MARK identifies a point whose containing topics should be excluded
6475from encryption. This supports 'except-current mode of 6500from encryption. This supports 'except-current mode of
6476`allout-encrypt-unencrypted-on-saves'. 6501`allout-encrypt-unencrypted-on-saves'.
6477 6502
6478Such a topic has the allout-topic-encryption-bullet without an 6503Such a topic has the `allout-topic-encryption-bullet' without an
6479immediately following '*' that would mark the topic as being encrypted. It 6504immediately following '*' that would mark the topic as being encrypted. It
6480must also have content." 6505must also have content."
6481 (let (done got content-beg) 6506 (let (done got content-beg)
@@ -6529,7 +6554,7 @@ must also have content."
6529 "Encrypt topics pending encryption except those containing exemption point. 6554 "Encrypt topics pending encryption except those containing exemption point.
6530 6555
6531EXCEPT-MARK identifies a point whose containing topics should be excluded 6556EXCEPT-MARK identifies a point whose containing topics should be excluded
6532from encryption. This supports 'except-current mode of 6557from encryption. This supports the `except-current' mode of
6533`allout-encrypt-unencrypted-on-saves'. 6558`allout-encrypt-unencrypted-on-saves'.
6534 6559
6535If a topic that is currently being edited was encrypted, we return a list 6560If a topic that is currently being edited was encrypted, we return a list
@@ -6597,7 +6622,7 @@ setup for auto-startup."
6597 (if (allout-goto-prefix) 6622 (if (allout-goto-prefix)
6598 t 6623 t
6599 (allout-open-topic 2) 6624 (allout-open-topic 2)
6600 (insert (concat "Dummy outline topic header - see" 6625 (insert (concat "Dummy outline topic header -- see"
6601 "`allout-mode' docstring: `^Hm'.")) 6626 "`allout-mode' docstring: `^Hm'."))
6602 (allout-adjust-file-variable 6627 (allout-adjust-file-variable
6603 "allout-layout" (or allout-layout '(-1 : 0)))))) 6628 "allout-layout" (or allout-layout '(-1 : 0))))))
@@ -6605,7 +6630,7 @@ setup for auto-startup."
6605(defun allout-file-vars-section-data () 6630(defun allout-file-vars-section-data ()
6606 "Return data identifying the file-vars section, or nil if none. 6631 "Return data identifying the file-vars section, or nil if none.
6607 6632
6608Returns list `(beginning-point prefix-string suffix-string)'." 6633Returns a list of the form (BEGINNING-POINT PREFIX-STRING SUFFIX-STRING)."
6609 ;; minimally gleaned from emacs 21.4 files.el hack-local-variables function. 6634 ;; minimally gleaned from emacs 21.4 files.el hack-local-variables function.
6610 (let (beg prefix suffix) 6635 (let (beg prefix suffix)
6611 (save-excursion 6636 (save-excursion
@@ -6707,7 +6732,7 @@ not its value."
6707 got) 6732 got)
6708 (dolist (sym configvar-value) 6733 (dolist (sym configvar-value)
6709 (if (not (boundp sym)) 6734 (if (not (boundp sym))
6710 (if (yes-or-no-p (format "%s entry `%s' is unbound - remove it? " 6735 (if (yes-or-no-p (format "%s entry `%s' is unbound -- remove it? "
6711 configvar-name sym)) 6736 configvar-name sym))
6712 (delq sym (symbol-value configvar-name))) 6737 (delq sym (symbol-value configvar-name)))
6713 (push (symbol-value sym) got))) 6738 (push (symbol-value sym) got)))
@@ -6754,7 +6779,7 @@ Optional arg DO-DEFAULTING indicates to accept empty input (CR)."
6754 string 6779 string
6755 "")) 6780 ""))
6756 nil)))) 6781 nil))))
6757 ;; got something out of loop - return it: 6782 ;; got something out of loop -- return it:
6758 got) 6783 got)
6759 ) 6784 )
6760;;;_ : Strings: 6785;;;_ : Strings:
@@ -6762,7 +6787,7 @@ Optional arg DO-DEFAULTING indicates to accept empty input (CR)."
6762(defun regexp-sans-escapes (regexp &optional successive-backslashes) 6787(defun regexp-sans-escapes (regexp &optional successive-backslashes)
6763 "Return a copy of REGEXP with all character escapes stripped out. 6788 "Return a copy of REGEXP with all character escapes stripped out.
6764 6789
6765Representations of actual backslashes - '\\\\\\\\' - are left as a 6790Representations of actual backslashes -- '\\\\\\\\' -- are left as a
6766single backslash. 6791single backslash.
6767 6792
6768Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion." 6793Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion."
@@ -6810,7 +6835,7 @@ If BEG is bigger than END we return 0."
6810 (cond ((null list) nil) 6835 (cond ((null list) nil)
6811 ((atom (car list)) (cons (car list) (allout-flatten (cdr list)))) 6836 ((atom (car list)) (cons (car list) (allout-flatten (cdr list))))
6812 (t (append (allout-flatten (car list)) (allout-flatten (cdr list)))))) 6837 (t (append (allout-flatten (car list)) (allout-flatten (cdr list))))))
6813;;;_ : Compatability: 6838;;;_ : Compatibility:
6814;;;_ > allout-mark-marker to accommodate divergent emacsen: 6839;;;_ > allout-mark-marker to accommodate divergent emacsen:
6815(defun allout-mark-marker (&optional force buffer) 6840(defun allout-mark-marker (&optional force buffer)
6816 "Accommodate the different signature for `mark-marker' across Emacsen. 6841 "Accommodate the different signature for `mark-marker' across Emacsen.
@@ -6862,7 +6887,7 @@ BEG and END default respectively to the beginning and end of buffer."
6862 (move-overlay o end (overlay-end o)) 6887 (move-overlay o end (overlay-end o))
6863 (delete-overlay o))))))) 6888 (delete-overlay o)))))))
6864 ) 6889 )
6865;;;_ > copy-overlay if necessary - xemacs ~ 21.4 6890;;;_ > copy-overlay if necessary -- xemacs ~ 21.4
6866(if (not (fboundp 'copy-overlay)) 6891(if (not (fboundp 'copy-overlay))
6867 (defun copy-overlay (o) 6892 (defun copy-overlay (o)
6868 "Return a copy of overlay O." 6893 "Return a copy of overlay O."
@@ -6874,7 +6899,7 @@ BEG and END default respectively to the beginning and end of buffer."
6874 (while props 6899 (while props
6875 (overlay-put o1 (pop props) (pop props))) 6900 (overlay-put o1 (pop props) (pop props)))
6876 o1))) 6901 o1)))
6877;;;_ > add-to-invisibility-spec if necessary - xemacs ~ 21.4 6902;;;_ > add-to-invisibility-spec if necessary -- xemacs ~ 21.4
6878(if (not (fboundp 'add-to-invisibility-spec)) 6903(if (not (fboundp 'add-to-invisibility-spec))
6879 (defun add-to-invisibility-spec (element) 6904 (defun add-to-invisibility-spec (element)
6880 "Add ELEMENT to `buffer-invisibility-spec'. 6905 "Add ELEMENT to `buffer-invisibility-spec'.
@@ -6884,14 +6909,14 @@ that can be added."
6884 (setq buffer-invisibility-spec (list t))) 6909 (setq buffer-invisibility-spec (list t)))
6885 (setq buffer-invisibility-spec 6910 (setq buffer-invisibility-spec
6886 (cons element buffer-invisibility-spec)))) 6911 (cons element buffer-invisibility-spec))))
6887;;;_ > remove-from-invisibility-spec if necessary - xemacs ~ 21.4 6912;;;_ > remove-from-invisibility-spec if necessary -- xemacs ~ 21.4
6888(if (not (fboundp 'remove-from-invisibility-spec)) 6913(if (not (fboundp 'remove-from-invisibility-spec))
6889 (defun remove-from-invisibility-spec (element) 6914 (defun remove-from-invisibility-spec (element)
6890 "Remove ELEMENT from `buffer-invisibility-spec'." 6915 "Remove ELEMENT from `buffer-invisibility-spec'."
6891 (if (consp buffer-invisibility-spec) 6916 (if (consp buffer-invisibility-spec)
6892 (setq buffer-invisibility-spec (delete element 6917 (setq buffer-invisibility-spec (delete element
6893 buffer-invisibility-spec))))) 6918 buffer-invisibility-spec)))))
6894;;;_ > move-beginning-of-line if necessary - older emacs, xemacs 6919;;;_ > move-beginning-of-line if necessary -- older emacs, xemacs
6895(if (not (fboundp 'move-beginning-of-line)) 6920(if (not (fboundp 'move-beginning-of-line))
6896 (defun move-beginning-of-line (arg) 6921 (defun move-beginning-of-line (arg)
6897 "Move point to beginning of current line as displayed. 6922 "Move point to beginning of current line as displayed.
@@ -6921,7 +6946,7 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
6921 (skip-chars-backward "^\n")) 6946 (skip-chars-backward "^\n"))
6922 (vertical-motion 0)) 6947 (vertical-motion 0))
6923) 6948)
6924;;;_ > move-end-of-line if necessary - older emacs, xemacs 6949;;;_ > move-end-of-line if necessary -- older emacs, xemacs
6925(if (not (fboundp 'move-end-of-line)) 6950(if (not (fboundp 'move-end-of-line))
6926 (defun move-end-of-line (arg) 6951 (defun move-end-of-line (arg)
6927 "Move point to end of current line as displayed. 6952 "Move point to end of current line as displayed.
@@ -6990,7 +7015,7 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
6990 (isearch-repeat 'forward) 7015 (isearch-repeat 'forward)
6991 (isearch-mode t))) 7016 (isearch-mode t)))
6992 7017
6993;;;_ #11 Unit tests - this should be last item before "Provide" 7018;;;_ #11 Unit tests -- this should be last item before "Provide"
6994;;;_ > allout-run-unit-tests () 7019;;;_ > allout-run-unit-tests ()
6995(defun allout-run-unit-tests () 7020(defun allout-run-unit-tests ()
6996 "Run the various allout unit tests." 7021 "Run the various allout unit tests."
@@ -7006,11 +7031,11 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
7006 (while (boundp name) (makunbound name))) 7031 (while (boundp name) (makunbound name)))
7007;;;_ > allout-test-resumptions () 7032;;;_ > allout-test-resumptions ()
7008(defvar allout-tests-globally-unbound nil 7033(defvar allout-tests-globally-unbound nil
7009 "Fodder for allout resumptions tests - defvar just for byte compiler.") 7034 "Fodder for allout resumptions tests -- defvar just for byte compiler.")
7010(defvar allout-tests-globally-true nil 7035(defvar allout-tests-globally-true nil
7011 "Fodder for allout resumptions tests - defvar just just for byte compiler.") 7036 "Fodder for allout resumptions tests -- defvar just for byte compiler.")
7012(defvar allout-tests-locally-true nil 7037(defvar allout-tests-locally-true nil
7013 "Fodder for allout resumptions tests - defvar just for byte compiler.") 7038 "Fodder for allout resumptions tests -- defvar just for byte compiler.")
7014(defun allout-test-resumptions () 7039(defun allout-test-resumptions ()
7015 "Exercise allout resumptions." 7040 "Exercise allout resumptions."
7016 ;; for each resumption case, we also test that the right local/global 7041 ;; for each resumption case, we also test that the right local/global
@@ -7046,10 +7071,10 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
7046 (allout-tests-obliterate-variable 'allout-tests-locally-true) 7071 (allout-tests-obliterate-variable 'allout-tests-locally-true)
7047 (set (make-local-variable 'allout-tests-locally-true) t) 7072 (set (make-local-variable 'allout-tests-locally-true) t)
7048 (assert (not (default-boundp 'allout-tests-locally-true)) 7073 (assert (not (default-boundp 'allout-tests-locally-true))
7049 nil (concat "Test setup mistake - variable supposed to" 7074 nil (concat "Test setup mistake -- variable supposed to"
7050 " not have global binding, but it does.")) 7075 " not have global binding, but it does."))
7051 (assert (local-variable-p 'allout-tests-locally-true) 7076 (assert (local-variable-p 'allout-tests-locally-true)
7052 nil (concat "Test setup mistake - variable supposed to have" 7077 nil (concat "Test setup mistake -- variable supposed to have"
7053 " local binding, but it lacks one.")) 7078 " local binding, but it lacks one."))
7054 (allout-add-resumptions '(allout-tests-locally-true nil)) 7079 (allout-add-resumptions '(allout-tests-locally-true nil))
7055 (assert (not (default-boundp 'allout-tests-locally-true))) 7080 (assert (not (default-boundp 'allout-tests-locally-true)))
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index 530325cd24e..db2818f31ed 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -513,7 +513,7 @@ property."
513(defun ansi-color-set-extent-face (extent face) 513(defun ansi-color-set-extent-face (extent face)
514 "Set the `face' property of EXTENT to FACE. 514 "Set the `face' property of EXTENT to FACE.
515XEmacs uses `set-extent-face', Emacs uses `overlay-put'." 515XEmacs uses `set-extent-face', Emacs uses `overlay-put'."
516 (if (fboundp 'set-extent-face) 516 (if (featurep 'xemacs)
517 (set-extent-face extent face) 517 (set-extent-face extent face)
518 (overlay-put extent 'face face))) 518 (overlay-put extent 'face face)))
519 519
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 2b417b06398..3e5cef9fec9 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -1019,7 +1019,8 @@ using `make-temp-file', and the generated name is returned."
1019 (archive-maybe-update t)) 1019 (archive-maybe-update t))
1020 (or (not (buffer-name buffer)) 1020 (or (not (buffer-name buffer))
1021 (cond 1021 (cond
1022 (view-p (view-buffer buffer (and just-created 'kill-buffer))) 1022 (view-p (view-buffer
1023 buffer (and just-created 'kill-buffer-if-not-modified)))
1023 ((eq other-window-p 'display) (display-buffer buffer)) 1024 ((eq other-window-p 'display) (display-buffer buffer))
1024 (other-window-p (switch-to-buffer-other-window buffer)) 1025 (other-window-p (switch-to-buffer-other-window buffer))
1025 (t (switch-to-buffer buffer)))))) 1026 (t (switch-to-buffer buffer))))))
@@ -1968,7 +1969,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
1968 (archive-rar-extract tmpfile name)) 1969 (archive-rar-extract tmpfile name))
1969 (if tmpbuf (kill-buffer tmpbuf)) 1970 (if tmpbuf (kill-buffer tmpbuf))
1970 (delete-file tmpfile)))) 1971 (delete-file tmpfile))))
1971 1972
1972 1973
1973;; ------------------------------------------------------------------------- 1974;; -------------------------------------------------------------------------
1974;; This line was a mistake; it is kept now for compatibility. 1975;; This line was a mistake; it is kept now for compatibility.
diff --git a/lisp/blank-mode.el b/lisp/blank-mode.el
new file mode 100644
index 00000000000..8956e95ac1e
--- /dev/null
+++ b/lisp/blank-mode.el
@@ -0,0 +1,1726 @@
1;;; blank-mode.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE
2
3;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
4;; Free Software Foundation, Inc.
5
6;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
7;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
8;; Keywords: data, wp
9;; Version: 9.2
10;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
11
12;; This file is part of GNU Emacs.
13
14;; GNU Emacs is free software; you can redistribute it and/or modify
15;; it under the terms of the GNU General Public License as published
16;; by the Free Software Foundation; either version 3, or (at your
17;; option) any later version.
18
19;; GNU Emacs is distributed in the hope that it will be useful, but
20;; WITHOUT ANY WARRANTY; without even the implied warranty of
21;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22;; General Public License for more details.
23
24;; You should have received a copy of the GNU General Public License
25;; along with GNU Emacs; see the file COPYING. If not, write to the
26;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27;; Boston, MA 02110-1301, USA.
28
29;;; Commentary:
30
31;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
32;;
33;; Introduction
34;; ------------
35;;
36;; This package is a minor mode to visualize blanks (TAB, (HARD) SPACE
37;; and NEWLINE).
38;;
39;; blank-mode uses two ways to visualize blanks: faces and display
40;; table.
41;;
42;; * Faces are used to highlight the background with a color.
43;; blank-mode uses font-lock to highlight blank characters.
44;;
45;; * Display table changes the way a character is displayed, that is,
46;; it provides a visual mark for characters, for example, at the end
47;; of line (?\xB6), at SPACEs (?\xB7) and at TABs (?\xBB).
48;;
49;; The `blank-style' and `blank-chars' variables are used to select
50;; which way should be used to visualize blanks.
51;;
52;; Note that when blank-mode is turned on, blank-mode saves the
53;; font-lock state, that is, if font-lock is on or off. And
54;; blank-mode restores the font-lock state when it is turned off. So,
55;; if blank-mode is turned on and font-lock is off, blank-mode also
56;; turns on the font-lock to highlight blanks, but the font-lock will
57;; be turned off when blank-mode is turned off. Thus, turn on
58;; font-lock before blank-mode is on, if you want that font-lock
59;; continues on after blank-mode is turned off.
60;;
61;; When blank-mode is on, it takes care of highlighting some special
62;; characters over the default mechanism of `nobreak-char-display'
63;; (which see) and `show-trailing-whitespace' (which see).
64;;
65;; There are two ways of using blank-mode: local and global.
66;;
67;; * Local blank-mode affects only the current buffer.
68;;
69;; * Global blank-mode affects all current and future buffers. That
70;; is, if you turn on global blank-mode and then create a new
71;; buffer, the new buffer will also have blank-mode on. The
72;; `blank-global-modes' variable controls which major-mode will be
73;; automagically turned on.
74;;
75;; You can mix the local and global usage without any conflict. But
76;; local blank-mode has priority over global blank-mode. Blank mode
77;; is active in a buffer if you have enabled it in that buffer or if
78;; you have enabled it globally.
79;;
80;; When global and local blank-mode are on:
81;;
82;; * if local blank-mode is turned off, blank-mode is turned off for
83;; the current buffer only.
84;;
85;; * if global blank-mode is turned off, blank-mode continues on only
86;; in the buffers in which local blank-mode is on.
87;;
88;; To use blank-mode, insert in your ~/.emacs:
89;;
90;; (require 'blank-mode)
91;;
92;; Or autoload at least one of the commands`blank-mode',
93;; `blank-toggle-options', `global-blank-mode' or
94;; `global-blank-toggle-options'. For example:
95;;
96;; (autoload 'blank-mode "blank-mode"
97;; "Toggle blank visualization." t)
98;; (autoload 'blank-toggle-options "blank-mode"
99;; "Toggle local `blank-mode' options." t)
100;;
101;; blank-mode was inspired by:
102;;
103;; whitespace.el Rajesh Vaidheeswarran <rv@gnu.org>
104;; Warn about and clean bogus whitespaces in the file
105;; (inspired the idea to warn and clean some blanks)
106;;
107;; show-whitespace-mode.el Aurelien Tisne <aurelien.tisne@free.fr>
108;; Simple mode to highlight whitespaces
109;; (inspired the idea to use font-lock)
110;;
111;; whitespace-mode.el Lawrence Mitchell <wence@gmx.li>
112;; Major mode for editing Whitespace
113;; (inspired the idea to use display table)
114;;
115;; visws.el Miles Bader <miles@gnu.org>
116;; Make whitespace visible
117;; (handle display table, his code was modified, but the main
118;; idea was kept)
119;;
120;;
121;; Using blank-mode
122;; ----------------
123;;
124;; There is no problem if you mix local and global minor mode usage.
125;;
126;; * LOCAL blank-mode:
127;; + To toggle blank-mode options locally, type:
128;;
129;; M-x blank-toggle-options RET
130;;
131;; + To activate blank-mode locally, type:
132;;
133;; C-u 1 M-x blank-mode RET
134;;
135;; + To deactivate blank-mode locally, type:
136;;
137;; C-u 0 M-x blank-mode RET
138;;
139;; + To toggle blank-mode locally, type:
140;;
141;; M-x blank-mode RET
142;;
143;; * GLOBAL blank-mode:
144;; + To toggle blank-mode options globally, type:
145;;
146;; M-x global-blank-toggle-options RET
147;;
148;; + To activate blank-mode globally, type:
149;;
150;; C-u 1 M-x global-blank-mode RET
151;;
152;; + To deactivate blank-mode globally, type:
153;;
154;; C-u 0 M-x global-blank-mode RET
155;;
156;; + To toggle blank-mode globally, type:
157;;
158;; M-x global-blank-mode RET
159;;
160;; There are also the following useful commands:
161;;
162;; `blank-cleanup'
163;; Cleanup some blank problems in all buffer or at region.
164;;
165;; `blank-cleanup-region'
166;; Cleanup some blank problems at region.
167;;
168;; The problems, which are cleaned up, are:
169;;
170;; 1. empty lines at beginning of buffer.
171;; 2. empty lines at end of buffer.
172;; If `blank-chars' has `empty' as an element, remove all empty
173;; lines at beginning and/or end of buffer.
174;;
175;; 3. 8 or more SPACEs at beginning of line.
176;; If `blank-chars' has `indentation' as an element, replace 8 or
177;; more SPACEs at beginning of line by TABs.
178;;
179;; 4. SPACEs before TAB.
180;; If `blank-chars' has `space-before-tab' as an element, replace
181;; SPACEs by TABs.
182;;
183;; 5. SPACEs or TABs at end of line.
184;; If `blank-chars' has `trailing' as an element, remove all
185;; SPACEs or TABs at end of line."
186;;
187;; 6. 8 or more SPACEs after TAB.
188;; If `blank-chars' has `space-after-tab' as an element, replace
189;; SPACEs by TABs.
190;;
191;;
192;; Hooks
193;; -----
194;;
195;; blank-mode has the following hook variables:
196;;
197;; `blank-mode-hook'
198;; It is evaluated always when blank-mode is turned on locally.
199;;
200;; `global-blank-mode-hook'
201;; It is evaluated always when blank-mode is turned on globally.
202;;
203;; `blank-load-hook'
204;; It is evaluated after blank-mode package is loaded.
205;;
206;;
207;; Options
208;; -------
209;;
210;; Below it's shown a brief description of blank-mode options, please,
211;; see the options declaration in the code for a long documentation.
212;;
213;; `blank-style' Specify the visualization style.
214;;
215;; `blank-chars' Specify which kind of blank is
216;; visualized.
217;;
218;; `blank-space' Face used to visualize SPACE.
219;;
220;; `blank-hspace' Face used to visualize HARD SPACE.
221;;
222;; `blank-tab' Face used to visualize TAB.
223;;
224;; `blank-newline' Face used to visualize NEWLINE char
225;; mapping.
226;;
227;; `blank-trailing' Face used to visualize trailing
228;; blanks.
229;;
230;; `blank-line' Face used to visualize "long" lines.
231;;
232;; `blank-space-before-tab' Face used to visualize SPACEs before
233;; TAB.
234;;
235;; `blank-indentation' Face used to visualize 8 or more
236;; SPACEs at beginning of line.
237;;
238;; `blank-empty' Face used to visualize empty lines at
239;; beginning and/or end of buffer.
240;;
241;; `blank-space-after-tab' Face used to visualize 8 or more
242;; SPACEs after TAB.
243;;
244;; `blank-space-regexp' Specify SPACE characters regexp.
245;;
246;; `blank-hspace-regexp' Specify HARD SPACE characters regexp.
247;;
248;; `blank-tab-regexp' Specify TAB characters regexp.
249;;
250;; `blank-trailing-regexp' Specify trailing characters regexp.
251;;
252;; `blank-space-before-tab-regexp' Specify SPACEs before TAB
253;; regexp.
254;;
255;; `blank-indentation-regexp' Specify regexp for 8 or more SPACEs at
256;; beginning of line.
257;;
258;; `blank-empty-at-bob-regexp' Specify regexp for empty lines at
259;; beginning of buffer.
260;;
261;; `blank-empty-at-eob-regexp' Specify regexp for empty lines at end
262;; of buffer.
263;;
264;; `blank-space-after-tab-regexp' Specify regexp for 8 or more
265;; SPACEs after TAB.
266;;
267;; `blank-line-column' Specify column beyond which the line
268;; is highlighted.
269;;
270;; `blank-display-mappings' Specify an alist of mappings for
271;; displaying characters.
272;;
273;; `blank-global-modes' Modes for which global `blank-mode' is
274;; automagically turned on.
275;;
276;;
277;; Acknowledgements
278;; ----------------
279;;
280;; Thanks to nschum (EmacsWiki) for the idea about highlight "long"
281;; lines tail. See EightyColumnRule (EmacsWiki).
282;;
283;; Thanks to Juri Linkov <juri@jurta.org> for suggesting:
284;; * `define-minor-mode'.
285;; * `global-blank-*' name for global commands.
286;;
287;; Thanks to Robert J. Chassell <bob@gnu.org> for doc fix and testing.
288;;
289;; Thanks to Drew Adams <drew.adams@oracle.com> for toggle commands
290;; suggestion.
291;;
292;; Thanks to Antti Kaihola <antti.kaihola@linux-aktivaattori.org> for
293;; helping to fix `find-file-hooks' reference.
294;;
295;; Thanks to Andreas Roehler <andreas.roehler@easy-emacs.de> for
296;; indicating defface byte-compilation warnings.
297;;
298;; Thanks to TimOCallaghan (EmacsWiki) for the idea about highlight
299;; "long" lines. See EightyColumnRule (EmacsWiki).
300;;
301;; Thanks to Yanghui Bian <yanghuibian@gmail.com> for indicating a new
302;; newline character mapping.
303;;
304;; Thanks to Pete Forman <pete.forman@westgeo.com> for indicating
305;; whitespace-mode on XEmacs.
306;;
307;; Thanks to Miles Bader <miles@gnu.org> for handling display table via
308;; visws.el (his code was modified, but the main idea was kept).
309;;
310;; Thanks to:
311;; Rajesh Vaidheeswarran <rv@gnu.org> whitespace.el
312;; Aurelien Tisne <aurelien.tisne@free.fr> show-whitespace-mode.el
313;; Lawrence Mitchell <wence@gmx.li> whitespace-mode.el
314;; Miles Bader <miles@gnu.org> visws.el
315;; And to all people who contributed with them.
316;;
317;;
318;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
319
320;;; code:
321
322
323;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
324;;;; User Variables:
325
326
327;;; Interface to the command system
328
329
330(defgroup blank nil
331 "Visualize blanks (TAB, (HARD) SPACE and NEWLINE)."
332 :link '(emacs-library-link :tag "Source Lisp File" "blank-mode.el")
333 :version "22.2"
334 :group 'wp
335 :group 'data)
336
337
338(defcustom blank-style '(mark color)
339 "*Specify the visualization style.
340
341It's a list which element value can be:
342
343 mark display mappings are visualized.
344
345 color faces are visualized.
346
347Any other value is ignored.
348
349If nil, don't visualize TABs, (HARD) SPACEs and NEWLINEs.
350
351See also `blank-display-mappings' for documentation."
352 :type '(repeat :tag "Style of Blank"
353 (choice :tag "Style of Blank"
354 (const :tag "Display Table" mark)
355 (const :tag "Faces" color)))
356 :group 'blank)
357
358
359(defcustom blank-chars
360 '(tabs spaces trailing lines space-before-tab newline
361 indentation empty space-after-tab)
362 "*Specify which kind of blank is visualized.
363
364It's a list which element value can be:
365
366 trailing trailing blanks are visualized.
367
368 tabs TABs are visualized.
369
370 spaces SPACEs and HARD SPACEs are visualized.
371
372 lines lines whose have columns beyond
373 `blank-line-column' are highlighted.
374 Whole line is highlighted.
375 It has precedence over
376 `lines-tail' (see below).
377
378 lines-tail lines whose have columns beyond
379 `blank-line-column' are highlighted.
380 But only the part of line which goes
381 beyond `blank-line-column' column.
382 It has effect only if `lines' (see above)
383 is not present in `blank-chars'.
384
385 space-before-tab SPACEs before TAB are visualized.
386
387 newline NEWLINEs are visualized.
388
389 indentation 8 or more SPACEs at beginning of line are
390 visualized.
391
392 empty empty lines at beginning and/or end of buffer
393 are visualized.
394
395 space-after-tab 8 or more SPACEs after a TAB are visualized.
396
397Any other value is ignored.
398
399If nil, don't visualize TABs, (HARD) SPACEs and NEWLINEs.
400
401Used when `blank-style' has `color' as an element.
402If `blank-chars' has `newline' as an element, used when `blank-style'
403has `mark' as an element."
404 :type '(repeat :tag "Kind of Blank"
405 (choice :tag "Kind of Blank"
406 (const :tag "Trailing TABs, SPACEs and HARD SPACEs"
407 trailing)
408 (const :tag "SPACEs and HARD SPACEs" spaces)
409 (const :tag "TABs" tabs)
410 (const :tag "Lines" lines)
411 (const :tag "SPACEs before TAB"
412 space-before-tab)
413 (const :tag "NEWLINEs" newline)
414 (const :tag "Indentation SPACEs" indentation)
415 (const :tag "Empty Lines At BOB And/Or EOB"
416 empty)
417 (const :tag "SPACEs after TAB"
418 space-after-tab)))
419 :group 'blank)
420
421
422(defcustom blank-space 'blank-space
423 "*Symbol face used to visualize SPACE.
424
425Used when `blank-style' has `color' as an element."
426 :type 'face
427 :group 'blank)
428
429
430(defface blank-space
431 '((((class color) (background dark))
432 (:background "grey20" :foreground "aquamarine3"))
433 (((class color) (background light))
434 (:background "LightYellow" :foreground "aquamarine3"))
435 (t (:inverse-video t)))
436 "Face used to visualize SPACE."
437 :group 'blank)
438
439
440(defcustom blank-hspace 'blank-hspace
441 "*Symbol face used to visualize HARD SPACE.
442
443Used when `blank-style' has `color' as an element."
444 :type 'face
445 :group 'blank)
446
447
448(defface blank-hspace ; 'nobreak-space
449 '((((class color) (background dark))
450 (:background "grey24" :foreground "aquamarine3"))
451 (((class color) (background light))
452 (:background "LemonChiffon3" :foreground "aquamarine3"))
453 (t (:inverse-video t)))
454 "Face used to visualize HARD SPACE."
455 :group 'blank)
456
457
458(defcustom blank-tab 'blank-tab
459 "*Symbol face used to visualize TAB.
460
461Used when `blank-style' has `color' as an element."
462 :type 'face
463 :group 'blank)
464
465
466(defface blank-tab
467 '((((class color) (background dark))
468 (:background "grey22" :foreground "aquamarine3"))
469 (((class color) (background light))
470 (:background "beige" :foreground "aquamarine3"))
471 (t (:inverse-video t)))
472 "Face used to visualize TAB."
473 :group 'blank)
474
475
476(defcustom blank-newline 'blank-newline
477 "*Symbol face used to visualize NEWLINE char mapping.
478
479See `blank-display-mappings'.
480
481Used when `blank-style' has `mark' and `color' as elements
482and `blank-chars' has `newline' as an element."
483 :type 'face
484 :group 'blank)
485
486
487(defface blank-newline
488 '((((class color) (background dark))
489 (:background "grey26" :foreground "aquamarine3" :bold t))
490 (((class color) (background light))
491 (:background "linen" :foreground "aquamarine3" :bold t))
492 (t (:bold t :underline t)))
493 "Face used to visualize NEWLINE char mapping.
494
495See `blank-display-mappings'."
496 :group 'blank)
497
498
499(defcustom blank-trailing 'blank-trailing
500 "*Symbol face used to visualize traling blanks.
501
502Used when `blank-style' has `color' as an element."
503 :type 'face
504 :group 'blank)
505
506
507(defface blank-trailing ; 'trailing-whitespace
508 '((((class mono)) (:inverse-video t :bold t :underline t))
509 (t (:background "red1" :foreground "yellow" :bold t)))
510 "Face used to visualize trailing blanks."
511 :group 'blank)
512
513
514(defcustom blank-line 'blank-line
515 "*Symbol face used to visualize \"long\" lines.
516
517See `blank-line-column'.
518
519Used when `blank-style' has `color' as an element."
520 :type 'face
521 :group 'blank)
522
523
524(defface blank-line
525 '((((class mono)) (:inverse-video t :bold t :underline t))
526 (t (:background "gray20" :foreground "violet")))
527 "Face used to visualize \"long\" lines.
528
529See `blank-line-column'."
530 :group 'blank)
531
532
533(defcustom blank-space-before-tab 'blank-space-before-tab
534 "*Symbol face used to visualize SPACEs before TAB.
535
536Used when `blank-style' has `color' as an element."
537 :type 'face
538 :group 'blank)
539
540
541(defface blank-space-before-tab
542 '((((class mono)) (:inverse-video t :bold t :underline t))
543 (t (:background "DarkOrange" :foreground "firebrick")))
544 "Face used to visualize SPACEs before TAB."
545 :group 'blank)
546
547
548(defcustom blank-indentation 'blank-indentation
549 "*Symbol face used to visualize 8 or more SPACEs at beginning of line.
550
551Used when `blank-style' has `color' as an element."
552 :type 'face
553 :group 'blank)
554
555
556(defface blank-indentation
557 '((((class mono)) (:inverse-video t :bold t :underline t))
558 (t (:background "yellow" :foreground "firebrick")))
559 "Face used to visualize 8 or more SPACEs at beginning of line."
560 :group 'blank)
561
562
563(defcustom blank-empty 'blank-empty
564 "*Symbol face used to visualize empty lines at beginning and/or end of buffer.
565
566Used when `blank-style' has `color' as an element."
567 :type 'face
568 :group 'blank)
569
570
571(defface blank-empty
572 '((((class mono)) (:inverse-video t :bold t :underline t))
573 (t (:background "yellow" :foreground "firebrick")))
574 "Face used to visualize empty lines at beginning and/or end of buffer."
575 :group 'blank)
576
577
578(defcustom blank-space-after-tab 'blank-space-after-tab
579 "*Symbol face used to visualize 8 or more SPACEs after TAB.
580
581Used when `blank-style' has `color' as an element."
582 :type 'face
583 :group 'blank)
584
585
586(defface blank-space-after-tab
587 '((((class mono)) (:inverse-video t :bold t :underline t))
588 (t (:background "yellow" :foreground "firebrick")))
589 "Face used to visualize 8 or more SPACEs after TAB."
590 :group 'blank)
591
592
593(defcustom blank-hspace-regexp
594 "\\(\\(\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20\\)+\\)"
595 "*Specify HARD SPACE characters regexp.
596
597If you're using `mule' package, it may exist other characters besides:
598
599 \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \"\\xF20\"
600
601that should be considered HARD SPACE.
602
603Here are some examples:
604
605 \"\\\\(^\\xA0+\\\\)\" \
606visualize only leading HARD SPACEs.
607 \"\\\\(\\xA0+$\\\\)\" \
608visualize only trailing HARD SPACEs.
609 \"\\\\(^\\xA0+\\\\|\\xA0+$\\\\)\" \
610visualize leading and/or trailing HARD SPACEs.
611 \"\\t\\\\(\\xA0+\\\\)\\t\" \
612visualize only HARD SPACEs between TABs.
613
614NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
615 Use exactly one pair of enclosing \\\\( and \\\\).
616
617Used when `blank-style' has `color' as an element, and
618`blank-chars' has `spaces' as an element."
619 :type '(regexp :tag "HARD SPACE Chars")
620 :group 'blank)
621
622
623(defcustom blank-space-regexp "\\( +\\)"
624 "*Specify SPACE characters regexp.
625
626If you're using `mule' package, it may exist other characters
627besides \" \" that should be considered SPACE.
628
629Here are some examples:
630
631 \"\\\\(^ +\\\\)\" visualize only leading SPACEs.
632 \"\\\\( +$\\\\)\" visualize only trailing SPACEs.
633 \"\\\\(^ +\\\\| +$\\\\)\" \
634visualize leading and/or trailing SPACEs.
635 \"\\t\\\\( +\\\\)\\t\" visualize only SPACEs between TABs.
636
637NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
638 Use exactly one pair of enclosing \\\\( and \\\\).
639
640Used when `blank-style' has `color' as an element, and
641`blank-chars' has `spaces' as an element."
642 :type '(regexp :tag "SPACE Chars")
643 :group 'blank)
644
645
646(defcustom blank-tab-regexp "\\(\t+\\)"
647 "*Specify TAB characters regexp.
648
649If you're using `mule' package, it may exist other characters
650besides \"\\t\" that should be considered TAB.
651
652Here are some examples:
653
654 \"\\\\(^\\t+\\\\)\" visualize only leading TABs.
655 \"\\\\(\\t+$\\\\)\" visualize only trailing TABs.
656 \"\\\\(^\\t+\\\\|\\t+$\\\\)\" \
657visualize leading and/or trailing TABs.
658 \" \\\\(\\t+\\\\) \" visualize only TABs between SPACEs.
659
660NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
661 Use exactly one pair of enclosing \\\\( and \\\\).
662
663Used when `blank-style' has `color' as an element, and
664`blank-chars' has `tabs' as an element."
665 :type '(regexp :tag "TAB Chars")
666 :group 'blank)
667
668
669(defcustom blank-trailing-regexp
670 "\t\\| \\|\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20"
671 "*Specify trailing characters regexp.
672
673If you're using `mule' package, it may exist other characters besides:
674
675 \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \
676\"\\xF20\"
677
678that should be considered blank.
679
680NOTE: DO NOT enclose by \\\\( and \\\\) the elements to highlight.
681 `blank-mode' surrounds this regexp by \"\\\\(\\\\(\" and
682 \"\\\\)+\\\\)$\".
683
684Used when `blank-style' has `color' as an element, and
685`blank-chars' has `trailing' as an element."
686 :type '(regexp :tag "Trailing Chars")
687 :group 'blank)
688
689
690(defcustom blank-space-before-tab-regexp "\\( +\\)\t"
691 "*Specify SPACEs before TAB regexp.
692
693If you're using `mule' package, it may exist other characters besides:
694
695 \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \
696\"\\xF20\"
697
698that should be considered blank.
699
700Used when `blank-style' has `color' as an element, and
701`blank-chars' has `space-before-tab' as an element."
702 :type '(regexp :tag "SPACEs Before TAB")
703 :group 'blank)
704
705
706(defcustom blank-indentation-regexp "^\t*\\(\\( \\{8\\}\\)+\\)[^\n\t]"
707 "*Specify regexp for 8 or more SPACEs at beginning of line.
708
709If you're using `mule' package, it may exist other characters besides:
710
711 \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \
712\"\\xF20\"
713
714that should be considered blank.
715
716Used when `blank-style' has `color' as an element, and
717`blank-chars' has `indentation' as an element."
718 :type '(regexp :tag "Indentation SPACEs")
719 :group 'blank)
720
721
722(defcustom blank-empty-at-bob-regexp "\\`\\(\\([ \t]*\n\\)+\\)"
723 "*Specify regexp for empty lines at beginning of buffer.
724
725If you're using `mule' package, it may exist other characters besides:
726
727 \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \
728\"\\xF20\"
729
730that should be considered blank.
731
732Used when `blank-style' has `color' as an element, and
733`blank-chars' has `empty' as an element."
734 :type '(regexp :tag "Empty Lines At Beginning Of Buffer")
735 :group 'blank)
736
737
738(defcustom blank-empty-at-eob-regexp "^\\([ \t\n]+\\)\\'"
739 "*Specify regexp for empty lines at end of buffer.
740
741If you're using `mule' package, it may exist other characters besides:
742
743 \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \
744\"\\xF20\"
745
746that should be considered blank.
747
748Used when `blank-style' has `color' as an element, and
749`blank-chars' has `empty' as an element."
750 :type '(regexp :tag "Empty Lines At End Of Buffer")
751 :group 'blank)
752
753
754(defcustom blank-space-after-tab-regexp "\t\\(\\( \\{8\\}\\)+\\)"
755 "*Specify regexp for 8 or more SPACEs after TAB.
756
757If you're using `mule' package, it may exist other characters besides:
758
759 \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \
760\"\\xF20\"
761
762that should be considered blank.
763
764Used when `blank-style' has `color' as an element, and
765`blank-chars' has `space-after-tab' as an element."
766 :type '(regexp :tag "SPACEs After TAB")
767 :group 'blank)
768
769
770(defcustom blank-line-column 80
771 "*Specify column beyond which the line is highlighted.
772
773Used when `blank-style' has `color' as an element, and
774`blank-chars' has `lines' or `lines-tail' as an element."
775 :type '(integer :tag "Line Length")
776 :group 'blank)
777
778
779;; Hacked from `visible-whitespace-mappings' in visws.el
780(defcustom blank-display-mappings
781 ;; Due to limitations of glyph representation, the char code can not
782 ;; be above ?\x1FFFF. Probably, this will be fixed after Emacs
783 ;; unicode merging.
784 '(
785 (?\ [?\xB7] [?.]) ; space - centered dot
786 (?\xA0 [?\xA4] [?_]) ; hard space - currency
787 (?\x8A0 [?\x8A4] [?_]) ; hard space - currency
788 (?\x920 [?\x924] [?_]) ; hard space - currency
789 (?\xE20 [?\xE24] [?_]) ; hard space - currency
790 (?\xF20 [?\xF24] [?_]) ; hard space - currency
791 ;; NEWLINE is displayed using the face `blank-newline'
792 (?\n [?$ ?\n]) ; end-of-line - dollar sign
793 ;; (?\n [?\u21B5 ?\n] [?$ ?\n]) ; end-of-line - downwards arrow
794 ;; (?\n [?\xB6 ?\n] [?$ ?\n]) ; end-of-line - pilcrow
795 ;; (?\n [?\x8AF ?\n] [?$ ?\n]) ; end-of-line - overscore
796 ;; (?\n [?\x8AC ?\n] [?$ ?\n]) ; end-of-line - negation
797 ;; (?\n [?\x8B0 ?\n] [?$ ?\n]) ; end-of-line - grade
798 ;;
799 ;; WARNING: the mapping below has a problem.
800 ;; When a TAB occupies exactly one column, it will display the
801 ;; character ?\xBB at that column followed by a TAB which goes to
802 ;; the next TAB column.
803 ;; If this is a problem for you, please, comment the line below.
804 (?\t [?\xBB ?\t] [?\\ ?\t]) ; tab - left quote mark
805 )
806 "*Specify an alist of mappings for displaying characters.
807
808Each element has the following form:
809
810 (CHAR VECTOR...)
811
812Where:
813
814CHAR is the character to be mapped.
815
816VECTOR is a vector of characters to be displayed in place of CHAR.
817 The first display vector that can be displayed is used;
818 if no display vector for a mapping can be displayed, then
819 that character is displayed unmodified.
820
821The NEWLINE character is displayed using the face given by
822`blank-newline' variable. The characters in the vector to be
823displayed will not have this face applied if the character code
824is above #x1FFFF.
825
826Used when `blank-style' has `mark' as an element."
827 :type '(repeat
828 (list :tag "Character Mapping"
829 (character :tag "Char")
830 (repeat :inline t :tag "Vector List"
831 (vector :tag ""
832 (repeat :inline t
833 :tag "Vector Characters"
834 (character :tag "Char"))))))
835 :group 'blank)
836
837
838(defcustom blank-global-modes t
839 "*Modes for which global `blank-mode' is automagically turned on.
840
841Global `blank-mode' is controlled by the command `global-blank-mode'.
842
843If nil, means no modes have `blank-mode' automatically turned on.
844If t, all modes that support `blank-mode' have it automatically
845turned on.
846Else it should be a list of `major-mode' symbol names for
847which `blank-mode' should be automatically turned on. The sense
848of the list is negated if it begins with `not'. For example:
849
850 (c-mode c++-mode)
851
852means that `blank-mode' is turned on for buffers in C and C++
853modes only."
854 :type '(choice (const :tag "None" nil)
855 (const :tag "All" t)
856 (set :menu-tag "Mode Specific" :tag "Modes"
857 :value (not)
858 (const :tag "Except" not)
859 (repeat :inline t
860 (symbol :tag "Mode"))))
861 :group 'blank)
862
863
864;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
865;;;; User commands - Local mode
866
867
868;;;###autoload
869(define-minor-mode blank-mode
870 "Toggle blank minor mode visualization (\"bl\" on modeline).
871
872If ARG is null, toggle blank visualization.
873If ARG is a number greater than zero, turn on visualization;
874otherwise, turn off visualization.
875Only useful with a windowing system."
876 :lighter " bl"
877 :init-value nil
878 :global nil
879 :group 'blank
880 (cond
881 (noninteractive ; running a batch job
882 (setq blank-mode nil))
883 (blank-mode ; blank-mode on
884 (blank-turn-on))
885 (t ; blank-mode off
886 (blank-turn-off))))
887
888
889;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
890;;;; User commands - Global mode
891
892
893(define-minor-mode global-blank-mode
894 "Toggle blank global minor mode visualization (\"BL\" on modeline).
895
896If ARG is null, toggle blank visualization.
897If ARG is a number greater than zero, turn on visualization;
898otherwise, turn off visualization.
899Only useful with a windowing system."
900 :lighter " BL"
901 :init-value nil
902 :global t
903 :group 'blank
904 (cond
905 (noninteractive ; running a batch job
906 (setq global-blank-mode nil))
907 (global-blank-mode ; global-blank-mode on
908 (save-excursion
909 (if (boundp 'find-file-hook)
910 (add-hook 'find-file-hook 'blank-turn-on-if-enabled t)
911 (add-hook 'find-file-hooks 'blank-turn-on-if-enabled t))
912 (dolist (buffer (buffer-list)) ; adjust all local mode
913 (set-buffer buffer)
914 (unless blank-mode
915 (blank-turn-on-if-enabled)))))
916 (t ; global-blank-mode off
917 (save-excursion
918 (if (boundp 'find-file-hook)
919 (remove-hook 'find-file-hook 'blank-turn-on-if-enabled)
920 (remove-hook 'find-file-hooks 'blank-turn-on-if-enabled))
921 (dolist (buffer (buffer-list)) ; adjust all local mode
922 (set-buffer buffer)
923 (unless blank-mode
924 (blank-turn-off)))))))
925
926
927(defun blank-turn-on-if-enabled ()
928 (when (cond
929 ((eq blank-global-modes t))
930 ((listp blank-global-modes)
931 (if (eq (car-safe blank-global-modes) 'not)
932 (not (memq major-mode (cdr blank-global-modes)))
933 (memq major-mode blank-global-modes)))
934 (t nil))
935 (let (inhibit-quit)
936 ;; Don't turn on blank mode if...
937 (or
938 ;; ...we don't have a display (we're running a batch job)
939 noninteractive
940 ;; ...or if the buffer is invisible (name starts with a space)
941 (eq (aref (buffer-name) 0) ?\ )
942 ;; ...or if the buffer is temporary (name starts with *)
943 (and (eq (aref (buffer-name) 0) ?*)
944 ;; except the scratch buffer.
945 (not (string= (buffer-name) "*scratch*")))
946 ;; Otherwise, turn on blank mode.
947 (blank-turn-on)))))
948
949
950;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
951;;;; User commands - Toggle
952
953
954(defconst blank-chars-value-list
955 '(tabs
956 spaces
957 trailing
958 space-before-tab
959 lines
960 lines-tail
961 newline
962 indentation
963 empty
964 space-after-tab
965 )
966 "List of valid `blank-chars' values.")
967
968
969(defconst blank-style-value-list
970 '(color
971 mark
972 )
973 "List of valid `blank-style' values.")
974
975
976(defconst blank-toggle-option-alist
977 '((?t . tabs)
978 (?s . spaces)
979 (?r . trailing)
980 (?b . space-before-tab)
981 (?l . lines)
982 (?L . lines-tail)
983 (?n . newline)
984 (?i . indentation)
985 (?e . empty)
986 (?a . space-after-tab)
987 (?c . color)
988 (?m . mark)
989 (?x . blank-chars)
990 (?z . blank-style)
991 )
992 "Alist of toggle options.
993
994Each element has the form:
995
996 (CHAR . SYMBOL)
997
998Where:
999
1000CHAR is a char which the user will have to type.
1001
1002SYMBOL is a valid symbol associated with CHAR.
1003 See `blank-chars-value-list' and `blank-style-value-list'.")
1004
1005
1006(defvar blank-active-chars nil
1007 "Used to save locally `blank-chars' value.")
1008(make-variable-buffer-local 'blank-active-chars)
1009
1010(defvar blank-active-style nil
1011 "Used to save locally `blank-style' value.")
1012(make-variable-buffer-local 'blank-active-style)
1013
1014
1015;;;###autoload
1016(defun blank-toggle-options (arg)
1017 "Toggle local `blank-mode' options.
1018
1019If local blank-mode is off, toggle the option given by ARG and
1020turn on local blank-mode.
1021
1022If local blank-mode is on, toggle the option given by ARG and
1023restart local blank-mode.
1024
1025Interactively, it reads one of the following chars:
1026
1027 CHAR MEANING
1028 t toggle TAB visualization
1029 s toggle SPACE and HARD SPACE visualization
1030 r toggle trailing blanks visualization
1031 b toggle SPACEs before TAB visualization
1032 l toggle \"long lines\" visualization
1033 L toggle \"long lines\" tail visualization
1034 n toggle NEWLINE visualization
1035 i toggle indentation SPACEs visualization
1036 e toggle empty line at bob and/or eob visualization
1037 a toggle SPACEs after TAB visualization
1038 c toggle color faces
1039 m toggle visual mark
1040 x restore `blank-chars' value
1041 z restore `blank-style' value
1042 ? display brief help
1043
1044Non-interactively, ARG should be a symbol or a list of symbols.
1045The valid symbols are:
1046
1047 tabs toggle TAB visualization
1048 spaces toggle SPACE and HARD SPACE visualization
1049 trailing toggle trailing blanks visualization
1050 space-before-tab toggle SPACEs before TAB visualization
1051 lines toggle \"long lines\" visualization
1052 lines-tail toggle \"long lines\" tail visualization
1053 newline toggle NEWLINE visualization
1054 indentation toggle indentation SPACEs visualization
1055 empty toggle empty line at bob and/or eob visualization
1056 space-after-tab toggle SPACEs after TAB visualization
1057 color toggle color faces
1058 mark toggle visual mark
1059 blank-chars restore `blank-chars' value
1060 blank-style restore `blank-style' value
1061
1062Only useful with a windowing system."
1063 (interactive (blank-interactive-char t))
1064 (let ((blank-chars
1065 (blank-toggle-list t arg blank-active-chars blank-chars
1066 'blank-chars blank-chars-value-list))
1067 (blank-style
1068 (blank-toggle-list t arg blank-active-style blank-style
1069 'blank-style blank-style-value-list)))
1070 (blank-mode 0)
1071 (blank-mode 1)))
1072
1073
1074(defvar blank-toggle-chars nil
1075 "Used to toggle the global `blank-chars' value.")
1076(defvar blank-toggle-style nil
1077 "Used to toggle the global `blank-style' value.")
1078
1079
1080;;;###autoload
1081(defun global-blank-toggle-options (arg)
1082 "Toggle global `blank-mode' options.
1083
1084If global blank-mode is off, toggle the option given by ARG and
1085turn on global blank-mode.
1086
1087If global blank-mode is on, toggle the option given by ARG and
1088restart global blank-mode.
1089
1090Interactively, it reads one of the following chars:
1091
1092 CHAR MEANING
1093 t toggle TAB visualization
1094 s toggle SPACE and HARD SPACE visualization
1095 r toggle trailing blanks visualization
1096 b toggle SPACEs before TAB visualization
1097 l toggle \"long lines\" visualization
1098 L toggle \"long lines\" tail visualization
1099 n toggle NEWLINE visualization
1100 i toggle indentation SPACEs visualization
1101 e toggle empty line at bob and/or eob visualization
1102 a toggle SPACEs after TAB visualization
1103 c toggle color faces
1104 m toggle visual mark
1105 x restore `blank-chars' value
1106 z restore `blank-style' value
1107 ? display brief help
1108
1109Non-interactively, ARG should be a symbol or a list of symbols.
1110The valid symbols are:
1111
1112 tabs toggle TAB visualization
1113 spaces toggle SPACE and HARD SPACE visualization
1114 trailing toggle trailing blanks visualization
1115 space-before-tab toggle SPACEs before TAB visualization
1116 lines toggle \"long lines\" visualization
1117 lines-tail toggle \"long lines\" tail visualization
1118 newline toggle NEWLINE visualization
1119 indentation toggle indentation SPACEs visualization
1120 empty toggle empty line at bob and/or eob visualization
1121 space-after-tab toggle SPACEs after TAB visualization
1122 color toggle color faces
1123 mark toggle visual mark
1124 blank-chars restore `blank-chars' value
1125 blank-style restore `blank-style' value
1126
1127Only useful with a windowing system."
1128 (interactive (blank-interactive-char nil))
1129 (let ((blank-chars
1130 (blank-toggle-list nil arg blank-toggle-chars blank-chars
1131 'blank-chars blank-chars-value-list))
1132 (blank-style
1133 (blank-toggle-list nil arg blank-toggle-style blank-style
1134 'blank-style blank-style-value-list)))
1135 (setq blank-toggle-chars blank-chars
1136 blank-toggle-style blank-style)
1137 (global-blank-mode 0)
1138 (global-blank-mode 1)))
1139
1140
1141;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1142;;;; User commands - Cleanup
1143
1144
1145;;;###autoload
1146(defun blank-cleanup ()
1147 "Cleanup some blank problems in all buffer or at region.
1148
1149It usually applies to the whole buffer, but in transient mark
1150mode when the mark is active, it applies to the region. It also
1151applies to the region when it is not in transiente mark mode, the
1152mark is active and it was pressed `C-u' just before calling
1153`blank-cleanup' interactively.
1154
1155See also `blank-cleanup-region'.
1156
1157The problems, which are cleaned up, are:
1158
11591. empty lines at beginning of buffer.
11602. empty lines at end of buffer.
1161 If `blank-chars' has `empty' as an element, remove all empty
1162 lines at beginning and/or end of buffer.
1163
11643. 8 or more SPACEs at beginning of line.
1165 If `blank-chars' has `indentation' as an element, replace 8 or
1166 more SPACEs at beginning of line by TABs.
1167
11684. SPACEs before TAB.
1169 If `blank-chars' has `space-before-tab' as an element, replace
1170 SPACEs by TABs.
1171
11725. SPACEs or TABs at end of line.
1173 If `blank-chars' has `trailing' as an element, remove all
1174 SPACEs or TABs at end of line.
1175
11766. 8 or more SPACEs after TAB.
1177 If `blank-chars' has `space-after-tab' as an element, replace
1178 SPACEs by TABs."
1179 (interactive "@*")
1180 (if (and (or transient-mark-mode
1181 current-prefix-arg)
1182 mark-active)
1183 ;; region active
1184 ;; problems 1 and 2 are not handled in region
1185 ;; problem 3: 8 or more SPACEs at bol
1186 ;; problem 4: SPACEs before TAB
1187 ;; problem 5: SPACEs or TABs at eol
1188 ;; problem 6: 8 or more SPACEs after TAB
1189 (blank-cleanup-region (region-beginning) (region-end))
1190 ;; whole buffer
1191 (save-excursion
1192 (save-match-data
1193 ;; problem 1: empty lines at bob
1194 ;; problem 2: empty lines at eob
1195 ;; action: remove all empty lines at bob and/or eob
1196 (when (memq 'empty blank-chars)
1197 (let (overwrite-mode) ; enforce no overwrite
1198 (goto-char (point-min))
1199 (when (re-search-forward blank-empty-at-bob-regexp nil t)
1200 (delete-region (match-beginning 1) (match-end 1)))
1201 (when (re-search-forward blank-empty-at-eob-regexp nil t)
1202 (delete-region (match-beginning 1) (match-end 1)))))))
1203 ;; problem 3: 8 or more SPACEs at bol
1204 ;; problem 4: SPACEs before TAB
1205 ;; problem 5: SPACEs or TABs at eol
1206 ;; problem 6: 8 or more SPACEs after TAB
1207 (blank-cleanup-region (point-min) (point-max))))
1208
1209
1210;;;###autoload
1211(defun blank-cleanup-region (start end)
1212 "Cleanup some blank problems at region.
1213
1214The problems, which are cleaned up, are:
1215
12161. 8 or more SPACEs at beginning of line.
1217 If `blank-chars' has `indentation' as an element, replace 8 or
1218 more SPACEs at beginning of line by TABs.
1219
12202. SPACEs before TAB.
1221 If `blank-chars' has `space-before-tab' as an element, replace
1222 SPACEs by TABs.
1223
12243. SPACEs or TABs at end of line.
1225 If `blank-chars' has `trailing' as an element, remove all
1226 SPACEs or TABs at end of line.
1227
12284. 8 or more SPACEs after TAB.
1229 If `blank-chars' has `space-after-tab' as an element, replace
1230 SPACEs by TABs."
1231 (interactive "@*r")
1232 (let ((rstart (min start end))
1233 (rend (copy-marker (max start end)))
1234 (tab-width 8) ; assure TAB width
1235 (indent-tabs-mode t) ; always insert TABs
1236 overwrite-mode ; enforce no overwrite
1237 tmp)
1238 (save-excursion
1239 (save-match-data
1240 ;; problem 1: 8 or more SPACEs at bol
1241 ;; action: replace 8 or more SPACEs at bol by TABs
1242 (when (memq 'indentation blank-chars)
1243 (goto-char rstart)
1244 (while (re-search-forward blank-indentation-regexp rend t)
1245 (setq tmp (current-indentation))
1246 (delete-horizontal-space)
1247 (unless (eolp)
1248 (indent-to tmp))))
1249 ;; problem 3: SPACEs or TABs at eol
1250 ;; action: remove all SPACEs or TABs at eol
1251 (when (memq 'trailing blank-chars)
1252 (let ((regexp (concat "\\(\\(" blank-trailing-regexp
1253 "\\)+\\)$")))
1254 (goto-char rstart)
1255 (while (re-search-forward regexp rend t)
1256 (delete-region (match-beginning 1) (match-end 1)))))
1257 ;; problem 4: 8 or more SPACEs after TAB
1258 ;; action: replace 8 or more SPACEs by TABs
1259 (when (memq 'space-after-tab blank-chars)
1260 (blank-replace-spaces-by-tabs
1261 rstart rend blank-space-after-tab-regexp))
1262 ;; problem 2: SPACEs before TAB
1263 ;; action: replace SPACEs before TAB by TABs
1264 (when (memq 'space-before-tab blank-chars)
1265 (blank-replace-spaces-by-tabs
1266 rstart rend blank-space-before-tab-regexp))))
1267 (set-marker rend nil))) ; point marker to nowhere
1268
1269
1270(defun blank-replace-spaces-by-tabs (rstart rend regexp)
1271 "Replace all SPACEs by TABs matched by REGEXP between RSTART and REND."
1272 (goto-char rstart)
1273 (while (re-search-forward regexp rend t)
1274 (goto-char (match-beginning 1))
1275 (let* ((scol (current-column))
1276 (ecol (save-excursion
1277 (goto-char (match-end 1))
1278 (current-column))))
1279 (delete-region (match-beginning 1) (match-end 1))
1280 (insert-char ?\t
1281 (/ (- (- ecol (% ecol 8)) ; prev end col
1282 (- scol (% scol 8))) ; prev start col
1283 8)))))
1284
1285
1286;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1287;;;; Internal functions
1288
1289
1290(defvar blank-font-lock-mode nil
1291 "Used to remember whether a buffer had font lock mode on or not.")
1292(make-variable-buffer-local 'blank-font-lock-mode)
1293
1294(defvar blank-font-lock nil
1295 "Used to remember whether a buffer initially had font lock on or not.")
1296(make-variable-buffer-local 'blank-font-lock)
1297
1298(defvar blank-font-lock-keywords nil
1299 "Used to save locally `font-lock-keywords' value.")
1300(make-variable-buffer-local 'blank-font-lock-keywords)
1301
1302
1303(defconst blank-help-text
1304 "\
1305 blank-mode toggle options:
1306
1307 [] t - toggle TAB visualization
1308 [] s - toggle SPACE and HARD SPACE visualization
1309 [] r - toggle trailing blanks visualization
1310 [] b - toggle SPACEs before TAB visualization
1311 [] l - toggle \"long lines\" visualization
1312 [] L - toggle \"long lines\" tail visualization
1313 [] n - toggle NEWLINE visualization
1314 [] i - toggle indentation SPACEs visualization
1315 [] e - toggle empty line at bob and/or eob visualization
1316 [] a - toggle SPACEs after TAB visualization
1317
1318 [] c - toggle color faces
1319 [] m - toggle visual mark
1320
1321 x - restore `blank-chars' value
1322 z - restore `blank-style' value
1323
1324 ? - display this text\n\n"
1325 "Text for blank toggle options.")
1326
1327
1328(defconst blank-help-buffer-name "*Blank Toggle Options*"
1329 "The buffer name for blank toggle options.")
1330
1331
1332(defun blank-insert-option-mark (the-list the-value)
1333 "Insert the option mark ('X' or ' ') in toggle options buffer."
1334 (forward-line 1)
1335 (dolist (sym the-list)
1336 (forward-line 1)
1337 (forward-char 2)
1338 (insert (if (memq sym the-value) "X" " "))))
1339
1340
1341(defun blank-help-on (chars style)
1342 "Display the blank toggle options."
1343 (unless (get-buffer blank-help-buffer-name)
1344 (delete-other-windows)
1345 (let ((buffer (get-buffer-create blank-help-buffer-name)))
1346 (save-excursion
1347 (set-buffer buffer)
1348 (erase-buffer)
1349 (insert blank-help-text)
1350 (goto-char (point-min))
1351 (blank-insert-option-mark blank-chars-value-list chars)
1352 (blank-insert-option-mark blank-style-value-list style)
1353 (goto-char (point-min))
1354 (set-buffer-modified-p nil)
1355 (let ((size (- (window-height)
1356 (max window-min-height
1357 (1+ (count-lines (point-min) (point-max)))))))
1358 (when (<= size 0)
1359 (kill-buffer buffer)
1360 (error "Frame height is too small; \
1361can't split window to display blank toggle options"))
1362 (set-window-buffer (split-window nil size) buffer))))))
1363
1364
1365(defun blank-help-off ()
1366 "Remove the buffer and window of the blank toggle options."
1367 (let ((buffer (get-buffer blank-help-buffer-name)))
1368 (when buffer
1369 (delete-windows-on buffer)
1370 (kill-buffer buffer))))
1371
1372
1373(defun blank-interactive-char (local-p)
1374 "Interactive function to read a char and return a symbol.
1375
1376If LOCAL-P is non-nil, it uses a local context; otherwise, it
1377uses a global context.
1378
1379It reads one of the following chars:
1380
1381 CHAR MEANING
1382 t toggle TAB visualization
1383 s toggle SPACE and HARD SPACE visualization
1384 r toggle trailing blanks visualization
1385 b toggle SPACEs before TAB visualization
1386 l toggle \"long lines\" visualization
1387 L toggle \"long lines\" tail visualization
1388 n toggle NEWLINE visualization
1389 i toggle indentation SPACEs visualization
1390 e toggle empty line at bob and/or eob visualization
1391 a toggle SPACEs after TAB visualization
1392 c toggle color faces
1393 m toggle visual mark
1394 x restore `blank-chars' value
1395 z restore `blank-style' value
1396 ? display brief help
1397
1398See also `blank-toggle-option-alist'."
1399 (let* ((is-off (not (if local-p blank-mode global-blank-mode)))
1400 (chars (cond (is-off blank-chars) ; use default value
1401 (local-p blank-active-chars)
1402 (t blank-toggle-chars)))
1403 (style (cond (is-off blank-style) ; use default value
1404 (local-p blank-active-style)
1405 (t blank-toggle-style)))
1406 (prompt
1407 (format "Blank Toggle %s (type ? for further options)-"
1408 (if local-p "Local" "Global")))
1409 ch sym)
1410 ;; read a valid option and get the corresponding symbol
1411 (save-window-excursion
1412 (condition-case data
1413 (progn
1414 (while
1415 ;; while condition
1416 (progn
1417 (setq ch (read-char prompt))
1418 (not
1419 (setq sym
1420 (cdr (assq ch blank-toggle-option-alist)))))
1421 ;; while body
1422 (if (eq ch ?\?)
1423 (blank-help-on chars style)
1424 (ding)))
1425 (blank-help-off)
1426 (message " ")) ; clean echo area
1427 ;; handler
1428 ((quit error)
1429 (blank-help-off)
1430 (error (error-message-string data)))))
1431 (list sym))) ; return the apropriate symbol
1432
1433
1434(defun blank-toggle-list (local-p arg the-list default-list
1435 sym-restore sym-list)
1436 "Toggle options in THE-LIST based on list ARG.
1437
1438If LOCAL-P is non-nil, it uses a local context; otherwise, it
1439uses a global context.
1440
1441ARG is a list of options to be toggled.
1442
1443THE-LIST is a list of options. This list will be toggled and the
1444resultant list will be returned.
1445
1446DEFAULT-LIST is the default list of options. It is used to
1447restore the options in THE-LIST.
1448
1449SYM-RESTORE is the symbol which indicates to restore the options
1450in THE-LIST.
1451
1452SYM-LIST is a list of valid options, used to check if the ARG's
1453options are valid."
1454 (unless (if local-p blank-mode global-blank-mode)
1455 (setq the-list default-list))
1456 (setq the-list (copy-sequence the-list)) ; keep original list
1457 (dolist (sym (if (listp arg) arg (list arg)))
1458 (cond
1459 ;; restore default values
1460 ((eq sym sym-restore)
1461 (setq the-list default-list))
1462 ;; toggle valid values
1463 ((memq sym sym-list)
1464 (setq the-list (if (memq sym the-list)
1465 (delq sym the-list)
1466 (cons sym the-list))))))
1467 the-list)
1468
1469
1470(defun blank-turn-on ()
1471 "Turn on blank visualization."
1472 (setq blank-active-style (if (listp blank-style)
1473 blank-style
1474 (list blank-style)))
1475 (setq blank-active-chars (if (listp blank-chars)
1476 blank-chars
1477 (list blank-chars)))
1478 (when (memq 'color blank-active-style)
1479 (blank-color-on))
1480 (when (memq 'mark blank-active-style)
1481 (blank-display-char-on)))
1482
1483
1484(defun blank-turn-off ()
1485 "Turn off blank visualization."
1486 (when (memq 'color blank-active-style)
1487 (blank-color-off))
1488 (when (memq 'mark blank-active-style)
1489 (blank-display-char-off)))
1490
1491
1492(defun blank-color-on ()
1493 "Turn on color visualization."
1494 (when blank-active-chars
1495 (unless blank-font-lock
1496 (setq blank-font-lock t
1497 blank-font-lock-keywords
1498 (copy-sequence font-lock-keywords)))
1499 ;; turn off font lock
1500 (setq blank-font-lock-mode font-lock-mode)
1501 (font-lock-mode 0)
1502 ;; add blank-mode color into font lock
1503 (when (memq 'spaces blank-active-chars)
1504 (font-lock-add-keywords
1505 nil
1506 (list
1507 ;; Show SPACEs
1508 (list blank-space-regexp 1 blank-space t)
1509 ;; Show HARD SPACEs
1510 (list blank-hspace-regexp 1 blank-hspace t))
1511 t))
1512 (when (memq 'tabs blank-active-chars)
1513 (font-lock-add-keywords
1514 nil
1515 (list
1516 ;; Show TABs
1517 (list blank-tab-regexp 1 blank-tab t))
1518 t))
1519 (when (memq 'trailing blank-active-chars)
1520 (font-lock-add-keywords
1521 nil
1522 (list
1523 ;; Show trailing blanks
1524 (list (concat "\\(\\(" blank-trailing-regexp "\\)+\\)$")
1525 1 blank-trailing t))
1526 t))
1527 (when (or (memq 'lines blank-active-chars)
1528 (memq 'lines-tail blank-active-chars))
1529 (font-lock-add-keywords
1530 nil
1531 (list
1532 ;; Show "long" lines
1533 (list
1534 (format
1535 "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
1536 tab-width (1- tab-width)
1537 (/ blank-line-column tab-width)
1538 (let ((rem (% blank-line-column tab-width)))
1539 (if (zerop rem)
1540 ""
1541 (format ".\\{%d\\}" rem))))
1542 (if (memq 'lines blank-active-chars)
1543 0 ; whole line
1544 2) ; line tail
1545 blank-line t))
1546 t))
1547 (when (memq 'space-before-tab blank-active-chars)
1548 (font-lock-add-keywords
1549 nil
1550 (list
1551 ;; Show SPACEs before TAB
1552 (list blank-space-before-tab-regexp
1553 1 blank-space-before-tab t))
1554 t))
1555 (when (memq 'indentation blank-active-chars)
1556 (font-lock-add-keywords
1557 nil
1558 (list
1559 ;; Show indentation SPACEs
1560 (list blank-indentation-regexp
1561 1 blank-indentation t))
1562 t))
1563 (when (memq 'empty blank-active-chars)
1564 (font-lock-add-keywords
1565 nil
1566 (list
1567 ;; Show empty lines at beginning of buffer
1568 (list blank-empty-at-bob-regexp
1569 1 blank-empty t))
1570 t)
1571 (font-lock-add-keywords
1572 nil
1573 (list
1574 ;; Show empty lines at end of buffer
1575 (list blank-empty-at-eob-regexp
1576 1 blank-empty t))
1577 t))
1578 (when (memq 'space-after-tab blank-active-chars)
1579 (font-lock-add-keywords
1580 nil
1581 (list
1582 ;; Show SPACEs after TAB
1583 (list blank-space-after-tab-regexp
1584 1 blank-space-after-tab t))
1585 t))
1586 ;; now turn on font lock and highlight blanks
1587 (font-lock-mode 1)))
1588
1589
1590(defun blank-color-off ()
1591 "Turn off color visualization."
1592 (when blank-active-chars
1593 ;; turn off font lock
1594 (font-lock-mode 0)
1595 (when blank-font-lock
1596 (setq blank-font-lock nil
1597 font-lock-keywords blank-font-lock-keywords))
1598 ;; restore original font lock state
1599 (font-lock-mode blank-font-lock-mode)))
1600
1601
1602;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1603;;;; Hacked from visws.el (Miles Bader <miles@gnu.org>)
1604
1605
1606(defvar blank-display-table nil
1607 "Used to save a local display table.")
1608(make-variable-buffer-local 'blank-display-table)
1609
1610(defvar blank-display-table-was-local nil
1611 "Used to remember whether a buffer initially had a local display table or not.")
1612(make-variable-buffer-local 'blank-display-table-was-local)
1613
1614
1615(defsubst blank-char-valid-p (char)
1616 ;; This check should be improved!!!
1617 (or (< char 256)
1618 (char-valid-p char)))
1619
1620
1621(defun blank-legal-display-vector-p (vec)
1622 "Return true if every character in vector VEC can be displayed."
1623 (let ((i (length vec)))
1624 (when (> i 0)
1625 (while (and (>= (setq i (1- i)) 0)
1626 (blank-char-valid-p (aref vec i))))
1627 (< i 0))))
1628
1629
1630(defun blank-display-char-on ()
1631 "Turn on character display mapping."
1632 (when blank-display-mappings
1633 (let (vecs vec)
1634 ;; Remember whether a buffer has a local display table.
1635 (unless blank-display-table-was-local
1636 (setq blank-display-table-was-local t
1637 blank-display-table
1638 (copy-sequence buffer-display-table)))
1639 (unless buffer-display-table
1640 (setq buffer-display-table (make-display-table)))
1641 (dolist (entry blank-display-mappings)
1642 (setq vecs (cdr entry))
1643 ;; Get a displayable mapping.
1644 (while (and vecs
1645 (not (blank-legal-display-vector-p (car vecs))))
1646 (setq vecs (cdr vecs)))
1647 ;; Display a valid mapping.
1648 (when vecs
1649 (setq vec (copy-sequence (car vecs)))
1650 (cond
1651 ;; Any char except newline
1652 ((not (eq (car entry) ?\n))
1653 (aset buffer-display-table (car entry) vec))
1654 ;; Newline char - display it
1655 ((memq 'newline blank-active-chars)
1656 ;; Only insert face bits on NEWLINE char mapping to avoid
1657 ;; obstruction of other faces like TABs and (HARD) SPACEs
1658 ;; faces, font-lock faces, etc.
1659 (when (memq 'color blank-active-style)
1660 (dotimes (i (length vec))
1661 ;; Due to limitations of glyph representation, the char
1662 ;; code can not be above ?\x1FFFF. Probably, this will
1663 ;; be fixed after Emacs unicode merging.
1664 (or (eq (aref vec i) ?\n)
1665 (> (aref vec i) #x1FFFF)
1666 (aset vec i (make-glyph-code (aref vec i)
1667 blank-newline)))))
1668 ;; Display mapping
1669 (aset buffer-display-table (car entry) vec))
1670 ;; Newline char - don't display it
1671 (t
1672 ;; Do nothing
1673 )))))))
1674
1675
1676(defun blank-display-char-off ()
1677 "Turn off character display mapping."
1678 (and blank-display-mappings
1679 blank-display-table-was-local
1680 (setq blank-display-table-was-local nil
1681 buffer-display-table blank-display-table)))
1682
1683
1684;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1685;;;; Aliases for whitespace compatibility
1686
1687
1688;;;###autoload
1689(defun whitespace-buffer ()
1690 (interactive)
1691 (blank-mode 0) ; assure is off
1692 ;; keep original values
1693 (let ((blank-style (copy-sequence blank-style))
1694 (blank-chars (copy-sequence blank-chars)))
1695 ;; adjust options for whitespace bogus blanks
1696 (add-to-list 'blank-style 'color)
1697 (mapc #'(lambda (option)
1698 (add-to-list 'blank-chars option))
1699 '(trailing
1700 indentation
1701 space-before-tab
1702 empty
1703 space-after-tab))
1704 (blank-mode 1)))
1705
1706;;;###autoload
1707(defalias 'whitespace-region 'whitespace-buffer) ; there is no `blank-region'
1708
1709;;;###autoload
1710(defalias 'whitespace-cleanup 'blank-cleanup)
1711
1712;;;###autoload
1713(defalias 'whitespace-cleanup-region 'blank-cleanup-region)
1714
1715
1716;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1717
1718
1719(provide 'blank-mode)
1720
1721
1722(run-hooks 'blank-load-hook)
1723
1724
1725;; arch-tag: 1b1e2500-dbd4-4a26-8f7a-5a5edfd3c97e
1726;;; blank-mode.el ends here
diff --git a/lisp/button.el b/lisp/button.el
index 5129df9b44f..0b45f2cec41 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -116,7 +116,7 @@ Buttons inherit them by setting their `category' property to that symbol."
116 116
117;;;###autoload 117;;;###autoload
118(defun define-button-type (name &rest properties) 118(defun define-button-type (name &rest properties)
119 "Define a `button type' called NAME. 119 "Define a `button type' called NAME (a symbol).
120The remaining arguments form a sequence of PROPERTY VALUE pairs, 120The remaining arguments form a sequence of PROPERTY VALUE pairs,
121specifying properties to use as defaults for buttons with this type 121specifying properties to use as defaults for buttons with this type
122\(a button's type may be set by giving it a `type' property when 122\(a button's type may be set by giving it a `type' property when
diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el
index ca67b65abfa..973a6a0c9d2 100644
--- a/lisp/calc/calc-menu.el
+++ b/lisp/calc/calc-menu.el
@@ -1,6 +1,6 @@
1;;; calc-menu.el --- a menu for Calc 1;;; calc-menu.el --- a menu for Calc
2 2
3;; Copyright (C) 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> 5;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
6 6
diff --git a/lisp/calc/calc-nlfit.el b/lisp/calc/calc-nlfit.el
index 4019058a567..4eb1093af18 100644
--- a/lisp/calc/calc-nlfit.el
+++ b/lisp/calc/calc-nlfit.el
@@ -1,6 +1,6 @@
1;;; calc-nlfit.el --- nonlinear curve fitting for Calc 1;;; calc-nlfit.el --- nonlinear curve fitting for Calc
2 2
3;; Copyright (C) 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> 5;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
6 6
diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el
index 2846c283c15..38c14c80b14 100644
--- a/lisp/calendar/cal-menu.el
+++ b/lisp/calendar/cal-menu.el
@@ -141,7 +141,10 @@
141 "--" 141 "--"
142 ,@(let ((l ())) 142 ,@(let ((l ()))
143 ;; Show 11 years--5 before, 5 after year of middle month. 143 ;; Show 11 years--5 before, 5 after year of middle month.
144 ;; We used to use :suffix rather than :label and bumped into
145 ;; an easymenu bug:
144 ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01813.html 146 ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01813.html
147 ;; The bug has since been fixed.
145 (dotimes (i 11) 148 (dotimes (i 11)
146 (push (vector (format "hol-year-%d" i) 149 (push (vector (format "hol-year-%d" i)
147 `(lambda () 150 `(lambda ()
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 46b16a54c89..62cc247e8de 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -1,6 +1,7 @@
1;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*- 1;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*-
2 2
3;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. 3;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
4;; Free Software Foundation, Inc.
4 5
5;; Author: Ulf Jasper <ulf.jasper@web.de> 6;; Author: Ulf Jasper <ulf.jasper@web.de>
6;; Created: August 2002 7;; Created: August 2002
@@ -40,33 +41,36 @@
40 41
41;; 0.07 onwards: see lisp/ChangeLog 42;; 0.07 onwards: see lisp/ChangeLog
42 43
43;; 0.06: Bugfixes regarding icalendar-import-format-*. 44;; 0.06: (2004-10-06)
44;; Fix in icalendar-convert-diary-to-ical -- thanks to Philipp 45;; - Bugfixes regarding icalendar-import-format-*.
45;; Grau. 46;; - Fix in icalendar-convert-diary-to-ical -- thanks to Philipp Grau.
46 47
47;; 0.05: New import format scheme: Replaced icalendar-import-prefix-*, 48;; 0.05: (2003-06-19)
48;; icalendar-import-ignored-properties, and 49;; - New import format scheme: Replaced icalendar-import-prefix-*,
49;; icalendar-import-separator with icalendar-import-format(-*). 50;; icalendar-import-ignored-properties, and
50;; icalendar-import-file and icalendar-convert-diary-to-ical 51;; icalendar-import-separator with icalendar-import-format(-*).
51;; have an extra parameter which should prevent them from 52;; - icalendar-import-file and icalendar-convert-diary-to-ical
52;; erasing their target files (untested!). 53;; have an extra parameter which should prevent them from
53;; Tested with Emacs 21.3.2 54;; erasing their target files (untested!).
54 55;; - Tested with Emacs 21.3.2
55;; 0.04: Bugfix: import: double quoted param values did not work 56
56;; Read DURATION property when importing. 57;; 0.04:
57;; Added parameter icalendar-duration-correction. 58;; - Bugfix: import: double quoted param values did not work
58 59;; - Read DURATION property when importing.
59;; 0.03: Export takes care of european-calendar-style. 60;; - Added parameter icalendar-duration-correction.
60;; Tested with Emacs 21.3.2 and XEmacs 21.4.12 61
61 62;; 0.03: (2003-05-07)
62;; 0.02: Should work in XEmacs now. Thanks to Len Trigg for the 63;; - Export takes care of european-calendar-style.
63;; XEmacs patches! 64;; - Tested with Emacs 21.3.2 and XEmacs 21.4.12
64;; Added exporting from Emacs diary to ical. 65
65;; Some bugfixes, after testing with calendars from 66;; 0.02:
66;; http://icalshare.com. 67;; - Should work in XEmacs now. Thanks to Len Trigg for the XEmacs patches!
67;; Tested with Emacs 21.3.2 and XEmacs 21.4.12 68;; - Added exporting from Emacs diary to ical.
68 69;; - Some bugfixes, after testing with calendars from http://icalshare.com.
69;; 0.01: First published version. Trial version. Alpha version. 70;; - Tested with Emacs 21.3.2 and XEmacs 21.4.12
71
72;; 0.01: (2003-03-21)
73;; - First published version. Trial version. Alpha version.
70 74
71;; ====================================================================== 75;; ======================================================================
72;; To Do: 76;; To Do:
@@ -86,7 +90,7 @@
86;; + the parser is too soft 90;; + the parser is too soft
87;; + error log is incomplete 91;; + error log is incomplete
88;; + nice to have: #include "webcal://foo.com/some-calendar.ics" 92;; + nice to have: #include "webcal://foo.com/some-calendar.ics"
89;; + timezones, currently all times are local! 93;; + timezones probably still need some improvements.
90 94
91;; * Export from diary to ical 95;; * Export from diary to ical
92;; + diary-date, diary-float, and self-made sexp entries are not 96;; + diary-date, diary-float, and self-made sexp entries are not
@@ -101,7 +105,7 @@
101 105
102;;; Code: 106;;; Code:
103 107
104(defconst icalendar-version "0.15" 108(defconst icalendar-version "0.17"
105 "Version number of icalendar.el.") 109 "Version number of icalendar.el.")
106 110
107;; ====================================================================== 111;; ======================================================================
@@ -114,17 +118,25 @@
114 118
115(defcustom icalendar-import-format 119(defcustom icalendar-import-format
116 "%s%d%l%o" 120 "%s%d%l%o"
117 "Format string for importing events from iCalendar into Emacs diary. 121 "Format for importing events from iCalendar into Emacs diary.
118This string defines how iCalendar events are inserted into diary 122It defines how iCalendar events are inserted into diary file.
119file. Meaning of the specifiers: 123This may either be a string or a function.
124
125In case of a formatting STRING the following specifiers can be used:
120%c Class, see `icalendar-import-format-class' 126%c Class, see `icalendar-import-format-class'
121%d Description, see `icalendar-import-format-description' 127%d Description, see `icalendar-import-format-description'
122%l Location, see `icalendar-import-format-location' 128%l Location, see `icalendar-import-format-location'
123%o Organizer, see `icalendar-import-format-organizer' 129%o Organizer, see `icalendar-import-format-organizer'
124%s Summary, see `icalendar-import-format-summary' 130%s Summary, see `icalendar-import-format-summary'
125%t Status, see `icalendar-import-format-status' 131%t Status, see `icalendar-import-format-status'
126%u URL, see `icalendar-import-format-url'" 132%u URL, see `icalendar-import-format-url'
127 :type 'string 133
134A formatting FUNCTION will be called with a VEVENT as its only
135argument. It must return a string. See
136`icalendar-import-format-sample' for an example."
137 :type '(choice
138 (string :tag "String")
139 (function :tag "Function"))
128 :group 'icalendar) 140 :group 'icalendar)
129 141
130(defcustom icalendar-import-format-summary 142(defcustom icalendar-import-format-summary
@@ -243,7 +255,7 @@ Pass arguments REGEXP REP STRING FIXEDCASE LITERAL to
243INVALUE gives the current iCalendar element we are reading. 255INVALUE gives the current iCalendar element we are reading.
244INPARAMS gives the current parameters..... 256INPARAMS gives the current parameters.....
245This function calls itself recursively for each nested calendar element 257This function calls itself recursively for each nested calendar element
246it finds" 258it finds."
247 (let (element children line name params param param-name param-value 259 (let (element children line name params param param-name param-value
248 value 260 value
249 (continue t)) 261 (continue t))
@@ -390,15 +402,90 @@ children."
390 (append result (list (list param-name param-value))))))) 402 (append result (list (list param-name param-value)))))))
391 result)) 403 result))
392 404
393(defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift) 405(defun icalendar--convert-tz-offset (alist dst-p)
406 "Return a cons of two strings representing a timezone start.
407ALIST is an alist entry from a VTIMEZONE, like STANDARD.
408DST-P is non-nil if this is for daylight savings time.
409The strings are suitable for assembling into a TZ variable."
410 (let ((offset (car (cddr (assq 'TZOFFSETTO alist))))
411 (rrule-value (car (cddr (assq 'RRULE alist))))
412 (dtstart (car (cddr (assq 'DTSTART alist)))))
413 ;; FIXME: for now we only handle RRULE and not RDATE here.
414 (when (and offset rrule-value dtstart)
415 (let* ((rrule (icalendar--split-value rrule-value))
416 (freq (cadr (assq 'FREQ rrule)))
417 (bymonth (cadr (assq 'BYMONTH rrule)))
418 (byday (cadr (assq 'BYDAY rrule))))
419 ;; FIXME: we don't correctly handle WKST here.
420 (if (and (string= freq "YEARLY") bymonth)
421 (cons
422 (concat
423 ;; Fake a name.
424 (if dst-p "(DST?)" "(STD?)")
425 ;; For TZ, OFFSET is added to the local time. So,
426 ;; invert the values.
427 (if (eq (aref offset 0) ?-) "+" "-")
428 (substring offset 1 3)
429 ":"
430 (substring offset 3 5))
431 ;; The start time.
432 (let* ((day (icalendar--get-weekday-number (substring byday -2)))
433 (week (if (eq day -1)
434 byday
435 (substring byday 0 -2))))
436 (concat "M" bymonth "." week "." (if (eq day -1) "0"
437 (int-to-string day))
438 ;; Start time.
439 "/"
440 (substring dtstart -6 -4)
441 ":"
442 (substring dtstart -4 -2)
443 ":"
444 (substring dtstart -2)))))))))
445
446(defun icalendar--parse-vtimezone (alist)
447 "Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING).
448Return nil if timezone cannot be parsed."
449 (let* ((tz-id (icalendar--get-event-property alist 'TZID))
450 (daylight (cadr (cdar (icalendar--get-children alist 'DAYLIGHT))))
451 (day (and daylight (icalendar--convert-tz-offset daylight t)))
452 (standard (cadr (cdar (icalendar--get-children alist 'STANDARD))))
453 (std (and standard (icalendar--convert-tz-offset standard nil))))
454 (if (and tz-id std)
455 (cons tz-id
456 (if day
457 (concat (car std) (car day)
458 "," (cdr day) "," (cdr std))
459 (car std))))))
460
461(defun icalendar--convert-all-timezones (icalendar)
462 "Convert all timezones in the ICALENDAR into an alist.
463Each element of the alist is a cons (ID . TZ-STRING),
464like `icalendar--parse-vtimezone'."
465 (let (result)
466 (dolist (zone (icalendar--get-children (car icalendar) 'VTIMEZONE))
467 (setq zone (icalendar--parse-vtimezone zone))
468 (if zone
469 (setq result (cons zone result))))
470 result))
471
472(defun icalendar--find-time-zone (prop-list zone-map)
473 "Return a timezone string for the time zone in PROP-LIST, or nil if none.
474ZONE-MAP is a timezone alist as returned by `icalendar--convert-all-timezones'."
475 (let ((id (plist-get prop-list 'TZID)))
476 (if id
477 (cdr (assoc id zone-map)))))
478
479(defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift
480 zone)
394 "Return ISODATETIMESTRING in format like `decode-time'. 481 "Return ISODATETIMESTRING in format like `decode-time'.
395Converts from ISO-8601 to Emacs representation. If 482Converts from ISO-8601 to Emacs representation. If
396ISODATETIMESTRING specifies UTC time (trailing letter Z) the 483ISODATETIMESTRING specifies UTC time (trailing letter Z) the
397decoded time is given in the local time zone! If optional 484decoded time is given in the local time zone! If optional
398parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT 485parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT
399days. 486days.
487ZONE, if provided, is the timezone, in any format understood by `encode-time'.
400 488
401FIXME: TZID-attributes are ignored....!
402FIXME: multiple comma-separated values should be allowed!" 489FIXME: multiple comma-separated values should be allowed!"
403 (icalendar--dmsg isodatetimestring) 490 (icalendar--dmsg isodatetimestring)
404 (if isodatetimestring 491 (if isodatetimestring
@@ -433,7 +520,7 @@ FIXME: multiple comma-separated values should be allowed!"
433 ;; create the decoded date-time 520 ;; create the decoded date-time
434 ;; FIXME!?! 521 ;; FIXME!?!
435 (condition-case nil 522 (condition-case nil
436 (decode-time (encode-time second minute hour day month year)) 523 (decode-time (encode-time second minute hour day month year zone))
437 (error 524 (error
438 (message "Cannot decode \"%s\"" isodatetimestring) 525 (message "Cannot decode \"%s\"" isodatetimestring)
439 ;; hope for the best... 526 ;; hope for the best...
@@ -710,7 +797,7 @@ would be \"pm\"."
710 "Export diary file to iCalendar format. 797 "Export diary file to iCalendar format.
711All diary entries in the file DIARY-FILENAME are converted to iCalendar 798All diary entries in the file DIARY-FILENAME are converted to iCalendar
712format. The result is appended to the file ICAL-FILENAME." 799format. The result is appended to the file ICAL-FILENAME."
713 (interactive "FExport diary data from file: 800 (interactive "FExport diary data from file:
714Finto iCalendar file: ") 801Finto iCalendar file: ")
715 (save-current-buffer 802 (save-current-buffer
716 (set-buffer (find-file diary-filename)) 803 (set-buffer (find-file diary-filename))
@@ -844,89 +931,95 @@ entries. ENTRY-MAIN is the first line of the diary entry."
844 (error "Could not parse entry"))) 931 (error "Could not parse entry")))
845 932
846(defun icalendar--parse-summary-and-rest (summary-and-rest) 933(defun icalendar--parse-summary-and-rest (summary-and-rest)
847 "Parse SUMMARY-AND-REST from a diary to fill iCalendar properties." 934 "Parse SUMMARY-AND-REST from a diary to fill iCalendar properties.
935Returns an alist."
848 (save-match-data 936 (save-match-data
849 (let* ((s icalendar-import-format) 937 (if (functionp icalendar-import-format)
850 (p-cla (or (string-match "%c" icalendar-import-format) -1)) 938 ;; can't do anything
851 (p-des (or (string-match "%d" icalendar-import-format) -1)) 939 nil
852 (p-loc (or (string-match "%l" icalendar-import-format) -1)) 940 ;; split summary-and-rest
853 (p-org (or (string-match "%o" icalendar-import-format) -1)) 941 (let* ((s icalendar-import-format)
854 (p-sum (or (string-match "%s" icalendar-import-format) -1)) 942 (p-cla (or (string-match "%c" icalendar-import-format) -1))
855 (p-sta (or (string-match "%t" icalendar-import-format) -1)) 943 (p-des (or (string-match "%d" icalendar-import-format) -1))
856 (p-url (or (string-match "%u" icalendar-import-format) -1)) 944 (p-loc (or (string-match "%l" icalendar-import-format) -1))
857 (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url) '<)) 945 (p-org (or (string-match "%o" icalendar-import-format) -1))
858 pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url) 946 (p-sum (or (string-match "%s" icalendar-import-format) -1))
859 (dotimes (i (length p-list)) 947 (p-sta (or (string-match "%t" icalendar-import-format) -1))
860 (cond ((and (>= p-cla 0) (= (nth i p-list) p-cla)) 948 (p-url (or (string-match "%u" icalendar-import-format) -1))
861 (setq pos-cla (+ 2 (* 2 i)))) 949 (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url) '<))
862 ((and (>= p-des 0) (= (nth i p-list) p-des)) 950 pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url)
863 (setq pos-des (+ 2 (* 2 i)))) 951 (dotimes (i (length p-list))
864 ((and (>= p-loc 0) (= (nth i p-list) p-loc)) 952 (cond ((and (>= p-cla 0) (= (nth i p-list) p-cla))
865 (setq pos-loc (+ 2 (* 2 i)))) 953 (setq pos-cla (+ 2 (* 2 i))))
866 ((and (>= p-org 0) (= (nth i p-list) p-org)) 954 ((and (>= p-des 0) (= (nth i p-list) p-des))
867 (setq pos-org (+ 2 (* 2 i)))) 955 (setq pos-des (+ 2 (* 2 i))))
868 ((and (>= p-sta 0) (= (nth i p-list) p-sta)) 956 ((and (>= p-loc 0) (= (nth i p-list) p-loc))
869 (setq pos-sta (+ 2 (* 2 i)))) 957 (setq pos-loc (+ 2 (* 2 i))))
870 ((and (>= p-sum 0) (= (nth i p-list) p-sum)) 958 ((and (>= p-org 0) (= (nth i p-list) p-org))
871 (setq pos-sum (+ 2 (* 2 i)))) 959 (setq pos-org (+ 2 (* 2 i))))
872 ((and (>= p-url 0) (= (nth i p-list) p-url)) 960 ((and (>= p-sta 0) (= (nth i p-list) p-sta))
873 (setq pos-url (+ 2 (* 2 i)))))) 961 (setq pos-sta (+ 2 (* 2 i))))
874 (mapc (lambda (ij) 962 ((and (>= p-sum 0) (= (nth i p-list) p-sum))
875 (setq s (icalendar--rris (car ij) (cadr ij) s t t))) 963 (setq pos-sum (+ 2 (* 2 i))))
876 (list 964 ((and (>= p-url 0) (= (nth i p-list) p-url))
877 ;; summary must be first! because of %s 965 (setq pos-url (+ 2 (* 2 i))))))
878 (list "%s" 966 (mapc (lambda (ij)
879 (concat "\\(" icalendar-import-format-summary "\\)?")) 967 (setq s (icalendar--rris (car ij) (cadr ij) s t t)))
880 (list "%c" 968 (list
881 (concat "\\(" icalendar-import-format-class "\\)?")) 969 ;; summary must be first! because of %s
882 (list "%d" 970 (list "%s"
883 (concat "\\(" icalendar-import-format-description "\\)?")) 971 (concat "\\(" icalendar-import-format-summary "\\)??"))
884 (list "%l" 972 (list "%c"
885 (concat "\\(" icalendar-import-format-location "\\)?")) 973 (concat "\\(" icalendar-import-format-class "\\)??"))
886 (list "%o" 974 (list "%d"
887 (concat "\\(" icalendar-import-format-organizer "\\)?")) 975 (concat "\\(" icalendar-import-format-description "\\)??"))
888 (list "%t" 976 (list "%l"
889 (concat "\\(" icalendar-import-format-status "\\)?")) 977 (concat "\\(" icalendar-import-format-location "\\)??"))
890 (list "%u" 978 (list "%o"
891 (concat "\\(" icalendar-import-format-url "\\)?")))) 979 (concat "\\(" icalendar-import-format-organizer "\\)??"))
892 (setq s (concat (icalendar--rris "%s" "\\(.*\\)" s nil t) " ")) 980 (list "%t"
893 (if (string-match s summary-and-rest) 981 (concat "\\(" icalendar-import-format-status "\\)??"))
894 (let (cla des loc org sta sum url) 982 (list "%u"
895 (if (and pos-sum (match-beginning pos-sum)) 983 (concat "\\(" icalendar-import-format-url "\\)??"))))
896 (setq sum (substring summary-and-rest 984 (setq s (concat "^" (icalendar--rris "%s" "\\(.*?\\)" s nil t)
897 (match-beginning pos-sum) 985 " $"))
898 (match-end pos-sum)))) 986 (if (string-match s summary-and-rest)
899 (if (and pos-cla (match-beginning pos-cla)) 987 (let (cla des loc org sta sum url)
900 (setq cla (substring summary-and-rest 988 (if (and pos-sum (match-beginning pos-sum))
901 (match-beginning pos-cla) 989 (setq sum (substring summary-and-rest
902 (match-end pos-cla)))) 990 (match-beginning pos-sum)
903 (if (and pos-des (match-beginning pos-des)) 991 (match-end pos-sum))))
904 (setq des (substring summary-and-rest 992 (if (and pos-cla (match-beginning pos-cla))
905 (match-beginning pos-des) 993 (setq cla (substring summary-and-rest
906 (match-end pos-des)))) 994 (match-beginning pos-cla)
907 (if (and pos-loc (match-beginning pos-loc)) 995 (match-end pos-cla))))
908 (setq loc (substring summary-and-rest 996 (if (and pos-des (match-beginning pos-des))
909 (match-beginning pos-loc) 997 (setq des (substring summary-and-rest
910 (match-end pos-loc)))) 998 (match-beginning pos-des)
911 (if (and pos-org (match-beginning pos-org)) 999 (match-end pos-des))))
912 (setq org (substring summary-and-rest 1000 (if (and pos-loc (match-beginning pos-loc))
913 (match-beginning pos-org) 1001 (setq loc (substring summary-and-rest
914 (match-end pos-org)))) 1002 (match-beginning pos-loc)
915 (if (and pos-sta (match-beginning pos-sta)) 1003 (match-end pos-loc))))
916 (setq sta (substring summary-and-rest 1004 (if (and pos-org (match-beginning pos-org))
917 (match-beginning pos-sta) 1005 (setq org (substring summary-and-rest
918 (match-end pos-sta)))) 1006 (match-beginning pos-org)
919 (if (and pos-url (match-beginning pos-url)) 1007 (match-end pos-org))))
920 (setq url (substring summary-and-rest 1008 (if (and pos-sta (match-beginning pos-sta))
921 (match-beginning pos-url) 1009 (setq sta (substring summary-and-rest
922 (match-end pos-url)))) 1010 (match-beginning pos-sta)
923 (list (if cla (cons 'cla cla) nil) 1011 (match-end pos-sta))))
924 (if des (cons 'des des) nil) 1012 (if (and pos-url (match-beginning pos-url))
925 (if loc (cons 'loc loc) nil) 1013 (setq url (substring summary-and-rest
926 (if org (cons 'org org) nil) 1014 (match-beginning pos-url)
927 (if sta (cons 'sta sta) nil) 1015 (match-end pos-url))))
928 ;;(if sum (cons 'sum sum) nil) 1016 (list (if cla (cons 'cla cla) nil)
929 (if url (cons 'url url) nil))))))) 1017 (if des (cons 'des des) nil)
1018 (if loc (cons 'loc loc) nil)
1019 (if org (cons 'org org) nil)
1020 (if sta (cons 'sta sta) nil)
1021 ;;(if sum (cons 'sum sum) nil)
1022 (if url (cons 'url url) nil))))))))
930 1023
931;; subroutines for icalendar-export-region 1024;; subroutines for icalendar-export-region
932(defun icalendar--convert-ordinary-to-ical (nonmarker entry-main) 1025(defun icalendar--convert-ordinary-to-ical (nonmarker entry-main)
@@ -1454,8 +1547,8 @@ Argument ICAL-FILENAME output iCalendar file.
1454Argument DIARY-FILENAME input `diary-file'. 1547Argument DIARY-FILENAME input `diary-file'.
1455Optional argument NON-MARKING determines whether events are created as 1548Optional argument NON-MARKING determines whether events are created as
1456non-marking or not." 1549non-marking or not."
1457 (interactive "fImport iCalendar data from file: 1550 (interactive "fImport iCalendar data from file:
1458Finto diary file: 1551Finto diary file:
1459p") 1552p")
1460 ;; clean up the diary file 1553 ;; clean up the diary file
1461 (save-current-buffer 1554 (save-current-buffer
@@ -1521,7 +1614,9 @@ buffer `*icalendar-errors*'."
1521 1614
1522(defun icalendar--format-ical-event (event) 1615(defun icalendar--format-ical-event (event)
1523 "Create a string representation of an iCalendar EVENT." 1616 "Create a string representation of an iCalendar EVENT."
1524 (let ((string icalendar-import-format) 1617 (if (functionp icalendar-import-format)
1618 (funcall icalendar-import-format event)
1619 (let ((string icalendar-import-format)
1525 (conversion-list 1620 (conversion-list
1526 '(("%c" CLASS icalendar-import-format-class) 1621 '(("%c" CLASS icalendar-import-format-class)
1527 ("%d" DESCRIPTION icalendar-import-format-description) 1622 ("%d" DESCRIPTION icalendar-import-format-description)
@@ -1549,7 +1644,7 @@ buffer `*icalendar-errors*'."
1549 string 1644 string
1550 t t)))) 1645 t t))))
1551 conversion-list) 1646 conversion-list)
1552 string)) 1647 string)))
1553 1648
1554(defun icalendar--convert-ical-to-diary (ical-list diary-file 1649(defun icalendar--convert-ical-to-diary (ical-list diary-file
1555 &optional do-not-ask 1650 &optional do-not-ask
@@ -1566,6 +1661,7 @@ written into the buffer `*icalendar-errors*'."
1566 (error-string "") 1661 (error-string "")
1567 (event-ok t) 1662 (event-ok t)
1568 (found-error nil) 1663 (found-error nil)
1664 (zone-map (icalendar--convert-all-timezones ical-list))
1569 e diary-string) 1665 e diary-string)
1570 ;; step through all events/appointments 1666 ;; step through all events/appointments
1571 (while ev 1667 (while ev
@@ -1574,13 +1670,24 @@ written into the buffer `*icalendar-errors*'."
1574 (setq event-ok nil) 1670 (setq event-ok nil)
1575 (condition-case error-val 1671 (condition-case error-val
1576 (let* ((dtstart (icalendar--get-event-property e 'DTSTART)) 1672 (let* ((dtstart (icalendar--get-event-property e 'DTSTART))
1577 (dtstart-dec (icalendar--decode-isodatetime dtstart)) 1673 (dtstart-zone (icalendar--find-time-zone
1674 (icalendar--get-event-property-attributes
1675 e 'DTSTART)
1676 zone-map))
1677 (dtstart-dec (icalendar--decode-isodatetime dtstart nil
1678 dtstart-zone))
1578 (start-d (icalendar--datetime-to-diary-date 1679 (start-d (icalendar--datetime-to-diary-date
1579 dtstart-dec)) 1680 dtstart-dec))
1580 (start-t (icalendar--datetime-to-colontime dtstart-dec)) 1681 (start-t (icalendar--datetime-to-colontime dtstart-dec))
1581 (dtend (icalendar--get-event-property e 'DTEND)) 1682 (dtend (icalendar--get-event-property e 'DTEND))
1582 (dtend-dec (icalendar--decode-isodatetime dtend)) 1683 (dtend-zone (icalendar--find-time-zone
1583 (dtend-1-dec (icalendar--decode-isodatetime dtend -1)) 1684 (icalendar--get-event-property-attributes
1685 e 'DTEND)
1686 zone-map))
1687 (dtend-dec (icalendar--decode-isodatetime dtend
1688 nil dtend-zone))
1689 (dtend-1-dec (icalendar--decode-isodatetime dtend -1
1690 dtend-zone))
1584 end-d 1691 end-d
1585 end-1-d 1692 end-1-d
1586 end-t 1693 end-t
@@ -1953,6 +2060,21 @@ the entry."
1953 ;; return diary-file in case it has been changed interactively 2060 ;; return diary-file in case it has been changed interactively
1954 diary-file) 2061 diary-file)
1955 2062
2063;; ======================================================================
2064;; Examples
2065;; ======================================================================
2066(defun icalendar-import-format-sample (event)
2067 "Example function for formatting an icalendar EVENT."
2068 (format (concat "SUMMARY=`%s' DESCRIPTION=`%s' LOCATION=`%s' ORGANIZER=`%s' "
2069 "STATUS=`%s' URL=`%s' CLASS=`%s'")
2070 (or (icalendar--get-event-property event 'SUMMARY) "")
2071 (or (icalendar--get-event-property event 'DESCRIPTION) "")
2072 (or (icalendar--get-event-property event 'LOCATION) "")
2073 (or (icalendar--get-event-property event 'ORGANIZER) "")
2074 (or (icalendar--get-event-property event 'STATUS) "")
2075 (or (icalendar--get-event-property event 'URL) "")
2076 (or (icalendar--get-event-property event 'CLASS) "")))
2077
1956(provide 'icalendar) 2078(provide 'icalendar)
1957 2079
1958;; arch-tag: 74fdbe8e-0451-4e38-bb61-4416e822f4fc 2080;; arch-tag: 74fdbe8e-0451-4e38-bb61-4416e822f4fc
diff --git a/lisp/comint.el b/lisp/comint.el
index 6fb89e28181..e4ee37c50f9 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -822,6 +822,7 @@ buffer. The hook `comint-exec-hook' is run after each exec."
822If there is no previous input at point, run the command specified 822If there is no previous input at point, run the command specified
823by the global keymap (usually `mouse-yank-at-point')." 823by the global keymap (usually `mouse-yank-at-point')."
824 (interactive "e") 824 (interactive "e")
825 (mouse-set-point event)
825 (let ((pos (posn-point (event-end event))) 826 (let ((pos (posn-point (event-end event)))
826 field input) 827 field input)
827 (with-selected-window (posn-window (event-end event)) 828 (with-selected-window (posn-window (event-end event))
@@ -1022,9 +1023,11 @@ See also `comint-read-input-ring'."
1022 (last-command last-command) 1023 (last-command last-command)
1023 (regexp (read-from-minibuffer prompt nil nil nil 1024 (regexp (read-from-minibuffer prompt nil nil nil
1024 'minibuffer-history-search-history))) 1025 'minibuffer-history-search-history)))
1026 ;; If the user didn't enter anything, nothing is added to m-h-s-h.
1027 ;; Use the previous search regexp, if there is one.
1025 (list (if (string-equal regexp "") 1028 (list (if (string-equal regexp "")
1026 (setcar minibuffer-history-search-history 1029 (or (car minibuffer-history-search-history)
1027 (nth 1 minibuffer-history-search-history)) 1030 regexp)
1028 regexp) 1031 regexp)
1029 (prefix-numeric-value current-prefix-arg)))) 1032 (prefix-numeric-value current-prefix-arg))))
1030 1033
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index c1071f3b3ef..7e014b4f7bd 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -826,16 +826,19 @@ and `yes-or-no-p' otherwise."
826 826
827(defun Custom-save (&rest ignore) 827(defun Custom-save (&rest ignore)
828 "Set all edited settings, then save all settings that have been set. 828 "Set all edited settings, then save all settings that have been set.
829If a setting was edited and set before, this saves it. 829If a setting was edited and set before, this saves it. If a
830If a setting was merely edited before, this sets it then saves it." 830setting was merely edited before, this sets it then saves it."
831 (interactive) 831 (interactive)
832 (if (custom-command-apply 832 (when (custom-command-apply
833 (lambda (child) 833 (lambda (child)
834 (when (memq (widget-get child :custom-state) 834 (when (memq (widget-get child :custom-state)
835 '(modified set changed rogue)) 835 '(modified set changed rogue))
836 (widget-apply child :custom-save))) 836 (widget-apply child :custom-mark-to-save)))
837 "Save all settings in this buffer? " t) 837 "Save all settings in this buffer? " t)
838 (custom-save-all))) 838 ;; Save changes to buffer and redraw.
839 (custom-save-all)
840 (dolist (child custom-options)
841 (widget-apply child :custom-state-set-and-redraw))))
839 842
840(defun custom-reset (widget &optional event) 843(defun custom-reset (widget &optional event)
841 "Select item from reset menu." 844 "Select item from reset menu."
@@ -865,20 +868,67 @@ This also shows the saved values in the buffer."
865 (widget-apply widget :custom-reset-saved))) 868 (widget-apply widget :custom-reset-saved)))
866 "Reset all settings (current values and buffer text) to saved values? ")) 869 "Reset all settings (current values and buffer text) to saved values? "))
867 870
871;; The next two variables are bound to '(t) by `Custom-reset-standard'
872;; and `custom-group-reset-standard'. If these variables are nil, both
873;; `custom-variable-reset-standard' and `custom-face-reset-standard'
874;; save, reset and redraw the handled widget immediately. Otherwise,
875;; they add the widget to the corresponding list and leave it to
876;; `custom-reset-standard-save-and-update' to save, reset and redraw it.
877(defvar custom-reset-standard-variables-list nil)
878(defvar custom-reset-standard-faces-list nil)
879
880;; The next function was excerpted from `custom-variable-reset-standard'
881;; and `custom-face-reset-standard' and is used to avoid calling
882;; `custom-save-all' repeatedly (and thus saving settings to file one by
883;; one) when erasing all customizations.
884(defun custom-reset-standard-save-and-update ()
885 "Save settings and redraw after erasing customizations."
886 (when (or (and custom-reset-standard-variables-list
887 (not (eq custom-reset-standard-variables-list '(t))))
888 (and custom-reset-standard-faces-list
889 (not (eq custom-reset-standard-faces-list '(t)))))
890 ;; Save settings to file.
891 (custom-save-all)
892 ;; Set state of and redraw variables.
893 (dolist (widget custom-reset-standard-variables-list)
894 (unless (eq widget t)
895 (widget-put widget :custom-state 'unknown)
896 (custom-redraw widget)))
897 ;; Set state of and redraw faces.
898 (dolist (widget custom-reset-standard-faces-list)
899 (unless (eq widget t)
900 (let* ((symbol (widget-value widget))
901 (child (car (widget-get widget :children)))
902 (value (get symbol 'face-defface-spec))
903 (comment-widget (widget-get widget :comment-widget)))
904 (put symbol 'face-comment nil)
905 (widget-value-set child
906 (custom-pre-filter-face-spec
907 (list (list t (custom-face-attributes-get
908 symbol nil)))))
909 ;; This call manages the comment visibility
910 (widget-value-set comment-widget "")
911 (custom-face-state-set widget)
912 (custom-redraw-magic widget))))))
913
868(defun Custom-reset-standard (&rest ignore) 914(defun Custom-reset-standard (&rest ignore)
869 "Erase all customization (either current or saved) for the group members. 915 "Erase all customizations (either current or saved) in current buffer.
870The immediate result is to restore them to their standard values. 916The immediate result is to restore them to their standard values.
871This operation eliminates any saved values for the group members, 917This operation eliminates any saved values for the group members,
872making them as if they had never been customized at all." 918making them as if they had never been customized at all."
873 (interactive) 919 (interactive)
874 (custom-command-apply 920 ;; Bind these temporarily.
875 (lambda (widget) 921 (let ((custom-reset-standard-variables-list '(t))
876 (and (or (null (widget-get widget :custom-standard-value)) 922 (custom-reset-standard-faces-list '(t)))
877 (widget-apply widget :custom-standard-value)) 923 (custom-command-apply
878 (memq (widget-get widget :custom-state) 924 (lambda (widget)
879 '(modified set changed saved rogue)) 925 (and (or (null (widget-get widget :custom-standard-value))
880 (widget-apply widget :custom-reset-standard))) 926 (widget-apply widget :custom-standard-value))
881 "Erase all customizations for settings in this buffer? " t)) 927 (memq (widget-get widget :custom-state)
928 '(modified set changed saved rogue))
929 (widget-apply widget :custom-mark-to-reset-standard)))
930 "Erase all customizations for settings in this buffer? " t)
931 (custom-reset-standard-save-and-update)))
882 932
883;;; The Customize Commands 933;;; The Customize Commands
884 934
@@ -1535,7 +1585,7 @@ Otherwise use brackets."
1535 (widget-insert "Editing a setting changes only the text in this buffer." 1585 (widget-insert "Editing a setting changes only the text in this buffer."
1536 (if init-file 1586 (if init-file
1537 " 1587 "
1538To set apply your changes, use the Save or Set buttons. 1588To apply your changes, use the Save or Set buttons.
1539Saving a change normally works by editing your init file." 1589Saving a change normally works by editing your init file."
1540 " 1590 "
1541Currently, these settings cannot be saved for future Emacs sessions, 1591Currently, these settings cannot be saved for future Emacs sessions,
@@ -2441,11 +2491,13 @@ However, setting it through Custom sets the default value.")
2441 :value-create 'custom-variable-value-create 2491 :value-create 'custom-variable-value-create
2442 :action 'custom-variable-action 2492 :action 'custom-variable-action
2443 :custom-set 'custom-variable-set 2493 :custom-set 'custom-variable-set
2444 :custom-save 'custom-variable-save 2494 :custom-mark-to-save 'custom-variable-mark-to-save
2445 :custom-reset-current 'custom-redraw 2495 :custom-reset-current 'custom-redraw
2446 :custom-reset-saved 'custom-variable-reset-saved 2496 :custom-reset-saved 'custom-variable-reset-saved
2447 :custom-reset-standard 'custom-variable-reset-standard 2497 :custom-reset-standard 'custom-variable-reset-standard
2448 :custom-standard-value 'custom-variable-standard-value) 2498 :custom-mark-to-reset-standard 'custom-variable-mark-to-reset-standard
2499 :custom-standard-value 'custom-variable-standard-value
2500 :custom-state-set-and-redraw 'custom-variable-state-set-and-redraw)
2449 2501
2450(defun custom-variable-type (symbol) 2502(defun custom-variable-type (symbol)
2451 "Return a widget suitable for editing the value of SYMBOL. 2503 "Return a widget suitable for editing the value of SYMBOL.
@@ -2807,8 +2859,8 @@ Optional EVENT is the location for the menu."
2807 (custom-variable-state-set widget) 2859 (custom-variable-state-set widget)
2808 (custom-redraw-magic widget))) 2860 (custom-redraw-magic widget)))
2809 2861
2810(defun custom-variable-save (widget) 2862(defun custom-variable-mark-to-save (widget)
2811 "Set and save the value for the variable being edited by WIDGET." 2863 "Set value and mark for saving the variable edited by WIDGET."
2812 (let* ((form (widget-get widget :custom-form)) 2864 (let* ((form (widget-get widget :custom-form))
2813 (state (widget-get widget :custom-state)) 2865 (state (widget-get widget :custom-state))
2814 (child (car (widget-get widget :children))) 2866 (child (car (widget-get widget :children)))
@@ -2846,10 +2898,18 @@ Optional EVENT is the location for the menu."
2846 (put symbol 'variable-comment comment) 2898 (put symbol 'variable-comment comment)
2847 (put symbol 'saved-variable-comment comment))) 2899 (put symbol 'saved-variable-comment comment)))
2848 (put symbol 'customized-value nil) 2900 (put symbol 'customized-value nil)
2849 (put symbol 'customized-variable-comment nil) 2901 (put symbol 'customized-variable-comment nil)))
2850 (custom-save-all) 2902
2851 (custom-variable-state-set widget) 2903(defsubst custom-variable-state-set-and-redraw (widget)
2852 (custom-redraw-magic widget))) 2904 "Set state of variable widget WIDGET and redraw with current settings."
2905 (custom-variable-state-set widget)
2906 (custom-redraw-magic widget))
2907
2908(defun custom-variable-save (widget)
2909 "Save value of variable edited by widget WIDGET."
2910 (custom-variable-mark-to-save widget)
2911 (custom-save-all)
2912 (custom-variable-state-set-and-redraw widget))
2853 2913
2854(defun custom-variable-reset-saved (widget) 2914(defun custom-variable-reset-saved (widget)
2855 "Restore the saved value for the variable being edited by WIDGET. 2915 "Restore the saved value for the variable being edited by WIDGET.
@@ -2875,12 +2935,10 @@ becomes the backup value, so you can get it again."
2875 ;; This call will possibly make the comment invisible 2935 ;; This call will possibly make the comment invisible
2876 (custom-redraw widget))) 2936 (custom-redraw widget)))
2877 2937
2878(defun custom-variable-reset-standard (widget) 2938(defun custom-variable-mark-to-reset-standard (widget)
2879 "Restore the standard setting for the variable being edited by WIDGET. 2939 "Mark to restore standard setting for the variable edited by widget WIDGET.
2880This operation eliminates any saved setting for the variable, 2940If `custom-reset-standard-variables-list' is nil, save, reset and
2881restoring it to the state of a variable that has never been customized. 2941redraw the widget immediately."
2882The value that was current before this operation
2883becomes the backup value, so you can get it again."
2884 (let* ((symbol (widget-value widget))) 2942 (let* ((symbol (widget-value widget)))
2885 (if (get symbol 'standard-value) 2943 (if (get symbol 'standard-value)
2886 (custom-variable-backup-value widget) 2944 (custom-variable-backup-value widget)
@@ -2890,13 +2948,32 @@ becomes the backup value, so you can get it again."
2890 (put symbol 'customized-variable-comment nil) 2948 (put symbol 'customized-variable-comment nil)
2891 (custom-push-theme 'theme-value symbol 'user 'reset) 2949 (custom-push-theme 'theme-value symbol 'user 'reset)
2892 (custom-theme-recalc-variable symbol) 2950 (custom-theme-recalc-variable symbol)
2893 (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment)) 2951 (if (and custom-reset-standard-variables-list
2894 (put symbol 'saved-value nil) 2952 (or (get symbol 'saved-value) (get symbol 'saved-variable-comment)))
2895 (put symbol 'saved-variable-comment nil) 2953 (progn
2896 (custom-save-all)) 2954 (put symbol 'saved-value nil)
2897 (widget-put widget :custom-state 'unknown) 2955 (put symbol 'saved-variable-comment nil)
2898 ;; This call will possibly make the comment invisible 2956 ;; Append this to `custom-reset-standard-variables-list' to
2899 (custom-redraw widget))) 2957 ;; have `custom-reset-standard-save-and-update' save setting
2958 ;; to the file, update the widget's state, and redraw it.
2959 (setq custom-reset-standard-variables-list
2960 (cons widget custom-reset-standard-variables-list)))
2961 (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment))
2962 (put symbol 'saved-value nil)
2963 (put symbol 'saved-variable-comment nil)
2964 (custom-save-all))
2965 (widget-put widget :custom-state 'unknown)
2966 ;; This call will possibly make the comment invisible
2967 (custom-redraw widget))))
2968
2969(defun custom-variable-reset-standard (widget)
2970 "Restore standard setting for the variable edited by WIDGET.
2971This operation eliminates any saved setting for the variable,
2972restoring it to the state of a variable that has never been customized.
2973The value that was current before this operation
2974becomes the backup value, so you can get it again."
2975 (let (custom-reset-standard-variables-list)
2976 (custom-variable-mark-to-reset-standard widget)))
2900 2977
2901(defun custom-variable-backup-value (widget) 2978(defun custom-variable-backup-value (widget)
2902 "Back up the current value for WIDGET's variable. 2979 "Back up the current value for WIDGET's variable.
@@ -3172,11 +3249,13 @@ Only match frames that support the specified face attributes.")
3172 :custom-category 'face 3249 :custom-category 'face
3173 :custom-form nil ; defaults to value of `custom-face-default-form' 3250 :custom-form nil ; defaults to value of `custom-face-default-form'
3174 :custom-set 'custom-face-set 3251 :custom-set 'custom-face-set
3175 :custom-save 'custom-face-save 3252 :custom-mark-to-save 'custom-face-mark-to-save
3176 :custom-reset-current 'custom-redraw 3253 :custom-reset-current 'custom-redraw
3177 :custom-reset-saved 'custom-face-reset-saved 3254 :custom-reset-saved 'custom-face-reset-saved
3178 :custom-reset-standard 'custom-face-reset-standard 3255 :custom-reset-standard 'custom-face-reset-standard
3256 :custom-mark-to-reset-standard 'custom-face-mark-to-reset-standard
3179 :custom-standard-value 'custom-face-standard-value 3257 :custom-standard-value 'custom-face-standard-value
3258 :custom-state-set-and-redraw 'custom-face-state-set-and-redraw
3180 :custom-menu 'custom-face-menu-create) 3259 :custom-menu 'custom-face-menu-create)
3181 3260
3182(define-widget 'custom-face-all 'editable-list 3261(define-widget 'custom-face-all 'editable-list
@@ -3321,6 +3400,7 @@ SPEC must be a full face spec."
3321 ;; Update buttons. 3400 ;; Update buttons.
3322 (widget-put widget :buttons buttons) 3401 (widget-put widget :buttons buttons)
3323 ;; Insert documentation. 3402 ;; Insert documentation.
3403 (widget-put widget :documentation-indent 3)
3324 (widget-add-documentation-string-button 3404 (widget-add-documentation-string-button
3325 widget :visibility-widget 'custom-visibility) 3405 widget :visibility-widget 'custom-visibility)
3326 3406
@@ -3510,8 +3590,8 @@ Optional EVENT is the location for the menu."
3510 (custom-face-state-set widget) 3590 (custom-face-state-set widget)
3511 (custom-redraw-magic widget))) 3591 (custom-redraw-magic widget)))
3512 3592
3513(defun custom-face-save (widget) 3593(defun custom-face-mark-to-save (widget)
3514 "Save in `.emacs' the face attributes in WIDGET." 3594 "Mark for saving the face edited by WIDGET."
3515 (let* ((symbol (widget-value widget)) 3595 (let* ((symbol (widget-value widget))
3516 (child (car (widget-get widget :children))) 3596 (child (car (widget-get widget :children)))
3517 (value (custom-post-filter-face-spec (widget-value child))) 3597 (value (custom-post-filter-face-spec (widget-value child)))
@@ -3532,10 +3612,18 @@ Optional EVENT is the location for the menu."
3532 (put symbol 'customized-face nil) 3612 (put symbol 'customized-face nil)
3533 (put symbol 'face-comment comment) 3613 (put symbol 'face-comment comment)
3534 (put symbol 'customized-face-comment nil) 3614 (put symbol 'customized-face-comment nil)
3535 (put symbol 'saved-face-comment comment) 3615 (put symbol 'saved-face-comment comment)))
3536 (custom-save-all) 3616
3537 (custom-face-state-set widget) 3617(defsubst custom-face-state-set-and-redraw (widget)
3538 (custom-redraw-magic widget))) 3618 "Set state of face widget WIDGET and redraw with current settings."
3619 (custom-face-state-set widget)
3620 (custom-redraw-magic widget))
3621
3622(defun custom-face-save (widget)
3623 "Save the face edited by WIDGET."
3624 (custom-face-mark-to-save widget)
3625 (custom-save-all)
3626 (custom-face-state-set-and-redraw widget))
3539 3627
3540;; For backward compatibility. 3628;; For backward compatibility.
3541(define-obsolete-function-alias 'custom-face-save-command 'custom-face-save 3629(define-obsolete-function-alias 'custom-face-save-command 'custom-face-save
@@ -3564,10 +3652,10 @@ Optional EVENT is the location for the menu."
3564(defun custom-face-standard-value (widget) 3652(defun custom-face-standard-value (widget)
3565 (get (widget-value widget) 'face-defface-spec)) 3653 (get (widget-value widget) 'face-defface-spec))
3566 3654
3567(defun custom-face-reset-standard (widget) 3655(defun custom-face-mark-to-reset-standard (widget)
3568 "Restore WIDGET to the face's standard attribute values. 3656 "Restore widget WIDGET to the face's standard attribute values.
3569This operation eliminates any saved attributes for the face, 3657If `custom-reset-standard-faces-list' is nil, save, reset and
3570restoring it to the state of a face that has never been customized." 3658redraw the widget immediately."
3571 (let* ((symbol (widget-value widget)) 3659 (let* ((symbol (widget-value widget))
3572 (child (car (widget-get widget :children))) 3660 (child (car (widget-get widget :children)))
3573 (value (get symbol 'face-defface-spec)) 3661 (value (get symbol 'face-defface-spec))
@@ -3579,19 +3667,37 @@ restoring it to the state of a face that has never been customized."
3579 (custom-push-theme 'theme-face symbol 'user 'reset) 3667 (custom-push-theme 'theme-face symbol 'user 'reset)
3580 (face-spec-set symbol value t) 3668 (face-spec-set symbol value t)
3581 (custom-theme-recalc-face symbol) 3669 (custom-theme-recalc-face symbol)
3582 (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment)) 3670 (if (and custom-reset-standard-faces-list
3583 (put symbol 'saved-face nil) 3671 (or (get symbol 'saved-face) (get symbol 'saved-face-comment)))
3584 (put symbol 'saved-face-comment nil) 3672 ;; Do this later.
3585 (custom-save-all)) 3673 (progn
3586 (put symbol 'face-comment nil) 3674 (put symbol 'saved-face nil)
3587 (widget-value-set child 3675 (put symbol 'saved-face-comment nil)
3588 (custom-pre-filter-face-spec 3676 ;; Append this to `custom-reset-standard-faces-list' and have
3589 (list (list t (custom-face-attributes-get 3677 ;; `custom-reset-standard-save-and-update' save setting to the
3590 symbol nil))))) 3678 ;; file, update the widget's state, and redraw it.
3591 ;; This call manages the comment visibility 3679 (setq custom-reset-standard-faces-list
3592 (widget-value-set comment-widget "") 3680 (cons widget custom-reset-standard-faces-list)))
3593 (custom-face-state-set widget) 3681 (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment))
3594 (custom-redraw-magic widget))) 3682 (put symbol 'saved-face nil)
3683 (put symbol 'saved-face-comment nil)
3684 (custom-save-all))
3685 (put symbol 'face-comment nil)
3686 (widget-value-set child
3687 (custom-pre-filter-face-spec
3688 (list (list t (custom-face-attributes-get
3689 symbol nil)))))
3690 ;; This call manages the comment visibility
3691 (widget-value-set comment-widget "")
3692 (custom-face-state-set widget)
3693 (custom-redraw-magic widget))))
3694
3695(defun custom-face-reset-standard (widget)
3696 "Restore WIDGET to the face's standard attribute values.
3697This operation eliminates any saved attributes for the face,
3698restoring it to the state of a face that has never been customized."
3699 (let (custom-reset-standard-faces-list)
3700 (custom-face-mark-to-reset-standard widget)))
3595 3701
3596;;; The `face' Widget. 3702;;; The `face' Widget.
3597 3703
@@ -3736,10 +3842,12 @@ and so forth. The remaining group tags are shown with `custom-group-tag'."
3736 :action 'custom-group-action 3842 :action 'custom-group-action
3737 :custom-category 'group 3843 :custom-category 'group
3738 :custom-set 'custom-group-set 3844 :custom-set 'custom-group-set
3739 :custom-save 'custom-group-save 3845 :custom-mark-to-save 'custom-group-mark-to-save
3740 :custom-reset-current 'custom-group-reset-current 3846 :custom-reset-current 'custom-group-reset-current
3741 :custom-reset-saved 'custom-group-reset-saved 3847 :custom-reset-saved 'custom-group-reset-saved
3742 :custom-reset-standard 'custom-group-reset-standard 3848 :custom-reset-standard 'custom-group-reset-standard
3849 :custom-mark-to-reset-standard 'custom-group-mark-to-reset-standard
3850 :custom-state-set-and-redraw 'custom-group-state-set-and-redraw
3743 :custom-menu 'custom-group-menu-create) 3851 :custom-menu 'custom-group-menu-create)
3744 3852
3745(defun custom-group-sample-face-get (widget) 3853(defun custom-group-sample-face-get (widget)
@@ -4034,11 +4142,23 @@ Optional EVENT is the location for the menu."
4034 (when (eq (widget-get child :custom-state) 'modified) 4142 (when (eq (widget-get child :custom-state) 'modified)
4035 (widget-apply child :custom-set)))) 4143 (widget-apply child :custom-set))))
4036 4144
4037(defun custom-group-save (widget) 4145(defun custom-group-mark-to-save (widget)
4038 "Save all modified group members." 4146 "Mark all modified group members for saving."
4039 (dolist (child (widget-get widget :children)) 4147 (dolist (child (widget-get widget :children))
4040 (when (memq (widget-get child :custom-state) '(modified set)) 4148 (when (memq (widget-get child :custom-state) '(modified set))
4041 (widget-apply child :custom-save)))) 4149 (widget-apply child :custom-mark-to-save))))
4150
4151(defsubst custom-group-state-set-and-redraw (widget)
4152 "Set state of group widget WIDGET and redraw with current settings."
4153 (dolist (child (widget-get widget :children))
4154 (when (memq (widget-get child :custom-state) '(modified set))
4155 (widget-apply child :custom-state-set-and-redraw))))
4156
4157(defun custom-group-save (widget)
4158 "Save all modified group members."
4159 (custom-group-mark-to-save widget)
4160 (custom-save-all)
4161 (custom-group-state-set-and-redraw widget))
4042 4162
4043(defun custom-group-reset-current (widget) 4163(defun custom-group-reset-current (widget)
4044 "Reset all modified group members." 4164 "Reset all modified group members."
@@ -4054,10 +4174,17 @@ Optional EVENT is the location for the menu."
4054 4174
4055(defun custom-group-reset-standard (widget) 4175(defun custom-group-reset-standard (widget)
4056 "Reset all modified, set, or saved group members." 4176 "Reset all modified, set, or saved group members."
4177 (let ((custom-reset-standard-variables-list '(t))
4178 (custom-reset-standard-faces-list '(t)))
4179 (custom-group-mark-to-reset-standard widget)
4180 (custom-reset-standard-save-and-update)))
4181
4182(defun custom-group-mark-to-reset-standard (widget)
4183 "Mark to reset all modified, set, or saved group members."
4057 (dolist (child (widget-get widget :children)) 4184 (dolist (child (widget-get widget :children))
4058 (when (memq (widget-get child :custom-state) 4185 (when (memq (widget-get child :custom-state)
4059 '(modified set saved)) 4186 '(modified set saved))
4060 (widget-apply child :custom-reset-standard)))) 4187 (widget-apply child :custom-mark-to-reset-standard))))
4061 4188
4062(defun custom-group-state-update (widget) 4189(defun custom-group-state-update (widget)
4063 "Update magic." 4190 "Update magic."
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 5094eebc7ca..e87f8806df2 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -95,7 +95,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
95 (scroll-down-aggressively windows 95 (scroll-down-aggressively windows
96 (choice (const :tag "off" nil) number) 96 (choice (const :tag "off" nil) number)
97 "21.1") 97 "21.1")
98 (line-spacing display (choice (const :tag "none" nil) integer)) 98 (line-spacing display (choice (const :tag "none" nil) integer)
99 "22.1")
99 ;; callint.c 100 ;; callint.c
100 (mark-even-if-inactive editing-basics boolean) 101 (mark-even-if-inactive editing-basics boolean)
101 ;; callproc.c 102 ;; callproc.c
@@ -128,7 +129,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
128 :match (lambda (widget value) 129 :match (lambda (widget value)
129 (and value (not (functionp value))))) 130 (and value (not (functionp value)))))
130 (function :value ignore)))) 131 (function :value ignore))))
131 (selection-coding-system mule coding-system) 132 (selection-coding-system mule coding-system "22.1")
132 ;; dired.c 133 ;; dired.c
133 (completion-ignored-extensions dired 134 (completion-ignored-extensions dired
134 (repeat (string :format "%v"))) 135 (repeat (string :format "%v")))
@@ -144,7 +145,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
144 (max-lisp-eval-depth limits integer) 145 (max-lisp-eval-depth limits integer)
145 (max-mini-window-height limits 146 (max-mini-window-height limits
146 (choice (const :tag "quarter screen" nil) 147 (choice (const :tag "quarter screen" nil)
147 number)) 148 number) "23.1")
148 (stack-trace-on-error debug 149 (stack-trace-on-error debug
149 (choice (const :tag "off") 150 (choice (const :tag "off")
150 (repeat :menu-tag "When" 151 (repeat :menu-tag "When"
@@ -178,7 +179,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
178 (sexp :tag "Value")))) 179 (sexp :tag "Value"))))
179 (mouse-highlight mouse (choice (const :tag "disabled" nil) 180 (mouse-highlight mouse (choice (const :tag "disabled" nil)
180 (const :tag "always shown" t) 181 (const :tag "always shown" t)
181 (other :tag "hidden by keypress" 1))) 182 (other :tag "hidden by keypress" 1))
183 "22.1")
182 ;; fringe.c 184 ;; fringe.c
183 (overflow-newline-into-fringe fringe boolean) 185 (overflow-newline-into-fringe fringe boolean)
184 ;; indent.c 186 ;; indent.c
@@ -192,7 +194,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
192 (polling-period keyboard integer) 194 (polling-period keyboard integer)
193 (double-click-time mouse (restricted-sexp 195 (double-click-time mouse (restricted-sexp
194 :match-alternatives (integerp 'nil 't))) 196 :match-alternatives (integerp 'nil 't)))
195 (double-click-fuzz mouse integer) 197 (double-click-fuzz mouse integer "22.1")
196 (inhibit-local-menu-bar-menus menu boolean) 198 (inhibit-local-menu-bar-menus menu boolean)
197 (help-char keyboard character) 199 (help-char keyboard character)
198 (help-event-list keyboard (repeat (sexp :format "%v"))) 200 (help-event-list keyboard (repeat (sexp :format "%v")))
@@ -250,9 +252,9 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
250 (completion-auto-help minibuffer boolean) 252 (completion-auto-help minibuffer boolean)
251 (enable-recursive-minibuffers minibuffer boolean) 253 (enable-recursive-minibuffers minibuffer boolean)
252 (history-length minibuffer 254 (history-length minibuffer
253 (choice (const :tag "Infinite" t) 255 (choice (const :tag "Infinite" t) integer)
254 integer)) 256 "22.1")
255 (history-delete-duplicates minibuffer boolean) 257 (history-delete-duplicates minibuffer boolean "22.1")
256 (minibuffer-prompt-properties 258 (minibuffer-prompt-properties
257 minibuffer 259 minibuffer
258 (list 260 (list
@@ -351,14 +353,15 @@ since it could result in memory overflow and make Emacs crash."
351 ;; and shape of the window. 353 ;; and shape of the window.
352 (const :tag "horizontally" 354 (const :tag "horizontally"
353 (lambda (window) 355 (lambda (window)
354 (split-window window nil 'horiz))))) 356 (split-window window nil 'horiz))))
357 "23.1")
355 (window-min-height windows integer) 358 (window-min-height windows integer)
356 (window-min-width windows integer) 359 (window-min-width windows integer)
357 (scroll-preserve-screen-position 360 (scroll-preserve-screen-position
358 windows (choice 361 windows (choice
359 (const :tag "Off (nil)" :value nil) 362 (const :tag "Off (nil)" :value nil)
360 (const :tag "Full screen (t)" :value t) 363 (const :tag "Full screen (t)" :value t)
361 (other :tag "Always" 1))) 364 (other :tag "Always" 1)) "22.1")
362 (display-buffer-reuse-frames windows boolean "21.1") 365 (display-buffer-reuse-frames windows boolean "21.1")
363 ;; xdisp.c 366 ;; xdisp.c
364 (scroll-step windows integer) 367 (scroll-step windows integer)
@@ -372,7 +375,7 @@ since it could result in memory overflow and make Emacs crash."
372 (line-number-display-limit display 375 (line-number-display-limit display
373 (choice integer 376 (choice integer
374 (const :tag "No limit" nil))) 377 (const :tag "No limit" nil)))
375 (line-number-display-limit-width display integer) 378 (line-number-display-limit-width display integer "22.1")
376 (highlight-nonselected-windows display boolean) 379 (highlight-nonselected-windows display boolean)
377 (message-log-max debug (choice (const :tag "Disable" nil) 380 (message-log-max debug (choice (const :tag "Disable" nil)
378 (integer :menu-tag "lines" 381 (integer :menu-tag "lines"
@@ -387,7 +390,7 @@ since it could result in memory overflow and make Emacs crash."
387 (const :tag "Immediate" :value t) 390 (const :tag "Immediate" :value t)
388 (number :tag "Delay by secs" :value 0.5)) "22.1") 391 (number :tag "Delay by secs" :value 0.5)) "22.1")
389 ;; xfaces.c 392 ;; xfaces.c
390 (scalable-fonts-allowed display boolean) 393 (scalable-fonts-allowed display boolean "22.1")
391 ;; xfns.c 394 ;; xfns.c
392 (x-bitmap-file-path installation 395 (x-bitmap-file-path installation
393 (repeat (directory :format "%v"))) 396 (repeat (directory :format "%v")))
diff --git a/lisp/custom.el b/lisp/custom.el
index a0b1db517a2..7466913eb9a 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1176,7 +1176,9 @@ This function returns nil if no custom theme specifies a value for VARIABLE."
1176(defun custom-theme-recalc-face (face) 1176(defun custom-theme-recalc-face (face)
1177 "Set FACE according to currently enabled custom themes." 1177 "Set FACE according to currently enabled custom themes."
1178 (if (facep face) 1178 (if (facep face)
1179 (face-spec-recalc face))) 1179 (face-spec-set face
1180 (get (or (get face 'face-alias) face)
1181 'face-override-spec))))
1180 1182
1181;;; XEmacs compability functions 1183;;; XEmacs compability functions
1182 1184
diff --git a/lisp/delsel.el b/lisp/delsel.el
index 6427c39eecb..3f9a0c7b32a 100644
--- a/lisp/delsel.el
+++ b/lisp/delsel.el
@@ -113,7 +113,23 @@ any selection."
113 ;; stop safe_run_hooks from clearing out pre-command-hook. 113 ;; stop safe_run_hooks from clearing out pre-command-hook.
114 (and (eq inhibit-quit 'pre-command-hook) 114 (and (eq inhibit-quit 'pre-command-hook)
115 (setq inhibit-quit 'delete-selection-dummy)) 115 (setq inhibit-quit 'delete-selection-dummy))
116 (signal 'file-supersession (cdr data))))))) 116 (signal 'file-supersession (cdr data)))
117 (text-read-only
118 ;; This signal may come either from `delete-active-region' or
119 ;; `self-insert-command' (when `overwrite-mode' is non-nil).
120 ;; To avoid clearing out `pre-command-hook' we handle this case
121 ;; by issuing a simple message. Note, however, that we do not
122 ;; handle all related problems: When read-only text ends before
123 ;; the end of the region, the latter is not deleted but any
124 ;; subsequent insertion will succeed. We could avoid this case
125 ;; by doing a (setq this-command 'ignore) here. This would,
126 ;; however, still not handle the case where read-only text ends
127 ;; precisely where the region starts: In that case the deletion
128 ;; would succeed but the subsequent insertion would fail with a
129 ;; text-read-only error. To handle that case we would have to
130 ;; investigate text properties at both ends of the region and
131 ;; skip the deletion when inserting text is forbidden there.
132 (message "Text is read-only") (ding))))))
117 133
118(put 'self-insert-command 'delete-selection t) 134(put 'self-insert-command 'delete-selection t)
119(put 'self-insert-iso 'delete-selection t) 135(put 'self-insert-iso 'delete-selection t)
@@ -157,7 +173,7 @@ then it takes a second \\[keyboard-quit] to abort the minibuffer."
157 (dolist (sym '(self-insert-command self-insert-iso yank clipboard-yank 173 (dolist (sym '(self-insert-command self-insert-iso yank clipboard-yank
158 insert-register delete-backward-char backward-delete-char-untabify 174 insert-register delete-backward-char backward-delete-char-untabify
159 delete-char newline-and-indent newline open-line)) 175 delete-char newline-and-indent newline open-line))
160 (remprop sym 'delete-selection)) 176 (put sym 'delete-selection nil))
161 ;; continue standard unloading 177 ;; continue standard unloading
162 nil) 178 nil)
163 179
diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el
index 6291453ba17..b8b6a009e2b 100644
--- a/lisp/diff-mode.el
+++ b/lisp/diff-mode.el
@@ -401,13 +401,9 @@ when editing big diffs)."
401(defun diff-end-of-hunk (&optional style) 401(defun diff-end-of-hunk (&optional style)
402 ;; Especially important for unified (because headers are ambiguous). 402 ;; Especially important for unified (because headers are ambiguous).
403 (setq style (diff-hunk-style style)) 403 (setq style (diff-hunk-style style))
404 ;; Some versions of diff replace all-blank context lines in unified
405 ;; format with empty lines. The use of \n below avoids matching such
406 ;; lines as headers.
407 ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html
408 (let ((end (and (re-search-forward (case style 404 (let ((end (and (re-search-forward (case style
409 ;; A `unified' header is ambiguous. 405 ;; A `unified' header is ambiguous.
410 (unified (concat "^[^-+# \\\n]\\|" 406 (unified (concat "^[^-+# \\]\\|"
411 diff-file-header-re)) 407 diff-file-header-re))
412 (context "^[^-+#! \\]") 408 (context "^[^-+#! \\]")
413 (normal "^[^<>#\\]") 409 (normal "^[^<>#\\]")
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 9c153dc584f..aaa68bf6387 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -99,11 +99,11 @@
99 99
100;;; Todo: 100;;; Todo:
101 101
102;; - share more code with image-mode again.
102;; - better menu. 103;; - better menu.
103;; - don't use `find-file'.
104;; - Bind slicing to a drag event. 104;; - Bind slicing to a drag event.
105;; - doc-view-fit-doc-to-window and doc-view-fit-window-to-doc. 105;; - doc-view-fit-doc-to-window and doc-view-fit-window-to-doc.
106;; - zoom a the region around the cursor (like xdvi). 106;; - zoom the region around the cursor (like xdvi).
107;; - get rid of the silly arrow in the fringe. 107;; - get rid of the silly arrow in the fringe.
108;; - improve anti-aliasing (pdf-utils gets it better). 108;; - improve anti-aliasing (pdf-utils gets it better).
109 109
@@ -247,6 +247,14 @@ has finished."
247(defvar doc-view-previous-major-mode nil 247(defvar doc-view-previous-major-mode nil
248 "Only used internally.") 248 "Only used internally.")
249 249
250(defvar doc-view-buffer-file-name nil
251 "Only used internally.
252The file name used for conversion. Normally it's the same as
253`buffer-file-name', but for remote files, compressed files and
254files inside an archive it is a temporary copy of
255the (uncompressed, extracted) file residing in
256`doc-view-cache-directory'.")
257
250;;;; DocView Keymaps 258;;;; DocView Keymaps
251 259
252(defvar doc-view-mode-map 260(defvar doc-view-mode-map
@@ -349,12 +357,7 @@ has finished."
349 ;; Update the buffer 357 ;; Update the buffer
350 (doc-view-insert-image (nth (1- page) doc-view-current-files) 358 (doc-view-insert-image (nth (1- page) doc-view-current-files)
351 :pointer 'arrow) 359 :pointer 'arrow)
352 (overlay-put doc-view-current-overlay 'help-echo doc-view-current-info) 360 (overlay-put doc-view-current-overlay 'help-echo doc-view-current-info)))
353 (goto-char (point-min))
354 ;; This seems to be needed for set-window-hscroll (in
355 ;; image-forward-hscroll) to do something useful, I don't have time to
356 ;; debug this now. :-( --Stef
357 (forward-char)))
358 361
359(defun doc-view-next-page (&optional arg) 362(defun doc-view-next-page (&optional arg)
360 "Browse ARG pages forward." 363 "Browse ARG pages forward."
@@ -450,12 +453,12 @@ It's a subdirectory of `doc-view-cache-directory'."
450 (setq doc-view-current-cache-dir 453 (setq doc-view-current-cache-dir
451 (file-name-as-directory 454 (file-name-as-directory
452 (expand-file-name 455 (expand-file-name
453 (let ((doc buffer-file-name)) 456 (concat (file-name-nondirectory buffer-file-name)
454 (concat (file-name-nondirectory doc) 457 "-"
455 "-" 458 (let ((file doc-view-buffer-file-name))
456 (with-temp-buffer 459 (with-temp-buffer
457 (insert-file-contents-literally doc) 460 (insert-file-contents-literally file)
458 (md5 (current-buffer))))) 461 (md5 (current-buffer)))))
459 doc-view-cache-directory))))) 462 doc-view-cache-directory)))))
460 463
461(defun doc-view-remove-if (predicate list) 464(defun doc-view-remove-if (predicate list)
@@ -476,7 +479,7 @@ Image types are symbols like `dvi', `postscript' or `pdf'."
476 (and (doc-view-mode-p 'pdf) 479 (and (doc-view-mode-p 'pdf)
477 doc-view-dvipdfm-program 480 doc-view-dvipdfm-program
478 (executable-find doc-view-dvipdfm-program))) 481 (executable-find doc-view-dvipdfm-program)))
479 ((or (eq type 'postscript) (eq type 'ps) 482 ((or (eq type 'postscript) (eq type 'ps) (eq type 'eps)
480 (eq type 'pdf)) 483 (eq type 'pdf))
481 (and doc-view-ghostscript-program 484 (and doc-view-ghostscript-program
482 (executable-find doc-view-ghostscript-program))) 485 (executable-find doc-view-ghostscript-program)))
@@ -550,13 +553,16 @@ Should be invoked when the cached images aren't up-to-date."
550(defun doc-view-pdf/ps->png (pdf-ps png) 553(defun doc-view-pdf/ps->png (pdf-ps png)
551 "Convert PDF-PS to PNG asynchronously." 554 "Convert PDF-PS to PNG asynchronously."
552 (setq doc-view-current-converter-process 555 (setq doc-view-current-converter-process
553 (apply 'start-process 556 ;; Make sure the process is started in an existing directory,
554 (append (list "pdf/ps->png" doc-view-conversion-buffer 557 ;; (rather than some file-name-handler-managed dir, for example).
555 doc-view-ghostscript-program) 558 (let ((default-directory (file-name-directory pdf-ps)))
556 doc-view-ghostscript-options 559 (apply 'start-process
557 (list (format "-r%d" (round doc-view-resolution))) 560 (append (list "pdf/ps->png" doc-view-conversion-buffer
558 (list (concat "-sOutputFile=" png)) 561 doc-view-ghostscript-program)
559 (list pdf-ps))) 562 doc-view-ghostscript-options
563 (list (format "-r%d" (round doc-view-resolution)))
564 (list (concat "-sOutputFile=" png))
565 (list pdf-ps))))
560 mode-line-process (list (format ":%s" doc-view-current-converter-process))) 566 mode-line-process (list (format ":%s" doc-view-current-converter-process)))
561 (process-put doc-view-current-converter-process 567 (process-put doc-view-current-converter-process
562 'buffer (current-buffer)) 568 'buffer (current-buffer))
@@ -620,7 +626,7 @@ Should be invoked when the cached images aren't up-to-date."
620 (process-put doc-view-current-converter-process 'pdf-file pdf)) 626 (process-put doc-view-current-converter-process 'pdf-file pdf))
621 627
622(defun doc-view-convert-current-doc () 628(defun doc-view-convert-current-doc ()
623 "Convert `buffer-file-name' to a set of png files, one file per page. 629 "Convert `doc-view-buffer-file-name' to a set of png files, one file per page.
624Those files are saved in the directory given by the function 630Those files are saved in the directory given by the function
625`doc-view-current-cache-dir'." 631`doc-view-current-cache-dir'."
626 ;; Let stale files still display while we recompute the new ones, so only 632 ;; Let stale files still display while we recompute the new ones, so only
@@ -632,12 +638,12 @@ Those files are saved in the directory given by the function
632 (let ((png-file (expand-file-name "page-%d.png" 638 (let ((png-file (expand-file-name "page-%d.png"
633 (doc-view-current-cache-dir)))) 639 (doc-view-current-cache-dir))))
634 (make-directory (doc-view-current-cache-dir)) 640 (make-directory (doc-view-current-cache-dir))
635 (if (not (string= (file-name-extension buffer-file-name) "dvi")) 641 (if (not (string= (file-name-extension doc-view-buffer-file-name) "dvi"))
636 ;; Convert to PNG images. 642 ;; Convert to PNG images.
637 (doc-view-pdf/ps->png buffer-file-name png-file) 643 (doc-view-pdf/ps->png doc-view-buffer-file-name png-file)
638 ;; DVI files have to be converted to PDF before Ghostscript can process 644 ;; DVI files have to be converted to PDF before Ghostscript can process
639 ;; it. 645 ;; it.
640 (doc-view-dvi->pdf buffer-file-name 646 (doc-view-dvi->pdf doc-view-buffer-file-name
641 (expand-file-name "doc.pdf" 647 (expand-file-name "doc.pdf"
642 doc-view-current-cache-dir))))) 648 doc-view-current-cache-dir)))))
643 649
@@ -697,13 +703,23 @@ ARGS is a list of image descriptors."
697 (when doc-view-pending-cache-flush 703 (when doc-view-pending-cache-flush
698 (clear-image-cache) 704 (clear-image-cache)
699 (setq doc-view-pending-cache-flush nil)) 705 (setq doc-view-pending-cache-flush nil))
700 (let ((image (apply 'create-image file 'png nil args))) 706 (if (null file)
701 (setq doc-view-current-image image) 707 ;; We're trying to display a page that doesn't exist. Typically happens
702 (move-overlay doc-view-current-overlay (point-min) (point-max)) 708 ;; if the conversion process somehow failed. Better not signal an
703 (overlay-put doc-view-current-overlay 'display 709 ;; error here because it could prevent a subsequent reconversion from
704 (if doc-view-current-slice 710 ;; fixing the problem.
705 (list (cons 'slice doc-view-current-slice) image) 711 (progn
706 image)))) 712 (setq doc-view-current-image nil)
713 (move-overlay doc-view-current-overlay (point-min) (point-max))
714 (overlay-put doc-view-current-overlay 'display
715 "Cannot display this page! Probably a conversion failure!"))
716 (let ((image (apply 'create-image file 'png nil args)))
717 (setq doc-view-current-image image)
718 (move-overlay doc-view-current-overlay (point-min) (point-max))
719 (overlay-put doc-view-current-overlay 'display
720 (if doc-view-current-slice
721 (list (cons 'slice doc-view-current-slice) image)
722 image)))))
707 723
708(defun doc-view-sort (a b) 724(defun doc-view-sort (a b)
709 "Return non-nil if A should be sorted before B. 725 "Return non-nil if A should be sorted before B.
@@ -847,15 +863,15 @@ If BACKWARD is non-nil, jump to the previous match."
847 ;; We must convert to TXT first! 863 ;; We must convert to TXT first!
848 (if doc-view-current-converter-process 864 (if doc-view-current-converter-process
849 (message "DocView: please wait till conversion finished.") 865 (message "DocView: please wait till conversion finished.")
850 (let ((ext (file-name-extension buffer-file-name))) 866 (let ((ext (file-name-extension doc-view-buffer-file-name)))
851 (cond 867 (cond
852 ((string= ext "pdf") 868 ((string= ext "pdf")
853 ;; Doc is a PDF, so convert it to TXT 869 ;; Doc is a PDF, so convert it to TXT
854 (doc-view-pdf->txt buffer-file-name txt)) 870 (doc-view-pdf->txt doc-view-buffer-file-name txt))
855 ((string= ext "ps") 871 ((string= ext "ps")
856 ;; Doc is a PS, so convert it to PDF (which will be converted to 872 ;; Doc is a PS, so convert it to PDF (which will be converted to
857 ;; TXT thereafter). 873 ;; TXT thereafter).
858 (doc-view-ps->pdf buffer-file-name 874 (doc-view-ps->pdf doc-view-buffer-file-name
859 (expand-file-name "doc.pdf" 875 (expand-file-name "doc.pdf"
860 (doc-view-current-cache-dir)))) 876 (doc-view-current-cache-dir))))
861 ((string= ext "dvi") 877 ((string= ext "dvi")
@@ -900,7 +916,7 @@ If BACKWARD is non-nil, jump to the previous match."
900 916
901(defun doc-view-initiate-display () 917(defun doc-view-initiate-display ()
902 ;; Switch to image display if possible 918 ;; Switch to image display if possible
903 (if (doc-view-mode-p (intern (file-name-extension buffer-file-name))) 919 (if (doc-view-mode-p (intern (file-name-extension doc-view-buffer-file-name)))
904 (progn 920 (progn
905 (doc-view-buffer-message) 921 (doc-view-buffer-message)
906 (setq doc-view-current-page (or doc-view-current-page 1)) 922 (setq doc-view-current-page (or doc-view-current-page 1))
@@ -918,7 +934,7 @@ If BACKWARD is non-nil, jump to the previous match."
918 "%s" 934 "%s"
919 (substitute-command-keys 935 (substitute-command-keys
920 (concat "No image (png) support available or some conversion utility for " 936 (concat "No image (png) support available or some conversion utility for "
921 (file-name-extension buffer-file-name)" files is missing. " 937 (file-name-extension doc-view-buffer-file-name)" files is missing. "
922 "Type \\[doc-view-toggle-display] to switch to an editing mode."))))) 938 "Type \\[doc-view-toggle-display] to switch to an editing mode.")))))
923 939
924(defvar bookmark-make-cell-function) 940(defvar bookmark-make-cell-function)
@@ -929,49 +945,72 @@ If BACKWARD is non-nil, jump to the previous match."
929You can use \\<doc-view-mode-map>\\[doc-view-toggle-display] to 945You can use \\<doc-view-mode-map>\\[doc-view-toggle-display] to
930toggle between displaying the document or editing it as text." 946toggle between displaying the document or editing it as text."
931 (interactive) 947 (interactive)
932 (if jka-compr-really-do-compress 948
933 ;; This is a compressed file uncompressed by auto-compression-mode. 949 (let* ((prev-major-mode (if (eq major-mode 'doc-view-mode)
934 (when (y-or-n-p (concat "DocView: Cannot convert compressed file. " 950 doc-view-previous-major-mode
935 "Save it uncompressed first? ")) 951 major-mode)))
936 (let ((file (read-file-name 952 (kill-all-local-variables)
937 "File: " 953 (set (make-local-variable 'doc-view-previous-major-mode) prev-major-mode))
938 (file-name-directory buffer-file-name)))) 954
939 (write-region (point-min) (point-max) file) 955 ;; Handle compressed files, remote files, files inside archives
940 (kill-buffer nil) 956 (set (make-local-variable 'doc-view-buffer-file-name)
941 (find-file file) 957 (cond
942 (doc-view-mode))) 958 (jka-compr-really-do-compress
943 (let* ((prev-major-mode (if (eq major-mode 'doc-view-mode) 959 (expand-file-name
944 doc-view-previous-major-mode 960 (file-name-nondirectory
945 major-mode))) 961 (file-name-sans-extension buffer-file-name))
946 (kill-all-local-variables) 962 doc-view-cache-directory))
947 (set (make-local-variable 'doc-view-previous-major-mode) prev-major-mode)) 963 ;; Is the file readable by local processes?
948 (make-local-variable 'doc-view-current-files) 964 ;; We used to use `file-remote-p' but it's unclear what it's
949 (make-local-variable 'doc-view-current-image) 965 ;; supposed to return nil for things like local files accessed via
950 (make-local-variable 'doc-view-current-page) 966 ;; `su' or via file://...
951 (make-local-variable 'doc-view-current-converter-process) 967 ((let ((file-name-handler-alist nil))
952 (make-local-variable 'doc-view-current-timer) 968 (not (file-readable-p buffer-file-name)))
953 (make-local-variable 'doc-view-current-slice) 969 (expand-file-name
954 (make-local-variable 'doc-view-current-cache-dir) 970 (file-name-nondirectory buffer-file-name)
955 (make-local-variable 'doc-view-current-info) 971 doc-view-cache-directory))
956 (make-local-variable 'doc-view-current-search-matches) 972 (t buffer-file-name)))
957 (set (make-local-variable 'doc-view-current-overlay) 973 (when (not (string= doc-view-buffer-file-name buffer-file-name))
958 (make-overlay (point-min) (point-max) nil t)) 974 (write-region nil nil doc-view-buffer-file-name))
959 (add-hook 'change-major-mode-hook 975
960 (lambda () (delete-overlay doc-view-current-overlay)) 976 (make-local-variable 'doc-view-current-files)
961 nil t) 977 (make-local-variable 'doc-view-current-image)
962 (set (make-local-variable 'mode-line-position) 978 (make-local-variable 'doc-view-current-page)
963 '(" P" (:eval (number-to-string doc-view-current-page)) 979 (make-local-variable 'doc-view-current-converter-process)
964 "/" (:eval (number-to-string (length doc-view-current-files))))) 980 (make-local-variable 'doc-view-current-timer)
965 (set (make-local-variable 'cursor-type) nil) 981 (make-local-variable 'doc-view-current-slice)
966 (use-local-map doc-view-mode-map) 982 (make-local-variable 'doc-view-current-cache-dir)
967 (set (make-local-variable 'after-revert-hook) 'doc-view-reconvert-doc) 983 (make-local-variable 'doc-view-current-info)
968 (set (make-local-variable 'bookmark-make-cell-function) 984 (make-local-variable 'doc-view-current-search-matches)
969 'doc-view-bookmark-make-cell) 985 (set (make-local-variable 'doc-view-current-overlay)
970 (setq mode-name "DocView" 986 (make-overlay (point-min) (point-max) nil t))
971 buffer-read-only t 987 (add-hook 'change-major-mode-hook
972 major-mode 'doc-view-mode) 988 (lambda () (delete-overlay doc-view-current-overlay))
973 (doc-view-initiate-display) 989 nil t)
974 (run-mode-hooks 'doc-view-mode-hook))) 990
991 ;; Keep track of [vh]scroll when switching buffers
992 (make-local-variable 'image-mode-current-hscroll)
993 (make-local-variable 'image-mode-current-vscroll)
994 (image-set-window-hscroll (selected-window) (window-hscroll))
995 (image-set-window-vscroll (selected-window) (window-vscroll))
996 (add-hook 'window-configuration-change-hook
997 'image-reset-current-vhscroll nil t)
998
999 (set (make-local-variable 'mode-line-position)
1000 '(" P" (:eval (number-to-string doc-view-current-page))
1001 "/" (:eval (number-to-string (length doc-view-current-files)))))
1002 ;; Don't scroll unless the user specifically asked for it.
1003 (set (make-local-variable 'auto-hscroll-mode) nil)
1004 (set (make-local-variable 'cursor-type) nil)
1005 (use-local-map doc-view-mode-map)
1006 (set (make-local-variable 'after-revert-hook) 'doc-view-reconvert-doc)
1007 (set (make-local-variable 'bookmark-make-cell-function)
1008 'doc-view-bookmark-make-cell)
1009 (setq mode-name "DocView"
1010 buffer-read-only t
1011 major-mode 'doc-view-mode)
1012 (doc-view-initiate-display)
1013 (run-mode-hooks 'doc-view-mode-hook))
975 1014
976;;;###autoload 1015;;;###autoload
977(define-minor-mode doc-view-minor-mode 1016(define-minor-mode doc-view-minor-mode
@@ -1003,7 +1042,7 @@ See the command `doc-view-mode' for more information on this mode."
1003 1042
1004(defun doc-view-bookmark-make-cell (annotation &rest args) 1043(defun doc-view-bookmark-make-cell (annotation &rest args)
1005 (let ((the-record 1044 (let ((the-record
1006 `((filename . ,(buffer-file-name)) 1045 `((filename . ,buffer-file-name)
1007 (page . ,doc-view-current-page) 1046 (page . ,doc-view-current-page)
1008 (handler . doc-view-bookmark-jump)))) 1047 (handler . doc-view-bookmark-jump))))
1009 1048
diff --git a/lisp/ediff-diff.el b/lisp/ediff-diff.el
index 685543b5369..b690bfbe4e1 100644
--- a/lisp/ediff-diff.el
+++ b/lisp/ediff-diff.el
@@ -948,7 +948,7 @@ delimiter regions"))
948 ))) 948 )))
949 949
950 950
951(defsubst ediff-convert-fine-diffs-to-overlays (diff-list region-num) 951(defun ediff-convert-fine-diffs-to-overlays (diff-list region-num)
952 (ediff-set-fine-overlays-in-one-buffer 'A diff-list region-num) 952 (ediff-set-fine-overlays-in-one-buffer 'A diff-list region-num)
953 (ediff-set-fine-overlays-in-one-buffer 'B diff-list region-num) 953 (ediff-set-fine-overlays-in-one-buffer 'B diff-list region-num)
954 (if ediff-3way-job 954 (if ediff-3way-job
diff --git a/lisp/ediff-util.el b/lisp/ediff-util.el
index dd844c9a542..058e20f6a19 100644
--- a/lisp/ediff-util.el
+++ b/lisp/ediff-util.el
@@ -41,6 +41,9 @@
41 41
42(defvar ediff-after-quit-hook-internal nil) 42(defvar ediff-after-quit-hook-internal nil)
43 43
44(eval-and-compile
45 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
46
44(eval-when-compile 47(eval-when-compile
45 (let ((load-path (cons (expand-file-name ".") load-path))) 48 (let ((load-path (cons (expand-file-name ".") load-path)))
46 (provide 'ediff-util) ; to break recursive load cycle 49 (provide 'ediff-util) ; to break recursive load cycle
@@ -2406,7 +2409,9 @@ If it is t, they will be preserved unconditionally. A prefix argument,
2406temporarily reverses the meaning of this variable." 2409temporarily reverses the meaning of this variable."
2407 (interactive "P") 2410 (interactive "P")
2408 (ediff-barf-if-not-control-buffer) 2411 (ediff-barf-if-not-control-buffer)
2409 (let ((ctl-buf (current-buffer))) 2412 (let ((ctl-buf (current-buffer))
2413 (ctl-frm (selected-frame))
2414 (minibuffer-auto-raise t))
2410 (if (y-or-n-p (format "Quit this Ediff session%s? " 2415 (if (y-or-n-p (format "Quit this Ediff session%s? "
2411 (if (ediff-buffer-live-p ediff-meta-buffer) 2416 (if (ediff-buffer-live-p ediff-meta-buffer)
2412 " & show containing session group" ""))) 2417 " & show containing session group" "")))
@@ -2414,6 +2419,8 @@ temporarily reverses the meaning of this variable."
2414 (message "") 2419 (message "")
2415 (set-buffer ctl-buf) 2420 (set-buffer ctl-buf)
2416 (ediff-really-quit reverse-default-keep-variants)) 2421 (ediff-really-quit reverse-default-keep-variants))
2422 (select-frame ctl-frm)
2423 (raise-frame ctl-frm)
2417 (message "")))) 2424 (message ""))))
2418 2425
2419 2426
@@ -2816,7 +2823,6 @@ up an appropriate window config."
2816 (message 2823 (message
2817 "To resume, type M-x eregistry and select the desired Ediff session")) 2824 "To resume, type M-x eregistry and select the desired Ediff session"))
2818 2825
2819
2820;; ediff-barf-if-not-control-buffer ensures only called from ediff. 2826;; ediff-barf-if-not-control-buffer ensures only called from ediff.
2821(declare-function ediff-version "ediff" ()) 2827(declare-function ediff-version "ediff" ())
2822 2828
diff --git a/lisp/ediff-wind.el b/lisp/ediff-wind.el
index c5a53b47b3b..26aa19f38a4 100644
--- a/lisp/ediff-wind.el
+++ b/lisp/ediff-wind.el
@@ -40,6 +40,11 @@
40(defvar frame-icon-title-format) 40(defvar frame-icon-title-format)
41(defvar ediff-diff-status) 41(defvar ediff-diff-status)
42 42
43;; declare-function does not exist in XEmacs
44(eval-and-compile
45 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
46
47
43(eval-when-compile 48(eval-when-compile
44 (let ((load-path (cons (expand-file-name ".") load-path))) 49 (let ((load-path (cons (expand-file-name ".") load-path)))
45 (or (featurep 'ediff-init) 50 (or (featurep 'ediff-init)
diff --git a/lisp/ediff.el b/lisp/ediff.el
index 353c6a14d47..cdfb66d9c00 100644
--- a/lisp/ediff.el
+++ b/lisp/ediff.el
@@ -8,7 +8,7 @@
8;; Keywords: comparing, merging, patching, tools, unix 8;; Keywords: comparing, merging, patching, tools, unix
9 9
10(defconst ediff-version "2.81.2" "The current version of Ediff") 10(defconst ediff-version "2.81.2" "The current version of Ediff")
11(defconst ediff-date "August 18, 2007" "Date of last update") 11(defconst ediff-date "January 09, 2008" "Date of last update")
12 12
13 13
14;; This file is part of GNU Emacs. 14;; This file is part of GNU Emacs.
@@ -113,6 +113,9 @@
113(defvar ediff-last-dir-patch) 113(defvar ediff-last-dir-patch)
114(defvar ediff-patch-default-directory) 114(defvar ediff-patch-default-directory)
115 115
116(eval-and-compile
117 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
118
116 119
117(eval-when-compile 120(eval-when-compile
118 (and noninteractive 121 (and noninteractive
diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el
index b8cf8362386..f2eb06710e1 100644
--- a/lisp/emacs-lisp/avl-tree.el
+++ b/lisp/emacs-lisp/avl-tree.el
@@ -1,6 +1,6 @@
1;;; avl-tree.el --- balanced binary trees, AVL-trees 1;;; avl-tree.el --- balanced binary trees, AVL-trees
2 2
3;; Copyright (C) 1995, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 1995, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Per Cederqvist <ceder@lysator.liu.se> 5;; Author: Per Cederqvist <ceder@lysator.liu.se>
6;; Inge Wallin <inge@lysator.liu.se> 6;; Inge Wallin <inge@lysator.liu.se>
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el
index fe7f774c7e9..9f81cebaca8 100644
--- a/lisp/emacs-lisp/check-declare.el
+++ b/lisp/emacs-lisp/check-declare.el
@@ -1,6 +1,6 @@
1;;; check-declare.el --- Check declare-function statements 1;;; check-declare.el --- Check declare-function statements
2 2
3;; Copyright (C) 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Glenn Morris <rgm@gnu.org> 5;; Author: Glenn Morris <rgm@gnu.org>
6;; Keywords: lisp, tools, maint 6;; Keywords: lisp, tools, maint
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index 7b0f1961530..2297314af87 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -10,16 +10,16 @@
10;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p 10;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p
11;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively 11;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively
12;;;;;; notevery notany every some mapcon mapcan mapl maplist map 12;;;;;; notevery notany every some mapcon mapcan mapl maplist map
13;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "53c2b3ede19dac62cff13a37f58cdf9c") 13;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "2f89c94c42629315419a9d7404469c42")
14;;; Generated autoloads from cl-extra.el 14;;; Generated autoloads from cl-extra.el
15 15
16(autoload (quote coerce) "cl-extra" "\ 16(autoload 'coerce "cl-extra" "\
17Coerce OBJECT to type TYPE. 17Coerce OBJECT to type TYPE.
18TYPE is a Common Lisp type specifier. 18TYPE is a Common Lisp type specifier.
19 19
20\(fn OBJECT TYPE)" nil nil) 20\(fn OBJECT TYPE)" nil nil)
21 21
22(autoload (quote equalp) "cl-extra" "\ 22(autoload 'equalp "cl-extra" "\
23Return t if two Lisp objects have similar structures and contents. 23Return t if two Lisp objects have similar structures and contents.
24This is like `equal', except that it accepts numerically equal 24This is like `equal', except that it accepts numerically equal
25numbers of different types (float vs. integer), and also compares 25numbers of different types (float vs. integer), and also compares
@@ -27,246 +27,246 @@ strings case-insensitively.
27 27
28\(fn X Y)" nil nil) 28\(fn X Y)" nil nil)
29 29
30(autoload (quote cl-mapcar-many) "cl-extra" "\ 30(autoload 'cl-mapcar-many "cl-extra" "\
31Not documented 31Not documented
32 32
33\(fn CL-FUNC CL-SEQS)" nil nil) 33\(fn CL-FUNC CL-SEQS)" nil nil)
34 34
35(autoload (quote map) "cl-extra" "\ 35(autoload 'map "cl-extra" "\
36Map a FUNCTION across one or more SEQUENCEs, returning a sequence. 36Map a FUNCTION across one or more SEQUENCEs, returning a sequence.
37TYPE is the sequence type to return. 37TYPE is the sequence type to return.
38 38
39\(fn TYPE FUNCTION SEQUENCE...)" nil nil) 39\(fn TYPE FUNCTION SEQUENCE...)" nil nil)
40 40
41(autoload (quote maplist) "cl-extra" "\ 41(autoload 'maplist "cl-extra" "\
42Map FUNCTION to each sublist of LIST or LISTs. 42Map FUNCTION to each sublist of LIST or LISTs.
43Like `mapcar', except applies to lists and their cdr's rather than to 43Like `mapcar', except applies to lists and their cdr's rather than to
44the elements themselves. 44the elements themselves.
45 45
46\(fn FUNCTION LIST...)" nil nil) 46\(fn FUNCTION LIST...)" nil nil)
47 47
48(autoload (quote mapl) "cl-extra" "\ 48(autoload 'mapl "cl-extra" "\
49Like `maplist', but does not accumulate values returned by the function. 49Like `maplist', but does not accumulate values returned by the function.
50 50
51\(fn FUNCTION LIST...)" nil nil) 51\(fn FUNCTION LIST...)" nil nil)
52 52
53(autoload (quote mapcan) "cl-extra" "\ 53(autoload 'mapcan "cl-extra" "\
54Like `mapcar', but nconc's together the values returned by the function. 54Like `mapcar', but nconc's together the values returned by the function.
55 55
56\(fn FUNCTION SEQUENCE...)" nil nil) 56\(fn FUNCTION SEQUENCE...)" nil nil)
57 57
58(autoload (quote mapcon) "cl-extra" "\ 58(autoload 'mapcon "cl-extra" "\
59Like `maplist', but nconc's together the values returned by the function. 59Like `maplist', but nconc's together the values returned by the function.
60 60
61\(fn FUNCTION LIST...)" nil nil) 61\(fn FUNCTION LIST...)" nil nil)
62 62
63(autoload (quote some) "cl-extra" "\ 63(autoload 'some "cl-extra" "\
64Return true if PREDICATE is true of any element of SEQ or SEQs. 64Return true if PREDICATE is true of any element of SEQ or SEQs.
65If so, return the true (non-nil) value returned by PREDICATE. 65If so, return the true (non-nil) value returned by PREDICATE.
66 66
67\(fn PREDICATE SEQ...)" nil nil) 67\(fn PREDICATE SEQ...)" nil nil)
68 68
69(autoload (quote every) "cl-extra" "\ 69(autoload 'every "cl-extra" "\
70Return true if PREDICATE is true of every element of SEQ or SEQs. 70Return true if PREDICATE is true of every element of SEQ or SEQs.
71 71
72\(fn PREDICATE SEQ...)" nil nil) 72\(fn PREDICATE SEQ...)" nil nil)
73 73
74(autoload (quote notany) "cl-extra" "\ 74(autoload 'notany "cl-extra" "\
75Return true if PREDICATE is false of every element of SEQ or SEQs. 75Return true if PREDICATE is false of every element of SEQ or SEQs.
76 76
77\(fn PREDICATE SEQ...)" nil nil) 77\(fn PREDICATE SEQ...)" nil nil)
78 78
79(autoload (quote notevery) "cl-extra" "\ 79(autoload 'notevery "cl-extra" "\
80Return true if PREDICATE is false of some element of SEQ or SEQs. 80Return true if PREDICATE is false of some element of SEQ or SEQs.
81 81
82\(fn PREDICATE SEQ...)" nil nil) 82\(fn PREDICATE SEQ...)" nil nil)
83 83
84(defalias (quote cl-map-keymap) (quote map-keymap)) 84(defalias 'cl-map-keymap 'map-keymap)
85 85
86(autoload (quote cl-map-keymap-recursively) "cl-extra" "\ 86(autoload 'cl-map-keymap-recursively "cl-extra" "\
87Not documented 87Not documented
88 88
89\(fn CL-FUNC-REC CL-MAP &optional CL-BASE)" nil nil) 89\(fn CL-FUNC-REC CL-MAP &optional CL-BASE)" nil nil)
90 90
91(autoload (quote cl-map-intervals) "cl-extra" "\ 91(autoload 'cl-map-intervals "cl-extra" "\
92Not documented 92Not documented
93 93
94\(fn CL-FUNC &optional CL-WHAT CL-PROP CL-START CL-END)" nil nil) 94\(fn CL-FUNC &optional CL-WHAT CL-PROP CL-START CL-END)" nil nil)
95 95
96(autoload (quote cl-map-overlays) "cl-extra" "\ 96(autoload 'cl-map-overlays "cl-extra" "\
97Not documented 97Not documented
98 98
99\(fn CL-FUNC &optional CL-BUFFER CL-START CL-END CL-ARG)" nil nil) 99\(fn CL-FUNC &optional CL-BUFFER CL-START CL-END CL-ARG)" nil nil)
100 100
101(autoload (quote cl-set-frame-visible-p) "cl-extra" "\ 101(autoload 'cl-set-frame-visible-p "cl-extra" "\
102Not documented 102Not documented
103 103
104\(fn FRAME VAL)" nil nil) 104\(fn FRAME VAL)" nil nil)
105 105
106(autoload (quote cl-progv-before) "cl-extra" "\ 106(autoload 'cl-progv-before "cl-extra" "\
107Not documented 107Not documented
108 108
109\(fn SYMS VALUES)" nil nil) 109\(fn SYMS VALUES)" nil nil)
110 110
111(autoload (quote gcd) "cl-extra" "\ 111(autoload 'gcd "cl-extra" "\
112Return the greatest common divisor of the arguments. 112Return the greatest common divisor of the arguments.
113 113
114\(fn &rest ARGS)" nil nil) 114\(fn &rest ARGS)" nil nil)
115 115
116(autoload (quote lcm) "cl-extra" "\ 116(autoload 'lcm "cl-extra" "\
117Return the least common multiple of the arguments. 117Return the least common multiple of the arguments.
118 118
119\(fn &rest ARGS)" nil nil) 119\(fn &rest ARGS)" nil nil)
120 120
121(autoload (quote isqrt) "cl-extra" "\ 121(autoload 'isqrt "cl-extra" "\
122Return the integer square root of the argument. 122Return the integer square root of the argument.
123 123
124\(fn X)" nil nil) 124\(fn X)" nil nil)
125 125
126(autoload (quote floor*) "cl-extra" "\ 126(autoload 'floor* "cl-extra" "\
127Return a list of the floor of X and the fractional part of X. 127Return a list of the floor of X and the fractional part of X.
128With two arguments, return floor and remainder of their quotient. 128With two arguments, return floor and remainder of their quotient.
129 129
130\(fn X &optional Y)" nil nil) 130\(fn X &optional Y)" nil nil)
131 131
132(autoload (quote ceiling*) "cl-extra" "\ 132(autoload 'ceiling* "cl-extra" "\
133Return a list of the ceiling of X and the fractional part of X. 133Return a list of the ceiling of X and the fractional part of X.
134With two arguments, return ceiling and remainder of their quotient. 134With two arguments, return ceiling and remainder of their quotient.
135 135
136\(fn X &optional Y)" nil nil) 136\(fn X &optional Y)" nil nil)
137 137
138(autoload (quote truncate*) "cl-extra" "\ 138(autoload 'truncate* "cl-extra" "\
139Return a list of the integer part of X and the fractional part of X. 139Return a list of the integer part of X and the fractional part of X.
140With two arguments, return truncation and remainder of their quotient. 140With two arguments, return truncation and remainder of their quotient.
141 141
142\(fn X &optional Y)" nil nil) 142\(fn X &optional Y)" nil nil)
143 143
144(autoload (quote round*) "cl-extra" "\ 144(autoload 'round* "cl-extra" "\
145Return a list of X rounded to the nearest integer and the remainder. 145Return a list of X rounded to the nearest integer and the remainder.
146With two arguments, return rounding and remainder of their quotient. 146With two arguments, return rounding and remainder of their quotient.
147 147
148\(fn X &optional Y)" nil nil) 148\(fn X &optional Y)" nil nil)
149 149
150(autoload (quote mod*) "cl-extra" "\ 150(autoload 'mod* "cl-extra" "\
151The remainder of X divided by Y, with the same sign as Y. 151The remainder of X divided by Y, with the same sign as Y.
152 152
153\(fn X Y)" nil nil) 153\(fn X Y)" nil nil)
154 154
155(autoload (quote rem*) "cl-extra" "\ 155(autoload 'rem* "cl-extra" "\
156The remainder of X divided by Y, with the same sign as X. 156The remainder of X divided by Y, with the same sign as X.
157 157
158\(fn X Y)" nil nil) 158\(fn X Y)" nil nil)
159 159
160(autoload (quote signum) "cl-extra" "\ 160(autoload 'signum "cl-extra" "\
161Return 1 if X is positive, -1 if negative, 0 if zero. 161Return 1 if X is positive, -1 if negative, 0 if zero.
162 162
163\(fn X)" nil nil) 163\(fn X)" nil nil)
164 164
165(autoload (quote random*) "cl-extra" "\ 165(autoload 'random* "cl-extra" "\
166Return a random nonnegative number less than LIM, an integer or float. 166Return a random nonnegative number less than LIM, an integer or float.
167Optional second arg STATE is a random-state object. 167Optional second arg STATE is a random-state object.
168 168
169\(fn LIM &optional STATE)" nil nil) 169\(fn LIM &optional STATE)" nil nil)
170 170
171(autoload (quote make-random-state) "cl-extra" "\ 171(autoload 'make-random-state "cl-extra" "\
172Return a copy of random-state STATE, or of `*random-state*' if omitted. 172Return a copy of random-state STATE, or of `*random-state*' if omitted.
173If STATE is t, return a new state object seeded from the time of day. 173If STATE is t, return a new state object seeded from the time of day.
174 174
175\(fn &optional STATE)" nil nil) 175\(fn &optional STATE)" nil nil)
176 176
177(autoload (quote random-state-p) "cl-extra" "\ 177(autoload 'random-state-p "cl-extra" "\
178Return t if OBJECT is a random-state object. 178Return t if OBJECT is a random-state object.
179 179
180\(fn OBJECT)" nil nil) 180\(fn OBJECT)" nil nil)
181 181
182(autoload (quote cl-float-limits) "cl-extra" "\ 182(autoload 'cl-float-limits "cl-extra" "\
183Not documented 183Not documented
184 184
185\(fn)" nil nil) 185\(fn)" nil nil)
186 186
187(autoload (quote subseq) "cl-extra" "\ 187(autoload 'subseq "cl-extra" "\
188Return the subsequence of SEQ from START to END. 188Return the subsequence of SEQ from START to END.
189If END is omitted, it defaults to the length of the sequence. 189If END is omitted, it defaults to the length of the sequence.
190If START or END is negative, it counts from the end. 190If START or END is negative, it counts from the end.
191 191
192\(fn SEQ START &optional END)" nil nil) 192\(fn SEQ START &optional END)" nil nil)
193 193
194(autoload (quote concatenate) "cl-extra" "\ 194(autoload 'concatenate "cl-extra" "\
195Concatenate, into a sequence of type TYPE, the argument SEQUENCEs. 195Concatenate, into a sequence of type TYPE, the argument SEQUENCEs.
196 196
197\(fn TYPE SEQUENCE...)" nil nil) 197\(fn TYPE SEQUENCE...)" nil nil)
198 198
199(autoload (quote revappend) "cl-extra" "\ 199(autoload 'revappend "cl-extra" "\
200Equivalent to (append (reverse X) Y). 200Equivalent to (append (reverse X) Y).
201 201
202\(fn X Y)" nil nil) 202\(fn X Y)" nil nil)
203 203
204(autoload (quote nreconc) "cl-extra" "\ 204(autoload 'nreconc "cl-extra" "\
205Equivalent to (nconc (nreverse X) Y). 205Equivalent to (nconc (nreverse X) Y).
206 206
207\(fn X Y)" nil nil) 207\(fn X Y)" nil nil)
208 208
209(autoload (quote list-length) "cl-extra" "\ 209(autoload 'list-length "cl-extra" "\
210Return the length of list X. Return nil if list is circular. 210Return the length of list X. Return nil if list is circular.
211 211
212\(fn X)" nil nil) 212\(fn X)" nil nil)
213 213
214(autoload (quote tailp) "cl-extra" "\ 214(autoload 'tailp "cl-extra" "\
215Return true if SUBLIST is a tail of LIST. 215Return true if SUBLIST is a tail of LIST.
216 216
217\(fn SUBLIST LIST)" nil nil) 217\(fn SUBLIST LIST)" nil nil)
218 218
219(autoload (quote get*) "cl-extra" "\ 219(autoload 'get* "cl-extra" "\
220Return the value of SYMBOL's PROPNAME property, or DEFAULT if none. 220Return the value of SYMBOL's PROPNAME property, or DEFAULT if none.
221 221
222\(fn SYMBOL PROPNAME &optional DEFAULT)" nil nil) 222\(fn SYMBOL PROPNAME &optional DEFAULT)" nil nil)
223 223
224(autoload (quote getf) "cl-extra" "\ 224(autoload 'getf "cl-extra" "\
225Search PROPLIST for property PROPNAME; return its value or DEFAULT. 225Search PROPLIST for property PROPNAME; return its value or DEFAULT.
226PROPLIST is a list of the sort returned by `symbol-plist'. 226PROPLIST is a list of the sort returned by `symbol-plist'.
227 227
228\(fn PROPLIST PROPNAME &optional DEFAULT)" nil nil) 228\(fn PROPLIST PROPNAME &optional DEFAULT)" nil nil)
229 229
230(autoload (quote cl-set-getf) "cl-extra" "\ 230(autoload 'cl-set-getf "cl-extra" "\
231Not documented 231Not documented
232 232
233\(fn PLIST TAG VAL)" nil nil) 233\(fn PLIST TAG VAL)" nil nil)
234 234
235(autoload (quote cl-do-remf) "cl-extra" "\ 235(autoload 'cl-do-remf "cl-extra" "\
236Not documented 236Not documented
237 237
238\(fn PLIST TAG)" nil nil) 238\(fn PLIST TAG)" nil nil)
239 239
240(autoload (quote cl-remprop) "cl-extra" "\ 240(autoload 'cl-remprop "cl-extra" "\
241Remove from SYMBOL's plist the property PROPNAME and its value. 241Remove from SYMBOL's plist the property PROPNAME and its value.
242 242
243\(fn SYMBOL PROPNAME)" nil nil) 243\(fn SYMBOL PROPNAME)" nil nil)
244 244
245(defalias (quote remprop) (quote cl-remprop)) 245(defalias 'remprop 'cl-remprop)
246 246
247(defalias (quote cl-gethash) (quote gethash)) 247(defalias 'cl-gethash 'gethash)
248 248
249(defalias (quote cl-puthash) (quote puthash)) 249(defalias 'cl-puthash 'puthash)
250 250
251(defalias (quote cl-remhash) (quote remhash)) 251(defalias 'cl-remhash 'remhash)
252 252
253(defalias (quote cl-clrhash) (quote clrhash)) 253(defalias 'cl-clrhash 'clrhash)
254 254
255(defalias (quote cl-maphash) (quote maphash)) 255(defalias 'cl-maphash 'maphash)
256 256
257(defalias (quote cl-make-hash-table) (quote make-hash-table)) 257(defalias 'cl-make-hash-table 'make-hash-table)
258 258
259(defalias (quote cl-hash-table-p) (quote hash-table-p)) 259(defalias 'cl-hash-table-p 'hash-table-p)
260 260
261(defalias (quote cl-hash-table-count) (quote hash-table-count)) 261(defalias 'cl-hash-table-count 'hash-table-count)
262 262
263(autoload (quote cl-macroexpand-all) "cl-extra" "\ 263(autoload 'cl-macroexpand-all "cl-extra" "\
264Expand all macro calls through a Lisp FORM. 264Expand all macro calls through a Lisp FORM.
265This also does some trivial optimizations to make the form prettier. 265This also does some trivial optimizations to make the form prettier.
266 266
267\(fn FORM &optional ENV)" nil nil) 267\(fn FORM &optional ENV)" nil nil)
268 268
269(autoload (quote cl-prettyexpand) "cl-extra" "\ 269(autoload 'cl-prettyexpand "cl-extra" "\
270Not documented 270Not documented
271 271
272\(fn FORM &optional FULL)" nil nil) 272\(fn FORM &optional FULL)" nil nil)
@@ -745,7 +745,7 @@ Not documented
745;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not 745;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not
746;;;;;; substitute-if substitute delete-duplicates remove-duplicates 746;;;;;; substitute-if substitute delete-duplicates remove-duplicates
747;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove* 747;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove*
748;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "77bee7df392948b6ab0699e391e8abc1") 748;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "e3c349e5231811c1c0482dd378dae56a")
749;;; Generated autoloads from cl-seq.el 749;;; Generated autoloads from cl-seq.el
750 750
751(autoload 'reduce "cl-seq" "\ 751(autoload 'reduce "cl-seq" "\
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 9a70c8bf778..9dc0bbc4abb 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2508,11 +2508,12 @@ They are not evaluated unless the assertion fails. If STRING is
2508omitted, a default message listing FORM itself is used." 2508omitted, a default message listing FORM itself is used."
2509 (and (or (not (cl-compiling-file)) 2509 (and (or (not (cl-compiling-file))
2510 (< cl-optimize-speed 3) (= cl-optimize-safety 3)) 2510 (< cl-optimize-speed 3) (= cl-optimize-safety 3))
2511 (let ((sargs (and show-args (delq nil (mapcar 2511 (let ((sargs (and show-args
2512 (function 2512 (delq nil (mapcar
2513 (lambda (x) 2513 (lambda (x)
2514 (and (not (cl-const-expr-p x)) 2514 (unless (cl-const-expr-p x)
2515 x))) (cdr form)))))) 2515 x))
2516 (cdr form))))))
2516 (list 'progn 2517 (list 'progn
2517 (list 'or form 2518 (list 'or form
2518 (if string 2519 (if string
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index fa19ecd9c0f..ca5151fa984 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -216,12 +216,18 @@ If NAME is provided, it is used for the keymap."
216 (setq menu (cdr (easy-menu-convert-item menu))))) 216 (setq menu (cdr (easy-menu-convert-item menu)))))
217 menu) 217 menu)
218 218
219(defvar easy-menu-avoid-duplicate-keys t
220 "Dynamically scoped var to register already used keys in a menu.
221If it holds a list, this is expected to be a list of keys already seen in the
222menu we're processing. Else it means we're not processing a menu.")
223
219;;;###autoload 224;;;###autoload
220(defun easy-menu-create-menu (menu-name menu-items) 225(defun easy-menu-create-menu (menu-name menu-items)
221 "Create a menu called MENU-NAME with items described in MENU-ITEMS. 226 "Create a menu called MENU-NAME with items described in MENU-ITEMS.
222MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items 227MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items
223possibly preceded by keyword pairs as described in `easy-menu-define'." 228possibly preceded by keyword pairs as described in `easy-menu-define'."
224 (let ((menu (make-sparse-keymap menu-name)) 229 (let ((menu (make-sparse-keymap menu-name))
230 (easy-menu-avoid-duplicate-keys nil)
225 prop keyword arg label enable filter visible help) 231 prop keyword arg label enable filter visible help)
226 ;; Look for keywords. 232 ;; Look for keywords.
227 (while (and menu-items 233 (while (and menu-items
@@ -341,22 +347,22 @@ ITEM defines an item as in `easy-menu-define'."
341 (setq prop (cons :button 347 (setq prop (cons :button
342 (cons (cons (cdr style) selected) prop))))) 348 (cons (cons (cdr style) selected) prop)))))
343 (when (stringp keys) 349 (when (stringp keys)
344 (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$" 350 (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$"
345 keys) 351 keys)
346 (let ((prefix 352 (let ((prefix
347 (if (< (match-beginning 0) (match-beginning 1)) 353 (if (< (match-beginning 0) (match-beginning 1))
348 (substring keys 0 (match-beginning 1)))) 354 (substring keys 0 (match-beginning 1))))
349 (postfix 355 (postfix
350 (if (< (match-end 1) (match-end 0)) 356 (if (< (match-end 1) (match-end 0))
351 (substring keys (match-end 1)))) 357 (substring keys (match-end 1))))
352 (cmd (intern (match-string 2 keys)))) 358 (cmd (intern (match-string 2 keys))))
353 (setq keys (and (or prefix postfix) 359 (setq keys (and (or prefix postfix)
354 (cons prefix postfix))) 360 (cons prefix postfix)))
355 (setq keys 361 (setq keys
356 (and (or keys (not (eq command cmd))) 362 (and (or keys (not (eq command cmd)))
357 (cons cmd keys)))) 363 (cons cmd keys))))
358 (setq cache-specified nil)) 364 (setq cache-specified nil))
359 (if keys (setq prop (cons :keys (cons keys prop))))) 365 (if keys (setq prop (cons :keys (cons keys prop)))))
360 (if (and visible (not (easy-menu-always-true-p visible))) 366 (if (and visible (not (easy-menu-always-true-p visible)))
361 (if (equal visible ''nil) 367 (if (equal visible ''nil)
362 ;; Invisible menu item. Don't insert into keymap. 368 ;; Invisible menu item. Don't insert into keymap.
@@ -371,12 +377,27 @@ ITEM defines an item as in `easy-menu-define'."
371 ;; `intern' the name so as to merge multiple entries with the same name. 377 ;; `intern' the name so as to merge multiple entries with the same name.
372 ;; It also makes it easier/possible to lookup/change menu bindings 378 ;; It also makes it easier/possible to lookup/change menu bindings
373 ;; via keymap functions. 379 ;; via keymap functions.
374 (cons (easy-menu-intern name) 380 (let ((key (easy-menu-intern name)))
375 (and (not remove) 381 (when (listp easy-menu-avoid-duplicate-keys)
376 (cons 'menu-item 382 ;; Merging multiple entries with the same name is sometimes what we
377 (cons label 383 ;; want, but not when the entries are actually different (e.g. same
378 (and name 384 ;; name but different :suffix as seen in cal-menu.el) and appear in
379 (cons command prop)))))))) 385 ;; the same menu. So we try to detect and resolve conflicts.
386 (while (and (stringp name)
387 (memq key easy-menu-avoid-duplicate-keys))
388 ;; We need to use some distinct object, ideally a symbol, ideally
389 ;; related to the `name'. Uninterned symbols do not work (they
390 ;; are apparently turned into strings and re-interned later on).
391 (setq key (intern (format "%s (%d)" (symbol-name key)
392 (length easy-menu-avoid-duplicate-keys)))))
393 (push key easy-menu-avoid-duplicate-keys))
394
395 (cons key
396 (and (not remove)
397 (cons 'menu-item
398 (cons label
399 (and name
400 (cons command prop)))))))))
380 401
381(defun easy-menu-define-key (menu key item &optional before) 402(defun easy-menu-define-key (menu key item &optional before)
382 "Add binding in MENU for KEY => ITEM. Similar to `define-key-after'. 403 "Add binding in MENU for KEY => ITEM. Similar to `define-key-after'.
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 7c4c01a6e32..85f3fe941b7 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -200,11 +200,17 @@ TYPE should be nil to find a function, or `defvar' to find a variable."
200 (let* ((path (cons (or find-function-source-path load-path) 200 (let* ((path (cons (or find-function-source-path load-path)
201 (find-library-suffixes))) 201 (find-library-suffixes)))
202 (def (if (eq (function-called-at-point) 'require) 202 (def (if (eq (function-called-at-point) 'require)
203 (save-excursion 203 ;; `function-called-at-point' may return 'require
204 (backward-up-list) 204 ;; with `point' anywhere on this line. So wrap the
205 (forward-char) 205 ;; `save-excursion' below in a `condition-case' to
206 (backward-sexp -2) 206 ;; avoid reporting a scan-error here.
207 (thing-at-point 'symbol)) 207 (condition-case nil
208 (save-excursion
209 (backward-up-list)
210 (forward-char)
211 (forward-sexp 2)
212 (thing-at-point 'symbol))
213 (error nil))
208 (thing-at-point 'symbol)))) 214 (thing-at-point 'symbol))))
209 (when def 215 (when def
210 (setq def (and (locate-file-completion def path 'test) def))) 216 (setq def (and (locate-file-completion def path 'test) def)))
@@ -233,8 +239,12 @@ The search is done in the source for library LIBRARY."
233 (setq symbol (get symbol 'definition-name))) 239 (setq symbol (get symbol 'definition-name)))
234 (if (string-match "\\`src/\\(.*\\.c\\)\\'" library) 240 (if (string-match "\\`src/\\(.*\\.c\\)\\'" library)
235 (find-function-C-source symbol (match-string 1 library) type) 241 (find-function-C-source symbol (match-string 1 library) type)
236 (if (string-match "\\.el\\(c\\)\\'" library) 242 (when (string-match "\\.el\\(c\\)\\'" library)
237 (setq library (substring library 0 (match-beginning 1)))) 243 (setq library (substring library 0 (match-beginning 1))))
244 ;; Strip extension from .emacs.el to make sure symbol is searched in
245 ;; .emacs too.
246 (when (string-match "\\.emacs\\(.el\\)" library)
247 (setq library (substring library 0 (match-beginning 1))))
238 (let* ((filename (find-library-name library)) 248 (let* ((filename (find-library-name library))
239 (regexp-symbol (cdr (assq type find-function-regexp-alist)))) 249 (regexp-symbol (cdr (assq type find-function-regexp-alist))))
240 (with-current-buffer (find-file-noselect filename) 250 (with-current-buffer (find-file-noselect filename)
diff --git a/lisp/emulation/crisp.el b/lisp/emulation/crisp.el
index b5fd7ee602c..7c254da869a 100644
--- a/lisp/emulation/crisp.el
+++ b/lisp/emulation/crisp.el
@@ -148,7 +148,7 @@ does not load the scroll-all package."
148 148
149(defun crisp-region-active () 149(defun crisp-region-active ()
150 "Compatibility function to test for an active region." 150 "Compatibility function to test for an active region."
151 (if (boundp 'zmacs-region-active-p) 151 (if (featurep 'xemacs)
152 zmacs-region-active-p 152 zmacs-region-active-p
153 mark-active)) 153 mark-active))
154 154
diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el
index 686a79c9350..e9de0409aa4 100644
--- a/lisp/emulation/tpu-edt.el
+++ b/lisp/emulation/tpu-edt.el
@@ -751,9 +751,7 @@ version of Emacs."
751Sets the mark at POS and activates the region according to the 751Sets the mark at POS and activates the region according to the
752current version of Emacs." 752current version of Emacs."
753 (set-mark pos) 753 (set-mark pos)
754 ;; We use a separate `if' for the fboundp so the byte-compiler notices it 754 (when (featurep 'xemacs) (when pos (zmacs-activate-region))))
755 ;; and doesn't complain about the subsequent call.
756 (if (fboundp 'zmacs-activate-region) (if pos (zmacs-activate-region))))
757 755
758(defun tpu-string-prompt (prompt history-symbol) 756(defun tpu-string-prompt (prompt history-symbol)
759 "Read a string with PROMPT." 757 "Read a string with PROMPT."
@@ -2439,7 +2437,7 @@ If FILE is nil, try to load a default file. The default file names are
2439 2437
2440 2438
2441;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins 2439;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins
2442;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "e0629234f1abe076917a303456b48329") 2440;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "c7ce8bad68736a5682eb3f5f5edc48db")
2443;;; Generated autoloads from tpu-extras.el 2441;;; Generated autoloads from tpu-extras.el
2444 2442
2445(autoload 'tpu-cursor-free-mode "tpu-extras" "\ 2443(autoload 'tpu-cursor-free-mode "tpu-extras" "\
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index 3d74286589c..68116cde092 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -47,6 +47,9 @@
47(defvar initial) 47(defvar initial)
48(defvar undo-beg-posn) 48(defvar undo-beg-posn)
49(defvar undo-end-posn) 49(defvar undo-end-posn)
50
51(eval-and-compile
52 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
50;; end pacifier 53;; end pacifier
51 54
52 55
@@ -2773,7 +2776,9 @@ On reaching beginning of line, stop and signal error."
2773(defun viper-next-line-carefully (arg) 2776(defun viper-next-line-carefully (arg)
2774 (condition-case nil 2777 (condition-case nil
2775 ;; do not use forward-line! need to keep column 2778 ;; do not use forward-line! need to keep column
2776 (with-no-warnings (next-line arg)) 2779 (if (featurep 'emacs)
2780 (with-no-warnings (next-line arg))
2781 (next-line arg))
2777 (error nil))) 2782 (error nil)))
2778 2783
2779 2784
@@ -3073,7 +3078,9 @@ On reaching beginning of line, stop and signal error."
3073 (com (viper-getCom arg))) 3078 (com (viper-getCom arg)))
3074 (if com (viper-move-marker-locally 'viper-com-point (point))) 3079 (if com (viper-move-marker-locally 'viper-com-point (point)))
3075 ;; do not use forward-line! need to keep column 3080 ;; do not use forward-line! need to keep column
3076 (with-no-warnings (next-line val)) 3081 (if (featurep 'emacs)
3082 (with-no-warnings (next-line val))
3083 (next-line val))
3077 (if viper-ex-style-motion 3084 (if viper-ex-style-motion
3078 (if (and (eolp) (not (bolp))) (backward-char 1))) 3085 (if (and (eolp) (not (bolp))) (backward-char 1)))
3079 (setq this-command 'next-line) 3086 (setq this-command 'next-line)
@@ -3120,7 +3127,9 @@ If point is on a widget or a button, simulate clicking on that widget/button."
3120 (com (viper-getCom arg))) 3127 (com (viper-getCom arg)))
3121 (if com (viper-move-marker-locally 'viper-com-point (point))) 3128 (if com (viper-move-marker-locally 'viper-com-point (point)))
3122 ;; do not use forward-line! need to keep column 3129 ;; do not use forward-line! need to keep column
3123 (with-no-warnings (previous-line val)) 3130 (if (featurep 'emacs)
3131 (with-no-warnings (previous-line val))
3132 (previous-line val))
3124 (if viper-ex-style-motion 3133 (if viper-ex-style-motion
3125 (if (and (eolp) (not (bolp))) (backward-char 1))) 3134 (if (and (eolp) (not (bolp))) (backward-char 1)))
3126 (setq this-command 'previous-line) 3135 (setq this-command 'previous-line)
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index 6ce34852235..8e19a0b50bd 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -2216,9 +2216,11 @@ Type 'mak ' (including the space) to run make with no args."
2216 (pos2 (viper-line-pos 'end)) 2216 (pos2 (viper-line-pos 'end))
2217 lines file info) 2217 lines file info)
2218 (setq lines (count-lines (point-min) (viper-line-pos 'end)) 2218 (setq lines (count-lines (point-min) (viper-line-pos 'end))
2219 file (if (buffer-file-name) 2219 file (cond ((buffer-file-name)
2220 (concat (viper-abbreviate-file-name (buffer-file-name)) ":") 2220 (concat (viper-abbreviate-file-name (buffer-file-name)) ":"))
2221 (concat (buffer-name) " [Not visiting any file]:")) 2221 ((buffer-file-name (buffer-base-buffer))
2222 (concat (viper-abbreviate-file-name (buffer-file-name (buffer-base-buffer))) " (indirect buffer):"))
2223 (t (concat (buffer-name) " [Not visiting any file]:")))
2222 info (format "line=%d/%d pos=%d/%d col=%d %s" 2224 info (format "line=%d/%d pos=%d/%d col=%d %s"
2223 (if (= pos1 pos2) 2225 (if (= pos1 pos2)
2224 (1+ lines) 2226 (1+ lines)
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el
index f76a9310518..05c90f995ab 100644
--- a/lisp/emulation/viper-keym.el
+++ b/lisp/emulation/viper-keym.el
@@ -33,6 +33,9 @@
33(defvar viper-expert-level) 33(defvar viper-expert-level)
34(defvar viper-ex-style-editing) 34(defvar viper-ex-style-editing)
35(defvar viper-ex-style-motion) 35(defvar viper-ex-style-motion)
36
37(eval-and-compile
38 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
36;; end pacifier 39;; end pacifier
37 40
38(require 'viper-util) 41(require 'viper-util)
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index 33061565196..b838d8ce80e 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -44,6 +44,9 @@
44 44
45(require 'ring) 45(require 'ring)
46 46
47(eval-and-compile
48 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
49
47;; end pacifier 50;; end pacifier
48 51
49(require 'viper-init) 52(require 'viper-init)
@@ -713,7 +716,7 @@
713 (not (memq (vc-state file) '(edited needs-merge))) 716 (not (memq (vc-state file) '(edited needs-merge)))
714 (not (stringp (vc-state file)))) 717 (not (stringp (vc-state file))))
715 ;; XEmacs has no vc-state 718 ;; XEmacs has no vc-state
716 (if (featurep 'xemacs)(not (vc-locking-user file)))) 719 (if (featurep 'xemacs) (not (vc-locking-user file))))
717 )) 720 ))
718 721
719;; checkout if visited file is checked in 722;; checkout if visited file is checked in
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 19d3a7f018a..9d2acac4ce7 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -9,7 +9,7 @@
9;; Author: Michael Kifer <kifer@cs.stonybrook.edu> 9;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
10;; Keywords: emulations 10;; Keywords: emulations
11 11
12(defconst viper-version "3.14 of August 18, 2007" 12(defconst viper-version "3.14 of January 09, 2008"
13 "The current version of Viper") 13 "The current version of Viper")
14 14
15;; This file is part of GNU Emacs. 15;; This file is part of GNU Emacs.
@@ -857,7 +857,9 @@ It also can't undo some Viper settings."
857 (modify-frame-parameters 857 (modify-frame-parameters
858 (selected-frame) 858 (selected-frame)
859 (list (cons 'viper-vi-state-cursor-color 859 (list (cons 'viper-vi-state-cursor-color
860 (viper-get-cursor-color)))))) 860 (viper-get-cursor-color))))
861 (setq viper-vi-state-cursor-color (viper-get-cursor-color))
862 ))
861 863
862 ;; Tell vc-diff to put *vc* in Vi mode 864 ;; Tell vc-diff to put *vc* in Vi mode
863 (if (featurep 'vc) 865 (if (featurep 'vc)
@@ -900,6 +902,7 @@ It also can't undo some Viper settings."
900 (modify-frame-parameters 902 (modify-frame-parameters
901 (selected-frame) 903 (selected-frame)
902 (list (cons 'viper-vi-state-cursor-color (ad-get-arg 0)))) 904 (list (cons 'viper-vi-state-cursor-color (ad-get-arg 0))))
905 (setq viper-vi-state-cursor-color (ad-get-arg 0))
903 ) 906 )
904 907
905 (when (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) 908 (when (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog
index b7d1d1bfe30..23057faa0b6 100644
--- a/lisp/erc/ChangeLog
+++ b/lisp/erc/ChangeLog
@@ -1,828 +1,288 @@
12008-01-04 Stefan Monnier <monnier@iro.umontreal.ca> 12008-01-26 Michael Olson <mwolson@gnu.org>
2
3 * erc-ibuffer.el (erc-channel-modes):
4 Pass mode-name through format-mode-line
5
62007-12-09 Michael Olson <mwolson@gnu.org>
7
8 * erc-services.el (erc-nickserv-alist): Fix regexps for GRnet.
9
102007-12-09 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change)
11
12 * erc-backend.el, erc.el:
13 Parse 275 (secure connection) responses.
14
15 * erc-services.el: Add identification hooks for GRnet, the Greek
16 IRC network <http://www.irc.gr>.
17
182007-12-08 David Kastrup <dak@gnu.org>
19
20 * erc-stamp.el (erc-echo-timestamp):
21 * erc-lang.el (language):
22 * erc-backend.el (erc-server-connect): Fix buggy call to `message'.
23
242007-12-07 Edward O'Connor <ted@oconnor.cx>
25
26 * erc-services.el: Provide a hook that runs when nickserv confirms
27 that the user has successfully identified.
28 (services, erc-nickserv-identify-mode): Add and remove
29 erc-nickserv-identification-autodetect from
30 erc-server-NOTICE-functions.
31 (erc-nickserv-alist): Add SUCCESS-REGEXP to each entry.
32 (erc-nickserv-alist-identified-regexp)
33 (erc-nickserv-identification-autodetect): New functions.
34 (erc-nickserv-identified-hook): New hook.
35
362007-12-06 D. Goel <deego3@gmail.com>
37
38 * erc-match.el (erc-add-entry-to-list): Fix buggy call to `error'.
39
402007-12-01 Glenn Morris <rgm@gnu.org>
41
42 * erc-backend.el (erc-server-send-ping): Move after definition of
43 erc-server-send.
44
45 * erc.el (iswitchb-temp-buflist, iswitchb-read-buffer)
46 (erc-controls-strip): Declare for compiler.
47 (erc-iswitchb): Don't require iswitchb when compiling. Test
48 iswitchb-mode is bound.
49
502007-11-30 Dan Nicolaescu <dann@ics.uci.edu>
51
52 * erc.el (open-ssl-stream, open-tls-stream, erc-network-name):
53 Declare as functions.
54
552007-11-29 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change)
56
57 * erc-backend.el, erc.el:
58 Parse 307 (nick has identified) responses.
59
602007-11-15 Juanma Barranquero <lekktu@gmail.com>
61
62 * erc.el (erc-open):
63 * erc-backend.el (define-erc-response-handler):
64 * erc-log.el (log):
65 * erc-match.el (erc-log-matches): Fix typos in docstrings.
66
672007-11-11 Michael Olson <mwolson@gnu.org>
68
69 * erc-autoaway.el (erc-autoaway-possibly-set-away):
70 * erc-netsplit.el (erc-netsplit-timer):
71 * erc-notify.el (erc-notify-timer):
72 * erc-track.el (erc-user-is-active): Only run if we have
73 successfully established a connection to the server and have
74 logged in. I suspect that sending messages too soon may make some
75 IRC servers not respond well, particularly when the network
76 connection is iffy or subject to traffic-shaping.
77
782007-11-01 Michael Olson <mwolson@gnu.org>
79
80 * erc-compat.el (erc-set-write-file-functions): New compatibility
81 function to set the write hooks appropriately.
82
83 * erc-log.el (erc-log-setup-logging): Use
84 erc-set-write-file-functions. This fixes a byte-compiler warning.
85
86 * erc-stamp.el: Silence byte-compiler warning about
87 erc-fill-column.
88
89 * erc.el (erc-with-all-buffers-of-server): Bind the result of
90 mapcar to a variable in order to silence a byte-compiler warning.
91
922007-10-29 Michael Olson <mwolson@gnu.org>
93
94 * erc-ibuffer.el (erc-modified-channels-alist): Use
95 eval-when-compile, and explain why we are doing this.
96
972007-10-25 Dan Nicolaescu <dann@ics.uci.edu>
98
99 * erc-ibuffer.el (erc-modified-channels-alist): Pacify
100 byte-compiler.
101
1022007-10-13 Glenn Morris <rgm@gnu.org>
103
104 * erc-track.el (erc-modified-channels-update): Use mapc rather
105 than mapcar.
106
1072007-10-12 Diane Murray <disumu@x3y2z1.net>
108
109 * erc.el (erc-join-channel): Prompt for channel key if C-u or
110 another prefix-arg was typed.
111
112 * NEWS: Noted this change.
113
1142007-10-07 Michael Olson <mwolson@gnu.org>
115
116 * erc.el (erc-cmd-ME'S): New command that handles the case where
117 someone types "/me's". It concatenates the text " 's" to the
118 beginning of the input and then sends the result like a normal
119 "/me" command.
120 (erc-command-regexp): Permit single-quote character.
121
1222007-09-30 Aidan Kehoe <kehoea@parhasard.net> (tiny change)
123
124 * erc-log.el (erc-save-buffer-in-logs): Prevent spurious warnings
125 when looking at a log file and concurrently saving to it.
126
1272007-09-18 Exal de Jesus Garcia Carrillo <exal@gnu.org> (tiny change)
128
129 * erc.texi (Special-Features): Fix small typo.
130
1312007-09-16 Michael Olson <mwolson@gnu.org>
132
133 * erc-track.el (erc-track-switch-direction): Mention
134 erc-track-faces-priority-list. Thanks to Leo for the suggestion.
135
1362007-09-11 Exal de Jesus Garcia Carrillo <exal@gnu.org> (tiny change)
137
138 * erc-sound.el: Fix typo in setting up instructions.
139
1402007-09-10 Michael Olson <mwolson@gnu.org>
141
142 * Makefile (elpa): Copy dir template rather than echoing a few
143 lines. The reason for this is that the ELPA package for ERC was
144 getting a corrupt dir entry.
145
146 * dir-template: Template for the ELPA dir file.
147
1482007-09-08 Michael Olson <mwolson@gnu.org>
149
150 * erc-log.el (erc-log-filter-function): New option that specifies
151 the function to call for filtering text before writing it to a log
152 file. Thanks to David O'Toole for the suggestion.
153 (erc-save-buffer-in-logs): Use erc-log-filter-function. Make sure
154 we carry along the value of coding-system-for-write, because this
155 could potentially be shadowed by the temporary buffer.
156
157 * erc.el (erc-version-string): Update to 5.3, development version.
158
1592007-09-07 Glenn Morris <rgm@gnu.org>
160
161 * erc.el (erc-toggle-debug-irc-protocol): Fix call to
162 erc-view-mode-enter.
163
1642007-08-08 Glenn Morris <rgm@gnu.org>
165
166 * erc-log.el, erc.el: Replace `iff' in doc-strings and comments.
167
1682007-09-03 Michael Olson <mwolson@gnu.org>
169
170 * erc.el (erc-default-port): Make this an integer value rather
171 than a string. Thanks to Luca Capello for the report.
172
1732007-08-27 Michael Olson <mwolson@gnu.org>
174
175 * erc.el (erc-cmd-GQUIT): If erc-kill-queries-on-quit is non-nil,
176 kill all query buffers after 4 seconds.
177
1782007-08-16 Michael Olson <mwolson@gnu.org>
179
180 * NEWS: Add ERC 5.3 changes section, and mention jbms' erc-track
181 compatibility note.
182
183 * erc-track.el (erc-track-list-changed-hook): Turn this into a
184 customizable option.
185 (erc-track-switch-direction): Add 'importance option.
186 (erc-modified-channels-display): If erc-track-switch-direction is
187 'importance, call erc-track-sort-by-importance.
188 (erc-track-face-priority): New function that returns a number
189 indicating the position of a face in erc-track-faces-priority-list.
190 (erc-track-sort-by-importance): New function that sorts
191 erc-modified-channels-list according to erc-track-face-priority.
192 (erc-track-get-active-buffer): Make 'oldest a rough opposite of
193 'importance.
194
1952007-08-14 Jeremy Maitin-Shepard <jbms@cmu.edu>
196
197 * erc-track.el (erc-track-remove-disconnected-buffers): New
198 variable which controls whether buffers associated with a server
199 that is disconnected should be removed from
200 `erc-modified-channels-alist'. Existing behavior is to
201 unconditionally remove such buffers, which is achieved by setting
202 `erc-track-removed-disconnected-buffers' to t. When set to t,
203 which is the new default value, such buffers remain in the list,
204 which I think is often the desired behavior, since the user may
205 likely wish to find out about activity that occurred in a channel
206 prior to it being disconnected.
207 (erc-track-list-changed-hook): New hook that is run whenever the
208 contents of `erc-modified-channels-alist' changes; it is useful
209 for users such as myself that don't use the default mode-line
210 notification but instead use a separate mechanism (which is tied
211 to my window manager) to provide notification of channel activity.
212 (erc-track-get-buffer-window): New function that acts as a wrapper
213 around `get-buffer-window' that handles the `selected-visible'
214 option of `erc-track-visibility'; previously, the value of
215 `erc-track-visibility' was passed directly to `get-buffer-window',
216 which does not support `selected-visible'; consequently,
217 `selected-visible' was not properly supported.
218 (erc-track-modified-channels): Fix a bug in the logic for removing
219 buffers from the list in certain cases.
220 (erc-track-position-in-mode-line): Add a supported value that
221 specifies that the tracking information should not be added to the
222 mode line at all. The value of nil is used to indicate that the
223 information should not be added at all to the mode line.
224 (erc-track-add-to-mode-line): Check for position eq to t, rather
225 than non-nil.
226 (erc-buffer-visible): Use erc-track-get-buffer-window.
227 (erc-modified-channels-update): Take
228 erc-track-remove-disconnected-buffers into account.
229 (erc-modified-channels-display): Run `erc-track-list-changed-hook'.
230
231 * erc.el (erc-reuse-frames): New option that determines whether
232 new frames are always created. Defaults to t. This only has an
233 effect when erc-join-buffer is set to 'frame.
234 (erc-setup-buffer): Use it.
235
2362007-08-14 Michael Olson <mwolson@gnu.org>
237
238 * erc-backend.el (erc-server-reconnect): If the server buffer has
239 been killed, use the current buffer instead. If the current
240 buffer is not an ERC buffer, give an error. This fixes a bug when
241 /reconnect is run from a channel buffer whose server buffer has
242 been deleted. Thanks to jbms for the report.
243 (erc-process-sentinel-1): Take server buffer as an argument, so
244 that we can make sure that it is current.
245 (erc-process-sentinel): Pass buffer to erc-process-sentinel-1.
246 (erc-process-sentinel-2): New function split from
247 erc-process-sentinel-1. If server buffer is deleted during a
248 reconnect attempt, stop trying to reconnect. Fix bug where
249 reconnect was not happening when erc-server-reconnect-attempts was
250 t. Call erc-server-reconnect-p only once each time. If we are
251 instructed to try connecting indefinitely, tell the user that they
252 can stop this by killing the server buffer. Call the process
253 sentinel by means of run-at-time, so that there is time to kill
254 the buffer if need be; this also removes the need for a while
255 loop. Refuse to reconnect again if erc-server-reconnect-timeout
256 is not an number.
257
258 * erc.el (erc-command-no-process-p): Fix bug: the return value of
259 erc-extract-command-from-line is a list rather than a single
260 symbol. Thanks to jbms for the report.
261 (erc-cmd-RECONNECT): Use simpler logic, and use buffer-live-p
262 rather than bufferp.
263 (erc-send-current-line, erc-display-command, erc-display-msg):
264 Handle case where erc-server-process is nil, so that /reconnect
265 works.
266
2672007-08-12 Michael Olson <mwolson@gnu.org>
268
269 * erc-identd.el (erc-identd-filter): Instead of sending an EOF
270 character, which now confuses freenode, stop the server process,
271 so that no new connections are accepted, and kill the current
272 client process.
273
2742007-07-30 Michael Olson <mwolson@gnu.org>
275
276 * erc-nicklist.el: Remove from the Emacs source tree. This file
277 is not release quality, and relies heavily on a module which
278 cannot be distributed with ERC due to licensing reasons.
279
2802007-07-29 Michael Olson <mwolson@gnu.org>
281
282 * erc-list.el: Relicense to GPLv3. Since the file was already
283 licensed under version 2 or later, it turns out that we do not
284 need the permission of all of the authors in order to proceed.
285
2862007-07-25 Glenn Morris <rgm@gnu.org>
287
288 * Relicense all FSF files to GPLv3 or later.
289
2902007-07-13 Michael Olson <mwolson@gnu.org>
291
292 * erc-goodies.el (erc-get-bg-color-face, erc-get-fg-color-face):
293 Use erc-error rather than message and beep.
294
295 * erc-sound.el: Indentation fix.
296
297 * erc.el (erc-command-no-process-p): New function that determines
298 if its argument is an ERC command that can be run when the server
299 process is not alive.
300 (erc-cmd-SET, erc-cmd-CLEAR, erc-cmd-COUNTRY, erc-cmd-HELP)
301 (erc-cmd-LASTLOG, erc-cmd-QUIT, erc-cmd-GQUIT)
302 (erc-cmd-RECONNECT, erc-cmd-SERVER): Denote that these commands
303 can be run even when the server process is not alive.
304 (erc-send-current-line): Call erc-command-no-process-p if the
305 server process is not alive, to determine if we have a command
306 that can be run anyway. Thanks to Tom Tromey for the bug report.
307 (erc-error): New function that either displays a message or throws
308 an error, depending on whether debug-on-error is non-nil.
309 (erc-cmd-SERVER, erc-send-current-line): Use it.
310
3112007-07-10 Michael Olson <mwolson@gnu.org>
312
313 * Relicense all FSF-assigned code to GPLv3.
314
3152007-06-25 Michael Olson <mwolson@gnu.org>
316
317 * erc.texi (Options): Fix typo.
318 (Getting Help and Reporting Bugs): Update webpage URL. Make Gmane
319 part more readable.
320
3212007-06-20 Michael Olson <mwolson@gnu.org>
322
323 * erc-stamp.el (erc-timestamp-format-left): New option that
324 specifies the left timestamp to use for
325 erc-insert-timestamp-left-and-right.
326 (erc-timestamp-format-right): New option that specifies the right
327 timestamp to use for erc-insert-timestamp-left-and-right.
328 (erc-insert-timestamp-function): Change default to
329 erc-insert-timestamp-left-and-right.
330 (erc-insert-away-timestamp-function): Ditto.
331 (erc-timestamp-last-inserted-left)
332 (erc-timestamp-last-inserted-right): New variables to keep track
333 of data for erc-insert-timestamp-left-and-right.
334 (erc-insert-timestamp-left-and-right): New function that places
335 timestamps on both the left and right sides of the screen, but
336 only if each timestamp has changed since it was last computed.
337 Thanks to offby1 for urging me to merge this.
338
339 * erc.el (erc-open-ssl-stream): Display informative error when
340 ssl.el not found.
341 (erc-tls): New function to connect using tls.el.
342 (erc-open-tls-stream): New function to initiate tls connection.
343 Display informative error when tls.el not found.
344
3452007-06-19 Michael Olson <mwolson@gnu.org>
346 2
347 * erc-log.el: Update header with accurate instructions. 3 * erc.el (erc-version-string): Release ERC 5.3.
348 4
3492007-06-17 Michael Olson <mwolson@gnu.org> 5 * Makefile (VERSION): Update.
6 (EXTRAS): Remove erc-list.el after all, because this is mainly for
7 users of the version that comes with Emacs, and they will have
8 erc-list.el by Emacs 23.
9 (MISC): Add ChangeLog.07.
350 10
351 * erc-pkg.el: Update description to match what is currently in ELPA. 11 * README.extras: Mention Emacs 23.
352 12
3532007-06-14 Juanma Barranquero <lekktu@gmail.com> 13 * erc.texi (Obtaining ERC): Update extras URLs for 5.3.
14 (Development): Write instructions for git, and remove those for
15 Arch.
16 (History): Mention the switch to git.
354 17
355 * erc-goodies.el (erc-scroll-to-bottom): Remove redundant check. 182008-01-25 Michael Olson <mwolson@gnu.org>
356 19
3572007-06-13 Michael Olson <mwolson@gnu.org> 20 * NEWS: Update.
358 21
359 * erc-compat.el (erc-with-selected-window): New compatibility 22 * erc-goodies.el (keep-place): New module which keeps your place
360 macro that implements `with-selected-window'. 23 in unvisited ERC buffers when new messages arrive. This is mostly
24 taken from Johan Bockgård's init file.
25 (erc-noncommands-list): Move to correct place.
26
27 * erc-networks.el: Add a module definition.
28
29 * erc-services.el (erc-nickserv-identify-mode): Force-enable the
30 networks module, because we need it to set erc-network for us.
31
32 * erc-track.el (erc-track-faces-normal-list): Indicate in the
33 docstring that this variable can be set to nil.
34
35 * erc.el: On second thought, don't load erc-networks. Just enable
36 the networks module by default.
37 (erc-modules): Add option for keep-place and networks. Enable
38 networks by default.
39 (erc-version-string): Make release candidate 1 available.
40
412008-01-24 Michael Olson <mwolson@gnu.org>
42
43 * erc.el: Load erc-networks.el so that functions get access to the
44 `erc-network-name' function.
45
46 * erc-track.el (erc-track-faces-normal-list): Add
47 erc-dangerous-host-face.
48 (erc-track-exclude-types): Add 333 and 353 to the default list of
49 things to ignore, and explain what they are in the docstring.
50
512008-01-23 Michael Olson <mwolson@gnu.org>
52
53 * erc-track.el (erc-track-faces-priority-list): Move
54 erc-nick-default-face higher, so that it can be used for the
55 activity indication effect. Add erc-current-nick-face,
56 erc-pal-face, erc-dangerous-host-face, and erc-fool-face by
57 themselves.
58 (erc-track-faces-normal-list): New option that contains a list of
59 faces to consider "normal".
60 (erc-track-position-in-mode-line): Minor docfix.
61 (erc-track-find-face): Use erc-track-faces-normal-list to produce
62 a sort of blinking activity effect.
63
642008-01-22 Michael Olson <mwolson@gnu.org>
65
66 * erc-button.el (erc-button-add-nickname-buttons): When in a
67 channel buffer, only look at nicks from the current channel.
68 Thanks to e1f for the report.
69
702008-01-21 Michael Olson <mwolson@gnu.org>
71
72 * erc-compat.el (erc-const-expr-p, erc-list*, erc-assert): Remove,
73 since we can use the default `assert' function without it causing
74 us any problems, even in Emacs 21. Thanks to bojohan for the
75 suggestion.
76
77 * erc-goodies.el (move-to-prompt): Use the "XEmacs" method
78 instead, because the [remap ...] method interferes with
79 delete-selection-mode.
80 (erc-move-to-prompt): Rename from erc-move-to-prompt-xemacs.
81 Deactivate mark and call push-mark before moving point. Thanks to
82 bojohan for the suggestion.
83 (erc-move-to-prompt-setup): Rename from
84 erc-move-to-prompt-init-xemacs.
85
86 * erc-track.el (erc-track-faces-priority-list): Replace erc-button
87 with '(erc-button erc-default-face) so that we only care about
88 buttons that are part of normal text. Adjust customization type
89 to handle this case. Make erc-nick-default-face a list. Handle
90 pals, fools, current nick, and dangerous hosts.
91 (erc-track-find-face): Simplify. Adapt for list of faces case.
92 (erc-faces-in): Don't deflate lists of faces. Add them as-is.
93 (erc-track-face-priority): Use equal instead of eq.
94
952008-01-20 Michael Olson <mwolson@gnu.org>
96
97 * erc-goodies.el (erc-move-to-prompt, erc-move-to-prompt-xemacs):
98 Fix off-by-one error that caused the point to move when placed at
99 the beginning of some already-typed text. Thanks to e1f for the
100 report.
101
102 * erc-dcc.el, erc-xdcc.el: Add simple module definitions.
103
104 * erc.el (erc-modules): Add dcc and xdcc.
105
1062008-01-19 Michael Olson <mwolson@gnu.org>
107
108 * erc-bbdb.el (erc-bbdb-insinuate-and-show-entry): Work around bug
109 in XEmacs 21.4 that throws an error when the first argument to
110 run-at-time is nil.
111
112 * erc-button.el (button): Undo XEmacs-specific change to all ERC
113 buffers when module is removed.
114 (erc-button-setup): Rename from erc-button-add-keys, and move
115 XEmacs-specific stuff here.
116
117 * erc-goodies.el (erc-unmorse): Improve regexp for detecting
118 morse. Deal with the morse style that has "/ " at the end of
119 every letter.
120 (erc-imenu-setup): New function that sets up Imenu support. Add
121 it instead of a lambda form to erc-mode-hook.
122 (scrolltobottom): Remove erc-scroll-to-bottom from all ERC buffers
123 when module is removed. Activate the functionality in all ERC
124 buffers when the module is activated, rather than leaving it up to
125 the user.
126 (move-to-prompt): New module that moves to the ERC prompt if a
127 user tries to type elsewhere in the buffer, and then inserts their
128 keystrokes there. This is mostly taken from Johan Bockgård's init
129 file.
130 (erc-move-to-prompt): New function that implements this.
131 (erc-move-to-prompt-xemacs): New function that implements this for
132 XEmacs.
133 (erc-move-to-prompt-init-xemacs): New function to perform the
134 extra initialization step needed for XEmacs.
135
136 * erc-page.el, erc-replace.el: Fix header and footer.
137
138 * erc-track.el (erc-track-minor-mode-maybe): Take an optional
139 buffer arg so that we can put this in erc-connect-pre-hook. If
140 given this argument, include it in the check to determine whether
141 to activate erc-track-minor-mode.
142 (track): Add erc-track-minor-mode-maybe to erc-connect-pre-hook,
143 so that we can use it as soon as a connection is attempted.
144
145 * erc.el (erc-format-network, erc-format-target-and/or-network):
146 Use erc-network-name function instead, and check to see whether
147 that function is bound. This fixes an error in process filter for
148 people who did not have erc-services or erc-networks loaded.
149 (erc-modules): Add move-to-prompt module and enable it by
150 default. Thanks to e1f for the suggestion.
151
1522008-01-18 Michael Olson <mwolson@gnu.org>
153
154 * Makefile (EXTRAS): Include erc-list-old.el.
155
156 * erc-dcc.el (erc-dcc-verbose): Rename from erc-verbose-dcc.
157 (erc-pack-int): Rewrite to not depend on a count argument.
158 (erc-unpack-int): Rewrite to remove 4-character limitation.
159 (erc-dcc-server): Call set-process-coding-system and
160 set-process-filter-multibyte so that the contents get sent out
161 without modification.
162 (erc-dcc-send-filter): Don't take a substring -- just pass the
163 whole string to erc-unpack-int.
164 (erc-dcc-receive-cache): New option that indicates the number of
165 bytes to let the receive buffer grow before flushing it.
166 (erc-dcc-file-name): New buffer-local variable to keep track of
167 the filename of the currently-received file.
168 (erc-dcc-get-file): Disable undo for a speed increase. Set
169 erc-dcc-file-name. Truncate the file before writing to it.
170 (erc-dcc-append-contents): New function to append the contents of
171 a buffer to a file and then erase the contents of the buffer.
172 (erc-dcc-get-filter): Flush buffer contents after exceeding
173 erc-dcc-receive-cache. This allows large files to be downloaded
174 without storing the whole thing in memory.
175 (erc-dcc-get-sentinel): Flush any remaining contents before
176 closing. No need to save buffer.
177 (erc-dcc-listen-host): New option that determines which IP address
178 to listen on.
179 (erc-dcc-public-host): New option that determines which IP address
180 to advertise when sending a file. This is useful for people who
181 are on a local subnet. Together, these two options replace
182 erc-dcc-host.
183
184 * erc.el (erc-mode-line-format): Add %N and %S. %N is the name of
185 the network, and %S is much like %s but with the network name
186 trumping the server name. Default to "%S %a". Thanks to e1f for
187 the suggestion.
188 (erc-format-network): New function that formats the network name.
189 (erc-format-target-and/or-network): New function that formats both
190 the network name and target, falling back on the server name if
191 the network name is not available.
192 (erc-update-mode-line-buffer): Add the new format spec items.
193
1942008-01-17 Michael Olson <mwolson@gnu.org>
195
196 * erc.el (erc-join-buffer): Improve documentation.
197 (erc-query-display): New option indicating how to display a query
198 buffer that is made by using the /QUERY command. The default is
199 to display the query in a new window.
200 (erc-cmd-QUERY): Use it. Improve docstring.
201 (erc-auto-query): Default this to 'window-noselect instead,
202 because I've already seen bug reports about new users thinking
203 that ERC didn't display their test messages. Improve
204 customization type.
205 (erc-notice-face): Make this work with XEmacs.
206 (erc-join-buffer): Mention 'buffer in docstring. Improve
207 customization type.
208
209 * erc-dcc.el (erc-dcc-send-sentinel): Better handle case where elt
210 is nil, in order to avoid an error. Thanks to Brent Goodrick for
211 the initial patch.
212 (erc-dcc-display-send): New function split from erc-dcc-send-hook.
213 (erc-dcc-send-connect-hook): Use it -- we don't like lambda forms
214 in hooks.
215 (erc-dcc-send-filter): Display byte count if the client confirmed
216 too much, and kill the buffer. Otherwise a DoS might be possible
217 by making Emacs run out of RAM.
218
219 * erc-backend.el (erc-server-connect): Detect early on whether the
220 connection attempt has failed in order to avoid confusing error
221 messages.
222
223 * erc-networks.el (erc-server-alist): Add Rizon network.
224
225 * erc-services.el (erc-nickserv-passwords): Add Rizon to options.
226 (erc-nickserv-alist): Add support for Rizon.
227
228 * erc-track.el (erc-track-find-face): Don't let buttons in notices
229 trump default text. Use catch/throw. Default to first element of
230 FACES is nothing is found.
231
232 * erc-xdcc.el: Add local variables for proper indentation setup.
233
2342008-01-15 Michael Olson <mwolson@gnu.org>
235
236 * erc-backend.el (erc-server-coding-system): Docfix.
237 (erc-coding-system-for-target): Pass the `target' argument along
238 as the first and only argument. It's not good to just depend on a
239 dynamic binding.
240
2412008-01-10 Michael Olson <mwolson@gnu.org>
242
243 * erc-backend.el (321, 322): Split message-displaying parts into
244 new functions, which are added to each response's respective
245 hook. This makes them easier to disable.
246
247 * erc-list.el: New file from Tom Tromey. Use erc-propertize
248 instead of propertize. Require 'erc.
249 (list): New module definition. Remove message-displaying
250 functions for 321 and 322 response handlers when enabling the
251 module, and restore them when disabling. As a sanity check,
252 remove the erc-list-handle-322 function when disabling the module.
253 (erc-list-handle-322): Handle the case where we run the LIST
254 command, but do not go through the normal steps.
255 (erc-cmd-LIST): Add docstring. Strip initial space from line if
256 it is non-nil. Use make-local-variable to silence compiler
257 warning. Capture current buffer and pass it to
258 erc-list-install-322-handler.
259 (erc-list-install-322-handler): Take server-buffer argument, so
260 that we are certain of being in the right buffer. Use 4th
261 argument to add-hook, so that erc-server-322-functions is only
262 modified in one buffer.
263
264 * erc-list-old.el: Renamed from old erc-list.el.
265
266 * erc.el (erc-modules): Add list-old.
267 (erc-set-topic): Handle case where there are no newlines in the
268 existing topic, which happens when /LIST is run.
269 (erc-notice-face): If we have less than 88 colors, make this
270 blue. Otherwise the text will be pink in a tty, which looks
271 dreadful. Thanks to e1f for the report.
272 (erc-remove-parsed-property): New option that determines whether
273 to remove the erc-parsed property after displaying a message.
274 This should have the effect of making ERC take up less memory.
275 (erc-display-line-1): Use it.
361 276
362 * erc-goodies.el (erc-scroll-to-bottom): Use it. This fixes a bug 2772008-01-04 Stefan Monnier <monnier@iro.umontreal.ca>
363 with buffer ordering where ERC buffers would move to the top.
364 Thanks to Ivan Kanis for the patch.
365
3662007-06-10 Michael Olson <mwolson@gnu.org>
367
368 * erc-log.el (erc-logging-enabled): Fix a bug that occurred when
369 `erc-log-channels-directory' had the name of a function.
370
3712007-06-06 Juanma Barranquero <lekktu@gmail.com>
372
373 * erc.el (erc-show-channel-key-p, erc-startup-file-list):
374 Fix typo in docstring.
375
3762007-06-03 Michael Olson <mwolson@gnu.org>
377
378 * erc-compat.el (erc-view-mode-enter): Make this its own function,
379 in order to document what we do, and provide sane fallback
380 behavior.
381
382 * erc.el (erc-toggle-debug-irc-protocol): Don't pass any arguments
383 to erc-view-mode-enter, since we don't do anything special with
384 the exit function. This fixes a bug with Emacs 21 and Emacs 22.
385 Thanks to Leo for noticing.
386
3872007-05-30 Michael Olson <mwolson@gnu.org>
388
389 * erc-compat.el (erc-user-emacs-directory): New variable that
390 determines where to find user-specific Emacs settings. For Emacs,
391 this is usually ~/.emacs.d, and for XEmacs this is usually
392 ~/.xemacs.
393
394 * erc.el (erc-startup-file-list): Use erc-user-emacs-directory.
395
3962007-05-28 Michael Olson <mwolson@gnu.org>
397
398 * erc-button.el (erc-button-url-regexp): Recognize parentheses as
399 part of URLs. Thanks to Lawrence Mitchell for the fix.
400
4012007-05-26 Michael Olson <mwolson@gnu.org>
402
403 * erc.texi (Modules): Fix references to completion modules.
404
4052007-05-21 Michael Olson <mwolson@gnu.org>
406
407 * Makefile (SOURCE): Remove erc-pkg.el.
408 (debclean): New rule to clean old Debian packages of ERC.
409 (debprepare): Don't modify the released tarball, but copy it as
410 the .orig.tar.gz file.
411 (debrelease, debrevision): Remove.
412 (debinstall): New target that copies the generated Debian file to
413 a distro-specific location.
414 (deb): New rule that chains together the stages in building a
415 Debian package.
416 (EXTRAS): Add erc-nicklist.el, since it is not release-quality.
417 (extras): Copy images directory.
418
419 * erc-nicklist.el (erc-nicklist-icons-directory): Use
420 locate-library to find the "images" directory. This should be
421 more failsafe. Thanks to Tom Tromey for the idea.
422
4232007-05-19 Michael Olson <mwolson@gnu.org>
424
425 * Makefile (ELPA): New variable that contains the location of my
426 local ELPA repository.
427 (elpa): New rule that makes an ELPA package for ERC.
428
4292007-04-19 Michael Olson <mwolson@gnu.org>
430
431 * erc.el (erc-parse-prefix): New function that retrieves the
432 PREFIX server parameter from the current server and returns an
433 alist of prefix type to prefix character.
434 (erc-channel-receive-names): Use `erc-parse-prefix' to determine
435 whether the first character of a nick is a prefix character or
436 not. This should fix a bug reported by bromine about needing to
437 type "%" first to complete nicks of people who are "hops" on
438 Slashnet. This should also support for very exotic IRC server
439 setups, if any exist.
440 (erc-update-current-channel-member): Indentation.
441
4422007-04-15 Michael Olson <mwolson@gnu.org>
443
444 * erc-log.el (erc-generate-log-file-name-function): Docfix.
445 Mention how to deal with the case for putting log files in
446 different directories. Change a customization type from `symbol'
447 to `function'.
448 (erc-log-channels-directory): Allow this to contain a function
449 name, which is called with the same args as in
450 `erc-generate-log-file-name-function'. Thanks to andrewy for the
451 report and use case.
452 (erc-current-logfile): Detect if `erc-log-channels-directory' is a
453 function and call it with arguments if so.
454
4552007-04-12 Michael Olson <mwolson@gnu.org>
456
457 * erc-backend.el (define-erc-response-handler): Mention that hook
458 processing stops when the function returns non-nil. This should
459 help avoid a nasty "gotcha" when making custom functions. Thanks
460 to John Sullivan for the report.
461
4622007-04-08 Diane Murray <disumu@x3y2z1.net>
463
464 * erc-nicklist.el (erc-nicklist-voiced-position): Fixed
465 customization mismatch.
466
4672007-04-01 Michael Olson <mwolson@gnu.org>
468
469 * erc.el (erc-version-string): Release ERC 5.2.
470
471 * erc-auto.in, erc-chess.el, erc-list.el, erc-speak.el:
472 * erc-viper.el: Update copyright notices.
473
474 * erc.texi: Make Emacs Lisp source code in this document
475 essentially public domain. Update version to 5.2.
476 (Obtaining ERC): Mention extras tarball.
477 (Releases): Mention local GNU mirror.
478 (Sample Configuration): Remove notice.
479
480 * FOR-RELEASE (5.3): Add item for erc-nicklist.
481 Mark NEWS as done. Mark extras tarball as done.
482
483 * Makefile (VERSION): Increment to 5.2.
484 (TESTING): Remove.
485 (EXTRAS): New variable containing the contents of our "Emacs 22
486 extras" tarball.
487 (SOURCE): Remove $(TESTING).
488 (MISC): Add COPYING and ChangeLog.06. Fix ChangeLog.NNNN ->
489 ChangeLog.NN.
490 (release): Use $(SNAPDIR) instead of erc-$(VERSION).
491 (extras): New rule which implements the building of the extras
492 tarball.
493 (upload-extras): New rule to upload the extras tarball. It's
494 yucky to replicate upload, but oh well.
495 (DISTRIBUTOR): New variable used to differentiate between building
496 packages for Ubuntu and Debian.
497 (debrelease, debrevision): Use it.
498 (debbuild): Run linda in addition to lintian.
499
500 * NEWS: Mention extras tarball. Note which files have been
501 renamed. Note that erc-list is enabled by default, except in
502 Emacs 22.
503
504 * README.extras: New file which serves as a README for the extras
505 tarball.
506
5072007-03-31 Michael Olson <mwolson@gnu.org>
508
509 * NEWS: Update for the 5.2 release.
510
511 * FOR-RELEASE: Finish up 5.2 manual item. Add documentation item
512 for 5.3.
513
514 * erc.texi (Sample Session): Flesh out. Mention #erc.
515 (Modules): Defer to 5.3 release.
516 (Advanced Usage): Move Sample Configuration chapter ahead of
517 unfinished chapters.
518 (Sample Configuration): Write.
519 (Options): Mention how to see available ERC options. Defer to 5.3
520 release.
521 (Tips and Tricks): Remove, since it seems better to just include
522 tips and tricks in the sample configuration, commented out.
523
524 * erc-bbdb.el (erc-bbdb-search-name-and-create): Make prompt more
525 informative about how to skip merging.
526 (erc-bbdb-insinuate-and-show-entry-1): Move contents of
527 erc-bbdb-insinuate-and-show-entry here.
528 (erc-bbdb-insinuate-and-show-entry): Run
529 erc-bbdb-insinuate-and-show-entry-1 "outside" of the calling
530 function, so that we can avoid triggering a process-filter error
531 if the user hits C-g.
532
5332007-03-30 Michael Olson <mwolson@gnu.org>
534
535 * FOR-RELEASE: Solve C-c C-SPC keybinding dilemma.
536
537 * erc-autoaway.el (erc-autoaway-idle-method): Use `if' rather than
538 `cond' and `set' rather than `set-default'.
539
540 * erc-log.el: Avoid compiler warning by requiring erc-network
541 during compilation.
542 (erc-generate-log-file-name-function): Add tag to each option.
543 Add erc-generate-log-file-name-network.
544 (erc-generate-log-file-name-network): New function which generates
545 a log file name that uses network name rather than server name,
546 when possible.
547
548 * erc-track.el (track): Assimilate track-when-inactive module,
549 since there's no need to have two modules in one file -- an option
550 will do. Remove track-modified-channels alias. Call
551 erc-track-minor-mode-maybe, and tear down the minor mode when
552 disabling.
553 (erc-track-when-inactive): New option which determines whether to
554 track visible buffers when inactive. The default is not to do so.
555 (erc-track-visibility): Mention erc-track-when-inactive.
556 (erc-buffer-visible): Use erc-track-when-inactive.
557 (erc-track-enable-keybindings): New option which determines
558 whether to enable the global-level tracking keybindings. The
559 default is to do so, unless they would override another binding,
560 in which case we prompt the user about it.
561 (erc-track-minor-mode-map): Move global keybindings here.
562 (erc-track-minor-mode): New minor mode which only enables the
563 keybindings and does nothing else.
564 (erc-track-minor-mode-maybe): New function which starts
565 erc-track-minor-mode, but only if it hasn't already been started,
566 an ERC buffer exists, and the user OK's it, depending on the value
567 of `erc-track-enable-keybindings'.
568 (erc-track-switch-buffer): Display a message if someone calls this
569 without first enabling erc-track-mode.
570
5712007-03-17 Michael Olson <mwolson@gnu.org>
572
573 * erc.texi (Development): Mention ErcDevelopment page on
574 emacswiki.
575 (Getting Started): Mention ~/.emacs.d/.ercrc.el and the Customize
576 interface.
577 (Sample Session): New section that has a very rough draft for a
578 sample ERC session.
579 (Special Features): New section that explains some of the special
580 features of ERC. Taken from ErcFeatures on emacswiki, with
581 enhancements.
582
5832007-03-12 Diane Murray <disumu@x3y2z1.net>
584
585 * erc-autoaway.el (erc-autoaway-idle-method): When setting the new
586 value, disable and re-enable `erc-autoaway-mode' only if it was
587 already enabled. This fixes a bug where autoaway was enabled just
588 by loading the file.
589
5902007-03-10 Diane Murray <disumu@x3y2z1.net>
591
592 * erc-capab.el: Added more information to the Usage section.
593 (erc-capab-identify-prefix): Doc fix.
594 (erc-capab-identify-unidentified): New face.
595 (290): Removed. Definition moved to erc-backend.el.
596 (erc-capab-identify-send-messages): Renamed from
597 `erc-capab-send-identify-messages'.
598 (erc-capab-identify-setup): Use it.
599 (erc-capab-identify-get-unidentified-nickname): Renamed from
600 `erc-capab-get-unidentified-nickname'.
601 (erc-capab-identify-add-prefix): Use it. Use
602 `erc-capab-identify-unidentified' as the face.
603
604 * erc-backend.el (290): Moved here from erc-capab.el.
605
606 * erc.el (erc-select): Added an autoload cookie.
607 (erc-message-type-member, erc-restore-text-properties): Use
608 `erc-get-parsed-vector'.
609 (erc-auto-query): Set the default to 'bury since many new users
610 expect private messages from others to be in dedicated query
611 buffers, not the server buffer.
612 (erc-common-server-suffixes): Use "freenode" for freenode.net, not
613 "OPN". Added oftc.net.
614
615 * NEWS: Added note about erc-auto-query's new default setting.
616
6172007-03-03 Michael Olson <mwolson@gnu.org>
618
619 * erc.el (erc-open, erc): Docfixes.
620
6212007-03-02 Michael Olson <mwolson@gnu.org>
622
623 * FOR-RELEASE: Make section for 5.3 release and move erc-backend
624 cleanup there. Awaiting discussion before doing other things.
625 Add tasks for merging filename changes from the 5.2 release
626 branch, and for making a tarball of modules not in Emacs 22. Add
627 item to remind me to update NEWS. Mark backtab entry as done.
628
629 * erc-button.el (button): Add call to `erc-button-add-keys'.
630 (erc-button-keys-added): New variable tracking whether we've added
631 the keys yet.
632 (erc-button-add-keys): New function that adds the <backtab> key to
633 erc-mode-map.
634
635 * erc.texi: Change version to 5.2 (pre-release).
636
6372007-02-15 Michael Olson <mwolson@gnu.org>
638
639 * CREDITS: Update.
640
641 * erc-backend.el (erc-server-send-ping-interval): Change to use a
642 default of 30 seconds. Improve customize interface.
643 (erc-server-send-ping-timeout): New option that determines when to
644 consider a connection stalled and restart it. The default is
645 after 120 seconds.
646 (erc-server-send-ping): Use erc-server-send-ping-timeout instead
647 of erc-server-send-ping-interval. If
648 erc-server-send-ping-timeout is nil, do not ever kill and restart
649 a hung IRC process.
650
651 * erc.el (erc-modules): Include the name of the module in its
652 description. This should make it easier for people to find and
653 enable a particular module.
654
6552007-02-15 Vivek Dasmohapatra <vivek@etla.org>
656
657 * erc.el (erc-cmd-RECONNECT): Kill old process if it is still
658 alive.
659 (erc-message-english-PART): Properly escape "%" characters in
660 reason.
661
662 * erc-backend.el (erc-server-reconnecting): New variable that is
663 set when the user requests a reconnect, but the old process is
664 still alive. This forces the reconnect to work even though the
665 process is killed manually during reconnect.
666 (erc-server-connect): Initialize it.
667 (erc-server-reconnect-p): Use it.
668 (erc-process-sentinel-1): Set it to nil after the first reconnect
669 attempt.
670
6712007-02-07 Diane Murray <disumu@x3y2z1.net>
672
673 * erc-menu.el (erc-menu-definition): Fixed so that the separator
674 is between "Current channel" and "Pals, fools and other keywords",
675 not at the bottom of the "Current channel" submenu.
676
6772007-01-25 Diane Murray <disumu@x3y2z1.net>
678
679 * erc-networks.el (erc-server-alist): Removed SSL server for now
680 since `erc-server-select' doesn't know to use `erc-ssl'.
681
682 * erc-networks.el (erc-server-alist, erc-networks-alist): Added
683 definitions for oftc.net.
684
685 * erc-services.el (erc-nickserv-alist): Fixed OFTC message regexp.
686
6872007-01-22 Michael Olson <mwolson@gnu.org>
688
689 * erc-backend.el (erc-server-error-occurred): New variable that
690 indicates when an error has been signaled by the server. This
691 should fix an infinite reconnect bug when giving some servers a
692 bogus :full-name. Thanks to Angelina Carlton for the report.
693 (erc-server-connect): Initialize erc-server-error-occurred.
694 (erc-server-reconnect-p): Use it.
695 (ERROR): Set it.
696
697 * erc-services.el (erc-nickserv-alist): Alphabetize and add Ars
698 and QuakeNet. Standardize look of entries. Fix type mismatch
699 error in customize interface.
700 (erc-nickserv-passwords): Alphabetize and add missing entries from
701 erc-nickserv-alist.
702
7032007-01-21 Michael Olson <mwolson@gnu.org>
704
705 * erc.el (erc-header-line-format): Document how to disable the
706 header line, and add a customization type for it. Also, make the
707 changes take effect immediately.
708
7092007-01-19 Michael Olson <mwolson@gnu.org>
710
711 * erc.texi (Modules): Document new menu module. Thanks to Leo
712 for noticing.
713
7142007-01-16 Diane Murray <disumu@x3y2z1.net>
715
716 * erc-stamp.el (erc-insert-timestamp-left): Fixed so that the
717 whitespace string filler is hidden correctly when timestamps are
718 hidden.
719 (erc-toggle-timestamps): New function to use instead of
720 `erc-show-timestamps' and `erc-hide-timestamps'.
721
722 * erc.el (erc-restore-text-properties): Moved here from
723 erc-fill.el since it could be useful in general.
724
725 * erc-fill.el (erc-restore-text-properties): Removed.
726
7272007-01-13 Michael Olson <mwolson@gnu.org>
728
729 * erc.el (erc-command-regexp): New variable that is used to match
730 a command.
731 (erc-send-input): Use it. This fixes a bug where paths --
732 "/usr/bin/foo", for example -- were being displayed as commands,
733 but still sent correctly.
734 (erc-extract-command-from-line): Use it.
735
736 * erc.texi (Modules): Document erc-capab-identify.
737
7382007-01-11 Diane Murray <disumu@x3y2z1.net>
739
740 * erc.el (erc-find-parsed-property): Moved here from erc-track.el
741 since it can be useful in general.
742
743 * erc-track.el (erc-find-parsed-property): Removed.
744
745 * erc-capab.el (erc-capab-find-parsed): Removed.
746 (erc-capab-identify-add-prefix): Use `erc-find-parsed-property'.
747
748 * erc.el (erc-open): Run `erc-before-connect' hook here. This
749 makes sure the hook always gets called before a connection is
750 made, as some functions, like `erc-handle-irc-url', use `erc-open'
751 instead of `erc'.
752 (erc): Removed `erc-before-connect' hook.
753
754 * erc-menu.el (erc-menu-definition): Put items specific to
755 channels in a "Current channel" submenu.
756
757 * erc-backend.el (321, 323): Display channel list in server buffer
758 when not using the channel list module.
759
760 * erc.el: Updated copyright years.
761 (erc-version-string): Set to 5.2 (devel).
762 (erc-format-lag-time): Fixed to work when `erc-server-lag' is nil.
763 (erc-update-mode-line-buffer): Set the header face.
764
7652007-01-11 Michael Olson <mwolson@gnu.org>
766
767 * erc-bbdb.el (erc-bbdb-popup-type): Fix customization type and
768 documentation.
769
770 * erc-services.el (erc-nickserv-identify-mode): Improve
771 documentation for nick-change option and move higher to fix
772 compiler warning. Avoid a recursive load error.
773 (erc-nickserv-alist): Add simple entry for BitlBee, to avoid
774 "NickServ is AWAY: User is offline" error. Oddly enough, bitlbee
775 was smart enough to recognize that as an authentication request
776 and log in regardless, which is why I didn't notice this earlier.
777 (erc-nickserv-alist-sender, erc-nickserv-alist-regexp)
778 (erc-nickserv-alist-nickserv, erc-nickserv-alist-ident-keyword)
779 (erc-nickserv-alist-use-nick-p)
780 (erc-nickserv-alist-ident-command): New accessors for
781 erc-nickserv-alist. Using nth is unwieldy.
782 (erc-nickserv-identify-autodetect)
783 (erc-nickserv-identify-on-connect)
784 (erc-nickserv-identify-on-nick-change, erc-nickserv-identify): Use
785 the new accessors.
786
7872007-01-11 Diane Murray <disumu@x3y2z1.net>
788
789 * NEWS: Added note for `erc-my-nick-face'. Fixed capab-identify
790 wording.
791
7922007-01-10 Diane Murray <disumu@x3y2z1.net>
793
794 * erc.el (erc-mode-line-format): Added %l to documentation.
795 (erc-header-line-format): Removed "[IRC]". Use the new %l
796 replacement character. Doc fix.
797 (erc-format-channel-modes): Removed lag code. Removed parentheses
798 from mode string.
799 (erc-format-lag-time): New function.
800 (erc-update-mode-line-buffer): Use it.
801
8022007-01-10 Michael Olson <mwolson@gnu.org>
803
804 * erc.el: Fix typo in url-irc-function instructions.
805
8062007-01-09 Michael Olson <mwolson@gnu.org>
807
808 * erc.el (erc-system-name): New option that determines the system
809 name to use when logging in. The default is to figure this out by
810 calling `system-name'.
811 (erc-login): Use it.
812
8132007-01-07 Michael Olson <mwolson@gnu.org>
814
815 * erc.el (erc-modules): Add the menu module. This should fix a
816 bug with incorrect ERC submenus being displayed.
817 278
818 * erc-menu.el: Turn this into a module. 279 * erc-ibuffer.el (erc-channel-modes):
819 (erc-menu-add, erc-menu-remove): New functions that add and remove 280 Pass mode-name through format-mode-line
820 the ERC menu.
821 281
822 282
823See ChangeLog.06 for earlier changes. 283See ChangeLog.07 for earlier changes.
824 284
825 Copyright (C) 2007, 2008 Free Software Foundation, Inc. 285 Copyright (C) 2008 Free Software Foundation, Inc.
826 286
827 This file is part of GNU Emacs. 287 This file is part of GNU Emacs.
828 288
@@ -846,4 +306,4 @@ See ChangeLog.06 for earlier changes.
846;; add-log-time-zone-rule: t 306;; add-log-time-zone-rule: t
847;; End: 307;; End:
848 308
849;; arch-tag: 3369b6e5-96b1-4b32-96cd-9a905c747496 309;; arch-tag: 15787dfd-e091-4c8c-8b88-747b474e1ac7
diff --git a/lisp/erc/ChangeLog.07 b/lisp/erc/ChangeLog.07
new file mode 100644
index 00000000000..c317fe62177
--- /dev/null
+++ b/lisp/erc/ChangeLog.07
@@ -0,0 +1,839 @@
12007-12-16 Diane Murray <disumu@x3y2z1.net>
2
3 * erc-services.el (erc-nickserv-alist): Removed autodetect regexp,
4 added identified regexp for OFTC.
5 (erc-nickserv-identification-autodetect): Make sure success-regex
6 is non-nil.
7 (erc-nickserv-identify-autodetect): Make sure identify-regex is
8 non-nil. Doc fix.
9
102007-12-13 Diane Murray <disumu@x3y2z1.net>
11
12 * erc-backend.el (PRIVMSG, QUIT, TOPIC, WALLOPS, 376, 004, 221)
13 (312, 315, 319, 330, 331, 333, 367, 368, 391, 405, 406, 412)
14 (421, 432, 433, 437, 442, 461, 474, 477, 482, 431): Doc fix.
15
162007-12-09 Michael Olson <mwolson@gnu.org>
17
18 * erc-services.el (erc-nickserv-alist): Fix regexps for GRnet.
19
202007-12-09 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change)
21
22 * erc-backend.el, erc.el:
23 Parse 275 (secure connection) responses.
24
25 * erc-services.el: Add identification hooks for GRnet, the Greek
26 IRC network <http://www.irc.gr>.
27
282007-12-08 David Kastrup <dak@gnu.org>
29
30 * erc-stamp.el (erc-echo-timestamp):
31 * erc-lang.el (language):
32 * erc-backend.el (erc-server-connect): Fix buggy call to `message'.
33
342007-12-07 Edward O'Connor <ted@oconnor.cx>
35
36 * erc-services.el: Provide a hook that runs when nickserv confirms
37 that the user has successfully identified.
38 (services, erc-nickserv-identify-mode): Add and remove
39 erc-nickserv-identification-autodetect from
40 erc-server-NOTICE-functions.
41 (erc-nickserv-alist): Add SUCCESS-REGEXP to each entry.
42 (erc-nickserv-alist-identified-regexp)
43 (erc-nickserv-identification-autodetect): New functions.
44 (erc-nickserv-identified-hook): New hook.
45
462007-12-06 D. Goel <deego3@gmail.com>
47
48 * erc-match.el (erc-add-entry-to-list): Fix buggy call to `error'.
49
502007-12-01 Glenn Morris <rgm@gnu.org>
51
52 * erc-backend.el (erc-server-send-ping): Move after definition of
53 erc-server-send.
54
552007-11-29 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change)
56
57 * erc-backend.el, erc.el:
58 Parse 307 (nick has identified) responses.
59
602007-11-15 Juanma Barranquero <lekktu@gmail.com>
61
62 * erc.el (erc-open):
63 * erc-backend.el (define-erc-response-handler):
64 * erc-log.el (log):
65 * erc-match.el (erc-log-matches): Fix typos in docstrings.
66
672007-11-11 Michael Olson <mwolson@gnu.org>
68
69 * erc-autoaway.el (erc-autoaway-possibly-set-away):
70 * erc-netsplit.el (erc-netsplit-timer):
71 * erc-notify.el (erc-notify-timer):
72 * erc-track.el (erc-user-is-active): Only run if we have
73 successfully established a connection to the server and have
74 logged in. I suspect that sending messages too soon may make some
75 IRC servers not respond well, particularly when the network
76 connection is iffy or subject to traffic-shaping.
77
782007-11-01 Michael Olson <mwolson@gnu.org>
79
80 * erc-compat.el (erc-set-write-file-functions): New compatibility
81 function to set the write hooks appropriately.
82
83 * erc-log.el (erc-log-setup-logging): Use
84 erc-set-write-file-functions. This fixes a byte-compiler warning.
85
86 * erc-stamp.el: Silence byte-compiler warning about
87 erc-fill-column.
88
89 * erc.el (erc-with-all-buffers-of-server): Bind the result of
90 mapcar to a variable in order to silence a byte-compiler warning.
91
922007-10-29 Michael Olson <mwolson@gnu.org>
93
94 * erc-ibuffer.el (erc-modified-channels-alist): Use
95 eval-when-compile, and explain why we are doing this.
96
972007-10-25 Dan Nicolaescu <dann@ics.uci.edu>
98
99 * erc-ibuffer.el (erc-modified-channels-alist): Pacify
100 byte-compiler.
101
1022007-10-13 Glenn Morris <rgm@gnu.org>
103
104 * erc-track.el (erc-modified-channels-update): Use mapc rather
105 than mapcar.
106
1072007-10-12 Diane Murray <disumu@x3y2z1.net>
108
109 * erc.el (erc-join-channel): Prompt for channel key if C-u or
110 another prefix-arg was typed.
111
112 * NEWS: Noted this change.
113
1142007-10-07 Michael Olson <mwolson@gnu.org>
115
116 * erc.el (erc-cmd-ME'S): New command that handles the case where
117 someone types "/me's". It concatenates the text " 's" to the
118 beginning of the input and then sends the result like a normal
119 "/me" command.
120 (erc-command-regexp): Permit single-quote character.
121
1222007-09-30 Aidan Kehoe <kehoea@parhasard.net> (tiny change)
123
124 * erc-log.el (erc-save-buffer-in-logs): Prevent spurious warnings
125 when looking at a log file and concurrently saving to it.
126
1272007-09-18 Exal de Jesus Garcia Carrillo <exal@gnu.org> (tiny change)
128
129 * erc.texi (Special-Features): Fix small typo.
130
1312007-09-16 Michael Olson <mwolson@gnu.org>
132
133 * erc-track.el (erc-track-switch-direction): Mention
134 erc-track-faces-priority-list. Thanks to Leo for the suggestion.
135
1362007-09-11 Exal de Jesus Garcia Carrillo <exal@gnu.org> (tiny change)
137
138 * erc-sound.el: Fix typo in setting up instructions.
139
1402007-09-10 Michael Olson <mwolson@gnu.org>
141
142 * Makefile (elpa): Copy dir template rather than echoing a few
143 lines. The reason for this is that the ELPA package for ERC was
144 getting a corrupt dir entry.
145
146 * dir-template: Template for the ELPA dir file.
147
1482007-09-08 Michael Olson <mwolson@gnu.org>
149
150 * erc-log.el (erc-log-filter-function): New option that specifies
151 the function to call for filtering text before writing it to a log
152 file. Thanks to David O'Toole for the suggestion.
153 (erc-save-buffer-in-logs): Use erc-log-filter-function. Make sure
154 we carry along the value of coding-system-for-write, because this
155 could potentially be shadowed by the temporary buffer.
156
157 * erc.el (erc-version-string): Update to 5.3, development version.
158
1592007-09-07 Glenn Morris <rgm@gnu.org>
160
161 * erc.el (erc-toggle-debug-irc-protocol): Fix call to
162 erc-view-mode-enter.
163
1642007-08-08 Glenn Morris <rgm@gnu.org>
165
166 * erc-log.el, erc.el: Replace `iff' in doc-strings and comments.
167
1682007-09-03 Michael Olson <mwolson@gnu.org>
169
170 * erc.el (erc-default-port): Make this an integer value rather
171 than a string. Thanks to Luca Capello for the report.
172
1732007-08-27 Michael Olson <mwolson@gnu.org>
174
175 * erc.el (erc-cmd-GQUIT): If erc-kill-queries-on-quit is non-nil,
176 kill all query buffers after 4 seconds.
177
1782007-08-16 Michael Olson <mwolson@gnu.org>
179
180 * NEWS: Add ERC 5.3 changes section, and mention jbms' erc-track
181 compatibility note.
182
183 * erc-track.el (erc-track-list-changed-hook): Turn this into a
184 customizable option.
185 (erc-track-switch-direction): Add 'importance option.
186 (erc-modified-channels-display): If erc-track-switch-direction is
187 'importance, call erc-track-sort-by-importance.
188 (erc-track-face-priority): New function that returns a number
189 indicating the position of a face in erc-track-faces-priority-list.
190 (erc-track-sort-by-importance): New function that sorts
191 erc-modified-channels-list according to erc-track-face-priority.
192 (erc-track-get-active-buffer): Make 'oldest a rough opposite of
193 'importance.
194
1952007-08-14 Jeremy Maitin-Shepard <jbms@cmu.edu>
196
197 * erc-track.el (erc-track-remove-disconnected-buffers): New
198 variable which controls whether buffers associated with a server
199 that is disconnected should be removed from
200 `erc-modified-channels-alist'. Existing behavior is to
201 unconditionally remove such buffers, which is achieved by setting
202 `erc-track-removed-disconnected-buffers' to t. When set to t,
203 which is the new default value, such buffers remain in the list,
204 which I think is often the desired behavior, since the user may
205 likely wish to find out about activity that occurred in a channel
206 prior to it being disconnected.
207 (erc-track-list-changed-hook): New hook that is run whenever the
208 contents of `erc-modified-channels-alist' changes; it is useful
209 for users such as myself that don't use the default mode-line
210 notification but instead use a separate mechanism (which is tied
211 to my window manager) to provide notification of channel activity.
212 (erc-track-get-buffer-window): New function that acts as a wrapper
213 around `get-buffer-window' that handles the `selected-visible'
214 option of `erc-track-visibility'; previously, the value of
215 `erc-track-visibility' was passed directly to `get-buffer-window',
216 which does not support `selected-visible'; consequently,
217 `selected-visible' was not properly supported.
218 (erc-track-modified-channels): Fix a bug in the logic for removing
219 buffers from the list in certain cases.
220 (erc-track-position-in-mode-line): Add a supported value that
221 specifies that the tracking information should not be added to the
222 mode line at all. The value of nil is used to indicate that the
223 information should not be added at all to the mode line.
224 (erc-track-add-to-mode-line): Check for position eq to t, rather
225 than non-nil.
226 (erc-buffer-visible): Use erc-track-get-buffer-window.
227 (erc-modified-channels-update): Take
228 erc-track-remove-disconnected-buffers into account.
229 (erc-modified-channels-display): Run `erc-track-list-changed-hook'.
230
231 * erc.el (erc-reuse-frames): New option that determines whether
232 new frames are always created. Defaults to t. This only has an
233 effect when erc-join-buffer is set to 'frame.
234 (erc-setup-buffer): Use it.
235
2362007-08-14 Michael Olson <mwolson@gnu.org>
237
238 * erc-backend.el (erc-server-reconnect): If the server buffer has
239 been killed, use the current buffer instead. If the current
240 buffer is not an ERC buffer, give an error. This fixes a bug when
241 /reconnect is run from a channel buffer whose server buffer has
242 been deleted. Thanks to jbms for the report.
243 (erc-process-sentinel-1): Take server buffer as an argument, so
244 that we can make sure that it is current.
245 (erc-process-sentinel): Pass buffer to erc-process-sentinel-1.
246 (erc-process-sentinel-2): New function split from
247 erc-process-sentinel-1. If server buffer is deleted during a
248 reconnect attempt, stop trying to reconnect. Fix bug where
249 reconnect was not happening when erc-server-reconnect-attempts was
250 t. Call erc-server-reconnect-p only once each time. If we are
251 instructed to try connecting indefinitely, tell the user that they
252 can stop this by killing the server buffer. Call the process
253 sentinel by means of run-at-time, so that there is time to kill
254 the buffer if need be; this also removes the need for a while
255 loop. Refuse to reconnect again if erc-server-reconnect-timeout
256 is not an number.
257
258 * erc.el (erc-command-no-process-p): Fix bug: the return value of
259 erc-extract-command-from-line is a list rather than a single
260 symbol. Thanks to jbms for the report.
261 (erc-cmd-RECONNECT): Use simpler logic, and use buffer-live-p
262 rather than bufferp.
263 (erc-send-current-line, erc-display-command, erc-display-msg):
264 Handle case where erc-server-process is nil, so that /reconnect
265 works.
266
2672007-08-12 Michael Olson <mwolson@gnu.org>
268
269 * erc-identd.el (erc-identd-filter): Instead of sending an EOF
270 character, which now confuses freenode, stop the server process,
271 so that no new connections are accepted, and kill the current
272 client process.
273
2742007-07-29 Michael Olson <mwolson@gnu.org>
275
276 * erc-list.el: Relicense to GPLv3. Since the file was already
277 licensed under version 2 or later, it turns out that we do not
278 need the permission of all of the authors in order to proceed.
279
2802007-07-13 Michael Olson <mwolson@gnu.org>
281
282 * erc-goodies.el (erc-get-bg-color-face, erc-get-fg-color-face):
283 Use erc-error rather than message and beep.
284
285 * erc-sound.el: Indentation fix.
286
287 * erc.el (erc-command-no-process-p): New function that determines
288 if its argument is an ERC command that can be run when the server
289 process is not alive.
290 (erc-cmd-SET, erc-cmd-CLEAR, erc-cmd-COUNTRY, erc-cmd-HELP)
291 (erc-cmd-LASTLOG, erc-cmd-QUIT, erc-cmd-GQUIT)
292 (erc-cmd-RECONNECT, erc-cmd-SERVER): Denote that these commands
293 can be run even when the server process is not alive.
294 (erc-send-current-line): Call erc-command-no-process-p if the
295 server process is not alive, to determine if we have a command
296 that can be run anyway. Thanks to Tom Tromey for the bug report.
297 (erc-error): New function that either displays a message or throws
298 an error, depending on whether debug-on-error is non-nil.
299 (erc-cmd-SERVER, erc-send-current-line): Use it.
300
3012007-07-10 Michael Olson <mwolson@gnu.org>
302
303 * Relicense all FSF-assigned code to GPLv3.
304
3052007-06-25 Michael Olson <mwolson@gnu.org>
306
307 * erc.texi (Options): Fix typo.
308 (Getting Help and Reporting Bugs): Update webpage URL. Make Gmane
309 part more readable.
310
3112007-06-20 Michael Olson <mwolson@gnu.org>
312
313 * erc-stamp.el (erc-timestamp-format-left): New option that
314 specifies the left timestamp to use for
315 erc-insert-timestamp-left-and-right.
316 (erc-timestamp-format-right): New option that specifies the right
317 timestamp to use for erc-insert-timestamp-left-and-right.
318 (erc-insert-timestamp-function): Change default to
319 erc-insert-timestamp-left-and-right.
320 (erc-insert-away-timestamp-function): Ditto.
321 (erc-timestamp-last-inserted-left)
322 (erc-timestamp-last-inserted-right): New variables to keep track
323 of data for erc-insert-timestamp-left-and-right.
324 (erc-insert-timestamp-left-and-right): New function that places
325 timestamps on both the left and right sides of the screen, but
326 only if each timestamp has changed since it was last computed.
327 Thanks to offby1 for urging me to merge this.
328
329 * erc.el (erc-open-ssl-stream): Display informative error when
330 ssl.el not found.
331 (erc-tls): New function to connect using tls.el.
332 (erc-open-tls-stream): New function to initiate tls connection.
333 Display informative error when tls.el not found.
334
3352007-06-19 Michael Olson <mwolson@gnu.org>
336
337 * erc-log.el: Update header with accurate instructions.
338
3392007-06-17 Michael Olson <mwolson@gnu.org>
340
341 * erc-pkg.el: Update description to match what is currently in ELPA.
342
3432007-06-14 Juanma Barranquero <lekktu@gmail.com>
344
345 * erc-goodies.el (erc-scroll-to-bottom): Remove redundant check.
346
3472007-06-13 Michael Olson <mwolson@gnu.org>
348
349 * erc-compat.el (erc-with-selected-window): New compatibility
350 macro that implements `with-selected-window'.
351
352 * erc-goodies.el (erc-scroll-to-bottom): Use it. This fixes a bug
353 with buffer ordering where ERC buffers would move to the top.
354 Thanks to Ivan Kanis for the patch.
355
3562007-06-10 Michael Olson <mwolson@gnu.org>
357
358 * erc-log.el (erc-logging-enabled): Fix a bug that occurred when
359 `erc-log-channels-directory' had the name of a function.
360
3612007-06-06 Juanma Barranquero <lekktu@gmail.com>
362
363 * erc.el (erc-show-channel-key-p, erc-startup-file-list):
364 Fix typo in docstring.
365
3662007-06-03 Michael Olson <mwolson@gnu.org>
367
368 * erc-compat.el (erc-view-mode-enter): Make this its own function,
369 in order to document what we do, and provide sane fallback
370 behavior.
371
372 * erc.el (erc-toggle-debug-irc-protocol): Don't pass any arguments
373 to erc-view-mode-enter, since we don't do anything special with
374 the exit function. This fixes a bug with Emacs 21 and Emacs 22.
375 Thanks to Leo for noticing.
376
3772007-05-30 Michael Olson <mwolson@gnu.org>
378
379 * erc-compat.el (erc-user-emacs-directory): New variable that
380 determines where to find user-specific Emacs settings. For Emacs,
381 this is usually ~/.emacs.d, and for XEmacs this is usually
382 ~/.xemacs.
383
384 * erc.el (erc-startup-file-list): Use erc-user-emacs-directory.
385
3862007-05-28 Michael Olson <mwolson@gnu.org>
387
388 * erc-button.el (erc-button-url-regexp): Recognize parentheses as
389 part of URLs. Thanks to Lawrence Mitchell for the fix.
390
3912007-05-26 Michael Olson <mwolson@gnu.org>
392
393 * erc.texi (Modules): Fix references to completion modules.
394
3952007-05-21 Michael Olson <mwolson@gnu.org>
396
397 * Makefile (SOURCE): Remove erc-pkg.el.
398 (debclean): New rule to clean old Debian packages of ERC.
399 (debprepare): Don't modify the released tarball, but copy it as
400 the .orig.tar.gz file.
401 (debrelease, debrevision): Remove.
402 (debinstall): New target that copies the generated Debian file to
403 a distro-specific location.
404 (deb): New rule that chains together the stages in building a
405 Debian package.
406 (EXTRAS): Add erc-nicklist.el, since it is not release-quality.
407 (extras): Copy images directory.
408
409 * erc-nicklist.el (erc-nicklist-icons-directory): Use
410 locate-library to find the "images" directory. This should be
411 more failsafe. Thanks to Tom Tromey for the idea.
412
4132007-05-19 Michael Olson <mwolson@gnu.org>
414
415 * Makefile (ELPA): New variable that contains the location of my
416 local ELPA repository.
417 (elpa): New rule that makes an ELPA package for ERC.
418
4192007-04-19 Michael Olson <mwolson@gnu.org>
420
421 * erc.el (erc-parse-prefix): New function that retrieves the
422 PREFIX server parameter from the current server and returns an
423 alist of prefix type to prefix character.
424 (erc-channel-receive-names): Use `erc-parse-prefix' to determine
425 whether the first character of a nick is a prefix character or
426 not. This should fix a bug reported by bromine about needing to
427 type "%" first to complete nicks of people who are "hops" on
428 Slashnet. This should also support for very exotic IRC server
429 setups, if any exist.
430 (erc-update-current-channel-member): Indentation.
431
4322007-04-15 Michael Olson <mwolson@gnu.org>
433
434 * erc-log.el (erc-generate-log-file-name-function): Docfix.
435 Mention how to deal with the case for putting log files in
436 different directories. Change a customization type from `symbol'
437 to `function'.
438 (erc-log-channels-directory): Allow this to contain a function
439 name, which is called with the same args as in
440 `erc-generate-log-file-name-function'. Thanks to andrewy for the
441 report and use case.
442 (erc-current-logfile): Detect if `erc-log-channels-directory' is a
443 function and call it with arguments if so.
444
4452007-04-12 Michael Olson <mwolson@gnu.org>
446
447 * erc-backend.el (define-erc-response-handler): Mention that hook
448 processing stops when the function returns non-nil. This should
449 help avoid a nasty "gotcha" when making custom functions. Thanks
450 to John Sullivan for the report.
451
4522007-04-08 Diane Murray <disumu@x3y2z1.net>
453
454 * erc-nicklist.el (erc-nicklist-voiced-position): Fixed
455 customization mismatch.
456
4572007-04-01 Michael Olson <mwolson@gnu.org>
458
459 * erc.el (erc-version-string): Release ERC 5.2.
460
461 * erc-auto.in, erc-chess.el, erc-list.el, erc-speak.el:
462 * erc-viper.el: Update copyright notices.
463
464 * erc.texi: Make Emacs Lisp source code in this document
465 essentially public domain. Update version to 5.2.
466 (Obtaining ERC): Mention extras tarball.
467 (Releases): Mention local GNU mirror.
468 (Sample Configuration): Remove notice.
469
470 * FOR-RELEASE (5.3): Add item for erc-nicklist.
471 Mark NEWS as done. Mark extras tarball as done.
472
473 * Makefile (VERSION): Increment to 5.2.
474 (TESTING): Remove.
475 (EXTRAS): New variable containing the contents of our "Emacs 22
476 extras" tarball.
477 (SOURCE): Remove $(TESTING).
478 (MISC): Add COPYING and ChangeLog.06. Fix ChangeLog.NNNN ->
479 ChangeLog.NN.
480 (release): Use $(SNAPDIR) instead of erc-$(VERSION).
481 (extras): New rule which implements the building of the extras
482 tarball.
483 (upload-extras): New rule to upload the extras tarball. It's
484 yucky to replicate upload, but oh well.
485 (DISTRIBUTOR): New variable used to differentiate between building
486 packages for Ubuntu and Debian.
487 (debrelease, debrevision): Use it.
488 (debbuild): Run linda in addition to lintian.
489
490 * NEWS: Mention extras tarball. Note which files have been
491 renamed. Note that erc-list is enabled by default, except in
492 Emacs 22.
493
494 * README.extras: New file which serves as a README for the extras
495 tarball.
496
4972007-03-31 Michael Olson <mwolson@gnu.org>
498
499 * NEWS: Update for the 5.2 release.
500
501 * FOR-RELEASE: Finish up 5.2 manual item. Add documentation item
502 for 5.3.
503
504 * erc.texi (Sample Session): Flesh out. Mention #erc.
505 (Modules): Defer to 5.3 release.
506 (Advanced Usage): Move Sample Configuration chapter ahead of
507 unfinished chapters.
508 (Sample Configuration): Write.
509 (Options): Mention how to see available ERC options. Defer to 5.3
510 release.
511 (Tips and Tricks): Remove, since it seems better to just include
512 tips and tricks in the sample configuration, commented out.
513
514 * erc-bbdb.el (erc-bbdb-search-name-and-create): Make prompt more
515 informative about how to skip merging.
516 (erc-bbdb-insinuate-and-show-entry-1): Move contents of
517 erc-bbdb-insinuate-and-show-entry here.
518 (erc-bbdb-insinuate-and-show-entry): Run
519 erc-bbdb-insinuate-and-show-entry-1 "outside" of the calling
520 function, so that we can avoid triggering a process-filter error
521 if the user hits C-g.
522
5232007-03-30 Michael Olson <mwolson@gnu.org>
524
525 * FOR-RELEASE: Solve C-c C-SPC keybinding dilemma.
526
527 * erc-autoaway.el (erc-autoaway-idle-method): Use `if' rather than
528 `cond' and `set' rather than `set-default'.
529
530 * erc-log.el: Avoid compiler warning by requiring erc-network
531 during compilation.
532 (erc-generate-log-file-name-function): Add tag to each option.
533 Add erc-generate-log-file-name-network.
534 (erc-generate-log-file-name-network): New function which generates
535 a log file name that uses network name rather than server name,
536 when possible.
537
538 * erc-track.el (track): Assimilate track-when-inactive module,
539 since there's no need to have two modules in one file -- an option
540 will do. Remove track-modified-channels alias. Call
541 erc-track-minor-mode-maybe, and tear down the minor mode when
542 disabling.
543 (erc-track-when-inactive): New option which determines whether to
544 track visible buffers when inactive. The default is not to do so.
545 (erc-track-visibility): Mention erc-track-when-inactive.
546 (erc-buffer-visible): Use erc-track-when-inactive.
547 (erc-track-enable-keybindings): New option which determines
548 whether to enable the global-level tracking keybindings. The
549 default is to do so, unless they would override another binding,
550 in which case we prompt the user about it.
551 (erc-track-minor-mode-map): Move global keybindings here.
552 (erc-track-minor-mode): New minor mode which only enables the
553 keybindings and does nothing else.
554 (erc-track-minor-mode-maybe): New function which starts
555 erc-track-minor-mode, but only if it hasn't already been started,
556 an ERC buffer exists, and the user OK's it, depending on the value
557 of `erc-track-enable-keybindings'.
558 (erc-track-switch-buffer): Display a message if someone calls this
559 without first enabling erc-track-mode.
560
5612007-03-17 Michael Olson <mwolson@gnu.org>
562
563 * erc.texi (Development): Mention ErcDevelopment page on
564 emacswiki.
565 (Getting Started): Mention ~/.emacs.d/.ercrc.el and the Customize
566 interface.
567 (Sample Session): New section that has a very rough draft for a
568 sample ERC session.
569 (Special Features): New section that explains some of the special
570 features of ERC. Taken from ErcFeatures on emacswiki, with
571 enhancements.
572
5732007-03-12 Diane Murray <disumu@x3y2z1.net>
574
575 * erc-autoaway.el (erc-autoaway-idle-method): When setting the new
576 value, disable and re-enable `erc-autoaway-mode' only if it was
577 already enabled. This fixes a bug where autoaway was enabled just
578 by loading the file.
579
5802007-03-10 Diane Murray <disumu@x3y2z1.net>
581
582 * erc-capab.el: Added more information to the Usage section.
583 (erc-capab-identify-prefix): Doc fix.
584 (erc-capab-identify-unidentified): New face.
585 (290): Removed. Definition moved to erc-backend.el.
586 (erc-capab-identify-send-messages): Renamed from
587 `erc-capab-send-identify-messages'.
588 (erc-capab-identify-setup): Use it.
589 (erc-capab-identify-get-unidentified-nickname): Renamed from
590 `erc-capab-get-unidentified-nickname'.
591 (erc-capab-identify-add-prefix): Use it. Use
592 `erc-capab-identify-unidentified' as the face.
593
594 * erc-backend.el (290): Moved here from erc-capab.el.
595
596 * erc.el (erc-select): Added an autoload cookie.
597 (erc-message-type-member, erc-restore-text-properties): Use
598 `erc-get-parsed-vector'.
599 (erc-auto-query): Set the default to 'bury since many new users
600 expect private messages from others to be in dedicated query
601 buffers, not the server buffer.
602 (erc-common-server-suffixes): Use "freenode" for freenode.net, not
603 "OPN". Added oftc.net.
604
605 * NEWS: Added note about erc-auto-query's new default setting.
606
6072007-03-03 Michael Olson <mwolson@gnu.org>
608
609 * erc.el (erc-open, erc): Docfixes.
610
6112007-03-02 Michael Olson <mwolson@gnu.org>
612
613 * FOR-RELEASE: Make section for 5.3 release and move erc-backend
614 cleanup there. Awaiting discussion before doing other things.
615 Add tasks for merging filename changes from the 5.2 release
616 branch, and for making a tarball of modules not in Emacs 22. Add
617 item to remind me to update NEWS. Mark backtab entry as done.
618
619 * erc-button.el (button): Add call to `erc-button-add-keys'.
620 (erc-button-keys-added): New variable tracking whether we've added
621 the keys yet.
622 (erc-button-add-keys): New function that adds the <backtab> key to
623 erc-mode-map.
624
625 * erc.texi: Change version to 5.2 (pre-release).
626
6272007-02-15 Michael Olson <mwolson@gnu.org>
628
629 * CREDITS: Update.
630
631 * erc-backend.el (erc-server-send-ping-interval): Change to use a
632 default of 30 seconds. Improve customize interface.
633 (erc-server-send-ping-timeout): New option that determines when to
634 consider a connection stalled and restart it. The default is
635 after 120 seconds.
636 (erc-server-send-ping): Use erc-server-send-ping-timeout instead
637 of erc-server-send-ping-interval. If
638 erc-server-send-ping-timeout is nil, do not ever kill and restart
639 a hung IRC process.
640
641 * erc.el (erc-modules): Include the name of the module in its
642 description. This should make it easier for people to find and
643 enable a particular module.
644
6452007-02-15 Vivek Dasmohapatra <vivek@etla.org>
646
647 * erc.el (erc-cmd-RECONNECT): Kill old process if it is still
648 alive.
649 (erc-message-english-PART): Properly escape "%" characters in
650 reason.
651
652 * erc-backend.el (erc-server-reconnecting): New variable that is
653 set when the user requests a reconnect, but the old process is
654 still alive. This forces the reconnect to work even though the
655 process is killed manually during reconnect.
656 (erc-server-connect): Initialize it.
657 (erc-server-reconnect-p): Use it.
658 (erc-process-sentinel-1): Set it to nil after the first reconnect
659 attempt.
660
6612007-02-07 Diane Murray <disumu@x3y2z1.net>
662
663 * erc-menu.el (erc-menu-definition): Fixed so that the separator
664 is between "Current channel" and "Pals, fools and other keywords",
665 not at the bottom of the "Current channel" submenu.
666
6672007-01-25 Diane Murray <disumu@x3y2z1.net>
668
669 * erc-networks.el (erc-server-alist): Removed SSL server for now
670 since `erc-server-select' doesn't know to use `erc-ssl'.
671
672 * erc-networks.el (erc-server-alist, erc-networks-alist): Added
673 definitions for oftc.net.
674
675 * erc-services.el (erc-nickserv-alist): Fixed OFTC message regexp.
676
6772007-01-22 Michael Olson <mwolson@gnu.org>
678
679 * erc-backend.el (erc-server-error-occurred): New variable that
680 indicates when an error has been signaled by the server. This
681 should fix an infinite reconnect bug when giving some servers a
682 bogus :full-name. Thanks to Angelina Carlton for the report.
683 (erc-server-connect): Initialize erc-server-error-occurred.
684 (erc-server-reconnect-p): Use it.
685 (ERROR): Set it.
686
687 * erc-services.el (erc-nickserv-alist): Alphabetize and add Ars
688 and QuakeNet. Standardize look of entries. Fix type mismatch
689 error in customize interface.
690 (erc-nickserv-passwords): Alphabetize and add missing entries from
691 erc-nickserv-alist.
692
6932007-01-21 Michael Olson <mwolson@gnu.org>
694
695 * erc.el (erc-header-line-format): Document how to disable the
696 header line, and add a customization type for it. Also, make the
697 changes take effect immediately.
698
6992007-01-19 Michael Olson <mwolson@gnu.org>
700
701 * erc.texi (Modules): Document new menu module. Thanks to Leo
702 for noticing.
703
7042007-01-16 Diane Murray <disumu@x3y2z1.net>
705
706 * erc-stamp.el (erc-insert-timestamp-left): Fixed so that the
707 whitespace string filler is hidden correctly when timestamps are
708 hidden.
709 (erc-toggle-timestamps): New function to use instead of
710 `erc-show-timestamps' and `erc-hide-timestamps'.
711
712 * erc.el (erc-restore-text-properties): Moved here from
713 erc-fill.el since it could be useful in general.
714
715 * erc-fill.el (erc-restore-text-properties): Removed.
716
7172007-01-13 Michael Olson <mwolson@gnu.org>
718
719 * erc.el (erc-command-regexp): New variable that is used to match
720 a command.
721 (erc-send-input): Use it. This fixes a bug where paths --
722 "/usr/bin/foo", for example -- were being displayed as commands,
723 but still sent correctly.
724 (erc-extract-command-from-line): Use it.
725
726 * erc.texi (Modules): Document erc-capab-identify.
727
7282007-01-11 Diane Murray <disumu@x3y2z1.net>
729
730 * erc.el (erc-find-parsed-property): Moved here from erc-track.el
731 since it can be useful in general.
732
733 * erc-track.el (erc-find-parsed-property): Removed.
734
735 * erc-capab.el (erc-capab-find-parsed): Removed.
736 (erc-capab-identify-add-prefix): Use `erc-find-parsed-property'.
737
738 * erc.el (erc-open): Run `erc-before-connect' hook here. This
739 makes sure the hook always gets called before a connection is
740 made, as some functions, like `erc-handle-irc-url', use `erc-open'
741 instead of `erc'.
742 (erc): Removed `erc-before-connect' hook.
743
744 * erc-menu.el (erc-menu-definition): Put items specific to
745 channels in a "Current channel" submenu.
746
747 * erc-backend.el (321, 323): Display channel list in server buffer
748 when not using the channel list module.
749
750 * erc.el: Updated copyright years.
751 (erc-version-string): Set to 5.2 (devel).
752 (erc-format-lag-time): Fixed to work when `erc-server-lag' is nil.
753 (erc-update-mode-line-buffer): Set the header face.
754
7552007-01-11 Michael Olson <mwolson@gnu.org>
756
757 * erc-bbdb.el (erc-bbdb-popup-type): Fix customization type and
758 documentation.
759
760 * erc-services.el (erc-nickserv-identify-mode): Improve
761 documentation for nick-change option and move higher to fix
762 compiler warning. Avoid a recursive load error.
763 (erc-nickserv-alist): Add simple entry for BitlBee, to avoid
764 "NickServ is AWAY: User is offline" error. Oddly enough, bitlbee
765 was smart enough to recognize that as an authentication request
766 and log in regardless, which is why I didn't notice this earlier.
767 (erc-nickserv-alist-sender, erc-nickserv-alist-regexp)
768 (erc-nickserv-alist-nickserv, erc-nickserv-alist-ident-keyword)
769 (erc-nickserv-alist-use-nick-p)
770 (erc-nickserv-alist-ident-command): New accessors for
771 erc-nickserv-alist. Using nth is unwieldy.
772 (erc-nickserv-identify-autodetect)
773 (erc-nickserv-identify-on-connect)
774 (erc-nickserv-identify-on-nick-change, erc-nickserv-identify): Use
775 the new accessors.
776
7772007-01-11 Diane Murray <disumu@x3y2z1.net>
778
779 * NEWS: Added note for `erc-my-nick-face'. Fixed capab-identify
780 wording.
781
7822007-01-10 Diane Murray <disumu@x3y2z1.net>
783
784 * erc.el (erc-mode-line-format): Added %l to documentation.
785 (erc-header-line-format): Removed "[IRC]". Use the new %l
786 replacement character. Doc fix.
787 (erc-format-channel-modes): Removed lag code. Removed parentheses
788 from mode string.
789 (erc-format-lag-time): New function.
790 (erc-update-mode-line-buffer): Use it.
791
7922007-01-10 Michael Olson <mwolson@gnu.org>
793
794 * erc.el: Fix typo in url-irc-function instructions.
795
7962007-01-09 Michael Olson <mwolson@gnu.org>
797
798 * erc.el (erc-system-name): New option that determines the system
799 name to use when logging in. The default is to figure this out by
800 calling `system-name'.
801 (erc-login): Use it.
802
8032007-01-07 Michael Olson <mwolson@gnu.org>
804
805 * erc.el (erc-modules): Add the menu module. This should fix a
806 bug with incorrect ERC submenus being displayed.
807
808 * erc-menu.el: Turn this into a module.
809 (erc-menu-add, erc-menu-remove): New functions that add and remove
810 the ERC menu.
811
812
813See ChangeLog.06 for earlier changes.
814
815 Copyright (C) 2007, 2008 Free Software Foundation, Inc.
816
817 This file is part of GNU Emacs.
818
819 GNU Emacs is free software; you can redistribute it and/or modify
820 it under the terms of the GNU General Public License as published by
821 the Free Software Foundation; either version 3, or (at your option)
822 any later version.
823
824 GNU Emacs is distributed in the hope that it will be useful,
825 but WITHOUT ANY WARRANTY; without even the implied warranty of
826 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
827 GNU General Public License for more details.
828
829 You should have received a copy of the GNU General Public License
830 along with GNU Emacs; see the file COPYING. If not, write to the
831 Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
832 Boston, MA 02110-1301, USA.
833
834;; Local Variables:
835;; coding: utf-8
836;; add-log-time-zone-rule: t
837;; End:
838
839;; arch-tag: 3369b6e5-96b1-4b32-96cd-9a905c747496
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 0fead116d8f..1bb3e4aada2 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -332,11 +332,10 @@ This is either a coding system, a cons, a function, or nil.
332 332
333If a cons, the encoding system for outgoing text is in the car 333If a cons, the encoding system for outgoing text is in the car
334and the decoding system for incoming text is in the cdr. The most 334and the decoding system for incoming text is in the cdr. The most
335interesting use for this is to put `undecided' in the cdr. If a 335interesting use for this is to put `undecided' in the cdr.
336function, it is called with no arguments and should return a 336
337coding system or a cons as described above. Note that you can use 337If a function, it is called with the argument `target' and should
338the dynamically bound variable `target' to get the current 338return a coding system or a cons as described above.
339target. See `erc-coding-system-for-target'.
340 339
341If you need to send non-ASCII text to people not using a client that 340If you need to send non-ASCII text to people not using a client that
342does decoding on its own, you must tell ERC what encoding to use. 341does decoding on its own, you must tell ERC what encoding to use.
@@ -491,6 +490,8 @@ We will store server variables in the buffer given by BUFFER."
491 (let ((process (funcall erc-server-connect-function 490 (let ((process (funcall erc-server-connect-function
492 (format "erc-%s-%s" server port) 491 (format "erc-%s-%s" server port)
493 nil server port))) 492 nil server port)))
493 (unless (processp process)
494 (error "Connection attempt failed"))
494 (message "%s...done" msg) 495 (message "%s...done" msg)
495 ;; Misc server variables 496 ;; Misc server variables
496 (with-current-buffer buffer 497 (with-current-buffer buffer
@@ -686,7 +687,7 @@ This is determined via `erc-encoding-coding-alist' or
686 (when (string-match (car pat) target) 687 (when (string-match (car pat) target)
687 (throw 'match (cdr pat))))))) 688 (throw 'match (cdr pat)))))))
688 (and (functionp erc-server-coding-system) 689 (and (functionp erc-server-coding-system)
689 (funcall erc-server-coding-system)) 690 (funcall erc-server-coding-system target))
690 erc-server-coding-system)) 691 erc-server-coding-system))
691 692
692(defun erc-decode-string-from-target (str target) 693(defun erc-decode-string-from-target (str target)
@@ -1349,7 +1350,7 @@ add things to `%s' instead."
1349 (erc-update-mode-line)))) 1350 (erc-update-mode-line))))
1350 1351
1351(define-erc-response-handler (PRIVMSG NOTICE) 1352(define-erc-response-handler (PRIVMSG NOTICE)
1352 nil nil 1353 "Handle private messages, including messages in channels." nil
1353 (let ((sender-spec (erc-response.sender parsed)) 1354 (let ((sender-spec (erc-response.sender parsed))
1354 (cmd (erc-response.command parsed)) 1355 (cmd (erc-response.command parsed))
1355 (tgt (car (erc-response.command-args parsed))) 1356 (tgt (car (erc-response.command-args parsed)))
@@ -1413,7 +1414,7 @@ add things to `%s' instead."
1413(add-hook 'erc-server-PRIVMSG-functions 'erc-auto-query) 1414(add-hook 'erc-server-PRIVMSG-functions 'erc-auto-query)
1414 1415
1415(define-erc-response-handler (QUIT) 1416(define-erc-response-handler (QUIT)
1416 nil nil 1417 "Another user has quit IRC." nil
1417 (let ((reason (erc-response.contents parsed)) 1418 (let ((reason (erc-response.contents parsed))
1418 bufs) 1419 bufs)
1419 (multiple-value-bind (nick login host) 1420 (multiple-value-bind (nick login host)
@@ -1426,7 +1427,7 @@ add things to `%s' instead."
1426 ?h host ?r reason)))) 1427 ?h host ?r reason))))
1427 1428
1428(define-erc-response-handler (TOPIC) 1429(define-erc-response-handler (TOPIC)
1429 nil nil 1430 "The channel topic has changed." nil
1430 (let* ((ch (first (erc-response.command-args parsed))) 1431 (let* ((ch (first (erc-response.command-args parsed)))
1431 (topic (erc-trim-string (erc-response.contents parsed))) 1432 (topic (erc-trim-string (erc-response.contents parsed)))
1432 (time (format-time-string "%T %m/%d/%y" (current-time)))) 1433 (time (format-time-string "%T %m/%d/%y" (current-time))))
@@ -1439,7 +1440,7 @@ add things to `%s' instead."
1439 ?c ch ?T topic)))) 1440 ?c ch ?T topic))))
1440 1441
1441(define-erc-response-handler (WALLOPS) 1442(define-erc-response-handler (WALLOPS)
1442 nil nil 1443 "Display a WALLOPS message." nil
1443 (let ((message (erc-response.contents parsed))) 1444 (let ((message (erc-response.contents parsed)))
1444 (multiple-value-bind (nick login host) 1445 (multiple-value-bind (nick login host)
1445 (erc-parse-user (erc-response.sender parsed)) 1446 (erc-parse-user (erc-response.sender parsed))
@@ -1465,12 +1466,12 @@ add things to `%s' instead."
1465 (erc-response.contents parsed))) 1466 (erc-response.contents parsed)))
1466 1467
1467(define-erc-response-handler (376 422) 1468(define-erc-response-handler (376 422)
1468 nil nil 1469 "End of MOTD/MOTD is missing." nil
1469 (erc-server-MOTD proc parsed) 1470 (erc-server-MOTD proc parsed)
1470 (erc-connection-established proc parsed)) 1471 (erc-connection-established proc parsed))
1471 1472
1472(define-erc-response-handler (004) 1473(define-erc-response-handler (004)
1473 nil nil 1474 "Display the server's identification." nil
1474 (multiple-value-bind (server-name server-version) 1475 (multiple-value-bind (server-name server-version)
1475 (cdr (erc-response.command-args parsed)) 1476 (cdr (erc-response.command-args parsed))
1476 (setq erc-server-version server-version) 1477 (setq erc-server-version server-version)
@@ -1510,7 +1511,7 @@ A server may send more than one 005 message."
1510 (erc-display-message parsed 'notice proc line))) 1511 (erc-display-message parsed 'notice proc line)))
1511 1512
1512(define-erc-response-handler (221) 1513(define-erc-response-handler (221)
1513 nil nil 1514 "Display the current user modes." nil
1514 (let* ((nick (first (erc-response.command-args parsed))) 1515 (let* ((nick (first (erc-response.command-args parsed)))
1515 (modes (mapconcat 'identity 1516 (modes (mapconcat 'identity
1516 (cdr (erc-response.command-args parsed)) " "))) 1517 (cdr (erc-response.command-args parsed)) " ")))
@@ -1596,7 +1597,7 @@ See `erc-display-server-message'." nil
1596 ?n nick ?f fname ?u user ?h host)))) 1597 ?n nick ?f fname ?u user ?h host))))
1597 1598
1598(define-erc-response-handler (312) 1599(define-erc-response-handler (312)
1599 nil nil 1600 "Server name response in WHOIS." nil
1600 (multiple-value-bind (nick server-host) 1601 (multiple-value-bind (nick server-host)
1601 (cdr (erc-response.command-args parsed)) 1602 (cdr (erc-response.command-args parsed))
1602 (erc-display-message 1603 (erc-display-message
@@ -1614,7 +1615,7 @@ See `erc-display-server-message'." nil
1614 ;; 318 - End of WHOIS list 1615 ;; 318 - End of WHOIS list
1615 ;; 323 - End of channel LIST 1616 ;; 323 - End of channel LIST
1616 ;; 369 - End of WHOWAS 1617 ;; 369 - End of WHOWAS
1617 nil nil 1618 "End of WHO/WHOIS/LIST/WHOWAS notices." nil
1618 (ignore proc parsed)) 1619 (ignore proc parsed))
1619 1620
1620(define-erc-response-handler (317) 1621(define-erc-response-handler (317)
@@ -1635,7 +1636,7 @@ See `erc-display-server-message'." nil
1635 ?n nick ?i (erc-sec-to-time (string-to-number seconds-idle)))))) 1636 ?n nick ?i (erc-sec-to-time (string-to-number seconds-idle))))))
1636 1637
1637(define-erc-response-handler (319) 1638(define-erc-response-handler (319)
1638 nil nil 1639 "Channel names in WHOIS response." nil
1639 (erc-display-message 1640 (erc-display-message
1640 parsed 'notice 'active 's319 1641 parsed 'notice 'active 's319
1641 ?n (second (erc-response.command-args parsed)) 1642 ?n (second (erc-response.command-args parsed))
@@ -1649,8 +1650,13 @@ See `erc-display-server-message'." nil
1649 1650
1650(define-erc-response-handler (321) 1651(define-erc-response-handler (321)
1651 "LIST header." nil 1652 "LIST header." nil
1652 (setq erc-channel-list nil) 1653 (setq erc-channel-list nil))
1653 (erc-display-message parsed 'notice proc 's321)) 1654
1655(defun erc-server-321-message (proc parsed)
1656 "Display a message for the 321 event."
1657 (erc-display-message parsed 'notice proc 's321)
1658 nil)
1659(add-hook 'erc-server-321-functions 'erc-server-321-message t)
1654 1660
1655(define-erc-response-handler (322) 1661(define-erc-response-handler (322)
1656 "LIST notice." nil 1662 "LIST notice." nil
@@ -1658,10 +1664,17 @@ See `erc-display-server-message'." nil
1658 (multiple-value-bind (channel num-users) 1664 (multiple-value-bind (channel num-users)
1659 (cdr (erc-response.command-args parsed)) 1665 (cdr (erc-response.command-args parsed))
1660 (add-to-list 'erc-channel-list (list channel)) 1666 (add-to-list 'erc-channel-list (list channel))
1661 (erc-update-channel-topic channel topic) 1667 (erc-update-channel-topic channel topic))))
1668
1669(defun erc-server-322-message (proc parsed)
1670 "Display a message for the 322 event."
1671 (let ((topic (erc-response.contents parsed)))
1672 (multiple-value-bind (channel num-users)
1673 (cdr (erc-response.command-args parsed))
1662 (erc-display-message 1674 (erc-display-message
1663 parsed 'notice proc 's322 1675 parsed 'notice proc 's322
1664 ?c channel ?u num-users ?t (or topic ""))))) 1676 ?c channel ?u num-users ?t (or topic "")))))
1677(add-hook 'erc-server-322-functions 'erc-server-322-message t)
1665 1678
1666(define-erc-response-handler (324) 1679(define-erc-response-handler (324)
1667 "Channel or nick modes." nil 1680 "Channel or nick modes." nil
@@ -1683,7 +1696,7 @@ See `erc-display-server-message'." nil
1683 's329 ?c channel ?t (format-time-string "%A %Y/%m/%d %X" time)))) 1696 's329 ?c channel ?t (format-time-string "%A %Y/%m/%d %X" time))))
1684 1697
1685(define-erc-response-handler (330) 1698(define-erc-response-handler (330)
1686 nil nil 1699 "Nick is authed as (on Quakenet network)." nil
1687 ;; FIXME: I don't know what the magic numbers mean. Mummy, make 1700 ;; FIXME: I don't know what the magic numbers mean. Mummy, make
1688 ;; the magic numbers go away. 1701 ;; the magic numbers go away.
1689 ;; No seriously, I have no clue about the format of this command, 1702 ;; No seriously, I have no clue about the format of this command,
@@ -1699,10 +1712,9 @@ See `erc-display-server-message'." nil
1699 ?n nick ?a authmsg ?i authaccount))) 1712 ?n nick ?a authmsg ?i authaccount)))
1700 1713
1701(define-erc-response-handler (331) 1714(define-erc-response-handler (331)
1702 "Channel topic." nil 1715 "No topic set for channel." nil
1703 (let ((channel (second (erc-response.command-args parsed))) 1716 (let ((channel (second (erc-response.command-args parsed)))
1704 (topic (erc-response.contents parsed))) 1717 (topic (erc-response.contents parsed)))
1705 ;; FIXME: why don't we do anything with the topic? -- Lawrence 2004/05/10
1706 (erc-display-message parsed 'notice (erc-get-buffer channel proc) 1718 (erc-display-message parsed 'notice (erc-get-buffer channel proc)
1707 's331 ?c channel))) 1719 's331 ?c channel)))
1708 1720
@@ -1715,8 +1727,7 @@ See `erc-display-server-message'." nil
1715 's332 ?c channel ?T topic))) 1727 's332 ?c channel ?T topic)))
1716 1728
1717(define-erc-response-handler (333) 1729(define-erc-response-handler (333)
1718 ;; Who set the topic, and when 1730 "Who set the topic, and when." nil
1719 nil nil
1720 (multiple-value-bind (channel nick time) 1731 (multiple-value-bind (channel nick time)
1721 (cdr (erc-response.command-args parsed)) 1732 (cdr (erc-response.command-args parsed))
1722 (setq time (format-time-string "%T %Y/%m/%d" 1733 (setq time (format-time-string "%T %Y/%m/%d"
@@ -1766,7 +1777,7 @@ See `erc-display-server-message'." nil
1766 (erc-channel-end-receiving-names))) 1777 (erc-channel-end-receiving-names)))
1767 1778
1768(define-erc-response-handler (367) 1779(define-erc-response-handler (367)
1769 "Channel ban list entries" nil 1780 "Channel ban list entries." nil
1770 (multiple-value-bind (channel banmask setter time) 1781 (multiple-value-bind (channel banmask setter time)
1771 (cdr (erc-response.command-args parsed)) 1782 (cdr (erc-response.command-args parsed))
1772 ;; setter and time are not standard 1783 ;; setter and time are not standard
@@ -1781,7 +1792,7 @@ See `erc-display-server-message'." nil
1781 ?b banmask)))) 1792 ?b banmask))))
1782 1793
1783(define-erc-response-handler (368) 1794(define-erc-response-handler (368)
1784 "End of channel ban list" nil 1795 "End of channel ban list." nil
1785 (let ((channel (second (erc-response.command-args parsed)))) 1796 (let ((channel (second (erc-response.command-args parsed))))
1786 (erc-display-message parsed 'notice 'active 's368 1797 (erc-display-message parsed 'notice 'active 's368
1787 ?c channel))) 1798 ?c channel)))
@@ -1797,7 +1808,7 @@ See `erc-display-server-message'." nil
1797 's379 ?c from ?f to))) 1808 's379 ?c from ?f to)))
1798 1809
1799(define-erc-response-handler (391) 1810(define-erc-response-handler (391)
1800 "Server's time string" nil 1811 "Server's time string." nil
1801 (erc-display-message 1812 (erc-display-message
1802 parsed 'notice 'active 1813 parsed 'notice 'active
1803 's391 ?s (second (erc-response.command-args parsed)) 1814 's391 ?s (second (erc-response.command-args parsed))
@@ -1824,56 +1835,47 @@ See `erc-display-server-message'." nil
1824 1835
1825 1836
1826(define-erc-response-handler (405) 1837(define-erc-response-handler (405)
1827 ;; Can't join that many channels. 1838 "Can't join that many channels." nil
1828 nil nil
1829 (erc-display-message parsed '(notice error) 'active 1839 (erc-display-message parsed '(notice error) 'active
1830 's405 ?c (second (erc-response.command-args parsed)))) 1840 's405 ?c (second (erc-response.command-args parsed))))
1831 1841
1832(define-erc-response-handler (406) 1842(define-erc-response-handler (406)
1833 ;; No such nick 1843 "No such nick." nil
1834 nil nil
1835 (erc-display-message parsed '(notice error) 'active 1844 (erc-display-message parsed '(notice error) 'active
1836 's406 ?n (second (erc-response.command-args parsed)))) 1845 's406 ?n (second (erc-response.command-args parsed))))
1837 1846
1838(define-erc-response-handler (412) 1847(define-erc-response-handler (412)
1839 ;; No text to send 1848 "No text to send." nil
1840 nil nil
1841 (erc-display-message parsed '(notice error) 'active 's412)) 1849 (erc-display-message parsed '(notice error) 'active 's412))
1842 1850
1843(define-erc-response-handler (421) 1851(define-erc-response-handler (421)
1844 ;; Unknown command 1852 "Unknown command." nil
1845 nil nil
1846 (erc-display-message parsed '(notice error) 'active 's421 1853 (erc-display-message parsed '(notice error) 'active 's421
1847 ?c (second (erc-response.command-args parsed)))) 1854 ?c (second (erc-response.command-args parsed))))
1848 1855
1849(define-erc-response-handler (432) 1856(define-erc-response-handler (432)
1850 ;; Bad nick. 1857 "Bad nick." nil
1851 nil nil
1852 (erc-display-message parsed '(notice error) 'active 's432 1858 (erc-display-message parsed '(notice error) 'active 's432
1853 ?n (second (erc-response.command-args parsed)))) 1859 ?n (second (erc-response.command-args parsed))))
1854 1860
1855(define-erc-response-handler (433) 1861(define-erc-response-handler (433)
1856 ;; Login-time "nick in use" 1862 "Login-time \"nick in use\"." nil
1857 nil nil
1858 (erc-nickname-in-use (second (erc-response.command-args parsed)) 1863 (erc-nickname-in-use (second (erc-response.command-args parsed))
1859 "already in use")) 1864 "already in use"))
1860 1865
1861(define-erc-response-handler (437) 1866(define-erc-response-handler (437)
1862 ;; Nick temporarily unavailable (IRCnet) 1867 "Nick temporarily unavailable (on IRCnet)." nil
1863 nil nil
1864 (let ((nick/channel (second (erc-response.command-args parsed)))) 1868 (let ((nick/channel (second (erc-response.command-args parsed))))
1865 (unless (erc-channel-p nick/channel) 1869 (unless (erc-channel-p nick/channel)
1866 (erc-nickname-in-use nick/channel "temporarily unavailable")))) 1870 (erc-nickname-in-use nick/channel "temporarily unavailable"))))
1867 1871
1868(define-erc-response-handler (442) 1872(define-erc-response-handler (442)
1869 ;; Not on channel 1873 "Not on channel." nil
1870 nil nil
1871 (erc-display-message parsed '(notice error) 'active 's442 1874 (erc-display-message parsed '(notice error) 'active 's442
1872 ?c (second (erc-response.command-args parsed)))) 1875 ?c (second (erc-response.command-args parsed))))
1873 1876
1874(define-erc-response-handler (461) 1877(define-erc-response-handler (461)
1875 ;; Not enough params for command. 1878 "Not enough parameters for command." nil
1876 nil nil
1877 (erc-display-message parsed '(notice error) 'active 's461 1879 (erc-display-message parsed '(notice error) 'active 's461
1878 ?c (second (erc-response.command-args parsed)) 1880 ?c (second (erc-response.command-args parsed))
1879 ?m (erc-response.contents parsed))) 1881 ?m (erc-response.contents parsed)))
@@ -1887,7 +1889,7 @@ See `erc-display-server-message'." nil
1887 (erc-response.contents parsed))) 1889 (erc-response.contents parsed)))
1888 1890
1889(define-erc-response-handler (474) 1891(define-erc-response-handler (474)
1890 "Banned from channel errors" nil 1892 "Banned from channel errors." nil
1891 (erc-display-message parsed '(notice error) nil 1893 (erc-display-message parsed '(notice error) nil
1892 (intern (format "s%s" 1894 (intern (format "s%s"
1893 (erc-response.command parsed))) 1895 (erc-response.command parsed)))
@@ -1906,14 +1908,14 @@ See `erc-display-server-message'." nil
1906 (erc-cmd-JOIN channel key))))) 1908 (erc-cmd-JOIN channel key)))))
1907 1909
1908(define-erc-response-handler (477) 1910(define-erc-response-handler (477)
1909 nil nil 1911 "Channel doesn't support modes." nil
1910 (let ((channel (second (erc-response.command-args parsed))) 1912 (let ((channel (second (erc-response.command-args parsed)))
1911 (message (erc-response.contents parsed))) 1913 (message (erc-response.contents parsed)))
1912 (erc-display-message parsed 'notice (erc-get-buffer channel proc) 1914 (erc-display-message parsed 'notice (erc-get-buffer channel proc)
1913 (format "%s: %s" channel message)))) 1915 (format "%s: %s" channel message))))
1914 1916
1915(define-erc-response-handler (482) 1917(define-erc-response-handler (482)
1916 nil nil 1918 "You need to be a channel operator to do that." nil
1917 (let ((channel (second (erc-response.command-args parsed))) 1919 (let ((channel (second (erc-response.command-args parsed)))
1918 (message (erc-response.contents parsed))) 1920 (message (erc-response.contents parsed)))
1919 (erc-display-message parsed '(error notice) 'active 's482 1921 (erc-display-message parsed '(error notice) 'active 's482
@@ -1935,7 +1937,9 @@ See `erc-display-server-message'." nil
1935 ;; 491 - No O-lines for your host 1937 ;; 491 - No O-lines for your host
1936 ;; 501 - Unknown MODE flag 1938 ;; 501 - Unknown MODE flag
1937 ;; 502 - Cannot change mode for other users 1939 ;; 502 - Cannot change mode for other users
1938 nil nil 1940 "Generic display of server error messages.
1941
1942See `erc-display-error-notice'." nil
1939 (erc-display-error-notice 1943 (erc-display-error-notice
1940 parsed 1944 parsed
1941 (intern (format "s%s" (erc-response.command parsed))))) 1945 (intern (format "s%s" (erc-response.command parsed)))))
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index a74d56b90bd..7e45c6cd4ea 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -57,16 +57,15 @@
57 ((add-hook 'erc-insert-modify-hook 'erc-button-add-buttons 'append) 57 ((add-hook 'erc-insert-modify-hook 'erc-button-add-buttons 'append)
58 (add-hook 'erc-send-modify-hook 'erc-button-add-buttons 'append) 58 (add-hook 'erc-send-modify-hook 'erc-button-add-buttons 'append)
59 (add-hook 'erc-complete-functions 'erc-button-next) 59 (add-hook 'erc-complete-functions 'erc-button-next)
60 (add-hook 'erc-mode-hook 'erc-button-add-keys)) 60 (add-hook 'erc-mode-hook 'erc-button-setup))
61 ((remove-hook 'erc-insert-modify-hook 'erc-button-add-buttons) 61 ((remove-hook 'erc-insert-modify-hook 'erc-button-add-buttons)
62 (remove-hook 'erc-send-modify-hook 'erc-button-add-buttons) 62 (remove-hook 'erc-send-modify-hook 'erc-button-add-buttons)
63 (remove-hook 'erc-complete-functions 'erc-button-next) 63 (remove-hook 'erc-complete-functions 'erc-button-next)
64 (remove-hook 'erc-mode-hook 'erc-button-add-keys))) 64 (remove-hook 'erc-mode-hook 'erc-button-setup)
65 65 (when (featurep 'xemacs)
66;; Make XEmacs use `erc-button-face'. 66 (dolist (buffer (erc-buffer-list))
67(when (featurep 'xemacs) 67 (with-current-buffer buffer
68 (add-hook 'erc-mode-hook 68 (kill-local-variable 'widget-button-face))))))
69 (lambda () (set (make-local-variable 'widget-button-face) nil))))
70 69
71;;; Variables 70;;; Variables
72 71
@@ -247,8 +246,12 @@ constituents.")
247 "Internal variable used to keep track of whether we've added the 246 "Internal variable used to keep track of whether we've added the
248global-level ERC button keys yet.") 247global-level ERC button keys yet.")
249 248
250(defun erc-button-add-keys () 249(defun erc-button-setup ()
251 "Add ERC mode-level button movement keys. This is only done once." 250 "Add ERC mode-level button movement keys. This is only done once."
251 ;; Make XEmacs use `erc-button-face'.
252 (when (featurep 'xemacs)
253 (set (make-local-variable 'widget-button-face) nil))
254 ;; Add keys.
252 (unless erc-button-keys-added 255 (unless erc-button-keys-added
253 (define-key erc-mode-map (kbd "<backtab>") 'erc-button-previous) 256 (define-key erc-mode-map (kbd "<backtab>") 'erc-button-previous)
254 (setq erc-button-keys-added t))) 257 (setq erc-button-keys-added t)))
@@ -299,9 +302,10 @@ specified by `erc-button-alist'."
299 (setq bounds (bounds-of-thing-at-point 'word)) 302 (setq bounds (bounds-of-thing-at-point 'word))
300 (setq word (buffer-substring-no-properties 303 (setq word (buffer-substring-no-properties
301 (car bounds) (cdr bounds))) 304 (car bounds) (cdr bounds)))
302 (if (erc-get-server-user word) 305 (when (or (and (erc-server-buffer-p) (erc-get-server-user word))
303 (erc-button-add-button (car bounds) (cdr bounds) 306 (and erc-channel-users (erc-get-channel-user word)))
304 fun t (list word))))))) 307 (erc-button-add-button (car bounds) (cdr bounds)
308 fun t (list word)))))))
305 309
306(defun erc-button-add-buttons-1 (regexp entry) 310(defun erc-button-add-buttons-1 (regexp entry)
307 "Search through the buffer for matches to ENTRY and add buttons." 311 "Search through the buffer for matches to ENTRY and add buttons."
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index d99d8fca7da..dd01280b3aa 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -88,53 +88,6 @@ See `replace-match' for explanations of FIXEDCASE and LITERAL."
88(defalias 'erc-make-obsolete 'make-obsolete) 88(defalias 'erc-make-obsolete 'make-obsolete)
89(defalias 'erc-make-obsolete-variable 'make-obsolete-variable) 89(defalias 'erc-make-obsolete-variable 'make-obsolete-variable)
90 90
91;; Provde an equivalent of `assert', based on the code from cl-macs.el
92(defun erc-const-expr-p (x)
93 (cond ((consp x)
94 (or (eq (car x) 'quote)
95 (and (memq (car x) '(function function*))
96 (or (symbolp (nth 1 x))
97 (and (eq (and (consp (nth 1 x))
98 (car (nth 1 x))) 'lambda) 'func)))))
99 ((symbolp x) (and (memq x '(nil t)) t))
100 (t t)))
101
102(put 'erc-assertion-failed 'error-conditions '(error))
103(put 'erc-assertion-failed 'error-message "Assertion failed")
104
105(defun erc-list* (arg &rest rest)
106 "Return a new list with specified args as elements, cons'd to last arg.
107Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
108`(cons A (cons B (cons C D)))'."
109 (cond ((not rest) arg)
110 ((not (cdr rest)) (cons arg (car rest)))
111 (t (let* ((n (length rest))
112 (copy (copy-sequence rest))
113 (last (nthcdr (- n 2) copy)))
114 (setcdr last (car (cdr last)))
115 (cons arg copy)))))
116
117(defmacro erc-assert (form &optional show-args string &rest args)
118 "Verify that FORM returns non-nil; signal an error if not.
119Second arg SHOW-ARGS means to include arguments of FORM in message.
120Other args STRING and ARGS... are arguments to be passed to `error'.
121They are not evaluated unless the assertion fails. If STRING is
122omitted, a default message listing FORM itself is used."
123 (let ((sargs
124 (and show-args
125 (delq nil (mapcar
126 (function
127 (lambda (x)
128 (and (not (erc-const-expr-p x)) x)))
129 (cdr form))))))
130 (list 'progn
131 (list 'or form
132 (if string
133 (erc-list* 'error string (append sargs args))
134 (list 'signal '(quote erc-assertion-failed)
135 (erc-list* 'list (list 'quote form) sargs))))
136 nil)))
137
138;; Provide a simpler replacement for `member-if' 91;; Provide a simpler replacement for `member-if'
139(defun erc-member-if (predicate list) 92(defun erc-member-if (predicate list)
140 "Find the first item satisfying PREDICATE in LIST. 93 "Find the first item satisfying PREDICATE in LIST.
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 8158c0999d3..2aca06479f6 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -60,6 +60,12 @@
60 (require 'cl) 60 (require 'cl)
61 (require 'pcomplete)) 61 (require 'pcomplete))
62 62
63;;;###autoload (autoload 'erc-dcc-mode "erc-dcc")
64(define-erc-module dcc nil
65 "Provide Direct Client-to-Client support for ERC."
66 ((add-hook 'erc-server-401-functions 'erc-dcc-no-such-nick))
67 ((remove-hook 'erc-server-401-functions 'erc-dcc-no-such-nick)))
68
63(defgroup erc-dcc nil 69(defgroup erc-dcc nil
64 "DCC stands for Direct Client Communication, where you and your 70 "DCC stands for Direct Client Communication, where you and your
65friend's client programs connect directly to each other, 71friend's client programs connect directly to each other,
@@ -70,7 +76,7 @@ Using DCC get and send, you can transfer files directly from and to other
70IRC users." 76IRC users."
71 :group 'erc) 77 :group 'erc)
72 78
73(defcustom erc-verbose-dcc t 79(defcustom erc-dcc-verbose nil
74 "*If non-nil, be verbose about DCC activity reporting." 80 "*If non-nil, be verbose about DCC activity reporting."
75 :group 'erc-dcc 81 :group 'erc-dcc
76 :type 'boolean) 82 :type 'boolean)
@@ -195,20 +201,22 @@ compared with `erc-nick-equal-p' which is IRC case-insensitive."
195 (setq list (cdr list))))) 201 (setq list (cdr list)))))
196 result)) 202 result))
197 203
198;; msa wrote this nifty little frob to convert an n-byte integer to a packed 204(defun erc-pack-int (value)
199;; string. 205 "Convert an integer into a packed string."
200(defun erc-pack-int (value count) 206 (let* ((len (ceiling (/ value 256.0)))
201 (if (> count 0) 207 (str (make-string len ?a))
202 (concat (erc-pack-int (/ value 256) (1- count)) 208 (i (1- len)))
203 (char-to-string (% value 256))) 209 (while (>= i 0)
204 "")) 210 (aset str i (% value 256))
211 (setq value (/ value 256))
212 (setq i (1- i)))
213 str))
205 214
206(defun erc-unpack-int (str) 215(defun erc-unpack-int (str)
207 "Unpack a 1-4 character packed string into an integer." 216 "Unpack a packed string into an integer."
208 (let ((len (length str)) 217 (let ((len (length str))
209 (num 0) 218 (num 0)
210 (count 0)) 219 (count 0))
211 (erc-assert (<= len 4)) ;; this isn't going to fit in elisp bounds
212 (while (< count len) 220 (while (< count len)
213 (setq num (+ num (lsh (aref str (- len count 1)) (* 8 count)))) 221 (setq num (+ num (lsh (aref str (- len count 1)) (* 8 count))))
214 (setq count (1+ count))) 222 (setq count (1+ count)))
@@ -256,15 +264,24 @@ The result is also a string."
256 264
257;;; Server code 265;;; Server code
258 266
259(defcustom erc-dcc-host nil 267(defcustom erc-dcc-listen-host nil
260 "*IP address to use for outgoing DCC offers. 268 "IP address to listen on when offering files.
261Should be set to a string or nil, if nil, automatic detection of the 269Should be set to a string or nil. If nil, automatic detection of
262host interface to use will be attempted." 270the host interface to use will be attempted."
263 :group 'erc-dcc 271 :group 'erc-dcc
264 :type (list 'choice (list 'const :tag "Auto-detect" nil) 272 :type (list 'choice (list 'const :tag "Auto-detect" nil)
265 (list 'string :tag "IP-address" 273 (list 'string :tag "IP-address"
266 :valid-regexp erc-dcc-ipv4-regexp))) 274 :valid-regexp erc-dcc-ipv4-regexp)))
267 275
276(defcustom erc-dcc-public-host nil
277 "IP address to use for outgoing DCC offers.
278Should be set to a string or nil. If nil, use the value of
279`erc-dcc-listen-host'."
280 :group 'erc-dcc
281 :type (list 'choice (list 'const :tag "Same as erc-dcc-listen-host" nil)
282 (list 'string :tag "IP-address"
283 :valid-regexp erc-dcc-ipv4-regexp)))
284
268(defcustom erc-dcc-send-request 'ask 285(defcustom erc-dcc-send-request 'ask
269 "*How to treat incoming DCC Send requests. 286 "*How to treat incoming DCC Send requests.
270'ask - Report the Send request, and wait for the user to manually accept it 287'ask - Report the Send request, and wait for the user to manually accept it
@@ -282,7 +299,7 @@ host interface to use will be attempted."
282 "Determine the IP address we are using. 299 "Determine the IP address we are using.
283If variable `erc-dcc-host' is non-nil, use it. Otherwise call 300If variable `erc-dcc-host' is non-nil, use it. Otherwise call
284`erc-dcc-get-host' on the erc-server-process." 301`erc-dcc-get-host' on the erc-server-process."
285 (or erc-dcc-host (erc-dcc-get-host erc-server-process) 302 (or erc-dcc-listen-host (erc-dcc-get-host erc-server-process)
286 (error "Unable to determine local address"))) 303 (error "Unable to determine local address")))
287 304
288(defcustom erc-dcc-port-range nil 305(defcustom erc-dcc-port-range nil
@@ -311,6 +328,7 @@ created subprocess, or nil."
311 process) 328 process)
312 (while (not process) 329 (while (not process)
313 (condition-case err 330 (condition-case err
331 (progn
314 (setq process 332 (setq process
315 (make-network-process :name name 333 (make-network-process :name name
316 :buffer nil 334 :buffer nil
@@ -322,6 +340,11 @@ created subprocess, or nil."
322 :sentinel sentinel 340 :sentinel sentinel
323 :log #'erc-dcc-server-accept 341 :log #'erc-dcc-server-accept
324 :server t)) 342 :server t))
343 (when (processp process)
344 (when (fboundp 'set-process-coding-system)
345 (set-process-coding-system process 'binary 'binary))
346 (when (fboundp 'set-process-filter-multibyte)
347 (set-process-filter-multibyte process nil))))
325 (file-error 348 (file-error
326 (unless (and (string= "Cannot bind server socket" (cadr err)) 349 (unless (and (string= "Cannot bind server socket" (cadr err))
327 (string= "address already in use" (caddr err))) 350 (string= "address already in use" (caddr err)))
@@ -698,7 +721,7 @@ bytes sent."
698 (confirmed-marker (plist-get elt :sent)) 721 (confirmed-marker (plist-get elt :sent))
699 (sent-marker (plist-get elt :sent))) 722 (sent-marker (plist-get elt :sent)))
700 (with-current-buffer (process-buffer proc) 723 (with-current-buffer (process-buffer proc)
701 (when erc-verbose-dcc 724 (when erc-dcc-verbose
702 (erc-display-message 725 (erc-display-message
703 nil 'notice (erc-dcc-get-parent proc) 726 nil 'notice (erc-dcc-get-parent proc)
704 (format "DCC: Confirmed %d, sent %d, sending block now" 727 (format "DCC: Confirmed %d, sent %d, sending block now"
@@ -713,8 +736,7 @@ bytes sent."
713 (length string))))) 736 (length string)))))
714 737
715(defun erc-dcc-send-filter (proc string) 738(defun erc-dcc-send-filter (proc string)
716 (erc-assert (= (% (length string) 4) 0)) 739 (let* ((size (erc-unpack-int string))
717 (let* ((size (erc-unpack-int (substring string (- (length string) 4))))
718 (elt (erc-dcc-member :peer proc)) 740 (elt (erc-dcc-member :peer proc))
719 (parent (plist-get elt :parent)) 741 (parent (plist-get elt :parent))
720 (sent-marker (plist-get elt :sent)) 742 (sent-marker (plist-get elt :sent))
@@ -742,16 +764,21 @@ bytes sent."
742 ((> confirmed-marker sent-marker) 764 ((> confirmed-marker sent-marker)
743 (erc-display-message 765 (erc-display-message
744 nil 'notice parent 766 nil 'notice parent
745 (format "DCC: Client confirmed too much!")) 767 (format "DCC: Client confirmed too much (%s vs %s)!"
768 (marker-position confirmed-marker)
769 (marker-position sent-marker)))
770 (set-buffer-modified-p nil)
771 (kill-buffer (current-buffer))
746 (delete-process proc)))))) 772 (delete-process proc))))))
747 773
774(defun erc-dcc-display-send (proc)
775 (erc-display-message
776 nil 'notice (erc-dcc-get-parent proc)
777 (format "DCC: SEND connect from %s"
778 (format-network-address (process-contact proc :remote)))))
779
748(defcustom erc-dcc-send-connect-hook 780(defcustom erc-dcc-send-connect-hook
749 '((lambda (proc) 781 '(erc-dcc-display-send erc-dcc-send-block)
750 (erc-display-message
751 nil 'notice (erc-dcc-get-parent proc)
752 (format "DCC: SEND connect from %s"
753 (format-network-address (process-contact proc :remote)))))
754 erc-dcc-send-block)
755 "*Hook run whenever the remote end of a DCC SEND offer connected to your 782 "*Hook run whenever the remote end of a DCC SEND offer connected to your
756listening port." 783listening port."
757 :group 'erc-dcc 784 :group 'erc-dcc
@@ -762,14 +789,14 @@ listening port."
762 (erc-extract-nick (plist-get plist :nick))) 789 (erc-extract-nick (plist-get plist :nick)))
763 790
764(defun erc-dcc-send-sentinel (proc event) 791(defun erc-dcc-send-sentinel (proc event)
765 (let* ((elt (erc-dcc-member :peer proc)) 792 (let* ((elt (erc-dcc-member :peer proc)))
766 (buf (marker-buffer (plist-get elt :sent))))
767 (cond 793 (cond
768 ((string-match "^open from " event) 794 ((string-match "^open from " event)
769 (when elt 795 (when elt
770 (with-current-buffer buf 796 (let ((buf (marker-buffer (plist-get elt :sent))))
771 (set-process-buffer proc buf) 797 (with-current-buffer buf
772 (setq erc-dcc-entry-data elt)) 798 (set-process-buffer proc buf)
799 (setq erc-dcc-entry-data elt)))
773 (run-hook-with-args 'erc-dcc-send-connect-hook proc)))))) 800 (run-hook-with-args 'erc-dcc-send-connect-hook proc))))))
774 801
775(defun erc-dcc-find-file (file) 802(defun erc-dcc-find-file (file)
@@ -807,15 +834,23 @@ other client."
807 (process-send-string 834 (process-send-string
808 pproc (format "PRIVMSG %s :\C-aDCC SEND %s %s %d %d\C-a\n" 835 pproc (format "PRIVMSG %s :\C-aDCC SEND %s %s %d %d\C-a\n"
809 nick (erc-dcc-file-to-name file) 836 nick (erc-dcc-file-to-name file)
810 (erc-ip-to-decimal (nth 0 contact)) 837 (erc-ip-to-decimal (or erc-dcc-public-host
838 (nth 0 contact)))
811 (nth 1 contact) 839 (nth 1 contact)
812 size))) 840 size)))
813 (error "`make-network-process' not supported by your Emacs"))) 841 (error "`make-network-process' not supported by your Emacs")))
814 842
815;;; GET handling 843;;; GET handling
816 844
845(defcustom erc-dcc-receive-cache (* 1024 512)
846 "Number of bytes to let the receive buffer grow before flushing it."
847 :group 'erc-dcc
848 :type 'integer)
849
817(defvar erc-dcc-byte-count nil) 850(defvar erc-dcc-byte-count nil)
818(make-variable-buffer-local 'erc-dcc-byte-count) 851(make-variable-buffer-local 'erc-dcc-byte-count)
852(defvar erc-dcc-file-name nil)
853(make-variable-buffer-local 'erc-dcc-file-name)
819 854
820(defun erc-dcc-get-file (entry file parent-proc) 855(defun erc-dcc-get-file (entry file parent-proc)
821 "This function does the work of setting up a transfer from the remote client 856 "This function does the work of setting up a transfer from the remote client
@@ -825,6 +860,7 @@ filter and a process sentinel, and making the connection."
825 proc) 860 proc)
826 (with-current-buffer buffer 861 (with-current-buffer buffer
827 (fundamental-mode) 862 (fundamental-mode)
863 (buffer-disable-undo (current-buffer))
828 ;; This is necessary to have the buffer saved as-is in GNU 864 ;; This is necessary to have the buffer saved as-is in GNU
829 ;; Emacs. 865 ;; Emacs.
830 ;; XEmacs change: We don't have `set-buffer-multibyte', setting 866 ;; XEmacs change: We don't have `set-buffer-multibyte', setting
@@ -835,7 +871,10 @@ filter and a process sentinel, and making the connection."
835 (setq mode-line-process '(":%s") 871 (setq mode-line-process '(":%s")
836 buffer-file-type t 872 buffer-file-type t
837 buffer-read-only t) 873 buffer-read-only t)
838 (set-visited-file-name file) 874 (setq erc-dcc-file-name file)
875
876 ;; Truncate the given file to size 0 before appending to it.
877 (write-region (point) (point) erc-dcc-file-name nil 'nomessage)
839 878
840 (setq erc-server-process parent-proc 879 (setq erc-server-process parent-proc
841 erc-dcc-entry-data entry) 880 erc-dcc-entry-data entry)
@@ -847,7 +886,6 @@ filter and a process sentinel, and making the connection."
847 (string-to-number (plist-get entry :port)) 886 (string-to-number (plist-get entry :port))
848 entry)) 887 entry))
849 (set-process-buffer proc buffer) 888 (set-process-buffer proc buffer)
850 ;; The following two lines make saving as-is work under Windows
851 (set-process-coding-system proc 'binary 'binary) 889 (set-process-coding-system proc 'binary 'binary)
852 (set-buffer-file-coding-system 'binary t) 890 (set-buffer-file-coding-system 'binary t)
853 891
@@ -856,6 +894,14 @@ filter and a process sentinel, and making the connection."
856 (setq entry (plist-put entry :start-time (erc-current-time))) 894 (setq entry (plist-put entry :start-time (erc-current-time)))
857 (setq entry (plist-put entry :peer proc))))) 895 (setq entry (plist-put entry :peer proc)))))
858 896
897(defun erc-dcc-append-contents (buffer file)
898 "Append the contents of BUFFER to FILE.
899The contents of the BUFFER will then be erased."
900 (with-current-buffer buffer
901 (let ((coding-system-for-write 'binary))
902 (write-region (point-min) (point-max) erc-dcc-file-name t 'nomessage)
903 (erase-buffer))))
904
859(defun erc-dcc-get-filter (proc str) 905(defun erc-dcc-get-filter (proc str)
860 "This is the process filter for transfers from other clients to this one. 906 "This is the process filter for transfers from other clients to this one.
861It reads incoming bytes from the network and stores them in the DCC 907It reads incoming bytes from the network and stores them in the DCC
@@ -868,8 +914,10 @@ rather than every 1024 byte block, but nobody seems to care."
868 (insert (string-make-unibyte str)) 914 (insert (string-make-unibyte str))
869 915
870 (setq erc-dcc-byte-count (+ (length str) erc-dcc-byte-count)) 916 (setq erc-dcc-byte-count (+ (length str) erc-dcc-byte-count))
871 (erc-assert (= erc-dcc-byte-count (1- (point-max)))) 917 (when (> (point-max) erc-dcc-receive-cache)
872 (and erc-verbose-dcc 918 (erc-dcc-append-contents (current-buffer) erc-dcc-file-name))
919
920 (and erc-dcc-verbose
873 (erc-display-message 921 (erc-display-message
874 nil 'notice erc-server-process 922 nil 'notice erc-server-process
875 'dcc-get-bytes-received 923 'dcc-get-bytes-received
@@ -885,7 +933,7 @@ rather than every 1024 byte block, but nobody seems to care."
885 (delete-process proc)) 933 (delete-process proc))
886 (t 934 (t
887 (process-send-string 935 (process-send-string
888 proc (erc-pack-int erc-dcc-byte-count 4))))))) 936 proc (erc-pack-int erc-dcc-byte-count)))))))
889 937
890 938
891(defun erc-dcc-get-sentinel (proc event) 939(defun erc-dcc-get-sentinel (proc event)
@@ -895,17 +943,18 @@ transfer is complete."
895 ;; FIXME, we should look at EVENT, and also check size. 943 ;; FIXME, we should look at EVENT, and also check size.
896 (with-current-buffer (process-buffer proc) 944 (with-current-buffer (process-buffer proc)
897 (delete-process proc) 945 (delete-process proc)
898 (setq buffer-read-only nil)
899 (setq erc-dcc-list (delete erc-dcc-entry-data erc-dcc-list)) 946 (setq erc-dcc-list (delete erc-dcc-entry-data erc-dcc-list))
947 (unless (= (point-min) (point-max))
948 (setq erc-dcc-byte-count (+ (buffer-size) erc-dcc-byte-count))
949 (erc-dcc-append-contents (current-buffer) erc-dcc-file-name))
900 (erc-display-message 950 (erc-display-message
901 nil 'notice erc-server-process 951 nil 'notice erc-server-process
902 'dcc-get-complete 952 'dcc-get-complete
903 ?f (file-name-nondirectory buffer-file-name) 953 ?f erc-dcc-file-name
904 ?s (number-to-string (buffer-size)) 954 ?s (number-to-string erc-dcc-byte-count)
905 ?t (format "%.0f" 955 ?t (format "%.0f"
906 (erc-time-diff (plist-get erc-dcc-entry-data :start-time) 956 (erc-time-diff (plist-get erc-dcc-entry-data :start-time)
907 (erc-current-time)))) 957 (erc-current-time)))))
908 (save-buffer))
909 (kill-buffer (process-buffer proc)) 958 (kill-buffer (process-buffer proc))
910 (delete-process proc)) 959 (delete-process proc))
911 960
@@ -1126,8 +1175,6 @@ other client."
1126 (if (processp peer) (delete-process peer))) 1175 (if (processp peer) (delete-process peer)))
1127 nil)) 1176 nil))
1128 1177
1129(add-hook 'erc-server-401-functions 'erc-dcc-no-such-nick)
1130
1131(provide 'erc-dcc) 1178(provide 'erc-dcc)
1132 1179
1133;;; erc-dcc.el ends here 1180;;; erc-dcc.el ends here
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 9612b001156..ff065467f84 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -33,10 +33,14 @@
33 33
34(require 'erc) 34(require 'erc)
35 35
36;; Imenu Autoload 36;;; Imenu support
37(add-hook 'erc-mode-hook 37
38 (lambda () 38(defun erc-imenu-setup ()
39 (setq imenu-create-index-function 'erc-create-imenu-index))) 39 "Setup Imenu support in an ERC buffer."
40 (set (make-local-variable 'imenu-create-index-function)
41 'erc-create-imenu-index))
42
43(add-hook 'erc-mode-hook 'erc-imenu-setup)
40(autoload 'erc-create-imenu-index "erc-imenu" "Imenu index creation function") 44(autoload 'erc-create-imenu-index "erc-imenu" "Imenu index creation function")
41 45
42;;; Automatically scroll to bottom 46;;; Automatically scroll to bottom
@@ -51,11 +55,15 @@ argument to `recenter'."
51 :type '(choice integer (const nil))) 55 :type '(choice integer (const nil)))
52 56
53(define-erc-module scrolltobottom nil 57(define-erc-module scrolltobottom nil
54 "This mode causes the prompt to stay at the end of the window. 58 "This mode causes the prompt to stay at the end of the window."
55You have to activate or deactivate it in already created windows 59 ((add-hook 'erc-mode-hook 'erc-add-scroll-to-bottom)
56separately." 60 (dolist (buffer (erc-buffer-list))
57 ((add-hook 'erc-mode-hook 'erc-add-scroll-to-bottom)) 61 (with-current-buffer buffer
58 ((remove-hook 'erc-mode-hook 'erc-add-scroll-to-bottom))) 62 (erc-add-scroll-to-bottom))))
63 ((remove-hook 'erc-mode-hook 'erc-add-scroll-to-bottom)
64 (dolist (buffer (erc-buffer-list))
65 (with-current-buffer buffer
66 (remove-hook 'window-scroll-functions 'erc-scroll-to-bottom t)))))
59 67
60(defun erc-add-scroll-to-bottom () 68(defun erc-add-scroll-to-bottom ()
61 "A hook function for `erc-mode-hook' to recenter output at bottom of window. 69 "A hook function for `erc-mode-hook' to recenter output at bottom of window.
@@ -110,7 +118,46 @@ Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'."
110 (put-text-property (point-min) (point-max) 'front-sticky t) 118 (put-text-property (point-min) (point-max) 'front-sticky t)
111 (put-text-property (point-min) (point-max) 'rear-nonsticky t)) 119 (put-text-property (point-min) (point-max) 'rear-nonsticky t))
112 120
113;; Distinguish non-commands 121;;; Move to prompt when typing text
122(define-erc-module move-to-prompt nil
123 "This mode causes the point to be moved to the prompt when typing text."
124 ((add-hook 'erc-mode-hook 'erc-move-to-prompt-setup)
125 (dolist (buffer (erc-buffer-list))
126 (with-current-buffer buffer
127 (erc-move-to-prompt-setup))))
128 ((remove-hook 'erc-mode-hook 'erc-move-to-prompt-setup)
129 (dolist (buffer (erc-buffer-list))
130 (with-current-buffer buffer
131 (remove-hook 'pre-command-hook 'erc-move-to-prompt t)))))
132
133(defun erc-move-to-prompt ()
134 "Move the point to the ERC prompt if this is a self-inserting command."
135 (when (and erc-input-marker (< (point) erc-input-marker)
136 (eq 'self-insert-command this-command))
137 (deactivate-mark)
138 (push-mark)
139 (goto-char (point-max))))
140
141(defun erc-move-to-prompt-setup ()
142 "Initialize the move-to-prompt module for XEmacs."
143 (add-hook 'pre-command-hook 'erc-move-to-prompt nil t))
144
145;;; Keep place in unvisited channels
146(define-erc-module keep-place nil
147 "Leave point above un-viewed text in other channels."
148 ((add-hook 'erc-insert-pre-hook 'erc-keep-place))
149 ((remove-hook 'erc-insert-pre-hook 'erc-keep-place)))
150
151(defun erc-keep-place (ignored)
152 "Move point away from the last line in a non-selected ERC buffer."
153 (when (and (not (eq (window-buffer (selected-window))
154 (current-buffer)))
155 (>= (point) erc-insert-marker))
156 (deactivate-mark)
157 (goto-char (erc-beg-of-input-line))
158 (forward-line -1)))
159
160;;; Distinguish non-commands
114(defvar erc-noncommands-list '(erc-cmd-ME 161(defvar erc-noncommands-list '(erc-cmd-ME
115 erc-cmd-COUNTRY 162 erc-cmd-COUNTRY
116 erc-cmd-SV 163 erc-cmd-SV
@@ -496,8 +543,19 @@ channel that has weird people talking in morse to each other.
496 543
497See also `unmorse-region'." 544See also `unmorse-region'."
498 (goto-char (point-min)) 545 (goto-char (point-min))
499 (when (re-search-forward "[.-]+\\([.-]+[/ ]\\)+[.-]+" nil t) 546 (when (re-search-forward "[.-]+\\([.-]*/? *\\)+[.-]+/?" nil t)
500 (unmorse-region (match-beginning 0) (match-end 0)))) 547 (save-restriction
548 (narrow-to-region (match-beginning 0) (match-end 0))
549 ;; Turn " / " into " "
550 (goto-char (point-min))
551 (while (re-search-forward " / " nil t)
552 (replace-match " "))
553 ;; Turn "/ " into "/"
554 (goto-char (point-min))
555 (while (re-search-forward "/ " nil t)
556 (replace-match "/"))
557 ;; Unmorse region
558 (unmorse-region (point-min) (point-max)))))
501 559
502;;; erc-occur 560;;; erc-occur
503(defun erc-occur (string &optional proc) 561(defun erc-occur (string &optional proc)
diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el
new file mode 100644
index 00000000000..586c720dd19
--- /dev/null
+++ b/lisp/erc/erc-list.el
@@ -0,0 +1,229 @@
1;;; erc-list.el --- /list support for ERC
2
3;; Copyright (C) 2008 Free Software Foundation, Inc.
4
5;; Author: Tom Tromey <tromey@redhat.com>
6;; Version: 0.1
7;; Keywords: comm
8
9;; This file is part of ERC.
10
11;; ERC is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 3, or (at your option)
14;; any later version.
15
16;; ERC is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with ERC; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;; This file provides nice support for /list in ERC.
29
30;;; Code:
31
32(require 'erc)
33
34;; This is implicitly the width of the channel name column. Pick
35;; something small enough that the topic has a chance of being
36;; readable, but long enough that most channel names won't make for
37;; strange formatting.
38(defconst erc-list-nusers-column 25)
39
40;; Width of the number-of-users column.
41(defconst erc-list-topic-column (+ erc-list-nusers-column 10))
42
43;; The list buffer. This is buffer local in the server buffer.
44(defvar erc-list-buffer nil)
45
46;; The argument to the last "/list". This is buffer local in the
47;; server buffer.
48(defvar erc-list-last-argument nil)
49
50;; The server buffer corresponding to the list buffer. This is buffer
51;; local in the list buffer.
52(defvar erc-list-server-buffer nil)
53
54;; Define module:
55;;;###autoload (autoload 'erc-list-mode "erc-list")
56(define-erc-module list nil
57 "List channels nicely in a separate buffer."
58 ((remove-hook 'erc-server-321-functions 'erc-server-321-message)
59 (remove-hook 'erc-server-322-functions 'erc-server-322-message))
60 ((erc-with-all-buffers-of-server nil
61 #'erc-open-server-buffer-p
62 (remove-hook 'erc-server-322-functions 'erc-list-handle-322 t))
63 (add-hook 'erc-server-321-functions 'erc-server-321-message t)
64 (add-hook 'erc-server-322-functions 'erc-server-322-message t)))
65
66;; Format a record for display.
67(defun erc-list-make-string (channel users topic)
68 (concat
69 channel
70 (erc-propertize " "
71 'display (list 'space :align-to erc-list-nusers-column)
72 'face 'fixed-pitch)
73 users
74 (erc-propertize " "
75 'display (list 'space :align-to erc-list-topic-column)
76 'face 'fixed-pitch)
77 topic))
78
79;; Insert a record into the list buffer.
80(defun erc-list-insert-item (channel users topic)
81 (save-excursion
82 (let ((buffer-read-only nil))
83 (goto-char (point-max))
84 (insert (erc-list-make-string channel users topic) "\n"))))
85
86(defun erc-list-join ()
87 "Join the irc channel named on this line."
88 (interactive)
89 (unless (eobp)
90 (beginning-of-line)
91 (unless (looking-at "\\([&#+!][^ \n]+\\)")
92 (error "Not looking at channel name?"))
93 (let ((chan (match-string 1)))
94 (with-current-buffer erc-list-server-buffer
95 (erc-join-channel chan)))))
96
97(defun erc-list-kill ()
98 "Kill the current ERC list buffer."
99 (interactive)
100 (kill-buffer (current-buffer)))
101
102(defun erc-list-revert ()
103 "Refresh the list of channels."
104 (interactive)
105 (with-current-buffer erc-list-server-buffer
106 (erc-cmd-LIST erc-list-last-argument)))
107
108(defun erc-list-menu-sort-by-column (&optional e)
109 "Sort the channel list by the column clicked on."
110 (interactive (list last-input-event))
111 (if e (mouse-select-window e))
112 (let* ((pos (event-start e))
113 (obj (posn-object pos))
114 (col (if obj
115 (get-text-property (cdr obj) 'column-number (car obj))
116 (get-text-property (posn-point pos) 'column-number))))
117 (let ((buffer-read-only nil))
118 (if (= col 1)
119 (sort-fields col (point-min) (point-max))
120 (sort-numeric-fields col (point-min) (point-max))))))
121
122(defvar erc-list-menu-mode-map nil
123 "Local keymap for `erc-list-mode' buffers.")
124
125(unless erc-list-menu-mode-map
126 (setq erc-list-menu-mode-map (make-keymap))
127 (suppress-keymap erc-list-menu-mode-map)
128 (define-key erc-list-menu-mode-map "k" 'erc-list-kill)
129 (define-key erc-list-menu-mode-map "j" 'erc-list-join)
130 (define-key erc-list-menu-mode-map "g" 'erc-list-revert)
131 (define-key erc-list-menu-mode-map "n" 'next-line)
132 (define-key erc-list-menu-mode-map "p" 'previous-line)
133 (define-key erc-list-menu-mode-map "q" 'quit-window))
134
135(defvar erc-list-menu-sort-button-map nil
136 "Local keymap for ERC list menu mode sorting buttons.")
137
138(unless erc-list-menu-sort-button-map
139 (let ((map (make-sparse-keymap)))
140 (define-key map [header-line mouse-1] 'erc-list-menu-sort-by-column)
141 (define-key map [follow-link] 'mouse-face)
142 (setq erc-list-menu-sort-button-map map)))
143
144;; Helper function that makes a buttonized column header.
145(defun erc-list-button (title column)
146 (erc-propertize title
147 'column-number column
148 'help-echo "mouse-1: sort by column"
149 'mouse-face 'highlight
150 'keymap erc-list-menu-sort-button-map))
151
152(define-derived-mode erc-list-menu-mode nil "ERC-List"
153 "Major mode for editing a list of irc channels."
154 (setq header-line-format
155 (concat
156 (erc-propertize " "
157 'display '(space :align-to 0)
158 'face 'fixed-pitch)
159 (erc-list-make-string (erc-list-button "Channel" 1)
160 (erc-list-button "# Users" 2)
161 "Topic")))
162 (setq truncate-lines t))
163
164(put 'erc-list-menu-mode 'mode-class 'special)
165
166;; Handle a "322" response. This response tells us about a single
167;; channel.
168(defun erc-list-handle-322 (proc parsed)
169 (let* ((args (cdr (erc-response.command-args parsed)))
170 (channel (car args))
171 (nusers (car (cdr args)))
172 (topic (erc-response.contents parsed)))
173 (when (buffer-live-p erc-list-buffer)
174 (with-current-buffer erc-list-buffer
175 (erc-list-insert-item channel nusers topic))))
176 ;; Don't let another hook run.
177 t)
178
179;; Helper function to install our 322 handler and make our buffer.
180(defun erc-list-install-322-handler (server-buffer)
181 (with-current-buffer server-buffer
182 ;; Arrange for 322 responses to insert into our buffer.
183 (add-hook 'erc-server-322-functions 'erc-list-handle-322 t t)
184 ;; Arrange for 323 (end of list) to end this.
185 (erc-once-with-server-event
186 323
187 '(progn
188 (remove-hook 'erc-server-322-functions 'erc-list-handle-322 t)))
189 ;; Find the list buffer, empty it, and display it.
190 (set (make-local-variable 'erc-list-buffer)
191 (get-buffer-create (concat "*Channels of "
192 erc-server-announced-name
193 "*")))
194 (with-current-buffer erc-list-buffer
195 (erc-list-menu-mode)
196 (setq buffer-read-only nil)
197 (erase-buffer)
198 (set (make-local-variable 'erc-list-server-buffer) server-buffer)
199 (setq buffer-read-only t))
200 (pop-to-buffer erc-list-buffer))
201 t)
202
203;; The main entry point.
204(defun erc-cmd-LIST (&optional line)
205 "Show a listing of channels on the current server in a separate window.
206
207If LINE is specified, include it with the /LIST command. It
208should usually be one or more channels, separated by commas.
209
210Please note that this function only works with IRC servers which conform
211to RFC and send the LIST header (#321) at start of list transmission."
212 (erc-with-server-buffer
213 (set (make-local-variable 'erc-list-last-argument) line)
214 (erc-once-with-server-event
215 321
216 (list 'progn
217 (list 'erc-list-install-322-handler (current-buffer)))))
218 (erc-server-send (concat "LIST :" (or (and line (substring line 1))
219 ""))))
220(put 'erc-cmd-LIST 'do-not-parse-args t)
221
222;;; erc-list.el ends here
223;;
224;; Local Variables:
225;; indent-tabs-mode: t
226;; tab-width: 8
227;; End:
228
229;; arch-tag: 99c5f9cb-6bac-4224-86bf-e394768cd1d0
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 48efd41791f..b74fdb245a4 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -28,9 +28,7 @@
28;; 28;;
29;; Usage: 29;; Usage:
30;; 30;;
31;; Put into your .emacs: 31;; This is the "networks" module.
32;;
33;; (require 'erc-networks)
34;; 32;;
35;; M-x erc-server-select provides an alternative way to connect to servers by 33;; M-x erc-server-select provides an alternative way to connect to servers by
36;; choosing networks. 34;; choosing networks.
@@ -351,6 +349,7 @@
351 ("Relicnet: Random server" Relicnet "irc.relic.net" 6667) 349 ("Relicnet: Random server" Relicnet "irc.relic.net" 6667)
352 ("Rezosup: Random server" Rezosup "irc.rezosup.org" 6667) 350 ("Rezosup: Random server" Rezosup "irc.rezosup.org" 6667)
353 ("Risanet: Random server" Risanet "irc.risanet.com" ((6667 6669))) 351 ("Risanet: Random server" Risanet "irc.risanet.com" ((6667 6669)))
352 ("Rizon: Random server" Rizon "irc.rizon.net" (6633 (6660 6669) 6697 7000 8080 9999))
354 ("Rubiks: Random server" Rubiks "irc.rubiks.net" 6667) 353 ("Rubiks: Random server" Rubiks "irc.rubiks.net" 6667)
355 ("Rusnet: EU, RU, Tomsk" Rusnet "irc.tsk.ru" ((6667 6669) (7770 7775) )) 354 ("Rusnet: EU, RU, Tomsk" Rusnet "irc.tsk.ru" ((6667 6669) (7770 7775) ))
356 ("Rusnet: EU, RU, Vladivostok" Rusnet "irc.vladivostok.ru" ((6667 6669) (7770 7775) )) 355 ("Rusnet: EU, RU, Vladivostok" Rusnet "irc.vladivostok.ru" ((6667 6669) (7770 7775) ))
@@ -765,9 +764,14 @@ network as a symbol."
765 (setq erc-network nil) 764 (setq erc-network nil)
766 nil) 765 nil)
767 766
768(add-hook 'erc-server-375-functions 'erc-set-network-name) 767(define-erc-module networks nil
769(add-hook 'erc-server-422-functions 'erc-set-network-name) 768 "Provide data about IRC networks."
770(add-hook 'erc-disconnected-hook 'erc-unset-network-name) 769 ((add-hook 'erc-server-375-functions 'erc-set-network-name)
770 (add-hook 'erc-server-422-functions 'erc-set-network-name)
771 (add-hook 'erc-disconnected-hook 'erc-unset-network-name))
772 ((remove-hook 'erc-server-375-functions 'erc-set-network-name)
773 (remove-hook 'erc-server-422-functions 'erc-set-network-name)
774 (remove-hook 'erc-disconnected-hook 'erc-unset-network-name)))
771 775
772(defun erc-ports-list (ports) 776(defun erc-ports-list (ports)
773 "Return a list of PORTS. 777 "Return a list of PORTS.
diff --git a/lisp/erc/erc-page.el b/lisp/erc/erc-page.el
index 90a2009106f..ff30bcab209 100644
--- a/lisp/erc/erc-page.el
+++ b/lisp/erc/erc-page.el
@@ -104,5 +104,11 @@ receive pages if `erc-page-mode' is on."
104 104
105(provide 'erc-page) 105(provide 'erc-page)
106 106
107;; arch-tag: 82fd2e0e-6060-4dd2-9788-8c1411e844de
108;;; erc-page.el ends here 107;;; erc-page.el ends here
108;;
109;; Local Variables:
110;; indent-tabs-mode: t
111;; tab-width: 8
112;; End:
113
114;; arch-tag: 82fd2e0e-6060-4dd2-9788-8c1411e844de
diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el
index d6713c6a442..45ce20e7fa7 100644
--- a/lisp/erc/erc-replace.el
+++ b/lisp/erc/erc-replace.el
@@ -1,6 +1,7 @@
1;; erc-replace.el -- wash and massage messages inserted into the buffer 1;; erc-replace.el -- wash and massage messages inserted into the buffer
2 2
3;; Copyright (C) 2001, 2002, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. 3;; Copyright (C) 2001, 2002, 2004, 2006, 2007,
4;; 2008 Free Software Foundation, Inc.
4 5
5;; Author: Andreas Fuchs <asf@void.at> 6;; Author: Andreas Fuchs <asf@void.at>
6;; Maintainer: Mario Lang (mlang@delysid.org) 7;; Maintainer: Mario Lang (mlang@delysid.org)
@@ -88,5 +89,11 @@ It replaces text according to `erc-replace-alist'."
88 89
89(provide 'erc-replace) 90(provide 'erc-replace)
90 91
91;; arch-tag: dd904a59-d8a6-47f8-ac3a-76b698289a18
92;;; erc-replace.el ends here 92;;; erc-replace.el ends here
93;;
94;; Local Variables:
95;; indent-tabs-mode: t
96;; tab-width: 8
97;; End:
98
99;; arch-tag: dd904a59-d8a6-47f8-ac3a-76b698289a18
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index ac57de9cd15..b25a10dc5ca 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -123,6 +123,10 @@ You can also use M-x erc-nickserv-identify-mode to change modes."
123 '(("autodetect") ("nick-change") ("both")) nil t)))) 123 '(("autodetect") ("nick-change") ("both")) nil t))))
124 (add-hook 'erc-server-NOTICE-functions 124 (add-hook 'erc-server-NOTICE-functions
125 'erc-nickserv-identification-autodetect) 125 'erc-nickserv-identification-autodetect)
126 (unless erc-networks-mode
127 ;; Force-enable networks module, because we need it to set
128 ;; erc-network for us.
129 (erc-networks-enable))
126 (cond ((eq mode 'autodetect) 130 (cond ((eq mode 'autodetect)
127 (setq erc-nickserv-identify-mode 'autodetect) 131 (setq erc-nickserv-identify-mode 'autodetect)
128 (add-hook 'erc-server-NOTICE-functions 132 (add-hook 'erc-server-NOTICE-functions
@@ -187,6 +191,7 @@ Example of use:
187 (const iip) 191 (const iip)
188 (const OFTC) 192 (const OFTC)
189 (const QuakeNet) 193 (const QuakeNet)
194 (const Rizon)
190 (const SlashNET) 195 (const SlashNET)
191 (symbol :tag "Network name")) 196 (symbol :tag "Network name"))
192 (repeat :tag "Nickname and password" 197 (repeat :tag "Nickname and password"
@@ -227,6 +232,8 @@ Example of use:
227 "IDENTIFY" nil nil nil) 232 "IDENTIFY" nil nil nil)
228 (freenode 233 (freenode
229 "NickServ!NickServ@services." 234 "NickServ!NickServ@services."
235 ;; freenode also accepts a password at login, see the `erc'
236 ;; :password argument.
230 "/msg\\s-NickServ\\s-IDENTIFY\\s-<password>" 237 "/msg\\s-NickServ\\s-IDENTIFY\\s-<password>"
231 "NickServ" 238 "NickServ"
232 "IDENTIFY" nil nil 239 "IDENTIFY" nil nil
@@ -249,9 +256,17 @@ Example of use:
249 "IDENTIFY" nil "SQUERY" nil) 256 "IDENTIFY" nil "SQUERY" nil)
250 (OFTC 257 (OFTC
251 "NickServ!services@services.oftc.net" 258 "NickServ!services@services.oftc.net"
252 "type\\s-/msg\\s-NickServ\\s-IDENTIFY\\s-password." 259 ;; OFTC's NickServ doesn't ask you to identify anymore.
260 nil
253 "NickServ" 261 "NickServ"
254 "IDENTIFY" nil nil nil) 262 "IDENTIFY" nil nil
263 "You\\s-are\\s-successfully\\s-identified\\s-as\\s-")
264 (Rizon
265 "NickServ!service@rizon.net"
266 "This\\s-nickname\\s-is\\s-registered\\s-and\\s-protected."
267 "NickServ"
268 "IDENTIFY" nil nil
269 "Password\\s-accepted\\s--\\s-you\\s-are\\s-now\\s-recognized.")
255 (QuakeNet 270 (QuakeNet
256 nil nil 271 nil nil
257 "Q@CServe.quakenet.org" 272 "Q@CServe.quakenet.org"
@@ -334,15 +349,15 @@ If this is the case, run `erc-nickserv-identified-hook'."
334 ;; continue only if we're sure it's the real nickserv for this network 349 ;; continue only if we're sure it's the real nickserv for this network
335 ;; and it's told us we've successfully identified 350 ;; and it's told us we've successfully identified
336 (when (and sender (equal sspec sender) 351 (when (and sender (equal sspec sender)
352 success-regex
337 (string-match success-regex msg)) 353 (string-match success-regex msg))
338 (erc-log "NickServ IDENTIFY success notification detected") 354 (erc-log "NickServ IDENTIFY success notification detected")
339 (run-hook-with-args 'erc-nickserv-identified-hook network nick) 355 (run-hook-with-args 'erc-nickserv-identified-hook network nick)
340 nil))) 356 nil)))
341 357
342(defun erc-nickserv-identify-autodetect (proc parsed) 358(defun erc-nickserv-identify-autodetect (proc parsed)
343 "Check for a NickServ identify request everytime a notice is received. 359 "Identify to NickServ when an identify request is received.
344Make sure it is the real NickServ for this network and that it has 360Make sure it is the real NickServ for this network.
345specifically asked the user to IDENTIFY.
346If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the 361If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the
347password for this nickname, otherwise try to send it automatically." 362password for this nickname, otherwise try to send it automatically."
348 (unless (and (null erc-nickserv-passwords) 363 (unless (and (null erc-nickserv-passwords)
@@ -356,6 +371,7 @@ password for this nickname, otherwise try to send it automatically."
356 ;; continue only if we're sure it's the real nickserv for this network 371 ;; continue only if we're sure it's the real nickserv for this network
357 ;; and it's asked us to identify 372 ;; and it's asked us to identify
358 (when (and sender (equal sspec sender) 373 (when (and sender (equal sspec sender)
374 identify-regex
359 (string-match identify-regex msg)) 375 (string-match identify-regex msg))
360 (erc-log "NickServ IDENTIFY request detected") 376 (erc-log "NickServ IDENTIFY request detected")
361 (erc-nickserv-call-identify-function nick) 377 (erc-nickserv-call-identify-function nick)
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 76a692219ca..360d92c32c5 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -101,9 +101,13 @@ disconnected from `erc-modified-channels-alist'."
101 :group 'erc-track 101 :group 'erc-track
102 :type 'boolean) 102 :type 'boolean)
103 103
104(defcustom erc-track-exclude-types '("NICK") 104(defcustom erc-track-exclude-types '("NICK" "333" "353")
105 "*List of message types to be ignored. 105 "*List of message types to be ignored.
106This list could look like '(\"JOIN\" \"PART\")." 106This list could look like '(\"JOIN\" \"PART\").
107
108By default, exclude changes of nicknames (NICK), display of who
109set the channel topic (333), and listing of users on the current
110channel (353)."
107 :group 'erc-track 111 :group 'erc-track
108 :type 'erc-message-type) 112 :type 'erc-message-type)
109 113
@@ -175,15 +179,32 @@ The faces used are the same as used for text in the buffers.
175 :type 'boolean) 179 :type 'boolean)
176 180
177(defcustom erc-track-faces-priority-list 181(defcustom erc-track-faces-priority-list
178 '(erc-error-face erc-current-nick-face erc-keyword-face erc-pal-face 182 '(erc-error-face
179 erc-nick-msg-face erc-direct-msg-face erc-button erc-dangerous-host-face 183 (erc-nick-default-face erc-current-nick-face)
180 erc-default-face erc-action-face erc-nick-default-face erc-fool-face 184 erc-current-nick-face
181 erc-notice-face erc-input-face erc-prompt-face) 185 erc-keyword-face
186 (erc-nick-default-face erc-pal-face)
187 erc-pal-face
188 erc-nick-msg-face
189 erc-direct-msg-face
190 (erc-button erc-default-face)
191 (erc-nick-default-face erc-dangerous-host-face)
192 erc-dangerous-host-face
193 erc-nick-default-face
194 (erc-nick-default-face erc-default-face)
195 erc-default-face
196 erc-action-face
197 (erc-nick-default-face erc-fool-face)
198 erc-fool-face
199 erc-notice-face
200 erc-input-face
201 erc-prompt-face)
182 "A list of faces used to highlight active buffer names in the modeline. 202 "A list of faces used to highlight active buffer names in the modeline.
183If a message contains one of the faces in this list, the buffer name will 203If a message contains one of the faces in this list, the buffer name will
184be highlighted using that face. The first matching face is used." 204be highlighted using that face. The first matching face is used."
185 :group 'erc-track 205 :group 'erc-track
186 :type '(repeat face)) 206 :type '(repeat (choice face
207 (repeat :tag "Combination" face))))
187 208
188(defcustom erc-track-priority-faces-only nil 209(defcustom erc-track-priority-faces-only nil
189 "Only track text highlighted with a priority face. 210 "Only track text highlighted with a priority face.
@@ -193,6 +214,7 @@ this variable. You can set a list of channel name strings, so those
193will be ignored while all other channels will be tracked as normal. 214will be ignored while all other channels will be tracked as normal.
194Other options are 'all, to apply this to all channels or nil, to disable 215Other options are 'all, to apply this to all channels or nil, to disable
195this feature. 216this feature.
217
196Note: If you have a lot of faces listed in `erc-track-faces-priority-list', 218Note: If you have a lot of faces listed in `erc-track-faces-priority-list',
197setting this variable might not be very useful." 219setting this variable might not be very useful."
198 :group 'erc-track 220 :group 'erc-track
@@ -200,17 +222,38 @@ setting this variable might not be very useful."
200 (repeat string) 222 (repeat string)
201 (const all))) 223 (const all)))
202 224
225(defcustom erc-track-faces-normal-list
226 '((erc-button erc-default-face)
227 (erc-nick-default-face erc-dangerous-host-face)
228 erc-dangerous-host-face
229 erc-nick-default-face
230 (erc-nick-default-face erc-default-face)
231 erc-default-face
232 erc-action-face)
233 "A list of faces considered to be part of normal conversations.
234This list is used to highlight active buffer names in the modeline.
235
236If a message contains one of the faces in this list, and the
237previous modeline face for this buffer is also in this list, then
238the buffer name will be highlighted using the face from the
239message. This gives a rough indication that active conversations
240are occurring in these channels.
241
242The effect may be disabled by setting this variable to nil."
243 :group 'erc-track
244 :type '(repeat (choice face
245 (repeat :tag "Combination" face))))
246
203(defcustom erc-track-position-in-mode-line 'before-modes 247(defcustom erc-track-position-in-mode-line 'before-modes
204 "Where to show modified channel information in the mode-line. 248 "Where to show modified channel information in the mode-line.
205 249
206Setting this variable only has effects in GNU Emacs versions above 21.3. 250Setting this variable only has effects in GNU Emacs versions above 21.3.
207 251
208Choices are: 252Choices are:
209'before-modes - add to the beginning of `mode-line-modes' 253'before-modes - add to the beginning of `mode-line-modes',
210'after-modes - add to the end of `mode-line-modes' 254'after-modes - add to the end of `mode-line-modes',
211t - add to the end of `global-mode-string'. 255t - add to the end of `global-mode-string',
212nil - don't add to mode line 256nil - don't add to mode line."
213"
214 :group 'erc-track 257 :group 'erc-track
215 :type '(choice (const :tag "Just before mode information" before-modes) 258 :type '(choice (const :tag "Just before mode information" before-modes)
216 (const :tag "Just after mode information" after-modes) 259 (const :tag "Just after mode information" after-modes)
@@ -443,7 +486,7 @@ START is the minimum length of the name used."
443 486
444;;; Test: 487;;; Test:
445 488
446(erc-assert 489(assert
447 (and 490 (and
448 ;; verify examples from the doc strings 491 ;; verify examples from the doc strings
449 (equal (let ((erc-track-shorten-aggressively nil)) 492 (equal (let ((erc-track-shorten-aggressively nil))
@@ -560,13 +603,15 @@ module, otherwise the keybindings will not do anything useful."
560 :global t 603 :global t
561 :group 'erc-track) 604 :group 'erc-track)
562 605
563(defun erc-track-minor-mode-maybe () 606(defun erc-track-minor-mode-maybe (&optional buffer)
564 "Enable `erc-track-minor-mode', depending on `erc-track-enable-keybindings'." 607 "Enable `erc-track-minor-mode', depending on `erc-track-enable-keybindings'."
565 (unless (or erc-track-minor-mode 608 (when (and (not erc-track-minor-mode)
566 ;; don't start the minor mode until we have an ERC 609 ;; don't start the minor mode until we have an ERC
567 ;; process running, because we don't want to prompt the 610 ;; process running, because we don't want to prompt the
568 ;; user while starting Emacs 611 ;; user while starting Emacs
569 (null (erc-buffer-list))) 612 (or (and (buffer-live-p buffer)
613 (with-current-buffer buffer (eq major-mode 'erc-mode)))
614 (erc-buffer-list)))
570 (cond ((eq erc-track-enable-keybindings 'ask) 615 (cond ((eq erc-track-enable-keybindings 'ask)
571 (let ((key (or (and (key-binding (kbd "C-c C-SPC")) "C-SPC") 616 (let ((key (or (and (key-binding (kbd "C-c C-SPC")) "C-SPC")
572 (and (key-binding (kbd "C-c C-@")) "C-@")))) 617 (and (key-binding (kbd "C-c C-@")) "C-@"))))
@@ -616,6 +661,7 @@ module, otherwise the keybindings will not do anything useful."
616 (add-hook 'erc-insert-post-hook 'erc-track-modified-channels) 661 (add-hook 'erc-insert-post-hook 'erc-track-modified-channels)
617 (add-hook 'erc-disconnected-hook 'erc-modified-channels-update)) 662 (add-hook 'erc-disconnected-hook 'erc-modified-channels-update))
618 ;; enable the tracking keybindings 663 ;; enable the tracking keybindings
664 (add-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe)
619 (erc-track-minor-mode-maybe))) 665 (erc-track-minor-mode-maybe)))
620 ;; Disable: 666 ;; Disable:
621 ((when (boundp 'erc-track-when-inactive) 667 ((when (boundp 'erc-track-when-inactive)
@@ -637,6 +683,7 @@ module, otherwise the keybindings will not do anything useful."
637 (remove-hook 'erc-disconnected-hook 'erc-modified-channels-update) 683 (remove-hook 'erc-disconnected-hook 'erc-modified-channels-update)
638 (remove-hook 'erc-insert-post-hook 'erc-track-modified-channels)) 684 (remove-hook 'erc-insert-post-hook 'erc-track-modified-channels))
639 ;; disable the tracking keybindings 685 ;; disable the tracking keybindings
686 (remove-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe)
640 (when erc-track-minor-mode 687 (when erc-track-minor-mode
641 (erc-track-minor-mode -1))))) 688 (erc-track-minor-mode -1)))))
642 689
@@ -821,15 +868,36 @@ Use `erc-make-mode-line-buffer-name' to create buttons."
821(defun erc-track-find-face (faces) 868(defun erc-track-find-face (faces)
822 "Return the face to use in the modeline from the faces in FACES. 869 "Return the face to use in the modeline from the faces in FACES.
823If `erc-track-faces-priority-list' is set, the one from FACES who is 870If `erc-track-faces-priority-list' is set, the one from FACES who is
824first in that list will be used." 871first in that list will be used.
825 (let ((candidates erc-track-faces-priority-list) 872
826 candidate face) 873If `erc-track-faces-normal-list' is non-nil, use it to produce a
827 (while (and candidates (not face)) 874blinking effect that indicates channel activity when the first
828 (setq candidate (car candidates) 875element in FACES and the highest-ranking face among the rest of
829 candidates (cdr candidates)) 876FACES are both members of `erc-track-faces-normal-list'.
830 (when (memq candidate faces) 877
831 (setq face candidate))) 878If `erc-track-faces-priority-list' is not set, the first element
832 face)) 879in FACES will be used.
880
881If one of the faces is a list, then it will be ranked according
882to its highest-tanking face member. A list of faces including
883that member will take priority over just the single member
884element."
885 (let ((choice (catch 'face
886 (dolist (candidate erc-track-faces-priority-list)
887 (when (member candidate faces)
888 (throw 'face candidate)))))
889 (no-first (and erc-track-faces-normal-list
890 (catch 'face
891 (dolist (candidate erc-track-faces-priority-list)
892 (when (member candidate (cdr faces))
893 (throw 'face candidate)))))))
894 (cond ((null choice)
895 (car faces))
896 ((and (member choice erc-track-faces-normal-list)
897 (member no-first erc-track-faces-normal-list))
898 no-first)
899 (t
900 choice))))
833 901
834(defun erc-track-modified-channels () 902(defun erc-track-modified-channels ()
835 "Hook function for `erc-insert-post-hook' to check if the current 903 "Hook function for `erc-insert-post-hook' to check if the current
@@ -898,14 +966,15 @@ is in `erc-mode'."
898 "Return a list of all faces used in STR." 966 "Return a list of all faces used in STR."
899 (let ((i 0) 967 (let ((i 0)
900 (m (length str)) 968 (m (length str))
901 (faces (erc-list (get-text-property 0 'face str)))) 969 (faces (erc-list (get-text-property 0 'face str)))
970 cur)
902 (while (and (setq i (next-single-property-change i 'face str m)) 971 (while (and (setq i (next-single-property-change i 'face str m))
903 (not (= i m))) 972 (not (= i m)))
904 (dolist (face (erc-list (get-text-property i 'face str))) 973 (when (setq cur (get-text-property i 'face str))
905 (add-to-list 'faces face))) 974 (add-to-list 'faces cur)))
906 faces)) 975 faces))
907 976
908(erc-assert 977(assert
909 (let ((str "is bold")) 978 (let ((str "is bold"))
910 (put-text-property 3 (length str) 979 (put-text-property 3 (length str)
911 'face '(bold erc-current-nick-face) 980 'face '(bold erc-current-nick-face)
@@ -935,7 +1004,7 @@ higher number than any other face in that list."
935 (let ((count 0)) 1004 (let ((count 0))
936 (catch 'done 1005 (catch 'done
937 (dolist (item erc-track-faces-priority-list) 1006 (dolist (item erc-track-faces-priority-list)
938 (if (eq item face) 1007 (if (equal item face)
939 (throw 'done t) 1008 (throw 'done t)
940 (setq count (1+ count))))) 1009 (setq count (1+ count)))))
941 count)) 1010 count))
diff --git a/lisp/erc/erc-xdcc.el b/lisp/erc/erc-xdcc.el
index ed1d0c948b6..b58a7b61713 100644
--- a/lisp/erc/erc-xdcc.el
+++ b/lisp/erc/erc-xdcc.el
@@ -62,6 +62,11 @@ being evaluated and should return stings."
62 :group 'erc-dcc 62 :group 'erc-dcc
63 :type '(repeat (repeat :tag "Message" (choice string sexp)))) 63 :type '(repeat (repeat :tag "Message" (choice string sexp))))
64 64
65;;;###autoload (autoload 'erc-xdcc-mode "erc-xdcc")
66(define-erc-module xdcc nil
67 "Act as an XDCC file-server."
68 nil nil)
69
65;;;###autoload 70;;;###autoload
66(defun erc-xdcc-add-file (file) 71(defun erc-xdcc-add-file (file)
67 "Add a file to `erc-xdcc-files'." 72 "Add a file to `erc-xdcc-files'."
@@ -126,5 +131,11 @@ being evaluated and should return stings."
126 131
127(provide 'erc-xdcc) 132(provide 'erc-xdcc)
128 133
129;; arch-tag: a13b62fe-2399-4562-af4e-f18a8dd4b9c8
130;;; erc-xdcc.el ends here 134;;; erc-xdcc.el ends here
135;;
136;; Local Variables:
137;; indent-tabs-mode: t
138;; tab-width: 8
139;; End:
140
141;; arch-tag: a13b62fe-2399-4562-af4e-f18a8dd4b9c8
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index c197f618442..e98c9d29baa 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -66,7 +66,7 @@
66 66
67;;; Code: 67;;; Code:
68 68
69(defconst erc-version-string "Version 5.3 (devel)" 69(defconst erc-version-string "Version 5.3"
70 "ERC version. This is used by function `erc-version'.") 70 "ERC version. This is used by function `erc-version'.")
71 71
72(eval-when-compile (require 'cl)) 72(eval-when-compile (require 'cl))
@@ -1167,7 +1167,12 @@ This will only be used if `erc-header-line-face-method' is non-nil."
1167See the variable `erc-command-indicator'." 1167See the variable `erc-command-indicator'."
1168 :group 'erc-faces) 1168 :group 'erc-faces)
1169 1169
1170(defface erc-notice-face '((t (:bold t :foreground "SlateBlue"))) 1170(defface erc-notice-face
1171 (if (featurep 'xemacs)
1172 '((t (:bold t :foreground "blue")))
1173 '((((class color) (min-colors 88))
1174 (:bold t :foreground "SlateBlue"))
1175 (t (:bold t :foreground "blue"))))
1171 "ERC face for notices." 1176 "ERC face for notices."
1172 :group 'erc-faces) 1177 :group 'erc-faces)
1173 1178
@@ -1465,18 +1470,23 @@ Turning on `erc-mode' runs the hook `erc-mode-hook'."
1465 "IRC port to use if it cannot be detected otherwise.") 1470 "IRC port to use if it cannot be detected otherwise.")
1466 1471
1467(defcustom erc-join-buffer 'buffer 1472(defcustom erc-join-buffer 'buffer
1468 "Determines how to display the newly created IRC buffer. 1473 "Determines how to display a newly created IRC buffer.
1469'window - in another window, 1474
1470'window-noselect - in another window, but don't select that one, 1475The available choices are:
1471'frame - in another frame, 1476
1472'bury - bury it in a new buffer, 1477 'window - in another window,
1473any other value - in place of the current buffer." 1478 'window-noselect - in another window, but don't select that one,
1479 'frame - in another frame,
1480 'bury - bury it in a new buffer,
1481 'buffer - in place of the current buffer,
1482 any other value - in place of the current buffer."
1474 :group 'erc-buffers 1483 :group 'erc-buffers
1475 :type '(choice (const window) 1484 :type '(choice (const :tag "Split window and select" window)
1476 (const window-noselect) 1485 (const :tag "Split window, don't select" window-noselect)
1477 (const frame) 1486 (const :tag "New frame" frame)
1478 (const bury) 1487 (const :tag "Bury in new buffer" bury)
1479 (const buffer))) 1488 (const :tag "Use current buffer" buffer)
1489 (const :tag "Use current buffer" t)))
1480 1490
1481(defcustom erc-frame-alist nil 1491(defcustom erc-frame-alist nil
1482 "*Alist of frame parameters for creating erc frames. 1492 "*Alist of frame parameters for creating erc frames.
@@ -1804,8 +1814,8 @@ buffer rather than a server buffer.")
1804 mods)))) 1814 mods))))
1805 1815
1806(defcustom erc-modules '(netsplit fill button match track completion readonly 1816(defcustom erc-modules '(netsplit fill button match track completion readonly
1807 ring autojoin noncommands irccontrols 1817 networks ring autojoin noncommands irccontrols
1808 stamp menu) 1818 move-to-prompt stamp menu list)
1809 "A list of modules which ERC should enable. 1819 "A list of modules which ERC should enable.
1810If you set the value of this without using `customize' remember to call 1820If you set the value of this without using `customize' remember to call
1811\(erc-update-modules) after you change it. When using `customize', modules 1821\(erc-update-modules) after you change it. When using `customize', modules
@@ -1837,14 +1847,20 @@ removed from the list will be disabled."
1837 (const :tag "completion: Complete nicknames and commands (programmable)" 1847 (const :tag "completion: Complete nicknames and commands (programmable)"
1838 completion) 1848 completion)
1839 (const :tag "hecomplete: Complete nicknames and commands (old)" hecomplete) 1849 (const :tag "hecomplete: Complete nicknames and commands (old)" hecomplete)
1850 (const :tag "dcc: Provide Direct Client-to-Client support" dcc)
1840 (const :tag "fill: Wrap long lines" fill) 1851 (const :tag "fill: Wrap long lines" fill)
1841 (const :tag "identd: Launch an identd server on port 8113" identd) 1852 (const :tag "identd: Launch an identd server on port 8113" identd)
1842 (const :tag "irccontrols: Highlight or remove IRC control characters" 1853 (const :tag "irccontrols: Highlight or remove IRC control characters"
1843 irccontrols) 1854 irccontrols)
1855 (const :tag "keep-place: Leave point above un-viewed text" keep-place)
1856 (const :tag "list: List channels in a separate buffer" list)
1844 (const :tag "log: Save buffers in logs" log) 1857 (const :tag "log: Save buffers in logs" log)
1845 (const :tag "match: Highlight pals, fools, and other keywords" match) 1858 (const :tag "match: Highlight pals, fools, and other keywords" match)
1846 (const :tag "menu: Display a menu in ERC buffers" menu) 1859 (const :tag "menu: Display a menu in ERC buffers" menu)
1860 (const :tag "move-to-prompt: Move to the prompt when typing text"
1861 move-to-prompt)
1847 (const :tag "netsplit: Detect netsplits" netsplit) 1862 (const :tag "netsplit: Detect netsplits" netsplit)
1863 (const :tag "networks: Provide data about IRC networks" networks)
1848 (const :tag "noncommands: Don't display non-IRC commands after evaluation" 1864 (const :tag "noncommands: Don't display non-IRC commands after evaluation"
1849 noncommands) 1865 noncommands)
1850 (const :tag 1866 (const :tag
@@ -1866,6 +1882,7 @@ removed from the list will be disabled."
1866 (const :tag "track: Track channel activity in the mode-line" track) 1882 (const :tag "track: Track channel activity in the mode-line" track)
1867 (const :tag "truncate: Truncate buffers to a certain size" truncate) 1883 (const :tag "truncate: Truncate buffers to a certain size" truncate)
1868 (const :tag "unmorse: Translate morse code in messages" unmorse) 1884 (const :tag "unmorse: Translate morse code in messages" unmorse)
1885 (const :tag "xdcc: Act as an XDCC file-server" xdcc)
1869 (repeat :tag "Others" :inline t symbol)) 1886 (repeat :tag "Others" :inline t symbol))
1870 :group 'erc) 1887 :group 'erc)
1871 1888
@@ -2324,6 +2341,15 @@ If ARG is non-nil, show the *erc-protocol* buffer."
2324I.e. any char in it has the `invisible' property set." 2341I.e. any char in it has the `invisible' property set."
2325 (text-property-any 0 (length string) 'invisible t string)) 2342 (text-property-any 0 (length string) 'invisible t string))
2326 2343
2344(defcustom erc-remove-parsed-property t
2345 "Whether to remove the erc-parsed text property after displaying a message.
2346
2347The default is to remove it, since it causes ERC to take up extra
2348memory. If you have code that relies on this property, then set
2349this option to nil."
2350 :type 'boolean
2351 :group 'erc)
2352
2327(defun erc-display-line-1 (string buffer) 2353(defun erc-display-line-1 (string buffer)
2328 "Display STRING in `erc-mode' BUFFER. 2354 "Display STRING in `erc-mode' BUFFER.
2329Auxiliary function used in `erc-display-line'. The line gets filtered to 2355Auxiliary function used in `erc-display-line'. The line gets filtered to
@@ -2364,7 +2390,10 @@ If STRING is nil, the function does nothing."
2364 (save-restriction 2390 (save-restriction
2365 (narrow-to-region insert-position (point)) 2391 (narrow-to-region insert-position (point))
2366 (run-hooks 'erc-insert-modify-hook) 2392 (run-hooks 'erc-insert-modify-hook)
2367 (run-hooks 'erc-insert-post-hook)))))) 2393 (run-hooks 'erc-insert-post-hook)
2394 (when erc-remove-parsed-property
2395 (remove-text-properties (point-min) (point-max)
2396 '(erc-parsed nil))))))))
2368 (erc-update-undo-list (- (or (marker-position erc-insert-marker) 2397 (erc-update-undo-list (- (or (marker-position erc-insert-marker)
2369 (point-max)) 2398 (point-max))
2370 insert-position)))))) 2399 insert-position))))))
@@ -3161,14 +3190,35 @@ just as you provided it. Use this command with care!"
3161 (t nil))) 3190 (t nil)))
3162(put 'erc-cmd-QUOTE 'do-not-parse-args t) 3191(put 'erc-cmd-QUOTE 'do-not-parse-args t)
3163 3192
3193(defcustom erc-query-display 'window
3194 "Indicates how to display query buffers when using the /QUERY
3195command to talk to someone.
3196
3197The default behavior is to display the message in a new window
3198and bring it to the front. See the documentation for
3199`erc-join-buffer' for a description of the available choices.
3200
3201See also `erc-auto-query' to decide how private messages from
3202other people should be displayed."
3203 :group 'erc-query
3204 :type '(choice (const :tag "Split window and select" window)
3205 (const :tag "Split window, don't select" window-noselect)
3206 (const :tag "New frame" frame)
3207 (const :tag "Bury in new buffer" bury)
3208 (const :tag "Use current buffer" buffer)
3209 (const :tag "Use current buffer" t)))
3210
3164(defun erc-cmd-QUERY (&optional user) 3211(defun erc-cmd-QUERY (&optional user)
3165 "Open a query with USER. 3212 "Open a query with USER.
3166The type of query window/frame/etc will depend on the value of 3213The type of query window/frame/etc will depend on the value of
3167`erc-join-buffer'. If USER is omitted, close the current query buffer if one 3214`erc-query-display'.
3168exists - except this is broken now ;-)" 3215
3216If USER is omitted, close the current query buffer if one exists
3217- except this is broken now ;-)"
3169 (interactive 3218 (interactive
3170 (list (read-from-minibuffer "Start a query with: " nil))) 3219 (list (read-from-minibuffer "Start a query with: " nil)))
3171 (let ((session-buffer (erc-server-buffer))) 3220 (let ((session-buffer (erc-server-buffer))
3221 (erc-join-buffer erc-query-display))
3172 (if user 3222 (if user
3173 (erc-query user session-buffer) 3223 (erc-query user session-buffer)
3174 ;; currently broken, evil hack to display help anyway 3224 ;; currently broken, evil hack to display help anyway
@@ -3707,8 +3757,9 @@ If `point' is at the beginning of a channel name, use that as default."
3707 (read-from-minibuffer 3757 (read-from-minibuffer
3708 (concat "Set topic of " (erc-default-target) ": ") 3758 (concat "Set topic of " (erc-default-target) ": ")
3709 (when erc-channel-topic 3759 (when erc-channel-topic
3710 (cons (apply 'concat (butlast (split-string erc-channel-topic "\C-o"))) 3760 (let ((ss (split-string erc-channel-topic "\C-o")))
3711 0))))) 3761 (cons (apply 'concat (if (cdr ss) (butlast ss) ss))
3762 0))))))
3712 (let ((topic-list (split-string topic "\C-o"))) ; strip off the topic setter 3763 (let ((topic-list (split-string topic "\C-o"))) ; strip off the topic setter
3713 (erc-cmd-TOPIC (concat (erc-default-target) " " (car topic-list))))) 3764 (erc-cmd-TOPIC (concat (erc-default-target) " " (car topic-list)))))
3714 3765
@@ -3841,20 +3892,22 @@ To change how this query window is displayed, use `let' to bind
3841 (erc-update-mode-line) 3892 (erc-update-mode-line)
3842 buf)) 3893 buf))
3843 3894
3844(defcustom erc-auto-query 'bury 3895(defcustom erc-auto-query 'window-noselect
3845 "If non-nil, create a query buffer each time you receive a private message. 3896 "If non-nil, create a query buffer each time you receive a private message.
3897If the buffer doesn't already exist, it is created.
3846 3898
3847If the buffer doesn't already exist it is created. This can be 3899This can be set to a symbol, to control how the new query window
3848set to a symbol, to control how the new query window should 3900should appear. The default behavior is to display the buffer in
3849appear. See the documentation for `erc-join-buffer' for 3901a new window, but not to select it. See the documentation for
3850available choices." 3902`erc-join-buffer' for a description of the available choices."
3851 :group 'erc-query 3903 :group 'erc-query
3852 :type '(choice (const nil) 3904 :type '(choice (const :tag "Don't create query window" nil)
3853 (const buffer) 3905 (const :tag "Split window and select" window)
3854 (const window) 3906 (const :tag "Split window, don't select" window-noselect)
3855 (const window-noselect) 3907 (const :tag "New frame" frame)
3856 (const bury) 3908 (const :tag "Bury in new buffer" bury)
3857 (const frame))) 3909 (const :tag "Use current buffer" buffer)
3910 (const :tag "Use current buffer" t)))
3858 3911
3859(defcustom erc-query-on-unjoined-chan-privmsg t 3912(defcustom erc-query-on-unjoined-chan-privmsg t
3860 "If non-nil create query buffer on receiving any PRIVMSG at all. 3913 "If non-nil create query buffer on receiving any PRIVMSG at all.
@@ -5822,7 +5875,7 @@ See `current-time' for details on the time format."
5822 5875
5823;; Mode line handling 5876;; Mode line handling
5824 5877
5825(defcustom erc-mode-line-format "%s %a" 5878(defcustom erc-mode-line-format "%S %a"
5826 "A string to be formatted and shown in the mode-line in `erc-mode'. 5879 "A string to be formatted and shown in the mode-line in `erc-mode'.
5827 5880
5828The string is formatted using `format-spec' and the result is set as the value 5881The string is formatted using `format-spec' and the result is set as the value
@@ -5833,12 +5886,16 @@ The following characters are replaced:
5833%l: The estimated lag time to the server 5886%l: The estimated lag time to the server
5834%m: The modes of the channel 5887%m: The modes of the channel
5835%n: The current nick name 5888%n: The current nick name
5889%N: The name of the network
5836%o: The topic of the channel 5890%o: The topic of the channel
5837%p: The session port 5891%p: The session port
5838%t: The name of the target (channel, nickname, or servername:port) 5892%t: The name of the target (channel, nickname, or servername:port)
5839%s: In the server-buffer, this gets filled with the value of 5893%s: In the server-buffer, this gets filled with the value of
5840 `erc-server-announced-name', in a channel, the value of 5894 `erc-server-announced-name', in a channel, the value of
5841 (erc-default-target) also get concatenated." 5895 (erc-default-target) also get concatenated.
5896%S: In the server-buffer, this gets filled with the value of
5897 `erc-network', in a channel, the value of (erc-default-target)
5898 also get concatenated."
5842 :group 'erc-mode-line-and-header 5899 :group 'erc-mode-line-and-header
5843 :type 'string) 5900 :type 'string)
5844 5901
@@ -5932,6 +5989,29 @@ This should be a string with substitution variables recognized by
5932 (server-name server-name) 5989 (server-name server-name)
5933 (t (buffer-name (current-buffer)))))) 5990 (t (buffer-name (current-buffer))))))
5934 5991
5992(defun erc-format-network ()
5993 "Return the name of the network we are currently on."
5994 (let ((network (and (fboundp 'erc-network-name) (erc-network-name))))
5995 (if (and network (symbolp network))
5996 (symbol-name network)
5997 "")))
5998
5999(defun erc-format-target-and/or-network ()
6000 "Return the network or the current target and network combined.
6001If the name of the network is not available, then use the
6002shortened server name instead."
6003 (let ((network-name (or (and (fboundp 'erc-network-name) (erc-network-name))
6004 (erc-shorten-server-name
6005 (or erc-server-announced-name
6006 erc-session-server)))))
6007 (when (and network-name (symbolp network-name))
6008 (setq network-name (symbol-name network-name)))
6009 (cond ((erc-default-target)
6010 (concat (erc-string-no-properties (erc-default-target))
6011 "@" network-name))
6012 (network-name network-name)
6013 (t (buffer-name (current-buffer))))))
6014
5935(defun erc-format-away-status () 6015(defun erc-format-away-status ()
5936 "Return a formatted `erc-mode-line-away-status-format' 6016 "Return a formatted `erc-mode-line-away-status-format'
5937if `erc-away' is non-nil." 6017if `erc-away' is non-nil."
@@ -5975,9 +6055,11 @@ if `erc-away' is non-nil."
5975 ?l (erc-format-lag-time) 6055 ?l (erc-format-lag-time)
5976 ?m (erc-format-channel-modes) 6056 ?m (erc-format-channel-modes)
5977 ?n (or (erc-current-nick) "") 6057 ?n (or (erc-current-nick) "")
6058 ?N (erc-format-network)
5978 ?o (erc-controls-strip erc-channel-topic) 6059 ?o (erc-controls-strip erc-channel-topic)
5979 ?p (erc-port-to-string erc-session-port) 6060 ?p (erc-port-to-string erc-session-port)
5980 ?s (erc-format-target-and/or-server) 6061 ?s (erc-format-target-and/or-server)
6062 ?S (erc-format-target-and/or-network)
5981 ?t (erc-format-target))) 6063 ?t (erc-format-target)))
5982 (process-status (cond ((and (erc-server-process-alive) 6064 (process-status (cond ((and (erc-server-process-alive)
5983 (not erc-server-connected)) 6065 (not erc-server-connected))
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 52fb372b8cd..c34478a30de 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -797,7 +797,10 @@ This uses ffap-file-exists-string, which may try adding suffixes from
797 ("\\.bib\\'" . ffap-bib) ; search ffap-bib-path 797 ("\\.bib\\'" . ffap-bib) ; search ffap-bib-path
798 ("\\`\\." . ffap-home) ; .emacs, .bashrc, .profile 798 ("\\`\\." . ffap-home) ; .emacs, .bashrc, .profile
799 ("\\`~/" . ffap-lcd) ; |~/misc/ffap.el.Z| 799 ("\\`~/" . ffap-lcd) ; |~/misc/ffap.el.Z|
800 ("^[Rr][Ff][Cc][- #]?\\([0-9]+\\)" ; no $ 800 ;; This uses to have a blank, but ffap-string-at-point doesn't
801 ;; handle blanks.
802 ;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg01058.html
803 ("^[Rr][Ff][Cc][-#]?\\([0-9]+\\)" ; no $
801 . ffap-rfc) ; "100% RFC2100 compliant" 804 . ffap-rfc) ; "100% RFC2100 compliant"
802 (dired-mode . ffap-dired) ; maybe in a subdirectory 805 (dired-mode . ffap-dired) ; maybe in a subdirectory
803 ) 806 )
@@ -969,7 +972,7 @@ If t, `ffap-tex-init' will initialize this when needed.")
969 ;; Slightly controversial decisions: 972 ;; Slightly controversial decisions:
970 ;; * strip trailing "@" and ":" 973 ;; * strip trailing "@" and ":"
971 ;; * no commas (good for latex) 974 ;; * no commas (good for latex)
972 (file "--:$+<>@-Z_[:lower:]~*?" "<@" "@>;.,!:") 975 (file "--:\\\\$+<>@-Z_[:lower:]~*?" "<@" "@>;.,!:")
973 ;; An url, or maybe a email/news message-id: 976 ;; An url, or maybe a email/news message-id:
974 (url "--:=&?$+@-Z_[:lower:]~#,%;*" "^[:alnum:]" ":;.,!?") 977 (url "--:=&?$+@-Z_[:lower:]~#,%;*" "^[:alnum:]" ":;.,!?")
975 ;; Find a string that does *not* contain a colon: 978 ;; Find a string that does *not* contain a colon:
@@ -1263,20 +1266,25 @@ which may actually result in an url rather than a filename."
1263 (setq dir (file-name-directory guess)))) 1266 (setq dir (file-name-directory guess))))
1264 (let ((minibuffer-completing-file-name t) 1267 (let ((minibuffer-completing-file-name t)
1265 (completion-ignore-case read-file-name-completion-ignore-case) 1268 (completion-ignore-case read-file-name-completion-ignore-case)
1266 ;; because of `rfn-eshadow-update-overlay'. 1269 (fnh-elem (cons ffap-url-regexp 'url-file-handler)))
1267 (file-name-handler-alist 1270 ;; Explain to `rfn-eshadow' that we can use URLs here.
1268 (cons (cons ffap-url-regexp 'url-file-handler) 1271 (push fnh-elem file-name-handler-alist)
1269 file-name-handler-alist))) 1272 (unwind-protect
1270 (setq guess 1273 (setq guess
1271 (completing-read 1274 (completing-read
1272 prompt 1275 prompt
1273 'ffap-read-file-or-url-internal 1276 'ffap-read-file-or-url-internal
1274 dir 1277 dir
1275 nil 1278 nil
1276 (if dir (cons guess (length dir)) guess) 1279 (if dir (cons guess (length dir)) guess)
1277 (list 'file-name-history) 1280 (list 'file-name-history)
1278 (and buffer-file-name 1281 (and buffer-file-name
1279 (abbreviate-file-name buffer-file-name))))) 1282 (abbreviate-file-name buffer-file-name))))
1283 ;; Remove the special handler manually. We used to just let-bind
1284 ;; file-name-handler-alist to preserve its value, but that caused
1285 ;; other modifications to be lost (e.g. when Tramp gets loaded
1286 ;; during the completing-read call).
1287 (setq file-name-handler-alist (delq fnh-elem file-name-handler-alist))))
1280 ;; Do file substitution like (interactive "F"), suggested by MCOOK. 1288 ;; Do file substitution like (interactive "F"), suggested by MCOOK.
1281 (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess))) 1289 (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess)))
1282 ;; Should not do it on url's, where $ is a common (VMS?) character. 1290 ;; Should not do it on url's, where $ is a common (VMS?) character.
diff --git a/lisp/files.el b/lisp/files.el
index bc74ecf4667..c790aa58810 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2488,13 +2488,13 @@ symbol and VAL is a value that is considered safe."
2488 :group 'find-file 2488 :group 'find-file
2489 :type 'alist) 2489 :type 'alist)
2490 2490
2491(defcustom safe-local-eval-forms nil 2491(defcustom safe-local-eval-forms '((add-hook 'write-file-hooks 'time-stamp))
2492 "Expressions that are considered safe in an `eval:' local variable. 2492 "Expressions that are considered safe in an `eval:' local variable.
2493Add expressions to this list if you want Emacs to evaluate them, when 2493Add expressions to this list if you want Emacs to evaluate them, when
2494they appear in an `eval' local variable specification, without first 2494they appear in an `eval' local variable specification, without first
2495asking you for confirmation." 2495asking you for confirmation."
2496 :group 'find-file 2496 :group 'find-file
2497 :version "22.1" 2497 :version "22.2"
2498 :type '(repeat sexp)) 2498 :type '(repeat sexp))
2499 2499
2500;; Risky local variables: 2500;; Risky local variables:
@@ -2839,7 +2839,8 @@ is specified, returning t if it is specified."
2839 (dolist (elt result) 2839 (dolist (elt result)
2840 (let ((var (car elt)) 2840 (let ((var (car elt))
2841 (val (cdr elt))) 2841 (val (cdr elt)))
2842 (or (eq var 'mode) 2842 ;; Don't query about the fake variables.
2843 (or (memq var '(mode unibyte coding))
2843 (and (eq var 'eval) 2844 (and (eq var 'eval)
2844 (or (eq enable-local-eval t) 2845 (or (eq enable-local-eval t)
2845 (hack-one-local-variable-eval-safep 2846 (hack-one-local-variable-eval-safep
diff --git a/lisp/frame.el b/lisp/frame.el
index 64e504d1c07..92b102a0878 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1254,7 +1254,7 @@ displays not explicitely specified."
1254 1254
1255(defun display-mm-height (&optional display) 1255(defun display-mm-height (&optional display)
1256 "Return the height of DISPLAY's screen in millimeters. 1256 "Return the height of DISPLAY's screen in millimeters.
1257System values can be overriden by `display-mm-dimensions-alist'. 1257System values can be overridden by `display-mm-dimensions-alist'.
1258If the information is unavailable, value is nil." 1258If the information is unavailable, value is nil."
1259 (and (memq (framep-on-display display) '(x w32 mac)) 1259 (and (memq (framep-on-display display) '(x w32 mac))
1260 (or (cddr (assoc (or display (frame-parameter nil 'display)) 1260 (or (cddr (assoc (or display (frame-parameter nil 'display))
@@ -1264,7 +1264,7 @@ If the information is unavailable, value is nil."
1264 1264
1265(defun display-mm-width (&optional display) 1265(defun display-mm-width (&optional display)
1266 "Return the width of DISPLAY's screen in millimeters. 1266 "Return the width of DISPLAY's screen in millimeters.
1267System values can be overriden by `display-mm-dimensions-alist'. 1267System values can be overridden by `display-mm-dimensions-alist'.
1268If the information is unavailable, value is nil." 1268If the information is unavailable, value is nil."
1269 (and (memq (framep-on-display display) '(x w32 mac)) 1269 (and (memq (framep-on-display display) '(x w32 mac))
1270 (or (cadr (assoc (or display (frame-parameter nil 'display)) 1270 (or (cadr (assoc (or display (frame-parameter nil 'display))
diff --git a/lisp/fringe.el b/lisp/fringe.el
index e2eb5d2d98b..2762dbe617a 100644
--- a/lisp/fringe.el
+++ b/lisp/fringe.el
@@ -93,6 +93,10 @@
93 93
94(defvar fringe-mode) 94(defvar fringe-mode)
95 95
96(defvar fringe-mode-explicit nil
97 "Non-nil means `set-fringe-mode' should really do something.
98This is nil while loading `fringe.el', and t afterward.")
99
96(defun set-fringe-mode-1 (ignore value) 100(defun set-fringe-mode-1 (ignore value)
97 "Call `set-fringe-mode' with VALUE. 101 "Call `set-fringe-mode' with VALUE.
98See `fringe-mode' for valid values and their effect. 102See `fringe-mode' for valid values and their effect.
@@ -104,13 +108,14 @@ This is usually invoked when setting `fringe-mode' via customize."
104See `fringe-mode' for possible values and their effect." 108See `fringe-mode' for possible values and their effect."
105 (setq fringe-mode value) 109 (setq fringe-mode value)
106 110
107 (modify-all-frames-parameters 111 (when fringe-mode-explicit
108 (list (cons 'left-fringe (if (consp fringe-mode) 112 (modify-all-frames-parameters
109 (car fringe-mode) 113 (list (cons 'left-fringe (if (consp fringe-mode)
110 fringe-mode)) 114 (car fringe-mode)
111 (cons 'right-fringe (if (consp fringe-mode) 115 fringe-mode))
112 (cdr fringe-mode) 116 (cons 'right-fringe (if (consp fringe-mode)
113 fringe-mode))))) 117 (cdr fringe-mode)
118 fringe-mode))))))
114 119
115;; For initialization of fringe-mode, take account of changes 120;; For initialization of fringe-mode, take account of changes
116;; made explicitly to default-frame-alist. 121;; made explicitly to default-frame-alist.
@@ -159,6 +164,10 @@ you can use the interactive function `set-fringe-style'."
159 :initialize 'fringe-mode-initialize 164 :initialize 'fringe-mode-initialize
160 :set 'set-fringe-mode-1) 165 :set 'set-fringe-mode-1)
161 166
167;; We just set fringe-mode, but that was the default.
168;; If it is set again, that is for real.
169(setq fringe-mode-explicit t)
170
162(defun fringe-query-style (&optional all-frames) 171(defun fringe-query-style (&optional all-frames)
163 "Query user for fringe style. 172 "Query user for fringe style.
164Returns values suitable for left-fringe and right-fringe frame parameters. 173Returns values suitable for left-fringe and right-fringe frame parameters.
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 728ea9a424a..f3b41740f3e 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,107 @@
12008-01-24 Michael Sperber <sperber@deinprogramm.de>
2
3 * mail-source.el (mail-sources): Add `group' choice.
4
5 * nnmail.el (nnmail-get-new-mail-1): Abstract this out to add another
6 parameter `in-group' to control into which group the articles go.
7 Add treatment of `group' mail-source.
8
92008-01-24 Dan Nicolaescu <dann@ics.uci.edu>
10
11 * sieve.el (sieve-make-overlay, sieve-overlay-put, sieve-overlays-at):
12 * message.el (message-beginning-of-line): Use featurep instead of bound
13 tests in order to resolve conditionals at compile time.
14
152008-01-23 Katsumi Yamaoka <yamaoka@jpl.org>
16
17 * gnus-art.el (gnus-insert-mime-button): Don't decode description.
18
19 * mm-decode.el (mm-dissect-buffer): Decode description.
20
21 * mml.el (mml-to-mime): Encode message header first.
22
232008-01-18 Katsumi Yamaoka <yamaoka@jpl.org>
24
25 * gnus-art.el (gnus-article-describe-bindings): Make it possible to use
26 xrefs, i.e. [back] and [forward] buttons, in *Help* buffer.
27
282008-01-18 Teodor Zlatanov <tzz@lifelogs.com>
29
30 * gnus-registry.el (gnus-registry-trim): Use append, not concat.
31
322008-01-17 Katsumi Yamaoka <yamaoka@jpl.org>
33
34 * gnus-art.el (gnus-article-read-summary-keys): Work for some `A'
35 prefix keys.
36 (gnus-article-read-summary-send-keys): Use gnus-character-to-event.
37 (gnus-article-describe-bindings): Simplify; move XEmacs stuff to
38 gnus-xmas.el.
39
402008-01-16 Teodor Zlatanov <tzz@lifelogs.com>
41
42 * gnus-registry.el (gnus-registry-marks, gnus-registry-default-mark):
43 Add new variables for article mark management.
44 (gnus-registry-extra-entries-precious, gnus-registry-trim): Define a
45 list of extra data entries which, when present, will indicate that the
46 article ID should not be trimmed from the registry.
47 (gnus-registry-mark-article, gnus-registry-article-marks): Remove these
48 functions.
49 (gnus-registry-read-mark): New function to read a mark name from the
50 user.
51 (gnus-registry-set-article-mark, gnus-registry-remove-article-mark)
52 (gnus-registry-set-article-mark-internal): New functions to add and
53 remove marks.
54 (gnus-registry-get-article-marks): New function to show the marks for
55 an article, or retrieve them for further use.
56
572008-01-16 Katsumi Yamaoka <yamaoka@jpl.org>
58
59 * gnus-art.el (gnus-article-describe-bindings): Show all `S' prefix
60 keys when no argument is given.
61
622008-01-12 Reiner Steib <Reiner.Steib@gmx.de>
63
64 * gnus-sum.el (gnus-article-sort-by-random)
65 (gnus-thread-sort-by-random): Fix doc strings. Reported by
66 jidanni@jidanni.org.
67
682008-01-11 Katsumi Yamaoka <yamaoka@jpl.org>
69
70 * gnus-art.el (gnus-article-describe-bindings): New function.
71 (gnus-article-read-summary-keys): Use it.
72 (gnus-article-mode-map): Bind `C-h b' to it.
73
742008-01-10 Katsumi Yamaoka <yamaoka@jpl.org>
75
76 * gnus-art.el (gnus-article-read-summary-keys): Work for `C-h' on
77 XEmacs.
78 (gnus-article-describe-key, gnus-article-describe-key-briefly): Protect
79 against non-character events.
80
812008-01-09 Reiner Steib <Reiner.Steib@gmx.de>
82
83 * gnus-group.el (gnus-group-read-ephemeral-gmane-group-url): New
84 command.
85 (gnus-group-read-ephemeral-gmane-group): Use optional argument RANGE
86 instead of END. Change name of the temp file.
87 (gnus-group-gmane-group-download-format): Add doc string. Make it
88 customizable.
89
902008-01-09 Katsumi Yamaoka <yamaoka@jpl.org>
91
92 * gnus-art.el (gnus-article-send-map): New keymap for `S' prefix keys;
93 bind `S W' to gnus-article-wide-reply-with-original; set default
94 binding to gnus-article-read-summary-send-keys.
95 (gnus-article-read-summary-keys): Fix the order of keys; display
96 continuation keys correctly in the echo area; describe bindings
97 correctly when keys end with `C-h'.
98 (gnus-article-read-summary-send-keys): New function.
99 (gnus-article-describe-key, gnus-article-describe-key-briefly): Work
100 for gnus-article-read-summary-send-keys; display continuation keys
101 correctly in the echo area.
102 (gnus-article-reply-with-original): Ignore prefix argument.
103 (gnus-article-wide-reply-with-original): New function.
104
12008-01-08 Katsumi Yamaoka <yamaoka@jpl.org> 1052008-01-08 Katsumi Yamaoka <yamaoka@jpl.org>
2 106
3 * gnus-bookmark.el (gnus-bookmark-mouse-available-p): Don't test for 107 * gnus-bookmark.el (gnus-bookmark-mouse-available-p): Don't test for
@@ -19,12 +123,6 @@
19 * mml-sec.el, sieve-manage.el, smime.el: Simplify loading of 123 * mml-sec.el, sieve-manage.el, smime.el: Simplify loading of
20 password-cache or password. Suggested by Glenn Morris <rgm@gnu.org>. 124 password-cache or password. Suggested by Glenn Morris <rgm@gnu.org>.
21 125
222007-12-21 Teodor Zlatanov <tzz@lifelogs.com>
23
24 * imap.el (imap-authenticate): Use current-buffer instead of buffer,
25 for the cases where imap-authenticate is called with a nil buffer
26 parameter.
27
282007-12-19 Katsumi Yamaoka <yamaoka@jpl.org> 1262007-12-19 Katsumi Yamaoka <yamaoka@jpl.org>
29 127
30 * gnus-art.el (gnus-article-browse-html-parts): Work for two or more 128 * gnus-art.el (gnus-article-browse-html-parts): Work for two or more
@@ -328,12 +426,6 @@
328 426
329 * message.el (message-ignored-supersedes-headers): Add "X-ID". 427 * message.el (message-ignored-supersedes-headers): Add "X-ID".
330 428
3312007-12-03 Nathan J. Williams <nathanw@MIT.EDU> (tiny change)
332
333 * imap.el (imap-mailbox-status-asynch): Upcase STATUS items.
334 (imap-parse-status): Upcase status-att for servers that sends them
335 lower-case (e.g., MS Exchange 2007).
336
3372007-12-03 Lars Magne Ingebrigtsen <larsi@gnus.org> 4292007-12-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
338 430
339 * gnus-sum.el (gnus-uu-extract-map): Add a command for the yenc 431 * gnus-sum.el (gnus-uu-extract-map): Add a command for the yenc
@@ -801,9 +893,6 @@
801 * webmail.el (webmail-debug): Replace mapcar called for effect with 893 * webmail.el (webmail-debug): Replace mapcar called for effect with
802 dolist. 894 dolist.
803 895
804 * gnus-xmas.el (gnus-group-add-icon): Replace mapcar called for effect
805 with mapc.
806
8072007-10-24 Katsumi Yamaoka <yamaoka@jpl.org> 8962007-10-24 Katsumi Yamaoka <yamaoka@jpl.org>
808 897
809 * gnus-agent.el (gnus-agent-read-agentview, gnus-agent-save-alist) 898 * gnus-agent.el (gnus-agent-read-agentview, gnus-agent-save-alist)
diff --git a/lisp/gnus/ecomplete.el b/lisp/gnus/ecomplete.el
index 285aca4270a..e0b759c33eb 100644
--- a/lisp/gnus/ecomplete.el
+++ b/lisp/gnus/ecomplete.el
@@ -1,6 +1,6 @@
1;;; ecomplete.el --- electric completion of addresses and the like 1;;; ecomplete.el --- electric completion of addresses and the like
2 2
3;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 5;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6;; Keywords: mail 6;; Keywords: mail
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index fda62bc79aa..f93a304be46 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -4215,6 +4215,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
4215 "F" gnus-article-followup-with-original 4215 "F" gnus-article-followup-with-original
4216 "\C-hk" gnus-article-describe-key 4216 "\C-hk" gnus-article-describe-key
4217 "\C-hc" gnus-article-describe-key-briefly 4217 "\C-hc" gnus-article-describe-key-briefly
4218 "\C-hb" gnus-article-describe-bindings
4218 4219
4219 "\C-d" gnus-article-read-summary-keys 4220 "\C-d" gnus-article-read-summary-keys
4220 "\M-*" gnus-article-read-summary-keys 4221 "\M-*" gnus-article-read-summary-keys
@@ -4225,6 +4226,13 @@ If variable `gnus-use-long-file-name' is non-nil, it is
4225(substitute-key-definition 4226(substitute-key-definition
4226 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) 4227 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
4227 4228
4229(gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map)
4230 "W" gnus-article-wide-reply-with-original)
4231(if (featurep 'xemacs)
4232 (set-keymap-default-binding gnus-article-send-map
4233 'gnus-article-read-summary-send-keys)
4234 (define-key gnus-article-send-map [t] 'gnus-article-read-summary-send-keys))
4235
4228(defun gnus-article-make-menu-bar () 4236(defun gnus-article-make-menu-bar ()
4229 (unless (boundp 'gnus-article-commands-menu) 4237 (unless (boundp 'gnus-article-commands-menu)
4230 (gnus-summary-make-menu-bar)) 4238 (gnus-summary-make-menu-bar))
@@ -5447,9 +5455,7 @@ N is the numerical prefix."
5447 (mail-content-type-get (mm-handle-type handle) 'url) 5455 (mail-content-type-get (mm-handle-type handle) 'url)
5448 "")) 5456 ""))
5449 (gnus-tmp-type (mm-handle-media-type handle)) 5457 (gnus-tmp-type (mm-handle-media-type handle))
5450 (gnus-tmp-description 5458 (gnus-tmp-description (or (mm-handle-description handle) ""))
5451 (mail-decode-encoded-word-string (or (mm-handle-description handle)
5452 "")))
5453 (gnus-tmp-dots 5459 (gnus-tmp-dots
5454 (if (if displayed (car displayed) 5460 (if (if displayed (car displayed)
5455 (mm-handle-displayed-p handle)) 5461 (mm-handle-displayed-p handle))
@@ -6234,26 +6240,27 @@ not have a face in `gnus-article-boring-faces'."
6234 "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" 6240 "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
6235 "=" "^" "\M-^" "|")) 6241 "=" "^" "\M-^" "|"))
6236 (nosave-but-article 6242 (nosave-but-article
6237 '("A\r")) 6243 '("A " "A<" "A>" "AM" "AP" "AR" "AT" "A\C-?" "A\M-\r" "A\r" "Ab" "Ae"
6244 "An" "Ap" [?A (meta return)] [?A delete]))
6238 (nosave-in-article 6245 (nosave-in-article
6239 '("\C-d")) 6246 '("AS" "\C-d"))
6240 (up-to-top 6247 (up-to-top
6241 '("n" "Gn" "p" "Gp")) 6248 '("n" "Gn" "p" "Gp"))
6242 keys new-sum-point) 6249 keys new-sum-point)
6243 (save-excursion 6250 (save-excursion
6244 (set-buffer gnus-article-current-summary) 6251 (set-buffer gnus-article-current-summary)
6245 (let (gnus-pick-mode) 6252 (let (gnus-pick-mode)
6246 (push (or key last-command-event) unread-command-events) 6253 (setq unread-command-events (nconc unread-command-events
6247 (setq keys (if (featurep 'xemacs) 6254 (list (or key last-command-event)))
6248 (events-to-keys (read-key-sequence nil)) 6255 keys (if (featurep 'xemacs)
6249 (read-key-sequence nil))))) 6256 (events-to-keys (read-key-sequence nil t))
6257 (read-key-sequence nil t)))))
6250 6258
6251 (message "") 6259 (message "")
6252 6260
6253 (cond 6261 (cond
6254 ((eq (aref keys (1- (length keys))) ?\C-h) 6262 ((eq (aref keys (1- (length keys))) ?\C-h)
6255 (with-current-buffer gnus-article-current-summary 6263 (gnus-article-describe-bindings (substring keys 0 -1)))
6256 (describe-bindings (substring keys 0 -1))))
6257 ((or (member keys nosaves) 6264 ((or (member keys nosaves)
6258 (member keys nosave-but-article) 6265 (member keys nosave-but-article)
6259 (member keys nosave-in-article)) 6266 (member keys nosave-in-article))
@@ -6339,53 +6346,98 @@ not have a face in `gnus-article-boring-faces'."
6339 (signal (car err) (cdr err)) 6346 (signal (car err) (cdr err))
6340 (ding)))))))) 6347 (ding))))))))
6341 6348
6349(defun gnus-article-read-summary-send-keys ()
6350 (interactive)
6351 (let ((unread-command-events (list (gnus-character-to-event ?S))))
6352 (gnus-article-read-summary-keys)))
6353
6342(defun gnus-article-describe-key (key) 6354(defun gnus-article-describe-key (key)
6343 "Display documentation of the function invoked by KEY. KEY is a string." 6355 "Display documentation of the function invoked by KEY.
6344 (interactive "kDescribe key: ") 6356KEY is a string or a vector."
6357 (interactive (list (let ((cursor-in-echo-area t)) ;; better for XEmacs.
6358 (read-key-sequence "Describe key: "))))
6345 (gnus-article-check-buffer) 6359 (gnus-article-check-buffer)
6346 (if (eq (key-binding key) 'gnus-article-read-summary-keys) 6360 (if (memq (key-binding key t) '(gnus-article-read-summary-keys
6361 gnus-article-read-summary-send-keys))
6347 (save-excursion 6362 (save-excursion
6348 (set-buffer gnus-article-current-summary) 6363 (set-buffer gnus-article-current-summary)
6349 (let (gnus-pick-mode) 6364 (setq unread-command-events
6350 (if (featurep 'xemacs) 6365 (if (featurep 'xemacs)
6351 (progn 6366 (append key nil)
6352 (push (elt key 0) unread-command-events) 6367 (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
6353 (setq key (events-to-keys 6368 (list 'meta (- x 128))
6354 (read-key-sequence "Describe key: ")))) 6369 x))
6355 (setq unread-command-events 6370 key)))
6356 (mapcar 6371 (let ((cursor-in-echo-area t)
6357 (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x)) 6372 gnus-pick-mode)
6358 (string-to-list key))) 6373 (describe-key (read-key-sequence nil t))))
6359 (setq key (read-key-sequence "Describe key: "))))
6360 (describe-key key))
6361 (describe-key key))) 6374 (describe-key key)))
6362 6375
6363(defun gnus-article-describe-key-briefly (key &optional insert) 6376(defun gnus-article-describe-key-briefly (key &optional insert)
6364 "Display documentation of the function invoked by KEY. KEY is a string." 6377 "Display documentation of the function invoked by KEY.
6365 (interactive "kDescribe key: \nP") 6378KEY is a string or a vector."
6379 (interactive (list (let ((cursor-in-echo-area t)) ;; better for XEmacs.
6380 (read-key-sequence "Describe key: "))
6381 current-prefix-arg))
6366 (gnus-article-check-buffer) 6382 (gnus-article-check-buffer)
6367 (if (eq (key-binding key) 'gnus-article-read-summary-keys) 6383 (if (memq (key-binding key t) '(gnus-article-read-summary-keys
6384 gnus-article-read-summary-send-keys))
6368 (save-excursion 6385 (save-excursion
6369 (set-buffer gnus-article-current-summary) 6386 (set-buffer gnus-article-current-summary)
6370 (let (gnus-pick-mode) 6387 (setq unread-command-events
6371 (if (featurep 'xemacs) 6388 (if (featurep 'xemacs)
6372 (progn 6389 (append key nil)
6373 (push (elt key 0) unread-command-events) 6390 (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
6374 (setq key (events-to-keys 6391 (list 'meta (- x 128))
6375 (read-key-sequence "Describe key: ")))) 6392 x))
6376 (setq unread-command-events 6393 key)))
6377 (mapcar 6394 (let ((cursor-in-echo-area t)
6378 (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x)) 6395 gnus-pick-mode)
6379 (string-to-list key))) 6396 (describe-key-briefly (read-key-sequence nil t) insert)))
6380 (setq key (read-key-sequence "Describe key: "))))
6381 (describe-key-briefly key insert))
6382 (describe-key-briefly key insert))) 6397 (describe-key-briefly key insert)))
6383 6398
6399;;`gnus-agent-mode' in gnus-agent.el will define it.
6400(defvar gnus-agent-summary-mode)
6401
6402(defun gnus-article-describe-bindings (&optional prefix)
6403 "Show a list of all defined keys, and their definitions.
6404The optional argument PREFIX, if non-nil, should be a key sequence;
6405then we display only bindings that start with that prefix."
6406 (interactive)
6407 (gnus-article-check-buffer)
6408 (let ((keymap (copy-keymap gnus-article-mode-map))
6409 (map (copy-keymap gnus-article-send-map))
6410 (sumkeys (where-is-internal 'gnus-article-read-summary-keys))
6411 agent)
6412 (define-key keymap "S" map)
6413 (define-key map [t] nil)
6414 (with-current-buffer gnus-article-current-summary
6415 (set-keymap-parent map (key-binding "S"))
6416 (let (def gnus-pick-mode)
6417 (dolist (key sumkeys)
6418 (when (setq def (key-binding key))
6419 (define-key keymap key def))))
6420 (when (boundp 'gnus-agent-summary-mode)
6421 (setq agent gnus-agent-summary-mode)))
6422 (with-temp-buffer
6423 (use-local-map keymap)
6424 (set (make-local-variable 'gnus-agent-summary-mode) agent)
6425 (describe-bindings prefix))
6426 (let ((item `((lambda (prefix)
6427 (save-excursion
6428 (set-buffer ,(current-buffer))
6429 (gnus-article-describe-bindings prefix)))
6430 ,prefix)))
6431 (with-current-buffer (if (fboundp 'help-buffer)
6432 (let (help-xref-following) (help-buffer))
6433 "*Help*") ;; Emacs 21
6434 (setq help-xref-stack-item item)))))
6435
6384(defun gnus-article-reply-with-original (&optional wide) 6436(defun gnus-article-reply-with-original (&optional wide)
6385 "Start composing a reply mail to the current message. 6437 "Start composing a reply mail to the current message.
6386The text in the region will be yanked. If the region isn't active, 6438The text in the region will be yanked. If the region isn't active,
6387the entire article will be yanked." 6439the entire article will be yanked."
6388 (interactive "P") 6440 (interactive)
6389 (let ((article (cdr gnus-article-current)) 6441 (let ((article (cdr gnus-article-current))
6390 contents) 6442 contents)
6391 (if (not (gnus-region-active-p)) 6443 (if (not (gnus-region-active-p))
@@ -6400,6 +6452,13 @@ the entire article will be yanked."
6400 (gnus-summary-reply 6452 (gnus-summary-reply
6401 (list (list article contents)) wide))))) 6453 (list (list article contents)) wide)))))
6402 6454
6455(defun gnus-article-wide-reply-with-original ()
6456 "Start composing a wide reply mail to the current message.
6457The text in the region will be yanked. If the region isn't active,
6458the entire article will be yanked."
6459 (interactive)
6460 (gnus-article-reply-with-original t))
6461
6403(defun gnus-article-followup-with-original () 6462(defun gnus-article-followup-with-original ()
6404 "Compose a followup to the current article. 6463 "Compose a followup to the current article.
6405The text in the region will be yanked. If the region isn't active, 6464The text in the region will be yanked. If the region isn't active,
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index 41f9dd0baca..ddfc559e12e 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -1,6 +1,6 @@
1;;; gnus-bookmark.el --- Bookmarks in Gnus 1;;; gnus-bookmark.el --- Bookmarks in Gnus
2 2
3;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Bastien Guerry <bzg AT altern DOT org> 5;; Author: Bastien Guerry <bzg AT altern DOT org>
6;; Keywords: news 6;; Keywords: news
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 2be0b6e5c80..ee5068e980d 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -2320,44 +2320,94 @@ Return the name of the group if selection was successful."
2320 (message "Quit reading the ephemeral group") 2320 (message "Quit reading the ephemeral group")
2321 nil))))) 2321 nil)))))
2322 2322
2323(defvar gnus-group-gmane-group-download-format 2323(defcustom gnus-group-gmane-group-download-format
2324 "http://download.gmane.org/%s/%s/%s") 2324 "http://download.gmane.org/%s/%s/%s"
2325(autoload 'url-insert-file-contents "url-handlers") 2325 "URL for downloading mbox files.
2326It must contain three \"%s\". They correspond to the group, the
2327minimal and maximal article numbers, respectively."
2328 :group 'gnus-group-foreign
2329 :version "23.0" ;; No Gnus
2330 :type 'string)
2326 2331
2327;; FIXME: Make gnus-group-gmane-group-download-format customizable. Add 2332(autoload 'url-insert-file-contents "url-handlers")
2328;; documentation, menu, key bindings... 2333;; FIXME:
2334;; - Add documentation, menu, key bindings, ...
2329 2335
2330(defun gnus-group-read-ephemeral-gmane-group (group start end) 2336(defun gnus-group-read-ephemeral-gmane-group (group start &optional range)
2331 "Read articles from Gmane group GROUP as an ephemeral group. 2337 "Read articles from Gmane group GROUP as an ephemeral group.
2332START and END specify the articles range. The articles are 2338START is the first article. RANGE specifies how many articles
2333downloaded via HTTP using the URL specified by 2339are fetched. The articles are downloaded via HTTP using the URL
2334`gnus-group-gmane-group-download-format'." 2340specified by `gnus-group-gmane-group-download-format'."
2335 ;; See <http://gmane.org/export.php> for more information. 2341 ;; See <http://gmane.org/export.php> for more information.
2336 (interactive 2342 (interactive
2337 (list 2343 (list
2338 (gnus-group-completing-read "Gmane group: ") 2344 (gnus-group-completing-read "Gmane group: ")
2339 (read-number "Start article number: ") 2345 (read-number "Start article number: ")
2340 (read-number "End article number: "))) 2346 (read-number "How many articles: ")))
2341 (when (< (- end start) 0) 2347 (unless range (setq range 500))
2342 (error "Invalid range.")) 2348 (when (< range 1)
2343 (when (> (- end start) 2349 (error "Invalid range: %s" range))
2344 (min (or gnus-large-ephemeral-newsgroup 100) 100)) 2350 (let ((tmpfile (make-temp-file
2345 (unless (y-or-n-p 2351 (format "%s.start-%s.range-%s." group start range)))
2346 (format "Large range (%s to %s), continue anyway? " 2352 (gnus-thread-sort-functions '(gnus-thread-sort-by-number)))
2347 start end))
2348 (error "Range too large. Aborted.")))
2349 (let ((tmpfile (make-temp-file "gmane.gnus-temp-group-")))
2350 (with-temp-file tmpfile 2353 (with-temp-file tmpfile
2351 (url-insert-file-contents 2354 (url-insert-file-contents
2352 (format gnus-group-gmane-group-download-format 2355 (format gnus-group-gmane-group-download-format
2353 group start end)) 2356 group start (+ start range)))
2354 (write-region (point-min) (point-max) tmpfile) 2357 (write-region (point-min) (point-max) tmpfile)
2355 (gnus-group-read-ephemeral-group 2358 (gnus-group-read-ephemeral-group
2356 "rs-gnus-read-gmane" 2359 (format "%s.start-%s.range-%s" group start range)
2357 `(nndoc ,tmpfile 2360 `(nndoc ,tmpfile
2358 (nndoc-article-type guess)))) 2361 (nndoc-article-type guess))))
2359 (delete-file tmpfile))) 2362 (delete-file tmpfile)))
2360 2363
2364(defun gnus-group-read-ephemeral-gmane-group-url (url)
2365 "Create an ephemeral Gmane group from URL.
2366
2367Valid input formats include:
2368\"http://thread.gmane.org/gmane.foo.bar/12300/focus=12399\",
2369\"http://thread.gmane.org/gmane.foo.bar/12345/\",
2370\"http://article.gmane.org/gmane.foo.bar/12345/\",
2371\"http://news.gmane.org/group/gmane.foo.bar/thread=12345\""
2372 ;; - Feel free to add other useful Gmane URLs here! Maybe the URLs should
2373 ;; be customizable?
2374 ;; - The URLs should be added to `gnus-button-alist'. Probably we should
2375 ;; prompt the user to decide: "View via `browse-url' or in Gnus? "
2376 ;; (`gnus-group-read-ephemeral-gmane-group-url')
2377 (interactive
2378 (list (gnus-group-completing-read "Gmane URL: ")))
2379 (let (group start range)
2380 (cond
2381 ;; URLs providing `group', `start' and `range':
2382 ((string-match
2383 ;; http://thread.gmane.org/gmane.emacs.devel/86326/focus=86525
2384 "^http://thread\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)/focus=\\([0-9]+\\)$"
2385 url)
2386 (setq group (match-string 1 url)
2387 start (string-to-number (match-string 2 url))
2388 ;; Ensure that `range' is large enough to ensure focus article is
2389 ;; included.
2390 range (- (string-to-number (match-string 3 url))
2391 start -1)))
2392 ;; URLs providing `group' and `start':
2393 ((or (string-match
2394 ;; http://article.gmane.org/gmane.comp.gnu.make.bugs/3584
2395 "^http://\\(?:thread\\|article\\)\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)"
2396 url)
2397 (string-match
2398 ;; Don't advertize these in the doc string yet:
2399 "^\\(?:nntp\\|news\\)://news\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)"
2400 url)
2401 (string-match
2402 ;; http://news.gmane.org/group/gmane.emacs.gnus.general/thread=65099/force_load=t
2403 "^http://news\.gmane\.org/group/\\([^/]+\\)/thread=\\([0-9]+\\)"
2404 url))
2405 (setq group (match-string 1 url)
2406 start (string-to-number (match-string 2 url))))
2407 (t
2408 (error "Can't parse URL %s" url)))
2409 (gnus-group-read-ephemeral-gmane-group group start range)))
2410
2361(defun gnus-group-jump-to-group (group &optional prompt) 2411(defun gnus-group-jump-to-group (group &optional prompt)
2362 "Jump to newsgroup GROUP. 2412 "Jump to newsgroup GROUP.
2363 2413
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index b879c90e91f..4c2e77e4d46 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -78,6 +78,17 @@
78 :test 'equal) 78 :test 'equal)
79 "*The article registry by Message ID.") 79 "*The article registry by Message ID.")
80 80
81(defcustom gnus-registry-marks
82 '(Important Work Personal To-Do Later)
83 "List of marks that `gnus-registry-mark-article' will offer for completion."
84 :group 'gnus-registry
85 :type '(repeat symbol))
86
87(defcustom gnus-registry-default-mark 'To-Do
88 "The default mark."
89 :group 'gnus-registry
90 :type 'symbol)
91
81(defcustom gnus-registry-unfollowed-groups '("delayed$" "drafts$" "queue$" "INBOX$") 92(defcustom gnus-registry-unfollowed-groups '("delayed$" "drafts$" "queue$" "INBOX$")
82 "List of groups that gnus-registry-split-fancy-with-parent won't return. 93 "List of groups that gnus-registry-split-fancy-with-parent won't return.
83The group names are matched, they don't have to be fully 94The group names are matched, they don't have to be fully
@@ -129,6 +140,16 @@ way."
129 :group 'gnus-registry 140 :group 'gnus-registry
130 :type 'boolean) 141 :type 'boolean)
131 142
143(defcustom gnus-registry-extra-entries-precious '(marks)
144 "What extra entries are precious, meaning they won't get trimmed.
145When you save the Gnus registry, it's trimmed to be no longer
146than `gnus-registry-max-entries' (which is nil by default, so no
147trimming happens). Any entries with extra data in this list (by
148default, marks are included, so articles with marks are
149considered precious) will not be trimmed."
150 :group 'gnus-registry
151 :type '(repeat symbol))
152
132(defcustom gnus-registry-cache-file 153(defcustom gnus-registry-cache-file
133 (nnheader-concat 154 (nnheader-concat
134 (or gnus-dribble-directory gnus-home-directory "~/") 155 (or gnus-dribble-directory gnus-home-directory "~/")
@@ -313,30 +334,50 @@ way."
313 334
314(defun gnus-registry-trim (alist) 335(defun gnus-registry-trim (alist)
315 "Trim alist to size, using gnus-registry-max-entries. 336 "Trim alist to size, using gnus-registry-max-entries.
316Also, drop all gnus-registry-ignored-groups matches." 337Also, drop all gnus-registry-ignored-groups matches.
317 (if (null gnus-registry-max-entries) 338Any entries with extra data (marks, currently) are left alone."
339 (if (null gnus-registry-max-entries)
318 alist ; just return the alist 340 alist ; just return the alist
319 ;; else, when given max-entries, trim the alist 341 ;; else, when given max-entries, trim the alist
320 (let* ((timehash (make-hash-table 342 (let* ((timehash (make-hash-table
321 :size 4096 343 :size 20000
344 :test 'equal))
345 (precious (make-hash-table
346 :size 20000
322 :test 'equal)) 347 :test 'equal))
323 (trim-length (- (length alist) gnus-registry-max-entries)) 348 (trim-length (- (length alist) gnus-registry-max-entries))
324 (trim-length (if (natnump trim-length) trim-length 0))) 349 (trim-length (if (natnump trim-length) trim-length 0))
350 precious-list junk-list)
325 (maphash 351 (maphash
326 (lambda (key value) 352 (lambda (key value)
327 (puthash key (gnus-registry-fetch-extra key 'mtime) timehash)) 353 (let ((extra (gnus-registry-fetch-extra key)))
354 (dolist (item gnus-registry-extra-entries-precious)
355 (dolist (e extra)
356 (when (equal (nth 0 e) item)
357 (puthash key t precious)
358 (return))))
359 (puthash key (gnus-registry-fetch-extra key 'mtime) timehash)))
328 gnus-registry-hashtb) 360 gnus-registry-hashtb)
329
330 ;; we use the return value of this setq, which is the trimmed alist
331 (setq alist
332 (nthcdr
333 trim-length
334 (sort alist
335 (lambda (a b)
336 (time-less-p
337 (or (cdr (gethash (car a) timehash)) '(0 0 0))
338 (or (cdr (gethash (car b) timehash)) '(0 0 0))))))))))
339 361
362 (dolist (item alist)
363 (let ((key (nth 0 item)))
364 (if (gethash key precious)
365 (push item precious-list)
366 (push item junk-list))))
367
368 (sort
369 junk-list
370 (lambda (a b)
371 (let ((t1 (or (cdr (gethash (car a) timehash))
372 '(0 0 0)))
373 (t2 (or (cdr (gethash (car b) timehash))
374 '(0 0 0))))
375 (time-less-p t1 t2))))
376
377 ;; we use the return value of this setq, which is the trimmed alist
378 (setq alist (append precious-list
379 (nthcdr trim-length junk-list))))))
380
340(defun gnus-registry-action (action data-header from &optional to method) 381(defun gnus-registry-action (action data-header from &optional to method)
341 (let* ((id (mail-header-id data-header)) 382 (let* ((id (mail-header-id data-header))
342 (subject (gnus-string-remove-all-properties 383 (subject (gnus-string-remove-all-properties
@@ -577,6 +618,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
577 (assoc article (gnus-data-list nil))))) 618 (assoc article (gnus-data-list nil)))))
578 nil)) 619 nil))
579 620
621;;; this should be redone with catch/throw
580(defun gnus-registry-grep-in-list (word list) 622(defun gnus-registry-grep-in-list (word list)
581 (when word 623 (when word
582 (memq nil 624 (memq nil
@@ -586,80 +628,91 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
586 (string-match word x)) 628 (string-match word x))
587 list))))) 629 list)))))
588 630
589(defun gnus-registry-mark-article (article &optional mark remove) 631
590 "Mark ARTICLE with MARK in the Gnus registry or remove MARK. 632(defun gnus-registry-read-mark ()
591MARK can be any symbol. If ARTICLE is nil, then the 633 "Read a mark name from the user with completion."
592`gnus-current-article' will be marked. If MARK is nil, 634 (let ((mark (gnus-completing-read-with-default
593`gnus-registry-flag-default' will be used." 635 (symbol-name gnus-registry-default-mark)
594 (interactive "nArticle number: ") 636 "Label"
595 (let ((article (or article gnus-current-article)) 637 (mapcar (lambda (x) ; completion list
596 (mark (or mark 'gnus-registry-flag-default)) 638 (cons (symbol-name x) x))
597 article-id) 639 gnus-registry-marks))))
598 (unless article 640 (when (stringp mark)
599 (error "No article on current line")) 641 (intern mark))))
600 (setq article-id 642
601 (gnus-registry-fetch-message-id-fast gnus-current-article)) 643(defun gnus-registry-set-article-mark (&rest articles)
602 (unless article-id 644 "Apply a mark to process-marked ARTICLES."
603 (error "No article ID could be retrieved")) 645 (interactive (gnus-summary-work-articles current-prefix-arg))
604 (let* ( 646 (gnus-registry-set-article-mark-internal (gnus-registry-read-mark) articles nil t))
605 ;; all the marks for this article 647
606 (marks (gnus-registry-fetch-extra-flags article-id)) 648(defun gnus-registry-remove-article-mark (&rest articles)
607 ;; the marks without the mark of interest 649 "Remove a mark from process-marked ARTICLES."
608 (cleaned-marks (delq mark marks)) 650 (interactive (gnus-summary-work-articles current-prefix-arg))
609 ;; the new marks we want to use 651 (gnus-registry-set-article-mark-internal (gnus-registry-read-mark) articles t t))
610 (new-marks (if remove 652
611 cleaned-marks 653(defun gnus-registry-set-article-mark-internal (mark articles &optional remove show-message)
612 (cons mark cleaned-marks)))) 654 "Apply a mark to a list of ARTICLES."
613 (apply 'gnus-registry-store-extra-flags ; set the extra flags 655 (let ((article-id-list
614 article-id ; for the message ID 656 (mapcar 'gnus-registry-fetch-message-id-fast articles)))
615 new-marks) 657 (dolist (id article-id-list)
616 (gnus-registry-fetch-extra-flags article-id)))) 658 (let* (
617 659 ;; all the marks for this article without the mark of
618(defun gnus-registry-article-marks (article) 660 ;; interest
619 "Get the Gnus registry marks for ARTICLE. 661 (marks
620If ARTICLE is nil, then the `gnus-current-article' will be 662 (delq mark (gnus-registry-fetch-extra-marks id)))
621used." 663 ;; the new marks we want to use
622 (interactive "nArticle number: ") 664 (new-marks (if remove
623 (let ((article (or article gnus-current-article)) 665 marks
624 article-id) 666 (cons mark marks))))
625 (unless article 667 (when show-message
626 (error "No article on current line")) 668 (gnus-message 1 "%s mark %s with message ID %s, resulting in %S"
627 (setq article-id 669 (if remove "Removing" "Adding")
628 (gnus-registry-fetch-message-id-fast gnus-current-article)) 670 mark id new-marks))
629 (unless article-id 671
630 (error "No article ID could be retrieved")) 672 (apply 'gnus-registry-store-extra-marks ; set the extra marks
631 (gnus-message 1 673 id ; for the message ID
632 "Message ID %s, Registry flags: %s" 674 new-marks)))))
633 article-id 675
634 (concat (gnus-registry-fetch-extra-flags article-id))))) 676(defun gnus-registry-get-article-marks (&rest articles)
635 677 "Get the Gnus registry marks for ARTICLES and show them if interactive.
636 678Uses process/prefix conventions. For multiple articles,
637;;; if this extends to more than 'flags, it should be improved to be more generic. 679only the last one's marks are returned."
638(defun gnus-registry-fetch-extra-flags (id) 680 (interactive (gnus-summary-work-articles 1))
639 "Get the flags of a message, based on the message ID. 681 (let (marks)
640Returns a list of symbol flags or nil." 682 (dolist (article articles)
641 (car-safe (cdr (gnus-registry-fetch-extra id 'flags)))) 683 (let ((article-id
642 684 (gnus-registry-fetch-message-id-fast article)))
643(defun gnus-registry-has-extra-flag (id flag) 685 (setq marks (gnus-registry-fetch-extra-marks article-id))))
644 "Checks if a message has `flag', based on the message ID." 686 (when (interactive-p)
645 (memq flag (gnus-registry-fetch-extra-flags id))) 687 (gnus-message 1 "Marks are %S" marks))
646 688 marks))
647(defun gnus-registry-store-extra-flags (id &rest flag-list) 689
648 "Set the flags of a message, based on the message ID. 690;;; if this extends to more than 'marks, it should be improved to be more generic.
649The `flag-list' can be nil, in which case no flags are left." 691(defun gnus-registry-fetch-extra-marks (id)
650 (gnus-registry-store-extra-entry id 'flags (list flag-list))) 692 "Get the marks of a message, based on the message ID.
651 693Returns a list of symbol marks or nil."
652(defun gnus-registry-delete-extra-flags (id &rest flag-delete-list) 694 (car-safe (cdr (gnus-registry-fetch-extra id 'marks))))
653 "Delete the message flags in `flag-delete-list', based on the message ID." 695
654 (let ((flags (gnus-registry-fetch-extra-flags id))) 696(defun gnus-registry-has-extra-mark (id mark)
655 (when flags 697 "Checks if a message has `mark', based on the message ID `id'."
656 (dolist (flag flag-delete-list) 698 (memq mark (gnus-registry-fetch-extra-marks id)))
657 (setq flags (delq flag flags)))) 699
658 (gnus-registry-store-extra-flags id (car flags)))) 700(defun gnus-registry-store-extra-marks (id &rest mark-list)
659 701 "Set the marks of a message, based on the message ID.
660(defun gnus-registry-delete-all-extra-flags (id) 702The `mark-list' can be nil, in which case no marks are left."
661 "Delete all the flags for a message ID." 703 (gnus-registry-store-extra-entry id 'marks (list mark-list)))
662 (gnus-registry-store-extra-flags id nil)) 704
705(defun gnus-registry-delete-extra-marks (id &rest mark-delete-list)
706 "Delete the message marks in `mark-delete-list', based on the message ID."
707 (let ((marks (gnus-registry-fetch-extra-marks id)))
708 (when marks
709 (dolist (mark mark-delete-list)
710 (setq marks (delq mark marks))))
711 (gnus-registry-store-extra-marks id (car marks))))
712
713(defun gnus-registry-delete-all-extra-marks (id)
714 "Delete all the marks for a message ID."
715 (gnus-registry-store-extra-marks id nil))
663 716
664(defun gnus-registry-fetch-extra (id &optional entry) 717(defun gnus-registry-fetch-extra (id &optional entry)
665 "Get the extra data of a message, based on the message ID. 718 "Get the extra data of a message, based on the message ID.
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index beccca289bc..52eab645d4e 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -4797,11 +4797,11 @@ using some other form will lead to serious barfage."
4797 (gnus-thread-header h1) (gnus-thread-header h2))) 4797 (gnus-thread-header h1) (gnus-thread-header h2)))
4798 4798
4799(defsubst gnus-article-sort-by-random (h1 h2) 4799(defsubst gnus-article-sort-by-random (h1 h2)
4800 "Sort articles by article number." 4800 "Sort articles randomly."
4801 (zerop (random 2))) 4801 (zerop (random 2)))
4802 4802
4803(defun gnus-thread-sort-by-random (h1 h2) 4803(defun gnus-thread-sort-by-random (h1 h2)
4804 "Sort threads by root article number." 4804 "Sort threads randomly."
4805 (gnus-article-sort-by-random 4805 (gnus-article-sort-by-random
4806 (gnus-thread-header h1) (gnus-thread-header h2))) 4806 (gnus-thread-header h1) (gnus-thread-header h2)))
4807 4807
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 9f9f9733110..01463c55628 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -74,6 +74,8 @@ See Info node `(gnus)Mail Source Specifiers'."
74 (repeat :tag "List" 74 (repeat :tag "List"
75 (choice :format "%[Value Menu%] %v" 75 (choice :format "%[Value Menu%] %v"
76 :value (file) 76 :value (file)
77 (cons :tag "Group parameter `mail-source'"
78 (const :format "" group))
77 (cons :tag "Spool file" 79 (cons :tag "Spool file"
78 (const :format "" file) 80 (const :format "" file)
79 (checklist :tag "Options" :greedy t 81 (checklist :tag "Options" :greedy t
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 731d9924286..273d1c4ec5b 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -5952,7 +5952,7 @@ beginning of header value. Therefore, repeated calls will toggle point
5952between beginning of field and beginning of line." 5952between beginning of field and beginning of line."
5953 (interactive "p") 5953 (interactive "p")
5954 (let ((zrs 'zmacs-region-stays)) 5954 (let ((zrs 'zmacs-region-stays))
5955 (when (and (interactive-p) (boundp zrs)) 5955 (when (and (featurep 'xemacs) (interactive-p) (boundp zrs))
5956 (set zrs t))) 5956 (set zrs t)))
5957 (if (and message-beginning-of-line 5957 (if (and message-beginning-of-line
5958 (message-point-in-header-p)) 5958 (message-point-in-header-p))
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 8e88ffca6bb..f832a9c28e1 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -570,7 +570,10 @@ Postpone undisplaying of viewers for types in
570 ;; creates unibyte buffers. This `if', though not a perfect 570 ;; creates unibyte buffers. This `if', though not a perfect
571 ;; solution, avoids most of them. 571 ;; solution, avoids most of them.
572 (if from 572 (if from
573 (setq from (cadr (mail-extract-address-components from)))))) 573 (setq from (cadr (mail-extract-address-components from))))
574 (if description
575 (setq description (mail-decode-encoded-word-string
576 description)))))
574 (if (or (not ctl) 577 (if (or (not ctl)
575 (not (string-match "/" (car ctl)))) 578 (not (string-match "/" (car ctl))))
576 (mm-dissect-singlepart 579 (mm-dissect-singlepart
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index da2e5bbbfc9..c335e985d0e 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -874,14 +874,19 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
874 874
875(defun mml-to-mime () 875(defun mml-to-mime ()
876 "Translate the current buffer from MML to MIME." 876 "Translate the current buffer from MML to MIME."
877 (message-encode-message-body) 877 ;; `message-encode-message-body' will insert an encoded Content-Description
878 ;; header in the message header if the body contains a single part
879 ;; that is specified by a user with a MML tag containing a description
880 ;; token. So, we encode the message header first to prevent the encoded
881 ;; Content-Description header from being encoded again.
878 (save-restriction 882 (save-restriction
879 (message-narrow-to-headers-or-head) 883 (message-narrow-to-headers-or-head)
880 ;; Skip past any From_ headers. 884 ;; Skip past any From_ headers.
881 (while (looking-at "From ") 885 (while (looking-at "From ")
882 (forward-line 1)) 886 (forward-line 1))
883 (let ((mail-parse-charset message-default-charset)) 887 (let ((mail-parse-charset message-default-charset))
884 (mail-encode-encoded-word-buffer)))) 888 (mail-encode-encoded-word-buffer)))
889 (message-encode-message-body))
885 890
886(defun mml-insert-mime (handle &optional no-markup) 891(defun mml-insert-mime (handle &optional no-markup)
887 (let (textp buffer mmlp) 892 (let (textp buffer mmlp)
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index f0f90218aab..a6ed7190351 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1766,11 +1766,15 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
1766 (symbol-value sym)))) 1766 (symbol-value sym))))
1767 1767
1768(defun nnmail-get-new-mail (method exit-func temp 1768(defun nnmail-get-new-mail (method exit-func temp
1769 &optional group spool-func) 1769 &optional group spool-func)
1770 "Read new incoming mail." 1770 "Read new incoming mail."
1771 (nnmail-get-new-mail-1 method exit-func temp group nil spool-func))
1772
1773(defun nnmail-get-new-mail-1 (method exit-func temp
1774 group in-group spool-func)
1775
1771 (let* ((sources mail-sources) 1776 (let* ((sources mail-sources)
1772 fetching-sources 1777 fetching-sources
1773 (group-in group)
1774 (i 0) 1778 (i 0)
1775 (new 0) 1779 (new 0)
1776 (total 0) 1780 (total 0)
@@ -1778,6 +1782,18 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
1778 (when (and (nnmail-get-value "%s-get-new-mail" method) 1782 (when (and (nnmail-get-value "%s-get-new-mail" method)
1779 sources) 1783 sources)
1780 (while (setq source (pop sources)) 1784 (while (setq source (pop sources))
1785
1786 ;; Use group's parameter
1787 (when (eq (car source) 'group)
1788 (let ((mail-sources
1789 (list
1790 (gnus-group-find-parameter
1791 (concat (symbol-name method) ":" group)
1792 'mail-source t))))
1793 (nnmail-get-new-mail-1 method exit-func temp
1794 group group spool-func))
1795 (setq source nil))
1796
1781 ;; Hack to only fetch the contents of a single group's spool file. 1797 ;; Hack to only fetch the contents of a single group's spool file.
1782 (when (and (eq (car source) 'directory) 1798 (when (and (eq (car source) 'directory)
1783 (null nnmail-scan-directory-mail-source-once) 1799 (null nnmail-scan-directory-mail-source-once)
@@ -1816,9 +1832,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
1816 (nnmail-split-incoming 1832 (nnmail-split-incoming
1817 file ',(intern (format "%s-save-mail" method)) 1833 file ',(intern (format "%s-save-mail" method))
1818 ',spool-func 1834 ',spool-func
1819 (if (equal file orig-file) 1835 (or in-group
1820 nil 1836 (if (equal file orig-file)
1821 (nnmail-get-split-group orig-file ',source)) 1837 nil
1838 (nnmail-get-split-group orig-file ',source)))
1822 ',(intern (format "%s-active-number" method))))))) 1839 ',(intern (format "%s-active-number" method)))))))
1823 (incf total new) 1840 (incf total new)
1824 (incf i))) 1841 (incf i)))
diff --git a/lisp/gnus/sieve.el b/lisp/gnus/sieve.el
index c05e9d1a356..c32c44ae505 100644
--- a/lisp/gnus/sieve.el
+++ b/lisp/gnus/sieve.el
@@ -290,15 +290,15 @@ Server : " server ":" (or port "2000") "
290 (get-char-property (or pos (point)) 'script-name)) 290 (get-char-property (or pos (point)) 'script-name))
291 291
292(eval-and-compile 292(eval-and-compile
293 (defalias 'sieve-make-overlay (if (fboundp 'make-overlay) 293 (defalias 'sieve-make-overlay (if (featurep 'xemacs)
294 'make-overlay 294 'make-extent
295 'make-extent)) 295 'make-overlay))
296 (defalias 'sieve-overlay-put (if (fboundp 'overlay-put) 296 (defalias 'sieve-overlay-put (if (featurep 'xemacs)
297 'overlay-put 297 'set-extent-property
298 'set-extent-property)) 298 'overlay-put))
299 (defalias 'sieve-overlays-at (if (fboundp 'overlays-at) 299 (defalias 'sieve-overlays-at (if (featurep 'xemacs)
300 'overlays-at 300 'extents-at
301 'extents-at))) 301 'overlays-at)))
302 302
303(defun sieve-highlight (on) 303(defun sieve-highlight (on)
304 "Turn ON or off highlighting on the current language overlay." 304 "Turn ON or off highlighting on the current language overlay."
diff --git a/lisp/gnus/spam-wash.el b/lisp/gnus/spam-wash.el
index be9a822dd2f..70192e06c1a 100644
--- a/lisp/gnus/spam-wash.el
+++ b/lisp/gnus/spam-wash.el
@@ -1,6 +1,6 @@
1;;; spam-wash.el --- wash spam before analysis 1;;; spam-wash.el --- wash spam before analysis
2 2
3;; Copyright (C) 2004, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2004, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Andrew Cohen <cohen@andy.bu.edu> 5;; Author: Andrew Cohen <cohen@andy.bu.edu>
6;; Keywords: mail 6;; Keywords: mail
diff --git a/lisp/help.el b/lisp/help.el
index 68d3e33fe0a..24f1e74d71a 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -860,7 +860,7 @@ whose documentation describes the minor mode."
860 (let ((mode mode-name)) 860 (let ((mode mode-name))
861 (with-current-buffer standard-output 861 (with-current-buffer standard-output
862 (let ((start (point))) 862 (let ((start (point)))
863 (insert (format-mode-line mode)) 863 (insert (format-mode-line mode nil nil buffer))
864 (add-text-properties start (point) '(face bold))))) 864 (add-text-properties start (point) '(face bold)))))
865 (princ " mode:\n") 865 (princ " mode:\n")
866 (princ (documentation major-mode)))))) 866 (princ (documentation major-mode))))))
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 0b2586d0fce..82face5eccb 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -228,7 +228,7 @@ Currently, this only applies to `ibuffer-saved-filters' and
228 (ignore-errors 228 (ignore-errors
229 (with-current-buffer buf 229 (with-current-buffer buf
230 (when (and ibuffer-auto-mode 230 (when (and ibuffer-auto-mode
231 (eq major-mode 'ibuffer-mode)) 231 (derived-mode-p 'ibuffer-mode))
232 (ibuffer-update nil t))))))) 232 (ibuffer-update nil t)))))))
233 233
234;;;###autoload 234;;;###autoload
@@ -236,15 +236,14 @@ Currently, this only applies to `ibuffer-saved-filters' and
236 "Toggle use of Ibuffer's auto-update facility. 236 "Toggle use of Ibuffer's auto-update facility.
237With numeric ARG, enable auto-update if and only if ARG is positive." 237With numeric ARG, enable auto-update if and only if ARG is positive."
238 (interactive) 238 (interactive)
239 (unless (eq major-mode 'ibuffer-mode) 239 (unless (derived-mode-p 'ibuffer-mode)
240 (error "This buffer is not in Ibuffer mode")) 240 (error "This buffer is not in Ibuffer mode"))
241 (set (make-local-variable 'ibuffer-auto-mode) 241 (set (make-local-variable 'ibuffer-auto-mode)
242 (if arg 242 (if arg
243 (plusp arg) 243 (plusp arg)
244 (not ibuffer-auto-mode))) 244 (not ibuffer-auto-mode)))
245 (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) ; Initialize state vector 245 (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) ; Initialize state vector
246 (add-hook 'post-command-hook 'ibuffer-auto-update-changed) 246 (add-hook 'post-command-hook 'ibuffer-auto-update-changed))
247 (ibuffer-update-mode-name))
248 247
249;;;###autoload 248;;;###autoload
250(defun ibuffer-mouse-filter-by-mode (event) 249(defun ibuffer-mouse-filter-by-mode (event)
@@ -731,8 +730,7 @@ prompt for NAME, and use the current filters."
731 (ibuffer-aif (assoc name ibuffer-saved-filter-groups) 730 (ibuffer-aif (assoc name ibuffer-saved-filter-groups)
732 (setcdr it groups) 731 (setcdr it groups)
733 (push (cons name groups) ibuffer-saved-filter-groups)) 732 (push (cons name groups) ibuffer-saved-filter-groups))
734 (ibuffer-maybe-save-stuff) 733 (ibuffer-maybe-save-stuff))
735 (ibuffer-update-mode-name))
736 734
737;;;###autoload 735;;;###autoload
738(defun ibuffer-delete-saved-filter-groups (name) 736(defun ibuffer-delete-saved-filter-groups (name)
@@ -897,8 +895,7 @@ Interactively, prompt for NAME, and use the current filters."
897 (ibuffer-aif (assoc name ibuffer-saved-filters) 895 (ibuffer-aif (assoc name ibuffer-saved-filters)
898 (setcdr it filters) 896 (setcdr it filters)
899 (push (list name filters) ibuffer-saved-filters)) 897 (push (list name filters) ibuffer-saved-filters))
900 (ibuffer-maybe-save-stuff) 898 (ibuffer-maybe-save-stuff))
901 (ibuffer-update-mode-name))
902 899
903;;;###autoload 900;;;###autoload
904(defun ibuffer-delete-saved-filters (name) 901(defun ibuffer-delete-saved-filters (name)
@@ -1158,6 +1155,20 @@ Ordering is lexicographic."
1158 (with-current-buffer (car b) 1155 (with-current-buffer (car b)
1159 (buffer-size)))) 1156 (buffer-size))))
1160 1157
1158;;;###autoload (autoload 'ibuffer-do-sort-by-filename/process "ibuf-ext")
1159(define-ibuffer-sorter filename/process
1160 "Sort the buffers by their file name/process name."
1161 (:description "file name")
1162 (string-lessp
1163 ;; FIXME: For now just compare the file name and the process name
1164 ;; (if it exists). Is there a better way to do this?
1165 (or (buffer-file-name (car a))
1166 (let ((pr-a (get-buffer-process (car a))))
1167 (and (processp pr-a) (process-name pr-a))))
1168 (or (buffer-file-name (car b))
1169 (let ((pr-b (get-buffer-process (car b))))
1170 (and (processp pr-b) (process-name pr-b))))))
1171
1161;;; Functions to emulate bs.el 1172;;; Functions to emulate bs.el
1162 1173
1163;;;###autoload 1174;;;###autoload
@@ -1386,7 +1397,7 @@ You can then feed the file name(s) to other commands with \\[yank]."
1386 (ibuffer-mark-on-buffer 1397 (ibuffer-mark-on-buffer
1387 #'(lambda (buf) 1398 #'(lambda (buf)
1388 (with-current-buffer buf 1399 (with-current-buffer buf
1389 (string-match regexp (format-mode-line mode-name)))))) 1400 (string-match regexp (format-mode-line mode-name nil nil buf))))))
1390 1401
1391;;;###autoload 1402;;;###autoload
1392(defun ibuffer-mark-by-file-name-regexp (regexp) 1403(defun ibuffer-mark-by-file-name-regexp (regexp)
@@ -1539,5 +1550,5 @@ defaults to one."
1539 1550
1540(provide 'ibuf-ext) 1551(provide 'ibuf-ext)
1541 1552
1542;;; arch-tag: 9af21953-deda-4c30-b76d-f81d9128e76d 1553;; arch-tag: 9af21953-deda-4c30-b76d-f81d9128e76d
1543;;; ibuf-ext.el ends here 1554;;; ibuf-ext.el ends here
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 9e6918e8020..7c6da00cf0f 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -209,6 +209,7 @@ view of the buffers."
209 :type '(choice (const :tag "Last view time" :value recency) 209 :type '(choice (const :tag "Last view time" :value recency)
210 (const :tag "Lexicographic" :value alphabetic) 210 (const :tag "Lexicographic" :value alphabetic)
211 (const :tag "Buffer size" :value size) 211 (const :tag "Buffer size" :value size)
212 (const :tag "File name" :value filename/process)
212 (const :tag "Major mode" :value major-mode)) 213 (const :tag "Major mode" :value major-mode))
213 :group 'ibuffer) 214 :group 'ibuffer)
214(defvar ibuffer-sorting-mode nil) 215(defvar ibuffer-sorting-mode nil)
@@ -447,6 +448,7 @@ directory, like `default-directory'."
447 (define-key map (kbd "s a") 'ibuffer-do-sort-by-alphabetic) 448 (define-key map (kbd "s a") 'ibuffer-do-sort-by-alphabetic)
448 (define-key map (kbd "s v") 'ibuffer-do-sort-by-recency) 449 (define-key map (kbd "s v") 'ibuffer-do-sort-by-recency)
449 (define-key map (kbd "s s") 'ibuffer-do-sort-by-size) 450 (define-key map (kbd "s s") 'ibuffer-do-sort-by-size)
451 (define-key map (kbd "s f") 'ibuffer-do-sort-by-filename/process)
450 (define-key map (kbd "s m") 'ibuffer-do-sort-by-major-mode) 452 (define-key map (kbd "s m") 'ibuffer-do-sort-by-major-mode)
451 453
452 (define-key map (kbd "/ m") 'ibuffer-filter-by-mode) 454 (define-key map (kbd "/ m") 'ibuffer-filter-by-mode)
@@ -828,6 +830,11 @@ directory, like `default-directory'."
828 (define-key map [down-mouse-3] 'ibuffer-mouse-popup-menu) 830 (define-key map [down-mouse-3] 'ibuffer-mouse-popup-menu)
829 map)) 831 map))
830 832
833(defvar ibuffer-filename/process-header-map
834 (let ((map (make-sparse-keymap)))
835 (define-key map [(mouse-1)] 'ibuffer-do-sort-by-filename/process)
836 map))
837
831(defvar ibuffer-mode-name-map 838(defvar ibuffer-mode-name-map
832 (let ((map (make-sparse-keymap))) 839 (let ((map (make-sparse-keymap)))
833 (define-key map [(mouse-2)] 'ibuffer-mouse-filter-by-mode) 840 (define-key map [(mouse-2)] 'ibuffer-mouse-filter-by-mode)
@@ -1722,7 +1729,7 @@ If point is on a group name, this function operates on that group."
1722 ('mouse-face 'highlight 1729 ('mouse-face 'highlight
1723 'keymap ibuffer-mode-name-map 1730 'keymap ibuffer-mode-name-map
1724 'help-echo "mouse-2: filter by this mode")) 1731 'help-echo "mouse-2: filter by this mode"))
1725 (format-mode-line mode-name)) 1732 (format-mode-line mode-name nil nil (current-buffer)))
1726 1733
1727(define-ibuffer-column process 1734(define-ibuffer-column process
1728 (:summarizer 1735 (:summarizer
@@ -1753,6 +1760,7 @@ If point is on a group name, this function operates on that group."
1753 1760
1754(define-ibuffer-column filename-and-process 1761(define-ibuffer-column filename-and-process
1755 (:name "Filename/Process" 1762 (:name "Filename/Process"
1763 :header-mouse-map ibuffer-filename/process-header-map
1756 :summarizer 1764 :summarizer
1757 (lambda (strings) 1765 (lambda (strings)
1758 (setq strings (delete "" strings)) 1766 (setq strings (delete "" strings))
@@ -2097,29 +2105,6 @@ the value of point at the beginning of the line for that buffer."
2097 (point)) 2105 (point))
2098 `(ibuffer-summary t))))) 2106 `(ibuffer-summary t)))))
2099 2107
2100(defun ibuffer-update-mode-name ()
2101 (setq mode-name (format "Ibuffer by %s" (if ibuffer-sorting-mode
2102 ibuffer-sorting-mode
2103 "view time")))
2104 (when ibuffer-sorting-reversep
2105 (setq mode-name (concat mode-name " [rev]")))
2106 (when (and (featurep 'ibuf-ext)
2107 ibuffer-auto-mode)
2108 (setq mode-name (concat mode-name " (Auto)")))
2109 (let ((result ""))
2110 (when (featurep 'ibuf-ext)
2111 (dolist (qualifier ibuffer-filtering-qualifiers)
2112 (setq result
2113 (concat result (ibuffer-format-qualifier qualifier))))
2114 (if ibuffer-use-header-line
2115 (setq header-line-format
2116 (when ibuffer-filtering-qualifiers
2117 (replace-regexp-in-string "%" "%%"
2118 (concat mode-name result))))
2119 (progn
2120 (setq mode-name (concat mode-name result))
2121 (when (boundp 'header-line-format)
2122 (setq header-line-format nil)))))))
2123 2108
2124(defun ibuffer-redisplay (&optional silent) 2109(defun ibuffer-redisplay (&optional silent)
2125 "Redisplay the current list of buffers. 2110 "Redisplay the current list of buffers.
@@ -2137,7 +2122,6 @@ If optional arg SILENT is non-nil, do not display progress messages."
2137 (message "No buffers! (note: filtering in effect)") 2122 (message "No buffers! (note: filtering in effect)")
2138 (error "No buffers!"))) 2123 (error "No buffers!")))
2139 (ibuffer-redisplay-engine blist t) 2124 (ibuffer-redisplay-engine blist t)
2140 (ibuffer-update-mode-name)
2141 (unless silent 2125 (unless silent
2142 (message "Redisplaying current buffer list...done")) 2126 (message "Redisplaying current buffer list...done"))
2143 (ibuffer-forward-line 0))) 2127 (ibuffer-forward-line 0)))
@@ -2174,7 +2158,6 @@ If optional arg SILENT is non-nil, do not display progress messages."
2174 (unless silent 2158 (unless silent
2175 (message "Updating buffer list...")) 2159 (message "Updating buffer list..."))
2176 (ibuffer-redisplay-engine blist arg) 2160 (ibuffer-redisplay-engine blist arg)
2177 (ibuffer-update-mode-name)
2178 (unless silent 2161 (unless silent
2179 (message "Updating buffer list...done"))) 2162 (message "Updating buffer list...done")))
2180 (if (eq ibuffer-shrink-to-minimum-size 'onewindow) 2163 (if (eq ibuffer-shrink-to-minimum-size 'onewindow)
@@ -2458,6 +2441,7 @@ Sorting commands:
2458 '\\[ibuffer-toggle-sorting-mode]' - Rotate between the various sorting modes. 2441 '\\[ibuffer-toggle-sorting-mode]' - Rotate between the various sorting modes.
2459 '\\[ibuffer-invert-sorting]' - Reverse the current sorting order. 2442 '\\[ibuffer-invert-sorting]' - Reverse the current sorting order.
2460 '\\[ibuffer-do-sort-by-alphabetic]' - Sort the buffers lexicographically. 2443 '\\[ibuffer-do-sort-by-alphabetic]' - Sort the buffers lexicographically.
2444 '\\[ibuffer-do-sort-by-filename/process]' - Sort the buffers by the file name.
2461 '\\[ibuffer-do-sort-by-recency]' - Sort the buffers by last viewing time. 2445 '\\[ibuffer-do-sort-by-recency]' - Sort the buffers by last viewing time.
2462 '\\[ibuffer-do-sort-by-size]' - Sort the buffers by size. 2446 '\\[ibuffer-do-sort-by-size]' - Sort the buffers by size.
2463 '\\[ibuffer-do-sort-by-major-mode]' - Sort the buffers by major mode. 2447 '\\[ibuffer-do-sort-by-major-mode]' - Sort the buffers by major mode.
@@ -2540,6 +2524,28 @@ will be inserted before the group at point."
2540 (use-local-map ibuffer-mode-map) 2524 (use-local-map ibuffer-mode-map)
2541 (setq major-mode 'ibuffer-mode) 2525 (setq major-mode 'ibuffer-mode)
2542 (setq mode-name "Ibuffer") 2526 (setq mode-name "Ibuffer")
2527 ;; Include state info next to the mode name.
2528 (set (make-local-variable 'mode-line-process)
2529 '(" by "
2530 (ibuffer-sorting-mode (:eval (symbol-name ibuffer-sorting-mode))
2531 "view time")
2532 (ibuffer-sorting-reversep " [rev]")
2533 (ibuffer-auto-mode " (Auto)")
2534 ;; Only list the filters if they're not already in the header-line.
2535 (header-line-format
2536 ""
2537 (:eval (if (functionp 'ibuffer-format-qualifier)
2538 (mapconcat 'ibuffer-format-qualifier
2539 ibuffer-filtering-qualifiers ""))))))
2540 (setq header-line-format
2541 (if ibuffer-use-header-line
2542 ;; Display the part that won't be in the mode-line.
2543 (list* "" mode-name
2544 (mapcar (lambda (elem)
2545 (if (eq (car-safe elem) 'header-line-format)
2546 (nth 2 elem) elem))
2547 mode-line-process))))
2548
2543 (setq buffer-read-only t) 2549 (setq buffer-read-only t)
2544 (buffer-disable-undo) 2550 (buffer-disable-undo)
2545 (setq truncate-lines ibuffer-truncate-lines) 2551 (setq truncate-lines ibuffer-truncate-lines)
@@ -2578,9 +2584,7 @@ will be inserted before the group at point."
2578 (when ibuffer-default-directory 2584 (when ibuffer-default-directory
2579 (setq default-directory ibuffer-default-directory)) 2585 (setq default-directory ibuffer-default-directory))
2580 (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) 2586 (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
2581 (run-mode-hooks 'ibuffer-mode-hook) 2587 (run-mode-hooks 'ibuffer-mode-hook))
2582 ;; called after mode hooks to allow the user to add filters
2583 (ibuffer-update-mode-name))
2584 2588
2585(provide 'ibuffer) 2589(provide 'ibuffer)
2586 2590
@@ -2590,5 +2594,5 @@ will be inserted before the group at point."
2590;; coding: iso-8859-1 2594;; coding: iso-8859-1
2591;; End: 2595;; End:
2592 2596
2593;;; arch-tag: 72581688-0603-4954-b8cf-837c700f62e8 2597;; arch-tag: 72581688-0603-4954-b8cf-837c700f62e8
2594;;; ibuffer.el ends here 2598;;; ibuffer.el ends here
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index b1e8fa5ebb5..3eb4b4babf2 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -147,8 +147,7 @@ is minibuffer."
147 (save-excursion 147 (save-excursion
148 (let* ((sym (intern func-name)) 148 (let* ((sym (intern func-name))
149 (buf (other-buffer nil t)) 149 (buf (other-buffer nil t))
150 (map (save-excursion (set-buffer buf) (current-local-map))) 150 (keys (with-current-buffer buf (where-is-internal sym))))
151 (keys (where-is-internal sym map)))
152 (if keys 151 (if keys
153 (concat "<" 152 (concat "<"
154 (mapconcat 'key-description 153 (mapconcat 'key-description
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 6b02db50134..55caae9a91d 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -50,22 +50,49 @@
50 50
51;;; Image scrolling functions 51;;; Image scrolling functions
52 52
53(defvar image-mode-current-vscroll nil
54 "An alist with elements (WINDOW . VSCROLL).")
55
56(defvar image-mode-current-hscroll nil
57 "An alist with elements (WINDOW . HSCROLL).")
58
59(defun image-set-window-vscroll (window vscroll &optional pixels-p)
60 (setq image-mode-current-vscroll
61 (append (list (cons window vscroll))
62 (delete (assoc window image-mode-current-vscroll)
63 image-mode-current-vscroll)))
64 (set-window-vscroll window vscroll pixels-p))
65
66(defun image-set-window-hscroll (window ncol)
67 (setq image-mode-current-hscroll
68 (append (list (cons window ncol))
69 (delete (assoc window image-mode-current-hscroll)
70 image-mode-current-hscroll)))
71 (set-window-hscroll window ncol))
72
73(defun image-reset-current-vhscroll ()
74 (let ((win (selected-window)))
75 (when (assoc win image-mode-current-hscroll)
76 (set-window-hscroll win (cdr (assoc win image-mode-current-hscroll))))
77 (when (assoc win image-mode-current-vscroll)
78 (set-window-vscroll win (cdr (assoc win image-mode-current-vscroll))))))
79
53(defun image-forward-hscroll (&optional n) 80(defun image-forward-hscroll (&optional n)
54 "Scroll image in current window to the left by N character widths. 81 "Scroll image in current window to the left by N character widths.
55Stop if the right edge of the image is reached." 82Stop if the right edge of the image is reached."
56 (interactive "p") 83 (interactive "p")
57 (cond ((= n 0) nil) 84 (cond ((= n 0) nil)
58 ((< n 0) 85 ((< n 0)
59 (set-window-hscroll (selected-window) 86 (image-set-window-hscroll (selected-window)
60 (max 0 (+ (window-hscroll) n)))) 87 (max 0 (+ (window-hscroll) n))))
61 (t 88 (t
62 (let* ((image (get-char-property (point-min) 'display)) 89 (let* ((image (get-char-property (point-min) 'display))
63 (edges (window-inside-edges)) 90 (edges (window-inside-edges))
64 (win-width (- (nth 2 edges) (nth 0 edges))) 91 (win-width (- (nth 2 edges) (nth 0 edges)))
65 (img-width (ceiling (car (image-size image))))) 92 (img-width (ceiling (car (image-size image)))))
66 (set-window-hscroll (selected-window) 93 (image-set-window-hscroll (selected-window)
67 (min (max 0 (- img-width win-width)) 94 (min (max 0 (- img-width win-width))
68 (+ n (window-hscroll)))))))) 95 (+ n (window-hscroll))))))))
69 96
70(defun image-backward-hscroll (&optional n) 97(defun image-backward-hscroll (&optional n)
71 "Scroll image in current window to the right by N character widths. 98 "Scroll image in current window to the right by N character widths.
@@ -79,16 +106,16 @@ Stop if the bottom edge of the image is reached."
79 (interactive "p") 106 (interactive "p")
80 (cond ((= n 0) nil) 107 (cond ((= n 0) nil)
81 ((< n 0) 108 ((< n 0)
82 (set-window-vscroll (selected-window) 109 (image-set-window-vscroll (selected-window)
83 (max 0 (+ (window-vscroll) n)))) 110 (max 0 (+ (window-vscroll) n))))
84 (t 111 (t
85 (let* ((image (get-char-property (point-min) 'display)) 112 (let* ((image (get-char-property (point-min) 'display))
86 (edges (window-inside-edges)) 113 (edges (window-inside-edges))
87 (win-height (- (nth 3 edges) (nth 1 edges))) 114 (win-height (- (nth 3 edges) (nth 1 edges)))
88 (img-height (ceiling (cdr (image-size image))))) 115 (img-height (ceiling (cdr (image-size image)))))
89 (set-window-vscroll (selected-window) 116 (image-set-window-vscroll (selected-window)
90 (min (max 0 (- img-height win-height)) 117 (min (max 0 (- img-height win-height))
91 (+ n (window-vscroll)))))))) 118 (+ n (window-vscroll))))))))
92 119
93(defun image-previous-line (&optional n) 120(defun image-previous-line (&optional n)
94 "Scroll image in current window downward by N lines. 121 "Scroll image in current window downward by N lines.
@@ -146,7 +173,7 @@ stopping if the top or bottom edge of the image is reached."
146 (and arg 173 (and arg
147 (/= (setq arg (prefix-numeric-value arg)) 1) 174 (/= (setq arg (prefix-numeric-value arg)) 1)
148 (image-next-line (- arg 1))) 175 (image-next-line (- arg 1)))
149 (set-window-hscroll (selected-window) 0)) 176 (image-set-window-hscroll (selected-window) 0))
150 177
151(defun image-eol (arg) 178(defun image-eol (arg)
152 "Scroll horizontally to the right edge of the image in the current window. 179 "Scroll horizontally to the right edge of the image in the current window.
@@ -160,14 +187,14 @@ stopping if the top or bottom edge of the image is reached."
160 (edges (window-inside-edges)) 187 (edges (window-inside-edges))
161 (win-width (- (nth 2 edges) (nth 0 edges))) 188 (win-width (- (nth 2 edges) (nth 0 edges)))
162 (img-width (ceiling (car (image-size image))))) 189 (img-width (ceiling (car (image-size image)))))
163 (set-window-hscroll (selected-window) 190 (image-set-window-hscroll (selected-window)
164 (max 0 (- img-width win-width))))) 191 (max 0 (- img-width win-width)))))
165 192
166(defun image-bob () 193(defun image-bob ()
167 "Scroll to the top-left corner of the image in the current window." 194 "Scroll to the top-left corner of the image in the current window."
168 (interactive) 195 (interactive)
169 (set-window-hscroll (selected-window) 0) 196 (image-set-window-hscroll (selected-window) 0)
170 (set-window-vscroll (selected-window) 0)) 197 (image-set-window-vscroll (selected-window) 0))
171 198
172(defun image-eob () 199(defun image-eob ()
173 "Scroll to the bottom-right corner of the image in the current window." 200 "Scroll to the bottom-right corner of the image in the current window."
@@ -178,8 +205,8 @@ stopping if the top or bottom edge of the image is reached."
178 (img-width (ceiling (car (image-size image)))) 205 (img-width (ceiling (car (image-size image))))
179 (win-height (- (nth 3 edges) (nth 1 edges))) 206 (win-height (- (nth 3 edges) (nth 1 edges)))
180 (img-height (ceiling (cdr (image-size image))))) 207 (img-height (ceiling (cdr (image-size image)))))
181 (set-window-hscroll (selected-window) (max 0 (- img-width win-width))) 208 (image-set-window-hscroll (selected-window) (max 0 (- img-width win-width)))
182 (set-window-vscroll (selected-window) (max 0 (- img-height win-height))))) 209 (image-set-window-vscroll (selected-window) (max 0 (- img-height win-height)))))
183 210
184;;; Image Mode setup 211;;; Image Mode setup
185 212
@@ -224,6 +251,15 @@ to toggle between display as an image and display as text."
224 ;; Use our own bookmarking function for images. 251 ;; Use our own bookmarking function for images.
225 (set (make-local-variable 'bookmark-make-cell-function) 252 (set (make-local-variable 'bookmark-make-cell-function)
226 'image-bookmark-make-cell) 253 'image-bookmark-make-cell)
254
255 ;; Keep track of [vh]scroll when switching buffers
256 (make-local-variable 'image-mode-current-hscroll)
257 (make-local-variable 'image-mode-current-vscroll)
258 (image-set-window-hscroll (selected-window) (window-hscroll))
259 (image-set-window-vscroll (selected-window) (window-vscroll))
260 (add-hook 'window-configuration-change-hook
261 'image-reset-current-vhscroll nil t)
262
227 (add-hook 'change-major-mode-hook 'image-toggle-display-text nil t) 263 (add-hook 'change-major-mode-hook 'image-toggle-display-text nil t)
228 (if (and (display-images-p) 264 (if (and (display-images-p)
229 (not (get-char-property (point-min) 'display))) 265 (not (get-char-property (point-min) 'display)))
@@ -255,9 +291,9 @@ See the command `image-mode' for more information on this mode."
255 (setq image-type "text")) 291 (setq image-type "text"))
256 (add-hook 'change-major-mode-hook (lambda () (image-minor-mode -1)) nil t) 292 (add-hook 'change-major-mode-hook (lambda () (image-minor-mode -1)) nil t)
257 (message "%s" (concat (substitute-command-keys 293 (message "%s" (concat (substitute-command-keys
258 "Type \\[image-toggle-display] to view the image as ") 294 "Type \\[image-toggle-display] to view the image as ")
259 (if (get-char-property (point-min) 'display) 295 (if (get-char-property (point-min) 'display)
260 "text" "an image") ".")))) 296 "text" "an image") "."))))
261 297
262;;;###autoload 298;;;###autoload
263(defun image-mode-maybe () 299(defun image-mode-maybe ()
@@ -333,9 +369,9 @@ and showing the image as an image."
333 (image (create-image file-or-data type data-p)) 369 (image (create-image file-or-data type data-p))
334 (props 370 (props
335 `(display ,image 371 `(display ,image
336 intangible ,image 372 intangible ,image
337 rear-nonsticky (display intangible) 373 rear-nonsticky (display intangible)
338 read-only t front-sticky (read-only))) 374 read-only t front-sticky (read-only)))
339 (inhibit-read-only t) 375 (inhibit-read-only t)
340 (buffer-undo-list t) 376 (buffer-undo-list t)
341 (modified (buffer-modified-p))) 377 (modified (buffer-modified-p)))
diff --git a/lisp/isearch-multi.el b/lisp/isearch-multi.el
index 9161ef82c7e..1cac7bb9b9e 100644
--- a/lisp/isearch-multi.el
+++ b/lisp/isearch-multi.el
@@ -1,6 +1,6 @@
1;;; isearch-multi.el --- isearch extensions for multi-buffer search 1;;; isearch-multi.el --- isearch extensions for multi-buffer search
2 2
3;; Copyright (C) 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Juri Linkov <juri@jurta.org> 5;; Author: Juri Linkov <juri@jurta.org>
6;; Keywords: matching 6;; Keywords: matching
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index 450c5f219f9..7f2b22a4385 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -249,7 +249,6 @@ This is just like `add-change-log-entry' except that it displays
249the change log file in another window. 249the change log file in another window.
250 250
251\(fn &optional WHOAMI FILE-NAME)" t nil) 251\(fn &optional WHOAMI FILE-NAME)" t nil)
252 (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
253 252
254(autoload 'change-log-mode "add-log" "\ 253(autoload 'change-log-mode "add-log" "\
255Major mode for editing change logs; like Indented Text Mode. 254Major mode for editing change logs; like Indented Text Mode.
@@ -945,48 +944,48 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'.
945;;; Generated autoloads from calendar/appt.el 944;;; Generated autoloads from calendar/appt.el
946 945
947(defvar appt-issue-message t "\ 946(defvar appt-issue-message t "\
948*Non-nil means check for appointments in the diary buffer. 947Non-nil means check for appointments in the diary buffer.
949To be detected, the diary entry must have the format described in the 948To be detected, the diary entry must have the format described in the
950documentation of the function `appt-check'.") 949documentation of the function `appt-check'.")
951 950
952(custom-autoload 'appt-issue-message "appt" t) 951(custom-autoload 'appt-issue-message "appt" t)
953 952
954(defvar appt-message-warning-time 12 "\ 953(defvar appt-message-warning-time 12 "\
955*Time in minutes before an appointment that the warning begins.") 954Time in minutes before an appointment that the warning begins.")
956 955
957(custom-autoload 'appt-message-warning-time "appt" t) 956(custom-autoload 'appt-message-warning-time "appt" t)
958 957
959(defvar appt-audible t "\ 958(defvar appt-audible t "\
960*Non-nil means beep to indicate appointment.") 959Non-nil means beep to indicate appointment.")
961 960
962(custom-autoload 'appt-audible "appt" t) 961(custom-autoload 'appt-audible "appt" t)
963 962
964(defvar appt-visible t "\ 963(defvar appt-visible t "\
965*Non-nil means display appointment message in echo area. 964Non-nil means display appointment message in echo area.
966This variable is only relevant if `appt-msg-window' is nil.") 965This variable is only relevant if `appt-msg-window' is nil.")
967 966
968(custom-autoload 'appt-visible "appt" t) 967(custom-autoload 'appt-visible "appt" t)
969 968
970(defvar appt-msg-window t "\ 969(defvar appt-msg-window t "\
971*Non-nil means display appointment message in another window. 970Non-nil means display appointment message in another window.
972If non-nil, this variable overrides `appt-visible'.") 971If non-nil, this variable overrides `appt-visible'.")
973 972
974(custom-autoload 'appt-msg-window "appt" t) 973(custom-autoload 'appt-msg-window "appt" t)
975 974
976(defvar appt-display-mode-line t "\ 975(defvar appt-display-mode-line t "\
977*Non-nil means display minutes to appointment and time on the mode line. 976Non-nil means display minutes to appointment and time on the mode line.
978This is in addition to any other display of appointment messages.") 977This is in addition to any other display of appointment messages.")
979 978
980(custom-autoload 'appt-display-mode-line "appt" t) 979(custom-autoload 'appt-display-mode-line "appt" t)
981 980
982(defvar appt-display-duration 10 "\ 981(defvar appt-display-duration 10 "\
983*The number of seconds an appointment message is displayed. 982The number of seconds an appointment message is displayed.
984Only relevant if reminders are to be displayed in their own window.") 983Only relevant if reminders are to be displayed in their own window.")
985 984
986(custom-autoload 'appt-display-duration "appt" t) 985(custom-autoload 'appt-display-duration "appt" t)
987 986
988(defvar appt-display-diary t "\ 987(defvar appt-display-diary t "\
989*Non-nil displays the diary when the appointment list is first initialized. 988Non-nil displays the diary when the appointment list is first initialized.
990This will occur at midnight when the appointment list is updated.") 989This will occur at midnight when the appointment list is updated.")
991 990
992(custom-autoload 'appt-display-diary "appt" t) 991(custom-autoload 'appt-display-diary "appt" t)
@@ -1732,7 +1731,7 @@ b => (ba bb bc) ; assume b has this value
1732 1731
1733Vectors work just like lists. Nested backquotes are permitted. 1732Vectors work just like lists. Nested backquotes are permitted.
1734 1733
1735\(fn ARG)" nil (quote macro)) 1734\(fn STRUCTURE)" nil (quote macro))
1736 1735
1737(defalias '\` (symbol-function 'backquote)) 1736(defalias '\` (symbol-function 'backquote))
1738 1737
@@ -1807,6 +1806,19 @@ non-interactive use see also `benchmark-run' and
1807;;;;;; 875)) 1806;;;;;; 875))
1808;;; Generated autoloads from textmodes/bibtex.el 1807;;; Generated autoloads from textmodes/bibtex.el
1809 1808
1809(autoload 'bibtex-initialize "bibtex" "\
1810(Re)Initialize BibTeX buffers.
1811Visit the BibTeX files defined by `bibtex-files' and return a list
1812of corresponding buffers.
1813Initialize in these buffers `bibtex-reference-keys' if not yet set.
1814List of BibTeX buffers includes current buffer if CURRENT is non-nil.
1815If FORCE is non-nil, (re)initialize `bibtex-reference-keys' even if
1816already set. If SELECT is non-nil interactively select a BibTeX buffer.
1817When called interactively, FORCE is t, CURRENT is t if current buffer uses
1818`bibtex-mode', and SELECT is t if current buffer does not use `bibtex-mode',
1819
1820\(fn &optional CURRENT FORCE SELECT)" t nil)
1821
1810(autoload 'bibtex-mode "bibtex" "\ 1822(autoload 'bibtex-mode "bibtex" "\
1811Major mode for editing BibTeX files. 1823Major mode for editing BibTeX files.
1812 1824
@@ -2828,7 +2840,7 @@ Must be used only with `-batch', and kills Emacs on completion.
2828For example, invoke `emacs -batch -f batch-byte-recompile-directory .'. 2840For example, invoke `emacs -batch -f batch-byte-recompile-directory .'.
2829 2841
2830Optional argument ARG is passed as second argument ARG to 2842Optional argument ARG is passed as second argument ARG to
2831`batch-recompile-directory'; see there for its possible values 2843`byte-recompile-directory'; see there for its possible values
2832and corresponding effects. 2844and corresponding effects.
2833 2845
2834\(fn &optional ARG)" nil nil) 2846\(fn &optional ARG)" nil nil)
@@ -3371,7 +3383,7 @@ List of functions called for listing diary file and included files.
3371As the files are processed for diary entries, these functions are used 3383As the files are processed for diary entries, these functions are used
3372to cull relevant entries. You can use either or both of 3384to cull relevant entries. You can use either or both of
3373`list-hebrew-diary-entries', `list-islamic-diary-entries' and 3385`list-hebrew-diary-entries', `list-islamic-diary-entries' and
3374`list-bahai-diary-entries'. The documentation for these functions 3386`diary-bahai-list-entries'. The documentation for these functions
3375describes the style of such diary entries.") 3387describes the style of such diary entries.")
3376 3388
3377(custom-autoload 'nongregorian-diary-listing-hook "calendar" t) 3389(custom-autoload 'nongregorian-diary-listing-hook "calendar" t)
@@ -3825,7 +3837,29 @@ and exists only for compatibility reasons.
3825;;;### (autoloads nil "cc-subword" "progmodes/cc-subword.el" (18177 3837;;;### (autoloads nil "cc-subword" "progmodes/cc-subword.el" (18177
3826;;;;;; 872)) 3838;;;;;; 872))
3827;;; Generated autoloads from progmodes/cc-subword.el 3839;;; Generated autoloads from progmodes/cc-subword.el
3828 (autoload 'c-subword-mode "cc-subword" "Mode enabling subword movement and editing keys." t) 3840
3841(autoload 'c-subword-mode "cc-subword" "\
3842Mode enabling subword movement and editing keys.
3843In spite of GNU Coding Standards, it is popular to name a symbol by
3844mixing uppercase and lowercase letters, e.g. \"GtkWidget\",
3845\"EmacsFrameClass\", \"NSGraphicsContext\", etc. Here we call these
3846mixed case symbols `nomenclatures'. Also, each capitalized (or
3847completely uppercase) part of a nomenclature is called a `subword'.
3848Here are some examples:
3849
3850 Nomenclature Subwords
3851 ===========================================================
3852 GtkWindow => \"Gtk\" and \"Window\"
3853 EmacsFrameClass => \"Emacs\", \"Frame\" and \"Class\"
3854 NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\"
3855
3856The subword oriented commands activated in this minor mode recognize
3857subwords in a nomenclature to move between subwords and to edit them
3858as words.
3859
3860\\{c-subword-mode-map}
3861
3862\(fn &optional ARG)" t nil)
3829 3863
3830;;;*** 3864;;;***
3831 3865
@@ -4112,6 +4146,26 @@ to the action header.
4112 4146
4113;;;*** 4147;;;***
4114 4148
4149;;;### (autoloads (check-declare-directory check-declare-file) "check-declare"
4150;;;;;; "emacs-lisp/check-declare.el" (18308 19808))
4151;;; Generated autoloads from emacs-lisp/check-declare.el
4152
4153(autoload 'check-declare-file "check-declare" "\
4154Check veracity of all `declare-function' statements in FILE.
4155See `check-declare-directory' for more information.
4156
4157\(fn FILE)" t nil)
4158
4159(autoload 'check-declare-directory "check-declare" "\
4160Check veracity of all `declare-function' statements under directory ROOT.
4161Returns non-nil if any false statements are found. For this to
4162work correctly, the statements must adhere to the format
4163described in the documentation of `declare-function'.
4164
4165\(fn ROOT)" t nil)
4166
4167;;;***
4168
4115;;;### (autoloads (checkdoc-minor-mode checkdoc-ispell-defun checkdoc-ispell-comments 4169;;;### (autoloads (checkdoc-minor-mode checkdoc-ispell-defun checkdoc-ispell-comments
4116;;;;;; checkdoc-ispell-continue checkdoc-ispell-start checkdoc-ispell-message-text 4170;;;;;; checkdoc-ispell-continue checkdoc-ispell-start checkdoc-ispell-message-text
4117;;;;;; checkdoc-ispell-message-interactive checkdoc-ispell-interactive 4171;;;;;; checkdoc-ispell-message-interactive checkdoc-ispell-interactive
@@ -5091,6 +5145,12 @@ Insert a copyright by $ORGANIZATION notice at cursor.
5091;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (18231 31069)) 5145;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (18231 31069))
5092;;; Generated autoloads from progmodes/cperl-mode.el 5146;;; Generated autoloads from progmodes/cperl-mode.el
5093(put 'cperl-indent-level 'safe-local-variable 'integerp) 5147(put 'cperl-indent-level 'safe-local-variable 'integerp)
5148(put 'cperl-brace-offset 'safe-local-variable 'integerp)
5149(put 'cperl-continued-brace-offset 'safe-local-variable 'integerp)
5150(put 'cperl-label-offset 'safe-local-variable 'integerp)
5151(put 'cperl-continued-statement-offset 'safe-local-variable 'integerp)
5152(put 'cperl-extra-newline-before-brace 'safe-local-variable 'booleanp)
5153(put 'cperl-merge-trailing-else 'safe-local-variable 'booleanp)
5094 5154
5095(autoload 'cperl-mode "cperl-mode" "\ 5155(autoload 'cperl-mode "cperl-mode" "\
5096Major mode for editing Perl code. 5156Major mode for editing Perl code.
@@ -5628,7 +5688,7 @@ that are not customizable options, as well as faces and groups
5628(autoload 'customize-apropos-options "cus-edit" "\ 5688(autoload 'customize-apropos-options "cus-edit" "\
5629Customize all loaded customizable options matching REGEXP. 5689Customize all loaded customizable options matching REGEXP.
5630With prefix arg, include variables that are not customizable options 5690With prefix arg, include variables that are not customizable options
5631\(but we recommend using `apropos-variable' instead). 5691\(but it is better to use `apropos-variable' if you want to find those).
5632 5692
5633\(fn REGEXP &optional ARG)" t nil) 5693\(fn REGEXP &optional ARG)" t nil)
5634 5694
@@ -6230,8 +6290,8 @@ or call the function `delete-selection-mode'.")
6230 6290
6231(autoload 'delete-selection-mode "delsel" "\ 6291(autoload 'delete-selection-mode "delsel" "\
6232Toggle Delete Selection mode. 6292Toggle Delete Selection mode.
6233With prefix ARG, turn Delete Selection mode on if and only if ARG is 6293With prefix ARG, turn Delete Selection mode on if ARG is
6234positive. 6294positive, off if ARG is not positive.
6235 6295
6236When Delete Selection mode is enabled, Transient Mark mode is also 6296When Delete Selection mode is enabled, Transient Mark mode is also
6237enabled and typed text replaces the selection if the selection is 6297enabled and typed text replaces the selection if the selection is
@@ -6701,7 +6761,7 @@ some of the `ls' switches are not supported; see the doc string of
6701 6761
6702(custom-autoload 'dired-listing-switches "dired" t) 6762(custom-autoload 'dired-listing-switches "dired" t)
6703 6763
6704(defvar dired-chown-program (if (memq system-type '(hpux dgux usg-unix-v irix linux gnu/linux cygwin)) "chown" (if (file-exists-p "/usr/sbin/chown") "/usr/sbin/chown" "/etc/chown")) "\ 6764(defvar dired-chown-program (if (memq system-type '(hpux usg-unix-v irix linux gnu/linux cygwin)) "chown" (if (file-exists-p "/usr/sbin/chown") "/usr/sbin/chown" "/etc/chown")) "\
6705Name of chown command (usually `chown' or `/etc/chown').") 6765Name of chown command (usually `chown' or `/etc/chown').")
6706 6766
6707(defvar dired-ls-F-marks-symlinks nil "\ 6767(defvar dired-ls-F-marks-symlinks nil "\
@@ -7564,6 +7624,12 @@ Locate SOA record and increment the serial field.
7564;;;;;; "doc-view.el" (18231 31060)) 7624;;;;;; "doc-view.el" (18231 31060))
7565;;; Generated autoloads from doc-view.el 7625;;; Generated autoloads from doc-view.el
7566 7626
7627(autoload 'doc-view-mode-p "doc-view" "\
7628Return non-nil if image type TYPE is available for `doc-view'.
7629Image types are symbols like `dvi', `postscript' or `pdf'.
7630
7631\(fn TYPE)" nil nil)
7632
7567(autoload 'doc-view-mode "doc-view" "\ 7633(autoload 'doc-view-mode "doc-view" "\
7568Major mode in DocView buffers. 7634Major mode in DocView buffers.
7569You can use \\<doc-view-mode-map>\\[doc-view-toggle-display] to 7635You can use \\<doc-view-mode-map>\\[doc-view-toggle-display] to
@@ -7796,10 +7862,15 @@ whenever this expression's value is non-nil.
7796INCLUDE is an expression; this item is only visible if this 7862INCLUDE is an expression; this item is only visible if this
7797expression has a non-nil value. `:included' is an alias for `:visible'. 7863expression has a non-nil value. `:included' is an alias for `:visible'.
7798 7864
7865 :label FORM
7866
7867FORM is an expression that will be dynamically evaluated and whose
7868value will be used for the menu entry's text label (the default is NAME).
7869
7799 :suffix FORM 7870 :suffix FORM
7800 7871
7801FORM is an expression that will be dynamically evaluated and whose 7872FORM is an expression that will be dynamically evaluated and whose
7802value will be concatenated to the menu entry's NAME. 7873value will be concatenated to the menu entry's label.
7803 7874
7804 :style STYLE 7875 :style STYLE
7805 7876
@@ -9602,12 +9673,7 @@ corresponding to a successful execution.
9602 9673
9603\(fn COMMAND &optional STATUS-VAR)" nil nil) 9674\(fn COMMAND &optional STATUS-VAR)" nil nil)
9604 9675
9605(autoload 'eshell-report-bug "eshell" "\ 9676(define-obsolete-function-alias 'eshell-report-bug 'report-emacs-bug "23.1")
9606Report a bug in Eshell.
9607Prompts for the TOPIC. Leaves you in a mail buffer.
9608Please include any configuration details that might be involved.
9609
9610\(fn TOPIC)" t nil)
9611 9677
9612;;;*** 9678;;;***
9613 9679
@@ -10773,9 +10839,6 @@ the name is considered already unique; only the second substitution
10773\(directories) is done. 10839\(directories) is done.
10774 10840
10775\(fn ARG)" t nil) 10841\(fn ARG)" t nil)
10776 (define-key minibuffer-local-completion-map [C-tab] 'file-cache-minibuffer-complete)
10777 (define-key minibuffer-local-map [C-tab] 'file-cache-minibuffer-complete)
10778 (define-key minibuffer-local-must-match-map [C-tab] 'file-cache-minibuffer-complete)
10779 10842
10780;;;*** 10843;;;***
10781 10844
@@ -10825,6 +10888,13 @@ On other systems, the closest you can come is to use `-l'.")
10825 10888
10826(custom-autoload 'find-grep-options "find-dired" t) 10889(custom-autoload 'find-grep-options "find-dired" t)
10827 10890
10891(defvar find-name-arg (if read-file-name-completion-ignore-case "-iname" "-name") "\
10892*Argument used to specify file name pattern.
10893If `read-file-name-completion-ignore-case' is non-nil, -iname is used so that
10894find also ignores case. Otherwise, -name is used.")
10895
10896(custom-autoload 'find-name-arg "find-dired" t)
10897
10828(autoload 'find-dired "find-dired" "\ 10898(autoload 'find-dired "find-dired" "\
10829Run `find' and go into Dired mode on a buffer of the output. 10899Run `find' and go into Dired mode on a buffer of the output.
10830The command run (after changing into DIR) is 10900The command run (after changing into DIR) is
@@ -11551,7 +11621,6 @@ Run gdb on program FILE in buffer *gud-FILE*.
11551The directory containing FILE becomes the initial working 11621The directory containing FILE becomes the initial working
11552directory and source-file directory for your debugger. 11622directory and source-file directory for your debugger.
11553 11623
11554
11555If `gdb-many-windows' is nil (the default value) then gdb just 11624If `gdb-many-windows' is nil (the default value) then gdb just
11556pops up the GUD buffer unless `gdb-show-main' is t. In this case 11625pops up the GUD buffer unless `gdb-show-main' is t. In this case
11557it starts with two windows: one displaying the GUD buffer and the 11626it starts with two windows: one displaying the GUD buffer and the
@@ -12049,7 +12118,7 @@ Not documented
12049(autoload 'turn-on-gnus-dired-mode "gnus-dired" "\ 12118(autoload 'turn-on-gnus-dired-mode "gnus-dired" "\
12050Convenience method to turn on gnus-dired-mode. 12119Convenience method to turn on gnus-dired-mode.
12051 12120
12052\(fn)" nil nil) 12121\(fn)" t nil)
12053 12122
12054;;;*** 12123;;;***
12055 12124
@@ -12622,6 +12691,11 @@ This variable's value takes effect when `grep-compute-defaults' is called.")
12622The default find program for `grep-find-command'. 12691The default find program for `grep-find-command'.
12623This variable's value takes effect when `grep-compute-defaults' is called.") 12692This variable's value takes effect when `grep-compute-defaults' is called.")
12624 12693
12694(defvar xargs-program "xargs" "\
12695The default xargs program for `grep-find-command'.
12696See `grep-find-use-xargs'.
12697This variable's value takes effect when `grep-compute-defaults' is called.")
12698
12625(defvar grep-find-use-xargs nil "\ 12699(defvar grep-find-use-xargs nil "\
12626Non-nil means that `grep-find' uses the `xargs' utility by default. 12700Non-nil means that `grep-find' uses the `xargs' utility by default.
12627If `exec', use `find -exec'. 12701If `exec', use `find -exec'.
@@ -12653,19 +12727,19 @@ Sets `grep-last-buffer' and `compilation-window-height'.
12653(autoload 'grep "grep" "\ 12727(autoload 'grep "grep" "\
12654Run grep, with user-specified args, and collect output in a buffer. 12728Run grep, with user-specified args, and collect output in a buffer.
12655While grep runs asynchronously, you can use \\[next-error] (M-x next-error), 12729While grep runs asynchronously, you can use \\[next-error] (M-x next-error),
12656or \\<grep-mode-map>\\[compile-goto-error] in the grep output buffer, to go to the lines 12730or \\<grep-mode-map>\\[compile-goto-error] in the grep output buffer, to go to the lines where grep
12657where grep found matches. 12731found matches.
12658 12732
12659For doing a recursive `grep', see the `rgrep' command. For running 12733For doing a recursive `grep', see the `rgrep' command. For running
12660`grep' in a specific directory, see `lgrep'. 12734`grep' in a specific directory, see `lgrep'.
12661 12735
12662This command uses a special history list for its COMMAND-ARGS, so you can 12736This command uses a special history list for its COMMAND-ARGS, so you
12663easily repeat a grep command. 12737can easily repeat a grep command.
12664 12738
12665A prefix argument says to default the argument based upon the current 12739A prefix argument says to default the argument based upon the current
12666tag the cursor is over, substituting it into the last grep command 12740tag the cursor is over, substituting it into the last grep command
12667in the grep command history (or into `grep-command' 12741in the grep command history (or into `grep-command' if that history
12668if that history list is empty). 12742list is empty).
12669 12743
12670\(fn COMMAND-ARGS)" t nil) 12744\(fn COMMAND-ARGS)" t nil)
12671 12745
@@ -12693,8 +12767,8 @@ before it is executed.
12693With two \\[universal-argument] prefixes, directly edit and run `grep-command'. 12767With two \\[universal-argument] prefixes, directly edit and run `grep-command'.
12694 12768
12695Collect output in a buffer. While grep runs asynchronously, you 12769Collect output in a buffer. While grep runs asynchronously, you
12696can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] 12770can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] in the grep output buffer,
12697in the grep output buffer, to go to the lines where grep found matches. 12771to go to the lines where grep found matches.
12698 12772
12699This command shares argument histories with \\[rgrep] and \\[grep]. 12773This command shares argument histories with \\[rgrep] and \\[grep].
12700 12774
@@ -12711,8 +12785,8 @@ before it is executed.
12711With two \\[universal-argument] prefixes, directly edit and run `grep-find-command'. 12785With two \\[universal-argument] prefixes, directly edit and run `grep-find-command'.
12712 12786
12713Collect output in a buffer. While find runs asynchronously, you 12787Collect output in a buffer. While find runs asynchronously, you
12714can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] 12788can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] in the grep output buffer,
12715in the grep output buffer, to go to the lines where grep found matches. 12789to go to the lines where grep found matches.
12716 12790
12717This command shares argument histories with \\[lgrep] and \\[grep-find]. 12791This command shares argument histories with \\[lgrep] and \\[grep-find].
12718 12792
@@ -13833,6 +13907,8 @@ The optional LABEL is used to label the buffer created.
13833 13907
13834\(fn Y1 Y2 &optional L LABEL)" t nil) 13908\(fn Y1 Y2 &optional L LABEL)" t nil)
13835 13909
13910(defalias 'holiday-list 'list-holidays)
13911
13836;;;*** 13912;;;***
13837 13913
13838;;;### (autoloads (html2text) "html2text" "gnus/html2text.el" (18231 13914;;;### (autoloads (html2text) "html2text" "gnus/html2text.el" (18231
@@ -15348,6 +15424,11 @@ information on these modes.
15348 15424
15349\(fn)" t nil) 15425\(fn)" t nil)
15350 15426
15427(autoload 'image-bookmark-jump "image-mode" "\
15428Not documented
15429
15430\(fn BMK)" nil nil)
15431
15351;;;*** 15432;;;***
15352 15433
15353;;;### (autoloads (imenu imenu-add-menubar-index imenu-add-to-menubar 15434;;;### (autoloads (imenu imenu-add-menubar-index imenu-add-to-menubar
@@ -15857,15 +15938,15 @@ The value is nil when the search still is in the initial buffer.")
15857Function to call to get the next buffer to search. 15938Function to call to get the next buffer to search.
15858 15939
15859When this variable is set to a function that returns a buffer, then 15940When this variable is set to a function that returns a buffer, then
15860after typing another C-s or C-r at a failing search, the search goes 15941after typing another \\[isearch-forward] or \\[isearch-backward] at a failing search, the search goes
15861to the next buffer in the series and continues searching for the 15942to the next buffer in the series and continues searching for the
15862next occurrence. 15943next occurrence.
15863 15944
15864The first argument of this function is the current buffer where the 15945The first argument of this function is the current buffer where the
15865search is currently searching. It defines the base buffer relative to 15946search is currently searching. It defines the base buffer relative to
15866which this function should find the next buffer. When the isearch 15947which this function should find the next buffer. When the isearch
15867direction is backward (when isearch-forward is nil), this function 15948direction is backward (when `isearch-forward' is nil), this function
15868should return the previous buffer to search. If the second argument of 15949should return the previous buffer to search. If the second argument of
15869this function WRAP is non-nil, then it should return the first buffer 15950this function WRAP is non-nil, then it should return the first buffer
15870in the series; and for the backward search, it should return the last 15951in the series; and for the backward search, it should return the last
15871buffer in the series.") 15952buffer in the series.")
@@ -16009,14 +16090,14 @@ Optional arg BUFFER is ignored (for use in `format-alist').
16009 16090
16010(autoload 'iso-iso2sgml "iso-cvt" "\ 16091(autoload 'iso-iso2sgml "iso-cvt" "\
16011Translate ISO 8859-1 characters in the region to SGML entities. 16092Translate ISO 8859-1 characters in the region to SGML entities.
16012The entities used are from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\". 16093Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\".
16013Optional arg BUFFER is ignored (for use in `format-alist'). 16094Optional arg BUFFER is ignored (for use in `format-alist').
16014 16095
16015\(fn FROM TO &optional BUFFER)" t nil) 16096\(fn FROM TO &optional BUFFER)" t nil)
16016 16097
16017(autoload 'iso-sgml2iso "iso-cvt" "\ 16098(autoload 'iso-sgml2iso "iso-cvt" "\
16018Translate SGML entities in the region to ISO 8859-1 characters. 16099Translate SGML entities in the region to ISO 8859-1 characters.
16019The entities used are from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\". 16100Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\".
16020Optional arg BUFFER is ignored (for use in `format-alist'). 16101Optional arg BUFFER is ignored (for use in `format-alist').
16021 16102
16022\(fn FROM TO &optional BUFFER)" t nil) 16103\(fn FROM TO &optional BUFFER)" t nil)
@@ -16177,6 +16258,7 @@ for skipping in latex mode.")
16177Same format as `ispell-skip-region-alist' 16258Same format as `ispell-skip-region-alist'
16178Note - substrings of other matches must come last 16259Note - substrings of other matches must come last
16179 (e.g. \"<[tT][tT]/\" and \"<[^ \\t\\n>]\").") 16260 (e.g. \"<[tT][tT]/\" and \"<[^ \\t\\n>]\").")
16261(put 'ispell-local-pdict 'safe-local-variable 'stringp)
16180 (define-key esc-map "$" 'ispell-word) 16262 (define-key esc-map "$" 'ispell-word)
16181 16263
16182(autoload 'ispell-word "ispell" "\ 16264(autoload 'ispell-word "ispell" "\
@@ -17098,17 +17180,22 @@ except that FILTER is not optional.
17098Setup a buffer to enter a log message. 17180Setup a buffer to enter a log message.
17099\\<log-edit-mode-map>The buffer will be put in `log-edit-mode'. 17181\\<log-edit-mode-map>The buffer will be put in `log-edit-mode'.
17100If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run. 17182If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run.
17101Mark and point will be set around the entire contents of the 17183Mark and point will be set around the entire contents of the buffer so
17102buffer so that it is easy to kill the contents of the buffer with \\[kill-region]. 17184that it is easy to kill the contents of the buffer with \\[kill-region].
17103Once you're done editing the message, pressing \\[log-edit-done] will call 17185Once you're done editing the message, pressing \\[log-edit-done] will call
17104`log-edit-done' which will end up calling CALLBACK to do the actual commit. 17186`log-edit-done' which will end up calling CALLBACK to do the actual commit.
17105LISTFUN if non-nil is a function of no arguments returning the list of files 17187
17106 that are concerned by the current operation (using relative names). 17188PARAMS if non-nil is an alist. Possible keys and associated values:
17189 `log-edit-listfun' -- function taking no arguments that returns the list of
17190 files that are concerned by the current operation (using relative names);
17191 `log-edit-diff-function' -- function taking no arguments that
17192 displays a diff of the files concerned by the current operation.
17193
17107If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the 17194If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the
17108 log message and go back to the current buffer when done. Otherwise, it 17195log message and go back to the current buffer when done. Otherwise, it
17109 uses the current buffer. 17196uses the current buffer.
17110 17197
17111\(fn CALLBACK &optional SETUP LISTFUN BUFFER &rest IGNORE)" nil nil) 17198\(fn CALLBACK &optional SETUP PARAMS BUFFER &rest IGNORE)" nil nil)
17112 17199
17113;;;*** 17200;;;***
17114 17201
@@ -17151,7 +17238,7 @@ are indicated with a symbol.
17151 17238
17152(defvar lpr-windows-system (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt))) 17239(defvar lpr-windows-system (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
17153 17240
17154(defvar lpr-lp-system (memq system-type '(usg-unix-v dgux hpux irix))) 17241(defvar lpr-lp-system (memq system-type '(usg-unix-v hpux irix)))
17155 17242
17156(defvar printer-name (and lpr-windows-system "PRN") "\ 17243(defvar printer-name (and lpr-windows-system "PRN") "\
17157*The name of a local printer to which data is sent for printing. 17244*The name of a local printer to which data is sent for printing.
@@ -19388,6 +19475,95 @@ closing requests for requests that are used in matched pairs.
19388 19475
19389;;;*** 19476;;;***
19390 19477
19478;;;### (autoloads (nxml-glyph-display-string) "nxml-glyph" "nxml/nxml-glyph.el"
19479;;;;;; (18308 19808))
19480;;; Generated autoloads from nxml/nxml-glyph.el
19481
19482(autoload 'nxml-glyph-display-string "nxml-glyph" "\
19483Return a string that can display a glyph for Unicode code-point N.
19484FACE gives the face that will be used for displaying the string.
19485Return nil if the face cannot display a glyph for N.
19486
19487\(fn N FACE)" nil nil)
19488
19489;;;***
19490
19491;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (18313
19492;;;;;; 19474))
19493;;; Generated autoloads from nxml/nxml-mode.el
19494
19495(autoload 'nxml-mode "nxml-mode" "\
19496Major mode for editing XML.
19497
19498Syntax highlighting is performed unless the variable
19499`nxml-syntax-highlight-flag' is nil.
19500
19501\\[nxml-finish-element] finishes the current element by inserting an end-tag.
19502C-c C-i closes a start-tag with `>' and then inserts a balancing end-tag
19503leaving point between the start-tag and end-tag.
19504\\[nxml-balanced-close-start-tag-block] is similar but for block rather than inline elements:
19505the start-tag, point, and end-tag are all left on separate lines.
19506If `nxml-slash-auto-complete-flag' is non-nil, then inserting a `</'
19507automatically inserts the rest of the end-tag.
19508
19509\\[nxml-complete] performs completion on the symbol preceding point.
19510
19511\\[nxml-dynamic-markup-word] uses the contents of the current buffer
19512to choose a tag to put around the word preceding point.
19513
19514Sections of the document can be displayed in outline form. The
19515variable `nxml-section-element-name-regexp' controls when an element
19516is recognized as a section. The same key sequences that change
19517visibility in outline mode are used except that they start with C-c C-o
19518instead of C-c.
19519
19520Validation is provided by the related minor-mode `rng-validate-mode'.
19521This also makes completion schema- and context- sensitive. Element
19522names, attribute names, attribute values and namespace URIs can all be
19523completed. By default, `rng-validate-mode' is automatically enabled. You
19524can toggle it using \\[rng-validate-mode] or change the default by
19525customizing `rng-nxml-auto-validate-flag'.
19526
19527\\[indent-for-tab-command] indents the current line appropriately.
19528This can be customized using the variable `nxml-child-indent'
19529and the variable `nxml-attribute-indent'.
19530
19531\\[nxml-insert-named-char] inserts a character reference using
19532the character's name (by default, the Unicode name). \\[universal-argument] \\[nxml-insert-named-char]
19533inserts the character directly.
19534
19535The Emacs commands that normally operate on balanced expressions will
19536operate on XML markup items. Thus \\[forward-sexp] will move forward
19537across one markup item; \\[backward-sexp] will move backward across
19538one markup item; \\[kill-sexp] will kill the following markup item;
19539\\[mark-sexp] will mark the following markup item. By default, each
19540tag each treated as a single markup item; to make the complete element
19541be treated as a single markup item, set the variable
19542`nxml-sexp-element-flag' to t. For more details, see the function
19543`nxml-forward-balanced-item'.
19544
19545\\[nxml-backward-up-element] and \\[nxml-down-element] move up and down the element structure.
19546
19547Many aspects this mode can be customized using
19548\\[customize-group] nxml RET.
19549
19550\(fn)" t nil)
19551
19552;;;***
19553
19554;;;### (autoloads (nxml-enable-unicode-char-name-sets) "nxml-uchnm"
19555;;;;;; "nxml/nxml-uchnm.el" (18312 40673))
19556;;; Generated autoloads from nxml/nxml-uchnm.el
19557
19558(autoload 'nxml-enable-unicode-char-name-sets "nxml-uchnm" "\
19559Enable the use of Unicode standard names for characters.
19560The Unicode blocks for which names are enabled is controlled by
19561the variable `nxml-enabled-unicode-blocks'.
19562
19563\(fn)" t nil)
19564
19565;;;***
19566
19391;;;### (autoloads (octave-help) "octave-hlp" "progmodes/octave-hlp.el" 19567;;;### (autoloads (octave-help) "octave-hlp" "progmodes/octave-hlp.el"
19392;;;;;; (18177 873)) 19568;;;;;; (18177 873))
19393;;; Generated autoloads from progmodes/octave-hlp.el 19569;;; Generated autoloads from progmodes/octave-hlp.el
@@ -20286,16 +20462,6 @@ but before calling PC Selection mode):
20286 20462
20287\(fn &optional ARG)" t nil) 20463\(fn &optional ARG)" t nil)
20288 20464
20289(defvar pc-selection-mode nil "\
20290Toggle PC Selection mode.
20291Change mark behavior to emulate Motif, MAC or MS-Windows cut and paste style,
20292and cursor movement commands.
20293This mode enables Delete Selection mode and Transient Mark mode.
20294Setting this variable directly does not take effect;
20295you must modify it using \\[customize] or \\[pc-selection-mode].")
20296
20297(custom-autoload 'pc-selection-mode "pc-select" nil)
20298
20299;;;*** 20465;;;***
20300 20466
20301;;;### (autoloads (pcomplete/cvs) "pcmpl-cvs" "pcmpl-cvs.el" (18177 20467;;;### (autoloads (pcomplete/cvs) "pcmpl-cvs" "pcmpl-cvs.el" (18177
@@ -20569,6 +20735,11 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp d
20569;;;;;; (18177 873)) 20735;;;;;; (18177 873))
20570;;; Generated autoloads from progmodes/perl-mode.el 20736;;; Generated autoloads from progmodes/perl-mode.el
20571(put 'perl-indent-level 'safe-local-variable 'integerp) 20737(put 'perl-indent-level 'safe-local-variable 'integerp)
20738(put 'perl-continued-statement-offset 'safe-local-variable 'integerp)
20739(put 'perl-continued-brace-offset 'safe-local-variable 'integerp)
20740(put 'perl-brace-offset 'safe-local-variable 'integerp)
20741(put 'perl-brace-imaginary-offset 'safe-local-variable 'integerp)
20742(put 'perl-label-offset 'safe-local-variable 'integerp)
20572 20743
20573(autoload 'perl-mode "perl-mode" "\ 20744(autoload 'perl-mode "perl-mode" "\
20574Major mode for editing Perl code. 20745Major mode for editing Perl code.
@@ -22736,7 +22907,6 @@ comments, including the first comment line, are visible), or to make the
22736first comment line visible (if point is in a comment). 22907first comment line visible (if point is in a comment).
22737 22908
22738\(fn &optional ARG)" t nil) 22909\(fn &optional ARG)" t nil)
22739 (define-key esc-map "\C-l" 'reposition-window)
22740 22910
22741;;;*** 22911;;;***
22742 22912
@@ -24812,6 +24982,12 @@ Minor mode to simplify editing output from the diff3 program.
24812 24982
24813\(fn &optional ARG)" t nil) 24983\(fn &optional ARG)" t nil)
24814 24984
24985(autoload 'smerge-start-session "smerge-mode" "\
24986Turn on `smerge-mode' and move point to first conflict marker.
24987If no conflict maker is found, turn off `smerge-mode'.
24988
24989\(fn)" nil nil)
24990
24815;;;*** 24991;;;***
24816 24992
24817;;;### (autoloads (smiley-buffer smiley-region) "smiley" "gnus/smiley.el" 24993;;;### (autoloads (smiley-buffer smiley-region) "smiley" "gnus/smiley.el"
@@ -25203,9 +25379,9 @@ From a program takes two point or marker arguments, BEG and END.
25203(autoload 'spam-initialize "spam" "\ 25379(autoload 'spam-initialize "spam" "\
25204Install the spam.el hooks and do other initialization. 25380Install the spam.el hooks and do other initialization.
25205When SYMBOLS is given, set those variables to t. This is so you 25381When SYMBOLS is given, set those variables to t. This is so you
25206can call spam-initialize before you set spam-use-* variables on 25382can call `spam-initialize' before you set spam-use-* variables on
25207explicitly, and matters only if you need the extra headers 25383explicitly, and matters only if you need the extra headers
25208installed through spam-necessary-extra-headers. 25384installed through `spam-necessary-extra-headers'.
25209 25385
25210\(fn &rest SYMBOLS)" t nil) 25386\(fn &rest SYMBOLS)" t nil)
25211 25387
@@ -27624,6 +27800,7 @@ If DATE is malformed, return a time value of zeros.
27624;;;;;; "time-stamp.el" (18177 876)) 27800;;;;;; "time-stamp.el" (18177 876))
27625;;; Generated autoloads from time-stamp.el 27801;;; Generated autoloads from time-stamp.el
27626(put 'time-stamp-format 'safe-local-variable 'stringp) 27802(put 'time-stamp-format 'safe-local-variable 'stringp)
27803(put 'time-stamp-time-zone 'safe-local-variable 'string-or-null-p)
27627(put 'time-stamp-line-limit 'safe-local-variable 'integerp) 27804(put 'time-stamp-line-limit 'safe-local-variable 'integerp)
27628(put 'time-stamp-start 'safe-local-variable 'stringp) 27805(put 'time-stamp-start 'safe-local-variable 'stringp)
27629(put 'time-stamp-end 'safe-local-variable 'stringp) 27806(put 'time-stamp-end 'safe-local-variable 'stringp)
@@ -28809,6 +28986,13 @@ Use URL to handle URL-like file names.
28809 28986
28810\(fn &optional ARG)" t nil) 28987\(fn &optional ARG)" t nil)
28811 28988
28989(autoload 'url-file-handler "url-handlers" "\
28990Function called from the `file-name-handler-alist' routines.
28991OPERATION is what needs to be done (`file-exists-p', etc). ARGS are
28992the arguments that would have been passed to OPERATION.
28993
28994\(fn OPERATION &rest ARGS)" nil nil)
28995
28812(autoload 'url-copy-file "url-handlers" "\ 28996(autoload 'url-copy-file "url-handlers" "\
28813Copy URL to NEWNAME. Both args must be strings. 28997Copy URL to NEWNAME. Both args must be strings.
28814Signals a `file-already-exists' error if file NEWNAME already exists, 28998Signals a `file-already-exists' error if file NEWNAME already exists,
@@ -29364,7 +29548,8 @@ merge in the changes into your working copy.
29364\(fn VERBOSE)" t nil) 29548\(fn VERBOSE)" t nil)
29365 29549
29366(autoload 'vc-register "vc" "\ 29550(autoload 'vc-register "vc" "\
29367Register the current file into a version control system. 29551Register into a version control system.
29552If FNAME is given register that file, otherwise register the current file.
29368With prefix argument SET-REVISION, allow user to specify initial revision 29553With prefix argument SET-REVISION, allow user to specify initial revision
29369level. If COMMENT is present, use that as an initial comment. 29554level. If COMMENT is present, use that as an initial comment.
29370 29555
@@ -29375,7 +29560,7 @@ directory are already registered under that backend) will be used to
29375register the file. If no backend declares itself responsible, the 29560register the file. If no backend declares itself responsible, the
29376first backend that could register the file is used. 29561first backend that could register the file is used.
29377 29562
29378\(fn &optional SET-REVISION COMMENT)" t nil) 29563\(fn &optional FNAME SET-REVISION COMMENT)" t nil)
29379 29564
29380(autoload 'vc-version-diff "vc" "\ 29565(autoload 'vc-version-diff "vc" "\
29381Report diffs between revisions of the fileset in the repository history. 29566Report diffs between revisions of the fileset in the repository history.
@@ -29753,6 +29938,142 @@ Key bindings:
29753 29938
29754;;;*** 29939;;;***
29755 29940
29941;;;### (autoloads (verilog-mode) "verilog-mode" "progmodes/verilog-mode.el"
29942;;;;;; (18307 57872))
29943;;; Generated autoloads from progmodes/verilog-mode.el
29944
29945(autoload 'verilog-mode "verilog-mode" "\
29946Major mode for editing Verilog code.
29947\\<verilog-mode-map>
29948See \\[describe-function] verilog-auto (\\[verilog-auto]) for details on how
29949AUTOs can improve coding efficiency.
29950
29951Use \\[verilog-faq] for a pointer to frequently asked questions.
29952
29953NEWLINE, TAB indents for Verilog code.
29954Delete converts tabs to spaces as it moves back.
29955
29956Supports highlighting.
29957
29958Turning on Verilog mode calls the value of the variable `verilog-mode-hook'
29959with no args, if that value is non-nil.
29960
29961Variables controlling indentation/edit style:
29962
29963 variable `verilog-indent-level' (default 3)
29964 Indentation of Verilog statements with respect to containing block.
29965 `verilog-indent-level-module' (default 3)
29966 Absolute indentation of Module level Verilog statements.
29967 Set to 0 to get initial and always statements lined up
29968 on the left side of your screen.
29969 `verilog-indent-level-declaration' (default 3)
29970 Indentation of declarations with respect to containing block.
29971 Set to 0 to get them list right under containing block.
29972 `verilog-indent-level-behavioral' (default 3)
29973 Indentation of first begin in a task or function block
29974 Set to 0 to get such code to lined up underneath the task or function keyword
29975 `verilog-indent-level-directive' (default 1)
29976 Indentation of `ifdef/`endif blocks
29977 `verilog-cexp-indent' (default 1)
29978 Indentation of Verilog statements broken across lines i.e.:
29979 if (a)
29980 begin
29981 `verilog-case-indent' (default 2)
29982 Indentation for case statements.
29983 `verilog-auto-newline' (default nil)
29984 Non-nil means automatically newline after semicolons and the punctuation
29985 mark after an end.
29986 `verilog-auto-indent-on-newline' (default t)
29987 Non-nil means automatically indent line after newline
29988 `verilog-tab-always-indent' (default t)
29989 Non-nil means TAB in Verilog mode should always reindent the current line,
29990 regardless of where in the line point is when the TAB command is used.
29991 `verilog-indent-begin-after-if' (default t)
29992 Non-nil means to indent begin statements following a preceding
29993 if, else, while, for and repeat statements, if any. otherwise,
29994 the begin is lined up with the preceding token. If t, you get:
29995 if (a)
29996 begin // amount of indent based on `verilog-cexp-indent'
29997 otherwise you get:
29998 if (a)
29999 begin
30000 `verilog-auto-endcomments' (default t)
30001 Non-nil means a comment /* ... */ is set after the ends which ends
30002 cases, tasks, functions and modules.
30003 The type and name of the object will be set between the braces.
30004 `verilog-minimum-comment-distance' (default 10)
30005 Minimum distance (in lines) between begin and end required before a comment
30006 will be inserted. Setting this variable to zero results in every
30007 end acquiring a comment; the default avoids too many redundant
30008 comments in tight quarters.
30009 `verilog-auto-lineup' (default `(all))
30010 List of contexts where auto lineup of code should be done.
30011
30012Variables controlling other actions:
30013
30014 `verilog-linter' (default surelint)
30015 Unix program to call to run the lint checker. This is the default
30016 command for \\[compile-command] and \\[verilog-auto-save-compile].
30017
30018See \\[customize] for the complete list of variables.
30019
30020AUTO expansion functions are, in part:
30021
30022 \\[verilog-auto] Expand AUTO statements.
30023 \\[verilog-delete-auto] Remove the AUTOs.
30024 \\[verilog-inject-auto] Insert AUTOs for the first time.
30025
30026Some other functions are:
30027
30028 \\[verilog-complete-word] Complete word with appropriate possibilities.
30029 \\[verilog-mark-defun] Mark function.
30030 \\[verilog-beg-of-defun] Move to beginning of current function.
30031 \\[verilog-end-of-defun] Move to end of current function.
30032 \\[verilog-label-be] Label matching begin ... end, fork ... join, etc statements.
30033
30034 \\[verilog-comment-region] Put marked area in a comment.
30035 \\[verilog-uncomment-region] Uncomment an area commented with \\[verilog-comment-region].
30036 \\[verilog-insert-block] Insert begin ... end;.
30037 \\[verilog-star-comment] Insert /* ... */.
30038
30039 \\[verilog-sk-always] Insert a always @(AS) begin .. end block.
30040 \\[verilog-sk-begin] Insert a begin .. end block.
30041 \\[verilog-sk-case] Insert a case block, prompting for details.
30042 \\[verilog-sk-for] Insert a for (...) begin .. end block, prompting for details.
30043 \\[verilog-sk-generate] Insert a generate .. endgenerate block.
30044 \\[verilog-sk-header] Insert a nice header block at the top of file.
30045 \\[verilog-sk-initial] Insert an initial begin .. end block.
30046 \\[verilog-sk-fork] Insert a fork begin .. end .. join block.
30047 \\[verilog-sk-module] Insert a module .. (/*AUTOARG*/);.. endmodule block.
30048 \\[verilog-sk-primitive] Insert a primitive .. (.. );.. endprimitive block.
30049 \\[verilog-sk-repeat] Insert a repeat (..) begin .. end block.
30050 \\[verilog-sk-specify] Insert a specify .. endspecify block.
30051 \\[verilog-sk-task] Insert a task .. begin .. end endtask block.
30052 \\[verilog-sk-while] Insert a while (...) begin .. end block, prompting for details.
30053 \\[verilog-sk-casex] Insert a casex (...) item: begin.. end endcase block, prompting for details.
30054 \\[verilog-sk-casez] Insert a casez (...) item: begin.. end endcase block, prompting for details.
30055 \\[verilog-sk-if] Insert an if (..) begin .. end block.
30056 \\[verilog-sk-else-if] Insert an else if (..) begin .. end block.
30057 \\[verilog-sk-comment] Insert a comment block.
30058 \\[verilog-sk-assign] Insert an assign .. = ..; statement.
30059 \\[verilog-sk-function] Insert a function .. begin .. end endfunction block.
30060 \\[verilog-sk-input] Insert an input declaration, prompting for details.
30061 \\[verilog-sk-output] Insert an output declaration, prompting for details.
30062 \\[verilog-sk-state-machine] Insert a state machine definition, prompting for details.
30063 \\[verilog-sk-inout] Insert an inout declaration, prompting for details.
30064 \\[verilog-sk-wire] Insert a wire declaration, prompting for details.
30065 \\[verilog-sk-reg] Insert a register declaration, prompting for details.
30066 \\[verilog-sk-define-signal] Define signal under point as a register at the top of the module.
30067
30068All key bindings can be seen in a Verilog-buffer with \\[describe-bindings].
30069Key bindings specific to `verilog-mode-map' are:
30070
30071\\{verilog-mode-map}
30072
30073\(fn)" t nil)
30074
30075;;;***
30076
29756;;;### (autoloads (vhdl-mode) "vhdl-mode" "progmodes/vhdl-mode.el" 30077;;;### (autoloads (vhdl-mode) "vhdl-mode" "progmodes/vhdl-mode.el"
29757;;;;;; (18213 1260)) 30078;;;;;; (18213 1260))
29758;;; Generated autoloads from progmodes/vhdl-mode.el 30079;;; Generated autoloads from progmodes/vhdl-mode.el
@@ -30821,6 +31142,11 @@ and off otherwise.
30821;;;;;; whitespace-toggle-leading-check) "whitespace" "whitespace.el" 31142;;;;;; whitespace-toggle-leading-check) "whitespace" "whitespace.el"
30822;;;;;; (18231 31064)) 31143;;;;;; (18231 31064))
30823;;; Generated autoloads from whitespace.el 31144;;; Generated autoloads from whitespace.el
31145(put 'whitespace-check-buffer-leading 'safe-local-variable 'booleanp)
31146(put 'whitespace-check-buffer-trailing 'safe-local-variable 'booleanp)
31147(put 'whitespace-check-buffer-indent 'safe-local-variable 'booleanp)
31148(put 'whitespace-check-buffer-spacetab 'safe-local-variable 'booleanp)
31149(put 'whitespace-check-buffer-ateol 'safe-local-variable 'booleanp)
30824 31150
30825(autoload 'whitespace-toggle-leading-check "whitespace" "\ 31151(autoload 'whitespace-toggle-leading-check "whitespace" "\
30826Toggle the check for leading space in the local buffer. 31152Toggle the check for leading space in the local buffer.
@@ -31371,7 +31697,7 @@ Zone out, completely.
31371;;;;;; "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/hex-util.el" "gnus/hmac-def.el" 31697;;;;;; "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/hex-util.el" "gnus/hmac-def.el"
31372;;;;;; "gnus/hmac-md5.el" "gnus/ietf-drums.el" "gnus/imap.el" "gnus/legacy-gnus-agent.el" 31698;;;;;; "gnus/hmac-md5.el" "gnus/ietf-drums.el" "gnus/imap.el" "gnus/legacy-gnus-agent.el"
31373;;;;;; "gnus/mail-parse.el" "gnus/mail-prsvr.el" "gnus/mail-source.el" 31699;;;;;; "gnus/mail-parse.el" "gnus/mail-prsvr.el" "gnus/mail-source.el"
31374;;;;;; "gnus/mailcap.el" "gnus/md4.el" "gnus/messcompat.el" "gnus/mm-bodies.el" 31700;;;;;; "gnus/mailcap.el" "gnus/messcompat.el" "gnus/mm-bodies.el"
31375;;;;;; "gnus/mm-decode.el" "gnus/mm-encode.el" "gnus/mm-util.el" 31701;;;;;; "gnus/mm-decode.el" "gnus/mm-encode.el" "gnus/mm-util.el"
31376;;;;;; "gnus/mm-view.el" "gnus/mml-sec.el" "gnus/mml-smime.el" "gnus/mml.el" 31702;;;;;; "gnus/mm-view.el" "gnus/mml-sec.el" "gnus/mml-smime.el" "gnus/mml.el"
31377;;;;;; "gnus/nnagent.el" "gnus/nnbabyl.el" "gnus/nndb.el" "gnus/nndir.el" 31703;;;;;; "gnus/nnagent.el" "gnus/nnbabyl.el" "gnus/nndb.el" "gnus/nndir.el"
@@ -31380,11 +31706,9 @@ Zone out, completely.
31380;;;;;; "gnus/nnmail.el" "gnus/nnmaildir.el" "gnus/nnmbox.el" "gnus/nnmh.el" 31706;;;;;; "gnus/nnmail.el" "gnus/nnmaildir.el" "gnus/nnmbox.el" "gnus/nnmh.el"
31381;;;;;; "gnus/nnnil.el" "gnus/nnoo.el" "gnus/nnrss.el" "gnus/nnslashdot.el" 31707;;;;;; "gnus/nnnil.el" "gnus/nnoo.el" "gnus/nnrss.el" "gnus/nnslashdot.el"
31382;;;;;; "gnus/nnspool.el" "gnus/nntp.el" "gnus/nnultimate.el" "gnus/nnvirtual.el" 31708;;;;;; "gnus/nnspool.el" "gnus/nntp.el" "gnus/nnultimate.el" "gnus/nnvirtual.el"
31383;;;;;; "gnus/nnwarchive.el" "gnus/nnweb.el" "gnus/nnwfm.el" "gnus/ntlm.el" 31709;;;;;; "gnus/nnwarchive.el" "gnus/nnweb.el" "gnus/nnwfm.el" "gnus/pop3.el"
31384;;;;;; "gnus/password.el" "gnus/pop3.el" "gnus/rfc1843.el" "gnus/rfc2045.el" 31710;;;;;; "gnus/rfc1843.el" "gnus/rfc2045.el" "gnus/rfc2047.el" "gnus/rfc2104.el"
31385;;;;;; "gnus/rfc2047.el" "gnus/rfc2104.el" "gnus/rfc2231.el" "gnus/sasl-cram.el" 31711;;;;;; "gnus/rfc2231.el" "gnus/sieve-manage.el" "gnus/smime.el"
31386;;;;;; "gnus/sasl-digest.el" "gnus/sasl-ntlm.el" "gnus/sasl.el"
31387;;;;;; "gnus/sieve-manage.el" "gnus/smime-ldap.el" "gnus/smime.el"
31388;;;;;; "gnus/spam-stat.el" "gnus/spam-wash.el" "gnus/starttls.el" 31712;;;;;; "gnus/spam-stat.el" "gnus/spam-wash.el" "gnus/starttls.el"
31389;;;;;; "gnus/utf7.el" "gnus/webmail.el" "help.el" "indent.el" "international/characters.el" 31713;;;;;; "gnus/utf7.el" "gnus/webmail.el" "help.el" "indent.el" "international/characters.el"
31390;;;;;; "international/charprop.el" "international/cp51932.el" "international/eucjp-ms.el" 31714;;;;;; "international/charprop.el" "international/cp51932.el" "international/eucjp-ms.el"
diff --git a/lisp/linum.el b/lisp/linum.el
new file mode 100644
index 00000000000..078645c4120
--- /dev/null
+++ b/lisp/linum.el
@@ -0,0 +1,196 @@
1;;; linum.el --- display line numbers in the left margin
2
3;; Copyright (C) 2008 Free Software Foundation, Inc.
4
5;; Author: Markus Triska <markus.triska@gmx.at>
6;; Maintainer: FSF
7;; Keywords: convenience
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 3, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;; Display line numbers for the current buffer.
29;;
30;; Toggle display of line numbers with M-x linum-mode. To enable
31;; line numbering in all buffers, use M-x global-linum-mode.
32
33;;; Code:
34
35(defconst linum-version "0.9wx")
36
37(defvar linum-overlays nil "Overlays used in this buffer.")
38(defvar linum-available nil "Overlays available for reuse.")
39(defvar linum-before-numbering-hook nil
40 "Functions run in each buffer before line numbering starts.")
41
42(mapc #'make-variable-buffer-local '(linum-overlays linum-available))
43
44(defgroup linum nil
45 "Show line numbers in the left margin."
46 :group 'convenience)
47
48;;;###autoload
49(defcustom linum-format 'dynamic
50 "Format used to display line numbers.
51Either a format string like \"%7d\", `dynamic' to adapt the width
52as needed, or a function that is called with a line number as its
53argument and should evaluate to a string to be shown on that line.
54See also `linum-before-numbering-hook'."
55 :group 'linum
56 :type 'sexp)
57
58(defface linum
59 '((t :inherit shadow))
60 "Face for displaying line numbers in the display margin."
61 :group 'linum)
62
63(defcustom linum-eager t
64 "Whether line numbers should be updated after each command.
65The conservative setting `nil' might miss some buffer changes,
66and you have to scroll or press \\[recenter-top-bottom] to update the numbers."
67 :group 'linum
68 :type 'boolean)
69
70(defcustom linum-delay t
71 "Delay updates to give Emacs a chance for other changes."
72 :group 'linum
73 :type 'boolean)
74
75;;;###autoload
76(define-minor-mode linum-mode
77 "Toggle display of line numbers in the left margin."
78 :lighter "" ; for desktop.el
79 (if linum-mode
80 (progn
81 (if linum-eager
82 (add-hook 'post-command-hook (if linum-delay
83 'linum-schedule
84 'linum-update-current) nil t)
85 (add-hook 'after-change-functions 'linum-after-change nil t))
86 (add-hook 'window-scroll-functions 'linum-after-scroll nil t)
87 ;; mistake in Emacs: window-size-change-functions cannot be local
88 (add-hook 'window-size-change-functions 'linum-after-size)
89 (add-hook 'change-major-mode-hook 'linum-delete-overlays nil t)
90 (add-hook 'window-configuration-change-hook
91 'linum-after-config nil t)
92 (linum-update-current))
93 (remove-hook 'post-command-hook 'linum-update-current t)
94 (remove-hook 'post-command-hook 'linum-schedule t)
95 (remove-hook 'window-size-change-functions 'linum-after-size)
96 (remove-hook 'window-scroll-functions 'linum-after-scroll t)
97 (remove-hook 'after-change-functions 'linum-after-change t)
98 (remove-hook 'window-configuration-change-hook 'linum-after-config t)
99 (remove-hook 'change-major-mode-hook 'linum-delete-overlays t)
100 (linum-delete-overlays)))
101
102;;;###autoload
103(define-globalized-minor-mode global-linum-mode linum-mode linum-on)
104
105(defun linum-on ()
106 (unless (minibufferp)
107 (linum-mode 1)))
108
109(defun linum-delete-overlays ()
110 "Delete all overlays displaying line numbers for this buffer."
111 (mapc #'delete-overlay linum-overlays)
112 (setq linum-overlays nil)
113 (dolist (w (get-buffer-window-list (current-buffer) nil t))
114 (set-window-margins w 0)))
115
116(defun linum-update-current ()
117 "Update line numbers for the current buffer."
118 (linum-update (current-buffer)))
119
120(defun linum-update (buffer)
121 "Update line numbers for all windows displaying BUFFER."
122 (with-current-buffer buffer
123 (when linum-mode
124 (setq linum-available linum-overlays)
125 (setq linum-overlays nil)
126 (save-excursion
127 (mapc #'linum-update-window
128 (get-buffer-window-list buffer nil 'visible)))
129 (mapc #'delete-overlay linum-available)
130 (setq linum-available nil))))
131
132(defun linum-update-window (win)
133 "Update line numbers for the portion visible in window WIN."
134 (goto-char (window-start win))
135 (let ((line (line-number-at-pos))
136 (limit (1+ (window-end win t)))
137 (fmt (cond ((stringp linum-format) linum-format)
138 ((eq linum-format 'dynamic)
139 (let ((w (length (number-to-string
140 (count-lines (point-min) (point-max))))))
141 (concat "%" (number-to-string w) "d")))))
142 (width 0)
143 visited
144 ov)
145 (run-hooks 'linum-before-numbering-hook)
146 ;; Create an overlay (or reuse an existing one) for each
147 ;; line visible in this window, if necessary.
148 (while (and (not (eobp)) (< (point) limit))
149 (setq visited nil)
150 (dolist (o (overlays-in (point) (point)))
151 (when (eq (overlay-get o 'linum-line) line)
152 (unless (memq o linum-overlays)
153 (push o linum-overlays))
154 (setq linum-available (delete o linum-available))
155 (setq visited t)))
156 (let ((str (if fmt
157 (propertize (format fmt line) 'face 'linum)
158 (funcall linum-format line))))
159 (setq width (max width (length str)))
160 (unless visited
161 (if (null linum-available)
162 (setq ov (make-overlay (point) (point)))
163 (setq ov (pop linum-available))
164 (move-overlay ov (point) (point)))
165 (push ov linum-overlays)
166 (setq str (propertize " " 'display `((margin left-margin) ,str)))
167 (overlay-put ov 'before-string str)
168 (overlay-put ov 'linum-line line)))
169 (forward-line)
170 (setq line (1+ line)))
171 (set-window-margins win width)))
172
173(defun linum-after-change (beg end len)
174 ;; update overlays on deletions, and after newlines are inserted
175 (when (or (= beg end)
176 (= end (point-max))
177 (string-match-p "\n" (buffer-substring-no-properties beg end)))
178 (linum-update-current)))
179
180(defun linum-after-scroll (win start)
181 (linum-update (window-buffer win)))
182
183(defun linum-after-size (frame)
184 (linum-after-config))
185
186(defun linum-schedule ()
187 ;; schedule an update; the delay gives Emacs a chance for display changes
188 (run-with-idle-timer 0 nil #'linum-update-current))
189
190(defun linum-after-config ()
191 (walk-windows (lambda (w) (linum-update (window-buffer))) nil 'visible))
192
193(provide 'linum)
194
195;; arch-tag: dea45631-ed3c-4867-8b49-1c41c80aec6a
196;;; linum.el ends here
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 5aaa06b0a11..71e81ae4221 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -74,7 +74,7 @@ A library name is equivalent to the file name that `load-library' would load."
74 (let (provides) 74 (let (provides)
75 (dolist (x (file-loadhist-lookup file) provides) 75 (dolist (x (file-loadhist-lookup file) provides)
76 (when (eq (car-safe x) 'provide) 76 (when (eq (car-safe x) 'provide)
77 (push x provides))))) 77 (push (cdr x) provides)))))
78 78
79(defun file-requires (file) 79(defun file-requires (file)
80 "Return the list of features required by FILE as it was loaded. 80 "Return the list of features required by FILE as it was loaded.
@@ -83,7 +83,7 @@ A library name is equivalent to the file name that `load-library' would load."
83 (let (requires) 83 (let (requires)
84 (dolist (x (file-loadhist-lookup file) requires) 84 (dolist (x (file-loadhist-lookup file) requires)
85 (when (eq (car-safe x) 'require) 85 (when (eq (car-safe x) 'require)
86 (push x requires))))) 86 (push (cdr x) requires)))))
87 87
88(defsubst file-set-intersect (p q) 88(defsubst file-set-intersect (p q)
89 "Return the set intersection of two lists." 89 "Return the set intersection of two lists."
diff --git a/lisp/log-edit.el b/lisp/log-edit.el
index b92de701b03..5447cda9f1c 100644
--- a/lisp/log-edit.el
+++ b/lisp/log-edit.el
@@ -309,20 +309,20 @@ automatically."
309 "Setup a buffer to enter a log message. 309 "Setup a buffer to enter a log message.
310\\<log-edit-mode-map>The buffer will be put in `log-edit-mode'. 310\\<log-edit-mode-map>The buffer will be put in `log-edit-mode'.
311If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run. 311If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run.
312Mark and point will be set around the entire contents of the 312Mark and point will be set around the entire contents of the buffer so
313buffer so that it is easy to kill the contents of the buffer with \\[kill-region]. 313that it is easy to kill the contents of the buffer with \\[kill-region].
314Once you're done editing the message, pressing \\[log-edit-done] will call 314Once you're done editing the message, pressing \\[log-edit-done] will call
315`log-edit-done' which will end up calling CALLBACK to do the actual commit. 315`log-edit-done' which will end up calling CALLBACK to do the actual commit.
316PARAMS if non-nil is an alist. The keys for the alist can be: 316
317`log-edit-listfun' and `log-edit-diff-function'. The associated 317PARAMS if non-nil is an alist. Possible keys and associated values:
318value for `log-edit-listfun' should be a function with not 318 `log-edit-listfun' -- function taking no arguments that returns the list of
319arguments that returns the list of files that are concerned by 319 files that are concerned by the current operation (using relative names);
320the current operation (using relative names). The associated 320 `log-edit-diff-function' -- function taking no arguments that
321value for `log-edit-diff-function' should be a function with no 321 displays a diff of the files concerned by the current operation.
322arguments that displays a diff of the files concerned by the current operation. 322
323If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the 323If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the
324 log message and go back to the current buffer when done. Otherwise, it 324log message and go back to the current buffer when done. Otherwise, it
325 uses the current buffer." 325uses the current buffer."
326 (let ((parent (current-buffer))) 326 (let ((parent (current-buffer)))
327 (if buffer (pop-to-buffer buffer)) 327 (if buffer (pop-to-buffer buffer))
328 (when (and log-edit-setup-invert (not (eq setup 'force))) 328 (when (and log-edit-setup-invert (not (eq setup 'force)))
diff --git a/lisp/longlines.el b/lisp/longlines.el
index 932a70480a1..77176a5db24 100644
--- a/lisp/longlines.el
+++ b/lisp/longlines.el
@@ -136,7 +136,8 @@ are indicated with a symbol."
136 (let ((buffer-undo-list t) 136 (let ((buffer-undo-list t)
137 (inhibit-read-only t) 137 (inhibit-read-only t)
138 (after-change-functions nil) 138 (after-change-functions nil)
139 (mod (buffer-modified-p))) 139 (mod (buffer-modified-p))
140 buffer-file-name buffer-file-truename)
140 ;; Turning off undo is OK since (spaces + newlines) is 141 ;; Turning off undo is OK since (spaces + newlines) is
141 ;; conserved, except for a corner case in 142 ;; conserved, except for a corner case in
142 ;; longlines-wrap-lines that we'll never encounter from here 143 ;; longlines-wrap-lines that we'll never encounter from here
@@ -176,7 +177,8 @@ are indicated with a symbol."
176 (longlines-unshow-hard-newlines)) 177 (longlines-unshow-hard-newlines))
177 (let ((buffer-undo-list t) 178 (let ((buffer-undo-list t)
178 (after-change-functions nil) 179 (after-change-functions nil)
179 (inhibit-read-only t)) 180 (inhibit-read-only t)
181 buffer-file-name buffer-file-truename)
180 (if longlines-decoded 182 (if longlines-decoded
181 (save-restriction 183 (save-restriction
182 (widen) 184 (widen)
@@ -220,7 +222,8 @@ With optional argument ARG, make the hard newlines invisible again."
220 (mod (buffer-modified-p)) 222 (mod (buffer-modified-p))
221 (buffer-undo-list t) 223 (buffer-undo-list t)
222 (inhibit-read-only t) 224 (inhibit-read-only t)
223 (inhibit-modification-hooks t)) 225 (inhibit-modification-hooks t)
226 buffer-file-name buffer-file-truename)
224 (while pos 227 (while pos
225 (put-text-property pos (1+ pos) 'display 228 (put-text-property pos (1+ pos) 'display
226 (copy-sequence longlines-show-effect)) 229 (copy-sequence longlines-show-effect))
@@ -235,7 +238,8 @@ With optional argument ARG, make the hard newlines invisible again."
235 (mod (buffer-modified-p)) 238 (mod (buffer-modified-p))
236 (buffer-undo-list t) 239 (buffer-undo-list t)
237 (inhibit-read-only t) 240 (inhibit-read-only t)
238 (inhibit-modification-hooks t)) 241 (inhibit-modification-hooks t)
242 buffer-file-name buffer-file-truename)
239 (while pos 243 (while pos
240 (remove-text-properties pos (1+ pos) '(display)) 244 (remove-text-properties pos (1+ pos) '(display))
241 (setq pos (text-property-not-all (1+ pos) (point-max) 'hard nil))) 245 (setq pos (text-property-not-all (1+ pos) (point-max) 'hard nil)))
diff --git a/lisp/lpr.el b/lisp/lpr.el
index 8f4a8679338..9e9de8c4bb9 100644
--- a/lisp/lpr.el
+++ b/lisp/lpr.el
@@ -47,7 +47,7 @@
47 47
48;;;###autoload 48;;;###autoload
49(defcustom printer-name 49(defcustom printer-name
50 (and lpr-windows-system "PRN") 50 (and (memq system-type '(emx ms-dos)) "PRN")
51 "*The name of a local printer to which data is sent for printing. 51 "*The name of a local printer to which data is sent for printing.
52\(Note that PostScript files are sent to `ps-printer-name', which see.\) 52\(Note that PostScript files are sent to `ps-printer-name', which see.\)
53 53
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 302329b9bba..2963168a899 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -209,7 +209,7 @@ The Lisp emulation does not run any external programs or shells. It
209supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards' 209supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards'
210is non-nil; otherwise, it interprets wildcards as regular expressions 210is non-nil; otherwise, it interprets wildcards as regular expressions
211to match file names. It does not support all `ls' switches -- those 211to match file names. It does not support all `ls' switches -- those
212that work are: A a c i r S s t u U X g G B C R and F partly." 212that work are: A a c i r S s t u U X g G B C R n and F partly."
213 (if ls-lisp-use-insert-directory-program 213 (if ls-lisp-use-insert-directory-program
214 (funcall original-insert-directory 214 (funcall original-insert-directory
215 file switches wildcard full-directory-p) 215 file switches wildcard full-directory-p)
@@ -286,7 +286,10 @@ not contain `d', so that a full listing is expected."
286 (let* ((dir (file-name-as-directory file)) 286 (let* ((dir (file-name-as-directory file))
287 (default-directory dir) ; so that file-attributes works 287 (default-directory dir) ; so that file-attributes works
288 (file-alist 288 (file-alist
289 (directory-files-and-attributes dir nil wildcard-regexp t 'string)) 289 (directory-files-and-attributes dir nil wildcard-regexp t
290 (if (memq ?n switches)
291 'integer
292 'string)))
290 (now (current-time)) 293 (now (current-time))
291 (sum 0) 294 (sum 0)
292 ;; do all bindings here for speed 295 ;; do all bindings here for speed
diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el
index 36cd17fe6fc..5b292961b98 100644
--- a/lisp/mail/hashcash.el
+++ b/lisp/mail/hashcash.el
@@ -1,6 +1,6 @@
1;;; hashcash.el --- Add hashcash payments to email 1;;; hashcash.el --- Add hashcash payments to email
2 2
3;; Copyright (C) 2003, 2004, 2005, 2007 Free Software Foundation 3;; Copyright (C) 2003, 2004, 2005, 2007, 2008 Free Software Foundation
4 4
5;; Written by: Paul Foley <mycroft@actrix.gen.nz> (1997-2002) 5;; Written by: Paul Foley <mycroft@actrix.gen.nz> (1997-2002)
6;; Maintainer: Paul Foley <mycroft@actrix.gen.nz> 6;; Maintainer: Paul Foley <mycroft@actrix.gen.nz>
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 7a6e013e5d0..359088ec2e7 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -1934,7 +1934,7 @@ is non-nil if the user has supplied the password interactively.
1934 (save-restriction 1934 (save-restriction
1935 (while (not (eobp)) 1935 (while (not (eobp))
1936 (setq start (point)) 1936 (setq start (point))
1937 (cond ((looking-at "BABYL OPTIONS:");Babyl header 1937 (cond ((looking-at "BABYL OPTIONS:") ;Babyl header
1938 (if (search-forward "\n\^_" nil t) 1938 (if (search-forward "\n\^_" nil t)
1939 ;; If we find the proper terminator, delete through there. 1939 ;; If we find the proper terminator, delete through there.
1940 (delete-region (point-min) (point)) 1940 (delete-region (point-min) (point))
@@ -1953,75 +1953,80 @@ is non-nil if the user has supplied the password interactively.
1953 (save-excursion 1953 (save-excursion
1954 (skip-chars-forward " \t\n") 1954 (skip-chars-forward " \t\n")
1955 (point))) 1955 (point)))
1956 (save-excursion 1956 ;; The following let* form was wrapped in a `save-excursion'
1957 (let* ((header-end 1957 ;; which in one case caused infinite looping, see:
1958 (progn 1958 ;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00968.html
1959 (save-excursion 1959 ;; Removing that form leaves `point' at the end of the
1960 (goto-char start) 1960 ;; region decoded by `rmail-decode-region' which should
1961 (forward-line 1) 1961 ;; be correct.
1962 (if (looking-at "0") 1962 (let* ((header-end
1963 (forward-line 1) 1963 (progn
1964 (forward-line 2))
1965 (save-restriction
1966 (narrow-to-region (point) (point-max))
1967 (rfc822-goto-eoh)
1968 (point)))))
1969 (case-fold-search t)
1970 (quoted-printable-header-field-end
1971 (save-excursion
1972 (goto-char start)
1973 (re-search-forward
1974 "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*"
1975 header-end t)))
1976 (base64-header-field-end
1977 (save-excursion 1964 (save-excursion
1978 (goto-char start) 1965 (goto-char start)
1979 ;; Don't try to decode non-text data. 1966 (forward-line 1)
1980 (and (re-search-forward 1967 (if (looking-at "0")
1981 "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/" 1968 (forward-line 1)
1982 header-end t) 1969 (forward-line 2))
1983 (goto-char start) 1970 (save-restriction
1984 (re-search-forward 1971 (narrow-to-region (point) (point-max))
1985 "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*" 1972 (rfc822-goto-eoh)
1986 header-end t))))) 1973 (point)))))
1987 (if quoted-printable-header-field-end 1974 (case-fold-search t)
1975 (quoted-printable-header-field-end
1988 (save-excursion 1976 (save-excursion
1989 (unless 1977 (goto-char start)
1990 (mail-unquote-printable-region header-end (point) nil t t) 1978 (re-search-forward
1991 (message "Malformed MIME quoted-printable message")) 1979 "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*"
1992 ;; Change "quoted-printable" to "8bit", 1980 header-end t)))
1993 ;; to reflect the decoding we just did. 1981 (base64-header-field-end
1994 (goto-char quoted-printable-header-field-end)
1995 (delete-region (point) (search-backward ":"))
1996 (insert ": 8bit")))
1997 (if base64-header-field-end
1998 (save-excursion 1982 (save-excursion
1999 (when 1983 (goto-char start)
2000 (condition-case nil 1984 ;; Don't try to decode non-text data.
2001 (progn 1985 (and (re-search-forward
2002 (base64-decode-region (1+ header-end) 1986 "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/"
2003 (- (point) 2)) 1987 header-end t)
2004 t) 1988 (goto-char start)
2005 (error nil)) 1989 (re-search-forward
2006 ;; Change "base64" to "8bit", to reflect the 1990 "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*"
2007 ;; decoding we just did. 1991 header-end t)))))
2008 (goto-char base64-header-field-end) 1992 (if quoted-printable-header-field-end
2009 (delete-region (point) (search-backward ":")) 1993 (save-excursion
2010 (insert ": 8bit")))) 1994 (unless
2011 (setq last-coding-system-used nil) 1995 (mail-unquote-printable-region header-end (point) nil t t)
2012 (or rmail-enable-mime 1996 (message "Malformed MIME quoted-printable message"))
2013 (not rmail-enable-multibyte) 1997 ;; Change "quoted-printable" to "8bit",
2014 (let ((mime-charset 1998 ;; to reflect the decoding we just did.
2015 (if (and rmail-decode-mime-charset 1999 (goto-char quoted-printable-header-field-end)
2016 (save-excursion 2000 (delete-region (point) (search-backward ":"))
2017 (goto-char start) 2001 (insert ": 8bit")))
2018 (search-forward "\n\n" nil t) 2002 (if base64-header-field-end
2019 (let ((case-fold-search t)) 2003 (save-excursion
2020 (re-search-backward 2004 (when
2021 rmail-mime-charset-pattern 2005 (condition-case nil
2022 start t)))) 2006 (progn
2023 (intern (downcase (match-string 1)))))) 2007 (base64-decode-region (1+ header-end)
2024 (rmail-decode-region start (point) mime-charset))))) 2008 (- (point) 2))
2009 t)
2010 (error nil))
2011 ;; Change "base64" to "8bit", to reflect the
2012 ;; decoding we just did.
2013 (goto-char base64-header-field-end)
2014 (delete-region (point) (search-backward ":"))
2015 (insert ": 8bit"))))
2016 (setq last-coding-system-used nil)
2017 (or rmail-enable-mime
2018 (not rmail-enable-multibyte)
2019 (let ((mime-charset
2020 (if (and rmail-decode-mime-charset
2021 (save-excursion
2022 (goto-char start)
2023 (search-forward "\n\n" nil t)
2024 (let ((case-fold-search t))
2025 (re-search-backward
2026 rmail-mime-charset-pattern
2027 start t))))
2028 (intern (downcase (match-string 1))))))
2029 (rmail-decode-region start (point) mime-charset))))
2025 ;; Add an X-Coding-System: header if we don't have one. 2030 ;; Add an X-Coding-System: header if we don't have one.
2026 (save-excursion 2031 (save-excursion
2027 (goto-char start) 2032 (goto-char start)
@@ -2051,8 +2056,8 @@ is non-nil if the user has supplied the password interactively.
2051 (save-restriction 2056 (save-restriction
2052 (narrow-to-region start (1- (point))) 2057 (narrow-to-region start (1- (point)))
2053 (goto-char (point-min)) 2058 (goto-char (point-min))
2054 (while (search-forward "\n\^_" nil t); single char "\^_" 2059 (while (search-forward "\n\^_" nil t) ; single char "\^_"
2055 (replace-match "\n^_")))); 2 chars: "^" and "_" 2060 (replace-match "\n^_")))) ; 2 chars: "^" and "_"
2056 (setq last-coding-system-used nil) 2061 (setq last-coding-system-used nil)
2057 (or rmail-enable-mime 2062 (or rmail-enable-mime
2058 (not rmail-enable-multibyte) 2063 (not rmail-enable-multibyte)
@@ -2168,8 +2173,8 @@ is non-nil if the user has supplied the password interactively.
2168 (save-restriction 2173 (save-restriction
2169 (narrow-to-region start (point)) 2174 (narrow-to-region start (point))
2170 (goto-char (point-min)) 2175 (goto-char (point-min))
2171 (while (search-forward "\n\^_" nil t); single char 2176 (while (search-forward "\n\^_" nil t) ; single char
2172 (replace-match "\n^_")))); 2 chars: "^" and "_" 2177 (replace-match "\n^_")))) ; 2 chars: "^" and "_"
2173 ;; This is for malformed messages that don't end in newline. 2178 ;; This is for malformed messages that don't end in newline.
2174 ;; There shouldn't be any, but some users say occasionally 2179 ;; There shouldn't be any, but some users say occasionally
2175 ;; there are some. 2180 ;; there are some.
diff --git a/lisp/mb-depth.el b/lisp/mb-depth.el
index c1fd0780730..d85380ea64c 100644
--- a/lisp/mb-depth.el
+++ b/lisp/mb-depth.el
@@ -1,6 +1,6 @@
1;;; mb-depth.el --- Indicate minibuffer-depth in prompt 1;;; mb-depth.el --- Indicate minibuffer-depth in prompt
2;; 2;;
3;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
4;; 4;;
5;; Author: Miles Bader <miles@gnu.org> 5;; Author: Miles Bader <miles@gnu.org>
6;; Keywords: convenience 6;; Keywords: convenience
diff --git a/lisp/md4.el b/lisp/md4.el
index 7ccb22a20fe..13435097b71 100644
--- a/lisp/md4.el
+++ b/lisp/md4.el
@@ -1,6 +1,6 @@
1;;; md4.el --- MD4 Message Digest Algorithm. 1;;; md4.el --- MD4 Message Digest Algorithm.
2 2
3;; Copyright (C) 2001, 2004, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2001, 2004, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Taro Kawagishi <tarok@transpulse.org> 5;; Author: Taro Kawagishi <tarok@transpulse.org>
6;; Keywords: MD4 6;; Keywords: MD4
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index 0eba20a9899..96c612da42a 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -1,3 +1,8 @@
12008-01-30 Bill Wohler <wohler@newt.com>
2
3 * mh-mime.el (mh-mml-to-mime): Don't look up sender if From
4 absent. Fixes "Wrong type argument: stringp, nil" error.
5
12007-12-02 Glenn Morris <rgm@gnu.org> 62007-12-02 Glenn Morris <rgm@gnu.org>
2 7
3 * mh-mime.el (mail-strip-quoted-names): Autoload it. 8 * mh-mime.el (mail-strip-quoted-names): Autoload it.
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index ec0940a5d5e..5713ec8dba4 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -1621,13 +1621,14 @@ This action can be undone by running \\[undo]."
1621 (require 'message) 1621 (require 'message)
1622 (when mh-pgp-support-flag 1622 (when mh-pgp-support-flag
1623 ;; PGP requires actual e-mail addresses, not aliases. 1623 ;; PGP requires actual e-mail addresses, not aliases.
1624 ;; Parse the recipients and sender from the message 1624 ;; Parse the recipients and sender from the message.
1625 (message-options-set-recipient) 1625 (message-options-set-recipient)
1626 ;; Do an alias lookup on sender 1626 ;; Do an alias lookup on sender (if From field is present).
1627 (message-options-set 'message-sender 1627 (when (message-options-get 'message-sender)
1628 (mail-strip-quoted-names 1628 (message-options-set 'message-sender
1629 (mh-alias-expand 1629 (mail-strip-quoted-names
1630 (message-options-get 'message-sender)))) 1630 (mh-alias-expand
1631 (message-options-get 'message-sender)))))
1631 ;; Do an alias lookup on recipients 1632 ;; Do an alias lookup on recipients
1632 (message-options-set 'message-recipients 1633 (message-options-set 'message-recipients
1633 (mapconcat 1634 (mapconcat
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 83075762b73..ef84db1ccf7 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -46,6 +46,17 @@
46(defconst dbus-interface-introspectable "org.freedesktop.DBus.Introspectable" 46(defconst dbus-interface-introspectable "org.freedesktop.DBus.Introspectable"
47 "The interface supported by introspectable objects.") 47 "The interface supported by introspectable objects.")
48 48
49(defmacro dbus-ignore-errors (&rest body)
50 "Execute BODY; signal D-Bus error when `dbus-debug' is non-nil.
51Otherwise, return result of last form in BODY, or all other errors."
52 `(condition-case err
53 (progn ,@body)
54 (dbus-error (when dbus-debug (signal (car err) (cdr err))))))
55
56(put 'dbus-ignore-errors 'lisp-indent-function 0)
57(put 'dbus-ignore-errors 'edebug-form-spec '(form symbolp body))
58(font-lock-add-keywords 'emacs-lisp-mode '("\\<dbus-ignore-errors\\>"))
59
49 60
50;;; Hash table of registered functions. 61;;; Hash table of registered functions.
51 62
@@ -64,6 +75,35 @@ hash table."
64 dbus-registered-functions-table) 75 dbus-registered-functions-table)
65 result)) 76 result))
66 77
78(defun dbus-unregister-object (object)
79 "Unregister OBJECT from D-Bus.
80OBJECT must be the result of a preceding `dbus-register-method'
81or `dbus-register-signal' call. It returns t if OBJECT has been
82unregistered, nil otherwise."
83 ;; Check parameter.
84 (unless (and (consp object) (not (null (car object))) (consp (cdr object)))
85 (signal 'wrong-type-argument (list 'D-Bus object)))
86
87 ;; Find the corresponding entry in the hash table.
88 (let* ((key (car object))
89 (value (gethash key dbus-registered-functions-table)))
90 ;; Loop over the registered functions.
91 (while (consp value)
92 ;; (car value) has the structure (UNAME SERVICE PATH HANDLER).
93 ;; (cdr object) has the structure ((SERVICE PATH HANDLER) ...).
94 (if (not (equal (cdr (car value)) (car (cdr object))))
95 (setq value (cdr value))
96 ;; Compute new hash value. If it is empty, remove it from
97 ;; hash table.
98 (unless
99 (puthash
100 key
101 (delete (car value) (gethash key dbus-registered-functions-table))
102 dbus-registered-functions-table)
103 (remhash key dbus-registered-functions-table))
104 (setq value t)))
105 value))
106
67(defun dbus-name-owner-changed-handler (&rest args) 107(defun dbus-name-owner-changed-handler (&rest args)
68 "Reapplies all member registrations to D-Bus. 108 "Reapplies all member registrations to D-Bus.
69This handler is applied when a \"NameOwnerChanged\" signal has 109This handler is applied when a \"NameOwnerChanged\" signal has
@@ -110,15 +150,13 @@ usage: (dbus-name-owner-changed-handler service old-owner new-owner)"
110 args)))))) 150 args))))))
111 151
112;; Register the handler. 152;; Register the handler.
113(condition-case nil 153(dbus-ignore-errors
114 (progn 154 (dbus-register-signal
115 (dbus-register-signal 155 :system dbus-service-dbus dbus-path-dbus dbus-interface-dbus
116 :system dbus-service-dbus dbus-path-dbus dbus-interface-dbus 156 "NameOwnerChanged" 'dbus-name-owner-changed-handler)
117 "NameOwnerChanged" 'dbus-name-owner-changed-handler) 157 (dbus-register-signal
118 (dbus-register-signal 158 :session dbus-service-dbus dbus-path-dbus dbus-interface-dbus
119 :session dbus-service-dbus dbus-path-dbus dbus-interface-dbus 159 "NameOwnerChanged" 'dbus-name-owner-changed-handler))
120 "NameOwnerChanged" 'dbus-name-owner-changed-handler))
121 (dbus-error))
122 160
123 161
124;;; D-Bus events. 162;;; D-Bus events.
@@ -168,16 +206,15 @@ part of the event, is called with arguments ARGS."
168 (interactive "e") 206 (interactive "e")
169 ;; We don't want to raise an error, because this function is called 207 ;; We don't want to raise an error, because this function is called
170 ;; in the event handling loop. 208 ;; in the event handling loop.
171 (condition-case err 209 (dbus-ignore-errors
172 (let (result) 210 (let (result)
173 (dbus-check-event event) 211 (dbus-check-event event)
174 (setq result (apply (nth 7 event) (nthcdr 8 event))) 212 (setq result (apply (nth 7 event) (nthcdr 8 event)))
175 (unless (consp result) (setq result (cons result nil))) 213 (unless (consp result) (setq result (cons result nil)))
176 ;; Return a message when serial is not nil. 214 ;; Return a message when serial is not nil.
177 (when (not (null (nth 2 event))) 215 (when (not (null (nth 2 event)))
178 (apply 'dbus-method-return 216 (apply 'dbus-method-return-internal
179 (nth 1 event) (nth 2 event) (nth 3 event) result))) 217 (nth 1 event) (nth 2 event) (nth 3 event) result)))))
180 (dbus-error (when dbus-debug (signal (car err) (cdr err))))))
181 218
182(defun dbus-event-bus-name (event) 219(defun dbus-event-bus-name (event)
183 "Return the bus name the event is coming from. 220 "Return the bus name the event is coming from.
@@ -238,11 +275,10 @@ well formed."
238 "Return the D-Bus service names which can be activated as list. 275 "Return the D-Bus service names which can be activated as list.
239The result is a list of strings, which is nil when there are no 276The result is a list of strings, which is nil when there are no
240activatable service names at all." 277activatable service names at all."
241 (condition-case nil 278 (dbus-ignore-errors
242 (dbus-call-method 279 (dbus-call-method
243 :system dbus-service-dbus 280 :system dbus-service-dbus
244 dbus-path-dbus dbus-interface-dbus "ListActivatableNames") 281 dbus-path-dbus dbus-interface-dbus "ListActivatableNames")))
245 (dbus-error)))
246 282
247(defun dbus-list-names (bus) 283(defun dbus-list-names (bus)
248 "Return the service names registered at D-Bus BUS. 284 "Return the service names registered at D-Bus BUS.
@@ -250,10 +286,9 @@ The result is a list of strings, which is nil when there are no
250registered service names at all. Well known names are strings like 286registered service names at all. Well known names are strings like
251\"org.freedesktop.DBus\". Names starting with \":\" are unique names 287\"org.freedesktop.DBus\". Names starting with \":\" are unique names
252for services." 288for services."
253 (condition-case nil 289 (dbus-ignore-errors
254 (dbus-call-method 290 (dbus-call-method
255 bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames") 291 bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames")))
256 (dbus-error)))
257 292
258(defun dbus-list-known-names (bus) 293(defun dbus-list-known-names (bus)
259 "Retrieve all services which correspond to a known name in BUS. 294 "Retrieve all services which correspond to a known name in BUS.
@@ -267,20 +302,18 @@ A service has a known name if it doesn't start with \":\"."
267"Return the unique names registered at D-Bus BUS and queued for SERVICE. 302"Return the unique names registered at D-Bus BUS and queued for SERVICE.
268The result is a list of strings, or nil when there are no queued name 303The result is a list of strings, or nil when there are no queued name
269owners service names at all." 304owners service names at all."
270 (condition-case nil 305 (dbus-ignore-errors
271 (dbus-call-method 306 (dbus-call-method
272 bus dbus-service-dbus dbus-path-dbus 307 bus dbus-service-dbus dbus-path-dbus
273 dbus-interface-dbus "ListQueuedOwners" service) 308 dbus-interface-dbus "ListQueuedOwners" service)))
274 (dbus-error)))
275 309
276(defun dbus-get-name-owner (bus service) 310(defun dbus-get-name-owner (bus service)
277 "Return the name owner of SERVICE registered at D-Bus BUS. 311 "Return the name owner of SERVICE registered at D-Bus BUS.
278The result is either a string, or nil if there is no name owner." 312The result is either a string, or nil if there is no name owner."
279 (condition-case nil 313 (dbus-ignore-errors
280 (dbus-call-method 314 (dbus-call-method
281 bus dbus-service-dbus dbus-path-dbus 315 bus dbus-service-dbus dbus-path-dbus
282 dbus-interface-dbus "GetNameOwner" service) 316 dbus-interface-dbus "GetNameOwner" service)))
283 (dbus-error)))
284 317
285(defun dbus-introspect (bus service path) 318(defun dbus-introspect (bus service path)
286 "Return the introspection data of SERVICE in D-Bus BUS at object path PATH. 319 "Return the introspection data of SERVICE in D-Bus BUS at object path PATH.
@@ -291,10 +324,9 @@ Example:
291\(dbus-introspect 324\(dbus-introspect
292 :system \"org.freedesktop.Hal\" 325 :system \"org.freedesktop.Hal\"
293 \"/org/freedesktop/Hal/devices/computer\")" 326 \"/org/freedesktop/Hal/devices/computer\")"
294 (condition-case nil 327 (dbus-ignore-errors
295 (dbus-call-method 328 (dbus-call-method
296 bus service path dbus-interface-introspectable "Introspect") 329 bus service path dbus-interface-introspectable "Introspect")))
297 (dbus-error)))
298 330
299(if nil ;; Must be reworked. Shall we offer D-Bus signatures at all? 331(if nil ;; Must be reworked. Shall we offer D-Bus signatures at all?
300(defun dbus-get-signatures (bus interface signal) 332(defun dbus-get-signatures (bus interface signal)
@@ -310,42 +342,39 @@ the third parameter is of type array of integer.
310If INTERFACE or SIGNAL do not exist, or if they do not support 342If INTERFACE or SIGNAL do not exist, or if they do not support
311the D-Bus method org.freedesktop.DBus.Introspectable.Introspect, 343the D-Bus method org.freedesktop.DBus.Introspectable.Introspect,
312the function returns nil." 344the function returns nil."
313 (condition-case nil 345 (dbus-ignore-errors
314 (let ((introspect-xml 346 (let ((introspect-xml
315 (with-temp-buffer 347 (with-temp-buffer
316 (insert (dbus-introspect bus interface)) 348 (insert (dbus-introspect bus interface))
317 (xml-parse-region (point-min) (point-max)))) 349 (xml-parse-region (point-min) (point-max))))
318 node interfaces signals args result) 350 node interfaces signals args result)
319 ;; Get the root node. 351 ;; Get the root node.
320 (setq node (xml-node-name introspect-xml)) 352 (setq node (xml-node-name introspect-xml))
321 ;; Get all interfaces. 353 ;; Get all interfaces.
322 (setq interfaces (xml-get-children node 'interface)) 354 (setq interfaces (xml-get-children node 'interface))
323 (while interfaces 355 (while interfaces
324 (when (string-equal (xml-get-attribute (car interfaces) 'name) 356 (when (string-equal (xml-get-attribute (car interfaces) 'name)
325 interface) 357 interface)
326 ;; That's the requested interface. Check for signals. 358 ;; That's the requested interface. Check for signals.
327 (setq signals (xml-get-children (car interfaces) 'signal)) 359 (setq signals (xml-get-children (car interfaces) 'signal))
328 (while signals 360 (while signals
329 (when (string-equal (xml-get-attribute (car signals) 'name) 361 (when (string-equal (xml-get-attribute (car signals) 'name) signal)
330 signal) 362 ;; The signal we are looking for.
331 ;; The signal we are looking for. 363 (setq args (xml-get-children (car signals) 'arg))
332 (setq args (xml-get-children (car signals) 'arg)) 364 (while args
333 (while args 365 (unless (xml-get-attribute (car args) 'type)
334 (unless (xml-get-attribute (car args) 'type) 366 ;; This shouldn't happen, let's escape.
335 ;; This shouldn't happen, let's escape. 367 (signal 'dbus-error nil))
336 (signal 'dbus-error "")) 368 ;; We append the signature.
337 ;; We append the signature. 369 (setq
338 (setq 370 result (append result
339 result (append result 371 (list (xml-get-attribute (car args) 'type))))
340 (list (xml-get-attribute (car args) 'type)))) 372 (setq args (cdr args)))
341 (setq args (cdr args))) 373 (setq signals nil))
342 (setq signals nil)) 374 (setq signals (cdr signals)))
343 (setq signals (cdr signals))) 375 (setq interfaces nil))
344 (setq interfaces nil)) 376 (setq interfaces (cdr interfaces)))
345 (setq interfaces (cdr interfaces))) 377 result)))
346 result)
347 ;; We ignore `dbus-error'. There might be no introspectable interface.
348 (dbus-error nil)))
349) ;; (if nil ... 378) ;; (if nil ...
350 379
351(provide 'dbus) 380(provide 'dbus)
diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el
index bfff7282adf..6b7cb7ddecc 100644
--- a/lisp/net/hmac-def.el
+++ b/lisp/net/hmac-def.el
@@ -1,6 +1,6 @@
1;;; hmac-def.el --- A macro for defining HMAC functions. 1;;; hmac-def.el --- A macro for defining HMAC functions.
2 2
3;; Copyright (C) 1999, 2001, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 1999, 2001, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> 5;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
6;; Keywords: HMAC, RFC 2104 6;; Keywords: HMAC, RFC 2104
diff --git a/lisp/net/hmac-md5.el b/lisp/net/hmac-md5.el
index 186708446f0..50a2d2742b7 100644
--- a/lisp/net/hmac-md5.el
+++ b/lisp/net/hmac-md5.el
@@ -1,6 +1,6 @@
1;;; hmac-md5.el --- Compute HMAC-MD5. 1;;; hmac-md5.el --- Compute HMAC-MD5.
2 2
3;; Copyright (C) 1999, 2001, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 1999, 2001, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> 5;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
6;; Keywords: HMAC, RFC 2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5 6;; Keywords: HMAC, RFC 2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index 0ee4de6fee8..27b434541ce 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -1150,6 +1150,13 @@ necessary. If nil, the buffer name is generated."
1150 (when imap-stream 1150 (when imap-stream
1151 buffer)))) 1151 buffer))))
1152 1152
1153(defcustom imap-ping-server t
1154 "If non-nil, check if IMAP is open.
1155See the function `imap-ping-server'."
1156 :version "23.0" ;; No Gnus
1157 :group 'imap
1158 :type 'boolean)
1159
1153(defun imap-opened (&optional buffer) 1160(defun imap-opened (&optional buffer)
1154 "Return non-nil if connection to imap server in BUFFER is open. 1161 "Return non-nil if connection to imap server in BUFFER is open.
1155If BUFFER is nil then the current buffer is used." 1162If BUFFER is nil then the current buffer is used."
@@ -1157,7 +1164,18 @@ If BUFFER is nil then the current buffer is used."
1157 (buffer-live-p buffer) 1164 (buffer-live-p buffer)
1158 (with-current-buffer buffer 1165 (with-current-buffer buffer
1159 (and imap-process 1166 (and imap-process
1160 (memq (process-status imap-process) '(open run)))))) 1167 (memq (process-status imap-process) '(open run))
1168 (if imap-ping-server
1169 (imap-ping-server)
1170 t)))))
1171
1172(defun imap-ping-server (&optional buffer)
1173 "Ping the IMAP server in BUFFER with a \"NOOP\" command.
1174Return non-nil if the server responds, and nil if it does not
1175respond. If BUFFER is nil, the current buffer is used."
1176 (condition-case ()
1177 (imap-ok-p (imap-send-command-wait "NOOP" buffer))
1178 (error nil)))
1161 1179
1162(defun imap-authenticate (&optional user passwd buffer) 1180(defun imap-authenticate (&optional user passwd buffer)
1163 "Authenticate to server in BUFFER, using current buffer if nil. 1181 "Authenticate to server in BUFFER, using current buffer if nil.
diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index 126f6688f0d..2418338228b 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -1,6 +1,6 @@
1;;; ntlm.el --- NTLM (NT LanManager) authentication support 1;;; ntlm.el --- NTLM (NT LanManager) authentication support
2 2
3;; Copyright (C) 2001, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2001, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Taro Kawagishi <tarok@transpulse.org> 5;; Author: Taro Kawagishi <tarok@transpulse.org>
6;; Keywords: NTLM, SASL 6;; Keywords: NTLM, SASL
diff --git a/lisp/net/sasl-cram.el b/lisp/net/sasl-cram.el
index 32f1e69f81f..911c8fe1805 100644
--- a/lisp/net/sasl-cram.el
+++ b/lisp/net/sasl-cram.el
@@ -1,6 +1,6 @@
1;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework 1;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework
2 2
3;; Copyright (C) 2000, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2000, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Daiki Ueno <ueno@unixuser.org> 5;; Author: Daiki Ueno <ueno@unixuser.org>
6;; Kenichi OKADA <okada@opaopa.org> 6;; Kenichi OKADA <okada@opaopa.org>
diff --git a/lisp/net/sasl-digest.el b/lisp/net/sasl-digest.el
index 6c544518e7f..85417dff31e 100644
--- a/lisp/net/sasl-digest.el
+++ b/lisp/net/sasl-digest.el
@@ -1,6 +1,6 @@
1;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework 1;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework
2 2
3;; Copyright (C) 2000, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2000, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Daiki Ueno <ueno@unixuser.org> 5;; Author: Daiki Ueno <ueno@unixuser.org>
6;; Kenichi OKADA <okada@opaopa.org> 6;; Kenichi OKADA <okada@opaopa.org>
diff --git a/lisp/net/sasl-ntlm.el b/lisp/net/sasl-ntlm.el
index cd8304db70a..699fd125270 100644
--- a/lisp/net/sasl-ntlm.el
+++ b/lisp/net/sasl-ntlm.el
@@ -1,6 +1,6 @@
1;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework 1;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework
2 2
3;; Copyright (C) 2000, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2000, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Taro Kawagishi <tarok@transpulse.org> 5;; Author: Taro Kawagishi <tarok@transpulse.org>
6;; Keywords: SASL, NTLM 6;; Keywords: SASL, NTLM
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el
index 9118d288da4..000bca51040 100644
--- a/lisp/net/sasl.el
+++ b/lisp/net/sasl.el
@@ -1,6 +1,6 @@
1;;; sasl.el --- SASL client framework 1;;; sasl.el --- SASL client framework
2 2
3;; Copyright (C) 2000, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2000, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Daiki Ueno <ueno@unixuser.org> 5;; Author: Daiki Ueno <ueno@unixuser.org>
6;; Keywords: SASL 6;; Keywords: SASL
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index b28c20263f4..4654c212ee3 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -1,6 +1,6 @@
1;;; tramp-cache.el --- file information caching for Tramp 1;;; tramp-cache.el --- file information caching for Tramp
2 2
3;; Copyright (C) 2000, 2005, 2006, 2007 by Free Software Foundation, Inc. 3;; Copyright (C) 2000, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Daniel Pittman <daniel@inanna.danann.net> 5;; Author: Daniel Pittman <daniel@inanna.danann.net>
6;; Michael Albinus <michael.albinus@gmx.de> 6;; Michael Albinus <michael.albinus@gmx.de>
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 7cf2bf3d923..d76e27e443c 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -1,6 +1,6 @@
1;;; tramp-cmds.el --- Interactive commands for Tramp 1;;; tramp-cmds.el --- Interactive commands for Tramp
2 2
3;; Copyright (C) 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Michael Albinus <michael.albinus@gmx.de> 5;; Author: Michael Albinus <michael.albinus@gmx.de>
6;; Keywords: comm, processes 6;; Keywords: comm, processes
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index b63b8c1e2fb..fcd8ba112b5 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -1,6 +1,6 @@
1;;; tramp-compat.el --- Tramp compatibility functions 1;;; tramp-compat.el --- Tramp compatibility functions
2 2
3;; Copyright (C) 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Michael Albinus <michael.albinus@gmx.de> 5;; Author: Michael Albinus <michael.albinus@gmx.de>
6;; Keywords: comm, processes 6;; Keywords: comm, processes
diff --git a/lisp/net/tramp-fish.el b/lisp/net/tramp-fish.el
index 95091c276bc..f6f455b1823 100644
--- a/lisp/net/tramp-fish.el
+++ b/lisp/net/tramp-fish.el
@@ -1,6 +1,6 @@
1;;; tramp-fish.el --- Tramp access functions for FISH protocol 1;;; tramp-fish.el --- Tramp access functions for FISH protocol
2 2
3;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Michael Albinus <michael.albinus@gmx.de> 5;; Author: Michael Albinus <michael.albinus@gmx.de>
6;; Keywords: comm, processes 6;; Keywords: comm, processes
diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el
index fa2e9ba68b0..498112c66b1 100644
--- a/lisp/net/tramp-gw.el
+++ b/lisp/net/tramp-gw.el
@@ -1,6 +1,6 @@
1;;; tramp-gw.el --- Tramp utility functions for HTTP tunnels and SOCKS gateways 1;;; tramp-gw.el --- Tramp utility functions for HTTP tunnels and SOCKS gateways
2 2
3;; Copyright (C) 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Michael Albinus <michael.albinus@gmx.de> 5;; Author: Michael Albinus <michael.albinus@gmx.de>
6;; Keywords: comm, processes 6;; Keywords: comm, processes
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 5a65b95b0f8..5829635d035 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -441,7 +441,7 @@ files conditionalize this setup based on the TERM environment variable."
441 (tramp-password-end-of-line nil)) 441 (tramp-password-end-of-line nil))
442 ("sudo" (tramp-login-program "sudo") 442 ("sudo" (tramp-login-program "sudo")
443 (tramp-login-args (("-u" "%u") 443 (tramp-login-args (("-u" "%u")
444 ("-s" "-p" "Password:"))) 444 ("-s") ("-H") ("-p" "Password:")))
445 (tramp-remote-sh "/bin/sh") 445 (tramp-remote-sh "/bin/sh")
446 (tramp-copy-program nil) 446 (tramp-copy-program nil)
447 (tramp-copy-args nil) 447 (tramp-copy-args nil)
@@ -519,7 +519,9 @@ files conditionalize this setup based on the TERM environment variable."
519 (tramp-default-port 22)) 519 (tramp-default-port 22))
520 ("plinkx" 520 ("plinkx"
521 (tramp-login-program "plink") 521 (tramp-login-program "plink")
522 (tramp-login-args (("-load" "%h") ("-t") 522 ;; ("%h") must be a single element, see
523 ;; `tramp-compute-multi-hops'.
524 (tramp-login-args (("-load") ("%h") ("-t")
523 (,(format 525 (,(format
524 "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=$ '" 526 "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=$ '"
525 tramp-terminal-type)) 527 tramp-terminal-type))
@@ -914,7 +916,7 @@ directories for POSIX compatible commands."
914 (string :tag "Directory")))) 916 (string :tag "Directory"))))
915 917
916(defcustom tramp-remote-process-environment 918(defcustom tramp-remote-process-environment
917 `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_CTYPE=C" "LC_TIME=C" 919 `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_ALL=C"
918 ,(concat "TERM=" tramp-terminal-type) 920 ,(concat "TERM=" tramp-terminal-type)
919 "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" 921 "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH="
920 "autocorrect=" "correct=") 922 "autocorrect=" "correct=")
@@ -1433,9 +1435,11 @@ means to use always cached values for the directory contents."
1433;;; Internal Variables: 1435;;; Internal Variables:
1434 1436
1435(defvar tramp-end-of-output 1437(defvar tramp-end-of-output
1436 (concat 1438 (format
1437 "///" (md5 (concat 1439 "%s///%s%s"
1438 (prin1-to-string process-environment) (current-time-string)))) 1440 tramp-rsh-end-of-line
1441 (md5 (concat (prin1-to-string process-environment) (current-time-string)))
1442 tramp-rsh-end-of-line)
1439 "String used to recognize end of output.") 1443 "String used to recognize end of output.")
1440 1444
1441(defvar tramp-current-method nil 1445(defvar tramp-current-method nil
@@ -3032,6 +3036,11 @@ and `rename'. FILENAME and NEWNAME must be absolute file names."
3032 ;; One of them must be a Tramp file. 3036 ;; One of them must be a Tramp file.
3033 (error "Tramp implementation says this cannot happen"))) 3037 (error "Tramp implementation says this cannot happen")))
3034 3038
3039 ;; In case of `rename', we must flush the cache of the source file.
3040 (when (and t1 (eq op 'rename))
3041 (with-parsed-tramp-file-name filename nil
3042 (tramp-flush-file-property v localname)))
3043
3035 ;; When newname did exist, we have wrong cached values. 3044 ;; When newname did exist, we have wrong cached values.
3036 (when t2 3045 (when t2
3037 (with-parsed-tramp-file-name newname nil 3046 (with-parsed-tramp-file-name newname nil
@@ -3774,13 +3783,15 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1."
3774 (command &optional output-buffer error-buffer) 3783 (command &optional output-buffer error-buffer)
3775 "Like `shell-command' for Tramp files." 3784 "Like `shell-command' for Tramp files."
3776 (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command)) 3785 (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))
3777 (args (split-string (substring command 0 asynchronous) " ")) 3786 ;; We cannot use `shell-file-name' and `shell-command-switch',
3787 ;; they are variables of the local host.
3788 (args (list "/bin/sh" "-c" (substring command 0 asynchronous)))
3778 (output-buffer 3789 (output-buffer
3779 (cond 3790 (cond
3780 ((bufferp output-buffer) output-buffer) 3791 ((bufferp output-buffer) output-buffer)
3781 ((stringp output-buffer) (get-buffer-create output-buffer)) 3792 ((stringp output-buffer) (get-buffer-create output-buffer))
3782 (output-buffer (current-buffer)) 3793 (output-buffer (current-buffer))
3783 (t (generate-new-buffer 3794 (t (get-buffer-create
3784 (if asynchronous 3795 (if asynchronous
3785 "*Async Shell Command*" 3796 "*Async Shell Command*"
3786 "*Shell Command Output*"))))) 3797 "*Shell Command Output*")))))
@@ -3792,22 +3803,42 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1."
3792 (if (and (not asynchronous) error-buffer) 3803 (if (and (not asynchronous) error-buffer)
3793 (with-parsed-tramp-file-name default-directory nil 3804 (with-parsed-tramp-file-name default-directory nil
3794 (list output-buffer (tramp-make-tramp-temp-file v))) 3805 (list output-buffer (tramp-make-tramp-temp-file v)))
3795 output-buffer))) 3806 output-buffer))
3796 3807 (proc (get-buffer-process output-buffer)))
3797 (prog1 3808
3798 ;; Run the process. 3809 ;; Check whether there is another process running. Tramp does not
3799 (if (integerp asynchronous) 3810 ;; support 2 (asynchronous) processes in parallel.
3811 (when proc
3812 (if (yes-or-no-p "A command is running. Kill it? ")
3813 (ignore-errors (kill-process proc))
3814 (error "Shell command in progress")))
3815
3816 (with-current-buffer output-buffer
3817 (setq buffer-read-only nil
3818 buffer-undo-list t)
3819 (erase-buffer))
3820
3821 (if (integerp asynchronous)
3822 (prog1
3823 ;; Run the process.
3800 (apply 'start-file-process "*Async Shell*" buffer args) 3824 (apply 'start-file-process "*Async Shell*" buffer args)
3801 (apply 'process-file (car args) nil buffer nil (cdr args))) 3825 ;; Display output.
3802 ;; Insert error messages if they were separated. 3826 (pop-to-buffer output-buffer))
3803 (when (listp buffer) 3827
3804 (with-current-buffer error-buffer (insert-file-contents (cadr buffer))) 3828 (prog1
3805 (delete-file (cadr buffer))) 3829 ;; Run the process.
3806 ;; There's some output, display it. 3830 (apply 'process-file (car args) nil buffer nil (cdr args))
3807 (when (with-current-buffer output-buffer (> (point-max) (point-min))) 3831 ;; Insert error messages if they were separated.
3808 (if (functionp 'display-message-or-buffer) 3832 (when (listp buffer)
3809 (funcall (symbol-function 'display-message-or-buffer) output-buffer) 3833 (with-current-buffer error-buffer
3810 (pop-to-buffer output-buffer)))))) 3834 (insert-file-contents (cadr buffer)))
3835 (delete-file (cadr buffer)))
3836 ;; There's some output, display it.
3837 (when (with-current-buffer output-buffer (> (point-max) (point-min)))
3838 (if (functionp 'display-message-or-buffer)
3839 (funcall (symbol-function 'display-message-or-buffer)
3840 output-buffer)
3841 (pop-to-buffer output-buffer)))))))
3811 3842
3812;; File Editing. 3843;; File Editing.
3813 3844
@@ -5360,22 +5391,14 @@ file exists and nonzero exit status otherwise."
5360 vec 5391 vec
5361 (format "PROMPT_COMMAND='' PS1='$ ' PS2='' PS3='' exec %s" shell) 5392 (format "PROMPT_COMMAND='' PS1='$ ' PS2='' PS3='' exec %s" shell)
5362 t)) 5393 t))
5394 ;; Setting prompts.
5363 (tramp-message vec 5 "Setting remote shell prompt...") 5395 (tramp-message vec 5 "Setting remote shell prompt...")
5364 ;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we 5396 (tramp-send-command vec (format "PS1='%s'" tramp-end-of-output) t)
5365 ;; must use "\n" here, not tramp-rsh-end-of-line. Kai left the
5366 ;; last tramp-rsh-end-of-line, Douglas wanted to replace that,
5367 ;; as well.
5368 (tramp-send-command
5369 vec
5370 (format "PS1='%s%s%s'"
5371 tramp-rsh-end-of-line
5372 tramp-end-of-output
5373 tramp-rsh-end-of-line)
5374 t)
5375 (tramp-send-command vec "PS2=''" t) 5397 (tramp-send-command vec "PS2=''" t)
5376 (tramp-send-command vec "PS3=''" t) 5398 (tramp-send-command vec "PS3=''" t)
5377 (tramp-send-command vec "PROMPT_COMMAND=''" t) 5399 (tramp-send-command vec "PROMPT_COMMAND=''" t)
5378 (tramp-message vec 5 "Setting remote shell prompt...done")) 5400 (tramp-message vec 5 "Setting remote shell prompt...done"))
5401
5379 (t (tramp-message 5402 (t (tramp-message
5380 vec 5 "Remote `%s' groks tilde expansion, good" 5403 vec 5 "Remote `%s' groks tilde expansion, good"
5381 (tramp-get-method-parameter 5404 (tramp-get-method-parameter
@@ -5668,13 +5691,7 @@ process to set up. VEC specifies the connection."
5668 ;; We can set $PS1 to `tramp-end-of-output' only when the echo has 5691 ;; We can set $PS1 to `tramp-end-of-output' only when the echo has
5669 ;; been disabled. Otherwise, the echo of the command would be 5692 ;; been disabled. Otherwise, the echo of the command would be
5670 ;; regarded as prompt already. 5693 ;; regarded as prompt already.
5671 (tramp-send-command 5694 (tramp-send-command vec (format "PS1='%s'" tramp-end-of-output) t)
5672 vec
5673 (format "PS1='%s%s%s'"
5674 tramp-rsh-end-of-line
5675 tramp-end-of-output
5676 tramp-rsh-end-of-line)
5677 t)
5678 (tramp-send-command vec "PS2=''" t) 5695 (tramp-send-command vec "PS2=''" t)
5679 (tramp-send-command vec "PS3=''" t) 5696 (tramp-send-command vec "PS3=''" t)
5680 (tramp-send-command vec "PROMPT_COMMAND=''" t) 5697 (tramp-send-command vec "PROMPT_COMMAND=''" t)
@@ -6059,6 +6076,29 @@ Gateway hops are already opened."
6059 "Method `%s' is not supported for multi-hops." 6076 "Method `%s' is not supported for multi-hops."
6060 (tramp-file-name-method item))))) 6077 (tramp-file-name-method item)))))
6061 6078
6079 ;; In case the host name is not used for the remote shell
6080 ;; command, the user could be misguided by applying a random
6081 ;; hostname.
6082 (let* ((v (car target-alist))
6083 (method (tramp-file-name-method v))
6084 (host (tramp-file-name-host v)))
6085 (unless
6086 (or
6087 ;; There are multi-hops.
6088 (cdr target-alist)
6089 ;; The host name is used for the remote shell command.
6090 (member
6091 '("%h") (tramp-get-method-parameter method 'tramp-login-args))
6092 ;; The host is local. We cannot use `tramp-local-host-p'
6093 ;; here, because it opens a connection as well.
6094 (string-match
6095 (concat "^" (regexp-opt (list "localhost" (system-name)) t) "$")
6096 host))
6097 (tramp-error
6098 v 'file-error
6099 "Host `%s' looks like a remote host, `%s' can only use the local host"
6100 host method)))
6101
6062 ;; Result. 6102 ;; Result.
6063 target-alist)) 6103 target-alist))
6064 6104
@@ -6249,7 +6289,11 @@ function waits for output unless NOOUTPUT is set."
6249 (with-current-buffer (process-buffer proc) 6289 (with-current-buffer (process-buffer proc)
6250 ;; Initially, `tramp-end-of-output' is "$ ". There might be 6290 ;; Initially, `tramp-end-of-output' is "$ ". There might be
6251 ;; leading escape sequences, which must be ignored. 6291 ;; leading escape sequences, which must be ignored.
6252 (let* ((regexp (format "^[^$\n]*%s\r?$" (regexp-quote tramp-end-of-output))) 6292 (let* ((regexp
6293 (if (string-match (regexp-quote "\n") tramp-end-of-output)
6294 (mapconcat
6295 'identity (split-string tramp-end-of-output "\n") "\r?\n")
6296 (format "^[^$\n]*%s\r?$" (regexp-quote tramp-end-of-output))))
6253 (found (tramp-wait-for-regexp proc timeout regexp))) 6297 (found (tramp-wait-for-regexp proc timeout regexp)))
6254 (if found 6298 (if found
6255 (let (buffer-read-only) 6299 (let (buffer-read-only)
@@ -6666,6 +6710,10 @@ values."
6666 (user (match-string (nth 2 tramp-file-name-structure) name)) 6710 (user (match-string (nth 2 tramp-file-name-structure) name))
6667 (host (match-string (nth 3 tramp-file-name-structure) name)) 6711 (host (match-string (nth 3 tramp-file-name-structure) name))
6668 (localname (match-string (nth 4 tramp-file-name-structure) name))) 6712 (localname (match-string (nth 4 tramp-file-name-structure) name)))
6713 (when (member method '("multi" "multiu"))
6714 (error
6715 "`%s' method is no longer supported, see (info \"(tramp)Multi-hops\")"
6716 method))
6669 (if nodefault 6717 (if nodefault
6670 (vector method user host localname) 6718 (vector method user host localname)
6671 (vector 6719 (vector
@@ -6731,11 +6779,20 @@ necessary only. This function will be used in file name completion."
6731 6779
6732(defun tramp-local-host-p (vec) 6780(defun tramp-local-host-p (vec)
6733 "Return t if this points to the local host, nil otherwise." 6781 "Return t if this points to the local host, nil otherwise."
6734 (let ((host (tramp-file-name-real-host vec))) 6782 ;; We cannot use `tramp-file-name-real-host'. A port is an
6783 ;; indication for an ssh tunnel or alike.
6784 (let ((host (tramp-file-name-host vec)))
6735 (and 6785 (and
6736 (stringp host) 6786 (stringp host)
6737 (string-match 6787 (string-match
6738 (concat "^" (regexp-opt (list "localhost" (system-name)) t) "$") host)))) 6788 (concat "^" (regexp-opt (list "localhost" (system-name)) t) "$") host)
6789 ;; The local temp directory must be writable for the other user.
6790 (file-writable-p
6791 (tramp-make-tramp-file-name
6792 (tramp-file-name-method vec)
6793 (tramp-file-name-user vec)
6794 host
6795 (tramp-compat-temporary-file-directory))))))
6739 6796
6740;; Variables local to connection. 6797;; Variables local to connection.
6741 6798
@@ -6831,8 +6888,7 @@ necessary only. This function will be used in file name completion."
6831 vec (format "( %s / -nt / )" (tramp-get-test-command vec))) 6888 vec (format "( %s / -nt / )" (tramp-get-test-command vec)))
6832 (with-current-buffer (tramp-get-buffer vec) 6889 (with-current-buffer (tramp-get-buffer vec)
6833 (goto-char (point-min)) 6890 (goto-char (point-min))
6834 (when (looking-at 6891 (when (looking-at (regexp-quote tramp-end-of-output))
6835 (format "\n%s\r?\n" (regexp-quote tramp-end-of-output)))
6836 (format "%s %%s -nt %%s" (tramp-get-test-command vec))))) 6892 (format "%s %%s -nt %%s" (tramp-get-test-command vec)))))
6837 (progn 6893 (progn
6838 (tramp-send-command 6894 (tramp-send-command
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 689987faff4..4a5525bd0fa 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -2,7 +2,8 @@
2;;; -*- mode: Emacs-Lisp; coding: utf-8; -*- 2;;; -*- mode: Emacs-Lisp; coding: utf-8; -*-
3;;; lisp/trampver.el. Generated from trampver.el.in by configure. 3;;; lisp/trampver.el. Generated from trampver.el.in by configure.
4 4
5;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. 5;; Copyright (C) 2003, 2004, 2005, 2006, 2007,
6;; 2008 Free Software Foundation, Inc.
6 7
7;; Author: Kai Großjohann <kai.grossjohann@gmx.net> 8;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
8;; Keywords: comm, processes 9;; Keywords: comm, processes
@@ -30,14 +31,14 @@
30;; "autoconf && ./configure" to change them. (X)Emacs version check is defined 31;; "autoconf && ./configure" to change them. (X)Emacs version check is defined
31;; in macro AC_EMACS_INFO of aclocal.m4; should be changed only there. 32;; in macro AC_EMACS_INFO of aclocal.m4; should be changed only there.
32 33
33(defconst tramp-version "2.1.12" 34(defconst tramp-version "2.1.13-pre"
34 "This version of Tramp.") 35 "This version of Tramp.")
35 36
36(defconst tramp-bug-report-address "tramp-devel@gnu.org" 37(defconst tramp-bug-report-address "tramp-devel@gnu.org"
37 "Email address to send bug reports to.") 38 "Email address to send bug reports to.")
38 39
39;; Check for (X)Emacs version. 40;; Check for (X)Emacs version.
40(let ((x (if (or (< emacs-major-version 21) (and (featurep 'xemacs) (< emacs-minor-version 4))) (format "Tramp 2.1.12 is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version)))) "ok"))) 41(let ((x (if (or (< emacs-major-version 21) (and (featurep 'xemacs) (< emacs-minor-version 4))) (format "Tramp 2.1.13-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version)))) "ok")))
41 (unless (string-match "\\`ok\\'" x) (error "%s" x))) 42 (unless (string-match "\\`ok\\'" x) (error "%s" x)))
42 43
43(provide 'trampver) 44(provide 'trampver)
diff --git a/lisp/nxml/nxml-enc.el b/lisp/nxml/nxml-enc.el
index 115db17ad70..2210f76ccf5 100644
--- a/lisp/nxml/nxml-enc.el
+++ b/lisp/nxml/nxml-enc.el
@@ -1,6 +1,6 @@
1;;; nxml-enc.el --- XML encoding auto-detection 1;;; nxml-enc.el --- XML encoding auto-detection
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML 6;; Keywords: XML
diff --git a/lisp/nxml/nxml-glyph.el b/lisp/nxml/nxml-glyph.el
index 47d7086f246..8e608a32fdc 100644
--- a/lisp/nxml/nxml-glyph.el
+++ b/lisp/nxml/nxml-glyph.el
@@ -1,6 +1,6 @@
1;;; nxml-glyph.el --- glyph-handling for nxml-mode 1;;; nxml-glyph.el --- glyph-handling for nxml-mode
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML 6;; Keywords: XML
diff --git a/lisp/nxml/nxml-maint.el b/lisp/nxml/nxml-maint.el
index 7df2bc99f35..d9ba6fff90a 100644
--- a/lisp/nxml/nxml-maint.el
+++ b/lisp/nxml/nxml-maint.el
@@ -1,6 +1,6 @@
1;;; nxml-maint.el --- commands for maintainers of nxml-*.el 1;;; nxml-maint.el --- commands for maintainers of nxml-*.el
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML 6;; Keywords: XML
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index 973197242f3..11fadedd531 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -1,6 +1,6 @@
1;;; nxml-mode.el --- a new XML mode 1;;; nxml-mode.el --- a new XML mode
2 2
3;; Copyright (C) 2003, 2004, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2004, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML 6;; Keywords: XML
@@ -24,8 +24,6 @@
24 24
25;;; Commentary: 25;;; Commentary:
26 26
27;; To use this include rng-auto.el in your .emacs.
28
29;; See nxml-rap.el for description of parsing strategy. 27;; See nxml-rap.el for description of parsing strategy.
30 28
31;; The font locking here is independent of font-lock.el. We want to 29;; The font locking here is independent of font-lock.el. We want to
@@ -45,6 +43,9 @@
45(require 'nxml-rap) 43(require 'nxml-rap)
46(require 'nxml-outln) 44(require 'nxml-outln)
47 45
46(declare-function rng-nxml-mode-init "rng-nxml")
47(declare-function nxml-enable-unicode-char-name-sets "nxml-uchnm")
48
48;;; Customization 49;;; Customization
49 50
50(defgroup nxml nil 51(defgroup nxml nil
@@ -479,9 +480,9 @@ instead of C-c.
479Validation is provided by the related minor-mode `rng-validate-mode'. 480Validation is provided by the related minor-mode `rng-validate-mode'.
480This also makes completion schema- and context- sensitive. Element 481This also makes completion schema- and context- sensitive. Element
481names, attribute names, attribute values and namespace URIs can all be 482names, attribute names, attribute values and namespace URIs can all be
482completed. By default, `rng-validate-mode' is automatically enabled by 483completed. By default, `rng-validate-mode' is automatically enabled. You
483`rng-nxml-mode-init' which is normally added to `nxml-mode-hook'. You 484can toggle it using \\[rng-validate-mode] or change the default by
484can toggle it using \\[rng-validate-mode]. 485customizing `rng-nxml-auto-validate-flag'.
485 486
486\\[indent-for-tab-command] indents the current line appropriately. 487\\[indent-for-tab-command] indents the current line appropriately.
487This can be customized using the variable `nxml-child-indent' 488This can be customized using the variable `nxml-child-indent'
@@ -509,6 +510,7 @@ Many aspects this mode can be customized using
509 (kill-all-local-variables) 510 (kill-all-local-variables)
510 (setq major-mode 'nxml-mode) 511 (setq major-mode 'nxml-mode)
511 (setq mode-name "nXML") 512 (setq mode-name "nXML")
513 (set (make-local-variable 'mode-line-process) '((nxml-degraded "/degraded")))
512 ;; We'll determine the fill prefix ourselves 514 ;; We'll determine the fill prefix ourselves
513 (make-local-variable 'adaptive-fill-mode) 515 (make-local-variable 'adaptive-fill-mode)
514 (setq adaptive-fill-mode nil) 516 (setq adaptive-fill-mode nil)
@@ -555,6 +557,8 @@ Many aspects this mode can be customized using
555 (setq buffer-file-coding-system nxml-default-buffer-file-coding-system)) 557 (setq buffer-file-coding-system nxml-default-buffer-file-coding-system))
556 (when nxml-auto-insert-xml-declaration-flag 558 (when nxml-auto-insert-xml-declaration-flag
557 (nxml-insert-xml-declaration))) 559 (nxml-insert-xml-declaration)))
560 (rng-nxml-mode-init)
561 (nxml-enable-unicode-char-name-sets)
558 (run-hooks 'nxml-mode-hook)) 562 (run-hooks 'nxml-mode-hook))
559 563
560(defun nxml-degrade (context err) 564(defun nxml-degrade (context err)
@@ -570,8 +574,7 @@ Many aspects this mode can be customized using
570 (nxml-with-unmodifying-text-property-changes 574 (nxml-with-unmodifying-text-property-changes
571 (nxml-clear-face (point-min) (point-max)) 575 (nxml-clear-face (point-min) (point-max))
572 (nxml-set-fontified (point-min) (point-max)) 576 (nxml-set-fontified (point-min) (point-max))
573 (nxml-clear-inside (point-min) (point-max))) 577 (nxml-clear-inside (point-min) (point-max))))))
574 (setq mode-name "nXML/degraded"))))
575 578
576;;; Change management 579;;; Change management
577 580
@@ -2433,7 +2436,7 @@ and attempts to find another possible way to do the markup."
2433 2436
2434;;; Character names 2437;;; Character names
2435 2438
2436(defvar nxml-char-name-ignore-case nil) 2439(defvar nxml-char-name-ignore-case t)
2437 2440
2438(defvar nxml-char-name-alist nil 2441(defvar nxml-char-name-alist nil
2439 "Alist of character names. 2442 "Alist of character names.
diff --git a/lisp/nxml/nxml-ns.el b/lisp/nxml/nxml-ns.el
index 0d1b1543b45..f9f5656211d 100644
--- a/lisp/nxml/nxml-ns.el
+++ b/lisp/nxml/nxml-ns.el
@@ -1,6 +1,6 @@
1;;; nxml-ns.el --- XML namespace processing 1;;; nxml-ns.el --- XML namespace processing
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML 6;; Keywords: XML
diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el
index 96d8cebf5dc..3363daae15b 100644
--- a/lisp/nxml/nxml-outln.el
+++ b/lisp/nxml/nxml-outln.el
@@ -1,6 +1,6 @@
1;;; nxml-outln.el --- outline support for nXML mode 1;;; nxml-outln.el --- outline support for nXML mode
2 2
3;; Copyright (C) 2004, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2004, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML 6;; Keywords: XML
diff --git a/lisp/nxml/nxml-parse.el b/lisp/nxml/nxml-parse.el
index 267c18cf887..bad7710a3d5 100644
--- a/lisp/nxml/nxml-parse.el
+++ b/lisp/nxml/nxml-parse.el
@@ -1,6 +1,6 @@
1;;; nxml-parse.el --- XML parser, sharing infrastructure with nxml-mode 1;;; nxml-parse.el --- XML parser, sharing infrastructure with nxml-mode
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML 6;; Keywords: XML
diff --git a/lisp/nxml/nxml-rap.el b/lisp/nxml/nxml-rap.el
index 907812be4cb..095fe11ff44 100644
--- a/lisp/nxml/nxml-rap.el
+++ b/lisp/nxml/nxml-rap.el
@@ -1,6 +1,6 @@
1;;; nxml-rap.el --- low-level support for random access parsing for nXML mode 1;;; nxml-rap.el --- low-level support for random access parsing for nXML mode
2 2
3;; Copyright (C) 2003, 2004, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2004, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML 6;; Keywords: XML
diff --git a/lisp/nxml/nxml-uchnm.el b/lisp/nxml/nxml-uchnm.el
index 9514a7de476..09ae310403d 100644
--- a/lisp/nxml/nxml-uchnm.el
+++ b/lisp/nxml/nxml-uchnm.el
@@ -1,6 +1,6 @@
1;;; nxml-uchnm.el --- support for Unicode standard cha names in nxml-mode 1;;; nxml-uchnm.el --- support for Unicode standard cha names in nxml-mode
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML 6;; Keywords: XML
@@ -28,9 +28,6 @@
28;; Standard. The use of the names can be controlled on a per-block 28;; Standard. The use of the names can be controlled on a per-block
29;; basis, so as both to reduce memory usage and loading time, 29;; basis, so as both to reduce memory usage and loading time,
30;; and to make completion work better. 30;; and to make completion work better.
31;; The main entry point is `nxml-enable-unicode-char-name-sets'. Typically,
32;; this is added to `nxml-mode-hook' (rng-auto.el does this already).
33;; To customize the blocks for which names are used
34 31
35;;; Code: 32;;; Code:
36 33
@@ -213,7 +210,9 @@ by a hyphen."
213 data-directory))) 210 data-directory)))
214 nxml-unicode-blocks) 211 nxml-unicode-blocks)
215 212
216(defvar nxml-enable-unicode-char-name-sets-flag nil) 213;; Internal flag to control whether customize reloads the character tables.
214;; Should be set the first time the
215(defvar nxml-internal-unicode-char-name-sets-enabled nil)
217 216
218(defcustom nxml-enabled-unicode-blocks nxml-enabled-unicode-blocks-default 217(defcustom nxml-enabled-unicode-blocks nxml-enabled-unicode-blocks-default
219 "List of Unicode blocks for which Unicode character names are enabled. 218 "List of Unicode blocks for which Unicode character names are enabled.
@@ -222,8 +221,8 @@ of the block by downcasing and replacing each space by a hyphen."
222 :group 'nxml 221 :group 'nxml
223 :set (lambda (sym value) 222 :set (lambda (sym value)
224 (set-default 'nxml-enabled-unicode-blocks value) 223 (set-default 'nxml-enabled-unicode-blocks value)
225 (when nxml-enable-unicode-char-name-sets-flag 224 (when nxml-internal-unicode-char-name-sets-enabled
226 (nxml-enable-unicode-char-name-sets-1))) 225 (nxml-enable-unicode-char-name-sets)))
227 :type (cons 'set 226 :type (cons 'set
228 (mapcar (lambda (block) 227 (mapcar (lambda (block)
229 `(const :tag ,(format "%s (%04X-%04X)" 228 `(const :tag ,(format "%s (%04X-%04X)"
@@ -240,11 +239,7 @@ of the block by downcasing and replacing each space by a hyphen."
240The Unicode blocks for which names are enabled is controlled by 239The Unicode blocks for which names are enabled is controlled by
241the variable `nxml-enabled-unicode-blocks'." 240the variable `nxml-enabled-unicode-blocks'."
242 (interactive) 241 (interactive)
243 (setq nxml-char-name-ignore-case t) 242 (setq nxml-internal-unicode-char-name-sets-enabled t)
244 (setq nxml-enable-unicode-char-name-sets-flag t)
245 (nxml-enable-unicode-char-name-sets-1))
246
247(defun nxml-enable-unicode-char-name-sets-1 ()
248 (mapc (lambda (block) 243 (mapc (lambda (block)
249 (nxml-disable-char-name-set 244 (nxml-disable-char-name-set
250 (nxml-unicode-block-char-name-set (car block)))) 245 (nxml-unicode-block-char-name-set (car block))))
diff --git a/lisp/nxml/nxml-util.el b/lisp/nxml/nxml-util.el
index 73b8354ddf6..7ea52f34fde 100644
--- a/lisp/nxml/nxml-util.el
+++ b/lisp/nxml/nxml-util.el
@@ -1,6 +1,6 @@
1;;; nxml-util.el --- utility functions for nxml-*.el 1;;; nxml-util.el --- utility functions for nxml-*.el
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML 6;; Keywords: XML
diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el
index a83af6ad077..a1915b1d7fe 100644
--- a/lisp/nxml/rng-cmpct.el
+++ b/lisp/nxml/rng-cmpct.el
@@ -1,6 +1,6 @@
1;;; rng-cmpct.el --- parsing of RELAX NG Compact Syntax schemas 1;;; rng-cmpct.el --- parsing of RELAX NG Compact Syntax schemas
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML, RelaxNG 6;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/rng-dt.el b/lisp/nxml/rng-dt.el
index 2ed8e19c7d9..700c53407d4 100644
--- a/lisp/nxml/rng-dt.el
+++ b/lisp/nxml/rng-dt.el
@@ -1,6 +1,6 @@
1;;; rng-dt.el --- datatype library interface for RELAX NG 1;;; rng-dt.el --- datatype library interface for RELAX NG
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML, RelaxNG 6;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/rng-loc.el b/lisp/nxml/rng-loc.el
index 5646a262068..bae99ff8be6 100644
--- a/lisp/nxml/rng-loc.el
+++ b/lisp/nxml/rng-loc.el
@@ -1,6 +1,6 @@
1;;; rng-loc.el --- locate the schema to use for validation 1;;; rng-loc.el --- locate the schema to use for validation
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML, RelaxNG 6;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/rng-maint.el b/lisp/nxml/rng-maint.el
index d535c45691a..e273a536156 100644
--- a/lisp/nxml/rng-maint.el
+++ b/lisp/nxml/rng-maint.el
@@ -1,6 +1,6 @@
1;;; rng-maint.el --- commands for RELAX NG maintainers 1;;; rng-maint.el --- commands for RELAX NG maintainers
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML, RelaxNG 6;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/rng-match.el b/lisp/nxml/rng-match.el
index eb79d999634..1f7501d9f2a 100644
--- a/lisp/nxml/rng-match.el
+++ b/lisp/nxml/rng-match.el
@@ -1,6 +1,6 @@
1;;; rng-match.el --- matching of RELAX NG patterns against XML events 1;;; rng-match.el --- matching of RELAX NG patterns against XML events
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML, RelaxNG 6;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el
index 5b3f2a7baf8..083c637876b 100644
--- a/lisp/nxml/rng-nxml.el
+++ b/lisp/nxml/rng-nxml.el
@@ -1,6 +1,6 @@
1;;; rng-nxml.el --- make nxml-mode take advantage of rng-validate-mode 1;;; rng-nxml.el --- make nxml-mode take advantage of rng-validate-mode
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML, RelaxNG 6;; Keywords: XML, RelaxNG
@@ -41,10 +41,12 @@
41 :type 'boolean 41 :type 'boolean
42 :group 'relax-ng) 42 :group 'relax-ng)
43 43
44(defvar rng-preferred-prefix-alist-default nil 44(defcustom rng-preferred-prefix-alist
45 "Default value for variable `rng-preferred-prefix-alist'.") 45 '(("http://www.w3.org/1999/XSL/Transform" . "xsl")
46 46 ("http://www.w3.org/1999/02/22-rdf-syntax-ns#" . "rdf")
47(defcustom rng-preferred-prefix-alist rng-preferred-prefix-alist-default 47 ("http://www.w3.org/1999/xlink" . "xlink")
48 ("http://www.w3.org/2001/XmlSchema" . "xsd")
49 ("http://www.w3.org/2001/XMLSchema-instance" . "xsi"))
48 "*Alist of namespaces vs preferred prefixes." 50 "*Alist of namespaces vs preferred prefixes."
49 :type '(repeat (cons :tag "With" 51 :type '(repeat (cons :tag "With"
50 (string :tag "this namespace URI") 52 (string :tag "this namespace URI")
@@ -100,8 +102,9 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil."
100 (easy-menu-define rng-nxml-menu nxml-mode-map 102 (easy-menu-define rng-nxml-menu nxml-mode-map
101 "Menu for nxml-mode used with rng-validate-mode." 103 "Menu for nxml-mode used with rng-validate-mode."
102 rng-nxml-easy-menu) 104 rng-nxml-easy-menu)
103 (setq mode-line-process 105 (add-to-list 'mode-line-process
104 '(rng-validate-mode (:eval (rng-compute-mode-line-string)))) 106 '(rng-validate-mode (:eval (rng-compute-mode-line-string)))
107 'append)
105 (cond (rng-nxml-auto-validate-flag 108 (cond (rng-nxml-auto-validate-flag
106 (rng-validate-mode 1) 109 (rng-validate-mode 1)
107 (add-hook 'nxml-completion-hook 'rng-complete nil t) 110 (add-hook 'nxml-completion-hook 'rng-complete nil t)
diff --git a/lisp/nxml/rng-parse.el b/lisp/nxml/rng-parse.el
index e9d10e03f21..bf8df6314db 100644
--- a/lisp/nxml/rng-parse.el
+++ b/lisp/nxml/rng-parse.el
@@ -1,6 +1,6 @@
1;;; rng-parse.el --- parse an XML file and validate it against a schema 1;;; rng-parse.el --- parse an XML file and validate it against a schema
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML, RelaxNG 6;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/rng-pttrn.el b/lisp/nxml/rng-pttrn.el
index 2ed87943160..bbf28b2b516 100644
--- a/lisp/nxml/rng-pttrn.el
+++ b/lisp/nxml/rng-pttrn.el
@@ -1,6 +1,6 @@
1;;; rng-pttrn.el --- RELAX NG patterns 1;;; rng-pttrn.el --- RELAX NG patterns
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML, RelaxNG 6;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el
index f18012abcfe..8f454213c12 100644
--- a/lisp/nxml/rng-uri.el
+++ b/lisp/nxml/rng-uri.el
@@ -1,6 +1,6 @@
1;;; rng-uri.el --- URI parsing and manipulation 1;;; rng-uri.el --- URI parsing and manipulation
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML 6;; Keywords: XML
diff --git a/lisp/nxml/rng-util.el b/lisp/nxml/rng-util.el
index 7ae75f8a607..545ad425fdf 100644
--- a/lisp/nxml/rng-util.el
+++ b/lisp/nxml/rng-util.el
@@ -1,6 +1,6 @@
1;;; rng-util.el --- utility functions for RELAX NG library 1;;; rng-util.el --- utility functions for RELAX NG library
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML, RelaxNG 6;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el
index 9b6500e002a..3df0e0e30d2 100644
--- a/lisp/nxml/rng-valid.el
+++ b/lisp/nxml/rng-valid.el
@@ -1,6 +1,6 @@
1;;; rng-valid.el --- real-time validation of XML using RELAX NG 1;;; rng-valid.el --- real-time validation of XML using RELAX NG
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML, RelaxNG 6;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/rng-xsd.el b/lisp/nxml/rng-xsd.el
index 782627c4205..bc9e8a9538e 100644
--- a/lisp/nxml/rng-xsd.el
+++ b/lisp/nxml/rng-xsd.el
@@ -1,6 +1,6 @@
1;;; rng-xsd.el --- W3C XML Schema datatypes library for RELAX NG 1;;; rng-xsd.el --- W3C XML Schema datatypes library for RELAX NG
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML, RelaxNG 6;; Keywords: XML, RelaxNG
diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el
index add55bf9840..2fa741c8832 100644
--- a/lisp/nxml/xmltok.el
+++ b/lisp/nxml/xmltok.el
@@ -1,6 +1,6 @@
1;;; xmltok.el --- XML tokenization 1;;; xmltok.el --- XML tokenization
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML 6;; Keywords: XML
diff --git a/lisp/nxml/xsd-regexp.el b/lisp/nxml/xsd-regexp.el
index a698ce71e60..185be58388d 100644
--- a/lisp/nxml/xsd-regexp.el
+++ b/lisp/nxml/xsd-regexp.el
@@ -1,6 +1,6 @@
1;;; xsd-regexp.el --- translate W3C XML Schema regexps to Emacs regexps 1;;; xsd-regexp.el --- translate W3C XML Schema regexps to Emacs regexps
2 2
3;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: James Clark 5;; Author: James Clark
6;; Keywords: XML, regexp 6;; Keywords: XML, regexp
diff --git a/lisp/whitespace.el b/lisp/obsolete/whitespace.el
index 3afa2246d45..b2ef06c9584 100644
--- a/lisp/whitespace.el
+++ b/lisp/obsolete/whitespace.el
@@ -159,21 +159,21 @@ visited by the buffers.")
159 159
160(defcustom whitespace-check-leading-whitespace t 160(defcustom whitespace-check-leading-whitespace t
161 "Flag to check leading whitespace. This is the global for the system. 161 "Flag to check leading whitespace. This is the global for the system.
162It can be overriden by setting a buffer local variable 162It can be overridden by setting a buffer local variable
163`whitespace-check-buffer-leading'." 163`whitespace-check-buffer-leading'."
164 :type 'boolean 164 :type 'boolean
165 :group 'whitespace) 165 :group 'whitespace)
166 166
167(defcustom whitespace-check-trailing-whitespace t 167(defcustom whitespace-check-trailing-whitespace t
168 "Flag to check trailing whitespace. This is the global for the system. 168 "Flag to check trailing whitespace. This is the global for the system.
169It can be overriden by setting a buffer local variable 169It can be overridden by setting a buffer local variable
170`whitespace-check-buffer-trailing'." 170`whitespace-check-buffer-trailing'."
171 :type 'boolean 171 :type 'boolean
172 :group 'whitespace) 172 :group 'whitespace)
173 173
174(defcustom whitespace-check-spacetab-whitespace t 174(defcustom whitespace-check-spacetab-whitespace t
175 "Flag to check space followed by a TAB. This is the global for the system. 175 "Flag to check space followed by a TAB. This is the global for the system.
176It can be overriden by setting a buffer local variable 176It can be overridden by setting a buffer local variable
177`whitespace-check-buffer-spacetab'." 177`whitespace-check-buffer-spacetab'."
178 :type 'boolean 178 :type 'boolean
179 :group 'whitespace) 179 :group 'whitespace)
@@ -185,7 +185,7 @@ It can be overriden by setting a buffer local variable
185 185
186(defcustom whitespace-check-indent-whitespace indent-tabs-mode 186(defcustom whitespace-check-indent-whitespace indent-tabs-mode
187 "Flag to check indentation whitespace. This is the global for the system. 187 "Flag to check indentation whitespace. This is the global for the system.
188It can be overriden by setting a buffer local variable 188It can be overridden by setting a buffer local variable
189`whitespace-check-buffer-indent'." 189`whitespace-check-buffer-indent'."
190 :type 'boolean 190 :type 'boolean
191 :group 'whitespace) 191 :group 'whitespace)
@@ -198,7 +198,7 @@ The default value ignores leading TABs."
198 198
199(defcustom whitespace-check-ateol-whitespace t 199(defcustom whitespace-check-ateol-whitespace t
200 "Flag to check end-of-line whitespace. This is the global for the system. 200 "Flag to check end-of-line whitespace. This is the global for the system.
201It can be overriden by setting a buffer local variable 201It can be overridden by setting a buffer local variable
202`whitespace-check-buffer-ateol'." 202`whitespace-check-buffer-ateol'."
203 :type 'boolean 203 :type 'boolean
204 :group 'whitespace) 204 :group 'whitespace)
diff --git a/lisp/outline.el b/lisp/outline.el
index f075a474810..40340e10f42 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -971,8 +971,8 @@ If INVISIBLE-OK is non-nil, also consider invisible lines."
971 (or (eq last-command 'outline-up-heading) (push-mark))) 971 (or (eq last-command 'outline-up-heading) (push-mark)))
972 (outline-back-to-heading invisible-ok) 972 (outline-back-to-heading invisible-ok)
973 (let ((start-level (funcall outline-level))) 973 (let ((start-level (funcall outline-level)))
974 (if (eq start-level 1) 974 (when (<= start-level 1)
975 (error "Already at top level of the outline")) 975 (error "Already at top level of the outline"))
976 (while (and (> start-level 1) (> arg 0) (not (bobp))) 976 (while (and (> start-level 1) (> arg 0) (not (bobp)))
977 (let ((level start-level)) 977 (let ((level start-level))
978 (while (not (or (< level start-level) (bobp))) 978 (while (not (or (< level start-level) (bobp)))
diff --git a/lisp/password-cache.el b/lisp/password-cache.el
index eeaa31b9a31..e937c45a8b6 100644
--- a/lisp/password-cache.el
+++ b/lisp/password-cache.el
@@ -1,6 +1,6 @@
1;;; password-cache.el --- Read passwords, possibly using a password cache. 1;;; password-cache.el --- Read passwords, possibly using a password cache.
2 2
3;; Copyright (C) 1999, 2000, 2003, 2004, 2005, 2006, 2007 3;; Copyright (C) 1999, 2000, 2003, 2004, 2005, 2006, 2007, 2008
4;; Free Software Foundation, Inc. 4;; Free Software Foundation, Inc.
5 5
6;; Author: Simon Josefsson <simon@josefsson.org> 6;; Author: Simon Josefsson <simon@josefsson.org>
diff --git a/lisp/pcvs-defs.el b/lisp/pcvs-defs.el
index fa6f2b1c050..a4e7fde0f51 100644
--- a/lisp/pcvs-defs.el
+++ b/lisp/pcvs-defs.el
@@ -404,8 +404,8 @@ This variable is buffer local and only used in the *cvs* buffer.")
404 404
405(easy-menu-define cvs-menu cvs-mode-map "Menu used in `cvs-mode'." 405(easy-menu-define cvs-menu cvs-mode-map "Menu used in `cvs-mode'."
406 '("CVS" 406 '("CVS"
407 ["Open file.." cvs-mode-find-file t] 407 ["Open file" cvs-mode-find-file t]
408 [" ..other window" cvs-mode-find-file-other-window t] 408 ["Open in other window" cvs-mode-find-file-other-window t]
409 ["Display in other window" cvs-mode-display-file t] 409 ["Display in other window" cvs-mode-display-file t]
410 ["Interactive merge" cvs-mode-imerge t] 410 ["Interactive merge" cvs-mode-imerge t]
411 ("View diff" 411 ("View diff"
@@ -413,6 +413,7 @@ This variable is buffer local and only used in the *cvs* buffer.")
413 ["Current diff" cvs-mode-diff t] 413 ["Current diff" cvs-mode-diff t]
414 ["Diff with head" cvs-mode-diff-head t] 414 ["Diff with head" cvs-mode-diff-head t]
415 ["Diff with vendor" cvs-mode-diff-vendor t] 415 ["Diff with vendor" cvs-mode-diff-vendor t]
416 ["Diff against yesterday" cvs-mode-diff-yesterday t]
416 ["Diff with backup" cvs-mode-diff-backup t]) 417 ["Diff with backup" cvs-mode-diff-backup t])
417 ["View log" cvs-mode-log t] 418 ["View log" cvs-mode-log t]
418 ["View status" cvs-mode-status t] 419 ["View status" cvs-mode-status t]
@@ -437,6 +438,9 @@ This variable is buffer local and only used in the *cvs* buffer.")
437 ["Unmark all" cvs-mode-unmark-all-files t] 438 ["Unmark all" cvs-mode-unmark-all-files t]
438 ["Hide handled" cvs-mode-remove-handled t] 439 ["Hide handled" cvs-mode-remove-handled t]
439 "----" 440 "----"
441 ["PCL-CVS Manual" (lambda () (interactive)
442 (info "(pcl-cvs)Top")) t]
443 "----"
440 ["Quit" cvs-mode-quit t])) 444 ["Quit" cvs-mode-quit t]))
441 445
442;;;; 446;;;;
diff --git a/lisp/pcvs.el b/lisp/pcvs.el
index c4a7f67d930..462597a277b 100644
--- a/lisp/pcvs.el
+++ b/lisp/pcvs.el
@@ -2311,7 +2311,7 @@ this file, or a list of arguments to send to the program."
2311 ;; do want to reset the mode for VC, so we do it explicitly. 2311 ;; do want to reset the mode for VC, so we do it explicitly.
2312 (vc-find-file-hook) 2312 (vc-find-file-hook)
2313 (when (eq (cvs-fileinfo->type fileinfo) 'CONFLICT) 2313 (when (eq (cvs-fileinfo->type fileinfo) 'CONFLICT)
2314 (smerge-mode 1)))))))) 2314 (smerge-start-session))))))))
2315 2315
2316 2316
2317(defun cvs-change-cvsroot (newroot) 2317(defun cvs-change-cvsroot (newroot)
diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el
index e54dad675a8..f8ed471beb7 100644
--- a/lisp/play/blackbox.el
+++ b/lisp/play/blackbox.el
@@ -106,7 +106,9 @@
106 (blackbox-redefine-key map 'move-end-of-line 'bb-eol) 106 (blackbox-redefine-key map 'move-end-of-line 'bb-eol)
107 (blackbox-redefine-key map 'move-beginning-of-line 'bb-bol) 107 (blackbox-redefine-key map 'move-beginning-of-line 'bb-bol)
108 (define-key map " " 'bb-romp) 108 (define-key map " " 'bb-romp)
109 (define-key map "q" 'bury-buffer)
109 (define-key map [insert] 'bb-romp) 110 (define-key map [insert] 'bb-romp)
111 (define-key map [return] 'bb-done)
110 (blackbox-redefine-key map 'newline 'bb-done) 112 (blackbox-redefine-key map 'newline 'bb-done)
111 map)) 113 map))
112 114
diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el
index 5f8709d17b7..b4997ce4d57 100644
--- a/lisp/play/bubbles.el
+++ b/lisp/play/bubbles.el
@@ -1,6 +1,6 @@
1;;; bubbles.el --- Puzzle game for Emacs. 1;;; bubbles.el --- Puzzle game for Emacs.
2 2
3;; Copyright (C) 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: Ulf Jasper <ulf.jasper@web.de> 5;; Author: Ulf Jasper <ulf.jasper@web.de>
6;; URL: http://ulf.epplejasper.de/ 6;; URL: http://ulf.epplejasper.de/
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index 2c3acdda176..39e66b049c0 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -930,7 +930,8 @@ are treated as numbers instead of gnatprep comments."
930 (buffer-undo-list t) 930 (buffer-undo-list t)
931 (inhibit-read-only t) 931 (inhibit-read-only t)
932 (inhibit-point-motion-hooks t) 932 (inhibit-point-motion-hooks t)
933 (inhibit-modification-hooks t)) 933 (inhibit-modification-hooks t)
934 buffer-file-name buffer-file-truename)
934 (remove-text-properties (point-min) (point-max) '(syntax-table nil)) 935 (remove-text-properties (point-min) (point-max) '(syntax-table nil))
935 (goto-char (point-min)) 936 (goto-char (point-min))
936 (while (re-search-forward 937 (while (re-search-forward
@@ -4954,11 +4955,11 @@ The paragraph is indented on the first line."
4954;; cursor at the correct position. 4955;; cursor at the correct position.
4955;; Standard Ada does not force any relation between unit names and file names, 4956;; Standard Ada does not force any relation between unit names and file names,
4956;; so some of these functions can only be a good approximation. However, they 4957;; so some of these functions can only be a good approximation. However, they
4957;; are also overriden in `ada-xref'.el when we know that the user is using 4958;; are also overridden in `ada-xref'.el when we know that the user is using
4958;; GNAT. 4959;; GNAT.
4959;; --------------------------------------------------- 4960;; ---------------------------------------------------
4960 4961
4961;; Overriden when we work with GNAT, to use gnatkrunch 4962;; Overridden when we work with GNAT, to use gnatkrunch
4962(defun ada-make-filename-from-adaname (adaname) 4963(defun ada-make-filename-from-adaname (adaname)
4963 "Determine the filename in which ADANAME is found. 4964 "Determine the filename in which ADANAME is found.
4964This matches the GNAT default naming convention, except for 4965This matches the GNAT default naming convention, except for
diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el
index f9b5c026a4e..c63850ee5be 100644
--- a/lisp/progmodes/ada-xref.el
+++ b/lisp/progmodes/ada-xref.el
@@ -617,7 +617,7 @@ If NO-USER-QUESTION, don't prompt user for file. Call
617 617
618(defun ada-convert-file-name (name) 618(defun ada-convert-file-name (name)
619 "Convert from NAME to a name that can be used by the compilation commands. 619 "Convert from NAME to a name that can be used by the compilation commands.
620This is overriden on VMS to convert from VMS filenames to Unix filenames." 620This is overridden on VMS to convert from VMS filenames to Unix filenames."
621 name) 621 name)
622;; FIXME: use convert-standard-filename instead 622;; FIXME: use convert-standard-filename instead
623 623
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index d9a70558697..b361585422a 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -478,7 +478,7 @@
478 478
479(defun c-awk-get-NL-prop-prev-line (&optional do-lim) 479(defun c-awk-get-NL-prop-prev-line (&optional do-lim)
480 ;; Get the c-awk-NL-prop text-property from the previous line, calculating 480 ;; Get the c-awk-NL-prop text-property from the previous line, calculating
481 ;; it if necessary. Return nil if we're at BOB. 481 ;; it if necessary. Return nil if we're already at BOB.
482 ;; See c-awk-after-if-for-while-condition-p for a description of DO-LIM. 482 ;; See c-awk-after-if-for-while-condition-p for a description of DO-LIM.
483 ;; 483 ;;
484 ;; This function might do hidden buffer changes. 484 ;; This function might do hidden buffer changes.
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index 8d3facb08b6..1a2ee3f0ce5 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -524,7 +524,11 @@ inside a literal or a macro, nothing special happens."
524 ;; This is the list of brace syntactic symbols that can hang. 524 ;; This is the list of brace syntactic symbols that can hang.
525 ;; If any new ones are added to c-offsets-alist, they should be 525 ;; If any new ones are added to c-offsets-alist, they should be
526 ;; added here as well. 526 ;; added here as well.
527 '(class-open class-close defun-open defun-close 527 ;;
528 ;; The order of this list is important; if SYNTAX has several
529 ;; elements, the element that "wins" is the earliest in SYMS.
530 '(arglist-cont-nonempty ; e.g. an array literal.
531 class-open class-close defun-open defun-close
528 inline-open inline-close 532 inline-open inline-close
529 brace-list-open brace-list-close 533 brace-list-open brace-list-close
530 brace-list-intro brace-entry-open 534 brace-list-intro brace-entry-open
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 288aca687aa..2d4cc982714 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -96,7 +96,7 @@
96 96
97;;; Variables also used at compile time. 97;;; Variables also used at compile time.
98 98
99(defconst c-version "5.31.4" 99(defconst c-version "5.31.5"
100 "CC Mode version number.") 100 "CC Mode version number.")
101 101
102(defconst c-version-sym (intern c-version)) 102(defconst c-version-sym (intern c-version))
@@ -425,6 +425,8 @@ The return value is the value of the last form in BODY."
425 (inhibit-read-only t) (inhibit-point-motion-hooks t) 425 (inhibit-read-only t) (inhibit-point-motion-hooks t)
426 before-change-functions after-change-functions 426 before-change-functions after-change-functions
427 deactivate-mark 427 deactivate-mark
428 buffer-file-name buffer-file-truename ; Prevent primitives checking
429 ; for file modification
428 ,@varlist) 430 ,@varlist)
429 (unwind-protect 431 (unwind-protect
430 (progn ,@body) 432 (progn ,@body)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 7cac158166e..48bbcaf18cf 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -5094,7 +5094,8 @@ comment at the start of cc-engine.el for more info."
5094 ;; 5094 ;;
5095 ;; The point is left at the first token after the first complete 5095 ;; The point is left at the first token after the first complete
5096 ;; declarator, if there is one. The return value is a cons where 5096 ;; declarator, if there is one. The return value is a cons where
5097 ;; the car is the position of the first token in the declarator. 5097 ;; the car is the position of the first token in the declarator. (See
5098 ;; below for the cdr.)
5098 ;; Some examples: 5099 ;; Some examples:
5099 ;; 5100 ;;
5100 ;; void foo (int a, char *b) stuff ... 5101 ;; void foo (int a, char *b) stuff ...
@@ -5118,9 +5119,9 @@ comment at the start of cc-engine.el for more info."
5118 ;; Foo::Foo (int b) : Base (b) {} 5119 ;; Foo::Foo (int b) : Base (b) {}
5119 ;; car ^ ^ point 5120 ;; car ^ ^ point
5120 ;; 5121 ;;
5121 ;; The cdr of the return value is non-nil if a 5122 ;; The cdr of the return value is non-nil iff a `c-typedef-decl-kwds'
5122 ;; `c-typedef-decl-kwds' specifier is found in the declaration, 5123 ;; specifier (e.g. class, struct, enum, typedef) is found in the
5123 ;; i.e. the declared identifier(s) are types. 5124 ;; declaration, i.e. the declared identifier(s) are types.
5124 ;; 5125 ;;
5125 ;; If a cast is parsed: 5126 ;; If a cast is parsed:
5126 ;; 5127 ;;
@@ -5135,7 +5136,7 @@ comment at the start of cc-engine.el for more info."
5135 ;; the first token in (the visible part of) the buffer. 5136 ;; the first token in (the visible part of) the buffer.
5136 ;; 5137 ;;
5137 ;; CONTEXT is a symbol that describes the context at the point: 5138 ;; CONTEXT is a symbol that describes the context at the point:
5138 ;; 'decl In a comma-separatded declaration context (typically 5139 ;; 'decl In a comma-separated declaration context (typically
5139 ;; inside a function declaration arglist). 5140 ;; inside a function declaration arglist).
5140 ;; '<> In an angle bracket arglist. 5141 ;; '<> In an angle bracket arglist.
5141 ;; 'arglist Some other type of arglist. 5142 ;; 'arglist Some other type of arglist.
@@ -8032,12 +8033,15 @@ comment at the start of cc-engine.el for more info."
8032 8033
8033 ;; CASE 5A.5: ordinary defun open 8034 ;; CASE 5A.5: ordinary defun open
8034 (t 8035 (t
8035 (goto-char placeholder) 8036 (save-excursion
8036 (if (or containing-decl-open macro-start) 8037 (c-beginning-of-decl-1 lim)
8037 (c-add-syntax 'defun-open (c-point 'boi)) 8038 (while (looking-at c-specifier-key)
8038 ;; Bogus to use bol here, but it's the legacy. 8039 (goto-char (match-end 1))
8039 (c-add-syntax 'defun-open (c-point 'bol))) 8040 (c-forward-syntactic-ws indent-point))
8040 ))) 8041 (c-add-syntax 'defun-open (c-point 'boi))
8042 ;; Bogus to use bol here, but it's the legacy. (Resolved,
8043 ;; 2007-11-09)
8044 ))))
8041 8045
8042 ;; CASE 5B: After a function header but before the body (or 8046 ;; CASE 5B: After a function header but before the body (or
8043 ;; the ending semicolon if there's no body). 8047 ;; the ending semicolon if there's no body).
@@ -8296,6 +8300,7 @@ comment at the start of cc-engine.el for more info."
8296 8300
8297 ;; CASE 5H: we could be looking at subsequent knr-argdecls 8301 ;; CASE 5H: we could be looking at subsequent knr-argdecls
8298 ((and c-recognize-knr-p 8302 ((and c-recognize-knr-p
8303 (not containing-sexp) ; can't be knr inside braces.
8299 (not (eq char-before-ip ?})) 8304 (not (eq char-before-ip ?}))
8300 (save-excursion 8305 (save-excursion
8301 (setq placeholder (cdr (c-beginning-of-decl-1 lim))) 8306 (setq placeholder (cdr (c-beginning-of-decl-1 lim)))
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index ea527730620..54725c0fd88 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -1771,11 +1771,13 @@ one of `c-type-list-kwds', `c-ref-list-kwds',
1771(c-lang-defvar c-prefix-spec-kwds-re (c-lang-const c-prefix-spec-kwds-re)) 1771(c-lang-defvar c-prefix-spec-kwds-re (c-lang-const c-prefix-spec-kwds-re))
1772 1772
1773(c-lang-defconst c-specifier-key 1773(c-lang-defconst c-specifier-key
1774 ;; Adorned regexp of the keywords in `c-prefix-spec-kwds' that 1774 ;; Adorned regexp of the keywords in `c-prefix-spec-kwds' that aren't
1775 ;; aren't ambiguous with types or type prefixes. 1775 ;; ambiguous with types or type prefixes. These are the keywords (like
1776 ;; extern, namespace, but NOT template) that can modify a declaration.
1776 t (c-make-keywords-re t 1777 t (c-make-keywords-re t
1777 (set-difference (c-lang-const c-prefix-spec-kwds) 1778 (set-difference (c-lang-const c-prefix-spec-kwds)
1778 (c-lang-const c-type-start-kwds) 1779 (append (c-lang-const c-type-start-kwds)
1780 (c-lang-const c-<>-arglist-kwds))
1779 :test 'string-equal))) 1781 :test 'string-equal)))
1780(c-lang-defvar c-specifier-key (c-lang-const c-specifier-key)) 1782(c-lang-defvar c-specifier-key (c-lang-const c-specifier-key))
1781 1783
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index 41f1836c0a4..26596e42ae8 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -58,7 +58,8 @@
58 '(("gnu" 58 '(("gnu"
59 (c-basic-offset . 2) 59 (c-basic-offset . 2)
60 (c-comment-only-line-offset . (0 . 0)) 60 (c-comment-only-line-offset . (0 . 0))
61 (c-hanging-braces-alist . ((substatement-open before after))) 61 (c-hanging-braces-alist . ((substatement-open before after)
62 (arglist-cont-nonempty)))
62 (c-offsets-alist . ((statement-block-intro . +) 63 (c-offsets-alist . ((statement-block-intro . +)
63 (knr-argdecl-intro . 5) 64 (knr-argdecl-intro . 5)
64 (substatement-open . +) 65 (substatement-open . +)
@@ -170,7 +171,8 @@
170 (case-label . +) 171 (case-label . +)
171 (access-label . -) 172 (access-label . -)
172 (inclass . ++) 173 (inclass . ++)
173 (inline-open . 0)))) 174 (inline-open . 0)
175 (arglist-cont-nonempty))))
174 176
175 ("linux" 177 ("linux"
176 (c-basic-offset . 8) 178 (c-basic-offset . 8)
@@ -178,7 +180,8 @@
178 (c-hanging-braces-alist . ((brace-list-open) 180 (c-hanging-braces-alist . ((brace-list-open)
179 (brace-entry-open) 181 (brace-entry-open)
180 (substatement-open after) 182 (substatement-open after)
181 (block-close . c-snug-do-while))) 183 (block-close . c-snug-do-while)
184 (arglist-cont-nonempty)))
182 (c-cleanup-list . (brace-else-brace)) 185 (c-cleanup-list . (brace-else-brace))
183 (c-offsets-alist . ((statement-block-intro . +) 186 (c-offsets-alist . ((statement-block-intro . +)
184 (knr-argdecl-intro . 0) 187 (knr-argdecl-intro . 0)
@@ -200,7 +203,8 @@
200 (brace-list-close) 203 (brace-list-close)
201 (brace-entry-open) 204 (brace-entry-open)
202 (substatement-open after) 205 (substatement-open after)
203 (block-close . c-snug-do-while))) 206 (block-close . c-snug-do-while)
207 (arglist-cont-nonempty)))
204 (c-block-comment-prefix . "")) 208 (c-block-comment-prefix . ""))
205 209
206 ("java" 210 ("java"
@@ -230,7 +234,8 @@
230 (c-hanging-braces-alist . ((defun-open after) 234 (c-hanging-braces-alist . ((defun-open after)
231 (defun-close . c-snug-1line-defun-close) 235 (defun-close . c-snug-1line-defun-close)
232 (substatement-open after) 236 (substatement-open after)
233 (block-close . c-snug-do-while))) 237 (block-close . c-snug-do-while)
238 (arglist-cont-nonempty)))
234 (c-hanging-semi&comma-criteria . nil) 239 (c-hanging-semi&comma-criteria . nil)
235 (c-cleanup-list . nil) ; You might want one-liner-defun here. 240 (c-cleanup-list . nil) ; You might want one-liner-defun here.
236 (c-offsets-alist . ((statement-block-intro . +) 241 (c-offsets-alist . ((statement-block-intro . +)
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index 25adb2be01b..8b7b9cd24ee 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -73,8 +73,28 @@ Useful as last item in a `choice' widget."
73 :format "%t%n" 73 :format "%t%n"
74 :value 'other)) 74 :value 'other))
75 75
76;; The next defun will supersede c-const-symbol.
77(eval-and-compile
78 (defun c-constant-symbol (sym len)
79 "Create an uneditable symbol for customization buffers.
80SYM is the name of the symbol, LEN the length of the field (in
81characters) the symbol will be displayed in. LEN must be big
82enough.
83
84This returns a (const ....) structure, suitable for embedding
85within a customization type."
86 (or (symbolp sym) (error "c-constant-symbol: %s is not a symbol" sym))
87 (let* ((name (symbol-name sym))
88 (l (length name))
89 (disp (concat name ":" (make-string (- len l 1) ?\ ))))
90 `(const
91 :size ,len
92 :format ,disp
93 :value ,sym))))
94
76(define-widget 'c-const-symbol 'item 95(define-widget 'c-const-symbol 'item
77 "An uneditable lisp symbol." 96 "An uneditable lisp symbol. This is obsolete -
97use c-constant-symbol instead."
78 :value nil 98 :value nil
79 :tag "Symbol" 99 :tag "Symbol"
80 :format "%t: %v\n%d" 100 :format "%t: %v\n%d"
@@ -305,6 +325,7 @@ e.g. `c-special-indent-hook'."
305 :type 'boolean 325 :type 'boolean
306 :group 'c) 326 :group 'c)
307(make-variable-buffer-local 'c-syntactic-indentation) 327(make-variable-buffer-local 'c-syntactic-indentation)
328(put 'c-syntactic-indentation 'safe-local-variable 'booleanp)
308 329
309(defcustom c-syntactic-indentation-in-macros t 330(defcustom c-syntactic-indentation-in-macros t
310 "*Enable syntactic analysis inside macros. 331 "*Enable syntactic analysis inside macros.
@@ -323,6 +344,7 @@ countered easily by surrounding the statements by a block \(or even
323better with the \"do { ... } while \(0)\" trick)." 344better with the \"do { ... } while \(0)\" trick)."
324 :type 'boolean 345 :type 'boolean
325 :group 'c) 346 :group 'c)
347(put 'c-syntactic-indentation-in-macros 'safe-local-variable 'booleanp)
326 348
327(defcustom-c-stylevar c-comment-only-line-offset 0 349(defcustom-c-stylevar c-comment-only-line-offset 0
328 "*Extra offset for line which contains only the start of a comment. 350 "*Extra offset for line which contains only the start of a comment.
@@ -405,9 +427,7 @@ in that case, i.e. as if \\[c-indent-command] was used instead."
405 `(set ,@(mapcar 427 `(set ,@(mapcar
406 (lambda (elt) 428 (lambda (elt)
407 `(cons :format "%v" 429 `(cons :format "%v"
408 (c-const-symbol :format "%v: " 430 ,(c-constant-symbol elt 20)
409 :size 20
410 :value ,elt)
411 (choice 431 (choice
412 :format "%[Choice%] %v" 432 :format "%[Choice%] %v"
413 :value (column . nil) 433 :value (column . nil)
@@ -709,7 +729,8 @@ involve auto-newline inserted newlines:
709 (module-open after) 729 (module-open after)
710 (composition-open after) 730 (composition-open after)
711 (inexpr-class-open after) 731 (inexpr-class-open after)
712 (inexpr-class-close before)) 732 (inexpr-class-close before)
733 (arglist-cont-nonempty))
713 "*Controls the insertion of newlines before and after braces 734 "*Controls the insertion of newlines before and after braces
714when the auto-newline feature is active. This variable contains an 735when the auto-newline feature is active. This variable contains an
715association list with elements of the following form: 736association list with elements of the following form:
@@ -743,18 +764,15 @@ syntactic context for the brace line."
743 `(set ,@(mapcar 764 `(set ,@(mapcar
744 (lambda (elt) 765 (lambda (elt)
745 `(cons :format "%v" 766 `(cons :format "%v"
746 (c-const-symbol :format "%v: " 767 ,(c-constant-symbol elt 24)
747 :size 20
748 :value ,elt)
749 (choice :format "%[Choice%] %v" 768 (choice :format "%[Choice%] %v"
750 :value (before after) 769 :value (before after)
751 (set :menu-tag "Before/after" 770 (set :menu-tag "Before/after"
752 :format "Newline %v brace\n" 771 :format "Newline %v brace\n"
753 (const :format "%v, " before) 772 (const :format "%v, " before)
754 (const :format "%v" after)) 773 (const :format "%v " after))
755 (function :menu-tag "Function" 774 (function :menu-tag "Function"
756 :format "Run function: %v" 775 :format "Run function: %v"))))
757 :value c-))))
758 '(defun-open defun-close 776 '(defun-open defun-close
759 class-open class-close 777 class-open class-close
760 inline-open inline-close 778 inline-open inline-close
@@ -766,7 +784,8 @@ syntactic context for the brace line."
766 namespace-open namespace-close 784 namespace-open namespace-close
767 module-open module-close 785 module-open module-close
768 composition-open composition-close 786 composition-open composition-close
769 inexpr-class-open inexpr-class-close))) 787 inexpr-class-open inexpr-class-close
788 arglist-cont-nonempty)))
770 :group 'c) 789 :group 'c)
771 790
772(defcustom c-max-one-liner-length 80 791(defcustom c-max-one-liner-length 80
@@ -790,11 +809,9 @@ currently not supported for this variable."
790 `(set ,@(mapcar 809 `(set ,@(mapcar
791 (lambda (elt) 810 (lambda (elt)
792 `(cons :format "%v" 811 `(cons :format "%v"
793 (c-const-symbol :format "%v: " 812 ,(c-constant-symbol elt 20)
794 :size 20 813 (set :format "Newline %v colon\n"
795 :value ,elt) 814 (const :format "%v, " before)
796 (set :format "Newline %v brace\n"
797 (const :format "%v, " before)
798 (const :format "%v" after)))) 815 (const :format "%v" after))))
799 '(case-label label access-label member-init-intro inher-intro))) 816 '(case-label label access-label member-init-intro inher-intro)))
800 :group 'c) 817 :group 'c)
@@ -1307,8 +1324,7 @@ Here is the current list of valid syntactic element symbols:
1307 (lambda (elt) 1324 (lambda (elt)
1308 `(cons :format "%v" 1325 `(cons :format "%v"
1309 :value ,elt 1326 :value ,elt
1310 (c-const-symbol :format "%v: " 1327 ,(c-constant-symbol (car elt) 25)
1311 :size 25)
1312 (sexp :format "%v" 1328 (sexp :format "%v"
1313 :validate 1329 :validate
1314 (lambda (widget) 1330 (lambda (widget)
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 772d35f94f0..f02a7756419 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -272,8 +272,9 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
272 " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2) 272 " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2)
273 273
274 (msft 274 (msft
275 ;; AFAWK, The message may be a "warning", "error", or "fatal error".
275 "^\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \ 276 "^\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
276: \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 2 3 nil (4)) 277: \\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:" 2 3 nil (4))
277 278
278 (oracle 279 (oracle
279 "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\ 280 "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index 6bd7e8c780c..eaeabe58aae 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -1614,21 +1614,6 @@ and (b) in the directories named in `ebrowse-search-path'."
1614 file-name)) 1614 file-name))
1615 1615
1616 1616
1617(defun ebrowse-view-file-other-window (file)
1618 "View a file FILE in another window.
1619This is a replacement for `view-file-other-window' which does not
1620seem to work. It should be removed when `view.el' is fixed."
1621 (interactive)
1622 (let ((old-arrangement (current-window-configuration))
1623 (had-a-buf (get-file-buffer file))
1624 (buf-to-view (find-file-noselect file)))
1625 (switch-to-buffer-other-window buf-to-view)
1626 (view-mode-enter old-arrangement
1627 (and (not had-a-buf)
1628 (not (buffer-modified-p buf-to-view))
1629 'kill-buffer))))
1630
1631
1632(defun ebrowse-view-exit-fn (buffer) 1617(defun ebrowse-view-exit-fn (buffer)
1633 "Function called when exiting View mode in BUFFER. 1618 "Function called when exiting View mode in BUFFER.
1634Restore frame configuration active before viewing the file, 1619Restore frame configuration active before viewing the file,
@@ -1649,10 +1634,9 @@ and possibly kill the viewed buffer."
1649 1634
1650(defun ebrowse-view-file-other-frame (file) 1635(defun ebrowse-view-file-other-frame (file)
1651 "View a file FILE in another frame. 1636 "View a file FILE in another frame.
1652The new frame is deleted when it is no longer used." 1637The new frame is deleted when you quit viewing the file in that frame."
1653 (interactive) 1638 (interactive)
1654 (let ((old-frame-configuration (current-frame-configuration)) 1639 (let ((old-frame-configuration (current-frame-configuration))
1655 (old-arrangement (current-window-configuration))
1656 (had-a-buf (get-file-buffer file)) 1640 (had-a-buf (get-file-buffer file))
1657 (buf-to-view (find-file-noselect file))) 1641 (buf-to-view (find-file-noselect file)))
1658 (switch-to-buffer-other-frame buf-to-view) 1642 (switch-to-buffer-other-frame buf-to-view)
@@ -1663,8 +1647,8 @@ The new frame is deleted when it is no longer used."
1663 (and (not had-a-buf) 1647 (and (not had-a-buf)
1664 (not (buffer-modified-p buf-to-view)) 1648 (not (buffer-modified-p buf-to-view))
1665 'kill-buffer)) 1649 'kill-buffer))
1666 (view-mode-enter old-arrangement 'ebrowse-view-exit-fn))) 1650 (view-mode-enter (cons (selected-window) (cons (selected-window) t))
1667 1651 'ebrowse-view-exit-fn)))
1668 1652
1669(defun ebrowse-view/find-file-and-search-pattern 1653(defun ebrowse-view/find-file-and-search-pattern
1670 (struc info file tags-file-name &optional view where) 1654 (struc info file tags-file-name &optional view where)
@@ -1699,7 +1683,7 @@ specifies where to find/view the result."
1699 (setq view-mode-hook nil)) 1683 (setq view-mode-hook nil))
1700 (push 'ebrowse-find-pattern view-mode-hook) 1684 (push 'ebrowse-find-pattern view-mode-hook)
1701 (case where 1685 (case where
1702 (other-window (ebrowse-view-file-other-window file)) 1686 (other-window (view-file-other-window file))
1703 (other-frame (ebrowse-view-file-other-frame file)) 1687 (other-frame (ebrowse-view-file-other-frame file))
1704 (t (view-file file)))) 1688 (t (view-file file))))
1705 (t 1689 (t
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 21a5593c659..32aecdd8295 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -1815,13 +1815,19 @@ See documentation of variable `tags-file-name'."
1815 (tags-loop-continue (or file-list-form t)))) 1815 (tags-loop-continue (or file-list-form t))))
1816 1816
1817;;;###autoload 1817;;;###autoload
1818(defun tags-query-replace (from to &optional delimited file-list-form start end) 1818(defun tags-query-replace (from to &optional delimited file-list-form)
1819 "Do `query-replace-regexp' of FROM with TO on all files listed in tags table. 1819 "Do `query-replace-regexp' of FROM with TO on all files listed in tags table.
1820Third arg DELIMITED (prefix arg) means replace only word-delimited matches. 1820Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
1821If you exit (\\[keyboard-quit], RET or q), you can resume the query replace 1821If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
1822with the command \\[tags-loop-continue]. 1822with the command \\[tags-loop-continue].
1823Fourth arg FILE-LIST-FORM non-nil means initialize the replacement loop.
1824Fifth and sixth arguments START and END are accepted, for compatibility
1825with `query-replace-regexp', and ignored.
1823 1826
1824See documentation of variable `tags-file-name'." 1827If FILE-LIST-FORM is non-nil, it is a form to evaluate to
1828produce the list of files to search.
1829
1830See also the documentation of the variable `tags-file-name'."
1825 (interactive (query-replace-read-args "Tags query replace (regexp)" t t)) 1831 (interactive (query-replace-read-args "Tags query replace (regexp)" t t))
1826 (setq tags-loop-scan `(let ,(unless (equal from (downcase from)) 1832 (setq tags-loop-scan `(let ,(unless (equal from (downcase from))
1827 '((case-fold-search nil))) 1833 '((case-fold-search nil)))
diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el
index df10b5ecd30..2c152d91512 100644
--- a/lisp/progmodes/f90.el
+++ b/lisp/progmodes/f90.el
@@ -1681,7 +1681,7 @@ A block is a subroutine, if-endif, etc."
1681 (push-mark) 1681 (push-mark)
1682 (goto-char pos) 1682 (goto-char pos)
1683 (setq program (f90-beginning-of-subprogram)) 1683 (setq program (f90-beginning-of-subprogram))
1684 (if (fboundp 'zmacs-activate-region) 1684 (if (featurep 'xemacs)
1685 (zmacs-activate-region) 1685 (zmacs-activate-region)
1686 (setq mark-active t 1686 (setq mark-active t
1687 deactivate-mark nil)) 1687 deactivate-mark nil))
@@ -1866,7 +1866,7 @@ If run in the middle of a line, the line is not broken."
1866 (goto-char save-point) 1866 (goto-char save-point)
1867 (set-marker end-region-mark nil) 1867 (set-marker end-region-mark nil)
1868 (set-marker save-point nil) 1868 (set-marker save-point nil)
1869 (if (fboundp 'zmacs-deactivate-region) 1869 (if (featurep 'xemacs)
1870 (zmacs-deactivate-region) 1870 (zmacs-deactivate-region)
1871 (deactivate-mark)))) 1871 (deactivate-mark))))
1872 1872
@@ -1976,7 +1976,7 @@ Like `join-line', but handles F90 syntax."
1976 f90-cache-position (point))) 1976 f90-cache-position (point)))
1977 (setq f90-cache-position nil) 1977 (setq f90-cache-position nil)
1978 (set-marker end-region-mark nil) 1978 (set-marker end-region-mark nil)
1979 (if (fboundp 'zmacs-deactivate-region) 1979 (if (featurep 'xemacs)
1980 (zmacs-deactivate-region) 1980 (zmacs-deactivate-region)
1981 (deactivate-mark)))) 1981 (deactivate-mark))))
1982 1982
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el
index eee68fb2b6f..3e29f9732b2 100644
--- a/lisp/progmodes/gdb-ui.el
+++ b/lisp/progmodes/gdb-ui.el
@@ -435,11 +435,11 @@ otherwise do not."
435 (output 435 (output
436 (with-output-to-string 436 (with-output-to-string
437 (with-current-buffer standard-output 437 (with-current-buffer standard-output
438 (call-process shell-file-name 438 (and file (file-exists-p file)
439 (if (file-exists-p file) file nil) 439 (call-process shell-file-name file
440 (list t nil) nil "-c" 440 (list t nil) nil "-c"
441 (concat gdb-cpp-define-alist-program " " 441 (concat gdb-cpp-define-alist-program " "
442 gdb-cpp-define-alist-flags))))) 442 gdb-cpp-define-alist-flags))))))
443 (define-list (split-string output "\n" t)) (name)) 443 (define-list (split-string output "\n" t)) (name))
444 (setq gdb-define-alist nil) 444 (setq gdb-define-alist nil)
445 (dolist (define define-list) 445 (dolist (define define-list)
@@ -1214,10 +1214,12 @@ This filter may simply queue input for a later time."
1214 1214
1215(defun gdb-dequeue-input () 1215(defun gdb-dequeue-input ()
1216 (let ((queue gdb-input-queue)) 1216 (let ((queue gdb-input-queue))
1217 (and queue 1217 (if queue
1218 (let ((last (car (last queue)))) 1218 (let ((last (car (last queue))))
1219 (unless (nbutlast queue) (setq gdb-input-queue '())) 1219 (unless (nbutlast queue) (setq gdb-input-queue '()))
1220 last)))) 1220 last)
1221 ;; This should be nil here anyway but set it just to make sure.
1222 (setq gdb-pending-triggers nil))))
1221 1223
1222(defun gdb-send-item (item) 1224(defun gdb-send-item (item)
1223 (setq gdb-flush-pending-output nil) 1225 (setq gdb-flush-pending-output nil)
@@ -3445,7 +3447,8 @@ BUFFER nil or omitted means use the current buffer."
3445 (let ((buffer (marker-buffer gud-overlay-arrow-position)) 3447 (let ((buffer (marker-buffer gud-overlay-arrow-position))
3446 (position (marker-position gud-overlay-arrow-position))) 3448 (position (marker-position gud-overlay-arrow-position)))
3447 (when (and buffer 3449 (when (and buffer
3448 (string-equal (buffer-name buffer) 3450 (string-equal (file-name-nondirectory
3451 (buffer-file-name buffer))
3449 (file-name-nondirectory (match-string 3)))) 3452 (file-name-nondirectory (match-string 3))))
3450 (with-current-buffer buffer 3453 (with-current-buffer buffer
3451 (setq fringe-indicator-alist 3454 (setq fringe-indicator-alist
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 126b5310ccc..83ffb5f7a0e 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -1,7 +1,7 @@
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, 2003, 2004, 2005, 2006, 2007, 2008 3;; Copyright (C) 1988, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
4;; Free Software Foundation, Inc. 4;; 2008 Free Software Foundation, Inc.
5 5
6;; Author: Daniel LaLiberte <liberte@holonexus.org> 6;; Author: Daniel LaLiberte <liberte@holonexus.org>
7;; Maintainer: FSF 7;; Maintainer: FSF
@@ -99,12 +99,6 @@
99;; 99;;
100;; Written by Brian Marick, at Gould, Computer Systems Division, Urbana IL. 100;; Written by Brian Marick, at Gould, Computer Systems Division, Urbana IL.
101;; Extensively modified by Daniel LaLiberte (while at Gould). 101;; Extensively modified by Daniel LaLiberte (while at Gould).
102;;
103;; You may freely modify and distribute this, but keep a record
104;; of modifications and send comments to:
105;; liberte@a.cs.uiuc.edu or ihnp4!uiucdcs!liberte
106;; I will continue to upgrade hide-ifdef-mode
107;; with your contributions.
108 102
109;;; Code: 103;;; Code:
110 104
@@ -114,6 +108,33 @@
114 "Hide selected code within `ifdef'." 108 "Hide selected code within `ifdef'."
115 :group 'c) 109 :group 'c)
116 110
111(defcustom hide-ifdef-initially nil
112 "Non-nil means call `hide-ifdefs' when Hide-Ifdef mode is first activated."
113 :type 'boolean
114 :group 'hide-ifdef)
115
116(defcustom hide-ifdef-read-only nil
117 "Set to non-nil if you want buffer to be read-only while hiding text."
118 :type 'boolean
119 :group 'hide-ifdef)
120
121(defcustom hide-ifdef-lines nil
122 "Non-nil means hide the #ifX, #else, and #endif lines."
123 :type 'boolean
124 :group 'hide-ifdef)
125
126(defcustom hide-ifdef-shadow nil
127 "Non-nil means shadow text instead of hiding it."
128 :type 'boolean
129 :group 'hide-ifdef
130 :version "23.1")
131
132(defface hide-ifdef-shadow '((t (:inherit shadow)))
133 "Face for shadowing ifdef blocks."
134 :group 'hide-ifdef
135 :version "23.1")
136
137
117(defvar hide-ifdef-mode-submap 138(defvar hide-ifdef-mode-submap
118 ;; Set up the submap that goes after the prefix key. 139 ;; Set up the submap that goes after the prefix key.
119 (let ((map (make-sparse-keymap))) 140 (let ((map (make-sparse-keymap)))
@@ -128,6 +149,7 @@
128 (define-key map "\C-s" 'show-ifdef-block) 149 (define-key map "\C-s" 'show-ifdef-block)
129 150
130 (define-key map "\C-q" 'hide-ifdef-toggle-read-only) 151 (define-key map "\C-q" 'hide-ifdef-toggle-read-only)
152 (define-key map "\C-w" 'hide-ifdef-toggle-shadowing)
131 (substitute-key-definition 153 (substitute-key-definition
132 'toggle-read-only 'hide-ifdef-toggle-outside-read-only map) 154 'toggle-read-only 'hide-ifdef-toggle-outside-read-only map)
133 map) 155 map)
@@ -155,7 +177,9 @@
155 ["Use an alist" hide-ifdef-use-define-alist t] 177 ["Use an alist" hide-ifdef-use-define-alist t]
156 ["Undefine a variable" hide-ifdef-undef t] 178 ["Undefine a variable" hide-ifdef-undef t]
157 ["Toggle read only" hide-ifdef-toggle-read-only 179 ["Toggle read only" hide-ifdef-toggle-read-only
158 :style toggle :selected hide-ifdef-read-only])) 180 :style toggle :selected hide-ifdef-read-only]
181 ["Toggle shadowing" hide-ifdef-toggle-shadowing
182 :style toggle :selected hide-ifdef-shadow]))
159 183
160(defvar hide-ifdef-hiding nil 184(defvar hide-ifdef-hiding nil
161 "Non-nil when text may be hidden.") 185 "Non-nil when text may be hidden.")
@@ -256,9 +280,12 @@ how the hiding is done:
256 (end-of-line 2))) 280 (end-of-line 2)))
257 281
258(defun hide-ifdef-region-internal (start end) 282(defun hide-ifdef-region-internal (start end)
259 (remove-overlays start end 'invisible 'hide-ifdef) 283 (remove-overlays start end 'hide-ifdef t)
260 (let ((o (make-overlay start end))) 284 (let ((o (make-overlay start end)))
261 (overlay-put o 'invisible 'hide-ifdef))) 285 (overlay-put o 'hide-ifdef t)
286 (if hide-ifdef-shadow
287 (overlay-put o 'face 'hide-ifdef-shadow)
288 (overlay-put o 'invisible 'hide-ifdef))))
262 289
263(defun hide-ifdef-region (start end) 290(defun hide-ifdef-region (start end)
264 "START is the start of a #if or #else form. END is the ending part. 291 "START is the start of a #if or #else form. END is the ending part.
@@ -270,7 +297,7 @@ Everything including these lines is made invisible."
270 297
271(defun hif-show-ifdef-region (start end) 298(defun hif-show-ifdef-region (start end)
272 "Everything between START and END is made visible." 299 "Everything between START and END is made visible."
273 (remove-overlays start end 'invisible 'hide-ifdef)) 300 (remove-overlays start end 'hide-ifdef t))
274 301
275 302
276;;===%%SF%% evaluation (Start) === 303;;===%%SF%% evaluation (Start) ===
@@ -740,11 +767,11 @@ Point is left unchanged."
740 767
741(defun hif-hide-line (point) 768(defun hif-hide-line (point)
742 "Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil." 769 "Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil."
743 (if hide-ifdef-lines 770 (when hide-ifdef-lines
744 (save-excursion 771 (save-excursion
745 (goto-char point) 772 (goto-char point)
746 (hide-ifdef-region-internal (line-beginning-position) 773 (hide-ifdef-region-internal
747 (progn (hif-end-of-line) (point)))))) 774 (line-beginning-position) (progn (hif-end-of-line) (point))))))
748 775
749 776
750;;; Hif-Possibly-Hide 777;;; Hif-Possibly-Hide
@@ -827,24 +854,6 @@ It does not do the work that's pointless to redo on a recursive entry."
827 854
828;;===%%SF%% exports (Start) === 855;;===%%SF%% exports (Start) ===
829 856
830;;;###autoload
831(defcustom hide-ifdef-initially nil
832 "*Non-nil means call `hide-ifdefs' when Hide-Ifdef mode is first activated."
833 :type 'boolean
834 :group 'hide-ifdef)
835
836;;;###autoload
837(defcustom hide-ifdef-read-only nil
838 "*Set to non-nil if you want buffer to be read-only while hiding text."
839 :type 'boolean
840 :group 'hide-ifdef)
841
842;;;###autoload
843(defcustom hide-ifdef-lines nil
844 "*Non-nil means hide the #ifX, #else, and #endif lines."
845 :type 'boolean
846 :group 'hide-ifdef)
847
848(defun hide-ifdef-toggle-read-only () 857(defun hide-ifdef-toggle-read-only ()
849 "Toggle `hide-ifdef-read-only'." 858 "Toggle `hide-ifdef-read-only'."
850 (interactive) 859 (interactive)
@@ -866,6 +875,21 @@ It does not do the work that's pointless to redo on a recursive entry."
866 hif-outside-read-only)) 875 hif-outside-read-only))
867 (force-mode-line-update)) 876 (force-mode-line-update))
868 877
878(defun hide-ifdef-toggle-shadowing ()
879 "Toggle shadowing."
880 (interactive)
881 (set (make-local-variable 'hide-ifdef-shadow) (not hide-ifdef-shadow))
882 (message "Shadowing %s" (if hide-ifdef-shadow "ON" "OFF"))
883 (save-restriction
884 (widen)
885 (dolist (overlay (overlays-in (point-min) (point-max)))
886 (when (overlay-get overlay 'hide-ifdef)
887 (if hide-ifdef-shadow
888 (progn
889 (overlay-put overlay 'invisible nil)
890 (overlay-put overlay 'face 'hide-ifdef-shadow))
891 (overlay-put overlay 'face nil)
892 (overlay-put overlay 'invisible 'hide-ifdef))))))
869 893
870(defun hide-ifdef-define (var) 894(defun hide-ifdef-define (var)
871 "Define a VAR so that #ifdef VAR would be included." 895 "Define a VAR so that #ifdef VAR would be included."
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
index 6dca919ba25..4c33b6b053c 100644
--- a/lisp/progmodes/pascal.el
+++ b/lisp/progmodes/pascal.el
@@ -523,8 +523,8 @@ This puts the mark at the end, and point at the beginning."
523 (pascal-end-of-defun) 523 (pascal-end-of-defun)
524 (push-mark (point)) 524 (push-mark (point))
525 (pascal-beg-of-defun) 525 (pascal-beg-of-defun)
526 (if (fboundp 'zmacs-activate-region) 526 (when (featurep 'xemacs)
527 (zmacs-activate-region))) 527 (zmacs-activate-region)))
528 528
529(defun pascal-comment-area (start end) 529(defun pascal-comment-area (start end)
530 "Put the region into a Pascal comment. 530 "Put the region into a Pascal comment.
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index bef282f5e98..39fe096309d 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -1889,7 +1889,8 @@ Uses `python-beginning-of-block', `python-end-of-block'."
1889 1889
1890;;;; Completion. 1890;;;; Completion.
1891 1891
1892(defvar python-imports nil 1892;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2008-01/msg00076.html
1893(defvar python-imports "None"
1893 "String of top-level import statements updated by `python-find-imports'.") 1894 "String of top-level import statements updated by `python-find-imports'.")
1894(make-variable-buffer-local 'python-imports) 1895(make-variable-buffer-local 'python-imports)
1895 1896
@@ -2076,7 +2077,7 @@ The default contents correspond to the elements of `python-skeletons'."
2076 < ; Avoid wrong indentation after block opening. 2077 < ; Avoid wrong indentation after block opening.
2077 "elif " str ":" \n 2078 "elif " str ":" \n
2078 > _ \n nil) 2079 > _ \n nil)
2079 (python-else) | ^) 2080 '(python-else) | ^)
2080 2081
2081(define-skeleton python-else 2082(define-skeleton python-else
2082 "Auxiliary skeleton." 2083 "Auxiliary skeleton."
@@ -2090,24 +2091,24 @@ The default contents correspond to the elements of `python-skeletons'."
2090 "Condition: " 2091 "Condition: "
2091 "while " str ":" \n 2092 "while " str ":" \n
2092 > _ \n 2093 > _ \n
2093 (python-else) | ^) 2094 '(python-else) | ^)
2094 2095
2095(def-python-skeleton for 2096(def-python-skeleton for
2096 "Target, %s: " 2097 "Target, %s: "
2097 "for " str " in " (skeleton-read "Expression, %s: ") ":" \n 2098 "for " str " in " (skeleton-read "Expression, %s: ") ":" \n
2098 > _ \n 2099 > _ \n
2099 (python-else) | ^) 2100 '(python-else) | ^)
2100 2101
2101(def-python-skeleton try/except 2102(def-python-skeleton try/except
2102 nil 2103 nil
2103 "try:" \n 2104 "try:" \n
2104 > _ \n 2105 > _ \n
2105 ("Exception, %s: " 2106 ("Exception, %s: "
2106 < "except " str (python-target) ":" \n 2107 < "except " str '(python-target) ":" \n
2107 > _ \n nil) 2108 > _ \n nil)
2108 < "except:" \n 2109 < "except:" \n
2109 > _ \n 2110 > _ \n
2110 (python-else) | ^) 2111 '(python-else) | ^)
2111 2112
2112(define-skeleton python-target 2113(define-skeleton python-target
2113 "Auxiliary skeleton." 2114 "Auxiliary skeleton."
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 56b4b9b0f38..90b2fda36e2 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -1186,6 +1186,7 @@ Can be set to a number, or to nil which means leave it as is."
1186This value is used for the `+' and `-' symbols in an indentation variable." 1186This value is used for the `+' and `-' symbols in an indentation variable."
1187 :type 'integer 1187 :type 'integer
1188 :group 'sh-indentation) 1188 :group 'sh-indentation)
1189(put 'sh-basic-offset 'safe-local-variable 'integerp)
1189 1190
1190(defcustom sh-indent-comment nil 1191(defcustom sh-indent-comment nil
1191 "How a comment line is to be indented. 1192 "How a comment line is to be indented.
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 54a3f0f6f80..c177ca1b184 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -11,6 +11,12 @@
11;; http://www.veripool.com 11;; http://www.veripool.com
12;; Keywords: languages 12;; Keywords: languages
13 13
14;; This code supports Emacs 21.1 and later
15;; And XEmacs 21.1 and later
16;; Please do not make changes that break Emacs 21. Thanks!
17;;
18;;
19
14;; This file is part of GNU Emacs. 20;; This file is part of GNU Emacs.
15 21
16;; GNU Emacs is free software; you can redistribute it and/or modify 22;; GNU Emacs is free software; you can redistribute it and/or modify
@@ -30,12 +36,12 @@
30 36
31;;; Commentary: 37;;; Commentary:
32 38
33;; This mode borrows heavily from the Pascal-mode and the cc-mode of emacs 39;; This mode borrows heavily from the Pascal-mode and the cc-mode of Emacs
34 40
35;; USAGE 41;; USAGE
36;; ===== 42;; =====
37 43
38;; A major mode for editing Verilog HDL source code. When you have 44;; A major mode for editing Verilog HDL source code. When you have
39;; entered Verilog mode, you may get more info by pressing C-h m. You 45;; entered Verilog mode, you may get more info by pressing C-h m. You
40;; may also get online help describing various functions by: C-h f 46;; may also get online help describing various functions by: C-h f
41;; <Name of function you want described> 47;; <Name of function you want described>
@@ -44,8 +50,8 @@
44;; ======================= 50;; =======================
45 51
46;; Verilog is a rapidly evolving language, and hence this mode is 52;; Verilog is a rapidly evolving language, and hence this mode is
47;; under continuous development. Hence this is beta code, and likely 53;; under continuous development. Hence this is beta code, and likely
48;; has bugs. Please report any and all bugs to me at mac@verilog.com. 54;; has bugs. Please report any and all bugs to me at mac@verilog.com.
49;; Please use verilog-submit-bug-report to submit a report; type C-c 55;; Please use verilog-submit-bug-report to submit a report; type C-c
50;; C-b to invoke this and as a result I will have a much easier time 56;; C-b to invoke this and as a result I will have a much easier time
51;; of reproducing the bug you find, and hence fixing it. 57;; of reproducing the bug you find, and hence fixing it.
@@ -55,7 +61,7 @@
55 61
56;; An older version of this mode may be already installed as a part of 62;; An older version of this mode may be already installed as a part of
57;; your environment, and one method of updating would be to update 63;; your environment, and one method of updating would be to update
58;; your emacs environment. Sometimes this is difficult for local 64;; your Emacs environment. Sometimes this is difficult for local
59;; political/control reasons, and hence you can always install a 65;; political/control reasons, and hence you can always install a
60;; private copy (or even a shared copy) which overrides the system 66;; private copy (or even a shared copy) which overrides the system
61;; default. 67;; default.
@@ -74,7 +80,7 @@
74 80
75;; If you want to customize Verilog mode to fit your needs better, 81;; If you want to customize Verilog mode to fit your needs better,
76;; you may add these lines (the values of the variables presented 82;; you may add these lines (the values of the variables presented
77;; here are the defaults). Note also that if you use an emacs that 83;; here are the defaults). Note also that if you use an Emacs that
78;; supports custom, it's probably better to use the custom menu to 84;; supports custom, it's probably better to use the custom menu to
79;; edit these. 85;; edit these.
80;; 86;;
@@ -102,15 +108,19 @@
102;; 108;;
103 109
104;;; History: 110;;; History:
105;; 111;;
106;; 112;; See commit history at http://www.veripool.com/verilog-mode.html
113;; (This section is required to appease checkdoc.)
114
107;;; Code: 115;;; Code:
108 116
109;; This variable will always hold the version number of the mode 117;; This variable will always hold the version number of the mode
110(defconst verilog-mode-version "377" 118(defconst verilog-mode-version "383"
111 "Version of this verilog mode.")
112(defconst verilog-mode-release-date "2007-12-07"
113 "Version of this verilog mode.") 119 "Version of this verilog mode.")
120(defconst verilog-mode-release-date "2008-01-07-GNU"
121 "Release date of this verilog mode.")
122(defconst verilog-mode-release-emacs t
123 "If non-nil, this version of verilog mode was released with Emacs itself.")
114 124
115(defun verilog-version () 125(defun verilog-version ()
116 "Inform caller of the version of this file." 126 "Inform caller of the version of this file."
@@ -118,7 +128,10 @@
118 (message "Using verilog-mode version %s" verilog-mode-version)) 128 (message "Using verilog-mode version %s" verilog-mode-version))
119 129
120;; Insure we have certain packages, and deal with it if we don't 130;; Insure we have certain packages, and deal with it if we don't
131;; Be sure to note which Emacs flavor and version added each feature.
121(eval-when-compile 132(eval-when-compile
133 ;; The below were disabled when GNU Emacs 22 was released;
134 ;; perhaps some still need to be there to support Emacs 21.
122 (when (featurep 'xemacs) 135 (when (featurep 'xemacs)
123 (condition-case nil 136 (condition-case nil
124 (require 'easymenu) 137 (require 'easymenu)
@@ -181,8 +194,8 @@ STRING should be given if the last search was by `string-match' on STRING."
181 result) 194 result)
182 (buffer-substring-no-properties (match-beginning num) 195 (buffer-substring-no-properties (match-beginning num)
183 (match-end num) 196 (match-end num)
184 (current-buffer) 197 (current-buffer)))))
185 ))))) 198 )
186 (error nil)) 199 (error nil))
187 (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) 200 (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
188 nil ;; We've got what we needed 201 nil ;; We've got what we needed
@@ -210,6 +223,8 @@ STRING should be given if the last search was by `string-match' on STRING."
210;; Provide a regular expression optimization routine, using regexp-opt 223;; Provide a regular expression optimization routine, using regexp-opt
211;; if provided by the user's elisp libraries 224;; if provided by the user's elisp libraries
212(eval-and-compile 225(eval-and-compile
226 ;; The below were disabled when GNU Emacs 22 was released;
227 ;; perhaps some still need to be there to support Emacs 21.
213 (if (featurep 'xemacs) 228 (if (featurep 'xemacs)
214 (if (fboundp 'regexp-opt) 229 (if (fboundp 'regexp-opt)
215 ;; regexp-opt is defined, does it take 3 or 2 arguments? 230 ;; regexp-opt is defined, does it take 3 or 2 arguments?
@@ -222,8 +237,7 @@ STRING should be given if the last search was by `string-match' on STRING."
222 (defun verilog-regexp-opt (a b) 237 (defun verilog-regexp-opt (a b)
223 "Deal with differing number of required arguments for `regexp-opt'. 238 "Deal with differing number of required arguments for `regexp-opt'.
224 Call 'regexp-opt' on A and B." 239 Call 'regexp-opt' on A and B."
225 (regexp-opt a b 't) 240 (regexp-opt a b 't))
226 )
227 (error nil)) 241 (error nil))
228 ) 242 )
229 ((eq args 2) ;; It takes 2 243 ((eq args 2) ;; It takes 2
@@ -261,6 +275,12 @@ STRING should be given if the last search was by `string-match' on STRING."
261 (if (fboundp 'customize-apropos) 275 (if (fboundp 'customize-apropos)
262 (customize-apropos "font-lock-*" 'faces))) 276 (customize-apropos "font-lock-*" 'faces)))
263 277
278(defun verilog-booleanp (value)
279 "Return t if VALUE is boolean.
280 This implements GNU Emacs 22.1's `booleanp' function in earlier Emacs.
281 This function may be removed when Emacs 21 is no longer supported."
282 (or (equal value t) (equal value nil)))
283
264(defgroup verilog-mode nil 284(defgroup verilog-mode nil
265 "Facilitates easy editing of Verilog source text" 285 "Facilitates easy editing of Verilog source text"
266 :group 'languages) 286 :group 'languages)
@@ -290,6 +310,7 @@ you type \\[compile]. When the compile completes, \\[next-error] will take
290you to the next lint error." 310you to the next lint error."
291 :type 'string 311 :type 'string
292 :group 'verilog-mode-actions) 312 :group 'verilog-mode-actions)
313;; We don't mark it safe, as it's used as a shell command
293 314
294(defcustom verilog-coverage 315(defcustom verilog-coverage
295 "echo 'No verilog-coverage set, see \"M-x describe-variable verilog-coverage\"'" 316 "echo 'No verilog-coverage set, see \"M-x describe-variable verilog-coverage\"'"
@@ -299,6 +320,7 @@ you type \\[compile]. When the compile completes, \\[next-error] will take
299you to the next lint error." 320you to the next lint error."
300 :type 'string 321 :type 'string
301 :group 'verilog-mode-actions) 322 :group 'verilog-mode-actions)
323;; We don't mark it safe, as it's used as a shell command
302 324
303(defcustom verilog-simulator 325(defcustom verilog-simulator
304 "echo 'No verilog-simulator set, see \"M-x describe-variable verilog-simulator\"'" 326 "echo 'No verilog-simulator set, see \"M-x describe-variable verilog-simulator\"'"
@@ -308,6 +330,7 @@ you type \\[compile]. When the compile completes, \\[next-error] will take
308you to the next lint error." 330you to the next lint error."
309 :type 'string 331 :type 'string
310 :group 'verilog-mode-actions) 332 :group 'verilog-mode-actions)
333;; We don't mark it safe, as it's used as a shell command
311 334
312(defcustom verilog-compiler 335(defcustom verilog-compiler
313 "echo 'No verilog-compiler set, see \"M-x describe-variable verilog-compiler\"'" 336 "echo 'No verilog-compiler set, see \"M-x describe-variable verilog-compiler\"'"
@@ -317,6 +340,7 @@ you type \\[compile]. When the compile completes, \\[next-error] will take
317you to the next lint error." 340you to the next lint error."
318 :type 'string 341 :type 'string
319 :group 'verilog-mode-actions) 342 :group 'verilog-mode-actions)
343;; We don't mark it safe, as it's used as a shell command
320 344
321(defvar verilog-tool 'verilog-linter 345(defvar verilog-tool 'verilog-linter
322 "Which tool to use for building compiler-command. 346 "Which tool to use for building compiler-command.
@@ -336,11 +360,14 @@ Note: Activate the new setting in a Verilog buffer by re-fontifying it (menu
336entry \"Fontify Buffer\"). XEmacs: turn off and on font locking." 360entry \"Fontify Buffer\"). XEmacs: turn off and on font locking."
337 :type 'boolean 361 :type 'boolean
338 :group 'verilog-mode-indent) 362 :group 'verilog-mode-indent)
363;; Note we don't use :safe, as that would break on Emacsen before 22.0.
364(put 'verilog-highlight-translate-off 'safe-local-variable 'verilog-booleanp)
339 365
340(defcustom verilog-indent-level 3 366(defcustom verilog-indent-level 3
341 "*Indentation of Verilog statements with respect to containing block." 367 "*Indentation of Verilog statements with respect to containing block."
342 :group 'verilog-mode-indent 368 :group 'verilog-mode-indent
343 :type 'integer) 369 :type 'integer)
370(put 'verilog-indent-level 'safe-local-variable 'integerp)
344 371
345(defcustom verilog-indent-level-module 3 372(defcustom verilog-indent-level-module 3
346 "*Indentation of Module level Verilog statements. (eg always, initial) 373 "*Indentation of Module level Verilog statements. (eg always, initial)
@@ -348,12 +375,14 @@ Set to 0 to get initial and always statements lined up on the left side of
348your screen." 375your screen."
349 :group 'verilog-mode-indent 376 :group 'verilog-mode-indent
350 :type 'integer) 377 :type 'integer)
378(put 'verilog-indent-level-module 'safe-local-variable 'integerp)
351 379
352(defcustom verilog-indent-level-declaration 3 380(defcustom verilog-indent-level-declaration 3
353 "*Indentation of declarations with respect to containing block. 381 "*Indentation of declarations with respect to containing block.
354Set to 0 to get them list right under containing block." 382Set to 0 to get them list right under containing block."
355 :group 'verilog-mode-indent 383 :group 'verilog-mode-indent
356 :type 'integer) 384 :type 'integer)
385(put 'verilog-indent-level-declaration 'safe-local-variable 'integerp)
357 386
358(defcustom verilog-indent-declaration-macros nil 387(defcustom verilog-indent-declaration-macros nil
359 "*How to treat macro expansions in a declaration. 388 "*How to treat macro expansions in a declaration.
@@ -367,6 +396,7 @@ If non nil, treat as:
367 output c;" 396 output c;"
368 :group 'verilog-mode-indent 397 :group 'verilog-mode-indent
369 :type 'boolean) 398 :type 'boolean)
399(put 'verilog-indent-declaration-macros 'safe-local-variable 'verilog-booleanp)
370 400
371(defcustom verilog-indent-lists t 401(defcustom verilog-indent-lists t
372 "*How to treat indenting items in a list. 402 "*How to treat indenting items in a list.
@@ -379,62 +409,73 @@ If nil, treat as:
379 reset ) begin" 409 reset ) begin"
380 :group 'verilog-mode-indent 410 :group 'verilog-mode-indent
381 :type 'boolean) 411 :type 'boolean)
412(put 'verilog-indent-lists 'safe-local-variable 'verilog-booleanp)
382 413
383(defcustom verilog-indent-level-behavioral 3 414(defcustom verilog-indent-level-behavioral 3
384 "*Absolute indentation of first begin in a task or function block. 415 "*Absolute indentation of first begin in a task or function block.
385Set to 0 to get such code to start at the left side of the screen." 416Set to 0 to get such code to start at the left side of the screen."
386 :group 'verilog-mode-indent 417 :group 'verilog-mode-indent
387 :type 'integer) 418 :type 'integer)
419(put 'verilog-indent-level-behavioral 'safe-local-variable 'integerp)
388 420
389(defcustom verilog-indent-level-directive 1 421(defcustom verilog-indent-level-directive 1
390 "*Indentation to add to each level of `ifdef declarations. 422 "*Indentation to add to each level of `ifdef declarations.
391Set to 0 to have all directives start at the left side of the screen." 423Set to 0 to have all directives start at the left side of the screen."
392 :group 'verilog-mode-indent 424 :group 'verilog-mode-indent
393 :type 'integer) 425 :type 'integer)
426(put 'verilog-indent-level-directive 'safe-local-variable 'integerp)
394 427
395(defcustom verilog-cexp-indent 2 428(defcustom verilog-cexp-indent 2
396 "*Indentation of Verilog statements split across lines." 429 "*Indentation of Verilog statements split across lines."
397 :group 'verilog-mode-indent 430 :group 'verilog-mode-indent
398 :type 'integer) 431 :type 'integer)
432(put 'verilog-cexp-indent 'safe-local-variable 'integerp)
399 433
400(defcustom verilog-case-indent 2 434(defcustom verilog-case-indent 2
401 "*Indentation for case statements." 435 "*Indentation for case statements."
402 :group 'verilog-mode-indent 436 :group 'verilog-mode-indent
403 :type 'integer) 437 :type 'integer)
438(put 'verilog-case-indent 'safe-local-variable 'integerp)
404 439
405(defcustom verilog-auto-newline t 440(defcustom verilog-auto-newline t
406 "*True means automatically newline after semicolons." 441 "*True means automatically newline after semicolons."
407 :group 'verilog-mode-indent 442 :group 'verilog-mode-indent
408 :type 'boolean) 443 :type 'boolean)
444(put 'verilog-auto-newline 'safe-local-variable 'verilog-booleanp)
409 445
410(defcustom verilog-auto-indent-on-newline t 446(defcustom verilog-auto-indent-on-newline t
411 "*True means automatically indent line after newline." 447 "*True means automatically indent line after newline."
412 :group 'verilog-mode-indent 448 :group 'verilog-mode-indent
413 :type 'boolean) 449 :type 'boolean)
450(put 'verilog-auto-indent-on-newline 'safe-local-variable 'verilog-booleanp)
414 451
415(defcustom verilog-tab-always-indent t 452(defcustom verilog-tab-always-indent t
416 "*True means TAB should always re-indent the current line. 453 "*True means TAB should always re-indent the current line.
417Nil means TAB will only reindent when at the beginning of the line." 454Nil means TAB will only reindent when at the beginning of the line."
418 :group 'verilog-mode-indent 455 :group 'verilog-mode-indent
419 :type 'boolean) 456 :type 'boolean)
457(put 'verilog-tab-always-indent 'safe-local-variable 'verilog-booleanp)
420 458
421(defcustom verilog-tab-to-comment nil 459(defcustom verilog-tab-to-comment nil
422 "*True means TAB moves to the right hand column in preparation for a comment." 460 "*True means TAB moves to the right hand column in preparation for a comment."
423 :group 'verilog-mode-actions 461 :group 'verilog-mode-actions
424 :type 'boolean) 462 :type 'boolean)
463(put 'verilog-tab-to-comment 'safe-local-variable 'verilog-booleanp)
425 464
426(defcustom verilog-indent-begin-after-if t 465(defcustom verilog-indent-begin-after-if t
427 "*If true, indent begin statements following if, else, while, for and repeat. 466 "*If true, indent begin statements following if, else, while, for and repeat.
428Otherwise, line them up." 467Otherwise, line them up."
429 :group 'verilog-mode-indent 468 :group 'verilog-mode-indent
430 :type 'boolean ) 469 :type 'boolean)
470(put 'verilog-indent-begin-after-if 'safe-local-variable 'verilog-booleanp)
431 471
432 472
433(defcustom verilog-align-ifelse nil 473(defcustom verilog-align-ifelse nil
434 "*If true, align `else' under matching `if'. 474 "*If true, align `else' under matching `if'.
435Otherwise else is lined up with first character on line holding matching if." 475Otherwise else is lined up with first character on line holding matching if."
436 :group 'verilog-mode-indent 476 :group 'verilog-mode-indent
437 :type 'boolean ) 477 :type 'boolean)
478(put 'verilog-align-ifelse 'safe-local-variable 'verilog-booleanp)
438 479
439(defcustom verilog-minimum-comment-distance 10 480(defcustom verilog-minimum-comment-distance 10
440 "*Minimum distance (in lines) between begin and end required before a comment. 481 "*Minimum distance (in lines) between begin and end required before a comment.
@@ -442,6 +483,7 @@ Setting this variable to zero results in every end acquiring a comment; the
442default avoids too many redundant comments in tight quarters" 483default avoids too many redundant comments in tight quarters"
443 :group 'verilog-mode-indent 484 :group 'verilog-mode-indent
444 :type 'integer) 485 :type 'integer)
486(put 'verilog-minimum-comment-distance 'safe-local-variable 'integerp)
445 487
446(defcustom verilog-auto-lineup '(declaration) 488(defcustom verilog-auto-lineup '(declaration)
447 "*Algorithm for lining up statements on multiple lines. 489 "*Algorithm for lining up statements on multiple lines.
@@ -481,23 +523,26 @@ would become
481; 523;
482 524
483 :group 'verilog-mode-indent 525 :group 'verilog-mode-indent
484 :type 'list ) 526 :type 'list)
527(put 'verilog-auto-lineup 'safe-local-variable 'listp)
485 528
486(defcustom verilog-highlight-p1800-keywords nil 529(defcustom verilog-highlight-p1800-keywords nil
487 "*If true highlight words newly reserved by IEEE-1800 in 530 "*True means highlight words newly reserved by IEEE-1800.
488verilog-font-lock-p1800-face in order to gently suggest changing where 531These will appear in `verilog-font-lock-p1800-face' in order to gently
489these words are used as variables to something else. Nil means highlight 532suggest changing where these words are used as variables to something else.
490these words as appropriate for the SystemVerilog IEEE-1800 standard. Note 533Nil means highlight these words as appropriate for the SystemVerilog
491that changing this will require restarting emacs to see the effect as font 534IEEE-1800 standard. Note that changing this will require restarting Emacs
492color choices are cached by emacs" 535to see the effect as font color choices are cached by Emacs"
493 :group 'verilog-mode-indent 536 :group 'verilog-mode-indent
494 :type 'boolean) 537 :type 'boolean)
538(put 'verilog-highlight-p1800-keywords 'safe-local-variable 'verilog-booleanp)
495 539
496(defcustom verilog-auto-endcomments t 540(defcustom verilog-auto-endcomments t
497 "*True means insert a comment /* ... */ after 'end's. 541 "*True means insert a comment /* ... */ after 'end's.
498The name of the function or case will be set between the braces." 542The name of the function or case will be set between the braces."
499 :group 'verilog-mode-actions 543 :group 'verilog-mode-actions
500 :type 'boolean ) 544 :type 'boolean)
545(put 'verilog-auto-endcomments 'safe-local-variable 'verilog-booleanp)
501 546
502(defcustom verilog-auto-read-includes nil 547(defcustom verilog-auto-read-includes nil
503 "*True means to automatically read includes before AUTOs. 548 "*True means to automatically read includes before AUTOs.
@@ -506,7 +551,8 @@ each AUTO expansion. This makes it easier to embed defines and includes,
506but can result in very slow reading times if there are many or large 551but can result in very slow reading times if there are many or large
507include files." 552include files."
508 :group 'verilog-mode-actions 553 :group 'verilog-mode-actions
509 :type 'boolean ) 554 :type 'boolean)
555(put 'verilog-auto-read-includes 'safe-local-variable 'verilog-booleanp)
510 556
511(defcustom verilog-auto-save-policy nil 557(defcustom verilog-auto-save-policy nil
512 "*Non-nil indicates action to take when saving a Verilog buffer with AUTOs. 558 "*Non-nil indicates action to take when saving a Verilog buffer with AUTOs.
@@ -527,6 +573,7 @@ They will be expanded in the same way as if there was a AUTOINST in the
527instantiation. See also `verilog-auto-star' and `verilog-auto-star-save'." 573instantiation. See also `verilog-auto-star' and `verilog-auto-star-save'."
528 :group 'verilog-mode-actions 574 :group 'verilog-mode-actions
529 :type 'boolean) 575 :type 'boolean)
576(put 'verilog-auto-star-expand 'safe-local-variable 'verilog-booleanp)
530 577
531(defcustom verilog-auto-star-save nil 578(defcustom verilog-auto-star-save nil
532 "*Non-nil indicates to save to disk SystemVerilog .* instance expansions. 579 "*Non-nil indicates to save to disk SystemVerilog .* instance expansions.
@@ -537,6 +584,7 @@ Instead of setting this, you may want to use /*AUTOINST*/, which will
537always be saved." 584always be saved."
538 :group 'verilog-mode-actions 585 :group 'verilog-mode-actions
539 :type 'boolean) 586 :type 'boolean)
587(put 'verilog-auto-star-save 'safe-local-variable 'verilog-booleanp)
540 588
541(defvar verilog-auto-update-tick nil 589(defvar verilog-auto-update-tick nil
542 "Modification tick at which autos were last performed.") 590 "Modification tick at which autos were last performed.")
@@ -624,8 +672,7 @@ always be saved."
624 ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 1 bold t) 672 ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 1 bold t)
625 ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 2 bold t) 673 ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 2 bold t)
626 ) 674 )
627 "*Keywords to also highlight in Verilog *compilation* buffers." 675 "*Keywords to also highlight in Verilog *compilation* buffers.")
628 )
629 676
630(defcustom verilog-library-flags '("") 677(defcustom verilog-library-flags '("")
631 "*List of standard Verilog arguments to use for /*AUTOINST*/. 678 "*List of standard Verilog arguments to use for /*AUTOINST*/.
@@ -656,6 +703,7 @@ have problems, use \\[find-alternate-file] RET to have these take effect.
656See also the variables mentioned above." 703See also the variables mentioned above."
657 :group 'verilog-mode-auto 704 :group 'verilog-mode-auto
658 :type '(repeat string)) 705 :type '(repeat string))
706(put 'verilog-library-flags 'safe-local-variable 'listp)
659 707
660(defcustom verilog-library-directories '(".") 708(defcustom verilog-library-directories '(".")
661 "*List of directories when looking for files for /*AUTOINST*/. 709 "*List of directories when looking for files for /*AUTOINST*/.
@@ -678,9 +726,11 @@ See also `verilog-library-flags', `verilog-library-files'
678and `verilog-library-extensions'." 726and `verilog-library-extensions'."
679 :group 'verilog-mode-auto 727 :group 'verilog-mode-auto
680 :type '(repeat file)) 728 :type '(repeat file))
729(put 'verilog-library-directories 'safe-local-variable 'listp)
681 730
682(defcustom verilog-library-files '() 731(defcustom verilog-library-files '()
683 "*List of files to search for modules when looking for AUTOINST files. 732 "*List of files to search for modules.
733AUTOINST will use this when it needs to resolve a module name.
684This is a complete path, usually to a technology file with many standard 734This is a complete path, usually to a technology file with many standard
685cells defined in it. 735cells defined in it.
686 736
@@ -698,12 +748,14 @@ have problems, use \\[find-alternate-file] RET to have these take effect.
698See also `verilog-library-flags', `verilog-library-directories'." 748See also `verilog-library-flags', `verilog-library-directories'."
699 :group 'verilog-mode-auto 749 :group 'verilog-mode-auto
700 :type '(repeat directory)) 750 :type '(repeat directory))
751(put 'verilog-library-files 'safe-local-variable 'listp)
701 752
702(defcustom verilog-library-extensions '(".v") 753(defcustom verilog-library-extensions '(".v")
703 "*List of extensions to use when looking for files for /*AUTOINST*/. 754 "*List of extensions to use when looking for files for /*AUTOINST*/.
704See also `verilog-library-flags', `verilog-library-directories'." 755See also `verilog-library-flags', `verilog-library-directories'."
705 :type '(repeat string) 756 :type '(repeat string)
706 :group 'verilog-mode-auto) 757 :group 'verilog-mode-auto)
758(put 'verilog-library-extensions 'safe-local-variable 'listp)
707 759
708(defcustom verilog-active-low-regexp nil 760(defcustom verilog-active-low-regexp nil
709 "*If set, treat signals matching this regexp as active low. 761 "*If set, treat signals matching this regexp as active low.
@@ -711,21 +763,24 @@ This is used for AUTORESET and AUTOTIEOFF. For proper behavior,
711you will probably also need `verilog-auto-reset-widths' set." 763you will probably also need `verilog-auto-reset-widths' set."
712 :group 'verilog-mode-auto 764 :group 'verilog-mode-auto
713 :type 'string) 765 :type 'string)
766(put 'verilog-active-low-regexp 'safe-local-variable 'stringp)
714 767
715(defcustom verilog-auto-sense-include-inputs nil 768(defcustom verilog-auto-sense-include-inputs nil
716 "*If true, AUTOSENSE should include all inputs. 769 "*If true, AUTOSENSE should include all inputs.
717If nil, only inputs that are NOT output signals in the same block are 770If nil, only inputs that are NOT output signals in the same block are
718included." 771included."
719 :type 'boolean 772 :group 'verilog-mode-auto
720 :group 'verilog-mode-auto) 773 :type 'boolean)
774(put 'verilog-auto-sense-include-inputs 'safe-local-variable 'verilog-booleanp)
721 775
722(defcustom verilog-auto-sense-defines-constant nil 776(defcustom verilog-auto-sense-defines-constant nil
723 "*If true, AUTOSENSE should assume all defines represent constants. 777 "*If true, AUTOSENSE should assume all defines represent constants.
724When true, the defines will not be included in sensitivity lists. To 778When true, the defines will not be included in sensitivity lists. To
725maintain compatibility with other sites, this should be set at the bottom 779maintain compatibility with other sites, this should be set at the bottom
726of each verilog file that requires it, rather than being set globally." 780of each verilog file that requires it, rather than being set globally."
727 :type 'boolean 781 :group 'verilog-mode-auto
728 :group 'verilog-mode-auto) 782 :type 'boolean)
783(put 'verilog-auto-sense-defines-constant 'safe-local-variable 'verilog-booleanp)
729 784
730(defcustom verilog-auto-reset-widths t 785(defcustom verilog-auto-reset-widths t
731 "*If true, AUTORESET should determine the width of signals. 786 "*If true, AUTORESET should determine the width of signals.
@@ -735,11 +790,13 @@ the constant zero. This may result in ugly code when parameters determine
735the MSB or LSB of a signal inside a AUTORESET." 790the MSB or LSB of a signal inside a AUTORESET."
736 :type 'boolean 791 :type 'boolean
737 :group 'verilog-mode-auto) 792 :group 'verilog-mode-auto)
793(put 'verilog-auto-reset-widths 'safe-local-variable 'verilog-booleanp)
738 794
739(defcustom verilog-assignment-delay "" 795(defcustom verilog-assignment-delay ""
740 "*Text used for delays in delayed assignments. Add a trailing space if set." 796 "*Text used for delays in delayed assignments. Add a trailing space if set."
741 :type 'string 797 :group 'verilog-mode-auto
742 :group 'verilog-mode-auto) 798 :type 'string)
799(put 'verilog-assignment-delay 'safe-local-variable 'stringp)
743 800
744(defcustom verilog-auto-inst-vector t 801(defcustom verilog-auto-inst-vector t
745 "*If true, when creating default ports with AUTOINST, use bus subscripts. 802 "*If true, when creating default ports with AUTOINST, use bus subscripts.
@@ -748,7 +805,8 @@ the module (AUTOWIRE signals always are subscripted, you must manually
748declare the wire to have the subscripts removed.) Nil may speed up some 805declare the wire to have the subscripts removed.) Nil may speed up some
749simulators, but is less general and harder to read, so avoid." 806simulators, but is less general and harder to read, so avoid."
750 :group 'verilog-mode-auto 807 :group 'verilog-mode-auto
751 :type 'boolean ) 808 :type 'boolean)
809(put 'verilog-auto-inst-vector 'safe-local-variable 'verilog-booleanp)
752 810
753(defcustom verilog-auto-inst-template-numbers nil 811(defcustom verilog-auto-inst-template-numbers nil
754 "*If true, when creating templated ports with AUTOINST, add a comment. 812 "*If true, when creating templated ports with AUTOINST, add a comment.
@@ -756,7 +814,8 @@ The comment will add the line number of the template that was used for that
756port declaration. Setting this aids in debugging, but nil is suggested for 814port declaration. Setting this aids in debugging, but nil is suggested for
757regular use to prevent large numbers of merge conflicts." 815regular use to prevent large numbers of merge conflicts."
758 :group 'verilog-mode-auto 816 :group 'verilog-mode-auto
759 :type 'boolean ) 817 :type 'boolean)
818(put 'verilog-auto-inst-template-numbers 'safe-local-variable 'verilog-booleanp)
760 819
761(defvar verilog-auto-inst-column 40 820(defvar verilog-auto-inst-column 40
762 "Column number for first part of auto-inst.") 821 "Column number for first part of auto-inst.")
@@ -765,31 +824,36 @@ regular use to prevent large numbers of merge conflicts."
765 "*If set, when creating AUTOINPUT list, ignore signals matching this regexp. 824 "*If set, when creating AUTOINPUT list, ignore signals matching this regexp.
766See the \\[verilog-faq] for examples on using this." 825See the \\[verilog-faq] for examples on using this."
767 :group 'verilog-mode-auto 826 :group 'verilog-mode-auto
768 :type 'string ) 827 :type 'string)
828(put 'verilog-auto-input-ignore-regexp 'safe-local-variable 'stringp)
769 829
770(defcustom verilog-auto-inout-ignore-regexp nil 830(defcustom verilog-auto-inout-ignore-regexp nil
771 "*If set, when creating AUTOINOUT list, ignore signals matching this regexp. 831 "*If set, when creating AUTOINOUT list, ignore signals matching this regexp.
772See the \\[verilog-faq] for examples on using this." 832See the \\[verilog-faq] for examples on using this."
773 :group 'verilog-mode-auto 833 :group 'verilog-mode-auto
774 :type 'string ) 834 :type 'string)
835(put 'verilog-auto-inout-ignore-regexp 'safe-local-variable 'stringp)
775 836
776(defcustom verilog-auto-output-ignore-regexp nil 837(defcustom verilog-auto-output-ignore-regexp nil
777 "*If set, when creating AUTOOUTPUT list, ignore signals matching this regexp. 838 "*If set, when creating AUTOOUTPUT list, ignore signals matching this regexp.
778See the \\[verilog-faq] for examples on using this." 839See the \\[verilog-faq] for examples on using this."
779 :group 'verilog-mode-auto 840 :group 'verilog-mode-auto
780 :type 'string ) 841 :type 'string)
842(put 'verilog-auto-output-ignore-regexp 'safe-local-variable 'stringp)
781 843
782(defcustom verilog-auto-unused-ignore-regexp nil 844(defcustom verilog-auto-unused-ignore-regexp nil
783 "*If set, when creating AUTOUNUSED list, ignore signals matching this regexp. 845 "*If set, when creating AUTOUNUSED list, ignore signals matching this regexp.
784See the \\[verilog-faq] for examples on using this." 846See the \\[verilog-faq] for examples on using this."
785 :group 'verilog-mode-auto 847 :group 'verilog-mode-auto
786 :type 'string ) 848 :type 'string)
849(put 'verilog-auto-unused-ignore-regexp 'safe-local-variable 'stringp)
787 850
788(defcustom verilog-typedef-regexp nil 851(defcustom verilog-typedef-regexp nil
789 "*If non-nil, regular expression that matches Verilog-2001 typedef names. 852 "*If non-nil, regular expression that matches Verilog-2001 typedef names.
790For example, \"_t$\" matches typedefs named with _t, as in the C language." 853For example, \"_t$\" matches typedefs named with _t, as in the C language."
791 :group 'verilog-mode-auto 854 :group 'verilog-mode-auto
792 :type 'string ) 855 :type 'string)
856(put 'verilog-typedef-regexp 'safe-local-variable 'stringp)
793 857
794(defcustom verilog-mode-hook 'verilog-set-compile-command 858(defcustom verilog-mode-hook 'verilog-set-compile-command
795 "*Hook (List of functions) run after verilog mode is loaded." 859 "*Hook (List of functions) run after verilog mode is loaded."
@@ -798,33 +862,33 @@ For example, \"_t$\" matches typedefs named with _t, as in the C language."
798 862
799(defcustom verilog-auto-hook nil 863(defcustom verilog-auto-hook nil
800 "*Hook run after `verilog-mode' updates AUTOs." 864 "*Hook run after `verilog-mode' updates AUTOs."
801 :type 'hook 865 :group 'verilog-mode-auto
802 :group 'verilog-mode-auto) 866 :type 'hook)
803 867
804(defcustom verilog-before-auto-hook nil 868(defcustom verilog-before-auto-hook nil
805 "*Hook run before `verilog-mode' updates AUTOs." 869 "*Hook run before `verilog-mode' updates AUTOs."
806 :type 'hook 870 :group 'verilog-mode-auto
807 :group 'verilog-mode-auto) 871 :type 'hook)
808 872
809(defcustom verilog-delete-auto-hook nil 873(defcustom verilog-delete-auto-hook nil
810 "*Hook run after `verilog-mode' deletes AUTOs." 874 "*Hook run after `verilog-mode' deletes AUTOs."
811 :type 'hook 875 :group 'verilog-mode-auto
812 :group 'verilog-mode-auto) 876 :type 'hook)
813 877
814(defcustom verilog-before-delete-auto-hook nil 878(defcustom verilog-before-delete-auto-hook nil
815 "*Hook run before `verilog-mode' deletes AUTOs." 879 "*Hook run before `verilog-mode' deletes AUTOs."
816 :type 'hook 880 :group 'verilog-mode-auto
817 :group 'verilog-mode-auto) 881 :type 'hook)
818 882
819(defcustom verilog-getopt-flags-hook nil 883(defcustom verilog-getopt-flags-hook nil
820 "*Hook run after `verilog-getopt-flags' determines the Verilog option lists." 884 "*Hook run after `verilog-getopt-flags' determines the Verilog option lists."
821 :type 'hook 885 :group 'verilog-mode-auto
822 :group 'verilog-mode-auto) 886 :type 'hook)
823 887
824(defcustom verilog-before-getopt-flags-hook nil 888(defcustom verilog-before-getopt-flags-hook nil
825 "*Hook run before `verilog-getopt-flags' determines the Verilog option lists." 889 "*Hook run before `verilog-getopt-flags' determines the Verilog option lists."
826 :type 'hook 890 :group 'verilog-mode-auto
827 :group 'verilog-mode-auto) 891 :type 'hook)
828 892
829(defvar verilog-imenu-generic-expression 893(defvar verilog-imenu-generic-expression
830 '((nil "^\\s-*\\(\\(m\\(odule\\|acromodule\\)\\)\\|primitive\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 4) 894 '((nil "^\\s-*\\(\\(m\\(odule\\|acromodule\\)\\)\\|primitive\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 4)
@@ -843,13 +907,11 @@ format (e.g. 09/17/1997) is not supported.")
843(defvar verilog-company nil 907(defvar verilog-company nil
844 "*Default name of Company for verilog header. 908 "*Default name of Company for verilog header.
845If set will become buffer local.") 909If set will become buffer local.")
846
847(make-variable-buffer-local 'verilog-company) 910(make-variable-buffer-local 'verilog-company)
848 911
849(defvar verilog-project nil 912(defvar verilog-project nil
850 "*Default name of Project for verilog header. 913 "*Default name of Project for verilog header.
851If set will become buffer local.") 914If set will become buffer local.")
852
853(make-variable-buffer-local 'verilog-project) 915(make-variable-buffer-local 'verilog-project)
854 916
855(defvar verilog-mode-map 917(defvar verilog-mode-map
@@ -871,7 +933,6 @@ If set will become buffer local.")
871 (define-key map "\M-\r" `electric-verilog-terminate-and-indent) 933 (define-key map "\M-\r" `electric-verilog-terminate-and-indent)
872 (define-key map "\M-\t" 'verilog-complete-word) 934 (define-key map "\M-\t" 'verilog-complete-word)
873 (define-key map "\M-?" 'verilog-show-completions) 935 (define-key map "\M-?" 'verilog-show-completions)
874 (define-key map [(meta control h)] 'verilog-mark-defun)
875 (define-key map "\C-c\`" 'verilog-lint-off) 936 (define-key map "\C-c\`" 'verilog-lint-off)
876 (define-key map "\C-c\*" 'verilog-delete-auto-star-implicit) 937 (define-key map "\C-c\*" 'verilog-delete-auto-star-implicit)
877 (define-key map "\C-c\C-r" 'verilog-label-be) 938 (define-key map "\C-c\C-r" 'verilog-label-be)
@@ -881,8 +942,10 @@ If set will become buffer local.")
881 (define-key map "\M-*" 'verilog-star-comment) 942 (define-key map "\M-*" 'verilog-star-comment)
882 (define-key map "\C-c\C-c" 'verilog-comment-region) 943 (define-key map "\C-c\C-c" 'verilog-comment-region)
883 (define-key map "\C-c\C-u" 'verilog-uncomment-region) 944 (define-key map "\C-c\C-u" 'verilog-uncomment-region)
884 (define-key map "\M-\C-a" 'verilog-beg-of-defun) 945 (when (featurep 'xemacs)
885 (define-key map "\M-\C-e" 'verilog-end-of-defun) 946 (define-key map [(meta control h)] 'verilog-mark-defun)
947 (define-key map "\M-\C-a" 'verilog-beg-of-defun)
948 (define-key map "\M-\C-e" 'verilog-end-of-defun))
886 (define-key map "\C-c\C-d" 'verilog-goto-defun) 949 (define-key map "\C-c\C-d" 'verilog-goto-defun)
887 (define-key map "\C-c\C-k" 'verilog-delete-auto) 950 (define-key map "\C-c\C-k" 'verilog-delete-auto)
888 (define-key map "\C-c\C-a" 'verilog-auto) 951 (define-key map "\C-c\C-a" 'verilog-auto)
@@ -895,7 +958,7 @@ If set will become buffer local.")
895 958
896;; menus 959;; menus
897(defvar verilog-xemacs-menu 960(defvar verilog-xemacs-menu
898 '("Verilog" 961 `("Verilog"
899 ("Choose Compilation Action" 962 ("Choose Compilation Action"
900 ["None" 963 ["None"
901 (progn 964 (progn
@@ -929,9 +992,15 @@ If set will become buffer local.")
929 :selected (equal verilog-tool `verilog-compiler)] 992 :selected (equal verilog-tool `verilog-compiler)]
930 ) 993 )
931 ("Move" 994 ("Move"
932 ["Beginning of function" verilog-beg-of-defun t] 995 ,(if (featurep 'xemacs)
933 ["End of function" verilog-end-of-defun t] 996 (progn
934 ["Mark function" verilog-mark-defun t] 997 ["Beginning of function" verilog-beg-of-defun t]
998 ["End of function" verilog-end-of-defun t]
999 ["Mark function" verilog-mark-defun t])
1000 ["Beginning of function" beginning-of-defun t]
1001 ["End of function" end-of-defun t]
1002 ["Mark function" mark-defun t])
1003
935 ["Goto function/module" verilog-goto-defun t] 1004 ["Goto function/module" verilog-goto-defun t]
936 ["Move to beginning of block" electric-verilog-backward-sexp t] 1005 ["Move to beginning of block" electric-verilog-backward-sexp t]
937 ["Move to end of block" electric-verilog-forward-sexp t] 1006 ["Move to end of block" electric-verilog-forward-sexp t]
@@ -1025,8 +1094,7 @@ If set will become buffer local.")
1025 ["Casex" verilog-sk-casex t] 1094 ["Casex" verilog-sk-casex t]
1026 ["Casez" verilog-sk-casez t] 1095 ["Casez" verilog-sk-casez t]
1027 ) 1096 )
1028 "Menu for statement templates in Verilog." 1097 "Menu for statement templates in Verilog.")
1029 )
1030 1098
1031(easy-menu-define verilog-menu verilog-mode-map "Menu for Verilog mode" 1099(easy-menu-define verilog-menu verilog-mode-map "Menu for Verilog mode"
1032 verilog-xemacs-menu) 1100 verilog-xemacs-menu)
@@ -1072,8 +1140,7 @@ will break, as the o's continuously replace. xa -> x works ok though."
1072 (store-match-data '(nil nil)) 1140 (store-match-data '(nil nil))
1073 (if BOUND 1141 (if BOUND
1074 (< (point) BOUND) 1142 (< (point) BOUND)
1075 t) 1143 t)))))
1076 ))))
1077 (match-end 0)) 1144 (match-end 0))
1078 1145
1079(defsubst verilog-re-search-backward (REGEXP BOUND NOERROR) 1146(defsubst verilog-re-search-backward (REGEXP BOUND NOERROR)
@@ -1087,8 +1154,7 @@ will break, as the o's continuously replace. xa -> x works ok though."
1087 (store-match-data '(nil nil)) 1154 (store-match-data '(nil nil))
1088 (if BOUND 1155 (if BOUND
1089 (> (point) BOUND) 1156 (> (point) BOUND)
1090 t) 1157 t)))))
1091 ))))
1092 (match-end 0)) 1158 (match-end 0))
1093 1159
1094(defsubst verilog-re-search-forward-quick (regexp bound noerror) 1160(defsubst verilog-re-search-forward-quick (regexp bound noerror)
@@ -1130,6 +1196,8 @@ so there may be a large up front penalty for the first search."
1130 (save-excursion 1196 (save-excursion
1131 (nth 3 (parse-partial-sexp (verilog-get-beg-of-line) (point))))) 1197 (nth 3 (parse-partial-sexp (verilog-get-beg-of-line) (point)))))
1132 1198
1199(defvar compile-command)
1200
1133;; compilation program 1201;; compilation program
1134(defun verilog-set-compile-command () 1202(defun verilog-set-compile-command ()
1135 "Function to compute shell command to compile verilog. 1203 "Function to compute shell command to compile verilog.
@@ -1201,8 +1269,7 @@ find the errors."
1201 (setq compilation-error-regexp-alist 1269 (setq compilation-error-regexp-alist
1202 (default-value 'compilation-error-regexp-alist)) 1270 (default-value 'compilation-error-regexp-alist))
1203 (set (make-local-variable 'compilation-error-regexp-alist) 1271 (set (make-local-variable 'compilation-error-regexp-alist)
1204 (default-value 'compilation-error-regexp-alist)) 1272 (default-value 'compilation-error-regexp-alist)))))
1205 )))
1206 1273
1207(add-hook 'compilation-mode-hook 'verilog-error-regexp-add) 1274(add-hook 'compilation-mode-hook 'verilog-error-regexp-add)
1208 1275
@@ -1330,8 +1397,7 @@ find the errors."
1330 "endprogram" 1397 "endprogram"
1331 "endsequence" 1398 "endsequence"
1332 "endclocking" 1399 "endclocking"
1333 ) 1400 ))))
1334 )))
1335 1401
1336 1402
1337(defconst verilog-endcomment-reason-re 1403(defconst verilog-endcomment-reason-re
@@ -1655,157 +1721,37 @@ find the errors."
1655 ) 1721 )
1656 "List of Verilog keywords.") 1722 "List of Verilog keywords.")
1657 1723
1658
1659(defconst verilog-emacs-features
1660 ;; Documentation at the bottom
1661 (let ((major (and (boundp 'emacs-major-version)
1662 emacs-major-version))
1663 (minor (and (boundp 'emacs-minor-version)
1664 emacs-minor-version))
1665 flavor comments flock-syntax)
1666 ;; figure out version numbers if not already discovered
1667 (and (or (not major) (not minor))
1668 (string-match "\\([0-9]+\\).\\([0-9]+\\)" emacs-version)
1669 (setq major (string-to-number (substring emacs-version
1670 (match-beginning 1)
1671 (match-end 1)))
1672 minor (string-to-number (substring emacs-version
1673 (match-beginning 2)
1674 (match-end 2)))))
1675 (if (not (and major minor))
1676 (error "Cannot figure out the major and minor version numbers"))
1677 ;; calculate the major version
1678 (cond
1679 ((= major 4) (setq major 'v18)) ;Epoch 4
1680 ((= major 18) (setq major 'v18)) ;Emacs 18
1681 ((= major 19) (setq major 'v19 ;Emacs 19
1682 flavor (if (or (string-match "Lucid" emacs-version)
1683 (string-match "XEmacs" emacs-version))
1684 'XEmacs 'FSF)))
1685 ((> major 19) (setq major 'v20
1686 flavor (if (or (string-match "Lucid" emacs-version)
1687 (string-match "XEmacs" emacs-version))
1688 'XEmacs 'FSF)))
1689 ;; I don't know
1690 (t (error "Cannot recognize major version number: %s" major)))
1691 ;; XEmacs 19 uses 8-bit modify-syntax-entry flags, as do all
1692 ;; patched Emacs 19, Emacs 18, Epoch 4's. Only Emacs 19 uses a
1693 ;; 1-bit flag. Let's be as smart as we can about figuring this
1694 ;; out.
1695 (if (or (eq major 'v20) (eq major 'v19))
1696 (let ((table (copy-syntax-table)))
1697 (modify-syntax-entry ?a ". 12345678" table)
1698 (cond
1699 ;; XEmacs pre 20 and Emacs pre 19.30 use vectors for syntax tables.
1700 ((vectorp table)
1701 (if (= (logand (lsh (aref table ?a) -16) 255) 255)
1702 (setq comments '8-bit)
1703 (setq comments '1-bit)))
1704 ;; XEmacs 20 is known to be 8-bit
1705 ((eq flavor 'XEmacs) (setq comments '8-bit))
1706 ;; Emacs 19.30 and beyond are known to be 1-bit
1707 ((eq flavor 'FSF) (setq comments '1-bit))
1708 ;; Don't know what this is
1709 (t (error "Couldn't figure out syntax table format"))
1710 ))
1711 ;; Emacs 18 has no support for dual comments
1712 (setq comments 'no-dual-comments))
1713 ;; determine whether to use old or new font lock syntax
1714 ;; We can assume 8-bit syntax table emacsen support new syntax, otherwise
1715 ;; look for version > 19.30
1716 (setq flock-syntax
1717 (if (or (equal comments '8-bit)
1718 (equal major 'v20)
1719 (and (equal major 'v19) (> minor 30)))
1720 'flock-syntax-after-1930
1721 'flock-syntax-before-1930))
1722 ;; lets do some minimal sanity checking.
1723 (if (or
1724 ;; Emacs before 19.6 had bugs
1725 (and (eq major 'v19) (eq flavor 'XEmacs) (< minor 6))
1726 ;; Emacs 19 before 19.21 has known bugs
1727 (and (eq major 'v19) (eq flavor 'FSF) (< minor 21))
1728 )
1729 (with-output-to-temp-buffer "*verilog-mode warnings*"
1730 (print (format
1731 "The version of Emacs that you are running, %s,
1732has known bugs in its syntax parsing routines which will affect the
1733performance of verilog-mode. You should strongly consider upgrading to the
1734latest available version. verilog-mode may continue to work, after a
1735fashion, but strange indentation errors could be encountered."
1736 emacs-version))))
1737 ;; Emacs 18, with no patch is not too good
1738 (if (and (eq major 'v18) (eq comments 'no-dual-comments))
1739 (with-output-to-temp-buffer "*verilog-mode warnings*"
1740 (print (format
1741 "The version of Emacs 18 you are running, %s,
1742has known deficiencies in its ability to handle the dual verilog
1743\(and C++) comments, (e.g. the // and /* */ comments). This will
1744not be much of a problem for you if you only use the /* */ comments,
1745but you really should strongly consider upgrading to one of the latest
1746Emacs 19's. In Emacs 18, you may also experience performance degradations.
1747Emacs 19 has some new built-in routines which will speed things up for you.
1748Because of these inherent problems, verilog-mode is not supported
1749on emacs-18."
1750 emacs-version))))
1751 ;; Emacs 18 with the syntax patches are no longer supported
1752 (if (and (eq major 'v18) (not (eq comments 'no-dual-comments)))
1753 (with-output-to-temp-buffer "*verilog-mode warnings*"
1754 (print (format
1755 "You are running a syntax patched Emacs 18 variant. While this should
1756work for you, you may want to consider upgrading to Emacs 19.
1757The syntax patches are no longer supported either for verilog-mode."))))
1758 (list major comments flock-syntax))
1759 "A list of features extant in the Emacs you are using.
1760There are many flavors of Emacs out there, each with different
1761features supporting those needed by `verilog-mode'. Here's the current
1762supported list, along with the values for this variable:
1763
1764 Vanilla Emacs 18/Epoch 4: (v18 no-dual-comments flock-syntax-before-1930)
1765 Emacs 18/Epoch 4 (patch2): (v18 8-bit flock-syntax-after-1930)
1766 XEmacs (formerly Lucid) 19: (v19 8-bit flock-syntax-after-1930)
1767 XEmacs 20: (v20 8-bit flock-syntax-after-1930)
1768 Emacs 19.1-19.30: (v19 8-bit flock-syntax-before-1930)
1769 Emacs 19.31-19.xx: (v19 8-bit flock-syntax-after-1930)
1770 Emacs20 : (v20 1-bit flock-syntax-after-1930).")
1771
1772(defconst verilog-comment-start-regexp "//\\|/\\*" 1724(defconst verilog-comment-start-regexp "//\\|/\\*"
1773 "Dual comment value for `comment-start-regexp'.") 1725 "Dual comment value for `comment-start-regexp'.")
1774 1726
1775(defun verilog-populate-syntax-table (table) 1727(defvar verilog-mode-syntax-table
1776 "Populate the syntax TABLE." 1728 (let ((table (make-syntax-table)))
1777 (modify-syntax-entry ?\\ "\\" table) 1729 ;; Populate the syntax TABLE.
1778 (modify-syntax-entry ?+ "." table) 1730 (modify-syntax-entry ?\\ "\\" table)
1779 (modify-syntax-entry ?- "." table) 1731 (modify-syntax-entry ?+ "." table)
1780 (modify-syntax-entry ?= "." table) 1732 (modify-syntax-entry ?- "." table)
1781 (modify-syntax-entry ?% "." table) 1733 (modify-syntax-entry ?= "." table)
1782 (modify-syntax-entry ?< "." table) 1734 (modify-syntax-entry ?% "." table)
1783 (modify-syntax-entry ?> "." table) 1735 (modify-syntax-entry ?< "." table)
1784 (modify-syntax-entry ?& "." table) 1736 (modify-syntax-entry ?> "." table)
1785 (modify-syntax-entry ?| "." table) 1737 (modify-syntax-entry ?& "." table)
1786 (modify-syntax-entry ?` "w" table) 1738 (modify-syntax-entry ?| "." table)
1787 (modify-syntax-entry ?_ "w" table) 1739 (modify-syntax-entry ?` "w" table)
1788 (modify-syntax-entry ?\' "." table) 1740 (modify-syntax-entry ?_ "w" table)
1789) 1741 (modify-syntax-entry ?\' "." table)
1790 1742
1791(defun verilog-setup-dual-comments (table) 1743 ;; Set up TABLE to handle block and line style comments.
1792 "Set up TABLE to handle block and line style comments." 1744 (if (featurep 'xemacs)
1793 (cond 1745 (progn
1794 ((memq '8-bit verilog-emacs-features) 1746 ;; XEmacs (formerly Lucid) has the best implementation
1795 ;; XEmacs (formerly Lucid) has the best implementation 1747 (modify-syntax-entry ?/ ". 1456" table)
1796 (modify-syntax-entry ?/ ". 1456" table) 1748 (modify-syntax-entry ?* ". 23" table)
1797 (modify-syntax-entry ?* ". 23" table) 1749 (modify-syntax-entry ?\n "> b" table))
1798 (modify-syntax-entry ?\n "> b" table) 1750 ;; Emacs 19 does things differently, but we can work with it
1799 ) 1751 (modify-syntax-entry ?/ ". 124b" table)
1800 ((memq '1-bit verilog-emacs-features) 1752 (modify-syntax-entry ?* ". 23" table)
1801 ;; Emacs 19 does things differently, but we can work with it 1753 (modify-syntax-entry ?\n "> b" table))
1802 (modify-syntax-entry ?/ ". 124b" table) 1754 table)
1803 (modify-syntax-entry ?* ". 23" table)
1804 (modify-syntax-entry ?\n "> b" table)
1805 )
1806 ))
1807
1808(defvar verilog-mode-syntax-table nil
1809 "Syntax table used in `verilog-mode' buffers.") 1755 "Syntax table used in `verilog-mode' buffers.")
1810 1756
1811(defvar verilog-font-lock-keywords nil 1757(defvar verilog-font-lock-keywords nil
@@ -1961,8 +1907,7 @@ See also `verilog-font-lock-extra-types'.")
1961 'font-lock-type-face)) 1907 'font-lock-type-face))
1962 ;; Fontify Verilog-AMS keywords 1908 ;; Fontify Verilog-AMS keywords
1963 (cons (concat "\\<\\(" verilog-ams-keywords "\\)\\>") 1909 (cons (concat "\\<\\(" verilog-ams-keywords "\\)\\>")
1964 'verilog-font-lock-ams-face) 1910 'verilog-font-lock-ams-face)))
1965 ))
1966 1911
1967 (setq verilog-font-lock-keywords-1 1912 (setq verilog-font-lock-keywords-1
1968 (append verilog-font-lock-keywords 1913 (append verilog-font-lock-keywords
@@ -1976,15 +1921,12 @@ See also `verilog-font-lock-extra-types'.")
1976 (list 1921 (list
1977 (concat "\\<function\\>\\s-+\\(integer\\|real\\(time\\)?\\|time\\)\\s-+\\(\\sw+\\)" ) 1922 (concat "\\<function\\>\\s-+\\(integer\\|real\\(time\\)?\\|time\\)\\s-+\\(\\sw+\\)" )
1978 '(1 font-lock-keyword-face) 1923 '(1 font-lock-keyword-face)
1979 '(3 font-lock-reference-face prepend) 1924 '(3 font-lock-reference-face prepend))
1980 )
1981 '("\\<function\\>\\s-+\\(\\[[^]]+\\]\\)\\s-+\\(\\sw+\\)" 1925 '("\\<function\\>\\s-+\\(\\[[^]]+\\]\\)\\s-+\\(\\sw+\\)"
1982 (1 font-lock-keyword-face) 1926 (1 font-lock-keyword-face)
1983 (2 font-lock-reference-face append) 1927 (2 font-lock-reference-face append))
1984 )
1985 '("\\<function\\>\\s-+\\(\\sw+\\)" 1928 '("\\<function\\>\\s-+\\(\\sw+\\)"
1986 1 'font-lock-reference-face append) 1929 1 'font-lock-reference-face append))))
1987 )))
1988 1930
1989 (setq verilog-font-lock-keywords-2 1931 (setq verilog-font-lock-keywords-2
1990 (append verilog-font-lock-keywords-1 1932 (append verilog-font-lock-keywords-1
@@ -2002,7 +1944,6 @@ See also `verilog-font-lock-extra-types'.")
2002 0 font-lock-type-face append) 1944 0 font-lock-type-face append)
2003 ;; Fontify instantiation names 1945 ;; Fontify instantiation names
2004 '("\\([A-Za-z][A-Za-z0-9_]+\\)\\s-*(" 1 font-lock-function-name-face) 1946 '("\\([A-Za-z][A-Za-z0-9_]+\\)\\s-*(" 1 font-lock-function-name-face)
2005
2006 ))) 1947 )))
2007 1948
2008 (setq verilog-font-lock-keywords-3 1949 (setq verilog-font-lock-keywords-3
@@ -2015,15 +1956,14 @@ See also `verilog-font-lock-extra-types'.")
2015 ))))) 1956 )))))
2016 1957
2017 1958
2018
2019(defun verilog-inside-comment-p () 1959(defun verilog-inside-comment-p ()
2020 "Check if point inside a nested comment." 1960 "Check if point inside a nested comment."
2021 (save-excursion 1961 (save-excursion
2022 (let ((st-point (point)) hitbeg) 1962 (let ((st-point (point)) hitbeg)
2023 (or (search-backward "//" (verilog-get-beg-of-line) t) 1963 (or (search-backward "//" (verilog-get-beg-of-line) t)
2024 (if (progn 1964 (if (progn
2025 ;; This is for tricky case //*, we keep searching if /* is 1965 ;; This is for tricky case //*, we keep searching if /*
2026 ;; proceeded by // on same line. 1966 ;; is proceeded by // on same line.
2027 (while 1967 (while
2028 (and (setq hitbeg (search-backward "/*" nil t)) 1968 (and (setq hitbeg (search-backward "/*" nil t))
2029 (progn 1969 (progn
@@ -2048,14 +1988,14 @@ Use filename, if current buffer being edited shorten to just buffer name."
2048 "Move backward over a sexp." 1988 "Move backward over a sexp."
2049 (interactive) 1989 (interactive)
2050 ;; before that see if we are in a comment 1990 ;; before that see if we are in a comment
2051 (verilog-backward-sexp) 1991 (verilog-backward-sexp))
2052) 1992
2053(defun electric-verilog-forward-sexp () 1993(defun electric-verilog-forward-sexp ()
2054 "Move backward over a sexp." 1994 "Move backward over a sexp."
2055 (interactive) 1995 (interactive)
2056 ;; before that see if we are in a comment 1996 ;; before that see if we are in a comment
2057 (verilog-forward-sexp) 1997 (verilog-forward-sexp))
2058) 1998
2059;;;used by hs-minor-mode 1999;;;used by hs-minor-mode
2060(defun verilog-forward-sexp-function (arg) 2000(defun verilog-forward-sexp-function (arg)
2061 (if (< arg 0) 2001 (if (< arg 0)
@@ -2067,19 +2007,16 @@ Use filename, if current buffer being edited shorten to just buffer name."
2067 (let ((reg) 2007 (let ((reg)
2068 (elsec 1) 2008 (elsec 1)
2069 (found nil) 2009 (found nil)
2070 (st (point)) 2010 (st (point)))
2071 )
2072 (if (not (looking-at "\\<")) 2011 (if (not (looking-at "\\<"))
2073 (forward-word -1)) 2012 (forward-word -1))
2074 (cond 2013 (cond
2075 ((verilog-skip-backward-comment-or-string) 2014 ((verilog-skip-backward-comment-or-string))
2076 )
2077 ((looking-at "\\<else\\>") 2015 ((looking-at "\\<else\\>")
2078 (setq reg (concat 2016 (setq reg (concat
2079 verilog-end-block-re 2017 verilog-end-block-re
2080 "\\|\\(\\<else\\>\\)" 2018 "\\|\\(\\<else\\>\\)"
2081 "\\|\\(\\<if\\>\\)" 2019 "\\|\\(\\<if\\>\\)"))
2082 ))
2083 (while (and (not found) 2020 (while (and (not found)
2084 (verilog-re-search-backward reg nil 'move)) 2021 (verilog-re-search-backward reg nil 'move))
2085 (cond 2022 (cond
@@ -2094,11 +2031,7 @@ Use filename, if current buffer being edited shorten to just buffer name."
2094 (setq elsec (1- elsec)) 2031 (setq elsec (1- elsec))
2095 (if (= 0 elsec) 2032 (if (= 0 elsec)
2096 ;; Now previous line describes syntax 2033 ;; Now previous line describes syntax
2097 (setq found 't) 2034 (setq found 't))))))
2098 ))
2099 )
2100 )
2101 )
2102 ((looking-at verilog-end-block-re) 2035 ((looking-at verilog-end-block-re)
2103 (verilog-leap-to-head)) 2036 (verilog-leap-to-head))
2104 ((looking-at "\\(endmodule\\>\\)\\|\\(\\<endprimitive\\>\\)\\|\\(\\<endclass\\>\\)\\|\\(\\<endprogram\\>\\)\\|\\(\\<endinterface\\>\\)\\|\\(\\<endpackage\\>\\)") 2037 ((looking-at "\\(endmodule\\>\\)\\|\\(\\<endprimitive\\>\\)\\|\\(\\<endclass\\>\\)\\|\\(\\<endprogram\\>\\)\\|\\(\\<endinterface\\>\\)\\|\\(\\<endpackage\\>\\)")
@@ -2120,9 +2053,7 @@ Use filename, if current buffer being edited shorten to just buffer name."
2120 (backward-sexp 1)))) 2053 (backward-sexp 1))))
2121 (t 2054 (t
2122 (goto-char st) 2055 (goto-char st)
2123 (backward-sexp)) 2056 (backward-sexp)))))
2124 ) ;; cond
2125 ))
2126 2057
2127(defun verilog-forward-sexp () 2058(defun verilog-forward-sexp ()
2128 (let ((reg) 2059 (let ((reg)
@@ -2132,8 +2063,7 @@ Use filename, if current buffer being edited shorten to just buffer name."
2132 (forward-word -1)) 2063 (forward-word -1))
2133 (cond 2064 (cond
2134 ((verilog-skip-forward-comment-or-string) 2065 ((verilog-skip-forward-comment-or-string)
2135 (verilog-forward-syntactic-ws) 2066 (verilog-forward-syntactic-ws))
2136 )
2137 ((looking-at verilog-beg-block-re-ordered);; begin|case|fork|class|table|specify|function|task|generate|covergroup|property|sequence|clocking 2067 ((looking-at verilog-beg-block-re-ordered);; begin|case|fork|class|table|specify|function|task|generate|covergroup|property|sequence|clocking
2138 (cond 2068 (cond
2139 ((match-end 1) ; end 2069 ((match-end 1) ; end
@@ -2141,8 +2071,7 @@ Use filename, if current buffer being edited shorten to just buffer name."
2141 (setq reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)" )) 2071 (setq reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)" ))
2142 ((match-end 2) ; endcase 2072 ((match-end 2) ; endcase
2143 ;; Search forward for matching case 2073 ;; Search forward for matching case
2144 (setq reg "\\(\\<randcase\\>\\|\\(\\<unique\\>\\s-+\\|\\<priority\\>\\s-+\\)?\\<case[xz]?\\>[^:]\\)\\|\\(\\<endcase\\>\\)" ) 2074 (setq reg "\\(\\<randcase\\>\\|\\(\\<unique\\>\\s-+\\|\\<priority\\>\\s-+\\)?\\<case[xz]?\\>[^:]\\)\\|\\(\\<endcase\\>\\)" ))
2145 )
2146 ((match-end 3) ; join 2075 ((match-end 3) ; join
2147 ;; Search forward for matching fork 2076 ;; Search forward for matching fork
2148 (setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" )) 2077 (setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" ))
@@ -2173,12 +2102,10 @@ Use filename, if current buffer being edited shorten to just buffer name."
2173 ((match-end 12) ; endsequence 2102 ((match-end 12) ; endsequence
2174 ;; Search forward for matching sequence 2103 ;; Search forward for matching sequence
2175 (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)" ) 2104 (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)" )
2176 (setq md 3) ; 3 to get to endsequence in the reg above 2105 (setq md 3)) ; 3 to get to endsequence in the reg above
2177 )
2178 ((match-end 13) ; endclocking 2106 ((match-end 13) ; endclocking
2179 ;; Search forward for matching clocking 2107 ;; Search forward for matching clocking
2180 (setq reg "\\(\\<clocking\\>\\)\\|\\(\\<endclocking\\>\\)" )) 2108 (setq reg "\\(\\<clocking\\>\\)\\|\\(\\<endclocking\\>\\)" )))
2181 )
2182 (if (forward-word 1) 2109 (if (forward-word 1)
2183 (catch 'skip 2110 (catch 'skip
2184 (let ((nest 1)) 2111 (let ((nest 1))
@@ -2189,9 +2116,7 @@ Use filename, if current buffer being edited shorten to just buffer name."
2189 (if (= 0 nest) ; we are out! 2116 (if (= 0 nest) ; we are out!
2190 (throw 'skip 1))) 2117 (throw 'skip 1)))
2191 ((match-end 1) ; the opener in reg, so we are deeper now 2118 ((match-end 1) ; the opener in reg, so we are deeper now
2192 (setq nest (1+ nest))))) 2119 (setq nest (1+ nest)))))))))
2193 )))
2194 )
2195 ((looking-at (concat 2120 ((looking-at (concat
2196 "\\(\\<\\(macro\\)?module\\>\\)\\|" 2121 "\\(\\<\\(macro\\)?module\\>\\)\\|"
2197 "\\(\\<primitive\\>\\)\\|" 2122 "\\(\\<primitive\\>\\)\\|"
@@ -2221,9 +2146,7 @@ Use filename, if current buffer being edited shorten to just buffer name."
2221 (goto-char st) 2146 (goto-char st)
2222 (if (= (following-char) ?\) ) 2147 (if (= (following-char) ?\) )
2223 (forward-char 1) 2148 (forward-char 1)
2224 (forward-sexp 1))) 2149 (forward-sexp 1))))))
2225 ) ;; cond
2226 ))
2227 2150
2228(defun verilog-declaration-beg () 2151(defun verilog-declaration-beg ()
2229 (verilog-re-search-backward verilog-declaration-re (bobp) t)) 2152 (verilog-re-search-backward verilog-declaration-re (bobp) t))
@@ -2238,8 +2161,7 @@ Use filename, if current buffer being edited shorten to just buffer name."
2238 (list 2161 (list
2239 ;; Fontify things in translate off regions 2162 ;; Fontify things in translate off regions
2240 '(verilog-match-translate-off 2163 '(verilog-match-translate-off
2241 (0 'verilog-font-lock-translate-off-face prepend)) 2164 (0 'verilog-font-lock-translate-off-face prepend))))))
2242 ))))
2243 (put 'verilog-mode 'font-lock-defaults 2165 (put 'verilog-mode 'font-lock-defaults
2244 '((verilog-font-lock-keywords 2166 '((verilog-font-lock-keywords
2245 verilog-font-lock-keywords-1 2167 verilog-font-lock-keywords-1
@@ -2253,23 +2175,7 @@ Use filename, if current buffer being edited shorten to just buffer name."
2253 2175
2254;; initialize fontification for Verilog Mode 2176;; initialize fontification for Verilog Mode
2255(verilog-font-lock-init) 2177(verilog-font-lock-init)
2256;; start up message 2178
2257(defconst verilog-startup-message-lines
2258 '("Please use \\[verilog-submit-bug-report] to report bugs."
2259 "Visit http://www.verilog.com to check for updates"
2260 ))
2261(defvar verilog-startup-message-displayed t)
2262(defun verilog-display-startup-message ()
2263 (if (not verilog-startup-message-displayed)
2264 (if (sit-for 5)
2265 (let ((lines verilog-startup-message-lines))
2266 (message "verilog-mode version %s, released %s; type \\[describe-mode] for help"
2267 verilog-mode-version verilog-mode-release-date)
2268 (setq verilog-startup-message-displayed t)
2269 (while (and (sit-for 4) lines)
2270 (message (substitute-command-keys (car lines)))
2271 (setq lines (cdr lines)))))
2272 (message "")))
2273;; 2179;;
2274;; 2180;;
2275;; Mode 2181;; Mode
@@ -2409,14 +2315,10 @@ Key bindings specific to `verilog-mode-map' are:
2409 (setq major-mode 'verilog-mode) 2315 (setq major-mode 'verilog-mode)
2410 (setq mode-name "Verilog") 2316 (setq mode-name "Verilog")
2411 (setq local-abbrev-table verilog-mode-abbrev-table) 2317 (setq local-abbrev-table verilog-mode-abbrev-table)
2412 (setq verilog-mode-syntax-table (make-syntax-table)) 2318 (set (make-local-variable 'beginning-of-defun-function)
2413 (verilog-populate-syntax-table verilog-mode-syntax-table)
2414 (set (make-local-variable 'beginning-of-defun-function)
2415 'verilog-beg-of-defun) 2319 'verilog-beg-of-defun)
2416 (set (make-local-variable 'end-of-defun-function) 2320 (set (make-local-variable 'end-of-defun-function)
2417 'verilog-end-of-defun) 2321 'verilog-end-of-defun)
2418 ;; add extra comment syntax
2419 (verilog-setup-dual-comments verilog-mode-syntax-table)
2420 (set-syntax-table verilog-mode-syntax-table) 2322 (set-syntax-table verilog-mode-syntax-table)
2421 (make-local-variable 'indent-line-function) 2323 (make-local-variable 'indent-line-function)
2422 (setq indent-line-function 'verilog-indent-line-relative) 2324 (setq indent-line-function 'verilog-indent-line-relative)
@@ -2444,8 +2346,8 @@ Key bindings specific to `verilog-mode-map' are:
2444 (not (assoc "Verilog" current-menubar))) 2346 (not (assoc "Verilog" current-menubar)))
2445 ;; (set-buffer-menubar (copy-sequence current-menubar)) 2347 ;; (set-buffer-menubar (copy-sequence current-menubar))
2446 (add-submenu nil verilog-xemacs-menu) 2348 (add-submenu nil verilog-xemacs-menu)
2447 (add-submenu nil verilog-stmt-menu) 2349 (add-submenu nil verilog-stmt-menu)))
2448 )) 2350
2449 ;; Stuff for GNU emacs 2351 ;; Stuff for GNU emacs
2450 (set (make-local-variable 'font-lock-defaults) 2352 (set (make-local-variable 'font-lock-defaults)
2451 '((verilog-font-lock-keywords verilog-font-lock-keywords-1 2353 '((verilog-font-lock-keywords verilog-font-lock-keywords-1
@@ -2472,8 +2374,6 @@ Key bindings specific to `verilog-mode-map' are:
2472 (cons '(verilog-mode-mode "\\<begin\\>" "\\<end\\>" nil 2374 (cons '(verilog-mode-mode "\\<begin\\>" "\\<end\\>" nil
2473 verilog-forward-sexp-function) 2375 verilog-forward-sexp-function)
2474 hs-special-modes-alist))) 2376 hs-special-modes-alist)))
2475 ;; Display version splash information.
2476 (verilog-display-startup-message)
2477 2377
2478 ;; Stuff for autos 2378 ;; Stuff for autos
2479 (add-hook 'write-contents-hooks 'verilog-auto-save-check) ; already local 2379 (add-hook 'write-contents-hooks 'verilog-auto-save-check) ; already local
@@ -2527,27 +2427,19 @@ With optional ARG, remove existing end of line comments."
2527 (progn 2427 (progn
2528 (end-of-line) 2428 (end-of-line)
2529 (delete-horizontal-space) 2429 (delete-horizontal-space)
2530 't 2430 't)))
2531 )
2532 )
2533 )
2534 ;; see if we should line up assignments 2431 ;; see if we should line up assignments
2535 (progn 2432 (progn
2536 (if (or (memq 'all verilog-auto-lineup) 2433 (if (or (memq 'all verilog-auto-lineup)
2537 (memq 'assignments verilog-auto-lineup)) 2434 (memq 'assignments verilog-auto-lineup))
2538 (verilog-pretty-expr) 2435 (verilog-pretty-expr))
2539 ) 2436 (newline))
2540 (newline) 2437 (forward-line 1))
2541 )
2542 (forward-line 1)
2543 )
2544 ;; Indent next line 2438 ;; Indent next line
2545 (if verilog-auto-indent-on-newline 2439 (if verilog-auto-indent-on-newline
2546 (verilog-indent-line)) 2440 (verilog-indent-line)))
2547 )
2548 (t 2441 (t
2549 (newline)) 2442 (newline)))))
2550 )))
2551 2443
2552(defun electric-verilog-terminate-and-indent () 2444(defun electric-verilog-terminate-and-indent ()
2553 "Insert a newline and indent for the next statement." 2445 "Insert a newline and indent for the next statement."
@@ -2565,8 +2457,7 @@ With optional ARG, remove existing end of line comments."
2565 (save-excursion 2457 (save-excursion
2566 (beginning-of-line) 2458 (beginning-of-line)
2567 (verilog-forward-ws&directives) 2459 (verilog-forward-ws&directives)
2568 (verilog-indent-line) 2460 (verilog-indent-line))
2569 )
2570 (if (and verilog-auto-newline 2461 (if (and verilog-auto-newline
2571 (not (verilog-parenthesis-depth))) 2462 (not (verilog-parenthesis-depth)))
2572 (electric-verilog-terminate-line)))) 2463 (electric-verilog-terminate-line))))
@@ -2648,9 +2539,7 @@ With optional ARG, remove existing end of line comments."
2648 (re-search-forward comment-start-skip oldpnt 'move) 2539 (re-search-forward comment-start-skip oldpnt 'move)
2649 (goto-char (match-beginning 0)) 2540 (goto-char (match-beginning 0))
2650 (skip-chars-backward " \t") 2541 (skip-chars-backward " \t")
2651 (kill-region (point) oldpnt) 2542 (kill-region (point) oldpnt))))))
2652 ))))
2653 )
2654 (progn (insert "\t")))) 2543 (progn (insert "\t"))))
2655 2544
2656 2545
@@ -2690,7 +2579,7 @@ To call this from the command line, see \\[verilog-batch-indent]."
2690 (insert " * ")) 2579 (insert " * "))
2691 2580
2692(defun verilog-insert-1 (fmt max) 2581(defun verilog-insert-1 (fmt max)
2693 "Insert integers 0 to MAX-1 according to format string FMT. 2582 "Use format string FMT to insert integers 0 to MAX - 1.
2694Inserts one integer per line, at the current column. Stops early 2583Inserts one integer per line, at the current column. Stops early
2695if it reaches the end of the buffer." 2584if it reaches the end of the buffer."
2696 (let ((col (current-column)) 2585 (let ((col (current-column))
@@ -2724,7 +2613,7 @@ located after the first 'a' gives:
2724 a = b a[ 7] = b 2613 a = b a[ 7] = b
2725 a = b a[ 8] = b" 2614 a = b a[ 8] = b"
2726 2615
2727 (interactive "NMAX? ") 2616 (interactive "NMAX: ")
2728 (verilog-insert-1 "[%3d]" max)) 2617 (verilog-insert-1 "[%3d]" max))
2729 2618
2730(defun verilog-generate-numbers (max) 2619(defun verilog-generate-numbers (max)
@@ -2744,19 +2633,20 @@ following code fragment:
2744 buf buf buf buf007 2633 buf buf buf buf007
2745 buf buf buf buf008" 2634 buf buf buf buf008"
2746 2635
2747 (interactive "NMAX? ") 2636 (interactive "NMAX: ")
2748 (verilog-insert-1 "%3.3d" max)) 2637 (verilog-insert-1 "%3.3d" max))
2749 2638
2750(defun verilog-mark-defun () 2639(defun verilog-mark-defun ()
2751 "Mark the current verilog function (or procedure). 2640 "Mark the current verilog function (or procedure).
2752This puts the mark at the end, and point at the beginning." 2641This puts the mark at the end, and point at the beginning."
2753 (interactive) 2642 (interactive)
2754 (push-mark (point)) 2643 (when (featurep 'xemacs)
2755 (verilog-end-of-defun) 2644 (push-mark (point))
2756 (push-mark (point)) 2645 (verilog-end-of-defun)
2757 (verilog-beg-of-defun) 2646 (push-mark (point))
2758 (if (fboundp 'zmacs-activate-region) 2647 (verilog-beg-of-defun)
2759 (zmacs-activate-region))) 2648 (if (fboundp 'zmacs-activate-region)
2649 (zmacs-activate-region))))
2760 2650
2761(defun verilog-comment-region (start end) 2651(defun verilog-comment-region (start end)
2762 ; checkdoc-params: (start end) 2652 ; checkdoc-params: (start end)
@@ -2792,8 +2682,7 @@ The commented area starts with `verilog-exclude-str-start', and ends with
2792 (save-excursion 2682 (save-excursion
2793 (let ((s+1 (1+ start))) 2683 (let ((s+1 (1+ start)))
2794 (while (re-search-backward "/\\*" s+1 t) 2684 (while (re-search-backward "/\\*" s+1 t)
2795 (replace-match "/-*" t t)))) 2685 (replace-match "/-*" t t))))))
2796 ))
2797 2686
2798(defun verilog-uncomment-region () 2687(defun verilog-uncomment-region ()
2799 "Uncomment a commented area; change deformed comments back to normal. 2688 "Uncomment a commented area; change deformed comments back to normal.
@@ -2869,8 +2758,7 @@ With ARG, first kill any existing labels."
2869 (point-marker))) 2758 (point-marker)))
2870 (e (progn 2759 (e (progn
2871 (verilog-end-of-defun) 2760 (verilog-end-of-defun)
2872 (point-marker))) 2761 (point-marker))))
2873 )
2874 (goto-char (marker-position b)) 2762 (goto-char (marker-position b))
2875 (if (> (- e b) 200) 2763 (if (> (- e b) 200)
2876 (message "Relabeling module...")) 2764 (message "Relabeling module..."))
@@ -2885,18 +2773,15 @@ With ARG, first kill any existing labels."
2885 (let ((indent-str (verilog-indent-line))) 2773 (let ((indent-str (verilog-indent-line)))
2886 (verilog-set-auto-endcomments indent-str 't) 2774 (verilog-set-auto-endcomments indent-str 't)
2887 (end-of-line) 2775 (end-of-line)
2888 (delete-horizontal-space) 2776 (delete-horizontal-space))
2889 )
2890 (setq cnt (1+ cnt)) 2777 (setq cnt (1+ cnt))
2891 (if (= 9 (% cnt 10)) 2778 (if (= 9 (% cnt 10))
2892 (message "%d..." cnt)) 2779 (message "%d..." cnt)))
2893 )
2894 (goto-char oldpos) 2780 (goto-char oldpos)
2895 (if (or 2781 (if (or
2896 (> (- e b) 200) 2782 (> (- e b) 200)
2897 (> cnt 20)) 2783 (> cnt 20))
2898 (message "%d lines auto commented" cnt)) 2784 (message "%d lines auto commented" cnt))))
2899 ))
2900 2785
2901(defun verilog-beg-of-statement () 2786(defun verilog-beg-of-statement ()
2902 "Move backward to beginning of statement." 2787 "Move backward to beginning of statement."
@@ -2919,15 +2804,13 @@ With ARG, first kill any existing labels."
2919 (looking-at verilog-extended-complete-re) 2804 (looking-at verilog-extended-complete-re)
2920 (not (save-excursion 2805 (not (save-excursion
2921 (verilog-backward-token) 2806 (verilog-backward-token)
2922 (looking-at verilog-extended-complete-re))) 2807 (looking-at verilog-extended-complete-re))))
2923 )
2924 (looking-at verilog-basic-complete-re) 2808 (looking-at verilog-basic-complete-re)
2925 (save-excursion 2809 (save-excursion
2926 (verilog-backward-token) 2810 (verilog-backward-token)
2927 (or 2811 (or
2928 (looking-at verilog-end-block-re) 2812 (looking-at verilog-end-block-re)
2929 (looking-at verilog-preprocessor-re))) 2813 (looking-at verilog-preprocessor-re)))))
2930 ))
2931 (verilog-backward-syntactic-ws) 2814 (verilog-backward-syntactic-ws)
2932 (verilog-backward-token)) 2815 (verilog-backward-token))
2933 ;; Now point is where the previous line ended. 2816 ;; Now point is where the previous line ended.
@@ -3011,9 +2894,9 @@ more specifically, point @ in the line foo : @ begin"
3011 (throw 'found 1)) 2894 (throw 'found 1))
3012 (setq nest (1- nest))) 2895 (setq nest (1- nest)))
3013 (t 2896 (t
3014 (throw 'found (= nest 0))) 2897 (throw 'found (= nest 0)))))))
3015 ))))
3016 nil))) 2898 nil)))
2899
3017(defun verilog-in-struct-region-p () 2900(defun verilog-in-struct-region-p ()
3018 "Return TRUE if in a struct region; 2901 "Return TRUE if in a struct region;
3019more specifically, in a list after a struct|union keyword" 2902more specifically, in a list after a struct|union keyword"
@@ -3024,20 +2907,14 @@ more specifically, in a list after a struct|union keyword"
3024 (if depth 2907 (if depth
3025 (progn (backward-up-list depth) 2908 (progn (backward-up-list depth)
3026 (verilog-beg-of-statement) 2909 (verilog-beg-of-statement)
3027 (looking-at "\\<typedef\\>?\\s-*\\<struct\\|union\\>") 2910 (looking-at "\\<typedef\\>?\\s-*\\<struct\\|union\\>"))))))
3028 )
3029 )
3030 )
3031 )
3032 )
3033 2911
3034(defun verilog-in-generate-region-p () 2912(defun verilog-in-generate-region-p ()
3035 "Return TRUE if in a generate region; 2913 "Return TRUE if in a generate region;
3036more specifically, after a generate and before an endgenerate" 2914more specifically, after a generate and before an endgenerate"
3037 (interactive) 2915 (interactive)
3038 (let ((lim (save-excursion (verilog-beg-of-defun) (point))) 2916 (let ((lim (save-excursion (verilog-beg-of-defun) (point)))
3039 (nest 1) 2917 (nest 1))
3040 )
3041 (save-excursion 2918 (save-excursion
3042 (while (and 2919 (while (and
3043 (/= nest 0) 2920 (/= nest 0)
@@ -3046,17 +2923,14 @@ more specifically, after a generate and before an endgenerate"
3046 ((match-end 1) ; generate 2923 ((match-end 1) ; generate
3047 (setq nest (1- nest))) 2924 (setq nest (1- nest)))
3048 ((match-end 2) ; endgenerate 2925 ((match-end 2) ; endgenerate
3049 (setq nest (1+ nest))) 2926 (setq nest (1+ nest)))))))
3050 ))
3051 ))
3052 (= nest 0) )) ; return nest 2927 (= nest 0) )) ; return nest
3053 2928
3054(defun verilog-in-fork-region-p () 2929(defun verilog-in-fork-region-p ()
3055 "Return true if between a fork and join." 2930 "Return true if between a fork and join."
3056 (interactive) 2931 (interactive)
3057 (let ((lim (save-excursion (verilog-beg-of-defun) (point))) 2932 (let ((lim (save-excursion (verilog-beg-of-defun) (point)))
3058 (nest 1) 2933 (nest 1))
3059 )
3060 (save-excursion 2934 (save-excursion
3061 (while (and 2935 (while (and
3062 (/= nest 0) 2936 (/= nest 0)
@@ -3065,9 +2939,7 @@ more specifically, after a generate and before an endgenerate"
3065 ((match-end 1) ; fork 2939 ((match-end 1) ; fork
3066 (setq nest (1- nest))) 2940 (setq nest (1- nest)))
3067 ((match-end 2) ; join 2941 ((match-end 2) ; join
3068 (setq nest (1+ nest))) 2942 (setq nest (1+ nest)))))))
3069 ))
3070 ))
3071 (= nest 0) )) ; return nest 2943 (= nest 0) )) ; return nest
3072 2944
3073(defun verilog-backward-case-item (lim) 2945(defun verilog-backward-case-item (lim)
@@ -3099,8 +2971,7 @@ Limit search to point LIM."
3099 (setq colon (1- colon))) 2971 (setq colon (1- colon)))
3100 2972
3101 ((match-end 3) ;; : 2973 ((match-end 3) ;; :
3102 (setq colon (1+ colon))) 2974 (setq colon (1+ colon)))))
3103 ))
3104 ;; Skip back to beginning of case item 2975 ;; Skip back to beginning of case item
3105 (skip-chars-backward "\t ") 2976 (skip-chars-backward "\t ")
3106 (verilog-skip-backward-comment-or-string) 2977 (verilog-skip-backward-comment-or-string)
@@ -3123,10 +2994,8 @@ Limit search to point LIM."
3123 (t 2994 (t
3124 (goto-char (match-end 0)) 2995 (goto-char (match-end 0))
3125 (verilog-forward-ws&directives) 2996 (verilog-forward-ws&directives)
3126 (point)) 2997 (point))))
3127 )) 2998 (error "Malformed case item"))))
3128 (error "Malformed case item")
3129 )))
3130 (setq str (buffer-substring b e)) 2999 (setq str (buffer-substring b e))
3131 (if 3000 (if
3132 (setq e 3001 (setq e
@@ -3178,8 +3047,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter
3178 (search-backward "//" (verilog-get-beg-of-line) t))))) 3047 (search-backward "//" (verilog-get-beg-of-line) t)))))
3179 (let ((nest 1) b e 3048 (let ((nest 1) b e
3180 m 3049 m
3181 (else (if (match-end 2) "!" " ")) 3050 (else (if (match-end 2) "!" " ")))
3182 )
3183 (end-of-line) 3051 (end-of-line)
3184 (if kill-existing-comment 3052 (if kill-existing-comment
3185 (verilog-kill-existing-comment)) 3053 (verilog-kill-existing-comment))
@@ -3199,8 +3067,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter
3199 ((match-end 4) ; `ifdef 3067 ((match-end 4) ; `ifdef
3200 (setq nest (1- nest))) 3068 (setq nest (1- nest)))
3201 ((match-end 5) ; `ifndef 3069 ((match-end 5) ; `ifndef
3202 (setq nest (1- nest))) 3070 (setq nest (1- nest)))))
3203 ))
3204 (if (match-end 0) 3071 (if (match-end 0)
3205 (setq 3072 (setq
3206 m (buffer-substring 3073 m (buffer-substring
@@ -3212,15 +3079,13 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter
3212 (point)) 3079 (point))
3213 e (progn 3080 e (progn
3214 (skip-chars-forward "a-zA-Z0-9_") 3081 (skip-chars-forward "a-zA-Z0-9_")
3215 (point) 3082 (point)))))
3216 ))))
3217 (if b 3083 (if b
3218 (if (> (count-lines (point) b) verilog-minimum-comment-distance) 3084 (if (> (count-lines (point) b) verilog-minimum-comment-distance)
3219 (insert (concat " // " else m " " (buffer-substring b e)))) 3085 (insert (concat " // " else m " " (buffer-substring b e))))
3220 (progn 3086 (progn
3221 (insert " // unmatched `else or `endif") 3087 (insert " // unmatched `else or `endif")
3222 (ding 't)) 3088 (ding 't)))))
3223 )))
3224 3089
3225 (; Comment close case/class/function/task/module and named block 3090 (; Comment close case/class/function/task/module and named block
3226 (and (looking-at "\\<end") 3091 (and (looking-at "\\<end")
@@ -3269,8 +3134,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter
3269 (err 't) 3134 (err 't)
3270 (here (point)) 3135 (here (point))
3271 there 3136 there
3272 cntx 3137 cntx)
3273 )
3274 (save-excursion 3138 (save-excursion
3275 (verilog-leap-to-head) 3139 (verilog-leap-to-head)
3276 (setq there (point)) 3140 (setq there (point))
@@ -3282,12 +3146,10 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter
3282 (verilog-kill-existing-comment)) 3146 (verilog-kill-existing-comment))
3283 (delete-horizontal-space) 3147 (delete-horizontal-space)
3284 (insert str) 3148 (insert str)
3285 (ding 't) 3149 (ding 't))
3286 )
3287 (let ((lim 3150 (let ((lim
3288 (save-excursion (verilog-beg-of-defun) (point))) 3151 (save-excursion (verilog-beg-of-defun) (point)))
3289 (here (point)) 3152 (here (point)))
3290 )
3291 (cond 3153 (cond
3292 (;-- handle named block differently 3154 (;-- handle named block differently
3293 (looking-at verilog-named-block-re) 3155 (looking-at verilog-named-block-re)
@@ -3336,8 +3198,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter
3336 (;- else 3198 (;- else
3337 (match-end 4) 3199 (match-end 4)
3338 (let ((nest 0) 3200 (let ((nest 0)
3339 ( reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)") 3201 ( reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)"))
3340 )
3341 (catch 'skip 3202 (catch 'skip
3342 (while (verilog-re-search-backward reg nil 'move) 3203 (while (verilog-re-search-backward reg nil 'move)
3343 (cond 3204 (cond
@@ -3353,16 +3214,13 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter
3353 (setq err nil) 3214 (setq err nil)
3354 (setq str (verilog-get-expr)) 3215 (setq str (verilog-get-expr))
3355 (setq str (concat " // else: !if" str )) 3216 (setq str (concat " // else: !if" str ))
3356 (throw 'skip 1)) 3217 (throw 'skip 1)))))))))
3357 )))
3358 ))))
3359 3218
3360 (;- end else 3219 (;- end else
3361 (match-end 5) 3220 (match-end 5)
3362 (goto-char there) 3221 (goto-char there)
3363 (let ((nest 0) 3222 (let ((nest 0)
3364 ( reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)") 3223 (reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)"))
3365 )
3366 (catch 'skip 3224 (catch 'skip
3367 (while (verilog-re-search-backward reg nil 'move) 3225 (while (verilog-re-search-backward reg nil 'move)
3368 (cond 3226 (cond
@@ -3378,9 +3236,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter
3378 (setq err nil) 3236 (setq err nil)
3379 (setq str (verilog-get-expr)) 3237 (setq str (verilog-get-expr))
3380 (setq str (concat " // else: !if" str )) 3238 (setq str (concat " // else: !if" str ))
3381 (throw 'skip 1)) 3239 (throw 'skip 1)))))))))
3382 )))
3383 ))))
3384 3240
3385 (;- task/function/initial et cetera 3241 (;- task/function/initial et cetera
3386 t 3242 t
@@ -3392,8 +3248,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter
3392 (setq str (concat " // " cntx str ))) 3248 (setq str (concat " // " cntx str )))
3393 3249
3394 (;-- otherwise... 3250 (;-- otherwise...
3395 (setq str " // auto-endcomment confused ")) 3251 (setq str " // auto-endcomment confused "))))
3396 ))
3397 3252
3398 ((and 3253 ((and
3399 (verilog-in-case-region-p) ;-- handle case item differently 3254 (verilog-in-case-region-p) ;-- handle case item differently
@@ -3431,9 +3286,8 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter
3431 (match-end 11) ;; of verilog-end-block-ordered-re 3286 (match-end 11) ;; of verilog-end-block-ordered-re
3432 ;;(goto-char there) 3287 ;;(goto-char there)
3433 (let ((nest 0) 3288 (let ((nest 0)
3434 ( reg "\\<\\(class\\)\\|\\(endclass\\)\\|\\(package\\|primitive\\|\\(macro\\)?module\\)\\>") 3289 (reg "\\<\\(class\\)\\|\\(endclass\\)\\|\\(package\\|primitive\\|\\(macro\\)?module\\)\\>")
3435 string 3290 string)
3436 )
3437 (save-excursion 3291 (save-excursion
3438 (catch 'skip 3292 (catch 'skip
3439 (while (verilog-re-search-backward reg nil 'move) 3293 (while (verilog-re-search-backward reg nil 'move)
@@ -3463,8 +3317,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter
3463 (throw 'skip 1)))) 3317 (throw 'skip 1))))
3464 )))) 3318 ))))
3465 (end-of-line) 3319 (end-of-line)
3466 (insert (concat " // " string ))) 3320 (insert (concat " // " string ))))
3467 )
3468 3321
3469 (;- this is end{function,generate,task,module,primitive,table,generate} 3322 (;- this is end{function,generate,task,module,primitive,table,generate}
3470 ;- which can not be nested. 3323 ;- which can not be nested.
@@ -3479,8 +3332,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter
3479 (cond 3332 (cond
3480 ((match-end 5) ;; of verilog-end-block-ordered-re 3333 ((match-end 5) ;; of verilog-end-block-ordered-re
3481 (setq reg "\\(\\<function\\>\\)\\|\\(\\<\\(endfunction\\|task\\|\\(macro\\)?module\\|primitive\\)\\>\\)") 3334 (setq reg "\\(\\<function\\>\\)\\|\\(\\<\\(endfunction\\|task\\|\\(macro\\)?module\\|primitive\\)\\>\\)")
3482 (setq width "\\(\\s-*\\(\\[[^]]*\\]\\)\\|\\(real\\(time\\)?\\)\\|\\(integer\\)\\|\\(time\\)\\)?") 3335 (setq width "\\(\\s-*\\(\\[[^]]*\\]\\)\\|\\(real\\(time\\)?\\)\\|\\(integer\\)\\|\\(time\\)\\)?"))
3483 )
3484 ((match-end 6) ;; of verilog-end-block-ordered-re 3336 ((match-end 6) ;; of verilog-end-block-ordered-re
3485 (setq reg "\\(\\<task\\>\\)\\|\\(\\<\\(endtask\\|function\\|\\(macro\\)?module\\|primitive\\)\\>\\)")) 3337 (setq reg "\\(\\<task\\>\\)\\|\\(\\<\\(endtask\\|function\\|\\(macro\\)?module\\|primitive\\)\\>\\)"))
3486 ((match-end 7) ;; of verilog-end-block-ordered-re 3338 ((match-end 7) ;; of verilog-end-block-ordered-re
@@ -3502,8 +3354,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter
3502 ((match-end 15) ;; of verilog-end-block-ordered-re 3354 ((match-end 15) ;; of verilog-end-block-ordered-re
3503 (setq reg "\\(\\<clocking\\>\\)\\|\\<endclocking\\>")) 3355 (setq reg "\\(\\<clocking\\>\\)\\|\\<endclocking\\>"))
3504 3356
3505 (t (error "Problem in verilog-set-auto-endcomments")) 3357 (t (error "Problem in verilog-set-auto-endcomments")))
3506 )
3507 (let (b e) 3358 (let (b e)
3508 (save-excursion 3359 (save-excursion
3509 (verilog-re-search-backward reg nil 'move) 3360 (verilog-re-search-backward reg nil 'move)
@@ -3515,8 +3366,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter
3515 (if (and width (looking-at width)) 3366 (if (and width (looking-at width))
3516 (progn 3367 (progn
3517 (goto-char (match-end 0)) 3368 (goto-char (match-end 0))
3518 (verilog-forward-ws&directives) 3369 (verilog-forward-ws&directives)))
3519 ))
3520 (point)) 3370 (point))
3521 e (progn 3371 e (progn
3522 (skip-chars-forward "a-zA-Z0-9_") 3372 (skip-chars-forward "a-zA-Z0-9_")
@@ -3577,8 +3427,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter
3577 b) 3427 b)
3578 ('t 3428 ('t
3579 (skip-chars-forward "^: \t\n\f") 3429 (skip-chars-forward "^: \t\n\f")
3580 (point) 3430 (point)))))
3581 ))))
3582 (str (buffer-substring b e))) 3431 (str (buffer-substring b e)))
3583 (if (setq e (string-match "[ \t]*\\(\\(\n\\)\\|\\(//\\)\\|\\(/\\*\\)\\)" str)) 3432 (if (setq e (string-match "[ \t]*\\(\\(\n\\)\\|\\(//\\)\\|\\(/\\*\\)\\)" str))
3584 (setq str (concat (substring str 0 e) "..."))) 3433 (setq str (concat (substring str 0 e) "...")))
@@ -3601,8 +3450,8 @@ Useful for creating tri's and other expanded fields."
3601 (concat "\\(.*\\)" 3450 (concat "\\(.*\\)"
3602 (regexp-quote bra) 3451 (regexp-quote bra)
3603 "\\([0-9]*\\)\\(:[0-9]*\\|\\)\\(::[0-9---]*\\|\\)" 3452 "\\([0-9]*\\)\\(:[0-9]*\\|\\)\\(::[0-9---]*\\|\\)"
3604 (regexp-quote ket) 3453 (regexp-quote ket)
3605 "\\(.*\\)$") signal-string) 3454 "\\(.*\\)$") signal-string)
3606 (let* ((sig-head (match-string 1 signal-string)) 3455 (let* ((sig-head (match-string 1 signal-string))
3607 (vec-start (string-to-number (match-string 2 signal-string))) 3456 (vec-start (string-to-number (match-string 2 signal-string)))
3608 (vec-end (if (= (match-beginning 3) (match-end 3)) 3457 (vec-end (if (= (match-beginning 3) (match-end 3))
@@ -3765,8 +3614,7 @@ becomes:
3765 ))) 3614 )))
3766 ((verilog-in-star-comment-p) 3615 ((verilog-in-star-comment-p)
3767 (re-search-backward "/\*") 3616 (re-search-backward "/\*")
3768 (insert (format " // surefire lint_off_line %6s" code )) 3617 (insert (format " // surefire lint_off_line %6s" code )))
3769 )
3770 (t 3618 (t
3771 (insert (format " // surefire lint_off_line %6s" code )) 3619 (insert (format " // surefire lint_off_line %6s" code ))
3772 ))))))))) 3620 )))))))))
@@ -3823,11 +3671,11 @@ This lets programs calling batch mode to easily extract error messages."
3823 (setq default-major-mode `verilog-mode) 3671 (setq default-major-mode `verilog-mode)
3824 ;; Ditto files already read in 3672 ;; Ditto files already read in
3825 (mapc (lambda (buf) 3673 (mapc (lambda (buf)
3826 (when (buffer-file-name buf) 3674 (when (buffer-file-name buf)
3827 (save-excursion 3675 (save-excursion
3828 (set-buffer buf) 3676 (set-buffer buf)
3829 (verilog-mode)))) 3677 (verilog-mode))))
3830 (buffer-list)) 3678 (buffer-list))
3831 ;; Process the files 3679 ;; Process the files
3832 (mapcar '(lambda (buf) 3680 (mapcar '(lambda (buf)
3833 (when (buffer-file-name buf) 3681 (when (buffer-file-name buf)
@@ -3943,8 +3791,7 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
3943 (not (verilog-in-coverage)) 3791 (not (verilog-in-coverage))
3944 (verilog-in-paren)) 3792 (verilog-in-paren))
3945 (progn (setq par 1) 3793 (progn (setq par 1)
3946 (throw 'nesting 'block)) 3794 (throw 'nesting 'block)))
3947 )
3948 3795
3949 ;; See if we are continuing a previous line 3796 ;; See if we are continuing a previous line
3950 (while t 3797 (while t
@@ -4026,8 +3873,7 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
4026 (setq reg "\\(\\<class\\>\\)\\|\\(\\<endclass\\>\\)" )) 3873 (setq reg "\\(\\<class\\>\\)\\|\\(\\<endclass\\>\\)" ))
4027 ((match-end 12) ; covergroup 3874 ((match-end 12) ; covergroup
4028 ;; Search back for matching covergroup 3875 ;; Search back for matching covergroup
4029 (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<endgroup\\>\\)" )) 3876 (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<endgroup\\>\\)" )))
4030 )
4031 (catch 'skip 3877 (catch 'skip
4032 (while (verilog-re-search-backward reg nil 'move) 3878 (while (verilog-re-search-backward reg nil 'move)
4033 (cond 3879 (cond
@@ -4037,11 +3883,8 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
4037 (throw 'skip 1))) 3883 (throw 'skip 1)))
4038 ((match-end 2) ; end 3884 ((match-end 2) ; end
4039 (setq nest (1+ nest))))) 3885 (setq nest (1+ nest)))))
4040 ) 3886 )))))))
4041 )) 3887 (throw 'nesting (verilog-calc-1)))
4042 ))))
4043 (throw 'nesting (verilog-calc-1))
4044 )
4045 );; catch nesting 3888 );; catch nesting
4046 );; type 3889 );; type
4047 ) 3890 )
@@ -4058,8 +3901,8 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
4058 ((eq type 'defun) 3901 ((eq type 'defun)
4059 (list type 0)) 3902 (list type 0))
4060 (t 3903 (t
4061 (list type (verilog-current-indent-level))))) 3904 (list type (verilog-current-indent-level))))))))
4062 ))) 3905
4063(defun verilog-wai () 3906(defun verilog-wai ()
4064 "Show matching nesting block for debugging." 3907 "Show matching nesting block for debugging."
4065 (interactive) 3908 (interactive)
@@ -4073,8 +3916,7 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
4073 (cond 3916 (cond
4074 ((equal (char-after) ?\{) 3917 ((equal (char-after) ?\{)
4075 (if (verilog-at-constraint-p) 3918 (if (verilog-at-constraint-p)
4076 (throw 'nesting 'block) 3919 (throw 'nesting 'block)))
4077 ))
4078 ((equal (char-after) ?\}) 3920 ((equal (char-after) ?\})
4079 3921
4080 (let ((there (verilog-at-close-constraint-p))) 3922 (let ((there (verilog-at-close-constraint-p)))
@@ -4133,8 +3975,7 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
4133For speed, the searcher looks at the last directive, not the indent 3975For speed, the searcher looks at the last directive, not the indent
4134of the appropriate enclosing block." 3976of the appropriate enclosing block."
4135 (let ((base -1) ;; Indent of the line that determines our indentation 3977 (let ((base -1) ;; Indent of the line that determines our indentation
4136 (ind 0) ;; Relative offset caused by other directives (like `endif on same line as `else) 3978 (ind 0)) ;; Relative offset caused by other directives (like `endif on same line as `else)
4137 )
4138 ;; Start at current location, scan back for another directive 3979 ;; Start at current location, scan back for another directive
4139 3980
4140 (save-excursion 3981 (save-excursion
@@ -4142,8 +3983,7 @@ of the appropriate enclosing block."
4142 (while (and (< base 0) 3983 (while (and (< base 0)
4143 (verilog-re-search-backward verilog-directive-re nil t)) 3984 (verilog-re-search-backward verilog-directive-re nil t))
4144 (cond ((save-excursion (skip-chars-backward " \t") (bolp)) 3985 (cond ((save-excursion (skip-chars-backward " \t") (bolp))
4145 (setq base (current-indentation)) 3986 (setq base (current-indentation))))
4146 ))
4147 (cond ((and (looking-at verilog-directive-end) (< base 0)) ;; Only matters when not at BOL 3987 (cond ((and (looking-at verilog-directive-end) (< base 0)) ;; Only matters when not at BOL
4148 (setq ind (- ind verilog-indent-level-directive))) 3988 (setq ind (- ind verilog-indent-level-directive)))
4149 ((and (looking-at verilog-directive-middle) (>= base 0)) ;; Only matters when at BOL 3989 ((and (looking-at verilog-directive-middle) (>= base 0)) ;; Only matters when at BOL
@@ -4223,8 +4063,7 @@ from endcase to matching case, and so on."
4223 (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)" )) 4063 (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)" ))
4224 ((looking-at "\\<endclocking\\>") 4064 ((looking-at "\\<endclocking\\>")
4225 ;; 12: Search back for matching clocking 4065 ;; 12: Search back for matching clocking
4226 (setq reg "\\(\\<clocking\\)\\|\\(\\<endclocking\\>\\)" )) 4066 (setq reg "\\(\\<clocking\\)\\|\\(\\<endclocking\\>\\)" )))
4227 )
4228 (if reg 4067 (if reg
4229 (catch 'skip 4068 (catch 'skip
4230 (let (sreg) 4069 (let (sreg)
@@ -4268,9 +4107,7 @@ Set point to where line starts"
4268 (save-excursion 4107 (save-excursion
4269 (skip-chars-backward " \t") 4108 (skip-chars-backward " \t")
4270 (not (bolp)))) 4109 (not (bolp))))
4271 (setq continued (verilog-backward-token)) 4110 (setq continued (verilog-backward-token)))))
4272 ) ;; while
4273 ))
4274 (setq continued nil)) 4111 (setq continued nil))
4275 continued)) 4112 continued))
4276 4113
@@ -4289,15 +4126,13 @@ Set point to where line starts"
4289 (= (preceding-char) ?\}) 4126 (= (preceding-char) ?\})
4290 (progn 4127 (progn
4291 (backward-char) 4128 (backward-char)
4292 (verilog-at-close-constraint-p)) 4129 (verilog-at-close-constraint-p)))
4293 )
4294 (;-- constraint foo { a = b } 4130 (;-- constraint foo { a = b }
4295 ; is a complete statement. *sigh* 4131 ; is a complete statement. *sigh*
4296 (= (preceding-char) ?\{) 4132 (= (preceding-char) ?\{)
4297 (progn 4133 (progn
4298 (backward-char) 4134 (backward-char)
4299 (not (verilog-at-constraint-p))) 4135 (not (verilog-at-constraint-p))))
4300 )
4301 (;-- Could be 'case (foo)' or 'always @(bar)' which is complete 4136 (;-- Could be 'case (foo)' or 'always @(bar)' which is complete
4302 ; also could be simply '@(foo)' 4137 ; also could be simply '@(foo)'
4303 ; or foo u1 #(a=8) 4138 ; or foo u1 #(a=8)
@@ -4322,10 +4157,8 @@ Set point to where line starts"
4322 (verilog-backward-token) 4157 (verilog-backward-token)
4323 (not (looking-at "\\<\\(always\\(_latch\\|_ff\\|_comb\\)?\\|initial\\|while\\)\\>")))) 4158 (not (looking-at "\\<\\(always\\(_latch\\|_ff\\|_comb\\)?\\|initial\\|while\\)\\>"))))
4324 ((= (preceding-char) ?\#) 4159 ((= (preceding-char) ?\#)
4325 (backward-char) 4160 (backward-char))
4326 ) 4161 (t t)))))))
4327 (t t))
4328 )))))
4329 4162
4330 (;-- any of begin|initial|while are complete statements; 'begin : foo' is also complete 4163 (;-- any of begin|initial|while are complete statements; 'begin : foo' is also complete
4331 t 4164 t
@@ -4346,8 +4179,7 @@ Set point to where line starts"
4346 (backward-sexp) 4179 (backward-sexp)
4347 (if (looking-at verilog-nameable-item-re ) 4180 (if (looking-at verilog-nameable-item-re )
4348 nil 4181 nil
4349 t) 4182 t))
4350 )
4351 ((= (preceding-char) ?\#) 4183 ((= (preceding-char) ?\#)
4352 (backward-char) 4184 (backward-char)
4353 t) 4185 t)
@@ -4357,8 +4189,7 @@ Set point to where line starts"
4357 4189
4358 (t 4190 (t
4359 (goto-char back) 4191 (goto-char back)
4360 t) 4192 t))))))))
4361 )))))))
4362 4193
4363(defun verilog-backward-syntactic-ws (&optional bound) 4194(defun verilog-backward-syntactic-ws (&optional bound)
4364 "Backward skip over syntactic whitespace for Emacs 19. 4195 "Backward skip over syntactic whitespace for Emacs 19.
@@ -4370,9 +4201,7 @@ Optional BOUND limits search."
4370 (narrow-to-region bound (point)) 4201 (narrow-to-region bound (point))
4371 (while (/= here (point)) 4202 (while (/= here (point))
4372 (setq here (point)) 4203 (setq here (point))
4373 (verilog-skip-backward-comments) 4204 (verilog-skip-backward-comments))))))
4374 )))
4375 ))
4376 t) 4205 t)
4377 4206
4378(defun verilog-forward-syntactic-ws (&optional bound) 4207(defun verilog-forward-syntactic-ws (&optional bound)
@@ -4380,16 +4209,13 @@ Optional BOUND limits search."
4380Optional BOUND limits search." 4209Optional BOUND limits search."
4381 (save-restriction 4210 (save-restriction
4382 (let* ((bound (or bound (point-max))) 4211 (let* ((bound (or bound (point-max)))
4383 (here bound) 4212 (here bound))
4384 )
4385 (if (> bound (point)) 4213 (if (> bound (point))
4386 (progn 4214 (progn
4387 (narrow-to-region (point) bound) 4215 (narrow-to-region (point) bound)
4388 (while (/= here (point)) 4216 (while (/= here (point))
4389 (setq here (point)) 4217 (setq here (point))
4390 (forward-comment (buffer-size)) 4218 (forward-comment (buffer-size))))))))
4391 )))
4392 )))
4393 4219
4394(defun verilog-backward-ws&directives (&optional bound) 4220(defun verilog-backward-ws&directives (&optional bound)
4395 "Backward skip over syntactic whitespace and compiler directives for Emacs 19. 4221 "Backward skip over syntactic whitespace and compiler directives for Emacs 19.
@@ -4423,9 +4249,7 @@ Optional BOUND limits search."
4423 (point)) 4249 (point))
4424 (t 4250 (t
4425 nil)))) 4251 nil))))
4426 (if p (goto-char p)) 4252 (if p (goto-char p))))))))
4427 )))
4428 )))
4429 4253
4430(defun verilog-forward-ws&directives (&optional bound) 4254(defun verilog-forward-ws&directives (&optional bound)
4431 "Forward skip over syntactic whitespace and compiler directives for Emacs 19. 4255 "Forward skip over syntactic whitespace and compiler directives for Emacs 19.
@@ -4433,8 +4257,7 @@ Optional BOUND limits search."
4433 (save-restriction 4257 (save-restriction
4434 (let* ((bound (or bound (point-max))) 4258 (let* ((bound (or bound (point-max)))
4435 (here bound) 4259 (here bound)
4436 jump 4260 jump)
4437 )
4438 (if (> bound (point)) 4261 (if (> bound (point))
4439 (progn 4262 (progn
4440 (let ((state 4263 (let ((state
@@ -4455,9 +4278,7 @@ Optional BOUND limits search."
4455 (if (looking-at verilog-directive-re-1) 4278 (if (looking-at verilog-directive-re-1)
4456 (setq jump t))) 4279 (setq jump t)))
4457 (if jump 4280 (if jump
4458 (beginning-of-line 2)) 4281 (beginning-of-line 2))))))))
4459 )))
4460 )))
4461 4282
4462(defun verilog-in-comment-p () 4283(defun verilog-in-comment-p ()
4463 "Return true if in a star or // comment." 4284 "Return true if in a star or // comment."
@@ -4537,14 +4358,11 @@ Optional BOUND limits search."
4537 (forward-list) 4358 (forward-list)
4538 (progn (backward-char 1) 4359 (progn (backward-char 1)
4539 (verilog-backward-ws&directives) 4360 (verilog-backward-ws&directives)
4540 (equal (char-before) ?\;)) 4361 (equal (char-before) ?\;))))
4541 ))
4542 ;; maybe 4362 ;; maybe
4543 (verilog-re-search-backward "\\<constraint\\|coverpoint\\|cross\\>" nil 'move) 4363 (verilog-re-search-backward "\\<constraint\\|coverpoint\\|cross\\>" nil 'move)
4544 ;; not 4364 ;; not
4545 nil 4365 nil))
4546 )
4547 )
4548 4366
4549(defun verilog-parenthesis-depth () 4367(defun verilog-parenthesis-depth ()
4550 "Return non zero if in parenthetical-expression." 4368 "Return non zero if in parenthetical-expression."
@@ -4608,8 +4426,7 @@ Optional BOUND limits search."
4608 t) 4426 t)
4609 ((and (not (bobp)) 4427 ((and (not (bobp))
4610 (= (char-before) ?\/) 4428 (= (char-before) ?\/)
4611 (= (char-before (1- (point))) ?\*) 4429 (= (char-before (1- (point))) ?\*))
4612 )
4613 (goto-char (- (point) 2)) 4430 (goto-char (- (point) 2))
4614 t) 4431 t)
4615 (t 4432 (t
@@ -4650,8 +4467,8 @@ Only look at a few lines to determine indent level."
4650 (if (verilog-continued-line) 4467 (if (verilog-continued-line)
4651 (progn 4468 (progn
4652 (goto-char sp) 4469 (goto-char sp)
4653 (setq 4470 (setq indent-str
4654 indent-str (list 'statement (verilog-current-indent-level)))) 4471 (list 'statement (verilog-current-indent-level))))
4655 (goto-char sp1) 4472 (goto-char sp1)
4656 (setq indent-str (list 'block (verilog-current-indent-level))))) 4473 (setq indent-str (list 'block (verilog-current-indent-level)))))
4657 (goto-char sp)) 4474 (goto-char sp))
@@ -4701,16 +4518,13 @@ Only look at a few lines to determine indent level."
4701 (progn 4518 (progn
4702 (forward-char 1) 4519 (forward-char 1)
4703 (backward-up-list -1) 4520 (backward-up-list -1)
4704 (skip-chars-forward " \t"))) 4521 (skip-chars-forward " \t"))))
4705 )
4706 (current-column)) 4522 (current-column))
4707 (progn 4523 (progn
4708 (goto-char fst) 4524 (goto-char fst)
4709 (+ (current-column) verilog-cexp-indent)) 4525 (+ (current-column) verilog-cexp-indent))))))
4710 ))))
4711 (goto-char here) 4526 (goto-char here)
4712 (indent-line-to val)) 4527 (indent-line-to val)))
4713 )
4714 ((= (preceding-char) ?\) ) 4528 ((= (preceding-char) ?\) )
4715 (goto-char here) 4529 (goto-char here)
4716 (let ((val (eval (cdr (assoc type verilog-indent-alist))))) 4530 (let ((val (eval (cdr (assoc type verilog-indent-alist)))))
@@ -4724,8 +4538,7 @@ Only look at a few lines to determine indent level."
4724 (setq val (current-column)) 4538 (setq val (current-column))
4725 (setq val (eval (cdr (assoc type verilog-indent-alist))))) 4539 (setq val (eval (cdr (assoc type verilog-indent-alist)))))
4726 (goto-char here) 4540 (goto-char here)
4727 (indent-line-to val))) 4541 (indent-line-to val))))))
4728 )))
4729 4542
4730 (; handle inside parenthetical expressions 4543 (; handle inside parenthetical expressions
4731 (eq type 'cparenexp) 4544 (eq type 'cparenexp)
@@ -4737,8 +4550,7 @@ Only look at a few lines to determine indent level."
4737 (indent-line-to val) 4550 (indent-line-to val)
4738 (if (and (not (verilog-in-struct-region-p)) 4551 (if (and (not (verilog-in-struct-region-p))
4739 (looking-at verilog-declaration-re)) 4552 (looking-at verilog-declaration-re))
4740 (verilog-indent-declaration ind)) 4553 (verilog-indent-declaration ind))))
4741 ))
4742 4554
4743 (;-- Handle the ends 4555 (;-- Handle the ends
4744 (or 4556 (or
@@ -4774,8 +4586,8 @@ Only look at a few lines to determine indent level."
4774 (;-- Everything else 4586 (;-- Everything else
4775 t 4587 t
4776 (let ((val (eval (cdr (assoc type verilog-indent-alist))))) 4588 (let ((val (eval (cdr (assoc type verilog-indent-alist)))))
4777 (indent-line-to val))) 4589 (indent-line-to val))))
4778 ) 4590
4779 (if (looking-at "[ \t]+$") 4591 (if (looking-at "[ \t]+$")
4780 (skip-chars-forward " \t")) 4592 (skip-chars-forward " \t"))
4781 indent-str ; Return indent data 4593 indent-str ; Return indent data
@@ -4823,8 +4635,7 @@ Do not count named blocks or case-statements."
4823 (t 4635 (t
4824 (save-excursion 4636 (save-excursion
4825 (re-search-backward "//" nil t) 4637 (re-search-backward "//" nil t)
4826 (current-column))) 4638 (current-column))))))
4827 )))
4828 (indent-line-to stcol) 4639 (indent-line-to stcol)
4829 stcol)) 4640 stcol))
4830 4641
@@ -4843,8 +4654,7 @@ Do not count named blocks or case-statements."
4843 (t 4654 (t
4844 (save-excursion 4655 (save-excursion
4845 (re-search-backward "//" nil t) 4656 (re-search-backward "//" nil t)
4846 (current-column))) 4657 (current-column))))))
4847 )))
4848 (progn 4658 (progn
4849 (indent-to stcol) 4659 (indent-to stcol)
4850 (if (and star 4660 (if (and star
@@ -4912,8 +4722,7 @@ ARG is ignored, for `comment-indent-function' compatibility."
4912 (goto-char start) 4722 (goto-char start)
4913 (verilog-do-indent (verilog-calculate-indent)) 4723 (verilog-do-indent (verilog-calculate-indent))
4914 (verilog-forward-ws&directives) 4724 (verilog-forward-ws&directives)
4915 (current-column))) 4725 (current-column))))
4916 )
4917 (goto-char end) 4726 (goto-char end)
4918 (goto-char start) 4727 (goto-char start)
4919 (if (> (- end start) 100) 4728 (if (> (- end start) 100)
@@ -4927,15 +4736,12 @@ ARG is ignored, for `comment-indent-function' compatibility."
4927 (verilog-forward-ws&directives) 4736 (verilog-forward-ws&directives)
4928 (indent-line-to base-ind) 4737 (indent-line-to base-ind)
4929 (verilog-forward-ws&directives) 4738 (verilog-forward-ws&directives)
4930 (verilog-re-search-forward "[ \t\n\f]" e 'move) 4739 (verilog-re-search-forward "[ \t\n\f]" e 'move))
4931 )
4932 (t 4740 (t
4933 (just-one-space) 4741 (just-one-space)
4934 (verilog-re-search-forward "[ \t\n\f]" e 'move) 4742 (verilog-re-search-forward "[ \t\n\f]" e 'move)))
4935 ) 4743 ;;(forward-line)
4936 )
4937 ) 4744 )
4938 ;;(forward-line))
4939 ;; Now find biggest prefix 4745 ;; Now find biggest prefix
4940 (setq ind (verilog-get-lineup-indent start edpos)) 4746 (setq ind (verilog-get-lineup-indent start edpos))
4941 ;; Now indent each line. 4747 ;; Now indent each line.
@@ -4960,21 +4766,19 @@ ARG is ignored, for `comment-indent-function' compatibility."
4960 (indent-to ind)) 4766 (indent-to ind))
4961 (progn 4767 (progn
4962 (just-one-space) 4768 (just-one-space)
4963 (indent-to ind)) 4769 (indent-to ind)))))
4964 )))
4965 ((verilog-continued-line-1 start) 4770 ((verilog-continued-line-1 start)
4966 (goto-char e) 4771 (goto-char e)
4967 (indent-line-to ind)) 4772 (indent-line-to ind))
4968 (t ; Must be comment or white space 4773 (t ; Must be comment or white space
4969 (goto-char e) 4774 (goto-char e)
4970 (verilog-forward-ws&directives) 4775 (verilog-forward-ws&directives)
4971 (forward-line -1)) 4776 (forward-line -1)))
4972 )
4973 (forward-line 1)) 4777 (forward-line 1))
4974 (message ""))))) 4778 (message "")))))
4975 4779
4976(defun verilog-pretty-expr (&optional myre) 4780(defun verilog-pretty-expr (&optional myre)
4977 "Line up expressions around point." 4781 "Line up expressions around point, or optional regexp MYRE."
4978 (interactive "sRegular Expression: ((<|:)?=) ") 4782 (interactive "sRegular Expression: ((<|:)?=) ")
4979 (save-excursion 4783 (save-excursion
4980 (if (or (eq myre nil) 4784 (if (or (eq myre nil)
@@ -4995,8 +4799,7 @@ ARG is ignored, for `comment-indent-function' compatibility."
4995 (beginning-of-line) 4799 (beginning-of-line)
4996 (while (and (not (looking-at (concat "^\\s-*" verilog-complete-reg))) 4800 (while (and (not (looking-at (concat "^\\s-*" verilog-complete-reg)))
4997 (looking-at myre) 4801 (looking-at myre)
4998 (not (bobp)) 4802 (not (bobp)))
4999 )
5000 (setq e (point)) 4803 (setq e (point))
5001 (verilog-backward-syntactic-ws) 4804 (verilog-backward-syntactic-ws)
5002 (beginning-of-line) 4805 (beginning-of-line)
@@ -5015,12 +4818,10 @@ ARG is ignored, for `comment-indent-function' compatibility."
5015 (end-of-line) 4818 (end-of-line)
5016 (setq e (point)) 4819 (setq e (point))
5017 (verilog-forward-syntactic-ws) 4820 (verilog-forward-syntactic-ws)
5018 (beginning-of-line) 4821 (beginning-of-line))
5019 )
5020 e)) 4822 e))
5021 (edpos (set-marker (make-marker) end)) 4823 (edpos (set-marker (make-marker) end))
5022 (ind) 4824 (ind))
5023 )
5024 (goto-char start) 4825 (goto-char start)
5025 (verilog-do-indent (verilog-calculate-indent)) 4826 (verilog-do-indent (verilog-calculate-indent))
5026 (if (> (- end start) 100) 4827 (if (> (- end start) 100)
@@ -5031,8 +4832,7 @@ ARG is ignored, for `comment-indent-function' compatibility."
5031 (beginning-of-line) 4832 (beginning-of-line)
5032 (verilog-just-one-space myre) 4833 (verilog-just-one-space myre)
5033 (end-of-line) 4834 (end-of-line)
5034 (verilog-forward-syntactic-ws) 4835 (verilog-forward-syntactic-ws))
5035 )
5036 4836
5037 ;; Now find biggest prefix 4837 ;; Now find biggest prefix
5038 (setq ind (verilog-get-lineup-indent-2 myre start edpos)) 4838 (setq ind (verilog-get-lineup-indent-2 myre start edpos))
@@ -5049,20 +4849,16 @@ ARG is ignored, for `comment-indent-function' compatibility."
5049 (goto-char (match-end 1)) 4849 (goto-char (match-end 1))
5050 (if (eq (char-after) ?=) 4850 (if (eq (char-after) ?=)
5051 (indent-to (1+ ind)) ; line up the = of the <= with surrounding = 4851 (indent-to (1+ ind)) ; line up the = of the <= with surrounding =
5052 (indent-to ind) 4852 (indent-to ind)))
5053 )
5054 )
5055 ((verilog-continued-line-1 start) 4853 ((verilog-continued-line-1 start)
5056 (goto-char e) 4854 (goto-char e)
5057 (indent-line-to ind)) 4855 (indent-line-to ind))
5058 (t ; Must be comment or white space 4856 (t ; Must be comment or white space
5059 (goto-char e) 4857 (goto-char e)
5060 (verilog-forward-ws&directives) 4858 (verilog-forward-ws&directives)
5061 (forward-line -1)) 4859 (forward-line -1)))
5062 )
5063 (forward-line 1)) 4860 (forward-line 1))
5064 (message "") 4861 (message "")))))
5065 ))))
5066 4862
5067(defun verilog-just-one-space (myre) 4863(defun verilog-just-one-space (myre)
5068 "Remove extra spaces around regular expression MYRE." 4864 "Remove extra spaces around regular expression MYRE."
@@ -5073,12 +4869,10 @@ ARG is ignored, for `comment-indent-function' compatibility."
5073 (p2 (match-end 2))) 4869 (p2 (match-end 2)))
5074 (progn 4870 (progn
5075 (goto-char p2) 4871 (goto-char p2)
5076 (if (looking-at "\\s-") (just-one-space) ) 4872 (if (looking-at "\\s-") (just-one-space))
5077 (goto-char p1) 4873 (goto-char p1)
5078 (forward-char -1) 4874 (forward-char -1)
5079 (if (looking-at "\\s-") (just-one-space)) 4875 (if (looking-at "\\s-") (just-one-space)))))
5080 )
5081 ))
5082 (message "")) 4876 (message ""))
5083 4877
5084(defun verilog-indent-declaration (baseind) 4878(defun verilog-indent-declaration (baseind)
@@ -5093,8 +4887,7 @@ BASEIND is the base indent to offset everything."
5093 (point))) 4887 (point)))
5094 (ind) 4888 (ind)
5095 (val) 4889 (val)
5096 (m1 (make-marker)) 4890 (m1 (make-marker)))
5097 )
5098 (setq val 4891 (setq val
5099 (+ baseind (eval (cdr (assoc 'declaration verilog-indent-alist))))) 4892 (+ baseind (eval (cdr (assoc 'declaration verilog-indent-alist)))))
5100 (indent-line-to val) 4893 (indent-line-to val)
@@ -5125,13 +4918,11 @@ BASEIND is the base indent to offset everything."
5125 (just-one-space) 4918 (just-one-space)
5126 (goto-char (marker-position m1)) 4919 (goto-char (marker-position m1))
5127 (just-one-space) 4920 (just-one-space)
5128 (indent-to ind) 4921 (indent-to ind))
5129 )
5130 (if (/= (current-column) ind) 4922 (if (/= (current-column) ind)
5131 (progn 4923 (progn
5132 (just-one-space) 4924 (just-one-space)
5133 (indent-to ind)) 4925 (indent-to ind)))))
5134 )))
5135 (if (looking-at verilog-declaration-re-2-no-macro) 4926 (if (looking-at verilog-declaration-re-2-no-macro)
5136 (let ((p (match-end 0))) 4927 (let ((p (match-end 0)))
5137 (set-marker m1 p) 4928 (set-marker m1 p)
@@ -5362,11 +5153,8 @@ for matches of `str' and adding the occurrence tp `all' through point END."
5362 (if (or (null verilog-pred) 5153 (if (or (null verilog-pred)
5363 (funcall verilog-pred match)) 5154 (funcall verilog-pred match))
5364 (setq verilog-all (cons match verilog-all))))) 5155 (setq verilog-all (cons match verilog-all)))))
5365 (forward-line 1) 5156 (forward-line 1)))
5366 ) 5157 verilog-all)
5367 )
5368 verilog-all
5369 )
5370 5158
5371(defun verilog-type-completion () 5159(defun verilog-type-completion ()
5372 "Calculate all possible completions for types." 5160 "Calculate all possible completions for types."
@@ -5663,8 +5451,7 @@ If search fails, other files are checked based on
5663 (goto-char pt) 5451 (goto-char pt)
5664 (beginning-of-line)) 5452 (beginning-of-line))
5665 pt) 5453 pt)
5666 (verilog-goto-defun-file label) 5454 (verilog-goto-defun-file label))))
5667 )))
5668 5455
5669;; Eliminate compile warning 5456;; Eliminate compile warning
5670(eval-when-compile 5457(eval-when-compile
@@ -5680,8 +5467,7 @@ If search fails, other files are checked based on
5680 (first 1) 5467 (first 1)
5681 (prevpos (point-min)) 5468 (prevpos (point-min))
5682 (final-context-start (make-marker)) 5469 (final-context-start (make-marker))
5683 (regexp "\\(module\\s-+\\w+\\s-*(\\)\\|\\(\\w+\\s-+\\w+\\s-*(\\)") 5470 (regexp "\\(module\\s-+\\w+\\s-*(\\)\\|\\(\\w+\\s-+\\w+\\s-*(\\)"))
5684 )
5685 (with-output-to-temp-buffer "*Occur*" 5471 (with-output-to-temp-buffer "*Occur*"
5686 (save-excursion 5472 (save-excursion
5687 (message (format "Searching for %s ..." regexp)) 5473 (message (format "Searching for %s ..." regexp))
@@ -5854,8 +5640,7 @@ Bound search by LIMIT. Adapted from
5854 (search-forward "<company>") 5640 (search-forward "<company>")
5855 (replace-match string t t) 5641 (replace-match string t t)
5856 (search-backward "<description>") 5642 (search-backward "<description>")
5857 (replace-match "" t t) 5643 (replace-match "" t t))))
5858 )))
5859 5644
5860;; verilog-header Uses the verilog-insert-date function 5645;; verilog-header Uses the verilog-insert-date function
5861 5646
@@ -5994,8 +5779,7 @@ Duplicate signals are also removed. For example A[2] and A[1] become A[2:1]."
5994 sv-type (verilog-sig-type sig) 5779 sv-type (verilog-sig-type sig)
5995 sv-multidim (verilog-sig-multidim sig) 5780 sv-multidim (verilog-sig-multidim sig)
5996 combo "" 5781 combo ""
5997 buswarn "" 5782 buswarn ""))
5998 ))
5999 ;; Extract bus details 5783 ;; Extract bus details
6000 (setq bus (verilog-sig-bits sig)) 5784 (setq bus (verilog-sig-bits sig))
6001 (cond ((and bus 5785 (cond ((and bus
@@ -6043,16 +5827,15 @@ Duplicate signals are also removed. For example A[2] and A[1] become A[2:1]."
6043 (if sv-highbit 5827 (if sv-highbit
6044 (concat "[" (int-to-string sv-highbit) ":" 5828 (concat "[" (int-to-string sv-highbit) ":"
6045 (int-to-string sv-lowbit) "]"))) 5829 (int-to-string sv-lowbit) "]")))
6046 (concat sv-comment combo buswarn) 5830 (concat sv-comment combo buswarn)
6047 sv-memory sv-enum sv-signed sv-type sv-multidim) 5831 sv-memory sv-enum sv-signed sv-type sv-multidim)
6048 out-list) 5832 out-list)
6049 sv-name nil))) 5833 sv-name nil))))
6050 )
6051 ;; 5834 ;;
6052 out-list)) 5835 out-list))
6053 5836
6054(defun verilog-sig-tieoff (sig &optional no-width) 5837(defun verilog-sig-tieoff (sig &optional no-width)
6055 "Return tieoff expression for given SIGNAL, with appropriate width. 5838 "Return tieoff expression for given SIG, with appropriate width.
6056Ignore width if optional NO-WIDTH is set." 5839Ignore width if optional NO-WIDTH is set."
6057 (let* ((width (if no-width nil (verilog-sig-width sig)))) 5840 (let* ((width (if no-width nil (verilog-sig-width sig))))
6058 (concat 5841 (concat
@@ -6189,8 +5972,7 @@ Return a array of [outputs inouts inputs wire reg assign const]."
6189 (forward-char 1) 5972 (forward-char 1)
6190 (when (< paren sig-paren) 5973 (when (< paren sig-paren)
6191 (setq expect-signal nil)) ; ) that ends variables inside v2k arg list 5974 (setq expect-signal nil)) ; ) that ends variables inside v2k arg list
6192 t) 5975 t))))
6193 )))
6194 ((looking-at "\\s-*\\(\\[[^]]+\\]\\)") 5976 ((looking-at "\\s-*\\(\\[[^]]+\\]\\)")
6195 (goto-char (match-end 0)) 5977 (goto-char (match-end 0))
6196 (cond (newsig ; Memory, not just width. Patch last signal added's memory (nth 3) 5978 (cond (newsig ; Memory, not just width. Patch last signal added's memory (nth 3)
@@ -6272,12 +6054,15 @@ Return a array of [outputs inouts inputs wire reg assign const]."
6272 (nreverse sigs-reg) 6054 (nreverse sigs-reg)
6273 (nreverse sigs-assign) 6055 (nreverse sigs-assign)
6274 (nreverse sigs-const) 6056 (nreverse sigs-const)
6275 (nreverse sigs-gparam) 6057 (nreverse sigs-gparam)))))
6276 ))))
6277 6058
6278(defvar sigs-in) ; Prevent compile warning 6059(eval-when-compile
6279(defvar sigs-inout) ; Prevent compile warning 6060 ;; Prevent compile warnings; these are let's, not globals
6280(defvar sigs-out) ; Prevent compile warning 6061 ;; Do not remove the eval-when-compile
6062 ;; - we want a error when we are debugging this code if they are refed.
6063 (defvar sigs-in)
6064 (defvar sigs-inout)
6065 (defvar sigs-out))
6281 6066
6282 6067
6283(defsubst verilog-modi-get-decls (modi) 6068(defsubst verilog-modi-get-decls (modi)
@@ -6524,10 +6309,16 @@ For example if declare A A (.B(SIG)) then B will be included in the list."
6524 (end-pt (point))) 6309 (end-pt (point)))
6525 (eval-region beg-pt end-pt nil))))) 6310 (eval-region beg-pt end-pt nil)))))
6526 6311
6527;; These are passed in a let, not global 6312(eval-when-compile
6528(defvar got-sig) 6313 ;; Prevent compile warnings; these are let's, not globals
6529(defvar got-rvalue) 6314 ;; Do not remove the eval-when-compile
6530(defvar uses-delayed) 6315 ;; - we want a error when we are debugging this code if they are refed.
6316 (defvar sigs-in)
6317 (defvar sigs-out)
6318 (defvar got-sig)
6319 (defvar got-rvalue)
6320 (defvar uses-delayed)
6321 (defvar vector-skip-list))
6531 6322
6532(defun verilog-read-always-signals-recurse 6323(defun verilog-read-always-signals-recurse
6533 (exit-keywd rvalue ignore-next) 6324 (exit-keywd rvalue ignore-next)
@@ -6653,8 +6444,7 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement."
6653 (t 6444 (t
6654 (forward-char 1))) 6445 (forward-char 1)))
6655 ;; End of non-comment token 6446 ;; End of non-comment token
6656 (setq last-keywd keywd) 6447 (setq last-keywd keywd)))
6657 ))
6658 (skip-syntax-forward " ")) 6448 (skip-syntax-forward " "))
6659 ;; Append the final pending signal 6449 ;; Append the final pending signal
6660 (when got-sig 6450 (when got-sig
@@ -6700,8 +6490,7 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement."
6700 (instant (match-string 2))) 6490 (instant (match-string 2)))
6701 (if (not (member module verilog-keywords)) 6491 (if (not (member module verilog-keywords))
6702 (setq instants-list (cons (list module instant) instants-list))))) 6492 (setq instants-list (cons (list module instant) instants-list)))))
6703 (forward-line 1) 6493 (forward-line 1)))
6704 ))
6705 instants-list)) 6494 instants-list))
6706 6495
6707 6496
@@ -6776,8 +6565,7 @@ list of ( (signal_name connection_name)... )"
6776 (t 6565 (t
6777 (error "%s: AUTO_TEMPLATE parsing error: %s" 6566 (error "%s: AUTO_TEMPLATE parsing error: %s"
6778 (verilog-point-text) 6567 (verilog-point-text)
6779 (progn (looking-at ".*$") (match-string 0)))) 6568 (progn (looking-at ".*$") (match-string 0))))))
6780 ))
6781 ;; Return 6569 ;; Return
6782 (vector tpl-regexp 6570 (vector tpl-regexp
6783 (list tpl-sig-list tpl-wild-list))) 6571 (list tpl-sig-list tpl-wild-list)))
@@ -6799,8 +6587,7 @@ Optionally associate it with the specified enumeration ENUMNAME."
6799 (let ((enumvar (intern (concat "venum-" enumname)))) 6587 (let ((enumvar (intern (concat "venum-" enumname))))
6800 ;;(message "Define %s=%s" defname defvalue) (sleep-for 1) 6588 ;;(message "Define %s=%s" defname defvalue) (sleep-for 1)
6801 (make-variable-buffer-local enumvar) 6589 (make-variable-buffer-local enumvar)
6802 (add-to-list enumvar defname))) 6590 (add-to-list enumvar defname)))))
6803 ))
6804 6591
6805(defun verilog-read-defines (&optional filename recurse subcall) 6592(defun verilog-read-defines (&optional filename recurse subcall)
6806 "Read `defines and parameters for the current file, or optional FILENAME. 6593 "Read `defines and parameters for the current file, or optional FILENAME.
@@ -6884,8 +6671,7 @@ warning message, you need to add to your .emacs file:
6884 (while (looking-at "\\s-*,?\\s-*\\([a-zA-Z0-9_$]+\\)\\s-*=\\s-*\\([^;,]*\\),?\\s-*") 6671 (while (looking-at "\\s-*,?\\s-*\\([a-zA-Z0-9_$]+\\)\\s-*=\\s-*\\([^;,]*\\),?\\s-*")
6885 (verilog-set-define (match-string-no-properties 1) (match-string-no-properties 2) origbuf enumname) 6672 (verilog-set-define (match-string-no-properties 1) (match-string-no-properties 2) origbuf enumname)
6886 (goto-char (match-end 0)) 6673 (goto-char (match-end 0))
6887 (forward-comment 999)))) 6674 (forward-comment 999)))))))
6888 )))
6889 6675
6890(defun verilog-read-includes () 6676(defun verilog-read-includes ()
6891 "Read `includes for the current file. 6677 "Read `includes for the current file.
@@ -6950,8 +6736,7 @@ Some macros and such are also found and included. For dinotrace.el"
6950 (or (member keywd verilog-keywords) 6736 (or (member keywd verilog-keywords)
6951 (member keywd sigs-all) 6737 (member keywd sigs-all)
6952 (setq sigs-all (cons keywd sigs-all)))) 6738 (setq sigs-all (cons keywd sigs-all))))
6953 (t (forward-char 1))) 6739 (t (forward-char 1))))
6954 )
6955 ;; Return list 6740 ;; Return list
6956 sigs-all))) 6741 sigs-all)))
6957 6742
@@ -7019,10 +6804,7 @@ Some macros and such are also found and included. For dinotrace.el"
7019 ((string-match "^[^-+]" arg) 6804 ((string-match "^[^-+]" arg)
7020 (verilog-add-list-unique `verilog-library-files arg)) 6805 (verilog-add-list-unique `verilog-library-files arg))
7021 ;; Default - ignore; no warning 6806 ;; Default - ignore; no warning
7022 ) 6807 ))))
7023 )
7024 )
7025 )
7026;;(verilog-getopt (list "+libext+.a+.b" "+incdir+foodir" "+define+a+aval" "-f" "otherf" "-v" "library" "-y" "dir")) 6808;;(verilog-getopt (list "+libext+.a+.b" "+incdir+foodir" "+define+a+aval" "-f" "otherf" "-v" "library" "-y" "dir"))
7027 6809
7028(defun verilog-getopt-file (filename) 6810(defun verilog-getopt-file (filename)
@@ -7096,8 +6878,7 @@ Allows version control to check out the file if need be."
7096 "Return true if SYMBOL is number-like." 6878 "Return true if SYMBOL is number-like."
7097 (or (string-match "^[0-9 \t:]+$" symbol) 6879 (or (string-match "^[0-9 \t:]+$" symbol)
7098 (string-match "^[---]*[0-9]+$" symbol) 6880 (string-match "^[---]*[0-9]+$" symbol)
7099 (string-match "^[0-9 \t]+'s?[hdxbo][0-9a-fA-F_xz? \t]*$" symbol) 6881 (string-match "^[0-9 \t]+'s?[hdxbo][0-9a-fA-F_xz? \t]*$" symbol)))
7100 ))
7101 6882
7102(defun verilog-symbol-detick (symbol wing-it) 6883(defun verilog-symbol-detick (symbol wing-it)
7103 "Return a expanded SYMBOL name without any defines. 6884 "Return a expanded SYMBOL name without any defines.
@@ -7185,13 +6966,11 @@ Or, just the existing dirnames themselves if there are no wildcards."
7185 (setq dirfile (expand-file-name (concat (car dirfiles) rest)) 6966 (setq dirfile (expand-file-name (concat (car dirfiles) rest))
7186 dirfiles (cdr dirfiles)) 6967 dirfiles (cdr dirfiles))
7187 (if (file-directory-p dirfile) 6968 (if (file-directory-p dirfile)
7188 (setq dirlist (cons dirfile dirlist)))) 6969 (setq dirlist (cons dirfile dirlist)))))
7189 )
7190 ;; Defaults 6970 ;; Defaults
7191 (t 6971 (t
7192 (if (file-directory-p dirname) 6972 (if (file-directory-p dirname)
7193 (setq dirlist (cons dirname dirlist)))) 6973 (setq dirlist (cons dirname dirlist))))))
7194 ))
7195 dirlist)) 6974 dirlist))
7196;;(verilog-expand-dirnames (list "." ".." "nonexist" "../*" "/home/wsnyder/*/v")) 6975;;(verilog-expand-dirnames (list "." ".." "nonexist" "../*" "/home/wsnyder/*/v"))
7197 6976
@@ -7295,13 +7074,11 @@ Return modi if successful, else print message unless IGNORE-ERROR is true."
7295 "") 7074 "")
7296 "\n Check the verilog-library-directories variable." 7075 "\n Check the verilog-library-directories variable."
7297 "\n I looked in (if not listed, doesn't exist):\n\t" 7076 "\n I looked in (if not listed, doesn't exist):\n\t"
7298 (mapconcat 'concat orig-filenames "\n\t"))))) 7077 (mapconcat 'concat orig-filenames "\n\t"))))))
7299 )
7300 (setq verilog-modi-lookup-last-mod module 7078 (setq verilog-modi-lookup-last-mod module
7301 verilog-modi-lookup-last-current current 7079 verilog-modi-lookup-last-current current
7302 verilog-modi-lookup-last-tick (buffer-modified-tick))))) 7080 verilog-modi-lookup-last-tick (buffer-modified-tick)))))
7303 verilog-modi-lookup-last-modi 7081 verilog-modi-lookup-last-modi))
7304 ))
7305 7082
7306(defsubst verilog-modi-name (modi) 7083(defsubst verilog-modi-name (modi)
7307 (aref modi 0)) 7084 (aref modi 0))
@@ -7370,8 +7147,7 @@ Cache the output of function so next call may have faster access."
7370 (buffer-modified-tick) 7147 (buffer-modified-tick)
7371 (visited-file-modtime) 7148 (visited-file-modtime)
7372 func-returns) 7149 func-returns)
7373 verilog-modi-cache-list))) 7150 verilog-modi-cache-list)))))
7374 ))
7375 ;; 7151 ;;
7376 func-returns)) 7152 func-returns))
7377 7153
@@ -7483,7 +7259,7 @@ and invalidating the cache."
7483 (funcall func)))) 7259 (funcall func))))
7484 7260
7485(defun verilog-insert-one-definition (sig type indent-pt) 7261(defun verilog-insert-one-definition (sig type indent-pt)
7486 "Print out a definition for SIGNAL of the given TYPE, 7262 "Print out a definition for SIG of the given TYPE,
7487with appropriate INDENT-PT indentation." 7263with appropriate INDENT-PT indentation."
7488 (indent-to indent-pt) 7264 (indent-to indent-pt)
7489 (insert type) 7265 (insert type)
@@ -7594,9 +7370,8 @@ This repairs those mis-inserted by a AUTOARG."
7594 (string-to-number (match-string 2 range-exp))))))) 7370 (string-to-number (match-string 2 range-exp)))))))
7595 ((string-match "^\\(.*\\)\\s *:\\s *\\(.*\\)\\s *$" range-exp) 7371 ((string-match "^\\(.*\\)\\s *:\\s *\\(.*\\)\\s *$" range-exp)
7596 (concat "(1+(" (match-string 1 range-exp) ")" 7372 (concat "(1+(" (match-string 1 range-exp) ")"
7597 (if (equal "0" (match-string 2 range-exp)) 7373 (if (equal "0" (match-string 2 range-exp))
7598 ;; Don't bother with -(0) 7374 "" ;; Don't bother with -(0)
7599 ""
7600 (concat "-(" (match-string 2 range-exp) ")")) 7375 (concat "-(" (match-string 2 range-exp) ")"))
7601 ")")) 7376 ")"))
7602 (t nil))))) 7377 (t nil)))))
@@ -7621,8 +7396,7 @@ This repairs those mis-inserted by a AUTOARG."
7621 ;; End exists 7396 ;; End exists
7622 (end-of-line) 7397 (end-of-line)
7623 (delete-region pt (point)) 7398 (delete-region pt (point))
7624 (forward-line 1)) 7399 (forward-line 1))))
7625 ))
7626 7400
7627(defun verilog-forward-close-paren () 7401(defun verilog-forward-close-paren ()
7628 "Find the close parenthesis that match the current point, 7402 "Find the close parenthesis that match the current point,
@@ -7897,8 +7671,7 @@ Typing \\[verilog-inject-auto] will make this into:
7897 (when (yes-or-no-p "AUTO statements not recomputed, do it now? ") 7671 (when (yes-or-no-p "AUTO statements not recomputed, do it now? ")
7898 (verilog-auto)) 7672 (verilog-auto))
7899 ;; Don't ask again if didn't update 7673 ;; Don't ask again if didn't update
7900 (set (make-local-variable 'verilog-auto-update-tick) (buffer-modified-tick)) 7674 (set (make-local-variable 'verilog-auto-update-tick) (buffer-modified-tick))))
7901 ))
7902 (when (not verilog-auto-star-save) 7675 (when (not verilog-auto-star-save)
7903 (verilog-delete-auto-star-implicit)) 7676 (verilog-delete-auto-star-implicit))
7904 nil) ;; Always return nil -- we don't write the file ourselves 7677 nil) ;; Always return nil -- we don't write the file ourselves
@@ -8008,13 +7781,11 @@ Avoid declaring ports manually, as it makes code harder to maintain."
8008 (verilog-repair-close-comma) 7781 (verilog-repair-close-comma)
8009 (unless (eq (char-before) ?/ ) 7782 (unless (eq (char-before) ?/ )
8010 (insert "\n")) 7783 (insert "\n"))
8011 (indent-to verilog-indent-level-declaration) 7784 (indent-to verilog-indent-level-declaration))))
8012 )))
8013 7785
8014(defun verilog-auto-inst-port-map (port-st) 7786(defun verilog-auto-inst-port-map (port-st)
8015 nil) 7787 nil)
8016 7788
8017(defvar vector-skip-list nil) ; Prevent compile warning
8018(defvar vl-cell-type nil "See `verilog-auto-inst'.") ; Prevent compile warning 7789(defvar vl-cell-type nil "See `verilog-auto-inst'.") ; Prevent compile warning
8019(defvar vl-cell-name nil "See `verilog-auto-inst'.") ; Prevent compile warning 7790(defvar vl-cell-name nil "See `verilog-auto-inst'.") ; Prevent compile warning
8020(defvar vl-name nil "See `verilog-auto-inst'.") ; Prevent compile warning 7791(defvar vl-name nil "See `verilog-auto-inst'.") ; Prevent compile warning
@@ -8025,7 +7796,8 @@ Avoid declaring ports manually, as it makes code harder to maintain."
8025 "Print out a instantiation connection for this PORT-ST. 7796 "Print out a instantiation connection for this PORT-ST.
8026Insert to INDENT-PT, use template TPL-LIST. 7797Insert to INDENT-PT, use template TPL-LIST.
8027@ are instantiation numbers, replaced with TPL-NUM. 7798@ are instantiation numbers, replaced with TPL-NUM.
8028@\"(expression @)\" are evaluated, with @ as a variable." 7799@\"(expression @)\" are evaluated, with @ as a variable.
7800If FOR-STAR add comment it is a .* expansion."
8029 (let* ((port (verilog-sig-name port-st)) 7801 (let* ((port (verilog-sig-name port-st))
8030 (tpl-ass (or (assoc port (car tpl-list)) 7802 (tpl-ass (or (assoc port (car tpl-list))
8031 (verilog-auto-inst-port-map port-st))) 7803 (verilog-auto-inst-port-map port-st)))
@@ -8072,13 +7844,11 @@ Insert to INDENT-PT, use template TPL-LIST.
8072 (prin1 (eval (car (read-from-string expr))) 7844 (prin1 (eval (car (read-from-string expr)))
8073 (lambda (ch) ()))))) 7845 (lambda (ch) ())))))
8074 (if (numberp value) (setq value (number-to-string value))) 7846 (if (numberp value) (setq value (number-to-string value)))
8075 value 7847 value))
8076 ))
8077 (substring tpl-net (match-end 0)))))) 7848 (substring tpl-net (match-end 0))))))
8078 ;; Replace @ and [] magic variables in final output 7849 ;; Replace @ and [] magic variables in final output
8079 (setq tpl-net (verilog-string-replace-matches "@" tpl-num nil nil tpl-net)) 7850 (setq tpl-net (verilog-string-replace-matches "@" tpl-num nil nil tpl-net))
8080 (setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net)) 7851 (setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net)))
8081 )
8082 (indent-to indent-pt) 7852 (indent-to indent-pt)
8083 (insert "." port) 7853 (insert "." port)
8084 (indent-to verilog-auto-inst-column) 7854 (indent-to verilog-auto-inst-column)
@@ -8462,9 +8232,7 @@ Lisp Templates:
8462 (if (search-forward ")" nil t) ;; From user, moved up a line 8232 (if (search-forward ")" nil t) ;; From user, moved up a line
8463 (delete-backward-char 1)) 8233 (delete-backward-char 1))
8464 (if (search-forward ";" nil t) ;; Don't error if user had syntax error and forgot it 8234 (if (search-forward ";" nil t) ;; Don't error if user had syntax error and forgot it
8465 (delete-backward-char 1)) 8235 (delete-backward-char 1)))))))))
8466 )))
8467 ))))
8468 8236
8469(defun verilog-auto-inst-param () 8237(defun verilog-auto-inst-param ()
8470 "Expand AUTOINSTPARAM statements, as part of \\[verilog-auto]. 8238 "Expand AUTOINSTPARAM statements, as part of \\[verilog-auto].
@@ -8566,9 +8334,7 @@ Templates:
8566 (search-forward "\n") ;; Added by inst-port 8334 (search-forward "\n") ;; Added by inst-port
8567 (delete-backward-char 1) 8335 (delete-backward-char 1)
8568 (if (search-forward ")" nil t) ;; From user, moved up a line 8336 (if (search-forward ")" nil t) ;; From user, moved up a line
8569 (delete-backward-char 1)) 8337 (delete-backward-char 1)))))))))
8570 )))
8571 ))))
8572 8338
8573(defun verilog-auto-reg () 8339(defun verilog-auto-reg ()
8574 "Expand AUTOREG statements, as part of \\[verilog-auto]. 8340 "Expand AUTOREG statements, as part of \\[verilog-auto].
@@ -8612,15 +8378,13 @@ Typing \\[verilog-auto] will make this into:
8612 (verilog-modi-get-consts modi) 8378 (verilog-modi-get-consts modi)
8613 (verilog-modi-get-gparams modi) 8379 (verilog-modi-get-gparams modi)
8614 (verilog-modi-get-sub-outputs modi) 8380 (verilog-modi-get-sub-outputs modi)
8615 (verilog-modi-get-sub-inouts modi) 8381 (verilog-modi-get-sub-inouts modi)))))
8616 ))))
8617 (forward-line 1) 8382 (forward-line 1)
8618 (when sig-list 8383 (when sig-list
8619 (verilog-insert-indent "// Beginning of automatic regs (for this module's undeclared outputs)\n") 8384 (verilog-insert-indent "// Beginning of automatic regs (for this module's undeclared outputs)\n")
8620 (verilog-insert-definition sig-list "reg" indent-pt nil) 8385 (verilog-insert-definition sig-list "reg" indent-pt nil)
8621 (verilog-modi-cache-add-regs modi sig-list) 8386 (verilog-modi-cache-add-regs modi sig-list)
8622 (verilog-insert-indent "// End of automatics\n")) 8387 (verilog-insert-indent "// End of automatics\n")))))
8623 )))
8624 8388
8625(defun verilog-auto-reg-input () 8389(defun verilog-auto-reg-input ()
8626 "Expand AUTOREGINPUT statements, as part of \\[verilog-auto]. 8390 "Expand AUTOREGINPUT statements, as part of \\[verilog-auto].
@@ -8665,15 +8429,13 @@ Typing \\[verilog-auto] will make this into:
8665 (verilog-signals-not-in 8429 (verilog-signals-not-in
8666 (append (verilog-modi-get-sub-inputs modi) 8430 (append (verilog-modi-get-sub-inputs modi)
8667 (verilog-modi-get-sub-inouts modi)) 8431 (verilog-modi-get-sub-inouts modi))
8668 (verilog-modi-get-signals modi) 8432 (verilog-modi-get-signals modi)))))
8669 ))))
8670 (forward-line 1) 8433 (forward-line 1)
8671 (when sig-list 8434 (when sig-list
8672 (verilog-insert-indent "// Beginning of automatic reg inputs (for undeclared instantiated-module inputs)\n") 8435 (verilog-insert-indent "// Beginning of automatic reg inputs (for undeclared instantiated-module inputs)\n")
8673 (verilog-insert-definition sig-list "reg" indent-pt nil) 8436 (verilog-insert-definition sig-list "reg" indent-pt nil)
8674 (verilog-modi-cache-add-regs modi sig-list) 8437 (verilog-modi-cache-add-regs modi sig-list)
8675 (verilog-insert-indent "// End of automatics\n")) 8438 (verilog-insert-indent "// End of automatics\n")))))
8676 )))
8677 8439
8678(defun verilog-auto-wire () 8440(defun verilog-auto-wire ()
8679 "Expand AUTOWIRE statements, as part of \\[verilog-auto]. 8441 "Expand AUTOWIRE statements, as part of \\[verilog-auto].
@@ -8726,8 +8488,7 @@ Typing \\[verilog-auto] will make this into:
8726 (verilog-signals-not-in 8488 (verilog-signals-not-in
8727 (append (verilog-modi-get-sub-outputs modi) 8489 (append (verilog-modi-get-sub-outputs modi)
8728 (verilog-modi-get-sub-inouts modi)) 8490 (verilog-modi-get-sub-inouts modi))
8729 (verilog-modi-get-signals modi) 8491 (verilog-modi-get-signals modi)))))
8730 ))))
8731 (forward-line 1) 8492 (forward-line 1)
8732 (when sig-list 8493 (when sig-list
8733 (verilog-insert-indent "// Beginning of automatic wires (for undeclared instantiated-module outputs)\n") 8494 (verilog-insert-indent "// Beginning of automatic wires (for undeclared instantiated-module outputs)\n")
@@ -8739,8 +8500,7 @@ Typing \\[verilog-auto] will make this into:
8739 (setq pnt (point)) 8500 (setq pnt (point))
8740 (verilog-pretty-declarations) 8501 (verilog-pretty-declarations)
8741 (goto-char pnt) 8502 (goto-char pnt)
8742 (verilog-pretty-expr "//"))) 8503 (verilog-pretty-expr "//"))))))
8743 )))
8744 8504
8745(defun verilog-auto-output () 8505(defun verilog-auto-output ()
8746 "Expand AUTOOUTPUT statements, as part of \\[verilog-auto]. 8506 "Expand AUTOOUTPUT statements, as part of \\[verilog-auto].
@@ -8793,8 +8553,7 @@ Typing \\[verilog-auto] will make this into:
8793 (append (verilog-modi-get-outputs modi) 8553 (append (verilog-modi-get-outputs modi)
8794 (verilog-modi-get-inouts modi) 8554 (verilog-modi-get-inouts modi)
8795 (verilog-modi-get-sub-inputs modi) 8555 (verilog-modi-get-sub-inputs modi)
8796 (verilog-modi-get-sub-inouts modi) 8556 (verilog-modi-get-sub-inouts modi)))))
8797 ))))
8798 (setq sig-list (verilog-signals-not-matching-regexp 8557 (setq sig-list (verilog-signals-not-matching-regexp
8799 sig-list verilog-auto-output-ignore-regexp)) 8558 sig-list verilog-auto-output-ignore-regexp))
8800 (forward-line 1) 8559 (forward-line 1)
@@ -8804,8 +8563,7 @@ Typing \\[verilog-auto] will make this into:
8804 (verilog-insert-definition sig-list "output" indent-pt v2k) 8563 (verilog-insert-definition sig-list "output" indent-pt v2k)
8805 (verilog-modi-cache-add-outputs modi sig-list) 8564 (verilog-modi-cache-add-outputs modi sig-list)
8806 (verilog-insert-indent "// End of automatics\n")) 8565 (verilog-insert-indent "// End of automatics\n"))
8807 (when v2k (verilog-repair-close-comma)) 8566 (when v2k (verilog-repair-close-comma)))))
8808 )))
8809 8567
8810(defun verilog-auto-output-every () 8568(defun verilog-auto-output-every ()
8811 "Expand AUTOOUTPUTEVERY statements, as part of \\[verilog-auto]. 8569 "Expand AUTOOUTPUTEVERY statements, as part of \\[verilog-auto].
@@ -8847,8 +8605,7 @@ Typing \\[verilog-auto] will make this into:
8847 (sig-list (verilog-signals-combine-bus 8605 (sig-list (verilog-signals-combine-bus
8848 (verilog-signals-not-in 8606 (verilog-signals-not-in
8849 (verilog-modi-get-signals modi) 8607 (verilog-modi-get-signals modi)
8850 (verilog-modi-get-ports modi) 8608 (verilog-modi-get-ports modi)))))
8851 ))))
8852 (forward-line 1) 8609 (forward-line 1)
8853 (when v2k (verilog-repair-open-comma)) 8610 (when v2k (verilog-repair-open-comma))
8854 (when sig-list 8611 (when sig-list
@@ -8856,8 +8613,7 @@ Typing \\[verilog-auto] will make this into:
8856 (verilog-insert-definition sig-list "output" indent-pt v2k) 8613 (verilog-insert-definition sig-list "output" indent-pt v2k)
8857 (verilog-modi-cache-add-outputs modi sig-list) 8614 (verilog-modi-cache-add-outputs modi sig-list)
8858 (verilog-insert-indent "// End of automatics\n")) 8615 (verilog-insert-indent "// End of automatics\n"))
8859 (when v2k (verilog-repair-close-comma)) 8616 (when v2k (verilog-repair-close-comma)))))
8860 )))
8861 8617
8862(defun verilog-auto-input () 8618(defun verilog-auto-input ()
8863 "Expand AUTOINPUT statements, as part of \\[verilog-auto]. 8619 "Expand AUTOINPUT statements, as part of \\[verilog-auto].
@@ -8913,8 +8669,7 @@ Typing \\[verilog-auto] will make this into:
8913 (verilog-modi-get-consts modi) 8669 (verilog-modi-get-consts modi)
8914 (verilog-modi-get-gparams modi) 8670 (verilog-modi-get-gparams modi)
8915 (verilog-modi-get-sub-outputs modi) 8671 (verilog-modi-get-sub-outputs modi)
8916 (verilog-modi-get-sub-inouts modi) 8672 (verilog-modi-get-sub-inouts modi)))))
8917 ))))
8918 (setq sig-list (verilog-signals-not-matching-regexp 8673 (setq sig-list (verilog-signals-not-matching-regexp
8919 sig-list verilog-auto-input-ignore-regexp)) 8674 sig-list verilog-auto-input-ignore-regexp))
8920 (forward-line 1) 8675 (forward-line 1)
@@ -8924,8 +8679,7 @@ Typing \\[verilog-auto] will make this into:
8924 (verilog-insert-definition sig-list "input" indent-pt v2k) 8679 (verilog-insert-definition sig-list "input" indent-pt v2k)
8925 (verilog-modi-cache-add-inputs modi sig-list) 8680 (verilog-modi-cache-add-inputs modi sig-list)
8926 (verilog-insert-indent "// End of automatics\n")) 8681 (verilog-insert-indent "// End of automatics\n"))
8927 (when v2k (verilog-repair-close-comma)) 8682 (when v2k (verilog-repair-close-comma)))))
8928 )))
8929 8683
8930(defun verilog-auto-inout () 8684(defun verilog-auto-inout ()
8931 "Expand AUTOINOUT statements, as part of \\[verilog-auto]. 8685 "Expand AUTOINOUT statements, as part of \\[verilog-auto].
@@ -8978,8 +8732,7 @@ Typing \\[verilog-auto] will make this into:
8978 (verilog-modi-get-inouts modi) 8732 (verilog-modi-get-inouts modi)
8979 (verilog-modi-get-inputs modi) 8733 (verilog-modi-get-inputs modi)
8980 (verilog-modi-get-sub-inputs modi) 8734 (verilog-modi-get-sub-inputs modi)
8981 (verilog-modi-get-sub-outputs modi) 8735 (verilog-modi-get-sub-outputs modi)))))
8982 ))))
8983 (setq sig-list (verilog-signals-not-matching-regexp 8736 (setq sig-list (verilog-signals-not-matching-regexp
8984 sig-list verilog-auto-inout-ignore-regexp)) 8737 sig-list verilog-auto-inout-ignore-regexp))
8985 (forward-line 1) 8738 (forward-line 1)
@@ -8989,8 +8742,7 @@ Typing \\[verilog-auto] will make this into:
8989 (verilog-insert-definition sig-list "inout" indent-pt v2k) 8742 (verilog-insert-definition sig-list "inout" indent-pt v2k)
8990 (verilog-modi-cache-add-inouts modi sig-list) 8743 (verilog-modi-cache-add-inouts modi sig-list)
8991 (verilog-insert-indent "// End of automatics\n")) 8744 (verilog-insert-indent "// End of automatics\n"))
8992 (when v2k (verilog-repair-close-comma)) 8745 (when v2k (verilog-repair-close-comma)))))
8993 )))
8994 8746
8995(defun verilog-auto-inout-module () 8747(defun verilog-auto-inout-module ()
8996 "Expand AUTOINOUTMODULE statements, as part of \\[verilog-auto]. 8748 "Expand AUTOINOUTMODULE statements, as part of \\[verilog-auto].
@@ -9062,8 +8814,7 @@ Typing \\[verilog-auto] will make this into:
9062 (verilog-modi-cache-add-outputs modi sig-list-o) 8814 (verilog-modi-cache-add-outputs modi sig-list-o)
9063 (verilog-modi-cache-add-inouts modi sig-list-io) 8815 (verilog-modi-cache-add-inouts modi sig-list-io)
9064 (verilog-insert-indent "// End of automatics\n")) 8816 (verilog-insert-indent "// End of automatics\n"))
9065 (when v2k (verilog-repair-close-comma)) 8817 (when v2k (verilog-repair-close-comma)))))))
9066 )))))
9067 8818
9068(defun verilog-auto-sense-sigs (modi presense-sigs) 8819(defun verilog-auto-sense-sigs (modi presense-sigs)
9069 "Return list of signals for current AUTOSENSE block." 8820 "Return list of signals for current AUTOSENSE block."
@@ -9164,8 +8915,7 @@ Typing \\[verilog-auto] will make this into:
9164 (not-first (insert " or "))) 8915 (not-first (insert " or ")))
9165 (insert (verilog-sig-name (car sig-list))) 8916 (insert (verilog-sig-name (car sig-list)))
9166 (setq sig-list (cdr sig-list) 8917 (setq sig-list (cdr sig-list)
9167 not-first t)) 8918 not-first t)))))
9168 )))
9169 8919
9170(defun verilog-auto-reset () 8920(defun verilog-auto-reset ()
9171 "Expand AUTORESET statements, as part of \\[verilog-auto]. 8921 "Expand AUTORESET statements, as part of \\[verilog-auto].
@@ -9260,8 +9010,7 @@ Typing \\[verilog-auto] will make this into:
9260 ";\n") 9010 ";\n")
9261 (indent-to indent-pt) 9011 (indent-to indent-pt)
9262 (setq sig-list (cdr sig-list)))) 9012 (setq sig-list (cdr sig-list))))
9263 (insert "// End of automatics")) 9013 (insert "// End of automatics")))))
9264 )))
9265 9014
9266(defun verilog-auto-tieoff () 9015(defun verilog-auto-tieoff ()
9267 "Expand AUTOTIEOFF statements, as part of \\[verilog-auto]. 9016 "Expand AUTOTIEOFF statements, as part of \\[verilog-auto].
@@ -9316,8 +9065,7 @@ Typing \\[verilog-auto] will make this into:
9316 (verilog-modi-get-consts modi) 9065 (verilog-modi-get-consts modi)
9317 (verilog-modi-get-gparams modi) 9066 (verilog-modi-get-gparams modi)
9318 (verilog-modi-get-sub-outputs modi) 9067 (verilog-modi-get-sub-outputs modi)
9319 (verilog-modi-get-sub-inouts modi) 9068 (verilog-modi-get-sub-inouts modi)))))
9320 ))))
9321 (when sig-list 9069 (when sig-list
9322 (forward-line 1) 9070 (forward-line 1)
9323 (verilog-insert-indent "// Beginning of automatic tieoffs (for this module's unterminated outputs)\n") 9071 (verilog-insert-indent "// Beginning of automatic tieoffs (for this module's unterminated outputs)\n")
@@ -9330,8 +9078,7 @@ Typing \\[verilog-auto] will make this into:
9330 (insert "= " (verilog-sig-tieoff sig) 9078 (insert "= " (verilog-sig-tieoff sig)
9331 ";\n") 9079 ";\n")
9332 (setq sig-list (cdr sig-list)))) 9080 (setq sig-list (cdr sig-list))))
9333 (verilog-insert-indent "// End of automatics\n") 9081 (verilog-insert-indent "// End of automatics\n")))))
9334 ))))
9335 9082
9336(defun verilog-auto-unused () 9083(defun verilog-auto-unused ()
9337 "Expand AUTOUNUSED statements, as part of \\[verilog-auto]. 9084 "Expand AUTOUNUSED statements, as part of \\[verilog-auto].
@@ -9395,8 +9142,7 @@ Typing \\[verilog-auto] will make this into:
9395 (append (verilog-modi-get-inputs modi) 9142 (append (verilog-modi-get-inputs modi)
9396 (verilog-modi-get-inouts modi)) 9143 (verilog-modi-get-inouts modi))
9397 (append (verilog-modi-get-sub-inputs modi) 9144 (append (verilog-modi-get-sub-inputs modi)
9398 (verilog-modi-get-sub-inouts modi) 9145 (verilog-modi-get-sub-inouts modi)))))
9399 ))))
9400 (setq sig-list (verilog-signals-not-matching-regexp 9146 (setq sig-list (verilog-signals-not-matching-regexp
9401 sig-list verilog-auto-unused-ignore-regexp)) 9147 sig-list verilog-auto-unused-ignore-regexp))
9402 (when sig-list 9148 (when sig-list
@@ -9408,8 +9154,7 @@ Typing \\[verilog-auto] will make this into:
9408 (indent-to indent-pt) 9154 (indent-to indent-pt)
9409 (insert (verilog-sig-name sig) ",\n") 9155 (insert (verilog-sig-name sig) ",\n")
9410 (setq sig-list (cdr sig-list)))) 9156 (setq sig-list (cdr sig-list))))
9411 (verilog-insert-indent "// End of automatics\n") 9157 (verilog-insert-indent "// End of automatics\n")))))
9412 ))))
9413 9158
9414(defun verilog-enum-ascii (signm elim-regexp) 9159(defun verilog-enum-ascii (signm elim-regexp)
9415 "Convert a enum name SIGNM to a ascii string for insertion. 9160 "Convert a enum name SIGNM to a ascii string for insertion.
@@ -9543,8 +9288,7 @@ Typing \\[verilog-auto] will make this into:
9543 (verilog-insert-indent "endcase\n") 9288 (verilog-insert-indent "endcase\n")
9544 (setq indent-pt (- indent-pt verilog-indent-level)) 9289 (setq indent-pt (- indent-pt verilog-indent-level))
9545 (verilog-insert-indent "end\n" 9290 (verilog-insert-indent "end\n"
9546 "// End of automatics\n") 9291 "// End of automatics\n"))))
9547 )))
9548 9292
9549(defun verilog-auto-templated-rel () 9293(defun verilog-auto-templated-rel ()
9550 "Replace Templated relative line numbers with absolute line numbers. 9294 "Replace Templated relative line numbers with absolute line numbers.
@@ -9694,8 +9438,7 @@ Wilson Snyder (wsnyder@wsnyder.org), and/or see http://www.veripool.com."
9694 ;; Must be after all inputs outputs are generated 9438 ;; Must be after all inputs outputs are generated
9695 (verilog-auto-search-do "/*AUTOARG*/" 'verilog-auto-arg) 9439 (verilog-auto-search-do "/*AUTOARG*/" 'verilog-auto-arg)
9696 ;; Fix line numbers (comments only) 9440 ;; Fix line numbers (comments only)
9697 (verilog-auto-templated-rel) 9441 (verilog-auto-templated-rel))
9698 )
9699 ;; 9442 ;;
9700 (run-hooks 'verilog-auto-hook) 9443 (run-hooks 'verilog-auto-hook)
9701 ;; 9444 ;;
@@ -9709,14 +9452,13 @@ Wilson Snyder (wsnyder@wsnyder.org), and/or see http://www.veripool.com."
9709 ;; Unwind forms 9452 ;; Unwind forms
9710 (progn 9453 (progn
9711 ;; Restore font-lock 9454 ;; Restore font-lock
9712 (when fontlocked (font-lock-mode t))) 9455 (when fontlocked (font-lock-mode t))))))
9713 )))
9714 9456
9715 9457
9716;; 9458;;
9717;; Skeleton based code insertion 9459;; Skeleton based code insertion
9718;; 9460;;
9719(defvar verilog-template-map 9461(defvar verilog-template-map
9720 (let ((map (make-sparse-keymap))) 9462 (let ((map (make-sparse-keymap)))
9721 (define-key map "a" 'verilog-sk-always) 9463 (define-key map "a" 'verilog-sk-always)
9722 (define-key map "b" 'verilog-sk-begin) 9464 (define-key map "b" 'verilog-sk-begin)
@@ -9985,16 +9727,14 @@ and the case items."
9985(defun verilog-sk-define-signal () 9727(defun verilog-sk-define-signal ()
9986 "Insert a definition of signal under point at top of module." 9728 "Insert a definition of signal under point at top of module."
9987 (interactive "*") 9729 (interactive "*")
9988 (let* ( 9730 (let* ((sig-re "[a-zA-Z0-9_]*")
9989 (sig-re "[a-zA-Z0-9_]*")
9990 (v1 (buffer-substring 9731 (v1 (buffer-substring
9991 (save-excursion 9732 (save-excursion
9992 (skip-chars-backward sig-re) 9733 (skip-chars-backward sig-re)
9993 (point)) 9734 (point))
9994 (save-excursion 9735 (save-excursion
9995 (skip-chars-forward sig-re) 9736 (skip-chars-forward sig-re)
9996 (point)))) 9737 (point)))))
9997 )
9998 (if (not (member v1 verilog-keywords)) 9738 (if (not (member v1 verilog-keywords))
9999 (save-excursion 9739 (save-excursion
10000 (setq verilog-sk-signal v1) 9740 (setq verilog-sk-signal v1)
@@ -10003,10 +9743,7 @@ and the case items."
10003 (verilog-forward-syntactic-ws) 9743 (verilog-forward-syntactic-ws)
10004 (verilog-sk-def-reg) 9744 (verilog-sk-def-reg)
10005 (message "signal at point is %s" v1)) 9745 (message "signal at point is %s" v1))
10006 (message "object at point (%s) is a keyword" v1)) 9746 (message "object at point (%s) is a keyword" v1))))
10007 )
10008 )
10009
10010 9747
10011(define-skeleton verilog-sk-wire 9748(define-skeleton verilog-sk-wire
10012 "Insert a wire definition." 9749 "Insert a wire definition."
@@ -10109,7 +9846,7 @@ and the case items."
10109 "^`include\\s-+\"\\([^\n\"]*\\)\"" 9846 "^`include\\s-+\"\\([^\n\"]*\\)\""
10110 "Regexp that matches the include file.") 9847 "Regexp that matches the include file.")
10111 9848
10112(defvar verilog-mode-mouse-map 9849(defvar verilog-mode-mouse-map
10113 (let ((map (make-sparse-keymap))) ; as described in info pages, make a map 9850 (let ((map (make-sparse-keymap))) ; as described in info pages, make a map
10114 (set-keymap-parent map verilog-mode-map) 9851 (set-keymap-parent map verilog-mode-map)
10115 ;; mouse button bindings 9852 ;; mouse button bindings
@@ -10189,8 +9926,7 @@ Files are checked based on `verilog-library-directories'."
10189 (progn 9926 (progn
10190 (message 9927 (message
10191 "File '%s' isn't readable, use shift-mouse2 to paste in this field" 9928 "File '%s' isn't readable, use shift-mouse2 to paste in this field"
10192 (match-string 1)))) 9929 (match-string 1)))))))
10193 )))
10194 9930
10195;; ffap isn't useable for verilog mode. It uses library paths. 9931;; ffap isn't useable for verilog mode. It uses library paths.
10196;; so define this function to do more or less the same as ffap 9932;; so define this function to do more or less the same as ffap
@@ -10208,8 +9944,7 @@ Files are checked based on `verilog-library-directories'."
10208 (file-readable-p (car (verilog-library-filenames 9944 (file-readable-p (car (verilog-library-filenames
10209 (match-string 1) (buffer-file-name))))) 9945 (match-string 1) (buffer-file-name)))))
10210 (find-file (car (verilog-library-filenames 9946 (find-file (car (verilog-library-filenames
10211 (match-string 1) (buffer-file-name)))))) 9947 (match-string 1) (buffer-file-name))))))))
10212 ))
10213 9948
10214 9949
10215;; 9950;;
@@ -10230,6 +9965,7 @@ Files are checked based on `verilog-library-directories'."
10230 (princ "\n"))) 9965 (princ "\n")))
10231 9966
10232(autoload 'reporter-submit-bug-report "reporter") 9967(autoload 'reporter-submit-bug-report "reporter")
9968(defvar reporter-prompt-for-summary-p)
10233 9969
10234(defun verilog-submit-bug-report () 9970(defun verilog-submit-bug-report ()
10235 "Submit via mail a bug report on verilog-mode.el." 9971 "Submit via mail a bug report on verilog-mode.el."
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 98818ea8354..72fda808053 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -2047,7 +2047,7 @@ your style, only those that are different from the default.")
2047(defun vhdl-keep-region-active () 2047(defun vhdl-keep-region-active ()
2048 "Do whatever is necessary to keep the region active in XEmacs. 2048 "Do whatever is necessary to keep the region active in XEmacs.
2049Ignore byte-compiler warnings you might see." 2049Ignore byte-compiler warnings you might see."
2050 (and (boundp 'zmacs-region-stays) 2050 (and (featurep 'xemacs)
2051 (setq zmacs-region-stays t))) 2051 (setq zmacs-region-stays t)))
2052 2052
2053;; `wildcard-to-regexp' is included only in XEmacs 21 2053;; `wildcard-to-regexp' is included only in XEmacs 21
diff --git a/lisp/repeat.el b/lisp/repeat.el
index 8e97abf32e9..fdeec47f7c4 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -200,6 +200,14 @@ this function is always whether the value of `this-command' would've been
200(defvar repeat-previous-repeated-command nil 200(defvar repeat-previous-repeated-command nil
201 "The previous repeated command.") 201 "The previous repeated command.")
202 202
203;; The following variable counts repeated self-insertions. The idea is
204;; that repeating a self-insertion command and subsequently undoing it
205;; should have almost the same effect as if the characters were inserted
206;; manually. The basic difference is that we leave in one undo-boundary
207;; between the original insertion and its first repetition.
208(defvar repeat-undo-count nil
209 "Number of self-insertions since last `undo-boundary'.")
210
203;;;###autoload 211;;;###autoload
204(defun repeat (repeat-arg) 212(defun repeat (repeat-arg)
205 "Repeat most recently executed command. 213 "Repeat most recently executed command.
@@ -246,12 +254,6 @@ recently executed command not bound to an input event\"."
246 ;; needs to be saved. 254 ;; needs to be saved.
247 (let ((repeat-repeat-char 255 (let ((repeat-repeat-char
248 (if (eq repeat-on-final-keystroke t) 256 (if (eq repeat-on-final-keystroke t)
249 ;; The following commented out since it's equivalent to
250 ;; last-comment-char (martin 2007-08-29).
251;;; ;; allow any final input event that was a character
252;;; (when (eq last-command-char
253;;; last-command-event)
254;;; last-command-char)
255 last-command-char 257 last-command-char
256 ;; allow only specified final keystrokes 258 ;; allow only specified final keystrokes
257 (car (memq last-command-char 259 (car (memq last-command-char
@@ -293,11 +295,22 @@ recently executed command not bound to an input event\"."
293 (i 0)) 295 (i 0))
294 ;; Run pre- and post-command hooks for self-insertion too. 296 ;; Run pre- and post-command hooks for self-insertion too.
295 (run-hooks 'pre-command-hook) 297 (run-hooks 'pre-command-hook)
298 (cond
299 ((not repeat-undo-count))
300 ((< repeat-undo-count 20)
301 ;; Don't make an undo-boundary here.
302 (setq repeat-undo-count (1+ repeat-undo-count)))
303 (t
304 ;; Make an undo-boundary after 20 repetitions only.
305 (undo-boundary)
306 (setq repeat-undo-count 1)))
296 (while (< i count) 307 (while (< i count)
297 (repeat-self-insert insertion) 308 (repeat-self-insert insertion)
298 (setq i (1+ i))) 309 (setq i (1+ i)))
299 (run-hooks 'post-command-hook))) 310 (run-hooks 'post-command-hook)))
300 (let ((indirect (indirect-function last-repeatable-command))) 311 (let ((indirect (indirect-function last-repeatable-command)))
312 ;; Make each repetition undo separately.
313 (undo-boundary)
301 (if (or (stringp indirect) 314 (if (or (stringp indirect)
302 (vectorp indirect)) 315 (vectorp indirect))
303 ;; Bind real-last-command so that executing the macro does 316 ;; Bind real-last-command so that executing the macro does
@@ -314,12 +327,20 @@ recently executed command not bound to an input event\"."
314 ;; (only 32 repetitions are possible given the default value of 200 for 327 ;; (only 32 repetitions are possible given the default value of 200 for
315 ;; max-lisp-eval-depth), but if I now locally disable the repeat char I 328 ;; max-lisp-eval-depth), but if I now locally disable the repeat char I
316 ;; can iterate indefinitely here around a single level of recursion. 329 ;; can iterate indefinitely here around a single level of recursion.
317 (let (repeat-on-final-keystroke) 330 (let (repeat-on-final-keystroke
331 ;; Bind `undo-inhibit-record-point' to t in order to avoid
332 ;; recording point in `buffer-undo-list' here. We have to
333 ;; do this since the command loop does not set the last
334 ;; position of point thus confusing the point recording
335 ;; mechanism when inserting or deleting text.
336 (undo-inhibit-record-point t))
318 (setq real-last-command 'repeat) 337 (setq real-last-command 'repeat)
319 (while (eq (read-event) repeat-repeat-char) 338 (setq repeat-undo-count 1)
320 ;; Make each repetition undo separately. 339 (unwind-protect
321 (undo-boundary) 340 (while (eq (read-event) repeat-repeat-char)
322 (repeat repeat-arg)) 341 (repeat repeat-arg))
342 ;; Make sure `repeat-undo-count' is reset.
343 (setq repeat-undo-count nil))
323 (setq unread-command-events (list last-input-event)))))) 344 (setq unread-command-events (list last-input-event))))))
324 345
325(defun repeat-self-insert (string) 346(defun repeat-self-insert (string)
diff --git a/lisp/replace.el b/lisp/replace.el
index 0217e73e44c..3680d574e8c 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -789,6 +789,13 @@ See `occur-revert-function'.")
789 :type 'hook 789 :type 'hook
790 :group 'matching) 790 :group 'matching)
791 791
792(defcustom occur-mode-find-occurrence-hook nil
793 "Hook run by Occur after locating an occurrence.
794This will be called with the cursor position at the occurrence. An application
795for this is to reveal context in an outline-mode when the occurrence is hidden."
796 :type 'hook
797 :group 'matching)
798
792(put 'occur-mode 'mode-class 'special) 799(put 'occur-mode 'mode-class 'special)
793(defun occur-mode () 800(defun occur-mode ()
794 "Major mode for output from \\[occur]. 801 "Major mode for output from \\[occur].
@@ -837,14 +844,16 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
837 same-window-buffer-names 844 same-window-buffer-names
838 same-window-regexps) 845 same-window-regexps)
839 (pop-to-buffer (marker-buffer pos)) 846 (pop-to-buffer (marker-buffer pos))
840 (goto-char pos))) 847 (goto-char pos)
848 (run-hooks 'occur-mode-find-occurrence-hook)))
841 849
842(defun occur-mode-goto-occurrence-other-window () 850(defun occur-mode-goto-occurrence-other-window ()
843 "Go to the occurrence the current line describes, in another window." 851 "Go to the occurrence the current line describes, in another window."
844 (interactive) 852 (interactive)
845 (let ((pos (occur-mode-find-occurrence))) 853 (let ((pos (occur-mode-find-occurrence)))
846 (switch-to-buffer-other-window (marker-buffer pos)) 854 (switch-to-buffer-other-window (marker-buffer pos))
847 (goto-char pos))) 855 (goto-char pos)
856 (run-hooks 'occur-mode-find-occurrence-hook)))
848 857
849(defun occur-mode-display-occurrence () 858(defun occur-mode-display-occurrence ()
850 "Display in another window the occurrence the current line describes." 859 "Display in another window the occurrence the current line describes."
@@ -858,7 +867,8 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
858 ;; This is the way to set point in the proper window. 867 ;; This is the way to set point in the proper window.
859 (save-selected-window 868 (save-selected-window
860 (select-window window) 869 (select-window window)
861 (goto-char pos)))) 870 (goto-char pos)
871 (run-hooks 'occur-mode-find-occurrence-hook))))
862 872
863(defun occur-find-match (n search message) 873(defun occur-find-match (n search message)
864 (if (not n) (setq n 1)) 874 (if (not n) (setq n 1))
diff --git a/lisp/server.el b/lisp/server.el
index 63245135347..024df504779 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -291,17 +291,29 @@ If NOFRAME is non-nil, let the frames live. (To be used from
291 291
292 (server-log "Deleted" proc)))) 292 (server-log "Deleted" proc))))
293 293
294(defvar server-log-time-function 'current-time-string
295 "Function to generate timestamps for `server-buffer'.")
296
297(defconst server-buffer " *server*"
298 "Buffer used internally by Emacs's server.
299One use is to log the I/O for debugging purposes (see `server-log'),
300the other is to provide a current buffer in which the process filter can
301safely let-bind buffer-local variables like `default-directory'.")
302
303(defvar server-log nil
304 "If non-nil, log the server's inputs and outputs in the `server-buffer'.")
305
294(defun server-log (string &optional client) 306(defun server-log (string &optional client)
295 "If a *server* buffer exists, write STRING to it for logging purposes. 307 "If `server-log' is non-nil, log STRING to `server-buffer'.
296If CLIENT is non-nil, add a description of it to the logged message." 308If CLIENT is non-nil, add a description of it to the logged message."
297 (when (get-buffer "*server*") 309 (when server-log
298 (with-current-buffer "*server*" 310 (with-current-buffer (get-buffer-create server-buffer)
299 (goto-char (point-max)) 311 (goto-char (point-max))
300 (insert (current-time-string) 312 (insert (funcall server-log-time-function)
301 (cond 313 (cond
302 ((null client) " ") 314 ((null client) " ")
303 ((listp client) (format " %s: " (car client))) 315 ((listp client) (format " %s: " (car client)))
304 (t (format " %s: " client))) 316 (t (format " %s: " client)))
305 string) 317 string)
306 (or (bolp) (newline))))) 318 (or (bolp) (newline)))))
307 319
@@ -494,7 +506,7 @@ kill any existing server communications subprocess."
494 ;; Those are decoded by server-process-filter according 506 ;; Those are decoded by server-process-filter according
495 ;; to file-name-coding-system. 507 ;; to file-name-coding-system.
496 :coding 'raw-text 508 :coding 'raw-text
497 ;; The rest of the args depends on the kind of socket used. 509 ;; The other args depend on the kind of socket used.
498 (if server-use-tcp 510 (if server-use-tcp
499 (list :family nil 511 (list :family nil
500 :service t 512 :service t
@@ -764,7 +776,7 @@ The following commands are accepted by the client:
764 (server-log (concat "Received " string) proc) 776 (server-log (concat "Received " string) proc)
765 ;; First things first: let's check the authentication 777 ;; First things first: let's check the authentication
766 (unless (process-get proc :authenticated) 778 (unless (process-get proc :authenticated)
767 (if (and (string-match "-auth \\(.*?\\)\n" string) 779 (if (and (string-match "-auth \\([!-~]+\\)\n?" string)
768 (equal (match-string 1 string) (process-get proc :auth-key))) 780 (equal (match-string 1 string) (process-get proc :auth-key)))
769 (progn 781 (progn
770 (setq string (substring string (match-end 0))) 782 (setq string (substring string (match-end 0)))
@@ -805,8 +817,7 @@ The following commands are accepted by the client:
805 (tty-name nil) ;nil, `window-system', or the tty name. 817 (tty-name nil) ;nil, `window-system', or the tty name.
806 tty-type ;string. 818 tty-type ;string.
807 (files nil) 819 (files nil)
808 (lineno 1) 820 (filepos nil)
809 (columnno 0)
810 command-line-args-left 821 command-line-args-left
811 arg) 822 arg)
812 ;; Remove this line from STRING. 823 ;; Remove this line from STRING.
@@ -876,9 +887,9 @@ The following commands are accepted by the client:
876 (string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?" 887 (string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?"
877 (car command-line-args-left))) 888 (car command-line-args-left)))
878 (setq arg (pop command-line-args-left)) 889 (setq arg (pop command-line-args-left))
879 (setq lineno (string-to-number (match-string 1 arg)) 890 (setq filepos
880 columnno (if (null (match-end 2)) 0 891 (cons (string-to-number (match-string 1 arg))
881 (string-to-number (match-string 2 arg))))) 892 (string-to-number (or (match-string 2 arg) "")))))
882 893
883 ;; -file FILENAME: Load the given file. 894 ;; -file FILENAME: Load the given file.
884 ((and (equal "-file" arg) 895 ((and (equal "-file" arg)
@@ -887,11 +898,10 @@ The following commands are accepted by the client:
887 (if coding-system 898 (if coding-system
888 (setq file (decode-coding-string file coding-system))) 899 (setq file (decode-coding-string file coding-system)))
889 (setq file (command-line-normalize-file-name file)) 900 (setq file (command-line-normalize-file-name file))
890 (push (list file lineno columnno) files) 901 (push (cons file filepos) files)
891 (server-log (format "New file: %s (%d:%d)" 902 (server-log (format "New file: %s %s"
892 file lineno columnno) proc)) 903 file (or filepos "")) proc))
893 (setq lineno 1 904 (setq filepos nil))
894 columnno 0))
895 905
896 ;; -eval EXPR: Evaluate a Lisp expression. 906 ;; -eval EXPR: Evaluate a Lisp expression.
897 ((and (equal "-eval" arg) 907 ((and (equal "-eval" arg)
@@ -901,8 +911,7 @@ The following commands are accepted by the client:
901 (setq expr (decode-coding-string expr coding-system))) 911 (setq expr (decode-coding-string expr coding-system)))
902 (push (lambda () (server-eval-and-print expr proc)) 912 (push (lambda () (server-eval-and-print expr proc))
903 commands) 913 commands)
904 (setq lineno 1 914 (setq filepos nil)))
905 columnno 0)))
906 915
907 ;; -env NAME=VALUE: An environment variable. 916 ;; -env NAME=VALUE: An environment variable.
908 ((and (equal "-env" arg) command-line-args-left) 917 ((and (equal "-env" arg) command-line-args-left)
@@ -928,17 +937,25 @@ The following commands are accepted by the client:
928 (server-create-window-system-frame display nowait proc)) 937 (server-create-window-system-frame display nowait proc))
929 (t (server-create-tty-frame tty-name tty-type proc)))) 938 (t (server-create-tty-frame tty-name tty-type proc))))
930 939
931 (process-put proc 'continuation 940 (process-put
932 (lexical-let ((proc proc) 941 proc 'continuation
933 (files files) 942 (lexical-let ((proc proc)
934 (nowait nowait) 943 (files files)
935 (commands commands) 944 (nowait nowait)
936 (dontkill dontkill) 945 (commands commands)
937 (frame frame) 946 (dontkill dontkill)
938 (tty-name tty-name)) 947 (frame frame)
939 (lambda () 948 (dir dir)
940 (server-execute proc files nowait commands 949 (tty-name tty-name))
941 dontkill frame tty-name)))) 950 (lambda ()
951 (with-current-buffer (get-buffer-create server-buffer)
952 ;; Use the same cwd as the emacsclient, if possible, so
953 ;; relative file names work correctly, even in `eval'.
954 (let ((default-directory
955 (if (and dir (file-directory-p dir))
956 dir default-directory)))
957 (server-execute proc files nowait commands
958 dontkill frame tty-name))))))
942 959
943 (when (or frame files) 960 (when (or frame files)
944 (server-goto-toplevel proc)) 961 (server-goto-toplevel proc))
@@ -991,18 +1008,19 @@ The following commands are accepted by the client:
991 (server-log (error-message-string err) proc) 1008 (server-log (error-message-string err) proc)
992 (delete-process proc))) 1009 (delete-process proc)))
993 1010
994(defun server-goto-line-column (file-line-col) 1011(defun server-goto-line-column (line-col)
995 "Move point to the position indicated in FILE-LINE-COL. 1012 "Move point to the position indicated in LINE-COL.
996FILE-LINE-COL should be a three-element list as described in 1013LINE-COL should be a pair (LINE . COL)."
997`server-visit-files'." 1014 (when line-col
998 (goto-line (nth 1 file-line-col)) 1015 (goto-line (car line-col))
999 (let ((column-number (nth 2 file-line-col))) 1016 (let ((column-number (cdr line-col)))
1000 (when (> column-number 0) 1017 (when (> column-number 0)
1001 (move-to-column (1- column-number))))) 1018 (move-to-column (1- column-number))))))
1002 1019
1003(defun server-visit-files (files proc &optional nowait) 1020(defun server-visit-files (files proc &optional nowait)
1004 "Find FILES and return a list of buffers created. 1021 "Find FILES and return a list of buffers created.
1005FILES is an alist whose elements are (FILENAME LINENUMBER COLUMNNUMBER). 1022FILES is an alist whose elements are (FILENAME . FILEPOS)
1023where FILEPOS can be nil or a pair (LINENUMBER . COLUMNNUMBER).
1006PROC is the client that requested this operation. 1024PROC is the client that requested this operation.
1007NOWAIT non-nil means this client is not waiting for the results, 1025NOWAIT non-nil means this client is not waiting for the results,
1008so don't mark these buffers specially, just visit them normally." 1026so don't mark these buffers specially, just visit them normally."
@@ -1021,22 +1039,21 @@ so don't mark these buffers specially, just visit them normally."
1021 (filen (car file)) 1039 (filen (car file))
1022 (obuf (get-file-buffer filen))) 1040 (obuf (get-file-buffer filen)))
1023 (add-to-history 'file-name-history filen) 1041 (add-to-history 'file-name-history filen)
1024 (if (and obuf (set-buffer obuf)) 1042 (if (null obuf)
1025 (progn 1043 (set-buffer (find-file-noselect filen))
1026 (cond ((file-exists-p filen) 1044 (set-buffer obuf)
1027 (when (not (verify-visited-file-modtime obuf)) 1045 (cond ((file-exists-p filen)
1028 (revert-buffer t nil))) 1046 (when (not (verify-visited-file-modtime obuf))
1029 (t 1047 (revert-buffer t nil)))
1030 (when (y-or-n-p 1048 (t
1031 (concat "File no longer exists: " filen 1049 (when (y-or-n-p
1032 ", write buffer to file? ")) 1050 (concat "File no longer exists: " filen
1033 (write-file filen)))) 1051 ", write buffer to file? "))
1034 (unless server-buffer-clients 1052 (write-file filen))))
1035 (setq server-existing-buffer t)) 1053 (unless server-buffer-clients
1036 (server-goto-line-column file)) 1054 (setq server-existing-buffer t)))
1037 (set-buffer (find-file-noselect filen)) 1055 (server-goto-line-column (cdr file))
1038 (server-goto-line-column file) 1056 (run-hooks 'server-visit-hook))
1039 (run-hooks 'server-visit-hook)))
1040 (unless nowait 1057 (unless nowait
1041 ;; When the buffer is killed, inform the clients. 1058 ;; When the buffer is killed, inform the clients.
1042 (add-hook 'kill-buffer-hook 'server-kill-buffer nil t) 1059 (add-hook 'kill-buffer-hook 'server-kill-buffer nil t)
diff --git a/lisp/smerge-mode.el b/lisp/smerge-mode.el
index b72107eb6c3..f2a7a9caf9e 100644
--- a/lisp/smerge-mode.el
+++ b/lisp/smerge-mode.el
@@ -851,10 +851,12 @@ replace chars to try and eliminate some spurious differences."
851 (remove-overlays (match-beginning 0) (match-end 0) 'smerge 'refine) 851 (remove-overlays (match-beginning 0) (match-end 0) 'smerge 'refine)
852 (smerge-ensure-match 1) 852 (smerge-ensure-match 1)
853 (smerge-ensure-match 3) 853 (smerge-ensure-match 3)
854 (smerge-refine-subst (match-beginning 1) (match-end 1) 854 ;; Match 1 and 3 may be one and the same in case of trivial diff3 -A conflict.
855 (match-beginning 3) (match-end 3) 855 (let ((n1 (if (eq (match-end 1) (match-end 3)) 2 1)))
856 '((smerge . refine) 856 (smerge-refine-subst (match-beginning n1) (match-end n1)
857 (face . smerge-refined-change)))) 857 (match-beginning 3) (match-end 3)
858 '((smerge . refine)
859 (face . smerge-refined-change)))))
858 860
859(defun smerge-diff (n1 n2) 861(defun smerge-diff (n1 n2)
860 (smerge-match-conflict) 862 (smerge-match-conflict)
@@ -992,6 +994,32 @@ buffer names."
992 (message "Conflict resolution finished; you may save the buffer"))))) 994 (message "Conflict resolution finished; you may save the buffer")))))
993 (message "Please resolve conflicts now; exit ediff when done"))) 995 (message "Please resolve conflicts now; exit ediff when done")))
994 996
997(defun smerge-makeup-conflict (pt1 pt2 pt3 &optional pt4)
998 "Insert diff3 markers to make a new conflict.
999Uses point and mark for 2 of the relevant positions and previous marks
1000for the other ones.
1001By default, makes up a 2-way conflict,
1002with a \\[universal-argument] prefix, makes up a 3-way conflict."
1003 (interactive
1004 (list (point)
1005 (mark)
1006 (progn (pop-mark) (mark))
1007 (when current-prefix-arg (pop-mark) (mark))))
1008 ;; Start from the end so as to avoid problems with pos-changes.
1009 (destructuring-bind (pt1 pt2 pt3 &optional pt4)
1010 (sort (list* pt1 pt2 pt3 (if pt4 (list pt4))) '>=)
1011 (goto-char pt1) (beginning-of-line)
1012 (insert ">>>>>>> OTHER\n")
1013 (goto-char pt2) (beginning-of-line)
1014 (insert "=======\n")
1015 (goto-char pt3) (beginning-of-line)
1016 (when pt4
1017 (insert "||||||| BASE\n")
1018 (goto-char pt4) (beginning-of-line))
1019 (insert "<<<<<<< MINE\n"))
1020 (if smerge-mode nil (smerge-mode 1))
1021 (smerge-refine))
1022
995 1023
996(defconst smerge-parsep-re 1024(defconst smerge-parsep-re
997 (concat smerge-begin-re "\\|" smerge-end-re "\\|" 1025 (concat smerge-begin-re "\\|" smerge-end-re "\\|"
@@ -1021,6 +1049,14 @@ buffer names."
1021 (unless smerge-mode 1049 (unless smerge-mode
1022 (smerge-remove-props (point-min) (point-max)))) 1050 (smerge-remove-props (point-min) (point-max))))
1023 1051
1052;;;###autoload
1053(defun smerge-start-session ()
1054 "Turn on `smerge-mode' and move point to first conflict marker.
1055If no conflict maker is found, turn off `smerge-mode'."
1056 (smerge-mode 1)
1057 (condition-case nil
1058 (smerge-next)
1059 (error (smerge-auto-leave))))
1024 1060
1025(provide 'smerge-mode) 1061(provide 'smerge-mode)
1026 1062
diff --git a/lisp/subr.el b/lisp/subr.el
index 2ce5fff571d..8c7d89591d9 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1103,7 +1103,17 @@ function, it is changed to a list of functions."
1103 (append hook-value (list function)) 1103 (append hook-value (list function))
1104 (cons function hook-value)))) 1104 (cons function hook-value))))
1105 ;; Set the actual variable 1105 ;; Set the actual variable
1106 (if local (set hook hook-value) (set-default hook hook-value)))) 1106 (if local
1107 (progn
1108 ;; If HOOK isn't a permanent local,
1109 ;; but FUNCTION wants to survive a change of modes,
1110 ;; mark HOOK as partially permanent.
1111 (and (symbolp function)
1112 (get function 'permanent-local-hook)
1113 (not (get hook 'permanent-local))
1114 (put hook 'permanent-local 'permanent-local-hook))
1115 (set hook hook-value))
1116 (set-default hook hook-value))))
1107 1117
1108(defun remove-hook (hook function &optional local) 1118(defun remove-hook (hook function &optional local)
1109 "Remove from the value of HOOK the function FUNCTION. 1119 "Remove from the value of HOOK the function FUNCTION.
@@ -1860,6 +1870,10 @@ user can undo the change normally."
1860 (let ((handle (make-symbol "--change-group-handle--")) 1870 (let ((handle (make-symbol "--change-group-handle--"))
1861 (success (make-symbol "--change-group-success--"))) 1871 (success (make-symbol "--change-group-success--")))
1862 `(let ((,handle (prepare-change-group)) 1872 `(let ((,handle (prepare-change-group))
1873 ;; Don't truncate any undo data in the middle of this.
1874 (undo-outer-limit nil)
1875 (undo-limit most-positive-fixnum)
1876 (undo-strong-limit most-positive-fixnum)
1863 (,success nil)) 1877 (,success nil))
1864 (unwind-protect 1878 (unwind-protect
1865 (progn 1879 (progn
@@ -2113,26 +2127,29 @@ Note that this should end with a directory separator.")
2113(defun find-tag-default () 2127(defun find-tag-default ()
2114 "Determine default tag to search for, based on text at point. 2128 "Determine default tag to search for, based on text at point.
2115If there is no plausible default, return nil." 2129If there is no plausible default, return nil."
2116 (save-excursion 2130 (let (from to bound)
2117 (while (looking-at "\\sw\\|\\s_") 2131 (when (or (progn
2118 (forward-char 1)) 2132 ;; Look at text around `point'.
2119 (if (or (re-search-backward "\\sw\\|\\s_" 2133 (save-excursion
2120 (save-excursion (beginning-of-line) (point)) 2134 (skip-syntax-backward "w_") (setq from (point)))
2121 t) 2135 (save-excursion
2122 (re-search-forward "\\(\\sw\\|\\s_\\)+" 2136 (skip-syntax-forward "w_") (setq to (point)))
2123 (save-excursion (end-of-line) (point)) 2137 (> to from))
2124 t)) 2138 ;; Look between `line-beginning-position' and `point'.
2125 (progn 2139 (save-excursion
2126 (goto-char (match-end 0)) 2140 (and (setq bound (line-beginning-position))
2127 (condition-case nil 2141 (skip-syntax-backward "^w_" bound)
2128 (buffer-substring-no-properties 2142 (> (setq to (point)) bound)
2129 (point) 2143 (skip-syntax-backward "w_")
2130 (progn (forward-sexp -1) 2144 (setq from (point))))
2131 (while (looking-at "\\s'") 2145 ;; Look between `point' and `line-end-position'.
2132 (forward-char 1)) 2146 (save-excursion
2133 (point))) 2147 (and (setq bound (line-end-position))
2134 (error nil))) 2148 (skip-syntax-forward "^w_" bound)
2135 nil))) 2149 (< (setq from (point)) bound)
2150 (skip-syntax-forward "w_")
2151 (setq to (point)))))
2152 (buffer-substring-no-properties from to))))
2136 2153
2137(defun play-sound (sound) 2154(defun play-sound (sound)
2138 "SOUND is a list of the form `(sound KEYWORD VALUE...)'. 2155 "SOUND is a list of the form `(sound KEYWORD VALUE...)'.
diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el
index 1a000f37470..a89fe142551 100644
--- a/lisp/t-mouse.el
+++ b/lisp/t-mouse.el
@@ -4,7 +4,8 @@
4;; Maintainer: FSF 4;; Maintainer: FSF
5;; Keywords: mouse gpm linux 5;; Keywords: mouse gpm linux
6 6
7;; Copyright (C) 1994, 1995, 1998, 2006, 2007, 2008 Free Software Foundation, Inc. 7;; Copyright (C) 1994, 1995, 1998, 2006, 2007, 2008
8;; Free Software Foundation, Inc.
8 9
9;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
10 11
@@ -39,6 +40,9 @@
39 40
40;;; Code: 41;;; Code:
41 42
43;; Prevent warning when compiling in an Emacs without gpm support.
44(declare-function gpm-mouse-start "term.c" ())
45
42;;;###autoload 46;;;###autoload
43(define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1") 47(define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1")
44;;;###autoload 48;;;###autoload
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 23d5af1bc63..ed974160382 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -785,7 +785,8 @@ appear on disk when you save the tar-file's buffer."
785 (narrow-to-region (point-min) tar-header-offset) 785 (narrow-to-region (point-min) tar-header-offset)
786 (goto-char pos))) 786 (goto-char pos)))
787 (if view-p 787 (if view-p
788 (view-buffer buffer (and just-created 'kill-buffer)) 788 (view-buffer
789 buffer (and just-created 'kill-buffer-if-not-modified))
789 (if (eq other-window-p 'display) 790 (if (eq other-window-p 'display)
790 (display-buffer buffer) 791 (display-buffer buffer)
791 (if other-window-p 792 (if other-window-p
diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el
index f45d7e0ad7a..c5f34a668b0 100644
--- a/lisp/term/w32console.el
+++ b/lisp/term/w32console.el
@@ -1,6 +1,6 @@
1;;; w32console.el -- Setup w32 console keys and colors. 1;;; w32console.el -- Setup w32 console keys and colors.
2 2
3;; Copyright (C) 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: FSF 5;; Author: FSF
6;; Keywords: terminals 6;; Keywords: terminals
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 9cdd3082168..1544e4fd24f 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -119,6 +119,7 @@ inherit-booktitle If entry contains a crossref field and the booktitle
119realign Realign entries, so that field texts and perhaps equal 119realign Realign entries, so that field texts and perhaps equal
120 signs (depending on the value of 120 signs (depending on the value of
121 `bibtex-align-at-equal-sign') begin in the same column. 121 `bibtex-align-at-equal-sign') begin in the same column.
122 Also fill fields.
122last-comma Add or delete comma on end of last field in entry, 123last-comma Add or delete comma on end of last field in entry,
123 according to value of `bibtex-comma-after-last-field'. 124 according to value of `bibtex-comma-after-last-field'.
124delimiters Change delimiters according to variables 125delimiters Change delimiters according to variables
@@ -1085,6 +1086,7 @@ Used by `bibtex-find-crossref' and for font-locking."
1085 "--" 1086 "--"
1086 ["Convert Alien Buffer" bibtex-convert-alien t]) 1087 ["Convert Alien Buffer" bibtex-convert-alien t])
1087 ("Operating on Multiple Buffers" 1088 ("Operating on Multiple Buffers"
1089 ["(Re)Initialize BibTeX Buffers" bibtex-initialize t]
1088 ["Validate Entries" bibtex-validate-globally t]))) 1090 ["Validate Entries" bibtex-validate-globally t])))
1089 1091
1090(easy-menu-define 1092(easy-menu-define
@@ -1782,7 +1784,7 @@ If FLAG is nil, a message is echoed if point was incremented at least
1782 ")")) 1784 ")"))
1783 1785
1784(defun bibtex-flash-head (prompt) 1786(defun bibtex-flash-head (prompt)
1785 "Flash at BibTeX entry head before point, if exists." 1787 "Flash at BibTeX entry head before point, if it exists."
1786 (let ((case-fold-search t) 1788 (let ((case-fold-search t)
1787 (pnt (point))) 1789 (pnt (point)))
1788 (save-excursion 1790 (save-excursion
@@ -1790,7 +1792,8 @@ If FLAG is nil, a message is echoed if point was incremented at least
1790 (when (and (looking-at bibtex-any-entry-maybe-empty-head) 1792 (when (and (looking-at bibtex-any-entry-maybe-empty-head)
1791 (< (point) pnt)) 1793 (< (point) pnt))
1792 (goto-char (match-beginning bibtex-type-in-head)) 1794 (goto-char (match-beginning bibtex-type-in-head))
1793 (if (pos-visible-in-window-p (point)) 1795 (if (and (< 0 blink-matching-delay)
1796 (pos-visible-in-window-p (point)))
1794 (sit-for blink-matching-delay) 1797 (sit-for blink-matching-delay)
1795 (message "%s%s" prompt (buffer-substring-no-properties 1798 (message "%s%s" prompt (buffer-substring-no-properties
1796 (point) (match-end bibtex-key-in-head)))))))) 1799 (point) (match-end bibtex-key-in-head))))))))
@@ -1875,38 +1878,42 @@ Optional arg COMMA is as in `bibtex-enclosing-field'."
1875(defun bibtex-format-entry () 1878(defun bibtex-format-entry ()
1876 "Helper function for `bibtex-clean-entry'. 1879 "Helper function for `bibtex-clean-entry'.
1877Formats current entry according to variable `bibtex-entry-format'." 1880Formats current entry according to variable `bibtex-entry-format'."
1881 ;; initialize `bibtex-field-braces-opt' if necessary
1882 (if (and bibtex-field-braces-alist (not bibtex-field-braces-opt))
1883 (setq bibtex-field-braces-opt
1884 (bibtex-field-re-init bibtex-field-braces-alist 'braces)))
1885 ;; initialize `bibtex-field-strings-opt' if necessary
1886 (if (and bibtex-field-strings-alist (not bibtex-field-strings-opt))
1887 (setq bibtex-field-strings-opt
1888 (bibtex-field-re-init bibtex-field-strings-alist 'strings)))
1889
1878 (save-excursion 1890 (save-excursion
1879 (save-restriction 1891 (save-restriction
1880 (bibtex-narrow-to-entry) 1892 (bibtex-narrow-to-entry)
1881 (let ((case-fold-search t) 1893 (let ((case-fold-search t)
1882 (format (if (eq bibtex-entry-format t) 1894 (format (if (eq bibtex-entry-format t)
1883 '(realign opts-or-alts required-fields 1895 '(realign opts-or-alts required-fields numerical-fields
1884 numerical-fields 1896 page-dashes whitespace inherit-booktitle
1885 last-comma page-dashes delimiters 1897 last-comma delimiters unify-case braces
1886 unify-case inherit-booktitle) 1898 strings)
1887 bibtex-entry-format)) 1899 bibtex-entry-format))
1888 crossref-key bounds alternatives-there non-empty-alternative 1900 bounds crossref-key req-field-list default-field-list field-list)
1889 entry-list req-field-list field-list) 1901
1890 1902 ;; There are more elegant high-level functions for several tasks
1891 ;; Initialize `bibtex-field-braces-opt' and `bibtex-field-strings-opt' 1903 ;; done by `bibtex-format-entry'. However, they contain some
1892 ;; if necessary. 1904 ;; redundancy compared with what we need to do anyway.
1893 (unless bibtex-field-braces-opt 1905 ;; So for speed-up we avoid using them.
1894 (setq bibtex-field-braces-opt 1906 ;; (`bibtex-format-entry' is called many times by `bibtex-reformat'.)
1895 (bibtex-field-re-init bibtex-field-braces-alist 'braces)))
1896 (unless bibtex-field-strings-opt
1897 (setq bibtex-field-strings-opt
1898 (bibtex-field-re-init bibtex-field-strings-alist 'strings)))
1899 1907
1900 ;; identify entry type 1908 ;; identify entry type
1901 (goto-char (point-min)) 1909 (goto-char (point-min))
1902 (or (re-search-forward bibtex-entry-type nil t) 1910 (or (re-search-forward bibtex-entry-type nil t)
1903 (error "Not inside a BibTeX entry")) 1911 (error "Not inside a BibTeX entry"))
1904 (let ((beg-type (1+ (match-beginning 0))) 1912 (let* ((beg-type (1+ (match-beginning 0)))
1905 (end-type (match-end 0))) 1913 (end-type (match-end 0))
1906 (setq entry-list (assoc-string (buffer-substring-no-properties 1914 (entry-list (assoc-string (buffer-substring-no-properties
1907 beg-type end-type) 1915 beg-type end-type)
1908 bibtex-entry-field-alist 1916 bibtex-entry-field-alist t)))
1909 t))
1910 1917
1911 ;; unify case of entry name 1918 ;; unify case of entry name
1912 (when (memq 'unify-case format) 1919 (when (memq 'unify-case format)
@@ -1918,35 +1925,24 @@ Formats current entry according to variable `bibtex-entry-format'."
1918 (goto-char end-type) 1925 (goto-char end-type)
1919 (skip-chars-forward " \t\n") 1926 (skip-chars-forward " \t\n")
1920 (delete-char 1) 1927 (delete-char 1)
1921 (insert (bibtex-entry-left-delimiter)))) 1928 (insert (bibtex-entry-left-delimiter)))
1922 1929
1923 ;; determine if entry has crossref field and if at least 1930 ;; Do we have a crossref key?
1924 ;; one alternative is non-empty 1931 (goto-char (point-min))
1925 (goto-char (point-min)) 1932 (if (setq bounds (bibtex-search-forward-field "crossref"))
1926 (let* ((fields-alist (bibtex-parse-entry t)) 1933 (let ((text (bibtex-text-in-field-bounds bounds t)))
1927 (field (assoc-string "crossref" fields-alist t))) 1934 (unless (equal "" text)
1928 (setq crossref-key (and field 1935 (setq crossref-key text))))
1929 (not (equal "" (cdr field))) 1936
1930 (cdr field)) 1937 ;; list of required fields appropriate for an entry with
1931 req-field-list (if crossref-key 1938 ;; or without crossref key.
1932 (nth 0 (nth 2 entry-list)) ; crossref part 1939 (setq req-field-list (if (and crossref-key (nth 2 entry-list))
1933 (nth 0 (nth 1 entry-list)))) ; required part 1940 (car (nth 2 entry-list))
1934 1941 (car (nth 1 entry-list)))
1935 (dolist (rfield req-field-list) 1942 ;; default list of fields that may appear in this entry
1936 (when (nth 3 rfield) ; we should have an alternative 1943 default-field-list (append (nth 0 (nth 1 entry-list))
1937 (setq alternatives-there t 1944 (nth 1 (nth 1 entry-list))
1938 field (assoc-string (car rfield) fields-alist t)) 1945 bibtex-user-optional-fields)))
1939 (if (and field
1940 (not (equal "" (cdr field))))
1941 (cond ((not non-empty-alternative)
1942 (setq non-empty-alternative t))
1943 ((memq 'required-fields format)
1944 (error "More than one non-empty alternative")))))))
1945
1946 (if (and alternatives-there
1947 (not non-empty-alternative)
1948 (memq 'required-fields format))
1949 (error "All alternatives are empty"))
1950 1946
1951 ;; process all fields 1947 ;; process all fields
1952 (bibtex-beginning-first-field (point-min)) 1948 (bibtex-beginning-first-field (point-min))
@@ -1965,25 +1961,18 @@ Formats current entry according to variable `bibtex-entry-format'."
1965 (empty-field (equal "" (bibtex-text-in-field-bounds bounds t))) 1961 (empty-field (equal "" (bibtex-text-in-field-bounds bounds t)))
1966 deleted) 1962 deleted)
1967 1963
1968 ;; We have more elegant high-level functions for several
1969 ;; tasks done by `bibtex-format-entry'. However, they contain
1970 ;; quite some redundancy compared with what we need to do
1971 ;; anyway. So for speed-up we avoid using them.
1972
1973 (if (memq 'opts-or-alts format) 1964 (if (memq 'opts-or-alts format)
1965 ;; delete empty optional and alternative fields
1966 ;; (but keep empty required fields)
1974 (cond ((and empty-field 1967 (cond ((and empty-field
1975 (or opt-alt 1968 (or opt-alt
1976 (let ((field (assoc-string 1969 (let ((field (assoc-string
1977 field-name req-field-list t))) 1970 field-name req-field-list t)))
1978 (or (not field) ; OPT field 1971 (or (not field) ; OPT field
1979 (nth 3 field))))) ; ALT field 1972 (nth 3 field))))) ; ALT field
1980 ;; Either it is an empty ALT field. Then we have checked
1981 ;; already that we have one non-empty alternative. Or it
1982 ;; is an empty OPT field that we do not miss anyway.
1983 ;; So we can safely delete this field.
1984 (delete-region beg-field end-field) 1973 (delete-region beg-field end-field)
1985 (setq deleted t)) 1974 (setq deleted t))
1986 ;; otherwise: not empty, delete "OPT" or "ALT" 1975 ;; otherwise nonempty field: delete "OPT" or "ALT"
1987 (opt-alt 1976 (opt-alt
1988 (goto-char beg-name) 1977 (goto-char beg-name)
1989 (delete-char 3)))) 1978 (delete-char 3))))
@@ -2087,16 +2076,7 @@ Formats current entry according to variable `bibtex-entry-format'."
2087 (goto-char (1+ beg-text)) 2076 (goto-char (1+ beg-text))
2088 (insert title)))) 2077 (insert title))))
2089 2078
2090 ;; Use booktitle to set a missing title. 2079 ;; if empty field is a required field, complain
2091 (if (and empty-field
2092 (bibtex-string= field-name "title"))
2093 (let ((booktitle (bibtex-text-in-field "booktitle")))
2094 (when booktitle
2095 (setq empty-field nil)
2096 (goto-char (1+ beg-text))
2097 (insert booktitle))))
2098
2099 ;; if empty field, complain
2100 (if (and empty-field 2080 (if (and empty-field
2101 (memq 'required-fields format) 2081 (memq 'required-fields format)
2102 (assoc-string field-name req-field-list t)) 2082 (assoc-string field-name req-field-list t))
@@ -2104,12 +2084,8 @@ Formats current entry according to variable `bibtex-entry-format'."
2104 2084
2105 ;; unify case of field name 2085 ;; unify case of field name
2106 (if (memq 'unify-case format) 2086 (if (memq 'unify-case format)
2107 (let ((fname (car (assoc-string 2087 (let ((fname (car (assoc-string field-name
2108 field-name 2088 default-field-list t))))
2109 (append (nth 0 (nth 1 entry-list))
2110 (nth 1 (nth 1 entry-list))
2111 bibtex-user-optional-fields)
2112 t))))
2113 (if fname 2089 (if fname
2114 (progn 2090 (progn
2115 (delete-region beg-name end-name) 2091 (delete-region beg-name end-name)
@@ -2123,23 +2099,21 @@ Formats current entry according to variable `bibtex-entry-format'."
2123 2099
2124 ;; check whether all required fields are present 2100 ;; check whether all required fields are present
2125 (if (memq 'required-fields format) 2101 (if (memq 'required-fields format)
2126 (let ((found 0) altlist) 2102 (let ((found 0) alt-list)
2127 (dolist (fname req-field-list) 2103 (dolist (fname req-field-list)
2128 (if (nth 3 fname) 2104 (cond ((nth 3 fname) ; t if field has alternative flag
2129 (push (car fname) altlist)) 2105 (push (car fname) alt-list)
2130 (unless (or (member (car fname) field-list) 2106 (if (member-ignore-case (car fname) field-list)
2131 (nth 3 fname)) 2107 (setq found (1+ found))))
2132 (error "Mandatory field `%s' is missing" (car fname)))) 2108 ((not (member-ignore-case (car fname) field-list))
2133 (when altlist 2109 (error "Mandatory field `%s' is missing" (car fname)))))
2134 (dolist (fname altlist) 2110 (if alt-list
2135 (if (member fname field-list) 2111 (cond ((= found 0)
2136 (setq found (1+ found)))) 2112 (error "Alternative mandatory field `%s' is missing"
2137 (cond ((= found 0) 2113 alt-list))
2138 (error "Alternative mandatory field `%s' is missing" 2114 ((> found 1)
2139 altlist)) 2115 (error "Alternative fields `%s' are defined %s times"
2140 ((> found 1) 2116 alt-list found))))))
2141 (error "Alternative fields `%s' are defined %s times"
2142 altlist found))))))
2143 2117
2144 ;; update comma after last field 2118 ;; update comma after last field
2145 (if (memq 'last-comma format) 2119 (if (memq 'last-comma format)
@@ -2158,7 +2132,7 @@ Formats current entry according to variable `bibtex-entry-format'."
2158 (delete-char 1) 2132 (delete-char 1)
2159 (insert (bibtex-entry-right-delimiter))) 2133 (insert (bibtex-entry-right-delimiter)))
2160 2134
2161 ;; fill entry 2135 ;; realign and fill entry
2162 (if (memq 'realign format) 2136 (if (memq 'realign format)
2163 (bibtex-fill-entry)))))) 2137 (bibtex-fill-entry))))))
2164 2138
@@ -2426,7 +2400,7 @@ Concatenate the key:
2426 (apply 'append 2400 (apply 'append
2427 (mapcar (lambda (buf) 2401 (mapcar (lambda (buf)
2428 (with-current-buffer buf bibtex-reference-keys)) 2402 (with-current-buffer buf bibtex-reference-keys))
2429 (bibtex-files-expand t))) 2403 (bibtex-initialize t)))
2430 bibtex-reference-keys)) 2404 bibtex-reference-keys))
2431 2405
2432(defun bibtex-read-key (prompt &optional key global) 2406(defun bibtex-read-key (prompt &optional key global)
@@ -2606,14 +2580,22 @@ Parsing initializes `bibtex-reference-keys' and `bibtex-strings'."
2606 (setq bibtex-buffer-last-parsed-tick (buffer-modified-tick))))) 2580 (setq bibtex-buffer-last-parsed-tick (buffer-modified-tick)))))
2607 (setq buffers (cdr buffers)))))) 2581 (setq buffers (cdr buffers))))))
2608 2582
2609(defun bibtex-files-expand (&optional current force) 2583;;;###autoload
2610 "Return an expanded list of BibTeX buffers based on `bibtex-files'. 2584(defun bibtex-initialize (&optional current force select)
2585 "(Re)Initialize BibTeX buffers.
2586Visit the BibTeX files defined by `bibtex-files' and return a list
2587of corresponding buffers.
2611Initialize in these buffers `bibtex-reference-keys' if not yet set. 2588Initialize in these buffers `bibtex-reference-keys' if not yet set.
2612List of BibTeX buffers includes current buffer if CURRENT is non-nil. 2589List of BibTeX buffers includes current buffer if CURRENT is non-nil.
2613If FORCE is non-nil, (re)initialize `bibtex-reference-keys' even if 2590If FORCE is non-nil, (re)initialize `bibtex-reference-keys' even if
2614already set." 2591already set. If SELECT is non-nil interactively select a BibTeX buffer.
2592When called interactively, FORCE is t, CURRENT is t if current buffer uses
2593`bibtex-mode', and SELECT is t if current buffer does not use `bibtex-mode',"
2594 (interactive (list (eq major-mode 'bibtex-mode) t
2595 (not (eq major-mode 'bibtex-mode))))
2615 (let ((file-path (split-string (or bibtex-file-path default-directory) ":+")) 2596 (let ((file-path (split-string (or bibtex-file-path default-directory) ":+"))
2616 file-list dir-list buffer-list) 2597 file-list dir-list buffer-list)
2598 ;; generate list of BibTeX files
2617 (dolist (file bibtex-files) 2599 (dolist (file bibtex-files)
2618 (cond ((eq file 'bibtex-file-path) 2600 (cond ((eq file 'bibtex-file-path)
2619 (setq dir-list (append dir-list file-path))) 2601 (setq dir-list (append dir-list file-path)))
@@ -2624,34 +2606,46 @@ already set."
2624 (file-name-absolute-p file)) 2606 (file-name-absolute-p file))
2625 (push file file-list)) 2607 (push file file-list))
2626 (t 2608 (t
2627 (let (fullfilename found) 2609 (let (expanded-file-name found)
2628 (dolist (dir file-path) 2610 (dolist (dir file-path)
2629 (when (file-readable-p 2611 (when (file-readable-p
2630 (setq fullfilename (expand-file-name file dir))) 2612 (setq expanded-file-name (expand-file-name file dir)))
2631 (push fullfilename file-list) 2613 (push expanded-file-name file-list)
2632 (setq found t))) 2614 (setq found t)))
2633 (unless found 2615 (unless found
2634 (error "File %s not in paths defined via bibtex-file-path" 2616 (error "File `%s' not in paths defined via bibtex-file-path"
2635 file)))))) 2617 file))))))
2636 (dolist (file file-list) 2618 (dolist (file file-list)
2637 (unless (file-readable-p file) 2619 (unless (file-readable-p file)
2638 (error "BibTeX file %s not found" file))) 2620 (error "BibTeX file `%s' not found" file)))
2639 ;; expand dir-list 2621 ;; expand dir-list
2640 (dolist (dir dir-list) 2622 (dolist (dir dir-list)
2641 (setq file-list 2623 (setq file-list
2642 (append file-list (directory-files dir t "\\.bib\\'" t)))) 2624 (append file-list (directory-files dir t "\\.bib\\'" t))))
2643 (delete-dups file-list) 2625 (delete-dups file-list)
2626 ;; visit files in FILE-LIST
2644 (dolist (file file-list) 2627 (dolist (file file-list)
2645 (when (file-readable-p file) 2628 (if (file-readable-p file)
2646 (push (find-file-noselect file) buffer-list) 2629 (push (find-file-noselect file) buffer-list)))
2647 (with-current-buffer (car buffer-list) 2630 ;; include current buffer iff we want it
2648 (if (or force (not (listp bibtex-reference-keys)))
2649 (bibtex-parse-keys)))))
2650 (cond ((and current (not (memq (current-buffer) buffer-list))) 2631 (cond ((and current (not (memq (current-buffer) buffer-list)))
2651 (push (current-buffer) buffer-list) 2632 (push (current-buffer) buffer-list))
2652 (if force (bibtex-parse-keys)))
2653 ((and (not current) (memq (current-buffer) buffer-list)) 2633 ((and (not current) (memq (current-buffer) buffer-list))
2654 (setq buffer-list (delq (current-buffer) buffer-list)))) 2634 (setq buffer-list (delq (current-buffer) buffer-list))))
2635 ;; parse keys
2636 (dolist (buffer buffer-list)
2637 (with-current-buffer buffer
2638 (if (or force (nlistp bibtex-reference-keys))
2639 (bibtex-parse-keys))))
2640 ;; select BibTeX buffer
2641 (if select
2642 (if buffer-list
2643 (switch-to-buffer
2644 (completing-read "Switch to BibTeX buffer: "
2645 (mapcar 'buffer-name buffer-list)
2646 nil t
2647 (if current (buffer-name (current-buffer)))))
2648 (message "No BibTeX buffers defined")))
2655 buffer-list)) 2649 buffer-list))
2656 2650
2657(defun bibtex-complete-internal (completions) 2651(defun bibtex-complete-internal (completions)
@@ -3130,7 +3124,6 @@ field contents of the neighboring entry. Finally try to update the text
3130based on the difference between the keys of the neighboring and the current 3124based on the difference between the keys of the neighboring and the current
3131entry (for example, the year parts of the keys)." 3125entry (for example, the year parts of the keys)."
3132 (interactive) 3126 (interactive)
3133 (undo-boundary) ;So you can easily undo it, if it didn't work right.
3134 (bibtex-beginning-of-entry) 3127 (bibtex-beginning-of-entry)
3135 (when (looking-at bibtex-entry-head) 3128 (when (looking-at bibtex-entry-head)
3136 (let ((type (bibtex-type-in-head)) 3129 (let ((type (bibtex-type-in-head))
@@ -3413,13 +3406,18 @@ If its value is nil use plain sorting."
3413 (cond ((not index1) (not index2)) ; indices can be nil 3406 (cond ((not index1) (not index2)) ; indices can be nil
3414 ((not index2) nil) 3407 ((not index2) nil)
3415 ((eq bibtex-maintain-sorted-entries 'crossref) 3408 ((eq bibtex-maintain-sorted-entries 'crossref)
3416 (if (nth 1 index1) 3409 ;; CROSSREF-KEY may be nil or it can point to an entry
3417 (if (nth 1 index2) 3410 ;; in another BibTeX file. In both cases we ignore CROSSREF-KEY.
3411 (if (and (nth 1 index1)
3412 (cdr (assoc-string (nth 1 index1) bibtex-reference-keys)))
3413 (if (and (nth 1 index2)
3414 (cdr (assoc-string (nth 1 index2) bibtex-reference-keys)))
3418 (or (string-lessp (nth 1 index1) (nth 1 index2)) 3415 (or (string-lessp (nth 1 index1) (nth 1 index2))
3419 (and (string-equal (nth 1 index1) (nth 1 index2)) 3416 (and (string-equal (nth 1 index1) (nth 1 index2))
3420 (string-lessp (nth 0 index1) (nth 0 index2)))) 3417 (string-lessp (nth 0 index1) (nth 0 index2))))
3421 (not (string-lessp (nth 0 index2) (nth 1 index1)))) 3418 (not (string-lessp (nth 0 index2) (nth 1 index1))))
3422 (if (nth 1 index2) 3419 (if (and (nth 1 index2)
3420 (cdr (assoc-string (nth 1 index2) bibtex-reference-keys)))
3423 (string-lessp (nth 0 index1) (nth 1 index2)) 3421 (string-lessp (nth 0 index1) (nth 1 index2))
3424 (string-lessp (nth 0 index1) (nth 0 index2))))) 3422 (string-lessp (nth 0 index1) (nth 0 index2)))))
3425 ((eq bibtex-maintain-sorted-entries 'entry-class) 3423 ((eq bibtex-maintain-sorted-entries 'entry-class)
@@ -3444,6 +3442,9 @@ are ignored."
3444 (interactive) 3442 (interactive)
3445 (bibtex-beginning-of-first-entry) ; Needed by `sort-subr' 3443 (bibtex-beginning-of-first-entry) ; Needed by `sort-subr'
3446 (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'. 3444 (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'.
3445 (if (and (eq bibtex-maintain-sorted-entries 'crossref)
3446 (nlistp bibtex-reference-keys))
3447 (bibtex-parse-keys)) ; Needed by `bibtex-lessp'.
3447 (sort-subr nil 3448 (sort-subr nil
3448 'bibtex-skip-to-valid-entry ; NEXTREC function 3449 'bibtex-skip-to-valid-entry ; NEXTREC function
3449 'bibtex-end-of-entry ; ENDREC function 3450 'bibtex-end-of-entry ; ENDREC function
@@ -3539,7 +3540,7 @@ Otherwise, use `set-buffer'. DISPLAY is t when called interactively."
3539 (interactive (list (bibtex-read-key "Find key: " nil current-prefix-arg) 3540 (interactive (list (bibtex-read-key "Find key: " nil current-prefix-arg)
3540 current-prefix-arg nil t)) 3541 current-prefix-arg nil t))
3541 (if (and global bibtex-files) 3542 (if (and global bibtex-files)
3542 (let ((buffer-list (bibtex-files-expand t)) 3543 (let ((buffer-list (bibtex-initialize t))
3543 buffer found) 3544 buffer found)
3544 (while (and (not found) 3545 (while (and (not found)
3545 (setq buffer (pop buffer-list))) 3546 (setq buffer (pop buffer-list)))
@@ -3581,6 +3582,9 @@ search to look for place for KEY. This requires that buffer is sorted,
3581see `bibtex-validate'. 3582see `bibtex-validate'.
3582Return t if preparation was successful or nil if entry KEY already exists." 3583Return t if preparation was successful or nil if entry KEY already exists."
3583 (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'. 3584 (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'.
3585 (if (and (eq bibtex-maintain-sorted-entries 'crossref)
3586 (nlistp bibtex-reference-keys))
3587 (bibtex-parse-keys)) ; Needed by `bibtex-lessp'.
3584 (let ((key (nth 0 index)) 3588 (let ((key (nth 0 index))
3585 key-exist) 3589 key-exist)
3586 (cond ((or (null key) 3590 (cond ((or (null key)
@@ -3671,6 +3675,9 @@ Return t if test was successful, nil otherwise."
3671 (setq syntax-error t) 3675 (setq syntax-error t)
3672 3676
3673 ;; Check for duplicate keys and correct sort order 3677 ;; Check for duplicate keys and correct sort order
3678 (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'.
3679 (bibtex-parse-keys) ; Possibly needed by `bibtex-lessp'.
3680 ; Always needed by subsequent global key check.
3674 (let (previous current key-list) 3681 (let (previous current key-list)
3675 (bibtex-progress-message "Checking for duplicate keys") 3682 (bibtex-progress-message "Checking for duplicate keys")
3676 (bibtex-map-entries 3683 (bibtex-map-entries
@@ -3692,9 +3699,12 @@ Return t if test was successful, nil otherwise."
3692 (bibtex-progress-message 'done)) 3699 (bibtex-progress-message 'done))
3693 3700
3694 ;; Check for duplicate keys in `bibtex-files'. 3701 ;; Check for duplicate keys in `bibtex-files'.
3695 (bibtex-parse-keys) 3702 ;; `bibtex-validate' only compares keys in current buffer with keys
3703 ;; in `bibtex-files'. `bibtex-validate-globally' compares keys for
3704 ;; each file in `bibtex-files' with keys of all other files in
3705 ;; `bibtex-files'.
3696 ;; We don't want to be fooled by outdated `bibtex-reference-keys'. 3706 ;; We don't want to be fooled by outdated `bibtex-reference-keys'.
3697 (dolist (buffer (bibtex-files-expand nil t)) 3707 (dolist (buffer (bibtex-initialize nil t))
3698 (dolist (key (with-current-buffer buffer bibtex-reference-keys)) 3708 (dolist (key (with-current-buffer buffer bibtex-reference-keys))
3699 (when (and (cdr key) 3709 (when (and (cdr key)
3700 (cdr (assoc-string (car key) bibtex-reference-keys))) 3710 (cdr (assoc-string (car key) bibtex-reference-keys)))
@@ -3792,7 +3802,7 @@ Return t if test was successful, nil otherwise."
3792With optional prefix arg STRINGS, check for duplicate strings, too. 3802With optional prefix arg STRINGS, check for duplicate strings, too.
3793Return t if test was successful, nil otherwise." 3803Return t if test was successful, nil otherwise."
3794 (interactive "P") 3804 (interactive "P")
3795 (let ((buffer-list (bibtex-files-expand t)) 3805 (let ((buffer-list (bibtex-initialize t))
3796 buffer-key-list current-buf current-keys error-list) 3806 buffer-key-list current-buf current-keys error-list)
3797 ;; Check for duplicate keys within BibTeX buffer 3807 ;; Check for duplicate keys within BibTeX buffer
3798 (dolist (buffer buffer-list) 3808 (dolist (buffer buffer-list)
@@ -4133,14 +4143,15 @@ At end of the cleaning process, the functions in
4133 (error "Not inside a BibTeX entry"))) 4143 (error "Not inside a BibTeX entry")))
4134 (entry-type (bibtex-type-in-head)) 4144 (entry-type (bibtex-type-in-head))
4135 (key (bibtex-key-in-head))) 4145 (key (bibtex-key-in-head)))
4136 ;; formatting 4146 ;; formatting (undone if error occurs)
4137 (cond ((bibtex-string= entry-type "preamble") 4147 (atomic-change-group
4138 ;; (bibtex-format-preamble) 4148 (cond ((bibtex-string= entry-type "preamble")
4139 (error "No clean up of @Preamble entries")) 4149 ;; (bibtex-format-preamble)
4140 ((bibtex-string= entry-type "string") 4150 (error "No clean up of @Preamble entries"))
4141 (setq entry-type 'string)) 4151 ((bibtex-string= entry-type "string")
4142 ;; (bibtex-format-string) 4152 (setq entry-type 'string))
4143 (t (bibtex-format-entry))) 4153 ;; (bibtex-format-string)
4154 (t (bibtex-format-entry))))
4144 ;; set key 4155 ;; set key
4145 (when (or new-key (not key)) 4156 (when (or new-key (not key))
4146 (setq key (bibtex-generate-autokey)) 4157 (setq key (bibtex-generate-autokey))
@@ -4184,7 +4195,7 @@ At end of the cleaning process, the functions in
4184 (bibtex-find-entry key nil end)))) 4195 (bibtex-find-entry key nil end))))
4185 (if error 4196 (if error
4186 (error "New inserted entry yields duplicate key")) 4197 (error "New inserted entry yields duplicate key"))
4187 (dolist (buffer (bibtex-files-expand)) 4198 (dolist (buffer (bibtex-initialize))
4188 (with-current-buffer buffer 4199 (with-current-buffer buffer
4189 (if (cdr (assoc-string key bibtex-reference-keys)) 4200 (if (cdr (assoc-string key bibtex-reference-keys))
4190 (error "Duplicate key in %s" (buffer-file-name))))) 4201 (error "Duplicate key in %s" (buffer-file-name)))))
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 900a2c36893..796a6a6d7e1 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1597,7 +1597,7 @@ quit spell session exited."
1597 (or quietly 1597 (or quietly
1598 (message "%s is correct" 1598 (message "%s is correct"
1599 (funcall ispell-format-word-function word))) 1599 (funcall ispell-format-word-function word)))
1600 (and (fboundp 'extent-at) 1600 (and (featurep 'xemacs)
1601 (extent-at start) 1601 (extent-at start)
1602 (and (fboundp 'delete-extent) 1602 (and (fboundp 'delete-extent)
1603 (delete-extent (extent-at start))))) 1603 (delete-extent (extent-at start)))))
@@ -1606,7 +1606,7 @@ quit spell session exited."
1606 (message "%s is correct because of root %s" 1606 (message "%s is correct because of root %s"
1607 (funcall ispell-format-word-function word) 1607 (funcall ispell-format-word-function word)
1608 (funcall ispell-format-word-function poss))) 1608 (funcall ispell-format-word-function poss)))
1609 (and (fboundp 'extent-at) 1609 (and (featurep 'xemacs)
1610 (extent-at start) 1610 (extent-at start)
1611 (and (fboundp 'delete-extent) 1611 (and (fboundp 'delete-extent)
1612 (delete-extent (extent-at start))))) 1612 (delete-extent (extent-at start)))))
diff --git a/lisp/textmodes/org-export-latex.el b/lisp/textmodes/org-export-latex.el
index eef1c10e5b6..7624af8aa0e 100644
--- a/lisp/textmodes/org-export-latex.el
+++ b/lisp/textmodes/org-export-latex.el
@@ -1,10 +1,10 @@
1 ;;; org-export-latex.el --- LaTeX exporter for org-mode 1;;; org-export-latex.el --- LaTeX exporter for org-mode
2;; 2;;
3;; Copyright (C) 2007 Free Software Foundation, Inc. 3;; Copyright (c) 2007, 2008 Free Software Foundation, Inc.
4;; 4;;
5;; Emacs Lisp Archive Entry 5;; Emacs Lisp Archive Entry
6;; Filename: org-export-latex.el 6;; Filename: org-export-latex.el
7;; Version: 5.12 7;; Version: 5.19
8;; Author: Bastien Guerry <bzg AT altern DOT org> 8;; Author: Bastien Guerry <bzg AT altern DOT org>
9;; Maintainer: Bastien Guerry <bzg AT altern DOT org> 9;; Maintainer: Bastien Guerry <bzg AT altern DOT org>
10;; Keywords: org, wp, tex 10;; Keywords: org, wp, tex
@@ -18,31 +18,31 @@
18;; Free Software Foundation; either version 3, or (at your option) any 18;; Free Software Foundation; either version 3, or (at your option) any
19;; later version. 19;; later version.
20;; 20;;
21;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT 21;; GNU Emacs is distributed in the hope that it will be useful, but
22;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 22;; WITHOUT ANY WARRANTY; without even the implied warranty of
23;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 23;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
24;; more details. 24;; General Public License for more details.
25;; 25;;
26;; You should have received a copy of the GNU General Public License along 26;; You should have received a copy of the GNU General Public License
27;; with GNU Emacs; see the file COPYING. If not, write to the Free Software 27;; along with GNU Emacs; see the file COPYING. If not, write to the Free
28;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 28;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
29;; 02110-1301, USA. 29;; MA 02110-1301, USA.
30;; 30;;
31;;; Commentary: 31;;; Commentary:
32;; 32;;
33;; This library implements a LaTeX exporter for org-mode. 33;; This library implements a LaTeX exporter for org-mode.
34;; 34;;
35;; Put this file into your load-path and the following into your ~/.emacs: 35;; Put this file into your load-path and the following into your ~/.emacs:
36;; (require 'org-export-latex) 36;; (require 'org-export-latex)
37;; 37;;
38;; The interactive functions are similar to those of the HTML exporter: 38;; The interactive functions are similar to those of the HTML exporter:
39;; 39;;
40;; M-x `org-export-as-latex' 40;; M-x `org-export-as-latex'
41;; M-x `org-export-as-latex-batch' 41;; M-x `org-export-as-latex-batch'
42;; M-x `org-export-as-latex-to-buffer' 42;; M-x `org-export-as-latex-to-buffer'
43;; M-x `org-export-region-as-latex' 43;; M-x `org-export-region-as-latex'
44;; M-x `org-replace-region-by-latex' 44;; M-x `org-replace-region-by-latex'
45;; 45;;
46;;; Code: 46;;; Code:
47 47
48(eval-when-compile 48(eval-when-compile
@@ -52,15 +52,19 @@
52(require 'org) 52(require 'org)
53 53
54;;; Variables: 54;;; Variables:
55(defvar org-latex-options-plist nil) 55(defvar org-export-latex-class nil)
56(defvar org-latex-todo-keywords-1 nil) 56(defvar org-export-latex-header nil)
57(defvar org-latex-all-targets-regexp nil) 57(defvar org-export-latex-append-header nil)
58(defvar org-latex-add-level 0) 58(defvar org-export-latex-options-plist nil)
59(defvar org-latex-sectioning-depth 0) 59(defvar org-export-latex-todo-keywords-1 nil)
60(defvar org-export-latex-all-targets-re nil)
61(defvar org-export-latex-add-level 0)
62(defvar org-export-latex-sectioning "")
63(defvar org-export-latex-sectioning-depth 0)
60(defvar org-export-latex-list-beginning-re 64(defvar org-export-latex-list-beginning-re
61 "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) +?") 65 "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) +?")
62 66
63(defvar org-latex-special-string-regexps 67(defvar org-export-latex-special-string-regexps
64 '(org-ts-regexp 68 '(org-ts-regexp
65 org-scheduled-string 69 org-scheduled-string
66 org-deadline-string 70 org-deadline-string
@@ -71,28 +75,82 @@
71(defvar re-quote) ; dynamically scoped from org.el 75(defvar re-quote) ; dynamically scoped from org.el
72(defvar commentsp) ; dynamically scoped from org.el 76(defvar commentsp) ; dynamically scoped from org.el
73 77
74;;; Custom variables: 78;;; User variables:
75(defcustom org-export-latex-sectioning-alist
76 '((1 "\\section{%s}" "\\section*{%s}")
77 (2 "\\subsection{%s}" "\\subsection*{%s}")
78 (3 "\\subsubsection{%s}" "\\subsubsection*{%s}")
79 (4 "\\paragraph{%s}" "\\paragraph*{%s}")
80 (5 "\\subparagraph{%s}" "\\subparagraph*{%s}"))
81 "Alist of LaTeX commands for inserting sections.
82Here is the structure of each cell:
83 79
84 \(level unnumbered-section numbered-section\) 80(defcustom org-export-latex-default-class "article"
81 "The default LaTeX class."
82 :group 'org-export-latex
83 :type '(string :tag "LaTeX class"))
85 84
86The %s formatter will be replaced by the title of the section." 85(defcustom org-export-latex-classes
86 '(("article"
87 "\\documentclass[11pt,a4paper]{article}
88\\usepackage[utf8]{inputenc}
89\\usepackage[T1]{fontenc}
90\\usepackage{hyperref}"
91 ("\\section{%s}" . "\\section*{%s}")
92 ("\\subsection{%s}" . "\\subsection*{%s}")
93 ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
94 ("\\paragraph{%s}" . "\\paragraph*{%s}")
95 ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
96 ("report"
97 "\\documentclass[11pt,a4paper]{report}
98\\usepackage[utf8]{inputenc}
99\\usepackage[T1]{fontenc}
100\\usepackage{hyperref}"
101 ("\\part{%s}" . "\\part*{%s}")
102 ("\\chapter{%s}" . "\\chapter*{%s}")
103 ("\\section{%s}" . "\\section*{%s}")
104 ("\\subsection{%s}" . "\\subsection*{%s}")
105 ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))
106 ("book"
107 "\\documentclass[11pt,a4paper]{book}
108\\usepackage[utf8]{inputenc}
109\\usepackage[T1]{fontenc}
110\\usepackage{hyperref}"
111 ("\\part{%s}" . "\\part*{%s}")
112 ("\\chapter{%s}" . "\\chapter*{%s}")
113 ("\\section{%s}" . "\\section*{%s}")
114 ("\\subsection{%s}" . "\\subsection*{%s}")
115 ("\\subsubsection{%s}" . "\\subsubsection*{%s}")))
116 "Alist of LaTeX classes and associated header and structure.
117If #+LaTeX_CLASS is set in the buffer, use its value and the
118associated information. Here is the structure of each cell:
119
120 \(class-name
121 header-string
122 (unnumbered-section numbered-section\)
123 ...\)
124
125A %s formatter is mandatory in each section string and will be
126replaced by the title of the section."
87 :group 'org-export-latex 127 :group 'org-export-latex
88 :type 'alist) 128 :type '(repeat
129 (list (string :tag "LaTeX class")
130 (string :tag "LaTeX header")
131 (cons :tag "Level 1"
132 (string :tag "Numbered")
133 (string :tag "Unnumbered"))
134 (cons :tag "Level 2"
135 (string :tag "Numbered")
136 (string :tag "Unnumbered"))
137 (cons :tag "Level 3"
138 (string :tag "Numbered")
139 (string :tag "Unnumbered"))
140 (cons :tag "Level 4"
141 (string :tag "Numbered")
142 (string :tag "Unnumbered"))
143 (cons :tag "Level 5"
144 (string :tag "Numbered")
145 (string :tag "Unnumbered")))))
89 146
90(defcustom org-export-latex-emphasis-alist 147(defcustom org-export-latex-emphasis-alist
91 '(("*" "\\textbf{%s}" nil) 148 '(("*" "\\textbf{%s}" nil)
92 ("/" "\\emph{%s}" nil) 149 ("/" "\\emph{%s}" nil)
93 ("_" "\\underline{%s}" nil) 150 ("_" "\\underline{%s}" nil)
94 ("+" "\\texttt{%s}" nil) 151 ("+" "\\texttt{%s}" nil)
95 ("=" "\\texttt{%s}" nil)) 152 ("=" "\\texttt{%s}" nil)
153 ("~" "\\texttt{%s}" t))
96 "Alist of LaTeX expressions to convert emphasis fontifiers. 154 "Alist of LaTeX expressions to convert emphasis fontifiers.
97Each element of the list is a list of three elements. 155Each element of the list is a list of three elements.
98The first element is the character used as a marker for fontification. 156The first element is the character used as a marker for fontification.
@@ -102,15 +160,6 @@ conversions."
102 :group 'org-export-latex 160 :group 'org-export-latex
103 :type 'alist) 161 :type 'alist)
104 162
105(defcustom org-export-latex-preamble
106 "\\documentclass[11pt,a4paper]{article}
107\\usepackage[utf8]{inputenc}
108\\usepackage[T1]{fontenc}
109\\usepackage{hyperref}"
110 "Preamble to be inserted at the very beginning of the LaTeX export."
111 :group 'org-export-latex
112 :type 'string)
113
114(defcustom org-export-latex-title-command "\\maketitle" 163(defcustom org-export-latex-title-command "\\maketitle"
115 "The command used to insert the title just after \\begin{document}. 164 "The command used to insert the title just after \\begin{document}.
116If this string contains the formatting specification \"%s\" then 165If this string contains the formatting specification \"%s\" then
@@ -119,7 +168,7 @@ argument."
119 :group 'org-export-latex 168 :group 'org-export-latex
120 :type 'string) 169 :type 'string)
121 170
122(defcustom org-export-latex-date-format 171(defcustom org-export-latex-date-format
123 "%d %B %Y" 172 "%d %B %Y"
124 "Format string for \\date{...}." 173 "Format string for \\date{...}."
125 :group 'org-export-latex 174 :group 'org-export-latex
@@ -130,14 +179,15 @@ argument."
130 :group 'org-export-latex 179 :group 'org-export-latex
131 :type 'boolean) 180 :type 'boolean)
132 181
133(defcustom org-export-latex-packages-alist nil 182(defcustom org-export-latex-tables-column-borders nil
134 "Alist of packages to be inserted in the preamble. 183 "When non-nil, group of columns are surrounded with borders,
135Each cell is of the forma \( option . package \). 184XSeven if these borders are the outside borders of the table."
136 185 :group 'org-export-latex
137For example: 186 :type 'boolean)
138 187
139\(setq org-export-latex-packages-alist 188(defcustom org-export-latex-packages-alist nil
140 '((\"french\" \"babel\"))" 189 "Alist of packages to be inserted in the header.
190Each cell is of the forma \( \"option\" . \"package\" \)."
141 :group 'org-export-latex 191 :group 'org-export-latex
142 :type 'alist) 192 :type 'alist)
143 193
@@ -167,17 +217,42 @@ Don't remove the keys, just change their values."
167(defcustom org-export-latex-image-default-option "width=10em" 217(defcustom org-export-latex-image-default-option "width=10em"
168 "Default option for images." 218 "Default option for images."
169 :group 'org-export-latex 219 :group 'org-export-latex
170 :type '(string)) 220 :type 'string)
171 221
172(defcustom org-export-latex-coding-system nil 222(defcustom org-export-latex-coding-system nil
173 "Coding system for the exported LaTex file." 223 "Coding system for the exported LaTex file."
174 :group 'org-export-latex 224 :group 'org-export-latex
175 :type 'coding-system) 225 :type 'coding-system)
176 226
177;; FIXME Do we want this one? 227(defcustom org-list-radio-list-templates
178;; (defun org-export-as-latex-and-open (arg) ...) 228 '((latex-mode "% BEGIN RECEIVE ORGLST %n
229% END RECEIVE ORGLST %n
230\\begin{comment}
231#+ORGLST: SEND %n org-list-to-latex
232| | |
233\\end{comment}\n")
234 (texinfo-mode "@c BEGIN RECEIVE ORGLST %n
235@c END RECEIVE ORGLST %n
236@ignore
237#+ORGLST: SEND %n org-list-to-texinfo
238| | |
239@end ignore\n")
240 (html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
241<!-- END RECEIVE ORGLST %n -->
242<!--
243#+ORGLST: SEND %n org-list-to-html
244| | |
245-->\n"))
246 "Templates for radio lists in different major modes.
247All occurrences of %n in a template will be replaced with the name of the
248list, obtained by prompting the user."
249 :group 'org-plain-lists
250 :type '(repeat
251 (list (symbol :tag "Major mode")
252 (string :tag "Format"))))
179 253
180;;; Autoload functions: 254;;; Autoload functions:
255
181;;;###autoload 256;;;###autoload
182(defun org-export-as-latex-batch () 257(defun org-export-as-latex-batch ()
183 "Call `org-export-as-latex', may be used in batch processing as 258 "Call `org-export-as-latex', may be used in batch processing as
@@ -199,7 +274,7 @@ No file is created. The prefix ARG is passed through to `org-export-as-latex'."
199(defun org-replace-region-by-latex (beg end) 274(defun org-replace-region-by-latex (beg end)
200 "Replace the region from BEG to END with its LaTeX export. 275 "Replace the region from BEG to END with its LaTeX export.
201It assumes the region has `org-mode' syntax, and then convert it to 276It assumes the region has `org-mode' syntax, and then convert it to
202LaTeX. This can be used in any buffer. For example, you could 277LaTeX. This can be used in any buffer. For example, you could
203write an itemized list in `org-mode' syntax in an LaTeX buffer and 278write an itemized list in `org-mode' syntax in an LaTeX buffer and
204then use this command to convert it." 279then use this command to convert it."
205 (interactive "r") 280 (interactive "r")
@@ -255,7 +330,21 @@ in a window. A non-interactive call will only retunr the buffer."
255;;;###autoload 330;;;###autoload
256(defun org-export-as-latex (arg &optional hidden ext-plist 331(defun org-export-as-latex (arg &optional hidden ext-plist
257 to-buffer body-only) 332 to-buffer body-only)
258 "Export current buffer to a LaTeX file." 333 "Export current buffer to a LaTeX file.
334If there is an active region, export only the region. The prefix
335ARG specifies how many levels of the outline should become
336headlines. The default is 3. Lower levels will be exported
337depending on `org-export-latex-low-levels'. The default is to
338convert them as description lists. When HIDDEN is non-nil, don't
339display the LaTeX buffer. EXT-PLIST is a property list with
340external parameters overriding org-mode's default settings, but
341still inferior to file-local settings. When TO-BUFFER is
342non-nil, create a buffer with that name and export to that
343buffer. If TO-BUFFER is the symbol `string', don't leave any
344buffer behind but just return the resulting LaTeX as a string.
345When BODY-ONLY is set, don't produce the file header and footer,
346simply return the content of \begin{document}...\end{document},
347without even the \begin{document} and \end{document} commands."
259 (interactive "P") 348 (interactive "P")
260 ;; Make sure we have a file name when we need it. 349 ;; Make sure we have a file name when we need it.
261 (when (and (not (or to-buffer body-only)) 350 (when (and (not (or to-buffer body-only))
@@ -268,9 +357,23 @@ in a window. A non-interactive call will only retunr the buffer."
268 357
269 (message "Exporting to LaTeX...") 358 (message "Exporting to LaTeX...")
270 (org-update-radio-target-regexp) 359 (org-update-radio-target-regexp)
271 (org-export-latex-set-initial-vars ext-plist) 360 (org-export-latex-set-initial-vars ext-plist arg)
272 (let* ((wcf (current-window-configuration)) 361 (let* ((wcf (current-window-configuration))
273 (opt-plist org-latex-options-plist) 362 (opt-plist org-export-latex-options-plist)
363 (region-p (org-region-active-p))
364 (subtree-p
365 (when region-p
366 (save-excursion
367 (goto-char (region-beginning))
368 (and (org-at-heading-p)
369 (>= (org-end-of-subtree t t) (region-end))))))
370 (title (or (and subtree-p (org-export-get-title-from-subtree))
371 (plist-get opt-plist :title)
372 (and (not
373 (plist-get opt-plist :skip-before-1st-heading))
374 (org-export-grab-title-from-buffer))
375 (file-name-sans-extension
376 (file-name-nondirectory buffer-file-name))))
274 (filename (concat (file-name-as-directory 377 (filename (concat (file-name-as-directory
275 (org-export-directory :LaTeX ext-plist)) 378 (org-export-directory :LaTeX ext-plist))
276 (file-name-sans-extension 379 (file-name-sans-extension
@@ -286,10 +389,11 @@ in a window. A non-interactive call will only retunr the buffer."
286 "*Org LaTeX Export*")) 389 "*Org LaTeX Export*"))
287 (t (get-buffer-create to-buffer))) 390 (t (get-buffer-create to-buffer)))
288 (find-file-noselect filename))) 391 (find-file-noselect filename)))
289 (region-p (org-region-active-p))
290 (odd org-odd-levels-only) 392 (odd org-odd-levels-only)
291 (preamble (org-export-latex-make-preamble opt-plist)) 393 (header (org-export-latex-make-header title opt-plist))
292 (skip (plist-get opt-plist :skip-before-1st-heading)) 394 (skip (if subtree-p nil
395 ;; never skip first lines when exporting a subtree
396 (plist-get opt-plist :skip-before-1st-heading)))
293 (text (plist-get opt-plist :text)) 397 (text (plist-get opt-plist :text))
294 (first-lines (if skip "" (org-export-latex-first-lines))) 398 (first-lines (if skip "" (org-export-latex-first-lines)))
295 (coding-system (and (boundp 'buffer-file-coding-system) 399 (coding-system (and (boundp 'buffer-file-coding-system)
@@ -310,19 +414,21 @@ in a window. A non-interactive call will only retunr the buffer."
310 :skip-before-1st-heading skip 414 :skip-before-1st-heading skip
311 :LaTeX-fragments nil))) 415 :LaTeX-fragments nil)))
312 416
313 (set-buffer buffer) 417 (set-buffer buffer)
314 (erase-buffer) 418 (erase-buffer)
315 419
316 (and (fboundp 'set-buffer-file-coding-system) 420 (and (fboundp 'set-buffer-file-coding-system)
317 (set-buffer-file-coding-system coding-system-for-write)) 421 (set-buffer-file-coding-system coding-system-for-write))
318 422
319 ;; insert the preamble and initial document commands 423 ;; insert the header and initial document commands
320 (unless (or (eq to-buffer 'string) body-only) 424 (unless (or (eq to-buffer 'string) body-only)
321 (insert preamble)) 425 (insert header))
322 426
323 ;; insert text found in #+TEXT 427 ;; insert text found in #+TEXT
324 (when (and text (not (eq to-buffer 'string))) 428 (when (and text (not (eq to-buffer 'string)))
325 (insert (org-export-latex-content text) "\n\n")) 429 (insert (org-export-latex-content
430 text '(lists tables fixed-width keywords))
431 "\n\n"))
326 432
327 ;; insert lines before the first headline 433 ;; insert lines before the first headline
328 (unless (or skip (eq to-buffer 'string)) 434 (unless (or skip (eq to-buffer 'string))
@@ -342,7 +448,7 @@ in a window. A non-interactive call will only retunr the buffer."
342 (when (re-search-forward "^\\(\\*+\\) " nil t) 448 (when (re-search-forward "^\\(\\*+\\) " nil t)
343 (let* ((asters (length (match-string 1))) 449 (let* ((asters (length (match-string 1)))
344 (level (if odd (- asters 2) (- asters 1)))) 450 (level (if odd (- asters 2) (- asters 1))))
345 (setq org-latex-add-level 451 (setq org-export-latex-add-level
346 (if odd (1- (/ (1+ asters) 2)) (1- asters))) 452 (if odd (1- (/ (1+ asters) 2)) (1- asters)))
347 (org-export-latex-parse-global level odd))))) 453 (org-export-latex-parse-global level odd)))))
348 454
@@ -358,16 +464,16 @@ in a window. A non-interactive call will only retunr the buffer."
358 (current-buffer)) 464 (current-buffer))
359 (set-window-configuration wcf)))) 465 (set-window-configuration wcf))))
360 466
361
362;;; Parsing functions: 467;;; Parsing functions:
468
363(defun org-export-latex-parse-global (level odd) 469(defun org-export-latex-parse-global (level odd)
364 "Parse the current buffer recursively, starting at LEVEL. 470 "Parse the current buffer recursively, starting at LEVEL.
365If ODD is non-nil, assume the buffer only contains odd sections. 471If ODD is non-nil, assume the buffer only contains odd sections.
366Return A list reflecting the document structure." 472Return a list reflecting the document structure."
367 (save-excursion 473 (save-excursion
368 (goto-char (point-min)) 474 (goto-char (point-min))
369 (let* ((cnt 0) output 475 (let* ((cnt 0) output
370 (depth org-latex-sectioning-depth)) 476 (depth org-export-latex-sectioning-depth))
371 (while (re-search-forward 477 (while (re-search-forward
372 (concat "^\\(\\(?:\\*\\)\\{" 478 (concat "^\\(\\(?:\\*\\)\\{"
373 (number-to-string (+ (if odd 2 1) level)) 479 (number-to-string (+ (if odd 2 1) level))
@@ -404,57 +510,11 @@ Return A list reflecting the document structure."
404 `(occur . ,cnt) 510 `(occur . ,cnt)
405 `(heading . ,heading) 511 `(heading . ,heading)
406 `(content . ,(org-export-latex-parse-content)) 512 `(content . ,(org-export-latex-parse-content))
407 `(subcontent . ,(org-export-latex-parse-subcontent 513 `(subcontent . ,(org-export-latex-parse-subcontent
408 level odd))))))) 514 level odd)))))))
409 (widen))) 515 (widen)))
410 (list output)))) 516 (list output))))
411 517
412(defun org-export-latex-parse-list (&optional delete)
413 "Parse the list at point.
414Return a list containing first level items as strings and
415sublevels as list of strings."
416 (let ((start (point))
417 ;; Find the end of the list
418 (end (save-excursion
419 (catch 'exit
420 (while (or (looking-at org-export-latex-list-beginning-re)
421 (looking-at "^[ \t]+\\|^$"))
422 (if (eq (point) (point-max))
423 (throw 'exit (point-max)))
424 (forward-line 1))) (point)))
425 output itemsep)
426 (while (re-search-forward org-export-latex-list-beginning-re end t)
427 (setq itemsep (if (save-match-data
428 (string-match "^[0-9]" (match-string 2)))
429 "[0-9]+\\(?:\\.\\|)\\)" "[-+]"))
430 (let* ((indent1 (match-string 1))
431 (nextitem (save-excursion
432 (save-match-data
433 (or (and (re-search-forward
434 (concat "^" indent1 itemsep " *?") end t)
435 (match-beginning 0)) end))))
436 (item (buffer-substring
437 (point)
438 (or (and (re-search-forward
439 org-export-latex-list-beginning-re end t)
440 (goto-char (match-beginning 0)))
441 (goto-char end))))
442 (nextindent (match-string 1))
443 (item (org-trim item))
444 (item (if (string-match "^\\[.+\\]" item)
445 (replace-match "\\\\texttt{\\&}"
446 t nil item) item)))
447 (push item output)
448 (when (> (length nextindent)
449 (length indent1))
450 (narrow-to-region (point) nextitem)
451 (push (org-export-latex-parse-list) output)
452 (widen))))
453 (when delete (delete-region start end))
454 (setq output (nreverse output))
455 (push (if (string-match "^\\[0" itemsep)
456 'ordered 'unordered) output)))
457
458(defun org-export-latex-parse-content () 518(defun org-export-latex-parse-content ()
459 "Extract the content of a section." 519 "Extract the content of a section."
460 (let ((beg (point)) 520 (let ((beg (point))
@@ -487,7 +547,7 @@ CONTENT is an element of the list produced by
487 "Export the list SUBCONTENT to LaTeX. 547 "Export the list SUBCONTENT to LaTeX.
488SUBCONTENT is an alist containing information about the headline 548SUBCONTENT is an alist containing information about the headline
489and its content." 549and its content."
490 (let ((num (plist-get org-latex-options-plist :section-numbers))) 550 (let ((num (plist-get org-export-latex-options-plist :section-numbers)))
491 (mapc (lambda(x) (org-export-latex-subcontent x num)) subcontent))) 551 (mapc (lambda(x) (org-export-latex-subcontent x num)) subcontent)))
492 552
493(defun org-export-latex-subcontent (subcontent num) 553(defun org-export-latex-subcontent (subcontent num)
@@ -495,20 +555,20 @@ and its content."
495 (let ((heading (org-export-latex-fontify-headline 555 (let ((heading (org-export-latex-fontify-headline
496 (cdr (assoc 'heading subcontent)))) 556 (cdr (assoc 'heading subcontent))))
497 (level (- (cdr (assoc 'level subcontent)) 557 (level (- (cdr (assoc 'level subcontent))
498 org-latex-add-level)) 558 org-export-latex-add-level))
499 (occur (number-to-string (cdr (assoc 'occur subcontent)))) 559 (occur (number-to-string (cdr (assoc 'occur subcontent))))
500 (content (cdr (assoc 'content subcontent))) 560 (content (cdr (assoc 'content subcontent)))
501 (subcontent (cadr (assoc 'subcontent subcontent)))) 561 (subcontent (cadr (assoc 'subcontent subcontent))))
502 (cond 562 (cond
503 ;; Normal conversion 563 ;; Normal conversion
504 ((<= level org-latex-sectioning-depth) 564 ((<= level org-export-latex-sectioning-depth)
505 (let ((sec (assoc level org-export-latex-sectioning-alist))) 565 (let ((sec (nth (1- level) org-export-latex-sectioning)))
506 (insert (format (if num (cadr sec) (caddr sec)) heading) "\n")) 566 (insert (format (if num (car sec) (cdr sec)) heading) "\n"))
507 (insert (org-export-latex-content content)) 567 (insert (org-export-latex-content content))
508 (cond ((stringp subcontent) (insert subcontent)) 568 (cond ((stringp subcontent) (insert subcontent))
509 ((listp subcontent) (org-export-latex-sub subcontent)))) 569 ((listp subcontent) (org-export-latex-sub subcontent))))
510 ;; At a level under the hl option: we can drop this subsection 570 ;; At a level under the hl option: we can drop this subsection
511 ((> level org-latex-sectioning-depth) 571 ((> level org-export-latex-sectioning-depth)
512 (cond ((eq org-export-latex-low-levels 'description) 572 (cond ((eq org-export-latex-low-levels 'description)
513 (insert (format "\\begin{description}\n\n\\item[%s]\n\n" heading)) 573 (insert (format "\\begin{description}\n\n\\item[%s]\n\n" heading))
514 (insert (org-export-latex-content content)) 574 (insert (org-export-latex-content content))
@@ -521,52 +581,47 @@ and its content."
521 (cond ((stringp subcontent) (insert subcontent)) 581 (cond ((stringp subcontent) (insert subcontent))
522 ((listp subcontent) (org-export-latex-sub subcontent))))))))) 582 ((listp subcontent) (org-export-latex-sub subcontent)))))))))
523 583
524
525;;; Exporting internals: 584;;; Exporting internals:
526(defun org-export-latex-protect-string (string) 585(defun org-export-latex-set-initial-vars (ext-plist level)
527 "Prevent further conversion for STRING by adding the
528org-protect property."
529 (add-text-properties
530 0 (length string) '(org-protected t) string) string)
531
532(defun org-export-latex-protect-char-in-string (char-list string)
533 "Add org-protected text-property to char from CHAR-LIST in STRING."
534 (with-temp-buffer
535 (save-match-data
536 (insert string)
537 (goto-char (point-min))
538 (while (re-search-forward (regexp-opt char-list) nil t)
539 (add-text-properties (match-beginning 0)
540 (match-end 0) '(org-protected t)))
541 (buffer-string))))
542
543(defun org-export-latex-set-initial-vars (ext-plist)
544 "Store org local variables required for LaTeX export. 586 "Store org local variables required for LaTeX export.
545EXT-PLIST is an optional additional plist." 587EXT-PLIST is an optional additional plist.
546 (setq org-latex-todo-keywords-1 org-todo-keywords-1 588LEVEL indicates the default depth for export."
547 org-latex-all-targets-regexp 589 (setq org-export-latex-todo-keywords-1 org-todo-keywords-1
590 org-export-latex-all-targets-re
548 (org-make-target-link-regexp (org-all-targets)) 591 (org-make-target-link-regexp (org-all-targets))
549 org-latex-options-plist 592 org-export-latex-options-plist
550 (org-combine-plists (org-default-export-plist) ext-plist 593 (org-combine-plists (org-default-export-plist) ext-plist
551 (org-infile-export-plist)) 594 (org-infile-export-plist))
552 org-latex-sectioning-depth 595 org-export-latex-class
553 (let ((hl-levels (plist-get org-latex-options-plist :headline-levels)) 596 (save-excursion
554 (sec-depth (length org-export-latex-sectioning-alist))) 597 (goto-char (point-min))
555 ;; Fall back on org-export-latex-sectioning-alist length if 598 (if (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\([a-zA-Z]+\\)" nil t)
556 ;; headline-levels goes beyond it 599 (assoc (match-string 1) org-export-latex-classes))
557 (if (> hl-levels sec-depth) sec-depth hl-levels)))) 600 (match-string 1)
558 601 org-export-latex-default-class))
559(defun org-export-latex-make-preamble (opt-plist) 602 org-export-latex-header
560 "Make the LaTeX preamble and return it as a string. 603 (cadr (assoc org-export-latex-class org-export-latex-classes))
561Argument OPT-PLIST is the options plist for current buffer." 604 org-export-latex-sectioning
562 (let ((toc (plist-get opt-plist :table-of-contents))) 605 (cddr (assoc org-export-latex-class org-export-latex-classes))
563 (concat 606 org-export-latex-sectioning-depth
607 (or level
608 (let ((hl-levels
609 (plist-get org-export-latex-options-plist :headline-levels))
610 (sec-depth (length org-export-latex-sectioning)))
611 (if (> hl-levels sec-depth) sec-depth hl-levels)))))
612
613(defun org-export-latex-make-header (title opt-plist)
614 "Make the LaTeX header and return it as a string.
615TITLE is the current title from the buffer or region.
616OPT-PLIST is the options plist for current buffer."
617 (let ((toc (plist-get opt-plist :table-of-contents))
618 (author (plist-get opt-plist :author)))
619 (concat
564 (if (plist-get opt-plist :time-stamp-file) 620 (if (plist-get opt-plist :time-stamp-file)
565 (format-time-string "% Created %Y-%m-%d %a %H:%M\n")) 621 (format-time-string "% Created %Y-%m-%d %a %H:%M\n"))
566 622 ;; insert LaTeX custom header
567 ;; insert LaTeX custom preamble 623 org-export-latex-header
568 org-export-latex-preamble "\n" 624 "\n"
569
570 ;; insert information on LaTeX packages 625 ;; insert information on LaTeX packages
571 (when org-export-latex-packages-alist 626 (when org-export-latex-packages-alist
572 (mapconcat (lambda(p) 627 (mapconcat (lambda(p)
@@ -575,46 +630,34 @@ Argument OPT-PLIST is the options plist for current buffer."
575 (format "\\usepackage[%s]{%s}" 630 (format "\\usepackage[%s]{%s}"
576 (car p) (cadr p)))) 631 (car p) (cadr p))))
577 org-export-latex-packages-alist "\n")) 632 org-export-latex-packages-alist "\n"))
578 633 ;; insert additional commands in the header
634 org-export-latex-append-header
579 ;; insert the title 635 ;; insert the title
580 (format 636 (format
581 "\\title{%s}\n" 637 "\n\n\\title{%s}\n"
582 ;; convert the title 638 ;; convert the title
583 (org-export-latex-content 639 (org-export-latex-content
584 (or (plist-get opt-plist :title) 640 title '(lists tables fixed-width keywords)))
585 (and (not
586 (plist-get opt-plist :skip-before-1st-heading))
587 (org-export-grab-title-from-buffer))
588 (and buffer-file-name
589 (file-name-sans-extension
590 (file-name-nondirectory buffer-file-name)))
591 "UNTITLED")))
592
593 ;; insert author info 641 ;; insert author info
594 (if (plist-get opt-plist :author-info) 642 (if (plist-get opt-plist :author-info)
595 (format "\\author{%s}\n" 643 (format "\\author{%s}\n"
596 (or (plist-get opt-plist :author) user-full-name)) 644 (or author user-full-name))
597 (format "%%\\author{%s}\n" 645 (format "%%\\author{%s}\n"
598 (or (plist-get opt-plist :author) user-full-name))) 646 (or author user-full-name)))
599
600 ;; insert the date 647 ;; insert the date
601 (format "\\date{%s}\n" 648 (format "\\date{%s}\n"
602 (format-time-string 649 (format-time-string
603 (or (plist-get opt-plist :date) 650 (or (plist-get opt-plist :date)
604 org-export-latex-date-format))) 651 org-export-latex-date-format)))
605
606 ;; beginning of the document 652 ;; beginning of the document
607 "\n\\begin{document}\n\n" 653 "\n\\begin{document}\n\n"
608
609 ;; insert the title command 654 ;; insert the title command
610 (if (string-match "%s" org-export-latex-title-command) 655 (if (string-match "%s" org-export-latex-title-command)
611 (format org-export-latex-title-command 656 (format org-export-latex-title-command title)
612 (plist-get opt-plist :title))
613 org-export-latex-title-command) 657 org-export-latex-title-command)
614 "\n\n" 658 "\n\n"
615
616 ;; table of contents 659 ;; table of contents
617 (when (and org-export-with-toc 660 (when (and org-export-with-toc
618 (plist-get opt-plist :section-numbers)) 661 (plist-get opt-plist :section-numbers))
619 (cond ((numberp toc) 662 (cond ((numberp toc)
620 (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\n" 663 (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\n"
@@ -628,8 +671,9 @@ COMMENTS is either nil to replace them with the empty string or a
628formatting string like %%%%s if we want to comment them out." 671formatting string like %%%%s if we want to comment them out."
629 (save-excursion 672 (save-excursion
630 (goto-char (point-min)) 673 (goto-char (point-min))
674 (if (org-at-heading-p) (beginning-of-line 2))
631 (let* ((pt (point)) 675 (let* ((pt (point))
632 (end (if (and (re-search-forward "^\\*" nil t) 676 (end (if (and (re-search-forward "^\\* " nil t)
633 (not (eq pt (match-beginning 0)))) 677 (not (eq pt (match-beginning 0))))
634 (goto-char (match-beginning 0)) 678 (goto-char (match-beginning 0))
635 (goto-char (point-max))))) 679 (goto-char (point-max)))))
@@ -643,10 +687,58 @@ formatting string like %%%%s if we want to comment them out."
643 :skip-before-1st-heading nil 687 :skip-before-1st-heading nil
644 :LaTeX-fragments nil))))) 688 :LaTeX-fragments nil)))))
645 689
690(defun org-export-latex-content (content &optional exclude-list)
691 "Convert CONTENT string to LaTeX.
692Don't perform conversions that are in EXCLUDE-LIST. Recognized
693conversion types are: quotation-marks, emphasis, sub-superscript,
694links, keywords, lists, tables, fixed-width"
695 (with-temp-buffer
696 (insert content)
697 (unless (memq 'quotation-marks exclude-list)
698 (org-export-latex-quotation-marks))
699 (unless (memq 'emphasis exclude-list)
700 (when (plist-get org-export-latex-options-plist :emphasize)
701 (org-export-latex-fontify)))
702 (unless (memq 'sub-superscript exclude-list)
703 (org-export-latex-special-chars
704 (plist-get org-export-latex-options-plist :sub-superscript)))
705 (unless (memq 'links exclude-list)
706 (org-export-latex-links))
707 (unless (memq 'keywords exclude-list)
708 (org-export-latex-keywords
709 (plist-get org-export-latex-options-plist :timestamps)))
710 (unless (memq 'lists exclude-list)
711 (org-export-latex-lists))
712 (unless (memq 'tables exclude-list)
713 (org-export-latex-tables
714 (plist-get org-export-latex-options-plist :tables)))
715 (unless (memq 'fixed-width exclude-list)
716 (org-export-latex-fixed-width
717 (plist-get org-export-latex-options-plist :fixed-width)))
718 ;; return string
719 (buffer-substring (point-min) (point-max))))
720
721(defun org-export-latex-protect-string (s)
722 "Prevent further conversion for string S by adding the
723org-protect property."
724 (add-text-properties 0 (length s) '(org-protected t) s) s)
725
726(defun org-export-latex-protect-char-in-string (char-list string)
727 "Add org-protected text-property to char from CHAR-LIST in STRING."
728 (with-temp-buffer
729 (save-match-data
730 (insert string)
731 (goto-char (point-min))
732 (while (re-search-forward (regexp-opt char-list) nil t)
733 (add-text-properties (match-beginning 0)
734 (match-end 0) '(org-protected t)))
735 (buffer-string))))
736
646(defun org-export-latex-keywords-maybe (remove-list) 737(defun org-export-latex-keywords-maybe (remove-list)
647 "Maybe remove keywords depending on rules in REMOVE-LIST." 738 "Maybe remove keywords depending on rules in REMOVE-LIST."
648 (goto-char (point-min)) 739 (goto-char (point-min))
649 (let ((re-todo (mapconcat 'identity org-latex-todo-keywords-1 "\\|"))) 740 (let ((re-todo (mapconcat 'identity org-export-latex-todo-keywords-1 "\\|"))
741 (case-fold-search nil))
650 ;; convert TODO keywords 742 ;; convert TODO keywords
651 (when (re-search-forward (concat "^\\(" re-todo "\\)") nil t) 743 (when (re-search-forward (concat "^\\(" re-todo "\\)") nil t)
652 (if (plist-get remove-list :todo) 744 (if (plist-get remove-list :todo)
@@ -664,48 +756,25 @@ formatting string like %%%%s if we want to comment them out."
664 (replace-match "") 756 (replace-match "")
665 (replace-match (format "\\texttt{%s}" (match-string 0)) t t))))) 757 (replace-match (format "\\texttt{%s}" (match-string 0)) t t)))))
666 758
667(defun org-export-latex-fontify-headline (headline) 759(defun org-export-latex-fontify-headline (string)
668 "Fontify special words in a HEADLINE." 760 "Fontify special words in string."
669 (with-temp-buffer 761 (with-temp-buffer
670 ;; FIXME: org-inside-LaTeX-fragment-p doesn't work when the $...$ is at 762 ;; FIXME: org-inside-LaTeX-fragment-p doesn't work when the $...$ is at
671 ;; the beginning of the buffer - inserting "\n" is safe here though. 763 ;; the beginning of the buffer - inserting "\n" is safe here though.
672 (insert "\n" headline) 764 (insert "\n" string)
673 (goto-char (point-min)) 765 (goto-char (point-min))
674 (when (plist-get org-latex-options-plist :emphasize) 766 (when (plist-get org-export-latex-options-plist :emphasize)
675 (org-export-latex-fontify)) 767 (org-export-latex-fontify))
676 (org-export-latex-special-chars 768 (org-export-latex-special-chars
677 (plist-get org-latex-options-plist :sub-superscript)) 769 (plist-get org-export-latex-options-plist :sub-superscript))
678 (org-export-latex-keywords-maybe 770 (org-export-latex-keywords-maybe
679 org-export-latex-remove-from-headlines) 771 org-export-latex-remove-from-headlines)
680 (org-export-latex-links) 772 (org-export-latex-links)
681 (org-trim (buffer-substring-no-properties (point-min) (point-max))))) 773 (org-trim (buffer-substring-no-properties (point-min) (point-max)))))
682 774
683(defun org-export-latex-content (content)
684 "Convert CONTENT string to LaTeX."
685 (with-temp-buffer
686 (insert content)
687 (org-export-latex-quotation-marks)
688 (when (plist-get org-latex-options-plist :emphasize)
689 (org-export-latex-fontify))
690 (org-export-latex-special-chars
691 (plist-get org-latex-options-plist :sub-superscript))
692 (org-export-latex-links)
693 (org-export-latex-keywords
694 (plist-get org-latex-options-plist :timestamps))
695 (org-export-latex-lists)
696 (org-export-latex-tables
697 (plist-get org-latex-options-plist :tables))
698 (org-export-latex-fixed-width
699 (plist-get org-latex-options-plist :fixed-width))
700 ;; return string
701 (buffer-substring (point-min) (point-max))))
702
703(defun org-export-latex-quotation-marks () 775(defun org-export-latex-quotation-marks ()
704 "Export question marks depending on language conventions. 776 "Export question marks depending on language conventions."
705Local definition of the language overrides 777 (let* ((lang (plist-get org-export-latex-options-plist :language))
706`org-export-latex-quotation-marks-convention' which overrides
707`org-export-default-language'."
708 (let* ((lang (plist-get org-latex-options-plist :language))
709 (quote-rpl (if (equal lang "fr") 778 (quote-rpl (if (equal lang "fr")
710 '(("\\(\\s-\\)\"" "«~") 779 '(("\\(\\s-\\)\"" "«~")
711 ("\\(\\S-\\)\"" "~»") 780 ("\\(\\S-\\)\"" "~»")
@@ -720,21 +789,6 @@ Local definition of the language overrides
720 (org-if-unprotected 789 (org-if-unprotected
721 (replace-match rpl t t))))) quote-rpl))) 790 (replace-match rpl t t))))) quote-rpl)))
722 791
723;; | chars/string in Org | normal environment | math environment |
724;; |-----------------------+-----------------------+-----------------------|
725;; | & # % $ | \& \# \% \$ | \& \# \% \$ |
726;; | { } _ ^ \ | \{ \} \_ \^ \\ | { } _ ^ \ |
727;; |-----------------------+-----------------------+-----------------------|
728;; | a_b and a^b | $a_b$ and $a^b$ | a_b and a^b |
729;; | a_abc and a_{abc} | $a_a$bc and $a_{abc}$ | a_abc and a_{abc} |
730;; | \tau and \mu | $\tau$ and $\mu$ | \tau and \mu |
731;; |-----------------------+-----------------------+-----------------------|
732;; | \_ \^ | \_ \^ | \_ \^ |
733;; | \(a=\mu\mbox{m}\) | \(a=\mu\mbox{m}\) | \(a=\mu\mbox{m}\) |
734;; | \[\beta^2-a=0\] | \[\beta^2-a=0\] | \[\beta^2-a=0\] |
735;; | $x=22\tau$ | $x=22\tau$ | $x=22\tau$ |
736;; | $$\alpha=\sqrt{a^3}$$ | $$\alpha=\sqrt{a^3}$$ | $$\alpha=\sqrt{a^3}$$ |
737
738(defun org-export-latex-special-chars (sub-superscript) 792(defun org-export-latex-special-chars (sub-superscript)
739 "Export special characters to LaTeX. 793 "Export special characters to LaTeX.
740If SUB-SUPERSCRIPT is non-nil, convert \\ and ^. 794If SUB-SUPERSCRIPT is non-nil, convert \\ and ^.
@@ -744,7 +798,8 @@ See the `org-export-latex.el' code for a complete conversion table."
744 (goto-char (point-min)) 798 (goto-char (point-min))
745 (while (re-search-forward c nil t) 799 (while (re-search-forward c nil t)
746 ;; Put the point where to check for org-protected 800 ;; Put the point where to check for org-protected
747 (unless (get-text-property (match-beginning 2) 'org-protected) 801 (unless (or (get-text-property (match-beginning 2) 'org-protected)
802 (org-at-table-p))
748 (cond ((member (match-string 2) '("\\$" "$")) 803 (cond ((member (match-string 2) '("\\$" "$"))
749 (if (equal (match-string 2) "\\$") 804 (if (equal (match-string 2) "\\$")
750 (replace-match (concat (match-string 1) "$" 805 (replace-match (concat (match-string 1) "$"
@@ -756,11 +811,15 @@ See the `org-export-latex.el' code for a complete conversion table."
756 (replace-match (match-string 2) t t) 811 (replace-match (match-string 2) t t)
757 (replace-match (concat (match-string 1) "\\" 812 (replace-match (concat (match-string 1) "\\"
758 (match-string 2)) t t))) 813 (match-string 2)) t t)))
814 ((equal (match-string 2) "...")
815 (replace-match
816 (concat (match-string 1)
817 (org-export-latex-protect-string "\\ldots{}")) t t))
759 ((equal (match-string 2) "~") 818 ((equal (match-string 2) "~")
760 (cond ((equal (match-string 1) "\\") nil) 819 (cond ((equal (match-string 1) "\\") nil)
761 ((eq 'org-link (get-text-property 0 'face (match-string 2))) 820 ((eq 'org-link (get-text-property 0 'face (match-string 2)))
762 (replace-match (concat (match-string 1) "\\~") t t)) 821 (replace-match (concat (match-string 1) "\\~") t t))
763 (t (replace-match 822 (t (replace-match
764 (org-export-latex-protect-string 823 (org-export-latex-protect-string
765 (concat (match-string 1) "\\~{}")) t t)))) 824 (concat (match-string 1) "\\~{}")) t t))))
766 ((member (match-string 2) '("{" "}")) 825 ((member (match-string 2) '("{" "}"))
@@ -791,6 +850,7 @@ See the `org-export-latex.el' code for a complete conversion table."
791 "\\(.\\|^\\)\\({\\)" 850 "\\(.\\|^\\)\\({\\)"
792 "\\(.\\|^\\)\\(}\\)" 851 "\\(.\\|^\\)\\(}\\)"
793 "\\(.\\|^\\)\\(~\\)" 852 "\\(.\\|^\\)\\(~\\)"
853 "\\(.\\|^\\)\\(\\.\\.\\.\\)"
794 ;; (?\< . "\\textless{}") 854 ;; (?\< . "\\textless{}")
795 ;; (?\> . "\\textgreater{}") 855 ;; (?\> . "\\textgreater{}")
796 ))) 856 )))
@@ -812,7 +872,7 @@ Convert CHAR depending on STRING-BEFORE and STRING-AFTER."
812 (cond ((eq 1 (length string-after)) 872 (cond ((eq 1 (length string-after))
813 (concat string-before char string-after)) 873 (concat string-before char string-after))
814 ((string-match "[({]?\\([^)}]+\\)[)}]?" string-after) 874 ((string-match "[({]?\\([^)}]+\\)[)}]?" string-after)
815 (format "%s%s{%s}" string-before char 875 (format "%s%s{%s}" string-before char
816 (match-string 1 string-after)))))) 876 (match-string 1 string-after))))))
817 ((and subsup 877 ((and subsup
818 (> (length string-after) 1) 878 (> (length string-after) 1)
@@ -842,7 +902,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
842 (string-match "^[ \t\n]" string-after))) 902 (string-match "^[ \t\n]" string-after)))
843 ;; backslash might escape a character (like \#) or a user TeX 903 ;; backslash might escape a character (like \#) or a user TeX
844 ;; macro (like \setcounter) 904 ;; macro (like \setcounter)
845 (org-export-latex-protect-string 905 (org-export-latex-protect-string
846 (concat string-before "\\" string-after))) 906 (concat string-before "\\" string-after)))
847 ((and (string-match "^[ \t\n]" string-after) 907 ((and (string-match "^[ \t\n]" string-after)
848 (string-match "[ \t\n]\\'" string-before)) 908 (string-match "[ \t\n]\\'" string-before))
@@ -854,19 +914,18 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
854 914
855(defun org-export-latex-keywords (timestamps) 915(defun org-export-latex-keywords (timestamps)
856 "Convert special keywords to LaTeX. 916 "Convert special keywords to LaTeX.
857Regexps are those from `org-latex-special-string-regexps'." 917Regexps are those from `org-export-latex-special-string-regexps'."
858 (let ((rg org-latex-special-string-regexps) r) 918 (let ((rg org-export-latex-special-string-regexps) r)
859 (while (setq r (pop rg)) 919 (while (setq r (pop rg))
860 (goto-char (point-min)) 920 (goto-char (point-min))
861 (while (re-search-forward (eval r) nil t) 921 (while (re-search-forward (eval r) nil t)
862 (if (not timestamps) 922 (if (not timestamps)
863 (replace-match (format "\\\\texttt{%s}" (match-string 0)) t) 923 (replace-match (format "\\\\texttt{%s}" (match-string 0)) t)
864 (replace-match "")))))) 924 (replace-match ""))))))
865 925
866(defun org-export-latex-fixed-width (opt) 926(defun org-export-latex-fixed-width (opt)
867 "When OPT is non-nil convert fixed-width sections to LaTeX." 927 "When OPT is non-nil convert fixed-width sections to LaTeX."
868 (goto-char (point-min)) 928 (goto-char (point-min))
869 ;; FIXME the search shouldn't be performed on already converted text
870 (while (re-search-forward "^[ \t]*:" nil t) 929 (while (re-search-forward "^[ \t]*:" nil t)
871 (if opt 930 (if opt
872 (progn (goto-char (match-beginning 0)) 931 (progn (goto-char (match-beginning 0))
@@ -882,73 +941,6 @@ Regexps are those from `org-latex-special-string-regexps'."
882 (match-string 2)) t t) 941 (match-string 2)) t t)
883 (forward-line)))))) 942 (forward-line))))))
884 943
885(defun org-export-latex-lists ()
886 "Convert lists to LaTeX."
887 (goto-char (point-min))
888 (while (re-search-forward org-export-latex-list-beginning-re nil t)
889 (beginning-of-line)
890 (org-export-list-to-latex
891 (org-export-latex-parse-list t))))
892
893(defun org-export-list-to-generic (list params)
894 "Convert a LIST parsed through `org-export-latex-parse-list' to other formats.
895
896Valid parameters are
897
898:ustart String to start an unordered list
899:uend String to end an unordered list
900
901:ostart String to start an ordered list
902:oend String to end an ordered list
903
904:splice When set to t, return only list body lines, don't wrap
905 them into :[u/o]start and :[u/o]end. Default is nil.
906
907:istart String to start a list item
908:iend String to end a list item
909:isep String to separate items
910:lsep String to separate sublists"
911 (interactive)
912 (let* ((p params) sublist
913 (splicep (plist-get p :splice))
914 (ostart (plist-get p :ostart))
915 (oend (plist-get p :oend))
916 (ustart (plist-get p :ustart))
917 (uend (plist-get p :uend))
918 (istart (plist-get p :istart))
919 (iend (plist-get p :iend))
920 (isep (plist-get p :isep))
921 (lsep (plist-get p :lsep)))
922 (let ((wrapper
923 (cond ((eq (car list) 'ordered)
924 (concat ostart "\n%s" oend "\n"))
925 ((eq (car list) 'unordered)
926 (concat ustart "\n%s" uend "\n"))))
927 rtn)
928 (while (setq sublist (pop list))
929 (cond ((symbolp sublist) nil)
930 ((stringp sublist)
931 (setq rtn (concat rtn istart sublist iend isep)))
932 (t
933 (setq rtn (concat rtn ;; previous list
934 lsep ;; list separator
935 (org-export-list-to-generic sublist p)
936 lsep ;; list separator
937 )))))
938 (format wrapper rtn))))
939
940(defun org-export-list-to-latex (list)
941 "Convert LIST into a LaTeX list."
942 (insert
943 (org-export-list-to-generic
944 list '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}"
945 :ustart "\\begin{itemize}" :uend "\\end{itemize}"
946 :istart "\\item " :iend ""
947 :isep "\n" :lsep "\n"))
948 ;; Add a trailing \n after list conversion
949 "\n"))
950
951;; FIXME Use org-export-highlight-first-table-line ?
952(defun org-export-latex-tables (insert) 944(defun org-export-latex-tables (insert)
953 "Convert tables to LaTeX and INSERT it." 945 "Convert tables to LaTeX and INSERT it."
954 (goto-char (point-min)) 946 (goto-char (point-min))
@@ -975,7 +967,7 @@ Valid parameters are
975 (unless (string-match "^[ \t]*|-" line) 967 (unless (string-match "^[ \t]*|-" line)
976 (setq fields (org-split-string line "[ \t]*|[ \t]*")) 968 (setq fields (org-split-string line "[ \t]*|[ \t]*"))
977 (setq fnum (make-vector (length fields) 0)) 969 (setq fnum (make-vector (length fields) 0))
978 (setq line-fmt 970 (setq line-fmt
979 (mapconcat 971 (mapconcat
980 (lambda (x) 972 (lambda (x)
981 (setq gr (pop org-table-colgroup-info)) 973 (setq gr (pop org-table-colgroup-info))
@@ -991,18 +983,21 @@ Valid parameters are
991 (progn (setq colgropen nil) "|") 983 (progn (setq colgropen nil) "|")
992 ""))) 984 "")))
993 fnum "")))) 985 fnum ""))))
986 ;; fix double || in line-fmt
987 (setq line-fmt (replace-regexp-in-string "||" "|" line-fmt))
994 ;; maybe remove the first and last "|" 988 ;; maybe remove the first and last "|"
995 (when (string-match "^\\(|\\)?\\(.+\\)|$" line-fmt) 989 (when (and (not org-export-latex-tables-column-borders)
990 (string-match "^\\(|\\)?\\(.+\\)|$" line-fmt))
996 (setq line-fmt (match-string 2 line-fmt))) 991 (setq line-fmt (match-string 2 line-fmt)))
997 ;; format alignment 992 ;; format alignment
998 (setq align (apply 'format 993 (setq align (apply 'format
999 (cons line-fmt 994 (cons line-fmt
1000 (mapcar (lambda (x) (if x "r" "l")) 995 (mapcar (lambda (x) (if x "r" "l"))
1001 org-table-last-alignment)))) 996 org-table-last-alignment))))
1002 ;; prepare the table to send to orgtbl-to-latex 997 ;; prepare the table to send to orgtbl-to-latex
1003 (setq lines 998 (setq lines
1004 (mapcar 999 (mapcar
1005 (lambda(elem) 1000 (lambda(elem)
1006 (or (and (string-match "[ \t]*|-+" elem) 'hline) 1001 (or (and (string-match "[ \t]*|-+" elem) 'hline)
1007 (split-string (org-trim elem) "|" t))) 1002 (split-string (org-trim elem) "|" t)))
1008 lines)) 1003 lines))
@@ -1016,8 +1011,8 @@ Valid parameters are
1016 (goto-char (point-min)) 1011 (goto-char (point-min))
1017 (while (re-search-forward org-emph-re nil t) 1012 (while (re-search-forward org-emph-re nil t)
1018 ;; The match goes one char after the *string* 1013 ;; The match goes one char after the *string*
1019 (let ((emph (assoc (match-string 3) 1014 (let ((emph (assoc (match-string 3)
1020 org-export-latex-emphasis-alist)) 1015 org-export-latex-emphasis-alist))
1021 rpl) 1016 rpl)
1022 (unless (get-text-property (1- (point)) 'org-protected) 1017 (unless (get-text-property (1- (point)) 'org-protected)
1023 (setq rpl (concat (match-string 1) 1018 (setq rpl (concat (match-string 1)
@@ -1025,7 +1020,7 @@ Valid parameters are
1025 '("\\" "{" "}") (cadr emph)) 1020 '("\\" "{" "}") (cadr emph))
1026 (match-string 4)) 1021 (match-string 4))
1027 (match-string 5))) 1022 (match-string 5)))
1028 (if (caddr emph) 1023 (if (caddr emph)
1029 (setq rpl (org-export-latex-protect-string rpl))) 1024 (setq rpl (org-export-latex-protect-string rpl)))
1030 (replace-match rpl t t))) 1025 (replace-match rpl t t)))
1031 (backward-char))) 1026 (backward-char)))
@@ -1038,7 +1033,7 @@ Valid parameters are
1038 (while (re-search-forward org-bracket-link-analytic-regexp nil t) 1033 (while (re-search-forward org-bracket-link-analytic-regexp nil t)
1039 (org-if-unprotected 1034 (org-if-unprotected
1040 (goto-char (match-beginning 0)) 1035 (goto-char (match-beginning 0))
1041 (let* ((re-radio org-latex-all-targets-regexp) 1036 (let* ((re-radio org-export-latex-all-targets-re)
1042 (remove (list (match-beginning 0) (match-end 0))) 1037 (remove (list (match-beginning 0) (match-end 0)))
1043 (type (match-string 2)) 1038 (type (match-string 2))
1044 (raw-path (match-string 3)) 1039 (raw-path (match-string 3))
@@ -1063,22 +1058,22 @@ Valid parameters are
1063 (if (file-exists-p raw-path) 1058 (if (file-exists-p raw-path)
1064 (concat type "://" (expand-file-name raw-path)) 1059 (concat type "://" (expand-file-name raw-path))
1065 (concat type "://" (org-export-directory 1060 (concat type "://" (org-export-directory
1066 :LaTeX org-latex-options-plist) 1061 :LaTeX org-export-latex-options-plist)
1067 raw-path)))))))) 1062 raw-path))))))))
1068 ;; process with link inserting 1063 ;; process with link inserting
1069 (apply 'delete-region remove) 1064 (apply 'delete-region remove)
1070 (cond ((and imgp (plist-get org-latex-options-plist :inline-images)) 1065 (cond ((and imgp (plist-get org-export-latex-options-plist :inline-images))
1071 (insert (format "\\includegraphics[%s]{%s}" 1066 (insert (format "\\includegraphics[%s]{%s}"
1072 ;; image option should be set be a comment line 1067 ;; image option should be set be a comment line
1073 org-export-latex-image-default-option 1068 org-export-latex-image-default-option
1074 (expand-file-name raw-path)))) 1069 (expand-file-name raw-path))))
1075 ;; FIXME: what about caption? image properties?
1076 (radiop (insert (format "\\hyperref[%s]{%s}" raw-path desc))) 1070 (radiop (insert (format "\\hyperref[%s]{%s}" raw-path desc)))
1077 (path (insert (format "\\href{%s}{%s}" path desc))) 1071 (path (insert (format "\\href{%s}{%s}" path desc)))
1078 (t (insert "\\texttt{" desc "}"))))))) 1072 (t (insert "\\texttt{" desc "}")))))))
1079 1073
1080(defun org-export-latex-cleaned-string (&optional commentsp) 1074(defvar org-latex-entities) ; defined below
1081 ;; FIXME remove commentsp call in org.el and here 1075
1076(defun org-export-latex-cleaned-string ()
1082 "Clean stuff in the LaTeX export." 1077 "Clean stuff in the LaTeX export."
1083 1078
1084 ;; Preserve line breaks 1079 ;; Preserve line breaks
@@ -1091,7 +1086,7 @@ Valid parameters are
1091 (goto-char (point-min)) 1086 (goto-char (point-min))
1092 (let ((case-fold-search nil) rpl) 1087 (let ((case-fold-search nil) rpl)
1093 (while (re-search-forward "\\([^+_]\\)LaTeX" nil t) 1088 (while (re-search-forward "\\([^+_]\\)LaTeX" nil t)
1094 (replace-match (org-export-latex-protect-string 1089 (replace-match (org-export-latex-protect-string
1095 (concat (match-string 1) "\\LaTeX{}")) t t))) 1090 (concat (match-string 1) "\\LaTeX{}")) t t)))
1096 1091
1097 ;; Convert horizontal rules 1092 ;; Convert horizontal rules
@@ -1099,19 +1094,25 @@ Valid parameters are
1099 (while (re-search-forward "^----+.$" nil t) 1094 (while (re-search-forward "^----+.$" nil t)
1100 (replace-match (org-export-latex-protect-string "\\hrule") t t)) 1095 (replace-match (org-export-latex-protect-string "\\hrule") t t))
1101 1096
1102 ;; Protect LaTeX \commands{...} 1097 ;; Protect LaTeX commands like \commad[...]{...} or \command{...}
1103 (goto-char (point-min)) 1098 (goto-char (point-min))
1104 (while (re-search-forward "\\\\[a-zA-Z]+\\(?:\\[.*\\]\\)?{.*}" nil t) 1099 (while (re-search-forward "\\\\[a-zA-Z]+\\(?:\\[.*\\]\\)?{.*}" nil t)
1105 (add-text-properties (match-beginning 0) (match-end 0) 1100 (add-text-properties (match-beginning 0) (match-end 0)
1106 '(org-protected t))) 1101 '(org-protected t)))
1107 1102
1103 ;; Protect LaTeX entities
1104 (goto-char (point-min))
1105 (while (re-search-forward (regexp-opt org-latex-entities) nil t)
1106 (add-text-properties (match-beginning 0) (match-end 0)
1107 '(org-protected t)))
1108
1108 ;; Replace radio links 1109 ;; Replace radio links
1109 (goto-char (point-min)) 1110 (goto-char (point-min))
1110 (while (re-search-forward 1111 (while (re-search-forward
1111 (concat "<<<?" org-latex-all-targets-regexp 1112 (concat "<<<?" org-export-latex-all-targets-re
1112 ">>>?\\((INVISIBLE)\\)?") nil t) 1113 ">>>?\\((INVISIBLE)\\)?") nil t)
1113 (replace-match 1114 (replace-match
1114 (org-export-latex-protect-string 1115 (org-export-latex-protect-string
1115 (format "\\label{%s}%s"(match-string 1) 1116 (format "\\label{%s}%s"(match-string 1)
1116 (if (match-string 2) "" (match-string 1)))) t t)) 1117 (if (match-string 2) "" (match-string 1)))) t t))
1117 1118
@@ -1123,7 +1124,7 @@ Valid parameters are
1123 1124
1124 ;; When converting to LaTeX, replace footnotes 1125 ;; When converting to LaTeX, replace footnotes
1125 ;; FIXME: don't protect footnotes from conversion 1126 ;; FIXME: don't protect footnotes from conversion
1126 (when (plist-get org-latex-options-plist :footnotes) 1127 (when (plist-get org-export-latex-options-plist :footnotes)
1127 (goto-char (point-min)) 1128 (goto-char (point-min))
1128 (while (re-search-forward "\\[[0-9]+\\]" nil t) 1129 (while (re-search-forward "\\[[0-9]+\\]" nil t)
1129 (when (save-match-data 1130 (when (save-match-data
@@ -1133,34 +1134,402 @@ Valid parameters are
1133 (foot-end (match-end 0)) 1134 (foot-end (match-end 0))
1134 (foot-prefix (match-string 0)) 1135 (foot-prefix (match-string 0))
1135 footnote footnote-rpl) 1136 footnote footnote-rpl)
1136 (when (and (re-search-forward (regexp-quote foot-prefix) nil t)) 1137 (save-excursion
1137 (replace-match "") 1138 (when (search-forward foot-prefix nil t)
1138 (let ((end (save-excursion 1139 (replace-match "")
1139 (if (re-search-forward "^$\\|^#.*$\\|\\[[0-9]+\\]" nil t) 1140 (let ((end (save-excursion
1140 (match-beginning 0) (point-max))))) 1141 (if (re-search-forward "^$\\|^#.*$\\|\\[[0-9]+\\]" nil t)
1141 (setq footnote 1142 (match-beginning 0) (point-max)))))
1142 (concat 1143 (setq footnote (concat (org-trim (buffer-substring (point) end))
1143 (org-trim (buffer-substring (point) end)) 1144 " ")) ; prevent last } being part of a link
1144 ;; FIXME stupid workaround for cases where 1145 (delete-region (point) end))
1145 ;; `org-bracket-link-analytic-regexp' matches 1146 (goto-char foot-beg)
1146 ;; }. as part of the link. 1147 (delete-region foot-beg foot-end)
1147 " ")) 1148 (unless (null footnote)
1148 (delete-region (point) end))) 1149 (setq footnote-rpl (format "\\footnote{%s}" footnote))
1149 (goto-char foot-beg) 1150 (add-text-properties 0 10 '(org-protected t) footnote-rpl)
1150 (delete-region foot-beg foot-end) 1151 (add-text-properties (1- (length footnote-rpl))
1151 (setq footnote-rpl (format "\\footnote{%s}" footnote)) 1152 (length footnote-rpl)
1152 (add-text-properties 0 10 '(org-protected t) footnote-rpl) 1153 '(org-protected t) footnote-rpl)
1153 (add-text-properties (1- (length footnote-rpl)) 1154 (insert footnote-rpl)))))))
1154 (length footnote-rpl) 1155
1155 '(org-protected t) footnote-rpl)
1156 (insert footnote-rpl))))
1157
1158 ;; Replace footnote section tag for LaTeX 1156 ;; Replace footnote section tag for LaTeX
1159 (goto-char (point-min)) 1157 (goto-char (point-min))
1160 (while (re-search-forward 1158 (while (re-search-forward
1161 (concat "^" footnote-section-tag-regexp) nil t) 1159 (concat "^" footnote-section-tag-regexp) nil t)
1162 (replace-match "")))) 1160 (replace-match ""))))
1163 1161
1162;;; List handling:
1163
1164(defun org-export-latex-lists ()
1165 "Replace plain text lists in current buffer into LaTeX lists."
1166 "Convert lists to LaTeX."
1167 (goto-char (point-min))
1168 (while (re-search-forward org-export-latex-list-beginning-re nil t)
1169 (beginning-of-line)
1170 (insert (org-list-to-latex (org-list-parse-list t)) "\n")))
1171
1172(defun org-list-parse-list (&optional delete)
1173 "Parse the list at point.
1174Return a list containing first level items as strings and
1175sublevels as a list of strings."
1176 (let ((start (org-list-item-begin))
1177 (end (org-list-end))
1178 output itemsep)
1179 (while (re-search-forward org-export-latex-list-beginning-re end t)
1180 (setq itemsep (if (save-match-data
1181 (string-match "^[0-9]" (match-string 2)))
1182 "[0-9]+\\(?:\\.\\|)\\)" "[-+]"))
1183 (let* ((indent1 (match-string 1))
1184 (nextitem (save-excursion
1185 (save-match-data
1186 (or (and (re-search-forward
1187 (concat "^" indent1 itemsep " *?") end t)
1188 (match-beginning 0)) end))))
1189 (item (buffer-substring
1190 (point)
1191 (or (and (re-search-forward
1192 org-export-latex-list-beginning-re end t)
1193 (goto-char (match-beginning 0)))
1194 (goto-char end))))
1195 (nextindent (match-string 1))
1196 (item (org-trim item))
1197 (item (if (string-match "^\\[.+\\]" item)
1198 (replace-match "\\\\texttt{\\&}"
1199 t nil item) item)))
1200 (push item output)
1201 (when (> (length nextindent)
1202 (length indent1))
1203 (narrow-to-region (point) nextitem)
1204 (push (org-list-parse-list) output)
1205 (widen))))
1206 (when delete (delete-region start end))
1207 (setq output (nreverse output))
1208 (push (if (string-match "^\\[0" itemsep)
1209 'ordered 'unordered) output)))
1210
1211(defun org-list-item-begin ()
1212 "Find the beginning of the list item and return its position."
1213 (save-excursion
1214 (if (not (or (looking-at org-export-latex-list-beginning-re)
1215 (re-search-backward
1216 org-export-latex-list-beginning-re nil t)))
1217 (progn (goto-char (point-min)) (point))
1218 (match-beginning 0))))
1219
1220(defun org-list-end ()
1221 "Find the end of the list and return its position."
1222 (save-excursion
1223 (catch 'exit
1224 (while (or (looking-at org-export-latex-list-beginning-re)
1225 (looking-at "^[ \t]+\\|^$"))
1226 (if (eq (point) (point-max))
1227 (throw 'exit (point-max)))
1228 (forward-line 1))) (point)))
1229
1230(defun org-list-insert-radio-list ()
1231 "Insert a radio list template appropriate for this major mode."
1232 (interactive)
1233 (let* ((e (assq major-mode org-list-radio-list-templates))
1234 (txt (nth 1 e))
1235 name pos)
1236 (unless e (error "No radio list setup defined for %s" major-mode))
1237 (setq name (read-string "List name: "))
1238 (while (string-match "%n" txt)
1239 (setq txt (replace-match name t t txt)))
1240 (or (bolp) (insert "\n"))
1241 (setq pos (point))
1242 (insert txt)
1243 (goto-char pos)))
1244
1245(defun org-list-send-list (&optional maybe)
1246 "Send a tranformed version of this list to the receiver position.
1247With argument MAYBE, fail quietly if no transformation is defined for
1248this list."
1249 (interactive)
1250 (catch 'exit
1251 (unless (org-at-item-p) (error "Not at a list"))
1252 (save-excursion
1253 (goto-char (org-list-item-begin))
1254 (beginning-of-line 0)
1255 (unless (looking-at "#\\+ORGLST: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?")
1256 (if maybe
1257 (throw 'exit nil)
1258 (error "Don't know how to transform this list"))))
1259 (let* ((name (match-string 1))
1260 beg
1261 (transform (intern (match-string 2)))
1262 (txt (buffer-substring-no-properties
1263 (org-list-item-begin)
1264 (org-list-end)))
1265 (list (org-list-parse-list)))
1266 (unless (fboundp transform)
1267 (error "No such transformation function %s" transform))
1268 (setq txt (funcall transform list))
1269 ;; Find the insertion place
1270 (save-excursion
1271 (goto-char (point-min))
1272 (unless (re-search-forward
1273 (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t)
1274 (error "Don't know where to insert translated list"))
1275 (goto-char (match-beginning 0))
1276 (beginning-of-line 2)
1277 (setq beg (point))
1278 (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
1279 (error "Cannot find end of insertion region"))
1280 (beginning-of-line 1)
1281 (delete-region beg (point))
1282 (goto-char beg)
1283 (insert txt "\n"))
1284 (message "List converted and installed at receiver location"))))
1285
1286(defun org-list-to-generic (list params)
1287 "Convert a LIST parsed through `org-list-parse-list' to other formats.
1288
1289Valid parameters are
1290
1291:ustart String to start an unordered list
1292:uend String to end an unordered list
1293
1294:ostart String to start an ordered list
1295:oend String to end an ordered list
1296
1297:splice When set to t, return only list body lines, don't wrap
1298 them into :[u/o]start and :[u/o]end. Default is nil.
1299
1300:istart String to start a list item
1301:iend String to end a list item
1302:isep String to separate items
1303:lsep String to separate sublists"
1304 (interactive)
1305 (let* ((p params) sublist
1306 (splicep (plist-get p :splice))
1307 (ostart (plist-get p :ostart))
1308 (oend (plist-get p :oend))
1309 (ustart (plist-get p :ustart))
1310 (uend (plist-get p :uend))
1311 (istart (plist-get p :istart))
1312 (iend (plist-get p :iend))
1313 (isep (plist-get p :isep))
1314 (lsep (plist-get p :lsep)))
1315 (let ((wrapper
1316 (cond ((eq (car list) 'ordered)
1317 (concat ostart "\n%s" oend "\n"))
1318 ((eq (car list) 'unordered)
1319 (concat ustart "\n%s" uend "\n"))))
1320 rtn)
1321 (while (setq sublist (pop list))
1322 (cond ((symbolp sublist) nil)
1323 ((stringp sublist)
1324 (setq rtn (concat rtn istart sublist iend isep)))
1325 (t
1326 (setq rtn (concat rtn ;; previous list
1327 lsep ;; list separator
1328 (org-list-to-generic sublist p)
1329 lsep ;; list separator
1330 )))))
1331 (format wrapper rtn))))
1332
1333(defun org-list-to-latex (list)
1334 "Convert LIST into a LaTeX list."
1335 (org-list-to-generic
1336 list '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}"
1337 :ustart "\\begin{itemize}" :uend "\\end{itemize}"
1338 :istart "\\item " :iend ""
1339 :isep "\n" :lsep "\n")))
1340
1341(defun org-list-to-html (list)
1342 "Convert LIST into a HTML list."
1343 (org-list-to-generic
1344 list '(:splicep nil :ostart "<ol>" :oend "</ol>"
1345 :ustart "<ul>" :uend "</ul>"
1346 :istart "<li>" :iend "</li>"
1347 :isep "\n" :lsep "\n")))
1348
1349(defun org-list-to-texinfo (list)
1350 "Convert LIST into a Texinfo list."
1351 (org-list-to-generic
1352 list '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize"
1353 :ustart "@enumerate" :uend "@end enumerate"
1354 :istart "@item\n" :iend ""
1355 :isep "\n" :lsep "\n")))
1356
1357(defconst org-latex-entities
1358 '("\\!"
1359 "\\'"
1360 "\\+"
1361 "\\,"
1362 "\\-"
1363 "\\:"
1364 "\\;"
1365 "\\<"
1366 "\\="
1367 "\\>"
1368 "\\Huge"
1369 "\\LARGE"
1370 "\\Large"
1371 "\\Styles"
1372 "\\\\"
1373 "\\`"
1374 "\\addcontentsline"
1375 "\\address"
1376 "\\addtocontents"
1377 "\\addtocounter"
1378 "\\addtolength"
1379 "\\addvspace"
1380 "\\alph"
1381 "\\appendix"
1382 "\\arabic"
1383 "\\author"
1384 "\\begin{array}"
1385 "\\begin{center}"
1386 "\\begin{description}"
1387 "\\begin{enumerate}"
1388 "\\begin{eqnarray}"
1389 "\\begin{equation}"
1390 "\\begin{figure}"
1391 "\\begin{flushleft}"
1392 "\\begin{flushright}"
1393 "\\begin{itemize}"
1394 "\\begin{list}"
1395 "\\begin{minipage}"
1396 "\\begin{picture}"
1397 "\\begin{quotation}"
1398 "\\begin{quote}"
1399 "\\begin{tabbing}"
1400 "\\begin{table}"
1401 "\\begin{tabular}"
1402 "\\begin{thebibliography}"
1403 "\\begin{theorem}"
1404 "\\begin{titlepage}"
1405 "\\begin{verbatim}"
1406 "\\begin{verse}"
1407 "\\bf"
1408 "\\bf"
1409 "\\bibitem"
1410 "\\bigskip"
1411 "\\cdots"
1412 "\\centering"
1413 "\\circle"
1414 "\\cite"
1415 "\\cleardoublepage"
1416 "\\clearpage"
1417 "\\cline"
1418 "\\closing"
1419 "\\dashbox"
1420 "\\date"
1421 "\\ddots"
1422 "\\dotfill"
1423 "\\em"
1424 "\\fbox"
1425 "\\flushbottom"
1426 "\\fnsymbol"
1427 "\\footnote"
1428 "\\footnotemark"
1429 "\\footnotesize"
1430 "\\footnotetext"
1431 "\\frac"
1432 "\\frame"
1433 "\\framebox"
1434 "\\hfill"
1435 "\\hline"
1436 "\\hrulespace"
1437 "\\hspace"
1438 "\\huge"
1439 "\\hyphenation"
1440 "\\include"
1441 "\\includeonly"
1442 "\\indent"
1443 "\\input"
1444 "\\it"
1445 "\\kill"
1446 "\\label"
1447 "\\large"
1448 "\\ldots"
1449 "\\line"
1450 "\\linebreak"
1451 "\\linethickness"
1452 "\\listoffigures"
1453 "\\listoftables"
1454 "\\location"
1455 "\\makebox"
1456 "\\maketitle"
1457 "\\mark"
1458 "\\mbox"
1459 "\\medskip"
1460 "\\multicolumn"
1461 "\\multiput"
1462 "\\newcommand"
1463 "\\newcounter"
1464 "\\newenvironment"
1465 "\\newfont"
1466 "\\newlength"
1467 "\\newline"
1468 "\\newpage"
1469 "\\newsavebox"
1470 "\\newtheorem"
1471 "\\nocite"
1472 "\\nofiles"
1473 "\\noindent"
1474 "\\nolinebreak"
1475 "\\nopagebreak"
1476 "\\normalsize"
1477 "\\onecolumn"
1478 "\\opening"
1479 "\\oval"
1480 "\\overbrace"
1481 "\\overline"
1482 "\\pagebreak"
1483 "\\pagenumbering"
1484 "\\pageref"
1485 "\\pagestyle"
1486 "\\par"
1487 "\\parbox"
1488 "\\put"
1489 "\\raggedbottom"
1490 "\\raggedleft"
1491 "\\raggedright"
1492 "\\raisebox"
1493 "\\ref"
1494 "\\rm"
1495 "\\roman"
1496 "\\rule"
1497 "\\savebox"
1498 "\\sc"
1499 "\\scriptsize"
1500 "\\setcounter"
1501 "\\setlength"
1502 "\\settowidth"
1503 "\\sf"
1504 "\\shortstack"
1505 "\\signature"
1506 "\\sl"
1507 "\\small"
1508 "\\smallskip"
1509 "\\sqrt"
1510 "\\tableofcontents"
1511 "\\telephone"
1512 "\\thanks"
1513 "\\thispagestyle"
1514 "\\tiny"
1515 "\\title"
1516 "\\tt"
1517 "\\twocolumn"
1518 "\\typein"
1519 "\\typeout"
1520 "\\underbrace"
1521 "\\underline"
1522 "\\usebox"
1523 "\\usecounter"
1524 "\\value"
1525 "\\vdots"
1526 "\\vector"
1527 "\\verb"
1528 "\\vfill"
1529 "\\vline"
1530 "\\vspace")
1531 "A list of LaTeX commands to be protected when performing conversion.")
1532
1164(provide 'org-export-latex) 1533(provide 'org-export-latex)
1165 1534
1166;; arch-tag: 23c2b87d-da04-4c2d-ad2d-1eb6487bc3ad 1535;; arch-tag: 23c2b87d-da04-4c2d-ad2d-1eb6487bc3ad
diff --git a/lisp/textmodes/org-mouse.el b/lisp/textmodes/org-mouse.el
new file mode 100644
index 00000000000..f91dc3af853
--- /dev/null
+++ b/lisp/textmodes/org-mouse.el
@@ -0,0 +1,1110 @@
1;;; org-mouse.el --- Better mouse support for org-mode
2
3;; Copyright (C) 2006, 2007, 2008 Free Software Foundation
4;;
5;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com>
6;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
7;; Version: 5.19
8;;
9;; This file is part of GNU Emacs.
10;;
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 3, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26;;
27;;; Commentary:
28;;
29;; Org-mouse provides mouse support for org-mode.
30;;
31;; http://orgmode.org
32;;
33;; Org-mouse implements the following features:
34;; * following links with the left mouse button (in Emacs 22)
35;; * subtree expansion/collapse (org-cycle) with the left mouse button
36;; * several context menus on the right mouse button:
37;; + general text
38;; + headlines
39;; + timestamps
40;; + priorities
41;; + links
42;; + tags
43;; * promoting/demoting/moving subtrees with mouse-3
44;; + if the drag starts and ends in the same line then promote/demote
45;; + otherwise move the subtree
46;;
47;; Use
48;; ---
49;;
50;; To use this package, put the following line in your .emacs:
51;;
52;; (require 'org-mouse)
53;;
54
55;; Fixme:
56;; + deal with folding / unfolding issues
57
58;; TODO (This list is only theoretical, if you'd like to have some
59;; feature implemented or a bug fix please send me an email, even if
60;; something similar appears in the list below. This will help me get
61;; the priorities right.):
62;;
63;; + org-store-link, insert link
64;; + org tables
65;; + occur with the current word/tag (same menu item)
66;; + ctrl-c ctrl-c, for example, renumber the current list
67;; + internal links
68
69;; Please email the maintainer with new feature suggestions / bugs
70
71;; History:
72;;
73;; SInce version 5.10: Changes are listed in the general org-mode docs.
74;;
75;; Version 5.09
76;; + Version number synchronization with Org-mode.
77;;
78;; Version 0.25
79;; + made compatible with org-mode 4.70 (thanks to Carsten for the patch)
80;;
81;; Version 0.24
82;; + minor changes to the table menu
83;;
84;; Version 0.23
85;; + preliminary support for tables and calculation marks
86;; + context menu support for org-agenda-undo & org-sort-entries
87;;
88;; Version 0.22
89;; + handles undo support for the agenda buffer (requires org-mode >=4.58)
90;;
91;; Version 0.21
92;; + selected text activates its context menu
93;; + shift-middleclick or right-drag inserts the text from the clipboard in the form of a link
94;;
95;; Version 0.20
96;; + the new "TODO Status" submenu replaces the "Cycle TODO" menu item
97;; + the TODO menu can now list occurrences of a specific TODO keyword
98;; + #+STARTUP line is now recognized
99;;
100;; Version 0.19
101;; + added support for dragging URLs to the org-buffer
102;;
103;; Version 0.18
104;; + added support for agenda blocks
105;;
106;; Version 0.17
107;; + toggle checkboxes with a single click
108;;
109;; Version 0.16
110;; + added support for checkboxes
111;;
112;; Version 0.15
113;; + org-mode now works with the Agenda buffer as well
114;;
115;; Version 0.14
116;; + added a menu option that converts plain list items to outline items
117;;
118;; Version 0.13
119;; + "Insert Heading" now inserts a sibling heading if the point is
120;; on "***" and a child heading otherwise
121;;
122;; Version 0.12
123;; + compatible with Emacs 21
124;; + custom agenda commands added to the main menu
125;; + moving trees should now work between windows in the same frame
126;;
127;; Version 0.11
128;; + fixed org-mouse-at-link (thanks to Carsten)
129;; + removed [follow-link] bindings
130;;
131;; Version 0.10
132;; + added a menu option to remove highlights
133;; + compatible with org-mode 4.21 now
134;;
135;; Version 0.08:
136;; + trees can be moved/promoted/demoted by dragging with the right
137;; mouse button (mouse-3)
138;; + small changes in the above function
139;;
140;; Versions 0.01 -- 0.07: (I don't remember)
141
142(eval-when-compile (require 'cl))
143(require 'org)
144
145(defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) "
146 "Regular expression that matches a plain list.")
147(defvar org-mouse-direct t
148 "Internal variable indicating whether the current action is direct.
149
150If t, then the current action has been invoked directly through the buffer
151it is intended to operate on. If nil, then the action has been invoked
152indirectly, for example, through the agenda buffer.")
153
154(defgroup org-mouse nil
155 "Mouse support for org-mode."
156 :tag "Org Mouse"
157 :group 'org)
158
159(defcustom org-mouse-punctuation ":"
160 "Punctuation used when inserting text by drag and drop."
161 :group 'org-mouse
162 :type 'string)
163
164
165(defun org-mouse-re-search-line (regexp)
166 "Search the current line for a given regular expression."
167 (beginning-of-line)
168 (re-search-forward regexp (point-at-eol) t))
169
170(defun org-mouse-end-headline ()
171 "Go to the end of current headline (ignoring tags)."
172 (interactive)
173 (end-of-line)
174 (skip-chars-backward "\t ")
175 (when (looking-back ":[A-Za-z]+:")
176 (skip-chars-backward ":A-Za-z")
177 (skip-chars-backward "\t ")))
178
179(defvar org-mouse-context-menu-function nil
180 "Function to create the context menu.
181The value of this variable is the function invoked by
182`org-mouse-context-menu' as the context menu.")
183(make-variable-buffer-local 'org-mouse-context-menu-function)
184
185(defun org-mouse-show-context-menu (event prefix)
186 "Invoke the context menu.
187
188If the value of `org-mouse-context-menu-function' is a function, then
189this function is called. Otherwise, the current major mode menu is used."
190 (interactive "@e \nP")
191 (if (and (= (event-click-count event) 1)
192 (or (not mark-active)
193 (sit-for (/ double-click-time 1000.0))))
194 (progn
195 (select-window (posn-window (event-start event)))
196 (when (not (org-mouse-mark-active))
197 (goto-char (posn-point (event-start event)))
198 (when (not (eolp)) (save-excursion (run-hooks 'post-command-hook)))
199 (let ((redisplay-dont-pause t))
200 (sit-for 0)))
201 (if (functionp org-mouse-context-menu-function)
202 (funcall org-mouse-context-menu-function event)
203 (mouse-major-mode-menu event prefix)))
204 (setq this-command 'mouse-save-then-kill)
205 (mouse-save-then-kill event)))
206
207
208(defun org-mouse-line-position ()
209 "Returns `:beginning' or `:middle' or `:end', depending on the point position.
210
211If the point is at the end of the line, return `:end'.
212If the point is separated from the beginning of the line only by white
213space and *'s (`org-mouse-bolp'), return `:beginning'. Otherwise,
214return `:middle'."
215 (cond
216 ((eolp) :end)
217 ((org-mouse-bolp) :beginning)
218 (t :middle)))
219
220(defun org-mouse-empty-line ()
221 "Return non-nil iff the line contains only white space."
222 (save-excursion (beginning-of-line) (looking-at "[ \t]*$")))
223
224(defun org-mouse-next-heading ()
225 "Go to the next heading.
226If there is none, ensure that the point is at the beginning of an empty line."
227 (unless (outline-next-heading)
228 (beginning-of-line)
229 (unless (org-mouse-empty-line)
230 (end-of-line)
231 (newline))))
232
233(defun org-mouse-insert-heading ()
234 "Insert a new heading, as `org-insert-heading'.
235
236If the point is at the :beginning (`org-mouse-line-position') of the line,
237insert the new heading before the current line. Otherwise, insert it
238after the current heading."
239 (interactive)
240 (case (org-mouse-line-position)
241 (:beginning (beginning-of-line)
242 (org-insert-heading))
243 (t (org-mouse-next-heading)
244 (org-insert-heading))))
245
246(defun org-mouse-timestamp-today (&optional shift units)
247 "Change the timestamp into SHIFT UNITS in the future.
248
249For the acceptable UNITS, see `org-timestamp-change'."
250 (interactive)
251 (flet ((org-read-date (&rest rest) (current-time)))
252 (org-time-stamp nil))
253 (when shift
254 (org-timestamp-change shift units)))
255
256(defun org-mouse-keyword-menu (keywords function &optional selected itemformat)
257 "A helper function.
258
259Returns a menu fragment consisting of KEYWORDS. When a keyword
260is selected by the user, FUNCTION is called with the selected
261keyword as the only argument.
262
263If SELECTED is nil, then all items are normal menu items. If
264SELECTED is a function, then each item is a checkbox, which is
265enabled for a given keyword iff (funcall SELECTED keyword) return
266non-nil. If SELECTED is neither nil nor a function, then the
267items are radio buttons. A radio button is enabled for the
268keyword `equal' to SELECTED.
269
270ITEMFORMAT governs formatting of the elements of KEYWORDS. If it
271is a function, it is invoked with the keyword as the only
272argument. If it is a string, it is interpreted as the format
273string to (format ITEMFORMAT keyword). If it is neither a string
274nor a function, elements of KEYWORDS are used directly. "
275 (mapcar
276 `(lambda (keyword)
277 (vector (cond
278 ((functionp ,itemformat) (funcall ,itemformat keyword))
279 ((stringp ,itemformat) (format ,itemformat keyword))
280 (t keyword))
281 (list 'funcall ,function keyword)
282 :style (cond
283 ((null ,selected) t)
284 ((functionp ,selected) 'toggle)
285 (t 'radio))
286 :selected (if (functionp ,selected)
287 (and (funcall ,selected keyword) t)
288 (equal ,selected keyword))))
289 keywords))
290
291(defun org-mouse-remove-match-and-spaces ()
292 "Remove the match, make just one space around the point."
293 (interactive)
294 (replace-match "")
295 (just-one-space))
296
297(defvar rest)
298(defun org-mouse-replace-match-and-surround (newtext &optional fixedcase
299 literal string subexp)
300 "The same as `replace-match', but surrounds the replacement with spaces."
301 (apply 'replace-match rest)
302 (save-excursion
303 (goto-char (match-beginning (or subexp 0)))
304 (just-one-space)
305 (goto-char (match-end (or subexp 0)))
306 (just-one-space)))
307
308
309(defun org-mouse-keyword-replace-menu (keywords &optional group itemformat
310 nosurround)
311 "A helper function.
312
313Returns a menu fragment consisting of KEYWORDS. When a keyword
314is selected, group GROUP of the current match is replaced by the
315keyword. The method ensures that both ends of the replacement
316are separated from the rest of the text in the buffer by
317individual spaces (unless NOSURROND is non-nil).
318
319The final entry of the menu is always \"None\", which removes the
320match.
321
322ITEMFORMAT governs formatting of the elements of KEYWORDS. If it
323is a function, it is invoked with the keyword as the only
324argument. If it is a string, it is interpreted as the format
325string to (format ITEMFORMAT keyword). If it is neither a string
326nor a function, elements of KEYWORDS are used directly.
327"
328 (setq group (or group 0))
329 (let ((replace (org-mouse-match-closure
330 (if nosurround 'replace-match
331 'org-mouse-replace-match-and-surround))))
332 (append
333 (org-mouse-keyword-menu
334 keywords
335 `(lambda (keyword) (funcall ,replace keyword t t nil ,group))
336 (match-string group)
337 itemformat)
338 `(["None" org-mouse-remove-match-and-spaces
339 :style radio
340 :selected ,(not (member (match-string group) keywords))]))))
341
342(defun org-mouse-show-headlines ()
343 "Change the visibility of the current org buffer to only show headlines."
344 (interactive)
345 (let ((this-command 'org-cycle)
346 (last-command 'org-cycle)
347 (org-cycle-global-status nil))
348 (org-cycle '(4))
349 (org-cycle '(4))))
350
351(defun org-mouse-show-overview ()
352 "Change visibility of current org buffer to first-level headlines only."
353 (interactive)
354 (let ((org-cycle-global-status nil))
355 (org-cycle '(4))))
356
357(defun org-mouse-set-priority (priority)
358 "Set the priority of the current headline to PRIORITY."
359 (flet ((read-char-exclusive () priority))
360 (org-priority)))
361
362(defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]"
363 "Regular expression matching the priority indicator.
364Differs from `org-priority-regexp' in that it doesn't contain the
365leading '.*?'.")
366
367(defun org-mouse-get-priority (&optional default)
368 "Return the priority of the current headline.
369DEFAULT is returned if no priority is given in the headline."
370 (save-excursion
371 (if (org-mouse-re-search-line org-mouse-priority-regexp)
372 (match-string 1)
373 (when default (char-to-string org-default-priority)))))
374
375;; (defun org-mouse-at-link ()
376;; (and (eq (get-text-property (point) 'face) 'org-link)
377;; (save-excursion
378;; (goto-char (previous-single-property-change (point) 'face))
379;; (or (looking-at org-bracket-link-regexp)
380;; (looking-at org-angle-link-re)
381;; (looking-at org-plain-link-re)))))
382
383
384(defun org-mouse-delete-timestamp ()
385 "Deletes the current timestamp as well as the preceding keyword.
386SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
387 (when (or (org-at-date-range-p) (org-at-timestamp-p))
388 (replace-match "") ; delete the timestamp
389 (skip-chars-backward " :A-Z")
390 (when (looking-at " *[A-Z][A-Z]+:")
391 (replace-match ""))))
392
393(defun org-mouse-looking-at (regexp skipchars &optional movechars)
394 (save-excursion
395 (let ((point (point)))
396 (if (looking-at regexp) t
397 (skip-chars-backward skipchars)
398 (forward-char (or movechars 0))
399 (when (looking-at regexp)
400 (> (match-end 0) point))))))
401
402(defun org-mouse-priority-list ()
403 (loop for priority from ?A to org-lowest-priority
404 collect (char-to-string priority)))
405
406(defun org-mouse-tag-menu () ;todo
407 (append
408 (let ((tags (org-split-string (org-get-tags) ":")))
409 (org-mouse-keyword-menu
410 (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
411 `(lambda (tag)
412 (org-mouse-set-tags
413 (sort (if (member tag (quote ,tags))
414 (delete tag (quote ,tags))
415 (cons tag (quote ,tags)))
416 'string-lessp)))
417 `(lambda (tag) (member tag (quote ,tags)))
418 ))
419 '("--"
420 ["Align Tags Here" (org-set-tags nil t) t]
421 ["Align Tags in Buffer" (org-set-tags t t) t]
422 ["Set Tags ..." (org-set-tags) t])))
423
424
425
426(defun org-mouse-set-tags (tags)
427 (save-excursion
428 ;; remove existing tags first
429 (beginning-of-line)
430 (when (org-mouse-re-search-line ":\\(\\([A-Za-z_]+:\\)+\\)")
431 (replace-match ""))
432
433 ;; set new tags if any
434 (when tags
435 (end-of-line)
436 (insert " :" (mapconcat 'identity tags ":") ":")
437 (org-set-tags nil t))))
438
439(defun org-mouse-insert-checkbox ()
440 (interactive)
441 (and (org-at-item-p)
442 (goto-char (match-end 0))
443 (unless (org-at-item-checkbox-p)
444 (delete-horizontal-space)
445 (insert " [ ] "))))
446
447(defun org-mouse-agenda-type (type)
448 (case type
449 ('tags "Tags: ")
450 ('todo "TODO: ")
451 ('tags-tree "Tags tree: ")
452 ('todo-tree "TODO tree: ")
453 ('occur-tree "Occur tree: ")
454 (t "Agenda command ???")))
455
456
457(defun org-mouse-list-options-menu (alloptions &optional function)
458 (let ((options (save-match-data
459 (split-string (match-string-no-properties 1)))))
460 (print options)
461 (loop for name in alloptions
462 collect
463 (vector name
464 `(progn
465 (replace-match
466 (mapconcat 'identity
467 (sort (if (member ',name ',options)
468 (delete ',name ',options)
469 (cons ',name ',options))
470 'string-lessp)
471 " ")
472 nil nil nil 1)
473 (when (functionp ',function) (funcall ',function)))
474 :style 'toggle
475 :selected (and (member name options) t)))))
476
477(defun org-mouse-clip-text (text maxlength)
478 (if (> (length text) maxlength)
479 (concat (substring text 0 (- maxlength 3)) "...")
480 text))
481
482(defun org-mouse-popup-global-menu ()
483 (popup-menu
484 `("Main Menu"
485 ["Show Overview" org-mouse-show-overview t]
486 ["Show Headlines" org-mouse-show-headlines t]
487 ["Show All" show-all t]
488 ["Remove Highlights" org-remove-occur-highlights
489 :visible org-occur-highlights]
490 "--"
491 ["Check Deadlines"
492 (if (functionp 'org-check-deadlines-and-todos)
493 (org-check-deadlines-and-todos org-deadline-warning-days)
494 (org-check-deadlines org-deadline-warning-days)) t]
495 ["Check TODOs" org-show-todo-tree t]
496 ("Check Tags"
497 ,@(org-mouse-keyword-menu
498 (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
499 '(lambda (tag) (org-tags-sparse-tree nil tag)))
500 "--"
501 ["Custom Tag ..." org-tags-sparse-tree t])
502 ["Check Phrase ..." org-occur]
503 "--"
504 ["Display Agenda" org-agenda-list t]
505 ["Display Timeline" org-timeline t]
506 ["Display TODO List" org-todo-list t]
507 ("Display Tags"
508 ,@(org-mouse-keyword-menu
509 (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
510 '(lambda (tag) (org-tags-view nil tag)))
511 "--"
512 ["Custom Tag ..." org-tags-view t])
513 ["Display Calendar" org-goto-calendar t]
514 "--"
515 ,@(org-mouse-keyword-menu
516 (mapcar 'car org-agenda-custom-commands)
517 '(lambda (key)
518 (eval `(flet ((read-char-exclusive () (string-to-char ,key)))
519 (org-agenda nil))))
520 nil
521 '(lambda (key)
522 (let ((entry (assoc key org-agenda-custom-commands)))
523 (org-mouse-clip-text
524 (cond
525 ((stringp (nth 1 entry)) (nth 1 entry))
526 ((stringp (nth 2 entry))
527 (concat (org-mouse-agenda-type (nth 1 entry))
528 (nth 2 entry)))
529 (t "Agenda Command '%s'"))
530 30))))
531 "--"
532 ["Delete Blank Lines" delete-blank-lines
533 :visible (org-mouse-empty-line)]
534 ["Insert Checkbox" org-mouse-insert-checkbox
535 :visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))]
536 ["Insert Checkboxes"
537 (org-mouse-for-each-item 'org-mouse-insert-checkbox)
538 :visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))]
539 ["Plain List to Outline" org-mouse-transform-to-outline
540 :visible (org-at-item-p)])))
541
542
543(defun org-mouse-get-context (contextlist context)
544 (let ((contextdata (assq context contextlist)))
545 (when contextdata
546 (save-excursion
547 (goto-char (second contextdata))
548 (re-search-forward ".*" (third contextdata))))))
549
550(defun org-mouse-for-each-item (function)
551 (save-excursion
552 (ignore-errors
553 (while t (org-previous-item)))
554 (ignore-errors
555 (while t
556 (funcall function)
557 (org-next-item)))))
558
559(defun org-mouse-bolp ()
560 "Returns true if there only spaces, tabs, and '*', between the beginning of line and the point"
561 (save-excursion
562 (skip-chars-backward " \t*") (bolp)))
563
564(defun org-mouse-insert-item (text)
565 (case (org-mouse-line-position)
566 (:beginning ; insert before
567 (beginning-of-line)
568 (looking-at "[ \t]*")
569 (open-line 1)
570 (indent-to (- (match-end 0) (match-beginning 0)))
571 (insert "+ "))
572
573 (:middle ; insert after
574 (end-of-line)
575 (newline t)
576 (indent-relative)
577 (insert "+ "))
578
579 (:end ; insert text here
580 (skip-chars-backward " \t")
581 (kill-region (point) (point-at-eol))
582 (unless (looking-back org-mouse-punctuation)
583 (insert (concat org-mouse-punctuation " ")))))
584
585 (insert text)
586 (beginning-of-line))
587
588(defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate)
589 (if (eq major-mode 'org-mode)
590 (org-mouse-insert-item text)
591 ad-do-it))
592
593(defadvice dnd-open-file (around org-mouse-dnd-open-file activate)
594 (if (eq major-mode 'org-mode)
595 (org-mouse-insert-item uri)
596 ad-do-it))
597
598(defun org-mouse-match-closure (function)
599 (let ((match (match-data t)))
600 `(lambda (&rest rest)
601 (save-match-data
602 (set-match-data ',match)
603 (apply ',function rest)))))
604
605(defun org-mouse-todo-keywords ()
606 (if (boundp 'org-todo-keywords-1) org-todo-keywords-1 org-todo-keywords))
607
608(defun org-mouse-match-todo-keyword ()
609 (save-excursion
610 (org-back-to-heading)
611 (if (looking-at outline-regexp) (goto-char (match-end 0)))
612 (or (looking-at (concat " +" org-todo-regexp " *"))
613 (looking-at " \\( *\\)"))))
614
615(defun org-mouse-yank-link (click)
616 (interactive "e")
617 ;; Give temporary modes such as isearch a chance to turn off.
618 (run-hooks 'mouse-leave-buffer-hook)
619 (mouse-set-point click)
620 (setq mouse-selection-click-count 0)
621 (delete-horizontal-space)
622 (insert-for-yank (concat " [[" (current-kill 0) "]] ")))
623
624(defun org-mouse-context-menu (&optional event)
625 (let ((stamp-prefixes (list org-deadline-string org-scheduled-string))
626 (contextlist (org-context)))
627 (flet ((get-context (context) (org-mouse-get-context contextlist context)))
628 (cond
629 ((org-mouse-mark-active)
630 (let ((region-string (buffer-substring (region-beginning) (region-end))))
631 (popup-menu
632 `(nil
633 ["Sparse Tree" (org-occur ',region-string)]
634 ["Find in Buffer" (occur ',region-string)]
635 ["Grep in Current Dir"
636 (grep (format "grep -rnH -e '%s' *" ',region-string))]
637 ["Grep in Parent Dir"
638 (grep (format "grep -rnH -e '%s' ../*" ',region-string))]
639 "--"
640 ["Convert to Link"
641 (progn (save-excursion (goto-char (region-beginning)) (insert "[["))
642 (save-excursion (goto-char (region-end)) (insert "]]")))]
643 ["Insert Link Here" (org-mouse-yank-link ',event)]))))
644
645 ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)"))
646 (popup-menu
647 `(nil
648 ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options)
649 'org-mode-restart))))
650 ((or (eolp)
651 (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
652 (looking-back " \\|\t")))
653 (org-mouse-popup-global-menu))
654 ((get-context :checkbox)
655 (popup-menu
656 '(nil
657 ["Toggle" org-toggle-checkbox t]
658 ["Remove" org-mouse-remove-match-and-spaces t]
659 ""
660 ["All Clear" (org-mouse-for-each-item
661 (lambda ()
662 (when (save-excursion (org-at-item-checkbox-p))
663 (replace-match "[ ]"))))]
664 ["All Set" (org-mouse-for-each-item
665 (lambda ()
666 (when (save-excursion (org-at-item-checkbox-p))
667 (replace-match "[X]"))))]
668 ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t]
669 ["All Remove" (org-mouse-for-each-item
670 (lambda ()
671 (when (save-excursion (org-at-item-checkbox-p))
672 (org-mouse-remove-match-and-spaces))))]
673 )))
674 ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_")
675 (member (match-string 0) (org-mouse-todo-keywords)))
676 (popup-menu
677 `(nil
678 ,@(org-mouse-keyword-replace-menu (org-mouse-todo-keywords))
679 "--"
680 ["Check TODOs" org-show-todo-tree t]
681 ["List all TODO keywords" org-todo-list t]
682 [,(format "List only %s" (match-string 0))
683 (org-todo-list (match-string 0)) t]
684 )))
685 ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z")
686 (member (match-string 0) stamp-prefixes))
687 (popup-menu
688 `(nil
689 ,@(org-mouse-keyword-replace-menu stamp-prefixes)
690 "--"
691 ["Check Deadlines" org-check-deadlines t]
692 )))
693 ((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority
694 (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
695 (org-mouse-priority-list) 1 "Priority %s" t))))
696 ((get-context :link)
697 (popup-menu
698 '(nil
699 ["Open" org-open-at-point t]
700 ["Open in Emacs" (org-open-at-point t) t]
701 "--"
702 ["Copy link" (kill-new (match-string 0))]
703 ["Cut link"
704 (progn
705 (kill-region (match-beginning 0) (match-end 0))
706 (just-one-space))]
707 "--"
708 ["Grep for TODOs"
709 (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))]
710; ["Paste file link" ((insert "file:") (yank))]
711 )))
712 ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags
713 (popup-menu
714 `(nil
715 [,(format "Display '%s'" (match-string 1))
716 (org-tags-view nil ,(match-string 1))]
717 [,(format "Sparse Tree '%s'" (match-string 1))
718 (org-tags-sparse-tree nil ,(match-string 1))]
719 "--"
720 ,@(org-mouse-tag-menu))))
721 ((org-at-timestamp-p)
722 (popup-menu
723 '(nil
724 ["Show Day" org-open-at-point t]
725 ["Change Timestamp" org-time-stamp t]
726 ["Delete Timestamp" (org-mouse-delete-timestamp) t]
727 ["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)]
728 "--"
729 ["Set for Today" org-mouse-timestamp-today]
730 ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)]
731 ["Set in 1 Week" (org-mouse-timestamp-today 7 'day)]
732 ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)]
733 ["Set in a Month" (org-mouse-timestamp-today 1 'month)]
734 "--"
735 ["+ 1 Day" (org-timestamp-change 1 'day)]
736 ["+ 1 Week" (org-timestamp-change 7 'day)]
737 ["+ 1 Month" (org-timestamp-change 1 'month)]
738 "--"
739 ["- 1 Day" (org-timestamp-change -1 'day)]
740 ["- 1 Week" (org-timestamp-change -7 'day)]
741 ["- 1 Month" (org-timestamp-change -1 'month)])))
742 ((get-context :table-special)
743 (let ((mdata (match-data)))
744 (incf (car mdata) 2)
745 (store-match-data mdata))
746 (message "match: %S" (match-string 0))
747 (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
748 '(" " "!" "^" "_" "$" "#" "*" "'") 0
749 (lambda (mark)
750 (case (string-to-char mark)
751 (? "( ) Nothing Special")
752 (?! "(!) Column Names")
753 (?^ "(^) Field Names Above")
754 (?_ "(^) Field Names Below")
755 (?$ "($) Formula Parameters")
756 (?# "(#) Recalculation: Auto")
757 (?* "(*) Recalculation: Manual")
758 (?' "(') Recalculation: None"))) t))))
759 ((assq :table contextlist)
760 (popup-menu
761 '(nil
762 ["Align Table" org-ctrl-c-ctrl-c]
763 ["Blank Field" org-table-blank-field]
764 ["Edit Field" org-table-edit-field]
765 "--"
766 ("Column"
767 ["Move Column Left" org-metaleft]
768 ["Move Column Right" org-metaright]
769 ["Delete Column" org-shiftmetaleft]
770 ["Insert Column" org-shiftmetaright]
771 "--"
772 ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle])
773 ("Row"
774 ["Move Row Up" org-metaup]
775 ["Move Row Down" org-metadown]
776 ["Delete Row" org-shiftmetaup]
777 ["Insert Row" org-shiftmetadown]
778 ["Sort lines in region" org-table-sort-lines (org-at-table-p)]
779 "--"
780 ["Insert Hline" org-table-insert-hline])
781 ("Rectangle"
782 ["Copy Rectangle" org-copy-special]
783 ["Cut Rectangle" org-cut-special]
784 ["Paste Rectangle" org-paste-special]
785 ["Fill Rectangle" org-table-wrap-region])
786 "--"
787 ["Set Column Formula" org-table-eval-formula]
788 ["Set Field Formula" (org-table-eval-formula '(4))]
789 ["Edit Formulas" org-table-edit-formulas]
790 "--"
791 ["Recalculate Line" org-table-recalculate]
792 ["Recalculate All" (org-table-recalculate '(4))]
793 ["Iterate All" (org-table-recalculate '(16))]
794 "--"
795 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks]
796 ["Sum Column/Rectangle" org-table-sum
797 :active (or (org-at-table-p) (org-region-active-p))]
798 ["Field Info" org-table-field-info]
799 ["Debug Formulas"
800 (setq org-table-formula-debug (not org-table-formula-debug))
801 :style toggle :selected org-table-formula-debug]
802 )))
803 ((and (assq :headline contextlist) (not (eolp)))
804 (let ((priority (org-mouse-get-priority t)))
805 (popup-menu
806 `("Headline Menu"
807 ("Tags and Priorities"
808 ,@(org-mouse-keyword-menu
809 (org-mouse-priority-list)
810 '(lambda (keyword)
811 (org-mouse-set-priority (string-to-char keyword)))
812 priority "Priority %s")
813 "--"
814 ,@(org-mouse-tag-menu))
815 ("TODO Status"
816 ,@(progn (org-mouse-match-todo-keyword)
817 (org-mouse-keyword-replace-menu (org-mouse-todo-keywords)
818 1)))
819 ["Show Tags"
820 (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags))
821 :visible (not org-mouse-direct)]
822 ["Show Priority"
823 (with-current-buffer org-mouse-main-buffer (org-agenda-show-priority))
824 :visible (not org-mouse-direct)]
825 ,@(if org-mouse-direct '("--") nil)
826 ["New Heading" org-mouse-insert-heading :visible org-mouse-direct]
827 ["Set Deadline"
828 (progn (org-mouse-end-headline) (insert " ") (org-deadline))
829 :active (not (save-excursion
830 (org-mouse-re-search-line org-deadline-regexp)))]
831 ["Schedule Task"
832 (progn (org-mouse-end-headline) (insert " ") (org-schedule))
833 :active (not (save-excursion
834 (org-mouse-re-search-line org-scheduled-regexp)))]
835 ["Insert Timestamp"
836 (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t]
837; ["Timestamp (inactive)" org-time-stamp-inactive t]
838 "--"
839 ["Archive Subtree" org-archive-subtree]
840 ["Cut Subtree" org-cut-special]
841 ["Copy Subtree" org-copy-special]
842 ["Paste Subtree" org-paste-special :visible org-mouse-direct]
843 ("Sort Children"
844 ["Alphabetically" (org-sort-entries nil ?a)]
845 ["Numerically" (org-sort-entries nil ?n)]
846 ["By Time/Date" (org-sort-entries nil ?t)]
847 "--"
848 ["Reverse Alphabetically" (org-sort-entries nil ?A)]
849 ["Reverse Numerically" (org-sort-entries nil ?N)]
850 ["Reverse By Time/Date" (org-sort-entries nil ?T)])
851 "--"
852 ["Move Trees" org-mouse-move-tree :active nil]
853 ))))
854 (t
855 (org-mouse-popup-global-menu))))))
856
857;; (defun org-mouse-at-regexp (regexp)
858;; (save-excursion
859;; (let ((point (point))
860;; (bol (progn (beginning-of-line) (point)))
861;; (eol (progn (end-of-line) (point))))
862;; (goto-char point)
863;; (re-search-backward regexp bol 1)
864;; (and (not (eolp))
865;; (progn (forward-char)
866;; (re-search-forward regexp eol t))
867;; (<= (match-beginning 0) point)))))
868
869(defun org-mouse-mark-active ()
870 (and mark-active transient-mark-mode))
871
872(defun org-mouse-in-region-p (pos)
873 (and (org-mouse-mark-active)
874 (>= pos (region-beginning))
875 (< pos (region-end))))
876
877(defun org-mouse-down-mouse (event)
878 (interactive "e")
879 (setq this-command last-command)
880 (unless (and (= 1 (event-click-count event))
881 (org-mouse-in-region-p (posn-point (event-start event))))
882 (mouse-drag-region event)))
883
884(add-hook 'org-mode-hook
885 '(lambda ()
886 (setq org-mouse-context-menu-function 'org-mouse-context-menu)
887
888; (define-key org-mouse-map [follow-link] 'mouse-face)
889 (define-key org-mouse-map (if (featurep 'xemacs) [button3] [mouse-3]) nil)
890 (define-key org-mode-map [mouse-3] 'org-mouse-show-context-menu)
891 (define-key org-mode-map [down-mouse-1] 'org-mouse-down-mouse)
892 (define-key org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree)
893 (define-key org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start)
894 (define-key org-mode-map [S-mouse-2] 'org-mouse-yank-link)
895 (define-key org-mode-map [drag-mouse-3] 'org-mouse-yank-link)
896 (define-key org-mouse-map [drag-mouse-3] 'org-mouse-move-tree)
897 (define-key org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start)
898
899 (font-lock-add-keywords nil
900 `((,outline-regexp
901 0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
902 'prepend)
903 ("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +"
904 (1 `(face org-link keymap ,org-mouse-map mouse-face highlight) 'prepend))
905 ("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)"
906 (2 `(face bold keymap ,org-mouse-map mouse-face highlight) t)))
907 t)
908
909 (defadvice org-open-at-point (around org-mouse-open-at-point activate)
910 (let ((context (org-context)))
911 (cond
912 ((assq :headline-stars context) (org-cycle))
913 ((assq :checkbox context) (org-toggle-checkbox))
914 ((assq :item-bullet context)
915 (let ((org-cycle-include-plain-lists t)) (org-cycle)))
916 (t ad-do-it))))))
917
918(defun org-mouse-move-tree-start (event)
919 (interactive "e")
920 (message "Same line: promote/demote, (***):move before, (text): make a child"))
921
922
923(defun org-mouse-make-marker (position)
924 (with-current-buffer (window-buffer (posn-window position))
925 (copy-marker (posn-point position))))
926
927(defun org-mouse-move-tree (event)
928 ;; todo: handle movements between different buffers
929 (interactive "e")
930 (save-excursion
931 (let* ((start (org-mouse-make-marker (event-start event)))
932 (end (org-mouse-make-marker (event-end event)))
933 (sbuf (marker-buffer start))
934 (ebuf (marker-buffer end)))
935
936 (when (and sbuf ebuf)
937 (set-buffer sbuf)
938 (goto-char start)
939 (org-back-to-heading)
940 (if (and (eq sbuf ebuf)
941 (equal
942 (point)
943 (save-excursion (goto-char end) (org-back-to-heading) (point))))
944 ;; if the same line then promote/demote
945 (if (>= end start) (org-demote-subtree) (org-promote-subtree))
946 ;; if different lines then move
947 (org-cut-subtree)
948
949 (set-buffer ebuf)
950 (goto-char end)
951 (org-back-to-heading)
952 (when (and (eq sbuf ebuf)
953 (equal
954 (point)
955 (save-excursion (goto-char start)
956 (org-back-to-heading) (point))))
957 (outline-end-of-subtree)
958 (end-of-line)
959 (if (eobp) (newline) (forward-char)))
960
961 (when (looking-at outline-regexp)
962 (let ((level (- (match-end 0) (match-beginning 0))))
963 (when (> end (match-end 0))
964 (outline-end-of-subtree)
965 (end-of-line)
966 (if (eobp) (newline) (forward-char))
967 (setq level (1+ level)))
968 (org-paste-subtree level)
969 (save-excursion
970 (outline-end-of-subtree)
971 (when (bolp) (delete-char -1))))))))))
972
973
974(defun org-mouse-transform-to-outline ()
975 (interactive)
976 (org-back-to-heading)
977 (let ((minlevel 1000)
978 (replace-text (concat (match-string 0) "* ")))
979 (beginning-of-line 2)
980 (save-excursion
981 (while (not (or (eobp) (looking-at outline-regexp)))
982 (when (looking-at org-mouse-plain-list-regexp)
983 (setq minlevel (min minlevel (- (match-end 1) (match-beginning 1)))))
984 (forward-line)))
985 (while (not (or (eobp) (looking-at outline-regexp)))
986 (when (and (looking-at org-mouse-plain-list-regexp)
987 (eq minlevel (- (match-end 1) (match-beginning 1))))
988 (replace-match replace-text))
989 (forward-line))))
990
991(defvar _cmd) ;dynamically scoped from `org-with-remote-undo'.
992
993(defun org-mouse-do-remotely (command)
994; (org-agenda-check-no-diary)
995 (when (get-text-property (point) 'org-marker)
996 (let* ((anticol (- (point-at-eol) (point)))
997 (marker (get-text-property (point) 'org-marker))
998 (buffer (marker-buffer marker))
999 (pos (marker-position marker))
1000 (hdmarker (get-text-property (point) 'org-hd-marker))
1001 (buffer-read-only nil)
1002 (newhead "--- removed ---")
1003 (org-mouse-direct nil)
1004 (org-mouse-main-buffer (current-buffer)))
1005 (when (eq (with-current-buffer buffer major-mode) 'org-mode)
1006 (let ((endmarker (save-excursion
1007 (set-buffer buffer)
1008 (outline-end-of-subtree)
1009 (forward-char 1)
1010 (copy-marker (point)))))
1011 (org-with-remote-undo buffer
1012 (with-current-buffer buffer
1013 (widen)
1014 (goto-char pos)
1015 (org-show-hidden-entry)
1016 (save-excursion
1017 (and (outline-next-heading)
1018 (org-flag-heading nil))) ; show the next heading
1019 (org-back-to-heading)
1020 (setq marker (copy-marker (point)))
1021 (goto-char (max (point-at-bol) (- (point-at-eol) anticol)))
1022 (funcall command)
1023 (message "_cmd: %S" _cmd)
1024 (message "this-command: %S" this-command)
1025 (unless (eq (marker-position marker) (marker-position endmarker))
1026 (setq newhead (org-get-heading))))
1027
1028 (beginning-of-line 1)
1029 (save-excursion
1030 (org-agenda-change-all-lines newhead hdmarker 'fixface))))
1031 t))))
1032
1033(defun org-mouse-agenda-context-menu (&optional event)
1034 (or (org-mouse-do-remotely 'org-mouse-context-menu)
1035 (popup-menu
1036 '("Agenda"
1037 ("Agenda Files")
1038 "--"
1039 ["Undo" (progn (message "last command: %S" last-command) (setq this-command 'org-agenda-undo) (org-agenda-undo))
1040 :visible (if (eq last-command 'org-agenda-undo)
1041 org-agenda-pending-undo-list
1042 org-agenda-undo-list)]
1043 ["Rebuild Buffer" org-agenda-redo t]
1044 ["New Diary Entry"
1045 org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline) t]
1046 "--"
1047 ["Goto Today" org-agenda-goto-today
1048 (org-agenda-check-type nil 'agenda 'timeline) t]
1049 ["Display Calendar" org-agenda-goto-calendar
1050 (org-agenda-check-type nil 'agenda 'timeline) t]
1051 ("Calendar Commands"
1052 ["Phases of the Moon" org-agenda-phases-of-moon
1053 (org-agenda-check-type nil 'agenda 'timeline)]
1054 ["Sunrise/Sunset" org-agenda-sunrise-sunset
1055 (org-agenda-check-type nil 'agenda 'timeline)]
1056 ["Holidays" org-agenda-holidays
1057 (org-agenda-check-type nil 'agenda 'timeline)]
1058 ["Convert" org-agenda-convert-date
1059 (org-agenda-check-type nil 'agenda 'timeline)]
1060 "--"
1061 ["Create iCalendar file" org-export-icalendar-combine-agenda-files t])
1062 "--"
1063 ["Day View" org-agenda-day-view
1064 :active (org-agenda-check-type nil 'agenda)
1065 :style radio :selected (equal org-agenda-ndays 1)]
1066 ["Week View" org-agenda-week-view
1067 :active (org-agenda-check-type nil 'agenda)
1068 :style radio :selected (equal org-agenda-ndays 7)]
1069 "--"
1070 ["Show Logbook entries" org-agenda-log-mode
1071 :style toggle :selected org-agenda-show-log
1072 :active (org-agenda-check-type nil 'agenda 'timeline)]
1073 ["Include Diary" org-agenda-toggle-diary
1074 :style toggle :selected org-agenda-include-diary
1075 :active (org-agenda-check-type nil 'agenda)]
1076 ["Use Time Grid" org-agenda-toggle-time-grid
1077 :style toggle :selected org-agenda-use-time-grid
1078 :active (org-agenda-check-type nil 'agenda)]
1079 ["Follow Mode" org-agenda-follow-mode
1080 :style toggle :selected org-agenda-follow-mode]
1081 "--"
1082 ["Quit" org-agenda-quit t]
1083 ["Exit and Release Buffers" org-agenda-exit t]
1084 ))))
1085
1086(defun org-mouse-get-gesture (event)
1087 (let ((startxy (posn-x-y (event-start event)))
1088 (endxy (posn-x-y (event-end event))))
1089 (if (< (car startxy) (car endxy)) :right :left)))
1090
1091
1092; (setq org-agenda-mode-hook nil)
1093(add-hook 'org-agenda-mode-hook
1094 '(lambda ()
1095 (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
1096 (define-key org-agenda-keymap
1097 (if (featurep 'xemacs) [button3] [mouse-3])
1098 'org-mouse-show-context-menu)
1099 (define-key org-agenda-keymap [down-mouse-3] 'org-mouse-move-tree-start)
1100 (define-key org-agenda-keymap [C-mouse-4] 'org-agenda-earlier)
1101 (define-key org-agenda-keymap [C-mouse-5] 'org-agenda-later)
1102 (define-key org-agenda-keymap [drag-mouse-3]
1103 '(lambda (event) (interactive "e")
1104 (case (org-mouse-get-gesture event)
1105 (:left (org-agenda-earlier 1))
1106 (:right (org-agenda-later 1)))))))
1107
1108(provide 'org-mouse)
1109
1110;; arch-tag: ff1ae557-3529-41a3-95c6-baaebdcc280f
diff --git a/lisp/textmodes/org-publish.el b/lisp/textmodes/org-publish.el
index 807a844c425..0a8e9019827 100644
--- a/lisp/textmodes/org-publish.el
+++ b/lisp/textmodes/org-publish.el
@@ -1,28 +1,28 @@
1;;; org-publish.el --- publish related org-mode files as a website 1;;; org-publish.el --- publish related org-mode files as a website
2 2
3;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: David O'Toole <dto@gnu.org> 5;; Author: David O'Toole <dto@gnu.org>
6;; Keywords: hypermedia, outlines 6;; Keywords: hypermedia, outlines
7;; Version: 1.80a 7;; Version: 1.80b
8 8
9;; This file is free software; you can redistribute it and/or modify 9;; This file is part of GNU Emacs.
10;;
11;; GNU Emacs is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by 12;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation; either version 3, or (at your option) 13;; the Free Software Foundation; either version 3, or (at your option)
12;; any later version. 14;; any later version.
13 15
14;; This file is distributed in the hope that it will be useful, 16;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details. 19;; GNU General Public License for more details.
18 20
19;; You should have received a copy of the GNU General Public License 21;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs; see the file COPYING. If not, write to 22;; along with GNU Emacs; see the file COPYING. If not, write to the
21;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22;; Boston, MA 02110-1301, USA. 24;; Boston, MA 02110-1301, USA.
23 25
24;; This file is part of GNU Emacs.
25
26;;; Commentary: 26;;; Commentary:
27 27
28;; Requires at least version 4.27 of org.el 28;; Requires at least version 4.27 of org.el
@@ -572,11 +572,10 @@ default is 'index.org'."
572With prefix argument, force publishing all files in project." 572With prefix argument, force publishing all files in project."
573 (interactive "P") 573 (interactive "P")
574 (save-window-excursion 574 (save-window-excursion
575 (let* ((project-name (org-publish-get-project-from-filename (buffer-file-name))) 575 (let* ((project-name (org-publish-get-project-from-filename (buffer-file-name))))
576 (org-publish-use-timestamps-flag (if force nil t)))
577 (if (not project-name) 576 (if (not project-name)
578 (error "File %s is not part of any known project." (buffer-file-name))) 577 (error "File %s is not part of any known project." (buffer-file-name)))
579 (org-publish project-name)))) 578 (org-publish project-name (if force nil t)))))
580 579
581 580
582;;;###autoload 581;;;###autoload
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el
index 15ad87f4f23..bc63a962b9c 100644
--- a/lisp/textmodes/org.el
+++ b/lisp/textmodes/org.el
@@ -5,7 +5,7 @@
5;; Author: Carsten Dominik <carsten at orgmode dot org> 5;; Author: Carsten Dominik <carsten at orgmode dot org>
6;; Keywords: outlines, hypermedia, calendar, wp 6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org 7;; Homepage: http://orgmode.org
8;; Version: 5.13i 8;; Version: 5.19a
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -77,13 +77,14 @@
77(require 'outline) (require 'noutline) 77(require 'outline) (require 'noutline)
78;; Other stuff we need. 78;; Other stuff we need.
79(require 'time-date) 79(require 'time-date)
80(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time))
80(require 'easymenu) 81(require 'easymenu)
81 82
82;;;; Customization variables 83;;;; Customization variables
83 84
84;;; Version 85;;; Version
85 86
86(defconst org-version "5.13i" 87(defconst org-version "5.19a"
87 "The version number of the file org.el.") 88 "The version number of the file org.el.")
88(defun org-version () 89(defun org-version ()
89 (interactive) 90 (interactive)
@@ -97,8 +98,12 @@
97 (get-text-property 0 'test (format "%s" x))) 98 (get-text-property 0 'test (format "%s" x)))
98 "Does format transport text properties?") 99 "Does format transport text properties?")
99 100
101(defmacro org-bound-and-true-p (var)
102 "Return the value of symbol VAR if it is bound, else nil."
103 `(and (boundp (quote ,var)) ,var))
104
100(defmacro org-unmodified (&rest body) 105(defmacro org-unmodified (&rest body)
101 "Execute body without changing buffer-modified-p." 106 "Execute body without changing `buffer-modified-p'."
102 `(set-buffer-modified-p 107 `(set-buffer-modified-p
103 (prog1 (buffer-modified-p) ,@body))) 108 (prog1 (buffer-modified-p) ,@body)))
104 109
@@ -251,7 +256,7 @@ Or return the original if not disputed."
251 "Define a key, possibly translated, as returned by `org-key'." 256 "Define a key, possibly translated, as returned by `org-key'."
252 (define-key keymap (org-key key) def)) 257 (define-key keymap (org-key key) def))
253 258
254(defcustom org-ellipsis 'org-ellipsis 259(defcustom org-ellipsis nil
255 "The ellipsis to use in the Org-mode outline. 260 "The ellipsis to use in the Org-mode outline.
256When nil, just use the standard three dots. When a string, use that instead, 261When nil, just use the standard three dots. When a string, use that instead,
257When a face, use the standart 3 dots, but with the specified face. 262When a face, use the standart 3 dots, but with the specified face.
@@ -332,6 +337,25 @@ After a match, group 1 contains the repeat expression.")
332 :tag "Org Reveal Location" 337 :tag "Org Reveal Location"
333 :group 'org-structure) 338 :group 'org-structure)
334 339
340(defconst org-context-choice
341 '(choice
342 (const :tag "Always" t)
343 (const :tag "Never" nil)
344 (repeat :greedy t :tag "Individual contexts"
345 (cons
346 (choice :tag "Context"
347 (const agenda)
348 (const org-goto)
349 (const occur-tree)
350 (const tags-tree)
351 (const link-search)
352 (const mark-goto)
353 (const bookmark-jump)
354 (const isearch)
355 (const default))
356 (boolean))))
357 "Contexts for the reveal options.")
358
335(defcustom org-show-hierarchy-above '((default . t)) 359(defcustom org-show-hierarchy-above '((default . t))
336 "Non-nil means, show full hierarchy when revealing a location. 360 "Non-nil means, show full hierarchy when revealing a location.
337Org-mode often shows locations in an org-mode file which might have 361Org-mode often shows locations in an org-mode file which might have
@@ -350,22 +374,7 @@ contexts. Valid contexts are
350 isearch when exiting from an incremental search 374 isearch when exiting from an incremental search
351 default default for all contexts not set explicitly" 375 default default for all contexts not set explicitly"
352 :group 'org-reveal-location 376 :group 'org-reveal-location
353 :type '(choice 377 :type org-context-choice)
354 (const :tag "Always" t)
355 (const :tag "Never" nil)
356 (repeat :greedy t :tag "Individual contexts"
357 (cons
358 (choice :tag "Context"
359 (const agenda)
360 (const org-goto)
361 (const occur-tree)
362 (const tags-tree)
363 (const link-search)
364 (const mark-goto)
365 (const bookmark-jump)
366 (const isearch)
367 (const default))
368 (boolean)))))
369 378
370(defcustom org-show-following-heading '((default . nil)) 379(defcustom org-show-following-heading '((default . nil))
371 "Non-nil means, show following heading when revealing a location. 380 "Non-nil means, show following heading when revealing a location.
@@ -378,22 +387,7 @@ use the command \\[org-reveal] to show more context.
378Instead of t, this can also be an alist specifying this option for different 387Instead of t, this can also be an alist specifying this option for different
379contexts. See `org-show-hierarchy-above' for valid contexts." 388contexts. See `org-show-hierarchy-above' for valid contexts."
380 :group 'org-reveal-location 389 :group 'org-reveal-location
381 :type '(choice 390 :type org-context-choice)
382 (const :tag "Always" t)
383 (const :tag "Never" nil)
384 (repeat :greedy t :tag "Individual contexts"
385 (cons
386 (choice :tag "Context"
387 (const agenda)
388 (const org-goto)
389 (const occur-tree)
390 (const tags-tree)
391 (const link-search)
392 (const mark-goto)
393 (const bookmark-jump)
394 (const isearch)
395 (const default))
396 (boolean)))))
397 391
398(defcustom org-show-siblings '((default . nil) (isearch t)) 392(defcustom org-show-siblings '((default . nil) (isearch t))
399 "Non-nil means, show all sibling heading when revealing a location. 393 "Non-nil means, show all sibling heading when revealing a location.
@@ -409,22 +403,19 @@ use the command \\[org-reveal] to show more context.
409Instead of t, this can also be an alist specifying this option for different 403Instead of t, this can also be an alist specifying this option for different
410contexts. See `org-show-hierarchy-above' for valid contexts." 404contexts. See `org-show-hierarchy-above' for valid contexts."
411 :group 'org-reveal-location 405 :group 'org-reveal-location
412 :type '(choice 406 :type org-context-choice)
413 (const :tag "Always" t) 407
414 (const :tag "Never" nil) 408(defcustom org-show-entry-below '((default . nil))
415 (repeat :greedy t :tag "Individual contexts" 409 "Non-nil means, show the entry below a headline when revealing a location.
416 (cons 410Org-mode often shows locations in an org-mode file which might have
417 (choice :tag "Context" 411been invisible before. When this is set, the text below the headline that is
418 (const agenda) 412exposed is also shown.
419 (const org-goto) 413
420 (const occur-tree) 414By default this is off for all contexts.
421 (const tags-tree) 415Instead of t, this can also be an alist specifying this option for different
422 (const link-search) 416contexts. See `org-show-hierarchy-above' for valid contexts."
423 (const mark-goto) 417 :group 'org-reveal-location
424 (const bookmark-jump) 418 :type org-context-choice)
425 (const isearch)
426 (const default))
427 (boolean)))))
428 419
429(defgroup org-cycle nil 420(defgroup org-cycle nil
430 "Options concerning visibility cycling in Org-mode." 421 "Options concerning visibility cycling in Org-mode."
@@ -463,7 +454,7 @@ of the buffer."
463 "Where should `org-cycle' emulate TAB. 454 "Where should `org-cycle' emulate TAB.
464nil Never 455nil Never
465white Only in completely white lines 456white Only in completely white lines
466whitestart Only at the beginning of lines, before the first non-white char. 457whitestart Only at the beginning of lines, before the first non-white char
467t Everywhere except in headlines 458t Everywhere except in headlines
468exc-hl-bol Everywhere except at the start of a headline 459exc-hl-bol Everywhere except at the start of a headline
469If TAB is used in a place where it does not emulate TAB, the current subtree 460If TAB is used in a place where it does not emulate TAB, the current subtree
@@ -568,7 +559,7 @@ and a boolean flag as cdr."
568(defcustom org-insert-heading-hook nil 559(defcustom org-insert-heading-hook nil
569 "Hook being run after inserting a new heading." 560 "Hook being run after inserting a new heading."
570 :group 'org-edit-structure 561 :group 'org-edit-structure
571 :type 'boolean) 562 :type 'hook)
572 563
573(defcustom org-enable-fixed-width-editor t 564(defcustom org-enable-fixed-width-editor t
574 "Non-nil means, lines starting with \":\" are treated as fixed-width. 565 "Non-nil means, lines starting with \":\" are treated as fixed-width.
@@ -658,7 +649,9 @@ with \\[org-ctrl-c-ctrl-c\\]."
658(defcustom org-archive-tag "ARCHIVE" 649(defcustom org-archive-tag "ARCHIVE"
659 "The tag that marks a subtree as archived. 650 "The tag that marks a subtree as archived.
660An archived subtree does not open during visibility cycling, and does 651An archived subtree does not open during visibility cycling, and does
661not contribute to the agenda listings." 652not contribute to the agenda listings.
653After changing this, font-lock must be restarted in the relevant buffers to
654get the proper fontification."
662 :group 'org-archive 655 :group 'org-archive
663 :group 'org-keywords 656 :group 'org-keywords
664 :type 'string) 657 :type 'string)
@@ -767,6 +760,17 @@ information."
767 (const :tag "Inherited tags" itags) 760 (const :tag "Inherited tags" itags)
768 (const :tag "Local tags" ltags))) 761 (const :tag "Local tags" ltags)))
769 762
763(defgroup org-imenu-and-speedbar nil
764 "Options concerning imenu and speedbar in Org-mode."
765 :tag "Org Imenu and Speedbar"
766 :group 'org-structure)
767
768(defcustom org-imenu-depth 2
769 "The maximum level for Imenu access to Org-mode headlines.
770This also applied for speedbar access."
771 :group 'org-imenu-and-speedbar
772 :type 'number)
773
770(defgroup org-table nil 774(defgroup org-table nil
771 "Options concerning tables in Org-mode." 775 "Options concerning tables in Org-mode."
772 :tag "Org Table" 776 :tag "Org Table"
@@ -892,7 +896,7 @@ alignment to the right border applies."
892 :type 'number) 896 :type 'number)
893 897
894(defgroup org-table-editing nil 898(defgroup org-table-editing nil
895 "Bahavior of tables during editing in Org-mode." 899 "Behavior of tables during editing in Org-mode."
896 :tag "Org Table Editing" 900 :tag "Org Table Editing"
897 :group 'org-table) 901 :group 'org-table)
898 902
@@ -1031,15 +1035,18 @@ links in Org-mode buffers can have an optional tag after a double colon, e.g.
1031 [[linkkey:tag][description]] 1035 [[linkkey:tag][description]]
1032 1036
1033If REPLACE is a string, the tag will simply be appended to create the link. 1037If REPLACE is a string, the tag will simply be appended to create the link.
1034If the string contains \"%s\", the tag will be inserted there. REPLACE may 1038If the string contains \"%s\", the tag will be inserted there.
1035also be a function that will be called with the tag as the only argument to 1039
1036create the link. See the manual for examples." 1040REPLACE may also be a function that will be called with the tag as the
1041only argument to create the link, which should be returned as a string.
1042
1043See the manual for examples."
1037 :group 'org-link 1044 :group 'org-link
1038 :type 'alist) 1045 :type 'alist)
1039 1046
1040(defcustom org-descriptive-links t 1047(defcustom org-descriptive-links t
1041 "Non-nil means, hide link part and only show description of bracket links. 1048 "Non-nil means, hide link part and only show description of bracket links.
1042Bracket links are like [[link][descritpion]]. This variable sets the initial 1049Bracket links are like [[link][descritpion]]. This variable sets the initial
1043state in new org-mode buffers. The setting can then be toggled on a 1050state in new org-mode buffers. The setting can then be toggled on a
1044per-buffer basis from the Org->Hyperlinks menu." 1051per-buffer basis from the Org->Hyperlinks menu."
1045 :group 'org-link 1052 :group 'org-link
@@ -1049,10 +1056,10 @@ per-buffer basis from the Org->Hyperlinks menu."
1049 "How the path name in file links should be stored. 1056 "How the path name in file links should be stored.
1050Valid values are: 1057Valid values are:
1051 1058
1052relative relative to the current directory, i.e. the directory of the file 1059relative Relative to the current directory, i.e. the directory of the file
1053 into which the link is being inserted. 1060 into which the link is being inserted.
1054absolute absolute path, if possible with ~ for home directory. 1061absolute Absolute path, if possible with ~ for home directory.
1055noabbrev absolute path, no abbreviation of home directory. 1062noabbrev Absolute path, no abbreviation of home directory.
1056adaptive Use relative path for files in the current directory and sub- 1063adaptive Use relative path for files in the current directory and sub-
1057 directories of it. For other files, use an absolute path." 1064 directories of it. For other files, use an absolute path."
1058 :group 'org-link 1065 :group 'org-link
@@ -1404,6 +1411,14 @@ When this variable is nil, `C-c C-c' give you the prompts, and
1404 :group 'org-remember 1411 :group 'org-remember
1405 :type 'boolean) 1412 :type 'boolean)
1406 1413
1414(defcustom org-remember-use-refile-when-interactive t
1415 "Non-nil means, use refile to file a remember note.
1416This is only used when the interactive mode for selecting a filing
1417location is used (see the variable `org-remember-store-without-prompt').
1418When nil, the `org-goto' interface is used."
1419 :group 'org-remember
1420 :type 'boolean)
1421
1407(defcustom org-remember-default-headline "" 1422(defcustom org-remember-default-headline ""
1408 "The headline that should be the default location in the notes file. 1423 "The headline that should be the default location in the notes file.
1409When filing remember notes, the cursor will start at that position. 1424When filing remember notes, the cursor will start at that position.
@@ -1416,9 +1431,9 @@ You can set this on a per-template basis with the variable
1416 "Templates for the creation of remember buffers. 1431 "Templates for the creation of remember buffers.
1417When nil, just let remember make the buffer. 1432When nil, just let remember make the buffer.
1418When not nil, this is a list of 5-element lists. In each entry, the first 1433When not nil, this is a list of 5-element lists. In each entry, the first
1419element is a the name of the template, It should be a single short word. 1434element is the name of the template, which should be a single short word.
1420The second element is a character, a unique key to select this template. 1435The second element is a character, a unique key to select this template.
1421The third element is the template. The forth element is optional and can 1436The third element is the template. The fourth element is optional and can
1422specify a destination file for remember items created with this template. 1437specify a destination file for remember items created with this template.
1423The default file is given by `org-default-notes-file'. An optional fifth 1438The default file is given by `org-default-notes-file'. An optional fifth
1424element can specify the headline in that file that should be offered 1439element can specify the headline in that file that should be offered
@@ -1429,7 +1444,9 @@ The template specifies the structure of the remember buffer. It should have
1429a first line starting with a star, to act as the org-mode headline. 1444a first line starting with a star, to act as the org-mode headline.
1430Furthermore, the following %-escapes will be replaced with content: 1445Furthermore, the following %-escapes will be replaced with content:
1431 1446
1432 %^{prompt} prompt the user for a string and replace this sequence with it. 1447 %^{prompt} Prompt the user for a string and replace this sequence with it.
1448 A default value and a completion table ca be specified like this:
1449 %^{prompt|default|completion2|completion3|...}
1433 %t time stamp, date only 1450 %t time stamp, date only
1434 %T time stamp with date and time 1451 %T time stamp with date and time
1435 %u, %U like the above, but inactive time stamps 1452 %u, %U like the above, but inactive time stamps
@@ -1440,6 +1457,13 @@ Furthermore, the following %-escapes will be replaced with content:
1440 %i initial content, the region when remember is called with C-u. 1457 %i initial content, the region when remember is called with C-u.
1441 If %i is indented, the entire inserted text will be indented 1458 If %i is indented, the entire inserted text will be indented
1442 as well. 1459 as well.
1460 %c content of the clipboard, or current kill ring head
1461 %^g prompt for tags, with completion on tags in target file
1462 %^G prompt for tags, with completion all tags in all agenda files
1463 %:keyword specific information for certain link types, see below
1464 %[pathname] insert the contents of the file given by `pathname'
1465 %(sexp) evaluate elisp `(sexp)' and replace with the result
1466 %! Store this note immediately after filling the template
1443 1467
1444 %? After completing the template, position cursor here. 1468 %? After completing the template, position cursor here.
1445 1469
@@ -1483,7 +1507,9 @@ calendar | %:type %:date"
1483 1507
1484(defcustom org-reverse-note-order nil 1508(defcustom org-reverse-note-order nil
1485 "Non-nil means, store new notes at the beginning of a file or entry. 1509 "Non-nil means, store new notes at the beginning of a file or entry.
1486When nil, new notes will be filed to the end of a file or entry." 1510When nil, new notes will be filed to the end of a file or entry.
1511This can also be a list with cons cells of regular expressions that
1512are matched against file names, and values."
1487 :group 'org-remember 1513 :group 'org-remember
1488 :type '(choice 1514 :type '(choice
1489 (const :tag "Reverse always" t) 1515 (const :tag "Reverse always" t)
@@ -1491,6 +1517,51 @@ When nil, new notes will be filed to the end of a file or entry."
1491 (repeat :tag "By file name regexp" 1517 (repeat :tag "By file name regexp"
1492 (cons regexp boolean)))) 1518 (cons regexp boolean))))
1493 1519
1520(defcustom org-refile-targets nil
1521 "Targets for refiling entries with \\[org-refile].
1522This is list of cons cells. Each cell contains:
1523- a specification of the files to be considered, either a list of files,
1524 or a symbol whose function or value fields will be used to retrieve
1525 a file name or a list of file names. Nil means, refile to a different
1526 heading in the current buffer.
1527- A specification of how to find candidate refile targets. This may be
1528 any of
1529 - a cons cell (:tag . \"TAG\") to identify refile targets by a tag.
1530 This tag has to be present in all target headlines, inheritance will
1531 not be considered.
1532 - a cons cell (:todo . \"KEYWORD\") to identify refile targets by
1533 todo keyword.
1534 - a cons cell (:regexp . \"REGEXP\") with a regular expression matching
1535 headlines that are refiling targets.
1536 - a cons cell (:level . N). Any headline of level N is considered a target.
1537 - a cons cell (:maxlevel . N). Any headline with level <= N is a target."
1538;; FIXME: what if there are a var and func with same name???
1539 :group 'org-remember
1540 :type '(repeat
1541 (cons
1542 (choice :value org-agenda-files
1543 (const :tag "All agenda files" org-agenda-files)
1544 (const :tag "Current buffer" nil)
1545 (function) (variable) (file))
1546 (choice :tag "Identify target headline by"
1547 (cons :tag "Specific tag" (const :tag) (string))
1548 (cons :tag "TODO keyword" (const :todo) (string))
1549 (cons :tag "Regular expression" (const :regexp) (regexp))
1550 (cons :tag "Level number" (const :level) (integer))
1551 (cons :tag "Max Level number" (const :maxlevel) (integer))))))
1552
1553(defcustom org-refile-use-outline-path nil
1554 "Non-nil means, provide refile targets as paths.
1555So a level 3 headline will be available as level1/level2/level3.
1556When the value is `file', also include the file name (without directory)
1557into the path. When `full-file-path', include the full file path."
1558 :group 'org-remember
1559 :type '(choice
1560 (const :tag "Not" nil)
1561 (const :tag "Yes" t)
1562 (const :tag "Start with file name" file)
1563 (const :tag "Start with full file path" full-file-path)))
1564
1494(defgroup org-todo nil 1565(defgroup org-todo nil
1495 "Options concerning TODO items in Org-mode." 1566 "Options concerning TODO items in Org-mode."
1496 :tag "Org TODO" 1567 :tag "Org TODO"
@@ -1712,6 +1783,15 @@ Nil means, clock will keep running until stopped explicitly with
1712 :group 'org-progress 1783 :group 'org-progress
1713 :type 'boolean) 1784 :type 'boolean)
1714 1785
1786(defcustom org-clock-in-switch-to-state nil
1787 "Set task to a special todo state while clocking it.
1788The value should be the state to which the entry should be switched."
1789 :group 'org-progress
1790 :group 'org-todo
1791 :type '(choice
1792 (const :tag "Don't force a state" nil)
1793 (string :tag "State")))
1794
1715(defgroup org-priorities nil 1795(defgroup org-priorities nil
1716 "Priorities in Org-mode." 1796 "Priorities in Org-mode."
1717 :tag "Org Priorities" 1797 :tag "Org Priorities"
@@ -1795,13 +1875,52 @@ end of the second format."
1795 (concat "[" (substring f 1 -1) "]") 1875 (concat "[" (substring f 1 -1) "]")
1796 f))) 1876 f)))
1797 1877
1798(defcustom org-popup-calendar-for-date-prompt t 1878(defcustom org-read-date-prefer-future t
1879 "Non-nil means, assume future for incomplete date input from user.
1880This affects the following situations:
18811. The user gives a day, but no month.
1882 For example, if today is the 15th, and you enter \"3\", Org-mode will
1883 read this as the third of *next* month. However, if you enter \"17\",
1884 it will be considered as *this* month.
18852. The user gives a month but not a year.
1886 For example, if it is april and you enter \"feb 2\", this will be read
1887 as feb 2, *next* year. \"May 5\", however, will be this year.
1888
1889When this option is nil, the current month and year will always be used
1890as defaults."
1891 :group 'org-time
1892 :type 'boolean)
1893
1894(defcustom org-read-date-display-live t
1895 "Non-nil means, display current interpretation of date prompt live.
1896This display will be in an overlay, in the minibuffer."
1897 :group 'org-time
1898 :type 'boolean)
1899
1900(defcustom org-read-date-popup-calendar t
1799 "Non-nil means, pop up a calendar when prompting for a date. 1901 "Non-nil means, pop up a calendar when prompting for a date.
1800In the calendar, the date can be selected with mouse-1. However, the 1902In the calendar, the date can be selected with mouse-1. However, the
1801minibuffer will also be active, and you can simply enter the date as well. 1903minibuffer will also be active, and you can simply enter the date as well.
1802When nil, only the minibuffer will be available." 1904When nil, only the minibuffer will be available."
1803 :group 'org-time 1905 :group 'org-time
1804 :type 'boolean) 1906 :type 'boolean)
1907(if (fboundp 'defvaralias)
1908 (defvaralias 'org-popup-calendar-for-date-prompt
1909 'org-read-date-popup-calendar))
1910
1911(defcustom org-extend-today-until 0
1912 "The hour when your day really ends.
1913This has influence for the following applications:
1914- When switching the agenda to \"today\". It it is still earlier than
1915 the time given here, the day recognized as TODAY is actually yesterday.
1916- When a date is read from the user and it is still before the time given
1917 here, the current date and time will be assumed to be yesterday, 23:59.
1918
1919FIXME:
1920IMPORTANT: This is still a very experimental feature, it may disappear
1921again or it may be extended to mean more things."
1922 :group 'org-time
1923 :type 'number)
1805 1924
1806(defcustom org-edit-timestamp-down-means-later nil 1925(defcustom org-edit-timestamp-down-means-later nil
1807 "Non-nil means, S-down will increase the time in a time stamp. 1926 "Non-nil means, S-down will increase the time in a time stamp.
@@ -1816,6 +1935,13 @@ moved to the new date."
1816 :group 'org-time 1935 :group 'org-time
1817 :type 'boolean) 1936 :type 'boolean)
1818 1937
1938(defcustom org-clock-heading-function nil
1939 "When non-nil, should be a function to create `org-clock-heading'.
1940This is the string shown in the mode line when a clock is running.
1941The function is called with point at the beginning of the headline."
1942 :group 'org-time ; FIXME: Should we have a separate group????
1943 :type 'function)
1944
1819(defgroup org-tags nil 1945(defgroup org-tags nil
1820 "Options concerning tags in Org-mode." 1946 "Options concerning tags in Org-mode."
1821 :tag "Org Tags" 1947 :tag "Org Tags"
@@ -1929,16 +2055,23 @@ lined-up with respect to each other."
1929 2055
1930(defcustom org-use-property-inheritance nil 2056(defcustom org-use-property-inheritance nil
1931 "Non-nil means, properties apply also for sublevels. 2057 "Non-nil means, properties apply also for sublevels.
1932This can cause significant overhead when doing a search, so this is turned 2058This setting is only relevant during property searches, not when querying
1933off by default. 2059an entry with `org-entry-get'. To retrieve a property with inheritance,
2060you need to call `org-entry-get' with the inheritance flag.
2061Turning this on can cause significant overhead when doing a search, so
2062this is turned off by default.
1934When nil, only the properties directly given in the current entry count. 2063When nil, only the properties directly given in the current entry count.
2064The value may also be a list of properties that shouldhave inheritance.
1935 2065
1936However, note that some special properties use inheritance under special 2066However, note that some special properties use inheritance under special
1937circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS, 2067circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS,
1938and the properties ending in \"_ALL\" when they are used as descriptor 2068and the properties ending in \"_ALL\" when they are used as descriptor
1939for valid values of a property." 2069for valid values of a property."
1940 :group 'org-properties 2070 :group 'org-properties
1941 :type 'boolean) 2071 :type '(choice
2072 (const :tag "Not" nil)
2073 (const :tag "Always" nil)
2074 (repeat :tag "Specific properties" (string :tag "Property"))))
1942 2075
1943(defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS" 2076(defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS"
1944 "The default column format, if no other format has been defined. 2077 "The default column format, if no other format has been defined.
@@ -1998,7 +2131,7 @@ agenda file per line."
1998 (repeat :tag "List of files and directories" file) 2131 (repeat :tag "List of files and directories" file)
1999 (file :tag "Store list in a file\n" :value "~/.agenda_files"))) 2132 (file :tag "Store list in a file\n" :value "~/.agenda_files")))
2000 2133
2001(defcustom org-agenda-file-regexp "\\.org\\'" 2134(defcustom org-agenda-file-regexp "\\`[^.].*\\.org\\'"
2002 "Regular expression to match files for `org-agenda-files'. 2135 "Regular expression to match files for `org-agenda-files'.
2003If any element in the list in that variable contains a directory instead 2136If any element in the list in that variable contains a directory instead
2004of a normal file, all files in that directory that are matched by this 2137of a normal file, all files in that directory that are matched by this
@@ -2318,6 +2451,11 @@ deadlines are always turned off when the item is DONE."
2318 :group 'org-agenda-skip 2451 :group 'org-agenda-skip
2319 :type 'boolean) 2452 :type 'boolean)
2320 2453
2454(defcustom org-agenda-skip-timestamp-if-done nil
2455 "Non-nil means don't select item by timestamp or -range if it is DONE."
2456 :group 'org-agenda-skip
2457 :type 'boolean)
2458
2321(defcustom org-timeline-show-empty-dates 3 2459(defcustom org-timeline-show-empty-dates 3
2322 "Non-nil means, `org-timeline' also shows dates without an entry. 2460 "Non-nil means, `org-timeline' also shows dates without an entry.
2323When nil, only the days which actually have entries are shown. 2461When nil, only the days which actually have entries are shown.
@@ -2400,7 +2538,9 @@ Valid values are:
2400current-window Display in the current window 2538current-window Display in the current window
2401other-window Just display in another window. 2539other-window Just display in another window.
2402dedicated-frame Create one new frame, and re-use it each time. 2540dedicated-frame Create one new frame, and re-use it each time.
2403new-frame Make a new frame each time." 2541new-frame Make a new frame each time. Note that in this case
2542 previously-made indirect buffers are kept, and you need to
2543 kill these buffers yourself."
2404 :group 'org-structure 2544 :group 'org-structure
2405 :group 'org-agenda-windows 2545 :group 'org-agenda-windows
2406 :type '(choice 2546 :type '(choice
@@ -2542,18 +2682,19 @@ a grid line."
2542 :tag "Org Agenda Sorting" 2682 :tag "Org Agenda Sorting"
2543 :group 'org-agenda) 2683 :group 'org-agenda)
2544 2684
2545(let ((sorting-choice 2685(defconst org-sorting-choice
2546 '(choice 2686 '(choice
2547 (const time-up) (const time-down) 2687 (const time-up) (const time-down)
2548 (const category-keep) (const category-up) (const category-down) 2688 (const category-keep) (const category-up) (const category-down)
2549 (const tag-down) (const tag-up) 2689 (const tag-down) (const tag-up)
2550 (const priority-up) (const priority-down)))) 2690 (const priority-up) (const priority-down))
2551 2691 "Sorting choices.")
2552 (defcustom org-agenda-sorting-strategy 2692
2553 '((agenda time-up category-keep priority-down) 2693(defcustom org-agenda-sorting-strategy
2554 (todo category-keep priority-down) 2694 '((agenda time-up category-keep priority-down)
2555 (tags category-keep priority-down)) 2695 (todo category-keep priority-down)
2556 "Sorting structure for the agenda items of a single day. 2696 (tags category-keep priority-down))
2697 "Sorting structure for the agenda items of a single day.
2557This is a list of symbols which will be used in sequence to determine 2698This is a list of symbols which will be used in sequence to determine
2558if an entry should be listed before another entry. The following 2699if an entry should be listed before another entry. The following
2559symbols are recognized: 2700symbols are recognized:
@@ -2580,17 +2721,21 @@ the sequence given in `org-agenda-files'. Within each category sort by
2580priority. 2721priority.
2581 2722
2582Leaving out `category-keep' would mean that items will be sorted across 2723Leaving out `category-keep' would mean that items will be sorted across
2583categories by priority." 2724categories by priority.
2725
2726Instead of a single list, this can also be a set of list for specific
2727contents, with a context symbol in the car of the list, any of
2728`agenda', `todo', `tags' for the corresponding agenda views."
2584 :group 'org-agenda-sorting 2729 :group 'org-agenda-sorting
2585 :type `(choice 2730 :type `(choice
2586 (repeat :tag "General" ,sorting-choice) 2731 (repeat :tag "General" ,org-sorting-choice)
2587 (list :tag "Individually" 2732 (list :tag "Individually"
2588 (cons (const :tag "Strategy for Weekly/Daily agenda" agenda) 2733 (cons (const :tag "Strategy for Weekly/Daily agenda" agenda)
2589 (repeat ,sorting-choice)) 2734 (repeat ,org-sorting-choice))
2590 (cons (const :tag "Strategy for TODO lists" todo) 2735 (cons (const :tag "Strategy for TODO lists" todo)
2591 (repeat ,sorting-choice)) 2736 (repeat ,org-sorting-choice))
2592 (cons (const :tag "Strategy for Tags matches" tags) 2737 (cons (const :tag "Strategy for Tags matches" tags)
2593 (repeat ,sorting-choice)))))) 2738 (repeat ,org-sorting-choice)))))
2594 2739
2595(defcustom org-sort-agenda-notime-is-late t 2740(defcustom org-sort-agenda-notime-is-late t
2596 "Non-nil means, items without time are considered late. 2741 "Non-nil means, items without time are considered late.
@@ -2673,9 +2818,16 @@ See also the variables `org-agenda-remove-times-when-in-prefix' and
2673 "The compiled version of the most recently used prefix format. 2818 "The compiled version of the most recently used prefix format.
2674See the variable `org-agenda-prefix-format'.") 2819See the variable `org-agenda-prefix-format'.")
2675 2820
2821(defcustom org-agenda-todo-keyword-format "%-1s"
2822 "Format for the TODO keyword in agenda lines.
2823Set this to something like \"%-12s\" if you want all TODO keywords
2824to occupy a fixed space in the agenda display."
2825 :group 'org-agenda-line-format
2826 :type 'string)
2827
2676(defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") 2828(defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ")
2677 "Text preceeding scheduled items in the agenda view. 2829 "Text preceeding scheduled items in the agenda view.
2678THis is a list with two strings. The first applies when the item is 2830This is a list with two strings. The first applies when the item is
2679scheduled on the current day. The second applies when it has been scheduled 2831scheduled on the current day. The second applies when it has been scheduled
2680previously, it may contain a %d to capture how many days ago the item was 2832previously, it may contain a %d to capture how many days ago the item was
2681scheduled." 2833scheduled."
@@ -2811,23 +2963,23 @@ This is a property list with the following properties:
2811 :tag "Org Export General" 2963 :tag "Org Export General"
2812 :group 'org-export) 2964 :group 'org-export)
2813 2965
2814(defcustom org-export-publishing-directory "." 2966;; FIXME
2815 "Path to the location where exported files should be located. 2967(defvar org-export-publishing-directory nil)
2816This path may be relative to the directory where the Org-mode file lives. 2968
2817The default is to put them into the same directory as the Org-mode file. 2969(defcustom org-export-with-special-strings t
2818The variable may also be an alist with export types `:html', `:ascii', 2970 "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export.
2819`:ical', `:LaTeX', or `:xoxo' and the corresponding directories. 2971When this option is turned on, these strings will be exported as:
2820If a directory path is relative, it is interpreted relative to the 2972
2821directory where the exported Org-mode files lives." 2973 Org HTML LaTeX
2822 :group 'org-export-general 2974 -----+----------+--------
2823 :type '(choice 2975 \\- &shy; \\-
2824 (directory) 2976 -- &ndash; --
2825 (repeat 2977 --- &mdash; ---
2826 (cons 2978 ... &hellip; \ldots
2827 (choice :tag "Type" 2979
2828 (const :html) (const :LaTeX) 2980This option can also be set with the +OPTIONS line, e.g. \"-:nil\"."
2829 (const :ascii) (const :ical) (const :xoxo)) 2981 :group 'org-export-translation
2830 (directory))))) 2982 :type 'boolean)
2831 2983
2832(defcustom org-export-language-setup 2984(defcustom org-export-language-setup
2833 '(("en" "Author" "Date" "Table of Contents") 2985 '(("en" "Author" "Date" "Table of Contents")
@@ -3032,6 +3184,20 @@ This option can also be set with the +OPTIONS line, e.g. \"^:nil\"."
3032 (const :tag "Only with braces" {}) 3184 (const :tag "Only with braces" {})
3033 (const :tag "Never interpret" nil))) 3185 (const :tag "Never interpret" nil)))
3034 3186
3187(defcustom org-export-with-special-strings t
3188 "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export.
3189When this option is turned on, these strings will be exported as:
3190
3191\\- : &shy;
3192-- : &ndash;
3193--- : &mdash;
3194
3195Not all export backends support this, but HTML does.
3196
3197This option can also be set with the +OPTIONS line, e.g. \"-:nil\"."
3198 :group 'org-export-translation
3199 :type 'boolean)
3200
3035(defcustom org-export-with-TeX-macros t 3201(defcustom org-export-with-TeX-macros t
3036 "Non-nil means, interpret simple TeX-like macros when exporting. 3202 "Non-nil means, interpret simple TeX-like macros when exporting.
3037For example, HTML export converts \\alpha to &alpha; and \\AA to &Aring;. 3203For example, HTML export converts \\alpha to &alpha; and \\AA to &Aring;.
@@ -3138,7 +3304,7 @@ In the given sequence, these characters will be used for level 1, 2, ..."
3138 3304
3139(defcustom org-export-ascii-bullets '(?* ?+ ?-) 3305(defcustom org-export-ascii-bullets '(?* ?+ ?-)
3140 "Bullet characters for headlines converted to lists in ASCII export. 3306 "Bullet characters for headlines converted to lists in ASCII export.
3141The first character is is used for the first lest level generated in this 3307The first character is used for the first lest level generated in this
3142way, and so on. If there are more levels than characters given here, 3308way, and so on. If there are more levels than characters given here,
3143the list will be repeated. 3309the list will be repeated.
3144Note that plain lists will keep the same bullets as the have in the 3310Note that plain lists will keep the same bullets as the have in the
@@ -3377,8 +3543,20 @@ Changing this variable requires a restart of Emacs to take effect."
3377 :group 'org-font-lock 3543 :group 'org-font-lock
3378 :type 'boolean) 3544 :type 'boolean)
3379 3545
3546(defcustom org-highlight-latex-fragments-and-specials nil
3547 "Non-nil means, fontify what is treated specially by the exporters."
3548 :group 'org-font-lock
3549 :type 'boolean)
3550
3551(defcustom org-hide-emphasis-markers nil
3552 "Non-nil mean font-lock should hide the emphasis marker characters."
3553 :group 'org-font-lock
3554 :type 'boolean)
3555
3380(defvar org-emph-re nil 3556(defvar org-emph-re nil
3381 "Regular expression for matching emphasis.") 3557 "Regular expression for matching emphasis.")
3558(defvar org-verbatim-re nil
3559 "Regular expression for matching verbatim text.")
3382(defvar org-emphasis-regexp-components) ; defined just below 3560(defvar org-emphasis-regexp-components) ; defined just below
3383(defvar org-emphasis-alist) ; defined just below 3561(defvar org-emphasis-alist) ; defined just below
3384(defun org-set-emph-re (var val) 3562(defun org-set-emph-re (var val)
@@ -3393,33 +3571,53 @@ Changing this variable requires a restart of Emacs to take effect."
3393 (border (nth 2 e)) 3571 (border (nth 2 e))
3394 (body (nth 3 e)) 3572 (body (nth 3 e))
3395 (nl (nth 4 e)) 3573 (nl (nth 4 e))
3396 (stacked (nth 5 e)) 3574 (stacked (and nil (nth 5 e))) ; stacked is no longer allowed, forced to nil
3397 (body1 (concat body "*?")) 3575 (body1 (concat body "*?"))
3398 (markers (mapconcat 'car org-emphasis-alist ""))) 3576 (markers (mapconcat 'car org-emphasis-alist ""))
3577 (vmarkers (mapconcat
3578 (lambda (x) (if (eq (nth 4 x) 'verbatim) (car x) ""))
3579 org-emphasis-alist "")))
3399 ;; make sure special characters appear at the right position in the class 3580 ;; make sure special characters appear at the right position in the class
3400 (if (string-match "\\^" markers) 3581 (if (string-match "\\^" markers)
3401 (setq markers (concat (replace-match "" t t markers) "^"))) 3582 (setq markers (concat (replace-match "" t t markers) "^")))
3402 (if (string-match "-" markers) 3583 (if (string-match "-" markers)
3403 (setq markers (concat (replace-match "" t t markers) "-"))) 3584 (setq markers (concat (replace-match "" t t markers) "-")))
3585 (if (string-match "\\^" vmarkers)
3586 (setq vmarkers (concat (replace-match "" t t vmarkers) "^")))
3587 (if (string-match "-" vmarkers)
3588 (setq vmarkers (concat (replace-match "" t t vmarkers) "-")))
3404 (if (> nl 0) 3589 (if (> nl 0)
3405 (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0," 3590 (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0,"
3406 (int-to-string nl) "\\}"))) 3591 (int-to-string nl) "\\}")))
3407 ;; Make the regexp 3592 ;; Make the regexp
3408 (setq org-emph-re 3593 (setq org-emph-re
3409 (concat "\\([" pre (if stacked markers) "]\\|^\\)" 3594 (concat "\\([" pre (if (and nil stacked) markers) "]\\|^\\)"
3410 "\\(" 3595 "\\("
3411 "\\([" markers "]\\)" 3596 "\\([" markers "]\\)"
3412 "\\(" 3597 "\\("
3598 "[^" border "]\\|"
3413 "[^" border (if (and nil stacked) markers) "]" 3599 "[^" border (if (and nil stacked) markers) "]"
3414 body1 3600 body1
3415 "[^" border (if (and nil stacked) markers) "]" 3601 "[^" border (if (and nil stacked) markers) "]"
3416 "\\)" 3602 "\\)"
3417 "\\3\\)" 3603 "\\3\\)"
3418 "\\([" post (if stacked markers) "]\\|$\\)"))))) 3604 "\\([" post (if (and nil stacked) markers) "]\\|$\\)"))
3605 (setq org-verbatim-re
3606 (concat "\\([" pre "]\\|^\\)"
3607 "\\("
3608 "\\([" vmarkers "]\\)"
3609 "\\("
3610 "[^" border "]\\|"
3611 "[^" border "]"
3612 body1
3613 "[^" border "]"
3614 "\\)"
3615 "\\3\\)"
3616 "\\([" post "]\\|$\\)")))))
3419 3617
3420(defcustom org-emphasis-regexp-components 3618(defcustom org-emphasis-regexp-components
3421 '(" \t('\"" "- \t.,:?;'\")" " \t\r\n,\"'" "." 1 nil) 3619 '(" \t('\"" "- \t.,:?;'\")" " \t\r\n,\"'" "." 1)
3422 "Components used to build the reqular expression for emphasis. 3620 "Components used to build the regular expression for emphasis.
3423This is a list with 6 entries. Terminology: In an emphasis string 3621This is a list with 6 entries. Terminology: In an emphasis string
3424like \" *strong word* \", we call the initial space PREMATCH, the final 3622like \" *strong word* \", we call the initial space PREMATCH, the final
3425space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters 3623space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters
@@ -3432,10 +3630,7 @@ border The chars *forbidden* as border characters.
3432body-regexp A regexp like \".\" to match a body character. Don't use 3630body-regexp A regexp like \".\" to match a body character. Don't use
3433 non-shy groups here, and don't allow newline here. 3631 non-shy groups here, and don't allow newline here.
3434newline The maximum number of newlines allowed in an emphasis exp. 3632newline The maximum number of newlines allowed in an emphasis exp.
3435stacked Non-nil means, allow stacked styles. This works only in HTML 3633
3436 export. When this is set, all marker characters (as given in
3437 `org-emphasis-alist') will be allowed as pre/post, aiding
3438 inside-out matching.
3439Use customize to modify this, or restart Emacs after changing it." 3634Use customize to modify this, or restart Emacs after changing it."
3440 :group 'org-font-lock 3635 :group 'org-font-lock
3441 :set 'org-set-emph-re 3636 :set 'org-set-emph-re
@@ -3445,16 +3640,17 @@ Use customize to modify this, or restart Emacs after changing it."
3445 (sexp :tag "Forbidden chars in border ") 3640 (sexp :tag "Forbidden chars in border ")
3446 (sexp :tag "Regexp for body ") 3641 (sexp :tag "Regexp for body ")
3447 (integer :tag "number of newlines allowed") 3642 (integer :tag "number of newlines allowed")
3448 (boolean :tag "Stacking allowed "))) 3643 (option (boolean :tag "Stacking (DISABLED) "))))
3449 3644
3450(defcustom org-emphasis-alist 3645(defcustom org-emphasis-alist
3451 '(("*" bold "<b>" "</b>") 3646 '(("*" bold "<b>" "</b>")
3452 ("/" italic "<i>" "</i>") 3647 ("/" italic "<i>" "</i>")
3453 ("_" underline "<u>" "</u>") 3648 ("_" underline "<u>" "</u>")
3454 ("=" org-code "<code>" "</code>") 3649 ("=" org-code "<code>" "</code>" verbatim)
3650 ("~" org-verbatim "" "" verbatim)
3455 ("+" (:strike-through t) "<del>" "</del>") 3651 ("+" (:strike-through t) "<del>" "</del>")
3456 ) 3652 )
3457"Special syntax for emphasized text. 3653 "Special syntax for emphasized text.
3458Text starting and ending with a special character will be emphasized, for 3654Text starting and ending with a special character will be emphasized, for
3459example *bold*, _underlined_ and /italic/. This variable sets the marker 3655example *bold*, _underlined_ and /italic/. This variable sets the marker
3460characters, the face to be used by font-lock for highlighting in Org-mode 3656characters, the face to be used by font-lock for highlighting in Org-mode
@@ -3469,7 +3665,8 @@ Use customize to modify this, or restart Emacs after changing it."
3469 (face :tag "Font-lock-face") 3665 (face :tag "Font-lock-face")
3470 (plist :tag "Face property list")) 3666 (plist :tag "Face property list"))
3471 (string :tag "HTML start tag") 3667 (string :tag "HTML start tag")
3472 (string :tag "HTML end tag")))) 3668 (string :tag "HTML end tag")
3669 (option (const verbatim)))))
3473 3670
3474;;; The faces 3671;;; The faces
3475 3672
@@ -3508,6 +3705,7 @@ any other entries, and any resulting duplicates will be removed entirely."
3508 (t (or (assoc (car e) r) (push e r))))) 3705 (t (or (assoc (car e) r) (push e r)))))
3509 (nreverse r))) 3706 (nreverse r)))
3510 (t specs))) 3707 (t specs)))
3708(put 'org-compatible-face 'lisp-indent-function 1)
3511 3709
3512(defface org-hide 3710(defface org-hide
3513 '((((background light)) (:foreground "white")) 3711 '((((background light)) (:foreground "white"))
@@ -3518,108 +3716,98 @@ color of the frame."
3518 :group 'org-faces) 3716 :group 'org-faces)
3519 3717
3520(defface org-level-1 ;; font-lock-function-name-face 3718(defface org-level-1 ;; font-lock-function-name-face
3521 (org-compatible-face 3719 (org-compatible-face 'outline-1
3522 'outline-1 3720 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
3523 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) 3721 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
3524 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) 3722 (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
3525 (((class color) (min-colors 16) (background light)) (:foreground "Blue")) 3723 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
3526 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) 3724 (((class color) (min-colors 8)) (:foreground "blue" :bold t))
3527 (((class color) (min-colors 8)) (:foreground "blue" :bold t)) 3725 (t (:bold t))))
3528 (t (:bold t))))
3529 "Face used for level 1 headlines." 3726 "Face used for level 1 headlines."
3530 :group 'org-faces) 3727 :group 'org-faces)
3531 3728
3532(defface org-level-2 ;; font-lock-variable-name-face 3729(defface org-level-2 ;; font-lock-variable-name-face
3533 (org-compatible-face 3730 (org-compatible-face 'outline-2
3534 'outline-2 3731 '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
3535 '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) 3732 (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
3536 (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) 3733 (((class color) (min-colors 8) (background light)) (:foreground "yellow"))
3537 (((class color) (min-colors 8) (background light)) (:foreground "yellow")) 3734 (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t))
3538 (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t)) 3735 (t (:bold t))))
3539 (t (:bold t))))
3540 "Face used for level 2 headlines." 3736 "Face used for level 2 headlines."
3541 :group 'org-faces) 3737 :group 'org-faces)
3542 3738
3543(defface org-level-3 ;; font-lock-keyword-face 3739(defface org-level-3 ;; font-lock-keyword-face
3544 (org-compatible-face 3740 (org-compatible-face 'outline-3
3545 'outline-3 3741 '((((class color) (min-colors 88) (background light)) (:foreground "Purple"))
3546 '((((class color) (min-colors 88) (background light)) (:foreground "Purple")) 3742 (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1"))
3547 (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) 3743 (((class color) (min-colors 16) (background light)) (:foreground "Purple"))
3548 (((class color) (min-colors 16) (background light)) (:foreground "Purple")) 3744 (((class color) (min-colors 16) (background dark)) (:foreground "Cyan"))
3549 (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) 3745 (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t))
3550 (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t)) 3746 (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t))
3551 (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t)) 3747 (t (:bold t))))
3552 (t (:bold t))))
3553 "Face used for level 3 headlines." 3748 "Face used for level 3 headlines."
3554 :group 'org-faces) 3749 :group 'org-faces)
3555 3750
3556(defface org-level-4 ;; font-lock-comment-face 3751(defface org-level-4 ;; font-lock-comment-face
3557 (org-compatible-face 3752 (org-compatible-face 'outline-4
3558 'outline-4 3753 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
3559 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) 3754 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
3560 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) 3755 (((class color) (min-colors 16) (background light)) (:foreground "red"))
3561 (((class color) (min-colors 16) (background light)) (:foreground "red")) 3756 (((class color) (min-colors 16) (background dark)) (:foreground "red1"))
3562 (((class color) (min-colors 16) (background dark)) (:foreground "red1")) 3757 (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
3563 (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) 3758 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
3564 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) 3759 (t (:bold t))))
3565 (t (:bold t))))
3566 "Face used for level 4 headlines." 3760 "Face used for level 4 headlines."
3567 :group 'org-faces) 3761 :group 'org-faces)
3568 3762
3569(defface org-level-5 ;; font-lock-type-face 3763(defface org-level-5 ;; font-lock-type-face
3570 (org-compatible-face 3764 (org-compatible-face 'outline-5
3571 'outline-5 3765 '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen"))
3572 '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) 3766 (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen"))
3573 (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) 3767 (((class color) (min-colors 8)) (:foreground "green"))))
3574 (((class color) (min-colors 8)) (:foreground "green"))))
3575 "Face used for level 5 headlines." 3768 "Face used for level 5 headlines."
3576 :group 'org-faces) 3769 :group 'org-faces)
3577 3770
3578(defface org-level-6 ;; font-lock-constant-face 3771(defface org-level-6 ;; font-lock-constant-face
3579 (org-compatible-face 3772 (org-compatible-face 'outline-6
3580 'outline-6 3773 '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
3581 '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) 3774 (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
3582 (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) 3775 (((class color) (min-colors 8)) (:foreground "magenta"))))
3583 (((class color) (min-colors 8)) (:foreground "magenta"))))
3584 "Face used for level 6 headlines." 3776 "Face used for level 6 headlines."
3585 :group 'org-faces) 3777 :group 'org-faces)
3586 3778
3587(defface org-level-7 ;; font-lock-builtin-face 3779(defface org-level-7 ;; font-lock-builtin-face
3588 (org-compatible-face 3780 (org-compatible-face 'outline-7
3589 'outline-7 3781 '((((class color) (min-colors 16) (background light)) (:foreground "Orchid"))
3590 '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) 3782 (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue"))
3591 (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) 3783 (((class color) (min-colors 8)) (:foreground "blue"))))
3592 (((class color) (min-colors 8)) (:foreground "blue"))))
3593 "Face used for level 7 headlines." 3784 "Face used for level 7 headlines."
3594 :group 'org-faces) 3785 :group 'org-faces)
3595 3786
3596(defface org-level-8 ;; font-lock-string-face 3787(defface org-level-8 ;; font-lock-string-face
3597 (org-compatible-face 3788 (org-compatible-face 'outline-8
3598 'outline-8 3789 '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
3599 '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) 3790 (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
3600 (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) 3791 (((class color) (min-colors 8)) (:foreground "green"))))
3601 (((class color) (min-colors 8)) (:foreground "green"))))
3602 "Face used for level 8 headlines." 3792 "Face used for level 8 headlines."
3603 :group 'org-faces) 3793 :group 'org-faces)
3604 3794
3605(defface org-special-keyword ;; font-lock-string-face 3795(defface org-special-keyword ;; font-lock-string-face
3606 (org-compatible-face 3796 (org-compatible-face nil
3607 nil 3797 '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
3608 '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) 3798 (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
3609 (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) 3799 (t (:italic t))))
3610 (t (:italic t))))
3611 "Face used for special keywords." 3800 "Face used for special keywords."
3612 :group 'org-faces) 3801 :group 'org-faces)
3613 3802
3614(defface org-drawer ;; font-lock-function-name-face 3803(defface org-drawer ;; font-lock-function-name-face
3615 (org-compatible-face 3804 (org-compatible-face nil
3616 nil 3805 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
3617 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) 3806 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
3618 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) 3807 (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
3619 (((class color) (min-colors 16) (background light)) (:foreground "Blue")) 3808 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
3620 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) 3809 (((class color) (min-colors 8)) (:foreground "blue" :bold t))
3621 (((class color) (min-colors 8)) (:foreground "blue" :bold t)) 3810 (t (:bold t))))
3622 (t (:bold t))))
3623 "Face used for drawers." 3811 "Face used for drawers."
3624 :group 'org-faces) 3812 :group 'org-faces)
3625 3813
@@ -3628,15 +3816,14 @@ color of the frame."
3628 :group 'org-faces) 3816 :group 'org-faces)
3629 3817
3630(defface org-column 3818(defface org-column
3631 (org-compatible-face 3819 (org-compatible-face nil
3632 nil 3820 '((((class color) (min-colors 16) (background light))
3633 '((((class color) (min-colors 16) (background light)) 3821 (:background "grey90"))
3634 (:background "grey90")) 3822 (((class color) (min-colors 16) (background dark))
3635 (((class color) (min-colors 16) (background dark)) 3823 (:background "grey30"))
3636 (:background "grey30")) 3824 (((class color) (min-colors 8))
3637 (((class color) (min-colors 8)) 3825 (:background "cyan" :foreground "black"))
3638 (:background "cyan" :foreground "black")) 3826 (t (:inverse-video t))))
3639 (t (:inverse-video t))))
3640 "Face for column display of entry properties." 3827 "Face for column display of entry properties."
3641 :group 'org-faces) 3828 :group 'org-faces)
3642 3829
@@ -3647,29 +3834,27 @@ color of the frame."
3647 :family (face-attribute 'default :family))) 3834 :family (face-attribute 'default :family)))
3648 3835
3649(defface org-warning 3836(defface org-warning
3650 (org-compatible-face 3837 (org-compatible-face 'font-lock-warning-face
3651 'font-lock-warning-face 3838 '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
3652 '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) 3839 (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t))
3653 (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) 3840 (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
3654 (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) 3841 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
3655 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) 3842 (t (:bold t))))
3656 (t (:bold t))))
3657 "Face for deadlines and TODO keywords." 3843 "Face for deadlines and TODO keywords."
3658 :group 'org-faces) 3844 :group 'org-faces)
3659 3845
3660(defface org-archived ; similar to shadow 3846(defface org-archived ; similar to shadow
3661 (org-compatible-face 3847 (org-compatible-face 'shadow
3662 'shadow 3848 '((((class color grayscale) (min-colors 88) (background light))
3663 '((((class color grayscale) (min-colors 88) (background light)) 3849 (:foreground "grey50"))
3664 (:foreground "grey50")) 3850 (((class color grayscale) (min-colors 88) (background dark))
3665 (((class color grayscale) (min-colors 88) (background dark)) 3851 (:foreground "grey70"))
3666 (:foreground "grey70")) 3852 (((class color) (min-colors 8) (background light))
3667 (((class color) (min-colors 8) (background light)) 3853 (:foreground "green"))
3668 (:foreground "green")) 3854 (((class color) (min-colors 8) (background dark))
3669 (((class color) (min-colors 8) (background dark)) 3855 (:foreground "yellow"))))
3670 (:foreground "yellow")))) 3856 "Face for headline with the ARCHIVE tag."
3671 "Face for headline with the ARCHIVE tag." 3857 :group 'org-faces)
3672 :group 'org-faces)
3673 3858
3674(defface org-link 3859(defface org-link
3675 '((((class color) (background light)) (:foreground "Purple" :underline t)) 3860 '((((class color) (background light)) (:foreground "Purple" :underline t))
@@ -3679,8 +3864,8 @@ color of the frame."
3679 :group 'org-faces) 3864 :group 'org-faces)
3680 3865
3681(defface org-ellipsis 3866(defface org-ellipsis
3682 '((((class color) (background light)) (:foreground "DarkGoldenrod" :strike-through t)) 3867 '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t))
3683 (((class color) (background dark)) (:foreground "LightGoldenrod" :strike-through t)) 3868 (((class color) (background dark)) (:foreground "LightGoldenrod" :underline t))
3684 (t (:strike-through t))) 3869 (t (:strike-through t)))
3685 "Face for the ellipsis in folded text." 3870 "Face for the ellipsis in folded text."
3686 :group 'org-faces) 3871 :group 'org-faces)
@@ -3712,32 +3897,29 @@ color of the frame."
3712 :group 'org-faces) 3897 :group 'org-faces)
3713 3898
3714(defface org-todo ; font-lock-warning-face 3899(defface org-todo ; font-lock-warning-face
3715 (org-compatible-face 3900 (org-compatible-face nil
3716 nil 3901 '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
3717 '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) 3902 (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t))
3718 (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) 3903 (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
3719 (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) 3904 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
3720 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) 3905 (t (:inverse-video t :bold t))))
3721 (t (:inverse-video t :bold t))))
3722 "Face for TODO keywords." 3906 "Face for TODO keywords."
3723 :group 'org-faces) 3907 :group 'org-faces)
3724 3908
3725(defface org-done ;; font-lock-type-face 3909(defface org-done ;; font-lock-type-face
3726 (org-compatible-face 3910 (org-compatible-face nil
3727 nil 3911 '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t))
3728 '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t)) 3912 (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t))
3729 (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) 3913 (((class color) (min-colors 8)) (:foreground "green"))
3730 (((class color) (min-colors 8)) (:foreground "green")) 3914 (t (:bold t))))
3731 (t (:bold t))))
3732 "Face used for todo keywords that indicate DONE items." 3915 "Face used for todo keywords that indicate DONE items."
3733 :group 'org-faces) 3916 :group 'org-faces)
3734 3917
3735(defface org-headline-done ;; font-lock-string-face 3918(defface org-headline-done ;; font-lock-string-face
3736 (org-compatible-face 3919 (org-compatible-face nil
3737 nil 3920 '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
3738 '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) 3921 (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
3739 (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) 3922 (((class color) (min-colors 8) (background light)) (:bold nil))))
3740 (((class color) (min-colors 8) (background light)) (:bold nil))))
3741 "Face used to indicate that a headline is DONE. 3923 "Face used to indicate that a headline is DONE.
3742This face is only used if `org-fontify-done-headline' is set. If applies 3924This face is only used if `org-fontify-done-headline' is set. If applies
3743to the part of the headline after the DONE keyword." 3925to the part of the headline after the DONE keyword."
@@ -3756,84 +3938,91 @@ list of attributes, like (:foreground \"blue\" :weight bold :underline t)."
3756 (sexp :tag "face")))) 3938 (sexp :tag "face"))))
3757 3939
3758(defface org-table ;; font-lock-function-name-face 3940(defface org-table ;; font-lock-function-name-face
3759 (org-compatible-face 3941 (org-compatible-face nil
3760 nil 3942 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
3761 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) 3943 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
3762 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) 3944 (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
3763 (((class color) (min-colors 16) (background light)) (:foreground "Blue")) 3945 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
3764 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) 3946 (((class color) (min-colors 8) (background light)) (:foreground "blue"))
3765 (((class color) (min-colors 8) (background light)) (:foreground "blue")) 3947 (((class color) (min-colors 8) (background dark)))))
3766 (((class color) (min-colors 8) (background dark)))))
3767 "Face used for tables." 3948 "Face used for tables."
3768 :group 'org-faces) 3949 :group 'org-faces)
3769 3950
3770(defface org-formula 3951(defface org-formula
3771 (org-compatible-face 3952 (org-compatible-face nil
3772 nil 3953 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
3773 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) 3954 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
3774 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) 3955 (((class color) (min-colors 8) (background light)) (:foreground "red"))
3775 (((class color) (min-colors 8) (background light)) (:foreground "red")) 3956 (((class color) (min-colors 8) (background dark)) (:foreground "red"))
3776 (((class color) (min-colors 8) (background dark)) (:foreground "red")) 3957 (t (:bold t :italic t))))
3777 (t (:bold t :italic t))))
3778 "Face for formulas." 3958 "Face for formulas."
3779 :group 'org-faces) 3959 :group 'org-faces)
3780 3960
3781(defface org-code 3961(defface org-code
3782 (org-compatible-face 3962 (org-compatible-face nil
3783 nil 3963 '((((class color grayscale) (min-colors 88) (background light))
3784 '((((class color grayscale) (min-colors 88) (background light)) 3964 (:foreground "grey50"))
3785 (:foreground "grey50")) 3965 (((class color grayscale) (min-colors 88) (background dark))
3786 (((class color grayscale) (min-colors 88) (background dark)) 3966 (:foreground "grey70"))
3787 (:foreground "grey70")) 3967 (((class color) (min-colors 8) (background light))
3788 (((class color) (min-colors 8) (background light)) 3968 (:foreground "green"))
3789 (:foreground "green")) 3969 (((class color) (min-colors 8) (background dark))
3790 (((class color) (min-colors 8) (background dark)) 3970 (:foreground "yellow"))))
3791 (:foreground "yellow")))) 3971 "Face for fixed-with text like code snippets."
3792 "Face for fixed-with text like code snippets." 3972 :group 'org-faces
3793 :group 'org-faces 3973 :version "22.1")
3794 :version "22.1") 3974
3975(defface org-verbatim
3976 (org-compatible-face nil
3977 '((((class color grayscale) (min-colors 88) (background light))
3978 (:foreground "grey50" :underline t))
3979 (((class color grayscale) (min-colors 88) (background dark))
3980 (:foreground "grey70" :underline t))
3981 (((class color) (min-colors 8) (background light))
3982 (:foreground "green" :underline t))
3983 (((class color) (min-colors 8) (background dark))
3984 (:foreground "yellow" :underline t))))
3985 "Face for fixed-with text like code snippets."
3986 :group 'org-faces
3987 :version "22.1")
3795 3988
3796(defface org-agenda-structure ;; font-lock-function-name-face 3989(defface org-agenda-structure ;; font-lock-function-name-face
3797 (org-compatible-face 3990 (org-compatible-face nil
3798 nil 3991 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
3799 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) 3992 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
3800 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) 3993 (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
3801 (((class color) (min-colors 16) (background light)) (:foreground "Blue")) 3994 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
3802 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) 3995 (((class color) (min-colors 8)) (:foreground "blue" :bold t))
3803 (((class color) (min-colors 8)) (:foreground "blue" :bold t)) 3996 (t (:bold t))))
3804 (t (:bold t))))
3805 "Face used in agenda for captions and dates." 3997 "Face used in agenda for captions and dates."
3806 :group 'org-faces) 3998 :group 'org-faces)
3807 3999
3808(defface org-scheduled-today 4000(defface org-scheduled-today
3809 (org-compatible-face 4001 (org-compatible-face nil
3810 nil 4002 '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen"))
3811 '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) 4003 (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen"))
3812 (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) 4004 (((class color) (min-colors 8)) (:foreground "green"))
3813 (((class color) (min-colors 8)) (:foreground "green")) 4005 (t (:bold t :italic t))))
3814 (t (:bold t :italic t))))
3815 "Face for items scheduled for a certain day." 4006 "Face for items scheduled for a certain day."
3816 :group 'org-faces) 4007 :group 'org-faces)
3817 4008
3818(defface org-scheduled-previously 4009(defface org-scheduled-previously
3819 (org-compatible-face 4010 (org-compatible-face nil
3820 nil 4011 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
3821 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) 4012 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
3822 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) 4013 (((class color) (min-colors 8) (background light)) (:foreground "red"))
3823 (((class color) (min-colors 8) (background light)) (:foreground "red")) 4014 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
3824 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) 4015 (t (:bold t))))
3825 (t (:bold t))))
3826 "Face for items scheduled previously, and not yet done." 4016 "Face for items scheduled previously, and not yet done."
3827 :group 'org-faces) 4017 :group 'org-faces)
3828 4018
3829(defface org-upcoming-deadline 4019(defface org-upcoming-deadline
3830 (org-compatible-face 4020 (org-compatible-face nil
3831 nil 4021 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
3832 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) 4022 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
3833 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) 4023 (((class color) (min-colors 8) (background light)) (:foreground "red"))
3834 (((class color) (min-colors 8) (background light)) (:foreground "red")) 4024 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
3835 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) 4025 (t (:bold t))))
3836 (t (:bold t))))
3837 "Face for items scheduled previously, and not yet done." 4026 "Face for items scheduled previously, and not yet done."
3838 :group 'org-faces) 4027 :group 'org-faces)
3839 4028
@@ -3842,8 +4031,8 @@ list of attributes, like (:foreground \"blue\" :weight bold :underline t)."
3842 (0.5 . org-upcoming-deadline) 4031 (0.5 . org-upcoming-deadline)
3843 (0.0 . default)) 4032 (0.0 . default))
3844 "Faces for showing deadlines in the agenda. 4033 "Faces for showing deadlines in the agenda.
3845This is a list of cons cells. The cdr of each cess is a face to be used, 4034This is a list of cons cells. The cdr of each cell is a face to be used,
3846and it can also just be a like like '(:foreground \"yellow\"). 4035and it can also just be like '(:foreground \"yellow\").
3847Each car is a fraction of the head-warning time that must have passed for 4036Each car is a fraction of the head-warning time that must have passed for
3848this the face in the cdr to be used for display. The numbers must be 4037this the face in the cdr to be used for display. The numbers must be
3849given in descending order. The head-warning time is normally taken 4038given in descending order. The head-warning time is normally taken
@@ -3862,12 +4051,23 @@ month and 365.24 days for a year)."
3862 (number :tag "Fraction of head-warning time passed") 4051 (number :tag "Fraction of head-warning time passed")
3863 (sexp :tag "Face")))) 4052 (sexp :tag "Face"))))
3864 4053
4054;; FIXME: this is not a good face yet.
4055(defface org-agenda-restriction-lock
4056 (org-compatible-face nil
4057 '((((class color) (min-colors 88) (background light)) (:background "yellow1"))
4058 (((class color) (min-colors 88) (background dark)) (:background "skyblue4"))
4059 (((class color) (min-colors 16) (background light)) (:background "yellow1"))
4060 (((class color) (min-colors 16) (background dark)) (:background "skyblue4"))
4061 (((class color) (min-colors 8)) (:background "cyan" :foreground "black"))
4062 (t (:inverse-video t))))
4063 "Face for showing the agenda restriction lock."
4064 :group 'org-faces)
4065
3865(defface org-time-grid ;; font-lock-variable-name-face 4066(defface org-time-grid ;; font-lock-variable-name-face
3866 (org-compatible-face 4067 (org-compatible-face nil
3867 nil 4068 '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
3868 '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) 4069 (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
3869 (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) 4070 (((class color) (min-colors 8)) (:foreground "yellow" :weight light))))
3870 (((class color) (min-colors 8)) (:foreground "yellow" :weight light))))
3871 "Face used for time grids." 4071 "Face used for time grids."
3872 :group 'org-faces) 4072 :group 'org-faces)
3873 4073
@@ -3883,7 +4083,24 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
3883 :type 'number 4083 :type 'number
3884 :group 'org-faces) 4084 :group 'org-faces)
3885 4085
3886;;; Function declarations. 4086;;; Functions and variables from ther packages
4087;; Declared here to avoid compiler warnings
4088
4089(eval-and-compile
4090 (unless (fboundp 'declare-function)
4091 (defmacro declare-function (fn file &optional arglist fileonly))))
4092
4093;; XEmacs only
4094(defvar outline-mode-menu-heading)
4095(defvar outline-mode-menu-show)
4096(defvar outline-mode-menu-hide)
4097(defvar zmacs-regions) ; XEmacs regions
4098
4099;; Emacs only
4100(defvar mark-active)
4101
4102;; Various packages
4103;; FIXME: get the argument lists for the UNKNOWN stuff
3887(declare-function add-to-diary-list "diary-lib" 4104(declare-function add-to-diary-list "diary-lib"
3888 (date string specifier &optional marker globcolor literal)) 4105 (date string specifier &optional marker globcolor literal))
3889(declare-function table--at-cell-p "table" (position &optional object at-column)) 4106(declare-function table--at-cell-p "table" (position &optional object at-column))
@@ -3899,6 +4116,8 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
3899(declare-function bibtex-generate-autokey "bibtex" ()) 4116(declare-function bibtex-generate-autokey "bibtex" ())
3900(declare-function bibtex-parse-entry "bibtex" (&optional content)) 4117(declare-function bibtex-parse-entry "bibtex" (&optional content))
3901(declare-function bibtex-url "bibtex" (&optional pos no-browse)) 4118(declare-function bibtex-url "bibtex" (&optional pos no-browse))
4119(defvar calc-embedded-close-formula)
4120(defvar calc-embedded-open-formula)
3902(declare-function calendar-astro-date-string "cal-julian" (&optional date)) 4121(declare-function calendar-astro-date-string "cal-julian" (&optional date))
3903(declare-function calendar-bahai-date-string "cal-bahai" (&optional date)) 4122(declare-function calendar-bahai-date-string "cal-bahai" (&optional date))
3904(declare-function calendar-check-holidays "holidays" (date)) 4123(declare-function calendar-check-holidays "holidays" (date))
@@ -3915,10 +4134,23 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
3915(declare-function calendar-julian-date-string "cal-julian" (&optional date)) 4134(declare-function calendar-julian-date-string "cal-julian" (&optional date))
3916(declare-function calendar-mayan-date-string "cal-mayan" (&optional date)) 4135(declare-function calendar-mayan-date-string "cal-mayan" (&optional date))
3917(declare-function calendar-persian-date-string "cal-persia" (&optional date)) 4136(declare-function calendar-persian-date-string "cal-persia" (&optional date))
4137(defvar calendar-mode-map)
4138(defvar original-date) ; dynamically scoped in calendar.el does scope this
3918(declare-function cdlatex-tab "ext:cdlatex" ()) 4139(declare-function cdlatex-tab "ext:cdlatex" ())
3919(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) 4140(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
4141(declare-function elmo-folder-exists-p "ext:elmo" (folder) t)
4142(declare-function elmo-message-entity-field "ext:elmo-msgdb" (entity field &optional type))
4143(declare-function elmo-message-field "ext:elmo" (folder number field &optional type) t)
4144;; backward compatibility to old version of elmo
4145(declare-function elmo-msgdb-overview-get-entity "ext:elmo" (&rest unknown) t)
4146(defvar font-lock-unfontify-region-function)
3920(declare-function gnus-article-show-summary "gnus-art" ()) 4147(declare-function gnus-article-show-summary "gnus-art" ())
3921(declare-function gnus-summary-last-subject "gnus-sum" ()) 4148(declare-function gnus-summary-last-subject "gnus-sum" ())
4149(defvar gnus-other-frame-object)
4150(defvar gnus-group-name)
4151(defvar gnus-article-current)
4152(defvar Info-current-file)
4153(defvar Info-current-node)
3922(declare-function mh-display-msg "mh-show" (msg-num folder-name)) 4154(declare-function mh-display-msg "mh-show" (msg-num folder-name))
3923(declare-function mh-find-path "mh-utils" ()) 4155(declare-function mh-find-path "mh-utils" ())
3924(declare-function mh-get-header-field "mh-utils" (field)) 4156(declare-function mh-get-header-field "mh-utils" (field))
@@ -3934,16 +4166,25 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
3934(declare-function mh-show-msg "mh-show" (msg)) 4166(declare-function mh-show-msg "mh-show" (msg))
3935(declare-function mh-show-show "mh-show" t t) 4167(declare-function mh-show-show "mh-show" t t)
3936(declare-function mh-visit-folder "mh-folder" (folder &optional range index-data)) 4168(declare-function mh-visit-folder "mh-folder" (folder &optional range index-data))
3937(declare-function org-export-latex-cleaned-string "org-export-latex" (&optional commentsp)) 4169(defvar mh-progs)
4170(defvar mh-current-folder)
4171(defvar mh-show-folder-buffer)
4172(defvar mh-index-folder)
4173(defvar mh-searcher)
4174(declare-function org-export-latex-cleaned-string "org-export-latex" ())
3938(declare-function parse-time-string "parse-time" (string)) 4175(declare-function parse-time-string "parse-time" (string))
3939(declare-function remember "remember" (&optional initial)) 4176(declare-function remember "remember" (&optional initial))
3940(declare-function remember-buffer-desc "remember" ()) 4177(declare-function remember-buffer-desc "remember" ())
4178(defvar remember-save-after-remembering)
4179(defvar remember-data-file)
4180(defvar remember-register)
4181(defvar remember-buffer)
4182(defvar remember-handler-functions)
4183(defvar remember-annotation-functions)
3941(declare-function rmail-narrow-to-non-pruned-header "rmail" ()) 4184(declare-function rmail-narrow-to-non-pruned-header "rmail" ())
3942(declare-function rmail-show-message "rmail" (&optional n no-summary)) 4185(declare-function rmail-show-message "rmail" (&optional n no-summary))
3943(declare-function rmail-what-message "rmail" ()) 4186(declare-function rmail-what-message "rmail" ())
3944(declare-function elmo-folder-exists-p "ext:elmo" (folder) t) 4187(defvar texmathp-why)
3945(declare-function elmo-message-entity-field "ext:elmo-msgdb" (entity field &optional type))
3946(declare-function elmo-message-field "ext:elmo" (folder number field &optional type) t)
3947(declare-function vm-beginning-of-message "ext:vm-page" ()) 4188(declare-function vm-beginning-of-message "ext:vm-page" ())
3948(declare-function vm-follow-summary-cursor "ext:vm-motion" ()) 4189(declare-function vm-follow-summary-cursor "ext:vm-motion" ())
3949(declare-function vm-get-header-contents "ext:vm-summary" (message header-name-regexp &optional clump-sep)) 4190(declare-function vm-get-header-contents "ext:vm-summary" (message header-name-regexp &optional clump-sep))
@@ -3953,6 +4194,12 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
3953(declare-function vm-su-message-id "ext:vm-summary" (m)) 4194(declare-function vm-su-message-id "ext:vm-summary" (m))
3954(declare-function vm-su-subject "ext:vm-summary" (m)) 4195(declare-function vm-su-subject "ext:vm-summary" (m))
3955(declare-function vm-summarize "ext:vm-summary" (&optional display raise)) 4196(declare-function vm-summarize "ext:vm-summary" (&optional display raise))
4197(defvar vm-message-pointer)
4198(defvar vm-folder-directory)
4199(defvar w3m-current-url)
4200(defvar w3m-current-title)
4201;; backward compatibility to old version of wl
4202(declare-function wl-summary-buffer-msgdb "ext:wl-folder" (&rest unknown) t)
3956(declare-function wl-folder-get-elmo-folder "ext:wl-folder" (entity &optional no-cache)) 4203(declare-function wl-folder-get-elmo-folder "ext:wl-folder" (entity &optional no-cache))
3957(declare-function wl-summary-goto-folder-subr "ext:wl-summary" (&optional name scan-type other-window sticky interactive scoring force-exit)) 4204(declare-function wl-summary-goto-folder-subr "ext:wl-summary" (&optional name scan-type other-window sticky interactive scoring force-exit))
3958(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary" (&optional id)) 4205(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary" (&optional id))
@@ -3960,6 +4207,12 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
3960(declare-function wl-summary-line-subject "ext:wl-summary" ()) 4207(declare-function wl-summary-line-subject "ext:wl-summary" ())
3961(declare-function wl-summary-message-number "ext:wl-summary" ()) 4208(declare-function wl-summary-message-number "ext:wl-summary" ())
3962(declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg)) 4209(declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg))
4210(defvar wl-summary-buffer-elmo-folder)
4211(defvar wl-summary-buffer-folder-name)
4212(declare-function speedbar-line-directory "speedbar" (&optional depth))
4213
4214(defvar org-latex-regexps)
4215(defvar constants-unit-system)
3963 4216
3964;;; Variables for pre-computed regular expressions, all buffer local 4217;;; Variables for pre-computed regular expressions, all buffer local
3965 4218
@@ -4134,7 +4387,7 @@ means to push this value onto the list in the variable.")
4134 ((equal key "CATEGORY") 4387 ((equal key "CATEGORY")
4135 (if (string-match "[ \t]+$" value) 4388 (if (string-match "[ \t]+$" value)
4136 (setq value (replace-match "" t t value))) 4389 (setq value (replace-match "" t t value)))
4137 (setq cat (intern value))) 4390 (setq cat value))
4138 ((member key '("SEQ_TODO" "TODO")) 4391 ((member key '("SEQ_TODO" "TODO"))
4139 (push (cons 'sequence (org-split-string value splitre)) kwds)) 4392 (push (cons 'sequence (org-split-string value splitre)) kwds))
4140 ((equal key "TYP_TODO") 4393 ((equal key "TYP_TODO")
@@ -4176,7 +4429,9 @@ means to push this value onto the list in the variable.")
4176 (remove-text-properties 0 (length arch) 4429 (remove-text-properties 0 (length arch)
4177 '(face t fontified t) arch))) 4430 '(face t fontified t) arch)))
4178 ))) 4431 )))
4179 (and cat (org-set-local 'org-category cat)) 4432 (when cat
4433 (org-set-local 'org-category (intern cat))
4434 (push (cons "CATEGORY" cat) props))
4180 (when prio 4435 (when prio
4181 (if (< (length prio) 3) (setq prio '("A" "C" "B"))) 4436 (if (< (length prio) 3) (setq prio '("A" "C" "B")))
4182 (setq prio (mapcar 'string-to-char prio)) 4437 (setq prio (mapcar 'string-to-char prio))
@@ -4332,7 +4587,7 @@ means to push this value onto the list in the variable.")
4332 "\\|" org-closed-string "\\|" org-clock-string 4587 "\\|" org-closed-string "\\|" org-clock-string
4333 "\\)\\>\\)") 4588 "\\)\\>\\)")
4334 ) 4589 )
4335 4590 (org-compute-latex-and-specials-regexp)
4336 (org-set-font-lock-defaults))) 4591 (org-set-font-lock-defaults)))
4337 4592
4338(defun org-remove-keyword-keys (list) 4593(defun org-remove-keyword-keys (list)
@@ -4342,6 +4597,31 @@ means to push this value onto the list in the variable.")
4342 x)) 4597 x))
4343 list)) 4598 list))
4344 4599
4600;; FIXME: this could be done much better, using second characters etc.
4601(defun org-assign-fast-keys (alist)
4602 "Assign fast keys to a keyword-key alist.
4603Respect keys that are already there."
4604 (let (new e k c c1 c2 (char ?a))
4605 (while (setq e (pop alist))
4606 (cond
4607 ((equal e '(:startgroup)) (push e new))
4608 ((equal e '(:endgroup)) (push e new))
4609 (t
4610 (setq k (car e) c2 nil)
4611 (if (cdr e)
4612 (setq c (cdr e))
4613 ;; automatically assign a character.
4614 (setq c1 (string-to-char
4615 (downcase (substring
4616 k (if (= (string-to-char k) ?@) 1 0)))))
4617 (if (or (rassoc c1 new) (rassoc c1 alist))
4618 (while (or (rassoc char new) (rassoc char alist))
4619 (setq char (1+ char)))
4620 (setq c2 c1))
4621 (setq c (or c2 char)))
4622 (push (cons k c) new))))
4623 (nreverse new)))
4624
4345;;; Some variables ujsed in various places 4625;;; Some variables ujsed in various places
4346 4626
4347(defvar org-window-configuration nil 4627(defvar org-window-configuration nil
@@ -4350,49 +4630,6 @@ means to push this value onto the list in the variable.")
4350 "Function to be called when `C-c C-c' is used. 4630 "Function to be called when `C-c C-c' is used.
4351This is for getting out of special buffers like remember.") 4631This is for getting out of special buffers like remember.")
4352 4632
4353;;; Foreign variables, to inform the compiler
4354
4355;; XEmacs only
4356(defvar outline-mode-menu-heading)
4357(defvar outline-mode-menu-show)
4358(defvar outline-mode-menu-hide)
4359(defvar zmacs-regions) ; XEmacs regions
4360;; Emacs only
4361(defvar mark-active)
4362
4363;; Packages that org-mode interacts with
4364(defvar calc-embedded-close-formula)
4365(defvar calc-embedded-open-formula)
4366(defvar font-lock-unfontify-region-function)
4367(defvar org-goto-start-pos)
4368(defvar vm-message-pointer)
4369(defvar vm-folder-directory)
4370(defvar wl-summary-buffer-elmo-folder)
4371(defvar wl-summary-buffer-folder-name)
4372(defvar gnus-other-frame-object)
4373(defvar gnus-group-name)
4374(defvar gnus-article-current)
4375(defvar w3m-current-url)
4376(defvar w3m-current-title)
4377(defvar mh-progs)
4378(defvar mh-current-folder)
4379(defvar mh-show-folder-buffer)
4380(defvar mh-index-folder)
4381(defvar mh-searcher)
4382(defvar calendar-mode-map)
4383(defvar Info-current-file)
4384(defvar Info-current-node)
4385(defvar texmathp-why)
4386(defvar remember-save-after-remembering)
4387(defvar remember-data-file)
4388(defvar remember-register)
4389(defvar remember-buffer)
4390(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode'
4391(defvar initial) ; from remember.el, dynamically scoped in `remember-mode'
4392(defvar org-latex-regexps)
4393(defvar constants-unit-system)
4394
4395(defvar original-date) ; dynamically scoped in calendar.el does scope this
4396 4633
4397;; FIXME: Occasionally check by commenting these, to make sure 4634;; FIXME: Occasionally check by commenting these, to make sure
4398;; no other functions uses these, forgetting to let-bind them. 4635;; no other functions uses these, forgetting to let-bind them.
@@ -4402,7 +4639,6 @@ This is for getting out of special buffers like remember.")
4402(defvar date) 4639(defvar date)
4403(defvar description) 4640(defvar description)
4404 4641
4405
4406;; Defined somewhere in this file, but used before definition. 4642;; Defined somewhere in this file, but used before definition.
4407(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized 4643(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
4408(defvar org-agenda-buffer-name) 4644(defvar org-agenda-buffer-name)
@@ -4495,8 +4731,10 @@ Works on both Emacs and XEmacs."
4495 (if org-ignore-region 4731 (if org-ignore-region
4496 nil 4732 nil
4497 (if (featurep 'xemacs) 4733 (if (featurep 'xemacs)
4498 (region-active-p) 4734 (and zmacs-regions (region-active-p))
4499 (use-region-p)))) 4735 (if (fboundp 'use-region-p)
4736 (use-region-p)
4737 (and transient-mark-mode mark-active))))) ; Emacs 22 and before
4500 4738
4501;; Invisibility compatibility 4739;; Invisibility compatibility
4502 4740
@@ -4624,6 +4862,10 @@ The following commands are available:
4624; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping 4862; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping
4625 (org-set-local 'comment-padding " ") 4863 (org-set-local 'comment-padding " ")
4626 4864
4865 ;; Imenu
4866 (org-set-local 'imenu-create-index-function
4867 'org-imenu-get-tree)
4868
4627 ;; Make isearch reveal context 4869 ;; Make isearch reveal context
4628 (if (or (featurep 'xemacs) 4870 (if (or (featurep 'xemacs)
4629 (not (boundp 'outline-isearch-open-invisible-function))) 4871 (not (boundp 'outline-isearch-open-invisible-function)))
@@ -4704,7 +4946,7 @@ that will be added to PLIST. Returns the string that was modified."
4704 4946
4705(defconst org-non-link-chars "]\t\n\r<>") 4947(defconst org-non-link-chars "]\t\n\r<>")
4706(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" "bbdb" "vm" 4948(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" "bbdb" "vm"
4707 "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp")) 4949 "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp" "message"))
4708(defvar org-link-re-with-space nil 4950(defvar org-link-re-with-space nil
4709 "Matches a link with spaces, optional angular brackets around it.") 4951 "Matches a link with spaces, optional angular brackets around it.")
4710(defvar org-link-re-with-space2 nil 4952(defvar org-link-re-with-space2 nil
@@ -4749,7 +4991,7 @@ This should be called after the variable `org-link-types' has changed."
4749 "\\)>") 4991 "\\)>")
4750 org-plain-link-re 4992 org-plain-link-re
4751 (concat 4993 (concat
4752 "\\(" (mapconcat 'identity org-link-types "\\|") "\\):" 4994 "\\<\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
4753 "\\([^]\t\n\r<>,;() ]+\\)") 4995 "\\([^]\t\n\r<>,;() ]+\\)")
4754 org-bracket-link-regexp 4996 org-bracket-link-regexp
4755 "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" 4997 "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]"
@@ -4810,7 +5052,12 @@ The time stamps may be either active or inactive.")
4810 org-emphasis-alist))) 5052 org-emphasis-alist)))
4811 (add-text-properties (match-beginning 2) (match-end 2) 5053 (add-text-properties (match-beginning 2) (match-end 2)
4812 '(font-lock-multiline t)) 5054 '(font-lock-multiline t))
4813 (backward-char 1)))) 5055 (when org-hide-emphasis-markers
5056 (add-text-properties (match-end 4) (match-beginning 5)
5057 '(invisible org-link))
5058 (add-text-properties (match-beginning 3) (match-end 3)
5059 '(invisible org-link)))))
5060 (backward-char 1))
4814 rtn)) 5061 rtn))
4815 5062
4816(defun org-emphasize (&optional char) 5063(defun org-emphasize (&optional char)
@@ -4925,10 +5172,10 @@ We use a macro so that the test can happen at compilation time."
4925 (ip (org-maybe-intangible 5172 (ip (org-maybe-intangible
4926 (list 'invisible 'org-link 'rear-nonsticky org-nonsticky-props 5173 (list 'invisible 'org-link 'rear-nonsticky org-nonsticky-props
4927 'keymap org-mouse-map 'mouse-face 'highlight 5174 'keymap org-mouse-map 'mouse-face 'highlight
4928 'help-echo help))) 5175 'font-lock-multiline t 'help-echo help)))
4929 (vp (list 'rear-nonsticky org-nonsticky-props 5176 (vp (list 'rear-nonsticky org-nonsticky-props
4930 'keymap org-mouse-map 'mouse-face 'highlight 5177 'keymap org-mouse-map 'mouse-face 'highlight
4931 'help-echo help))) 5178 ' font-lock-multiline t 'help-echo help)))
4932 ;; We need to remove the invisible property here. Table narrowing 5179 ;; We need to remove the invisible property here. Table narrowing
4933 ;; may have made some of this invisible. 5180 ;; may have made some of this invisible.
4934 (remove-text-properties (match-beginning 0) (match-end 0) 5181 (remove-text-properties (match-beginning 0) (match-end 0)
@@ -4998,6 +5245,97 @@ We use a macro so that the test can happen at compilation time."
4998 (goto-char e) 5245 (goto-char e)
4999 t))) 5246 t)))
5000 5247
5248(defvar org-latex-and-specials-regexp nil
5249 "Regular expression for highlighting export special stuff.")
5250(defvar org-match-substring-regexp)
5251(defvar org-match-substring-with-braces-regexp)
5252(defvar org-export-html-special-string-regexps)
5253
5254(defun org-compute-latex-and-specials-regexp ()
5255 "Compute regular expression for stuff treated specially by exporters."
5256 (if (not org-highlight-latex-fragments-and-specials)
5257 (org-set-local 'org-latex-and-specials-regexp nil)
5258 (let*
5259 ((matchers (plist-get org-format-latex-options :matchers))
5260 (latexs (delq nil (mapcar (lambda (x) (if (member (car x) matchers) x))
5261 org-latex-regexps)))
5262 (options (org-combine-plists (org-default-export-plist)
5263 (org-infile-export-plist)))
5264 (org-export-with-sub-superscripts (plist-get options :sub-superscript))
5265 (org-export-with-LaTeX-fragments (plist-get options :LaTeX-fragments))
5266 (org-export-with-TeX-macros (plist-get options :TeX-macros))
5267 (org-export-html-expand (plist-get options :expand-quoted-html))
5268 (org-export-with-special-strings (plist-get options :special-strings))
5269 (re-sub
5270 (cond
5271 ((equal org-export-with-sub-superscripts '{})
5272 (list org-match-substring-with-braces-regexp))
5273 (org-export-with-sub-superscripts
5274 (list org-match-substring-regexp))
5275 (t nil)))
5276 (re-latex
5277 (if org-export-with-LaTeX-fragments
5278 (mapcar (lambda (x) (nth 1 x)) latexs)))
5279 (re-macros
5280 (if org-export-with-TeX-macros
5281 (list (concat "\\\\"
5282 (regexp-opt
5283 (append (mapcar 'car org-html-entities)
5284 (if (boundp 'org-latex-entities)
5285 org-latex-entities nil))
5286 'words))) ; FIXME
5287 ))
5288 ;; (list "\\\\\\(?:[a-zA-Z]+\\)")))
5289 (re-special (if org-export-with-special-strings
5290 (mapcar (lambda (x) (car x))
5291 org-export-html-special-string-regexps)))
5292 (re-rest
5293 (delq nil
5294 (list
5295 (if org-export-html-expand "@<[^>\n]+>")
5296 ))))
5297 (org-set-local
5298 'org-latex-and-specials-regexp
5299 (mapconcat 'identity (append re-latex re-sub re-macros re-special
5300 re-rest) "\\|")))))
5301
5302(defface org-latex-and-export-specials
5303 (let ((font (cond ((assq :inherit custom-face-attributes)
5304 '(:inherit underline))
5305 (t '(:underline t)))))
5306 `((((class grayscale) (background light))
5307 (:foreground "DimGray" ,@font))
5308 (((class grayscale) (background dark))
5309 (:foreground "LightGray" ,@font))
5310 (((class color) (background light))
5311 (:foreground "SaddleBrown"))
5312 (((class color) (background dark))
5313 (:foreground "burlywood"))
5314 (t (,@font))))
5315 "Face used to highlight math latex and other special exporter stuff."
5316 :group 'org-faces)
5317
5318(defun org-do-latex-and-special-faces (limit)
5319 "Run through the buffer and add overlays to links."
5320 (when org-latex-and-specials-regexp
5321 (let (rtn d)
5322 (while (and (not rtn) (re-search-forward org-latex-and-specials-regexp
5323 limit t))
5324 (if (not (memq (car-safe (get-text-property (1+ (match-beginning 0))
5325 'face))
5326 '(org-code org-verbatim underline)))
5327 (progn
5328 (setq rtn t
5329 d (cond ((member (char-after (1+ (match-beginning 0)))
5330 '(?_ ?^)) 1)
5331 (t 0)))
5332 (font-lock-prepend-text-property
5333 (+ d (match-beginning 0)) (match-end 0)
5334 'face 'org-latex-and-export-specials)
5335 (add-text-properties (+ d (match-beginning 0)) (match-end 0)
5336 '(font-lock-multiline t)))))
5337 rtn)))
5338
5001(defun org-restart-font-lock () 5339(defun org-restart-font-lock ()
5002 "Restart font-lock-mode, to force refontification." 5340 "Restart font-lock-mode, to force refontification."
5003 (when (and (boundp 'font-lock-mode) font-lock-mode) 5341 (when (and (boundp 'font-lock-mode) font-lock-mode)
@@ -5064,7 +5402,7 @@ between words."
5064 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" 5402 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
5065 (1 'org-table t)) 5403 (1 'org-table t))
5066 ;; Table internals 5404 ;; Table internals
5067 '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t)) 5405 '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t))
5068 '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) 5406 '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
5069 '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) 5407 '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
5070 ;; Drawers 5408 ;; Drawers
@@ -5113,14 +5451,17 @@ between words."
5113 (if org-provide-checkbox-statistics 5451 (if org-provide-checkbox-statistics
5114 '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" 5452 '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
5115 (0 (org-get-checkbox-statistics-face) t))) 5453 (0 (org-get-checkbox-statistics-face) t)))
5454 (list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)")
5455 '(1 'org-archived prepend))
5456 ;; Specials
5457 '(org-do-latex-and-special-faces)
5458 ;; Code
5459 '(org-activate-code (1 'org-code t))
5116 ;; COMMENT 5460 ;; COMMENT
5117 (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string 5461 (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string
5118 "\\|" org-quote-string "\\)\\>") 5462 "\\|" org-quote-string "\\)\\>")
5119 '(1 'org-special-keyword t)) 5463 '(1 'org-special-keyword t))
5120 '("^#.*" (0 'font-lock-comment-face t)) 5464 '("^#.*" (0 'font-lock-comment-face t))
5121 '("^\\*+ \\(.*:ARCHIVE:.*\\)" (1 'org-archived prepend))
5122 ;; Code
5123 '(org-activate-code (1 'org-code t))
5124 ))) 5465 )))
5125 (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) 5466 (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
5126 ;; Now set the full font-lock-keywords 5467 ;; Now set the full font-lock-keywords
@@ -5345,12 +5686,12 @@ If KWD is a number, get the corresponding match group."
5345 (>= (match-end 0) pos)))) 5686 (>= (match-end 0) pos))))
5346 t 5687 t
5347 (eq org-cycle-emulate-tab t)) 5688 (eq org-cycle-emulate-tab t))
5348 (if (and (looking-at "[ \n\r\t]") 5689; (if (and (looking-at "[ \n\r\t]")
5349 (string-match "^[ \t]*$" (buffer-substring 5690; (string-match "^[ \t]*$" (buffer-substring
5350 (point-at-bol) (point)))) 5691; (point-at-bol) (point))))
5351 (progn 5692; (progn
5352 (beginning-of-line 1) 5693; (beginning-of-line 1)
5353 (and (looking-at "[ \t]+") (replace-match "")))) 5694; (and (looking-at "[ \t]+") (replace-match ""))))
5354 (call-interactively (global-key-binding "\t"))) 5695 (call-interactively (global-key-binding "\t")))
5355 5696
5356 (t (save-excursion 5697 (t (save-excursion
@@ -5418,6 +5759,17 @@ This function is the default value of the hook `org-cycle-hook'."
5418 ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) 5759 ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1)))
5419 ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) 5760 ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1))))))
5420 5761
5762(defun org-compact-display-after-subtree-move ()
5763 (let (beg end)
5764 (save-excursion
5765 (if (org-up-heading-safe)
5766 (progn
5767 (hide-subtree)
5768 (show-entry)
5769 (show-children)
5770 (org-cycle-show-empty-lines 'children)
5771 (org-cycle-hide-drawers 'children))
5772 (org-overview)))))
5421 5773
5422(defun org-cycle-show-empty-lines (state) 5774(defun org-cycle-show-empty-lines (state)
5423 "Show empty lines above all visible headlines. 5775 "Show empty lines above all visible headlines.
@@ -5508,6 +5860,8 @@ RET=jump to location [Q]uit and return to previous location
5508\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur" 5860\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur"
5509) 5861)
5510 5862
5863(defvar org-goto-start-pos) ; dynamically scoped parameter
5864
5511(defun org-goto () 5865(defun org-goto ()
5512 "Look up a different location in the current file, keeping current visibility. 5866 "Look up a different location in the current file, keeping current visibility.
5513 5867
@@ -5631,8 +5985,10 @@ or nil."
5631 "Create indirect buffer and narrow it to current subtree. 5985 "Create indirect buffer and narrow it to current subtree.
5632With numerical prefix ARG, go up to this level and then take that tree. 5986With numerical prefix ARG, go up to this level and then take that tree.
5633If ARG is negative, go up that many levels. 5987If ARG is negative, go up that many levels.
5634Normally this command removes the indirect buffer previously made 5988If `org-indirect-buffer-display' is not `new-frame', the command removes the
5635with this command. However, when called with a C-u prefix, the last buffer 5989indirect buffer previously made with this command, to avoid proliferation of
5990indirect buffers. However, when you call the command with a `C-u' prefix, or
5991when `org-indirect-buffer-display' is `new-frame', the last buffer
5636is kept so that you can work with several indirect buffers at the same time. 5992is kept so that you can work with several indirect buffers at the same time.
5637If `org-indirect-buffer-display' is `dedicated-frame', the C-u prefix also 5993If `org-indirect-buffer-display' is `dedicated-frame', the C-u prefix also
5638requests that a new frame be made for the new buffer, so that the dedicated 5994requests that a new frame be made for the new buffer, so that the dedicated
@@ -5652,8 +6008,9 @@ frame is not changed."
5652 (setq beg (point) 6008 (setq beg (point)
5653 heading (org-get-heading)) 6009 heading (org-get-heading))
5654 (org-end-of-subtree t) (setq end (point))) 6010 (org-end-of-subtree t) (setq end (point)))
5655 (if (and (not arg) 6011 (if (and (buffer-live-p org-last-indirect-buffer)
5656 (buffer-live-p org-last-indirect-buffer)) 6012 (not (eq org-indirect-buffer-display 'new-frame))
6013 (not arg))
5657 (kill-buffer org-last-indirect-buffer)) 6014 (kill-buffer org-last-indirect-buffer))
5658 (setq ibuf (org-get-indirect-buffer cbuf) 6015 (setq ibuf (org-get-indirect-buffer cbuf)
5659 org-last-indirect-buffer ibuf) 6016 org-last-indirect-buffer ibuf)
@@ -5917,7 +6274,8 @@ would end up with no indentation after the change, nothing at all is done."
5917 col) 6274 col)
5918 (unless (save-excursion (end-of-line 1) 6275 (unless (save-excursion (end-of-line 1)
5919 (re-search-forward prohibit end t)) 6276 (re-search-forward prohibit end t))
5920 (while (re-search-forward "^[ \t]+" end t) 6277 (while (and (< (point) end)
6278 (re-search-forward "^[ \t]+" end t))
5921 (goto-char (match-end 0)) 6279 (goto-char (match-end 0))
5922 (setq col (current-column)) 6280 (setq col (current-column))
5923 (if (< diff 0) (replace-match "")) 6281 (if (< diff 0) (replace-match ""))
@@ -5980,38 +6338,65 @@ is signaled in this case."
5980 'outline-get-last-sibling)) 6338 'outline-get-last-sibling))
5981 (ins-point (make-marker)) 6339 (ins-point (make-marker))
5982 (cnt (abs arg)) 6340 (cnt (abs arg))
5983 beg end txt folded) 6341 beg beg0 end txt folded ne-beg ne-end ne-ins ins-end)
5984 ;; Select the tree 6342 ;; Select the tree
5985 (org-back-to-heading) 6343 (org-back-to-heading)
5986 (setq beg (point)) 6344 (setq beg0 (point))
6345 (save-excursion
6346 (setq ne-beg (org-back-over-empty-lines))
6347 (setq beg (point)))
5987 (save-match-data 6348 (save-match-data
5988 (save-excursion (outline-end-of-heading) 6349 (save-excursion (outline-end-of-heading)
5989 (setq folded (org-invisible-p))) 6350 (setq folded (org-invisible-p)))
5990 (outline-end-of-subtree)) 6351 (outline-end-of-subtree))
5991 (outline-next-heading) 6352 (outline-next-heading)
6353 (setq ne-end (org-back-over-empty-lines))
5992 (setq end (point)) 6354 (setq end (point))
6355 (goto-char beg0)
6356 (when (and (> arg 0) (org-first-sibling-p) (< ne-end ne-beg))
6357 ;; include less whitespace
6358 (save-excursion
6359 (goto-char beg)
6360 (forward-line (- ne-beg ne-end))
6361 (setq beg (point))))
5993 ;; Find insertion point, with error handling 6362 ;; Find insertion point, with error handling
5994 (goto-char beg)
5995 (while (> cnt 0) 6363 (while (> cnt 0)
5996 (or (and (funcall movfunc) (looking-at outline-regexp)) 6364 (or (and (funcall movfunc) (looking-at outline-regexp))
5997 (progn (goto-char beg) 6365 (progn (goto-char beg0)
5998 (error "Cannot move past superior level or buffer limit"))) 6366 (error "Cannot move past superior level or buffer limit")))
5999 (setq cnt (1- cnt))) 6367 (setq cnt (1- cnt)))
6000 (if (> arg 0) 6368 (if (> arg 0)
6001 ;; Moving forward - still need to move over subtree 6369 ;; Moving forward - still need to move over subtree
6002 (progn (outline-end-of-subtree) 6370 (progn (org-end-of-subtree t t)
6003 (outline-next-heading) 6371 (save-excursion
6004 (if (not (or (looking-at (concat "^" outline-regexp)) 6372 (org-back-over-empty-lines)
6005 (bolp))) 6373 (or (bolp) (newline)))))
6006 (newline)))) 6374 (setq ne-ins (org-back-over-empty-lines))
6007 (move-marker ins-point (point)) 6375 (move-marker ins-point (point))
6008 (setq txt (buffer-substring beg end)) 6376 (setq txt (buffer-substring beg end))
6009 (delete-region beg end) 6377 (delete-region beg end)
6378 (outline-flag-region (1- beg) beg nil)
6379 (outline-flag-region (1- (point)) (point) nil)
6010 (insert txt) 6380 (insert txt)
6011 (or (bolp) (insert "\n")) 6381 (or (bolp) (insert "\n"))
6382 (setq ins-end (point))
6012 (goto-char ins-point) 6383 (goto-char ins-point)
6013 (if folded (hide-subtree)) 6384 (org-skip-whitespace)
6014 (move-marker ins-point nil))) 6385 (when (and (< arg 0)
6386 (org-first-sibling-p)
6387 (> ne-ins ne-beg))
6388 ;; Move whitespace back to beginning
6389 (save-excursion
6390 (goto-char ins-end)
6391 (let ((kill-whole-line t))
6392 (kill-line (- ne-ins ne-beg)) (point)))
6393 (insert (make-string (- ne-ins ne-beg) ?\n)))
6394 (move-marker ins-point nil)
6395 (org-compact-display-after-subtree-move)
6396 (unless folded
6397 (org-show-entry)
6398 (show-children)
6399 (org-cycle-hide-drawers 'children))))
6015 6400
6016(defvar org-subtree-clip "" 6401(defvar org-subtree-clip ""
6017 "Clipboard for cut and paste of subtrees. 6402 "Clipboard for cut and paste of subtrees.
@@ -6035,11 +6420,13 @@ With prefix arg N, cut this many sequential subtrees.
6035This is a short-hand for marking the subtree and then copying it. 6420This is a short-hand for marking the subtree and then copying it.
6036If CUT is non-nil, actually cut the subtree." 6421If CUT is non-nil, actually cut the subtree."
6037 (interactive "p") 6422 (interactive "p")
6038 (let (beg end folded) 6423 (let (beg end folded (beg0 (point)))
6039 (if (interactive-p) 6424 (if (interactive-p)
6040 (org-back-to-heading nil) ; take what looks like a subtree 6425 (org-back-to-heading nil) ; take what looks like a subtree
6041 (org-back-to-heading t)) ; take what is really there 6426 (org-back-to-heading t)) ; take what is really there
6427 (org-back-over-empty-lines)
6042 (setq beg (point)) 6428 (setq beg (point))
6429 (skip-chars-forward " \t\r\n")
6043 (save-match-data 6430 (save-match-data
6044 (save-excursion (outline-end-of-heading) 6431 (save-excursion (outline-end-of-heading)
6045 (setq folded (org-invisible-p))) 6432 (setq folded (org-invisible-p)))
@@ -6047,8 +6434,9 @@ If CUT is non-nil, actually cut the subtree."
6047 (outline-forward-same-level (1- n)) 6434 (outline-forward-same-level (1- n))
6048 (error nil)) 6435 (error nil))
6049 (org-end-of-subtree t t)) 6436 (org-end-of-subtree t t))
6437 (org-back-over-empty-lines)
6050 (setq end (point)) 6438 (setq end (point))
6051 (goto-char beg) 6439 (goto-char beg0)
6052 (when (> end beg) 6440 (when (> end beg)
6053 (setq org-subtree-clip-folded folded) 6441 (setq org-subtree-clip-folded folded)
6054 (if cut (kill-region beg end) (copy-region-as-kill beg end)) 6442 (if cut (kill-region beg end) (copy-region-as-kill beg end))
@@ -6124,11 +6512,14 @@ If optional TREE is given, use this text instead of the kill ring."
6124 (delete-region (point-at-bol) (point))) 6512 (delete-region (point-at-bol) (point)))
6125 ;; Paste 6513 ;; Paste
6126 (beginning-of-line 1) 6514 (beginning-of-line 1)
6515 (org-back-over-empty-lines) ;; FIXME: correct fix????
6127 (setq beg (point)) 6516 (setq beg (point))
6128 (insert txt) 6517 (insert-before-markers txt) ;; FIXME: correct fix????
6129 (unless (string-match "\n[ \t]*\\'" txt) (insert "\n")) 6518 (unless (string-match "\n\\'" txt) (insert "\n"))
6130 (setq end (point)) 6519 (setq end (point))
6131 (goto-char beg) 6520 (goto-char beg)
6521 (skip-chars-forward " \t\n\r")
6522 (setq beg (point))
6132 ;; Shift if necessary 6523 ;; Shift if necessary
6133 (unless (= shift 0) 6524 (unless (= shift 0)
6134 (save-restriction 6525 (save-restriction
@@ -6154,10 +6545,12 @@ which is OK for `org-paste-subtree'.
6154If optional TXT is given, check this string instead of the current kill." 6545If optional TXT is given, check this string instead of the current kill."
6155 (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) 6546 (let* ((kill (or txt (and kill-ring (current-kill 0)) ""))
6156 (start-level (and kill 6547 (start-level (and kill
6157 (string-match (concat "\\`" org-outline-regexp) kill) 6548 (string-match (concat "\\`\\([ \t\n\r]*?\n\\)?\\("
6158 (- (match-end 0) (match-beginning 0) 1))) 6549 org-outline-regexp "\\)")
6550 kill)
6551 (- (match-end 2) (match-beginning 2) 1)))
6159 (re (concat "^" org-outline-regexp)) 6552 (re (concat "^" org-outline-regexp))
6160 (start 1)) 6553 (start (1+ (match-beginning 2))))
6161 (if (not start-level) 6554 (if (not start-level)
6162 (progn 6555 (progn
6163 nil) ;; does not even start with a heading 6556 nil) ;; does not even start with a heading
@@ -6228,7 +6621,11 @@ WITH-CASE, the sorting considers case as well."
6228 (condition-case nil (progn (org-back-to-heading) t) (error nil))) 6621 (condition-case nil (progn (org-back-to-heading) t) (error nil)))
6229 ;; we will sort the children of the current headline 6622 ;; we will sort the children of the current headline
6230 (org-back-to-heading) 6623 (org-back-to-heading)
6231 (setq start (point) end (org-end-of-subtree) what "children") 6624 (setq start (point)
6625 end (progn (org-end-of-subtree t t)
6626 (org-back-over-empty-lines)
6627 (point))
6628 what "children")
6232 (goto-char start) 6629 (goto-char start)
6233 (show-subtree) 6630 (show-subtree)
6234 (outline-next-heading)) 6631 (outline-next-heading))
@@ -6309,12 +6706,12 @@ WITH-CASE, the sorting considers case as well."
6309 (cond 6706 (cond
6310 ((= dcst ?n) 6707 ((= dcst ?n)
6311 (string-to-number (buffer-substring (match-end 0) 6708 (string-to-number (buffer-substring (match-end 0)
6312 (line-end-position)))) 6709 (point-at-eol))))
6313 ((= dcst ?a) 6710 ((= dcst ?a)
6314 (buffer-substring (match-end 0) (line-end-position))) 6711 (buffer-substring (match-end 0) (point-at-eol)))
6315 ((= dcst ?t) 6712 ((= dcst ?t)
6316 (if (re-search-forward org-ts-regexp 6713 (if (re-search-forward org-ts-regexp
6317 (line-end-position) t) 6714 (point-at-eol) t)
6318 (org-time-string-to-time (match-string 0)) 6715 (org-time-string-to-time (match-string 0))
6319 now)) 6716 now))
6320 ((= dcst ?f) 6717 ((= dcst ?f)
@@ -6330,11 +6727,11 @@ WITH-CASE, the sorting considers case as well."
6330 ((= dcst ?n) 6727 ((= dcst ?n)
6331 (if (looking-at outline-regexp) 6728 (if (looking-at outline-regexp)
6332 (string-to-number (buffer-substring (match-end 0) 6729 (string-to-number (buffer-substring (match-end 0)
6333 (line-end-position))) 6730 (point-at-eol)))
6334 nil)) 6731 nil))
6335 ((= dcst ?a) 6732 ((= dcst ?a)
6336 (funcall case-func (buffer-substring (line-beginning-position) 6733 (funcall case-func (buffer-substring (point-at-bol)
6337 (line-end-position)))) 6734 (point-at-eol))))
6338 ((= dcst ?t) 6735 ((= dcst ?t)
6339 (if (re-search-forward org-ts-regexp 6736 (if (re-search-forward org-ts-regexp
6340 (save-excursion 6737 (save-excursion
@@ -6343,7 +6740,7 @@ WITH-CASE, the sorting considers case as well."
6343 (org-time-string-to-time (match-string 0)) 6740 (org-time-string-to-time (match-string 0))
6344 now)) 6741 now))
6345 ((= dcst ?p) 6742 ((= dcst ?p)
6346 (if (re-search-forward org-priority-regexp (line-end-position) t) 6743 (if (re-search-forward org-priority-regexp (point-at-eol) t)
6347 (string-to-char (match-string 2)) 6744 (string-to-char (match-string 2))
6348 org-default-priority)) 6745 org-default-priority))
6349 ((= dcst ?r) 6746 ((= dcst ?r)
@@ -6383,7 +6780,8 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive."
6383 (setq extractfun 'string-to-number 6780 (setq extractfun 'string-to-number
6384 comparefun (if (= dcst sorting-type) '< '>))) 6781 comparefun (if (= dcst sorting-type) '< '>)))
6385 ((= dcst ?a) 6782 ((= dcst ?a)
6386 (setq extractfun (if with-case 'identity 'downcase) 6783 (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x))
6784 (lambda(x) (downcase (org-sort-remove-invisible x))))
6387 comparefun (if (= dcst sorting-type) 6785 comparefun (if (= dcst sorting-type)
6388 'string< 6786 'string<
6389 (lambda (a b) (and (not (string< a b)) 6787 (lambda (a b) (and (not (string< a b))
@@ -6483,12 +6881,13 @@ Return t when things worked, nil when we are not in an item."
6483 ((org-on-heading-p) 6881 ((org-on-heading-p)
6484 (setq beg (point) end (save-excursion (outline-next-heading) (point)))) 6882 (setq beg (point) end (save-excursion (outline-next-heading) (point))))
6485 ((org-at-item-checkbox-p) 6883 ((org-at-item-checkbox-p)
6486 (save-excursion 6884 (let ((pos (point)))
6487 (replace-match 6885 (replace-match
6488 (cond (arg "[-]") 6886 (cond (arg "[-]")
6489 ((member (match-string 0) '("[ ]" "[-]")) "[X]") 6887 ((member (match-string 0) '("[ ]" "[-]")) "[X]")
6490 (t "[ ]")) 6888 (t "[ ]"))
6491 t t)) 6889 t t)
6890 (goto-char pos))
6492 (throw 'exit t)) 6891 (throw 'exit t))
6493 (t (error "Not at a checkbox or heading, and no active region"))) 6892 (t (error "Not at a checkbox or heading, and no active region")))
6494 (save-excursion 6893 (save-excursion
@@ -6707,27 +7106,49 @@ Error if not at a plain list, or if this is the first item in the list."
6707 (error (goto-char pos) 7106 (error (goto-char pos)
6708 (error "On first item"))))) 7107 (error "On first item")))))
6709 7108
7109(defun org-first-list-item-p ()
7110 "Is this heading the item in a plain list?"
7111 (unless (org-at-item-p)
7112 (error "Not at a plain list item"))
7113 (org-beginning-of-item)
7114 (= (point) (save-excursion (org-beginning-of-item-list))))
7115
6710(defun org-move-item-down () 7116(defun org-move-item-down ()
6711 "Move the plain list item at point down, i.e. swap with following item. 7117 "Move the plain list item at point down, i.e. swap with following item.
6712Subitems (items with larger indentation) are considered part of the item, 7118Subitems (items with larger indentation) are considered part of the item,
6713so this really moves item trees." 7119so this really moves item trees."
6714 (interactive) 7120 (interactive)
6715 (let (beg end ind ind1 (pos (point)) txt) 7121 (let (beg beg0 end end0 ind ind1 (pos (point)) txt ne-end ne-beg)
6716 (org-beginning-of-item) 7122 (org-beginning-of-item)
6717 (setq beg (point)) 7123 (setq beg0 (point))
7124 (save-excursion
7125 (setq ne-beg (org-back-over-empty-lines))
7126 (setq beg (point)))
7127 (goto-char beg0)
6718 (setq ind (org-get-indentation)) 7128 (setq ind (org-get-indentation))
6719 (org-end-of-item) 7129 (org-end-of-item)
6720 (setq end (point)) 7130 (setq end0 (point))
6721 (setq ind1 (org-get-indentation)) 7131 (setq ind1 (org-get-indentation))
7132 (setq ne-end (org-back-over-empty-lines))
7133 (setq end (point))
7134 (goto-char beg0)
7135 (when (and (org-first-list-item-p) (< ne-end ne-beg))
7136 ;; include less whitespace
7137 (save-excursion
7138 (goto-char beg)
7139 (forward-line (- ne-beg ne-end))
7140 (setq beg (point))))
7141 (goto-char end0)
6722 (if (and (org-at-item-p) (= ind ind1)) 7142 (if (and (org-at-item-p) (= ind ind1))
6723 (progn 7143 (progn
6724 (org-end-of-item) 7144 (org-end-of-item)
7145 (org-back-over-empty-lines)
6725 (setq txt (buffer-substring beg end)) 7146 (setq txt (buffer-substring beg end))
6726 (save-excursion 7147 (save-excursion
6727 (delete-region beg end)) 7148 (delete-region beg end))
6728 (setq pos (point)) 7149 (setq pos (point))
6729 (insert txt) 7150 (insert txt)
6730 (goto-char pos) 7151 (goto-char pos) (org-skip-whitespace)
6731 (org-maybe-renumber-ordered-list)) 7152 (org-maybe-renumber-ordered-list))
6732 (goto-char pos) 7153 (goto-char pos)
6733 (error "Cannot move this item further down")))) 7154 (error "Cannot move this item further down"))))
@@ -6737,13 +7158,19 @@ so this really moves item trees."
6737Subitems (items with larger indentation) are considered part of the item, 7158Subitems (items with larger indentation) are considered part of the item,
6738so this really moves item trees." 7159so this really moves item trees."
6739 (interactive "p") 7160 (interactive "p")
6740 (let (beg end ind ind1 (pos (point)) txt) 7161 (let (beg beg0 end end0 ind ind1 (pos (point)) txt
7162 ne-beg ne-end ne-ins ins-end)
6741 (org-beginning-of-item) 7163 (org-beginning-of-item)
6742 (setq beg (point)) 7164 (setq beg0 (point))
6743 (setq ind (org-get-indentation)) 7165 (setq ind (org-get-indentation))
7166 (save-excursion
7167 (setq ne-beg (org-back-over-empty-lines))
7168 (setq beg (point)))
7169 (goto-char beg0)
6744 (org-end-of-item) 7170 (org-end-of-item)
7171 (setq ne-end (org-back-over-empty-lines))
6745 (setq end (point)) 7172 (setq end (point))
6746 (goto-char beg) 7173 (goto-char beg0)
6747 (catch 'exit 7174 (catch 'exit
6748 (while t 7175 (while t
6749 (beginning-of-line 0) 7176 (beginning-of-line 0)
@@ -6762,12 +7189,23 @@ so this really moves item trees."
6762 (setq ind1 (org-get-indentation)) 7189 (setq ind1 (org-get-indentation))
6763 (if (and (org-at-item-p) (= ind ind1)) 7190 (if (and (org-at-item-p) (= ind ind1))
6764 (progn 7191 (progn
7192 (setq ne-ins (org-back-over-empty-lines))
6765 (setq txt (buffer-substring beg end)) 7193 (setq txt (buffer-substring beg end))
6766 (save-excursion 7194 (save-excursion
6767 (delete-region beg end)) 7195 (delete-region beg end))
6768 (setq pos (point)) 7196 (setq pos (point))
6769 (insert txt) 7197 (insert txt)
6770 (goto-char pos) 7198 (setq ins-end (point))
7199 (goto-char pos) (org-skip-whitespace)
7200
7201 (when (and (org-first-list-item-p) (> ne-ins ne-beg))
7202 ;; Move whitespace back to beginning
7203 (save-excursion
7204 (goto-char ins-end)
7205 (let ((kill-whole-line t))
7206 (kill-line (- ne-ins ne-beg)) (point)))
7207 (insert (make-string (- ne-ins ne-beg) ?\n)))
7208
6771 (org-maybe-renumber-ordered-list)) 7209 (org-maybe-renumber-ordered-list))
6772 (goto-char pos) 7210 (goto-char pos)
6773 (error "Cannot move this item further up")))) 7211 (error "Cannot move this item further up"))))
@@ -7090,7 +7528,7 @@ C-c C-c Set tags / toggle checkbox"
7090 "Unconditionally turn on `orgstruct-mode', and force org-mode indentations. 7528 "Unconditionally turn on `orgstruct-mode', and force org-mode indentations.
7091In addition to setting orgstruct-mode, this also exports all indentation and 7529In addition to setting orgstruct-mode, this also exports all indentation and
7092autofilling variables from org-mode into the buffer. Note that turning 7530autofilling variables from org-mode into the buffer. Note that turning
7093off orgstruct-mode will *not* remove these additonal settings." 7531off orgstruct-mode will *not* remove these additional settings."
7094 (orgstruct-mode 1) 7532 (orgstruct-mode 1)
7095 (let (var val) 7533 (let (var val)
7096 (mapc 7534 (mapc
@@ -7105,7 +7543,7 @@ off orgstruct-mode will *not* remove these additonal settings."
7105(defun orgstruct-error () 7543(defun orgstruct-error ()
7106 "Error when there is no default binding for a structure key." 7544 "Error when there is no default binding for a structure key."
7107 (interactive) 7545 (interactive)
7108 (error "This key is has no function outside structure elements")) 7546 (error "This key has no function outside structure elements"))
7109 7547
7110(defun orgstruct-setup () 7548(defun orgstruct-setup ()
7111 "Setup orgstruct keymaps." 7549 "Setup orgstruct keymaps."
@@ -7252,7 +7690,8 @@ this heading."
7252 (this-buffer (current-buffer)) 7690 (this-buffer (current-buffer))
7253 (org-archive-location org-archive-location) 7691 (org-archive-location org-archive-location)
7254 (re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$") 7692 (re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
7255 ;; start of variables that will be used for savind context 7693 ;; start of variables that will be used for saving context
7694 ;; The compiler complains about them - keep them anyway!
7256 (file (abbreviate-file-name (buffer-file-name))) 7695 (file (abbreviate-file-name (buffer-file-name)))
7257 (time (format-time-string 7696 (time (format-time-string
7258 (substring (cdr org-time-stamp-formats) 1 -1) 7697 (substring (cdr org-time-stamp-formats) 1 -1)
@@ -7469,7 +7908,8 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
7469 (save-excursion 7908 (save-excursion
7470 (beginning-of-line 1) 7909 (beginning-of-line 1)
7471 (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") 7910 (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:")
7472 (let ((b (match-end 0))) 7911 (let ((b (match-end 0))
7912 (outline-regexp org-outline-regexp))
7473 (if (re-search-forward 7913 (if (re-search-forward
7474 "^[ \t]*:END:" 7914 "^[ \t]*:END:"
7475 (save-excursion (outline-next-heading) (point)) t) 7915 (save-excursion (outline-next-heading) (point)) t)
@@ -7488,7 +7928,7 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
7488 (goto-char beg) 7928 (goto-char beg)
7489 (if (looking-at (concat ".*:" org-archive-tag ":")) 7929 (if (looking-at (concat ".*:" org-archive-tag ":"))
7490 (message "%s" (substitute-command-keys 7930 (message "%s" (substitute-command-keys
7491 "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway."))))))) 7931 "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway.")))))))
7492 7932
7493(defun org-force-cycle-archived () 7933(defun org-force-cycle-archived ()
7494 "Cycle subtree even if it is archived." 7934 "Cycle subtree even if it is archived."
@@ -7830,19 +8270,23 @@ This is being used to correctly align a single field after TAB or RET.")
7830 (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) 8270 (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|"))
7831 (hfmt1 (concat 8271 (hfmt1 (concat
7832 (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) 8272 (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+"))
7833 emptystrings links dates narrow fmax f1 len c e) 8273 emptystrings links dates emph narrow fmax f1 len c e)
7834 (untabify beg end) 8274 (untabify beg end)
7835 (remove-text-properties beg end '(org-cwidth t org-dwidth t display t)) 8275 (remove-text-properties beg end '(org-cwidth t org-dwidth t display t))
7836 ;; Check if we have links or dates 8276 ;; Check if we have links or dates
7837 (goto-char beg) 8277 (goto-char beg)
7838 (setq links (re-search-forward org-bracket-link-regexp end t)) 8278 (setq links (re-search-forward org-bracket-link-regexp end t))
7839 (goto-char beg) 8279 (goto-char beg)
8280 (setq emph (and org-hide-emphasis-markers
8281 (re-search-forward org-emph-re end t)))
8282 (goto-char beg)
7840 (setq dates (and org-display-custom-times 8283 (setq dates (and org-display-custom-times
7841 (re-search-forward org-ts-regexp-both end t))) 8284 (re-search-forward org-ts-regexp-both end t)))
7842 ;; Make sure the link properties are right 8285 ;; Make sure the link properties are right
7843 (when links (goto-char beg) (while (org-activate-bracket-links end))) 8286 (when links (goto-char beg) (while (org-activate-bracket-links end)))
7844 ;; Make sure the date properties are right 8287 ;; Make sure the date properties are right
7845 (when dates (goto-char beg) (while (org-activate-dates end))) 8288 (when dates (goto-char beg) (while (org-activate-dates end)))
8289 (when emph (goto-char beg) (while (org-do-emphasis-faces end)))
7846 8290
7847 ;; Check if we are narrowing any columns 8291 ;; Check if we are narrowing any columns
7848 (goto-char beg) 8292 (goto-char beg)
@@ -7923,13 +8367,14 @@ This is being used to correctly align a single field after TAB or RET.")
7923 8367
7924 ;; With invisible characters, `format' does not get the field width right 8368 ;; With invisible characters, `format' does not get the field width right
7925 ;; So we need to make these fields wide by hand. 8369 ;; So we need to make these fields wide by hand.
7926 (when links 8370 (when (or links emph)
7927 (loop for i from 0 upto (1- maxfields) do 8371 (loop for i from 0 upto (1- maxfields) do
7928 (setq len (nth i lengths)) 8372 (setq len (nth i lengths))
7929 (loop for j from 0 upto (1- (length fields)) do 8373 (loop for j from 0 upto (1- (length fields)) do
7930 (setq c (nthcdr i (car (nthcdr j fields)))) 8374 (setq c (nthcdr i (car (nthcdr j fields))))
7931 (if (and (stringp (car c)) 8375 (if (and (stringp (car c))
7932 (string-match org-bracket-link-regexp (car c)) 8376 (text-property-any 0 (length (car c)) 'invisible 'org-link (car c))
8377; (string-match org-bracket-link-regexp (car c))
7933 (< (org-string-width (car c)) len)) 8378 (< (org-string-width (car c)) len))
7934 (setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ ))))))) 8379 (setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ )))))))
7935 8380
@@ -8653,7 +9098,11 @@ should be done in reverse order."
8653 (skip-chars-backward "^|") 9098 (skip-chars-backward "^|")
8654 (setq ecol (1- (current-column))) 9099 (setq ecol (1- (current-column)))
8655 (org-table-goto-column column) 9100 (org-table-goto-column column)
8656 (setq lns (mapcar (lambda(x) (cons (org-trim (substring x bcol ecol)) x)) 9101 (setq lns (mapcar (lambda(x) (cons
9102 (org-sort-remove-invisible
9103 (nth (1- column)
9104 (org-split-string x "[ \t]*|[ \t]*")))
9105 x))
8657 (org-split-string (buffer-substring beg end) "\n"))) 9106 (org-split-string (buffer-substring beg end) "\n")))
8658 (setq lns (org-do-sort lns "Table" with-case sorting-type)) 9107 (setq lns (org-do-sort lns "Table" with-case sorting-type))
8659 (delete-region beg end) 9108 (delete-region beg end)
@@ -8664,6 +9113,15 @@ should be done in reverse order."
8664 (org-table-goto-column thiscol) 9113 (org-table-goto-column thiscol)
8665 (message "%d lines sorted, based on column %d" (length lns) column))) 9114 (message "%d lines sorted, based on column %d" (length lns) column)))
8666 9115
9116;; FIXME: maybe we will not need this? Table sorting is broken....
9117(defun org-sort-remove-invisible (s)
9118 (remove-text-properties 0 (length s) org-rm-props s)
9119 (while (string-match org-bracket-link-regexp s)
9120 (setq s (replace-match (if (match-end 2)
9121 (match-string 3 s)
9122 (match-string 1 s)) t t s)))
9123 s)
9124
8667(defun org-table-cut-region (beg end) 9125(defun org-table-cut-region (beg end)
8668 "Copy region in table to the clipboard and blank all relevant fields." 9126 "Copy region in table to the clipboard and blank all relevant fields."
8669 (interactive "r") 9127 (interactive "r")
@@ -9366,8 +9824,7 @@ of the new mark."
9366 (goto-line l1))) 9824 (goto-line l1)))
9367 (if (not (= epos (point-at-eol))) (org-table-align)) 9825 (if (not (= epos (point-at-eol))) (org-table-align))
9368 (goto-line l) 9826 (goto-line l)
9369 (and (interactive-p) 9827 (and (interactive-p) (message "%s" (cdr (assoc new org-recalc-marks))))))
9370 (message "%s" (or (cdr (assoc new org-recalc-marks)) "")))))
9371 9828
9372(defun org-table-maybe-recalculate-line () 9829(defun org-table-maybe-recalculate-line ()
9373 "Recompute the current line if marked for it, and if we haven't just done it." 9830 "Recompute the current line if marked for it, and if we haven't just done it."
@@ -10679,7 +11136,7 @@ to execute outside of tables."
10679(defun orgtbl-error () 11136(defun orgtbl-error ()
10680 "Error when there is no default binding for a table key." 11137 "Error when there is no default binding for a table key."
10681 (interactive) 11138 (interactive)
10682 (error "This key is has no function outside tables")) 11139 (error "This key has no function outside tables"))
10683 11140
10684(defun orgtbl-setup () 11141(defun orgtbl-setup ()
10685 "Setup orgtbl keymaps." 11142 "Setup orgtbl keymaps."
@@ -11202,9 +11659,9 @@ TeXInfo are:
11202 %s for the original field value. For example, to wrap 11659 %s for the original field value. For example, to wrap
11203 everything in @kbd{}, you could use :fmt \"@kbd{%s}\". 11660 everything in @kbd{}, you could use :fmt \"@kbd{%s}\".
11204 This may also be a property list with column numbers and 11661 This may also be a property list with column numbers and
11205 formats. for example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\"). 11662 formats. For example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\").
11206 11663
11207:cf \"f1 f2..\" The column fractions for the table. Bye default these 11664:cf \"f1 f2..\" The column fractions for the table. By default these
11208 are computed automatically from the width of the columns 11665 are computed automatically from the width of the columns
11209 under org-mode. 11666 under org-mode.
11210 11667
@@ -11265,7 +11722,7 @@ value. Each function should check if it is responsible for creating
11265this link (for example by looking at the major mode). 11722this link (for example by looking at the major mode).
11266If not, it must exit and return nil. 11723If not, it must exit and return nil.
11267If yes, it should return a non-nil value after a calling 11724If yes, it should return a non-nil value after a calling
11268`org-store-link-properties' with a list of properties and values. 11725`org-store-link-props' with a list of properties and values.
11269Special properties are: 11726Special properties are:
11270 11727
11271:type The link prefix. like \"http\". This must be given. 11728:type The link prefix. like \"http\". This must be given.
@@ -11285,8 +11742,9 @@ FOLLOW and PUBLISH are two functions. Both take the link path as
11285an argument. 11742an argument.
11286FOLLOW should do whatever is necessary to follow the link, for example 11743FOLLOW should do whatever is necessary to follow the link, for example
11287to find a file or display a mail message. 11744to find a file or display a mail message.
11745
11288PUBLISH takes the path and retuns the string that should be used when 11746PUBLISH takes the path and retuns the string that should be used when
11289this document is published." 11747this document is published. FIMXE: This is actually not yet implemented."
11290 (add-to-list 'org-link-types type t) 11748 (add-to-list 'org-link-types type t)
11291 (org-make-link-regexps) 11749 (org-make-link-regexps)
11292 (add-to-list 'org-link-protocols 11750 (add-to-list 'org-link-protocols
@@ -11374,10 +11832,10 @@ For file links, arg negates `org-context-in-file-links'."
11374 (if (fboundp 'elmo-message-entity) 11832 (if (fboundp 'elmo-message-entity)
11375 (elmo-message-entity 11833 (elmo-message-entity
11376 wl-summary-buffer-elmo-folder msgnum) 11834 wl-summary-buffer-elmo-folder msgnum)
11377 (elmo-msgdb-overview-get-entity 11835 (elmo-msgdb-overview-get-entity
11378 msgnum (wl-summary-buffer-msgdb)))) 11836 msgnum (wl-summary-buffer-msgdb))))
11379 (from (wl-summary-line-from)) 11837 (from (wl-summary-line-from))
11380 (to (elmo-message-entity-field wl-message-entity 'to)) 11838 (to (car (elmo-message-entity-field wl-message-entity 'to)))
11381 (subject (let (wl-thr-indent-string wl-parent-message-entity) 11839 (subject (let (wl-thr-indent-string wl-parent-message-entity)
11382 (wl-summary-line-subject)))) 11840 (wl-summary-line-subject))))
11383 (org-store-link-props :type "wl" :from from :to to 11841 (org-store-link-props :type "wl" :from from :to to
@@ -11613,8 +12071,10 @@ according to FMT (default from `org-email-link-description-format')."
11613 (error "Empty link")) 12071 (error "Empty link"))
11614 (when (stringp description) 12072 (when (stringp description)
11615 ;; Remove brackets from the description, they are fatal. 12073 ;; Remove brackets from the description, they are fatal.
11616 (while (string-match "\\[\\|\\]" description) 12074 (while (string-match "\\[" description)
11617 (setq description (replace-match "" t t description)))) 12075 (setq description (replace-match "{" t t description)))
12076 (while (string-match "\\]" description)
12077 (setq description (replace-match "}" t t description))))
11618 (when (equal (org-link-escape link) description) 12078 (when (equal (org-link-escape link) description)
11619 ;; No description needed, it is identical 12079 ;; No description needed, it is identical
11620 (setq description nil)) 12080 (setq description nil))
@@ -11626,29 +12086,29 @@ according to FMT (default from `org-email-link-description-format')."
11626 "]")) 12086 "]"))
11627 12087
11628(defconst org-link-escape-chars 12088(defconst org-link-escape-chars
11629 '((" " . "%20") 12089 '((?\ . "%20")
11630 ("[" . "%5B") 12090 (?\[ . "%5B")
11631 ("]" . "%5d") 12091 (?\] . "%5D")
11632 ("\340" . "%E0") ; `a 12092 (?\340 . "%E0") ; `a
11633 ("\342" . "%E2") ; ^a 12093 (?\342 . "%E2") ; ^a
11634 ("\347" . "%E7") ; ,c 12094 (?\347 . "%E7") ; ,c
11635 ("\350" . "%E8") ; `e 12095 (?\350 . "%E8") ; `e
11636 ("\351" . "%E9") ; 'e 12096 (?\351 . "%E9") ; 'e
11637 ("\352" . "%EA") ; ^e 12097 (?\352 . "%EA") ; ^e
11638 ("\356" . "%EE") ; ^i 12098 (?\356 . "%EE") ; ^i
11639 ("\364" . "%F4") ; ^o 12099 (?\364 . "%F4") ; ^o
11640 ("\371" . "%F9") ; `u 12100 (?\371 . "%F9") ; `u
11641 ("\373" . "%FB") ; ^u 12101 (?\373 . "%FB") ; ^u
11642 (";" . "%3B") 12102 (?\; . "%3B")
11643 ("?" . "%3F") 12103 (?? . "%3F")
11644 ("=" . "%3D") 12104 (?= . "%3D")
11645 ("+" . "%2B") 12105 (?+ . "%2B")
11646 ) 12106 )
11647 "Association list of escapes for some characters problematic in links. 12107 "Association list of escapes for some characters problematic in links.
11648This is the list that is used for internal purposes.") 12108This is the list that is used for internal purposes.")
11649 12109
11650(defconst org-link-escape-chars-browser 12110(defconst org-link-escape-chars-browser
11651 '((" " . "%20")) 12111 '((?\ . "%20")) ; 32 for the SPC char
11652 "Association list of escapes for some characters problematic in links. 12112 "Association list of escapes for some characters problematic in links.
11653This is the list that is used before handing over to the browser.") 12113This is the list that is used before handing over to the browser.")
11654 12114
@@ -11656,12 +12116,14 @@ This is the list that is used before handing over to the browser.")
11656 "Escape charaters in TEXT that are problematic for links." 12116 "Escape charaters in TEXT that are problematic for links."
11657 (setq table (or table org-link-escape-chars)) 12117 (setq table (or table org-link-escape-chars))
11658 (when text 12118 (when text
11659 (let ((re (mapconcat (lambda (x) (regexp-quote (car x))) 12119 (let ((re (mapconcat (lambda (x) (regexp-quote
12120 (char-to-string (car x))))
11660 table "\\|"))) 12121 table "\\|")))
11661 (while (string-match re text) 12122 (while (string-match re text)
11662 (setq text 12123 (setq text
11663 (replace-match 12124 (replace-match
11664 (cdr (assoc (match-string 0 text) table)) 12125 (cdr (assoc (string-to-char (match-string 0 text))
12126 table))
11665 t t text))) 12127 t t text)))
11666 text))) 12128 text)))
11667 12129
@@ -11674,7 +12136,7 @@ This is the list that is used before handing over to the browser.")
11674 (while (string-match re text) 12136 (while (string-match re text)
11675 (setq text 12137 (setq text
11676 (replace-match 12138 (replace-match
11677 (car (rassoc (match-string 0 text) table)) 12139 (char-to-string (car (rassoc (match-string 0 text) table)))
11678 t t text))) 12140 t t text)))
11679 text))) 12141 text)))
11680 12142
@@ -11957,189 +12419,192 @@ the end of the current subtree.
11957Normally, files will be opened by an appropriate application. If the 12419Normally, files will be opened by an appropriate application. If the
11958optional argument IN-EMACS is non-nil, Emacs will visit the file." 12420optional argument IN-EMACS is non-nil, Emacs will visit the file."
11959 (interactive "P") 12421 (interactive "P")
11960 (move-marker org-open-link-marker (point)) 12422 (catch 'abort
11961 (setq org-window-config-before-follow-link (current-window-configuration)) 12423 (move-marker org-open-link-marker (point))
11962 (org-remove-occur-highlights nil nil t) 12424 (setq org-window-config-before-follow-link (current-window-configuration))
11963 (if (org-at-timestamp-p t) 12425 (org-remove-occur-highlights nil nil t)
11964 (org-follow-timestamp-link) 12426 (if (org-at-timestamp-p t)
11965 (let (type path link line search (pos (point))) 12427 (org-follow-timestamp-link)
11966 (catch 'match 12428 (let (type path link line search (pos (point)))
11967 (save-excursion 12429 (catch 'match
11968 (skip-chars-forward "^]\n\r") 12430 (save-excursion
11969 (when (org-in-regexp org-bracket-link-regexp) 12431 (skip-chars-forward "^]\n\r")
11970 (setq link (org-link-unescape (org-match-string-no-properties 1))) 12432 (when (org-in-regexp org-bracket-link-regexp)
11971 (while (string-match " *\n *" link) 12433 (setq link (org-link-unescape (org-match-string-no-properties 1)))
11972 (setq link (replace-match " " t t link))) 12434 (while (string-match " *\n *" link)
11973 (setq link (org-link-expand-abbrev link)) 12435 (setq link (replace-match " " t t link)))
11974 (if (string-match org-link-re-with-space2 link) 12436 (setq link (org-link-expand-abbrev link))
11975 (setq type (match-string 1 link) path (match-string 2 link)) 12437 (if (string-match org-link-re-with-space2 link)
11976 (setq type "thisfile" path link)) 12438 (setq type (match-string 1 link) path (match-string 2 link))
11977 (throw 'match t))) 12439 (setq type "thisfile" path link))
11978 12440 (throw 'match t)))
11979 (when (get-text-property (point) 'org-linked-text) 12441
11980 (setq type "thisfile" 12442 (when (get-text-property (point) 'org-linked-text)
11981 pos (if (get-text-property (1+ (point)) 'org-linked-text) 12443 (setq type "thisfile"
11982 (1+ (point)) (point)) 12444 pos (if (get-text-property (1+ (point)) 'org-linked-text)
11983 path (buffer-substring 12445 (1+ (point)) (point))
11984 (previous-single-property-change pos 'org-linked-text) 12446 path (buffer-substring
11985 (next-single-property-change pos 'org-linked-text))) 12447 (previous-single-property-change pos 'org-linked-text)
11986 (throw 'match t)) 12448 (next-single-property-change pos 'org-linked-text)))
12449 (throw 'match t))
11987 12450
11988 (save-excursion 12451 (save-excursion
11989 (when (or (org-in-regexp org-angle-link-re) 12452 (when (or (org-in-regexp org-angle-link-re)
11990 (org-in-regexp org-plain-link-re)) 12453 (org-in-regexp org-plain-link-re))
11991 (setq type (match-string 1) path (match-string 2)) 12454 (setq type (match-string 1) path (match-string 2))
11992 (throw 'match t))) 12455 (throw 'match t)))
11993 (when (org-in-regexp "\\<\\([^><\n]+\\)\\>") 12456 (when (org-in-regexp "\\<\\([^><\n]+\\)\\>")
11994 (setq type "tree-match" 12457 (setq type "tree-match"
11995 path (match-string 1))
11996 (throw 'match t))
11997 (save-excursion
11998 (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$"))
11999 (setq type "tags"
12000 path (match-string 1)) 12458 path (match-string 1))
12001 (while (string-match ":" path) 12459 (throw 'match t))
12002 (setq path (replace-match "+" t t path))) 12460 (save-excursion
12003 (throw 'match t)))) 12461 (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$"))
12004 (unless path 12462 (setq type "tags"
12005 (error "No link found")) 12463 path (match-string 1))
12006 ;; Remove any trailing spaces in path 12464 (while (string-match ":" path)
12007 (if (string-match " +\\'" path) 12465 (setq path (replace-match "+" t t path)))
12008 (setq path (replace-match "" t t path))) 12466 (throw 'match t))))
12467 (unless path
12468 (error "No link found"))
12469 ;; Remove any trailing spaces in path
12470 (if (string-match " +\\'" path)
12471 (setq path (replace-match "" t t path)))
12009 12472
12010 (cond 12473 (cond
12011 12474
12012 ((assoc type org-link-protocols) 12475 ((assoc type org-link-protocols)
12013 (funcall (nth 1 (assoc type org-link-protocols)) path)) 12476 (funcall (nth 1 (assoc type org-link-protocols)) path))
12014 12477
12015 ((equal type "mailto") 12478 ((equal type "mailto")
12016 (let ((cmd (car org-link-mailto-program)) 12479 (let ((cmd (car org-link-mailto-program))
12017 (args (cdr org-link-mailto-program)) args1 12480 (args (cdr org-link-mailto-program)) args1
12018 (address path) (subject "") a) 12481 (address path) (subject "") a)
12019 (if (string-match "\\(.*\\)::\\(.*\\)" path) 12482 (if (string-match "\\(.*\\)::\\(.*\\)" path)
12020 (setq address (match-string 1 path) 12483 (setq address (match-string 1 path)
12021 subject (org-link-escape (match-string 2 path)))) 12484 subject (org-link-escape (match-string 2 path))))
12022 (while args 12485 (while args
12023 (cond 12486 (cond
12024 ((not (stringp (car args))) (push (pop args) args1)) 12487 ((not (stringp (car args))) (push (pop args) args1))
12025 (t (setq a (pop args)) 12488 (t (setq a (pop args))
12026 (if (string-match "%a" a) 12489 (if (string-match "%a" a)
12027 (setq a (replace-match address t t a))) 12490 (setq a (replace-match address t t a)))
12028 (if (string-match "%s" a) 12491 (if (string-match "%s" a)
12029 (setq a (replace-match subject t t a))) 12492 (setq a (replace-match subject t t a)))
12030 (push a args1)))) 12493 (push a args1))))
12031 (apply cmd (nreverse args1)))) 12494 (apply cmd (nreverse args1))))
12032 12495
12033 ((member type '("http" "https" "ftp" "news")) 12496 ((member type '("http" "https" "ftp" "news"))
12034 (browse-url (concat type ":" (org-link-escape 12497 (browse-url (concat type ":" (org-link-escape
12035 path org-link-escape-chars-browser)))) 12498 path org-link-escape-chars-browser))))
12036 12499
12037 ((string= type "tags") 12500 ((member type '("message"))
12038 (org-tags-view in-emacs path)) 12501 (browse-url (concat type ":" path)))
12039 ((string= type "thisfile") 12502
12040 (if in-emacs 12503 ((string= type "tags")
12041 (switch-to-buffer-other-window 12504 (org-tags-view in-emacs path))
12042 (org-get-buffer-for-internal-link (current-buffer))) 12505 ((string= type "thisfile")
12043 (org-mark-ring-push)) 12506 (if in-emacs
12044 (let ((cmd `(org-link-search 12507 (switch-to-buffer-other-window
12045 ,path 12508 (org-get-buffer-for-internal-link (current-buffer)))
12046 ,(cond ((equal in-emacs '(4)) 'occur) 12509 (org-mark-ring-push))
12047 ((equal in-emacs '(16)) 'org-occur) 12510 (let ((cmd `(org-link-search
12048 (t nil)) 12511 ,path
12049 ,pos))) 12512 ,(cond ((equal in-emacs '(4)) 'occur)
12050 (condition-case nil (eval cmd) 12513 ((equal in-emacs '(16)) 'org-occur)
12051 (error (progn (widen) (eval cmd)))))) 12514 (t nil))
12052 12515 ,pos)))
12053 ((string= type "tree-match") 12516 (condition-case nil (eval cmd)
12054 (org-occur (concat "\\[" (regexp-quote path) "\\]"))) 12517 (error (progn (widen) (eval cmd))))))
12055 12518
12056 ((string= type "file") 12519 ((string= type "tree-match")
12057 (if (string-match "::\\([0-9]+\\)\\'" path) 12520 (org-occur (concat "\\[" (regexp-quote path) "\\]")))
12058 (setq line (string-to-number (match-string 1 path)) 12521
12059 path (substring path 0 (match-beginning 0))) 12522 ((string= type "file")
12060 (if (string-match "::\\(.+\\)\\'" path) 12523 (if (string-match "::\\([0-9]+\\)\\'" path)
12061 (setq search (match-string 1 path) 12524 (setq line (string-to-number (match-string 1 path))
12062 path (substring path 0 (match-beginning 0))))) 12525 path (substring path 0 (match-beginning 0)))
12063 (org-open-file path in-emacs line search)) 12526 (if (string-match "::\\(.+\\)\\'" path)
12064 12527 (setq search (match-string 1 path)
12065 ((string= type "news") 12528 path (substring path 0 (match-beginning 0)))))
12066 (org-follow-gnus-link path)) 12529 (if (string-match "[*?{]" (file-name-nondirectory path))
12067 12530 (dired path)
12068 ((string= type "bbdb") 12531 (org-open-file path in-emacs line search)))
12069 (org-follow-bbdb-link path)) 12532
12070 12533 ((string= type "news")
12071 ((string= type "info") 12534 (org-follow-gnus-link path))
12072 (org-follow-info-link path)) 12535
12073 12536 ((string= type "bbdb")
12074 ((string= type "gnus") 12537 (org-follow-bbdb-link path))
12075 (let (group article) 12538
12076 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) 12539 ((string= type "info")
12077 (error "Error in Gnus link")) 12540 (org-follow-info-link path))
12078 (setq group (match-string 1 path) 12541
12079 article (match-string 3 path)) 12542 ((string= type "gnus")
12080 (org-follow-gnus-link group article))) 12543 (let (group article)
12081 12544 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
12082 ((string= type "vm") 12545 (error "Error in Gnus link"))
12083 (let (folder article) 12546 (setq group (match-string 1 path)
12084 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) 12547 article (match-string 3 path))
12085 (error "Error in VM link")) 12548 (org-follow-gnus-link group article)))
12086 (setq folder (match-string 1 path) 12549
12087 article (match-string 3 path)) 12550 ((string= type "vm")
12088 ;; in-emacs is the prefix arg, will be interpreted as read-only 12551 (let (folder article)
12089 (org-follow-vm-link folder article in-emacs))) 12552 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
12090 12553 (error "Error in VM link"))
12091 ((string= type "wl") 12554 (setq folder (match-string 1 path)
12092 (let (folder article) 12555 article (match-string 3 path))
12093 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) 12556 ;; in-emacs is the prefix arg, will be interpreted as read-only
12094 (error "Error in Wanderlust link")) 12557 (org-follow-vm-link folder article in-emacs)))
12095 (setq folder (match-string 1 path) 12558
12096 article (match-string 3 path)) 12559 ((string= type "wl")
12097 (org-follow-wl-link folder article))) 12560 (let (folder article)
12098 12561 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
12099 ((string= type "mhe") 12562 (error "Error in Wanderlust link"))
12100 (let (folder article) 12563 (setq folder (match-string 1 path)
12101 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) 12564 article (match-string 3 path))
12102 (error "Error in MHE link")) 12565 (org-follow-wl-link folder article)))
12103 (setq folder (match-string 1 path) 12566
12104 article (match-string 3 path)) 12567 ((string= type "mhe")
12105 (org-follow-mhe-link folder article))) 12568 (let (folder article)
12106 12569 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
12107 ((string= type "rmail") 12570 (error "Error in MHE link"))
12108 (let (folder article) 12571 (setq folder (match-string 1 path)
12109 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) 12572 article (match-string 3 path))
12110 (error "Error in RMAIL link")) 12573 (org-follow-mhe-link folder article)))
12111 (setq folder (match-string 1 path) 12574
12112 article (match-string 3 path)) 12575 ((string= type "rmail")
12113 (org-follow-rmail-link folder article))) 12576 (let (folder article)
12114 12577 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
12115 ((string= type "shell") 12578 (error "Error in RMAIL link"))
12116 (let ((cmd path)) 12579 (setq folder (match-string 1 path)
12117 ;; The following is only for backward compatibility 12580 article (match-string 3 path))
12118 (while (string-match "@{" cmd) (setq cmd (replace-match "<" t t cmd))) 12581 (org-follow-rmail-link folder article)))
12119 (while (string-match "@}" cmd) (setq cmd (replace-match ">" t t cmd))) 12582
12120 (if (or (not org-confirm-shell-link-function) 12583 ((string= type "shell")
12121 (funcall org-confirm-shell-link-function 12584 (let ((cmd path))
12122 (format "Execute \"%s\" in shell? " 12585 (if (or (not org-confirm-shell-link-function)
12123 (org-add-props cmd nil 12586 (funcall org-confirm-shell-link-function
12124 'face 'org-warning)))) 12587 (format "Execute \"%s\" in shell? "
12125 (progn 12588 (org-add-props cmd nil
12126 (message "Executing %s" cmd) 12589 'face 'org-warning))))
12127 (shell-command cmd)) 12590 (progn
12128 (error "Abort")))) 12591 (message "Executing %s" cmd)
12129 12592 (shell-command cmd))
12130 ((string= type "elisp") 12593 (error "Abort"))))
12131 (let ((cmd path)) 12594
12132 (if (or (not org-confirm-elisp-link-function) 12595 ((string= type "elisp")
12133 (funcall org-confirm-elisp-link-function 12596 (let ((cmd path))
12134 (format "Execute \"%s\" as elisp? " 12597 (if (or (not org-confirm-elisp-link-function)
12135 (org-add-props cmd nil 12598 (funcall org-confirm-elisp-link-function
12136 'face 'org-warning)))) 12599 (format "Execute \"%s\" as elisp? "
12137 (message "%s => %s" cmd (eval (read cmd))) 12600 (org-add-props cmd nil
12138 (error "Abort")))) 12601 'face 'org-warning))))
12602 (message "%s => %s" cmd (eval (read cmd)))
12603 (error "Abort"))))
12139 12604
12140 (t 12605 (t
12141 (browse-url-at-point))))) 12606 (browse-url-at-point)))))
12142 (move-marker org-open-link-marker nil)) 12607 (move-marker org-open-link-marker nil)))
12143 12608
12144;;; File search 12609;;; File search
12145 12610
@@ -12575,8 +13040,8 @@ use sequences."
12575 (mh-show-buffer-message-number)))) 13040 (mh-show-buffer-message-number))))
12576 13041
12577(defun org-mhe-get-header (header) 13042(defun org-mhe-get-header (header)
12578 "Return a header of the message in folder mode. This will create a 13043 "Return a header of the message in folder mode. This will create a
12579show buffer for the corresponding message. If you have a more clever 13044show buffer for the corresponding message. If you have a more clever
12580idea..." 13045idea..."
12581 (let* ((folder (org-mhe-get-message-folder)) 13046 (let* ((folder (org-mhe-get-message-folder))
12582 (num (org-mhe-get-message-num)) 13047 (num (org-mhe-get-message-num))
@@ -12727,9 +13192,10 @@ If the file does not exist, an error is thrown."
12727 (cond 13192 (cond
12728 ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) 13193 ((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
12729 ;; Remove quotes around the file name - we'll use shell-quote-argument. 13194 ;; Remove quotes around the file name - we'll use shell-quote-argument.
12730 (if (string-match "['\"]%s['\"]" cmd) 13195 (while (string-match "['\"]%s['\"]" cmd)
12731 (setq cmd (replace-match "%s" t t cmd))) 13196 (setq cmd (replace-match "%s" t t cmd)))
12732 (setq cmd (format cmd (shell-quote-argument file))) 13197 (while (string-match "%s" cmd)
13198 (setq cmd (replace-match (shell-quote-argument file) t t cmd)))
12733 (save-window-excursion 13199 (save-window-excursion
12734 (start-process-shell-command cmd nil cmd))) 13200 (start-process-shell-command cmd nil cmd)))
12735 ((or (stringp cmd) 13201 ((or (stringp cmd)
@@ -12772,7 +13238,18 @@ on the system \"/user@host:\"."
12772 (t nil))) 13238 (t nil)))
12773 13239
12774 13240
12775;;;; Hooks for remember.el 13241;;;; Hooks for remember.el, and refiling
13242
13243(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode'
13244(defvar initial) ; from remember.el, dynamically scoped in `remember-mode'
13245
13246;;;###autoload
13247(defun org-remember-insinuate ()
13248 "Setup remember.el for use wiht Org-mode."
13249 (require 'remember)
13250 (setq remember-annotation-functions '(org-remember-annotation))
13251 (setq remember-handler-functions '(org-remember-handler))
13252 (add-hook 'remember-mode-hook 'org-remember-apply-template))
12776 13253
12777;;;###autoload 13254;;;###autoload
12778(defun org-remember-annotation () 13255(defun org-remember-annotation ()
@@ -12792,44 +13269,54 @@ RET at beg-of-buf -> Append to file as level 2 headline
12792(defvar org-remember-previous-location nil) 13269(defvar org-remember-previous-location nil)
12793(defvar org-force-remember-template-char) ;; dynamically scoped 13270(defvar org-force-remember-template-char) ;; dynamically scoped
12794 13271
13272(defun org-select-remember-template (&optional use-char)
13273 (when org-remember-templates
13274 (let* ((templates (mapcar (lambda (x)
13275 (if (stringp (car x))
13276 (append (list (nth 1 x) (car x)) (cddr x))
13277 (append (list (car x) "") (cdr x))))
13278 org-remember-templates))
13279 (char (or use-char
13280 (cond
13281 ((= (length templates) 1)
13282 (caar templates))
13283 ((and (boundp 'org-force-remember-template-char)
13284 org-force-remember-template-char)
13285 (if (stringp org-force-remember-template-char)
13286 (string-to-char org-force-remember-template-char)
13287 org-force-remember-template-char))
13288 (t
13289 (message "Select template: %s"
13290 (mapconcat
13291 (lambda (x)
13292 (cond
13293 ((not (string-match "\\S-" (nth 1 x)))
13294 (format "[%c]" (car x)))
13295 ((equal (downcase (car x))
13296 (downcase (aref (nth 1 x) 0)))
13297 (format "[%c]%s" (car x)
13298 (substring (nth 1 x) 1)))
13299 (t (format "[%c]%s" (car x) (nth 1 x)))))
13300 templates " "))
13301 (let ((inhibit-quit t) (char0 (read-char-exclusive)))
13302 (when (equal char0 ?\C-g)
13303 (jump-to-register remember-register)
13304 (kill-buffer remember-buffer))
13305 char0))))))
13306 (cddr (assoc char templates)))))
13307
13308(defvar x-last-selected-text)
13309(defvar x-last-selected-text-primary)
13310
12795;;;###autoload 13311;;;###autoload
12796(defun org-remember-apply-template (&optional use-char skip-interactive) 13312(defun org-remember-apply-template (&optional use-char skip-interactive)
12797 "Initialize *remember* buffer with template, invoke `org-mode'. 13313 "Initialize *remember* buffer with template, invoke `org-mode'.
12798This function should be placed into `remember-mode-hook' and in fact requires 13314This function should be placed into `remember-mode-hook' and in fact requires
12799to be run from that hook to fucntion properly." 13315to be run from that hook to function properly."
13316 (unless (fboundp 'remember-finalize)
13317 (defalias 'remember-finalize 'remember-buffer))
12800 (if org-remember-templates 13318 (if org-remember-templates
12801 (let* ((templates (mapcar (lambda (x) 13319 (let* ((entry (org-select-remember-template use-char))
12802 (if (stringp (car x))
12803 (append (list (nth 1 x) (car x)) (cddr x))
12804 (append (list (car x) "") (cdr x))))
12805 org-remember-templates))
12806 (char (or use-char
12807 (cond
12808 ((= (length templates) 1)
12809 (caar templates))
12810 ((and (boundp 'org-force-remember-template-char)
12811 org-force-remember-template-char)
12812 (if (stringp org-force-remember-template-char)
12813 (string-to-char org-force-remember-template-char)
12814 org-force-remember-template-char))
12815 (t
12816 (message "Select template: %s"
12817 (mapconcat
12818 (lambda (x)
12819 (cond
12820 ((not (string-match "\\S-" (nth 1 x)))
12821 (format "[%c]" (car x)))
12822 ((equal (downcase (car x))
12823 (downcase (aref (nth 1 x) 0)))
12824 (format "[%c]%s" (car x) (substring (nth 1 x) 1)))
12825 (t (format "[%c]%s" (car x) (nth 1 x)))))
12826 templates " "))
12827 (let ((inhibit-quit t) (char0 (read-char-exclusive)))
12828 (when (equal char0 ?\C-g)
12829 (jump-to-register remember-register)
12830 (kill-buffer remember-buffer))
12831 char0)))))
12832 (entry (cddr (assoc char templates)))
12833 (tpl (car entry)) 13320 (tpl (car entry))
12834 (plist-p (if org-store-link-plist t nil)) 13321 (plist-p (if org-store-link-plist t nil))
12835 (file (if (and (nth 1 entry) (stringp (nth 1 entry)) 13322 (file (if (and (nth 1 entry) (stringp (nth 1 entry))
@@ -12837,6 +13324,12 @@ to be run from that hook to fucntion properly."
12837 (nth 1 entry) 13324 (nth 1 entry)
12838 org-default-notes-file)) 13325 org-default-notes-file))
12839 (headline (nth 2 entry)) 13326 (headline (nth 2 entry))
13327 (v-c (or (and (eq window-system 'x)
13328 (fboundp 'x-cut-buffer-or-selection-value)
13329 (x-cut-buffer-or-selection-value))
13330 (org-bound-and-true-p x-last-selected-text)
13331 (org-bound-and-true-p x-last-selected-text-primary)
13332 (and (> (length kill-ring) 0) (current-kill 0))))
12840 (v-t (format-time-string (car org-time-stamp-formats) (org-current-time))) 13333 (v-t (format-time-string (car org-time-stamp-formats) (org-current-time)))
12841 (v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time))) 13334 (v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time)))
12842 (v-u (concat "[" (substring v-t 1 -1) "]")) 13335 (v-u (concat "[" (substring v-t 1 -1) "]"))
@@ -12852,11 +13345,12 @@ to be run from that hook to fucntion properly."
12852 v-a)) 13345 v-a))
12853 (v-n user-full-name) 13346 (v-n user-full-name)
12854 (org-startup-folded nil) 13347 (org-startup-folded nil)
12855 org-time-was-given org-end-time-was-given x prompt char time) 13348 org-time-was-given org-end-time-was-given x
13349 prompt completions char time pos default histvar)
12856 (setq org-store-link-plist 13350 (setq org-store-link-plist
12857 (append (list :annotation v-a :initial v-i) 13351 (append (list :annotation v-a :initial v-i)
12858 org-store-link-plist)) 13352 org-store-link-plist))
12859 (unless tpl (setq tpl "") (message "No template") (ding)) 13353 (unless tpl (setq tpl "") (message "No template") (ding) (sit-for 1))
12860 (erase-buffer) 13354 (erase-buffer)
12861 (insert (substitute-command-keys 13355 (insert (substitute-command-keys
12862 (format 13356 (format
@@ -12873,7 +13367,7 @@ to be run from that hook to fucntion properly."
12873 (or (cdr org-remember-previous-location) "???")))) 13367 (or (cdr org-remember-previous-location) "???"))))
12874 (insert tpl) (goto-char (point-min)) 13368 (insert tpl) (goto-char (point-min))
12875 ;; Simple %-escapes 13369 ;; Simple %-escapes
12876 (while (re-search-forward "%\\([tTuUaiA]\\)" nil t) 13370 (while (re-search-forward "%\\([tTuUaiAc]\\)" nil t)
12877 (when (and initial (equal (match-string 0) "%i")) 13371 (when (and initial (equal (match-string 0) "%i"))
12878 (save-match-data 13372 (save-match-data
12879 (let* ((lead (buffer-substring 13373 (let* ((lead (buffer-substring
@@ -12884,16 +13378,43 @@ to be run from that hook to fucntion properly."
12884 (replace-match 13378 (replace-match
12885 (or (eval (intern (concat "v-" (match-string 1)))) "") 13379 (or (eval (intern (concat "v-" (match-string 1)))) "")
12886 t t)) 13380 t t))
13381
13382 ;; %[] Insert contents of a file.
13383 (goto-char (point-min))
13384 (while (re-search-forward "%\\[\\(.+\\)\\]" nil t)
13385 (let ((start (match-beginning 0))
13386 (end (match-end 0))
13387 (filename (expand-file-name (match-string 1))))
13388 (goto-char start)
13389 (delete-region start end)
13390 (condition-case error
13391 (insert-file-contents filename)
13392 (error (insert (format "%%![Couldn't insert %s: %s]"
13393 filename error))))))
13394 ;; %() embedded elisp
13395 (goto-char (point-min))
13396 (while (re-search-forward "%\\((.+)\\)" nil t)
13397 (goto-char (match-beginning 0))
13398 (let ((template-start (point)))
13399 (forward-char 1)
13400 (let ((result
13401 (condition-case error
13402 (eval (read (current-buffer)))
13403 (error (format "%%![Error: %s]" error)))))
13404 (delete-region template-start (point))
13405 (insert result))))
13406
12887 ;; From the property list 13407 ;; From the property list
12888 (when plist-p 13408 (when plist-p
12889 (goto-char (point-min)) 13409 (goto-char (point-min))
12890 (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) 13410 (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t)
12891 (and (setq x (plist-get org-store-link-plist 13411 (and (setq x (or (plist-get org-store-link-plist
12892 (intern (match-string 1)))) 13412 (intern (match-string 1))) ""))
12893 (replace-match x t t)))) 13413 (replace-match x t t))))
13414
12894 ;; Turn on org-mode in the remember buffer, set local variables 13415 ;; Turn on org-mode in the remember buffer, set local variables
12895 (org-mode) 13416 (org-mode)
12896 (org-set-local 'org-finish-function 'remember-buffer) 13417 (org-set-local 'org-finish-function 'remember-finalize)
12897 (if (and file (string-match "\\S-" file) (not (file-directory-p file))) 13418 (if (and file (string-match "\\S-" file) (not (file-directory-p file)))
12898 (org-set-local 'org-default-notes-file file)) 13419 (org-set-local 'org-default-notes-file file))
12899 (if (and headline (stringp headline) (string-match "\\S-" headline)) 13420 (if (and headline (stringp headline) (string-match "\\S-" headline))
@@ -12905,6 +13426,15 @@ to be run from that hook to fucntion properly."
12905 prompt (if (match-end 2) (match-string 2))) 13426 prompt (if (match-end 2) (match-string 2)))
12906 (goto-char (match-beginning 0)) 13427 (goto-char (match-beginning 0))
12907 (replace-match "") 13428 (replace-match "")
13429 (setq completions nil default nil)
13430 (when prompt
13431 (setq completions (org-split-string prompt "|")
13432 prompt (pop completions)
13433 default (car completions)
13434 histvar (intern (concat
13435 "org-remember-template-prompt-history::"
13436 (or prompt "")))
13437 completions (mapcar 'list completions)))
12908 (cond 13438 (cond
12909 ((member char '("G" "g")) 13439 ((member char '("G" "g"))
12910 (let* ((org-last-tags-completion-table 13440 (let* ((org-last-tags-completion-table
@@ -12930,33 +13460,92 @@ to be run from that hook to fucntion properly."
12930 (member char '("u" "U")) 13460 (member char '("u" "U"))
12931 nil nil (list org-end-time-was-given))) 13461 nil nil (list org-end-time-was-given)))
12932 (t 13462 (t
12933 (insert (read-string 13463 (insert (org-completing-read
12934 (if prompt (concat prompt ": ") "Enter string")))))) 13464 (concat (if prompt prompt "Enter string")
13465 (if default (concat " [" default "]"))
13466 ": ")
13467 completions nil nil nil histvar default)))))
12935 (goto-char (point-min)) 13468 (goto-char (point-min))
12936 (if (re-search-forward "%\\?" nil t) 13469 (if (re-search-forward "%\\?" nil t)
12937 (replace-match "") 13470 (replace-match "")
12938 (and (re-search-forward "^[^#\n]" nil t) (backward-char 1)))) 13471 (and (re-search-forward "^[^#\n]" nil t) (backward-char 1))))
12939 (org-mode) 13472 (org-mode)
12940 (org-set-local 'org-finish-function 'remember-buffer))) 13473 (org-set-local 'org-finish-function 'remember-finalize))
13474 (when (save-excursion
13475 (goto-char (point-min))
13476 (re-search-forward "%!" nil t))
13477 (replace-match "")
13478 (add-hook 'post-command-hook 'org-remember-finish-immediately 'append)))
13479
13480(defun org-remember-finish-immediately ()
13481 "File remember note immediately.
13482This should be run in `post-command-hook' and will remove itself
13483from that hook."
13484 (remove-hook 'post-command-hook 'org-remember-finish-immediately)
13485 (when org-finish-function
13486 (funcall org-finish-function)))
13487
12941 13488
12942;;;###autoload 13489;;;###autoload
12943(defun org-remember (&optional org-force-remember-template-char) 13490(defun org-remember (&optional goto org-force-remember-template-char)
12944 "Call `remember'. If this is already a remember buffer, re-apply template. 13491 "Call `remember'. If this is already a remember buffer, re-apply template.
12945If there is an active region, make sure remember uses it as initial content 13492If there is an active region, make sure remember uses it as initial content
12946of the remember buffer." 13493of the remember buffer.
13494
13495When called interactively with a `C-u' prefix argument GOTO, don't remember
13496anything, just go to the file/headline where the selected template usually
13497stores its notes. With a double prefix arg `C-u C-u', go to the last
13498note stored by remember.
13499
13500Lisp programs can set ORG-FORCE-REMEMBER-TEMPLATE-CHAR to a character
13501associated with a template in `org-remember-templates'."
13502 (interactive "P")
13503 (cond
13504 ((equal goto '(4)) (org-go-to-remember-target))
13505 ((equal goto '(16)) (org-remember-goto-last-stored))
13506 (t
13507 (if (memq org-finish-function '(remember-buffer remember-finalize))
13508 (progn
13509 (when (< (length org-remember-templates) 2)
13510 (error "No other template available"))
13511 (erase-buffer)
13512 (let ((annotation (plist-get org-store-link-plist :annotation))
13513 (initial (plist-get org-store-link-plist :initial)))
13514 (org-remember-apply-template))
13515 (message "Press C-c C-c to remember data"))
13516 (if (org-region-active-p)
13517 (remember (buffer-substring (point) (mark)))
13518 (call-interactively 'remember))))))
13519
13520(defun org-remember-goto-last-stored ()
13521 "Go to the location where the last remember note was stored."
12947 (interactive) 13522 (interactive)
12948 (if (eq org-finish-function 'remember-buffer) 13523 (bookmark-jump "org-remember-last-stored")
12949 (progn 13524 (message "This is the last note stored by remember"))
12950 (when (< (length org-remember-templates) 2) 13525
12951 (error "No other template available")) 13526(defun org-go-to-remember-target (&optional template-key)
12952 (erase-buffer) 13527 "Go to the target location of a remember template.
12953 (let ((annotation (plist-get org-store-link-plist :annotation)) 13528The user is queried for the template."
12954 (initial (plist-get org-store-link-plist :initial))) 13529 (interactive)
12955 (org-remember-apply-template)) 13530 (let* ((entry (org-select-remember-template template-key))
12956 (message "Press C-c C-c to remember data")) 13531 (file (nth 1 entry))
12957 (if (org-region-active-p) 13532 (heading (nth 2 entry))
12958 (remember (buffer-substring (point) (mark))) 13533 visiting)
12959 (call-interactively 'remember)))) 13534 (unless (and file (stringp file) (string-match "\\S-" file))
13535 (setq file org-default-notes-file))
13536 (unless (and heading (stringp heading) (string-match "\\S-" heading))
13537 (setq heading org-remember-default-headline))
13538 (setq visiting (org-find-base-buffer-visiting file))
13539 (if (not visiting) (find-file-noselect file))
13540 (switch-to-buffer (or visiting (get-file-buffer file)))
13541 (widen)
13542 (goto-char (point-min))
13543 (if (re-search-forward
13544 (concat "^\\*+[ \t]+" (regexp-quote heading)
13545 (org-re "\\([ \t]+:[[:alnum:]@_:]*\\)?[ \t]*$"))
13546 nil t)
13547 (goto-char (match-beginning 0))
13548 (error "Target headline not found: %s" heading))))
12960 13549
12961(defvar org-note-abort nil) ; dynamically scoped 13550(defvar org-note-abort nil) ; dynamically scoped
12962 13551
@@ -13000,23 +13589,34 @@ See also the variable `org-reverse-note-order'."
13000 (while (looking-at "^[ \t]*\n\\|^##.*\n") 13589 (while (looking-at "^[ \t]*\n\\|^##.*\n")
13001 (replace-match "")) 13590 (replace-match ""))
13002 (goto-char (point-max)) 13591 (goto-char (point-max))
13003 (unless (equal (char-before) ?\n) (insert "\n")) 13592 (beginning-of-line 1)
13593 (while (looking-at "[ \t]*$\\|##.*")
13594 (delete-region (1- (point)) (point-max))
13595 (beginning-of-line 1))
13004 (catch 'quit 13596 (catch 'quit
13005 (if org-note-abort (throw 'quit nil)) 13597 (if org-note-abort (throw 'quit nil))
13006 (let* ((txt (buffer-substring (point-min) (point-max))) 13598 (let* ((txt (buffer-substring (point-min) (point-max)))
13007 (fastp (org-xor (equal current-prefix-arg '(4)) 13599 (fastp (org-xor (equal current-prefix-arg '(4))
13008 org-remember-store-without-prompt)) 13600 org-remember-store-without-prompt))
13009 (file (if fastp org-default-notes-file (org-get-org-file))) 13601 (file (cond
13602 (fastp org-default-notes-file)
13603 ((and org-remember-use-refile-when-interactive
13604 org-refile-targets)
13605 org-default-notes-file)
13606 (t (org-get-org-file))))
13010 (heading org-remember-default-headline) 13607 (heading org-remember-default-headline)
13011 (visiting (org-find-base-buffer-visiting file)) 13608 (visiting (and file (org-find-base-buffer-visiting file)))
13012 (org-startup-folded nil) 13609 (org-startup-folded nil)
13013 (org-startup-align-all-tables nil) 13610 (org-startup-align-all-tables nil)
13014 (org-goto-start-pos 1) 13611 (org-goto-start-pos 1)
13015 spos exitcmd level indent reversed) 13612 spos exitcmd level indent reversed)
13016 (if (and (equal current-prefix-arg '(16)) org-remember-previous-location) 13613 (if (and (equal current-prefix-arg '(16)) org-remember-previous-location)
13017 (setq file (car org-remember-previous-location) 13614 (setq file (car org-remember-previous-location)
13018 heading (cdr org-remember-previous-location))) 13615 heading (cdr org-remember-previous-location)
13616 fastp t))
13019 (setq current-prefix-arg nil) 13617 (setq current-prefix-arg nil)
13618 (if (string-match "[ \t\n]+\\'" txt)
13619 (setq txt (replace-match "" t t txt)))
13020 ;; Modify text so that it becomes a nice subtree which can be inserted 13620 ;; Modify text so that it becomes a nice subtree which can be inserted
13021 ;; into an org tree. 13621 ;; into an org tree.
13022 (let* ((lines (split-string txt "\n")) 13622 (let* ((lines (split-string txt "\n"))
@@ -13031,9 +13631,25 @@ See also the variable `org-reverse-note-order'."
13031 " (" (remember-buffer-desc) ")") 13631 " (" (remember-buffer-desc) ")")
13032 indent " ")) 13632 indent " "))
13033 (if (and org-adapt-indentation indent) 13633 (if (and org-adapt-indentation indent)
13034 (setq lines (mapcar (lambda (x) (concat indent x)) lines))) 13634 (setq lines (mapcar
13635 (lambda (x)
13636 (if (string-match "\\S-" x)
13637 (concat indent x) x))
13638 lines)))
13035 (setq txt (concat first "\n" 13639 (setq txt (concat first "\n"
13036 (mapconcat 'identity lines "\n")))) 13640 (mapconcat 'identity lines "\n"))))
13641 (if (string-match "\n[ \t]*\n[ \t\n]*\\'" txt)
13642 (setq txt (replace-match "\n\n" t t txt))
13643 (if (string-match "[ \t\n]*\\'" txt)
13644 (setq txt (replace-match "\n" t t txt))))
13645 ;; Put the modified text back into the remember buffer, for refile.
13646 (erase-buffer)
13647 (insert txt)
13648 (goto-char (point-min))
13649 (when (and org-remember-use-refile-when-interactive
13650 (not fastp))
13651 (org-refile nil (or visiting (find-file-noselect file)))
13652 (throw 'quit t))
13037 ;; Find the file 13653 ;; Find the file
13038 (if (not visiting) (find-file-noselect file)) 13654 (if (not visiting) (find-file-noselect file))
13039 (with-current-buffer (or visiting (get-file-buffer file)) 13655 (with-current-buffer (or visiting (get-file-buffer file))
@@ -13082,19 +13698,22 @@ See also the variable `org-reverse-note-order'."
13082 (org-get-heading 'notags))) 13698 (org-get-heading 'notags)))
13083 (if reversed 13699 (if reversed
13084 (outline-next-heading) 13700 (outline-next-heading)
13085 (org-end-of-subtree) 13701 (org-end-of-subtree t)
13086 (if (not (bolp)) 13702 (if (not (bolp))
13087 (if (looking-at "[ \t]*\n") 13703 (if (looking-at "[ \t]*\n")
13088 (beginning-of-line 2) 13704 (beginning-of-line 2)
13089 (end-of-line 1) 13705 (end-of-line 1)
13090 (insert "\n")))) 13706 (insert "\n"))))
13707 (bookmark-set "org-remember-last-stored")
13091 (org-paste-subtree (org-get-legal-level level 1) txt)) 13708 (org-paste-subtree (org-get-legal-level level 1) txt))
13092 ((eq exitcmd 'left) 13709 ((eq exitcmd 'left)
13093 ;; before current 13710 ;; before current
13711 (bookmark-set "org-remember-last-stored")
13094 (org-paste-subtree level txt)) 13712 (org-paste-subtree level txt))
13095 ((eq exitcmd 'right) 13713 ((eq exitcmd 'right)
13096 ;; after current 13714 ;; after current
13097 (org-end-of-subtree t) 13715 (org-end-of-subtree t)
13716 (bookmark-set "org-remember-last-stored")
13098 (org-paste-subtree level txt)) 13717 (org-paste-subtree level txt))
13099 (t (error "This should not happen")))) 13718 (t (error "This should not happen"))))
13100 13719
@@ -13104,6 +13723,7 @@ See also the variable `org-reverse-note-order'."
13104 (widen) 13723 (widen)
13105 (goto-char (point-max)) 13724 (goto-char (point-max))
13106 (if (not (bolp)) (newline)) 13725 (if (not (bolp)) (newline))
13726 (bookmark-set "org-remember-last-stored")
13107 (org-paste-subtree (org-get-legal-level 1 1) txt))) 13727 (org-paste-subtree (org-get-legal-level 1 1) txt)))
13108 13728
13109 ((and (bobp) reversed) 13729 ((and (bobp) reversed)
@@ -13113,16 +13733,19 @@ See also the variable `org-reverse-note-order'."
13113 (goto-char (point-min)) 13733 (goto-char (point-min))
13114 (re-search-forward "^\\*+ " nil t) 13734 (re-search-forward "^\\*+ " nil t)
13115 (beginning-of-line 1) 13735 (beginning-of-line 1)
13736 (bookmark-set "org-remember-last-stored")
13116 (org-paste-subtree 1 txt))) 13737 (org-paste-subtree 1 txt)))
13117 (t 13738 (t
13118 ;; Put it right there, with automatic level determined by 13739 ;; Put it right there, with automatic level determined by
13119 ;; org-paste-subtree or from prefix arg 13740 ;; org-paste-subtree or from prefix arg
13741 (bookmark-set "org-remember-last-stored")
13120 (org-paste-subtree 13742 (org-paste-subtree
13121 (if (numberp current-prefix-arg) current-prefix-arg) 13743 (if (numberp current-prefix-arg) current-prefix-arg)
13122 txt))) 13744 txt)))
13123 (when remember-save-after-remembering 13745 (when remember-save-after-remembering
13124 (save-buffer) 13746 (save-buffer)
13125 (if (not visiting) (kill-buffer (current-buffer))))))))) 13747 (if (not visiting) (kill-buffer (current-buffer)))))))))
13748
13126 t) ;; return t to indicate that we took care of this note. 13749 t) ;; return t to indicate that we took care of this note.
13127 13750
13128(defun org-get-org-file () 13751(defun org-get-org-file ()
@@ -13146,6 +13769,160 @@ See also the variable `org-reverse-note-order'."
13146 (throw 'exit (cdr entry)))) 13769 (throw 'exit (cdr entry))))
13147 nil))))) 13770 nil)))))
13148 13771
13772;;; Refiling
13773
13774(defvar org-refile-target-table nil
13775 "The list of refile targets, created by `org-refile'.")
13776
13777(defvar org-agenda-new-buffers nil
13778 "Buffers created to visit agenda files.")
13779
13780(defun org-get-refile-targets (&optional default-buffer)
13781 "Produce a table with refile targets."
13782 (let ((entries (or org-refile-targets '((nil . (:level . 1)))))
13783 org-agenda-new-buffers targets txt re files f desc descre)
13784 (with-current-buffer (or default-buffer (current-buffer))
13785 (while (setq entry (pop entries))
13786 (setq files (car entry) desc (cdr entry))
13787 (cond
13788 ((null files) (setq files (list (current-buffer))))
13789 ((eq files 'org-agenda-files)
13790 (setq files (org-agenda-files 'unrestricted)))
13791 ((and (symbolp files) (fboundp files))
13792 (setq files (funcall files)))
13793 ((and (symbolp files) (boundp files))
13794 (setq files (symbol-value files))))
13795 (if (stringp files) (setq files (list files)))
13796 (cond
13797 ((eq (car desc) :tag)
13798 (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":")))
13799 ((eq (car desc) :todo)
13800 (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]")))
13801 ((eq (car desc) :regexp)
13802 (setq descre (cdr desc)))
13803 ((eq (car desc) :level)
13804 (setq descre (concat "^\\*\\{" (number-to-string
13805 (if org-odd-levels-only
13806 (1- (* 2 (cdr desc)))
13807 (cdr desc)))
13808 "\\}[ \t]")))
13809 ((eq (car desc) :maxlevel)
13810 (setq descre (concat "^\\*\\{1," (number-to-string
13811 (if org-odd-levels-only
13812 (1- (* 2 (cdr desc)))
13813 (cdr desc)))
13814 "\\}[ \t]")))
13815 (t (error "Bad refiling target description %s" desc)))
13816 (while (setq f (pop files))
13817 (save-excursion
13818 (set-buffer (if (bufferp f) f (org-get-agenda-file-buffer f)))
13819 (if (bufferp f) (setq f (buffer-file-name (buffer-base-buffer f))))
13820 (save-excursion
13821 (save-restriction
13822 (widen)
13823 (goto-char (point-min))
13824 (while (re-search-forward descre nil t)
13825 (goto-char (point-at-bol))
13826 (when (looking-at org-complex-heading-regexp)
13827 (setq txt (match-string 4)
13828 re (concat "^" (regexp-quote
13829 (buffer-substring (match-beginning 1)
13830 (match-end 4)))))
13831 (if (match-end 5) (setq re (concat re "[ \t]+"
13832 (regexp-quote
13833 (match-string 5)))))
13834 (setq re (concat re "[ \t]*$"))
13835 (when org-refile-use-outline-path
13836 (setq txt (mapconcat 'identity
13837 (append
13838 (if (eq org-refile-use-outline-path 'file)
13839 (list (file-name-nondirectory
13840 (buffer-file-name (buffer-base-buffer))))
13841 (if (eq org-refile-use-outline-path 'full-file-path)
13842 (list (buffer-file-name (buffer-base-buffer)))))
13843 (org-get-outline-path)
13844 (list txt))
13845 "/")))
13846 (push (list txt f re (point)) targets))
13847 (goto-char (point-at-eol))))))))
13848 (org-release-buffers org-agenda-new-buffers)
13849 (nreverse targets))))
13850
13851(defun org-get-outline-path ()
13852 (let (rtn)
13853 (save-excursion
13854 (while (org-up-heading-safe)
13855 (when (looking-at org-complex-heading-regexp)
13856 (push (org-match-string-no-properties 4) rtn)))
13857 rtn)))
13858
13859(defvar org-refile-history nil
13860 "History for refiling operations.")
13861
13862(defun org-refile (&optional reversed-or-update default-buffer)
13863 "Move the entry at point to another heading.
13864The list of target headings is compiled using the information in
13865`org-refile-targets', which see. This list is created upon first use, and
13866you can update it by calling this command with a double prefix (`C-u C-u').
13867FIXME: Can we find a better way of updating?
13868
13869At the target location, the entry is filed as a subitem of the target heading.
13870Depending on `org-reverse-note-order', the new subitem will either be the
13871first of the last subitem. A single C-u prefix will toggle the value of this
13872variable for the duration of the command."
13873 (interactive "P")
13874 (if (equal reversed-or-update '(16))
13875 (progn
13876 (setq org-refile-target-table (org-get-refile-targets default-buffer))
13877 (message "Refile targets updated (%d targets)"
13878 (length org-refile-target-table)))
13879 (when (or (not org-refile-target-table)
13880 (assq nil org-refile-targets))
13881 (setq org-refile-target-table (org-get-refile-targets default-buffer)))
13882 (unless org-refile-target-table
13883 (error "No refile targets"))
13884 (let* ((cbuf (current-buffer))
13885 (filename (buffer-file-name (buffer-base-buffer cbuf)))
13886 (fname (and filename (file-truename filename)))
13887 (tbl (mapcar
13888 (lambda (x)
13889 (if (not (equal fname (file-truename (nth 1 x))))
13890 (cons (concat (car x) " (" (file-name-nondirectory
13891 (nth 1 x)) ")")
13892 (cdr x))
13893 x))
13894 org-refile-target-table))
13895 (completion-ignore-case t)
13896 pos it nbuf file re level reversed)
13897 (when (setq it (completing-read "Refile to: " tbl
13898 nil t nil 'org-refile-history))
13899 (setq it (assoc it tbl)
13900 file (nth 1 it)
13901 re (nth 2 it))
13902 (org-copy-special)
13903 (save-excursion
13904 (set-buffer (setq nbuf (or (find-buffer-visiting file)
13905 (find-file-noselect file))))
13906 (setq reversed (org-notes-order-reversed-p))
13907 (if (equal reversed-or-update '(16)) (setq reversed (not reversed)))
13908 (save-excursion
13909 (save-restriction
13910 (widen)
13911 (goto-char (point-min))
13912 (unless (re-search-forward re nil t)
13913 (error "Cannot find target location - try again with `C-u' prefix."))
13914 (goto-char (match-beginning 0))
13915 (looking-at outline-regexp)
13916 (setq level (org-get-legal-level (funcall outline-level) 1))
13917 (goto-char (or (save-excursion
13918 (if reversed
13919 (outline-next-heading)
13920 (outline-get-next-sibling)))
13921 (point-max)))
13922 (org-paste-subtree level))))
13923 (org-cut-special)
13924 (message "Entry refiled to \"%s\"" (car it))))))
13925
13149;;;; Dynamic blocks 13926;;;; Dynamic blocks
13150 13927
13151(defun org-find-dblock (name) 13928(defun org-find-dblock (name)
@@ -13264,7 +14041,8 @@ This function can be used in a hook."
13264 14041
13265(defconst org-additional-option-like-keywords 14042(defconst org-additional-option-like-keywords
13266 '("BEGIN_HTML" "BEGIN_LaTeX" "END_HTML" "END_LaTeX" 14043 '("BEGIN_HTML" "BEGIN_LaTeX" "END_HTML" "END_LaTeX"
13267 "ORGTBL" "HTML:" "LaTeX:" "BEGIN:" "END:" "DATE:")) 14044 "ORGTBL" "HTML:" "LaTeX:" "BEGIN:" "END:" "DATE:" "TBLFM"
14045 "BEGIN_EXAMPLE" "END_EXAMPLE"))
13268 14046
13269(defun org-complete (&optional arg) 14047(defun org-complete (&optional arg)
13270 "Perform completion on word at point. 14048 "Perform completion on word at point.
@@ -13385,13 +14163,14 @@ At all other locations, this simply calls the value of
13385 (interactive) 14163 (interactive)
13386 (save-excursion 14164 (save-excursion
13387 (org-back-to-heading) 14165 (org-back-to-heading)
13388 (if (looking-at (concat outline-regexp 14166 (let (case-fold-search)
13389 "\\( *\\<" org-comment-string "\\>[ \t]*\\)")) 14167 (if (looking-at (concat outline-regexp
13390 (replace-match "" t t nil 1) 14168 "\\( *\\<" org-comment-string "\\>[ \t]*\\)"))
13391 (if (looking-at outline-regexp) 14169 (replace-match "" t t nil 1)
13392 (progn 14170 (if (looking-at outline-regexp)
13393 (goto-char (match-end 0)) 14171 (progn
13394 (insert org-comment-string " ")))))) 14172 (goto-char (match-end 0))
14173 (insert org-comment-string " ")))))))
13395 14174
13396(defvar org-last-todo-state-is-todo nil 14175(defvar org-last-todo-state-is-todo nil
13397 "This is non-nil when the last TODO state change led to a TODO state. 14176 "This is non-nil when the last TODO state change led to a TODO state.
@@ -13491,7 +14270,7 @@ For calling through lisp, arg is also interpreted in the following way:
13491 (or (looking-at (concat " +" org-todo-regexp " *")) 14270 (or (looking-at (concat " +" org-todo-regexp " *"))
13492 (looking-at " *")) 14271 (looking-at " *"))
13493 (let* ((match-data (match-data)) 14272 (let* ((match-data (match-data))
13494 (startpos (line-beginning-position)) 14273 (startpos (point-at-bol))
13495 (logging (save-match-data (org-entry-get nil "LOGGING" t))) 14274 (logging (save-match-data (org-entry-get nil "LOGGING" t)))
13496 (org-log-done (org-parse-local-options logging 'org-log-done)) 14275 (org-log-done (org-parse-local-options logging 'org-log-done))
13497 (org-log-repeat (org-parse-local-options logging 'org-log-repeat)) 14276 (org-log-repeat (org-parse-local-options logging 'org-log-repeat))
@@ -13666,8 +14445,6 @@ Returns the new TODO keyword, or nil if no state change should occur."
13666 (save-window-excursion 14445 (save-window-excursion
13667 (if expert 14446 (if expert
13668 (set-buffer (get-buffer-create " *Org todo*")) 14447 (set-buffer (get-buffer-create " *Org todo*"))
13669; (delete-other-windows)
13670; (split-window-vertically)
13671 (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*"))) 14448 (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*")))
13672 (erase-buffer) 14449 (erase-buffer)
13673 (org-set-local 'org-done-keywords done-keywords) 14450 (org-set-local 'org-done-keywords done-keywords)
@@ -13968,7 +14745,7 @@ The auto-repeater uses this.")
13968 (end-of-line 1) 14745 (end-of-line 1)
13969 (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) 14746 (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
13970 (indent-relative nil) 14747 (indent-relative nil)
13971 (insert " - " (pop lines)) 14748 (insert "- " (pop lines))
13972 (org-indent-line-function) 14749 (org-indent-line-function)
13973 (beginning-of-line 1) 14750 (beginning-of-line 1)
13974 (looking-at "[ \t]*") 14751 (looking-at "[ \t]*")
@@ -13994,12 +14771,17 @@ t Show entries with a specific TODO keyword.
13994T Show entries selected by a tags match. 14771T Show entries selected by a tags match.
13995p Enter a property name and its value (both with completion on existing 14772p Enter a property name and its value (both with completion on existing
13996 names/values) and show entries with that property. 14773 names/values) and show entries with that property.
13997r Show entries matching a regular expression" 14774r Show entries matching a regular expression
14775d Show deadlines due within `org-deadline-warning-days'."
13998 (interactive "P") 14776 (interactive "P")
13999 (let (ans kwd value) 14777 (let (ans kwd value)
14000 (message "Sparse tree: [r]egexp [t]odo-kwd [T]ag [p]roperty") 14778 (message "Sparse tree: [/]regexp [t]odo-kwd [T]ag [p]roperty [d]eadlines [b]efore-date")
14001 (setq ans (read-char-exclusive)) 14779 (setq ans (read-char-exclusive))
14002 (cond 14780 (cond
14781 ((equal ans ?d)
14782 (call-interactively 'org-check-deadlines))
14783 ((equal ans ?b)
14784 (call-interactively 'org-check-before-date))
14003 ((equal ans ?t) 14785 ((equal ans ?t)
14004 (org-show-todo-tree '(4))) 14786 (org-show-todo-tree '(4)))
14005 ((equal ans ?T) 14787 ((equal ans ?T)
@@ -14012,7 +14794,7 @@ r Show entries matching a regular expression"
14012 (unless (string-match "\\`{.*}\\'" value) 14794 (unless (string-match "\\`{.*}\\'" value)
14013 (setq value (concat "\"" value "\""))) 14795 (setq value (concat "\"" value "\"")))
14014 (org-tags-sparse-tree arg (concat kwd "=" value))) 14796 (org-tags-sparse-tree arg (concat kwd "=" value)))
14015 ((member ans '(?r ?R)) 14797 ((member ans '(?r ?R ?/))
14016 (call-interactively 'org-occur)) 14798 (call-interactively 'org-occur))
14017 (t (error "No such sparse tree command \"%c\"" ans))))) 14799 (t (error "No such sparse tree command \"%c\"" ans)))))
14018 14800
@@ -14063,12 +14845,13 @@ How much context is shown depends upon the variables
14063 (let ((heading-p (org-on-heading-p t)) 14845 (let ((heading-p (org-on-heading-p t))
14064 (hierarchy-p (org-get-alist-option org-show-hierarchy-above key)) 14846 (hierarchy-p (org-get-alist-option org-show-hierarchy-above key))
14065 (following-p (org-get-alist-option org-show-following-heading key)) 14847 (following-p (org-get-alist-option org-show-following-heading key))
14848 (entry-p (org-get-alist-option org-show-entry-below key))
14066 (siblings-p (org-get-alist-option org-show-siblings key))) 14849 (siblings-p (org-get-alist-option org-show-siblings key)))
14067 (catch 'exit 14850 (catch 'exit
14068 ;; Show heading or entry text 14851 ;; Show heading or entry text
14069 (if heading-p 14852 (if (and heading-p (not entry-p))
14070 (org-flag-heading nil) ; only show the heading 14853 (org-flag-heading nil) ; only show the heading
14071 (and (or (org-invisible-p) (org-invisible-p2)) 14854 (and (or entry-p (org-invisible-p) (org-invisible-p2))
14072 (org-show-hidden-entry))) ; show entire entry 14855 (org-show-hidden-entry))) ; show entire entry
14073 (when following-p 14856 (when following-p
14074 ;; Show next sibling, or heading below text 14857 ;; Show next sibling, or heading below text
@@ -14303,11 +15086,13 @@ MATCH can contain positive and negative selection of tags, like
14303If optional argument TODO_ONLY is non-nil, only select lines that are 15086If optional argument TODO_ONLY is non-nil, only select lines that are
14304also TODO lines." 15087also TODO lines."
14305 (interactive "P") 15088 (interactive "P")
15089 (org-prepare-agenda-buffers (list (current-buffer)))
14306 (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) 15090 (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only))
14307 15091
14308(defvar org-cached-props nil) 15092(defvar org-cached-props nil)
14309(defun org-cached-entry-get (pom property) 15093(defun org-cached-entry-get (pom property)
14310 (if org-use-property-inheritance 15094 (if (or (eq t org-use-property-inheritance)
15095 (member property org-use-property-inheritance))
14311 ;; Caching is not possible, check it directly 15096 ;; Caching is not possible, check it directly
14312 (org-entry-get pom property 'inherit) 15097 (org-entry-get pom property 'inherit)
14313 ;; Get all properties, so that we can do complicated checks easily 15098 ;; Get all properties, so that we can do complicated checks easily
@@ -14345,7 +15130,7 @@ also TODO lines."
14345 (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL=\\([0-9]+\\)\\|\\([[:alnum:]_]+\\)=\\({[^}]+}\\|\"[^\"]+\"\\)\\|[[:alnum:]_@]+\\)")) 15130 (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL=\\([0-9]+\\)\\|\\([[:alnum:]_]+\\)=\\({[^}]+}\\|\"[^\"]+\"\\)\\|[[:alnum:]_@]+\\)"))
14346 minus tag mm 15131 minus tag mm
14347 tagsmatch todomatch tagsmatcher todomatcher kwd matcher 15132 tagsmatch todomatch tagsmatcher todomatcher kwd matcher
14348 orterms term orlist re-p level-p prop-p pn pv) 15133 orterms term orlist re-p level-p prop-p pn pv cat-p gv)
14349 (if (string-match "/+" match) 15134 (if (string-match "/+" match)
14350 ;; match contains also a todo-matching request 15135 ;; match contains also a todo-matching request
14351 (progn 15136 (progn
@@ -14379,11 +15164,15 @@ also TODO lines."
14379 (prop-p 15164 (prop-p
14380 (setq pn (match-string 4 term) 15165 (setq pn (match-string 4 term)
14381 pv (match-string 5 term) 15166 pv (match-string 5 term)
15167 cat-p (equal pn "CATEGORY")
14382 re-p (equal (string-to-char pv) ?{) 15168 re-p (equal (string-to-char pv) ?{)
14383 pv (substring pv 1 -1)) 15169 pv (substring pv 1 -1))
15170 (if (equal pn "CATEGORY")
15171 (setq gv '(get-text-property (point) 'org-category))
15172 (setq gv `(org-cached-entry-get nil ,pn)))
14384 (if re-p 15173 (if re-p
14385 `(string-match ,pv (or (org-cached-entry-get nil ,pn) "")) 15174 `(string-match ,pv (or ,gv ""))
14386 `(equal ,pv (org-cached-entry-get nil ,pn)))) 15175 `(equal ,pv ,gv)))
14387 (t `(member ,(downcase tag) tags-list))) 15176 (t `(member ,(downcase tag) tags-list)))
14388 mm (if minus (list 'not mm) mm) 15177 mm (if minus (list 'not mm) mm)
14389 term (substring term (match-end 0))) 15178 term (substring term (match-end 0)))
@@ -14839,7 +15628,8 @@ Returns the new tags string, or nil to not change the current settings."
14839;;; Setting and retrieving properties 15628;;; Setting and retrieving properties
14840 15629
14841(defconst org-special-properties 15630(defconst org-special-properties
14842 '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "PRIORITY") 15631 '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "PRIORITY"
15632 "TIMESTAMP" "TIMESTAMP_IA")
14843 "The special properties valid in Org-mode. 15633 "The special properties valid in Org-mode.
14844 15634
14845These are properties that are not defined in the property drawer, 15635These are properties that are not defined in the property drawer,
@@ -14935,11 +15725,12 @@ If WHICH is nil or `all', get all properties. If WHICH is
14935 (org-with-point-at pom 15725 (org-with-point-at pom
14936 (let ((clockstr (substring org-clock-string 0 -1)) 15726 (let ((clockstr (substring org-clock-string 0 -1))
14937 (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY")) 15727 (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY"))
14938 beg end range props sum-props key value) 15728 beg end range props sum-props key value string clocksum)
14939 (save-excursion 15729 (save-excursion
14940 (when (condition-case nil (org-back-to-heading t) (error nil)) 15730 (when (condition-case nil (org-back-to-heading t) (error nil))
14941 (setq beg (point)) 15731 (setq beg (point))
14942 (setq sum-props (get-text-property (point) 'org-summaries)) 15732 (setq sum-props (get-text-property (point) 'org-summaries))
15733 (setq clocksum (get-text-property (point) :org-clock-minutes))
14943 (outline-next-heading) 15734 (outline-next-heading)
14944 (setq end (point)) 15735 (setq end (point))
14945 (when (memq which '(all special)) 15736 (when (memq which '(all special))
@@ -14955,17 +15746,23 @@ If WHICH is nil or `all', get all properties. If WHICH is
14955 (when (setq value (org-get-tags-at)) 15746 (when (setq value (org-get-tags-at))
14956 (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") ":")) 15747 (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") ":"))
14957 props)) 15748 props))
14958 (while (re-search-forward org-keyword-time-regexp end t) 15749 (while (re-search-forward org-maybe-keyword-time-regexp end t)
14959 (setq key (substring (org-match-string-no-properties 1) 0 -1)) 15750 (setq key (if (match-end 1) (substring (org-match-string-no-properties 1) 0 -1))
14960 (unless (member key excluded) (push key excluded)) 15751 string (if (equal key clockstr)
14961 (push (cons key 15752 (org-no-properties
14962 (if (equal key clockstr) 15753 (org-trim
14963 (org-no-properties 15754 (buffer-substring
14964 (org-trim 15755 (match-beginning 3) (goto-char (point-at-eol)))))
14965 (buffer-substring 15756 (substring (org-match-string-no-properties 3) 1 -1)))
14966 (match-beginning 2) (point-at-eol)))) 15757 (unless key
14967 (org-match-string-no-properties 2))) 15758 (if (= (char-after (match-beginning 3)) ?\[)
14968 props))) 15759 (setq key "TIMESTAMP_IA")
15760 (setq key "TIMESTAMP")))
15761 (when (or (equal key clockstr) (not (assoc key props)))
15762 (push (cons key string) props)))
15763
15764 )
15765
14969 (when (memq which '(all standard)) 15766 (when (memq which '(all standard))
14970 ;; Get the standard properties, like :PORP: ... 15767 ;; Get the standard properties, like :PORP: ...
14971 (setq range (org-get-property-block beg end)) 15768 (setq range (org-get-property-block beg end))
@@ -14978,6 +15775,11 @@ If WHICH is nil or `all', get all properties. If WHICH is
14978 value (org-trim (or (org-match-string-no-properties 2) ""))) 15775 value (org-trim (or (org-match-string-no-properties 2) "")))
14979 (unless (member key excluded) 15776 (unless (member key excluded)
14980 (push (cons key (or value "")) props))))) 15777 (push (cons key (or value "")) props)))))
15778 (if clocksum
15779 (push (cons "CLOCKSUM"
15780 (org-column-number-to-string (/ (float clocksum) 60.)
15781 'add_times))
15782 props))
14981 (append sum-props (nreverse props))))))) 15783 (append sum-props (nreverse props)))))))
14982 15784
14983(defun org-entry-get (pom property &optional inherit) 15785(defun org-entry-get (pom property &optional inherit)
@@ -15175,6 +15977,7 @@ internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING."
15175 (and (equal (char-after) ?\n) (forward-char 1)) 15977 (and (equal (char-after) ?\n) (forward-char 1))
15176 (org-skip-over-state-notes) 15978 (org-skip-over-state-notes)
15177 (skip-chars-backward " \t\n\r") 15979 (skip-chars-backward " \t\n\r")
15980 (if (eq (char-before) ?*) (forward-char 1))
15178 (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:")) 15981 (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:"))
15179 (beginning-of-line 0) 15982 (beginning-of-line 0)
15180 (indent-to-column indent) 15983 (indent-to-column indent)
@@ -15610,6 +16413,8 @@ Where possible, use the standard interface for changing this line."
15610 org-columns-overlays))) 16413 org-columns-overlays)))
15611 nval eval allowed) 16414 nval eval allowed)
15612 (cond 16415 (cond
16416 ((equal key "CLOCKSUM")
16417 (error "This special column cannot be edited"))
15613 ((equal key "ITEM") 16418 ((equal key "ITEM")
15614 (setq eval '(org-with-point-at pom 16419 (setq eval '(org-with-point-at pom
15615 (org-edit-headline)))) 16420 (org-edit-headline))))
@@ -15680,7 +16485,7 @@ Where possible, use the standard interface for changing this line."
15680 (key1 (concat key "_ALL")) 16485 (key1 (concat key "_ALL"))
15681 (allowed (org-entry-get (point) key1 t)) 16486 (allowed (org-entry-get (point) key1 t))
15682 nval) 16487 nval)
15683 ;; FIXME: Cover editing TODO, TAGS etc inbiffer settings.???? 16488 ;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.????
15684 (setq nval (read-string "Allowed: " allowed)) 16489 (setq nval (read-string "Allowed: " allowed))
15685 (org-entry-put 16490 (org-entry-put
15686 (cond ((marker-position org-entry-property-inherited-from) 16491 (cond ((marker-position org-entry-property-inherited-from)
@@ -15697,7 +16502,7 @@ Where possible, use the standard interface for changing this line."
15697 (save-excursion 16502 (save-excursion
15698 (beginning-of-line 1) 16503 (beginning-of-line 1)
15699 ;; `next-line' is needed here, because it skips invisible line. 16504 ;; `next-line' is needed here, because it skips invisible line.
15700 (condition-case nil (org-no-warnings (next-line 1)) (error nil)) 16505 (condition-case nil (org-no-warnings (next-line 1)) (error nil))
15701 (setq hidep (org-on-heading-p 1))) 16506 (setq hidep (org-on-heading-p 1)))
15702 (eval form) 16507 (eval form)
15703 (and hidep (hide-entry)))) 16508 (and hidep (hide-entry))))
@@ -15797,7 +16602,7 @@ Where possible, use the standard interface for changing this line."
15797 (org-verify-version 'columns) 16602 (org-verify-version 'columns)
15798 (org-columns-remove-overlays) 16603 (org-columns-remove-overlays)
15799 (move-marker org-columns-begin-marker (point)) 16604 (move-marker org-columns-begin-marker (point))
15800 (let (beg end fmt cache maxwidths) 16605 (let (beg end fmt cache maxwidths clocksump)
15801 (setq fmt (org-columns-get-format-and-top-level)) 16606 (setq fmt (org-columns-get-format-and-top-level))
15802 (save-excursion 16607 (save-excursion
15803 (goto-char org-columns-top-level-marker) 16608 (goto-char org-columns-top-level-marker)
@@ -15806,8 +16611,14 @@ Where possible, use the standard interface for changing this line."
15806 (org-columns-compute-all)) 16611 (org-columns-compute-all))
15807 (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil)) 16612 (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil))
15808 (point-max))) 16613 (point-max)))
15809 (goto-char beg)
15810 ;; Get and cache the properties 16614 ;; Get and cache the properties
16615 (goto-char beg)
16616 (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled)
16617 (setq clocksump t)
16618 (save-excursion
16619 (save-restriction
16620 (narrow-to-region beg end)
16621 (org-clock-sum))))
15811 (while (re-search-forward (concat "^" outline-regexp) end t) 16622 (while (re-search-forward (concat "^" outline-regexp) end t)
15812 (push (cons (org-current-line) (org-entry-properties)) cache)) 16623 (push (cons (org-current-line) (org-entry-properties)) cache))
15813 (when cache 16624 (when cache
@@ -15819,7 +16630,7 @@ Where possible, use the standard interface for changing this line."
15819 (org-columns-display-here (cdr x))) 16630 (org-columns-display-here (cdr x)))
15820 cache))))) 16631 cache)))))
15821 16632
15822(defun org-columns-new (&optional prop title width op fmt) 16633(defun org-columns-new (&optional prop title width op fmt &rest rest)
15823 "Insert a new column, to the leeft o the current column." 16634 "Insert a new column, to the leeft o the current column."
15824 (interactive) 16635 (interactive)
15825 (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled))) 16636 (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled)))
@@ -15833,7 +16644,7 @@ Where possible, use the standard interface for changing this line."
15833 (setq width (string-to-number width)) 16644 (setq width (string-to-number width))
15834 (setq width nil)) 16645 (setq width nil))
15835 (setq fmt (completing-read "Summary [none]: " 16646 (setq fmt (completing-read "Summary [none]: "
15836 '(("none") ("add_numbers") ("add_times") ("checkbox")) 16647 '(("none") ("add_numbers") ("currency") ("add_times") ("checkbox"))
15837 nil t)) 16648 nil t))
15838 (if (string-match "\\S-" fmt) 16649 (if (string-match "\\S-" fmt)
15839 (setq fmt (intern fmt)) 16650 (setq fmt (intern fmt))
@@ -16036,6 +16847,7 @@ display, or in the #+COLUMNS line of the current buffer."
16036 (level 0) 16847 (level 0)
16037 (ass (assoc property org-columns-current-fmt-compiled)) 16848 (ass (assoc property org-columns-current-fmt-compiled))
16038 (format (nth 4 ass)) 16849 (format (nth 4 ass))
16850 (printf (nth 5 ass))
16039 (beg org-columns-top-level-marker) 16851 (beg org-columns-top-level-marker)
16040 last-level val valflag flag end sumpos sum-alist sum str str1 useval) 16852 last-level val valflag flag end sumpos sum-alist sum str str1 useval)
16041 (save-excursion 16853 (save-excursion
@@ -16055,7 +16867,7 @@ display, or in the #+COLUMNS line of the current buffer."
16055 ;; put the sum of lower levels here as a property 16867 ;; put the sum of lower levels here as a property
16056 (setq sum (aref lsum last-level) ; current sum 16868 (setq sum (aref lsum last-level) ; current sum
16057 flag (aref lflag last-level) ; any valid entries from children? 16869 flag (aref lflag last-level) ; any valid entries from children?
16058 str (org-column-number-to-string sum format) 16870 str (org-column-number-to-string sum format printf)
16059 str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold) 16871 str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold)
16060 useval (if flag str1 (if valflag val "")) 16872 useval (if flag str1 (if valflag val ""))
16061 sum-alist (get-text-property sumpos 'org-summaries)) 16873 sum-alist (get-text-property sumpos 'org-summaries))
@@ -16069,7 +16881,6 @@ display, or in the #+COLUMNS line of the current buffer."
16069 (org-entry-put nil property (if flag str val))) 16881 (org-entry-put nil property (if flag str val)))
16070 ;; add current to current level accumulator 16882 ;; add current to current level accumulator
16071 (when (or flag valflag) 16883 (when (or flag valflag)
16072 ;; FIXME: is this ok?????????
16073 (aset lsum level (+ (aref lsum level) 16884 (aset lsum level (+ (aref lsum level)
16074 (if flag sum (org-column-string-to-number 16885 (if flag sum (org-column-string-to-number
16075 (if flag str val) format)))) 16886 (if flag str val) format))))
@@ -16112,7 +16923,7 @@ display, or in the #+COLUMNS line of the current buffer."
16112 (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) 16923 (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
16113 sum))) 16924 sum)))
16114 16925
16115(defun org-column-number-to-string (n fmt) 16926(defun org-column-number-to-string (n fmt &optional printf)
16116 "Convert a computed column number to a string value, according to FMT." 16927 "Convert a computed column number to a string value, according to FMT."
16117 (cond 16928 (cond
16118 ((eq fmt 'add_times) 16929 ((eq fmt 'add_times)
@@ -16122,6 +16933,9 @@ display, or in the #+COLUMNS line of the current buffer."
16122 (cond ((= n (floor n)) "[X]") 16933 (cond ((= n (floor n)) "[X]")
16123 ((> n 1.) "[-]") 16934 ((> n 1.) "[-]")
16124 (t "[ ]"))) 16935 (t "[ ]")))
16936 (printf (format printf n))
16937 ((eq fmt 'currency)
16938 (format "%.2f" n))
16125 (t (number-to-string n)))) 16939 (t (number-to-string n))))
16126 16940
16127(defun org-column-string-to-number (s fmt) 16941(defun org-column-string-to-number (s fmt)
@@ -16138,17 +16952,20 @@ display, or in the #+COLUMNS line of the current buffer."
16138 16952
16139(defun org-columns-uncompile-format (cfmt) 16953(defun org-columns-uncompile-format (cfmt)
16140 "Turn the compiled columns format back into a string representation." 16954 "Turn the compiled columns format back into a string representation."
16141 (let ((rtn "") e s prop title op width fmt) 16955 (let ((rtn "") e s prop title op width fmt printf)
16142 (while (setq e (pop cfmt)) 16956 (while (setq e (pop cfmt))
16143 (setq prop (car e) 16957 (setq prop (car e)
16144 title (nth 1 e) 16958 title (nth 1 e)
16145 width (nth 2 e) 16959 width (nth 2 e)
16146 op (nth 3 e) 16960 op (nth 3 e)
16147 fmt (nth 4 e)) 16961 fmt (nth 4 e)
16962 printf (nth 5 e))
16148 (cond 16963 (cond
16149 ((eq fmt 'add_times) (setq op ":")) 16964 ((eq fmt 'add_times) (setq op ":"))
16150 ((eq fmt 'checkbox) (setq op "X")) 16965 ((eq fmt 'checkbox) (setq op "X"))
16151 ((eq fmt 'add_numbers) (setq op "+"))) 16966 ((eq fmt 'add_numbers) (setq op "+"))
16967 ((eq fmt 'currency) (setq op "$")))
16968 (if (and op printf) (setq op (concat op ";" printf)))
16152 (if (equal title prop) (setq title nil)) 16969 (if (equal title prop) (setq title nil))
16153 (setq s (concat "%" (if width (number-to-string width)) 16970 (setq s (concat "%" (if width (number-to-string width))
16154 prop 16971 prop
@@ -16165,8 +16982,9 @@ property the property
16165title the title field for the columns 16982title the title field for the columns
16166width the column width in characters, can be nil for automatic 16983width the column width in characters, can be nil for automatic
16167operator the operator if any 16984operator the operator if any
16168format the output format for computed results, derived from operator" 16985format the output format for computed results, derived from operator
16169 (let ((start 0) width prop title op f) 16986printf a printf format for computed values"
16987 (let ((start 0) width prop title op f printf)
16170 (setq org-columns-current-fmt-compiled nil) 16988 (setq org-columns-current-fmt-compiled nil)
16171 (while (string-match 16989 (while (string-match
16172 (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*") 16990 (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*")
@@ -16176,13 +16994,18 @@ format the output format for computed results, derived from operator"
16176 prop (match-string 2 fmt) 16994 prop (match-string 2 fmt)
16177 title (or (match-string 3 fmt) prop) 16995 title (or (match-string 3 fmt) prop)
16178 op (match-string 4 fmt) 16996 op (match-string 4 fmt)
16179 f nil) 16997 f nil
16998 printf nil)
16180 (if width (setq width (string-to-number width))) 16999 (if width (setq width (string-to-number width)))
17000 (when (and op (string-match ";" op))
17001 (setq printf (substring op (match-end 0))
17002 op (substring op 0 (match-beginning 0))))
16181 (cond 17003 (cond
16182 ((equal op "+") (setq f 'add_numbers)) 17004 ((equal op "+") (setq f 'add_numbers))
17005 ((equal op "$") (setq f 'currency))
16183 ((equal op ":") (setq f 'add_times)) 17006 ((equal op ":") (setq f 'add_times))
16184 ((equal op "X") (setq f 'checkbox))) 17007 ((equal op "X") (setq f 'checkbox)))
16185 (push (list prop title width op f) org-columns-current-fmt-compiled)) 17008 (push (list prop title width op f printf) org-columns-current-fmt-compiled))
16186 (setq org-columns-current-fmt-compiled 17009 (setq org-columns-current-fmt-compiled
16187 (nreverse org-columns-current-fmt-compiled)))) 17010 (nreverse org-columns-current-fmt-compiled))))
16188 17011
@@ -16311,28 +17134,30 @@ So if you press just return without typing anything, the time stamp
16311will represent the current date/time. If there is already a timestamp 17134will represent the current date/time. If there is already a timestamp
16312at the cursor, it will be modified." 17135at the cursor, it will be modified."
16313 (interactive "P") 17136 (interactive "P")
16314 (let ((default-time 17137 (let* ((ts nil)
16315 ;; Default time is either today, or, when entering a range, 17138 (default-time
16316 ;; the range start. 17139 ;; Default time is either today, or, when entering a range,
16317 (if (or (org-at-timestamp-p t) 17140 ;; the range start.
16318 (save-excursion 17141 (if (or (and (org-at-timestamp-p t) (setq ts (match-string 0)))
16319 (re-search-backward 17142 (save-excursion
16320 (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses 17143 (re-search-backward
16321 (- (point) 20) t))) 17144 (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses
16322 (apply 'encode-time (org-parse-time-string (match-string 1))) 17145 (- (point) 20) t)))
16323 (current-time))) 17146 (apply 'encode-time (org-parse-time-string (match-string 1)))
16324 org-time-was-given org-end-time-was-given time) 17147 (current-time)))
17148 (default-input (and ts (org-get-compact-tod ts)))
17149 org-time-was-given org-end-time-was-given time)
16325 (cond 17150 (cond
16326 ((and (org-at-timestamp-p) 17151 ((and (org-at-timestamp-p)
16327 (eq last-command 'org-time-stamp) 17152 (eq last-command 'org-time-stamp)
16328 (eq this-command 'org-time-stamp)) 17153 (eq this-command 'org-time-stamp))
16329 (insert "--") 17154 (insert "--")
16330 (setq time (let ((this-command this-command)) 17155 (setq time (let ((this-command this-command))
16331 (org-read-date arg 'totime nil nil default-time))) 17156 (org-read-date arg 'totime nil nil default-time default-input)))
16332 (org-insert-time-stamp time (or org-time-was-given arg))) 17157 (org-insert-time-stamp time (or org-time-was-given arg)))
16333 ((org-at-timestamp-p) 17158 ((org-at-timestamp-p)
16334 (setq time (let ((this-command this-command)) 17159 (setq time (let ((this-command this-command))
16335 (org-read-date arg 'totime nil nil default-time))) 17160 (org-read-date arg 'totime nil nil default-time default-input)))
16336 (when (org-at-timestamp-p) ; just to get the match data 17161 (when (org-at-timestamp-p) ; just to get the match data
16337 (replace-match "") 17162 (replace-match "")
16338 (setq org-last-changed-timestamp 17163 (setq org-last-changed-timestamp
@@ -16342,10 +17167,28 @@ at the cursor, it will be modified."
16342 (message "Timestamp updated")) 17167 (message "Timestamp updated"))
16343 (t 17168 (t
16344 (setq time (let ((this-command this-command)) 17169 (setq time (let ((this-command this-command))
16345 (org-read-date arg 'totime nil nil default-time))) 17170 (org-read-date arg 'totime nil nil default-time default-input)))
16346 (org-insert-time-stamp time (or org-time-was-given arg) 17171 (org-insert-time-stamp time (or org-time-was-given arg)
16347 nil nil nil (list org-end-time-was-given)))))) 17172 nil nil nil (list org-end-time-was-given))))))
16348 17173
17174;; FIXME: can we use this for something else????
17175;; like computing time differences?????
17176(defun org-get-compact-tod (s)
17177 (when (string-match "\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\(-\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\)?" s)
17178 (let* ((t1 (match-string 1 s))
17179 (h1 (string-to-number (match-string 2 s)))
17180 (m1 (string-to-number (match-string 3 s)))
17181 (t2 (and (match-end 4) (match-string 5 s)))
17182 (h2 (and t2 (string-to-number (match-string 6 s))))
17183 (m2 (and t2 (string-to-number (match-string 7 s))))
17184 dh dm)
17185 (if (not t2)
17186 t1
17187 (setq dh (- h2 h1) dm (- m2 m1))
17188 (if (< dm 0) (setq dm (+ dm 60) dh (1- dh)))
17189 (concat t1 "+" (number-to-string dh)
17190 (if (/= 0 dm) (concat ":" (number-to-string dm))))))))
17191
16349(defun org-time-stamp-inactive (&optional arg) 17192(defun org-time-stamp-inactive (&optional arg)
16350 "Insert an inactive time stamp. 17193 "Insert an inactive time stamp.
16351An inactive time stamp is enclosed in square brackets instead of angle 17194An inactive time stamp is enclosed in square brackets instead of angle
@@ -16366,9 +17209,13 @@ So these are more for recording a certain time/date."
16366(defvar org-ans2) ; dynamically scoped parameter 17209(defvar org-ans2) ; dynamically scoped parameter
16367 17210
16368(defvar org-plain-time-of-day-regexp) ; defined below 17211(defvar org-plain-time-of-day-regexp) ; defined below
17212
17213(defvar org-read-date-overlay nil)
17214(defvar org-dcst nil) ; dynamically scoped
17215
16369(defun org-read-date (&optional with-time to-time from-string prompt 17216(defun org-read-date (&optional with-time to-time from-string prompt
16370 default-time) 17217 default-time default-input)
16371 "Read a date and make things smooth for the user. 17218 "Read a date, possibly a time, and make things smooth for the user.
16372The prompt will suggest to enter an ISO date, but you can also enter anything 17219The prompt will suggest to enter an ISO date, but you can also enter anything
16373which will at least partially be understood by `parse-time-string'. 17220which will at least partially be understood by `parse-time-string'.
16374Unrecognized parts of the date will default to the current day, month, year, 17221Unrecognized parts of the date will default to the current day, month, year,
@@ -16402,7 +17249,7 @@ While prompting, a calendar is popped up - you can also select the
16402date with the mouse (button 1). The calendar shows a period of three 17249date with the mouse (button 1). The calendar shows a period of three
16403months. To scroll it to other months, use the keys `>' and `<'. 17250months. To scroll it to other months, use the keys `>' and `<'.
16404If you don't like the calendar, turn it off with 17251If you don't like the calendar, turn it off with
16405 \(setq org-popup-calendar-for-date-prompt nil) 17252 \(setq org-read-date-popup-calendar nil)
16406 17253
16407With optional argument TO-TIME, the date will immediately be converted 17254With optional argument TO-TIME, the date will immediately be converted
16408to an internal time. 17255to an internal time.
@@ -16411,29 +17258,35 @@ insert a time. Note that when WITH-TIME is not set, you can still
16411enter a time, and this function will inform the calling routine about 17258enter a time, and this function will inform the calling routine about
16412this change. The calling routine may then choose to change the format 17259this change. The calling routine may then choose to change the format
16413used to insert the time stamp into the buffer to include the time. 17260used to insert the time stamp into the buffer to include the time.
16414With optional argument FROM-STRING, read fomr this string instead from 17261With optional argument FROM-STRING, read from this string instead from
16415the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is 17262the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is
16416the time/date that is used for everything that is not specified by the 17263the time/date that is used for everything that is not specified by the
16417user." 17264user."
16418 (require 'parse-time) 17265 (require 'parse-time)
16419 (let* ((org-time-stamp-rounding-minutes 17266 (let* ((org-time-stamp-rounding-minutes
16420 (if (equal with-time '(16)) 0 org-time-stamp-rounding-minutes)) 17267 (if (equal with-time '(16)) 0 org-time-stamp-rounding-minutes))
17268 (org-dcst org-display-custom-times)
16421 (ct (org-current-time)) 17269 (ct (org-current-time))
16422 (def (or default-time ct)) 17270 (def (or default-time ct))
16423 ; (defdecode (decode-time def)) 17271 (defdecode (decode-time def))
17272 (dummy (progn
17273 (when (< (nth 2 defdecode) org-extend-today-until)
17274 (setcar (nthcdr 2 defdecode) -1)
17275 (setcar (nthcdr 1 defdecode) 59)
17276 (setq def (apply 'encode-time defdecode)
17277 defdecode (decode-time def)))))
16424 (calendar-move-hook nil) 17278 (calendar-move-hook nil)
16425 (view-diary-entries-initially nil) 17279 (view-diary-entries-initially nil)
16426 (view-calendar-holidays-initially nil) 17280 (view-calendar-holidays-initially nil)
16427 (timestr (format-time-string 17281 (timestr (format-time-string
16428 (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def)) 17282 (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def))
16429 (prompt (concat (if prompt (concat prompt " ") "") 17283 (prompt (concat (if prompt (concat prompt " ") "")
16430 (format "Date and/or time (default [%s]): " timestr))) 17284 (format "Date+time [%s]: " timestr)))
16431 ans (org-ans0 "") org-ans1 org-ans2 delta deltan deltaw deltadef 17285 ans (org-ans0 "") org-ans1 org-ans2 final)
16432 second minute hour day month year tl wday wday1 pm h2 m2)
16433 17286
16434 (cond 17287 (cond
16435 (from-string (setq ans from-string)) 17288 (from-string (setq ans from-string))
16436 (org-popup-calendar-for-date-prompt 17289 (org-read-date-popup-calendar
16437 (save-excursion 17290 (save-excursion
16438 (save-window-excursion 17291 (save-window-excursion
16439 (calendar) 17292 (calendar)
@@ -16455,6 +17308,12 @@ user."
16455 (org-defkey minibuffer-local-map [(meta shift right)] 17308 (org-defkey minibuffer-local-map [(meta shift right)]
16456 (lambda () (interactive) 17309 (lambda () (interactive)
16457 (org-eval-in-calendar '(calendar-forward-month 1)))) 17310 (org-eval-in-calendar '(calendar-forward-month 1))))
17311 (org-defkey minibuffer-local-map [(meta shift up)]
17312 (lambda () (interactive)
17313 (org-eval-in-calendar '(calendar-backward-year 1))))
17314 (org-defkey minibuffer-local-map [(meta shift down)]
17315 (lambda () (interactive)
17316 (org-eval-in-calendar '(calendar-forward-year 1))))
16458 (org-defkey minibuffer-local-map [(shift up)] 17317 (org-defkey minibuffer-local-map [(shift up)]
16459 (lambda () (interactive) 17318 (lambda () (interactive)
16460 (org-eval-in-calendar '(calendar-backward-week 1)))) 17319 (org-eval-in-calendar '(calendar-backward-week 1))))
@@ -16476,15 +17335,75 @@ user."
16476 (unwind-protect 17335 (unwind-protect
16477 (progn 17336 (progn
16478 (use-local-map map) 17337 (use-local-map map)
16479 (setq org-ans0 (read-string prompt "" nil nil)) 17338 (add-hook 'post-command-hook 'org-read-date-display)
17339 (setq org-ans0 (read-string prompt default-input nil nil))
16480 ;; org-ans0: from prompt 17340 ;; org-ans0: from prompt
16481 ;; org-ans1: from mouse click 17341 ;; org-ans1: from mouse click
16482 ;; org-ans2: from calendar motion 17342 ;; org-ans2: from calendar motion
16483 (setq ans (concat org-ans0 " " (or org-ans1 org-ans2)))) 17343 (setq ans (concat org-ans0 " " (or org-ans1 org-ans2))))
16484 (use-local-map old-map)))))) 17344 (remove-hook 'post-command-hook 'org-read-date-display)
17345 (use-local-map old-map)
17346 (when org-read-date-overlay
17347 (org-delete-overlay org-read-date-overlay)
17348 (setq org-read-date-overlay nil)))))))
17349
16485 (t ; Naked prompt only 17350 (t ; Naked prompt only
16486 (setq ans (read-string prompt "" nil timestr)))) 17351 (unwind-protect
16487 (org-detach-overlay org-date-ovl) 17352 (setq ans (read-string prompt default-input nil timestr))
17353 (when org-read-date-overlay
17354 (org-delete-overlay org-read-date-overlay)
17355 (setq org-read-date-overlay nil)))))
17356
17357 (setq final (org-read-date-analyze ans def defdecode))
17358
17359 (if to-time
17360 (apply 'encode-time final)
17361 (if (and (boundp 'org-time-was-given) org-time-was-given)
17362 (format "%04d-%02d-%02d %02d:%02d"
17363 (nth 5 final) (nth 4 final) (nth 3 final)
17364 (nth 2 final) (nth 1 final))
17365 (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final))))))
17366(defvar def)
17367(defvar defdecode)
17368(defvar with-time)
17369(defun org-read-date-display ()
17370 "Display the currrent date prompt interpretation in the minibuffer."
17371 (when org-read-date-display-live
17372 (when org-read-date-overlay
17373 (org-delete-overlay org-read-date-overlay))
17374 (let ((p (point)))
17375 (end-of-line 1)
17376 (while (not (equal (buffer-substring
17377 (max (point-min) (- (point) 4)) (point))
17378 " "))
17379 (insert " "))
17380 (goto-char p))
17381 (let* ((ans (concat (buffer-substring (point-at-bol) (point-max))
17382 " " (or org-ans1 org-ans2)))
17383 (org-end-time-was-given nil)
17384 (f (org-read-date-analyze ans def defdecode))
17385 (fmts (if org-dcst
17386 org-time-stamp-custom-formats
17387 org-time-stamp-formats))
17388 (fmt (if (or with-time
17389 (and (boundp 'org-time-was-given) org-time-was-given))
17390 (cdr fmts)
17391 (car fmts)))
17392 (txt (concat "=> " (format-time-string fmt (apply 'encode-time f)))))
17393 (when (and org-end-time-was-given
17394 (string-match org-plain-time-of-day-regexp txt))
17395 (setq txt (concat (substring txt 0 (match-end 0)) "-"
17396 org-end-time-was-given
17397 (substring txt (match-end 0)))))
17398 (setq org-read-date-overlay
17399 (make-overlay (1- (point-at-eol)) (point-at-eol)))
17400 (org-overlay-display org-read-date-overlay txt 'secondary-selection))))
17401
17402(defun org-read-date-analyze (ans def defdecode)
17403 "Analyze the combined answer of the date prompt."
17404 ;; FIXME: cleanup and comment
17405 (let (delta deltan deltaw deltadef year month day
17406 hour minute second wday pm h2 m2 tl wday1)
16488 17407
16489 (when (setq delta (org-read-date-get-relative ans (current-time) def)) 17408 (when (setq delta (org-read-date-get-relative ans (current-time) def))
16490 (setq ans (replace-match "" t t ans) 17409 (setq ans (replace-match "" t t ans)
@@ -16527,22 +17446,32 @@ user."
16527 h2 (+ hour (string-to-number (match-string 3 ans))) 17446 h2 (+ hour (string-to-number (match-string 3 ans)))
16528 minute (string-to-number (match-string 2 ans)) 17447 minute (string-to-number (match-string 2 ans))
16529 m2 (+ minute (if (match-end 5) (string-to-number (match-string 5 ans))0))) 17448 m2 (+ minute (if (match-end 5) (string-to-number (match-string 5 ans))0)))
17449 (if (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60)))
16530 (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2) t t ans))) 17450 (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2) t t ans)))
16531 17451
16532 ;; Check if there is a time range 17452 ;; Check if there is a time range
16533 (when (and (boundp 'org-end-time-was-given) 17453 (when (boundp 'org-end-time-was-given)
16534 (string-match org-plain-time-of-day-regexp ans) 17454 (setq org-time-was-given nil)
16535 (match-end 8)) 17455 (when (and (string-match org-plain-time-of-day-regexp ans)
16536 (setq org-end-time-was-given (match-string 8 ans)) 17456 (match-end 8))
16537 (setq ans (concat (substring ans 0 (match-beginning 7)) 17457 (setq org-end-time-was-given (match-string 8 ans))
16538 (substring ans (match-end 7))))) 17458 (setq ans (concat (substring ans 0 (match-beginning 7))
17459 (substring ans (match-end 7))))))
16539 17460
16540 (setq tl (parse-time-string ans) 17461 (setq tl (parse-time-string ans)
16541 day (or (nth 3 tl) (string-to-number (format-time-string "%d" def))) 17462 day (or (nth 3 tl) (nth 3 defdecode))
16542 month (or (nth 4 tl) (string-to-number (format-time-string "%m" def))) 17463 month (or (nth 4 tl)
16543 year (or (nth 5 tl) (string-to-number (format-time-string "%Y" def))) 17464 (if (and org-read-date-prefer-future
16544 hour (or (nth 2 tl) (string-to-number (format-time-string "%H" def))) 17465 (nth 3 tl) (< (nth 3 tl) (nth 3 defdecode)))
16545 minute (or (nth 1 tl) (string-to-number (format-time-string "%M" def))) 17466 (1+ (nth 4 defdecode))
17467 (nth 4 defdecode)))
17468 year (or (nth 5 tl)
17469 (if (and org-read-date-prefer-future
17470 (nth 4 tl) (< (nth 4 tl) (nth 4 defdecode)))
17471 (1+ (nth 5 defdecode))
17472 (nth 5 defdecode)))
17473 hour (or (nth 2 tl) (nth 2 defdecode))
17474 minute (or (nth 1 tl) (nth 1 defdecode))
16546 second (or (nth 0 tl) 0) 17475 second (or (nth 0 tl) 0)
16547 wday (nth 6 tl)) 17476 wday (nth 6 tl))
16548 (when deltan 17477 (when deltan
@@ -16563,25 +17492,8 @@ user."
16563 (nth 2 tl)) 17492 (nth 2 tl))
16564 (setq org-time-was-given t)) 17493 (setq org-time-was-given t))
16565 (if (< year 100) (setq year (+ 2000 year))) 17494 (if (< year 100) (setq year (+ 2000 year)))
16566 (if to-time 17495 (if (< year 1970) (setq year (nth 5 defdecode))) ; not representable
16567 (encode-time second minute hour day month year) 17496 (list second minute hour day month year)))
16568 (if (or (nth 1 tl) (nth 2 tl))
16569 (format "%04d-%02d-%02d %02d:%02d" year month day hour minute)
16570 (format "%04d-%02d-%02d" year month day)))))
16571
16572;(defun org-parse-for-shift (n1 n2 given-dec default-dec)
16573; (cond
16574; ((not (nth n1 given-dec))
16575; (nth n1 default-dec))
16576; ((or (> (nth n1 given-dec) (nth n1 (default-dec)))
16577; (not org-read-date-prefer-future))
16578; (nth n1 given-dec))
16579; (t (1+
16580; (if (nth 3 given-dec)
16581; (nth 3 given-dec)
16582; (if (> (nth
16583; (setq given
16584; (if (and
16585 17497
16586(defvar parse-time-weekdays) 17498(defvar parse-time-weekdays)
16587 17499
@@ -16589,8 +17501,8 @@ user."
16589 "Check string S for special relative date string. 17501 "Check string S for special relative date string.
16590TODAY and DEFAULT are internal times, for today and for a default. 17502TODAY and DEFAULT are internal times, for today and for a default.
16591Return shift list (N what def-flag) 17503Return shift list (N what def-flag)
16592WHAT is \"d\", \"w\", \"m\", or \"y\" for day. week, month, year. 17504WHAT is \"d\", \"w\", \"m\", or \"y\" for day, week, month, year.
16593N is the number if WHATs to shift 17505N is the number of WHATs to shift.
16594DEF-FLAG is t when a double ++ or -- indicates shift relative to 17506DEF-FLAG is t when a double ++ or -- indicates shift relative to
16595 the DEFAULT date rather than TODAY." 17507 the DEFAULT date rather than TODAY."
16596 (when (string-match 17508 (when (string-match
@@ -16628,17 +17540,18 @@ Also, store the cursor date in variable org-ans2."
16628 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) 17540 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
16629 (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) 17541 (setq org-ans2 (format-time-string "%Y-%m-%d" time))))
16630 (org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) 17542 (org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer))
16631 (select-window sw) 17543 (select-window sw)))
16632 ;; Update the prompt to show new default date 17544
16633 (save-excursion 17545; ;; Update the prompt to show new default date
16634 (goto-char (point-min)) 17546; (save-excursion
16635 (when (and org-ans2 17547; (goto-char (point-min))
16636 (re-search-forward "\\[[-0-9]+\\]" nil t) 17548; (when (and org-ans2
16637 (get-text-property (match-end 0) 'field)) 17549; (re-search-forward "\\[[-0-9]+\\]" nil t)
16638 (let ((inhibit-read-only t)) 17550; (get-text-property (match-end 0) 'field))
16639 (replace-match (concat "[" org-ans2 "]") t t) 17551; (let ((inhibit-read-only t))
16640 (add-text-properties (point-min) (1+ (match-end 0)) 17552; (replace-match (concat "[" org-ans2 "]") t t)
16641 (text-properties-at (1+ (point-min))))))))) 17553; (add-text-properties (point-min) (1+ (match-end 0))
17554; (text-properties-at (1+ (point-min)))))))))
16642 17555
16643(defun org-calendar-select () 17556(defun org-calendar-select ()
16644 "Return to `org-read-date' with the date currently selected. 17557 "Return to `org-read-date' with the date currently selected.
@@ -16817,6 +17730,20 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s
16817 (org-occur regexp nil callback) 17730 (org-occur regexp nil callback)
16818 org-warn-days))) 17731 org-warn-days)))
16819 17732
17733(defun org-check-before-date (date)
17734 "Check if there are deadlines or scheduled entries before DATE."
17735 (interactive (list (org-read-date)))
17736 (let ((case-fold-search nil)
17737 (regexp (concat "\\<\\(" org-deadline-string
17738 "\\|" org-scheduled-string
17739 "\\) *<\\([^>]+\\)>"))
17740 (callback
17741 (lambda () (time-less-p
17742 (org-time-string-to-time (match-string 2))
17743 (org-time-string-to-time date)))))
17744 (message "%d entries before %s"
17745 (org-occur regexp nil callback) date)))
17746
16820(defun org-evaluate-time-range (&optional to-buffer) 17747(defun org-evaluate-time-range (&optional to-buffer)
16821 "Evaluate a time range by computing the difference between start and end. 17748 "Evaluate a time range by computing the difference between start and end.
16822Normally the result is just printed in the echo area, but with prefix arg 17749Normally the result is just printed in the echo area, but with prefix arg
@@ -16865,10 +17792,12 @@ days in order to avoid rounding problems."
16865 h 0 m 0)) 17792 h 0 m 0))
16866 (if (not to-buffer) 17793 (if (not to-buffer)
16867 (message "%s" (org-make-tdiff-string y d h m)) 17794 (message "%s" (org-make-tdiff-string y d h m))
16868 (when (org-at-table-p) 17795 (if (org-at-table-p)
16869 (goto-char match-end) 17796 (progn
16870 (setq align t) 17797 (goto-char match-end)
16871 (and (looking-at " *|") (goto-char (match-end 0)))) 17798 (setq align t)
17799 (and (looking-at " *|") (goto-char (match-end 0))))
17800 (goto-char match-end))
16872 (if (looking-at 17801 (if (looking-at
16873 "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") 17802 "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]")
16874 (replace-match "")) 17803 (replace-match ""))
@@ -16917,7 +17846,10 @@ D may be an absolute day number, or a calendar-type list (month day year)."
16917 17846
16918(defun org-calendar-holiday () 17847(defun org-calendar-holiday ()
16919 "List of holidays, for Diary display in Org-mode." 17848 "List of holidays, for Diary display in Org-mode."
16920 (let ((hl (calendar-check-holidays date))) 17849 (require 'holidays)
17850 (let ((hl (funcall
17851 (if (fboundp 'calendar-check-holidays)
17852 'calendar-check-holidays 'check-calendar-holidays) date)))
16921 (if hl (mapconcat 'identity hl "; ")))) 17853 (if hl (mapconcat 'identity hl "; "))))
16922 17854
16923(defun org-diary-sexp-entry (sexp entry date) 17855(defun org-diary-sexp-entry (sexp entry date)
@@ -16941,7 +17873,7 @@ D may be an absolute day number, or a calendar-type list (month day year)."
16941 (t nil)))) 17873 (t nil))))
16942 17874
16943(defun org-diary-to-ical-string (frombuf) 17875(defun org-diary-to-ical-string (frombuf)
16944 "Get iCalendar entreis from diary entries in buffer FROMBUF. 17876 "Get iCalendar entries from diary entries in buffer FROMBUF.
16945This uses the icalendar.el library." 17877This uses the icalendar.el library."
16946 (let* ((tmpdir (if (featurep 'xemacs) 17878 (let* ((tmpdir (if (featurep 'xemacs)
16947 (temp-directory) 17879 (temp-directory)
@@ -17292,6 +18224,7 @@ belonging to the category \"Work\"."
17292 (if (equal filter '(4)) 18224 (if (equal filter '(4))
17293 (setq filter (read-from-minibuffer "Regexp filter: "))) 18225 (setq filter (read-from-minibuffer "Regexp filter: ")))
17294 (let* ((cnt 0) ; count added events 18226 (let* ((cnt 0) ; count added events
18227 (org-agenda-new-buffers nil)
17295 (today (org-date-to-gregorian 18228 (today (org-date-to-gregorian
17296 (time-to-days (current-time)))) 18229 (time-to-days (current-time))))
17297 (files (org-agenda-files)) entries file) 18230 (files (org-agenda-files)) entries file)
@@ -17316,7 +18249,7 @@ belonging to the category \"Work\"."
17316 (cadr (assoc 'category filter)) cat) 18249 (cadr (assoc 'category filter)) cat)
17317 (string-match 18250 (string-match
17318 (cadr (assoc 'headline filter)) evt)))))) 18251 (cadr (assoc 'headline filter)) evt))))))
17319 ;; FIXME Shall we remove text-properties for the appt text? 18252 ;; FIXME: Shall we remove text-properties for the appt text?
17320 ;; (setq evt (set-text-properties 0 (length evt) nil evt)) 18253 ;; (setq evt (set-text-properties 0 (length evt) nil evt))
17321 (when (and ok tod) 18254 (when (and ok tod)
17322 (setq tod (number-to-string tod) 18255 (setq tod (number-to-string tod)
@@ -17326,6 +18259,7 @@ belonging to the category \"Work\"."
17326 (match-string 2 tod)))) 18259 (match-string 2 tod))))
17327 (appt-add tod evt) 18260 (appt-add tod evt)
17328 (setq cnt (1+ cnt))))) entries) 18261 (setq cnt (1+ cnt))))) entries)
18262 (org-release-buffers org-agenda-new-buffers)
17329 (message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))) 18263 (message "Added %d event%s for today" cnt (if (> cnt 1) "s" ""))))
17330 18264
17331;;; The clock for measuring work time. 18265;;; The clock for measuring work time.
@@ -17360,9 +18294,17 @@ If necessary, clock-out of the currently active clock."
17360 (let (ts) 18294 (let (ts)
17361 (save-excursion 18295 (save-excursion
17362 (org-back-to-heading t) 18296 (org-back-to-heading t)
17363 (if (looking-at org-todo-line-regexp) 18297 (when (and org-clock-in-switch-to-state
17364 (setq org-clock-heading (match-string 3)) 18298 (not (looking-at (concat outline-regexp "[ \t]*"
17365 (setq org-clock-heading "???")) 18299 org-clock-in-switch-to-state
18300 "\\>"))))
18301 (org-todo org-clock-in-switch-to-state))
18302 (if (and org-clock-heading-function
18303 (functionp org-clock-heading-function))
18304 (setq org-clock-heading (funcall org-clock-heading-function))
18305 (if (looking-at org-complex-heading-regexp)
18306 (setq org-clock-heading (match-string 4))
18307 (setq org-clock-heading "???")))
17366 (setq org-clock-heading (propertize org-clock-heading 'face nil)) 18308 (setq org-clock-heading (propertize org-clock-heading 'face nil))
17367 (org-clock-find-position) 18309 (org-clock-find-position)
17368 18310
@@ -17480,6 +18422,9 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
17480 (set-buffer (marker-buffer org-clock-marker)) 18422 (set-buffer (marker-buffer org-clock-marker))
17481 (goto-char org-clock-marker) 18423 (goto-char org-clock-marker)
17482 (delete-region (1- (point-at-bol)) (point-at-eol))) 18424 (delete-region (1- (point-at-bol)) (point-at-eol)))
18425 (setq global-mode-string
18426 (delq 'org-mode-line-string global-mode-string))
18427 (force-mode-line-update)
17483 (message "Clock canceled")) 18428 (message "Clock canceled"))
17484 18429
17485(defun org-clock-goto (&optional delete-windows) 18430(defun org-clock-goto (&optional delete-windows)
@@ -18016,8 +18961,10 @@ The following commands are available:
18016(org-defkey org-agenda-mode-map "f" 'org-agenda-follow-mode) 18961(org-defkey org-agenda-mode-map "f" 'org-agenda-follow-mode)
18017(org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode) 18962(org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode)
18018(org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary) 18963(org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary)
18019(org-defkey org-agenda-mode-map "g" 'org-agenda-toggle-time-grid) 18964(org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid)
18020(org-defkey org-agenda-mode-map "r" 'org-agenda-redo) 18965(org-defkey org-agenda-mode-map "r" 'org-agenda-redo)
18966(org-defkey org-agenda-mode-map "g" 'org-agenda-redo)
18967(org-defkey org-agenda-mode-map "e" 'org-agenda-execute)
18021(org-defkey org-agenda-mode-map "q" 'org-agenda-quit) 18968(org-defkey org-agenda-mode-map "q" 'org-agenda-quit)
18022(org-defkey org-agenda-mode-map "x" 'org-agenda-exit) 18969(org-defkey org-agenda-mode-map "x" 'org-agenda-exit)
18023(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda) 18970(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda)
@@ -18234,6 +19181,7 @@ that have been changed along."
18234(defvar org-agenda-restrict-begin (make-marker)) 19181(defvar org-agenda-restrict-begin (make-marker))
18235(defvar org-agenda-restrict-end (make-marker)) 19182(defvar org-agenda-restrict-end (make-marker))
18236(defvar org-agenda-last-dispatch-buffer nil) 19183(defvar org-agenda-last-dispatch-buffer nil)
19184(defvar org-agenda-overriding-restriction nil)
18237 19185
18238;;;###autoload 19186;;;###autoload
18239(defun org-agenda (arg &optional keys restriction) 19187(defun org-agenda (arg &optional keys restriction)
@@ -18263,6 +19211,7 @@ Pressing `<' twice means to restrict to the current subtree or region
18263 (interactive "P") 19211 (interactive "P")
18264 (catch 'exit 19212 (catch 'exit
18265 (let* ((prefix-descriptions nil) 19213 (let* ((prefix-descriptions nil)
19214 (org-agenda-custom-commands-orig org-agenda-custom-commands)
18266 (org-agenda-custom-commands 19215 (org-agenda-custom-commands
18267 ;; normalize different versions 19216 ;; normalize different versions
18268 (delq nil 19217 (delq nil
@@ -18278,11 +19227,12 @@ Pressing `<' twice means to restrict to the current subtree or region
18278 (buf (current-buffer)) 19227 (buf (current-buffer))
18279 (bfn (buffer-file-name (buffer-base-buffer))) 19228 (bfn (buffer-file-name (buffer-base-buffer)))
18280 entry key type match lprops ans) 19229 entry key type match lprops ans)
18281 ;; Turn off restriction 19230 ;; Turn off restriction unless there is an overriding one
18282 (put 'org-agenda-files 'org-restrict nil) 19231 (unless org-agenda-overriding-restriction
18283 (setq org-agenda-restrict nil) 19232 (put 'org-agenda-files 'org-restrict nil)
18284 (move-marker org-agenda-restrict-begin nil) 19233 (setq org-agenda-restrict nil)
18285 (move-marker org-agenda-restrict-end nil) 19234 (move-marker org-agenda-restrict-begin nil)
19235 (move-marker org-agenda-restrict-end nil))
18286 ;; Delete old local properties 19236 ;; Delete old local properties
18287 (put 'org-agenda-redo-command 'org-lprops nil) 19237 (put 'org-agenda-redo-command 'org-lprops nil)
18288 ;; Remember where this call originated 19238 ;; Remember where this call originated
@@ -18292,7 +19242,7 @@ Pressing `<' twice means to restrict to the current subtree or region
18292 keys (car ans) 19242 keys (car ans)
18293 restriction (cdr ans))) 19243 restriction (cdr ans)))
18294 ;; Estabish the restriction, if any 19244 ;; Estabish the restriction, if any
18295 (when restriction 19245 (when (and (not org-agenda-overriding-restriction) restriction)
18296 (put 'org-agenda-files 'org-restrict (list bfn)) 19246 (put 'org-agenda-files 'org-restrict (list bfn))
18297 (cond 19247 (cond
18298 ((eq restriction 'region) 19248 ((eq restriction 'region)
@@ -18346,7 +19296,9 @@ Pressing `<' twice means to restrict to the current subtree or region
18346 (org-let lprops '(funcall type match))) 19296 (org-let lprops '(funcall type match)))
18347 (t (error "Invalid custom agenda command type %s" type)))) 19297 (t (error "Invalid custom agenda command type %s" type))))
18348 (org-run-agenda-series (nth 1 entry) (cddr entry)))) 19298 (org-run-agenda-series (nth 1 entry) (cddr entry))))
18349 ((equal keys "C") (customize-variable 'org-agenda-custom-commands)) 19299 ((equal keys "C")
19300 (setq org-agenda-custom-commands org-agenda-custom-commands-orig)
19301 (customize-variable 'org-agenda-custom-commands))
18350 ((equal keys "a") (call-interactively 'org-agenda-list)) 19302 ((equal keys "a") (call-interactively 'org-agenda-list))
18351 ((equal keys "t") (call-interactively 'org-todo-list)) 19303 ((equal keys "t") (call-interactively 'org-todo-list))
18352 ((equal keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) 19304 ((equal keys "T") (org-call-with-arg 'org-todo-list (or arg '(4))))
@@ -18364,6 +19316,16 @@ Pressing `<' twice means to restrict to the current subtree or region
18364 ((equal keys "!") (customize-variable 'org-stuck-projects)) 19316 ((equal keys "!") (customize-variable 'org-stuck-projects))
18365 (t (error "Invalid agenda key")))))) 19317 (t (error "Invalid agenda key"))))))
18366 19318
19319(defun org-agenda-normalize-custom-commands (cmds)
19320 (delq nil
19321 (mapcar
19322 (lambda (x)
19323 (cond ((stringp (cdr x)) nil)
19324 ((stringp (nth 1 x)) x)
19325 ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
19326 (t (cons (car x) (cons "" (cdr x))))))
19327 cmds)))
19328
18367(defun org-agenda-get-restriction-and-command (prefix-descriptions) 19329(defun org-agenda-get-restriction-and-command (prefix-descriptions)
18368 "The user interface for selecting an agenda command." 19330 "The user interface for selecting an agenda command."
18369 (catch 'exit 19331 (catch 'exit
@@ -18380,13 +19342,14 @@ Pressing `<' twice means to restrict to the current subtree or region
18380 (erase-buffer) 19342 (erase-buffer)
18381 (insert (eval-when-compile 19343 (insert (eval-when-compile
18382 (let ((header 19344 (let ((header
18383"Press key for an agenda command: < Buffer,subtree/region restriction 19345"
18384-------------------------------- C Configure custom agenda commands 19346Press key for an agenda command: < Buffer,subtree/region restriction
19347-------------------------------- > Remove restriction
18385a Agenda for current week or day e Export agenda views 19348a Agenda for current week or day e Export agenda views
18386t List of all TODO entries T Entries with special TODO kwd 19349t List of all TODO entries T Entries with special TODO kwd
18387m Match a TAGS query M Like m, but only TODO entries 19350m Match a TAGS query M Like m, but only TODO entries
18388L Timeline for current buffer # List stuck projects (!=configure) 19351L Timeline for current buffer # List stuck projects (!=configure)
18389/ Multi-occur 19352/ Multi-occur C Configure custom agenda commands
18390") 19353")
18391 (start 0)) 19354 (start 0))
18392 (while (string-match 19355 (while (string-match
@@ -18402,10 +19365,10 @@ L Timeline for current buffer # List stuck projects (!=configure)
18402 (when (eq rmheader t) 19365 (when (eq rmheader t)
18403 (goto-line 1) 19366 (goto-line 1)
18404 (re-search-forward ":" nil t) 19367 (re-search-forward ":" nil t)
18405 (delete-region (match-end 0) (line-end-position)) 19368 (delete-region (match-end 0) (point-at-eol))
18406 (forward-char 1) 19369 (forward-char 1)
18407 (looking-at "-+") 19370 (looking-at "-+")
18408 (delete-region (match-end 0) (line-end-position)) 19371 (delete-region (match-end 0) (point-at-eol))
18409 (move-marker header-end (match-end 0))) 19372 (move-marker header-end (match-end 0)))
18410 (goto-char header-end) 19373 (goto-char header-end)
18411 (delete-region (point) (point-max)) 19374 (delete-region (point) (point-max))
@@ -18458,10 +19421,12 @@ L Timeline for current buffer # List stuck projects (!=configure)
18458 (setq second-time t) 19421 (setq second-time t)
18459 (fit-window-to-buffer))) 19422 (fit-window-to-buffer)))
18460 (message "Press key for agenda command%s:" 19423 (message "Press key for agenda command%s:"
18461 (if restrict-ok 19424 (if (or restrict-ok org-agenda-overriding-restriction)
18462 (if restriction 19425 (if org-agenda-overriding-restriction
18463 (format " (restricted to %s)" restriction) 19426 " (restriction lock active)"
18464 " (unrestricted)") 19427 (if restriction
19428 (format " (restricted to %s)" restriction)
19429 " (unrestricted)"))
18465 "")) 19430 ""))
18466 (setq c (read-char-exclusive)) 19431 (setq c (read-char-exclusive))
18467 (message "") 19432 (message "")
@@ -18484,10 +19449,13 @@ L Timeline for current buffer # List stuck projects (!=configure)
18484 (message "Restriction is only possible in Org-mode buffers") 19449 (message "Restriction is only possible in Org-mode buffers")
18485 (ding) (sit-for 1)) 19450 (ding) (sit-for 1))
18486 ((eq c ?1) 19451 ((eq c ?1)
19452 (org-agenda-remove-restriction-lock 'noupdate)
18487 (setq restriction 'buffer)) 19453 (setq restriction 'buffer))
18488 ((eq c ?0) 19454 ((eq c ?0)
19455 (org-agenda-remove-restriction-lock 'noupdate)
18489 (setq restriction (if region-p 'region 'subtree))) 19456 (setq restriction (if region-p 'region 'subtree)))
18490 ((eq c ?<) 19457 ((eq c ?<)
19458 (org-agenda-remove-restriction-lock 'noupdate)
18491 (setq restriction 19459 (setq restriction
18492 (cond 19460 (cond
18493 ((eq restriction 'buffer) 19461 ((eq restriction 'buffer)
@@ -18495,8 +19463,15 @@ L Timeline for current buffer # List stuck projects (!=configure)
18495 ((memq restriction '(subtree region)) 19463 ((memq restriction '(subtree region))
18496 nil) 19464 nil)
18497 (t 'buffer)))) 19465 (t 'buffer))))
18498 ((and (equal selstring "") (memq c '(?a ?t ?m ?L ?C ?e ?T ?M ?# ?/))) 19466 ((eq c ?>)
19467 (org-agenda-remove-restriction-lock 'noupdate)
19468 (setq restriction nil))
19469 ((and (equal selstring "") (memq c '(?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/)))
18499 (throw 'exit (cons (setq selstring (char-to-string c)) restriction))) 19470 (throw 'exit (cons (setq selstring (char-to-string c)) restriction)))
19471 ((and (> (length selstring) 0) (eq c ?\d))
19472 (delete-window)
19473 (org-agenda-get-restriction-and-command prefix-descriptions))
19474
18500 ((equal c ?q) (error "Abort")) 19475 ((equal c ?q) (error "Abort"))
18501 (t (error "Invalid key %c" c)))))))) 19476 (t (error "Invalid key %c" c))))))))
18502 19477
@@ -18543,7 +19518,7 @@ L Timeline for current buffer # List stuck projects (!=configure)
18543 "Run an agenda command in batch mode and send the result to STDOUT. 19518 "Run an agenda command in batch mode and send the result to STDOUT.
18544If CMD-KEY is a string of length 1, it is used as a key in 19519If CMD-KEY is a string of length 1, it is used as a key in
18545`org-agenda-custom-commands' and triggers this command. If it is a 19520`org-agenda-custom-commands' and triggers this command. If it is a
18546longer string is is used as a tags/todo match string. 19521longer string it is used as a tags/todo match string.
18547Paramters are alternating variable names and values that will be bound 19522Paramters are alternating variable names and values that will be bound
18548before running the agenda command." 19523before running the agenda command."
18549 (let (pars) 19524 (let (pars)
@@ -18568,7 +19543,7 @@ before running the agenda command."
18568 "Run an agenda command in batch mode and send the result to STDOUT. 19543 "Run an agenda command in batch mode and send the result to STDOUT.
18569If CMD-KEY is a string of length 1, it is used as a key in 19544If CMD-KEY is a string of length 1, it is used as a key in
18570`org-agenda-custom-commands' and triggers this command. If it is a 19545`org-agenda-custom-commands' and triggers this command. If it is a
18571longer string is is used as a tags/todo match string. 19546longer string it is used as a tags/todo match string.
18572Paramters are alternating variable names and values that will be bound 19547Paramters are alternating variable names and values that will be bound
18573before running the agenda command. 19548before running the agenda command.
18574 19549
@@ -18625,7 +19600,7 @@ agenda-day The day in the agenda where this is listed"
18625 19600
18626(defun org-fix-agenda-info (props) 19601(defun org-fix-agenda-info (props)
18627 "Make sure all properties on an agenda item have a canonical form, 19602 "Make sure all properties on an agenda item have a canonical form,
18628so the the export commands caneasily use it." 19603so the export commands can easily use it."
18629 (let (tmp re) 19604 (let (tmp re)
18630 (when (setq tmp (plist-get props 'tags)) 19605 (when (setq tmp (plist-get props 'tags))
18631 (setq props (plist-put props 'tags (mapconcat 'identity tmp ":")))) 19606 (setq props (plist-put props 'tags (mapconcat 'identity tmp ":"))))
@@ -18675,7 +19650,7 @@ so the the export commands caneasily use it."
18675;;;###autoload 19650;;;###autoload
18676(defmacro org-batch-store-agenda-views (&rest parameters) 19651(defmacro org-batch-store-agenda-views (&rest parameters)
18677 "Run all custom agenda commands that have a file argument." 19652 "Run all custom agenda commands that have a file argument."
18678 (let ((cmds org-agenda-custom-commands) 19653 (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands))
18679 (pop-up-frames nil) 19654 (pop-up-frames nil)
18680 (dir default-directory) 19655 (dir default-directory)
18681 pars cmd thiscmdkey files opts) 19656 pars cmd thiscmdkey files opts)
@@ -18686,8 +19661,8 @@ so the the export commands caneasily use it."
18686 (while cmds 19661 (while cmds
18687 (setq cmd (pop cmds) 19662 (setq cmd (pop cmds)
18688 thiscmdkey (car cmd) 19663 thiscmdkey (car cmd)
18689 opts (nth 3 cmd) 19664 opts (nth 4 cmd)
18690 files (nth 4 cmd)) 19665 files (nth 5 cmd))
18691 (if (stringp files) (setq files (list files))) 19666 (if (stringp files) (setq files (list files)))
18692 (when files 19667 (when files
18693 (eval (list 'let (append org-agenda-exporter-settings opts pars) 19668 (eval (list 'let (append org-agenda-exporter-settings opts pars)
@@ -18777,7 +19752,8 @@ is currently in place."
18777 (setq files (apply 'append 19752 (setq files (apply 'append
18778 (mapcar (lambda (f) 19753 (mapcar (lambda (f)
18779 (if (file-directory-p f) 19754 (if (file-directory-p f)
18780 (directory-files f t "\\.org\\'") 19755 (directory-files f t
19756 org-agenda-file-regexp)
18781 (list f))) 19757 (list f)))
18782 files))) 19758 files)))
18783 (if org-agenda-skip-unavailable-files 19759 (if org-agenda-skip-unavailable-files
@@ -18808,7 +19784,7 @@ the buffer and restores the previous window configuration."
18808 (message "New agenda file list installed")) 19784 (message "New agenda file list installed"))
18809 nil 'local) 19785 nil 'local)
18810 (message "%s" (substitute-command-keys 19786 (message "%s" (substitute-command-keys
18811 "Edit list and finish with \\[save-buffer]"))) 19787 "Edit list and finish with \\[save-buffer]")))
18812 (customize-variable 'org-agenda-files))) 19788 (customize-variable 'org-agenda-files)))
18813 19789
18814(defun org-store-new-agenda-file-list (list) 19790(defun org-store-new-agenda-file-list (list)
@@ -18893,7 +19869,7 @@ Optional argument FILE means, use this file instead of the current."
18893 (org-store-new-agenda-file-list files) 19869 (org-store-new-agenda-file-list files)
18894 (org-install-agenda-files-menu) 19870 (org-install-agenda-files-menu)
18895 (message "Removed file: %s" afile)) 19871 (message "Removed file: %s" afile))
18896 (message "File was not in list: %s" afile)))) 19872 (message "File was not in list: %s (not removed)" afile))))
18897 19873
18898(defun org-file-menu-entry (file) 19874(defun org-file-menu-entry (file)
18899 (vector file (list 'find-file file) t)) 19875 (vector file (list 'find-file file) t))
@@ -18982,10 +19958,9 @@ Optional argument FILE means, use this file instead of the current."
18982 (interactive) 19958 (interactive)
18983 (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority) 19959 (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority)
18984 (org-delete-overlay o))) 19960 (org-delete-overlay o)))
18985 (overlays-in (point-min) (point-max))) 19961 (org-overlays-in (point-min) (point-max)))
18986 (save-excursion 19962 (save-excursion
18987 (let ((ovs (org-overlays-in (point-min) (point-max))) 19963 (let ((inhibit-read-only t)
18988 (inhibit-read-only t)
18989 b e p ov h l) 19964 b e p ov h l)
18990 (goto-char (point-min)) 19965 (goto-char (point-min))
18991 (while (re-search-forward "\\[#\\(.\\)\\]" nil t) 19966 (while (re-search-forward "\\[#\\(.\\)\\]" nil t)
@@ -18994,7 +19969,7 @@ Optional argument FILE means, use this file instead of the current."
18994 l (or (get-char-property (point) 'org-lowest-priority) 19969 l (or (get-char-property (point) 'org-lowest-priority)
18995 org-lowest-priority) 19970 org-lowest-priority)
18996 p (string-to-char (match-string 1)) 19971 p (string-to-char (match-string 1))
18997 b (match-beginning 0) e (line-end-position) 19972 b (match-beginning 0) e (point-at-eol)
18998 ov (org-make-overlay b e)) 19973 ov (org-make-overlay b e))
18999 (org-overlay-put 19974 (org-overlay-put
19000 ov 'face 19975 ov 'face
@@ -19016,8 +19991,10 @@ Optional argument FILE means, use this file instead of the current."
19016 (save-excursion 19991 (save-excursion
19017 (save-restriction 19992 (save-restriction
19018 (while (setq file (pop files)) 19993 (while (setq file (pop files))
19019 (org-check-agenda-file file) 19994 (if (bufferp file)
19020 (set-buffer (org-get-agenda-file-buffer file)) 19995 (set-buffer file)
19996 (org-check-agenda-file file)
19997 (set-buffer (org-get-agenda-file-buffer file)))
19021 (widen) 19998 (widen)
19022 (setq bmp (buffer-modified-p)) 19999 (setq bmp (buffer-modified-p))
19023 (org-refresh-category-properties) 20000 (org-refresh-category-properties)
@@ -19096,9 +20073,6 @@ no longer in use."
19096 (while org-agenda-markers 20073 (while org-agenda-markers
19097 (move-marker (pop org-agenda-markers) nil)))) 20074 (move-marker (pop org-agenda-markers) nil))))
19098 20075
19099(defvar org-agenda-new-buffers nil
19100 "Buffers created to visit agenda files.")
19101
19102(defun org-get-agenda-file-buffer (file) 20076(defun org-get-agenda-file-buffer (file)
19103 "Get a buffer visiting FILE. If the buffer needs to be created, add 20077 "Get a buffer visiting FILE. If the buffer needs to be created, add
19104it to the list of buffers which might be released later." 20078it to the list of buffers which might be released later."
@@ -19303,7 +20277,9 @@ given in `org-agenda-start-on-weekday'."
19303 org-agenda-start-on-weekday nil)) 20277 org-agenda-start-on-weekday nil))
19304 (thefiles (org-agenda-files)) 20278 (thefiles (org-agenda-files))
19305 (files thefiles) 20279 (files thefiles)
19306 (today (time-to-days (current-time))) 20280 (today (time-to-days
20281 (time-subtract (current-time)
20282 (list 0 (* 3600 org-extend-today-until) 0))))
19307 (sd (or start-day today)) 20283 (sd (or start-day today))
19308 (start (if (or (null org-agenda-start-on-weekday) 20284 (start (if (or (null org-agenda-start-on-weekday)
19309 (< org-agenda-ndays 7)) 20285 (< org-agenda-ndays 7))
@@ -19576,11 +20552,12 @@ to skip this subtree. This is a function that can be put into
19576 20552
19577(defun org-agenda-skip-entry-if (&rest conditions) 20553(defun org-agenda-skip-entry-if (&rest conditions)
19578 "Skip entry if any of CONDITIONS is true. 20554 "Skip entry if any of CONDITIONS is true.
19579See `org-agenda-skip-if for details." 20555See `org-agenda-skip-if' for details."
19580 (org-agenda-skip-if nil conditions)) 20556 (org-agenda-skip-if nil conditions))
20557
19581(defun org-agenda-skip-subtree-if (&rest conditions) 20558(defun org-agenda-skip-subtree-if (&rest conditions)
19582 "Skip entry if any of CONDITIONS is true. 20559 "Skip entry if any of CONDITIONS is true.
19583See `org-agenda-skip-if for details." 20560See `org-agenda-skip-if' for details."
19584 (org-agenda-skip-if t conditions)) 20561 (org-agenda-skip-if t conditions))
19585 20562
19586(defun org-agenda-skip-if (subtree conditions) 20563(defun org-agenda-skip-if (subtree conditions)
@@ -19598,13 +20575,13 @@ notdeadline Check if there is no deadline
19598regexp Check if regexp matches 20575regexp Check if regexp matches
19599notregexp Check if regexp does not match. 20576notregexp Check if regexp does not match.
19600 20577
19601The regexp is taken from the conditions list, it must com right after the 20578The regexp is taken from the conditions list, it must come right after
19602`regexp' of `notregexp' element. 20579the `regexp' or `notregexp' element.
19603 20580
19604If any of these conditions is met, this function returns the end point of 20581If any of these conditions is met, this function returns the end point of
19605the entity, causing the search to continue from there. This is a function 20582the entity, causing the search to continue from there. This is a function
19606that can be put into `org-agenda-skip-function' for the duration of a command." 20583that can be put into `org-agenda-skip-function' for the duration of a command."
19607 (let (beg end m r) 20584 (let (beg end m)
19608 (org-back-to-heading t) 20585 (org-back-to-heading t)
19609 (setq beg (point) 20586 (setq beg (point)
19610 end (if subtree 20587 end (if subtree
@@ -19622,13 +20599,14 @@ that can be put into `org-agenda-skip-function' for the duration of a command."
19622 (and (memq 'notdeadline conditions) 20599 (and (memq 'notdeadline conditions)
19623 (not (re-search-forward org-deadline-time-regexp end t))) 20600 (not (re-search-forward org-deadline-time-regexp end t)))
19624 (and (setq m (memq 'regexp conditions)) 20601 (and (setq m (memq 'regexp conditions))
19625 (stringp (setq r (nth 1 m))) 20602 (stringp (nth 1 m))
19626 (re-search-forward (nth 1 m) end t)) 20603 (re-search-forward (nth 1 m) end t))
19627 (and (setq m (memq 'notregexp conditions)) 20604 (and (setq m (memq 'notregexp conditions))
19628 (stringp (setq r (nth 1 m))) 20605 (stringp (nth 1 m))
19629 (not (re-search-forward (nth 1 m) end t)))) 20606 (not (re-search-forward (nth 1 m) end t))))
19630 end))) 20607 end)))
19631 20608
20609;;;###autoload
19632(defun org-agenda-list-stuck-projects (&rest ignore) 20610(defun org-agenda-list-stuck-projects (&rest ignore)
19633 "Create agenda view for projects that are stuck. 20611 "Create agenda view for projects that are stuck.
19634Stuck projects are project that have no next actions. For the definitions 20612Stuck projects are project that have no next actions. For the definitions
@@ -19895,14 +20873,6 @@ the documentation of `org-diary'."
19895 (setq results (append results rtn)))))))) 20873 (setq results (append results rtn))))))))
19896 results)))) 20874 results))))
19897 20875
19898;; FIXME: this works only if the cursor is *not* at the
19899;; beginning of the entry
19900;(defun org-entry-is-done-p ()
19901; "Is the current entry marked DONE?"
19902; (save-excursion
19903; (and (re-search-backward "[\r\n]\\*+ " nil t)
19904; (looking-at org-nl-done-regexp))))
19905
19906(defun org-entry-is-todo-p () 20876(defun org-entry-is-todo-p ()
19907 (member (org-get-todo-state) org-not-done-keywords)) 20877 (member (org-get-todo-state) org-not-done-keywords))
19908 20878
@@ -20024,7 +20994,7 @@ the documentation of `org-diary'."
20024 "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" 20994 "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
20025 "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) 20995 "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
20026 marker hdmarker deadlinep scheduledp donep tmp priority category 20996 marker hdmarker deadlinep scheduledp donep tmp priority category
20027 ee txt timestr tags b0 b3 e3) 20997 ee txt timestr tags b0 b3 e3 head)
20028 (goto-char (point-min)) 20998 (goto-char (point-min))
20029 (while (re-search-forward regexp nil t) 20999 (while (re-search-forward regexp nil t)
20030 (setq b0 (match-beginning 0) 21000 (setq b0 (match-beginning 0)
@@ -20058,8 +21028,10 @@ the documentation of `org-diary'."
20058 (setq hdmarker (org-agenda-new-marker) 21028 (setq hdmarker (org-agenda-new-marker)
20059 tags (org-get-tags-at)) 21029 tags (org-get-tags-at))
20060 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") 21030 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
21031 (setq head (match-string 1))
21032 (and org-agenda-skip-timestamp-if-done donep (throw :skip t))
20061 (setq txt (org-format-agenda-item 21033 (setq txt (org-format-agenda-item
20062 nil (match-string 1) category tags timestr nil 21034 nil head category tags timestr nil
20063 remove-re))) 21035 remove-re)))
20064 (setq txt org-agenda-no-heading-message)) 21036 (setq txt org-agenda-no-heading-message))
20065 (setq priority (org-get-priority txt)) 21037 (setq priority (org-get-priority txt))
@@ -20331,7 +21303,8 @@ FRACTION is what fraction of the head-warning time has passed."
20331 (abbreviate-file-name buffer-file-name)))) 21303 (abbreviate-file-name buffer-file-name))))
20332 (regexp org-tr-regexp) 21304 (regexp org-tr-regexp)
20333 (d0 (calendar-absolute-from-gregorian date)) 21305 (d0 (calendar-absolute-from-gregorian date))
20334 marker hdmarker ee txt d1 d2 s1 s2 timestr category tags pos) 21306 marker hdmarker ee txt d1 d2 s1 s2 timestr category tags pos
21307 donep head)
20335 (goto-char (point-min)) 21308 (goto-char (point-min))
20336 (while (re-search-forward regexp nil t) 21309 (while (re-search-forward regexp nil t)
20337 (catch :skip 21310 (catch :skip
@@ -20354,10 +21327,14 @@ FRACTION is what fraction of the head-warning time has passed."
20354 (setq hdmarker (org-agenda-new-marker (point))) 21327 (setq hdmarker (org-agenda-new-marker (point)))
20355 (setq tags (org-get-tags-at)) 21328 (setq tags (org-get-tags-at))
20356 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") 21329 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
21330 (setq head (match-string 1))
21331 (and org-agenda-skip-timestamp-if-done
21332 (org-entry-is-done-p)
21333 (throw :skip t))
20357 (setq txt (org-format-agenda-item 21334 (setq txt (org-format-agenda-item
20358 (format (if (= d1 d2) "" "(%d/%d): ") 21335 (format (if (= d1 d2) "" "(%d/%d): ")
20359 (1+ (- d0 d1)) (1+ (- d2 d1))) 21336 (1+ (- d0 d1)) (1+ (- d2 d1)))
20360 (match-string 1) category tags 21337 head category tags
20361 (if (= d0 d1) timestr)))) 21338 (if (= d0 d1) timestr))))
20362 (setq txt org-agenda-no-heading-message)) 21339 (setq txt org-agenda-no-heading-message))
20363 (org-add-props txt props 21340 (org-add-props txt props
@@ -20518,7 +21495,7 @@ Any match of REMOVE-RE will be removed from TXT."
20518 'extra extra 21495 'extra extra
20519 'dotime dotime)))) 21496 'dotime dotime))))
20520 21497
20521(defvar org-agenda-sorting-strategy) ;; FIXME: can be removed? 21498(defvar org-agenda-sorting-strategy) ;; because the def is in a let form
20522(defvar org-agenda-sorting-strategy-selected nil) 21499(defvar org-agenda-sorting-strategy-selected nil)
20523 21500
20524(defun org-agenda-add-time-grid-maybe (list ndays todayp) 21501(defun org-agenda-add-time-grid-maybe (list ndays todayp)
@@ -20636,16 +21613,32 @@ HH:MM."
20636 (beginning-of-line 1) 21613 (beginning-of-line 1)
20637 (setq re (get-text-property (point) 'org-todo-regexp)) 21614 (setq re (get-text-property (point) 'org-todo-regexp))
20638 (goto-char (+ (point) (or (get-text-property (point) 'prefix-length) 0))) 21615 (goto-char (+ (point) (or (get-text-property (point) 'prefix-length) 0)))
20639 (and (looking-at (concat "[ \t]*\\.*" re)) 21616 (when (looking-at (concat "[ \t]*\\.*" re " +"))
20640 (add-text-properties (match-beginning 0) (match-end 0) 21617 (add-text-properties (match-beginning 0) (match-end 0)
20641 (list 'face (org-get-todo-face 0))))) 21618 (list 'face (org-get-todo-face 0)))
21619 (let ((s (buffer-substring (match-beginning 1) (match-end 1))))
21620 (delete-region (match-beginning 1) (1- (match-end 0)))
21621 (goto-char (match-beginning 1))
21622 (insert (format org-agenda-todo-keyword-format s)))))
20642 (setq re (concat (get-text-property 0 'org-todo-regexp x)) 21623 (setq re (concat (get-text-property 0 'org-todo-regexp x))
20643 pl (get-text-property 0 'prefix-length x)) 21624 pl (get-text-property 0 'prefix-length x))
20644 (and re (equal (string-match (concat "\\(\\.*\\)" re) x (or pl 0)) pl) 21625; (and re (equal (string-match (concat "\\(\\.*\\)" re) x (or pl 0)) pl)
20645 (add-text-properties 21626; (add-text-properties
20646 (or (match-end 1) (match-end 0)) (match-end 0) 21627; (or (match-end 1) (match-end 0)) (match-end 0)
20647 (list 'face (org-get-todo-face (match-string 2 x))) 21628; (list 'face (org-get-todo-face (match-string 2 x)))
20648 x)) 21629; x))
21630 (when (and re
21631 (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)")
21632 x (or pl 0)) pl))
21633 (add-text-properties
21634 (or (match-end 1) (match-end 0)) (match-end 0)
21635 (list 'face (org-get-todo-face (match-string 2 x)))
21636 x)
21637 (setq x (concat (substring x 0 (match-end 1))
21638 (format org-agenda-todo-keyword-format
21639 (match-string 2 x))
21640 " "
21641 (substring x (match-end 3)))))
20649 x))) 21642 x)))
20650 21643
20651(defsubst org-cmp-priority (a b) 21644(defsubst org-cmp-priority (a b)
@@ -20700,6 +21693,85 @@ HH:MM."
20700 (eval (cons 'or org-agenda-sorting-strategy-selected)) 21693 (eval (cons 'or org-agenda-sorting-strategy-selected))
20701 '((-1 . t) (1 . nil) (nil . nil)))))) 21694 '((-1 . t) (1 . nil) (nil . nil))))))
20702 21695
21696;;; Agenda restriction lock
21697
21698(defvar org-agenda-restriction-lock-overlay (org-make-overlay 1 1)
21699 "Overlay to mark the headline to which arenda commands are restricted.")
21700(org-overlay-put org-agenda-restriction-lock-overlay
21701 'face 'org-agenda-restriction-lock)
21702(org-overlay-put org-agenda-restriction-lock-overlay
21703 'help-echo "Agendas are currently limited to this subtree.")
21704(org-detach-overlay org-agenda-restriction-lock-overlay)
21705(defvar org-speedbar-restriction-lock-overlay (org-make-overlay 1 1)
21706 "Overlay marking the agenda restriction line in speedbar.")
21707(org-overlay-put org-speedbar-restriction-lock-overlay
21708 'face 'org-agenda-restriction-lock)
21709(org-overlay-put org-speedbar-restriction-lock-overlay
21710 'help-echo "Agendas are currently limited to this item.")
21711(org-detach-overlay org-speedbar-restriction-lock-overlay)
21712
21713(defun org-agenda-set-restriction-lock (&optional type)
21714 "Set restriction lock for agenda, to current subtree or file.
21715Restriction will be the file if TYPE is `file', or if type is the
21716universal prefix '(4), or if the cursor is before the first headline
21717in the file. Otherwise, restriction will be to the current subtree."
21718 (interactive "P")
21719 (and (equal type '(4)) (setq type 'file))
21720 (setq type (cond
21721 (type type)
21722 ((org-at-heading-p) 'subtree)
21723 ((condition-case nil (org-back-to-heading t) (error nil))
21724 'subtree)
21725 (t 'file)))
21726 (if (eq type 'subtree)
21727 (progn
21728 (setq org-agenda-restrict t)
21729 (setq org-agenda-overriding-restriction 'subtree)
21730 (put 'org-agenda-files 'org-restrict
21731 (list (buffer-file-name (buffer-base-buffer))))
21732 (org-back-to-heading t)
21733 (org-move-overlay org-agenda-restriction-lock-overlay (point) (point-at-eol))
21734 (move-marker org-agenda-restrict-begin (point))
21735 (move-marker org-agenda-restrict-end
21736 (save-excursion (org-end-of-subtree t)))
21737 (message "Locking agenda restriction to subtree"))
21738 (put 'org-agenda-files 'org-restrict
21739 (list (buffer-file-name (buffer-base-buffer))))
21740 (setq org-agenda-restrict nil)
21741 (setq org-agenda-overriding-restriction 'file)
21742 (move-marker org-agenda-restrict-begin nil)
21743 (move-marker org-agenda-restrict-end nil)
21744 (message "Locking agenda restriction to file"))
21745 (setq current-prefix-arg nil)
21746 (org-agenda-maybe-redo))
21747
21748(defun org-agenda-remove-restriction-lock (&optional noupdate)
21749 "Remove the agenda restriction lock."
21750 (interactive "P")
21751 (org-detach-overlay org-agenda-restriction-lock-overlay)
21752 (org-detach-overlay org-speedbar-restriction-lock-overlay)
21753 (setq org-agenda-overriding-restriction nil)
21754 (setq org-agenda-restrict nil)
21755 (put 'org-agenda-files 'org-restrict nil)
21756 (move-marker org-agenda-restrict-begin nil)
21757 (move-marker org-agenda-restrict-end nil)
21758 (setq current-prefix-arg nil)
21759 (message "Agenda restriction lock removed")
21760 (or noupdate (org-agenda-maybe-redo)))
21761
21762(defun org-agenda-maybe-redo ()
21763 "If there is any window showing the agenda view, update it."
21764 (let ((w (get-buffer-window org-agenda-buffer-name t))
21765 (w0 (selected-window)))
21766 (when w
21767 (select-window w)
21768 (org-agenda-redo)
21769 (select-window w0)
21770 (if org-agenda-overriding-restriction
21771 (message "Agenda view shifted to new %s restriction"
21772 org-agenda-overriding-restriction)
21773 (message "Agenda restriction lock removed")))))
21774
20703;;; Agenda commands 21775;;; Agenda commands
20704 21776
20705(defun org-agenda-check-type (error &rest types) 21777(defun org-agenda-check-type (error &rest types)
@@ -20734,6 +21806,13 @@ Org-mode buffers visited directly by the user will not be touched."
20734 (setq org-agenda-new-buffers nil) 21806 (setq org-agenda-new-buffers nil)
20735 (org-agenda-quit)) 21807 (org-agenda-quit))
20736 21808
21809(defun org-agenda-execute (arg)
21810 "Execute another agenda command, keeping same window.\\<global-map>
21811So this is just a shortcut for `\\[org-agenda]', available in the agenda."
21812 (interactive "P")
21813 (let ((org-agenda-window-setup 'current-window))
21814 (org-agenda arg)))
21815
20737(defun org-save-all-org-buffers () 21816(defun org-save-all-org-buffers ()
20738 "Save all Org-mode buffers without user confirmation." 21817 "Save all Org-mode buffers without user confirmation."
20739 (interactive) 21818 (interactive)
@@ -20770,7 +21849,9 @@ When this is the global TODO list, a prefix argument will be interpreted."
20770 (cond 21849 (cond
20771 (tdpos (goto-char tdpos)) 21850 (tdpos (goto-char tdpos))
20772 ((eq org-agenda-type 'agenda) 21851 ((eq org-agenda-type 'agenda)
20773 (let* ((sd (time-to-days (current-time))) 21852 (let* ((sd (time-to-days
21853 (time-subtract (current-time)
21854 (list 0 (* 3600 org-extend-today-until) 0))))
20774 (comp (org-agenda-compute-time-span sd org-agenda-span)) 21855 (comp (org-agenda-compute-time-span sd org-agenda-span))
20775 (org-agenda-overriding-arguments org-agenda-last-arguments)) 21856 (org-agenda-overriding-arguments org-agenda-last-arguments))
20776 (setf (nth 1 org-agenda-overriding-arguments) (car comp)) 21857 (setf (nth 1 org-agenda-overriding-arguments) (car comp))
@@ -22034,6 +23115,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
22034 (:archived-trees . org-export-with-archived-trees) 23115 (:archived-trees . org-export-with-archived-trees)
22035 (:emphasize . org-export-with-emphasize) 23116 (:emphasize . org-export-with-emphasize)
22036 (:sub-superscript . org-export-with-sub-superscripts) 23117 (:sub-superscript . org-export-with-sub-superscripts)
23118 (:special-strings . org-export-with-special-strings)
22037 (:footnotes . org-export-with-footnotes) 23119 (:footnotes . org-export-with-footnotes)
22038 (:drawers . org-export-with-drawers) 23120 (:drawers . org-export-with-drawers)
22039 (:tags . org-export-with-tags) 23121 (:tags . org-export-with-tags)
@@ -22047,10 +23129,11 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
22047 (:tables . org-export-with-tables) 23129 (:tables . org-export-with-tables)
22048 (:table-auto-headline . org-export-highlight-first-table-line) 23130 (:table-auto-headline . org-export-highlight-first-table-line)
22049 (:style . org-export-html-style) 23131 (:style . org-export-html-style)
22050 (:agenda-style . org-agenda-export-html-style) ;; FIXME: Does this work???? 23132 (:agenda-style . org-agenda-export-html-style)
22051 (:convert-org-links . org-export-html-link-org-files-as-html) 23133 (:convert-org-links . org-export-html-link-org-files-as-html)
22052 (:inline-images . org-export-html-inline-images) 23134 (:inline-images . org-export-html-inline-images)
22053 (:html-extension . org-export-html-extension) 23135 (:html-extension . org-export-html-extension)
23136 (:html-table-tag . org-export-html-table-tag)
22054 (:expand-quoted-html . org-export-html-expand) 23137 (:expand-quoted-html . org-export-html-expand)
22055 (:timestamp . org-export-html-with-timestamp) 23138 (:timestamp . org-export-html-with-timestamp)
22056 (:publishing-directory . org-export-publishing-directory) 23139 (:publishing-directory . org-export-publishing-directory)
@@ -22071,50 +23154,53 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
22071(defun org-infile-export-plist () 23154(defun org-infile-export-plist ()
22072 "Return the property list with file-local settings for export." 23155 "Return the property list with file-local settings for export."
22073 (save-excursion 23156 (save-excursion
22074 (goto-char 0) 23157 (save-restriction
22075 (let ((re (org-make-options-regexp 23158 (widen)
22076 '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) 23159 (goto-char 0)
22077 p key val text options) 23160 (let ((re (org-make-options-regexp
22078 (while (re-search-forward re nil t) 23161 '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")))
22079 (setq key (org-match-string-no-properties 1) 23162 p key val text options)
22080 val (org-match-string-no-properties 2)) 23163 (while (re-search-forward re nil t)
22081 (cond 23164 (setq key (org-match-string-no-properties 1)
22082 ((string-equal key "TITLE") (setq p (plist-put p :title val))) 23165 val (org-match-string-no-properties 2))
22083 ((string-equal key "AUTHOR")(setq p (plist-put p :author val))) 23166 (cond
22084 ((string-equal key "EMAIL") (setq p (plist-put p :email val))) 23167 ((string-equal key "TITLE") (setq p (plist-put p :title val)))
22085 ((string-equal key "DATE") (setq p (plist-put p :date val))) 23168 ((string-equal key "AUTHOR")(setq p (plist-put p :author val)))
22086 ((string-equal key "LANGUAGE") (setq p (plist-put p :language val))) 23169 ((string-equal key "EMAIL") (setq p (plist-put p :email val)))
22087 ((string-equal key "TEXT") 23170 ((string-equal key "DATE") (setq p (plist-put p :date val)))
22088 (setq text (if text (concat text "\n" val) val))) 23171 ((string-equal key "LANGUAGE") (setq p (plist-put p :language val)))
22089 ((string-equal key "OPTIONS") (setq options val)))) 23172 ((string-equal key "TEXT")
22090 (setq p (plist-put p :text text)) 23173 (setq text (if text (concat text "\n" val) val)))
22091 (when options 23174 ((string-equal key "OPTIONS") (setq options val))))
22092 (let ((op '(("H" . :headline-levels) 23175 (setq p (plist-put p :text text))
22093 ("num" . :section-numbers) 23176 (when options
22094 ("toc" . :table-of-contents) 23177 (let ((op '(("H" . :headline-levels)
22095 ("\\n" . :preserve-breaks) 23178 ("num" . :section-numbers)
22096 ("@" . :expand-quoted-html) 23179 ("toc" . :table-of-contents)
22097 (":" . :fixed-width) 23180 ("\\n" . :preserve-breaks)
22098 ("|" . :tables) 23181 ("@" . :expand-quoted-html)
22099 ("^" . :sub-superscript) 23182 (":" . :fixed-width)
22100 ("f" . :footnotes) 23183 ("|" . :tables)
22101 ("d" . :drawers) 23184 ("^" . :sub-superscript)
22102 ("tags" . :tags) 23185 ("-" . :special-strings)
22103 ("*" . :emphasize) 23186 ("f" . :footnotes)
22104 ("TeX" . :TeX-macros) 23187 ("d" . :drawers)
22105 ("LaTeX" . :LaTeX-fragments) 23188 ("tags" . :tags)
22106 ("skip" . :skip-before-1st-heading) 23189 ("*" . :emphasize)
22107 ("author" . :author-info) 23190 ("TeX" . :TeX-macros)
22108 ("timestamp" . :time-stamp-file))) 23191 ("LaTeX" . :LaTeX-fragments)
22109 o) 23192 ("skip" . :skip-before-1st-heading)
22110 (while (setq o (pop op)) 23193 ("author" . :author-info)
22111 (if (string-match (concat (regexp-quote (car o)) 23194 ("timestamp" . :time-stamp-file)))
22112 ":\\([^ \t\n\r;,.]*\\)") 23195 o)
22113 options) 23196 (while (setq o (pop op))
22114 (setq p (plist-put p (cdr o) 23197 (if (string-match (concat (regexp-quote (car o))
22115 (car (read-from-string 23198 ":\\([^ \t\n\r;,.]*\\)")
22116 (match-string 1 options))))))))) 23199 options)
22117 p))) 23200 (setq p (plist-put p (cdr o)
23201 (car (read-from-string
23202 (match-string 1 options)))))))))
23203 p))))
22118 23204
22119(defun org-export-directory (type plist) 23205(defun org-export-directory (type plist)
22120 (let* ((val (plist-get plist :publishing-directory)) 23206 (let* ((val (plist-get plist :publishing-directory))
@@ -22397,8 +23483,8 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
22397 ("prop") ("proptp"."&prop;") 23483 ("prop") ("proptp"."&prop;")
22398 ("infin") ("infty"."&infin;") 23484 ("infin") ("infty"."&infin;")
22399 ("ang") ("angle"."&ang;") 23485 ("ang") ("angle"."&ang;")
22400 ("and") ("vee"."&and;") 23486 ("and") ("wedge"."&and;")
22401 ("or") ("wedge"."&or;") 23487 ("or") ("vee"."&or;")
22402 ("cap") 23488 ("cap")
22403 ("cup") 23489 ("cup")
22404 ("int") 23490 ("int")
@@ -22523,6 +23609,8 @@ translations. There is currently no way for users to extend this.")
22523 (commentsp (plist-get parameters :comments)) 23609 (commentsp (plist-get parameters :comments))
22524 (archived-trees (plist-get parameters :archived-trees)) 23610 (archived-trees (plist-get parameters :archived-trees))
22525 (inhibit-read-only t) 23611 (inhibit-read-only t)
23612 (drawers org-drawers)
23613 (exp-drawers (plist-get parameters :drawers))
22526 (outline-regexp "\\*+ ") 23614 (outline-regexp "\\*+ ")
22527 a b xx 23615 a b xx
22528 rtn p) 23616 rtn p)
@@ -22561,14 +23649,14 @@ translations. There is currently no way for users to extend this.")
22561 (if (> b a) (delete-region a b))))) 23649 (if (> b a) (delete-region a b)))))
22562 23650
22563 ;; Get rid of drawers 23651 ;; Get rid of drawers
22564 (unless (eq t org-export-with-drawers) 23652 (unless (eq t exp-drawers)
22565 (goto-char (point-min)) 23653 (goto-char (point-min))
22566 (let ((re (concat "^[ \t]*:\\(" 23654 (let ((re (concat "^[ \t]*:\\("
22567 (mapconcat 'identity 23655 (mapconcat
22568 (if (listp org-export-with-drawers) 23656 'identity
22569 org-export-with-drawers 23657 (org-delete-all exp-drawers
22570 org-drawers) 23658 (copy-sequence drawers))
22571 "\\|") 23659 "\\|")
22572 "\\):[ \t]*\n\\([^@]*?\n\\)?[ \t]*:END:[ \t]*\n"))) 23660 "\\):[ \t]*\n\\([^@]*?\n\\)?[ \t]*:END:[ \t]*\n")))
22573 (while (re-search-forward re nil t) 23661 (while (re-search-forward re nil t)
22574 (replace-match "")))) 23662 (replace-match ""))))
@@ -22580,12 +23668,18 @@ translations. There is currently no way for users to extend this.")
22580 (replace-match "\\1(INVISIBLE)")) 23668 (replace-match "\\1(INVISIBLE)"))
22581 23669
22582 ;; Protect backend specific stuff, throw away the others. 23670 ;; Protect backend specific stuff, throw away the others.
22583 (goto-char (point-min))
22584 (let ((formatters 23671 (let ((formatters
22585 `((,htmlp "HTML" "BEGIN_HTML" "END_HTML") 23672 `((,htmlp "HTML" "BEGIN_HTML" "END_HTML")
22586 (,asciip "ASCII" "BEGIN_ASCII" "END_ASCII") 23673 (,asciip "ASCII" "BEGIN_ASCII" "END_ASCII")
22587 (,latexp "LaTeX" "BEGIN_LaTeX" "END_LaTeX"))) 23674 (,latexp "LaTeX" "BEGIN_LaTeX" "END_LaTeX")))
22588 fmt) 23675 fmt)
23676 (goto-char (point-min))
23677 (while (re-search-forward "^#\\+BEGIN_EXAMPLE[ \t]*\n" nil t)
23678 (goto-char (match-end 0))
23679 (while (not (looking-at "#\\+END_EXAMPLE"))
23680 (insert ": ")
23681 (beginning-of-line 2)))
23682 (goto-char (point-min))
22589 (while (re-search-forward "^[ \t]*:.*\\(\n[ \t]*:.*\\)*" nil t) 23683 (while (re-search-forward "^[ \t]*:.*\\(\n[ \t]*:.*\\)*" nil t)
22590 (add-text-properties (match-beginning 0) (match-end 0) 23684 (add-text-properties (match-beginning 0) (match-end 0)
22591 '(org-protected t))) 23685 '(org-protected t)))
@@ -22617,6 +23711,13 @@ translations. There is currently no way for users to extend this.")
22617 (add-text-properties (point) (org-end-of-subtree t) 23711 (add-text-properties (point) (org-end-of-subtree t)
22618 '(org-protected t))) 23712 '(org-protected t)))
22619 23713
23714 ;; Protect verbatim elements
23715 (goto-char (point-min))
23716 (while (re-search-forward org-verbatim-re nil t)
23717 (add-text-properties (match-beginning 4) (match-end 4)
23718 '(org-protected t))
23719 (goto-char (1+ (match-end 4))))
23720
22620 ;; Remove subtrees that are commented 23721 ;; Remove subtrees that are commented
22621 (goto-char (point-min)) 23722 (goto-char (point-min))
22622 (while (re-search-forward re-commented nil t) 23723 (while (re-search-forward re-commented nil t)
@@ -22640,6 +23741,9 @@ translations. There is currently no way for users to extend this.")
22640 (require 'org-export-latex nil) 23741 (require 'org-export-latex nil)
22641 (org-export-latex-cleaned-string)) 23742 (org-export-latex-cleaned-string))
22642 23743
23744 (when asciip
23745 (org-export-ascii-clean-string))
23746
22643 ;; Specific HTML stuff 23747 ;; Specific HTML stuff
22644 (when htmlp 23748 (when htmlp
22645 ;; Convert LaTeX fragments to images 23749 ;; Convert LaTeX fragments to images
@@ -22887,6 +23991,8 @@ underlined headlines. The default is 3."
22887 :for-ascii t 23991 :for-ascii t
22888 :skip-before-1st-heading 23992 :skip-before-1st-heading
22889 (plist-get opt-plist :skip-before-1st-heading) 23993 (plist-get opt-plist :skip-before-1st-heading)
23994 :drawers (plist-get opt-plist :drawers)
23995 :verbatim-multiline t
22890 :archived-trees 23996 :archived-trees
22891 (plist-get opt-plist :archived-trees) 23997 (plist-get opt-plist :archived-trees)
22892 :add-text (plist-get opt-plist :text)) 23998 :add-text (plist-get opt-plist :text))
@@ -23083,6 +24189,16 @@ underlined headlines. The default is 3."
23083 (goto-char beg))) 24189 (goto-char beg)))
23084 (goto-char (point-min)))) 24190 (goto-char (point-min))))
23085 24191
24192(defun org-export-ascii-clean-string ()
24193 "Do extra work for ASCII export"
24194 (goto-char (point-min))
24195 (while (re-search-forward org-verbatim-re nil t)
24196 (goto-char (match-end 2))
24197 (backward-delete-char 1) (insert "'")
24198 (goto-char (match-beginning 2))
24199 (delete-char 1) (insert "`")
24200 (goto-char (match-end 2))))
24201
23086(defun org-search-todo-below (line lines level) 24202(defun org-search-todo-below (line lines level)
23087 "Search the subtree below LINE for any TODO entries." 24203 "Search the subtree below LINE for any TODO entries."
23088 (let ((rest (cdr (memq line lines))) 24204 (let ((rest (cdr (memq line lines)))
@@ -23232,7 +24348,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
23232#+EMAIL: %s 24348#+EMAIL: %s
23233#+LANGUAGE: %s 24349#+LANGUAGE: %s
23234#+TEXT: Some descriptive text to be emitted. Several lines OK. 24350#+TEXT: Some descriptive text to be emitted. Several lines OK.
23235#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s f:%s *:%s TeX:%s LaTeX:%s skip:%s d:%s tags:%s 24351#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s -:%s f:%s *:%s TeX:%s LaTeX:%s skip:%s d:%s tags:%s
23236#+CATEGORY: %s 24352#+CATEGORY: %s
23237#+SEQ_TODO: %s 24353#+SEQ_TODO: %s
23238#+TYP_TODO: %s 24354#+TYP_TODO: %s
@@ -23252,6 +24368,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
23252 org-export-with-fixed-width 24368 org-export-with-fixed-width
23253 org-export-with-tables 24369 org-export-with-tables
23254 org-export-with-sub-superscripts 24370 org-export-with-sub-superscripts
24371 org-export-with-special-strings
23255 org-export-with-footnotes 24372 org-export-with-footnotes
23256 org-export-with-emphasize 24373 org-export-with-emphasize
23257 org-export-with-TeX-macros 24374 org-export-with-TeX-macros
@@ -23308,6 +24425,7 @@ this line is also exported in fixed-width font."
23308 (beg (if regionp (region-beginning) (point))) 24425 (beg (if regionp (region-beginning) (point)))
23309 (end (if regionp (region-end))) 24426 (end (if regionp (region-end)))
23310 (nlines (or arg (if (and beg end) (count-lines beg end) 1))) 24427 (nlines (or arg (if (and beg end) (count-lines beg end) 1)))
24428 (case-fold-search nil)
23311 (re "[ \t]*\\(:\\)") 24429 (re "[ \t]*\\(:\\)")
23312 off) 24430 off)
23313 (if regionp 24431 (if regionp
@@ -23415,6 +24533,7 @@ in a window. A non-interactive call will only retunr the buffer."
23415 (switch-to-buffer-other-window rtn) 24533 (switch-to-buffer-other-window rtn)
23416 rtn))) 24534 rtn)))
23417 24535
24536(defvar html-table-tag nil) ; dynamically scoped into this.
23418(defun org-export-as-html (arg &optional hidden ext-plist 24537(defun org-export-as-html (arg &optional hidden ext-plist
23419 to-buffer body-only) 24538 to-buffer body-only)
23420 "Export the outline as a pretty HTML file. 24539 "Export the outline as a pretty HTML file.
@@ -23469,14 +24588,16 @@ the body tags themselves."
23469 (umax nil) 24588 (umax nil)
23470 (umax-toc nil) 24589 (umax-toc nil)
23471 (filename (if to-buffer nil 24590 (filename (if to-buffer nil
23472 (concat (file-name-as-directory 24591 (expand-file-name
23473 (org-export-directory :html opt-plist)) 24592 (concat
23474 (file-name-sans-extension 24593 (file-name-sans-extension
23475 (or (and subtree-p 24594 (or (and subtree-p
23476 (org-entry-get (region-beginning) 24595 (org-entry-get (region-beginning)
23477 "EXPORT_FILE_NAME" t)) 24596 "EXPORT_FILE_NAME" t))
23478 (file-name-nondirectory buffer-file-name))) 24597 (file-name-nondirectory buffer-file-name)))
23479 "." org-export-html-extension))) 24598 "." org-export-html-extension)
24599 (file-name-as-directory
24600 (org-export-directory :html opt-plist)))))
23480 (current-dir (if buffer-file-name 24601 (current-dir (if buffer-file-name
23481 (file-name-directory buffer-file-name) 24602 (file-name-directory buffer-file-name)
23482 default-directory)) 24603 default-directory))
@@ -23497,6 +24618,7 @@ the body tags themselves."
23497 (file-name-sans-extension 24618 (file-name-sans-extension
23498 (file-name-nondirectory buffer-file-name))) 24619 (file-name-nondirectory buffer-file-name)))
23499 "UNTITLED")) 24620 "UNTITLED"))
24621 (html-table-tag (plist-get opt-plist :html-table-tag))
23500 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) 24622 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
23501 (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)")) 24623 (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
23502 (inquote nil) 24624 (inquote nil)
@@ -23533,6 +24655,7 @@ the body tags themselves."
23533 :for-html t 24655 :for-html t
23534 :skip-before-1st-heading 24656 :skip-before-1st-heading
23535 (plist-get opt-plist :skip-before-1st-heading) 24657 (plist-get opt-plist :skip-before-1st-heading)
24658 :drawers (plist-get opt-plist :drawers)
23536 :archived-trees 24659 :archived-trees
23537 (plist-get opt-plist :archived-trees) 24660 (plist-get opt-plist :archived-trees)
23538 :add-text 24661 :add-text
@@ -23569,7 +24692,7 @@ the body tags themselves."
23569 24692
23570 ;; Switch to the output buffer 24693 ;; Switch to the output buffer
23571 (set-buffer buffer) 24694 (set-buffer buffer)
23572 (erase-buffer) 24695 (let ((inhibit-read-only t)) (erase-buffer))
23573 (fundamental-mode) 24696 (fundamental-mode)
23574 24697
23575 (and (fboundp 'set-buffer-file-coding-system) 24698 (and (fboundp 'set-buffer-file-coding-system)
@@ -23732,7 +24855,8 @@ lang=\"%s\" xml:lang=\"%s\">
23732 (replace-match "\\2\n")) 24855 (replace-match "\\2\n"))
23733 (insert line "\n") 24856 (insert line "\n")
23734 (while (and lines 24857 (while (and lines
23735 (get-text-property 0 'org-protected (car lines))) 24858 (or (= (length (car lines)) 0)
24859 (get-text-property 0 'org-protected (car lines))))
23736 (insert (pop lines) "\n")) 24860 (insert (pop lines) "\n"))
23737 (and par (insert "<p>\n"))) 24861 (and par (insert "<p>\n")))
23738 (throw 'nextline nil)) 24862 (throw 'nextline nil))
@@ -23768,7 +24892,8 @@ lang=\"%s\" xml:lang=\"%s\">
23768 ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;" 24892 ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
23769 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>") 24893 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
23770 ;; Also handle sub_superscripts and checkboxes 24894 ;; Also handle sub_superscripts and checkboxes
23771 (setq line (org-html-expand line)) 24895 (or (string-match org-table-hline-regexp line)
24896 (setq line (org-html-expand line)))
23772 24897
23773 ;; Format the links 24898 ;; Format the links
23774 (setq start 0) 24899 (setq start 0)
@@ -23868,14 +24993,17 @@ lang=\"%s\" xml:lang=\"%s\">
23868 24993
23869 ;; Does this contain a reference to a footnote? 24994 ;; Does this contain a reference to a footnote?
23870 (when org-export-with-footnotes 24995 (when org-export-with-footnotes
23871 (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line) 24996 (setq start 0)
23872 (let ((n (match-string 2 line))) 24997 (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start)
23873 (setq line 24998 (if (get-text-property (match-beginning 2) 'org-protected line)
23874 (replace-match 24999 (setq start (match-end 2))
23875 (format 25000 (let ((n (match-string 2 line)))
23876 "%s<sup><a class=\"footref\" name=\"fnr.%s\" href=\"#fn.%s\">%s</a></sup>" 25001 (setq line
23877 (match-string 1 line) n n n) 25002 (replace-match
23878 t t line))))) 25003 (format
25004 "%s<sup><a class=\"footref\" name=\"fnr.%s\" href=\"#fn.%s\">%s</a></sup>"
25005 (match-string 1 line) n n n)
25006 t t line))))))
23879 25007
23880 (cond 25008 (cond
23881 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) 25009 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
@@ -24005,7 +25133,7 @@ lang=\"%s\" xml:lang=\"%s\">
24005 (pop local-list-num)) 25133 (pop local-list-num))
24006 (setq local-list-indent nil 25134 (setq local-list-indent nil
24007 in-local-list nil)) 25135 in-local-list nil))
24008 (org-html-level-start 0 nil umax 25136 (org-html-level-start 1 nil umax
24009 (and org-export-with-toc (<= level umax)) 25137 (and org-export-with-toc (<= level umax))
24010 head-count) 25138 head-count)
24011 25139
@@ -24016,8 +25144,13 @@ lang=\"%s\" xml:lang=\"%s\">
24016 (insert "<p class=\"author\"> " 25144 (insert "<p class=\"author\"> "
24017 (nth 1 lang-words) ": " author "\n") 25145 (nth 1 lang-words) ": " author "\n")
24018 (when email 25146 (when email
24019 (insert "<a href=\"mailto:" email "\">&lt;" 25147 (if (listp (split-string email ",+ *"))
24020 email "&gt;</a>\n")) 25148 (mapc (lambda(e)
25149 (insert "<a href=\"mailto:" e "\">&lt;"
25150 e "&gt;</a>\n"))
25151 (split-string email ",+ *"))
25152 (insert "<a href=\"mailto:" email "\">&lt;"
25153 email "&gt;</a>\n")))
24021 (insert "</p>\n")) 25154 (insert "</p>\n"))
24022 (when (and date org-export-time-stamp-file) 25155 (when (and date org-export-time-stamp-file)
24023 (insert "<p class=\"date\"> " 25156 (insert "<p class=\"date\"> "
@@ -24201,11 +25334,11 @@ lang=\"%s\" xml:lang=\"%s\">
24201 (unless splice (push "</table>\n" html)) 25334 (unless splice (push "</table>\n" html))
24202 (setq html (nreverse html)) 25335 (setq html (nreverse html))
24203 (unless splice 25336 (unless splice
24204 ;; Put in COL tags with the alignment (unfortuntely often ignored...) 25337 ;; Put in col tags with the alignment (unfortuntely often ignored...)
24205 (push (mapconcat 25338 (push (mapconcat
24206 (lambda (x) 25339 (lambda (x)
24207 (setq gr (pop org-table-colgroup-info)) 25340 (setq gr (pop org-table-colgroup-info))
24208 (format "%s<COL align=\"%s\"></COL>%s" 25341 (format "%s<col align=\"%s\"></col>%s"
24209 (if (memq gr '(:start :startend)) 25342 (if (memq gr '(:start :startend))
24210 (prog1 25343 (prog1
24211 (if colgropen "</colgroup>\n<colgroup>" "<colgroup>") 25344 (if colgropen "</colgroup>\n<colgroup>" "<colgroup>")
@@ -24219,7 +25352,7 @@ lang=\"%s\" xml:lang=\"%s\">
24219 fnum "") 25352 fnum "")
24220 html) 25353 html)
24221 (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html))))) 25354 (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html)))))
24222 (push org-export-html-table-tag html)) 25355 (push html-table-tag html))
24223 (concat (mapconcat 'identity html "\n") "\n"))) 25356 (concat (mapconcat 'identity html "\n") "\n")))
24224 25357
24225(defun org-table-clean-before-export (lines) 25358(defun org-table-clean-before-export (lines)
@@ -24267,8 +25400,7 @@ If yes remove the column and the special lines."
24267 ((or (string-match "^\\([ \t]*\\)|-+\\+" x) 25400 ((or (string-match "^\\([ \t]*\\)|-+\\+" x)
24268 (string-match "^\\([ \t]*\\)|[^|]*|" x)) 25401 (string-match "^\\([ \t]*\\)|[^|]*|" x))
24269 ;; remove the first column 25402 ;; remove the first column
24270 (replace-match "\\1|" t nil x)) 25403 (replace-match "\\1|" t nil x))))
24271 (t (error "This should not happen"))))
24272 lines)))) 25404 lines))))
24273 25405
24274(defun org-format-table-table-html (lines) 25406(defun org-format-table-table-html (lines)
@@ -24279,7 +25411,7 @@ But it has the disadvantage, that no cell- or row-spanning is allowed."
24279 (let (line field-buffer 25411 (let (line field-buffer
24280 (head org-export-highlight-first-table-line) 25412 (head org-export-highlight-first-table-line)
24281 fields html empty) 25413 fields html empty)
24282 (setq html (concat org-export-html-table-tag "\n")) 25414 (setq html (concat html-table-tag "\n"))
24283 (while (setq line (pop lines)) 25415 (while (setq line (pop lines))
24284 (setq empty "&nbsp;") 25416 (setq empty "&nbsp;")
24285 (catch 'next-line 25417 (catch 'next-line
@@ -24407,21 +25539,26 @@ If there are links in the string, don't modify these."
24407 "Apply all active conversions to translate special ASCII to HTML." 25539 "Apply all active conversions to translate special ASCII to HTML."
24408 (setq s (org-html-protect s)) 25540 (setq s (org-html-protect s))
24409 (if org-export-html-expand 25541 (if org-export-html-expand
24410 (while (string-match "@&lt;\\([^&]*\\)&gt;" s) 25542 (let ((start 0))
24411 (setq s (replace-match "<\\1>" t nil s)))) 25543 (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
25544 (setq s (replace-match "<\\1>" t nil s)))))
24412 (if org-export-with-emphasize 25545 (if org-export-with-emphasize
24413 (setq s (org-export-html-convert-emphasize s))) 25546 (setq s (org-export-html-convert-emphasize s)))
25547 (if org-export-with-special-strings
25548 (setq s (org-export-html-convert-special-strings s)))
24414 (if org-export-with-sub-superscripts 25549 (if org-export-with-sub-superscripts
24415 (setq s (org-export-html-convert-sub-super s))) 25550 (setq s (org-export-html-convert-sub-super s)))
24416 (if org-export-with-TeX-macros 25551 (if org-export-with-TeX-macros
24417 (let ((start 0) wd ass) 25552 (let ((start 0) wd ass)
24418 (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)" s start)) 25553 (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)" s start))
24419 (setq wd (match-string 1 s)) 25554 (if (get-text-property (match-beginning 0) 'org-protected s)
24420 (if (setq ass (assoc wd org-html-entities)) 25555 (setq start (match-end 0))
24421 (setq s (replace-match (or (cdr ass) 25556 (setq wd (match-string 1 s))
24422 (concat "&" (car ass) ";")) 25557 (if (setq ass (assoc wd org-html-entities))
24423 t t s)) 25558 (setq s (replace-match (or (cdr ass)
24424 (setq start (+ start (length wd))))))) 25559 (concat "&" (car ass) ";"))
25560 t t s))
25561 (setq start (+ start (length wd))))))))
24425 s) 25562 s)
24426 25563
24427(defun org-create-multibrace-regexp (left right n) 25564(defun org-create-multibrace-regexp (left right n)
@@ -24452,16 +25589,41 @@ stacked delimiters is N. Escaping delimiters is not possible."
24452 "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") 25589 "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)")
24453 "The regular expression matching a sub- or superscript.") 25590 "The regular expression matching a sub- or superscript.")
24454 25591
24455;(let ((s "a\\_b")) 25592(defvar org-match-substring-with-braces-regexp
24456; (and (string-match org-match-substring-regexp s) 25593 (concat
24457; (conca t (match-string 1 s) ":::" (match-string 2 s)))) 25594 "\\([^\\]\\)\\([_^]\\)\\("
25595 "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
25596 "\\)")
25597 "The regular expression matching a sub- or superscript, forcing braces.")
25598
25599(defconst org-export-html-special-string-regexps
25600 '(("\\\\-" . "&shy;")
25601 ("---\\([^-]\\)" . "&mdash;\\1")
25602 ("--\\([^-]\\)" . "&ndash;\\1")
25603 ("\\.\\.\\." . "&hellip;"))
25604 "Regular expressions for special string conversion.")
25605
25606(defun org-export-html-convert-special-strings (string)
25607 "Convert special characters in STRING to HTML."
25608 (let ((all org-export-html-special-string-regexps)
25609 e a re rpl start)
25610 (while (setq a (pop all))
25611 (setq re (car a) rpl (cdr a) start 0)
25612 (while (string-match re string start)
25613 (if (get-text-property (match-beginning 0) 'org-protected string)
25614 (setq start (match-end 0))
25615 (setq string (replace-match rpl t nil string)))))
25616 string))
24458 25617
24459(defun org-export-html-convert-sub-super (string) 25618(defun org-export-html-convert-sub-super (string)
24460 "Convert sub- and superscripts in STRING to HTML." 25619 "Convert sub- and superscripts in STRING to HTML."
24461 (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) 25620 (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
24462 (while (string-match org-match-substring-regexp string s) 25621 (while (string-match org-match-substring-regexp string s)
24463 (if (and requireb (match-end 8)) 25622 (cond
24464 (setq s (match-end 2)) 25623 ((and requireb (match-end 8)) (setq s (match-end 2)))
25624 ((get-text-property (match-beginning 2) 'org-protected string)
25625 (setq s (match-end 2)))
25626 (t
24465 (setq s (match-end 1) 25627 (setq s (match-end 1)
24466 key (if (string= (match-string 2 string) "_") "sub" "sup") 25628 key (if (string= (match-string 2 string) "_") "sub" "sup")
24467 c (or (match-string 8 string) 25629 c (or (match-string 8 string)
@@ -24470,22 +25632,29 @@ stacked delimiters is N. Escaping delimiters is not possible."
24470 string (replace-match 25632 string (replace-match
24471 (concat (match-string 1 string) 25633 (concat (match-string 1 string)
24472 "<" key ">" c "</" key ">") 25634 "<" key ">" c "</" key ">")
24473 t t string)))) 25635 t t string)))))
24474 (while (string-match "\\\\\\([_^]\\)" string) 25636 (while (string-match "\\\\\\([_^]\\)" string)
24475 (setq string (replace-match (match-string 1 string) t t string))) 25637 (setq string (replace-match (match-string 1 string) t t string)))
24476 string)) 25638 string))
24477 25639
24478(defun org-export-html-convert-emphasize (string) 25640(defun org-export-html-convert-emphasize (string)
24479 "Apply emphasis." 25641 "Apply emphasis."
24480 (let ((s 0)) 25642 (let ((s 0) rpl)
24481 (while (string-match org-emph-re string s) 25643 (while (string-match org-emph-re string s)
24482 (if (not (equal 25644 (if (not (equal
24483 (substring string (match-beginning 3) (1+ (match-beginning 3))) 25645 (substring string (match-beginning 3) (1+ (match-beginning 3)))
24484 (substring string (match-beginning 4) (1+ (match-beginning 4))))) 25646 (substring string (match-beginning 4) (1+ (match-beginning 4)))))
24485 (setq string (replace-match 25647 (setq s (match-beginning 0)
24486 (concat "\\1" (nth 2 (assoc (match-string 3 string) org-emphasis-alist)) 25648 rpl
24487 "\\4" (nth 3 (assoc (match-string 3 string) org-emphasis-alist)) 25649 (concat
24488 "\\5") t nil string)) 25650 (match-string 1 string)
25651 (nth 2 (assoc (match-string 3 string) org-emphasis-alist))
25652 (match-string 4 string)
25653 (nth 3 (assoc (match-string 3 string)
25654 org-emphasis-alist))
25655 (match-string 5 string))
25656 string (replace-match rpl t t string)
25657 s (+ s (- (length rpl) 2)))
24489 (setq s (1+ s)))) 25658 (setq s (1+ s))))
24490 string)) 25659 string))
24491 25660
@@ -24511,7 +25680,7 @@ stacked delimiters is N. Escaping delimiters is not possible."
24511When TITLE is nil, just close all open levels." 25680When TITLE is nil, just close all open levels."
24512 (org-close-par-maybe) 25681 (org-close-par-maybe)
24513 (let ((l org-level-max)) 25682 (let ((l org-level-max))
24514 (while (>= l (1+ level)) 25683 (while (>= l level)
24515 (if (aref org-levels-open (1- l)) 25684 (if (aref org-levels-open (1- l))
24516 (progn 25685 (progn
24517 (org-html-level-close l umax) 25686 (org-html-level-close l umax)
@@ -24657,10 +25826,14 @@ When COMBINE is non nil, add the category to each line."
24657 ts (match-string 0) 25826 ts (match-string 0)
24658 inc t 25827 inc t
24659 hd (org-get-heading) 25828 hd (org-get-heading)
24660 summary (org-entry-get nil "SUMMARY") 25829 summary (org-icalendar-cleanup-string
24661 desc (or (org-entry-get nil "DESCRIPTION") 25830 (org-entry-get nil "SUMMARY"))
24662 (org-get-cleaned-entry org-icalendar-include-body)) 25831 desc (org-icalendar-cleanup-string
24663 location (org-entry-get nil "LOCATION") 25832 (or (org-entry-get nil "DESCRIPTION")
25833 (and org-icalendar-include-body (org-get-entry)))
25834 t org-icalendar-include-body)
25835 location (org-icalendar-cleanup-string
25836 (org-entry-get nil "LOCATION"))
24664 category (org-get-category)) 25837 category (org-get-category))
24665 (if (looking-at re2) 25838 (if (looking-at re2)
24666 (progn 25839 (progn
@@ -24748,10 +25921,14 @@ END:VEVENT\n"
24748 (not (member org-archive-tag (org-get-tags-at))) 25921 (not (member org-archive-tag (org-get-tags-at)))
24749 ) 25922 )
24750 (setq hd (match-string 3) 25923 (setq hd (match-string 3)
24751 summary (org-entry-get nil "SUMMARY") 25924 summary (org-icalendar-cleanup-string
24752 desc (or (org-entry-get nil "DESCRIPTION") 25925 (org-entry-get nil "SUMMARY"))
24753 (org-get-cleaned-entry org-icalendar-include-body)) 25926 desc (org-icalendar-cleanup-string
24754 location (org-entry-get nil "LOCATION")) 25927 (or (org-entry-get nil "DESCRIPTION")
25928 (and org-icalendar-include-body (org-get-entry)))
25929 t org-icalendar-include-body)
25930 location (org-icalendar-cleanup-string
25931 (org-entry-get nil "LOCATION")))
24755 (if (string-match org-bracket-link-regexp hd) 25932 (if (string-match org-bracket-link-regexp hd)
24756 (setq hd (replace-match (if (match-end 3) (match-string 3 hd) 25933 (setq hd (replace-match (if (match-end 3) (match-string 3 hd)
24757 (match-string 1 hd)) 25934 (match-string 1 hd))
@@ -24780,24 +25957,38 @@ END:VTODO\n"
24780 (concat "\nDESCRIPTION: " desc) "") 25957 (concat "\nDESCRIPTION: " desc) "")
24781 category pri status))))))))) 25958 category pri status)))))))))
24782 25959
24783(defun org-get-cleaned-entry (what) 25960(defun org-icalendar-cleanup-string (s &optional is-body maxlength)
24784 "Clean-up description string." 25961 "Take out stuff and quote what needs to be quoted.
24785 (when what 25962When IS-BODY is non-nil, assume that this is the body of an item, clean up
24786 (save-excursion 25963whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
24787 (org-back-to-heading t) 25964characters."
24788 (let ((s (buffer-substring (point-at-bol 2) (org-end-of-subtree t))) 25965 (if (not s)
24789 (re (concat org-drawer-regexp "[^\000]*?:END:.*\n?")) 25966 nil
25967 (when is-body
25968 (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
24790 (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) 25969 (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
24791 (while (string-match re s) (setq s (replace-match "" t t s))) 25970 (while (string-match re s) (setq s (replace-match "" t t s)))
24792 (while (string-match re2 s) (setq s (replace-match "" t t s))) 25971 (while (string-match re2 s) (setq s (replace-match "" t t s)))))
24793 (if (string-match "[ \t\r\n]+\\'" s) (setq s (replace-match "" t t s))) 25972 (let ((start 0))
24794 (while (string-match "[ \t]*\n[ \t]*" s) 25973 (while (string-match "\\([,;\\]\\)" s start)
24795 (setq s (replace-match "\\n" t t s))) 25974 (setq start (+ (match-beginning 0) 2)
24796 (setq s (org-trim s)) 25975 s (replace-match "\\\\\\1" nil nil s))))
24797 (if (and (numberp what) 25976 (when is-body
24798 (> (length s) what)) 25977 (while (string-match "[ \t]*\n[ \t]*" s)
24799 (substring s 0 what) 25978 (setq s (replace-match "\\n" t t s))))
24800 s))))) 25979 (setq s (org-trim s))
25980 (if is-body
25981 (if maxlength
25982 (if (and (numberp maxlength)
25983 (> (length s) maxlength))
25984 (setq s (substring s 0 maxlength)))))
25985 s))
25986
25987(defun org-get-entry ()
25988 "Clean-up description string."
25989 (save-excursion
25990 (org-back-to-heading t)
25991 (buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
24801 25992
24802(defun org-start-icalendar-file (name) 25993(defun org-start-icalendar-file (name)
24803 "Start an iCalendar file by inserting the header." 25994 "Start an iCalendar file by inserting the header."
@@ -24853,8 +26044,8 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
24853 26044
24854 ;; Output everything as XOXO 26045 ;; Output everything as XOXO
24855 (with-current-buffer (get-buffer buffer) 26046 (with-current-buffer (get-buffer buffer)
24856 (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. 26047 (let* ((pos (point))
24857 (let* ((opt-plist (org-combine-plists (org-default-export-plist) 26048 (opt-plist (org-combine-plists (org-default-export-plist)
24858 (org-infile-export-plist))) 26049 (org-infile-export-plist)))
24859 (filename (concat (file-name-as-directory 26050 (filename (concat (file-name-as-directory
24860 (org-export-directory :xoxo opt-plist)) 26051 (org-export-directory :xoxo opt-plist))
@@ -24864,6 +26055,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
24864 (out (find-file-noselect filename)) 26055 (out (find-file-noselect filename))
24865 (last-level 1) 26056 (last-level 1)
24866 (hanging-li nil)) 26057 (hanging-li nil))
26058 (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed.
24867 ;; Check the output buffer is empty. 26059 ;; Check the output buffer is empty.
24868 (with-current-buffer out (erase-buffer)) 26060 (with-current-buffer out (erase-buffer))
24869 ;; Kick off the output 26061 ;; Kick off the output
@@ -24916,6 +26108,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
24916 (org-export-as-xoxo-insert-into out "</li>\n")) 26108 (org-export-as-xoxo-insert-into out "</li>\n"))
24917 (org-export-as-xoxo-insert-into out "</ol>\n")) 26109 (org-export-as-xoxo-insert-into out "</ol>\n"))
24918 26110
26111 (goto-char pos)
24919 ;; Finish the buffer off and clean it up. 26112 ;; Finish the buffer off and clean it up.
24920 (switch-to-buffer-other-window out) 26113 (switch-to-buffer-other-window out)
24921 (indent-region (point-min) (point-max) nil) 26114 (indent-region (point-min) (point-max) nil)
@@ -25009,7 +26202,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
25009(org-defkey org-mode-map "\C-c\C-d" 'org-deadline) 26202(org-defkey org-mode-map "\C-c\C-d" 'org-deadline)
25010(org-defkey org-mode-map "\C-c;" 'org-toggle-comment) 26203(org-defkey org-mode-map "\C-c;" 'org-toggle-comment)
25011(org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree) 26204(org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree)
25012(org-defkey org-mode-map "\C-c\C-w" 'org-check-deadlines) 26205(org-defkey org-mode-map "\C-c\C-w" 'org-refile)
25013(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved 26206(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved
25014(org-defkey org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res. 26207(org-defkey org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res.
25015(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) 26208(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret)
@@ -25032,12 +26225,15 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
25032(org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files) 26225(org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files)
25033(org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front) 26226(org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front)
25034(org-defkey org-mode-map "\C-c]" 'org-remove-file) 26227(org-defkey org-mode-map "\C-c]" 'org-remove-file)
26228(org-defkey org-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock)
26229(org-defkey org-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
25035(org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus) 26230(org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus)
25036(org-defkey org-mode-map "\C-c^" 'org-sort) 26231(org-defkey org-mode-map "\C-c^" 'org-sort)
25037(org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) 26232(org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c)
25038(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) 26233(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches)
25039(org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count) 26234(org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count)
25040(org-defkey org-mode-map "\C-m" 'org-return) 26235(org-defkey org-mode-map "\C-m" 'org-return)
26236(org-defkey org-mode-map "\C-j" 'org-return-indent)
25041(org-defkey org-mode-map "\C-c?" 'org-table-field-info) 26237(org-defkey org-mode-map "\C-c?" 'org-table-field-info)
25042(org-defkey org-mode-map "\C-c " 'org-table-blank-field) 26238(org-defkey org-mode-map "\C-c " 'org-table-blank-field)
25043(org-defkey org-mode-map "\C-c+" 'org-table-sum) 26239(org-defkey org-mode-map "\C-c+" 'org-table-sum)
@@ -25175,12 +26371,9 @@ because, in this case the deletion might narrow the column."
25175(put 'org-delete-char 'flyspell-delayed t) 26371(put 'org-delete-char 'flyspell-delayed t)
25176(put 'org-delete-backward-char 'flyspell-delayed t) 26372(put 'org-delete-backward-char 'flyspell-delayed t)
25177 26373
25178(eval-after-load "pabbrev" 26374;; Make pabbrev-mode expand after org-mode commands
25179 '(progn 26375(put 'org-self-insert-command 'pabbrev-expand-after-command t)
25180 (add-to-list 'pabbrev-expand-after-command-list 26376(put 'orgybl-self-insert-command 'pabbrev-expand-after-command t)
25181 'orgtbl-self-insert-command t)
25182 (add-to-list 'pabbrev-expand-after-command-list
25183 'org-self-insert-command t)))
25184 26377
25185;; How to do this: Measure non-white length of current string 26378;; How to do this: Measure non-white length of current string
25186;; If equal to column width, we should realign. 26379;; If equal to column width, we should realign.
@@ -25442,7 +26635,9 @@ This command does many different things, depending on context:
25442 links in this buffer. 26635 links in this buffer.
25443 26636
25444- If the cursor is on a numbered item in a plain list, renumber the 26637- If the cursor is on a numbered item in a plain list, renumber the
25445 ordered list." 26638 ordered list.
26639
26640- If the cursor is on a checkbox, toggle it."
25446 (interactive "P") 26641 (interactive "P")
25447 (let ((org-enable-table-editor t)) 26642 (let ((org-enable-table-editor t))
25448 (cond 26643 (cond
@@ -25500,25 +26695,31 @@ Also updates the keyword regular expressions."
25500 (message "Org-mode restarted to refresh keyword and special line setup")) 26695 (message "Org-mode restarted to refresh keyword and special line setup"))
25501 26696
25502(defun org-kill-note-or-show-branches () 26697(defun org-kill-note-or-show-branches ()
25503 "If this is a Note buffer, abort storing the note. Else call `show-branches'." 26698 "If this is a Note buffer, abort storing the note. Else call `show-branches'."
25504 (interactive) 26699 (interactive)
25505 (if (not org-finish-function) 26700 (if (not org-finish-function)
25506 (call-interactively 'show-branches) 26701 (call-interactively 'show-branches)
25507 (let ((org-note-abort t)) 26702 (let ((org-note-abort t))
25508 (funcall org-finish-function)))) 26703 (funcall org-finish-function))))
25509 26704
25510(defun org-return () 26705(defun org-return (&optional indent)
25511 "Goto next table row or insert a newline. 26706 "Goto next table row or insert a newline.
25512Calls `org-table-next-row' or `newline', depending on context. 26707Calls `org-table-next-row' or `newline', depending on context.
25513See the individual commands for more information." 26708See the individual commands for more information."
25514 (interactive) 26709 (interactive)
25515 (cond 26710 (cond
25516 ((bobp) (newline)) 26711 ((bobp) (if indent (newline-and-indent) (newline)))
25517 ((org-at-table-p) 26712 ((org-at-table-p)
25518 (org-table-justify-field-maybe) 26713 (org-table-justify-field-maybe)
25519 (call-interactively 'org-table-next-row)) 26714 (call-interactively 'org-table-next-row))
25520 (t (newline)))) 26715 (t (if indent (newline-and-indent) (newline)))))
25521 26716
26717(defun org-return-indent ()
26718 (interactive)
26719 "Goto next table row or insert a newline and indent.
26720Calls `org-table-next-row' or `newline-and-indent', depending on
26721context. See the individual commands for more information."
26722 (org-return t))
25522 26723
25523(defun org-ctrl-c-minus () 26724(defun org-ctrl-c-minus ()
25524 "Insert separator line in table or modify bullet type in list. 26725 "Insert separator line in table or modify bullet type in list.
@@ -25723,6 +26924,7 @@ See the individual commands for more information."
25723 :style toggle :selected org-log-done]) 26924 :style toggle :selected org-log-done])
25724 "--" 26925 "--"
25725 ["Agenda Command..." org-agenda t] 26926 ["Agenda Command..." org-agenda t]
26927 ["Set Restriction Lock" org-agenda-set-restriction-lock t]
25726 ("File List for Agenda") 26928 ("File List for Agenda")
25727 ("Special views current file" 26929 ("Special views current file"
25728 ["TODO Tree" org-show-todo-tree t] 26930 ["TODO Tree" org-show-todo-tree t]
@@ -25981,6 +27183,18 @@ really on, so that the block visually is on the match."
25981 (setq list (delete (pop elts) list))) 27183 (setq list (delete (pop elts) list)))
25982 list) 27184 list)
25983 27185
27186(defun org-back-over-empty-lines ()
27187 "Move backwards over witespace, to the beginning of the first empty line.
27188Returns the number o empty lines passed."
27189 (let ((pos (point)))
27190 (skip-chars-backward " \t\n\r")
27191 (beginning-of-line 2)
27192 (goto-char (min (point) pos))
27193 (count-lines (point) pos)))
27194
27195(defun org-skip-whitespace ()
27196 (skip-chars-forward " \t\n\r"))
27197
25984(defun org-point-in-group (point group &optional context) 27198(defun org-point-in-group (point group &optional context)
25985 "Check if POINT is in match-group GROUP. 27199 "Check if POINT is in match-group GROUP.
25986If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the 27200If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the
@@ -26129,10 +27343,13 @@ not an indirect buffer"
26129 (setq column tcol) 27343 (setq column tcol)
26130 (goto-char pos) 27344 (goto-char pos)
26131 (beginning-of-line 1) 27345 (beginning-of-line 1)
26132 (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") 27346 (if (looking-at "\\S-")
26133 (setq bullet (match-string 1) 27347 (progn
26134 btype (if (string-match "[0-9]" bullet) "n" bullet)) 27348 (looking-at "[ \t]*\\(\\S-+\\)[ \t]*")
26135 (setq column (if (equal btype bullet-type) bcol tcol)))) 27349 (setq bullet (match-string 1)
27350 btype (if (string-match "[0-9]" bullet) "n" bullet))
27351 (setq column (if (equal btype bullet-type) bcol tcol)))
27352 (setq column (org-get-indentation)))))
26136 (t (setq column (org-get-indentation)))))) 27353 (t (setq column (org-get-indentation))))))
26137 (goto-char pos) 27354 (goto-char pos)
26138 (if (<= (current-column) (current-indentation)) 27355 (if (<= (current-column) (current-indentation))
@@ -26141,7 +27358,7 @@ not an indirect buffer"
26141 (setq column (current-column)) 27358 (setq column (current-column))
26142 (beginning-of-line 1) 27359 (beginning-of-line 1)
26143 (if (looking-at 27360 (if (looking-at
26144 "\\([ \t]+\\)\\(:[0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") 27361 "\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)")
26145 (replace-match (concat "\\1" (format org-property-format 27362 (replace-match (concat "\\1" (format org-property-format
26146 (match-string 2) (match-string 3))) 27363 (match-string 2) (match-string 3)))
26147 t nil)) 27364 t nil))
@@ -26183,10 +27400,13 @@ not an indirect buffer"
26183 "Re-align a table, pass through to fill-paragraph if no table." 27400 "Re-align a table, pass through to fill-paragraph if no table."
26184 (let ((table-p (org-at-table-p)) 27401 (let ((table-p (org-at-table-p))
26185 (table.el-p (org-at-table.el-p))) 27402 (table.el-p (org-at-table.el-p)))
26186 (cond ((equal (char-after (point-at-bol)) ?*) t) ; skip headlines 27403 (cond ((and (equal (char-after (point-at-bol)) ?*)
26187 (table.el-p t) ; skip table.el tables 27404 (save-excursion (goto-char (point-at-bol))
26188 (table-p (org-table-align) t) ; align org-mode tables 27405 (looking-at outline-regexp)))
26189 (t nil)))) ; call paragraph-fill 27406 t) ; skip headlines
27407 (table.el-p t) ; skip table.el tables
27408 (table-p (org-table-align) t) ; align org-mode tables
27409 (t nil)))) ; call paragraph-fill
26190 27410
26191;; For reference, this is the default value of adaptive-fill-regexp 27411;; For reference, this is the default value of adaptive-fill-regexp
26192;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*" 27412;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*"
@@ -26318,6 +27538,20 @@ headline found, or nil if no higher level is found."
26318 (if (< level start-level) (throw 'exit level))) 27538 (if (< level start-level) (throw 'exit level)))
26319 nil))) 27539 nil)))
26320 27540
27541(defun org-first-sibling-p ()
27542 "Is this heading the first child of its parents?"
27543 (interactive)
27544 (let ((re (concat "^" outline-regexp))
27545 level l)
27546 (unless (org-at-heading-p t)
27547 (error "Not at a heading"))
27548 (setq level (funcall outline-level))
27549 (save-excursion
27550 (if (not (re-search-backward re nil t))
27551 t
27552 (setq l (funcall outline-level))
27553 (< l level)))))
27554
26321(defun org-goto-sibling (&optional previous) 27555(defun org-goto-sibling (&optional previous)
26322 "Goto the next sibling, even if it is invisible. 27556 "Goto the next sibling, even if it is invisible.
26323When PREVIOUS is set, go to the previous sibling instead. Returns t 27557When PREVIOUS is set, go to the previous sibling instead. Returns t
@@ -26446,7 +27680,104 @@ Show the heading too, if it is currently invisible."
26446 (org-show-context 'isearch)) 27680 (org-show-context 'isearch))
26447 27681
26448 27682
26449;;;; Address problems with some other packages 27683;;;; Integration with and fixes for other packages
27684
27685;;; Imenu support
27686
27687(defvar org-imenu-markers nil
27688 "All markers currently used by Imenu.")
27689(make-variable-buffer-local 'org-imenu-markers)
27690
27691(defun org-imenu-new-marker (&optional pos)
27692 "Return a new marker for use by Imenu, and remember the marker."
27693 (let ((m (make-marker)))
27694 (move-marker m (or pos (point)))
27695 (push m org-imenu-markers)
27696 m))
27697
27698(defun org-imenu-get-tree ()
27699 "Produce the index for Imenu."
27700 (mapc (lambda (x) (move-marker x nil)) org-imenu-markers)
27701 (setq org-imenu-markers nil)
27702 (let* ((n org-imenu-depth)
27703 (re (concat "^" outline-regexp))
27704 (subs (make-vector (1+ n) nil))
27705 (last-level 0)
27706 m tree level head)
27707 (save-excursion
27708 (save-restriction
27709 (widen)
27710 (goto-char (point-max))
27711 (while (re-search-backward re nil t)
27712 (setq level (org-reduced-level (funcall outline-level)))
27713 (when (<= level n)
27714 (looking-at org-complex-heading-regexp)
27715 (setq head (org-match-string-no-properties 4)
27716 m (org-imenu-new-marker))
27717 (org-add-props head nil 'org-imenu-marker m 'org-imenu t)
27718 (if (>= level last-level)
27719 (push (cons head m) (aref subs level))
27720 (push (cons head (aref subs (1+ level))) (aref subs level))
27721 (loop for i from (1+ level) to n do (aset subs i nil)))
27722 (setq last-level level)))))
27723 (aref subs 1)))
27724
27725(eval-after-load "imenu"
27726 '(progn
27727 (add-hook 'imenu-after-jump-hook
27728 (lambda () (org-show-context 'org-goto)))))
27729
27730;; Speedbar support
27731
27732(defun org-speedbar-set-agenda-restriction ()
27733 "Restrict future agenda commands to the location at point in speedbar.
27734To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
27735 (interactive)
27736 (let (p m tp np dir txt w)
27737 (cond
27738 ((setq p (text-property-any (point-at-bol) (point-at-eol)
27739 'org-imenu t))
27740 (setq m (get-text-property p 'org-imenu-marker))
27741 (save-excursion
27742 (save-restriction
27743 (set-buffer (marker-buffer m))
27744 (goto-char m)
27745 (org-agenda-set-restriction-lock 'subtree))))
27746 ((setq p (text-property-any (point-at-bol) (point-at-eol)
27747 'speedbar-function 'speedbar-find-file))
27748 (setq tp (previous-single-property-change
27749 (1+ p) 'speedbar-function)
27750 np (next-single-property-change
27751 tp 'speedbar-function)
27752 dir (speedbar-line-directory)
27753 txt (buffer-substring-no-properties (or tp (point-min))
27754 (or np (point-max))))
27755 (save-excursion
27756 (save-restriction
27757 (set-buffer (find-file-noselect
27758 (let ((default-directory dir))
27759 (expand-file-name txt))))
27760 (unless (org-mode-p)
27761 (error "Cannot restrict to non-Org-mode file"))
27762 (org-agenda-set-restriction-lock 'file))))
27763 (t (error "Don't know how to restrict Org-mode's agenda")))
27764 (org-move-overlay org-speedbar-restriction-lock-overlay
27765 (point-at-bol) (point-at-eol))
27766 (setq current-prefix-arg nil)
27767 (org-agenda-maybe-redo)))
27768
27769(eval-after-load "speedbar"
27770 '(progn
27771 (speedbar-add-supported-extension ".org")
27772 (define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction)
27773 (define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction)
27774 (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock)
27775 (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
27776 (add-hook 'speedbar-visiting-tag-hook
27777 (lambda () (org-show-context 'org-goto)))))
27778
27779
27780;;; Fixes and Hacks
26450 27781
26451;; Make flyspell not check words in links, to not mess up our keymap 27782;; Make flyspell not check words in links, to not mess up our keymap
26452(defun org-mode-flyspell-verify () 27783(defun org-mode-flyspell-verify ()
@@ -26471,6 +27802,13 @@ Show the heading too, if it is currently invisible."
26471 (org-invisible-p))) 27802 (org-invisible-p)))
26472 (org-show-context 'bookmark-jump))) 27803 (org-show-context 'bookmark-jump)))
26473 27804
27805;; Fix a bug in htmlize where there are text properties (face nil)
27806(eval-after-load "htmlize"
27807 '(progn
27808 (defadvice htmlize-faces-in-buffer (after org-no-nil-faces activate)
27809 "Make sure there are no nil faces"
27810 (setq ad-return-value (delq nil ad-return-value)))))
27811
26474;; Make session.el ignore our circular variable 27812;; Make session.el ignore our circular variable
26475(eval-after-load "session" 27813(eval-after-load "session"
26476 '(add-to-list 'session-globals-exclude 'org-mark-ring)) 27814 '(add-to-list 'session-globals-exclude 'org-mark-ring))
@@ -26479,7 +27817,7 @@ Show the heading too, if it is currently invisible."
26479 27817
26480(defun org-closed-in-range () 27818(defun org-closed-in-range ()
26481 "Sparse tree of items closed in a certain time range. 27819 "Sparse tree of items closed in a certain time range.
26482Still experimental, may disappear in the furture." 27820Still experimental, may disappear in the future."
26483 (interactive) 27821 (interactive)
26484 ;; Get the time interval from the user. 27822 ;; Get the time interval from the user.
26485 (let* ((time1 (time-to-seconds 27823 (let* ((time1 (time-to-seconds
@@ -26498,64 +27836,6 @@ Still experimental, may disappear in the furture."
26498 ;; make tree, check each match with the callback 27836 ;; make tree, check each match with the callback
26499 (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) 27837 (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback)))
26500 27838
26501(defun org-fill-paragraph-experimental (&optional justify)
26502 "Re-align a table, pass through to fill-paragraph if no table."
26503 (let ((table-p (org-at-table-p))
26504 (table.el-p (org-at-table.el-p)))
26505 (cond ((equal (char-after (point-at-bol)) ?*) t) ; skip headlines
26506 (table.el-p t) ; skip table.el tables
26507 (table-p (org-table-align) t) ; align org-mode tables
26508 ((save-excursion
26509 (let ((pos (1+ (point-at-eol))))
26510 (backward-paragraph 1)
26511 (re-search-forward "\\\\\\\\[ \t]*$" pos t)))
26512 (save-excursion
26513 (save-restriction
26514 (narrow-to-region (1+ (match-end 0)) (point-max))
26515 (fill-paragraph nil)
26516 t)))
26517 (t nil)))) ; call paragraph-fill
26518
26519;; FIXME: this needs a much better algorithm
26520(defun org-assign-fast-keys (alist)
26521 "Assign fast keys to a keyword-key alist.
26522Respect keys that are already there."
26523 (let (new e k c c1 c2 (char ?a))
26524 (while (setq e (pop alist))
26525 (cond
26526 ((equal e '(:startgroup)) (push e new))
26527 ((equal e '(:endgroup)) (push e new))
26528 (t
26529 (setq k (car e) c2 nil)
26530 (if (cdr e)
26531 (setq c (cdr e))
26532 ;; automatically assign a character.
26533 (setq c1 (string-to-char
26534 (downcase (substring
26535 k (if (= (string-to-char k) ?@) 1 0)))))
26536 (if (or (rassoc c1 new) (rassoc c1 alist))
26537 (while (or (rassoc char new) (rassoc char alist))
26538 (setq char (1+ char)))
26539 (setq c2 c1))
26540 (setq c (or c2 char)))
26541 (push (cons k c) new))))
26542 (nreverse new)))
26543
26544;(defcustom org-read-date-prefer-future nil
26545; "Non-nil means, when reading an incomplete date from the user, assume future.
26546;This affects the following situations:
26547;1. The user give a day, but no month.
26548; In this case, if the day number if after today, the current month will
26549; be used, otherwise the next month.
26550;2. The user gives a month but not a year.
26551; In this case, the the given month is after the current month, the current
26552; year will be used. Otherwise the next year will be used.;
26553;
26554;When nil, always the current month and year will be used."
26555; :group 'org-time ;????
26556; :type 'boolean)
26557
26558
26559;;;; Finish up 27839;;;; Finish up
26560 27840
26561(provide 'org) 27841(provide 'org)
@@ -26565,4 +27845,3 @@ Respect keys that are already there."
26565;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd 27845;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
26566;;; org.el ends here 27846;;; org.el ends here
26567 27847
26568
diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el
index 2d489eb5896..15fba461fd3 100644
--- a/lisp/textmodes/reftex-index.el
+++ b/lisp/textmodes/reftex-index.el
@@ -1243,8 +1243,9 @@ If the buffer is non-empty, delete the old header first."
1243 (beginning-of-line 2)) 1243 (beginning-of-line 2))
1244 (while (looking-at "^[ \t]*$") 1244 (while (looking-at "^[ \t]*$")
1245 (beginning-of-line 2)) 1245 (beginning-of-line 2))
1246 (cond ((fboundp 'zmacs-activate-region) (zmacs-activate-region)) 1246 (if (featurep 'xemacs)
1247 ((boundp 'make-active) (setq mark-active t))) 1247 (zmacs-activate-region)
1248 (setq mark-active t))
1248 (if (yes-or-no-p "Delete and rebuild header? ") 1249 (if (yes-or-no-p "Delete and rebuild header? ")
1249 (delete-region (point-min) (point)))) 1250 (delete-region (point-min) (point))))
1250 1251
@@ -1495,8 +1496,9 @@ index the new part without having to go over the unchanged parts again."
1495 (unwind-protect 1496 (unwind-protect
1496 (progn 1497 (progn
1497 ;; Hide the region highlighting 1498 ;; Hide the region highlighting
1498 (cond ((fboundp 'zmacs-deactivate-region) (zmacs-deactivate-region)) 1499 (if (featurep 'xemacs)
1499 ((fboundp 'deactivate-mark) (deactivate-mark))) 1500 (zmacs-deactivate-region)
1501 (deactivate-mark))
1500 (delete-other-windows) 1502 (delete-other-windows)
1501 (reftex-index-visit-phrases-buffer) 1503 (reftex-index-visit-phrases-buffer)
1502 (reftex-index-all-phrases)) 1504 (reftex-index-all-phrases))
diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el
index 0e501fdf23e..e57e9a59a73 100644
--- a/lisp/textmodes/reftex-toc.el
+++ b/lisp/textmodes/reftex-toc.el
@@ -326,7 +326,7 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
326(defun reftex-toc-next (&optional arg) 326(defun reftex-toc-next (&optional arg)
327 "Move to next selectable item." 327 "Move to next selectable item."
328 (interactive "p") 328 (interactive "p")
329 (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) 329 (when (featurep 'xemacs) (setq zmacs-region-stays t))
330 (setq reftex-callback-fwd t) 330 (setq reftex-callback-fwd t)
331 (or (eobp) (forward-char 1)) 331 (or (eobp) (forward-char 1))
332 (goto-char (or (next-single-property-change (point) :data) 332 (goto-char (or (next-single-property-change (point) :data)
@@ -334,21 +334,21 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
334(defun reftex-toc-previous (&optional arg) 334(defun reftex-toc-previous (&optional arg)
335 "Move to previous selectable item." 335 "Move to previous selectable item."
336 (interactive "p") 336 (interactive "p")
337 (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) 337 (when (featurep 'xemacs) (setq zmacs-region-stays t))
338 (setq reftex-callback-fwd nil) 338 (setq reftex-callback-fwd nil)
339 (goto-char (or (previous-single-property-change (point) :data) 339 (goto-char (or (previous-single-property-change (point) :data)
340 (point)))) 340 (point))))
341(defun reftex-toc-next-heading (&optional arg) 341(defun reftex-toc-next-heading (&optional arg)
342 "Move to next table of contentes line." 342 "Move to next table of contentes line."
343 (interactive "p") 343 (interactive "p")
344 (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) 344 (when (featurep 'xemacs) (setq zmacs-region-stays t))
345 (end-of-line) 345 (end-of-line)
346 (re-search-forward "^ " nil t arg) 346 (re-search-forward "^ " nil t arg)
347 (beginning-of-line)) 347 (beginning-of-line))
348(defun reftex-toc-previous-heading (&optional arg) 348(defun reftex-toc-previous-heading (&optional arg)
349 "Move to previous table of contentes line." 349 "Move to previous table of contentes line."
350 (interactive "p") 350 (interactive "p")
351 (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) 351 (when (featurep 'xemacs) (setq zmacs-region-stays t))
352 (re-search-backward "^ " nil t arg)) 352 (re-search-backward "^ " nil t arg))
353(defun reftex-toc-toggle-follow () 353(defun reftex-toc-toggle-follow ()
354 "Toggle follow (other window follows with context)." 354 "Toggle follow (other window follows with context)."
@@ -637,7 +637,7 @@ point."
637 (if mark-line 637 (if mark-line
638 (progn 638 (progn
639 (set-mark mpos) 639 (set-mark mpos)
640 (if (fboundp 'zmacs-activate-region) 640 (if (featurep 'xemacs)
641 (zmacs-activate-region) 641 (zmacs-activate-region)
642 (setq mark-active t 642 (setq mark-active t
643 deactivate-mark nil))))) 643 deactivate-mark nil)))))
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index 0790bee55ae..58027f2b478 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -1,7 +1,7 @@
1;;; remember --- a mode for quickly jotting down things to remember 1;;; remember --- a mode for quickly jotting down things to remember
2 2
3;; Copyright (C) 1999, 2000, 2001, 2003, 2004, 2005, 2006, 3;; Copyright (C) 1999, 2000, 2001, 2003, 2004, 2005, 2006, 2007,
4;; 2007 Free Software Foundation, Inc. 4;; 2008 Free Software Foundation, Inc.
5 5
6;; Author: John Wiegley <johnw@gnu.org> 6;; Author: John Wiegley <johnw@gnu.org>
7;; Created: 29 Mar 1999 7;; Created: 29 Mar 1999
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 40e0e85194b..7897fbaa9df 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -157,7 +157,7 @@ This takes effect when first loading the `sgml-mode' library.")
157 "Syntax table used in SGML mode. See also `sgml-specials'.") 157 "Syntax table used in SGML mode. See also `sgml-specials'.")
158 158
159(defconst sgml-tag-syntax-table 159(defconst sgml-tag-syntax-table
160 (let ((table (sgml-make-syntax-table '(?- ?\" ?\')))) 160 (let ((table (sgml-make-syntax-table sgml-specials)))
161 (dolist (char '(?\( ?\) ?\{ ?\} ?\[ ?\] ?$ ?% ?& ?* ?+ ?/)) 161 (dolist (char '(?\( ?\) ?\{ ?\} ?\[ ?\] ?$ ?% ?& ?* ?+ ?/))
162 (modify-syntax-entry char "." table)) 162 (modify-syntax-entry char "." table))
163 table) 163 table)
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 3890daabf46..3a70b5343a0 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,16 @@
12008-01-29 John Wiegley <johnw@newartisans.com>
2
3 * url-auth.el (url-digest-auth): If the 'opaque' argument is not
4 being used, don't add it to the response text. Also, changed an
5 if so that the interaction between the PROMPT and OVERWRITE
6 arguments can no longer result in the user being queried twice for
7 the same login and password information.
8
92008-01-21 Stefan Monnier <monnier@iro.umontreal.ca>
10
11 * url-handlers.el (unhandled-file-name-directory): Add handler.
12 (url-handler-unhandled-file-name-directory): New fun.
13
12008-01-07 Michael Albinus <michael.albinus@gmx.de> 142008-01-07 Michael Albinus <michael.albinus@gmx.de>
2 15
3 * url-handlers.el (url-file-handler): Autoload. 16 * url-handlers.el (url-file-handler): Autoload.
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index ea96bb08129..ed1a79260ee 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -188,31 +188,40 @@ instead of hostname:portnum."
188 (string= data (substring file 0 (length data))))) 188 (string= data (substring file 0 (length data)))))
189 (setq retval (cdr (car byserv)))) 189 (setq retval (cdr (car byserv))))
190 (setq byserv (cdr byserv)))) 190 (setq byserv (cdr byserv))))
191 (if (or (and (not retval) prompt) overwrite) 191 (if overwrite
192 (progn 192 (if (and (not retval) prompt)
193 (setq user (read-string (url-auth-user-prompt url realm) 193 (setq user (read-string (url-auth-user-prompt url realm)
194 (user-real-login-name)) 194 (user-real-login-name))
195 pass (read-passwd "Password: ") 195 pass (read-passwd "Password: ")
196 retval (setq retval 196 retval (setq retval
197 (cons user 197 (cons user
198 (url-digest-auth-create-key 198 (url-digest-auth-create-key
199 user pass realm 199 user pass realm
200 (or url-request-method "GET") 200 (or url-request-method "GET")
201 url))) 201 url)))
202 byserv (assoc server url-digest-auth-storage)) 202 byserv (assoc server url-digest-auth-storage))
203 (setcdr byserv 203 (setcdr byserv
204 (cons (cons file retval) (cdr byserv)))))) 204 (cons (cons file retval) (cdr byserv))))))
205 (t (setq retval nil))) 205 (t (setq retval nil)))
206 (if retval 206 (if retval
207 (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven")) 207 (if (cdr-safe (assoc "opaque" args))
208 (opaque (or (cdr-safe (assoc "opaque" args)) "nonegiven"))) 208 (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven"))
209 (format 209 (opaque (cdr-safe (assoc "opaque" args))))
210 (concat "Digest username=\"%s\", realm=\"%s\"," 210 (format
211 "nonce=\"%s\", uri=\"%s\"," 211 (concat "Digest username=\"%s\", realm=\"%s\","
212 "response=\"%s\", opaque=\"%s\"") 212 "nonce=\"%s\", uri=\"%s\","
213 (nth 0 retval) realm nonce (url-filename href) 213 "response=\"%s\", opaque=\"%s\"")
214 (md5 (concat (nth 1 retval) ":" nonce ":" 214 (nth 0 retval) realm nonce (url-filename href)
215 (nth 2 retval))) opaque)))))) 215 (md5 (concat (nth 1 retval) ":" nonce ":"
216 (nth 2 retval))) opaque))
217 (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven")))
218 (format
219 (concat "Digest username=\"%s\", realm=\"%s\","
220 "nonce=\"%s\", uri=\"%s\","
221 "response=\"%s\"")
222 (nth 0 retval) realm nonce (url-filename href)
223 (md5 (concat (nth 1 retval) ":" nonce ":"
224 (nth 2 retval))))))))))
216 225
217(defvar url-registered-auth-schemes nil 226(defvar url-registered-auth-schemes nil
218 "A list of the registered authorization schemes and various and sundry 227 "A list of the registered authorization schemes and various and sundry
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 869132df93f..acc85b939a1 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -150,6 +150,7 @@ the arguments that would have been passed to OPERATION."
150(put 'file-name-absolute-p 'url-file-handlers (lambda (&rest ignored) t)) 150(put 'file-name-absolute-p 'url-file-handlers (lambda (&rest ignored) t))
151(put 'expand-file-name 'url-file-handlers 'url-handler-expand-file-name) 151(put 'expand-file-name 'url-file-handlers 'url-handler-expand-file-name)
152(put 'directory-file-name 'url-file-handlers 'url-handler-directory-file-name) 152(put 'directory-file-name 'url-file-handlers 'url-handler-directory-file-name)
153(put 'unhandled-file-name-directory 'url-file-handlers 'url-handler-unhandled-file-name-directory)
153;; (put 'file-name-as-directory 'url-file-handlers 'url-handler-file-name-as-directory) 154;; (put 'file-name-as-directory 'url-file-handlers 'url-handler-file-name-as-directory)
154 155
155;; These are operations that we do not support yet (DAV!!!) 156;; These are operations that we do not support yet (DAV!!!)
@@ -181,6 +182,13 @@ the arguments that would have been passed to OPERATION."
181 (if (string-match "//\\'" dir) dir 182 (if (string-match "//\\'" dir) dir
182 (url-run-real-handler 'directory-file-name (list dir)))) 183 (url-run-real-handler 'directory-file-name (list dir))))
183 184
185(defun url-handler-unhandled-file-name-directory (filename)
186 ;; Copied from tramp.el. This is used as the cwd for subprocesses:
187 ;; without it running call-process or start-process in a URL directory
188 ;; signals an error.
189 ;; FIXME: we can do better if `filename' is a "file://" URL.
190 (expand-file-name "~/"))
191
184;; The actual implementation 192;; The actual implementation
185;;;###autoload 193;;;###autoload
186(defun url-copy-file (url newname &optional ok-if-already-exists keep-time) 194(defun url-copy-file (url newname &optional ok-if-already-exists keep-time)
diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el
index f47ff9a37c3..7d09150d52c 100644
--- a/lisp/url/url-parse.el
+++ b/lisp/url/url-parse.el
@@ -77,9 +77,9 @@
77 77
78;;;###autoload 78;;;###autoload
79(defun url-generic-parse-url (url) 79(defun url-generic-parse-url (url)
80 "Return a vector of the parts of URL. 80 "Return an URL-struct of the parts of URL.
81Format is: 81The CL-style struct contains the following fields:
82\[TYPE USER PASSWORD HOST PORT FILE TARGET ATTRIBUTES FULL\]" 82TYPE USER PASSWORD HOST PORTSPEC FILENAME TARGET ATTRIBUTES FULLNESS."
83 ;; See RFC 3986. 83 ;; See RFC 3986.
84 (cond 84 (cond
85 ((null url) 85 ((null url)
diff --git a/lisp/vc-arch.el b/lisp/vc-arch.el
index 284fe032a25..58a3bd0183d 100644
--- a/lisp/vc-arch.el
+++ b/lisp/vc-arch.el
@@ -347,9 +347,11 @@ Return non-nil if FILE is unchanged."
347 (save-excursion 347 (save-excursion
348 (let ((rej (concat buffer-file-name ".rej"))) 348 (let ((rej (concat buffer-file-name ".rej")))
349 (when (and buffer-file-name (vc-arch-diff3-rej-p rej)) 349 (when (and buffer-file-name (vc-arch-diff3-rej-p rej))
350 (if (not (re-search-forward "^<<<<<<< " nil t)) 350 (unless (re-search-forward "^<<<<<<< " nil t)
351 ;; The .rej file is obsolete. 351 ;; The .rej file is obsolete.
352 (condition-case nil (delete-file rej) (error nil))))))) 352 (condition-case nil (delete-file rej) (error nil))
353 ;; Remove the hook so that it is not called multiple times.
354 (remove-hook 'after-save-hook 'vc-arch-delete-rej-if-obsolete t))))))
353 355
354(defun vc-arch-find-file-hook () 356(defun vc-arch-find-file-hook ()
355 (let ((rej (concat buffer-file-name ".rej"))) 357 (let ((rej (concat buffer-file-name ".rej")))
diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el
index d84c2839573..cc4cd47cfe7 100644
--- a/lisp/vc-cvs.el
+++ b/lisp/vc-cvs.el
@@ -453,7 +453,7 @@ The changes are between FIRST-REVISION and SECOND-REVISION."
453 (message "Merging changes into %s..." file) 453 (message "Merging changes into %s..." file)
454 ;; (vc-file-setprop file 'vc-working-revision nil) 454 ;; (vc-file-setprop file 'vc-working-revision nil)
455 (vc-file-setprop file 'vc-checkout-time 0) 455 (vc-file-setprop file 'vc-checkout-time 0)
456 (vc-cvs-command nil 0 file "update") 456 (vc-cvs-command nil nil file "update")
457 ;; Analyze the merge result reported by CVS, and set 457 ;; Analyze the merge result reported by CVS, and set
458 ;; file properties accordingly. 458 ;; file properties accordingly.
459 (with-current-buffer (get-buffer "*vc*") 459 (with-current-buffer (get-buffer "*vc*")
diff --git a/lisp/vc-hg.el b/lisp/vc-hg.el
index 597c49aaa3f..4bcffebd3cb 100644
--- a/lisp/vc-hg.el
+++ b/lisp/vc-hg.el
@@ -149,7 +149,7 @@
149 (when (vc-hg-root file) ; short cut 149 (when (vc-hg-root file) ; short cut
150 (let ((state (vc-hg-state file))) ; expensive 150 (let ((state (vc-hg-state file))) ; expensive
151 (vc-file-setprop file 'vc-state state) 151 (vc-file-setprop file 'vc-state state)
152 (not (memq state '(ignored unregistered)))))) 152 (and state (not (memq state '(ignored unregistered)))))))
153 153
154(defun vc-hg-state (file) 154(defun vc-hg-state (file)
155 "Hg-specific version of `vc-state'." 155 "Hg-specific version of `vc-state'."
@@ -316,8 +316,7 @@
316 (if oldvers 316 (if oldvers
317 (if newvers 317 (if newvers
318 (list "-r" oldvers "-r" newvers) 318 (list "-r" oldvers "-r" newvers)
319 (list "-r" oldvers)) 319 (list "-r" oldvers)))))))
320 (list ""))))))
321 320
322(defun vc-hg-revision-table (files) 321(defun vc-hg-revision-table (files)
323 (let ((default-directory (file-name-directory (car files)))) 322 (let ((default-directory (file-name-directory (car files))))
@@ -480,35 +479,41 @@ REV is the revision to check out into WORKFILE."
480 479
481(define-derived-mode vc-hg-incoming-mode vc-hg-log-view-mode "Hg-Incoming") 480(define-derived-mode vc-hg-incoming-mode vc-hg-log-view-mode "Hg-Incoming")
482 481
483
484;; XXX Experimental function for the vc-dired replacement. 482;; XXX Experimental function for the vc-dired replacement.
485(defun vc-hg-dir-status (dir) 483(defun vc-hg-after-dir-status (update-function buff)
486 "Return a list of conses (file . state) for DIR." 484 (let ((status-char nil)
487 (with-temp-buffer 485 (file nil)
488 (vc-hg-command (current-buffer) nil dir "status" "-A") 486 (translation '((?= . up-to-date)
489 (goto-char (point-min)) 487 (?C . up-to-date)
490 (let ((status-char nil) 488 (?A . added)
491 (file nil) 489 (?R . removed)
492 (translation '((?= . up-to-date) 490 (?M . edited)
493 (?C . up-to-date) 491 (?I . ignored)
494 (?A . added) 492 (?! . deleted)
495 (?R . removed) 493 (?? . unregistered)))
496 (?M . edited) 494 (translated nil)
497 (?I . ignored)
498 (?! . deleted)
499 (?? . unregistered)))
500 (translated nil)
501 (result nil)) 495 (result nil))
496 (goto-char (point-min))
502 (while (not (eobp)) 497 (while (not (eobp))
503 (setq status-char (char-after)) 498 (setq status-char (char-after))
504 (setq file 499 (setq file
505 (buffer-substring-no-properties (+ (point) 2) 500 (buffer-substring-no-properties (+ (point) 2)
506 (line-end-position))) 501 (line-end-position)))
507 (setq translated (assoc status-char translation)) 502 (setq translated (assoc status-char translation))
508 (when (and translated (not (eq (cdr translated) 'up-to-date))) 503 (when (and translated (not (eq (cdr translated) 'up-to-date)))
509 (push (cons file (cdr translated)) result)) 504 (push (cons file (cdr translated)) result))
510 (forward-line)) 505 (forward-line))
511 result))) 506 (funcall update-function result buff)))
507
508;; XXX Experimental function for the vc-dired replacement.
509(defun vc-hg-dir-status (dir update-function status-buffer)
510 "Return a list of conses (file . state) for DIR."
511 (with-current-buffer
512 (get-buffer-create
513 (expand-file-name " *VC-hg* tmp status" dir))
514 (vc-hg-command (current-buffer) 'async dir "status")
515 (vc-exec-after
516 `(vc-hg-after-dir-status (quote ,update-function) ,status-buffer))))
512 517
513;; XXX this adds another top level menu, instead figure out how to 518;; XXX this adds another top level menu, instead figure out how to
514;; replace the Log-View menu. 519;; replace the Log-View menu.
diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el
index f50d5ab5dee..868680375cb 100644
--- a/lisp/vc-svn.el
+++ b/lisp/vc-svn.el
@@ -132,7 +132,8 @@ If you want to force an empty list of arguments, use t."
132 ;; an `error' by vc-do-command. 132 ;; an `error' by vc-do-command.
133 (error nil)))) 133 (error nil))))
134 (when (eq 0 status) 134 (when (eq 0 status)
135 (vc-svn-parse-status file)))))) 135 (let ((parsed (vc-svn-parse-status file)))
136 (and parsed (not (memq parsed '(ignored unregistered))))))))))
136 137
137(defun vc-svn-state (file &optional localp) 138(defun vc-svn-state (file &optional localp)
138 "SVN-specific version of `vc-state'." 139 "SVN-specific version of `vc-state'."
@@ -157,6 +158,35 @@ If you want to force an empty list of arguments, use t."
157 (vc-svn-command t 0 nil "status" (if localp "-v" "-u")) 158 (vc-svn-command t 0 nil "status" (if localp "-v" "-u"))
158 (vc-svn-parse-status)))) 159 (vc-svn-parse-status))))
159 160
161(defun vc-svn-after-dir-status (callback buffer)
162 (let ((state-map '((?A . added)
163 (?C . edited)
164 (?D . removed)
165 (?I . ignored)
166 (?M . edited)
167 (?R . removed)
168 (?? . unregistered)
169 ;; This is what vc-svn-parse-status does.
170 (?~ . edited)))
171 result)
172 (goto-char (point-min))
173 (while (re-search-forward "^\\(.\\)..... \\(.*\\)$" nil t)
174 (let ((state (cdr (assq (aref (match-string 1) 0) state-map)))
175 (filename (match-string 2)))
176 (when state
177 (setq result (cons (cons filename state) result)))))
178 (funcall callback result buffer)))
179
180(defun vc-svn-dir-status (dir callback buffer)
181 "Run 'svn status' for DIR and update BUFFER via CALLBACK.
182CALLBACK is called as (CALLBACK RESULT BUFFER), where
183RESULT is a list of conses (FILE . STATE) for directory DIR."
184 (with-current-buffer (get-buffer-create
185 (generate-new-buffer-name " *vc svn status*"))
186 (vc-svn-command (current-buffer) 'async nil "status")
187 (vc-exec-after
188 `(vc-svn-after-dir-status (quote ,callback) ,buffer))))
189
160(defun vc-svn-working-revision (file) 190(defun vc-svn-working-revision (file)
161 "SVN-specific version of `vc-working-revision'." 191 "SVN-specific version of `vc-working-revision'."
162 ;; There is no need to consult RCS headers under SVN, because we 192 ;; There is no need to consult RCS headers under SVN, because we
@@ -537,8 +567,10 @@ and that it passes `vc-svn-global-switches' to it before FLAGS."
537 "Call \"svn resolved\" if the conflict markers have been removed." 567 "Call \"svn resolved\" if the conflict markers have been removed."
538 (save-excursion 568 (save-excursion
539 (goto-char (point-min)) 569 (goto-char (point-min))
540 (if (not (re-search-forward "^<<<<<<< " nil t)) 570 (unless (re-search-forward "^<<<<<<< " nil t)
541 (vc-svn-command nil 0 buffer-file-name "resolved")))) 571 (vc-svn-command nil 0 buffer-file-name "resolved")
572 ;; Remove the hook so that it is not called multiple times.
573 (remove-hook 'after-save-hook 'vc-svn-resolve-when-done t))))
542 574
543;; Inspired by vc-arch-find-file-hook. 575;; Inspired by vc-arch-find-file-hook.
544(defun vc-svn-find-file-hook () 576(defun vc-svn-find-file-hook ()
@@ -550,7 +582,7 @@ and that it passes `vc-svn-global-switches' to it before FLAGS."
550 (re-search-forward "^<<<<<<< " nil t)) 582 (re-search-forward "^<<<<<<< " nil t))
551 ;; There are conflict markers. 583 ;; There are conflict markers.
552 (progn 584 (progn
553 (smerge-mode 1) 585 (smerge-start-session)
554 (add-hook 'after-save-hook 'vc-svn-resolve-when-done nil t)) 586 (add-hook 'after-save-hook 'vc-svn-resolve-when-done nil t))
555 ;; There are no conflict markers. This is problematic: maybe it means 587 ;; There are no conflict markers. This is problematic: maybe it means
556 ;; the conflict has been resolved and we should immediately call "svn 588 ;; the conflict has been resolved and we should immediately call "svn
diff --git a/lisp/vc.el b/lisp/vc.el
index 61a2c67d9d4..102eeef0fbf 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -1,14 +1,13 @@
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, 2000, 3;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000,
4;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. 4;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
5;; Free Software Foundation, Inc.
5 6
6;; Author: FSF (see below for full credits) 7;; Author: FSF (see below for full credits)
7;; Maintainer: Andre Spiegel <spiegel@gnu.org> 8;; Maintainer: Andre Spiegel <spiegel@gnu.org>
8;; Keywords: tools 9;; Keywords: tools
9 10
10;; $Id$
11
12;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
13 12
14;; GNU Emacs is free software; you can redistribute it and/or modify 13;; GNU Emacs is free software; you can redistribute it and/or modify
@@ -522,6 +521,55 @@
522;; to your backend and which does not map to any of the VC generic 521;; to your backend and which does not map to any of the VC generic
523;; concepts. 522;; concepts.
524 523
524;;; Todo:
525
526;; - Make vc-checkin avoid reverting the buffer if has not changed
527;; after the checkin. Comparing (md5 BUFFER) to (md5 FILE) should
528;; be enough.
529;;
530;; - vc-update/vc-merge should deal with VC systems that don't
531;; update/merge on a file basis, but on a whole repository basis.
532;;
533;; - the backend sometimes knows when a file it opens has been marked
534;; by the VCS as having a "conflict". Find a way to pass this info -
535;; to VC so that it can turn on smerge-mode when opening such a
536;; file.
537;;
538;; - the *VC-log* buffer needs font-locking.
539;;
540;; - make it easier to write logs, maybe C-x 4 a should add to the log
541;; buffer if there's one instead of the ChangeLog.
542;;
543;; - make vc-state for all backends return 'unregistered instead of
544;; nil for unregistered files, then update vc-next-action.
545;;
546;; - add a generic mechanism for remembering the current branch names,
547;; display the branch name in the mode-line. Replace
548;; vc-cvs-sticky-tag with that.
549;;
550;; - vc-register should register a fileset at a time. The backends
551;; already support this, only the front-end needs to be change to
552;; handle multiple files at a time.
553;;
554;; - add a mechanism to for ignoring files.
555;;
556;; - deal with push/pull operations.
557;;
558;; - decide if vc-status should replace vc-dired.
559;;
560;; - vc-status needs a menu, mouse bindings and some color bling.
561;;
562;; - vc-status needs to show missing files. It probably needs to have
563;; another state for those files. The user might want to restore
564;; them, or remove them from the VCS. C-x v v might also need
565;; adjustments.
566;;
567;; - "snapshots" should be renamed to "branches", and thoroughly reworked.
568;;
569;; - do not default to RCS anymore when the current directory is not
570;; controlled by any VCS and the user does C-x v v
571;;
572
525;;; Code: 573;;; Code:
526 574
527(require 'vc-hooks) 575(require 'vc-hooks)
@@ -907,13 +955,15 @@ However, before executing BODY, find FILE, and after BODY, save buffer."
907 "An alternative output filter for async process P. 955 "An alternative output filter for async process P.
908One difference with the default filter is that this inserts S after markers. 956One difference with the default filter is that this inserts S after markers.
909Another is that undo information is not kept." 957Another is that undo information is not kept."
910 (with-current-buffer (process-buffer p) 958 (let ((buffer (process-buffer p)))
911 (save-excursion 959 (when (buffer-live-p buffer)
912 (let ((buffer-undo-list t) 960 (with-current-buffer buffer
913 (inhibit-read-only t)) 961 (save-excursion
914 (goto-char (process-mark p)) 962 (let ((buffer-undo-list t)
915 (insert s) 963 (inhibit-read-only t))
916 (set-marker (process-mark p) (point)))))) 964 (goto-char (process-mark p))
965 (insert s)
966 (set-marker (process-mark p) (point))))))))
917 967
918(defun vc-setup-buffer (&optional buf) 968(defun vc-setup-buffer (&optional buf)
919 "Prepare BUF for executing a VC command and make it current. 969 "Prepare BUF for executing a VC command and make it current.
@@ -934,29 +984,39 @@ BUF defaults to \"*vc*\", can be a string and will be created if necessary."
934(defvar vc-sentinel-movepoint) ;Dynamically scoped. 984(defvar vc-sentinel-movepoint) ;Dynamically scoped.
935 985
936(defun vc-process-sentinel (p s) 986(defun vc-process-sentinel (p s)
937 (let ((previous (process-get p 'vc-previous-sentinel))) 987 (let ((previous (process-get p 'vc-previous-sentinel))
938 (if previous (funcall previous p s)) 988 (buf (process-buffer p)))
939 (with-current-buffer (process-buffer p) 989 ;; Impatient users sometime kill "slow" buffers; check liveness
940 (let (vc-sentinel-movepoint) 990 ;; to avoid "error in process sentinel: Selecting deleted buffer".
941 ;; Normally, we want async code such as sentinels to not move point. 991 (when (buffer-live-p buf)
942 (save-excursion 992 (if previous (funcall previous p s))
943 (goto-char (process-mark p)) 993 (with-current-buffer buf
944 (let ((cmds (process-get p 'vc-sentinel-commands))) 994 (setq mode-line-process
945 (process-put p 'vc-sentinel-commands nil) 995 (let ((status (process-status p)))
946 (dolist (cmd cmds) 996 ;; Leave mode-line uncluttered, normally.
947 ;; Each sentinel may move point and the next one should be run 997 ;; (Let known any weirdness in-form-ally. ;-) --ttn
948 ;; at that new point. We could get the same result by having 998 (unless (eq 'exit status)
949 ;; each sentinel read&set process-mark, but since `cmd' needs 999 (format " (%s)" status))))
950 ;; to work both for async and sync processes, this would be 1000 (let (vc-sentinel-movepoint)
951 ;; difficult to achieve. 1001 ;; Normally, we want async code such as sentinels to not move point.
952 (vc-exec-after cmd)))) 1002 (save-excursion
953 ;; But sometimes the sentinels really want to move point. 1003 (goto-char (process-mark p))
954 (if vc-sentinel-movepoint 1004 (let ((cmds (process-get p 'vc-sentinel-commands)))
955 (let ((win (get-buffer-window (current-buffer) 0))) 1005 (process-put p 'vc-sentinel-commands nil)
956 (if (not win) 1006 (dolist (cmd cmds)
957 (goto-char vc-sentinel-movepoint) 1007 ;; Each sentinel may move point and the next one should be run
958 (with-selected-window win 1008 ;; at that new point. We could get the same result by having
959 (goto-char vc-sentinel-movepoint))))))))) 1009 ;; each sentinel read&set process-mark, but since `cmd' needs
1010 ;; to work both for async and sync processes, this would be
1011 ;; difficult to achieve.
1012 (vc-exec-after cmd))))
1013 ;; But sometimes the sentinels really want to move point.
1014 (if vc-sentinel-movepoint
1015 (let ((win (get-buffer-window (current-buffer) 0)))
1016 (if (not win)
1017 (goto-char vc-sentinel-movepoint)
1018 (with-selected-window win
1019 (goto-char vc-sentinel-movepoint))))))))))
960 1020
961(defun vc-exec-after (code) 1021(defun vc-exec-after (code)
962 "Eval CODE when the current buffer's process is done. 1022 "Eval CODE when the current buffer's process is done.
@@ -975,6 +1035,17 @@ Else, add CODE to the process' sentinel."
975 (eval code)) 1035 (eval code))
976 ;; If a process is running, add CODE to the sentinel 1036 ;; If a process is running, add CODE to the sentinel
977 ((eq (process-status proc) 'run) 1037 ((eq (process-status proc) 'run)
1038 (setq mode-line-process
1039 ;; Deliberate overstatement, but power law respected.
1040 ;; (The message is ephemeral, so we make it loud.) --ttn
1041 (propertize " (incomplete/in progress)"
1042 'face (if (featurep 'compile)
1043 ;; ttn's preferred loudness
1044 'compilation-warning
1045 ;; suitably available fallback
1046 font-lock-warning-face)
1047 'help-echo
1048 "A VC command is in progress in this buffer"))
978 (let ((previous (process-sentinel proc))) 1049 (let ((previous (process-sentinel proc)))
979 (unless (eq previous 'vc-process-sentinel) 1050 (unless (eq previous 'vc-process-sentinel)
980 (process-put proc 'vc-previous-sentinel previous)) 1051 (process-put proc 'vc-previous-sentinel previous))
@@ -1276,9 +1347,12 @@ Otherwise, throw an error."
1276 (unless (eq (vc-backend f) firstbackend) 1347 (unless (eq (vc-backend f) firstbackend)
1277 (error "All members of a fileset must be under the same version-control system.")))) 1348 (error "All members of a fileset must be under the same version-control system."))))
1278 marked)) 1349 marked))
1279 ((eq major-mode 'vc-status-mode) 1350 ((eq major-mode 'vc-status-mode)
1280 (vc-status-marked-files)) 1351 (let ((marked (vc-status-marked-files)))
1281 ((vc-backend buffer-file-name) 1352 (if marked
1353 marked
1354 (list (vc-status-current-file)))))
1355 ((vc-backend buffer-file-name)
1282 (list buffer-file-name)) 1356 (list buffer-file-name))
1283 ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer) 1357 ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer)
1284 (with-current-buffer vc-parent-buffer 1358 (with-current-buffer vc-parent-buffer
@@ -1307,8 +1381,12 @@ Otherwise, throw an error."
1307 1381
1308(defun vc-ensure-vc-buffer () 1382(defun vc-ensure-vc-buffer ()
1309 "Make sure that the current buffer visits a version-controlled file." 1383 "Make sure that the current buffer visits a version-controlled file."
1310 (if vc-dired-mode 1384 (cond
1311 (set-buffer (find-file-noselect (dired-get-filename))) 1385 (vc-dired-mode
1386 (set-buffer (find-file-noselect (dired-get-filename))))
1387 ((eq major-mode 'vc-status-mode)
1388 (set-buffer (find-file-noselect (vc-status-current-file))))
1389 (t
1312 (while (and vc-parent-buffer 1390 (while (and vc-parent-buffer
1313 (buffer-live-p vc-parent-buffer) 1391 (buffer-live-p vc-parent-buffer)
1314 ;; Avoid infinite looping when vc-parent-buffer and 1392 ;; Avoid infinite looping when vc-parent-buffer and
@@ -1318,7 +1396,7 @@ Otherwise, throw an error."
1318 (if (not buffer-file-name) 1396 (if (not buffer-file-name)
1319 (error "Buffer %s is not associated with a file" (buffer-name)) 1397 (error "Buffer %s is not associated with a file" (buffer-name))
1320 (if (not (vc-backend buffer-file-name)) 1398 (if (not (vc-backend buffer-file-name))
1321 (error "File %s is not under version control" buffer-file-name))))) 1399 (error "File %s is not under version control" buffer-file-name))))))
1322 1400
1323;;; Support for the C-x v v command. This is where all the single-file-oriented 1401;;; Support for the C-x v v command. This is where all the single-file-oriented
1324;;; code from before the fileset rewrite lives. 1402;;; code from before the fileset rewrite lives.
@@ -1404,9 +1482,9 @@ merge in the changes into your working copy."
1404 revision) 1482 revision)
1405 ;; Verify that the fileset is homogenous 1483 ;; Verify that the fileset is homogenous
1406 (dolist (file (cdr files)) 1484 (dolist (file (cdr files))
1407 (if (not (vc-compatible-state (vc-state file) state)) 1485 (unless (vc-compatible-state (vc-state file) state)
1408 (error "Fileset is in a mixed-up state")) 1486 (error "Fileset is in a mixed-up state"))
1409 (if (not (eq (vc-checkout-model file) model)) 1487 (unless (eq (vc-checkout-model file) model)
1410 (error "Fileset has mixed checkout models"))) 1488 (error "Fileset has mixed checkout models")))
1411 ;; Check for buffers in the fileset not matching the on-disk contents. 1489 ;; Check for buffers in the fileset not matching the on-disk contents.
1412 (dolist (file files) 1490 (dolist (file files)
@@ -1428,13 +1506,15 @@ merge in the changes into your working copy."
1428 (error "Aborted")) 1506 (error "Aborted"))
1429 ;; Now, check if we have unsaved changes. 1507 ;; Now, check if we have unsaved changes.
1430 (vc-buffer-sync t) 1508 (vc-buffer-sync t)
1431 (if (buffer-modified-p) 1509 (when (buffer-modified-p)
1432 (or (y-or-n-p (message "Use %s on disk, keeping modified buffer? " file)) 1510 (or (y-or-n-p (message "Use %s on disk, keeping modified buffer? " file))
1433 (error "Aborted"))))))) 1511 (error "Aborted")))))))
1434 ;; Do the right thing 1512 ;; Do the right thing
1435 (cond 1513 (cond
1436 ;; Files aren't registered 1514 ;; Files aren't registered
1437 ((not state) 1515 ((or (not state) ;; RCS uses nil for unregistered files.
1516 (eq state 'unregistered)
1517 (eq state 'ignored))
1438 (mapc 'vc-register files)) 1518 (mapc 'vc-register files))
1439 ;; Files are up-to-date, or need a merge and user specified a revision 1519 ;; Files are up-to-date, or need a merge and user specified a revision
1440 ((or (eq state 'up-to-date) (and verbose (eq state 'needs-patch))) 1520 ((or (eq state 'up-to-date) (and verbose (eq state 'needs-patch)))
@@ -1458,32 +1538,30 @@ merge in the changes into your working copy."
1458 (let ((ready-for-commit files)) 1538 (let ((ready-for-commit files))
1459 ;; If files are edited but read-only, give user a chance to correct 1539 ;; If files are edited but read-only, give user a chance to correct
1460 (dolist (file files) 1540 (dolist (file files)
1461 (if (not (file-writable-p file)) 1541 (unless (file-writable-p file)
1462 (progn 1542 ;; Make the file+buffer read-write.
1463 ;; Make the file+buffer read-write. 1543 (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file))
1464 (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file)) 1544 (error "Aborted"))
1465 (error "Aborted")) 1545 (set-file-modes file (logior (file-modes file) 128))
1466 (set-file-modes file (logior (file-modes file) 128)) 1546 (let ((visited (get-file-buffer file)))
1467 (let ((visited (get-file-buffer file))) 1547 (when visited
1468 (if visited 1548 (with-current-buffer visited
1469 (with-current-buffer visited 1549 (toggle-read-only -1))))))
1470 (toggle-read-only -1)))))))
1471 ;; Allow user to revert files with no changes 1550 ;; Allow user to revert files with no changes
1472 (save-excursion 1551 (save-excursion
1473 (dolist (file files) 1552 (dolist (file files)
1474 (let ((visited (get-file-buffer file))) 1553 (let ((visited (get-file-buffer file)))
1475 ;; For files with locking, if the file does not contain 1554 ;; For files with locking, if the file does not contain
1476 ;; any changes, just let go of the lock, i.e. revert. 1555 ;; any changes, just let go of the lock, i.e. revert.
1477 (if (and (not (eq model 'implicit)) 1556 (when (and (not (eq model 'implicit))
1478 (vc-workfile-unchanged-p file) 1557 (vc-workfile-unchanged-p file)
1479 ;; If buffer is modified, that means the user just 1558 ;; If buffer is modified, that means the user just
1480 ;; said no to saving it; in that case, don't revert, 1559 ;; said no to saving it; in that case, don't revert,
1481 ;; because the user might intend to save after 1560 ;; because the user might intend to save after
1482 ;; finishing the log entry and committing. 1561 ;; finishing the log entry and committing.
1483 (not (and visited (buffer-modified-p)))) 1562 (not (and visited (buffer-modified-p))))
1484 (progn 1563 (vc-revert-file file)
1485 (vc-revert-file file) 1564 (delete file ready-for-commit)))))
1486 (delete file ready-for-commit))))))
1487 ;; Remaining files need to be committed 1565 ;; Remaining files need to be committed
1488 (if (not ready-for-commit) 1566 (if (not ready-for-commit)
1489 (message "No files remain to be committed") 1567 (message "No files remain to be committed")
@@ -1493,15 +1571,28 @@ merge in the changes into your working copy."
1493 (setq revision (read-string "New revision or backend: ")) 1571 (setq revision (read-string "New revision or backend: "))
1494 (let ((vsym (intern (upcase revision)))) 1572 (let ((vsym (intern (upcase revision))))
1495 (if (member vsym vc-handled-backends) 1573 (if (member vsym vc-handled-backends)
1496 (vc-transfer-file file vsym) 1574 (dolist (file files) (vc-transfer-file file vsym))
1497 (vc-checkin ready-for-commit revision)))))))) 1575 (vc-checkin ready-for-commit revision))))))))
1498 ;; locked by somebody else (locking VCSes only) 1576 ;; locked by somebody else (locking VCSes only)
1499 ((stringp state) 1577 ((stringp state)
1500 (let ((revision 1578 ;; In the old days, we computed the revision once and used it on
1501 (if verbose 1579 ;; the single file. Then, for the 2007-2008 fileset rewrite, we
1502 (read-string "Revision to steal: ") 1580 ;; computed the revision once (incorrectly, using a free var) and
1503 (vc-working-revision file)))) 1581 ;; used it on all files. To fix the free var bug, we can either
1504 (dolist (file files) (vc-steal-lock file revision state)))) 1582 ;; use `(car files)' or do what we do here: distribute the
1583 ;; revision computation among `files'. Although this may be
1584 ;; tedious for those backends where a "revision" is a trans-file
1585 ;; concept, it is nonetheless correct for both those and (more
1586 ;; importantly) for those where "revision" is a per-file concept.
1587 ;; If the intersection of the former group and "locking VCSes" is
1588 ;; non-empty [I vaguely doubt it --ttn], we can reinstate the
1589 ;; pre-computation approach of yore.
1590 (dolist (file files)
1591 (vc-steal-lock
1592 file (if verbose
1593 (read-string (format "%s revision to steal: " file))
1594 (vc-working-revision file))
1595 state)))
1505 ;; needs-patch 1596 ;; needs-patch
1506 ((eq state 'needs-patch) 1597 ((eq state 'needs-patch)
1507 (dolist (file files) 1598 (dolist (file files)
@@ -1509,16 +1600,16 @@ merge in the changes into your working copy."
1509 "%s is not up-to-date. Get latest revision? " 1600 "%s is not up-to-date. Get latest revision? "
1510 (file-name-nondirectory file))) 1601 (file-name-nondirectory file)))
1511 (vc-checkout file (eq model 'implicit) t) 1602 (vc-checkout file (eq model 'implicit) t)
1512 (if (and (not (eq model 'implicit)) 1603 (when (and (not (eq model 'implicit))
1513 (yes-or-no-p "Lock this revision? ")) 1604 (yes-or-no-p "Lock this revision? "))
1514 (vc-checkout file t))))) 1605 (vc-checkout file t)))))
1515 ;; needs-merge 1606 ;; needs-merge
1516 ((eq state 'needs-merge) 1607 ((eq state 'needs-merge)
1517 (dolist (file files) 1608 (dolist (file files)
1518 (if (yes-or-no-p (format 1609 (when (yes-or-no-p (format
1519 "%s is not up-to-date. Merge in changes now? " 1610 "%s is not up-to-date. Merge in changes now? "
1520 (file-name-nondirectory file))) 1611 (file-name-nondirectory file)))
1521 (vc-maybe-resolve-conflicts file (vc-call merge-news file))))) 1612 (vc-maybe-resolve-conflicts file (vc-call merge-news file)))))
1522 1613
1523 ;; unlocked-changes 1614 ;; unlocked-changes
1524 ((eq state 'unlocked-changes) 1615 ((eq state 'unlocked-changes)
@@ -1667,7 +1758,7 @@ INITIAL-CONTENTS is nil, do action immediately as if the user had
1667entered COMMENT. If COMMENT is t, also do action immediately with an 1758entered COMMENT. If COMMENT is t, also do action immediately with an
1668empty comment. Remember the file's buffer in `vc-parent-buffer' 1759empty comment. Remember the file's buffer in `vc-parent-buffer'
1669\(current one if no file). AFTER-HOOK specifies the local value 1760\(current one if no file). AFTER-HOOK specifies the local value
1670for vc-log-operation-hook." 1761for `vc-log-after-operation-hook'."
1671 (let ((parent 1762 (let ((parent
1672 (if (eq major-mode 'vc-dired-mode) 1763 (if (eq major-mode 'vc-dired-mode)
1673 ;; If we are called from VC dired, the parent buffer is 1764 ;; If we are called from VC dired, the parent buffer is
@@ -1900,18 +1991,19 @@ the buffer contents as a comment."
1900(defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff)) 1991(defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff))
1901(make-obsolete 'vc-diff-switches-list 'vc-switches "22.1") 1992(make-obsolete 'vc-diff-switches-list 'vc-switches "22.1")
1902 1993
1903(defun vc-diff-sentinel (verbose rev1-name rev2-name) 1994(defun vc-diff-finish (buffer-name verbose)
1904 ;; The empty sync output case has already been handled, so the only 1995 ;; The empty sync output case has already been handled, so the only
1905 ;; possibility of an empty output is for an async process, in which case 1996 ;; possibility of an empty output is for an async process.
1906 ;; it's important to insert the "diffs end here" message in the buffer 1997 (when (buffer-live-p buffer-name)
1907 ;; since the user may miss a message in the echo area. 1998 (with-current-buffer (get-buffer buffer-name)
1908 (when verbose 1999 (and verbose
1909 (let ((inhibit-read-only t)) 2000 (zerop (buffer-size))
1910 (if (eq (buffer-size) 0) 2001 (let ((inhibit-read-only t))
1911 (insert "No differences found.\n") 2002 (insert "No differences found.\n")))
1912 (insert (format "\n\nDiffs between %s and %s end here." rev1-name rev2-name))))) 2003 (goto-char (point-min))
1913 (goto-char (point-min)) 2004 (let ((window (get-buffer-window (current-buffer) t)))
1914 (shrink-window-if-larger-than-buffer)) 2005 (when window
2006 (shrink-window-if-larger-than-buffer window))))))
1915 2007
1916(defvar vc-diff-added-files nil 2008(defvar vc-diff-added-files nil
1917 "If non-nil, diff added files by comparing them to /dev/null.") 2009 "If non-nil, diff added files by comparing them to /dev/null.")
@@ -1970,7 +2062,7 @@ returns t if the buffer had changes, nil otherwise."
1970 ;; bindings are nicer for read only buffers. pcl-cvs does the 2062 ;; bindings are nicer for read only buffers. pcl-cvs does the
1971 ;; same thing. 2063 ;; same thing.
1972 (setq buffer-read-only t) 2064 (setq buffer-read-only t)
1973 (vc-exec-after `(vc-diff-sentinel ,verbose ,rev1-name ,rev2-name)) 2065 (vc-exec-after `(vc-diff-finish ,(buffer-name) ,verbose))
1974 ;; Display the buffer, but at the end because it can change point. 2066 ;; Display the buffer, but at the end because it can change point.
1975 (pop-to-buffer (current-buffer)) 2067 (pop-to-buffer (current-buffer))
1976 ;; In the async case, we return t even if there are no differences 2068 ;; In the async case, we return t even if there are no differences
@@ -2486,8 +2578,6 @@ With prefix arg READ-SWITCHES, specify a value to override
2486 (interactive "DDired under VC (directory): \nP") 2578 (interactive "DDired under VC (directory): \nP")
2487 (let ((vc-dired-switches (concat vc-dired-listing-switches 2579 (let ((vc-dired-switches (concat vc-dired-listing-switches
2488 (if vc-dired-recurse "R" "")))) 2580 (if vc-dired-recurse "R" ""))))
2489 (if (eq (string-match tramp-file-name-regexp dir) 0)
2490 (error "Sorry, vc-directory does not work over Tramp"))
2491 (if read-switches 2581 (if read-switches
2492 (setq vc-dired-switches 2582 (setq vc-dired-switches
2493 (read-string "Dired listing switches: " 2583 (read-string "Dired listing switches: "
@@ -2512,19 +2602,27 @@ With prefix arg READ-SWITCHES, specify a value to override
2512 2602
2513(defvar vc-status nil) 2603(defvar vc-status nil)
2514 2604
2515(defun vc-status-insert-headers (backend dir) 2605(defun vc-status-headers (backend dir)
2516 (insert (format "VC backend :%s\n" backend)) 2606 (concat
2517 (insert "Repository : The repository goes here\n") 2607 (format "VC backend : %s\n" backend)
2518 (insert (format "Working dir: %s\n\n\n" dir))) 2608 "Repository : The repository goes here\n"
2609 (format "Working dir: %s\n" dir)))
2519 2610
2520(defun vc-status-printer (fileentry) 2611(defun vc-status-printer (fileentry)
2521 "Pretty print FILEENTRY." 2612 "Pretty print FILEENTRY."
2522 (insert 2613 (insert
2614 ;; If you change this, change vc-status-move-to-goal-column.
2523 (format "%c %-20s %s" 2615 (format "%c %-20s %s"
2524 (if (vc-status-fileinfo->marked fileentry) ?* ? ) 2616 (if (vc-status-fileinfo->marked fileentry) ?* ? )
2525 (vc-status-fileinfo->state fileentry) 2617 (vc-status-fileinfo->state fileentry)
2526 (vc-status-fileinfo->name fileentry)))) 2618 (vc-status-fileinfo->name fileentry))))
2527 2619
2620(defun vc-status-move-to-goal-column ()
2621 (beginning-of-line)
2622 ;; Must be in sync with vc-status-printer.
2623 (forward-char 25))
2624
2625;;;###autoload
2528(defun vc-status (dir) 2626(defun vc-status (dir)
2529 "Show the VC status for DIR." 2627 "Show the VC status for DIR."
2530 (interactive "DVC status for directory: ") 2628 (interactive "DVC status for directory: ")
@@ -2533,10 +2631,33 @@ With prefix arg READ-SWITCHES, specify a value to override
2533 (cd dir) 2631 (cd dir)
2534 (vc-status-mode)) 2632 (vc-status-mode))
2535 2633
2536(defvar vc-status-mode-map 2634(defvar vc-status-mode-map
2537 (let ((map (make-sparse-keymap))) 2635 (let ((map (make-keymap)))
2636 (suppress-keymap map)
2637 ;; Marking.
2538 (define-key map "m" 'vc-status-mark-file) 2638 (define-key map "m" 'vc-status-mark-file)
2639 (define-key map "M" 'vc-status-mark-all-files)
2539 (define-key map "u" 'vc-status-unmark-file) 2640 (define-key map "u" 'vc-status-unmark-file)
2641 (define-key map "\C-?" 'vc-status-unmark-file-up)
2642 (define-key map "\M-\C-?" 'vc-status-unmark-all-files)
2643 ;; Movement.
2644 (define-key map "n" 'vc-status-next-line)
2645 (define-key map " " 'vc-status-next-line)
2646 (define-key map "\t" 'vc-status-next-line)
2647 (define-key map "p" 'vc-status-previous-line)
2648 (define-key map [backtab] 'vc-status-previous-line)
2649 ;; VC commands.
2650 (define-key map "=" 'vc-diff)
2651 (define-key map "a" 'vc-status-register)
2652 ;; Can't be "g" (as in vc map), so "A" for "Annotate".
2653 (define-key map "A" 'vc-annotate)
2654 ;; vc-print-log uses the current buffer, not a file.
2655 ;; (define-key map "l" 'vc-status-print-log)
2656 ;; The remainder.
2657 (define-key map "f" 'vc-status-find-file)
2658 (define-key map "o" 'vc-status-find-file-other-window)
2659 (define-key map "q" 'bury-buffer)
2660 (define-key map "g" 'vc-status-refresh)
2540 map) 2661 map)
2541 "Keymap for VC status") 2662 "Keymap for VC status")
2542 2663
@@ -2552,38 +2673,128 @@ With prefix arg READ-SWITCHES, specify a value to override
2552 entries) 2673 entries)
2553 (erase-buffer) 2674 (erase-buffer)
2554 (set (make-local-variable 'vc-status) 2675 (set (make-local-variable 'vc-status)
2555 (ewoc-create #'vc-status-printer)) 2676 (ewoc-create #'vc-status-printer
2556 (vc-status-insert-headers backend default-directory) 2677 (vc-status-headers backend default-directory)))
2557 (setq entries (vc-call-backend backend 'dir-status default-directory)) 2678 (vc-status-refresh)))
2679
2680(put 'vc-status-mode 'mode-class 'special)
2681
2682(defun vc-update-vc-status-buffer (entries buffer)
2683 (with-current-buffer buffer
2558 (dolist (entry entries) 2684 (dolist (entry entries)
2559 (ewoc-enter-last 2685 (ewoc-enter-last vc-status
2560 vc-status (vc-status-create-fileinfo (cdr entry) (car entry)))))) 2686 (vc-status-create-fileinfo (cdr entry) (car entry))))
2687 (ewoc-goto-node vc-status (ewoc-nth vc-status 0))))
2688
2689(defun vc-status-refresh ()
2690 "Refresh the contents of the VC status buffer."
2691 (interactive)
2692 ;; This is not very efficient; ewoc could use a new function here.
2693 (ewoc-filter vc-status (lambda (node) nil))
2694 (let ((backend (vc-responsible-backend default-directory)))
2695 ;; Call the dir-status backend function. dir-status is supposed to
2696 ;; be asynchronous. It should compute the results and call the
2697 ;; function passed as a an arg to update the vc-status buffer with
2698 ;; the results.
2699 (vc-call-backend
2700 backend 'dir-status default-directory
2701 #'vc-update-vc-status-buffer (current-buffer))))
2702
2703(defun vc-status-next-line (arg)
2704 "Go to the next line.
2705If a prefix argument is given, move by that many lines."
2706 (interactive "p")
2707 (ewoc-goto-next vc-status arg)
2708 (vc-status-move-to-goal-column))
2709
2710(defun vc-status-previous-line (arg)
2711 "Go to the previous line.
2712If a prefix argument is given, move by that many lines."
2713 (interactive "p")
2714 (ewoc-goto-prev vc-status arg)
2715 (vc-status-move-to-goal-column))
2561 2716
2562(defun vc-status-mark-file () 2717(defun vc-status-mark-file ()
2563 "Mark the current file." 2718 "Mark the current file and move to the next line."
2564 (interactive) 2719 (interactive)
2565 (let* ((crt (ewoc-locate vc-status)) 2720 (let* ((crt (ewoc-locate vc-status))
2566 (file (ewoc-data crt))) 2721 (file (ewoc-data crt)))
2567 (setf (vc-status-fileinfo->marked file) t) 2722 (setf (vc-status-fileinfo->marked file) t)
2568 (ewoc-invalidate vc-status crt) 2723 (ewoc-invalidate vc-status crt)
2569 (ewoc-goto-next vc-status 1))) 2724 (vc-status-next-line 1)))
2725
2726(defun vc-status-mark-all-files ()
2727 "Mark all files."
2728 (interactive)
2729 (ewoc-map
2730 (lambda (file)
2731 (unless (vc-status-fileinfo->marked file)
2732 (setf (vc-status-fileinfo->marked file) t)
2733 t))
2734 vc-status))
2570 2735
2571(defun vc-status-unmark-file () 2736(defun vc-status-unmark-file ()
2572 "Mark the current file." 2737 "Unmark the current file and move to the next line."
2573 (interactive) 2738 (interactive)
2574 (let* ((crt (ewoc-locate vc-status)) 2739 (let* ((crt (ewoc-locate vc-status))
2575 (file (ewoc-data crt))) 2740 (file (ewoc-data crt)))
2576 (setf (vc-status-fileinfo->marked file) nil) 2741 (setf (vc-status-fileinfo->marked file) nil)
2577 (ewoc-invalidate vc-status crt) 2742 (ewoc-invalidate vc-status crt)
2578 (ewoc-goto-next vc-status 1))) 2743 (vc-status-next-line 1)))
2744
2745(defun vc-status-unmark-file-up ()
2746 "Move to the previous line and unmark the file."
2747 (interactive)
2748 ;; If we're on the first line, we won't move up, but we will still
2749 ;; remove the mark. This seems a bit odd but it is what buffer-menu
2750 ;; does.
2751 (let* ((prev (ewoc-goto-prev vc-status 1))
2752 (file (ewoc-data prev)))
2753 (setf (vc-status-fileinfo->marked file) nil)
2754 (ewoc-invalidate vc-status prev)
2755 (vc-status-move-to-goal-column)))
2756
2757(defun vc-status-unmark-all-files ()
2758 "Unmark all files."
2759 (interactive)
2760 (ewoc-map
2761 (lambda (file)
2762 (when (vc-status-fileinfo->marked file)
2763 (setf (vc-status-fileinfo->marked file) nil)
2764 t))
2765 vc-status))
2766
2767(defun vc-status-register ()
2768 "Register the marked files, or the current file if no marks."
2769 (interactive)
2770 (let ((files (or (vc-status-marked-files)
2771 (list (vc-status-current-file)))))
2772 (dolist (file files)
2773 (vc-register file))))
2774
2775(defun vc-status-find-file ()
2776 "Find the file on the current line."
2777 (interactive)
2778 (find-file (vc-status-current-file)))
2779
2780(defun vc-status-find-file-other-window ()
2781 "Find the file on the current line, in another window."
2782 (interactive)
2783 (find-file-other-window (vc-status-current-file)))
2784
2785(defun vc-status-current-file ()
2786 (let ((node (ewoc-locate vc-status)))
2787 (unless node
2788 (error "No file available."))
2789 (expand-file-name (vc-status-fileinfo->name (ewoc-data node)))))
2579 2790
2580(defun vc-status-marked-files () 2791(defun vc-status-marked-files ()
2581 "Return the list of marked files" 2792 "Return the list of marked files"
2582 (mapcar 2793 (mapcar
2583 (lambda (elem) 2794 (lambda (elem)
2584 (expand-file-name (vc-status-fileinfo->name elem))) 2795 (expand-file-name (vc-status-fileinfo->name elem)))
2585 (ewoc-collect 2796 (ewoc-collect
2586 vc-status 2797 vc-status
2587 (lambda (crt) (vc-status-fileinfo->marked crt))))) 2798 (lambda (crt) (vc-status-fileinfo->marked crt)))))
2588 2799
2589;;; End experimental code. 2800;;; End experimental code.
@@ -2782,8 +2993,7 @@ changes from the current branch are merged into the working file."
2782 (if (not (vc-find-backend-function (vc-backend file) 'merge-news)) 2993 (if (not (vc-find-backend-function (vc-backend file) 'merge-news))
2783 (error "Sorry, merging news is not implemented for %s" 2994 (error "Sorry, merging news is not implemented for %s"
2784 (vc-backend file)) 2995 (vc-backend file))
2785 (vc-call merge-news file) 2996 (vc-maybe-resolve-conflicts file (vc-call merge-news file)))))))
2786 (vc-resynch-buffer file t t))))))
2787 2997
2788(defun vc-version-backup-file (file &optional rev) 2998(defun vc-version-backup-file (file &optional rev)
2789 "Return name of backup file for revision REV of FILE. 2999 "Return name of backup file for revision REV of FILE.
@@ -3024,9 +3234,6 @@ log entries should be gathered."
3024 ;; it should find all relevant files relative to 3234 ;; it should find all relevant files relative to
3025 ;; the default-directory. 3235 ;; the default-directory.
3026 nil))) 3236 nil)))
3027 (dolist (file (or args (list default-directory)))
3028 (if (eq (string-match tramp-file-name-regexp file) 0)
3029 (error "Sorry, vc-update-change-log does not work over Tramp")))
3030 (vc-call-backend (vc-responsible-backend default-directory) 3237 (vc-call-backend (vc-responsible-backend default-directory)
3031 'update-changelog args)) 3238 'update-changelog args))
3032 3239
diff --git a/lisp/view.el b/lisp/view.el
index 367af486425..c7a8d3d54c9 100644
--- a/lisp/view.el
+++ b/lisp/view.el
@@ -243,6 +243,16 @@ This is local in each buffer, once it is used.")
243 243
244;;; Commands that enter or exit view mode. 244;;; Commands that enter or exit view mode.
245 245
246;; This is used when view mode is exited, to make sure we don't try to
247;; kill a buffer modified by the user. A buffer in view mode can
248;; become modified if the user types C-x C-q, edits the buffer, then
249;; types C-x C-q again to return to view mode.
250(defun kill-buffer-if-not-modified (buf)
251 "Like `kill-buffer', but does nothing if the buffer is modified."
252 (let ((buf (get-buffer buf)))
253 (and buf (not (buffer-modified-p buf))
254 (kill-buffer buf))))
255
246;;;###autoload 256;;;###autoload
247(defun view-file (file) 257(defun view-file (file)
248 "View FILE in View mode, returning to previous buffer when done. 258 "View FILE in View mode, returning to previous buffer when done.
@@ -263,41 +273,50 @@ This command runs the normal hook `view-mode-hook'."
263 (progn 273 (progn
264 (switch-to-buffer buffer) 274 (switch-to-buffer buffer)
265 (message "Not using View mode because the major mode is special")) 275 (message "Not using View mode because the major mode is special"))
266 (view-buffer buffer (and (not had-a-buf) 'kill-buffer))))) 276 (view-buffer buffer (and (not had-a-buf) 'kill-buffer-if-not-modified)))))
267 277
268;;;###autoload 278;;;###autoload
269(defun view-file-other-window (file) 279(defun view-file-other-window (file)
270 "View FILE in View mode in another window. 280 "View FILE in View mode in another window.
271Return that window to its previous buffer when done. Emacs commands 281When done, return that window to its previous buffer, and kill the
272editing the buffer contents are not available; instead, a special set of 282buffer visiting FILE if unmodified and if it wasn't visited before.
273commands (mostly letters and punctuation) are defined for moving around 283
274in the buffer. 284Emacs commands editing the buffer contents are not available; instead,
285a special set of commands (mostly letters and punctuation)
286are defined for moving around in the buffer.
275Space scrolls forward, Delete scrolls backward. 287Space scrolls forward, Delete scrolls backward.
276For a list of all View commands, type H or h while viewing. 288For a list of all View commands, type H or h while viewing.
277 289
278This command runs the normal hook `view-mode-hook'." 290This command runs the normal hook `view-mode-hook'."
279 (interactive "fIn other window view file: ") 291 (interactive "fIn other window view file: ")
280 (unless (file-exists-p file) (error "%s does not exist" file)) 292 (unless (file-exists-p file) (error "%s does not exist" file))
281 (let ((had-a-buf (get-file-buffer file))) 293 (let ((had-a-buf (get-file-buffer file))
282 (view-buffer-other-window (find-file-noselect file) nil 294 (buf-to-view (find-file-noselect file)))
283 (and (not had-a-buf) 'kill-buffer)))) 295 (view-buffer-other-window buf-to-view nil
296 (and (not had-a-buf)
297 'kill-buffer-if-not-modified))))
284 298
285;;;###autoload 299;;;###autoload
286(defun view-file-other-frame (file) 300(defun view-file-other-frame (file)
287 "View FILE in View mode in another frame. 301 "View FILE in View mode in another frame.
288Maybe delete other frame and/or return to previous buffer when done. 302When done, kill the buffer visiting FILE if unmodified and if it wasn't
289Emacs commands editing the buffer contents are not available; instead, a 303visited before; also, maybe delete other frame and/or return to previous
290special set of commands (mostly letters and punctuation) are defined for 304buffer.
291moving around in the buffer. 305
306Emacs commands editing the buffer contents are not available; instead,
307a special set of commands (mostly letters and punctuation)
308are defined for moving around in the buffer.
292Space scrolls forward, Delete scrolls backward. 309Space scrolls forward, Delete scrolls backward.
293For a list of all View commands, type H or h while viewing. 310For a list of all View commands, type H or h while viewing.
294 311
295This command runs the normal hook `view-mode-hook'." 312This command runs the normal hook `view-mode-hook'."
296 (interactive "fIn other frame view file: ") 313 (interactive "fIn other frame view file: ")
297 (unless (file-exists-p file) (error "%s does not exist" file)) 314 (unless (file-exists-p file) (error "%s does not exist" file))
298 (let ((had-a-buf (get-file-buffer file))) 315 (let ((had-a-buf (get-file-buffer file))
299 (view-buffer-other-frame (find-file-noselect file) nil 316 (buf-to-view (find-file-noselect file)))
300 (and (not had-a-buf) 'kill-buffer)))) 317 (view-buffer-other-frame buf-to-view nil
318 (and (not had-a-buf)
319 'kill-buffer-if-not-modified))))
301 320
302 321
303;;;###autoload 322;;;###autoload
@@ -313,7 +332,12 @@ This command runs the normal hook `view-mode-hook'.
313 332
314Optional argument EXIT-ACTION is either nil or a function with buffer as 333Optional argument EXIT-ACTION is either nil or a function with buffer as
315argument. This function is called when finished viewing buffer. Use 334argument. This function is called when finished viewing buffer. Use
316this argument instead of explicitly setting `view-exit-action'." 335this argument instead of explicitly setting `view-exit-action'.
336
337Do not set EXIT-ACTION to `kill-buffer' when BUFFER visits a
338file: Users may suspend viewing in order to modify the buffer.
339Exiting View mode will then discard the user's edits. Setting
340EXIT-ACTION to `kill-buffer-if-not-modified' avoids this."
317 (interactive "bView buffer: ") 341 (interactive "bView buffer: ")
318 (let ((undo-window (list (window-buffer) (window-start) (window-point)))) 342 (let ((undo-window (list (window-buffer) (window-start) (window-point))))
319 (switch-to-buffer buffer) 343 (switch-to-buffer buffer)
diff --git a/lisp/wdired.el b/lisp/wdired.el
index 287e2119c8d..36725db5db5 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -323,7 +323,11 @@ non-nil means return old filename."
323 (unless (eq beg end) 323 (unless (eq beg end)
324 (if old 324 (if old
325 (setq file (get-text-property beg 'old-name)) 325 (setq file (get-text-property beg 'old-name))
326 (setq end (next-single-property-change (1+ beg) 'end-name)) 326 ;; In the following form changed `(1+ beg)' to `beg' so that
327 ;; the filename end is found even when the filename is empty.
328 ;; Fixes error and spurious newlines when marking files for
329 ;; deletion.
330 (setq end (next-single-property-change beg 'end-name))
327 (setq file (buffer-substring-no-properties (1+ beg) end))) 331 (setq file (buffer-substring-no-properties (1+ beg) end)))
328 (and file (setq file (wdired-normalize-filename file)))) 332 (and file (setq file (wdired-normalize-filename file))))
329 (if (or no-dir old) 333 (if (or no-dir old)
diff --git a/lisp/winner.el b/lisp/winner.el
index 27b68106a53..5e9d6a3212e 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -51,7 +51,7 @@
51 '(region-active-p))) 51 '(region-active-p)))
52 52
53(defsetf winner-active-region () (store) 53(defsetf winner-active-region () (store)
54 (if (fboundp 'zmacs-activate-region) 54 (if (featurep 'xemacs)
55 `(if ,store (zmacs-activate-region) 55 `(if ,store (zmacs-activate-region)
56 (zmacs-deactivate-region)) 56 (zmacs-deactivate-region))
57 `(setq mark-active ,store))) 57 `(setq mark-active ,store)))
diff --git a/lisp/woman.el b/lisp/woman.el
index 0778d424324..2ba414aef9c 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -3540,8 +3540,10 @@ The expression may be an argument in quotes."
3540 (setq value (funcall op value (woman-parse-numeric-value)))) 3540 (setq value (funcall op value (woman-parse-numeric-value))))
3541 ((looking-at "[<=>]=?") ; relational operators 3541 ((looking-at "[<=>]=?") ; relational operators
3542 (goto-char (match-end 0)) 3542 (goto-char (match-end 0))
3543 (setq op (or (intern-soft (match-string 0)) 3543 (setq op (intern-soft
3544 (intern-soft "="))) 3544 (if (string-equal (match-string 0) "==")
3545 "="
3546 (match-string 0))))
3545 (setq value (if (funcall op value (woman-parse-numeric-value)) 3547 (setq value (if (funcall op value (woman-parse-numeric-value))
3546 1 0))) 3548 1 0)))
3547 ((memq (setq op (following-char)) '(?& ?:)) ; Boolean and / or 3549 ((memq (setq op (following-char)) '(?& ?:)) ; Boolean and / or