aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorKaroly Lorentey2005-10-23 22:47:29 +0000
committerKaroly Lorentey2005-10-23 22:47:29 +0000
commit6dc59f76f49a35140b3bbdeb9c495609f8e55f3a (patch)
tree3694df29f4ce4ab94220bd377cd0d32b64f98b0a /lisp
parenta095475c5f316eed7b27f6e0e6df52dae53dc2a5 (diff)
parentc286104c51b4510ead8e92d265a84aa661ddbf97 (diff)
downloademacs-6dc59f76f49a35140b3bbdeb9c495609f8e55f3a.tar.gz
emacs-6dc59f76f49a35140b3bbdeb9c495609f8e55f3a.zip
Merged from miles@gnu.org--gnu-2005 (patch 610-614)
Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-610 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-611 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-612 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-613 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-614 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-429
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog286
-rw-r--r--lisp/ChangeLog.102
-rw-r--r--lisp/allout.el1890
-rw-r--r--lisp/bookmark.el15
-rw-r--r--lisp/calc/calc-units.el314
-rw-r--r--lisp/cus-face.el2
-rw-r--r--lisp/desktop.el7
-rw-r--r--lisp/disp-table.el6
-rw-r--r--lisp/emacs-lisp/find-func.el2
-rw-r--r--lisp/emacs-lisp/syntax.el14
-rw-r--r--lisp/font-core.el15
-rw-r--r--lisp/font-lock.el237
-rw-r--r--lisp/frame.el6
-rw-r--r--lisp/ido.el72
-rw-r--r--lisp/image.el125
-rw-r--r--lisp/info.el3
-rw-r--r--lisp/language/vietnamese.el1
-rw-r--r--lisp/loadhist.el29
-rw-r--r--lisp/mail/sendmail.el10
-rw-r--r--lisp/makefile.w32-in1
-rw-r--r--lisp/net/ange-ftp.el7
-rw-r--r--lisp/net/rcirc.el1720
-rw-r--r--lisp/progmodes/etags.el14
-rw-r--r--lisp/progmodes/sh-script.el33
-rw-r--r--lisp/replace.el3
-rw-r--r--lisp/savehist.el7
-rw-r--r--lisp/simple.el11
-rw-r--r--lisp/startup.el11
-rw-r--r--lisp/subr.el4
-rw-r--r--lisp/tar-mode.el12
-rw-r--r--lisp/term.el2
-rw-r--r--lisp/textmodes/fill.el11
-rw-r--r--lisp/textmodes/org.el230
-rw-r--r--lisp/textmodes/paragraphs.el25
-rw-r--r--lisp/textmodes/texinfo.el3
-rw-r--r--lisp/url/ChangeLog9
-rw-r--r--lisp/url/url-dired.el4
-rw-r--r--lisp/url/url-file.el8
-rw-r--r--lisp/url/url-handlers.el15
-rw-r--r--lisp/url/url-http.el4
-rw-r--r--lisp/url/url-nfs.el8
41 files changed, 4303 insertions, 875 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index da7c1765255..395cf7a2c5e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,285 @@
12005-10-22 Kenichi Handa <handa@m17n.org>
2
3 * tar-mode.el (tar-extract): Be sure to call
4 find-operation-coding-system if set-auto-coding doesn't find a
5 coding system.
6
72005-10-22 Kim F. Storm <storm@cua.dk>
8
9 * image.el (image-type-header-regexps): Rename from image-type-regexps.
10 Change users.
11 (image-type-file-name-regexps): New defconst.
12 (image-type-from-data): Simplify loop.
13 (image-type-from-buffer): New defun.
14 (image-type-from-file-header): Use it instead of image-type-from-data.
15 Use image-search-load-path instead of only looking in data-directory.
16 (image-type-from-file-name): New defun.
17 (image-search-load-path): Make PATH arg optional, default to image-load-path.
18 Change `pathname' to `filename'.
19
202005-10-21 Richard M. Stallman <rms@gnu.org>
21
22 * textmodes/texinfo.el (texinfo-mode): Set sentence-end-base.
23
24 * textmodes/paragraphs.el (sentence-end-base): New variable.
25 (sentence-end): Use sentence-end-base.
26
272005-10-21 Stefan Monnier <monnier@iro.umontreal.ca>
28
29 * font-lock.el (font-lock-default-fontify-region): Check the multiline
30 property independently from the font-lock-multiline variable.
31
322005-10-21 Richard M. Stallman <rms@gnu.org>
33
34 * emacs-lisp/find-func.el (find-library-name): Doc fix.
35
36 * startup.el (command-line): Convert library names
37 in `load-history' to absolute file names.
38
39 * subr.el (symbol-file): Doc fix.
40
41 * loadhist.el (file-loadhist-lookup): Call locate-library
42 instead of find-library-name. Don't try converting
43 abs file names to library names, since load-history no longer
44 has library names in it.
45 (file-dependents, file-provides, file-requires): Doc fixes.
46
472005-10-21 Juri Linkov <juri@jurta.org>
48
49 * progmodes/etags.el (tags-table-mode): New function.
50 (tags-verify-table): Replace initialize-new-tags-table with
51 tags-table-mode.
52
53 * desktop.el (desktop-buffers-not-to-save): Remove TAGS from the
54 default value.
55 (desktop-modes-not-to-save): Add tags-table-mode to the
56 default value.
57
58 * info.el (Info-index-next): Add total number of index
59 alternatives to the message.
60
61 * textmodes/fill.el (fill-nobreak-p): Fix first two rules to skip
62 backward only space (instead of space and period) before looking
63 at sentence end.
64
65 * simple.el (set-variable): Use user-variable-p instead of symbolp.
66 Add the old variable value as 4th default-value arg of read-string.
67
682005-10-21 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
69
70 * cus-face.el (custom-declare-face): Make face from X resources
71 also on Mac.
72
73 * disp-table.el (standard-display-g1, standard-display-graphic):
74 Refuse to use string glyphs also on Mac.
75 (standard-display-european): Don't set terminal coding system also
76 on Mac.
77
78 * frame.el (display-screens): Use x-display-screens also on Mac.
79
802005-10-21 Romain Francoise <romain@orebokech.com>
81
82 * net/rcirc.el: Now part of GNU Emacs. Update FSF's address.
83
842005-10-21 Stefan Monnier <monnier@iro.umontreal.ca>
85
86 * progmodes/sh-script.el (sh-font-lock-syntactic-keywords): Make $@
87 and $? into sexps.
88
89 * font-lock.el (font-lock-compile-keywords): Add a help-echo to the
90 warning face on open-paren-in-column-0.
91
92 * emacs-lisp/syntax.el (syntax-ppss-flush-cache): Fix corner
93 boundary case. Fix typo.
94 Suggested by Martin Rudalics <rudalics@gmx.at>.
95
962005-10-21 Carsten Dominik <dominik@science.uva.nl>
97
98 * textmodes/org.el: (org-combined-agenda-icalendar-file)
99 (org-icalendar-include-todo, org-icalendar-combined-name): New options.
100 (org-export-icalendar-this-file)
101 (org-export-icalendar-all-agenda-files)
102 (org-export-icalendar-combine-agenda-files): New commands.
103 (org-export-icalendar, org-print-icalendar-entries)
104 (org-start-icalendar-file, org-finish-icalendar-file)
105 (org-ical-ts-to-string): New functions.
106 (org-read-date, org-goto-calendar)
107 (org-agenda-goto-calendar): Inhibit displaying diary entries by
108 call to `calendar'.
109 (orgtbl-setup): Remove the :keys arguments from the menu description.
110 (org-after-save-iCalendar-file-hook): New variable.
111
1122005-10-21 Kenichi Handa <handa@m17n.org>
113
114 * language/vietnamese.el (tcvn-5712): Make it an alias of
115 vietnamese-tcvn coding-system.
116
1172005-10-20 Michael Albinus <michael.albinus@gmx.de>
118
119 * net/ange-ftp.el (ange-ftp-date-regexp): Handle also the case no
120 group id is given.
121
1222005-10-20 Stefan Monnier <monnier@iro.umontreal.ca>
123
124 * progmodes/sh-script.el (sh-escaped-line-re): New var.
125 (sh-here-doc-open-re, sh-font-lock-close-heredoc): Use it.
126 (sh-font-lock-open-heredoc): Try to properly handle heredoc starters
127 whose line is either continued or ends with a comment.
128
1292005-10-20 Romain Francoise <romain@orebokech.com>
130
131 * net/rcirc.el (with-rcirc-process-buffer): Move above its first user.
132
133 * replace.el (occur-engine): Add follow-link property.
134
135 * font-core.el (font-lock-mode): Doc fix.
136
1372005-10-20 Richard M. Stallman <rms@gnu.org>
138
139 * net/rcirc.el: New file.
140
1412005-10-20 Bryan Henderson <bryanh@giraffe-data.com> (tiny change)
142
143 * term.el (term-term-name): Initialize to "eterm-color".
144
1452005-10-20 Ken Manheimer <ken.manheimer@gmail.com>
146
147 * allout.el: Add autoloads of crypt++ and mailcrypt routines, all
148 for encryption functionality.
149 Move allout customization subgroup from `editing' to `outlines' group.
150 Fix commentary 'keywords' to legitimate ones.
151 Update author info (using my current email address, obscurified).
152 (allout-encrypt-string, allout-encryption-produce-work-buffer)
153 (allout-encrypted-topic-p, allout-encrypted-text-type)
154 (allout-mc-activate-passwd, allout-create-encryption-key-verifier)
155 (allout-situate-encryption-key-verifier)
156 (allout-get-encryption-key-verifier, allout-verify-key)
157 (allout-next-topic-pending-encryption)
158 (allout-encrypt-decrypted, allout-encrypted-type-prefix): New funcs.
159 (outline-topic-encryption-bullet, outline-default-encryption-scheme)
160 (outline-key-verifier-handling, outline-key-hint-handling)
161 (outline-encrypt-unencrypted-on-saves): New defcustoms.
162 (allout-file-key-verifier-string, allout-encryption-scheme)
163 (allout-key-verifier-string, allout-key-hint-string)
164 (allout-after-save-decrypt): New variables.
165 (allout-write-file-hook-handler, allout-auto-save-hook-handler)
166 (allout-after-saves-handler): New hook functions.
167 (allout-post-command-business): Do allout-after-save-decrypt.
168 (allout-enable-file-variable-adjustment): Custom var to enable
169 mechanism for adding and adjusting settings of Emacs file variables.
170 (allout-adjust-file-variable, allout-file-vars-section-data):
171 New functions, implement the mechanism.
172 (outlineify-sticky): Use the file vars mechanism.
173 (allout-inhibit-protection, allout-during-write-cue)
174 (allout-override-protect, allout-before-change-protect): Remove.
175 (allout-flag-region, allout-open-topic): Adjust read-only text.
176 (allout-open-line-not-read-only): Add to facilitate read-only
177 text based protection.
178 (allout-kill-line): Revise to adjust read-only text, clue the
179 user about the inhibition.
180 (allout-unprotected): Use unwind-protect.
181 (allout-shift-in, allout-shift-out): Disallow manually shifting a
182 topic deeper than the offspring depth of the previous topic -
183 avoiding confusing "containment discontinuities".
184 (allout-reindent-bodies): Fix retention of body relative hanging
185 indent during promotion of collapsed bodies.
186 (allout-open-topic): Make it easy to open new topic with same
187 bullet as current topic - topic creation functions provided with
188 any universal argument provokes now prompt for bullet, defaulting
189 to the bullet of the previous topic.
190 (allout-plain-bullets-string, allout-distinctive-bullets-string):
191 Plain bullet alternates '.' period and ',' comma only. All other
192 bullets are relegated to special status (but customizable).
193 (allout-end-of-entry): Rename from 'allout-end-of-current-entry
194 since it actually operates w.r.t. most immediately containing
195 entry, visible or not.
196 (allout-hide-current-entry, allout-show-current-entry): Use the
197 revised version.
198 (allout-old-expose-topic): Solidify deprecation.
199 (allout-end-of-subtree): Add so we can span concealed as well
200 as visible topics.
201 (allout-end-of-current-subtree): Use `allout-end-of-subtree'.
202 (allout-end-of-current-heading): Tweak to just respect the first line.
203 (allout-get-body-text): Add.
204 (allout-ascend-to-depth, allout-ascend): Position at end of prefix
205 when invoked interactively.
206 (allout-up-current-level): Use `interactive-p'.
207 (allout-mode, allout-init): Miscellaneous docstring and
208 operational refinements, as well as hookups of new encryption stuff.
209 (allout-beginning-of-current-entry): Now works as advertised.
210 (allout-end-of-current-entry): Remove of superfluous allout-show-entry.
211 (allout-isearch-rectification): Refine condition for isearching.
212 (allout-isearch-abort, allout-enwrap-isearch)
213 (allout-flag-region, my-region-active-p): Relocate some macros.
214 (allout-title): Fallback title is '(buffer-name)', not
215 non-existing '(current-buffer-name)'.
216 (subst-char-in-string): Define if absent (for some XEmacs versions).
217
2182005-10-20 Jari Aalto <jari.aalto@cante.net>
219
220 * mail/sendmail.el (mail-setup-hook, mail-aliases)
221 (mail-yank-prefix, mail-indentation-spaces, mail-yank-hooks)
222 (mail-citation-prefix-regexp, mail-signature-file)
223 (mail-default-headers, mail-bury-selects-summary)
224 (mail-send-nonascii): Add autoload cookies.
225
2262005-10-20 Emanuele Giaquinta <emanuele.giaquinta@gmail.com> (tiny change)
227
228 * frame.el (blink-cursor-mode): Add `mac' to the list of
229 window-system's that support blinking cursor.
230
2312005-10-20 Reiner Steib <Reiner.Steib@gmx.de>
232
233 * textmodes/org.el (org-level-color-stars-only): Fix typo in docstring.
234
2352005-10-20 Eli Zaretskii <eliz@gnu.org>
236
237 * makefile.w32-in ($(lisp)/mh-e/mh-loaddefs.el):
238 Bind find-file-suppress-same-file-warnings to t, to avoid warnings due
239 to different drive letter case in D:/foo/bar.el vs d:/foo/bar.el.
240
2412005-10-20 Kim F. Storm <storm@cua.dk>
242
243 * ido.el (ido-is-tramp-root): Simplify regexp matching tramp root.
244 (ido-set-current-directory): Don't add / after final @.
245 (ido-file-name-all-completions-1): Adapt to fixed tramp completion.
246 Explicitly handle ange-ftp completion oddities.
247 (ido-make-file-list): Don't rotate list at tramp root to avoid
248 triggering tramp file handler for expand-file-name via get-file-buffer.
249
2502005-10-19 Stefan Monnier <monnier@iro.umontreal.ca>
251
252 * simple.el (eval-expression-print-format): Put the char-string
253 inside the parenthesis, like the other alternative notations.
254 (kill-new): Use push.
255 (copy-to-buffer): Use with-current-buffer.
256 (completion-setup-function): Simplify.
257 (minibuffer-local-must-match-map): Don't add redundant bindings which
258 are already present in its parent (minibuffer-local-completion-map).
259
260 * savehist.el (savehist-coding-system): Revert to checking XEmacs.
261
2622005-10-19 Jay Belanger <belanger@truman.edu>
263
264 * calc/calc-units.el (math-standard-units): Add units, adjust
265 symbols and update values.
266 (math-unit-prefixes): Add more prefixes.
267
2682005-10-19 Romain Francoise <romain@orebokech.com>
269
270 * bookmark.el (bookmark-menu-heading): New face.
271 (bookmark-bmenu-list): Use it.
272 Don't fiddle with `baud-rate' at top-level.
273
2742005-10-18 Chong Yidong <cyd@stupidchicken.com>
275
276 * image.el (create-image, find-image): Mention max-image-size in
277 docstring.
278
12005-10-18 Stefan Monnier <monnier@iro.umontreal.ca> 2792005-10-18 Stefan Monnier <monnier@iro.umontreal.ca>
2 280
281 * savehist.el (savehist-load): Revert to checking XEmacs.
282
3 * textmodes/conf-mode.el: Don't use font-lock-defaults-alist. 283 * textmodes/conf-mode.el: Don't use font-lock-defaults-alist.
4 Various docstring and line-width fixups. 284 Various docstring and line-width fixups.
5 (conf-mode): Use cond. 285 (conf-mode): Use cond.
@@ -117,15 +397,14 @@
117 397
1182005-10-18 Jay Belanger <belanger@truman.edu> 3982005-10-18 Jay Belanger <belanger@truman.edu>
119 399
120 * calc/calc-store (calc-store-into): Get the proper variable name 400 * calc/calc-store.el (calc-store-into): Get the proper variable name
121 to display in message. 401 to display in message.
122 402
1232005-10-18 Nick Roberts <nickrob@snap.net.nz> 4032005-10-18 Nick Roberts <nickrob@snap.net.nz>
124 404
125 * progmodes/gdb-ui.el (gdb-var-create-handler): Make watch 405 * progmodes/gdb-ui.el (gdb-var-create-handler): Make watch
126 expressions display in speedbar for all buffers when debugging. 406 expressions display in speedbar for all buffers when debugging.
127 (gdb-speedbar-expand-node): Ensure node contraction is always 407 (gdb-speedbar-expand-node): Ensure node contraction is always updated.
128 updated.
129 408
130 * speedbar.el (speedbar-set-mode-line-format): Indent properly. 409 * speedbar.el (speedbar-set-mode-line-format): Indent properly.
131 (speedbar-insert-button, speedbar-make-button): 410 (speedbar-insert-button, speedbar-make-button):
@@ -249,7 +528,6 @@
249 * progmodes/pascal.el (pascal-complete-word) 528 * progmodes/pascal.el (pascal-complete-word)
250 (pascal-show-completions): Ditto. 529 (pascal-show-completions): Ditto.
251 530
252
253 * textmodes/bibtex.el (bibtex-complete-internal): Ditto. 531 * textmodes/bibtex.el (bibtex-complete-internal): Ditto.
254 532
255 * simple.el (completion-common-substring): New variable. 533 * simple.el (completion-common-substring): New variable.
diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10
index 6467fef4e72..51cda269238 100644
--- a/lisp/ChangeLog.10
+++ b/lisp/ChangeLog.10
@@ -14639,7 +14639,7 @@
14639 * font-lock.el (font-lock-defaults, font-lock-defaults-alist) 14639 * font-lock.el (font-lock-defaults, font-lock-defaults-alist)
14640 (font-lock-multiline, font-lock-fontified, font-lock-mode) 14640 (font-lock-multiline, font-lock-fontified, font-lock-mode)
14641 (turn-on-font-lock, font-lock-add-keywords, global-font-lock-mode) 14641 (turn-on-font-lock, font-lock-add-keywords, global-font-lock-mode)
14642 (font-lock-global-modes): Moved to font-core.el. 14642 (font-lock-global-modes): Move to font-core.el.
14643 (font-lock-set-defaults-1): Partially moved to font-core.el. 14643 (font-lock-set-defaults-1): Partially moved to font-core.el.
14644 14644
14645 * font-core.el: New file, with functions taken from font-lock.el. 14645 * font-core.el: New file, with functions taken from font-lock.el.
diff --git a/lisp/allout.el b/lisp/allout.el
index a64ba4b8f9f..5dc16ee3546 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -3,10 +3,10 @@
3;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, 3;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004,
4;; 2005 Free Software Foundation, Inc. 4;; 2005 Free Software Foundation, Inc.
5 5
6;; Author: Ken Manheimer <klm@zope.com> 6;; Author: Ken Manheimer <ken dot manheimer at gmail dot com>
7;; Maintainer: Ken Manheimer <klm@zope.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;; Keywords: outlines mode wp languages 9;; Keywords: outlines wp languages
10 10
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12 12
@@ -34,43 +34,68 @@
34;; programming languages. (For an example, see the allout code 34;; programming languages. (For an example, see the allout code
35;; itself, which is organized in ;; an outline framework.) 35;; itself, which is organized in ;; an outline framework.)
36;; 36;;
37;; In addition to outline navigation and exposure, allout includes: 37;; Some features:
38;; 38;;
39;; - topic-oriented repositioning, cut, and paste 39;; - classic outline-mode topic-oriented navigation and exposure adjustment
40;; - integral outline exposure-layout 40;; - topic-oriented editing including coherent topic and subtopic
41;; - incremental search with dynamic exposure and reconcealment of hidden text 41;; creation, promotion, demotion, cut/paste across depths, etc
42;; - incremental search with dynamic exposure and reconcealment of text
43;; - customizable bullet format enbles programming-language specific
44;; outlining, for ultimate code-folding editing. (allout code itself is
45;; formatted as an outline - do ESC-x eval-current-buffer in allout.el
46;; to try it out.)
47;; - configurable per-file initial exposure settings
48;; - symmetric-key and key-pair topic encryption, plus reliable key
49;; verification and user-supplied hint maintenance. (see
50;; allout-toggle-current-subtree-encryption docstring.)
42;; - automatic topic-number maintenance 51;; - automatic topic-number maintenance
43;; - "Hot-spot" operation, for single-keystroke maneuvering and 52;; - "hot-spot" operation, for single-keystroke maneuvering and
44;; 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
55;; outline styles
45;; 56;;
46;; and many other features. 57;; and more.
47;; 58;;
48;; The outline menubar additions provide quick reference to many of 59;; The outline menubar additions provide quick reference to many of
49;; the features, and see the docstring of the function `allout-init' 60;; the features, and see the docstring of the variable `allout-init'
50;; for instructions on priming your Emacs session for automatic 61;; for instructions on priming your emacs session for automatic
51;; activation of `allout-mode'. 62;; activation of allout-mode.
52;; 63;;
53;; See the docstring of the variables `allout-layout' and 64;; See the docstring of the variables `allout-layout' and
54;; `allout-auto-activation' for details on automatic activation of 65;; `allout-auto-activation' for details on automatic activation of
55;; allout `allout-mode' as a minor mode. (It has changed since allout 66;; `allout-mode' as a minor mode. (It has changed since allout
56;; 3.x, for those of you that depend on the old method.) 67;; 3.x, for those of you that depend on the old method.)
57;; 68;;
58;; Note - the lines beginning with `;;;_' are outline topic headers. 69;; Note - the lines beginning with `;;;_' are outline topic headers.
59;; Just `ESC-x eval-current-buffer' to give it a whirl. 70;; Just `ESC-x eval-current-buffer' to give it a whirl.
60 71
61;; Ken Manheimer klm@zope.com 72;; ken manheimer (ken dot manheimer at gmail dot com)
62 73
63;;; Code: 74;;; Code:
64 75
65;;;_* Provide 76;;;_* Provide
77;(provide 'outline)
66(provide 'allout) 78(provide 'allout)
67 79
80;;;_* Dependency autoloads
81(eval-when-compile 'cl) ; otherwise, flet compilation fouls
82(autoload 'crypt-encrypt-buffer "crypt++")
83(setq-default crypt-encryption-type 'gpg)
84
85(autoload 'mc-encrypt "mailcrypt"
86 "*Encrypt the current buffer")
87(autoload 'mc-activate-passwd "mailcrypt"
88 "Activate the passphrase matching ID, using PROMPT for a prompt.
89Return the passphrase. If PROMPT is nil, only return value if cached.")
90(autoload 'mc-gpg-process-region "mc-gpg")
91(autoload 'mc-dectivate-passwd "mailcrypt"
92 "*Deactivate the passphrase cache.")
93
68;;;_* USER CUSTOMIZATION VARIABLES: 94;;;_* USER CUSTOMIZATION VARIABLES:
69(defgroup allout nil 95(defgroup allout nil
70 "Extensive outline mode for use alone and with other modes." 96 "Extensive outline mode for use alone and with other modes."
71 :prefix "allout-" 97 :prefix "allout-"
72 :group 'editing 98 :group 'outlines)
73 :version "22.1")
74 99
75;;;_ + Layout, Mode, and Topic Header Configuration 100;;;_ + Layout, Mode, and Topic Header Configuration
76 101
@@ -111,8 +136,8 @@ Buffer-specific.
111 136
112A list value specifies a default layout for the current buffer, to be 137A list value specifies a default layout for the current buffer, to be
113applied upon activation of `allout-mode'. Any non-nil value will 138applied upon activation of `allout-mode'. Any non-nil value will
114automatically trigger `allout-mode', provided `allout-init' 139automatically trigger `allout-mode' \(provided `allout-init' has been called
115has been called to enable it. 140to enable this behavior).
116 141
117See the docstring for `allout-init' for details on setting up for 142See the docstring for `allout-init' for details on setting up for
118auto-mode-activation, and for `allout-expose-topic' for the format of 143auto-mode-activation, and for `allout-expose-topic' for the format of
@@ -171,7 +196,7 @@ bullets."
171 :group 'allout) 196 :group 'allout)
172(make-variable-buffer-local 'allout-primary-bullet) 197(make-variable-buffer-local 'allout-primary-bullet)
173;;;_ = allout-plain-bullets-string 198;;;_ = allout-plain-bullets-string
174(defcustom allout-plain-bullets-string ".:,;" 199(defcustom allout-plain-bullets-string ".,"
175 "*The bullets normally used in outline topic prefixes. 200 "*The bullets normally used in outline topic prefixes.
176 201
177See `allout-distinctive-bullets-string' for the other kind of 202See `allout-distinctive-bullets-string' for the other kind of
@@ -185,7 +210,7 @@ of this var to take effect."
185 :group 'allout) 210 :group 'allout)
186(make-variable-buffer-local 'allout-plain-bullets-string) 211(make-variable-buffer-local 'allout-plain-bullets-string)
187;;;_ = allout-distinctive-bullets-string 212;;;_ = allout-distinctive-bullets-string
188(defcustom allout-distinctive-bullets-string "*+-=>([{}&!?#%\"X@$~_\\" 213(defcustom allout-distinctive-bullets-string "*+-=>()[{}&!?#%\"X@$~_\\:;^"
189 "*Persistent outline header bullets used to distinguish special topics. 214 "*Persistent outline header bullets used to distinguish special topics.
190 215
191These bullets are used to distinguish topics from the run-of-the-mill 216These bullets are used to distinguish topics from the run-of-the-mill
@@ -198,12 +223,13 @@ rebulleting, so they can be used to characterize topics, eg:
198 `?' question topics 223 `?' question topics
199 `\(' parenthetic comment \(with a matching close paren inside) 224 `\(' parenthetic comment \(with a matching close paren inside)
200 `[' meta-note \(with a matching close ] inside) 225 `[' meta-note \(with a matching close ] inside)
201 `\"' a quote 226 `\"' a quotation
202 `=' value settings 227 `=' value settings
203 `~' \"more or less\" 228 `~' \"more or less\"
229 `^' see above
204 230
205... just for example. (`#' typically has a special meaning to the 231 ... for example. (`#' typically has a special meaning to the software,
206software, according to the value of `allout-numbered-bullet'.) 232according to the value of `allout-numbered-bullet'.)
207 233
208See `allout-plain-bullets-string' for the selection of 234See `allout-plain-bullets-string' for the selection of
209alternating bullets. 235alternating bullets.
@@ -337,7 +363,6 @@ disables numbering maintenance."
337Set this var to the bullet you want to use for file cross-references." 363Set this var to the bullet you want to use for file cross-references."
338 :type '(choice (const nil) string) 364 :type '(choice (const nil) string)
339 :group 'allout) 365 :group 'allout)
340
341;;;_ = allout-presentation-padding 366;;;_ = allout-presentation-padding
342(defcustom allout-presentation-padding 2 367(defcustom allout-presentation-padding 2
343 "*Presentation-format white-space padding factor, for greater indent." 368 "*Presentation-format white-space padding factor, for greater indent."
@@ -381,7 +406,7 @@ numbers are always used."
381 :type 'string 406 :type 'string
382 :group 'allout) 407 :group 'allout)
383;;;_ - allout-title 408;;;_ - allout-title
384(defcustom allout-title '(or buffer-file-name (current-buffer-name)) 409(defcustom allout-title '(or buffer-file-name (buffer-name))
385 "*Expression to be evaluated to determine the title for LaTeX 410 "*Expression to be evaluated to determine the title for LaTeX
386formatted copy." 411formatted copy."
387 :type 'sexp 412 :type 'sexp
@@ -397,6 +422,94 @@ formatted copy."
397 :type 'string 422 :type 'string
398 :group 'allout) 423 :group 'allout)
399 424
425;;;_ + Topic encryption
426;;;_ = allout-topic-encryption-bullet
427(defcustom allout-topic-encryption-bullet "~"
428 "*Bullet signifying encryption of the entry's body."
429 :type '(choice (const nil) string)
430 :group 'allout)
431;;;_ = allout-default-encryption-scheme
432(defcustom allout-default-encryption-scheme 'mc-scheme-gpg
433 "*Default allout outline topic encryption mode.
434
435See mailcrypt variable `mc-schemes' and mailcrypt docs for encryption schemes."
436 :type 'symbol
437 :group 'allout)
438;;;_ = allout-key-verifier-handling
439(defcustom allout-key-verifier-handling 'situate
440 "*Dictate outline encryption key verifier handling.
441
442The key verifier is string associated with a file that is encrypted with
443the file's current symmetric encryption key. It is used, if present, to
444confirm that the key entered by the user is the same as the established
445one, or explicitly presenting the user with the choice to go with a
446new key when a difference is encountered.
447
448The range of values are:
449
450 situate - include key verifier string as text in the file's local-vars
451 section
452 transient - establish the value as a variable in the file's buffer, but
453 don't preserve it as a file variable.
454 disabled - don't establish or do verification.
455
456See the docstring for the `allout-enable-file-variable-adjustment'
457variable for details about allout ajustment of file variables."
458 :type '(choice (const situate)
459 (const transient)
460 (const disabled))
461 :group 'allout)
462(make-variable-buffer-local 'allout-key-verifier-handling)
463;;;_ = allout-key-hint-handling
464(defcustom allout-key-hint-handling 'always
465 "*Dictate outline encryption key reminder handling:
466
467 always - always show reminder when prompting
468 needed - show reminder on key entry failure
469 manage - never present reminder, but still manage a file-var entry for it
470 disabled - don't even manage the file variable entry
471
472See the docstring for the `allout-enable-file-variable-adjustment'
473variable for details about allout ajustment of file variables."
474 :type '(choice (const always)
475 (const needed)
476 (const manage)
477 (const disabled))
478 :group 'allout)
479(make-variable-buffer-local 'allout-key-hint-handling)
480;;;_ = allout-encrypt-unencrypted-on-saves
481(defcustom allout-encrypt-unencrypted-on-saves 'except-current
482 "*When saving, should topics pending encryption be encrypted?
483
484The idea is to prevent file-system exposure of any un-encrypted stuff, and
485mostly covers both deliberate file writes and auto-saves.
486
487 - Yes: encrypt all topics pending encryption, even if it's the one
488 currently being edited. \(In that case, the currently edited topic
489 will be automatically decrypted before any user interaction, so they
490 can continue editing but the copy on the file system will be
491 encrypted.)
492 Auto-saves will use the \"All except current topic\" mode if this
493 one is selected, to avoid practical difficulties - see below.
494 - All except current topic: skip the topic currently being edited, even if
495 it's pending encryption. This may expose the current topic on the
496 file sytem, but avoids the nuisance of prompts for the encryption
497 key in the middle of editing for, eg, autosaves.
498 This mode is used for auto-saves for both this option and \"Yes\".
499 - No: leave it to the user to encrypt any unencrypted topics.
500
501For practical reasons, auto-saves always use the 'except-current policy
502when auto-encryption is enabled. \(Otherwise, spurious key prompts and
503unavoidable timing collisions are too disruptive.) If security for a file
504requires that even the current topic is never auto-saved in the clear,
505disable auto-saves for that file."
506
507 :type '(choice (const :tag "Yes" t)
508 (const :tag "All except current topic" except-current)
509 (const :tag "No" nil))
510 :group 'allout)
511(make-variable-buffer-local 'allout-encrypt-unencrypted-on-saves)
512
400;;;_ + Miscellaneous customization 513;;;_ + Miscellaneous customization
401 514
402;;;_ = allout-command-prefix 515;;;_ = allout-command-prefix
@@ -422,13 +535,15 @@ unless optional third, non-nil element is present.")
422 ("\C-f" allout-forward-current-level) 535 ("\C-f" allout-forward-current-level)
423 ("\C-b" allout-backward-current-level) 536 ("\C-b" allout-backward-current-level)
424 ("\C-a" allout-beginning-of-current-entry) 537 ("\C-a" allout-beginning-of-current-entry)
425 ("\C-e" allout-end-of-current-entry) 538 ("\C-e" allout-end-of-entry)
426 ; Exposure commands: 539 ; Exposure commands:
427 ("\C-i" allout-show-children) 540 ("\C-i" allout-show-children)
428 ("\C-s" allout-show-current-subtree) 541 ("\C-s" allout-show-current-subtree)
429 ("\C-h" allout-hide-current-subtree) 542 ("\C-h" allout-hide-current-subtree)
543 ("h" allout-hide-current-subtree)
430 ("\C-o" allout-show-current-entry) 544 ("\C-o" allout-show-current-entry)
431 ("!" allout-show-all) 545 ("!" allout-show-all)
546 ("x" allout-toggle-current-subtree-encryption)
432 ; Alteration commands: 547 ; Alteration commands:
433 (" " allout-open-sibtopic) 548 (" " allout-open-sibtopic)
434 ("." allout-open-subtopic) 549 ("." allout-open-subtopic)
@@ -489,19 +604,22 @@ those that do not have the variable `comment-start' set. A value of
489 604
490(make-variable-buffer-local 'allout-reindent-bodies) 605(make-variable-buffer-local 'allout-reindent-bodies)
491 606
492;;;_ = allout-inhibit-protection 607;;;_ = allout-enable-file-variable-adjustment
493(defcustom allout-inhibit-protection nil 608(defcustom allout-enable-file-variable-adjustment t
494 "*Non-nil disables warnings and confirmation-checks for concealed-text edits. 609 "*If non-nil, some allout outline actions can edit Emacs file variables text.
610
611This can range from changes to existing entries, addition of new ones,
612and creation of a new local variables section when necessary.
495 613
496Outline mode uses Emacs change-triggered functions to detect unruly 614Emacs file variables adjustments are also inhibited if `enable-local-variables'
497changes to concealed regions. Set this var non-nil to disable the 615is nil.
498protection, potentially increasing text-entry responsiveness a bit.
499 616
500This var takes effect at `allout-mode' activation, so you may have to 617Operations potentially causing edits include allout encryption routines.
501deactivate and then reactivate the mode if you want to toggle the 618See the docstring for `allout-toggle-current-subtree-encryption' for
502behavior." 619details."
503 :type 'boolean 620 :type 'boolean
504 :group 'allout) 621 :group 'allout)
622(make-variable-buffer-local 'allout-enable-file-variable-adjustment)
505 623
506;;;_* CODE - no user customizations below. 624;;;_* CODE - no user customizations below.
507 625
@@ -728,7 +846,16 @@ See doc string for allout-keybindings-list for format of binding list."
728 (car (cdr cell))))))) 846 (car (cdr cell)))))))
729 keymap-list) 847 keymap-list)
730 map)) 848 map))
731 849;;;_ = allout-prior-bindings - being deprecated.
850(defvar allout-prior-bindings nil
851 "Variable for use in V18, with allout-added-bindings, for
852resurrecting, on mode deactivation, bindings that existed before
853activation. Being deprecated.")
854;;;_ = allout-added-bindings - being deprecated
855(defvar allout-added-bindings nil
856 "Variable for use in V18, with allout-prior-bindings, for
857resurrecting, on mode deactivation, bindings that existed before
858activation. Being deprecated.")
732;;;_ : Menu bar 859;;;_ : Menu bar
733(defvar allout-mode-exposure-menu) 860(defvar allout-mode-exposure-menu)
734(defvar allout-mode-editing-menu) 861(defvar allout-mode-editing-menu)
@@ -759,7 +886,11 @@ See doc string for allout-keybindings-list for format of binding list."
759 ["Shift Topic Out" allout-shift-out t] 886 ["Shift Topic Out" allout-shift-out t]
760 ["Rebullet Topic" allout-rebullet-topic t] 887 ["Rebullet Topic" allout-rebullet-topic t]
761 ["Rebullet Heading" allout-rebullet-current-heading t] 888 ["Rebullet Heading" allout-rebullet-current-heading t]
762 ["Number Siblings" allout-number-siblings t])) 889 ["Number Siblings" allout-number-siblings t]
890 "----"
891 ["Toggle Topic Encryption"
892 allout-toggle-current-subtree-encryption
893 (> (allout-current-depth) 1)]))
763 (easy-menu-define allout-mode-navigation-menu 894 (easy-menu-define allout-mode-navigation-menu
764 allout-mode-map 895 allout-mode-map
765 "Allout outline navigation menu." 896 "Allout outline navigation menu."
@@ -775,7 +906,7 @@ See doc string for allout-keybindings-list for format of binding list."
775 "----" 906 "----"
776 ["Beginning of Entry" 907 ["Beginning of Entry"
777 allout-beginning-of-current-entry t] 908 allout-beginning-of-current-entry t]
778 ["End of Entry" allout-end-of-current-entry t] 909 ["End of Entry" allout-end-of-entry t]
779 ["End of Subtree" allout-end-of-current-subtree t])) 910 ["End of Subtree" allout-end-of-current-subtree t]))
780 (easy-menu-define allout-mode-misc-menu 911 (easy-menu-define allout-mode-misc-menu
781 allout-mode-map 912 allout-mode-map
@@ -855,13 +986,6 @@ from the list."
855 (setq allout-mode-prior-settings rebuild))))) 986 (setq allout-mode-prior-settings rebuild)))))
856 ) 987 )
857;;;_ : Mode-specific incidentals 988;;;_ : Mode-specific incidentals
858;;;_ = allout-during-write-cue nil
859(defvar allout-during-write-cue nil
860 "Used to inhibit outline change-protection during file write.
861
862See also `allout-post-command-business', `allout-write-file-hook',
863`allout-before-change-protect', and `allout-post-command-business'
864functions.")
865;;;_ = allout-pre-was-isearching nil 989;;;_ = allout-pre-was-isearching nil
866(defvar allout-pre-was-isearching nil 990(defvar allout-pre-was-isearching nil
867 "Cue for isearch-dynamic-exposure mechanism, implemented in 991 "Cue for isearch-dynamic-exposure mechanism, implemented in
@@ -869,22 +993,28 @@ allout-pre- and -post-command-hooks.")
869(make-variable-buffer-local 'allout-pre-was-isearching) 993(make-variable-buffer-local 'allout-pre-was-isearching)
870;;;_ = allout-isearch-prior-pos nil 994;;;_ = allout-isearch-prior-pos nil
871(defvar allout-isearch-prior-pos nil 995(defvar allout-isearch-prior-pos nil
872 "Cue for isearch-dynamic-exposure tracking, used by `allout-isearch-expose'.") 996 "Cue for isearch-dynamic-exposure tracking, used by
997`allout-isearch-expose'.")
873(make-variable-buffer-local 'allout-isearch-prior-pos) 998(make-variable-buffer-local 'allout-isearch-prior-pos)
874;;;_ = allout-override-protect nil 999;;;_ = allout-isearch-did-quit
875(defvar allout-override-protect nil 1000(defvar allout-isearch-did-quit nil
876 "Used in `allout-mode' for regulate of concealed-text protection mechanism. 1001 "Distinguishes isearch conclusion and cancellation.
877 1002
878Allout outline mode regulates alteration of concealed text to protect 1003Maintained by allout-isearch-abort \(which is wrapped around the real
879against inadvertent, unnoticed changes. This is for use by specific, 1004isearch-abort), and monitored by allout-isearch-expose for action.")
880native outline functions to temporarily override that protection. 1005(make-variable-buffer-local 'allout-isearch-did-quit)
881It's automatically reset to nil after every buffer modification.")
882(make-variable-buffer-local 'allout-override-protect)
883;;;_ > allout-unprotected (expr) 1006;;;_ > allout-unprotected (expr)
884(defmacro allout-unprotected (expression) 1007(defmacro allout-unprotected (expr)
885 "Evaluate EXPRESSION with `allout-override-protect' let-bound to t." 1008 "Enable internal outline operations to alter read-only text."
886 `(let ((allout-override-protect t)) 1009 `(let ((was-inhibit-r-o inhibit-read-only))
887 ,expression)) 1010 (unwind-protect
1011 (progn
1012 (setq inhibit-read-only t)
1013 ,expr)
1014 (setq inhibit-read-only was-inhibit-r-o)
1015 )
1016 )
1017 )
888;;;_ = allout-undo-aggregation 1018;;;_ = allout-undo-aggregation
889(defvar allout-undo-aggregation 30 1019(defvar allout-undo-aggregation 30
890 "Amount of successive self-insert actions to bunch together per undo. 1020 "Amount of successive self-insert actions to bunch together per undo.
@@ -897,14 +1027,109 @@ the way that `before-change-functions' and undo interact.")
897 "Horrible hack used to prevent invalid multiple triggering of outline 1027 "Horrible hack used to prevent invalid multiple triggering of outline
898mode from prop-line file-var activation. Used by `allout-mode' function 1028mode from prop-line file-var activation. Used by `allout-mode' function
899to track repeats.") 1029to track repeats.")
900;;;_ > allout-write-file-hook () 1030;;;_ = allout-file-key-verifier-string
901(defun allout-write-file-hook () 1031(defvar allout-file-key-verifier-string nil
902 "In `allout-mode', run as a `write-contents-functions' activity. 1032 "Name for use as a file variable for verifying encryption key across
903 1033sessions.")
904Currently just sets `allout-during-write-cue', so outline change-protection 1034(make-variable-buffer-local 'allout-file-key-verifier-string)
905knows to keep inactive during file write." 1035;;;_ = allout-encryption-scheme
906 (setq allout-during-write-cue t) 1036(defvar allout-encryption-scheme nil
907 nil) 1037 "*Allout outline topic encryption scheme pending for the current buffer.
1038
1039Intended as a file-specific (buffer local) setting, it defaults to the
1040value of allout-default-encryption-scheme if nil.")
1041(make-variable-buffer-local 'allout-encryption-scheme)
1042;;;_ = allout-key-verifier-string
1043(defvar allout-key-verifier-string nil
1044 "Setting used to test solicited encryption keys against that already
1045associated with a file.
1046
1047It consists of an encrypted random string useful only to verify that a key
1048entered by the user is effective for decryption. The key itself is \*not*
1049recorded in the file anywhere, and the encrypted contents are random binary
1050characters to avoid exposing greater susceptibility to search attacks.
1051
1052The verifier string is retained as an Emacs file variable, as well as in
1053the emacs buffer state, if file variable adjustments are enabled. See
1054`allout-enable-file-variable-adjustment' for details about that.")
1055(make-variable-buffer-local 'allout-key-verifier-string)
1056(setq-default allout-key-verifier-string nil)
1057;;;_ = allout-key-hint-string
1058(defvar allout-key-hint-string ""
1059 "Variable used to retain a reminder string for a file's encryption key.
1060
1061See the description of `allout-key-hint-handling' for details about how
1062the reminder is deployed.
1063
1064The hint is retained as an Emacs file variable, as well as in the emacs buffer
1065state, if file variable adjustments are enabled. See
1066`allout-enable-file-variable-adjustment' for details about that.")
1067(make-variable-buffer-local 'allout-key-hint-string)
1068(setq-default allout-key-hint-string "")
1069;;;_ = allout-after-save-decrypt
1070(defvar allout-after-save-decrypt nil
1071 "Internal variable, is nil or has the value of two points:
1072
1073 - the location of a topic to be decrypted after saving is done
1074 - where to situate the cursor after the decryption is performed
1075
1076This is used to decrypt the topic that was currently being edited, if it
1077was encrypted automatically as part of a file write or autosave.")
1078(make-variable-buffer-local 'allout-after-save-decrypt)
1079;;;_ > allout-write-file-hook-handler ()
1080(defun allout-write-file-hook-handler ()
1081 "Implement `allout-encrypt-unencrypted-on-saves' policy for file writes."
1082
1083 (if (or (not (boundp 'allout-encrypt-unencrypted-on-saves))
1084 (not allout-encrypt-unencrypted-on-saves))
1085 nil
1086 (let ((except-mark (and (equal allout-encrypt-unencrypted-on-saves
1087 'except-current)
1088 (point-marker))))
1089 (if (save-excursion (goto-char (point-min))
1090 (allout-next-topic-pending-encryption except-mark))
1091 (progn
1092 (message "auto-encrypting pending topics")
1093 (sit-for 2)
1094 (condition-case failure
1095 (setq allout-after-save-decrypt
1096 (allout-encrypt-decrypted except-mark))
1097 (error (progn
1098 (message
1099 "allout-write-file-hook-handler suppressing error %s"
1100 failure)
1101 (sit-for 2))))))
1102 ))
1103 nil)
1104;;;_ > allout-auto-save-hook-handler ()
1105(defun allout-auto-save-hook-handler ()
1106 "Implement `allout-encrypt-unencrypted-on-saves' policy for auto saves."
1107
1108 (if allout-encrypt-unencrypted-on-saves
1109 ;; Always implement 'except-current policy when enabled.
1110 (let ((allout-encrypt-unencrypted-on-saves 'except-current))
1111 (allout-write-file-hook-handler))))
1112;;;_ > allout-after-saves-handler ()
1113(defun allout-after-saves-handler ()
1114 "Decrypt topic encrypted for save, if it's currently being edited.
1115
1116Ie, if it was pending encryption and contained the point in its body before
1117the save.
1118
1119We use values stored in `allout-after-save-decrypt' to locate the topic
1120and the place for the cursor after the decryption is done."
1121 (if (not (and (allout-mode-p)
1122 (boundp 'allout-after-save-decrypt)
1123 allout-after-save-decrypt))
1124 t
1125 (goto-char (car allout-after-save-decrypt))
1126 (let ((was-modified (buffer-modified-p)))
1127 (allout-toggle-current-subtree-encryption)
1128 (if (not was-modified)
1129 (set-buffer-modified-p nil)))
1130 (goto-char (cadr allout-after-save-decrypt))
1131 (setq allout-after-save-decrypt nil))
1132 )
908 1133
909;;;_ #2 Mode activation 1134;;;_ #2 Mode activation
910;;;_ = allout-mode 1135;;;_ = allout-mode
@@ -916,11 +1141,10 @@ knows to keep inactive during file write."
916 'allout-mode) 1141 'allout-mode)
917;;;_ = allout-explicitly-deactivated 1142;;;_ = allout-explicitly-deactivated
918(defvar allout-explicitly-deactivated nil 1143(defvar allout-explicitly-deactivated nil
919 "Non-nil if `allout-mode' was last deliberately deactivated. 1144 "If t, `allout-mode's last deactivation was deliberate.
920So `allout-post-command-business' should not reactivate it...") 1145So `allout-post-command-business' should not reactivate it...")
921(make-variable-buffer-local 'allout-explicitly-deactivated) 1146(make-variable-buffer-local 'allout-explicitly-deactivated)
922;;;_ > allout-init (&optional mode) 1147;;;_ > allout-init (&optional mode)
923;;;###autoload
924(defun allout-init (&optional mode) 1148(defun allout-init (&optional mode)
925 "Prime `allout-mode' to enable/disable auto-activation, wrt `allout-layout'. 1149 "Prime `allout-mode' to enable/disable auto-activation, wrt `allout-layout'.
926 1150
@@ -939,9 +1163,9 @@ of allout outline mode, contingent to the buffer-specific setting of
939the `allout-layout' variable. (See `allout-layout' and 1163the `allout-layout' variable. (See `allout-layout' and
940`allout-expose-topic' docstrings for more details on auto layout). 1164`allout-expose-topic' docstrings for more details on auto layout).
941 1165
942`allout-init' works by setting up (or removing) 1166`allout-init' works by setting up (or removing) the `allout-mode'
943`allout-find-file-hook' in `find-file-hook', and giving 1167find-file-hook, and giving `allout-auto-activation' a suitable
944`allout-auto-activation' a suitable setting. 1168setting.
945 1169
946To prime your Emacs session for full auto-outline operation, include 1170To prime your Emacs session for full auto-outline operation, include
947the following two lines in your Emacs init file: 1171the following two lines in your Emacs init file:
@@ -949,32 +1173,35 @@ the following two lines in your Emacs init file:
949\(require 'allout) 1173\(require 'allout)
950\(allout-init t)" 1174\(allout-init t)"
951 1175
952 (interactive 1176 (interactive)
953 (let ((m (completing-read 1177 (if (interactive-p)
954 (concat "Select outline auto setup mode " 1178 (progn
955 "(empty for report, ? for options) ") 1179 (setq mode
956 '(("nil")("full")("activate")("deactivate") 1180 (completing-read
957 ("ask") ("report") ("")) 1181 (concat "Select outline auto setup mode "
958 nil 1182 "(empty for report, ? for options) ")
959 t))) 1183 '(("nil")("full")("activate")("deactivate")
960 (if (string= m "") 'report 1184 ("ask") ("report") (""))
961 (intern-soft m)))) 1185 nil
1186 t))
1187 (if (string= mode "")
1188 (setq mode 'report)
1189 (setq mode (intern-soft mode)))))
962 (let 1190 (let
963 ;; convenience aliases, for consistent ref to respective vars: 1191 ;; convenience aliases, for consistent ref to respective vars:
964 ((hook 'allout-find-file-hook) 1192 ((hook 'allout-find-file-hook)
965 (curr-mode 'allout-auto-activation)) 1193 (curr-mode 'allout-auto-activation))
966 1194
967 (cond ((not mode) 1195 (cond ((not mode)
968 (setq find-file-hook (delq hook find-file-hook)) 1196 (setq find-file-hooks (delq hook find-file-hooks))
969 (if (interactive-p) 1197 (if (interactive-p)
970 (message "Allout outline mode auto-activation inhibited."))) 1198 (message "Allout outline mode auto-activation inhibited.")))
971 ((eq mode 'report) 1199 ((eq mode 'report)
972 (if (memq hook find-file-hook) 1200 (if (not (memq hook find-file-hooks))
973 ;; Just punt and use the reports from each of the modes: 1201 (allout-init nil)
974 (allout-init (symbol-value curr-mode)) 1202 ;; Just punt and use the reports from each of the modes:
975 (allout-init nil) 1203 (allout-init (symbol-value curr-mode))))
976 (message "Allout outline mode auto-activation inhibited."))) 1204 (t (add-hook 'find-file-hooks hook)
977 (t (add-hook 'find-file-hook hook)
978 (set curr-mode ; `set', not `setq'! 1205 (set curr-mode ; `set', not `setq'!
979 (cond ((eq mode 'activate) 1206 (cond ((eq mode 'activate)
980 (message 1207 (message
@@ -1022,10 +1249,11 @@ outline.)
1022 1249
1023In addition to outline navigation and exposure, allout includes: 1250In addition to outline navigation and exposure, allout includes:
1024 1251
1025 - topic-oriented repositioning, cut, and paste 1252 - topic-oriented repositioning, promotion/demotion, cut, and paste
1026 - integral outline exposure-layout 1253 - integral outline exposure-layout
1027 - incremental search with dynamic exposure and reconcealment of hidden text 1254 - incremental search with dynamic exposure and reconcealment of hidden text
1028 - automatic topic-number maintenance 1255 - automatic topic-number maintenance
1256 - easy topic encryption and decryption
1029 - \"Hot-spot\" operation, for single-keystroke maneuvering and 1257 - \"Hot-spot\" operation, for single-keystroke maneuvering and
1030 exposure control. \(See the allout-mode docstring.) 1258 exposure control. \(See the allout-mode docstring.)
1031 1259
@@ -1035,7 +1263,7 @@ Below is a description of the bindings, and then explanation of
1035special `allout-mode' features and terminology. See also the outline 1263special `allout-mode' features and terminology. See also the outline
1036menubar additions for quick reference to many of the features, and see 1264menubar additions for quick reference to many of the features, and see
1037the docstring of the function `allout-init' for instructions on 1265the docstring of the function `allout-init' for instructions on
1038priming your Emacs session for automatic activation of `allout-mode'. 1266priming your emacs session for automatic activation of `allout-mode'.
1039 1267
1040 1268
1041The bindings are dictated by the `allout-keybindings-list' and 1269The bindings are dictated by the `allout-keybindings-list' and
@@ -1048,7 +1276,7 @@ C-c C-p allout-previous-visible-heading | C-c C-i allout-show-children
1048C-c C-u allout-up-current-level | C-c C-s allout-show-current-subtree 1276C-c C-u allout-up-current-level | C-c C-s allout-show-current-subtree
1049C-c C-f allout-forward-current-level | C-c C-o allout-show-current-entry 1277C-c C-f allout-forward-current-level | C-c C-o allout-show-current-entry
1050C-c C-b allout-backward-current-level | ^U C-c C-s allout-show-all 1278C-c C-b allout-backward-current-level | ^U C-c C-s allout-show-all
1051C-c C-e allout-end-of-current-entry | allout-hide-current-leaves 1279C-c C-e allout-end-of-entry | allout-hide-current-leaves
1052C-c C-a allout-beginning-of-current-entry, alternately, goes to hot-spot 1280C-c C-a allout-beginning-of-current-entry, alternately, goes to hot-spot
1053 1281
1054 Topic Header Production: 1282 Topic Header Production:
@@ -1064,7 +1292,7 @@ C-c < allout-shift-out ... less deep.
1064C-c<CR> allout-rebullet-topic Reconcile bullets of topic and its offspring 1292C-c<CR> allout-rebullet-topic Reconcile bullets of topic and its offspring
1065 - distinctive bullets are not changed, others 1293 - distinctive bullets are not changed, others
1066 alternated according to nesting depth. 1294 alternated according to nesting depth.
1067C-c * allout-rebullet-current-heading Prompt for alternate bullet for 1295C-c b allout-rebullet-current-heading Prompt for alternate bullet for
1068 current topic. 1296 current topic.
1069C-c # allout-number-siblings Number bullets of topic and siblings - the 1297C-c # allout-number-siblings Number bullets of topic and siblings - the
1070 offspring are not affected. With repeat 1298 offspring are not affected. With repeat
@@ -1087,8 +1315,8 @@ M-x outlineify-sticky Activate outline mode for current buffer,
1087C-c C-SPC allout-mark-topic 1315C-c C-SPC allout-mark-topic
1088C-c = c allout-copy-exposed-to-buffer 1316C-c = c allout-copy-exposed-to-buffer
1089 Duplicate outline, sans concealed text, to 1317 Duplicate outline, sans concealed text, to
1090 buffer with name derived from derived from 1318 buffer with name derived from derived from that
1091 that of current buffer - \"*XXX exposed*\". 1319 of current buffer - \"*BUFFERNAME exposed*\".
1092C-c = p allout-flatten-exposed-to-buffer 1320C-c = p allout-flatten-exposed-to-buffer
1093 Like above 'copy-exposed', but convert topic 1321 Like above 'copy-exposed', but convert topic
1094 prefixes to section.subsection... numeric 1322 prefixes to section.subsection... numeric
@@ -1096,6 +1324,19 @@ C-c = p allout-flatten-exposed-to-buffer
1096ESC ESC (allout-init t) Setup Emacs session for outline mode 1324ESC ESC (allout-init t) Setup Emacs session for outline mode
1097 auto-activation. 1325 auto-activation.
1098 1326
1327 Encrypted Entries
1328
1329Outline mode supports easily togglable gpg encryption of topics, with
1330niceities like support for symmetric and key-pair modes, key timeout, key
1331consistency checking, user-provided hinting for symmetric key mode, and
1332auto-encryption of topics pending encryption on save. The aim is to enable
1333reliable topic privacy while preventing accidents like neglected
1334encryption, encryption with a mistaken key, forgetting which key was used,
1335and other practical pitfalls.
1336
1337See the `allout-toggle-current-subtree-encryption' function and
1338`allout-encrypt-unencrypted-on-saves' customization variable for details.
1339
1099 HOT-SPOT Operation 1340 HOT-SPOT Operation
1100 1341
1101Hot-spot operation provides a means for easy, single-keystroke outline 1342Hot-spot operation provides a means for easy, single-keystroke outline
@@ -1148,11 +1389,11 @@ Topic text constituents:
1148 1389
1149HEADER: The first line of a topic, include the topic PREFIX and header 1390HEADER: The first line of a topic, include the topic PREFIX and header
1150 text. 1391 text.
1151PREFIX: The leading text of a topic which distinguishes it from 1392PREFIX: The leading text of a topic which distinguishes it from normal
1152 normal text. It has a strict form, which consists of a 1393 text. It has a strict form, which consists of a prefix-lead
1153 prefix-lead string, padding, and a bullet. The bullet may be 1394 string, padding, and a bullet. The bullet may be followed by a
1154 followed by a number, indicating the ordinal number of the 1395 number, indicating the ordinal number of the topic among its
1155 topic among its siblings, a space, and then the header text. 1396 siblings, a space, and then the header text.
1156 1397
1157 The relative length of the PREFIX determines the nesting depth 1398 The relative length of the PREFIX determines the nesting depth
1158 of the topic. 1399 of the topic.
@@ -1223,7 +1464,7 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1223 ;; off on second invocation, so we detect it as best we can, and 1464 ;; off on second invocation, so we detect it as best we can, and
1224 ;; skip everything. 1465 ;; skip everything.
1225 ((and same-complex-command ; Still in same complex command 1466 ((and same-complex-command ; Still in same complex command
1226 ; as last time `allout-mode' invoked. 1467 ; as last time `allout-mode' invoked.
1227 active ; Already activated. 1468 active ; Already activated.
1228 (not explicit-activation) ; Prop-line file-vars don't have args. 1469 (not explicit-activation) ; Prop-line file-vars don't have args.
1229 (string-match "^19.1[89]" ; Bug only known to be in v19.18 and 1470 (string-match "^19.1[89]" ; Bug only known to be in v19.18 and
@@ -1238,6 +1479,19 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1238 ; active state or *de*activation 1479 ; active state or *de*activation
1239 ; specifically requested: 1480 ; specifically requested:
1240 (setq allout-explicitly-deactivated t) 1481 (setq allout-explicitly-deactivated t)
1482 (if (string-match "^18\." emacs-version)
1483 ; Revoke those keys that remain
1484 ; as we set them:
1485 (let ((curr-loc (current-local-map)))
1486 (mapcar (function
1487 (lambda (cell)
1488 (if (eq (lookup-key curr-loc (car cell))
1489 (car (cdr cell)))
1490 (define-key curr-loc (car cell)
1491 (assq (car cell) allout-prior-bindings)))))
1492 allout-added-bindings)
1493 (allout-resumptions 'allout-added-bindings)
1494 (allout-resumptions 'allout-prior-bindings)))
1241 1495
1242 (if allout-old-style-prefixes 1496 (if allout-old-style-prefixes
1243 (progn 1497 (progn
@@ -1246,9 +1500,12 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1246 (allout-resumptions 'selective-display) 1500 (allout-resumptions 'selective-display)
1247 (if (and (boundp 'before-change-functions) before-change-functions) 1501 (if (and (boundp 'before-change-functions) before-change-functions)
1248 (allout-resumptions 'before-change-functions)) 1502 (allout-resumptions 'before-change-functions))
1249 (setq write-contents-functions 1503 (setq local-write-file-hooks
1250 (delq 'allout-write-file-hook 1504 (delq 'allout-write-file-hook-handler
1251 write-contents-functions)) 1505 local-write-file-hooks))
1506 (setq auto-save-hook
1507 (delq 'allout-auto-save-hook-handler
1508 auto-save-hook))
1252 (allout-resumptions 'paragraph-start) 1509 (allout-resumptions 'paragraph-start)
1253 (allout-resumptions 'paragraph-separate) 1510 (allout-resumptions 'paragraph-separate)
1254 (allout-resumptions (if (string-match "^18" emacs-version) 1511 (allout-resumptions (if (string-match "^18" emacs-version)
@@ -1288,25 +1545,27 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1288 (cons '(allout-mode . allout-mode-map) 1545 (cons '(allout-mode . allout-mode-map)
1289 minor-mode-map-alist)))) 1546 minor-mode-map-alist))))
1290 1547
1548 ; V18 minor-mode key bindings:
1549 ; Stash record of added bindings
1550 ; for later revocation:
1551 (allout-resumptions 'allout-added-bindings
1552 (list allout-keybindings-list))
1553 (allout-resumptions 'allout-prior-bindings
1554 (list (current-local-map)))
1291 ; and add them: 1555 ; and add them:
1292 (use-local-map (produce-allout-mode-map allout-keybindings-list 1556 (use-local-map (produce-allout-mode-map allout-keybindings-list
1293 (current-local-map))) 1557 (current-local-map)))
1294 ) 1558 )
1295 1559
1296 ; selective-display is the 1560 ; selective-display is the
1297 ; Emacs conditional exposure 1561 ; emacs conditional exposure
1298 ; mechanism: 1562 ; mechanism:
1299 (allout-resumptions 'selective-display '(t)) 1563 (allout-resumptions 'selective-display '(t))
1300 (if allout-inhibit-protection
1301 t
1302 (allout-resumptions 'before-change-functions
1303 '(allout-before-change-protect)))
1304 (add-hook 'pre-command-hook 'allout-pre-command-business) 1564 (add-hook 'pre-command-hook 'allout-pre-command-business)
1305 (add-hook 'post-command-hook 'allout-post-command-business) 1565 (add-hook 'post-command-hook 'allout-post-command-business)
1306 ; Temporarily set by any outline 1566 (add-hook 'local-write-file-hooks 'allout-write-file-hook-handler)
1307 ; functions that can be trusted to 1567 (make-variable-buffer-local 'auto-save-hook)
1308 ; deal properly with concealed text. 1568 (add-hook 'auto-save-hook 'allout-auto-save-hook-handler)
1309 (add-hook 'write-contents-functions 'allout-write-file-hook)
1310 ; Custom auto-fill func, to support 1569 ; Custom auto-fill func, to support
1311 ; respect for topic headline, 1570 ; respect for topic headline,
1312 ; hanging-indents, etc: 1571 ; hanging-indents, etc:
@@ -1337,7 +1596,8 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1337 (if allout-layout 1596 (if allout-layout
1338 (setq do-layout t)) 1597 (setq do-layout t))
1339 1598
1340 (if allout-isearch-dynamic-expose 1599 (if (and allout-isearch-dynamic-expose
1600 (not (fboundp 'allout-real-isearch-abort)))
1341 (allout-enwrap-isearch)) 1601 (allout-enwrap-isearch))
1342 1602
1343 (run-hooks 'allout-mode-hook) 1603 (run-hooks 'allout-mode-hook)
@@ -1376,7 +1636,6 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1376 ) ; let* 1636 ) ; let*
1377 ) ; defun 1637 ) ; defun
1378;;;_ > allout-minor-mode 1638;;;_ > allout-minor-mode
1379;;; XXX released verion doesn't do this?
1380(defalias 'allout-minor-mode 'allout-mode) 1639(defalias 'allout-minor-mode 'allout-mode)
1381 1640
1382;;;_ #3 Internal Position State-Tracking - "allout-recent-*" funcs 1641;;;_ #3 Internal Position State-Tracking - "allout-recent-*" funcs
@@ -1400,12 +1659,12 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1400 "Buffer point last returned by `allout-end-of-current-subtree'.") 1659 "Buffer point last returned by `allout-end-of-current-subtree'.")
1401(make-variable-buffer-local 'allout-recent-end-of-subtree) 1660(make-variable-buffer-local 'allout-recent-end-of-subtree)
1402;;;_ > allout-prefix-data (beg end) 1661;;;_ > allout-prefix-data (beg end)
1403(defmacro allout-prefix-data (beginning end) 1662(defmacro allout-prefix-data (beg end)
1404 "Register allout-prefix state data - BEGINNING and END of prefix. 1663 "Register allout-prefix state data - BEGINNING and END of prefix.
1405 1664
1406For reference by `allout-recent' funcs. Returns BEGINNING." 1665For reference by `allout-recent' funcs. Returns BEGINNING."
1407 `(setq allout-recent-prefix-end ,end 1666 `(setq allout-recent-prefix-end ,end
1408 allout-recent-prefix-beginning ,beginning)) 1667 allout-recent-prefix-beginning ,beg))
1409;;;_ > allout-recent-depth () 1668;;;_ > allout-recent-depth ()
1410(defmacro allout-recent-depth () 1669(defmacro allout-recent-depth ()
1411 "Return depth of last heading encountered by an outline maneuvering function. 1670 "Return depth of last heading encountered by an outline maneuvering function.
@@ -1612,9 +1871,12 @@ Return the location of the beginning of the heading, or nil if not found."
1612 "Produce a location \"chart\" of subtopics of the containing topic. 1871 "Produce a location \"chart\" of subtopics of the containing topic.
1613 1872
1614Optional argument LEVELS specifies the depth \(relative to start 1873Optional argument LEVELS specifies the depth \(relative to start
1615depth) for the chart. 1874depth) for the chart. Subsequent optional args are not for public
1875use.
1876
1877Point is left at the end of the subtree.
1616 1878
1617Charts are used to capture outline structure, so that outline altering 1879Charts are used to capture outline structure, so that outline-altering
1618routines need assess the structure only once, and then use the chart 1880routines need assess the structure only once, and then use the chart
1619for their elaborate manipulations. 1881for their elaborate manipulations.
1620 1882
@@ -1625,11 +1887,9 @@ list containing, recursively, the charts for the respective subtopics.
1625The chart for a topics' offspring precedes the entry for the topic 1887The chart for a topics' offspring precedes the entry for the topic
1626itself. 1888itself.
1627 1889
1628\(fn &optional LEVELS)" 1890The other function parameters are for internal recursion, and should
1629 1891not be specified by external callers. ORIG-DEPTH is depth of topic at
1630 ;; The other function parameters are for internal recursion, and should 1892starting point, and PREV-DEPTH is depth of prior topic."
1631 ;; not be specified by external callers. ORIG-DEPTH is depth of topic at
1632 ;; starting point, and PREV-DEPTH is depth of prior topic."
1633 1893
1634 (let ((original (not orig-depth)) ; `orig-depth' set only in recursion. 1894 (let ((original (not orig-depth)) ; `orig-depth' set only in recursion.
1635 chart curr-depth) 1895 chart curr-depth)
@@ -1835,11 +2095,18 @@ Returns that character position."
1835 (if (re-search-forward allout-line-boundary-regexp nil 'move) 2095 (if (re-search-forward allout-line-boundary-regexp nil 'move)
1836 (prog1 (goto-char (match-beginning 0)) 2096 (prog1 (goto-char (match-beginning 0))
1837 (allout-prefix-data (match-beginning 2)(match-end 2))))) 2097 (allout-prefix-data (match-beginning 2)(match-end 2)))))
1838;;;_ > allout-end-of-current-subtree () 2098;;;_ > allout-end-of-subtree (&optional current)
1839(defun allout-end-of-current-subtree () 2099(defun allout-end-of-subtree (&optional current)
1840 "Put point at the end of the last leaf in the currently visible topic." 2100 "Put point at the end of the last leaf in the containing topic.
1841 (interactive) 2101
1842 (allout-back-to-current-heading) 2102If optional CURRENT is true (default false), then put point at the end of
2103the containing visible topic.
2104
2105Returns the value of point."
2106 (interactive "P")
2107 (if current
2108 (allout-back-to-current-heading)
2109 (allout-goto-prefix))
1843 (let ((level (allout-recent-depth))) 2110 (let ((level (allout-recent-depth)))
1844 (allout-next-heading) 2111 (allout-next-heading)
1845 (while (and (not (eobp)) 2112 (while (and (not (eobp))
@@ -1851,9 +2118,16 @@ Returns that character position."
1851 '(?\n ?\r)) 2118 '(?\n ?\r))
1852 (forward-char -1)) 2119 (forward-char -1))
1853 (setq allout-recent-end-of-subtree (point)))) 2120 (setq allout-recent-end-of-subtree (point))))
2121;;;_ > allout-end-of-current-subtree ()
2122(defun allout-end-of-current-subtree ()
2123 "Put point at end of last leaf in currently visible containing topic.
2124
2125Returns the value of point."
2126 (interactive)
2127 (allout-end-of-subtree t))
1854;;;_ > allout-beginning-of-current-entry () 2128;;;_ > allout-beginning-of-current-entry ()
1855(defun allout-beginning-of-current-entry () 2129(defun allout-beginning-of-current-entry ()
1856 "When not already there, position point at beginning of current topic's body. 2130 "When not already there, position point at beginning of current topic header.
1857 2131
1858If already there, move cursor to bullet for hot-spot operation. 2132If already there, move cursor to bullet for hot-spot operation.
1859\(See `allout-mode' doc string for details on hot-spot operation.)" 2133\(See `allout-mode' doc string for details on hot-spot operation.)"
@@ -1863,11 +2137,10 @@ If already there, move cursor to bullet for hot-spot operation.
1863 (if (and (interactive-p) 2137 (if (and (interactive-p)
1864 (= (point) start-point)) 2138 (= (point) start-point))
1865 (goto-char (allout-current-bullet-pos))))) 2139 (goto-char (allout-current-bullet-pos)))))
1866;;;_ > allout-end-of-current-entry () 2140;;;_ > allout-end-of-entry ()
1867(defun allout-end-of-current-entry () 2141(defun allout-end-of-entry ()
1868 "Position the point at the end of the current topics' entry." 2142 "Position the point at the end of the current topics' entry."
1869 (interactive) 2143 (interactive)
1870 (allout-show-entry)
1871 (prog1 (allout-pre-next-preface) 2144 (prog1 (allout-pre-next-preface)
1872 (if (and (not (bobp))(looking-at "^$")) 2145 (if (and (not (bobp))(looking-at "^$"))
1873 (forward-char -1)))) 2146 (forward-char -1))))
@@ -1875,9 +2148,27 @@ If already there, move cursor to bullet for hot-spot operation.
1875(defun allout-end-of-current-heading () 2148(defun allout-end-of-current-heading ()
1876 (interactive) 2149 (interactive)
1877 (allout-beginning-of-current-entry) 2150 (allout-beginning-of-current-entry)
1878 (forward-line -1) 2151 (re-search-forward "[\n\r]" nil t)
1879 (end-of-line)) 2152 (forward-char -1))
1880(defalias 'allout-end-of-heading 'allout-end-of-current-heading) 2153(defalias 'allout-end-of-heading 'allout-end-of-current-heading)
2154;;;_ > allout-get-body-text ()
2155(defun allout-get-body-text ()
2156 "Return the unmangled body text of the topic immediately containing point."
2157 (save-excursion
2158 (allout-end-of-prefix)
2159 (if (not (re-search-forward "[\n\r]" nil t))
2160 nil
2161 (backward-char 1)
2162 (let ((pre-body (point)))
2163 (if (not pre-body)
2164 nil
2165 (allout-end-of-entry)
2166 (if (not (= pre-body (point)))
2167 (buffer-substring-no-properties (1+ pre-body) (point))))
2168 )
2169 )
2170 )
2171 )
1881 2172
1882;;;_ - Depth-wise 2173;;;_ - Depth-wise
1883;;;_ > allout-ascend-to-depth (depth) 2174;;;_ > allout-ascend-to-depth (depth)
@@ -1892,12 +2183,16 @@ If already there, move cursor to bullet for hot-spot operation.
1892 (if (= (allout-recent-depth) depth) 2183 (if (= (allout-recent-depth) depth)
1893 (progn (goto-char allout-recent-prefix-beginning) 2184 (progn (goto-char allout-recent-prefix-beginning)
1894 depth) 2185 depth)
1895 (goto-char last-good))))) 2186 (goto-char last-good)
2187 nil))
2188 (if (interactive-p) (allout-end-of-prefix))))
1896;;;_ > allout-ascend () 2189;;;_ > allout-ascend ()
1897(defun allout-ascend () 2190(defun allout-ascend ()
1898 "Ascend one level, returning t if successful, nil if not." 2191 "Ascend one level, returning t if successful, nil if not."
1899 (if (allout-beginning-of-level) 2192 (prog1
1900 (allout-previous-heading))) 2193 (if (allout-beginning-of-level)
2194 (allout-previous-heading))
2195 (if (interactive-p) (allout-end-of-prefix))))
1901;;;_ > allout-descend-to-depth (depth) 2196;;;_ > allout-descend-to-depth (depth)
1902(defun allout-descend-to-depth (depth) 2197(defun allout-descend-to-depth (depth)
1903 "Descend to depth DEPTH within current topic. 2198 "Descend to depth DEPTH within current topic.
@@ -1917,13 +2212,13 @@ Returning depth if successful, nil if not."
1917 nil)) 2212 nil))
1918 ) 2213 )
1919;;;_ > allout-up-current-level (arg &optional dont-complain) 2214;;;_ > allout-up-current-level (arg &optional dont-complain)
1920(defun allout-up-current-level (arg &optional dont-complain interactive) 2215(defun allout-up-current-level (arg &optional dont-complain)
1921 "Move out ARG levels from current visible topic. 2216 "Move out ARG levels from current visible topic.
1922 2217
1923Positions on heading line of containing topic. Error if unable to 2218Positions on heading line of containing topic. Error if unable to
1924ascend that far, or nil if unable to ascend but optional arg 2219ascend that far, or nil if unable to ascend but optional arg
1925DONT-COMPLAIN is non-nil." 2220DONT-COMPLAIN is non-nil."
1926 (interactive "p\np") 2221 (interactive "p")
1927 (allout-back-to-current-heading) 2222 (allout-back-to-current-heading)
1928 (let ((present-level (allout-recent-depth)) 2223 (let ((present-level (allout-recent-depth))
1929 (last-good (point)) 2224 (last-good (point))
@@ -1944,12 +2239,12 @@ DONT-COMPLAIN is non-nil."
1944 (if (or failed 2239 (if (or failed
1945 (> arg 0)) 2240 (> arg 0))
1946 (progn (goto-char last-good) 2241 (progn (goto-char last-good)
1947 (if interactive (allout-end-of-prefix)) 2242 (if (interactive-p) (allout-end-of-prefix))
1948 (if (not dont-complain) 2243 (if (not dont-complain)
1949 (error "Can't ascend past outermost level") 2244 (error "Can't ascend past outermost level")
1950 (if interactive (allout-end-of-prefix)) 2245 (if (interactive-p) (allout-end-of-prefix))
1951 nil)) 2246 nil))
1952 (if interactive (allout-end-of-prefix)) 2247 (if (interactive-p) (allout-end-of-prefix))
1953 allout-recent-prefix-beginning))) 2248 allout-recent-prefix-beginning)))
1954 2249
1955;;;_ - Linear 2250;;;_ - Linear
@@ -1981,7 +2276,7 @@ Return depth if successful, nil otherwise."
1981 nil)))) 2276 nil))))
1982;;;_ > allout-previous-sibling (&optional depth backward) 2277;;;_ > allout-previous-sibling (&optional depth backward)
1983(defun allout-previous-sibling (&optional depth backward) 2278(defun allout-previous-sibling (&optional depth backward)
1984 "Like `allout-forward-current-level', but backwards & respect invisible topics. 2279 "Like `allout-forward-current-level' backwards, respecting invisible topics.
1985 2280
1986Optional DEPTH specifies depth to traverse, default current depth. 2281Optional DEPTH specifies depth to traverse, default current depth.
1987 2282
@@ -2015,7 +2310,7 @@ Presumes point is at the start of a topic prefix."
2015 (let ((depth (allout-depth))) 2310 (let ((depth (allout-depth)))
2016 (while (allout-previous-sibling depth nil)) 2311 (while (allout-previous-sibling depth nil))
2017 (prog1 (allout-recent-depth) 2312 (prog1 (allout-recent-depth)
2018 (allout-end-of-prefix)))) 2313 (if (interactive-p) (allout-end-of-prefix)))))
2019;;;_ > allout-next-visible-heading (arg) 2314;;;_ > allout-next-visible-heading (arg)
2020(defun allout-next-visible-heading (arg) 2315(defun allout-next-visible-heading (arg)
2021 "Move to the next ARG'th visible heading line, backward if arg is negative. 2316 "Move to the next ARG'th visible heading line, backward if arg is negative.
@@ -2053,13 +2348,13 @@ matches)."
2053 (interactive "p") 2348 (interactive "p")
2054 (allout-next-visible-heading (- arg))) 2349 (allout-next-visible-heading (- arg)))
2055;;;_ > allout-forward-current-level (arg) 2350;;;_ > allout-forward-current-level (arg)
2056(defun allout-forward-current-level (arg &optional interactive) 2351(defun allout-forward-current-level (arg)
2057 "Position point at the next heading of the same level. 2352 "Position point at the next heading of the same level.
2058 2353
2059Takes optional repeat-count, goes backward if count is negative. 2354Takes optional repeat-count, goes backward if count is negative.
2060 2355
2061Returns resulting position, else nil if none found." 2356Returns resulting position, else nil if none found."
2062 (interactive "p\np") 2357 (interactive "p")
2063 (let ((start-depth (allout-current-depth)) 2358 (let ((start-depth (allout-current-depth))
2064 (start-point (point)) 2359 (start-point (point))
2065 (start-arg arg) 2360 (start-arg arg)
@@ -2087,7 +2382,7 @@ Returns resulting position, else nil if none found."
2087 (= (allout-recent-depth) start-depth))) 2382 (= (allout-recent-depth) start-depth)))
2088 allout-recent-prefix-beginning 2383 allout-recent-prefix-beginning
2089 (goto-char last-good) 2384 (goto-char last-good)
2090 (if (not interactive) 2385 (if (not (interactive-p))
2091 nil 2386 nil
2092 (allout-end-of-prefix) 2387 (allout-end-of-prefix)
2093 (error "Hit %s level %d topic, traversed %d of %d requested" 2388 (error "Hit %s level %d topic, traversed %d of %d requested"
@@ -2096,10 +2391,10 @@ Returns resulting position, else nil if none found."
2096 (- (abs start-arg) arg) 2391 (- (abs start-arg) arg)
2097 (abs start-arg)))))) 2392 (abs start-arg))))))
2098;;;_ > allout-backward-current-level (arg) 2393;;;_ > allout-backward-current-level (arg)
2099(defun allout-backward-current-level (arg &optional interactive) 2394(defun allout-backward-current-level (arg)
2100 "Inverse of `allout-forward-current-level'." 2395 "Inverse of `allout-forward-current-level'."
2101 (interactive "p\np") 2396 (interactive "p")
2102 (if interactive 2397 (if (interactive-p)
2103 (let ((current-prefix-arg (* -1 arg))) 2398 (let ((current-prefix-arg (* -1 arg)))
2104 (call-interactively 'allout-forward-current-level)) 2399 (call-interactively 'allout-forward-current-level))
2105 (allout-forward-current-level (* -1 arg)))) 2400 (allout-forward-current-level (* -1 arg))))
@@ -2107,121 +2402,6 @@ Returns resulting position, else nil if none found."
2107;;;_ #5 Alteration 2402;;;_ #5 Alteration
2108 2403
2109;;;_ - Fundamental 2404;;;_ - Fundamental
2110;;;_ > allout-before-change-protect (beg end)
2111(defun allout-before-change-protect (beg end)
2112 "Outline before-change hook, regulates changes to concealed text.
2113
2114Reveal concealed text that would be changed by current command, and
2115offer user choice to commit or forego the change. Unchanged text is
2116reconcealed. User has option to have changed text reconcealed.
2117
2118Undo commands are specially treated - the user is not prompted for
2119choice, the undoes are always committed (based on presumption that the
2120things being undone were already subject to this regulation routine),
2121and undoes always leave the changed stuff exposed.
2122
2123Changes to concealed regions are ignored while file is being written.
2124\(This is for the sake of functions that do change the file during
2125writes, like crypt and zip modes.)
2126
2127Locally bound in outline buffers to `before-change-functions', which
2128in Emacs 19 is run before any change to the buffer.
2129
2130Any functions which set [`this-command' to `undo', or which set]
2131`allout-override-protect' non-nil (as does, eg, allout-flag-chars)
2132are exempt from this restriction."
2133 (if (and (allout-mode-p)
2134 ; allout-override-protect
2135 ; set by functions that know what
2136 ; they're doing, eg outline internals:
2137 (not allout-override-protect)
2138 (not allout-during-write-cue)
2139 (save-match-data ; Preserve operation position state.
2140 ; Both beginning and end chars must
2141 ; be exposed:
2142 (save-excursion (if (memq this-command '(newline open-line))
2143 ;; Compensate for stupid Emacs {new,
2144 ;; open-}line display optimization:
2145 (setq beg (1+ beg)
2146 end (1+ end)))
2147 (goto-char beg)
2148 (or (allout-hidden-p)
2149 (and (not (= beg end))
2150 (goto-char end)
2151 (allout-hidden-p))))))
2152 (save-match-data
2153 (if (equal this-command 'undo)
2154 ;; Allow undo without inhibition.
2155 ;; - Undoing new and open-line hits stupid Emacs redisplay
2156 ;; optimization (em 19 cmds.c, ~ line 200).
2157 ;; - Presumably, undoing what was properly protected when
2158 ;; done.
2159 ;; - Undo may be users' only recourse in protection faults.
2160 ;; So, expose what getting changed:
2161 (progn (message "Undo! - exposing concealed target...")
2162 (if (allout-hidden-p)
2163 (allout-show-children))
2164 (message "Undo!"))
2165 (let (response
2166 (rehide-completely (save-excursion (allout-goto-prefix)
2167 (allout-hidden-p)))
2168 rehide-place)
2169
2170 (save-excursion
2171 (if (condition-case err
2172 ;; Condition case to catch keyboard quits during reads.
2173 (progn
2174 ; Give them a peek where
2175 (save-excursion
2176 (if (eolp) (setq rehide-place
2177 (allout-goto-prefix)))
2178 (allout-show-entry))
2179 ; Present the message, but...
2180 ; leave the cursor at the location
2181 ; until they respond:
2182 ; Then interpret the response:
2183 (while
2184 (progn
2185 (message (concat "Change inside concealed"
2186 " region - do it? "
2187 "(n or 'y'/'r'eclose)"))
2188 (setq response (read-char))
2189 (not
2190 (cond ((memq response '(?r ?R))
2191 (setq response 'reclose))
2192 ((memq response '(?y ?Y ? ))
2193 (setq response t))
2194 ((memq response '(?n ?N 127))
2195 (setq response nil)
2196 t)
2197 ((eq response ??)
2198 (message
2199 "`r' means `yes, then reclose'")
2200 nil)
2201 (t (message "Please answer y, n, or r")
2202 (sit-for 1)
2203 nil)))))
2204 response)
2205 ('quit nil))
2206 ; Continue:
2207 (if (eq response 'reclose)
2208 (save-excursion
2209 (if rehide-place (goto-char rehide-place))
2210 (if rehide-completely
2211 (allout-hide-current-entry-completely)
2212 (allout-hide-current-entry)))
2213 (if (allout-ascend-to-depth (1- (allout-recent-depth)))
2214 (allout-show-children)
2215 (allout-show-to-offshoot)))
2216 ; Prevent:
2217 (if rehide-completely
2218 (save-excursion
2219 (if rehide-place (goto-char rehide-place))
2220 (allout-hide-current-entry-completely))
2221 (allout-hide-current-entry))
2222 (error "Change within concealed region prevented"))))))
2223 ) ; if
2224 ) ; defun
2225;;;_ = allout-post-goto-bullet 2405;;;_ = allout-post-goto-bullet
2226(defvar allout-post-goto-bullet nil 2406(defvar allout-post-goto-bullet nil
2227 "Outline internal var, for `allout-pre-command-business' hot-spot operation. 2407 "Outline internal var, for `allout-pre-command-business' hot-spot operation.
@@ -2236,24 +2416,20 @@ are mapped to the command of the corresponding control-key on the
2236(defun allout-post-command-business () 2416(defun allout-post-command-business ()
2237 "Outline `post-command-hook' function. 2417 "Outline `post-command-hook' function.
2238 2418
2239- Null `allout-override-protect', so it's not left open.
2240
2241- Implement (and clear) `allout-post-goto-bullet', for hot-spot 2419- Implement (and clear) `allout-post-goto-bullet', for hot-spot
2242 outline commands. 2420 outline commands.
2243 2421
2244- Massages `buffer-undo-list' so successive, standard character self-inserts 2422- Decrypt topic currently being edited if it was encrypted for a save.
2245 are aggregated. This kludge compensates for lack of undo bunching when 2423
2246 `before-change-functions' is used." 2424- Massage buffer-undo-list so successive, standard character self-inserts are
2425 aggregated. This kludge compensates for lack of undo bunching when
2426 before-change-functions is used."
2247 2427
2248 ; Apply any external change func: 2428 ; Apply any external change func:
2249 (if (not (allout-mode-p)) ; In allout-mode. 2429 (if (not (allout-mode-p)) ; In allout-mode.
2250 nil 2430 nil
2251 (setq allout-override-protect nil)
2252 (if allout-isearch-dynamic-expose 2431 (if allout-isearch-dynamic-expose
2253 (allout-isearch-rectification)) 2432 (allout-isearch-rectification))
2254 (if allout-during-write-cue
2255 ;; Was used by allout-before-change-protect, done with it now:
2256 (setq allout-during-write-cue nil))
2257 ;; Undo bunching business: 2433 ;; Undo bunching business:
2258 (if (and (listp buffer-undo-list) ; Undo history being kept. 2434 (if (and (listp buffer-undo-list) ; Undo history being kept.
2259 (equal this-command 'self-insert-command) 2435 (equal this-command 'self-insert-command)
@@ -2282,6 +2458,11 @@ are mapped to the command of the corresponding control-key on the
2282 (setq buffer-undo-list 2458 (setq buffer-undo-list
2283 (cons (cons prev-from cur-to) 2459 (cons (cons prev-from cur-to)
2284 (cdr (cdr (cdr buffer-undo-list)))))))) 2460 (cdr (cdr (cdr buffer-undo-list))))))))
2461
2462 (if (and (boundp 'allout-after-save-decrypt)
2463 allout-after-save-decrypt)
2464 (allout-after-saves-handler))
2465
2285 ;; Implement -post-goto-bullet, if set: (must be after undo business) 2466 ;; Implement -post-goto-bullet, if set: (must be after undo business)
2286 (if (and allout-post-goto-bullet 2467 (if (and allout-post-goto-bullet
2287 (allout-current-bullet-pos)) 2468 (allout-current-bullet-pos))
@@ -2304,8 +2485,9 @@ outline maneuvering operations by positioning the cursor on the bullet
2304char. When in this mode you can use regular cursor-positioning 2485char. When in this mode you can use regular cursor-positioning
2305command/keystrokes to relocate the cursor off of a bullet character to 2486command/keystrokes to relocate the cursor off of a bullet character to
2306return to regular interpretation of self-insert characters." 2487return to regular interpretation of self-insert characters."
2488
2307 (if (not (allout-mode-p)) 2489 (if (not (allout-mode-p))
2308 ;; Shouldn't be invoked if not in allout allout-mode, but just in case: 2490 ;; Shouldn't be invoked if not in allout-mode, but just in case:
2309 nil 2491 nil
2310 ;; Register isearch status: 2492 ;; Register isearch status:
2311 (if (and (boundp 'isearch-mode) isearch-mode) 2493 (if (and (boundp 'isearch-mode) isearch-mode)
@@ -2317,7 +2499,9 @@ return to regular interpretation of self-insert characters."
2317 (let* ((this-key-num (cond 2499 (let* ((this-key-num (cond
2318 ((numberp last-command-char) 2500 ((numberp last-command-char)
2319 last-command-char) 2501 last-command-char)
2320 ((fboundp 'char-to-int) 2502 ;; Only xemacs has characterp.
2503 ((and (fboundp 'characterp)
2504 (characterp last-command-char))
2321 (char-to-int last-command-char)) 2505 (char-to-int last-command-char))
2322 (t 0))) 2506 (t 0)))
2323 mapped-binding) 2507 mapped-binding)
@@ -2340,7 +2524,7 @@ return to regular interpretation of self-insert characters."
2340 this-command mapped-binding))))))) 2524 this-command mapped-binding)))))))
2341;;;_ > allout-find-file-hook () 2525;;;_ > allout-find-file-hook ()
2342(defun allout-find-file-hook () 2526(defun allout-find-file-hook ()
2343 "Activate `allout-mode' when `allout-auto-activation' & `allout-layout' are non-nil. 2527 "Activate `allout-mode' when `allout-auto-activation', `allout-layout' non-nil.
2344 2528
2345See `allout-init' for setup instructions." 2529See `allout-init' for setup instructions."
2346 (if (and allout-auto-activation 2530 (if (and allout-auto-activation
@@ -2353,7 +2537,7 @@ See `allout-init' for setup instructions."
2353 2537
2354Called as part of `allout-post-command-business'." 2538Called as part of `allout-post-command-business'."
2355 2539
2356 (let ((isearching isearch-mode)) 2540 (let ((isearching (and (boundp 'isearch-mode) isearch-mode)))
2357 (cond ((and isearching (not allout-pre-was-isearching)) 2541 (cond ((and isearching (not allout-pre-was-isearching))
2358 (allout-isearch-expose 'start)) 2542 (allout-isearch-expose 'start))
2359 ((and isearching allout-pre-was-isearching) 2543 ((and isearching allout-pre-was-isearching)
@@ -2361,24 +2545,11 @@ Called as part of `allout-post-command-business'."
2361 ((and (not isearching) allout-pre-was-isearching) 2545 ((and (not isearching) allout-pre-was-isearching)
2362 (allout-isearch-expose 'final)) 2546 (allout-isearch-expose 'final))
2363 ;; Not and wasn't isearching: 2547 ;; Not and wasn't isearching:
2364 (t (setq allout-isearch-prior-pos nil))))) 2548 (t (setq allout-isearch-prior-pos nil)
2549 (setq allout-isearch-did-quit nil)))))
2365;;;_ = allout-isearch-was-font-lock 2550;;;_ = allout-isearch-was-font-lock
2366(defvar allout-isearch-was-font-lock 2551(defvar allout-isearch-was-font-lock
2367 (and (boundp 'font-lock-mode) font-lock-mode)) 2552 (and (boundp 'font-lock-mode) font-lock-mode))
2368
2369;;;_ > allout-flag-region (from to flag)
2370(defmacro allout-flag-region (from to flag)
2371 "Hide or show lines from FROM to TO, via Emacs `selective-display' FLAG char.
2372Ie, text following flag C-m \(carriage-return) is hidden until the
2373next C-j (newline) char.
2374
2375Returns the endpoint of the region."
2376 `(let ((buffer-read-only nil)
2377 (allout-override-protect t))
2378 (subst-char-in-region ,from ,to
2379 (if (= ,flag ?\n) ?\r ?\n)
2380 ,flag t)))
2381
2382;;;_ > allout-isearch-expose (mode) 2553;;;_ > allout-isearch-expose (mode)
2383(defun allout-isearch-expose (mode) 2554(defun allout-isearch-expose (mode)
2384 "MODE is either 'clear, 'start, 'continue, or 'final." 2555 "MODE is either 'clear, 'start, 'continue, or 'final."
@@ -2403,21 +2574,56 @@ Returns the endpoint of the region."
2403 (setq allout-isearch-prior-pos nil) 2574 (setq allout-isearch-prior-pos nil)
2404 (if (not (eq mode 'final)) 2575 (if (not (eq mode 'final))
2405 (setq allout-isearch-prior-pos (cons (point) (allout-show-entry))) 2576 (setq allout-isearch-prior-pos (cons (point) (allout-show-entry)))
2406 (if isearch-mode-end-hook-quit 2577 (if allout-isearch-did-quit
2407 nil 2578 nil
2408 (setq allout-isearch-prior-pos nil) 2579 (setq allout-isearch-prior-pos nil)
2409 (allout-show-children))))) 2580 (allout-show-children))))
2581 (setq allout-isearch-did-quit nil))
2410;;;_ > allout-enwrap-isearch () 2582;;;_ > allout-enwrap-isearch ()
2411(defun allout-enwrap-isearch () 2583(defun allout-enwrap-isearch ()
2412 "Impose `isearch-abort' wrapper for dynamic exposure in isearch. 2584 "Impose `allout-mode' isearch-abort wrapper for dynamic exposure in isearch.
2413 2585
2414The function checks to ensure that the rebinding is done only once." 2586The function checks to ensure that the rebinding is done only once."
2415 (add-hook 'isearch-mode-end-hook 'allout-isearch-rectification)) 2587
2588 (add-hook 'isearch-mode-end-hook 'allout-isearch-rectification)
2589 (if (fboundp 'allout-real-isearch-abort)
2590 ;;
2591 nil
2592 ; Ensure load of isearch-mode:
2593 (if (or (and (fboundp 'isearch-mode)
2594 (fboundp 'isearch-abort))
2595 (condition-case error
2596 (load-library "isearch-mode")
2597 ('file-error (message
2598 "Skipping isearch-mode provisions - %s '%s'"
2599 (car (cdr error))
2600 (car (cdr (cdr error))))
2601 (sit-for 1)
2602 ;; Inhibit subsequent tries and return nil:
2603 (setq allout-isearch-dynamic-expose nil))))
2604 ;; Isearch-mode loaded, encapsulate specific entry points for
2605 ;; outline dynamic-exposure business:
2606 (progn
2607 ;; stash crucial isearch-mode funcs under known, private
2608 ;; names, then register wrapper functions under the old
2609 ;; names, in their stead:
2610 (fset 'allout-real-isearch-abort (symbol-function 'isearch-abort))
2611 (fset 'isearch-abort 'allout-isearch-abort)))))
2612;;;_ > allout-isearch-abort ()
2613(defun allout-isearch-abort ()
2614 "Wrapper for allout-real-isearch-abort \(which see), to register
2615actual quits."
2616 (interactive)
2617 (setq allout-isearch-did-quit nil)
2618 (condition-case what
2619 (allout-real-isearch-abort)
2620 ('quit (setq allout-isearch-did-quit t)
2621 (signal 'quit nil))))
2416 2622
2417;;; Prevent unnecessary font-lock while isearching! 2623;;; Prevent unnecessary font-lock while isearching!
2418(defvar isearch-was-font-locking nil) 2624(defvar isearch-was-font-locking nil)
2419(defun isearch-inhibit-font-lock () 2625(defun isearch-inhibit-font-lock ()
2420 "Inhibit `font-lock-mode' while isearching - for use on `isearch-mode-hook'." 2626 "Inhibit `font-lock' while isearching - for use on `isearch-mode-hook'."
2421 (if (and (allout-mode-p) (boundp 'font-lock-mode) font-lock-mode) 2627 (if (and (allout-mode-p) (boundp 'font-lock-mode) font-lock-mode)
2422 (setq isearch-was-font-locking t 2628 (setq isearch-was-font-locking t
2423 font-lock-mode nil))) 2629 font-lock-mode nil)))
@@ -2465,6 +2671,14 @@ Offer one suitable for current depth DEPTH as default."
2465 (if prefix 2671 (if prefix
2466 (allout-get-prefix-bullet prefix) 2672 (allout-get-prefix-bullet prefix)
2467 (allout-get-bullet))))) 2673 (allout-get-bullet)))))
2674;;;_ > allout-encrypted-type-prefix (&optional prefix)
2675(defun allout-encrypted-type-prefix (&optional prefix)
2676 "True if current header prefix bullet is for an encrypted entry \(body)."
2677 (and allout-topic-encryption-bullet
2678 (string= allout-topic-encryption-bullet
2679 (if prefix
2680 (allout-get-prefix-bullet prefix)
2681 (allout-get-bullet)))))
2468;;;_ > allout-bullet-for-depth (&optional depth) 2682;;;_ > allout-bullet-for-depth (&optional depth)
2469(defun allout-bullet-for-depth (&optional depth) 2683(defun allout-bullet-for-depth (&optional depth)
2470 "Return outline topic bullet suited to optional DEPTH, or current depth." 2684 "Return outline topic bullet suited to optional DEPTH, or current depth."
@@ -2625,15 +2839,15 @@ index for each successive sibling)."
2625 ((allout-sibling-index)))))) 2839 ((allout-sibling-index))))))
2626 ) 2840 )
2627 ) 2841 )
2628;;;_ > allout-open-topic (relative-depth &optional before use-sib-bullet) 2842;;;_ > allout-open-topic (relative-depth &optional before use_recent_bullet)
2629(defun allout-open-topic (relative-depth &optional before use-sib-bullet) 2843(defun allout-open-topic (relative-depth &optional before use_recent_bullet)
2630 "Open a new topic at depth RELATIVE-DEPTH. 2844 "Open a new topic at depth DEPTH.
2631 2845
2632New topic is situated after current one, unless optional flag BEFORE 2846New topic is situated after current one, unless optional flag BEFORE
2633is non-nil, or unless current line is complete empty (not even 2847is non-nil, or unless current line is complete empty (not even
2634whitespace), in which case open is done on current line. 2848whitespace), in which case open is done on current line.
2635 2849
2636If USE-SIB-BULLET is true, use the bullet of the prior sibling. 2850If USE_RECENT_BULLET is true, offer to use the bullet of the prior sibling.
2637 2851
2638Nuances: 2852Nuances:
2639 2853
@@ -2660,9 +2874,11 @@ Nuances:
2660 (let* ((depth (+ (allout-current-depth) relative-depth)) 2874 (let* ((depth (+ (allout-current-depth) relative-depth))
2661 (opening-on-blank (if (looking-at "^\$") 2875 (opening-on-blank (if (looking-at "^\$")
2662 (not (setq before nil)))) 2876 (not (setq before nil))))
2663 opening-numbered ; Will get while computing ref-topic, below 2877 ;; bunch o vars set while computing ref-topic
2664 ref-depth ; Will get while computing ref-topic, below 2878 opening-numbered
2665 ref-bullet ; Will get while computing ref-topic, next 2879 opening-encrypted
2880 ref-depth
2881 ref-bullet
2666 (ref-topic (save-excursion 2882 (ref-topic (save-excursion
2667 (cond ((< relative-depth 0) 2883 (cond ((< relative-depth 0)
2668 (allout-ascend-to-depth depth)) 2884 (allout-ascend-to-depth depth))
@@ -2680,6 +2896,13 @@ Nuances:
2680 (allout-descend-to-depth depth)) 2896 (allout-descend-to-depth depth))
2681 (if (allout-numbered-type-prefix) 2897 (if (allout-numbered-type-prefix)
2682 allout-numbered-bullet)))) 2898 allout-numbered-bullet))))
2899 (setq opening-encrypted
2900 (save-excursion
2901 (and allout-topic-encryption-bullet
2902 (or (<= relative-depth 0)
2903 (allout-descend-to-depth depth))
2904 (if (allout-numbered-type-prefix)
2905 allout-numbered-bullet))))
2683 (point))) 2906 (point)))
2684 dbl-space 2907 dbl-space
2685 doing-beginning) 2908 doing-beginning)
@@ -2718,19 +2941,24 @@ Nuances:
2718 (if (not (bobp)) 2941 (if (not (bobp))
2719 (allout-previous-heading))) 2942 (allout-previous-heading)))
2720 (if (and before (bobp)) 2943 (if (and before (bobp))
2721 (allout-unprotected (open-line 1)))) 2944 (allout-unprotected (allout-open-line-not-read-only))))
2722 2945
2723 (if (<= relative-depth 0) 2946 (if (<= relative-depth 0)
2724 ;; Not going inwards, don't snug up: 2947 ;; Not going inwards, don't snug up:
2725 (if doing-beginning 2948 (if doing-beginning
2726 (allout-unprotected (open-line (if dbl-space 2 1))) 2949 (allout-unprotected
2950 (if (not dbl-space)
2951 (allout-open-line-not-read-only)
2952 (allout-open-line-not-read-only)
2953 (allout-open-line-not-read-only)))
2727 (if before 2954 (if before
2728 (progn (end-of-line) 2955 (progn (end-of-line)
2729 (allout-pre-next-preface) 2956 (allout-pre-next-preface)
2730 (while (= ?\r (following-char)) 2957 (while (= ?\r (following-char))
2731 (forward-char 1)) 2958 (forward-char 1))
2732 (if (not (looking-at "^$")) 2959 (if (not (looking-at "^$"))
2733 (allout-unprotected (open-line 1)))) 2960 (allout-unprotected
2961 (allout-open-line-not-read-only))))
2734 (allout-end-of-current-subtree))) 2962 (allout-end-of-current-subtree)))
2735 ;; Going inwards - double-space if first offspring is, 2963 ;; Going inwards - double-space if first offspring is,
2736 ;; otherwise snug up. 2964 ;; otherwise snug up.
@@ -2748,38 +2976,47 @@ Nuances:
2748 (progn (forward-line -1) 2976 (progn (forward-line -1)
2749 (looking-at "^\\s-*$")))) 2977 (looking-at "^\\s-*$"))))
2750 (progn (forward-line 1) 2978 (progn (forward-line 1)
2751 (allout-unprotected (open-line 1)))) 2979 (allout-unprotected
2980 (allout-open-line-not-read-only))
2981 (forward-line 1)))
2752 (end-of-line)) 2982 (end-of-line))
2753 ;;(if doing-beginning (goto-char doing-beginning)) 2983 ;;(if doing-beginning (goto-char doing-beginning))
2754 (if (not (bobp)) 2984 (if (not (bobp))
2985 ;; We insert a newline char rather than using open-line to
2986 ;; avoid rear-stickiness inheritence of read-only property.
2755 (progn (if (and (not (> depth ref-depth)) 2987 (progn (if (and (not (> depth ref-depth))
2756 (not before)) 2988 (not before))
2757 (allout-unprotected (open-line 1)) 2989 (allout-unprotected
2990 (allout-open-line-not-read-only))
2758 (if (> depth ref-depth) 2991 (if (> depth ref-depth)
2759 (allout-unprotected (newline 1)) 2992 (allout-unprotected
2993 (allout-open-line-not-read-only))
2760 (if dbl-space 2994 (if dbl-space
2761 (allout-unprotected (open-line 1)) 2995 (allout-unprotected
2996 (allout-open-line-not-read-only))
2762 (if (not before) 2997 (if (not before)
2763 (allout-unprotected (newline 1)))))) 2998 (allout-unprotected (newline 1))))))
2764 (if dbl-space 2999 (if dbl-space
2765 (allout-unprotected (newline 1))) 3000 (allout-unprotected (newline 1)))
2766 (if (and (not (eobp)) 3001 (if (and (not (eobp))
2767 (not (bolp))) 3002 (not (bolp)))
2768 (forward-char 1)))) 3003 (forward-char 1))))
2769 )) 3004 ))
2770 (insert (concat (allout-make-topic-prefix opening-numbered 3005 (insert (concat (allout-make-topic-prefix opening-numbered
2771 t 3006 t
2772 depth) 3007 depth)
2773 " ")) 3008 " "))
2774 3009
2775 ;;(if doing-beginning (save-excursion (newline (if dbl-space 2 1)))) 3010 ;;(if doing-beginning (save-excursion (newline (if dbl-space 2 1))))
2776 3011
2777 3012
2778 (allout-rebullet-heading (and use-sib-bullet ref-bullet);;; solicit 3013 (allout-rebullet-heading (and use_recent_bullet ;;; solicit
3014 ref-bullet)
2779 depth ;;; depth 3015 depth ;;; depth
2780 nil ;;; number-control 3016 nil ;;; number-control
2781 nil ;;; index 3017 nil ;;; index
2782 t) (end-of-line) 3018 t)
3019 (end-of-line)
2783 ) 3020 )
2784 ) 3021 )
2785;;;_ . open-topic contingencies 3022;;;_ . open-topic contingencies
@@ -2795,6 +3032,13 @@ Nuances:
2795;;;_ ; buffer boundaries - special provisions for beginning and end ob 3032;;;_ ; buffer boundaries - special provisions for beginning and end ob
2796;;;_ ; level 1 topics have special provisions also - double space. 3033;;;_ ; level 1 topics have special provisions also - double space.
2797;;;_ ; location of new topic 3034;;;_ ; location of new topic
3035;;;_ > allout-open-line-not-read-only ()
3036(defun allout-open-line-not-read-only ()
3037 "Open line and remove inherited read-only text prop from new char, if any."
3038 (open-line 1)
3039 (if (plist-get (text-properties-at (point)) 'read-only)
3040 (allout-unprotected
3041 (remove-text-properties (point) (+ 1 (point)) '(read-only nil)))))
2798;;;_ > allout-open-subtopic (arg) 3042;;;_ > allout-open-subtopic (arg)
2799(defun allout-open-subtopic (arg) 3043(defun allout-open-subtopic (arg)
2800 "Open new topic header at deeper level than the current one. 3044 "Open new topic header at deeper level than the current one.
@@ -2802,7 +3046,7 @@ Nuances:
2802Negative universal arg means to open deeper, but place the new topic 3046Negative universal arg means to open deeper, but place the new topic
2803prior to the current one." 3047prior to the current one."
2804 (interactive "p") 3048 (interactive "p")
2805 (allout-open-topic 1 (> 0 arg))) 3049 (allout-open-topic 1 (> 0 arg) (< 1 arg)))
2806;;;_ > allout-open-sibtopic (arg) 3050;;;_ > allout-open-sibtopic (arg)
2807(defun allout-open-sibtopic (arg) 3051(defun allout-open-sibtopic (arg)
2808 "Open new topic header at same level as the current one. 3052 "Open new topic header at same level as the current one.
@@ -2812,7 +3056,7 @@ Positive universal arg means to use the bullet of the prior sibling.
2812Negative universal arg means to place the new topic prior to the current 3056Negative universal arg means to place the new topic prior to the current
2813one." 3057one."
2814 (interactive "p") 3058 (interactive "p")
2815 (allout-open-topic 0 (> 0 arg) (< 1 arg))) 3059 (allout-open-topic 0 (> 0 arg) (not (= 1 arg))))
2816;;;_ > allout-open-supertopic (arg) 3060;;;_ > allout-open-supertopic (arg)
2817(defun allout-open-supertopic (arg) 3061(defun allout-open-supertopic (arg)
2818 "Open new topic header at shallower level than the current one. 3062 "Open new topic header at shallower level than the current one.
@@ -2821,7 +3065,7 @@ Negative universal arg means to open shallower, but place the new
2821topic prior to the current one." 3065topic prior to the current one."
2822 3066
2823 (interactive "p") 3067 (interactive "p")
2824 (allout-open-topic -1 (> 0 arg))) 3068 (allout-open-topic -1 (> 0 arg) (< 1 arg)))
2825 3069
2826;;;_ - Outline Alteration 3070;;;_ - Outline Alteration
2827;;;_ : Topic Modification 3071;;;_ : Topic Modification
@@ -2877,15 +3121,15 @@ Note that refill of indented paragraphs is not done."
2877 (setq old-indent-begin (match-beginning 1) 3121 (setq old-indent-begin (match-beginning 1)
2878 old-indent-end (match-end 1)) 3122 old-indent-end (match-end 1))
2879 (not (looking-at allout-regexp))) 3123 (not (looking-at allout-regexp)))
2880 (if (> 0 (setq excess (- (current-column) 3124 (if (> 0 (setq excess (- (- old-indent-end old-indent-begin)
2881 old-margin))) 3125 old-margin)))
2882 ;; Text starts left of old margin - don't adjust: 3126 ;; Text starts left of old margin - don't adjust:
2883 nil 3127 nil
2884 ;; Text was hanging at or right of old left margin - 3128 ;; Text was hanging at or right of old left margin -
2885 ;; reindent it, preserving its existing indentation 3129 ;; reindent it, preserving its existing indentation
2886 ;; beyond the old margin: 3130 ;; beyond the old margin:
2887 (delete-region old-indent-begin old-indent-end) 3131 (delete-region old-indent-begin old-indent-end)
2888 (indent-to (+ new-margin excess))))))))) 3132 (indent-to (+ new-margin excess (current-column))))))))))
2889;;;_ > allout-rebullet-current-heading (arg) 3133;;;_ > allout-rebullet-current-heading (arg)
2890(defun allout-rebullet-current-heading (arg) 3134(defun allout-rebullet-current-heading (arg)
2891 "Solicit new bullet for current visible heading." 3135 "Solicit new bullet for current visible heading."
@@ -2922,28 +3166,30 @@ Note that refill of indented paragraphs is not done."
2922 3166
2923 "Adjust bullet of current topic prefix. 3167 "Adjust bullet of current topic prefix.
2924 3168
3169All args are optional.
3170
2925If SOLICIT is non-nil, then the choice of bullet is solicited from 3171If SOLICIT is non-nil, then the choice of bullet is solicited from
2926user. If it's a character, then that character is offered as the 3172user. If it's a character, then that character is offered as the
2927default, otherwise the one suited to the context \(according to 3173default, otherwise the one suited to the context \(according to
2928distinction or depth) is offered. If non-nil, then the 3174distinction or depth) is offered. If non-nil, then the
2929context-specific bullet is just used. 3175context-specific bullet is just used.
2930 3176
2931Second arg NEW-DEPTH forces the topic prefix to that depth, regardless 3177Second arg DEPTH forces the topic prefix to that depth, regardless
2932of the topic's current depth. 3178of the topic's current depth.
2933 3179
2934Third arg NUMBER-CONTROL can force the prefix to or away from 3180Third arg NUMBER-CONTROL can force the prefix to or away from
2935numbered form. It has effect only if `allout-numbered-bullet' is 3181numbered form. It has effect only if `allout-numbered-bullet' is
2936non-nil and soliciting was not explicitly invoked (via first arg). 3182non-nil and soliciting was not explicitly invoked (via first arg).
2937Its effect, numbering or denumbering, then depends on the setting 3183Its effect, numbering or denumbering, then depends on the setting
2938of the fourth arg, INDEX. 3184of the forth arg, INDEX.
2939 3185
2940If NUMBER-CONTROL is non-nil and fourth arg INDEX is nil, then the 3186If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the
2941prefix of the topic is forced to be non-numbered. Null index and 3187prefix of the topic is forced to be non-numbered. Null index and
2942non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and 3188non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and
2943non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil 3189non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil
2944INDEX is a number, then that number is used for the numbered 3190INDEX is a number, then that number is used for the numbered
2945prefix. Non-nil and non-number means that the index for the 3191prefix. Non-nil and non-number means that the index for the
2946numbered prefix will be derived by `allout-make-topic-prefix'. 3192numbered prefix will be derived by allout-make-topic-prefix.
2947 3193
2948Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding 3194Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding
2949siblings. 3195siblings.
@@ -2986,9 +3232,10 @@ this function."
2986 ; Put in new prefix: 3232 ; Put in new prefix:
2987 (allout-unprotected (insert new-prefix)) 3233 (allout-unprotected (insert new-prefix))
2988 3234
2989 ;; Reindent the body if elected and margin changed: 3235 ;; Reindent the body if elected, margin changed, and not encrypted body:
2990 (if (and allout-reindent-bodies 3236 (if (and allout-reindent-bodies
2991 (not (= new-depth current-depth))) 3237 (not (= new-depth current-depth))
3238 (not (allout-encrypted-topic-p)))
2992 (allout-reindent-body current-depth new-depth)) 3239 (allout-reindent-body current-depth new-depth))
2993 3240
2994 ;; Recursively rectify successive siblings of orig topic if 3241 ;; Recursively rectify successive siblings of orig topic if
@@ -3010,7 +3257,7 @@ this function."
3010 ) ; defun 3257 ) ; defun
3011;;;_ > allout-rebullet-topic (arg) 3258;;;_ > allout-rebullet-topic (arg)
3012(defun allout-rebullet-topic (arg) 3259(defun allout-rebullet-topic (arg)
3013 "Like `allout-rebullet-topic-grunt', but start from topic visible at point. 3260 "Rebullet the visible topic containing point and all contained subtopics.
3014 3261
3015Descends into invisible as well as visible topics, however. 3262Descends into invisible as well as visible topics, however.
3016 3263
@@ -3036,18 +3283,18 @@ With repeat count, shift topic depth by that amount."
3036 starting-point 3283 starting-point
3037 index 3284 index
3038 do-successors) 3285 do-successors)
3286 "Like `allout-rebullet-topic', but on nearest containing topic
3287\(visible or not).
3039 3288
3040 "Rebullet the topic at point, visible or invisible, and all 3289See `allout-rebullet-heading' for rebulleting behavior.
3041contained subtopics. See `allout-rebullet-heading' for rebulleting
3042behavior.
3043 3290
3044Arg RELATIVE-DEPTH means to shift the depth of the entire 3291All arguments are optional.
3045topic that amount.
3046 3292
3047\(fn &optional RELATIVE-DEPTH)" 3293First arg RELATIVE-DEPTH means to shift the depth of the entire
3294topic that amount.
3048 3295
3049 ;; All args except the first one are for internal recursive use by the 3296The rest of the args are for internal recursive use by the function
3050 ;; function itself. 3297itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX."
3051 3298
3052 (let* ((relative-depth (or relative-depth 0)) 3299 (let* ((relative-depth (or relative-depth 0))
3053 (new-depth (allout-depth)) 3300 (new-depth (allout-depth))
@@ -3177,13 +3424,42 @@ rebulleting each topic at this level."
3177 (setq more (allout-next-sibling depth nil)))))) 3424 (setq more (allout-next-sibling depth nil))))))
3178;;;_ > allout-shift-in (arg) 3425;;;_ > allout-shift-in (arg)
3179(defun allout-shift-in (arg) 3426(defun allout-shift-in (arg)
3180 "Increase depth of current heading and any topics collapsed within it." 3427 "Increase depth of current heading and any topics collapsed within it.
3428
3429We disallow shifts that would result in the topic having a depth more than
3430one level greater than the immediately previous topic, to avoid containment
3431discontinuity. The first topic in the file can be adjusted to any positive
3432depth, however."
3181 (interactive "p") 3433 (interactive "p")
3434 (if (> arg 0)
3435 (save-excursion
3436 (allout-back-to-current-heading)
3437 (if (not (bobp))
3438 (let* ((current-depth (allout-recent-depth))
3439 (start-point (point))
3440 (predecessor-depth (progn
3441 (forward-char -1)
3442 (allout-goto-prefix)
3443 (if (< (point) start-point)
3444 (allout-recent-depth)
3445 0))))
3446 (if (and (> predecessor-depth 0)
3447 (> (+ current-depth arg)
3448 (1+ predecessor-depth)))
3449 (error (concat "May not shift deeper than offspring depth"
3450 " of previous topic")))))))
3182 (allout-rebullet-topic arg)) 3451 (allout-rebullet-topic arg))
3183;;;_ > allout-shift-out (arg) 3452;;;_ > allout-shift-out (arg)
3184(defun allout-shift-out (arg) 3453(defun allout-shift-out (arg)
3185 "Decrease depth of current heading and any topics collapsed within it." 3454 "Decrease depth of current heading and any topics collapsed within it.
3455
3456We disallow shifts that would result in the topic having a depth more than
3457one level greater than the immediately previous topic, to avoid containment
3458discontinuity. The first topic in the file can be adjusted to any positive
3459depth, however."
3186 (interactive "p") 3460 (interactive "p")
3461 (if (< arg 0)
3462 (allout-shift-in (* arg -1)))
3187 (allout-rebullet-topic (* arg -1))) 3463 (allout-rebullet-topic (* arg -1)))
3188;;;_ : Surgery (kill-ring) functions with special provisions for outlines: 3464;;;_ : Surgery (kill-ring) functions with special provisions for outlines:
3189;;;_ > allout-kill-line (&optional arg) 3465;;;_ > allout-kill-line (&optional arg)
@@ -3191,24 +3467,56 @@ rebulleting each topic at this level."
3191 "Kill line, adjusting subsequent lines suitably for outline mode." 3467 "Kill line, adjusting subsequent lines suitably for outline mode."
3192 3468
3193 (interactive "*P") 3469 (interactive "*P")
3194 (if (not (and (allout-mode-p) ; active outline mode, 3470
3195 allout-numbered-bullet ; numbers may need adjustment, 3471 (let ((start-point (point))
3196 (bolp) ; may be clipping topic head, 3472 (leading-kill-ring-entry (car kill-ring))
3197 (looking-at allout-regexp))) ; are clipping topic head. 3473 binding)
3198 ;; Above conditions do not obtain - just do a regular kill: 3474
3199 (kill-line arg) 3475 (condition-case err
3200 ;; Ah, have to watch out for adjustments: 3476
3201 (let* ((depth (allout-depth))) 3477 (if (not (and (allout-mode-p) ; active outline mode,
3202 ; Do the kill: 3478 allout-numbered-bullet ; numbers may need adjustment,
3203 (kill-line arg) 3479 (bolp) ; may be clipping topic head,
3480 (looking-at allout-regexp))) ; are clipping topic head.
3481 ;; Above conditions do not obtain - just do a regular kill:
3482 (kill-line arg)
3483 ;; Ah, have to watch out for adjustments:
3484 (let* ((depth (allout-depth))
3485 (start-point (point))
3486 binding)
3487 ; Do the kill, presenting option
3488 ; for read-only text:
3489 (kill-line arg)
3204 ; Provide some feedback: 3490 ; Provide some feedback:
3205 (sit-for 0) 3491 (sit-for 0)
3206 (save-excursion 3492 (save-excursion
3207 ; Start with the topic 3493 ; Start with the topic
3208 ; following killed line: 3494 ; following killed line:
3209 (if (not (looking-at allout-regexp)) 3495 (if (not (looking-at allout-regexp))
3210 (allout-next-heading)) 3496 (allout-next-heading))
3211 (allout-renumber-to-depth depth))))) 3497 (allout-renumber-to-depth depth))))
3498 ;; condition case handler:
3499 (text-read-only
3500 (goto-char start-point)
3501 (setq binding (where-is-internal 'allout-kill-topic nil t))
3502 (cond ((not binding) (setq binding ""))
3503 ((arrayp binding)
3504 (setq binding (mapconcat 'key-description (list binding) ", ")))
3505 (t (setq binding (format "%s" binding))))
3506 ;; ensure prior kill-ring leader is properly restored:
3507 (if (eq leading-kill-ring-entry (cadr kill-ring))
3508 ;; Aborted kill got pushed on front - ditch it:
3509 (pop kill-ring)
3510 ;; Aborted kill got appended to prior - resurrect prior:
3511 (setcar kill-ring leading-kill-ring-entry))
3512 ;; make last-command skip this failed command, so kill-appending
3513 ;; conditions track:
3514 (setq this-command last-command)
3515 (error (concat "read-only text hit - use %s allout-kill-topic to"
3516 " discard collapsed stuff")
3517 binding)))
3518 )
3519 )
3212;;;_ > allout-kill-topic () 3520;;;_ > allout-kill-topic ()
3213(defun allout-kill-topic () 3521(defun allout-kill-topic ()
3214 "Kill topic together with subtopics. 3522 "Kill topic together with subtopics.
@@ -3236,14 +3544,14 @@ Leaves primary topic's trailing vertical whitespace, if any."
3236 (>= (allout-recent-depth) depth)))) 3544 (>= (allout-recent-depth) depth))))
3237 (forward-char 1))) 3545 (forward-char 1)))
3238 3546
3239 (kill-region beg (point)) 3547 (allout-unprotected (kill-region beg (point)))
3240 (sit-for 0) 3548 (sit-for 0)
3241 (save-excursion 3549 (save-excursion
3242 (allout-renumber-to-depth depth)))) 3550 (allout-renumber-to-depth depth))))
3243;;;_ > allout-yank-processing () 3551;;;_ > allout-yank-processing ()
3244(defun allout-yank-processing (&optional arg) 3552(defun allout-yank-processing (&optional arg)
3245 3553
3246 "Incidental outline specific business to be done just after text yanks. 3554 "Incidental outline-specific business to be done just after text yanks.
3247 3555
3248Does depth adjustment of yanked topics, when: 3556Does depth adjustment of yanked topics, when:
3249 3557
@@ -3259,7 +3567,7 @@ header into which it's being yanked.
3259 3567
3260The point is left in front of yanked, adjusted topics, rather than 3568The point is left in front of yanked, adjusted topics, rather than
3261at the end (and vice-versa with the mark). Non-adjusted yanks, 3569at the end (and vice-versa with the mark). Non-adjusted yanks,
3262however, are left exactly like normal, not outline specific yanks." 3570however, are left exactly like normal, non-allout-specific yanks."
3263 3571
3264 (interactive "*P") 3572 (interactive "*P")
3265 ; Get to beginning, leaving 3573 ; Get to beginning, leaving
@@ -3463,6 +3771,60 @@ by pops to non-distinctive yanks. Bug..."
3463;;;_ #6 Exposure Control 3771;;;_ #6 Exposure Control
3464 3772
3465;;;_ - Fundamental 3773;;;_ - Fundamental
3774;;;_ > allout-flag-region (from to flag)
3775(defun allout-flag-region (from to flag)
3776 "Hide or show lines from FROM to TO, via Emacs selective-display FLAG char.
3777Ie, text following flag C-m \(carriage-return) is hidden until the
3778next C-j (newline) char.
3779
3780Returns the endpoint of the region."
3781 ;; "OFR-" prefixes to avoid collisions with vars in code calling the macro.
3782 ;; ie, elisp macro vars are not 'hygenic', so distinct names are necessary.
3783 (let ((was-inhibit-r-o inhibit-read-only)
3784 (was-undo-list buffer-undo-list)
3785 (was-modified (buffer-modified-p))
3786 trans)
3787 (unwind-protect
3788 (save-excursion
3789 (setq inhibit-read-only t)
3790 (setq buffer-undo-list t)
3791 (if (> from to)
3792 (setq trans from from to to trans))
3793 (subst-char-in-region from to
3794 (if (= flag ?\n) ?\r ?\n)
3795 flag t)
3796 ;; adjust character read-protection on all the affected lines.
3797 ;; we handle the region line-by-line.
3798 (goto-char to)
3799 (end-of-line)
3800 (setq to (min (+ 2 (point)) (point-max)))
3801 (goto-char from)
3802 (beginning-of-line)
3803 (while (< (point) to)
3804 ;; handle from start of exposed to beginning of hidden, or eol:
3805 (remove-text-properties (point)
3806 (progn (if (re-search-forward "[\r\n]"
3807 nil t)
3808 (forward-char -1))
3809 (point))
3810 '(read-only nil))
3811 ;; handle from start of hidden, if any, to eol:
3812 (if (and (not (eobp)) (= (char-after (point)) ?\r))
3813 (put-text-property (point) (progn (end-of-line) (point))
3814 'read-only t))
3815 ;; Handle the end-of-line to beginning of next line:
3816 (if (not (eobp))
3817 (progn (forward-char 1)
3818 (remove-text-properties (1- (point)) (point)
3819 '(read-only nil)))))
3820 )
3821 (if (not was-modified)
3822 (set-buffer-modified-p nil))
3823 (setq inhibit-read-only was-inhibit-r-o)
3824 (setq buffer-undo-list was-undo-list)
3825 )
3826 )
3827 )
3466;;;_ > allout-flag-current-subtree (flag) 3828;;;_ > allout-flag-current-subtree (flag)
3467(defun allout-flag-current-subtree (flag) 3829(defun allout-flag-current-subtree (flag)
3468 "Hide or show subtree of currently-visible topic. 3830 "Hide or show subtree of currently-visible topic.
@@ -3471,9 +3833,9 @@ See `allout-flag-region' for more details."
3471 3833
3472 (save-excursion 3834 (save-excursion
3473 (allout-back-to-current-heading) 3835 (allout-back-to-current-heading)
3474 (allout-flag-region (point) 3836 (let ((from (point))
3475 (progn (allout-end-of-current-subtree) (1- (point))) 3837 (to (progn (allout-end-of-current-subtree) (1- (point)))))
3476 flag))) 3838 (allout-flag-region from to flag))))
3477 3839
3478;;;_ - Topic-specific 3840;;;_ - Topic-specific
3479;;;_ > allout-show-entry () 3841;;;_ > allout-show-entry ()
@@ -3482,7 +3844,7 @@ See `allout-flag-region' for more details."
3482 3844
3483This is a way to give restricted peek at a concealed locality without the 3845This is a way to give restricted peek at a concealed locality without the
3484expense of exposing its context, but can leave the outline with aberrant 3846expense of exposing its context, but can leave the outline with aberrant
3485exposure. `allout-hide-current-entry-completely' or `allout-show-to-offshoot' 3847exposure. `allout-hide-current-entry-completely' or `allout-show-offshoot'
3486should be used after the peek to rectify the exposure." 3848should be used after the peek to rectify the exposure."
3487 3849
3488 (interactive) 3850 (interactive)
@@ -3602,7 +3964,7 @@ aberrant exposure states produced by `allout-show-entry'."
3602 (allout-back-to-current-heading) 3964 (allout-back-to-current-heading)
3603 (save-excursion 3965 (save-excursion
3604 (allout-flag-region (point) 3966 (allout-flag-region (point)
3605 (progn (allout-end-of-current-entry) (point)) 3967 (progn (allout-end-of-entry) (point))
3606 ?\r))) 3968 ?\r)))
3607;;;_ > allout-show-current-entry (&optional arg) 3969;;;_ > allout-show-current-entry (&optional arg)
3608(defun allout-show-current-entry (&optional arg) 3970(defun allout-show-current-entry (&optional arg)
@@ -3614,8 +3976,9 @@ aberrant exposure states produced by `allout-show-entry'."
3614 (allout-hide-current-entry) 3976 (allout-hide-current-entry)
3615 (save-excursion 3977 (save-excursion
3616 (allout-flag-region (point) 3978 (allout-flag-region (point)
3617 (progn (allout-end-of-current-entry) (point)) 3979 (progn (allout-end-of-entry) (point))
3618 ?\n)))) 3980 ?\n)
3981 )))
3619;;;_ > allout-hide-current-entry-completely () 3982;;;_ > allout-hide-current-entry-completely ()
3620; ... allout-hide-current-entry-completely also for isearch dynamic exposure: 3983; ... allout-hide-current-entry-completely also for isearch dynamic exposure:
3621(defun allout-hide-current-entry-completely () 3984(defun allout-hide-current-entry-completely ()
@@ -3846,7 +4209,11 @@ Examples:
3846 max-pos))) 4209 max-pos)))
3847;;;_ > allout-old-expose-topic (spec &rest followers) 4210;;;_ > allout-old-expose-topic (spec &rest followers)
3848(defun allout-old-expose-topic (spec &rest followers) 4211(defun allout-old-expose-topic (spec &rest followers)
3849 "Dictate wholesale exposure scheme for current topic, according to SPEC. 4212
4213 "Deprecated. Use `allout-expose-topic' \(with different schema
4214format) instead.
4215
4216Dictate wholesale exposure scheme for current topic, according to SPEC.
3850 4217
3851SPEC is either a number or a list. Optional successive args 4218SPEC is either a number or a list. Optional successive args
3852dictate exposure for subsequent siblings of current topic. 4219dictate exposure for subsequent siblings of current topic.
@@ -3918,9 +4285,6 @@ Optional FOLLOWERS arguments dictate exposure for succeeding siblings."
3918 (allout-old-expose-topic (car followers)) 4285 (allout-old-expose-topic (car followers))
3919 (setq followers (cdr followers))) 4286 (setq followers (cdr followers)))
3920 max-pos)) 4287 max-pos))
3921(make-obsolete 'allout-old-expose-topic
3922 "use `allout-expose-topic' (with different schema format) instead."
3923 "19.23")
3924;;;_ > allout-new-exposure '() 4288;;;_ > allout-new-exposure '()
3925(defmacro allout-new-exposure (&rest spec) 4289(defmacro allout-new-exposure (&rest spec)
3926 "Literal frontend for `allout-expose-topic', doesn't evaluate arguments. 4290 "Literal frontend for `allout-expose-topic', doesn't evaluate arguments.
@@ -3929,6 +4293,8 @@ need not be quoted in `allout-new-exposure'.
3929 4293
3930Cursor is left at start position. 4294Cursor is left at start position.
3931 4295
4296Use this instead of obsolete `allout-exposure'.
4297
3932Examples: 4298Examples:
3933\(allout-new-exposure (-1 () () () 1) 0) 4299\(allout-new-exposure (-1 () () () 1) 0)
3934 Close current topic at current level so only the immediate 4300 Close current topic at current level so only the immediate
@@ -4151,13 +4517,20 @@ header and body. The elements of that list are:
4151 (cdr format))))))) 4517 (cdr format)))))))
4152 ;; Put the list with first at front, to last at back: 4518 ;; Put the list with first at front, to last at back:
4153 (nreverse result)))) 4519 (nreverse result))))
4520;;;_ > my-region-active-p ()
4521(defmacro my-region-active-p ()
4522 (if (fboundp 'region-active-p)
4523 '(region-active-p)
4524 'mark-active))
4154;;;_ > allout-process-exposed (&optional func from to frombuf 4525;;;_ > allout-process-exposed (&optional func from to frombuf
4155;;; tobuf format) 4526;;; tobuf format)
4156(defun allout-process-exposed (&optional func from to frombuf tobuf 4527(defun allout-process-exposed (&optional func from to frombuf tobuf
4157 format start-num) 4528 format &optional start-num)
4158 "Map function on exposed parts of current topic; results to another buffer. 4529 "Map function on exposed parts of current topic; results to another buffer.
4159 4530
4160Apply FUNC to exposed portions FROM position TO position in buffer 4531All args are options; default values itemized below.
4532
4533Apply FUNCTION to exposed portions FROM position TO position in buffer
4161FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an 4534FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an
4162alternate presentation form: 4535alternate presentation form:
4163 4536
@@ -4170,7 +4543,7 @@ alternate presentation form:
4170 except for distinctive bullets. 4543 except for distinctive bullets.
4171 4544
4172Defaults: 4545Defaults:
4173 FUNC: `allout-insert-listified' 4546 FUNCTION: `allout-insert-listified'
4174 FROM: region start, if region active, else start of buffer 4547 FROM: region start, if region active, else start of buffer
4175 TO: region end, if region active, else end of buffer 4548 TO: region end, if region active, else end of buffer
4176 FROMBUF: current buffer 4549 FROMBUF: current buffer
@@ -4219,9 +4592,7 @@ LISTIFIED is a list representing each topic header and body:
4219 4592
4220 \`(depth prefix text)' 4593 \`(depth prefix text)'
4221 4594
4222or 4595or \`(depth prefix text bullet-plus)'
4223
4224 \`(depth prefix text bullet-plus)'
4225 4596
4226If `bullet-plus' is specified, it is inserted just after the entire prefix." 4597If `bullet-plus' is specified, it is inserted just after the entire prefix."
4227 (setq listified (cdr listified)) 4598 (setq listified (cdr listified))
@@ -4237,7 +4608,7 @@ If `bullet-plus' is specified, it is inserted just after the entire prefix."
4237 (while text 4608 (while text
4238 (insert (car text)) 4609 (insert (car text))
4239 (if (setq text (cdr text)) 4610 (if (setq text (cdr text))
4240 (insert "\n"))) 4611 (insert-string "\n")))
4241 (insert "\n"))) 4612 (insert "\n")))
4242;;;_ > allout-copy-exposed-to-buffer (&optional arg tobuf format) 4613;;;_ > allout-copy-exposed-to-buffer (&optional arg tobuf format)
4243(defun allout-copy-exposed-to-buffer (&optional arg tobuf format) 4614(defun allout-copy-exposed-to-buffer (&optional arg tobuf format)
@@ -4440,14 +4811,14 @@ BULLET string, and a list of TEXT strings for the body."
4440 body-content bop) 4811 body-content bop)
4441 ; Do the head line: 4812 ; Do the head line:
4442 (insert (concat "\\OneHeadLine{\\verb\1 " 4813 (insert (concat "\\OneHeadLine{\\verb\1 "
4443 (allout-latex-verb-quote bullet) 4814 (allout-latex-verb-quote bullet)
4444 "\1}{" 4815 "\1}{"
4445 depth 4816 depth
4446 "}{\\verb\1 " 4817 "}{\\verb\1 "
4447 (if head-line 4818 (if head-line
4448 (allout-latex-verb-quote head-line) 4819 (allout-latex-verb-quote head-line)
4449 "") 4820 "")
4450 "\1}\n")) 4821 "\1}\n"))
4451 (if (not body-lines) 4822 (if (not body-lines)
4452 nil 4823 nil
4453 ;;(insert "\\beginlines\n") 4824 ;;(insert "\\beginlines\n")
@@ -4509,7 +4880,615 @@ With repeat count, copy the exposed portions of entire buffer."
4509 (pop-to-buffer buf) 4880 (pop-to-buffer buf)
4510 (goto-char start-pt))) 4881 (goto-char start-pt)))
4511 4882
4512;;;_ #8 miscellaneous 4883;;;_ #8 Encryption
4884;;;_ > allout-toggle-current-subtree-encryption (&optional fetch-key)
4885(defun allout-toggle-current-subtree-encryption (&optional fetch-key)
4886 "Encrypt clear text or decrypt encoded contents of a topic.
4887
4888Contents includes body and subtopics.
4889
4890Currently only GnuPG encryption is supported.
4891
4892\**NOTE WELL** that the encrypted text must be ascii-armored. For gnupg
4893encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file.
4894
4895Both symmetric-key and key-pair encryption is implemented. Symmetric is
4896the default, use a single \(x4) universal argument for keypair mode.
4897
4898Encrypted topic's bullet is set to a `~' to signal that the contents of the
4899topic \(body and subtopics, but not heading) is pending encryption or
4900encrypted. An `*' asterisk immediately after the bullet signals that the
4901body is encrypted, its absence means it's meant to be encrypted but is not
4902- it's \"disclosed\". When a file with disclosed topics is saved, the user
4903prompted for an ok to \(symmetric-key) encrypt the disclosed topics. NOTE
4904WELL that you must explicitly \(re)encrypt key-pair encrypted topics if you
4905want them to continue to be in key-pair mode.
4906
4907Level-1 topics, with prefix consisting solely of an `*' asterisk, cannot be
4908encrypted. If you want to encrypt the contents of a top-level topic, use
4909\\[allout-shift-in] to increase its depth.
4910
4911Failed transformation does not change the an entry being encrypted -
4912instead, the key is re-solicited and the transformation is retried.
4913\\[keyboard-quit] to abort.
4914
4915Decryption does symmetric or key-pair key mode depending on how the text
4916was encrypted. The encryption key is solicited if not currently available
4917from the key cache from a recent prior encryption action.
4918
4919Optional FETCH-KEY universal argument is used for two purposes - to provoke
4920key-pair instead of symmetric encryption, or to provoke clearing of the key
4921cache so keys are freshly fetched.
4922
4923 - Without any universal arguments, then the appropriate key for the is
4924 obtained from the cache, if available, else from the user.
4925
4926 - If FETCH-KEY is the result of one universal argument - ie, equal to 4 -
4927 then key-pair encryption is used.
4928
4929 - With repeated universal argument - equal to 16 - then the key cache is
4930 cleared before any encryption transformations, to force prompting of the
4931 user for the key.
4932
4933The solicited key is retained for reuse in a buffer-specific cache for some
4934set period of time \(default, 60 seconds), after which the string is
4935nulled. `mailcrypt' provides the key caching functionality. You can
4936adjust the key cache timeout by ajdusting the setting of the elisp variable
4937`mc-passwd-timeout'.
4938
4939If the file previously had no associated key, or had a different key than
4940specified, the user is prompted to repeat the new one for corroboration. A
4941random string encrypted by the new key is set on the buffer-specific
4942variable `allout-key-verifier-string', for confirmation of the key when
4943next obtained, before encrypting or decrypting anything with it. This
4944helps avoid mistakenly shifting between keys.
4945
4946If allout customization var `allout-key-verifier-handling' is non-nil, an
4947entry for `allout-key-verifier-string' and its value is added to an Emacs
4948'local variables' section at the end of the file, which is created if
4949necessary. That setting is for retention of the key verifier across emacs
4950sessions.
4951
4952Similarly, `allout-key-hint-string' stores a user-provided reminder about
4953their key, and `allout-key-hint-handling' specifies when the hint is
4954presented, or if key hints are disabled. If enabled \(see the
4955`allout-key-hint-handling' docstring for details), the hint string is
4956stored in the local-variables section of the file, and solicited whenever
4957the key is changed."
4958
4959;;; This routine handles allout-specific business, dispatching
4960;;; encryption-specific business to allout-encrypt-string.
4961
4962 (interactive "P")
4963 (save-excursion
4964 (allout-end-of-prefix t)
4965
4966 (if (= (allout-recent-depth) 1)
4967 (error (concat "Cannot encrypt or decrypt level 1 topics -"
4968 " shift it in to make it encryptable")))
4969
4970 (if (and fetch-key
4971 (not (equal fetch-key '(4))))
4972 (mc-deactivate-passwd))
4973
4974 (let* ((allout-buffer (current-buffer))
4975 ;; Asses location:
4976 (after-bullet-pos (point))
4977 (was-encrypted
4978 (progn (if (= (point-max) after-bullet-pos)
4979 (error "no body to encrypt"))
4980 (looking-at "\\*")))
4981 (was-collapsed (if (not (re-search-forward "[\n\r]" nil t))
4982 nil
4983 (backward-char 1)
4984 (looking-at "\r")))
4985 (subtree-beg (1+ (point)))
4986 (subtree-end (allout-end-of-subtree))
4987 (subject-text (buffer-substring-no-properties subtree-beg
4988 subtree-end))
4989 (subtree-end-char (char-after (1- subtree-end)))
4990 (subtree-trailling-char (char-after subtree-end))
4991 (place-holder (if (or (string= "" subject-text)
4992 (string= "\n" subject-text))
4993 (error "No topic contents to %scrypt"
4994 (if was-encrypted "de" "en"))))
4995 ;; Assess key parameters:
4996 (key-type (or
4997 ;; detect the type by which it is already encrypted
4998 (and was-encrypted
4999 (allout-encrypted-text-type subject-text))
5000 (and (member fetch-key '(4 (4)))
5001 (yes-or-no-p "Use key-pair encryption instead? ")
5002 'keypair)
5003 'symmetric))
5004 (fetch-key (and fetch-key (not (member fetch-key '(16 (16))))))
5005 result-text)
5006
5007 (setq result-text
5008 (allout-encrypt-string subject-text was-encrypted
5009 (current-buffer) key-type fetch-key))
5010
5011 ;; Replace the subtree with the processed product.
5012 (allout-unprotected
5013 (progn
5014 (set-buffer allout-buffer)
5015 (delete-region subtree-beg subtree-end)
5016 (insert result-text)
5017 (if was-collapsed
5018 (allout-flag-region subtree-beg (1- (point)) ?\r))
5019 ;; adjust trailling-blank-lines to preserve topic spacing:
5020 (if (not was-encrypted)
5021 (if (and (member subtree-end-char '(?\r ?\n))
5022 (member subtree-trailling-char '(?\r ?\n)))
5023 (insert subtree-trailling-char)))
5024 ;; Ensure that the item has an encrypted-entry bullet:
5025 (if (not (string= (buffer-substring-no-properties
5026 (1- after-bullet-pos) after-bullet-pos)
5027 allout-topic-encryption-bullet))
5028 (progn (goto-char (1- after-bullet-pos))
5029 (delete-char 1)
5030 (insert allout-topic-encryption-bullet)))
5031 (if was-encrypted
5032 ;; Remove the is-encrypted bullet qualifier:
5033 (progn (goto-char after-bullet-pos)
5034 (delete-char 1))
5035 ;; Add the is-encrypted bullet qualifier:
5036 (goto-char after-bullet-pos)
5037 (insert "*"))
5038 )
5039 )
5040 )
5041 )
5042 )
5043;;;_ > allout-encrypt-string (text decrypt allout-buffer key-type rekey
5044;;; &optional retried verifying)
5045(defun allout-encrypt-string (text decrypt allout-buffer key-type rekey
5046 &optional retried verifying)
5047 "Encrypt or decrypt a string TEXT using KEY.
5048
5049If optional DECRYPT is true (default false), then decrypt instead of
5050encrypt.
5051
5052Optional REKEY (default false) provokes clearing of the key cache to force
5053fresh prompting for the key.
5054
5055Optional RETRIED is for internal use - conveys the number of failed keys have
5056been solicited in sequence leading to this current call.
5057
5058Optional VERIFYING is for internal use, signifying processing of text
5059solely for verification of the cached key.
5060
5061Returns the resulting string, or nil if the transformation fails."
5062
5063 ;; Ensure that we have an alternate handle on the real mc-activate-passwd:
5064 (if (not (fboundp 'real-mc-activate-passwd))
5065 ;; Force loads of the primary mailcrypt packages, so flet below holds.
5066 (progn (require 'mailcrypt)
5067 (load "mc-toplev")
5068 (fset 'real-mc-activate-passwd
5069 (symbol-function 'mc-activate-passwd))))
5070
5071 (if (and rekey (not verifying)) (mc-deactivate-passwd))
5072
5073 (catch 'encryption-failed
5074 (save-excursion
5075
5076 (let* ((mc-default-scheme (or allout-encryption-scheme
5077 allout-default-encryption-scheme))
5078 (id (format "%s-%s" key-type
5079 (or (buffer-file-name allout-buffer)
5080 (buffer-name allout-buffer))))
5081 (cached (real-mc-activate-passwd id nil))
5082 (comment "Processed by allout driving mailcrypt")
5083 key work-buffer result result-text encryption-process-status)
5084
5085 (unwind-protect
5086
5087 ;; Interject our mc-activate-passwd wrapper:
5088 (flet ((mc-activate-passwd (id &optional prompt)
5089 (allout-mc-activate-passwd id prompt)))
5090
5091 (setq work-buffer
5092 (set-buffer (allout-encryption-produce-work-buffer text)))
5093
5094 (cond
5095
5096 ;; symmetric:
5097 ((equal key-type 'symmetric)
5098 (setq key (if verifying
5099 (real-mc-activate-passwd id nil)
5100 (allout-mc-activate-passwd id)))
5101 (setq encryption-process-status
5102 (crypt-encrypt-buffer key decrypt))
5103 (if (zerop encryption-process-status)
5104 t
5105 (if verifying
5106 (throw 'encryption-failed nil)
5107 (mc-deactivate-passwd)
5108 (error "Symmetric-key encryption failed (%s) - wrong key?"
5109 encryption-process-status))))
5110
5111 ;; encrypt 'keypair:
5112 ((not decrypt)
5113 (condition-case result
5114 (mailcrypt-encrypt 1)
5115 (error (mc-deactivate-passwd)
5116 (error "encryption failed: %s"
5117 (cadr result)))))
5118
5119 ;; decrypt 'keypair:
5120 (t (condition-case result
5121 (mc-decrypt)
5122 (error (mc-deactivate-passwd)
5123 (error "decryption failed: %s"
5124 (cadr result))))))
5125
5126 (setq result-text (if (or (equal key-type 'keypair)
5127 (not decrypt))
5128 (buffer-substring 1 (1- (point-max)))
5129 (buffer-string)))
5130 ;; validate result - non-empty
5131 (cond ((not result-text)
5132 (if verifying
5133 nil
5134 ;; Transformation was fruitless - retry with new key.
5135 (mc-deactivate-passwd)
5136 (allout-encrypt-string text allout-buffer decrypt nil
5137 (if retried (1+ retried) 1)
5138 verifying)))
5139
5140 ;; Barf if encryption yields extraordinary control chars:
5141 ((and (not decrypt)
5142 (string-match "[\C-a\C-k\C-o-\C-z\C-@]" result-text))
5143 (error (concat "encryption produced unusable"
5144 " non-armored text - reconfigure!")))
5145
5146 ;; valid result and just verifying or non-symmetric:
5147 ((or verifying (not (equal key-type 'symmetric)))
5148 result-text)
5149
5150 ;; valid result and regular symmetric - situate validator:
5151 (t
5152 ;; valid result and verifier needs to be situated in
5153 ;; allout-buffer:
5154 (set-buffer allout-buffer)
5155 (if (and (or rekey (not cached))
5156 (not (allout-verify-key key allout-buffer)))
5157 (allout-situate-encryption-key-verifier key id))
5158 result-text)
5159 )
5160 )
5161
5162 ;; unwind-protect emergence:
5163 (if work-buffer
5164 (kill-buffer work-buffer))
5165 )
5166 )
5167 )
5168 )
5169 )
5170;;;_ > allout-mc-activate-passwd (id &optional prompt)
5171(defun allout-mc-activate-passwd (id &optional prompt)
5172 "Substituted for mc-activate-passwd during allout outline encryption.
5173
5174We add key-verification to vanilla mc-activate-passwd.
5175
5176We depend in some cases on values of the following allout-encrypt-string
5177internal or prevailing variables:
5178 - key-type - 'symmetric or 'keypair
5179 - id - id associated with current key in key cache
5180 - allout-buffer - where subject text resides
5181 - retried - number of current attempts to obtain this key
5182 - rekey - user asked to present a new key - needs to be confirmed"
5183
5184;; - if we're doing non-symmetric key, just do normal mc-activate-passwd
5185;; - otherwise, if we are have a cached version of the key, then assume
5186;; it's verified and return it
5187;; - otherwise, prompt for a key, and:
5188;; - if we have a key verifier \(a string value which should decrypt
5189;; against a symmetric key), validate against the verifier
5190;; - if successful, return the verified key
5191;; - if unsuccessful:
5192;; - offer to use the new key
5193;; - if accepted, do confirm process
5194;; - if refused, try again until we get a correctly spelled one or the
5195;; user quits
5196;; - if no key verifier, resolicit the key to get corroboration and return
5197;; the corroborated key if spelled identically, or error if not.
5198
5199 (if (not (equal key-type 'symmetric))
5200 ;; do regular mc-activate-passwd on non-symmetric key
5201 (real-mc-activate-passwd id prompt)
5202
5203 ;; Symmetric hereon:
5204
5205 (save-excursion
5206 (set-buffer allout-buffer)
5207 (let* ((hint (if (and (not (string= allout-key-hint-string ""))
5208 (or (equal allout-key-hint-handling 'always)
5209 (and (equal allout-key-hint-handling 'needed)
5210 retried)))
5211 (format " [%s]" allout-key-hint-string)
5212 ""))
5213 (retry-message (if retried (format " (%s retry)" retried) ""))
5214 (prompt-sans-hint (format "'%s' symmetric key%s: "
5215 (buffer-name allout-buffer)
5216 retry-message))
5217 (full-prompt (format "'%s' symmetric key%s%s: "
5218 (buffer-name allout-buffer)
5219 hint retry-message))
5220 (prompt full-prompt)
5221 (verifier-string (allout-get-encryption-key-verifier))
5222 ;; force retention of cached passwords for five minutes while
5223 ;; we're in this particular routine:
5224 (mc-passwd-timeout 300)
5225 (cached (real-mc-activate-passwd id nil))
5226 (got (or cached (real-mc-activate-passwd id full-prompt)))
5227 confirmation)
5228
5229 (if (not got)
5230 nil
5231
5232 ;; Duplicate our handle on the key so it's not clobbered by
5233 ;; deactivate-passwd memory clearing:
5234 (setq got (format "%s" got))
5235
5236 (cond (verifier-string
5237 (if (and (not (allout-encrypt-string
5238 verifier-string 'decrypt allout-buffer
5239 'symmetric nil 0 'verifying))
5240 (if (yes-or-no-p
5241 (concat "Key differs from established"
5242 " - use new one instead? "))
5243 ;; deactivate password for subsequent
5244 ;; confirmation:
5245 (progn (mc-deactivate-passwd)
5246 (setq prompt prompt-sans-hint)
5247 nil)
5248 t))
5249 (progn (mc-deactivate-passwd)
5250 (error "Wrong key."))))
5251 ;; Force confirmation by repetition for new key:
5252 ((or rekey (not cached)) (mc-deactivate-passwd))))
5253 ;; we have a key and it's either verified and cached.
5254 ;; confirmation vs new input - doing mc-activate-passwd will do the
5255 ;; right thing, in either case:
5256 (setq confirmation
5257 (real-mc-activate-passwd id (concat prompt
5258 " ... confirm spelling: ")))
5259 (prog1
5260 (if (equal got confirmation)
5261 confirmation
5262 (if (yes-or-no-p (concat "spelling of original and"
5263 " confirmation differ - retry? "))
5264 (progn (setq retried (if retried (1+ retried) 1))
5265 (mc-deactivate-passwd)
5266 ;; recurse to this routine:
5267 (mc-activate-passwd id prompt-sans-hint))
5268 (mc-deactivate-passwd)
5269 (error "Confirmation failed.")))
5270 ;; reduce opportunity for memory cherry-picking by zeroing duplicate:
5271 (dotimes (i (length got))
5272 (aset got i 0))
5273 )
5274 )
5275 )
5276 )
5277 )
5278;;;_ > allout-encryption-produce-work-buffer (text)
5279(defun allout-encryption-produce-work-buffer (text)
5280 "Establish a new buffer filled with TEXT, for outline encrypion processing.
5281
5282TEXT is massaged so outline collapsing, if any, is removed."
5283 (let ((work-buffer (generate-new-buffer " *allout encryption*")))
5284 (save-excursion
5285 (set-buffer work-buffer)
5286 (insert (subst-char-in-string ?\r ?\n text)))
5287 work-buffer))
5288;;;_ > allout-encrypted-topic-p ()
5289(defun allout-encrypted-topic-p ()
5290 "True if the current topic is encryptable and encrypted."
5291 (save-excursion
5292 (allout-end-of-prefix t)
5293 (and (string= (buffer-substring-no-properties (1- (point)) (point))
5294 allout-topic-encryption-bullet)
5295 (looking-at "\\*"))
5296 )
5297 )
5298;;;_ > allout-encrypted-text-type (text)
5299;;; XXX gpg-specific, not generic!
5300(defun allout-encrypted-text-type (text)
5301 "For gpg encrypted text, return 'symmetric or 'keypair."
5302
5303 ;; Ensure mc-gpg-path has a value:
5304 (if (not (boundp 'mc-gpg-path))
5305 (load-library "mc-gpg"))
5306
5307 (save-excursion
5308 (let* ((work-buffer (set-buffer
5309 (allout-encryption-produce-work-buffer text)))
5310 (result (mc-gpg-process-region (point-min) (point-max)
5311 nil mc-gpg-path
5312 '("--batch" "--decrypt")
5313 'mc-gpg-decrypt-parser
5314 work-buffer nil)))
5315 (cond ((equal (nth 0 result) 'symmetric)
5316 'symmetric)
5317 ((equal (nth 0 result) t)
5318 'keypair)
5319 (t (error "Unrecognized/unsupported encryption type %S"
5320 (nth 0 result))))
5321 )
5322 )
5323 )
5324;;;_ > allout-create-encryption-key-verifier (key id)
5325(defun allout-create-encryption-key-verifier (key id)
5326 "Encrypt a random message for later validation of symmetric key."
5327 ;; use 20 random ascii characters, across the entire ascii range.
5328 (random t)
5329 (let ((spew (make-string 20 ?\0)))
5330 (dotimes (i (length spew))
5331 (aset spew i (1+ (random 254))))
5332 (allout-encrypt-string spew nil nil 'symmetric nil nil t))
5333 )
5334;;;_ > allout-situate-encryption-key-verifier (key id)
5335(defun allout-situate-encryption-key-verifier (key id)
5336 "Establish key verifier string on file variable.
5337
5338We also prompt for and situate a new reminder, if reminders are enabled.
5339
5340We massage the string to simplify programmatic adjustment. File variable
5341is `allout-file-key-verifier-string'."
5342 (let ((verifier-string
5343 ;; Collapse to a single line and enclose in string quotes:
5344 (subst-char-in-string ?\n ?\C-a
5345 (allout-create-encryption-key-verifier
5346 key id)))
5347 (reminder (if (not (equal allout-key-hint-handling 'disabled))
5348 (read-from-minibuffer
5349 "Key hint to jog your memory next time: "
5350 allout-key-hint-string))))
5351 (setq allout-key-verifier-string verifier-string)
5352 (allout-adjust-file-variable "allout-key-verifier-string"
5353 verifier-string)
5354 (cond ((equal allout-key-hint-handling 'disabled)
5355 nil)
5356 ((not (string= reminder allout-key-hint-string))
5357 (setq allout-key-hint-string reminder)
5358 (allout-adjust-file-variable "allout-key-hint-string"
5359 reminder)))
5360 )
5361 )
5362;;;_ > allout-get-encryption-key-verifier ()
5363(defun allout-get-encryption-key-verifier ()
5364 "Return the text of the encrypt key verifier, unmassaged, or nil if none.
5365
5366Derived from value of `allout-file-key-verifier-string'."
5367
5368 (let ((verifier-string (and (boundp 'allout-key-verifier-string)
5369 allout-key-verifier-string)))
5370 (if verifier-string
5371 ;; Return it uncollapsed
5372 (subst-char-in-string ?\C-a ?\n verifier-string)
5373 nil)
5374 )
5375 )
5376;;;_ > allout-verify-key (key)
5377(defun allout-verify-key (key allout-buffer)
5378 "True if key successfully decrypts key verifier, nil otherwise.
5379
5380\"Otherwise\" includes absence of key verifier."
5381 (save-excursion
5382 (set-buffer allout-buffer)
5383 (and (boundp 'allout-key-verifier-string)
5384 allout-key-verifier-string
5385 (allout-encrypt-string (allout-get-encryption-key-verifier)
5386 'decrypt allout-buffer 'symmetric
5387 nil nil 'verifying)
5388 t)))
5389;;;_ > allout-next-topic-pending-encryption (&optional except-mark)
5390(defun allout-next-topic-pending-encryption (&optional except-mark)
5391 "Return the point of the next topic pending encryption, or nil if none.
5392
5393EXCEPT-MARK identifies a point whose containing topics should be excluded
5394from encryption. This supports 'except-current mode of
5395`allout-encrypt-unencrypted-on-saves'.
5396
5397Such a topic has the allout-topic-encryption-bullet without an
5398immediately following '*' that would mark the topic as being encrypted. It
5399must also have content."
5400 (let (done got content-beg)
5401 (while (not done)
5402
5403 (if (not (re-search-forward
5404 (format "\\(\\`\\|[\n\r]\\)%s *%s[^*]"
5405 (regexp-quote allout-header-prefix)
5406 (regexp-quote allout-topic-encryption-bullet))
5407 nil t))
5408 (setq got nil
5409 done t)
5410 (goto-char (setq got (match-beginning 0)))
5411 (if (looking-at "[\n\r]")
5412 (forward-char 1))
5413 (setq got (point)))
5414
5415 (cond ((not got)
5416 (setq done t))
5417
5418 ((not (re-search-forward "[\n\r]"))
5419 (setq got nil
5420 done t))
5421
5422 ((eobp)
5423 (setq got nil
5424 done t))
5425
5426 (t
5427 (setq content-beg (point))
5428 (backward-char 1)
5429 (allout-end-of-subtree)
5430 (if (or (<= (point) content-beg)
5431 (and except-mark
5432 (<= content-beg except-mark)
5433 (>= (point) except-mark)))
5434 ;; Continue looking
5435 (setq got nil)
5436 ;; Got it!
5437 (setq done t)))
5438 )
5439 )
5440 (if got
5441 (goto-char got))
5442 )
5443 )
5444;;;_ > allout-encrypt-decrypted (&optional except-mark)
5445(defun allout-encrypt-decrypted (&optional except-mark)
5446 "Encrypt topics pending encryption except those containing exemption point.
5447
5448EXCEPT-MARK identifies a point whose containing topics should be excluded
5449from encryption. This supports 'except-current mode of
5450`allout-encrypt-unencrypted-on-saves'.
5451
5452If a topic that is currently being edited was encrypted, we return a list
5453containing the location of the topic and the location of the cursor just
5454before the topic was encrypted. This can be used, eg, to decrypt the topic
5455and exactly resituate the cursor if this is being done as part of a file
5456save. See `allout-encrypt-unencrypted-on-saves' for more info."
5457
5458 (interactive "p")
5459 (save-excursion
5460 (let ((current-mark (point-marker))
5461 was-modified
5462 bo-subtree
5463 editing-topic editing-point)
5464 (goto-char (point-min))
5465 (while (allout-next-topic-pending-encryption except-mark)
5466 (setq was-modified (buffer-modified-p))
5467 (if (save-excursion
5468 (and (boundp 'allout-encrypt-unencrypted-on-saves)
5469 allout-encrypt-unencrypted-on-saves
5470 (setq bo-subtree (re-search-forward "[\n\r]"))
5471 ;; Not collapsed:
5472 (string= (match-string 0) "\n")
5473 (>= current-mark (point))
5474 (allout-end-of-current-subtree)
5475 (<= current-mark (point))))
5476 (setq editing-topic (point)
5477 ;; we had to wait for this 'til now so prior topics are
5478 ;; encrypted, any relevant text shifts are in place:
5479 editing-point (marker-position current-mark)))
5480 (allout-toggle-current-subtree-encryption)
5481 (if (not was-modified)
5482 (set-buffer-modified-p nil))
5483 )
5484 (if (not was-modified)
5485 (set-buffer-modified-p nil))
5486 (if editing-topic (list editing-topic editing-point))
5487 )
5488 )
5489 )
5490
5491;;;_ #9 miscellaneous
4513;;;_ > allout-mark-topic () 5492;;;_ > allout-mark-topic ()
4514(defun allout-mark-topic () 5493(defun allout-mark-topic ()
4515 "Put the region around topic currently containing point." 5494 "Put the region around topic currently containing point."
@@ -4538,22 +5517,100 @@ setup for auto-startup."
4538 t 5517 t
4539 (allout-open-topic 2) 5518 (allout-open-topic 2)
4540 (insert (concat "Dummy outline topic header - see" 5519 (insert (concat "Dummy outline topic header - see"
4541 "`allout-mode' docstring: `^Hm'.")) 5520 "`allout-mode' docstring: `^Hm'."))
4542 (forward-line 1) 5521 (allout-adjust-file-variable
5522 "allout-layout" (format "%s" (or allout-layout '(-1 : 0)))))))
5523;;;_ > allout-file-vars-section-data ()
5524(defun allout-file-vars-section-data ()
5525 "Return data identifying the file-vars section, or nil if none.
5526
5527Returns list `(beginning-point prefix-string suffix-string)'."
5528 ;; minimally gleaned from emacs 21.4 files.el hack-local-variables function.
5529 (let (beg prefix suffix)
5530 (save-excursion
4543 (goto-char (point-max)) 5531 (goto-char (point-max))
4544 (open-line 1) 5532 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
4545 (allout-open-topic 0) 5533 (if (let ((case-fold-search t))
4546 (insert "Local emacs vars.\n") 5534 (not (search-forward "Local Variables:" nil t)))
4547 (allout-open-topic 1) 5535 nil
4548 (insert "(`allout-layout' is for allout.el allout-mode)\n") 5536 (setq beg (- (point) 16))
4549 (allout-open-topic 0) 5537 (setq suffix (buffer-substring-no-properties
4550 (insert "Local variables:\n") 5538 (point)
4551 (allout-open-topic 0) 5539 (progn (if (re-search-forward "[\n\r]" nil t)
4552 (insert (format "allout-layout: %s\n" 5540 (forward-char -1))
4553 (or allout-layout 5541 (point))))
4554 '(-1 : 0)))) 5542 (setq prefix (buffer-substring-no-properties
4555 (allout-open-topic 0) 5543 (progn (if (re-search-backward "[\n\r]" nil t)
4556 (insert "End:\n")))) 5544 (forward-char 1))
5545 (point))
5546 beg))
5547 (list beg prefix suffix))
5548 )
5549 )
5550 )
5551;;;_ > allout-adjust-file-variable (varname value)
5552(defun allout-adjust-file-variable (varname value)
5553 "Adjust the setting of an emacs file variable named VARNAME to VALUE.
5554
5555This activity is inhibited if either `enable-local-variables'
5556`allout-enable-file-variable-adjustment' are nil.
5557
5558When enabled, an entry for the variable is created if not already present,
5559or changed if established with a different value. The section for the file
5560variables, itself, is created if not already present. When created, the
5561section lines \(including the section line) exist as second-level topics in
5562a top-level topic at the end of the file.
5563
5564enable-local-variables must be true for any of this to happen."
5565 (if (not (and enable-local-variables
5566 allout-enable-file-variable-adjustment))
5567 nil
5568 (save-excursion
5569 (let ((section-data (allout-file-vars-section-data))
5570 beg prefix suffix)
5571 (if section-data
5572 (setq beg (car section-data)
5573 prefix (cadr section-data)
5574 suffix (car (cddr section-data)))
5575 ;; create the section
5576 (goto-char (point-max))
5577 (open-line 1)
5578 (allout-open-topic 0)
5579 (end-of-line)
5580 (insert "Local emacs vars.\n")
5581 (allout-open-topic 1)
5582 (setq beg (point)
5583 suffix ""
5584 prefix (buffer-substring-no-properties (progn
5585 (beginning-of-line)
5586 (point))
5587 beg))
5588 (goto-char beg)
5589 (insert "Local variables:\n")
5590 (allout-open-topic 0)
5591 (insert "End:\n")
5592 )
5593 ;; look for existing entry or create one, leaving point for insertion
5594 ;; of new value:
5595 (goto-char beg)
5596 (allout-show-to-offshoot)
5597 (if (search-forward (concat "\n" prefix varname ":") nil t)
5598 (let* ((value-beg (point))
5599 (line-end (progn (if (re-search-forward "[\n\r]" nil t)
5600 (forward-char -1))
5601 (point)))
5602 (value-end (- line-end (length suffix))))
5603 (if (> value-end value-beg)
5604 (delete-region value-beg value-end)))
5605 (end-of-line)
5606 (open-line 1)
5607 (forward-line 1)
5608 (insert (concat prefix varname ":")))
5609 (insert (format " %S%s" value suffix))
5610 )
5611 )
5612 )
5613 )
4557;;;_ > solicit-char-in-string (prompt string &optional do-defaulting) 5614;;;_ > solicit-char-in-string (prompt string &optional do-defaulting)
4558(defun solicit-char-in-string (prompt string &optional do-defaulting) 5615(defun solicit-char-in-string (prompt string &optional do-defaulting)
4559 "Solicit (with first arg PROMPT) choice of a character from string STRING. 5616 "Solicit (with first arg PROMPT) choice of a character from string STRING.
@@ -4594,8 +5651,7 @@ Optional arg DO-DEFAULTING indicates to accept empty input (CR)."
4594Representations of actual backslashes - '\\\\\\\\' - are left as a 5651Representations of actual backslashes - '\\\\\\\\' - are left as a
4595single backslash. 5652single backslash.
4596 5653
4597\(fn REGEXP)" 5654Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion."
4598;; Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion.
4599 5655
4600 (if (string= regexp "") 5656 (if (string= regexp "")
4601 "" 5657 ""
@@ -4611,11 +5667,6 @@ single backslash.
4611 (regexp-sans-escapes (substring regexp 1))) 5667 (regexp-sans-escapes (substring regexp 1)))
4612 ;; Exclude first char, but maintain count: 5668 ;; Exclude first char, but maintain count:
4613 (regexp-sans-escapes (substring regexp 1) successive-backslashes)))) 5669 (regexp-sans-escapes (substring regexp 1) successive-backslashes))))
4614;;;_ > my-region-active-p ()
4615(defmacro my-region-active-p ()
4616 (if (fboundp 'region-active-p)
4617 '(region-active-p)
4618 'mark-active))
4619;;;_ - add-hook definition for divergent emacsen 5670;;;_ - add-hook definition for divergent emacsen
4620;;;_ > add-hook (hook function &optional append) 5671;;;_ > add-hook (hook function &optional append)
4621(if (not (fboundp 'add-hook)) 5672(if (not (fboundp 'add-hook))
@@ -4636,17 +5687,30 @@ function. If HOOK is void, it is first set to nil."
4636 (if append 5687 (if append
4637 (nconc (symbol-value hook) (list function)) 5688 (nconc (symbol-value hook) (list function))
4638 (cons function (symbol-value hook))))))) 5689 (cons function (symbol-value hook)))))))
5690;;;_ > subst-char-in-string if necessary
5691(if (not (fboundp 'subst-char-in-string))
5692 (defun subst-char-in-string (fromchar tochar string &optional inplace)
5693 "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
5694Unless optional argument INPLACE is non-nil, return a new string."
5695 (let ((i (length string))
5696 (newstr (if inplace string (copy-sequence string))))
5697 (while (> i 0)
5698 (setq i (1- i))
5699 (if (eq (aref newstr i) fromchar)
5700 (aset newstr i tochar)))
5701 newstr)))
5702
4639;;;_ : my-mark-marker to accommodate divergent emacsen: 5703;;;_ : my-mark-marker to accommodate divergent emacsen:
4640(defun my-mark-marker (&optional force buffer) 5704(defun my-mark-marker (&optional force buffer)
4641 "Accommodate the different signature for `mark-marker' across Emacsen. 5705 "Accommodate the different signature for `mark-marker' across Emacsen.
4642 5706
4643XEmacs takes two optional args, while GNU Emacs does not, 5707XEmacs takes two optional args, while mainline GNU Emacs does not,
4644so pass them along when appropriate." 5708so pass them along when appropriate."
4645 (if (featurep 'xemacs) 5709 (if (string-match " XEmacs " emacs-version)
4646 (mark-marker force buffer) 5710 (mark-marker force buffer)
4647 (mark-marker))) 5711 (mark-marker)))
4648 5712
4649;;;_ #9 Under development 5713;;;_ #10 Under development
4650;;;_ > allout-bullet-isearch (&optional bullet) 5714;;;_ > allout-bullet-isearch (&optional bullet)
4651(defun allout-bullet-isearch (&optional bullet) 5715(defun allout-bullet-isearch (&optional bullet)
4652 "Isearch \(regexp) for topic with bullet BULLET." 5716 "Isearch \(regexp) for topic with bullet BULLET."
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 75228288fff..86fa6e489f0 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -198,6 +198,13 @@ following in your `.emacs' file:
198 :group 'bookmark) 198 :group 'bookmark)
199 199
200 200
201(defface bookmark-menu-heading
202 '((t (:inherit font-lock-type-face)))
203 "Face used to highlight the heading in bookmark menu buffers."
204 :group 'bookmark
205 :version "22.1")
206
207
201;;; No user-serviceable parts beyond this point. 208;;; No user-serviceable parts beyond this point.
202 209
203;; Is it XEmacs? 210;; Is it XEmacs?
@@ -211,12 +218,6 @@ following in your `.emacs' file:
211;; suggested for lucid compatibility by david hughes: 218;; suggested for lucid compatibility by david hughes:
212(or (fboundp 'frame-height) (defalias 'frame-height 'screen-height)) 219(or (fboundp 'frame-height) (defalias 'frame-height 'screen-height))
213 220
214;; This variable is probably obsolete now...
215(or (boundp 'baud-rate)
216 ;; some random value higher than 9600
217 (setq baud-rate 19200))
218
219
220 221
221;;; Keymap stuff: 222;;; Keymap stuff:
222 223
@@ -1555,6 +1556,8 @@ deletion, or > if it is flagged for displaying."
1555 (let ((inhibit-read-only t)) 1556 (let ((inhibit-read-only t))
1556 (erase-buffer) 1557 (erase-buffer)
1557 (insert "% Bookmark\n- --------\n") 1558 (insert "% Bookmark\n- --------\n")
1559 (add-text-properties (point-min) (point)
1560 '(font-lock-face bookmark-menu-heading))
1558 (bookmark-maybe-sort-alist) 1561 (bookmark-maybe-sort-alist)
1559 (mapcar 1562 (mapcar
1560 (lambda (full-record) 1563 (lambda (full-record)
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 8fcbe7c0943..c1673508897 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -43,200 +43,208 @@
43;;; for CODATA 1998 see one of 43;;; for CODATA 1998 see one of
44;;; - Journal of Physical and Chemical Reference Data, 28(6), 1713-1852, 1999. 44;;; - Journal of Physical and Chemical Reference Data, 28(6), 1713-1852, 1999.
45;;; - Reviews of Modern Physics, 72(2), 351-495, 2000. 45;;; - Reviews of Modern Physics, 72(2), 351-495, 2000.
46;;; for CODATA 2005 see
46;;; - http://physics.nist.gov/cuu/Constants/index.html 47;;; - http://physics.nist.gov/cuu/Constants/index.html
47 48
48(defvar math-standard-units 49(defvar math-standard-units
49 '( ;; Length 50 '( ;; Length
50 ( m nil "*Meter" ) 51 ( m nil "*Meter" )
51 ( in "2.54 cm" "Inch" ) 52 ( in "2.54 cm" "Inch" )
52 ( ft "12 in" "Foot" ) 53 ( ft "12 in" "Foot" )
53 ( yd "3 ft" "Yard" ) 54 ( yd "3 ft" "Yard" )
54 ( mi "5280 ft" "Mile" ) 55 ( mi "5280 ft" "Mile" )
55 ( au "149597870691 m" "Astronomical Unit" ) ;; NASA JPL (http://neo.jpl.nasa.gov/glossary/au.html) 56 ( au "149597870691 m" "Astronomical Unit" ) ;; NASA JPL (http://neo.jpl.nasa.gov/glossary/au.html)
56 ( lyr "9460536207068016 m" "Light Year" ) 57 ( lyr "9460536207068016 m" "Light Year" )
57 ( pc "206264.80625 au" "Parsec" ) 58 ( pc "206264.80625 au" "Parsec" )
58 ( nmi "1852 m" "Nautical Mile" ) 59 ( nmi "1852 m" "Nautical Mile" )
59 ( fath "6 ft" "Fathom" ) 60 ( fath "6 ft" "Fathom" )
60 ( u "1 um" "Micron" ) 61 ( mu "1 um" "Micron" )
61 ( mil "in/1000" "Mil" ) 62 ( mil "in/1000" "Mil" )
62 ( point "in/72" "Point (1/72 inch)" ) 63 ( point "in/72" "Point (1/72 inch)" )
63 ( tpt "in/72.27" "Point (TeX conventions)" ) 64 ( Ang "1e-10 m" "Angstrom" )
64 ( Ang "1e-10 m" "Angstrom" ) 65 ( mfi "mi+ft+in" "Miles + feet + inches" )
65 ( mfi "mi+ft+in" "Miles + feet + inches" ) 66 ;; TeX lengths
67 ( texpt "in/72.27" "Point (TeX conventions)" )
68 ( texpc "12 texpt" "Pica" )
69 ( texbp "point" "Big point (TeX conventions)" )
70 ( texdd "1238/1157 texpt" "Didot point" )
71 ( texcc "12 texdd" "Cicero" )
72 ( texsp "1/66536 texpt" "Scaled TeX point" )
66 73
67 ;; Area 74 ;; Area
68 ( hect "10000 m^2" "*Hectare" ) 75 ( hect "10000 m^2" "*Hectare" )
69 ( acre "mi^2 / 640" "Acre" ) 76 ( a "100 m^2" "Are")
70 ( b "1e-28 m^2" "Barn" ) 77 ( acre "mi^2 / 640" "Acre" )
78 ( b "1e-28 m^2" "Barn" )
71 79
72 ;; Volume 80 ;; Volume
73 ( l "1e-3 m^3" "*Liter" ) 81 ( L "1e-3 m^3" "*Liter" )
74 ( L "1e-3 m^3" "Liter" ) 82 ( l "L" "Liter" )
75 ( gal "4 qt" "US Gallon" ) 83 ( gal "4 qt" "US Gallon" )
76 ( qt "2 pt" "Quart" ) 84 ( qt "2 pt" "Quart" )
77 ( pt "2 cup" "Pint" ) 85 ( pt "2 cup" "Pint" )
78 ( cup "8 ozfl" "Cup" ) 86 ( cup "8 ozfl" "Cup" )
79 ( ozfl "2 tbsp" "Fluid Ounce" ) 87 ( ozfl "2 tbsp" "Fluid Ounce" )
80 ( floz "2 tbsp" "Fluid Ounce" ) 88 ( floz "2 tbsp" "Fluid Ounce" )
81 ( tbsp "3 tsp" "Tablespoon" ) 89 ( tbsp "3 tsp" "Tablespoon" )
82 ( tsp "4.92892159375 ml" "Teaspoon" ) 90 ( tsp "4.92892159375 ml" "Teaspoon" )
83 ( vol "tsp+tbsp+ozfl+cup+pt+qt+gal" "Gallons + ... + teaspoons" ) 91 ( vol "tsp+tbsp+ozfl+cup+pt+qt+gal" "Gallons + ... + teaspoons" )
84 ( galC "4.54609 l" "Canadian Gallon" ) 92 ( galC "4.54609 L" "Canadian Gallon" )
85 ( galUK "4.546092 l" "UK Gallon" ) 93 ( galUK "4.546092 L" "UK Gallon" )
86 94
87 ;; Time 95 ;; Time
88 ( s nil "*Second" ) 96 ( s nil "*Second" )
89 ( sec "s" "Second" ) 97 ( sec "s" "Second" )
90 ( min "60 s" "Minute" ) 98 ( min "60 s" "Minute" )
91 ( hr "60 min" "Hour" ) 99 ( hr "60 min" "Hour" )
92 ( day "24 hr" "Day" ) 100 ( day "24 hr" "Day" )
93 ( wk "7 day" "Week" ) 101 ( wk "7 day" "Week" )
94 ( hms "wk+day+hr+min+s" "Hours, minutes, seconds" ) 102 ( hms "wk+day+hr+min+s" "Hours, minutes, seconds" )
95 ( yr "365.25 day" "Year" ) 103 ( yr "365.25 day" "Year" )
96 ( Hz "1/s" "Hertz" ) 104 ( Hz "1/s" "Hertz" )
97 105
98 ;; Speed 106 ;; Speed
99 ( mph "mi/hr" "*Miles per hour" ) 107 ( mph "mi/hr" "*Miles per hour" )
100 ( kph "km/hr" "Kilometers per hour" ) 108 ( kph "km/hr" "Kilometers per hour" )
101 ( knot "nmi/hr" "Knot" ) 109 ( knot "nmi/hr" "Knot" )
102 ( c "2.99792458e8 m/s" "Speed of light" ) 110 ( c "299792458 m/s" "Speed of light" ) ;;; CODATA 2005
103 111
104 ;; Acceleration 112 ;; Acceleration
105 ( ga "9.80665 m/s^2" "*\"g\" acceleration" ) 113 ( ga "9.80665 m/s^2" "*\"g\" acceleration" ) ;; CODATA 2005
106 114
107 ;; Mass 115 ;; Mass
108 ( g nil "*Gram" ) 116 ( g nil "*Gram" )
109 ( lb "16 oz" "Pound (mass)" ) 117 ( lb "16 oz" "Pound (mass)" )
110 ( oz "28.349523125 g" "Ounce (mass)" ) 118 ( oz "28.349523125 g" "Ounce (mass)" )
111 ( ton "2000 lb" "Ton" ) 119 ( ton "2000 lb" "Ton" )
112 ( tpo "ton+lb+oz" "Tons + pounds + ounces (mass)" ) 120 ( tpo "ton+lb+oz" "Tons + pounds + ounces (mass)" )
113 ( t "1000 kg" "Metric ton" ) 121 ( t "1000 kg" "Metric ton" )
114 ( tonUK "1016.0469088 kg" "UK ton" ) 122 ( tonUK "1016.0469088 kg" "UK ton" )
115 ( lbt "12 ozt" "Troy pound" ) 123 ( lbt "12 ozt" "Troy pound" )
116 ( ozt "31.103475 g" "Troy ounce" ) 124 ( ozt "31.103475 g" "Troy ounce" )
117 ( ct ".2 g" "Carat" ) 125 ( ct ".2 g" "Carat" )
118 ( amu "1.66053873e-27 kg" "Unified atomic mass" ) ;; CODATA 1998 126 ( u "1.66053886e-27 kg" "Unified atomic mass" ) ;; CODATA 2005
119 127
120 ;; Force 128 ;; Force
121 ( N "m kg/s^2" "*Newton" ) 129 ( N "m kg/s^2" "*Newton" )
122 ( dyn "1e-5 N" "Dyne" ) 130 ( dyn "1e-5 N" "Dyne" )
123 ( gf "ga g" "Gram (force)" ) 131 ( gf "ga g" "Gram (force)" )
124 ( lbf "4.44822161526 N" "Pound (force)" ) 132 ( lbf "4.44822161526 N" "Pound (force)" )
125 ( kip "1000 lbf" "Kilopound (force)" ) 133 ( kip "1000 lbf" "Kilopound (force)" )
126 ( pdl "0.138255 N" "Poundal" ) 134 ( pdl "0.138255 N" "Poundal" )
127 135
128 ;; Energy 136 ;; Energy
129 ( J "N m" "*Joule" ) 137 ( J "N m" "*Joule" )
130 ( erg "1e-7 J" "Erg" ) 138 ( erg "1e-7 J" "Erg" )
131 ( cal "4.1868 J" "International Table Calorie" ) 139 ( cal "4.1868 J" "International Table Calorie" )
132 ( Btu "1055.05585262 J" "International Table Btu" ) 140 ( Btu "1055.05585262 J" "International Table Btu" )
133 ( eV "ech V" "Electron volt" ) 141 ( eV "ech V" "Electron volt" )
134 ( ev "eV" "Electron volt" ) 142 ( ev "eV" "Electron volt" )
135 ( therm "105506000 J" "EEC therm" ) 143 ( therm "105506000 J" "EEC therm" )
136 ( invcm "h c/cm" "Energy in inverse centimeters" ) 144 ( invcm "h c/cm" "Energy in inverse centimeters" )
137 ( Kayser "invcm" "Kayser (inverse centimeter energy)" ) 145 ( Kayser "invcm" "Kayser (inverse centimeter energy)" )
138 ( men "100/invcm" "Inverse energy in meters" ) 146 ( men "100/invcm" "Inverse energy in meters" )
139 ( Hzen "h Hz" "Energy in Hertz") 147 ( Hzen "h Hz" "Energy in Hertz")
140 ( Ken "k K" "Energy in Kelvins") 148 ( Ken "k K" "Energy in Kelvins")
141 ( Wh "W hr" "Watt hour") 149 ( Wh "W hr" "Watt hour")
142 ( Ws "W s" "Watt second") 150 ( Ws "W s" "Watt second")
143 151
144 ;; Power 152 ;; Power
145 ( W "J/s" "*Watt" ) 153 ( W "J/s" "*Watt" )
146 ( hp "745.7 W" "Horsepower" ) 154 ( hp "745.7 W" "Horsepower" )
147 155
148 ;; Temperature 156 ;; Temperature
149 ( K nil "*Degree Kelvin" K ) 157 ( K nil "*Degree Kelvin" K )
150 ( dK "K" "Degree Kelvin" K ) 158 ( dK "K" "Degree Kelvin" K )
151 ( degK "K" "Degree Kelvin" K ) 159 ( degK "K" "Degree Kelvin" K )
152 ( dC "K" "Degree Celsius" C ) 160 ( dC "K" "Degree Celsius" C )
153 ( degC "K" "Degree Celsius" C ) 161 ( degC "K" "Degree Celsius" C )
154 ( dF "(5/9) K" "Degree Fahrenheit" F ) 162 ( dF "(5/9) K" "Degree Fahrenheit" F )
155 ( degF "(5/9) K" "Degree Fahrenheit" F ) 163 ( degF "(5/9) K" "Degree Fahrenheit" F )
156 164
157 ;; Pressure 165 ;; Pressure
158 ( Pa "N/m^2" "*Pascal" ) 166 ( Pa "N/m^2" "*Pascal" )
159 ( bar "1e5 Pa" "Bar" ) 167 ( bar "1e5 Pa" "Bar" )
160 ( atm "101325 Pa" "Standard atmosphere" ) 168 ( atm "101325 Pa" "Standard atmosphere" ) ;; CODATA 2005
161 ( torr " 1.333224e2 Pa" "Torr" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html) 169 ( Torr " 1.333224e2 Pa" "Torr" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html)
162 ( mHg "1000 torr" "Meter of mercury" ) 170 ( mHg "1000 Torr" "Meter of mercury" )
163 ( inHg "25.4 mmHg" "Inch of mercury" ) 171 ( inHg "25.4 mmHg" "Inch of mercury" )
164 ( inH2O "2.490889e2 Pa" "Inch of water" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html) 172 ( inH2O "2.490889e2 Pa" "Inch of water" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html)
165 ( psi "6894.75729317 Pa" "Pound per square inch" ) 173 ( psi "6894.75729317 Pa" "Pound per square inch" )
166 174
167 ;; Viscosity 175 ;; Viscosity
168 ( P "0.1 Pa s" "*Poise" ) 176 ( P "0.1 Pa s" "*Poise" )
169 ( St "1e-4 m^2/s" "Stokes" ) 177 ( St "1e-4 m^2/s" "Stokes" )
170 178
171 ;; Electromagnetism 179 ;; Electromagnetism
172 ( A nil "*Ampere" ) 180 ( A nil "*Ampere" )
173 ( C "A s" "Coulomb" ) 181 ( C "A s" "Coulomb" )
174 ( Fdy "ech Nav" "Faraday" ) 182 ( Fdy "ech Nav" "Faraday" )
175 ( e "1.602176462e-19 C" "Elementary charge" ) ;; CODATA 1998 183 ( e "1.60217653e-19 C" "Elementary charge" ) ;; CODATA 2005
176 ( ech "1.602176462e-19 C" "Elementary charge" ) ;; CODATA 1998 184 ( ech "1.60217653e-19 C" "Elementary charge" ) ;; CODATA 2005
177 ( V "W/A" "Volt" ) 185 ( V "W/A" "Volt" )
178 ( ohm "V/A" "Ohm" ) 186 ( ohm "V/A" "Ohm" )
179 ( mho "A/V" "Mho" ) 187 ( mho "A/V" "Mho" )
180 ( S "A/V" "Siemens" ) 188 ( S "A/V" "Siemens" )
181 ( F "C/V" "Farad" ) 189 ( F "C/V" "Farad" )
182 ( H "Wb/A" "Henry" ) 190 ( H "Wb/A" "Henry" )
183 ( T "Wb/m^2" "Tesla" ) 191 ( T "Wb/m^2" "Tesla" )
184 ( G "1e-4 T" "Gauss" ) 192 ( Gs "1e-4 T" "Gauss" )
185 ( Wb "V s" "Weber" ) 193 ( Wb "V s" "Weber" )
186 194
187 ;; Luminous intensity 195 ;; Luminous intensity
188 ( cd nil "*Candela" ) 196 ( cd nil "*Candela" )
189 ( sb "1e4 cd/m^2" "Stilb" ) 197 ( sb "1e4 cd/m^2" "Stilb" )
190 ( lm "cd sr" "Lumen" ) 198 ( lm "cd sr" "Lumen" )
191 ( lx "lm/m^2" "Lux" ) 199 ( lx "lm/m^2" "Lux" )
192 ( ph "1e4 lx" "Phot" ) 200 ( ph "1e4 lx" "Phot" )
193 ( fc "10.76391 lx" "Footcandle" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html) 201 ( fc "10.76391 lx" "Footcandle" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html)
194 ( lam "1e4 lm/m^2" "Lambert" ) 202 ( lam "1e4 lm/m^2" "Lambert" )
195 ( flam "3.426259 cd/m^2" "Footlambert" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html) 203 ( flam "3.426259 cd/m^2" "Footlambert" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html)
196 204
197 ;; Radioactivity 205 ;; Radioactivity
198 ( Bq "1/s" "*Becquerel" ) 206 ( Bq "1/s" "*Becquerel" )
199 ( Ci "3.7e10 Bq" "Curie" ) 207 ( Ci "3.7e10 Bq" "Curie" )
200 ( Gy "J/kg" "Gray" ) 208 ( Gy "J/kg" "Gray" )
201 ( Sv "Gy" "Sievert" ) 209 ( Sv "Gy" "Sievert" )
202 ( R "2.58e-4 C/kg" "Roentgen" ) 210 ( R "2.58e-4 C/kg" "Roentgen" )
203 ( rd ".01 Gy" "Rad" ) 211 ( rd ".01 Gy" "Rad" )
204 ( rem "rd" "Rem" ) 212 ( rem "rd" "Rem" )
205 213
206 ;; Amount of substance 214 ;; Amount of substance
207 ( mol nil "*Mole" ) 215 ( mol nil "*Mole" )
208 216
209 ;; Plane angle 217 ;; Plane angle
210 ( rad nil "*Radian" ) 218 ( rad nil "*Radian" )
211 ( circ "2 pi rad" "Full circle" ) 219 ( circ "2 pi rad" "Full circle" )
212 ( rev "circ" "Full revolution" ) 220 ( rev "circ" "Full revolution" )
213 ( deg "circ/360" "Degree" ) 221 ( deg "circ/360" "Degree" )
214 ( arcmin "deg/60" "Arc minute" ) 222 ( arcmin "deg/60" "Arc minute" )
215 ( arcsec "arcmin/60" "Arc second" ) 223 ( arcsec "arcmin/60" "Arc second" )
216 ( grad "circ/400" "Grade" ) 224 ( grad "circ/400" "Grade" )
217 ( rpm "rev/min" "Revolutions per minute" ) 225 ( rpm "rev/min" "Revolutions per minute" )
218 226
219 ;; Solid angle 227 ;; Solid angle
220 ( sr nil "*Steradian" ) 228 ( sr nil "*Steradian" )
221 229
222 ;; Other physical quantities (CODATA 1998) 230 ;; Other physical quantities
223 ( h "6.62606876e-34 J s" "*Planck's constant" ) 231 ( h "6.6260693e-34 J s" "*Planck's constant" ) ;; CODATA 2005
224 ( hbar "h / 2 pi" "Planck's constant" ) 232 ( hbar "h / 2 pi" "Planck's constant" )
225 ( mu0 "4 pi 1e-7 H/m" "Permeability of vacuum" ) 233 ( mu0 "4 pi 1e-7 H/m" "Permeability of vacuum" )
226 ( Grav "6.673e-11 m^3/kg^1/s^2" "Gravitational constant" ) 234 ( G "6.6742e-11 m^3/kg^1/s^2" "Gravitational constant" ) ;; CODATA 2005
227 ( Nav "6.02214199e23 / mol" "Avagadro's constant" ) 235 ( Nav "6.02214115e23 / mol" "Avagadro's constant" ) ;; CODATA 2005
228 ( me "9.10938188e-31 kg" "Electron rest mass" ) 236 ( me "9.1093826e-31 kg" "Electron rest mass" ) ;; CODATA 2005
229 ( mp "1.67262158e-27 kg" "Proton rest mass" ) 237 ( mp "1.67262171e-27 kg" "Proton rest mass" ) ;; CODATA 2005
230 ( mn "1.67492716e-27 kg" "Neutron rest mass" ) 238 ( mn "1.67492728e-27 kg" "Neutron rest mass" ) ;; CODATA 2005
231 ( mu "1.88353109e-28 kg" "Muon rest mass" ) 239 ( mmu "1.88353140e-28 kg" "Muon rest mass" ) ;; CODATA 2005
232 ( Ryd "10973731.568549 /m" "Rydberg's constant" ) 240 ( Ryd "10973731.568525 /m" "Rydberg's constant" ) ;; CODATA 2005
233 ( k "1.3806503e-23 J/K" "Boltzmann's constant" ) 241 ( k "1.3806505e-23 J/K" "Boltzmann's constant" ) ;; CODATA 2005
234 ( fsc "7.297352533e-3" "Fine structure constant" ) 242 ( alpha "7.297352568e-3" "Fine structure constant" ) ;; CODATA 2005
235 ( muB "927.400899e-26 J/T" "Bohr magneton" ) 243 ( muB "927.400949e-26 J/T" "Bohr magneton" ) ;; CODATA 2005
236 ( muN "5.05078317e-27 J/T" "Nuclear magneton" ) 244 ( muN "5.05078343e-27 J/T" "Nuclear magneton" ) ;; CODATA 2005
237 ( mue "-928.476362e-26 J/T" "Electron magnetic moment" ) 245 ( mue "-928.476412e-26 J/T" "Electron magnetic moment" ) ;; CODATA 2005
238 ( mup "1.410606633e-26 J/T" "Proton magnetic moment" ) 246 ( mup "1.41060671e-26 J/T" "Proton magnetic moment" ) ;; CODATA 2005
239 ( R0 "8.314472 J/mol/K" "Molar gas constant" ) 247 ( R0 "8.314472 J/mol/K" "Molar gas constant" ) ;; CODATA 2005
240 ( V0 "22.710981e-3 m^3/mol" "Standard volume of ideal gas" ))) 248 ( V0 "22.710981e-3 m^3/mol" "Standard volume of ideal gas" )))
241 249
242 250
@@ -247,7 +255,9 @@ If this is changed, be sure to set math-units-table to nil to ensure
247that the combined units table will be rebuilt.") 255that the combined units table will be rebuilt.")
248 256
249(defvar math-unit-prefixes 257(defvar math-unit-prefixes
250 '( ( ?E (float 1 18) "Exa" ) 258 '( ( ?Y (float 1 24) "Yotta" )
259 ( ?Z (float 1 21) "Zetta" )
260 ( ?E (float 1 18) "Exa" )
251 ( ?P (float 1 15) "Peta" ) 261 ( ?P (float 1 15) "Peta" )
252 ( ?T (float 1 12) "Tera" ) 262 ( ?T (float 1 12) "Tera" )
253 ( ?G (float 1 9) "Giga" ) 263 ( ?G (float 1 9) "Giga" )
@@ -265,7 +275,9 @@ that the combined units table will be rebuilt.")
265 ( ?n (float 1 -9) "Nano" ) 275 ( ?n (float 1 -9) "Nano" )
266 ( ?p (float 1 -12) "Pico" ) 276 ( ?p (float 1 -12) "Pico" )
267 ( ?f (float 1 -15) "Femto" ) 277 ( ?f (float 1 -15) "Femto" )
268 ( ?a (float 1 -18) "Atto" ))) 278 ( ?a (float 1 -18) "Atto" )
279 ( ?z (float 1 -21) "zepto" )
280 ( ?y (float 1 -24) "yocto" )))
269 281
270(defvar math-standard-units-systems 282(defvar math-standard-units-systems
271 '( ( base nil ) 283 '( ( base nil )
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 5dba9f7de5d..449efa5fe66 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -47,7 +47,7 @@
47 ;; Create frame-local faces 47 ;; Create frame-local faces
48 (dolist (frame (frame-list)) 48 (dolist (frame (frame-list))
49 (face-spec-set face value frame) 49 (face-spec-set face value frame)
50 (when (memq (window-system frame) '(x w32)) 50 (when (memq (window-system frame) '(x w32 mac))
51 (setq have-window-system t))) 51 (setq have-window-system t)))
52 ;; When making a face after frames already exist 52 ;; When making a face after frames already exist
53 (if have-window-system 53 (if have-window-system
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 0d5d18da191..087cb77f39d 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -293,9 +293,8 @@ modes are restored automatically; they should not be listed here."
293 293
294;; We skip .log files because they are normally temporary. 294;; We skip .log files because they are normally temporary.
295;; (ftp) files because they require passwords and whatnot. 295;; (ftp) files because they require passwords and whatnot.
296;; TAGS files to save time (tags-file-name is saved instead).
297(defcustom desktop-buffers-not-to-save 296(defcustom desktop-buffers-not-to-save
298 "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$" 297 "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\)$"
299 "Regexp identifying buffers that are to be excluded from saving." 298 "Regexp identifying buffers that are to be excluded from saving."
300 :type 'regexp 299 :type 'regexp
301 :group 'desktop) 300 :group 'desktop)
@@ -307,7 +306,9 @@ modes are restored automatically; they should not be listed here."
307 :type 'regexp 306 :type 'regexp
308 :group 'desktop) 307 :group 'desktop)
309 308
310(defcustom desktop-modes-not-to-save nil 309;; We skip TAGS files to save time (tags-file-name is saved instead).
310(defcustom desktop-modes-not-to-save
311 '(tags-table-mode)
311 "List of major modes whose buffers should not be saved." 312 "List of major modes whose buffers should not be saved."
312 :type '(repeat symbol) 313 :type '(repeat symbol)
313 :group 'desktop) 314 :group 'desktop)
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index 778ea092e43..3c862bcc421 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -145,7 +145,7 @@ Valid symbols are `truncation', `wrap', `escape', `control',
145 "Display character C as character SC in the g1 character set. 145 "Display character C as character SC in the g1 character set.
146This function assumes that your terminal uses the SO/SI characters; 146This function assumes that your terminal uses the SO/SI characters;
147it is meaningless for an X frame." 147it is meaningless for an X frame."
148 (if (memq window-system '(x w32)) 148 (if (memq window-system '(x w32 mac))
149 (error "Cannot use string glyphs in a windowing system")) 149 (error "Cannot use string glyphs in a windowing system"))
150 (or standard-display-table 150 (or standard-display-table
151 (setq standard-display-table (make-display-table))) 151 (setq standard-display-table (make-display-table)))
@@ -157,7 +157,7 @@ it is meaningless for an X frame."
157 "Display character C as character GC in graphics character set. 157 "Display character C as character GC in graphics character set.
158This function assumes VT100-compatible escapes; it is meaningless for an 158This function assumes VT100-compatible escapes; it is meaningless for an
159X frame." 159X frame."
160 (if (memq window-system '(x w32)) 160 (if (memq window-system '(x w32 mac))
161 (error "Cannot use string glyphs in a windowing system")) 161 (error "Cannot use string glyphs in a windowing system"))
162 (or standard-display-table 162 (or standard-display-table
163 (setq standard-display-table (make-display-table))) 163 (setq standard-display-table (make-display-table)))
@@ -217,7 +217,7 @@ for users who call this function in `.emacs'."
217 (equal (aref standard-display-table 161) [161]))) 217 (equal (aref standard-display-table 161) [161])))
218 (progn 218 (progn
219 (standard-display-default 160 255) 219 (standard-display-default 160 255)
220 (unless (or (memq window-system '(x w32))) 220 (unless (or (memq window-system '(x w32 mac)))
221 (and (terminal-coding-system) 221 (and (terminal-coding-system)
222 (set-terminal-coding-system nil)))) 222 (set-terminal-coding-system nil))))
223 223
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index dea72fc7567..0cebeeb6f7f 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -141,7 +141,7 @@ See the functions `find-function' and `find-variable'."
141 (unless (string-match "elc" suffix) (push suffix suffixes))))) 141 (unless (string-match "elc" suffix) (push suffix suffixes)))))
142 142
143(defun find-library-name (library) 143(defun find-library-name (library)
144 "Return the full name of the elisp source of LIBRARY." 144 "Return the absolute file name of the Lisp source of LIBRARY."
145 ;; If the library is byte-compiled, try to find a source library by 145 ;; If the library is byte-compiled, try to find a source library by
146 ;; the same name. 146 ;; the same name.
147 (if (string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library) 147 (if (string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library)
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 126c8d50dd9..9c2ac336b9b 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -83,10 +83,14 @@ point (where the PPSS is equivalent to nil).")
83 (setq syntax-ppss-cache (cdr syntax-ppss-cache))) 83 (setq syntax-ppss-cache (cdr syntax-ppss-cache)))
84 ;; Throw away `last' value if made invalid. 84 ;; Throw away `last' value if made invalid.
85 (when (< beg (or (car syntax-ppss-last) 0)) 85 (when (< beg (or (car syntax-ppss-last) 0))
86 (if (< beg (or (car (nth 10 syntax-ppss-last)) 86 ;; If syntax-begin-function jumped to BEG, then the old state at BEG can
87 (nth 9 syntax-ppss-last) 87 ;; depend on the text after BEG (which is presumably changed). So if
88 (nth 2 syntax-ppss-last) 88 ;; BEG=(car (nth 10 syntax-ppss-last)) don't reuse that data because the
89 0)) 89 ;; assumed nil state at BEG may not be valid any more.
90 (if (<= beg (or (car (nth 10 syntax-ppss-last))
91 (nth 9 syntax-ppss-last)
92 (nth 3 syntax-ppss-last)
93 0))
90 (setq syntax-ppss-last nil) 94 (setq syntax-ppss-last nil)
91 (setcar syntax-ppss-last nil))) 95 (setcar syntax-ppss-last nil)))
92 ;; Unregister if there's no cache left. Sadly this doesn't work 96 ;; Unregister if there's no cache left. Sadly this doesn't work
@@ -293,5 +297,5 @@ Point is at POS when this function returns."
293 297
294(provide 'syntax) 298(provide 'syntax)
295 299
296;;; arch-tag: 302f1eeb-e77c-4680-a8c5-c543e01161a5 300;; arch-tag: 302f1eeb-e77c-4680-a8c5-c543e01161a5
297;;; syntax.el ends here 301;;; syntax.el ends here
diff --git a/lisp/font-core.el b/lisp/font-core.el
index 4af6e1c41f0..27212f9fc68 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -118,17 +118,14 @@ of `font-lock-global-modes'. For example, put in your ~/.emacs:
118 118
119 (global-font-lock-mode t) 119 (global-font-lock-mode t)
120 120
121There are a number of support modes that may be used to speed up Font Lock mode 121Where major modes support different levels of fontification, you can use
122in various ways, specified via the variable `font-lock-support-mode'. Where 122the variable `font-lock-maximum-decoration' to specify which level you
123major modes support different levels of fontification, you can use the variable 123generally prefer. When you turn Font Lock mode on/off the buffer is
124`font-lock-maximum-decoration' to specify which level you generally prefer. 124fontified/defontified, though fontification occurs only if the buffer is
125When you turn Font Lock mode on/off the buffer is fontified/defontified, though 125less than `font-lock-maximum-size'.
126fontification occurs only if the buffer is less than `font-lock-maximum-size'.
127 126
128For example, to specify that Font Lock mode uses Lazy Lock mode as a support 127For example, to use maximum levels of fontification, put in your ~/.emacs:
129mode and use maximum levels of fontification, put in your ~/.emacs:
130 128
131 (setq font-lock-support-mode 'lazy-lock-mode)
132 (setq font-lock-maximum-decoration t) 129 (setq font-lock-maximum-decoration t)
133 130
134To add your own highlighting for some major mode, and modify the highlighting 131To add your own highlighting for some major mode, and modify the highlighting
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index fceb3e17f78..c0e9e9ab16b 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1048,8 +1048,7 @@ a very meaningful entity to highlight.")
1048 (setq beg (line-beginning-position (- 1 font-lock-lines-before))) 1048 (setq beg (line-beginning-position (- 1 font-lock-lines-before)))
1049 ;; check to see if we should expand the beg/end area for 1049 ;; check to see if we should expand the beg/end area for
1050 ;; proper multiline matches 1050 ;; proper multiline matches
1051 (when (and font-lock-multiline 1051 (when (and (> beg (point-min))
1052 (> beg (point-min))
1053 (get-text-property (1- beg) 'font-lock-multiline)) 1052 (get-text-property (1- beg) 'font-lock-multiline))
1054 ;; We are just after or in a multiline match. 1053 ;; We are just after or in a multiline match.
1055 (setq beg (or (previous-single-property-change 1054 (setq beg (or (previous-single-property-change
@@ -1057,10 +1056,9 @@ a very meaningful entity to highlight.")
1057 (point-min))) 1056 (point-min)))
1058 (goto-char beg) 1057 (goto-char beg)
1059 (setq beg (line-beginning-position))) 1058 (setq beg (line-beginning-position)))
1060 (when font-lock-multiline 1059 (setq end (or (text-property-any end (point-max)
1061 (setq end (or (text-property-any end (point-max) 1060 'font-lock-multiline nil)
1062 'font-lock-multiline nil) 1061 (point-max)))
1063 (point-max))))
1064 (goto-char end) 1062 (goto-char end)
1065 ;; Round up to a whole line. 1063 ;; Round up to a whole line.
1066 (unless (bolp) (setq end (line-beginning-position 2))) 1064 (unless (bolp) (setq end (line-beginning-position 2)))
@@ -1184,35 +1182,35 @@ Optional argument OBJECT is the string or buffer containing the text."
1184 1182
1185;; For completeness: this is to `remove-text-properties' as `put-text-property' 1183;; For completeness: this is to `remove-text-properties' as `put-text-property'
1186;; is to `add-text-properties', etc. 1184;; is to `add-text-properties', etc.
1187;(defun remove-text-property (start end property &optional object) 1185;;(defun remove-text-property (start end property &optional object)
1188; "Remove a property from text from START to END. 1186;; "Remove a property from text from START to END.
1189;Argument PROPERTY is the property to remove. 1187;;Argument PROPERTY is the property to remove.
1190;Optional argument OBJECT is the string or buffer containing the text. 1188;;Optional argument OBJECT is the string or buffer containing the text.
1191;Return t if the property was actually removed, nil otherwise." 1189;;Return t if the property was actually removed, nil otherwise."
1192; (remove-text-properties start end (list property) object)) 1190;; (remove-text-properties start end (list property) object))
1193 1191
1194;; For consistency: maybe this should be called `remove-single-property' like 1192;; For consistency: maybe this should be called `remove-single-property' like
1195;; `next-single-property-change' (not `next-single-text-property-change'), etc. 1193;; `next-single-property-change' (not `next-single-text-property-change'), etc.
1196;(defun remove-single-text-property (start end prop value &optional object) 1194;;(defun remove-single-text-property (start end prop value &optional object)
1197; "Remove a specific property value from text from START to END. 1195;; "Remove a specific property value from text from START to END.
1198;Arguments PROP and VALUE specify the property and value to remove. The 1196;;Arguments PROP and VALUE specify the property and value to remove. The
1199;resulting property values are not equal to VALUE nor lists containing VALUE. 1197;;resulting property values are not equal to VALUE nor lists containing VALUE.
1200;Optional argument OBJECT is the string or buffer containing the text." 1198;;Optional argument OBJECT is the string or buffer containing the text."
1201; (let ((start (text-property-not-all start end prop nil object)) next prev) 1199;; (let ((start (text-property-not-all start end prop nil object)) next prev)
1202; (while start 1200;; (while start
1203; (setq next (next-single-property-change start prop object end) 1201;; (setq next (next-single-property-change start prop object end)
1204; prev (get-text-property start prop object)) 1202;; prev (get-text-property start prop object))
1205; (cond ((and (symbolp prev) (eq value prev)) 1203;; (cond ((and (symbolp prev) (eq value prev))
1206; (remove-text-property start next prop object)) 1204;; (remove-text-property start next prop object))
1207; ((and (listp prev) (memq value prev)) 1205;; ((and (listp prev) (memq value prev))
1208; (let ((new (delq value prev))) 1206;; (let ((new (delq value prev)))
1209; (cond ((null new) 1207;; (cond ((null new)
1210; (remove-text-property start next prop object)) 1208;; (remove-text-property start next prop object))
1211; ((= (length new) 1) 1209;; ((= (length new) 1)
1212; (put-text-property start next prop (car new) object)) 1210;; (put-text-property start next prop (car new) object))
1213; (t 1211;; (t
1214; (put-text-property start next prop new object)))))) 1212;; (put-text-property start next prop new object))))))
1215; (setq start (text-property-not-all next end prop nil object))))) 1213;; (setq start (text-property-not-all next end prop nil object)))))
1216 1214
1217;;; End of Additional text property functions. 1215;;; End of Additional text property functions.
1218 1216
@@ -1534,7 +1532,8 @@ If REGEXP is non-nil, it means these keywords are used for
1534 (if (memq (get-text-property (match-beginning 0) 'face) 1532 (if (memq (get-text-property (match-beginning 0) 'face)
1535 '(font-lock-string-face font-lock-doc-face 1533 '(font-lock-string-face font-lock-doc-face
1536 font-lock-comment-face)) 1534 font-lock-comment-face))
1537 font-lock-warning-face) 1535 (list 'face font-lock-warning-face
1536 'help-echo "Looks like a toplevel defun: escape the parenthesis"))
1538 prepend))))) 1537 prepend)))))
1539 keywords)) 1538 keywords))
1540 1539
@@ -1602,7 +1601,7 @@ Sets various variables using `font-lock-defaults' (or, if nil, using
1602 (let* ((defaults (or font-lock-defaults 1601 (let* ((defaults (or font-lock-defaults
1603 (cdr (assq major-mode 1602 (cdr (assq major-mode
1604 (with-no-warnings 1603 (with-no-warnings
1605 font-lock-defaults-alist))))) 1604 font-lock-defaults-alist)))))
1606 (keywords 1605 (keywords
1607 (font-lock-choose-keywords (nth 0 defaults) 1606 (font-lock-choose-keywords (nth 0 defaults)
1608 (font-lock-value-in-major-mode font-lock-maximum-decoration))) 1607 (font-lock-value-in-major-mode font-lock-maximum-decoration)))
@@ -1854,95 +1853,95 @@ Sets various variables using `font-lock-defaults' (or, if nil, using
1854;; buttons and when they are on or off needs tweaking. I have assumed that the 1853;; buttons and when they are on or off needs tweaking. I have assumed that the
1855;; mechanism is via `menu-toggle' and `menu-selected' symbol properties. sm. 1854;; mechanism is via `menu-toggle' and `menu-selected' symbol properties. sm.
1856 1855
1857;;;;###autoload 1856;;;;;###autoload
1858;(progn 1857;;(progn
1859; ;; Make the Font Lock menu. 1858;; ;; Make the Font Lock menu.
1860; (defvar font-lock-menu (make-sparse-keymap "Syntax Highlighting")) 1859;; (defvar font-lock-menu (make-sparse-keymap "Syntax Highlighting"))
1861; ;; Add the menu items in reverse order. 1860;; ;; Add the menu items in reverse order.
1862; (define-key font-lock-menu [fontify-less] 1861;; (define-key font-lock-menu [fontify-less]
1863; '("Less In Current Buffer" . font-lock-fontify-less)) 1862;; '("Less In Current Buffer" . font-lock-fontify-less))
1864; (define-key font-lock-menu [fontify-more] 1863;; (define-key font-lock-menu [fontify-more]
1865; '("More In Current Buffer" . font-lock-fontify-more)) 1864;; '("More In Current Buffer" . font-lock-fontify-more))
1866; (define-key font-lock-menu [font-lock-sep] 1865;; (define-key font-lock-menu [font-lock-sep]
1867; '("--")) 1866;; '("--"))
1868; (define-key font-lock-menu [font-lock-mode] 1867;; (define-key font-lock-menu [font-lock-mode]
1869; '("In Current Buffer" . font-lock-mode)) 1868;; '("In Current Buffer" . font-lock-mode))
1870; (define-key font-lock-menu [global-font-lock-mode] 1869;; (define-key font-lock-menu [global-font-lock-mode]
1871; '("In All Buffers" . global-font-lock-mode))) 1870;; '("In All Buffers" . global-font-lock-mode)))
1872; 1871;;
1873;;;;###autoload 1872;;;;;###autoload
1874;(progn 1873;;(progn
1875; ;; We put the appropriate `menu-enable' etc. symbol property values on when 1874;; ;; We put the appropriate `menu-enable' etc. symbol property values on when
1876; ;; font-lock.el is loaded, so we don't need to autoload the three variables. 1875;; ;; font-lock.el is loaded, so we don't need to autoload the three variables.
1877; (put 'global-font-lock-mode 'menu-toggle t) 1876;; (put 'global-font-lock-mode 'menu-toggle t)
1878; (put 'font-lock-mode 'menu-toggle t) 1877;; (put 'font-lock-mode 'menu-toggle t)
1879; (put 'font-lock-fontify-more 'menu-enable '(identity)) 1878;; (put 'font-lock-fontify-more 'menu-enable '(identity))
1880; (put 'font-lock-fontify-less 'menu-enable '(identity))) 1879;; (put 'font-lock-fontify-less 'menu-enable '(identity)))
1881; 1880;;
1882; ;; Put the appropriate symbol property values on now. See above. 1881;; ;; Put the appropriate symbol property values on now. See above.
1883;(put 'global-font-lock-mode 'menu-selected 'global-font-lock-mode) 1882;;(put 'global-font-lock-mode 'menu-selected 'global-font-lock-mode)
1884;(put 'font-lock-mode 'menu-selected 'font-lock-mode) 1883;;(put 'font-lock-mode 'menu-selected 'font-lock-mode)
1885;(put 'font-lock-fontify-more 'menu-enable '(nth 2 font-lock-fontify-level)) 1884;;(put 'font-lock-fontify-more 'menu-enable '(nth 2 font-lock-fontify-level))
1886;(put 'font-lock-fontify-less 'menu-enable '(nth 1 font-lock-fontify-level)) 1885;;(put 'font-lock-fontify-less 'menu-enable '(nth 1 font-lock-fontify-level))
1887; 1886;;
1888;(defvar font-lock-fontify-level nil) ; For less/more fontification. 1887;;(defvar font-lock-fontify-level nil) ; For less/more fontification.
1889; 1888;;
1890;(defun font-lock-fontify-level (level) 1889;;(defun font-lock-fontify-level (level)
1891; (let ((font-lock-maximum-decoration level)) 1890;; (let ((font-lock-maximum-decoration level))
1892; (when font-lock-mode 1891;; (when font-lock-mode
1893; (font-lock-mode)) 1892;; (font-lock-mode))
1894; (font-lock-mode) 1893;; (font-lock-mode)
1895; (when font-lock-verbose 1894;; (when font-lock-verbose
1896; (message "Fontifying %s... level %d" (buffer-name) level)))) 1895;; (message "Fontifying %s... level %d" (buffer-name) level))))
1897; 1896;;
1898;(defun font-lock-fontify-less () 1897;;(defun font-lock-fontify-less ()
1899; "Fontify the current buffer with less decoration. 1898;; "Fontify the current buffer with less decoration.
1900;See `font-lock-maximum-decoration'." 1899;;See `font-lock-maximum-decoration'."
1901; (interactive) 1900;; (interactive)
1902; ;; Check in case we get called interactively. 1901;; ;; Check in case we get called interactively.
1903; (if (nth 1 font-lock-fontify-level) 1902;; (if (nth 1 font-lock-fontify-level)
1904; (font-lock-fontify-level (1- (car font-lock-fontify-level))) 1903;; (font-lock-fontify-level (1- (car font-lock-fontify-level)))
1905; (error "No less decoration"))) 1904;; (error "No less decoration")))
1906; 1905;;
1907;(defun font-lock-fontify-more () 1906;;(defun font-lock-fontify-more ()
1908; "Fontify the current buffer with more decoration. 1907;; "Fontify the current buffer with more decoration.
1909;See `font-lock-maximum-decoration'." 1908;;See `font-lock-maximum-decoration'."
1910; (interactive) 1909;; (interactive)
1911; ;; Check in case we get called interactively. 1910;; ;; Check in case we get called interactively.
1912; (if (nth 2 font-lock-fontify-level) 1911;; (if (nth 2 font-lock-fontify-level)
1913; (font-lock-fontify-level (1+ (car font-lock-fontify-level))) 1912;; (font-lock-fontify-level (1+ (car font-lock-fontify-level)))
1914; (error "No more decoration"))) 1913;; (error "No more decoration")))
1915; 1914;;
1916; ;; This should be called by `font-lock-set-defaults'. 1915;; ;; This should be called by `font-lock-set-defaults'.
1917;(defun font-lock-set-menu () 1916;;(defun font-lock-set-menu ()
1918; ;; Activate less/more fontification entries if there are multiple levels for 1917;; ;; Activate less/more fontification entries if there are multiple levels for
1919; ;; the current buffer. Sets `font-lock-fontify-level' to be of the form 1918;; ;; the current buffer. Sets `font-lock-fontify-level' to be of the form
1920; ;; (CURRENT-LEVEL IS-LOWER-LEVEL-P IS-HIGHER-LEVEL-P) for menu activation. 1919;; ;; (CURRENT-LEVEL IS-LOWER-LEVEL-P IS-HIGHER-LEVEL-P) for menu activation.
1921; (let ((keywords (or (nth 0 font-lock-defaults) 1920;; (let ((keywords (or (nth 0 font-lock-defaults)
1922; (nth 1 (assq major-mode font-lock-defaults-alist)))) 1921;; (nth 1 (assq major-mode font-lock-defaults-alist))))
1923; (level (font-lock-value-in-major-mode font-lock-maximum-decoration))) 1922;; (level (font-lock-value-in-major-mode font-lock-maximum-decoration)))
1924; (make-local-variable 'font-lock-fontify-level) 1923;; (make-local-variable 'font-lock-fontify-level)
1925; (if (or (symbolp keywords) (= (length keywords) 1)) 1924;; (if (or (symbolp keywords) (= (length keywords) 1))
1926; (font-lock-unset-menu) 1925;; (font-lock-unset-menu)
1927; (cond ((eq level t) 1926;; (cond ((eq level t)
1928; (setq level (1- (length keywords)))) 1927;; (setq level (1- (length keywords))))
1929; ((or (null level) (zerop level)) 1928;; ((or (null level) (zerop level))
1930; ;; The default level is usually, but not necessarily, level 1. 1929;; ;; The default level is usually, but not necessarily, level 1.
1931; (setq level (- (length keywords) 1930;; (setq level (- (length keywords)
1932; (length (member (eval (car keywords)) 1931;; (length (member (eval (car keywords))
1933; (mapcar 'eval (cdr keywords)))))))) 1932;; (mapcar 'eval (cdr keywords))))))))
1934; (setq font-lock-fontify-level (list level (> level 1) 1933;; (setq font-lock-fontify-level (list level (> level 1)
1935; (< level (1- (length keywords)))))))) 1934;; (< level (1- (length keywords))))))))
1936; 1935;;
1937; ;; This should be called by `font-lock-unset-defaults'. 1936;; ;; This should be called by `font-lock-unset-defaults'.
1938;(defun font-lock-unset-menu () 1937;;(defun font-lock-unset-menu ()
1939; ;; Deactivate less/more fontification entries. 1938;; ;; Deactivate less/more fontification entries.
1940; (setq font-lock-fontify-level nil)) 1939;; (setq font-lock-fontify-level nil))
1941 1940
1942;;; End of Menu support. 1941;;; End of Menu support.
1943 1942
1944;;; Various regexp information shared by several modes. 1943;;; Various regexp information shared by several modes.
1945; ;; Information specific to a single mode should go in its load library. 1944;; ;; Information specific to a single mode should go in its load library.
1946 1945
1947;; Font Lock support for C, C++, Objective-C and Java modes is now in 1946;; Font Lock support for C, C++, Objective-C and Java modes is now in
1948;; cc-fonts.el (and required by cc-mode.el). However, the below function 1947;; cc-fonts.el (and required by cc-mode.el). However, the below function
diff --git a/lisp/frame.el b/lisp/frame.el
index c8085762d2a..8342d8e6aac 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1132,9 +1132,9 @@ frame's display)."
1132 "Return the number of screens associated with DISPLAY." 1132 "Return the number of screens associated with DISPLAY."
1133 (let ((frame-type (framep-on-display display))) 1133 (let ((frame-type (framep-on-display display)))
1134 (cond 1134 (cond
1135 ((memq frame-type '(x w32)) 1135 ((memq frame-type '(x w32 mac))
1136 (x-display-screens display)) 1136 (x-display-screens display))
1137 (t ;; FIXME: is this correct for the Mac? 1137 (t
1138 1)))) 1138 1))))
1139 1139
1140(defun display-pixel-height (&optional display) 1140(defun display-pixel-height (&optional display)
@@ -1342,7 +1342,7 @@ cursor display. On a text-only terminal, this is not implemented."
1342 :init-value (not (or noninteractive 1342 :init-value (not (or noninteractive
1343 no-blinking-cursor 1343 no-blinking-cursor
1344 (eq system-type 'ms-dos) 1344 (eq system-type 'ms-dos)
1345 (not (memq initial-window-system '(x w32))))) 1345 (not (memq initial-window-system '(x w32 mac)))))
1346 :initialize 'custom-initialize-safe-default 1346 :initialize 'custom-initialize-safe-default
1347 :group 'cursor 1347 :group 'cursor
1348 :global t 1348 :global t
diff --git a/lisp/ido.el b/lisp/ido.el
index b234795d3be..cc4eab4bb4d 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1084,9 +1084,9 @@ it doesn't interfere with other minibuffer usage.")
1084 (setq truncate-lines t))))) 1084 (setq truncate-lines t)))))
1085 1085
1086(defun ido-is-tramp-root (&optional dir) 1086(defun ido-is-tramp-root (&optional dir)
1087 (setq dir (or dir ido-current-directory))
1088 (and ido-enable-tramp-completion 1087 (and ido-enable-tramp-completion
1089 (string-match "\\`/[^/][^/]+:\\([^/:@]+@\\)?\\'" dir))) 1088 (string-match "\\`/[^/]+[@:]\\'"
1089 (or dir ido-current-directory))))
1090 1090
1091(defun ido-is-root-directory (&optional dir) 1091(defun ido-is-root-directory (&optional dir)
1092 (setq dir (or dir ido-current-directory)) 1092 (setq dir (or dir ido-current-directory))
@@ -1507,11 +1507,16 @@ With ARG, turn ido speed-up on if arg is positive, off otherwise."
1507 1507
1508(defun ido-set-current-directory (dir &optional subdir no-merge) 1508(defun ido-set-current-directory (dir &optional subdir no-merge)
1509 ;; Set ido's current directory to DIR or DIR/SUBDIR 1509 ;; Set ido's current directory to DIR or DIR/SUBDIR
1510 (setq dir (ido-final-slash dir t)) 1510 (unless (and ido-enable-tramp-completion
1511 (string-match "\\`/[^/]*@\\'" dir))
1512 (setq dir (ido-final-slash dir t)))
1511 (setq ido-use-merged-list nil 1513 (setq ido-use-merged-list nil
1512 ido-try-merged-list (not no-merge)) 1514 ido-try-merged-list (not no-merge))
1513 (if subdir 1515 (when subdir
1514 (setq dir (ido-final-slash (concat dir subdir) t))) 1516 (setq dir (concat dir subdir))
1517 (unless (and ido-enable-tramp-completion
1518 (string-match "\\`/[^/]*@\\'" dir))
1519 (setq dir (ido-final-slash dir t))))
1515 (if (equal dir ido-current-directory) 1520 (if (equal dir ido-current-directory)
1516 nil 1521 nil
1517 (ido-trace "cd" dir) 1522 (ido-trace "cd" dir)
@@ -3102,27 +3107,29 @@ for first matching file."
3102 ((ido-nonreadable-directory-p dir) '()) 3107 ((ido-nonreadable-directory-p dir) '())
3103 ;; do not check (ido-directory-too-big-p dir) here. 3108 ;; do not check (ido-directory-too-big-p dir) here.
3104 ;; Caller must have done that if necessary. 3109 ;; Caller must have done that if necessary.
3110
3105 ((and ido-enable-tramp-completion 3111 ((and ido-enable-tramp-completion
3106 (string-match "\\`/\\([^/:]+:\\([^/:@]+@\\)?\\)\\'" dir)) 3112 (or (fboundp 'tramp-completion-mode)
3107 3113 (require 'tramp nil t))
3108 ;; Trick tramp's file-name-all-completions handler to DTRT, as it 3114 (string-match "\\`/[^/]+[:@]\\'" dir))
3109 ;; has some pretty obscure requirements. This seems to work... 3115 ;; Strip method:user@host: part of tramp completions.
3110 ;; /ftp: => (f-n-a-c "/ftp:" "") 3116 ;; Tramp completions do not include leading slash.
3111 ;; /ftp:kfs: => (f-n-a-c "" "/ftp:kfs:") 3117 (let ((len (1- (length dir)))
3112 ;; /ftp:kfs@ => (f-n-a-c "ftp:kfs@" "/") 3118 (compl
3113 ;; /ftp:kfs@kfs: => (f-n-a-c "" "/ftp:kfs@kfs:") 3119 (or (file-name-all-completions "" dir)
3114 ;; Currently no attempt is made to handle multi: stuff. 3120 ;; work around bug in ange-ftp.
3115 3121 ;; /ftp:user@host: => nil
3116 (let* ((prefix (match-string 1 dir)) 3122 ;; /ftp:user@host:./ => ok
3117 (user-flag (match-beginning 2)) 3123 (and
3118 (len (and prefix (length prefix))) 3124 (not (string= "/ftp:" dir))
3119 compl) 3125 (tramp-tramp-file-p dir)
3120 (if user-flag 3126 (fboundp 'tramp-ftp-file-name-p)
3121 (setq dir (substring dir 1))) 3127 (funcall 'tramp-ftp-file-name-p dir)
3122 (require 'tramp nil t) 3128 (string-match ":\\'" dir)
3123 (ido-trace "tramp complete" dir) 3129 (file-name-all-completions "" (concat dir "./"))))))
3124 (setq compl (file-name-all-completions dir (if user-flag "/" ""))) 3130 (if (and compl
3125 (if (> len 0) 3131 (> (length (car compl)) len)
3132 (string= (substring (car compl) 0 len) (substring dir 1)))
3126 (mapcar (lambda (c) (substring c len)) compl) 3133 (mapcar (lambda (c) (substring c len)) compl)
3127 compl))) 3134 compl)))
3128 (t 3135 (t
@@ -3193,13 +3200,14 @@ for first matching file."
3193 (if ido-file-extensions-order 3200 (if ido-file-extensions-order
3194 #'ido-file-extension-lessp 3201 #'ido-file-extension-lessp
3195 #'ido-file-lessp))) 3202 #'ido-file-lessp)))
3196 (let ((default-directory ido-current-directory)) 3203 (unless (ido-is-tramp-root ido-current-directory)
3197 (ido-to-end ;; move ftp hosts and visited files to end 3204 (let ((default-directory ido-current-directory))
3198 (delq nil (mapcar 3205 (ido-to-end ;; move ftp hosts and visited files to end
3199 (lambda (x) (if (or (string-match "..:\\'" x) 3206 (delq nil (mapcar
3200 (and (not (ido-final-slash x)) 3207 (lambda (x) (if (or (string-match "..:\\'" x)
3201 (get-file-buffer x))) x)) 3208 (and (not (ido-final-slash x))
3202 ido-temp-list)))) 3209 (get-file-buffer x))) x))
3210 ido-temp-list)))))
3203 (ido-to-end ;; move . files to end 3211 (ido-to-end ;; move . files to end
3204 (delq nil (mapcar 3212 (delq nil (mapcar
3205 (lambda (x) (if (string-equal (substring x 0 1) ".") x)) 3213 (lambda (x) (if (string-equal (substring x 0 1) ".") x))
diff --git a/lisp/image.el b/lisp/image.el
index ee188677517..72e6ee8e633 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -33,7 +33,7 @@
33 :group 'multimedia) 33 :group 'multimedia)
34 34
35 35
36(defconst image-type-regexps 36(defconst image-type-header-regexps
37 '(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm) 37 '(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm)
38 ("\\`P[1-6]" . pbm) 38 ("\\`P[1-6]" . pbm)
39 ("\\`GIF8" . gif) 39 ("\\`GIF8" . gif)
@@ -49,6 +49,21 @@ IMAGE-TYPE must be a pair (PREDICATE . TYPE). PREDICATE is called
49with one argument, a string containing the image data. If PREDICATE returns 49with one argument, a string containing the image data. If PREDICATE returns
50a non-nil value, TYPE is the image's type.") 50a non-nil value, TYPE is the image's type.")
51 51
52(defconst image-type-file-name-regexps
53 '(("\\.png\\'" . png)
54 ("\\.gif\\'" . gif)
55 ("\\.jpe?g\\'" . jpeg)
56 ("\\.bmp\\'" . bmp)
57 ("\\.xpm\\'" . xpm)
58 ("\\.pbm\\'" . pbm)
59 ("\\.xbm\\'" . xbm)
60 ("\\.ps\\'" . postscript)
61 ("\\.tiff?\\'" . tiff))
62 "Alist of (REGEXP . IMAGE-TYPE) pairs used to identify image files.
63When the name of an image file match REGEXP, it is assumed to
64be of image type IMAGE-TYPE.")
65
66
52(defvar image-load-path 67(defvar image-load-path
53 (list (file-name-as-directory (expand-file-name "images" data-directory)) 68 (list (file-name-as-directory (expand-file-name "images" data-directory))
54 'data-directory 'load-path) 69 'data-directory 'load-path)
@@ -87,18 +102,50 @@ We accept the tag Exif because that is the same format."
87 "Determine the image type from image data DATA. 102 "Determine the image type from image data DATA.
88Value is a symbol specifying the image type or nil if type cannot 103Value is a symbol specifying the image type or nil if type cannot
89be determined." 104be determined."
90 (let ((types image-type-regexps) 105 (let ((types image-type-header-regexps)
91 type) 106 type)
92 (while (and types (null type)) 107 (while types
93 (let ((regexp (car (car types))) 108 (let ((regexp (car (car types)))
94 (image-type (cdr (car types)))) 109 (image-type (cdr (car types))))
95 (when (or (and (symbolp image-type) 110 (if (or (and (symbolp image-type)
96 (string-match regexp data)) 111 (string-match regexp data))
97 (and (consp image-type) 112 (and (consp image-type)
98 (funcall (car image-type) data) 113 (funcall (car image-type) data)
99 (setq image-type (cdr image-type)))) 114 (setq image-type (cdr image-type))))
100 (setq type image-type)) 115 (setq type image-type
101 (setq types (cdr types)))) 116 types nil)
117 (setq types (cdr types)))))
118 type))
119
120
121;;;###autoload
122(defun image-type-from-buffer ()
123 "Determine the image type from data in the current buffer.
124Value is a symbol specifying the image type or nil if type cannot
125be determined."
126 (let ((types image-type-header-regexps)
127 type
128 (opoint (point)))
129 (goto-char (point-min))
130 (while types
131 (let ((regexp (car (car types)))
132 (image-type (cdr (car types)))
133 data)
134 (if (or (and (symbolp image-type)
135 (looking-at regexp))
136 (and (consp image-type)
137 (funcall (car image-type)
138 (or data
139 (setq data
140 (buffer-substring
141 (point-min)
142 (min (point-max)
143 (+ (point-min) 256))))))
144 (setq image-type (cdr image-type))))
145 (setq type image-type
146 types nil)
147 (setq types (cdr types)))))
148 (goto-char opoint)
102 type)) 149 type))
103 150
104 151
@@ -107,14 +154,30 @@ be determined."
107 "Determine the type of image file FILE from its first few bytes. 154 "Determine the type of image file FILE from its first few bytes.
108Value is a symbol specifying the image type, or nil if type cannot 155Value is a symbol specifying the image type, or nil if type cannot
109be determined." 156be determined."
110 (unless (file-name-directory file) 157 (unless (or (file-readable-p file)
111 (setq file (expand-file-name file data-directory))) 158 (file-name-absolute-p file))
112 (setq file (expand-file-name file)) 159 (setq file (image-search-load-path file)))
113 (let ((header (with-temp-buffer 160 (and file
114 (set-buffer-multibyte nil) 161 (file-readable-p file)
115 (insert-file-contents-literally file nil 0 256) 162 (with-temp-buffer
116 (buffer-string)))) 163 (set-buffer-multibyte nil)
117 (image-type-from-data header))) 164 (insert-file-contents-literally file nil 0 256)
165 (image-type-from-buffer))))
166
167
168;;;###autoload
169(defun image-type-from-file-name (file)
170 "Determine the type of image file FILE from its name.
171Value is a symbol specifying the image type, or nil if type cannot
172be determined."
173 (let ((types image-type-file-name-regexps)
174 type)
175 (while types
176 (if (string-match (car (car types)) file)
177 (setq type (cdr (car types))
178 types nil)
179 (setq types (cdr types))))
180 type))
118 181
119 182
120;;;###autoload 183;;;###autoload
@@ -124,6 +187,7 @@ Image types are symbols like `xbm' or `jpeg'."
124 (and (fboundp 'init-image-library) 187 (and (fboundp 'init-image-library)
125 (init-image-library type image-library-alist))) 188 (init-image-library type image-library-alist)))
126 189
190
127;;;###autoload 191;;;###autoload
128(defun create-image (file-or-data &optional type data-p &rest props) 192(defun create-image (file-or-data &optional type data-p &rest props)
129 "Create an image. 193 "Create an image.
@@ -135,7 +199,9 @@ use its file extension as image type.
135Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data. 199Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
136Optional PROPS are additional image attributes to assign to the image, 200Optional PROPS are additional image attributes to assign to the image,
137like, e.g. `:mask MASK'. 201like, e.g. `:mask MASK'.
138Value is the image created, or nil if images of type TYPE are not supported." 202Value is the image created, or nil if images of type TYPE are not supported.
203
204Images should not be larger than specified by `max-image-size'."
139 (when (and (not data-p) (not (stringp file-or-data))) 205 (when (and (not data-p) (not (stringp file-or-data)))
140 (error "Invalid image file name `%s'" file-or-data)) 206 (error "Invalid image file name `%s'" file-or-data))
141 (cond ((null data-p) 207 (cond ((null data-p)
@@ -279,27 +345,29 @@ BUFFER nil or omitted means use the current buffer."
279 (delete-overlay overlay))) 345 (delete-overlay overlay)))
280 (setq overlays (cdr overlays))))) 346 (setq overlays (cdr overlays)))))
281 347
282(defun image-search-load-path (file path) 348(defun image-search-load-path (file &optional path)
283 (let (element found pathname) 349 (unless path
350 (setq path image-load-path))
351 (let (element found filename)
284 (while (and (not found) (consp path)) 352 (while (and (not found) (consp path))
285 (setq element (car path)) 353 (setq element (car path))
286 (cond 354 (cond
287 ((stringp element) 355 ((stringp element)
288 (setq found 356 (setq found
289 (file-readable-p 357 (file-readable-p
290 (setq pathname (expand-file-name file element))))) 358 (setq filename (expand-file-name file element)))))
291 ((and (symbolp element) (boundp element)) 359 ((and (symbolp element) (boundp element))
292 (setq element (symbol-value element)) 360 (setq element (symbol-value element))
293 (cond 361 (cond
294 ((stringp element) 362 ((stringp element)
295 (setq found 363 (setq found
296 (file-readable-p 364 (file-readable-p
297 (setq pathname (expand-file-name file element))))) 365 (setq filename (expand-file-name file element)))))
298 ((consp element) 366 ((consp element)
299 (if (setq pathname (image-search-load-path file element)) 367 (if (setq filename (image-search-load-path file element))
300 (setq found t)))))) 368 (setq found t))))))
301 (setq path (cdr path))) 369 (setq path (cdr path)))
302 (if found pathname))) 370 (if found filename)))
303 371
304;;;###autoload 372;;;###autoload
305(defun find-image (specs) 373(defun find-image (specs)
@@ -317,7 +385,9 @@ is supported, and FILE exists, is used to construct the image
317specification to be returned. Return nil if no specification is 385specification to be returned. Return nil if no specification is
318satisfied. 386satisfied.
319 387
320The image is looked for in `image-load-path'." 388The image is looked for in `image-load-path'.
389
390Image files should not be larger than specified by `max-image-size'."
321 (let (image) 391 (let (image)
322 (while (and specs (null image)) 392 (while (and specs (null image))
323 (let* ((spec (car specs)) 393 (let* ((spec (car specs))
@@ -327,8 +397,7 @@ The image is looked for in `image-load-path'."
327 found) 397 found)
328 (when (image-type-available-p type) 398 (when (image-type-available-p type)
329 (cond ((stringp file) 399 (cond ((stringp file)
330 (if (setq found (image-search-load-path 400 (if (setq found (image-search-load-path file))
331 file image-load-path))
332 (setq image 401 (setq image
333 (cons 'image (plist-put (copy-sequence spec) 402 (cons 'image (plist-put (copy-sequence spec)
334 :file found))))) 403 :file found)))))
diff --git a/lisp/info.el b/lisp/info.el
index 6594d76fa03..c94e4121dc8 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -2819,7 +2819,8 @@ Give a blank topic name to go to the Index node itself."
2819 (car (car Info-index-alternatives)) 2819 (car (car Info-index-alternatives))
2820 (nth 2 (car Info-index-alternatives)) 2820 (nth 2 (car Info-index-alternatives))
2821 (if (cdr Info-index-alternatives) 2821 (if (cdr Info-index-alternatives)
2822 "(`,' tries to find next)" 2822 (format "(%s total; use `,' for next)"
2823 (length Info-index-alternatives))
2823 "(Only match)"))) 2824 "(Only match)")))
2824 2825
2825(defun Info-find-index-name (name) 2826(defun Info-find-index-name (name)
diff --git a/lisp/language/vietnamese.el b/lisp/language/vietnamese.el
index 7c10a10d35a..9849fd0c538 100644
--- a/lisp/language/vietnamese.el
+++ b/lisp/language/vietnamese.el
@@ -266,6 +266,7 @@
266 (valid-codes (0 . 255)))) 266 (valid-codes (0 . 255))))
267 267
268(define-coding-system-alias 'tcvn 'vietnamese-tcvn) 268(define-coding-system-alias 'tcvn 'vietnamese-tcvn)
269(define-coding-system-alias 'tcvn-5712 'vietnamese-tcvn)
269 270
270;; (make-coding-system 271;; (make-coding-system
271;; 'vietnamese-vps 4 ?p 272;; 'vietnamese-vps 4 ?p
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 61c4192387d..f23715f3825 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -53,24 +53,23 @@ a buffer with no associated file, or an `eval-region', return nil."
53 (car (feature-symbols feature)))) 53 (car (feature-symbols feature))))
54 54
55(defun file-loadhist-lookup (file) 55(defun file-loadhist-lookup (file)
56 "Return the `load-history' element for FILE." 56 "Return the `load-history' element for FILE.
57FILE can be a file name, or a library name.
58A library name is equivalent to the file name that `load-library' would load."
57 ;; First look for FILE as given. 59 ;; First look for FILE as given.
58 (let ((symbols (assoc file load-history))) 60 (let ((symbols (assoc file load-history)))
59 ;; Try converting a library name to an absolute file name. 61 ;; Try converting a library name to an absolute file name.
60 (and (null symbols) 62 (and (null symbols)
61 (let ((absname (find-library-name file))) 63 (let ((absname
62 (if (not (equal absname file)) 64 (locate-file file load-path load-suffixes)))
63 (setq symbols (cdr (assoc absname load-history)))))) 65 (and absname (not (equal absname file))
64 ;; Try converting an absolute file name to a library name. 66 (setq symbols (cdr (assoc absname load-history))))))
65 (and (null symbols) (string-match "[.]el\\'" file)
66 (let ((libname (file-name-nondirectory file)))
67 (string-match "[.]el\\'" libname)
68 (setq libname (substring libname 0 (match-beginning 0)))
69 (setq symbols (cdr (assoc libname load-history)))))
70 symbols)) 67 symbols))
71 68
72(defun file-provides (file) 69(defun file-provides (file)
73 "Return the list of features provided by FILE." 70 "Return the list of features provided by FILE as it was loaded.
71FILE can be a file name, or a library name.
72A library name is equivalent to the file name that `load-library' would load."
74 (let ((symbols (file-loadhist-lookup file)) 73 (let ((symbols (file-loadhist-lookup file))
75 provides) 74 provides)
76 (mapc (lambda (x) 75 (mapc (lambda (x)
@@ -80,7 +79,9 @@ a buffer with no associated file, or an `eval-region', return nil."
80 provides)) 79 provides))
81 80
82(defun file-requires (file) 81(defun file-requires (file)
83 "Return the list of features required by FILE." 82 "Return the list of features required by FILE as it was loaded.
83FILE can be a file name, or a library name.
84A library name is equivalent to the file name that `load-library' would load."
84 (let ((symbols (file-loadhist-lookup file)) 85 (let ((symbols (file-loadhist-lookup file))
85 requires) 86 requires)
86 (mapc (lambda (x) 87 (mapc (lambda (x)
@@ -98,7 +99,9 @@ a buffer with no associated file, or an `eval-region', return nil."
98 99
99(defun file-dependents (file) 100(defun file-dependents (file)
100 "Return the list of loaded libraries that depend on FILE. 101 "Return the list of loaded libraries that depend on FILE.
101This can include FILE itself." 102This can include FILE itself.
103FILE can be a file name, or a library name.
104A library name is equivalent to the file name that `load-library' would load."
102 (let ((provides (file-provides file)) 105 (let ((provides (file-provides file))
103 (dependents nil)) 106 (dependents nil))
104 (dolist (x load-history dependents) 107 (dolist (x load-history dependents)
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 81afe688c10..8e7a71d65ab 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -185,6 +185,7 @@ This file need not actually exist."
185 :type '(choice (const nil) file) 185 :type '(choice (const nil) file)
186 :group 'sendmail) 186 :group 'sendmail)
187 187
188;;;###autoload
188(defcustom mail-setup-hook nil 189(defcustom mail-setup-hook nil
189 "Normal hook, run each time a new outgoing mail message is initialized. 190 "Normal hook, run each time a new outgoing mail message is initialized.
190The function `mail-setup' runs this hook." 191The function `mail-setup' runs this hook."
@@ -192,6 +193,7 @@ The function `mail-setup' runs this hook."
192 :options '(fortune-to-signature spook mail-abbrevs-setup) 193 :options '(fortune-to-signature spook mail-abbrevs-setup)
193 :group 'sendmail) 194 :group 'sendmail)
194 195
196;;;###autoload
195(defvar mail-aliases t 197(defvar mail-aliases t
196 "Alist of mail address aliases, 198 "Alist of mail address aliases,
197or t meaning should be initialized from your mail aliases file. 199or t meaning should be initialized from your mail aliases file.
@@ -203,17 +205,20 @@ The alias definitions in the file have this form:
203(defvar mail-alias-modtime nil 205(defvar mail-alias-modtime nil
204 "The modification time of your mail alias file when it was last examined.") 206 "The modification time of your mail alias file when it was last examined.")
205 207
208;;;###autoload
206(defcustom mail-yank-prefix nil 209(defcustom mail-yank-prefix nil
207 "*Prefix insert on lines of yanked message being replied to. 210 "*Prefix insert on lines of yanked message being replied to.
208nil means use indentation." 211nil means use indentation."
209 :type '(choice (const nil) string) 212 :type '(choice (const nil) string)
210 :group 'sendmail) 213 :group 'sendmail)
211 214
215;;;###autoload
212(defcustom mail-indentation-spaces 3 216(defcustom mail-indentation-spaces 3
213 "*Number of spaces to insert at the beginning of each cited line. 217 "*Number of spaces to insert at the beginning of each cited line.
214Used by `mail-yank-original' via `mail-indent-citation'." 218Used by `mail-yank-original' via `mail-indent-citation'."
215 :type 'integer 219 :type 'integer
216 :group 'sendmail) 220 :group 'sendmail)
221
217(defvar mail-yank-hooks nil 222(defvar mail-yank-hooks nil
218 "Obsolete hook for modifying a citation just inserted in the mail buffer. 223 "Obsolete hook for modifying a citation just inserted in the mail buffer.
219Each hook function can find the citation between (point) and (mark t). 224Each hook function can find the citation between (point) and (mark t).
@@ -242,6 +247,7 @@ instead of no action."
242This enables the hook functions to see the whole message header 247This enables the hook functions to see the whole message header
243regardless of what part of it (if any) is included in the cited text.") 248regardless of what part of it (if any) is included in the cited text.")
244 249
250;;;###autoload
245(defcustom mail-citation-prefix-regexp "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|[ \t]*" 251(defcustom mail-citation-prefix-regexp "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|[ \t]*"
246 "*Regular expression to match a citation prefix plus whitespace. 252 "*Regular expression to match a citation prefix plus whitespace.
247It should match whatever sort of citation prefixes you want to handle, 253It should match whatever sort of citation prefixes you want to handle,
@@ -281,6 +287,7 @@ and should insert whatever you want to insert."
281 :group 'sendmail) 287 :group 'sendmail)
282(put 'mail-signature 'risky-local-variable t) 288(put 'mail-signature 'risky-local-variable t)
283 289
290;;;###autoload
284(defcustom mail-signature-file "~/.signature" 291(defcustom mail-signature-file "~/.signature"
285 "*File containing the text inserted at end of mail buffer." 292 "*File containing the text inserted at end of mail buffer."
286 :type 'file 293 :type 'file
@@ -301,6 +308,7 @@ This directory is used for auto-save files of mail buffers."
301(put 'mail-reply-action 'permanent-local t) 308(put 'mail-reply-action 'permanent-local t)
302(put 'mail-send-actions 'permanent-local t) 309(put 'mail-send-actions 'permanent-local t)
303 310
311;;;###autoload
304(defcustom mail-default-headers nil 312(defcustom mail-default-headers nil
305 "*A string containing header lines, to be inserted in outgoing messages. 313 "*A string containing header lines, to be inserted in outgoing messages.
306It is inserted before you edit the message, 314It is inserted before you edit the message,
@@ -308,6 +316,7 @@ so you can edit or delete these lines."
308 :type '(choice (const nil) string) 316 :type '(choice (const nil) string)
309 :group 'sendmail) 317 :group 'sendmail)
310 318
319;;;###autoload
311(defcustom mail-bury-selects-summary t 320(defcustom mail-bury-selects-summary t
312 "*If non-nil, try to show RMAIL summary buffer after returning from mail. 321 "*If non-nil, try to show RMAIL summary buffer after returning from mail.
313The functions \\[mail-send-on-exit] or \\[mail-dont-send] select 322The functions \\[mail-send-on-exit] or \\[mail-dont-send] select
@@ -316,6 +325,7 @@ is non-nil."
316 :type 'boolean 325 :type 'boolean
317 :group 'sendmail) 326 :group 'sendmail)
318 327
328;;;###autoload
319(defcustom mail-send-nonascii 'mime 329(defcustom mail-send-nonascii 'mime
320 "*Specify whether to allow sending non-ASCII characters in mail. 330 "*Specify whether to allow sending non-ASCII characters in mail.
321If t, that means do allow it. nil means don't allow it. 331If t, that means do allow it. nil means don't allow it.
diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in
index d909c909b10..059351cf4be 100644
--- a/lisp/makefile.w32-in
+++ b/lisp/makefile.w32-in
@@ -306,6 +306,7 @@ $(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC)
306 -l autoload \ 306 -l autoload \
307 --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \ 307 --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \
308 --eval "(setq generated-autoload-file \"$(lisp)/mh-e/mh-loaddefs.el\")" \ 308 --eval "(setq generated-autoload-file \"$(lisp)/mh-e/mh-loaddefs.el\")" \
309 --eval "(setq find-file-suppress-same-file-warnings t)" \
309 --eval "(setq make-backup-files nil)" \ 310 --eval "(setq make-backup-files nil)" \
310 -f batch-update-autoloads $(lisp)/mh-e 311 -f batch-update-autoloads $(lisp)/mh-e
311 312
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index bf3b1427ac2..f50ca07a488 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -2686,7 +2686,12 @@ away in the internal cache."
2686 ;; Require the previous column to end in a digit. 2686 ;; Require the previous column to end in a digit.
2687 ;; This avoids recognizing `1 may 1997' as a date in the line: 2687 ;; This avoids recognizing `1 may 1997' as a date in the line:
2688 ;; -r--r--r-- 1 may 1997 1168 Oct 19 16:49 README 2688 ;; -r--r--r-- 1 may 1997 1168 Oct 19 16:49 README
2689 (concat "[0-9]" s "\\(" western "\\|" japanese "\\)" s)) 2689 ;; albinus:
2690 ;; Require also the following column to start in a digit.
2691 ;; This avoids recognizing `kfs 10' as a date in the line:
2692 ;; -rw------- 1 kfs 10 May 27 2003 .autorun.lck
2693;; (concat "[0-9]" s "\\(" western "\\|" japanese "\\)" s))
2694 (concat "[0-9]" s "\\(" western "\\|" japanese "\\)" s "+[0-9]"))
2690 "Regular expression to match up to the column before the file name in a 2695 "Regular expression to match up to the column before the file name in a
2691directory listing. This regular expression is designed to recognize dates 2696directory listing. This regular expression is designed to recognize dates
2692regardless of the language.") 2697regardless of the language.")
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
new file mode 100644
index 00000000000..4448043056c
--- /dev/null
+++ b/lisp/net/rcirc.el
@@ -0,0 +1,1720 @@
1;;; rcirc.el --- default, simple IRC client.
2
3;; Copyright (C) 2005 Free Software Foundation, Inc.
4
5;; Author: Ryan Yeske
6;; URL: http://www.nongnu.org/rcirc
7;; Keywords: comm
8
9;; This file is part of GNU Emacs.
10
11;; This file is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; This file 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;; rcirc is an Internet Relay Chat (IRC) client for Emacs
29
30;; IRC is a form of instant communication over the Internet. It is
31;; mainly designed for group (many-to-many) communication in
32;; discussion forums called channels, but also allows one-to-one
33;; communication.
34
35;; Open a new irc connection with:
36;; M-x irc RET
37
38;;; Code:
39
40(require 'ring)
41(require 'time-date)
42(eval-when-compile (require 'cl))
43
44(defvar rcirc-server "irc.freenode.net"
45 "The default server to connect to.")
46
47(defvar rcirc-port 6667
48 "The default port to connect to.")
49
50(defvar rcirc-nick (user-login-name)
51 "Your nick.")
52
53(defvar rcirc-user-name (user-login-name)
54 "Your user name sent to the server when connecting.")
55
56(defvar rcirc-user-full-name (if (string= (user-full-name) "")
57 rcirc-user-name
58 (user-full-name))
59 "The full name sent to the server when connecting.")
60
61(defvar rcirc-startup-channels-alist nil
62 "Alist of channels to join at startup.
63Each element looks like (REGEXP . CHANNEL-LIST).")
64
65(defvar rcirc-fill-flag t
66 "*Non-nil means fill messages printed in channel buffers.")
67
68(defvar rcirc-fill-column nil
69 "*If non-nil, fill to this column, otherwise use value of `fill-column'.")
70
71(defvar rcirc-fill-prefix nil
72 "*Text to insert before filled lines.
73If nil, calculate the prefix dynamically to line up text
74underneath each nick.")
75
76(defvar rcirc-ignore-channel-activity nil
77 "If non-nil, ignore activity in this channel.")
78(make-variable-buffer-local 'rcirc-ignore-channel-activity)
79
80(defvar rcirc-ignore-all-activity-flag nil
81 "*Non-nil means track activity, but do not display it in the modeline.")
82
83(defvar rcirc-time-format "%H:%M "
84 "*Describes how timestamps are printed.
85Used as the first arg to `format-time-string'.")
86
87(defvar rcirc-input-ring-size 1024
88 "*Size of input history ring.")
89
90(defvar rcirc-read-only-flag t
91 "*Non-nil means make text in irc buffers read-only.")
92
93(defvar rcirc-buffer-maximum-lines nil
94 "*The maximum size in lines for rcirc buffers.
95Channel buffers are truncated from the top to be no greater than this
96number. If zero or nil, no truncating is done.")
97
98(defvar rcirc-authinfo-file-name
99 "~/.rcirc-authinfo"
100 "File containing rcirc authentication passwords.
101The file consists of a single list, with each element itself a
102list with a SERVER-REGEXP string, a NICK-REGEXP string, a METHOD
103and the remaining method specific ARGUMENTS. The valid METHOD
104symbols are `nickserv', `chanserv' and `bitlbee'.
105
106The required ARGUMENTS for each METHOD symbol are:
107 `nickserv': PASSWORD
108 `chanserv': CHANNEL PASSWORD
109 `bitlbee': PASSWORD
110
111Example:
112 ((\"freenode\" \"bob\" nickserv \"p455w0rd\")
113 (\"freenode\" \"bob\" chanserv \"#bobland\" \"passwd99\")
114 (\"bitlbee\" \"robert\" bitlbee \"sekrit\"))")
115
116(defvar rcirc-auto-authenticate-flag (file-readable-p rcirc-authinfo-file-name)
117 "*Non-nil means automatically send authentication string to server.
118See also `rcirc-authinfo-file-name'.")
119
120(defvar rcirc-print-hooks nil
121 "Hook run after text is printed.
122Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT.")
123
124(defvar rcirc-prompt "%n> "
125 "Prompt string to use in irc buffers.
126
127The following replacements are made:
128%n is your nick.
129%s is the server.
130%t is the buffer target, a channel or a user.
131
132Setting this alone will not affect the prompt;
133use `rcirc-update-prompt' after changing this variable.")
134
135(defvar rcirc-prompt-start-marker nil)
136(defvar rcirc-prompt-end-marker nil)
137
138(defvar rcirc-nick-table nil)
139
140(defvar rcirc-activity nil
141 "List of channels with unviewed activity.")
142
143(defvar rcirc-activity-string ""
144 "String displayed in modeline representing `rcirc-activity'.")
145(put 'rcirc-activity-string 'risky-local-variable t)
146
147(defvar rcirc-process nil
148 "The server process associated with this buffer.")
149
150(defvar rcirc-target nil
151 "The channel or user associated with this buffer.")
152
153(defvar rcirc-channels nil
154 "Joined channels.")
155
156(defvar rcirc-private-chats nil
157 "Private chats open.")
158
159(defvar rcirc-urls nil
160 "List of urls seen in the current buffer.")
161
162(defvar rcirc-keepalive-seconds 60
163 "Number of seconds between keepalive pings.")
164
165
166(defun rcirc-version (&optional here)
167 "Return rcirc version string.
168If optional argument HERE is non-nil, insert string at point."
169 (interactive "P")
170 (let ((version "rcirc.el 0.9 $Revision: 1.5 $"))
171 (if here
172 (insert version)
173 (if (interactive-p)
174 (message "%s" version)
175 version))))
176
177(defvar rcirc-startup-channels nil)
178;;;###autoload
179(defun rcirc (&optional server port nick channels)
180 "Connect to IRC.
181
182If any of the the optional SERVER, PORT, NICK or CHANNELS are not
183supplied, they are taken from the variables `rcirc-server',
184`rcirc-port', `rcirc-nick', and `rcirc-startup-channels',
185respectively."
186 (interactive (list (read-string "IRC Server: " rcirc-server)
187 (read-string "IRC Port: " (number-to-string rcirc-port))
188 (read-string "IRC Nick: " rcirc-nick)))
189 (or server (setq server rcirc-server))
190 (or port (setq port rcirc-port))
191 (or nick (setq nick rcirc-nick))
192 (or channels
193 (setq channels
194 (if (interactive-p)
195 (delete ""
196 (split-string
197 (read-string "Channels: "
198 (mapconcat 'identity
199 (rcirc-startup-channels server)
200 " "))
201 "[, ]+"))
202 (rcirc-startup-channels server))))
203 (or global-mode-string (setq global-mode-string '("")))
204 (and (not (memq 'rcirc-activity-string global-mode-string))
205 (setq global-mode-string
206 (append global-mode-string '(rcirc-activity-string))))
207 (add-hook 'window-configuration-change-hook 'rcirc-update-activity)
208 (rcirc-connect server port nick rcirc-user-name rcirc-user-full-name
209 channels))
210
211;;;###autoload
212(defalias 'irc 'rcirc)
213
214
215(defvar rcirc-process-output nil)
216(defvar rcirc-last-buffer nil)
217(defvar rcirc-topic nil)
218(defvar rcirc-keepalive-timer nil)
219(make-variable-buffer-local 'rcirc-topic)
220(defun rcirc-connect (server port nick user-name full-name startup-channels)
221 "Return a connection to SERVER on PORT.
222
223User will identify using the values of NICK, USER-NAME and
224FULL-NAME. The variable list of channel names in
225STARTUP-CHANNELS will automatically be joined on startup."
226 (save-excursion
227 (message "Connecting to %s..." server)
228 (let* ((inhibit-eol-conversion)
229 (port-number (if (stringp port)
230 (string-to-number port)
231 port))
232 (process (open-network-stream server nil server port-number)))
233 ;; set up process
234 (set-process-coding-system process 'raw-text 'raw-text)
235 (set-process-filter process 'rcirc-filter)
236 (switch-to-buffer (concat "*" (process-name process) "*"))
237 (set-process-buffer process (current-buffer))
238 (set-process-sentinel process 'rcirc-sentinel)
239 (rcirc-mode process nil)
240 (make-local-variable 'rcirc-nick-table)
241 (setq rcirc-nick-table (make-hash-table :test 'equal))
242 (make-local-variable 'rcirc-server)
243 (setq rcirc-server server)
244 (make-local-variable 'rcirc-nick)
245 (setq rcirc-nick nick)
246 (make-local-variable 'rcirc-process-output)
247 (setq rcirc-process-output nil)
248 (make-local-variable 'rcirc-last-buffer)
249 (setq rcirc-last-buffer (current-buffer))
250 (make-local-variable 'rcirc-channels)
251 (setq rcirc-channels nil)
252 (make-local-variable 'rcirc-private-chats)
253 (setq rcirc-private-chats nil)
254 (make-local-variable 'rcirc-startup-channels)
255 (setq rcirc-startup-channels startup-channels)
256
257 ;; identify
258 (rcirc-send-string process (concat "NICK " nick))
259 (rcirc-send-string process (concat "USER " user-name
260 " hostname servername :"
261 full-name))
262
263 ;; setup ping timer if necessary
264 (unless rcirc-keepalive-timer
265 (setq rcirc-keepalive-timer
266 (run-at-time 0 rcirc-keepalive-seconds 'rcirc-keepalive)))
267
268 (message "Connecting to %s...done" server)
269
270 ;; return process object
271 process)))
272
273(defun rcirc-keepalive ()
274 "Send keep alive pings to active rcirc processes."
275 (if (rcirc-process-list)
276 (mapc (lambda (process)
277 (with-current-buffer (process-buffer process)
278 (rcirc-send-string process (concat "PING " rcirc-server))))
279 (rcirc-process-list))
280 (cancel-timer rcirc-keepalive-timer)
281 (setq rcirc-keepalive-timer nil)))
282
283(defvar rcirc-log-buffer "*rcirc log*")
284(defvar rcirc-log-p nil
285 "If non-nil, write information to `rcirc-log-buffer'.")
286(defun rcirc-log (process text)
287 "Add an entry to the debug log including PROCESS and TEXT.
288Debug text is written to `rcirc-log-buffer' if `rcirc-log-p' is
289non-nil."
290 (when rcirc-log-p
291 (save-excursion
292 (save-window-excursion
293 (set-buffer (get-buffer-create rcirc-log-buffer))
294 (goto-char (point-max))
295 (insert (concat
296 "["
297 (format-time-string "%Y-%m-%dT%T ") (process-name process)
298 "] "
299 text))))))
300
301(defvar rcirc-sentinel-hooks nil
302 "Hook functions called when the process sentinel is called.
303Functions are called with PROCESS and SENTINEL arguments.")
304
305(defun rcirc-sentinel (process sentinel)
306 "Called when PROCESS receives SENTINEL."
307 (let ((sentinel (replace-regexp-in-string "\n" "" sentinel)))
308 (rcirc-log process (format "SENTINEL: %S %S\n" process sentinel))
309 (with-current-buffer (process-buffer process)
310 (dolist (target (append rcirc-channels
311 rcirc-private-chats
312 (list (current-buffer))))
313 (rcirc-print process "rcirc.el" "ERROR" target
314 (format "%s: %s (%S)"
315 (process-name process)
316 sentinel
317 (process-status process)) t)
318 ;; remove the prompt from buffers
319 (with-current-buffer (if (eq target (current-buffer))
320 (current-buffer)
321 (rcirc-get-buffer process target))
322 (let ((inhibit-read-only t))
323 (delete-region rcirc-prompt-start-marker
324 rcirc-prompt-end-marker)))))
325 (run-hook-with-args 'rcirc-sentinel-hooks process sentinel)))
326
327(defun rcirc-process-list ()
328 "Return a list of rcirc processes."
329 (let (ps)
330 (mapc (lambda (p)
331 (when (process-buffer p)
332 (with-current-buffer (process-buffer p)
333 (when (eq major-mode 'rcirc-mode)
334 (setq ps (cons p ps))))))
335 (process-list))
336 ps))
337
338(defvar rcirc-receive-message-hooks nil
339 "Hook functions run when a message is recieved from server.
340Function is called with PROCESS COMMAND SENDER ARGS and LINE.")
341(defun rcirc-filter (process output)
342 "Called when PROCESS receives OUTPUT."
343 (rcirc-log process output)
344 (with-current-buffer (process-buffer process)
345 (setq rcirc-process-output (concat rcirc-process-output output))
346 (when (= (aref rcirc-process-output
347 (1- (length rcirc-process-output))) ?\n)
348 (mapc (lambda (line)
349 (rcirc-process-server-response process line))
350 (delete "" (split-string rcirc-process-output "[\n\r]")))
351 (setq rcirc-process-output nil))))
352
353(defvar rcirc-trap-errors nil)
354(defun rcirc-process-server-response (process text)
355 (if rcirc-trap-errors
356 (condition-case err
357 (rcirc-process-server-response-1 process text)
358 (error
359 (rcirc-print process "RCIRC" "ERROR" nil
360 (format "rcirc: error processing: \"%s\" %s" text err))))
361 (rcirc-process-server-response-1 process text)))
362
363(defun rcirc-process-server-response-1 (process text)
364 (if (string-match "^\\(:\\([^ ]+\\) \\)?\\([^ ]+\\) \\(.+\\)$" text)
365 (let* ((sender (match-string 2 text))
366 (cmd (match-string 3 text))
367 (args (match-string 4 text))
368 (handler (intern-soft (concat "rcirc-handler-" cmd))))
369 (string-match "^\\([^:]*\\):?\\(.+\\)?$" args)
370 (let* ((args1 (match-string 1 args))
371 (args2 (match-string 2 args))
372 (args (append (delete "" (split-string args1 " "))
373 (list args2))))
374 (if (not (fboundp handler))
375 (rcirc-handler-generic process cmd sender args text)
376 (funcall handler process sender args text))
377 (run-hook-with-args 'rcirc-receive-message-hooks
378 process cmd sender args text)))
379 (message "UNHANDLED: %s" text)))
380
381(defun rcirc-handler-generic (process command sender args text)
382 "Generic server response handler."
383 (rcirc-print process sender command nil
384 (mapconcat 'identity (cdr args) " ")))
385
386(defun rcirc-send-string (process string)
387 "Send PROCESS a STRING plus a newline."
388 (let ((string (concat (encode-coding-string string
389 buffer-file-coding-system)
390 "\n")))
391 (rcirc-log process string)
392 (process-send-string process string)))
393
394(defun rcirc-server (process)
395 "Return PROCESS server, given by the 001 response."
396 (with-current-buffer (process-buffer process)
397 rcirc-server))
398
399(defun rcirc-nick (process)
400 "Return PROCESS nick."
401 (with-current-buffer (process-buffer process)
402 rcirc-nick))
403
404(defvar rcirc-max-message-length 450
405 "Messages longer than this value will be split.")
406
407(defun rcirc-send-message (process target message &optional noticep)
408 "Send TARGET associated with PROCESS a privmsg with text MESSAGE.
409If NOTICEP is non-nil, send a notice instead of privmsg."
410 ;; max message length is 512 including CRLF
411 (let* ((response (if noticep "NOTICE" "PRIVMSG"))
412 (oversize (> (length message) rcirc-max-message-length))
413 (text (if oversize
414 (substring message 0 rcirc-max-message-length)
415 message))
416 (text (if (string= text "")
417 " "
418 text))
419 (more (if oversize
420 (substring message rcirc-max-message-length))))
421 (rcirc-print process (rcirc-nick process) response target text)
422 (rcirc-send-string process (concat response " " target " :" text))
423 (if more
424 (rcirc-send-message process target more noticep))))
425
426(defvar rcirc-input-ring nil)
427(defvar rcirc-input-ring-index 0)
428(defun rcirc-prev-input-string (arg)
429 (ring-ref rcirc-input-ring (+ rcirc-input-ring-index arg)))
430
431(defun rcirc-insert-prev-input (arg)
432 (interactive "p")
433 (when (<= rcirc-prompt-end-marker (point))
434 (delete-region rcirc-prompt-end-marker (point-max))
435 (insert (rcirc-prev-input-string 0))
436 (setq rcirc-input-ring-index (1+ rcirc-input-ring-index))))
437
438(defun rcirc-insert-next-input (arg)
439 (interactive "p")
440 (when (<= rcirc-prompt-end-marker (point))
441 (delete-region rcirc-prompt-end-marker (point-max))
442 (setq rcirc-input-ring-index (1- rcirc-input-ring-index))
443 (insert (rcirc-prev-input-string -1))))
444
445(defvar rcirc-nick-completions nil)
446(defvar rcirc-nick-completion-start-offset nil)
447(defun rcirc-complete-nick ()
448 "Cycle through nick completions from list of nicks in channel."
449 (interactive)
450 (if (eq last-command 'rcirc-complete-nick)
451 (setq rcirc-nick-completions
452 (append (cdr rcirc-nick-completions)
453 (list (car rcirc-nick-completions))))
454 (setq rcirc-nick-completion-start-offset
455 (- (save-excursion
456 (if (re-search-backward " " rcirc-prompt-end-marker t)
457 (1+ (point))
458 rcirc-prompt-end-marker))
459 rcirc-prompt-end-marker))
460 (setq rcirc-nick-completions
461 (let ((completion-ignore-case t))
462 (all-completions
463 (buffer-substring
464 (+ rcirc-prompt-end-marker
465 rcirc-nick-completion-start-offset)
466 (point))
467 (mapcar (lambda (x) (cons x nil))
468 (rcirc-channel-nicks rcirc-process
469 (rcirc-buffer-target)))))))
470 (let ((completion (car rcirc-nick-completions)))
471 (when completion
472 (delete-region (+ rcirc-prompt-end-marker
473 rcirc-nick-completion-start-offset)
474 (point))
475 (insert (concat completion
476 (if (= (+ rcirc-prompt-end-marker
477 rcirc-nick-completion-start-offset)
478 rcirc-prompt-end-marker)
479 ": "))))))
480
481(defun rcirc-buffer-target (&optional buffer)
482 "Return the name of target for BUFFER.
483If buffer is nil, return the target of the current buffer."
484 (with-current-buffer (or buffer (current-buffer))
485 rcirc-target))
486
487(defvar rcirc-mode-map (make-sparse-keymap)
488 "Keymap for rcirc mode.")
489
490(define-key rcirc-mode-map (kbd "RET") 'rcirc-send-input)
491(define-key rcirc-mode-map (kbd "M-p") 'rcirc-insert-prev-input)
492(define-key rcirc-mode-map (kbd "M-n") 'rcirc-insert-next-input)
493(define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete-nick)
494(define-key rcirc-mode-map (kbd "C-c C-b") 'rcirc-browse-url)
495(define-key rcirc-mode-map (kbd "C-c C-c") 'rcirc-edit-multiline)
496(define-key rcirc-mode-map (kbd "C-c C-j") 'rcirc-cmd-join)
497(define-key rcirc-mode-map (kbd "C-c C-k") 'rcirc-cmd-kick)
498(define-key rcirc-mode-map (kbd "C-c C-l") 'rcirc-cmd-list)
499(define-key rcirc-mode-map (kbd "C-c C-d") 'rcirc-cmd-mode)
500(define-key rcirc-mode-map (kbd "C-c C-m") 'rcirc-cmd-msg)
501(define-key rcirc-mode-map (kbd "C-c C-r") 'rcirc-cmd-nick) ; rename
502(define-key rcirc-mode-map (kbd "C-c C-o") 'rcirc-cmd-oper)
503(define-key rcirc-mode-map (kbd "C-c C-p") 'rcirc-cmd-part)
504(define-key rcirc-mode-map (kbd "C-c C-q") 'rcirc-cmd-query)
505(define-key rcirc-mode-map (kbd "C-c C-t") 'rcirc-cmd-topic)
506(define-key rcirc-mode-map (kbd "C-c C-n") 'rcirc-cmd-names)
507(define-key rcirc-mode-map (kbd "C-c C-w") 'rcirc-cmd-whois)
508(define-key rcirc-mode-map (kbd "C-c C-x") 'rcirc-cmd-quit)
509(define-key rcirc-mode-map (kbd "C-c TAB") ; C-i
510 'rcirc-toggle-ignore-channel-activity)
511(define-key rcirc-mode-map (kbd "C-c C-s") 'rcirc-switch-to-server-buffer)
512(define-key rcirc-mode-map (kbd "C-c C-a") 'rcirc-jump-to-first-unread-line)
513
514(define-key global-map (kbd "C-c `") 'rcirc-next-active-buffer)
515(define-key global-map (kbd "C-c C-@") 'rcirc-next-active-buffer)
516(define-key global-map (kbd "C-c C-SPC") 'rcirc-next-active-buffer)
517
518(defvar rcirc-mode-hook nil
519 "Hook run when setting up rcirc buffer.")
520
521(defun rcirc-mode (process target)
522 "Major mode for irc channel buffers.
523
524\\{rcirc-mode-map}"
525 (kill-all-local-variables)
526 (use-local-map rcirc-mode-map)
527 (setq mode-name "rcirc")
528 (setq major-mode 'rcirc-mode)
529
530 (make-local-variable 'rcirc-input-ring)
531 (setq rcirc-input-ring (make-ring rcirc-input-ring-size))
532 (make-local-variable 'rcirc-process)
533 (setq rcirc-process process)
534 (make-local-variable 'rcirc-target)
535 (setq rcirc-target target)
536 (make-local-variable 'rcirc-urls)
537 (setq rcirc-urls nil)
538 (setq use-hard-newlines t)
539 (when (rcirc-channel-p rcirc-target)
540 (setq header-line-format 'rcirc-topic))
541
542 ;; setup the prompt and markers
543 (make-local-variable 'rcirc-prompt-start-marker)
544 (setq rcirc-prompt-start-marker (make-marker))
545 (set-marker rcirc-prompt-start-marker (point-max))
546 (make-local-variable 'rcirc-prompt-end-marker)
547 (setq rcirc-prompt-end-marker (make-marker))
548 (set-marker rcirc-prompt-end-marker (point-max))
549 (rcirc-update-prompt)
550 (goto-char rcirc-prompt-end-marker)
551 (make-local-variable 'overlay-arrow-position)
552 (setq overlay-arrow-position (make-marker))
553 (set-marker overlay-arrow-position nil)
554
555 (run-hooks 'rcirc-mode-hook))
556
557(defmacro with-rcirc-process-buffer (process &rest body)
558 (declare (indent 1) (debug t))
559 `(with-current-buffer (process-buffer ,process)
560 ,@body))
561
562(defun rcirc-update-prompt ()
563 "Reset the prompt string in the current buffer."
564 (let ((inhibit-read-only t)
565 (prompt (or rcirc-prompt "")))
566 (mapc (lambda (rep)
567 (setq prompt
568 (replace-regexp-in-string (car rep) (cdr rep) prompt)))
569 (list (cons "%n" (with-rcirc-process-buffer rcirc-process
570 rcirc-nick))
571 (cons "%s" (with-rcirc-process-buffer rcirc-process
572 rcirc-server))
573 (cons "%t" (or rcirc-target ""))))
574 (save-excursion
575 (delete-region rcirc-prompt-start-marker rcirc-prompt-end-marker)
576 (goto-char rcirc-prompt-start-marker)
577 (let ((start (point)))
578 (insert-before-markers prompt)
579 (set-marker rcirc-prompt-start-marker start)
580 (when (not (zerop (- rcirc-prompt-end-marker
581 rcirc-prompt-start-marker)))
582 (add-text-properties rcirc-prompt-start-marker
583 rcirc-prompt-end-marker
584 (list 'face 'rcirc-prompt-face
585 'read-only t 'field t
586 'front-sticky t 'rear-nonsticky t)))))))
587
588(defun rcirc-channel-p (target)
589 "Return t if TARGET is a channel name."
590 (and target
591 (not (zerop (length target)))
592 (or (eq (aref target 0) ?#)
593 (eq (aref target 0) ?&))))
594
595(defun rcirc-kill-buffer-hook ()
596 "Part the channel when killing an rcirc buffer."
597 (when (eq major-mode 'rcirc-mode)
598 (rcirc-clear-activity (current-buffer))
599 (when (and rcirc-process
600 (eq (process-status rcirc-process) 'open))
601 (if (rcirc-channel-p rcirc-target)
602 (rcirc-cmd-part "" rcirc-process rcirc-target)
603 ;; remove target from privchat list
604 (when rcirc-target
605 (let ((target (downcase rcirc-target)))
606 (with-rcirc-process-buffer rcirc-process
607 (setq rcirc-private-chats
608 (delete target rcirc-private-chats)))))))))
609(add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook)
610
611(defun rcirc-get-buffer-name (process target)
612 "Return buffer name based on PROCESS and TARGET."
613 (concat (and target (downcase target)) "@" (process-name process)))
614
615(defun rcirc-get-buffer (process target &optional error)
616 "Return the buffer associated with the PROCESS and TARGET.
617If TARGET is nil and ERROR is nil, return the process buffer."
618 (let ((buffer (and target
619 (get-buffer (rcirc-get-buffer-name process target)))))
620 (if (and buffer (buffer-live-p buffer))
621 buffer
622 (if error
623 (error "Buffer associated with %s does not exist" target)
624 (process-buffer process)))))
625
626(defun rcirc-get-buffer-create (process target)
627 "Return the buffer named associated with the PROCESS and TARGET.
628Create the buffer if it doesn't exist. If TARGET is nil, return
629the process buffer."
630 (with-current-buffer (process-buffer process)
631 (if (not target)
632 (current-buffer)
633 (let ((target (downcase target)))
634 ;; add private chats to list. we dont add channels here, they
635 ;; are managed by the join/part/quit handlers
636 (when (and (not (rcirc-channel-p target))
637 (not (member target rcirc-private-chats)))
638 (with-rcirc-process-buffer process
639 (setq rcirc-private-chats (cons target rcirc-private-chats))))
640 ;; create and setup a buffer, or return the existing one
641 (let ((bufname (rcirc-get-buffer-name process target)))
642 (with-current-buffer (get-buffer-create bufname)
643 (if (or (not rcirc-process)
644 (not (equal (process-status rcirc-process) 'open)))
645 (rcirc-mode process target)
646 (setq rcirc-target target))
647 (current-buffer)))))))
648
649(defun rcirc-send-input ()
650 "Send input to target associated with the current buffer."
651 (interactive)
652 (if (not (eq (process-status rcirc-process) 'open))
653 (error "Network connection to %s is not open"
654 (process-name rcirc-process))
655 ;; update last buffer
656 (rcirc-set-last-buffer rcirc-process (current-buffer))
657 (if (< (point) rcirc-prompt-end-marker)
658 ;; copy the line down to the input area
659 (progn
660 (forward-line 0)
661 (let ((start (if (eq (point) (point-min))
662 (point)
663 (if (get-text-property (1- (point)) 'hard)
664 (point)
665 (previous-single-property-change (point) 'hard))))
666 (end (next-single-property-change (1+ (point)) 'hard)))
667 (goto-char (point-max))
668 (insert (replace-regexp-in-string
669 "\n\\s-+" " "
670 (buffer-substring-no-properties start end)))))
671 ;; assume text has been read
672 (when (marker-position overlay-arrow-position)
673 (set-marker overlay-arrow-position nil))
674 ;; process input
675 (goto-char (point-max))
676 (let ((target (rcirc-buffer-target))
677 (start rcirc-prompt-end-marker))
678 (when (not (equal 0 (- (point) start)))
679 ;; delete a trailing newline
680 (when (eq (point) (point-at-bol))
681 (delete-backward-char 1))
682 (let ((input (buffer-substring-no-properties
683 rcirc-prompt-end-marker (point))))
684 ;; process a /cmd
685 (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" input)
686 (let* ((command (match-string 1 input))
687 (fun (intern-soft (concat "rcirc-cmd-" command)))
688 (args (match-string 2 input)))
689 (newline)
690 (with-current-buffer (current-buffer)
691 (delete-region rcirc-prompt-end-marker (point))
692 (if (string= command "me")
693 (rcirc-print rcirc-process (rcirc-nick rcirc-process)
694 "ACTION" target args)
695 (rcirc-print rcirc-process (rcirc-nick rcirc-process)
696 "COMMAND" target input))
697 (set-marker rcirc-prompt-end-marker (point))
698 (if (fboundp fun)
699 (funcall fun args rcirc-process target)
700 (rcirc-send-string rcirc-process
701 (concat command " " args)))))
702 ;; send message to server
703 (if (not rcirc-target)
704 (message "Not joined")
705 (delete-region rcirc-prompt-end-marker (point))
706 (mapc (lambda (message)
707 (rcirc-send-message rcirc-process target message))
708 (split-string input "\n"))))
709 ;; add to input-ring
710 (save-excursion
711 (ring-insert rcirc-input-ring input)
712 (setq rcirc-input-ring-index 0))))))))
713
714(defvar rcirc-parent-buffer nil)
715(defvar rcirc-window-configuration nil)
716(defun rcirc-edit-multiline ()
717 "Move current edit to a dedicated buffer."
718 (interactive)
719 (let ((pos (1+ (- (point) rcirc-prompt-end-marker))))
720 (goto-char (point-max))
721 (let ((text (buffer-substring rcirc-prompt-end-marker (point)))
722 (parent (buffer-name))
723 (process rcirc-process))
724 (delete-region rcirc-prompt-end-marker (point))
725 (setq rcirc-window-configuration (current-window-configuration))
726 (pop-to-buffer (concat "*multiline " parent "*"))
727 (rcirc-multiline-edit-mode)
728 (setq rcirc-parent-buffer parent)
729 (setq rcirc-process process)
730 (insert text)
731 (and (> pos 0) (goto-char pos)))))
732
733(define-derived-mode rcirc-multiline-edit-mode
734 text-mode "rcirc multi"
735 "Major mode for multiline edits
736\\{rcirc-multiline-edit-mode-map}"
737 (make-local-variable 'rcirc-parent-buffer)
738 (make-local-variable 'rcirc-process))
739
740(define-key rcirc-multiline-edit-mode-map
741 (kbd "C-c C-c") 'rcirc-multiline-edit-submit)
742(define-key rcirc-multiline-edit-mode-map
743 (kbd "C-x C-s") 'rcirc-multiline-edit-submit)
744(define-key rcirc-multiline-edit-mode-map
745 (kbd "C-c C-k") 'rcirc-multiline-edit-cancel)
746(define-key rcirc-multiline-edit-mode-map
747 (kbd "ESC ESC ESC") 'rcirc-multiline-edit-cancel)
748
749(defun rcirc-multiline-edit-submit ()
750 "Send the text in buffer back to parent buffer."
751 (interactive)
752 (assert (and (eq major-mode 'rcirc-multiline-edit-mode)))
753 (assert rcirc-parent-buffer)
754 (let ((text (buffer-substring (point-min) (point-max)))
755 (buffer (current-buffer))
756 (pos (point)))
757 (set-buffer rcirc-parent-buffer)
758 (goto-char (point-max))
759 (insert text)
760 (goto-char (+ rcirc-prompt-end-marker (1- pos)))
761 (kill-buffer buffer)
762 (set-window-configuration rcirc-window-configuration)))
763
764(defun rcirc-multiline-edit-cancel ()
765 "Cancel the multiline edit."
766 (interactive)
767 (assert (and (eq major-mode 'rcirc-multiline-edit-mode)))
768 (kill-buffer (current-buffer))
769 (set-window-configuration rcirc-window-configuration))
770
771(defun rcirc-last-buffer (process)
772 "Return the last working buffer for PROCESS.
773Used for displaying messages that don't have an explicit destination."
774 (with-current-buffer (process-buffer process)
775 (or (and rcirc-last-buffer
776 (buffer-live-p rcirc-last-buffer)
777 rcirc-last-buffer)
778 (current-buffer))))
779
780(defun rcirc-set-last-buffer (process buffer)
781 "Set the last working buffer for PROCESS to BUFFER."
782 (with-current-buffer (process-buffer process)
783 (setq rcirc-last-buffer buffer)))
784
785(defun rcirc-format-response-string (process sender response target text)
786 (concat (when rcirc-time-format
787 (format-time-string rcirc-time-format (current-time)))
788 (cond ((or (string= response "PRIVMSG")
789 (string= response "NOTICE")
790 (string= response "ACTION"))
791 (let (first middle end)
792 (cond ((string= response "PRIVMSG")
793 (setq first "<" middle "> "))
794 ((string= response "NOTICE")
795 (setq first "-" middle "- "))
796 (t
797 (setq first "[" middle " " end "]")))
798 (concat first
799 (rcirc-facify (rcirc-user-nick sender)
800 (if (string= sender
801 (rcirc-nick process))
802 'rcirc-my-nick-face
803 'rcirc-other-nick-face))
804 middle
805 (rcirc-mangle-text process text)
806 end)))
807 ((string= response "COMMAND")
808 text)
809 ((string= response "ERROR")
810 (propertize text 'face 'font-lock-warning-face))
811 (t
812 (rcirc-mangle-text
813 process
814 (rcirc-facify
815 (concat "*** "
816 (when (not (string= sender (rcirc-server process)))
817 (concat (rcirc-user-nick sender) " "))
818 (when (zerop (string-to-number response))
819 (concat response " "))
820 (when (and target (not (string= target rcirc-target)))
821 (concat target " "))
822 text)
823 'rcirc-server-face))))))
824
825(defvar rcirc-activity-type nil)
826(make-variable-buffer-local 'rcirc-activity-type)
827(defun rcirc-print (process sender response target text &optional activity)
828 "Print TEXT in the buffer associated with TARGET.
829Format based on SENDER and RESPONSE. If ACTIVITY is non-nil,
830record activity."
831 (let* ((buffer (cond ((bufferp target)
832 target)
833 ((not target)
834 (rcirc-last-buffer process))
835 ((not (rcirc-channel-p target))
836 (rcirc-get-buffer-create process target))
837 ((rcirc-get-buffer process target))
838 (t (process-buffer process))))
839 (inhibit-read-only t))
840 (with-current-buffer buffer
841 (let ((moving (= (point) rcirc-prompt-end-marker))
842 (old-point (point-marker))
843 (fill-start (marker-position rcirc-prompt-start-marker)))
844
845 (unless (string= sender (rcirc-nick process))
846 ;; only decode text from other senders, not ours
847 (setq text (decode-coding-string text buffer-file-coding-system))
848 ;; mark the line with overlay arrow
849 (unless (or (marker-position overlay-arrow-position)
850 (get-buffer-window (current-buffer)))
851 (set-marker overlay-arrow-position
852 (marker-position rcirc-prompt-start-marker))))
853
854 ;; temporarily set the marker insertion-type because
855 ;; insert-before-markers results in hidden text in new buffers
856 (goto-char rcirc-prompt-start-marker)
857 (set-marker-insertion-type rcirc-prompt-start-marker t)
858 (set-marker-insertion-type rcirc-prompt-end-marker t)
859 (insert
860 (rcirc-format-response-string process sender response target text)
861 (propertize "\n" 'hard t))
862 (set-marker-insertion-type rcirc-prompt-start-marker nil)
863 (set-marker-insertion-type rcirc-prompt-end-marker nil)
864
865 ;; fill the text we just inserted, maybe
866 (when (and rcirc-fill-flag
867 (not (string= response "372"))) ;/motd
868 (let ((fill-prefix
869 (or rcirc-fill-prefix
870 (make-string
871 (+ (if rcirc-time-format
872 (length (format-time-string
873 rcirc-time-format))
874 0)
875 (cond ((or (string= response "PRIVMSG")
876 (string= response "NOTICE"))
877 (+ (length (rcirc-user-nick sender))
878 2)) ; <>
879 ((string= response "ACTION")
880 (+ (length (rcirc-user-nick sender))
881 1)) ; [
882 (t 3)) ; ***
883 1)
884 ? )))
885 (fill-column (or rcirc-fill-column fill-column)))
886 (fill-region fill-start rcirc-prompt-start-marker 'left t)))
887
888 ;; truncate buffer if it is very long
889 (save-excursion
890 (when (and rcirc-buffer-maximum-lines
891 (> rcirc-buffer-maximum-lines 0)
892 (= (forward-line (- rcirc-buffer-maximum-lines)) 0))
893 (delete-region (point-min) (point))))
894
895 ;; set inserted text to be read-only
896 (when rcirc-read-only-flag
897 (put-text-property rcirc-prompt-start-marker fill-start 'read-only t)
898 (let ((inhibit-read-only t))
899 (put-text-property rcirc-prompt-start-marker fill-start
900 'front-sticky t)
901 (put-text-property (1- (point)) (point) 'rear-nonsticky t)))
902
903 ;; set the window point for buffers show in windows
904 (walk-windows (lambda (w)
905 (unless (eq (selected-window) w)
906 (when (and (eq (current-buffer)
907 (window-buffer w))
908 (>= (window-point w)
909 rcirc-prompt-end-marker))
910 (set-window-point w (point-max)))))
911 nil t)
912
913 ;; restore the point
914 (goto-char (if moving rcirc-prompt-end-marker old-point))
915
916 ;; flush undo (can we do something smarter here?)
917 (buffer-disable-undo)
918 (buffer-enable-undo))
919
920 ;; record modeline activity
921 (when activity
922 (let ((nick-match
923 (string-match (concat "\\b"
924 (regexp-quote (rcirc-nick process))
925 "\\b")
926 text)))
927 (when (or (not rcirc-ignore-channel-activity)
928 ;; always notice when our nick is mentioned, even
929 ;; if ignoring channel activity
930 nick-match)
931 (rcirc-record-activity
932 (current-buffer)
933 (when (or nick-match (not (rcirc-channel-p rcirc-target)))
934 'nick)))))
935
936 (run-hook-with-args 'rcirc-print-hooks
937 process sender response target text))))
938
939(defun rcirc-startup-channels (server)
940 "Return the list of startup channels for server."
941 (let (channels)
942 (dolist (i rcirc-startup-channels-alist)
943 (if (string-match (car i) server)
944 (setq channels (append channels (cdr i)))))
945 channels))
946
947(defun rcirc-join-channels (process channels)
948 "Join CHANNELS."
949 (save-window-excursion
950 (mapc (lambda (channel)
951 (with-current-buffer (process-buffer process)
952 (let (rcirc-last-buffer) ; make sure /join text is
953 ; printed in server buffer
954 (rcirc-print process (rcirc-nick process) "COMMAND"
955 nil (concat "/join " channel)))
956 (rcirc-cmd-join channel process)))
957 channels)))
958
959;;; nick management
960(defun rcirc-user-nick (user)
961 "Return the nick from USER. Remove any non-nick junk."
962 (if (string-match "^[@%+]?\\([^! ]+\\)!?" (or user ""))
963 (match-string 1 user)
964 user))
965
966(defun rcirc-user-non-nick (user)
967 "Return the non-nick portion of USER."
968 (if (string-match "^[@+]?[^! ]+!?\\(.*\\)" (or user ""))
969 (match-string 1 user)
970 user))
971
972(defun rcirc-nick-channels (process nick)
973 "Return list of channels for NICK."
974 (let ((nick (rcirc-user-nick nick)))
975 (with-current-buffer (process-buffer process)
976 (mapcar (lambda (x) (car x))
977 (gethash nick rcirc-nick-table)))))
978
979(defun rcirc-put-nick-channel (process nick channel)
980 "Add CHANNEL to list associated with NICK."
981 (with-current-buffer (process-buffer process)
982 (let* ((nick (rcirc-user-nick nick))
983 (chans (gethash nick rcirc-nick-table))
984 (record (assoc channel chans)))
985 (if record
986 (setcdr record (current-time))
987 (puthash nick (cons (cons channel (current-time))
988 chans)
989 rcirc-nick-table)))))
990
991(defun rcirc-nick-remove (process nick)
992 "Remove NICK from table."
993 (with-current-buffer (process-buffer process)
994 (remhash nick rcirc-nick-table)))
995
996(defun rcirc-remove-nick-channel (process nick channel)
997 "Remove the CHANNEL from list associated with NICK."
998 (with-current-buffer (process-buffer process)
999 (let* ((nick (rcirc-user-nick nick))
1000 (chans (gethash nick rcirc-nick-table))
1001 (newchans (assq-delete-all channel chans)))
1002 (if newchans
1003 (puthash nick newchans rcirc-nick-table)
1004 (remhash nick rcirc-nick-table)))))
1005
1006(defun rcirc-channel-nicks (process channel)
1007 "Return the list of nicks in CHANNEL sorted by last activity."
1008 (with-current-buffer (process-buffer process)
1009 (let (nicks)
1010 (maphash
1011 (lambda (k v)
1012 (let ((record (assoc channel v)))
1013 (if record
1014 (setq nicks (cons (cons k (cdr record)) nicks)))))
1015 rcirc-nick-table)
1016 (mapcar (lambda (x) (car x))
1017 (sort nicks (lambda (x y) (time-less-p (cdr y) (cdr x))))))))
1018
1019;;; activity tracking
1020(or (assq 'rcirc-ignore-channel-activity minor-mode-alist)
1021 (setq minor-mode-alist
1022 (cons '(rcirc-ignore-channel-activity " Ignore") minor-mode-alist)))
1023
1024(defun rcirc-toggle-ignore-channel-activity (&optional all)
1025 "Toggle the value of `rcirc-ignore-channel-activity'.
1026If ALL is non-nil, instead toggle the value of
1027`rcirc-ignore-all-activity-flag'."
1028 (interactive "P")
1029 (if all
1030 (progn
1031 (setq rcirc-ignore-all-activity-flag
1032 (not rcirc-ignore-all-activity-flag))
1033 (message (concat "Global activity "
1034 (if rcirc-ignore-all-activity-flag
1035 "hidden"
1036 "displayed")))
1037 (rcirc-update-activity-string))
1038 (setq rcirc-ignore-channel-activity
1039 (not rcirc-ignore-channel-activity)))
1040 (force-mode-line-update))
1041
1042(defvar rcirc-switch-to-buffer-function 'switch-to-buffer
1043 "Function to use when switching buffers.
1044Possible values are `switch-to-buffer', `pop-to-buffer', and
1045`display-buffer'.")
1046
1047(defun rcirc-switch-to-server-buffer ()
1048 "Switch to the server buffer associated with current channel buffer."
1049 (interactive)
1050 (funcall rcirc-switch-to-buffer-function (process-buffer rcirc-process)))
1051
1052(defun rcirc-jump-to-first-unread-line ()
1053 "Move the point to the first unread line in this buffer."
1054 (interactive)
1055 (when (marker-position overlay-arrow-position)
1056 (goto-char overlay-arrow-position)))
1057
1058(defvar rcirc-last-non-irc-buffer nil
1059 "The buffer to switch to when there is no more activity.")
1060
1061(defun rcirc-next-active-buffer (arg)
1062 "Go to the ARGth rcirc buffer with activity.
1063The function given by `rcirc-switch-to-buffer-function' is used to
1064show the buffer."
1065 (interactive "p")
1066 (if rcirc-activity
1067 (progn
1068 (unless (eq major-mode 'rcirc-mode)
1069 (setq rcirc-last-non-irc-buffer (current-buffer)))
1070 (if (and (> arg 0)
1071 (<= arg (length rcirc-activity)))
1072 (funcall rcirc-switch-to-buffer-function
1073 (nth (1- arg) rcirc-activity))
1074 (message "Invalid arg: %d" arg)))
1075 (if (eq major-mode 'rcirc-mode)
1076 (if (not (and rcirc-last-non-irc-buffer
1077 (buffer-live-p rcirc-last-non-irc-buffer)))
1078 (message "No last buffer.")
1079 (funcall rcirc-switch-to-buffer-function rcirc-last-non-irc-buffer)
1080 (setq rcirc-last-non-irc-buffer nil))
1081 (message "No channel activity. Go start something."))))
1082
1083(defvar rcirc-activity-hooks nil
1084 "Hook to be run when there is channel activity.
1085
1086Functions are called with a single argument, the buffer with the
1087activity. Only run if the buffer is not visible and
1088`rcirc-ignore-channel-activity' is non-nil.")
1089
1090(defun rcirc-record-activity (buffer type)
1091 "Record BUFFER activity with TYPE."
1092 (with-current-buffer buffer
1093 (when (not (get-buffer-window (current-buffer) t))
1094 (add-to-list 'rcirc-activity (current-buffer) 'append)
1095 (if (not rcirc-activity-type)
1096 (setq rcirc-activity-type type))
1097 (rcirc-update-activity-string)))
1098 (run-hook-with-args 'rcirc-activity-hooks buffer))
1099
1100(defun rcirc-clear-activity (buffer)
1101 "Clear the BUFFER activity."
1102 (setq rcirc-activity (delete buffer rcirc-activity))
1103 (with-current-buffer buffer
1104 (setq rcirc-activity-type nil)))
1105
1106(defun rcirc-update-activity-string ()
1107 "Update mode-line string."
1108 (setq rcirc-activity-string
1109 (if (or rcirc-ignore-all-activity-flag
1110 (not rcirc-activity))
1111 ""
1112 (concat " [" (mapconcat
1113 (lambda (b)
1114 (let ((s (rcirc-short-buffer-name b)))
1115 (with-current-buffer b
1116 (if (not (eq rcirc-activity-type 'nick))
1117 s
1118 (rcirc-facify s
1119 'rcirc-mode-line-nick-face)))))
1120 rcirc-activity ",") "]"))))
1121
1122(defun rcirc-short-buffer-name (buffer)
1123 "Return a short name for BUFFER to use in the modeline indicator."
1124 (with-current-buffer buffer
1125 (or rcirc-target (process-name rcirc-process))))
1126
1127(defun rcirc-update-activity ()
1128 "Go through visible windows and remove buffers from activity list."
1129 (walk-windows (lambda (w) (rcirc-clear-activity (window-buffer w))))
1130 (rcirc-update-activity-string))
1131
1132
1133;;; /commands these are called with 3 args: PROCESS, TARGET, which is
1134;; the current buffer/channel/user, and ARGS, which is a string
1135;; containing the text following the /cmd.
1136
1137(defmacro defun-rcirc-command (command argument docstring interactive-form
1138 &rest body)
1139 "Define a command."
1140 `(defun ,(intern (concat "rcirc-cmd-" (symbol-name command)))
1141 (,@argument &optional process target)
1142 ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values of"
1143 "\nbuffer local variables `rcirc-process' and `rcirc-target',"
1144 "\nwill be used.")
1145 ,interactive-form
1146 (let ((process (or process rcirc-process))
1147 (target (or target rcirc-target)))
1148 ,@body)))
1149
1150(defun-rcirc-command msg (message)
1151 "Send private MESSAGE to TARGET."
1152 (interactive "i")
1153 (if (null message)
1154 (progn
1155 (setq target (completing-read "Message nick: "
1156 (with-current-buffer
1157 (process-buffer rcirc-process)
1158 rcirc-nick-table)))
1159 (when (> (length target) 0)
1160 (setq message (read-string (format "Message %s: " target)))
1161 (when (> (length message) 0)
1162 (rcirc-send-message process target message))))
1163 (if (not (string-match "\\([^ ]+\\) \\(.+\\)" message))
1164 (message "Not enough args, or something.")
1165 (setq target (match-string 1 message)
1166 message (match-string 2 message))
1167 (rcirc-send-message process target message))))
1168
1169(defun-rcirc-command query (nick)
1170 "Open a private chat buffer to NICK."
1171 (interactive (list (completing-read "Query nick: "
1172 (with-current-buffer
1173 (process-buffer rcirc-process)
1174 rcirc-nick-table))))
1175 (let ((new-buffer (eq (rcirc-get-buffer rcirc-process nick)
1176 (process-buffer rcirc-process))))
1177 (switch-to-buffer (rcirc-get-buffer-create process nick))
1178 (when new-buffer
1179 (rcirc-cmd-whois nick))))
1180
1181(defun-rcirc-command join (args)
1182 "Join CHANNEL."
1183 (interactive "sJoin channel: ")
1184 (let* ((channel (car (split-string args)))
1185 (buffer (rcirc-get-buffer-create process channel)))
1186 (when (not (eq (selected-window) (minibuffer-window)))
1187 (funcall rcirc-switch-to-buffer-function buffer))
1188 (rcirc-send-string process (concat "JOIN " args))
1189 (rcirc-set-last-buffer process buffer)))
1190
1191(defun-rcirc-command part (channel)
1192 "Part CHANNEL."
1193 (interactive "sPart channel: ")
1194 (let ((channel (if (> (length channel) 0) channel target)))
1195 (rcirc-send-string process (concat "PART " channel " :" (rcirc-version)))))
1196
1197(defun-rcirc-command quit (reason)
1198 "Send a quit message to server with REASON."
1199 (interactive "sQuit reason: ")
1200 (rcirc-send-string process (concat "QUIT :" reason)))
1201
1202(defun-rcirc-command nick (nick)
1203 "Change nick to NICK."
1204 (interactive "i")
1205 (when (null nick)
1206 (setq nick (read-string "New nick: " (rcirc-nick process))))
1207 (rcirc-send-string process (concat "NICK " nick)))
1208
1209(defun-rcirc-command names (channel)
1210 "Display list of names in CHANNEL or in current channel if CHANNEL is nil.
1211If called interactively, prompt for a channel when prefix arg is supplied."
1212 (interactive "P")
1213 (if (interactive-p)
1214 (if channel
1215 (setq channel (read-string "List names in channel: " target))))
1216 (let ((channel (if (> (length channel) 0)
1217 channel
1218 target)))
1219 (rcirc-send-string process (concat "NAMES " channel))))
1220
1221(defun-rcirc-command topic (topic)
1222 "List TOPIC for the TARGET channel.
1223With a prefix arg, prompt for new topic."
1224 (interactive "P")
1225 (if (and (interactive-p) topic)
1226 (setq topic (read-string "New Topic: " rcirc-topic)))
1227 (rcirc-send-string process (concat "TOPIC " target
1228 (when (> (length topic) 0)
1229 (concat " :" topic)))))
1230
1231(defun-rcirc-command whois (nick)
1232 "Request information from server about NICK."
1233 (interactive (list
1234 (completing-read "Whois: "
1235 (with-current-buffer
1236 (process-buffer rcirc-process)
1237 rcirc-nick-table))))
1238 (rcirc-set-last-buffer rcirc-process (current-buffer))
1239 (rcirc-send-string process (concat "WHOIS " nick)))
1240
1241(defun-rcirc-command mode (args)
1242 "Set mode with ARGS."
1243 (interactive (list (concat (read-string "Mode nick or channel: ")
1244 " " (read-string "Mode: "))))
1245 (rcirc-send-string process (concat "MODE " args)))
1246
1247(defun-rcirc-command list (channels)
1248 "Request information on CHANNELS from server."
1249 (interactive "sList Channels: ")
1250 (rcirc-send-string process (concat "LIST " channels)))
1251
1252(defun-rcirc-command oper (args)
1253 "Send operator command to server."
1254 (interactive "sOper args: ")
1255 (rcirc-send-string process (concat "OPER " args)))
1256
1257(defun-rcirc-command quote (message)
1258 "Send MESSAGE literally to server."
1259 (interactive "sServer message: ")
1260 (rcirc-send-string process message))
1261
1262(defun-rcirc-command kick (arg)
1263 "Kick NICK from current channel."
1264 (interactive (list
1265 (concat (completing-read "Kick nick: "
1266 (rcirc-channel-nicks rcirc-process
1267 rcirc-target))
1268 (read-from-minibuffer "Kick reason: "))))
1269 (let* ((arglist (split-string arg))
1270 (argstring (concat (car arglist) " :"
1271 (mapconcat 'identity (cdr arglist) " "))))
1272 (rcirc-send-string process (concat "KICK " target " " argstring))))
1273
1274(defun rcirc-cmd-ctcp (args &optional process target)
1275 (if (string-match "^\\([^ ]+\\)\\s-+\\(.+\\)$" args)
1276 (let ((target (match-string 1 args))
1277 (request (match-string 2 args)))
1278 (rcirc-send-message process target
1279 (concat "\C-a" (upcase request) "\C-a")))
1280 (rcirc-print process (rcirc-nick process) "ERROR" target
1281 "usage: /ctcp NICK REQUEST")))
1282
1283(defun rcirc-cmd-me (args &optional process target)
1284 (rcirc-send-string process (format "PRIVMSG %s :\C-aACTION %s\C-a"
1285 target args)))
1286
1287(defun rcirc-message-leader (sender face)
1288 "Return a string with SENDER propertized with FACE."
1289 (rcirc-facify (concat "<" (rcirc-user-nick sender) "> ") face))
1290
1291(defun rcirc-facify (string face)
1292 "Return a copy of STRING with FACE property added."
1293 (propertize (or string "") 'face face 'rear-nonsticky t))
1294
1295;; shy grouping must be used within this regexp
1296(defvar rcirc-url-regexp
1297 "\\b\\(?:\\(?:www\\.\\|\\(?:s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\
1298\\|wais\\|mailto\\):\\)\\(?://[-a-zA-Z0-9_.]+:[0-9]*\\)?\\(?:[-a-zA-Z0-9_=!?#$\
1299@~`%&*+|\\/:;.,]\\|\\w\\)+\\(?:[-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)"
1300 "Regexp matching URL's. Set to nil to disable URL features in rcirc.")
1301
1302(defun rcirc-browse-url (&optional arg)
1303 "Prompt for url to browse based on urls in buffer."
1304 (interactive)
1305 (let ((completions (mapcar (lambda (x) (cons x nil)) rcirc-urls))
1306 (initial-input (car rcirc-urls))
1307 (history (cdr rcirc-urls)))
1308 (browse-url (completing-read "rcirc browse-url: "
1309 completions nil nil initial-input 'history)
1310 arg)))
1311
1312(defun rcirc-map-regexp (function regexp string)
1313 "Return a copy of STRING after calling FUNCTION for each REGEXP match.
1314FUNCTION takes 3 arguments, MATCH-START, MATCH-END, and STRING."
1315 (let ((start 0))
1316 (while (string-match regexp string start)
1317 (setq start (match-end 0))
1318 (funcall function (match-beginning 0) (match-end 0) string)))
1319 string)
1320
1321(defvar rcirc-nick-syntax-table
1322 (let ((table (make-syntax-table text-mode-syntax-table)))
1323 (mapc (lambda (c) (modify-syntax-entry c "w" table))
1324 "[]\\`_^{|}-")
1325 (modify-syntax-entry ?' "_" table)
1326 table)
1327 "Syntax table which includes all nick characters as word constituents.")
1328
1329(defun rcirc-mangle-text (process text)
1330 "Return TEXT with properties added based on various patterns."
1331 ;; ^B
1332 (setq text
1333 (rcirc-map-regexp (lambda (start end string)
1334 (add-text-properties
1335 start end
1336 (list 'face 'bold 'rear-nonsticky t)
1337 string))
1338 ".*?"
1339 text))
1340 (while (string-match "\\(.*\\)[]\\(.*\\)" text) ; deal with 
1341 (setq text (concat (match-string 1 text)
1342 (match-string 2 text))))
1343 ;; my nick
1344 (setq text
1345 (with-syntax-table rcirc-nick-syntax-table
1346 (rcirc-map-regexp (lambda (start end string)
1347 (add-text-properties
1348 start end
1349 (list 'face 'rcirc-nick-in-message-face
1350 'rear-nonsticky t)
1351 string))
1352 (concat "\\b"
1353 (regexp-quote (rcirc-nick process))
1354 "\\b")
1355 text)))
1356 ;; urls
1357 (setq text
1358 (rcirc-map-regexp
1359 (lambda (start end string)
1360 (let ((orig-face (get-text-property start 'face string)))
1361 (add-text-properties start end
1362 (list 'face (list orig-face 'bold)
1363 'rear-nonsticky t)
1364 string))
1365 (push (substring string start end) rcirc-urls))
1366 rcirc-url-regexp
1367 text))
1368 text)
1369
1370
1371;;; handlers
1372;; these are called with the server PROCESS, the SENDER, which is a
1373;; server or a user, depending on the command, the ARGS, which is a
1374;; list of strings, and the TEXT, which is the original server text,
1375;; verbatim
1376(defun rcirc-handler-001 (process sender args text)
1377 (rcirc-handler-generic process "001" sender args text)
1378 ;; set the real server name
1379 (with-current-buffer (process-buffer process)
1380 (setq rcirc-server sender)
1381 (setq rcirc-nick (car args))
1382 (rcirc-update-prompt)
1383 (when rcirc-auto-authenticate-flag (rcirc-authenticate))
1384 (let (rcirc-last-buffer)
1385 (rcirc-join-channels process rcirc-startup-channels))))
1386
1387(defun rcirc-handler-PRIVMSG (process sender args text)
1388 (let ((target (if (rcirc-channel-p (car args))
1389 (car args)
1390 (rcirc-user-nick sender)))
1391 (message (or (cadr args) "")))
1392 (if (string-match "^\C-a\\(.*\\)\C-a$" message)
1393 (rcirc-handler-CTCP process target sender (match-string 1 message))
1394 (rcirc-print process sender "PRIVMSG" target message t))
1395 ;; update nick timestamp
1396 (if (member target (rcirc-nick-channels process sender))
1397 (rcirc-put-nick-channel process sender target))))
1398
1399(defun rcirc-handler-NOTICE (process sender args text)
1400 (let ((target (car args))
1401 (message (cadr args)))
1402 (rcirc-print process sender "NOTICE"
1403 (cond ((rcirc-channel-p target)
1404 target)
1405 ((string-match "^\\[\\(#[^ ]+\\)\\]" message)
1406 (match-string 1 message))
1407 (sender
1408 (if (string= sender (rcirc-server process))
1409 (process-buffer process)
1410 (rcirc-user-nick sender))))
1411 message t)
1412 (and sender (rcirc-put-nick-channel process sender target))))
1413
1414(defun rcirc-handler-WALLOPS (process sender args text)
1415 (let ((target (rcirc-user-nick sender)))
1416 (rcirc-print process sender "WALLOPS" target (car args) t)))
1417
1418(defun rcirc-handler-JOIN (process sender args text)
1419 (let ((channel (downcase (car args)))
1420 (nick (rcirc-user-nick sender)))
1421 (rcirc-get-buffer-create process channel)
1422 (rcirc-print process sender "JOIN" channel "")
1423
1424 ;; print in private chat buffer if it exists
1425 (if (not (eq (process-buffer rcirc-process)
1426 (rcirc-get-buffer rcirc-process nick)))
1427 (rcirc-print process sender "JOIN" nick channel))
1428
1429 (rcirc-put-nick-channel process sender channel)
1430 (if (string= nick (rcirc-nick process))
1431 (setq rcirc-channels (cons channel rcirc-channels)))))
1432
1433;; PART and KICK are handled the same way
1434(defun rcirc-handler-PART-or-KICK (process response channel sender nick args)
1435 (rcirc-print process sender response channel (concat channel " " args))
1436
1437 ;; print in private chat buffer if it exists
1438 (when (not (eq (process-buffer rcirc-process)
1439 (rcirc-get-buffer rcirc-process nick)))
1440 (rcirc-print process sender response nick (concat channel " " args)))
1441
1442 (if (not (string= nick (rcirc-nick process)))
1443 ;; this is someone else leaving
1444 (rcirc-remove-nick-channel process nick channel)
1445 ;; this is us leaving
1446 (mapc (lambda (n)
1447 (rcirc-remove-nick-channel process n channel))
1448 (rcirc-channel-nicks process channel))
1449 (setq rcirc-channels (delete channel rcirc-channels))
1450 (with-current-buffer (rcirc-get-buffer process channel)
1451 (setq rcirc-target nil))))
1452
1453(defun rcirc-handler-PART (process sender args text)
1454 (rcirc-handler-PART-or-KICK process "PART"
1455 (car args) sender (rcirc-user-nick sender)
1456 (cadr args)))
1457
1458(defun rcirc-handler-KICK (process sender args text)
1459 (rcirc-handler-PART-or-KICK process "KICK" (car args) sender (cadr args)
1460 (caddr args)))
1461
1462(defun rcirc-handler-QUIT (process sender args text)
1463 (let ((nick (rcirc-user-nick sender)))
1464 (mapc (lambda (channel)
1465 (rcirc-print process sender "QUIT" channel (apply 'concat args)))
1466 (rcirc-nick-channels process nick))
1467
1468 ;; print in private chat buffer if it exists
1469 (if (not (eq (process-buffer rcirc-process)
1470 (rcirc-get-buffer rcirc-process nick)))
1471 (rcirc-print process sender "QUIT" nick (apply 'concat args)))
1472
1473 (rcirc-nick-remove process nick)))
1474
1475(defun rcirc-handler-NICK (process sender args text)
1476 (let* ((old-nick (rcirc-user-nick sender))
1477 (new-nick (car args))
1478 (channels (rcirc-nick-channels process old-nick)))
1479 ;; print message to nick's channels
1480 (dolist (target channels)
1481 (rcirc-print process sender "NICK" target new-nick))
1482 ;; update private chat buffer, if it exists
1483 (with-current-buffer (rcirc-get-buffer process old-nick)
1484 (when (not (equal (process-buffer rcirc-process)
1485 (current-buffer)))
1486 (rcirc-print process sender "NICK" old-nick new-nick)
1487 (setq rcirc-target new-nick)
1488 (rename-buffer (rcirc-get-buffer-name process new-nick))))
1489 ;; remove old nick and add new one
1490 (with-current-buffer (process-buffer process)
1491 (let ((v (gethash old-nick rcirc-nick-table)))
1492 (remhash old-nick rcirc-nick-table)
1493 (puthash new-nick v rcirc-nick-table))
1494 ;; if this is our nick...
1495 (when (string= old-nick rcirc-nick)
1496 (setq rcirc-nick new-nick)
1497 ;; update prompts
1498 (mapc (lambda (target)
1499 (with-current-buffer (rcirc-get-buffer process target)
1500 (rcirc-update-prompt)))
1501 (append rcirc-channels rcirc-private-chats))
1502 ;; reauthenticate
1503 (when rcirc-auto-authenticate-flag (rcirc-authenticate))))))
1504
1505(defun rcirc-handler-PING (process sender args text)
1506 (rcirc-send-string process (concat "PONG " (car args))))
1507
1508(defun rcirc-handler-PONG (process sender args text)
1509 ;; do nothing
1510 )
1511
1512(defun rcirc-handler-TOPIC (process sender args text)
1513 (let ((topic (cadr args)))
1514 (rcirc-print process sender "TOPIC" (car args) topic)
1515 (with-current-buffer (rcirc-get-buffer process (car args))
1516 (setq rcirc-topic topic))))
1517
1518(defun rcirc-handler-332 (process sender args text)
1519 "RPL_TOPIC"
1520 (with-current-buffer (rcirc-get-buffer process (cadr args))
1521 (setq rcirc-topic (caddr args))))
1522
1523(defun rcirc-handler-333 (process sender args text)
1524 "Not in rfc1459.txt"
1525 (with-current-buffer (rcirc-get-buffer process (cadr args))
1526 (let ((setter (caddr args))
1527 (time (current-time-string
1528 (seconds-to-time
1529 (string-to-number (cadddr args))))))
1530 (rcirc-print process sender "TOPIC" (cadr args)
1531 (format "%s (%s on %s)" rcirc-topic setter time)))))
1532
1533(defun rcirc-handler-477 (process sender args text)
1534 "ERR_NOCHANMODES"
1535 (rcirc-print process sender "477" (cadr args) (caddr args)))
1536
1537(defun rcirc-handler-MODE (process sender args text)
1538 (let ((target (car args))
1539 (msg (mapconcat 'identity (cdr args) " ")))
1540 (rcirc-print process sender "MODE"
1541 (if (string= target (rcirc-nick process))
1542 nil
1543 target)
1544 msg)
1545
1546 ;; print in private chat buffers if they exist
1547 (mapc (lambda (nick)
1548 (when (not (eq (process-buffer rcirc-process)
1549 (rcirc-get-buffer rcirc-process nick)))
1550 (rcirc-print process sender "MODE" nick msg)))
1551 (cddr args))))
1552
1553(defun rcirc-get-temp-buffer-create (process channel)
1554 "Return a buffer based on PROCESS and CHANNEL."
1555 (let ((tmpnam (concat " " (downcase channel) "TMP" (process-name process))))
1556 (get-buffer-create tmpnam)))
1557
1558(defun rcirc-handler-353 (process sender args text)
1559 "RPL_NAMREPLY"
1560 (let ((channel (downcase (caddr args))))
1561 (mapc (lambda (nick)
1562 (rcirc-put-nick-channel process nick channel))
1563 (delete "" (split-string (cadddr args) " ")))
1564 (with-current-buffer (rcirc-get-temp-buffer-create process channel)
1565 (goto-char (point-max))
1566 (insert (car (last args)) " "))))
1567
1568(defun rcirc-handler-366 (process sender args text)
1569 "RPL_ENDOFNAMES"
1570 (let* ((channel (cadr args))
1571 (buffer (rcirc-get-temp-buffer-create process channel)))
1572 (with-current-buffer buffer
1573 (rcirc-print process sender "NAMES" channel
1574 (buffer-substring (point-min) (point-max))))
1575 (kill-buffer buffer)))
1576
1577(defun rcirc-handler-433 (process sender args text)
1578 "ERR_NICKNAMEINUSE"
1579 (rcirc-handler-generic process "433" sender args text)
1580 (let* ((new-nick (concat (cadr args) "`")))
1581 (with-current-buffer (process-buffer process)
1582 (rcirc-cmd-nick new-nick nil process))))
1583
1584(defun rcirc-authenticate ()
1585 "Send authentication to process associated with current buffer.
1586Passwords are read from `rcirc-authinfo-file-name' (which see)."
1587 (interactive)
1588 (let ((password-alist
1589 (with-temp-buffer
1590 (insert-file-contents-literally rcirc-authinfo-file-name)
1591 (goto-char (point-min))
1592 (read (current-buffer)))))
1593 (with-current-buffer (process-buffer rcirc-process)
1594 (dolist (i password-alist)
1595 (let ((server (car i))
1596 (nick (cadr i))
1597 (method (caddr i))
1598 (args (cdddr i)))
1599 (when (and (string-match server rcirc-server)
1600 (string-match nick rcirc-nick))
1601 (cond ((equal method 'nickserv)
1602 (rcirc-send-string
1603 rcirc-process
1604 (concat
1605 "PRIVMSG nickserv :identify "
1606 (car args))))
1607 ((equal method 'chanserv)
1608 (rcirc-send-string
1609 rcirc-process
1610 (concat
1611 "PRIVMSG chanserv :identify "
1612 (car args) " " (cadr args))))
1613 ((equal method 'bitlbee)
1614 (rcirc-send-string
1615 rcirc-process
1616 (concat "PRIVMSG #bitlbee :identify " (car args))))
1617 (t
1618 (message "No %S authentication method defined"
1619 method)))))))))
1620
1621(defun rcirc-handler-INVITE (process sender args text)
1622 (rcirc-print process sender "INVITE" nil (mapconcat 'identity args " ") t))
1623
1624(defun rcirc-handler-ERROR (process sender args text)
1625 (rcirc-print process sender "ERROR" nil (mapconcat 'identity args " ")))
1626
1627(defun rcirc-handler-CTCP (process target sender text)
1628 (if (string-match "^\\([^ ]+\\) *\\(.*\\)$" text)
1629 (let* ((request (upcase (match-string 1 text)))
1630 (args (match-string 2 text))
1631 (nick (rcirc-user-nick sender))
1632 (handler (intern-soft (concat "rcirc-handler-ctcp-" request))))
1633 (if (not (fboundp handler))
1634 (rcirc-print process sender "ERROR" target
1635 (format "unhandled ctcp: %s" text))
1636 (funcall handler process target sender args)
1637 (if (not (string= request "ACTION"))
1638 (rcirc-print process sender "CTCP" target
1639 (format "%s" text)))))))
1640
1641(defun rcirc-handler-ctcp-VERSION (process target sender args)
1642 (rcirc-send-string process
1643 (concat "NOTICE " (rcirc-user-nick sender)
1644 " :\C-aVERSION " (rcirc-version)
1645 " - http://www.nongnu.org/rcirc"
1646 "\C-a")))
1647
1648(defun rcirc-handler-ctcp-ACTION (process target sender args)
1649 (rcirc-print process sender "ACTION" target args t))
1650
1651(defun rcirc-handler-ctcp-TIME (process target sender args)
1652 (rcirc-send-string process
1653 (concat "NOTICE " (rcirc-user-nick sender)
1654 " :\C-aTIME " (current-time-string) "\C-a")))
1655
1656(defface rcirc-my-nick-face
1657 '((((type tty) (class color)) (:foreground "blue" :weight bold))
1658 (((class color) (background light)) (:foreground "Blue"))
1659 (((class color) (background dark)) (:foreground "LightSkyBlue"))
1660 (t (:inverse-video t :bold t)))
1661 "The rcirc face used to highlight my messages."
1662 :group 'rcirc)
1663
1664(defface rcirc-other-nick-face
1665 '((((type tty) (class color)) (:foreground "yellow" :weight light))
1666 (((class grayscale) (background light))
1667 (:foreground "Gray90" :bold t :italic t))
1668 (((class grayscale) (background dark))
1669 (:foreground "DimGray" :bold t :italic t))
1670 (((class color) (background light)) (:foreground "DarkGoldenrod"))
1671 (((class color) (background dark)) (:foreground "LightGoldenrod"))
1672 (t (:bold t :italic t)))
1673 "The rcirc face used to highlight other messages."
1674 :group 'rcirc)
1675
1676(defface rcirc-server-face
1677 '((((type tty pc) (class color) (background light)) (:foreground "red"))
1678 (((type tty pc) (class color) (background dark)) (:foreground "red1"))
1679 (((class grayscale) (background light))
1680 (:foreground "DimGray" :bold t :italic t))
1681 (((class grayscale) (background dark))
1682 (:foreground "LightGray" :bold t :italic t))
1683 (((class color) (background light)) (:foreground "gray40"))
1684 (((class color) (background dark)) (:foreground "chocolate1"))
1685 (t (:bold t :italic t)))
1686 "The rcirc face used to highlight server messages."
1687 :group 'rcirc)
1688
1689(defface rcirc-nick-in-message-face
1690 '((((type tty) (class color)) (:foreground "cyan" :weight bold))
1691 (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
1692 (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
1693 (((class color) (background light)) (:foreground "Purple"))
1694 (((class color) (background dark)) (:foreground "Cyan"))
1695 (t (:bold t)))
1696 "The rcirc face used to highlight instances of nick within messages."
1697 :group 'rcirc)
1698
1699(defface rcirc-prompt-face
1700 '((((background dark)) (:foreground "cyan"))
1701 (t (:foreground "dark blue")))
1702 "The rcirc face to use to highlight prompts."
1703 :group 'rcirc)
1704
1705(defface rcirc-mode-line-nick-face
1706 '((t (:bold t)))
1707 "The rcirc face used indicate activity directed at you."
1708 :group 'rcirc)
1709
1710;; When using M-x flyspell-mode, only check words past the input marker
1711(put 'rcirc-mode 'flyspell-mode-predicate 'rcirc-looking-at-input)
1712(defun rcirc-looking-at-input ()
1713 "Returns true if point is past the input marker."
1714 (>= (point) rcirc-prompt-end-marker))
1715
1716
1717(provide 'rcirc)
1718
1719;; arch-tag: b471b7e8-6b5a-4399-b2c6-a3c78dfc8ffb
1720;;; rcirc.el ends here
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index ac2cc23048a..d9f4698ecf7 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -274,6 +274,14 @@ One argument, the tag info returned by `snarf-tag-function'.")
274 (run-hook-with-args-until-success 'tags-table-format-functions)) 274 (run-hook-with-args-until-success 'tags-table-format-functions))
275 275
276;;;###autoload 276;;;###autoload
277(defun tags-table-mode ()
278 "Major mode for tags table file buffers."
279 (interactive)
280 (setq major-mode 'tags-table-mode)
281 (setq mode-name "Tags Table")
282 (initialize-new-tags-table))
283
284;;;###autoload
277(defun visit-tags-table (file &optional local) 285(defun visit-tags-table (file &optional local)
278 "Tell tags commands to use tags table file FILE. 286 "Tell tags commands to use tags table file FILE.
279FILE should be the name of a file created with the `etags' program. 287FILE should be the name of a file created with the `etags' program.
@@ -415,7 +423,7 @@ Returns non-nil iff it is a valid table."
415 ;; having changed since we last used it. 423 ;; having changed since we last used it.
416 (let (win) 424 (let (win)
417 (set-buffer (get-file-buffer file)) 425 (set-buffer (get-file-buffer file))
418 (setq win (or verify-tags-table-function (initialize-new-tags-table))) 426 (setq win (or verify-tags-table-function (tags-table-mode)))
419 (if (or (verify-visited-file-modtime (current-buffer)) 427 (if (or (verify-visited-file-modtime (current-buffer))
420 ;; Decide whether to revert the file. 428 ;; Decide whether to revert the file.
421 ;; revert-without-query can say to revert 429 ;; revert-without-query can say to revert
@@ -434,7 +442,7 @@ Returns non-nil iff it is a valid table."
434 (and verify-tags-table-function 442 (and verify-tags-table-function
435 (funcall verify-tags-table-function)) 443 (funcall verify-tags-table-function))
436 (revert-buffer t t) 444 (revert-buffer t t)
437 (initialize-new-tags-table))) 445 (tags-table-mode)))
438 (and (file-exists-p file) 446 (and (file-exists-p file)
439 (progn 447 (progn
440 (set-buffer (find-file-noselect file)) 448 (set-buffer (find-file-noselect file))
@@ -446,7 +454,7 @@ Returns non-nil iff it is a valid table."
446 (setcar tail buffer-file-name)) 454 (setcar tail buffer-file-name))
447 (if (eq file tags-file-name) 455 (if (eq file tags-file-name)
448 (setq tags-file-name buffer-file-name)))) 456 (setq tags-file-name buffer-file-name))))
449 (initialize-new-tags-table))))) 457 (tags-table-mode)))))
450 458
451;; Subroutine of visit-tags-table-buffer. Search the current tags tables 459;; Subroutine of visit-tags-table-buffer. Search the current tags tables
452;; for one that has tags for THIS-FILE (or that includes a table that 460;; for one that has tags for THIS-FILE (or that includes a table that
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index b8c425428b5..2c4543a72fc 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -869,7 +869,15 @@ See `sh-feature'.")
869(defconst sh-st-symbol (string-to-syntax "_")) 869(defconst sh-st-symbol (string-to-syntax "_"))
870(defconst sh-here-doc-syntax (string-to-syntax "|")) ;; generic string 870(defconst sh-here-doc-syntax (string-to-syntax "|")) ;; generic string
871 871
872(defconst sh-here-doc-open-re "<<-?\\s-*\\\\?\\(\\(?:['\"][^'\"]+['\"]\\|\\sw\\)+\\).*\\(\n\\)") 872(defconst sh-escaped-line-re
873 ;; Should match until the real end-of-continued line, but if that is not
874 ;; possible (because we bump into EOB or the search bound), then we should
875 ;; match until the search bound.
876 "\\(?:\\(?:.*[^\\\n]\\)?\\(?:\\\\\\\\\\)*\\\\\n\\)*.*")
877
878(defconst sh-here-doc-open-re
879 (concat "<<-?\\s-*\\\\?\\(\\(?:['\"][^'\"]+['\"]\\|\\sw\\)+\\)"
880 sh-escaped-line-re "\\(\n\\)"))
873 881
874(defvar sh-here-doc-markers nil) 882(defvar sh-here-doc-markers nil)
875(make-variable-buffer-local 'sh-here-doc-markers) 883(make-variable-buffer-local 'sh-here-doc-markers)
@@ -883,7 +891,9 @@ If non-nil INDENTED indicates that the EOF was indented."
883 ;; A rough regexp that should find the opening <<EOF back. 891 ;; A rough regexp that should find the opening <<EOF back.
884 (sre (concat "<<\\(-?\\)\\s-*['\"\\]?" 892 (sre (concat "<<\\(-?\\)\\s-*['\"\\]?"
885 ;; Use \s| to cheaply check it's an open-heredoc. 893 ;; Use \s| to cheaply check it's an open-heredoc.
886 eof-re "['\"]?\\([ \t|;&)<>].*\\)?\\s|")) 894 eof-re "['\"]?\\([ \t|;&)<>]"
895 sh-escaped-line-re
896 "\\)?\\s|"))
887 ;; A regexp that will find other EOFs. 897 ;; A regexp that will find other EOFs.
888 (ere (concat "^" (if indented "[ \t]*") eof-re "\n")) 898 (ere (concat "^" (if indented "[ \t]*") eof-re "\n"))
889 (start (save-excursion 899 (start (save-excursion
@@ -922,7 +932,8 @@ If non-nil INDENTED indicates that the EOF was indented."
922START is the position of <<. 932START is the position of <<.
923STRING is the actual word used as delimiter (f.ex. \"EOF\"). 933STRING is the actual word used as delimiter (f.ex. \"EOF\").
924INDENTED is non-nil if the here document's content (and the EOF mark) can 934INDENTED is non-nil if the here document's content (and the EOF mark) can
925be indented (i.e. a <<- was used rather than just <<)." 935be indented (i.e. a <<- was used rather than just <<).
936Point is at the beginning of the next line."
926 (unless (or (memq (char-before start) '(?< ?>)) 937 (unless (or (memq (char-before start) '(?< ?>))
927 (sh-in-comment-or-string start)) 938 (sh-in-comment-or-string start))
928 ;; We're looking at <<STRING, so we add "^STRING$" to the syntactic 939 ;; We're looking at <<STRING, so we add "^STRING$" to the syntactic
@@ -933,6 +944,20 @@ be indented (i.e. a <<- was used rather than just <<)."
933 (setq sh-here-doc-re 944 (setq sh-here-doc-re
934 (concat sh-here-doc-open-re "\\|^\\([ \t]*\\)" 945 (concat sh-here-doc-open-re "\\|^\\([ \t]*\\)"
935 (regexp-opt sh-here-doc-markers t) "\\(\n\\)")))) 946 (regexp-opt sh-here-doc-markers t) "\\(\n\\)"))))
947 (let ((ppss (save-excursion (syntax-ppss (1- (point))))))
948 (if (nth 4 ppss)
949 ;; The \n not only starts the heredoc but also closes a comment.
950 ;; Let's close the comment just before the \n.
951 (put-text-property (1- (point)) (point) 'syntax-table '(12))) ;">"
952 (if (or (nth 5 ppss) (> (count-lines start (point)) 1))
953 ;; If the sh-escaped-line-re part of sh-here-doc-re has matched
954 ;; several lines, make sure we refontify them together.
955 ;; Furthermore, if (nth 5 ppss) is non-nil (i.e. the \n is
956 ;; escaped), it means the right \n is actually further down.
957 ;; Don't bother fixing it now, but place a multiline property so
958 ;; that when jit-lock-context-* refontifies the rest of the
959 ;; buffer, it also refontifies the current line with it.
960 (put-text-property start (point) 'font-lock-multiline t)))
936 sh-here-doc-syntax)) 961 sh-here-doc-syntax))
937 962
938(defun sh-font-lock-here-doc (limit) 963(defun sh-font-lock-here-doc (limit)
@@ -972,6 +997,8 @@ be indented (i.e. a <<- was used rather than just <<)."
972 ;; The list of special chars is taken from the single-unix spec 997 ;; The list of special chars is taken from the single-unix spec
973 ;; of the shell command language (under `quoting') but with `$' removed. 998 ;; of the shell command language (under `quoting') but with `$' removed.
974 `(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 ,sh-st-symbol) 999 `(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 ,sh-st-symbol)
1000 ;; Make sure $@ and @? are correctly recognized as sexps.
1001 ("\\$\\([?@]\\)" 1 ,sh-st-symbol)
975 ;; Find HEREDOC starters and add a corresponding rule for the ender. 1002 ;; Find HEREDOC starters and add a corresponding rule for the ender.
976 (sh-font-lock-here-doc 1003 (sh-font-lock-here-doc
977 (2 (sh-font-lock-open-heredoc 1004 (2 (sh-font-lock-open-heredoc
diff --git a/lisp/replace.el b/lisp/replace.el
index e2562ed3469..2d79754b4f0 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1157,7 +1157,8 @@ See also `multi-occur'."
1157 (insert "-------\n")) 1157 (insert "-------\n"))
1158 (add-text-properties 1158 (add-text-properties
1159 beg end 1159 beg end
1160 `(occur-target ,marker help-echo "mouse-2: go to this occurrence"))))) 1160 `(occur-target ,marker follow-link t
1161 help-echo "mouse-2: go to this occurrence")))))
1161 (goto-char endpt)) 1162 (goto-char endpt))
1162 (if endpt 1163 (if endpt
1163 (progn 1164 (progn
diff --git a/lisp/savehist.el b/lisp/savehist.el
index de0f1504ff8..efbc1e934a6 100644
--- a/lisp/savehist.el
+++ b/lisp/savehist.el
@@ -138,7 +138,12 @@ the user's privacy."
138 :type 'integer 138 :type 'integer
139 :group 'savehist) 139 :group 'savehist)
140 140
141(defvar savehist-coding-system (if (coding-system-p 'utf-8) 'utf-8 'iso-2022-8) 141(defvar savehist-coding-system
142 ;; UTF-8 is usually preferable to ISO-2022-8 when available, but under
143 ;; XEmacs, UTF-8 is provided by external packages, and may not always be
144 ;; available, so even if it currently is available, we prefer not to
145 ;; use is.
146 (if (featurep 'xemacs) 'iso-2022-8 'utf-8)
142 "The coding system savehist uses for saving the minibuffer history. 147 "The coding system savehist uses for saving the minibuffer history.
143Changing this value while Emacs is running is supported, but considered 148Changing this value while Emacs is running is supported, but considered
144unwise, unless you know what you are doing.") 149unwise, unless you know what you are doing.")
diff --git a/lisp/simple.el b/lisp/simple.el
index be5844fa794..16b6ee28953 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4576,10 +4576,10 @@ in the definition is used to check that VALUE is valid.
4576With a prefix argument, set VARIABLE to VALUE buffer-locally." 4576With a prefix argument, set VARIABLE to VALUE buffer-locally."
4577 (interactive 4577 (interactive
4578 (let* ((default-var (variable-at-point)) 4578 (let* ((default-var (variable-at-point))
4579 (var (if (symbolp default-var) 4579 (var (if (user-variable-p default-var)
4580 (read-variable (format "Set variable (default %s): " default-var) 4580 (read-variable (format "Set variable (default %s): " default-var)
4581 default-var) 4581 default-var)
4582 (read-variable "Set variable: "))) 4582 (read-variable "Set variable: ")))
4583 (minibuffer-help-form '(describe-variable var)) 4583 (minibuffer-help-form '(describe-variable var))
4584 (prop (get var 'variable-interactive)) 4584 (prop (get var 'variable-interactive))
4585 (obsolete (car (get var 'byte-obsolete-variable))) 4585 (obsolete (car (get var 'byte-obsolete-variable)))
@@ -4604,7 +4604,8 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally."
4604 arg)) 4604 arg))
4605 (read 4605 (read
4606 (read-string prompt nil 4606 (read-string prompt nil
4607 'set-variable-value-history)))))) 4607 'set-variable-value-history
4608 (format "%S" (symbol-value var))))))))
4608 (list var val current-prefix-arg))) 4609 (list var val current-prefix-arg)))
4609 4610
4610 (and (custom-variable-p variable) 4611 (and (custom-variable-p variable)
diff --git a/lisp/startup.el b/lisp/startup.el
index c7bd6b323e9..f474c692240 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -647,6 +647,17 @@ opening the first frame (e.g. open a connection to an X server).")
647 647
648 (set-locale-environment nil) 648 (set-locale-environment nil)
649 649
650 ;; Convert preloaded file names to absolute.
651 (setq load-history
652 (mapcar (lambda (elt)
653 (if (and (stringp (car elt))
654 (not (file-name-absolute-p (car elt))))
655 (cons (locate-file (car elt) load-path
656 load-suffixes)
657 (cdr elt))
658 elt))
659 load-history))
660
650 ;; Convert the arguments to Emacs internal representation. 661 ;; Convert the arguments to Emacs internal representation.
651 (let ((args (cdr command-line-args))) 662 (let ((args (cdr command-line-args)))
652 (while args 663 (while args
diff --git a/lisp/subr.el b/lisp/subr.el
index 87d58799dc7..48ac3c7e672 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1017,9 +1017,7 @@ The return value is the new value of LIST-VAR."
1017 1017
1018(defun symbol-file (symbol &optional type) 1018(defun symbol-file (symbol &optional type)
1019 "Return the input source in which SYMBOL was defined. 1019 "Return the input source in which SYMBOL was defined.
1020The value is normally a string that was passed to `load': 1020The value is an absolute file name.
1021either an absolute file name, or a library name
1022\(with no directory name and no `.el' or `.elc' at the end).
1023It can also be nil, if the definition is not associated with any file. 1021It can also be nil, if the definition is not associated with any file.
1024 1022
1025If TYPE is nil, then any kind of definition is acceptable. 1023If TYPE is nil, then any kind of definition is acceptable.
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 4362e97af0b..0e57d541dfe 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -735,7 +735,9 @@ appear on disk when you save the tar-file's buffer."
735 (and set-auto-coding-function 735 (and set-auto-coding-function
736 (save-excursion 736 (save-excursion
737 (funcall set-auto-coding-function 737 (funcall set-auto-coding-function
738 name (- (point-max) (point))))))) 738 name (- (point-max) (point)))))
739 (car (find-operation-coding-system
740 'insert-file-contents name t))))
739 (multibyte enable-multibyte-characters) 741 (multibyte enable-multibyte-characters)
740 (detected (detect-coding-region 742 (detected (detect-coding-region
741 (point-min) 743 (point-min)
@@ -747,13 +749,7 @@ appear on disk when you save the tar-file's buffer."
747 coding 749 coding
748 (coding-system-eol-type detected)))) 750 (coding-system-eol-type detected))))
749 (setq coding 751 (setq coding
750 (or (find-new-buffer-file-coding-system detected) 752 (find-new-buffer-file-coding-system detected)))
751 (let ((file-coding
752 (find-operation-coding-system
753 'insert-file-contents buffer-file-name)))
754 (if (consp file-coding)
755 (setq file-coding (car file-coding))
756 file-coding)))))
757 (if (or (eq coding 'no-conversion) 753 (if (or (eq coding 'no-conversion)
758 (eq (coding-system-type coding) 5)) 754 (eq (coding-system-type coding) 5))
759 (setq multibyte (set-buffer-multibyte nil))) 755 (setq multibyte (set-buffer-multibyte nil)))
diff --git a/lisp/term.el b/lisp/term.el
index 9d6ee5a4e93..471d7830de0 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -1393,7 +1393,7 @@ The main purpose is to get rid of the local keymap."
1393 1393
1394;;; Name to use for TERM. 1394;;; Name to use for TERM.
1395;;; Using "emacs" loses, because bash disables editing if TERM == emacs. 1395;;; Using "emacs" loses, because bash disables editing if TERM == emacs.
1396(defvar term-term-name "eterm") 1396(defvar term-term-name "eterm-color")
1397; Format string, usage: 1397; Format string, usage:
1398; (format term-termcap-string emacs-term-name "TERMCAP=" 24 80) 1398; (format term-termcap-string emacs-term-name "TERMCAP=" 24 80)
1399(defvar term-termcap-format 1399(defvar term-termcap-format
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index 11ddfc0e967..ce95c6f026f 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -344,13 +344,14 @@ and `fill-nobreak-invisible'."
344 ;; it at the end of the line. 344 ;; it at the end of the line.
345 (and sentence-end-double-space 345 (and sentence-end-double-space
346 (save-excursion 346 (save-excursion
347 (skip-chars-backward ". ") 347 (skip-chars-backward " ")
348 (looking-at "\\. \\([^ ]\\|$\\)"))) 348 (and (eq (preceding-char) ?.)
349 (looking-at " \\([^ ]\\|$\\)"))))
349 ;; Another approach to the same problem. 350 ;; Another approach to the same problem.
350 (save-excursion 351 (save-excursion
351 (skip-chars-backward ". ") 352 (skip-chars-backward " ")
352 (and (looking-at "\\.") 353 (and (eq (preceding-char) ?.)
353 (not (looking-at (sentence-end))))) 354 (not (progn (forward-char -1) (looking-at (sentence-end))))))
354 ;; Don't split a line if the rest would look like a new paragraph. 355 ;; Don't split a line if the rest would look like a new paragraph.
355 (unless use-hard-newlines 356 (unless use-hard-newlines
356 (save-excursion 357 (save-excursion
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el
index 7f0d257e5f6..a84f2be28ae 100644
--- a/lisp/textmodes/org.el
+++ b/lisp/textmodes/org.el
@@ -5,7 +5,7 @@
5;; Author: Carsten Dominik <dominik at science dot uva dot nl> 5;; Author: Carsten Dominik <dominik at science dot uva dot nl>
6;; Keywords: outlines, hypermedia, calendar 6;; Keywords: outlines, hypermedia, calendar
7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ 7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
8;; Version: 3.17 8;; Version: 3.18
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -80,6 +80,10 @@
80;; 80;;
81;; Changes: 81;; Changes:
82;; ------- 82;; -------
83;; Version 3.18
84;; - Export of calendar information in the standard iCalendar format.
85;; - Some bug fixes.
86;;
83;; Version 3.17 87;; Version 3.17
84;; - HTML export specifies character set depending on coding-system. 88;; - HTML export specifies character set depending on coding-system.
85;; 89;;
@@ -213,7 +217,7 @@
213 217
214;;; Customization variables 218;;; Customization variables
215 219
216(defvar org-version "3.17" 220(defvar org-version "3.18"
217 "The version number of the file org.el.") 221 "The version number of the file org.el.")
218(defun org-version () 222(defun org-version ()
219 (interactive) 223 (interactive)
@@ -777,7 +781,7 @@ as possible."
777(defcustom org-level-color-stars-only nil 781(defcustom org-level-color-stars-only nil
778 "Non-nil means fontify only the stars in each headline. 782 "Non-nil means fontify only the stars in each headline.
779When nil, the entire headline is fontified. 783When nil, the entire headline is fontified.
780After changin this, requires restart of Emacs to become effective." 784After changing this, requires restart of Emacs to become effective."
781 :group 'org-structure 785 :group 'org-structure
782 :type 'boolean) 786 :type 'boolean)
783 787
@@ -1490,6 +1494,23 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1490 :group 'org-export 1494 :group 'org-export
1491 :type 'boolean) 1495 :type 'boolean)
1492 1496
1497(defcustom org-combined-agenda-icalendar-file "~/org.ics"
1498 "The file name for the iCalendar file covering all agenda files.
1499This file is created with the command \\[org-export-icalendar-all-agenda-files]."
1500 :group 'org-export
1501 :type 'file)
1502
1503(defcustom org-icalendar-include-todo nil
1504 "Non-nil means, export to iCalendar files should also cover TODO items."
1505 :group 'org-export
1506 :type 'boolean)
1507
1508;; FIXME: not yet used.
1509(defcustom org-icalendar-combined-name "OrgMode"
1510 "Calendar name for the combined iCalendar representing all agenda files."
1511 :group 'org-export
1512 :type 'string)
1513
1493(defgroup org-faces nil 1514(defgroup org-faces nil
1494 "Faces for highlighting in Org-mode." 1515 "Faces for highlighting in Org-mode."
1495 :tag "Org Faces" 1516 :tag "Org Faces"
@@ -3179,7 +3200,8 @@ used to insert the time stamp into the buffer to include the time."
3179 ;; Copied (with modifications) from planner.el by John Wiegley 3200 ;; Copied (with modifications) from planner.el by John Wiegley
3180 (save-excursion 3201 (save-excursion
3181 (save-window-excursion 3202 (save-window-excursion
3182 (calendar) 3203 (let ((view-diary-entries-initially nil))
3204 (calendar))
3183 (calendar-forward-day (- (time-to-days default-time) 3205 (calendar-forward-day (- (time-to-days default-time)
3184 (calendar-absolute-from-gregorian 3206 (calendar-absolute-from-gregorian
3185 (calendar-current-date)))) 3207 (calendar-current-date))))
@@ -3523,7 +3545,8 @@ A prefix ARG can be used force the current date."
3523 (d2 (time-to-days 3545 (d2 (time-to-days
3524 (org-time-string-to-time (match-string 1))))) 3546 (org-time-string-to-time (match-string 1)))))
3525 (setq diff (- d2 d1)))) 3547 (setq diff (- d2 d1))))
3526 (calendar) 3548 (let ((view-diary-entries-initially nil))
3549 (calendar))
3527 (calendar-goto-today) 3550 (calendar-goto-today)
3528 (if (and diff (not arg)) (calendar-forward-day diff)))) 3551 (if (and diff (not arg)) (calendar-forward-day diff))))
3529 3552
@@ -3628,7 +3651,7 @@ The following commands are available:
3628(define-key org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down) 3651(define-key org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down)
3629(define-key org-agenda-mode-map [(right)] 'org-agenda-later) 3652(define-key org-agenda-mode-map [(right)] 'org-agenda-later)
3630(define-key org-agenda-mode-map [(left)] 'org-agenda-earlier) 3653(define-key org-agenda-mode-map [(left)] 'org-agenda-earlier)
3631 3654(define-key org-agenda-mode-map "\C-c\C-x\C-c" 'org-export-icalendar-combine-agenda-files)
3632(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) 3655(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map)
3633 "Local keymap for agenda entries from Org-mode.") 3656 "Local keymap for agenda entries from Org-mode.")
3634 3657
@@ -3681,6 +3704,7 @@ The following commands are available:
3681 ["Sunrise/Sunset" org-agenda-sunrise-sunset t] 3704 ["Sunrise/Sunset" org-agenda-sunrise-sunset t]
3682 ["Holidays" org-agenda-holidays t] 3705 ["Holidays" org-agenda-holidays t]
3683 ["Convert" org-agenda-convert-date t]) 3706 ["Convert" org-agenda-convert-date t])
3707 ["Create iCalendar file" org-export-icalendar-combine-agenda-files t]
3684 "--" 3708 "--"
3685 ["Quit" org-agenda-quit t] 3709 ["Quit" org-agenda-quit t]
3686 ["Exit and Release Buffers" org-agenda-exit t] 3710 ["Exit and Release Buffers" org-agenda-exit t]
@@ -4253,6 +4277,9 @@ Optional argument FILE means, use this file instead of the current."
4253 4277
4254(defun org-file-menu-entry (file) 4278(defun org-file-menu-entry (file)
4255 (vector file (list 'find-file file) t)) 4279 (vector file (list 'find-file file) t))
4280;; FIXME: Maybe removed a buffer visited through the menu from
4281;; org-agenda-new-buffers, so that the buffer will not be removed
4282;; when exiting the agenda????
4256 4283
4257(defun org-get-all-dates (beg end &optional no-ranges force-today) 4284(defun org-get-all-dates (beg end &optional no-ranges force-today)
4258 "Return a list of all relevant day numbers from BEG to END buffer positions. 4285 "Return a list of all relevant day numbers from BEG to END buffer positions.
@@ -5222,7 +5249,8 @@ argument, latitude and longitude will be prompted for."
5222 (let* ((day (or (get-text-property (point) 'day) 5249 (let* ((day (or (get-text-property (point) 'day)
5223 (error "Don't know which date to open in calendar"))) 5250 (error "Don't know which date to open in calendar")))
5224 (date (calendar-gregorian-from-absolute day))) 5251 (date (calendar-gregorian-from-absolute day)))
5225 (calendar) 5252 (let ((view-diary-entries-initially nil))
5253 (calendar))
5226 (calendar-goto-date date))) 5254 (calendar-goto-date date)))
5227 5255
5228(defun org-calendar-goto-agenda () 5256(defun org-calendar-goto-agenda ()
@@ -8031,10 +8059,10 @@ to execute outside of tables."
8031 "--" 8059 "--"
8032 ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"]) 8060 ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"])
8033 ("Rectangle" 8061 ("Rectangle"
8034 ["Copy Rectangle" org-copy-special :active (org-at-table-p) :keys "C-c C-x M-w"] 8062 ["Copy Rectangle" org-copy-special :active (org-at-table-p)]
8035 ["Cut Rectangle" org-cut-special :active (org-at-table-p) :keys "C-c C-x C-w"] 8063 ["Cut Rectangle" org-cut-special :active (org-at-table-p)]
8036 ["Paste Rectangle" org-paste-special :active (org-at-table-p) :keys "C-c C-x C-y"] 8064 ["Paste Rectangle" org-paste-special :active (org-at-table-p)]
8037 ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p) :keys "C-c C-q"]) 8065 ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)])
8038 "--" 8066 "--"
8039 ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] 8067 ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
8040 ["Set Named Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] 8068 ["Set Named Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
@@ -8834,6 +8862,8 @@ headlines. The default is 3. Lower levels will become bulleted lists."
8834 (coding-system (and (fboundp 'coding-system-get) 8862 (coding-system (and (fboundp 'coding-system-get)
8835 (boundp 'buffer-file-coding-system) 8863 (boundp 'buffer-file-coding-system)
8836 buffer-file-coding-system)) 8864 buffer-file-coding-system))
8865 (coding-system-for-write (or coding-system coding-system-for-write))
8866 (save-buffer-coding-system (or coding-system save-buffer-coding-system))
8837 (charset (and coding-system 8867 (charset (and coding-system
8838 (coding-system-get coding-system 'mime-charset))) 8868 (coding-system-get coding-system 'mime-charset)))
8839 table-open type 8869 table-open type
@@ -9066,6 +9096,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
9066 (if org-export-html-with-timestamp 9096 (if org-export-html-with-timestamp
9067 (insert org-export-html-html-helper-timestamp)) 9097 (insert org-export-html-html-helper-timestamp))
9068 (insert "</body>\n</html>\n") 9098 (insert "</body>\n</html>\n")
9099 (debug)
9069 (normal-mode) 9100 (normal-mode)
9070 (save-buffer) 9101 (save-buffer)
9071 (goto-char (point-min))))) 9102 (goto-char (point-min)))))
@@ -9409,6 +9440,172 @@ When LEVEL is non-nil, increase section numbers on that level."
9409 string)) 9440 string))
9410 9441
9411 9442
9443
9444
9445
9446(defun org-export-icalendar-this-file ()
9447 "Export current file as an iCalendar file.
9448The iCalendar file will be located in the same directory as the Org-mode
9449file, but with extension `.ics'."
9450 (interactive)
9451 (org-export-icalendar nil (buffer-file-name)))
9452
9453;;;###autoload
9454(defun org-export-icalendar-all-agenda-files ()
9455 "Export all files in `org-agenda-files' to iCalendar .ics files.
9456Each iCalendar file will be located in the same directory as the Org-mode
9457file, but with extension `.ics'."
9458 (interactive)
9459 (apply 'org-export-icalendar nil org-agenda-files))
9460
9461;;;###autoload
9462(defun org-export-icalendar-combine-agenda-files ()
9463 "Export all files in `org-agenda-files' to a single combined iCalendar file.
9464The file is stored under the name `org-combined-agenda-icalendar-file'."
9465 (interactive)
9466 (apply 'org-export-icalendar t org-agenda-files))
9467
9468(defun org-export-icalendar (combine &rest files)
9469 "Create iCalendar files for all elements of FILES.
9470If COMBINE is non-nil, combine all calendar entries into a single large
9471file and store it under the name `org-combined-agenda-icalendar-file'."
9472 (save-excursion
9473 (let* (file ical-file ical-buffer category started org-agenda-new-buffers)
9474 (when combine
9475 (setq ical-file org-combined-agenda-icalendar-file
9476 ical-buffer (org-get-agenda-file-buffer ical-file))
9477 (set-buffer ical-buffer) (erase-buffer))
9478 (while (setq file (pop files))
9479 (catch 'nextfile
9480 (org-check-agenda-file file)
9481 (unless combine
9482 (setq ical-file (concat (file-name-sans-extension file) ".ics"))
9483 (setq ical-buffer (org-get-agenda-file-buffer ical-file))
9484 (set-buffer ical-buffer) (erase-buffer))
9485 (set-buffer (org-get-agenda-file-buffer file))
9486 (setq category (or org-category
9487 (file-name-sans-extension
9488 (file-name-nondirectory (buffer-file-name)))))
9489 (if (symbolp category) (setq category (symbol-name category)))
9490 (let ((standard-output ical-buffer))
9491 (if combine
9492 (and (not started) (setq started t)
9493 (org-start-icalendar-file "OrgMode"))
9494 (org-start-icalendar-file category))
9495 (org-print-icalendar-entries combine category)
9496 (when (or (and combine (not files)) (not combine))
9497 (org-finish-icalendar-file)
9498 (set-buffer ical-buffer)
9499 (save-buffer)
9500 (run-hooks 'org-after-save-iCalendar-file-hook)))))
9501 (org-release-buffers org-agenda-new-buffers))))
9502
9503(defvar org-after-save-iCalendar-file-hook nil
9504 "Hook run after an iCalendar file has been saved.
9505The iCalendar buffer is still current when this hook is run.
9506A good way to use this is to tell a desktop calenndar application to re-read
9507the iCalendar file.")
9508
9509(defun org-print-icalendar-entries (&optional combine category)
9510 "Print iCalendar entries for the current Org-mode file to `standard-output'.
9511When COMBINE is non nil, add the category to each line."
9512 (let ((re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
9513 (dts (org-ical-ts-to-string
9514 (format-time-string (cdr org-time-stamp-formats) (current-time))
9515 "DTSTART"))
9516 hd ts ts2 state (inc t) pos scheduledp deadlinep donep tmp pri)
9517 (save-excursion
9518 (goto-char (point-min))
9519 (while (re-search-forward org-ts-regexp nil t)
9520 (setq pos (match-beginning 0)
9521 ts (match-string 0)
9522 inc t
9523 hd (org-get-heading))
9524 (if (looking-at re2)
9525 (progn
9526 (goto-char (match-end 0))
9527 (setq ts2 (match-string 1) inc nil))
9528 (setq ts2 ts
9529 tmp (buffer-substring (max (point-min)
9530 (- pos org-ds-keyword-length))
9531 pos)
9532 deadlinep (string-match org-deadline-regexp tmp)
9533 scheduledp (string-match org-scheduled-regexp tmp)
9534 donep (org-entry-is-done-p)))
9535 (if (or (string-match org-tr-regexp hd)
9536 (string-match org-ts-regexp hd))
9537 (setq hd (replace-match "" t t hd)))
9538 (if combine
9539 (setq hd (concat hd " (category " category ")")))
9540 (if deadlinep (setq hd (concat "DL: " hd " This is a deadline")))
9541 (if scheduledp (setq hd (concat "S: " hd " Scheduled for this date")))
9542 (princ (format "BEGIN:VEVENT
9543%s
9544%s
9545SUMMARY:%s
9546END:VEVENT\n"
9547 (org-ical-ts-to-string ts "DTSTART")
9548 (org-ical-ts-to-string ts2 "DTEND" inc)
9549 hd)))
9550 (when org-icalendar-include-todo
9551 (goto-char (point-min))
9552 (while (re-search-forward org-todo-line-regexp nil t)
9553 (setq state (match-string 1))
9554 (unless (equal state org-done-string)
9555 (setq hd (match-string 3))
9556 (if (string-match org-priority-regexp hd)
9557 (setq pri (string-to-char (match-string 2 hd))
9558 hd (concat (substring hd 0 (match-beginning 1))
9559 (substring hd (- (match-end 1)))))
9560 (setq pri org-default-priority))
9561 (setq pri (floor (1+ (* 8. (/ (float (- org-lowest-priority pri))
9562 (- org-lowest-priority ?A))))))
9563
9564 (princ (format "BEGIN:VTODO
9565%s
9566SUMMARY:%s
9567SEQUENCE:1
9568PRIORITY:%d
9569END:VTODO\n"
9570 dts hd pri))))))))
9571
9572(defun org-start-icalendar-file (name)
9573 "Start an iCalendar file by inserting the header."
9574 (let ((user user-full-name)
9575 (calname "something")
9576 (name (or name "unknown"))
9577 (timezone "FIXME"))
9578 (princ
9579 (format "BEGIN:VCALENDAR
9580VERSION:2.0
9581X-WR-CALNAME:%s
9582PRODID:-//%s//Emacs with Org-mode//EN
9583X-WR-TIMEZONE:Europe/Amsterdam
9584CALSCALE:GREGORIAN\n" name user timezone))))
9585
9586(defun org-finish-icalendar-file ()
9587 "Finish an iCalendar file by inserting the END statement."
9588 (princ "END:VCALENDAR\n"))
9589
9590(defun org-ical-ts-to-string (s keyword &optional inc)
9591 "Take a time string S and convert it to iCalendar format.
9592KEYWORD is added in front, to make a complete line like DTSTART....
9593When INC is non-nil, increase the hour by two (if time string contains
9594a time), or the day by one (if it does not contain a time)."
9595 (let ((t1 (org-parse-time-string s 'nodefault))
9596 t2 fmt have-time time)
9597 (if (and (car t1) (nth 1 t1) (nth 2 t1))
9598 (setq t2 t1 have-time t)
9599 (setq t2 (org-parse-time-string s)))
9600 (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2))
9601 (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2)))
9602 (when inc
9603 (if have-time (setq h (+ 2 h)) (setq d (1+ d))))
9604 (setq time (encode-time s mi h d m y)))
9605 (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d"))
9606 (concat keyword (format-time-string fmt time))))
9607
9608
9412;;; Key bindings 9609;;; Key bindings
9413 9610
9414;; - Bindings in Org-mode map are currently 9611;; - Bindings in Org-mode map are currently
@@ -9510,9 +9707,13 @@ When LEVEL is non-nil, increase section numbers on that level."
9510(define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii) 9707(define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii)
9511(define-key org-mode-map "\C-c\C-xv" 'org-export-copy-visible) 9708(define-key org-mode-map "\C-c\C-xv" 'org-export-copy-visible)
9512(define-key org-mode-map "\C-c\C-x\C-v" 'org-export-copy-visible) 9709(define-key org-mode-map "\C-c\C-x\C-v" 'org-export-copy-visible)
9513;; OPML support is only planned 9710;; OPML support is only an option for the future
9514;(define-key org-mode-map "\C-c\C-xo" 'org-export-as-opml) 9711;(define-key org-mode-map "\C-c\C-xo" 'org-export-as-opml)
9515;(define-key org-mode-map "\C-c\C-x\C-o" 'org-export-as-opml) 9712;(define-key org-mode-map "\C-c\C-x\C-o" 'org-export-as-opml)
9713(define-key org-mode-map "\C-c\C-xi" 'org-export-icalendar-this-file)
9714(define-key org-mode-map "\C-c\C-x\C-i" 'org-export-icalendar-all-agenda-files)
9715(define-key org-mode-map "\C-c\C-xc" 'org-export-icalendar-combine-agenda-files)
9716(define-key org-mode-map "\C-c\C-x\C-c" 'org-export-icalendar-combine-agenda-files)
9516(define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template) 9717(define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template)
9517(define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section) 9718(define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section)
9518(define-key org-mode-map "\C-c\C-xh" 'org-export-as-html) 9719(define-key org-mode-map "\C-c\C-xh" 'org-export-as-html)
@@ -9945,6 +10146,11 @@ See the individual commands for more information."
9945 ["HTML and Open" org-export-as-html-and-open t] 10146 ["HTML and Open" org-export-as-html-and-open t]
9946; ["OPML" org-export-as-opml nil] 10147; ["OPML" org-export-as-opml nil]
9947 "--" 10148 "--"
10149 ["iCalendar this file" org-export-icalendar-this-file t]
10150 ["iCalendar all agenda files" org-export-icalendar-all-agenda-files
10151 :active t :keys "C-c C-x C-i"]
10152 ["iCalendar combined" org-export-icalendar-combine-agenda-files t]
10153 "--"
9948 ["Option Template" org-insert-export-options-template t] 10154 ["Option Template" org-insert-export-options-template t]
9949 ["Toggle Fixed Width" org-toggle-fixed-width-section t]) 10155 ["Toggle Fixed Width" org-toggle-fixed-width-section t])
9950 "--" 10156 "--"
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index f4af34fdabf..1ed43279c3d 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -159,23 +159,32 @@ to obtain the value of this variable."
159 :group 'paragraphs 159 :group 'paragraphs
160 :type '(choice regexp (const :tag "Use default value" nil))) 160 :type '(choice regexp (const :tag "Use default value" nil)))
161 161
162(defcustom sentence-end-base "[.?!][]\"'\xd0c9\x5397d)}]*"
163 "*Regexp matching the basic end of a sentence, not including following space."
164 :group 'paragraphs
165 :type 'string
166 :version "22.1")
167
162(defun sentence-end () 168(defun sentence-end ()
163 "Return the regexp describing the end of a sentence. 169 "Return the regexp describing the end of a sentence.
164 170
165This function returns either the value of the variable `sentence-end' 171This function returns either the value of the variable `sentence-end'
166if it is non-nil, or the default value constructed from the 172if it is non-nil, or the default value constructed from the
167variables `sentence-end-double-space', `sentence-end-without-period' 173variables `sentence-end-base', `sentence-end-double-space',
168and `sentence-end-without-space'. The default value specifies 174`sentence-end-without-period' and `sentence-end-without-space'.
169that in order to be recognized as the end of a sentence, the 175
170ending period, question mark, or exclamation point must be 176The default value specifies that in order to be recognized as the
171followed by two spaces, unless it's inside some sort of quotes or 177end of a sentence, the ending period, question mark, or exclamation point
172parenthesis. See Info node `(elisp)Standard Regexps'." 178must be followed by two spaces, with perhaps some closing delimiters
179in between. See Info node `(elisp)Standard Regexps'."
173 (or sentence-end 180 (or sentence-end
174 (concat (if sentence-end-without-period "\\w \\|") 181 (concat (if sentence-end-without-period "\\w \\|")
175 "\\([.?!][]\"'\xd0c9\x5397d)}]*" 182 "\\("
183 sentence-end-base
176 (if sentence-end-double-space 184 (if sentence-end-double-space
177 "\\($\\| $\\|\t\\| \\)" "\\($\\|[\t ]\\)") 185 "\\($\\| $\\|\t\\| \\)" "\\($\\|[\t ]\\)")
178 "\\|[" sentence-end-without-space "]+\\)" 186 "\\|[" sentence-end-without-space "]+"
187 "\\)"
179 "[ \t\n]*"))) 188 "[ \t\n]*")))
180 189
181(defcustom page-delimiter "^\014" 190(defcustom page-delimiter "^\014"
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index a0dec653165..3507f6e57cf 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -593,6 +593,9 @@ value of `texinfo-mode-hook'."
593 (concat "\b\\|@[a-zA-Z]*[ \n]\\|" paragraph-separate)) 593 (concat "\b\\|@[a-zA-Z]*[ \n]\\|" paragraph-separate))
594 (make-local-variable 'paragraph-start) 594 (make-local-variable 'paragraph-start)
595 (setq paragraph-start (concat "\b\\|@[a-zA-Z]*[ \n]\\|" paragraph-start)) 595 (setq paragraph-start (concat "\b\\|@[a-zA-Z]*[ \n]\\|" paragraph-start))
596 (make-local-variable 'sentence-end-base)
597 (setq sentence-end-base
598 "\\(@\\(end\\)?dots{}\\|[.?!]\\)[]\"'\xd0c9\x5397d)}]*")
596 (make-local-variable 'adaptive-fill-mode) 599 (make-local-variable 'adaptive-fill-mode)
597 (setq adaptive-fill-mode nil) 600 (setq adaptive-fill-mode nil)
598 (make-local-variable 'fill-column) 601 (make-local-variable 'fill-column)
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index d7a822e105a..f45c73216f7 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,12 @@
12005-10-20 CHENG Gao <chenggao@gmail.com> (tiny change)
2
3 * url-nfs.el (top level):
4 * url-handlers.el (directory-files):
5 * url-file.el (top level):
6 * url-dired.el (url-dired-minor-mode-map):
7 * url-http.el (url-http-chunked-encoding-after-change-function):
8 Remove XEmacs support.
9
12005-10-15 Richard M. Stallman <rms@gnu.org> 102005-10-15 Richard M. Stallman <rms@gnu.org>
2 11
3 * url.el: Don't try to autoload hash table functions. 12 * url.el: Don't try to autoload hash table functions.
diff --git a/lisp/url/url-dired.el b/lisp/url/url-dired.el
index 7c635d13e3b..b5ff892721e 100644
--- a/lisp/url/url-dired.el
+++ b/lisp/url/url-dired.el
@@ -31,9 +31,7 @@
31(defvar url-dired-minor-mode-map 31(defvar url-dired-minor-mode-map
32 (let ((map (make-sparse-keymap))) 32 (let ((map (make-sparse-keymap)))
33 (define-key map "\C-m" 'url-dired-find-file) 33 (define-key map "\C-m" 'url-dired-find-file)
34 (if (featurep 'xemacs) 34 (define-key map [mouse-2] 'url-dired-find-file-mouse)
35 (define-key map [button2] 'url-dired-find-file-mouse)
36 (define-key map [mouse-2] 'url-dired-find-file-mouse))
37 map) 35 map)
38 "Keymap used when browsing directories.") 36 "Keymap used when browsing directories.")
39 37
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index 44a4f8bd9f4..64766930c43 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -230,12 +230,8 @@ to them."
230(url-file-create-wrapper file-readable-p (url)) 230(url-file-create-wrapper file-readable-p (url))
231(url-file-create-wrapper file-writable-p (url)) 231(url-file-create-wrapper file-writable-p (url))
232(url-file-create-wrapper file-executable-p (url)) 232(url-file-create-wrapper file-executable-p (url))
233(if (featurep 'xemacs) 233(url-file-create-wrapper directory-files (url &optional full match nosort))
234 (progn 234(url-file-create-wrapper file-truename (url &optional counter prev-dirs))
235 (url-file-create-wrapper directory-files (url &optional full match nosort files-only))
236 (url-file-create-wrapper file-truename (url &optional default)))
237 (url-file-create-wrapper directory-files (url &optional full match nosort))
238 (url-file-create-wrapper file-truename (url &optional counter prev-dirs)))
239 235
240(provide 'url-file) 236(provide 'url-file)
241 237
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index bbbf19f53fc..4fa52572a94 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -246,19 +246,8 @@ accessible."
246(url-handlers-create-wrapper file-writable-p (url)) 246(url-handlers-create-wrapper file-writable-p (url))
247(url-handlers-create-wrapper file-directory-p (url)) 247(url-handlers-create-wrapper file-directory-p (url))
248(url-handlers-create-wrapper file-executable-p (url)) 248(url-handlers-create-wrapper file-executable-p (url))
249 249(url-handlers-create-wrapper directory-files (url &optional full match nosort))
250(if (featurep 'xemacs) 250(url-handlers-create-wrapper file-truename (url &optional counter prev-dirs))
251 (progn
252 ;; XEmacs specific prototypes
253 (url-handlers-create-wrapper
254 directory-files (url &optional full match nosort files-only))
255 (url-handlers-create-wrapper
256 file-truename (url &optional default)))
257 ;; Emacs specific prototypes
258 (url-handlers-create-wrapper
259 directory-files (url &optional full match nosort))
260 (url-handlers-create-wrapper
261 file-truename (url &optional counter prev-dirs)))
262 251
263(add-hook 'find-file-hook 'url-handlers-set-buffer-mode) 252(add-hook 'find-file-hook 'url-handlers-set-buffer-mode)
264 253
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 89b7be42c47..39db321c080 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -840,9 +840,7 @@ the end of the document."
840 (list 'start-open t 840 (list 'start-open t
841 'end-open t 841 'end-open t
842 'chunked-encoding t 842 'chunked-encoding t
843 'face (if (featurep 'xemacs) 843 'face 'cursor
844 'text-cursor
845 'cursor)
846 'invisible t)) 844 'invisible t))
847 (setq url-http-chunked-length (string-to-number (buffer-substring 845 (setq url-http-chunked-length (string-to-number (buffer-substring
848 (match-beginning 1) 846 (match-beginning 1)
diff --git a/lisp/url/url-nfs.el b/lisp/url/url-nfs.el
index 858cd029a85..e6822efc242 100644
--- a/lisp/url/url-nfs.el
+++ b/lisp/url/url-nfs.el
@@ -87,12 +87,8 @@ Each can be used any number of times.")
87(url-nfs-create-wrapper file-readable-p (url)) 87(url-nfs-create-wrapper file-readable-p (url))
88(url-nfs-create-wrapper file-writable-p (url)) 88(url-nfs-create-wrapper file-writable-p (url))
89(url-nfs-create-wrapper file-executable-p (url)) 89(url-nfs-create-wrapper file-executable-p (url))
90(if (featurep 'xemacs) 90(url-nfs-create-wrapper directory-files (url &optional full match nosort))
91 (progn 91(url-nfs-create-wrapper file-truename (url &optional counter prev-dirs))
92 (url-nfs-create-wrapper directory-files (url &optional full match nosort files-only))
93 (url-nfs-create-wrapper file-truename (url &optional default)))
94 (url-nfs-create-wrapper directory-files (url &optional full match nosort))
95 (url-nfs-create-wrapper file-truename (url &optional counter prev-dirs)))
96 92
97(provide 'url-nfs) 93(provide 'url-nfs)
98 94