diff options
| author | Karoly Lorentey | 2005-10-23 22:47:29 +0000 |
|---|---|---|
| committer | Karoly Lorentey | 2005-10-23 22:47:29 +0000 |
| commit | 6dc59f76f49a35140b3bbdeb9c495609f8e55f3a (patch) | |
| tree | 3694df29f4ce4ab94220bd377cd0d32b64f98b0a /lisp | |
| parent | a095475c5f316eed7b27f6e0e6df52dae53dc2a5 (diff) | |
| parent | c286104c51b4510ead8e92d265a84aa661ddbf97 (diff) | |
| download | emacs-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')
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 @@ | |||
| 1 | 2005-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 | |||
| 7 | 2005-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 | |||
| 20 | 2005-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 | |||
| 27 | 2005-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 | |||
| 32 | 2005-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 | |||
| 47 | 2005-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 | |||
| 68 | 2005-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 | |||
| 80 | 2005-10-21 Romain Francoise <romain@orebokech.com> | ||
| 81 | |||
| 82 | * net/rcirc.el: Now part of GNU Emacs. Update FSF's address. | ||
| 83 | |||
| 84 | 2005-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 | |||
| 96 | 2005-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 | |||
| 112 | 2005-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 | |||
| 117 | 2005-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 | |||
| 122 | 2005-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 | |||
| 129 | 2005-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 | |||
| 137 | 2005-10-20 Richard M. Stallman <rms@gnu.org> | ||
| 138 | |||
| 139 | * net/rcirc.el: New file. | ||
| 140 | |||
| 141 | 2005-10-20 Bryan Henderson <bryanh@giraffe-data.com> (tiny change) | ||
| 142 | |||
| 143 | * term.el (term-term-name): Initialize to "eterm-color". | ||
| 144 | |||
| 145 | 2005-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 | |||
| 218 | 2005-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 | |||
| 226 | 2005-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 | |||
| 231 | 2005-10-20 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 232 | |||
| 233 | * textmodes/org.el (org-level-color-stars-only): Fix typo in docstring. | ||
| 234 | |||
| 235 | 2005-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 | |||
| 241 | 2005-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 | |||
| 250 | 2005-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 | |||
| 262 | 2005-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 | |||
| 268 | 2005-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 | |||
| 274 | 2005-10-18 Chong Yidong <cyd@stupidchicken.com> | ||
| 275 | |||
| 276 | * image.el (create-image, find-image): Mention max-image-size in | ||
| 277 | docstring. | ||
| 278 | |||
| 1 | 2005-10-18 Stefan Monnier <monnier@iro.umontreal.ca> | 279 | 2005-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 | ||
| 118 | 2005-10-18 Jay Belanger <belanger@truman.edu> | 398 | 2005-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 | ||
| 123 | 2005-10-18 Nick Roberts <nickrob@snap.net.nz> | 403 | 2005-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. | ||
| 89 | Return 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 | ||
| 112 | A list value specifies a default layout for the current buffer, to be | 137 | A list value specifies a default layout for the current buffer, to be |
| 113 | applied upon activation of `allout-mode'. Any non-nil value will | 138 | applied upon activation of `allout-mode'. Any non-nil value will |
| 114 | automatically trigger `allout-mode', provided `allout-init' | 139 | automatically trigger `allout-mode' \(provided `allout-init' has been called |
| 115 | has been called to enable it. | 140 | to enable this behavior). |
| 116 | 141 | ||
| 117 | See the docstring for `allout-init' for details on setting up for | 142 | See the docstring for `allout-init' for details on setting up for |
| 118 | auto-mode-activation, and for `allout-expose-topic' for the format of | 143 | auto-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 | ||
| 177 | See `allout-distinctive-bullets-string' for the other kind of | 202 | See `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 | ||
| 191 | These bullets are used to distinguish topics from the run-of-the-mill | 216 | These 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, |
| 206 | software, according to the value of `allout-numbered-bullet'.) | 232 | according to the value of `allout-numbered-bullet'.) |
| 207 | 233 | ||
| 208 | See `allout-plain-bullets-string' for the selection of | 234 | See `allout-plain-bullets-string' for the selection of |
| 209 | alternating bullets. | 235 | alternating bullets. |
| @@ -337,7 +363,6 @@ disables numbering maintenance." | |||
| 337 | Set this var to the bullet you want to use for file cross-references." | 363 | Set 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 |
| 386 | formatted copy." | 411 | formatted 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 | |||
| 435 | See 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 | |||
| 442 | The key verifier is string associated with a file that is encrypted with | ||
| 443 | the file's current symmetric encryption key. It is used, if present, to | ||
| 444 | confirm that the key entered by the user is the same as the established | ||
| 445 | one, or explicitly presenting the user with the choice to go with a | ||
| 446 | new key when a difference is encountered. | ||
| 447 | |||
| 448 | The 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 | |||
| 456 | See the docstring for the `allout-enable-file-variable-adjustment' | ||
| 457 | variable 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 | |||
| 472 | See the docstring for the `allout-enable-file-variable-adjustment' | ||
| 473 | variable 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 | |||
| 484 | The idea is to prevent file-system exposure of any un-encrypted stuff, and | ||
| 485 | mostly 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 | |||
| 501 | For practical reasons, auto-saves always use the 'except-current policy | ||
| 502 | when auto-encryption is enabled. \(Otherwise, spurious key prompts and | ||
| 503 | unavoidable timing collisions are too disruptive.) If security for a file | ||
| 504 | requires that even the current topic is never auto-saved in the clear, | ||
| 505 | disable 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 | |||
| 611 | This can range from changes to existing entries, addition of new ones, | ||
| 612 | and creation of a new local variables section when necessary. | ||
| 495 | 613 | ||
| 496 | Outline mode uses Emacs change-triggered functions to detect unruly | 614 | Emacs file variables adjustments are also inhibited if `enable-local-variables' |
| 497 | changes to concealed regions. Set this var non-nil to disable the | 615 | is nil. |
| 498 | protection, potentially increasing text-entry responsiveness a bit. | ||
| 499 | 616 | ||
| 500 | This var takes effect at `allout-mode' activation, so you may have to | 617 | Operations potentially causing edits include allout encryption routines. |
| 501 | deactivate and then reactivate the mode if you want to toggle the | 618 | See the docstring for `allout-toggle-current-subtree-encryption' for |
| 502 | behavior." | 619 | details." |
| 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 | ||
| 852 | resurrecting, on mode deactivation, bindings that existed before | ||
| 853 | activation. 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 | ||
| 857 | resurrecting, on mode deactivation, bindings that existed before | ||
| 858 | activation. 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 | |||
| 862 | See also `allout-post-command-business', `allout-write-file-hook', | ||
| 863 | `allout-before-change-protect', and `allout-post-command-business' | ||
| 864 | functions.") | ||
| 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 | ||
| 878 | Allout outline mode regulates alteration of concealed text to protect | 1003 | Maintained by allout-isearch-abort \(which is wrapped around the real |
| 879 | against inadvertent, unnoticed changes. This is for use by specific, | 1004 | isearch-abort), and monitored by allout-isearch-expose for action.") |
| 880 | native outline functions to temporarily override that protection. | 1005 | (make-variable-buffer-local 'allout-isearch-did-quit) |
| 881 | It'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 |
| 898 | mode from prop-line file-var activation. Used by `allout-mode' function | 1028 | mode from prop-line file-var activation. Used by `allout-mode' function |
| 899 | to track repeats.") | 1029 | to 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 | 1033 | sessions.") | |
| 904 | Currently just sets `allout-during-write-cue', so outline change-protection | 1034 | (make-variable-buffer-local 'allout-file-key-verifier-string) |
| 905 | knows 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 | |||
| 1039 | Intended as a file-specific (buffer local) setting, it defaults to the | ||
| 1040 | value 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 | ||
| 1045 | associated with a file. | ||
| 1046 | |||
| 1047 | It consists of an encrypted random string useful only to verify that a key | ||
| 1048 | entered by the user is effective for decryption. The key itself is \*not* | ||
| 1049 | recorded in the file anywhere, and the encrypted contents are random binary | ||
| 1050 | characters to avoid exposing greater susceptibility to search attacks. | ||
| 1051 | |||
| 1052 | The verifier string is retained as an Emacs file variable, as well as in | ||
| 1053 | the 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 | |||
| 1061 | See the description of `allout-key-hint-handling' for details about how | ||
| 1062 | the reminder is deployed. | ||
| 1063 | |||
| 1064 | The hint is retained as an Emacs file variable, as well as in the emacs buffer | ||
| 1065 | state, 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 | |||
| 1076 | This is used to decrypt the topic that was currently being edited, if it | ||
| 1077 | was 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 | |||
| 1116 | Ie, if it was pending encryption and contained the point in its body before | ||
| 1117 | the save. | ||
| 1118 | |||
| 1119 | We use values stored in `allout-after-save-decrypt' to locate the topic | ||
| 1120 | and 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. |
| 920 | So `allout-post-command-business' should not reactivate it...") | 1145 | So `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 | |||
| 939 | the `allout-layout' variable. (See `allout-layout' and | 1163 | the `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 | 1167 | find-file-hook, and giving `allout-auto-activation' a suitable |
| 944 | `allout-auto-activation' a suitable setting. | 1168 | setting. |
| 945 | 1169 | ||
| 946 | To prime your Emacs session for full auto-outline operation, include | 1170 | To prime your Emacs session for full auto-outline operation, include |
| 947 | the following two lines in your Emacs init file: | 1171 | the 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 | ||
| 1023 | In addition to outline navigation and exposure, allout includes: | 1250 | In 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 | |||
| 1035 | special `allout-mode' features and terminology. See also the outline | 1263 | special `allout-mode' features and terminology. See also the outline |
| 1036 | menubar additions for quick reference to many of the features, and see | 1264 | menubar additions for quick reference to many of the features, and see |
| 1037 | the docstring of the function `allout-init' for instructions on | 1265 | the docstring of the function `allout-init' for instructions on |
| 1038 | priming your Emacs session for automatic activation of `allout-mode'. | 1266 | priming your emacs session for automatic activation of `allout-mode'. |
| 1039 | 1267 | ||
| 1040 | 1268 | ||
| 1041 | The bindings are dictated by the `allout-keybindings-list' and | 1269 | The 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 | |||
| 1048 | C-c C-u allout-up-current-level | C-c C-s allout-show-current-subtree | 1276 | C-c C-u allout-up-current-level | C-c C-s allout-show-current-subtree |
| 1049 | C-c C-f allout-forward-current-level | C-c C-o allout-show-current-entry | 1277 | C-c C-f allout-forward-current-level | C-c C-o allout-show-current-entry |
| 1050 | C-c C-b allout-backward-current-level | ^U C-c C-s allout-show-all | 1278 | C-c C-b allout-backward-current-level | ^U C-c C-s allout-show-all |
| 1051 | C-c C-e allout-end-of-current-entry | allout-hide-current-leaves | 1279 | C-c C-e allout-end-of-entry | allout-hide-current-leaves |
| 1052 | C-c C-a allout-beginning-of-current-entry, alternately, goes to hot-spot | 1280 | C-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. | |||
| 1064 | C-c<CR> allout-rebullet-topic Reconcile bullets of topic and its offspring | 1292 | C-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. |
| 1067 | C-c * allout-rebullet-current-heading Prompt for alternate bullet for | 1295 | C-c b allout-rebullet-current-heading Prompt for alternate bullet for |
| 1068 | current topic. | 1296 | current topic. |
| 1069 | C-c # allout-number-siblings Number bullets of topic and siblings - the | 1297 | C-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, | |||
| 1087 | C-c C-SPC allout-mark-topic | 1315 | C-c C-SPC allout-mark-topic |
| 1088 | C-c = c allout-copy-exposed-to-buffer | 1316 | C-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*\". |
| 1092 | C-c = p allout-flatten-exposed-to-buffer | 1320 | C-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 | |||
| 1096 | ESC ESC (allout-init t) Setup Emacs session for outline mode | 1324 | ESC ESC (allout-init t) Setup Emacs session for outline mode |
| 1097 | auto-activation. | 1325 | auto-activation. |
| 1098 | 1326 | ||
| 1327 | Encrypted Entries | ||
| 1328 | |||
| 1329 | Outline mode supports easily togglable gpg encryption of topics, with | ||
| 1330 | niceities like support for symmetric and key-pair modes, key timeout, key | ||
| 1331 | consistency checking, user-provided hinting for symmetric key mode, and | ||
| 1332 | auto-encryption of topics pending encryption on save. The aim is to enable | ||
| 1333 | reliable topic privacy while preventing accidents like neglected | ||
| 1334 | encryption, encryption with a mistaken key, forgetting which key was used, | ||
| 1335 | and other practical pitfalls. | ||
| 1336 | |||
| 1337 | See 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 | ||
| 1101 | Hot-spot operation provides a means for easy, single-keystroke outline | 1342 | Hot-spot operation provides a means for easy, single-keystroke outline |
| @@ -1148,11 +1389,11 @@ Topic text constituents: | |||
| 1148 | 1389 | ||
| 1149 | HEADER: The first line of a topic, include the topic PREFIX and header | 1390 | HEADER: The first line of a topic, include the topic PREFIX and header |
| 1150 | text. | 1391 | text. |
| 1151 | PREFIX: The leading text of a topic which distinguishes it from | 1392 | PREFIX: 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 | ||
| 1406 | For reference by `allout-recent' funcs. Returns BEGINNING." | 1665 | For 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 | ||
| 1614 | Optional argument LEVELS specifies the depth \(relative to start | 1873 | Optional argument LEVELS specifies the depth \(relative to start |
| 1615 | depth) for the chart. | 1874 | depth) for the chart. Subsequent optional args are not for public |
| 1875 | use. | ||
| 1876 | |||
| 1877 | Point is left at the end of the subtree. | ||
| 1616 | 1878 | ||
| 1617 | Charts are used to capture outline structure, so that outline altering | 1879 | Charts are used to capture outline structure, so that outline-altering |
| 1618 | routines need assess the structure only once, and then use the chart | 1880 | routines need assess the structure only once, and then use the chart |
| 1619 | for their elaborate manipulations. | 1881 | for their elaborate manipulations. |
| 1620 | 1882 | ||
| @@ -1625,11 +1887,9 @@ list containing, recursively, the charts for the respective subtopics. | |||
| 1625 | The chart for a topics' offspring precedes the entry for the topic | 1887 | The chart for a topics' offspring precedes the entry for the topic |
| 1626 | itself. | 1888 | itself. |
| 1627 | 1889 | ||
| 1628 | \(fn &optional LEVELS)" | 1890 | The other function parameters are for internal recursion, and should |
| 1629 | 1891 | not be specified by external callers. ORIG-DEPTH is depth of topic at | |
| 1630 | ;; The other function parameters are for internal recursion, and should | 1892 | starting 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) | 2102 | If optional CURRENT is true (default false), then put point at the end of |
| 2103 | the containing visible topic. | ||
| 2104 | |||
| 2105 | Returns 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 | |||
| 2125 | Returns 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 | ||
| 1858 | If already there, move cursor to bullet for hot-spot operation. | 2132 | If 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 | ||
| 1923 | Positions on heading line of containing topic. Error if unable to | 2218 | Positions on heading line of containing topic. Error if unable to |
| 1924 | ascend that far, or nil if unable to ascend but optional arg | 2219 | ascend that far, or nil if unable to ascend but optional arg |
| 1925 | DONT-COMPLAIN is non-nil." | 2220 | DONT-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 | ||
| 1986 | Optional DEPTH specifies depth to traverse, default current depth. | 2281 | Optional 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 | ||
| 2059 | Takes optional repeat-count, goes backward if count is negative. | 2354 | Takes optional repeat-count, goes backward if count is negative. |
| 2060 | 2355 | ||
| 2061 | Returns resulting position, else nil if none found." | 2356 | Returns 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 | |||
| 2114 | Reveal concealed text that would be changed by current command, and | ||
| 2115 | offer user choice to commit or forego the change. Unchanged text is | ||
| 2116 | reconcealed. User has option to have changed text reconcealed. | ||
| 2117 | |||
| 2118 | Undo commands are specially treated - the user is not prompted for | ||
| 2119 | choice, the undoes are always committed (based on presumption that the | ||
| 2120 | things being undone were already subject to this regulation routine), | ||
| 2121 | and undoes always leave the changed stuff exposed. | ||
| 2122 | |||
| 2123 | Changes to concealed regions are ignored while file is being written. | ||
| 2124 | \(This is for the sake of functions that do change the file during | ||
| 2125 | writes, like crypt and zip modes.) | ||
| 2126 | |||
| 2127 | Locally bound in outline buffers to `before-change-functions', which | ||
| 2128 | in Emacs 19 is run before any change to the buffer. | ||
| 2129 | |||
| 2130 | Any functions which set [`this-command' to `undo', or which set] | ||
| 2131 | `allout-override-protect' non-nil (as does, eg, allout-flag-chars) | ||
| 2132 | are 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 | |||
| 2304 | char. When in this mode you can use regular cursor-positioning | 2485 | char. When in this mode you can use regular cursor-positioning |
| 2305 | command/keystrokes to relocate the cursor off of a bullet character to | 2486 | command/keystrokes to relocate the cursor off of a bullet character to |
| 2306 | return to regular interpretation of self-insert characters." | 2487 | return 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 | ||
| 2345 | See `allout-init' for setup instructions." | 2529 | See `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 | ||
| 2354 | Called as part of `allout-post-command-business'." | 2538 | Called 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. | ||
| 2372 | Ie, text following flag C-m \(carriage-return) is hidden until the | ||
| 2373 | next C-j (newline) char. | ||
| 2374 | |||
| 2375 | Returns 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 | ||
| 2414 | The function checks to ensure that the rebinding is done only once." | 2586 | The 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 | ||
| 2615 | actual 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 | ||
| 2632 | New topic is situated after current one, unless optional flag BEFORE | 2846 | New topic is situated after current one, unless optional flag BEFORE |
| 2633 | is non-nil, or unless current line is complete empty (not even | 2847 | is non-nil, or unless current line is complete empty (not even |
| 2634 | whitespace), in which case open is done on current line. | 2848 | whitespace), in which case open is done on current line. |
| 2635 | 2849 | ||
| 2636 | If USE-SIB-BULLET is true, use the bullet of the prior sibling. | 2850 | If USE_RECENT_BULLET is true, offer to use the bullet of the prior sibling. |
| 2637 | 2851 | ||
| 2638 | Nuances: | 2852 | Nuances: |
| 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: | |||
| 2802 | Negative universal arg means to open deeper, but place the new topic | 3046 | Negative universal arg means to open deeper, but place the new topic |
| 2803 | prior to the current one." | 3047 | prior 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. | |||
| 2812 | Negative universal arg means to place the new topic prior to the current | 3056 | Negative universal arg means to place the new topic prior to the current |
| 2813 | one." | 3057 | one." |
| 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 | |||
| 2821 | topic prior to the current one." | 3065 | topic 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 | ||
| 3169 | All args are optional. | ||
| 3170 | |||
| 2925 | If SOLICIT is non-nil, then the choice of bullet is solicited from | 3171 | If SOLICIT is non-nil, then the choice of bullet is solicited from |
| 2926 | user. If it's a character, then that character is offered as the | 3172 | user. If it's a character, then that character is offered as the |
| 2927 | default, otherwise the one suited to the context \(according to | 3173 | default, otherwise the one suited to the context \(according to |
| 2928 | distinction or depth) is offered. If non-nil, then the | 3174 | distinction or depth) is offered. If non-nil, then the |
| 2929 | context-specific bullet is just used. | 3175 | context-specific bullet is just used. |
| 2930 | 3176 | ||
| 2931 | Second arg NEW-DEPTH forces the topic prefix to that depth, regardless | 3177 | Second arg DEPTH forces the topic prefix to that depth, regardless |
| 2932 | of the topic's current depth. | 3178 | of the topic's current depth. |
| 2933 | 3179 | ||
| 2934 | Third arg NUMBER-CONTROL can force the prefix to or away from | 3180 | Third arg NUMBER-CONTROL can force the prefix to or away from |
| 2935 | numbered form. It has effect only if `allout-numbered-bullet' is | 3181 | numbered form. It has effect only if `allout-numbered-bullet' is |
| 2936 | non-nil and soliciting was not explicitly invoked (via first arg). | 3182 | non-nil and soliciting was not explicitly invoked (via first arg). |
| 2937 | Its effect, numbering or denumbering, then depends on the setting | 3183 | Its effect, numbering or denumbering, then depends on the setting |
| 2938 | of the fourth arg, INDEX. | 3184 | of the forth arg, INDEX. |
| 2939 | 3185 | ||
| 2940 | If NUMBER-CONTROL is non-nil and fourth arg INDEX is nil, then the | 3186 | If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the |
| 2941 | prefix of the topic is forced to be non-numbered. Null index and | 3187 | prefix of the topic is forced to be non-numbered. Null index and |
| 2942 | non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and | 3188 | non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and |
| 2943 | non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil | 3189 | non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil |
| 2944 | INDEX is a number, then that number is used for the numbered | 3190 | INDEX is a number, then that number is used for the numbered |
| 2945 | prefix. Non-nil and non-number means that the index for the | 3191 | prefix. Non-nil and non-number means that the index for the |
| 2946 | numbered prefix will be derived by `allout-make-topic-prefix'. | 3192 | numbered prefix will be derived by allout-make-topic-prefix. |
| 2947 | 3193 | ||
| 2948 | Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding | 3194 | Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding |
| 2949 | siblings. | 3195 | siblings. |
| @@ -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 | ||
| 3015 | Descends into invisible as well as visible topics, however. | 3262 | Descends 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 | 3289 | See `allout-rebullet-heading' for rebulleting behavior. |
| 3041 | contained subtopics. See `allout-rebullet-heading' for rebulleting | ||
| 3042 | behavior. | ||
| 3043 | 3290 | ||
| 3044 | Arg RELATIVE-DEPTH means to shift the depth of the entire | 3291 | All arguments are optional. |
| 3045 | topic that amount. | ||
| 3046 | 3292 | ||
| 3047 | \(fn &optional RELATIVE-DEPTH)" | 3293 | First arg RELATIVE-DEPTH means to shift the depth of the entire |
| 3294 | topic that amount. | ||
| 3048 | 3295 | ||
| 3049 | ;; All args except the first one are for internal recursive use by the | 3296 | The rest of the args are for internal recursive use by the function |
| 3050 | ;; function itself. | 3297 | itself. 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 | |||
| 3429 | We disallow shifts that would result in the topic having a depth more than | ||
| 3430 | one level greater than the immediately previous topic, to avoid containment | ||
| 3431 | discontinuity. The first topic in the file can be adjusted to any positive | ||
| 3432 | depth, 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 | |||
| 3456 | We disallow shifts that would result in the topic having a depth more than | ||
| 3457 | one level greater than the immediately previous topic, to avoid containment | ||
| 3458 | discontinuity. The first topic in the file can be adjusted to any positive | ||
| 3459 | depth, 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 | ||
| 3248 | Does depth adjustment of yanked topics, when: | 3556 | Does depth adjustment of yanked topics, when: |
| 3249 | 3557 | ||
| @@ -3259,7 +3567,7 @@ header into which it's being yanked. | |||
| 3259 | 3567 | ||
| 3260 | The point is left in front of yanked, adjusted topics, rather than | 3568 | The point is left in front of yanked, adjusted topics, rather than |
| 3261 | at the end (and vice-versa with the mark). Non-adjusted yanks, | 3569 | at the end (and vice-versa with the mark). Non-adjusted yanks, |
| 3262 | however, are left exactly like normal, not outline specific yanks." | 3570 | however, 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. | ||
| 3777 | Ie, text following flag C-m \(carriage-return) is hidden until the | ||
| 3778 | next C-j (newline) char. | ||
| 3779 | |||
| 3780 | Returns 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 | ||
| 3483 | This is a way to give restricted peek at a concealed locality without the | 3845 | This is a way to give restricted peek at a concealed locality without the |
| 3484 | expense of exposing its context, but can leave the outline with aberrant | 3846 | expense of exposing its context, but can leave the outline with aberrant |
| 3485 | exposure. `allout-hide-current-entry-completely' or `allout-show-to-offshoot' | 3847 | exposure. `allout-hide-current-entry-completely' or `allout-show-offshoot' |
| 3486 | should be used after the peek to rectify the exposure." | 3848 | should 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 | ||
| 4214 | format) instead. | ||
| 4215 | |||
| 4216 | Dictate wholesale exposure scheme for current topic, according to SPEC. | ||
| 3850 | 4217 | ||
| 3851 | SPEC is either a number or a list. Optional successive args | 4218 | SPEC is either a number or a list. Optional successive args |
| 3852 | dictate exposure for subsequent siblings of current topic. | 4219 | dictate 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 | ||
| 3930 | Cursor is left at start position. | 4294 | Cursor is left at start position. |
| 3931 | 4295 | ||
| 4296 | Use this instead of obsolete `allout-exposure'. | ||
| 4297 | |||
| 3932 | Examples: | 4298 | Examples: |
| 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 | ||
| 4160 | Apply FUNC to exposed portions FROM position TO position in buffer | 4531 | All args are options; default values itemized below. |
| 4532 | |||
| 4533 | Apply FUNCTION to exposed portions FROM position TO position in buffer | ||
| 4161 | FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an | 4534 | FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an |
| 4162 | alternate presentation form: | 4535 | alternate presentation form: |
| 4163 | 4536 | ||
| @@ -4170,7 +4543,7 @@ alternate presentation form: | |||
| 4170 | except for distinctive bullets. | 4543 | except for distinctive bullets. |
| 4171 | 4544 | ||
| 4172 | Defaults: | 4545 | Defaults: |
| 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 | ||
| 4222 | or | 4595 | or \`(depth prefix text bullet-plus)' |
| 4223 | |||
| 4224 | \`(depth prefix text bullet-plus)' | ||
| 4225 | 4596 | ||
| 4226 | If `bullet-plus' is specified, it is inserted just after the entire prefix." | 4597 | If `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 | |||
| 4888 | Contents includes body and subtopics. | ||
| 4889 | |||
| 4890 | Currently only GnuPG encryption is supported. | ||
| 4891 | |||
| 4892 | \**NOTE WELL** that the encrypted text must be ascii-armored. For gnupg | ||
| 4893 | encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file. | ||
| 4894 | |||
| 4895 | Both symmetric-key and key-pair encryption is implemented. Symmetric is | ||
| 4896 | the default, use a single \(x4) universal argument for keypair mode. | ||
| 4897 | |||
| 4898 | Encrypted topic's bullet is set to a `~' to signal that the contents of the | ||
| 4899 | topic \(body and subtopics, but not heading) is pending encryption or | ||
| 4900 | encrypted. An `*' asterisk immediately after the bullet signals that the | ||
| 4901 | body 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 | ||
| 4903 | prompted for an ok to \(symmetric-key) encrypt the disclosed topics. NOTE | ||
| 4904 | WELL that you must explicitly \(re)encrypt key-pair encrypted topics if you | ||
| 4905 | want them to continue to be in key-pair mode. | ||
| 4906 | |||
| 4907 | Level-1 topics, with prefix consisting solely of an `*' asterisk, cannot be | ||
| 4908 | encrypted. If you want to encrypt the contents of a top-level topic, use | ||
| 4909 | \\[allout-shift-in] to increase its depth. | ||
| 4910 | |||
| 4911 | Failed transformation does not change the an entry being encrypted - | ||
| 4912 | instead, the key is re-solicited and the transformation is retried. | ||
| 4913 | \\[keyboard-quit] to abort. | ||
| 4914 | |||
| 4915 | Decryption does symmetric or key-pair key mode depending on how the text | ||
| 4916 | was encrypted. The encryption key is solicited if not currently available | ||
| 4917 | from the key cache from a recent prior encryption action. | ||
| 4918 | |||
| 4919 | Optional FETCH-KEY universal argument is used for two purposes - to provoke | ||
| 4920 | key-pair instead of symmetric encryption, or to provoke clearing of the key | ||
| 4921 | cache 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 | |||
| 4933 | The solicited key is retained for reuse in a buffer-specific cache for some | ||
| 4934 | set period of time \(default, 60 seconds), after which the string is | ||
| 4935 | nulled. `mailcrypt' provides the key caching functionality. You can | ||
| 4936 | adjust the key cache timeout by ajdusting the setting of the elisp variable | ||
| 4937 | `mc-passwd-timeout'. | ||
| 4938 | |||
| 4939 | If the file previously had no associated key, or had a different key than | ||
| 4940 | specified, the user is prompted to repeat the new one for corroboration. A | ||
| 4941 | random string encrypted by the new key is set on the buffer-specific | ||
| 4942 | variable `allout-key-verifier-string', for confirmation of the key when | ||
| 4943 | next obtained, before encrypting or decrypting anything with it. This | ||
| 4944 | helps avoid mistakenly shifting between keys. | ||
| 4945 | |||
| 4946 | If allout customization var `allout-key-verifier-handling' is non-nil, an | ||
| 4947 | entry 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 | ||
| 4949 | necessary. That setting is for retention of the key verifier across emacs | ||
| 4950 | sessions. | ||
| 4951 | |||
| 4952 | Similarly, `allout-key-hint-string' stores a user-provided reminder about | ||
| 4953 | their key, and `allout-key-hint-handling' specifies when the hint is | ||
| 4954 | presented, or if key hints are disabled. If enabled \(see the | ||
| 4955 | `allout-key-hint-handling' docstring for details), the hint string is | ||
| 4956 | stored in the local-variables section of the file, and solicited whenever | ||
| 4957 | the 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 | |||
| 5049 | If optional DECRYPT is true (default false), then decrypt instead of | ||
| 5050 | encrypt. | ||
| 5051 | |||
| 5052 | Optional REKEY (default false) provokes clearing of the key cache to force | ||
| 5053 | fresh prompting for the key. | ||
| 5054 | |||
| 5055 | Optional RETRIED is for internal use - conveys the number of failed keys have | ||
| 5056 | been solicited in sequence leading to this current call. | ||
| 5057 | |||
| 5058 | Optional VERIFYING is for internal use, signifying processing of text | ||
| 5059 | solely for verification of the cached key. | ||
| 5060 | |||
| 5061 | Returns 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 | |||
| 5174 | We add key-verification to vanilla mc-activate-passwd. | ||
| 5175 | |||
| 5176 | We depend in some cases on values of the following allout-encrypt-string | ||
| 5177 | internal 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 | |||
| 5282 | TEXT 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 | |||
| 5338 | We also prompt for and situate a new reminder, if reminders are enabled. | ||
| 5339 | |||
| 5340 | We massage the string to simplify programmatic adjustment. File variable | ||
| 5341 | is `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 | |||
| 5366 | Derived 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 | |||
| 5393 | EXCEPT-MARK identifies a point whose containing topics should be excluded | ||
| 5394 | from encryption. This supports 'except-current mode of | ||
| 5395 | `allout-encrypt-unencrypted-on-saves'. | ||
| 5396 | |||
| 5397 | Such a topic has the allout-topic-encryption-bullet without an | ||
| 5398 | immediately following '*' that would mark the topic as being encrypted. It | ||
| 5399 | must 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 | |||
| 5448 | EXCEPT-MARK identifies a point whose containing topics should be excluded | ||
| 5449 | from encryption. This supports 'except-current mode of | ||
| 5450 | `allout-encrypt-unencrypted-on-saves'. | ||
| 5451 | |||
| 5452 | If a topic that is currently being edited was encrypted, we return a list | ||
| 5453 | containing the location of the topic and the location of the cursor just | ||
| 5454 | before the topic was encrypted. This can be used, eg, to decrypt the topic | ||
| 5455 | and exactly resituate the cursor if this is being done as part of a file | ||
| 5456 | save. 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 | |||
| 5527 | Returns 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 | |||
| 5555 | This activity is inhibited if either `enable-local-variables' | ||
| 5556 | `allout-enable-file-variable-adjustment' are nil. | ||
| 5557 | |||
| 5558 | When enabled, an entry for the variable is created if not already present, | ||
| 5559 | or changed if established with a different value. The section for the file | ||
| 5560 | variables, itself, is created if not already present. When created, the | ||
| 5561 | section lines \(including the section line) exist as second-level topics in | ||
| 5562 | a top-level topic at the end of the file. | ||
| 5563 | |||
| 5564 | enable-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)." | |||
| 4594 | Representations of actual backslashes - '\\\\\\\\' - are left as a | 5651 | Representations of actual backslashes - '\\\\\\\\' - are left as a |
| 4595 | single backslash. | 5652 | single backslash. |
| 4596 | 5653 | ||
| 4597 | \(fn REGEXP)" | 5654 | Optional 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. | ||
| 5694 | Unless 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 | ||
| 4643 | XEmacs takes two optional args, while GNU Emacs does not, | 5707 | XEmacs takes two optional args, while mainline GNU Emacs does not, |
| 4644 | so pass them along when appropriate." | 5708 | so 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 | |||
| 247 | that the combined units table will be rebuilt.") | 255 | that 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. |
| 146 | This function assumes that your terminal uses the SO/SI characters; | 146 | This function assumes that your terminal uses the SO/SI characters; |
| 147 | it is meaningless for an X frame." | 147 | it 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. |
| 158 | This function assumes VT100-compatible escapes; it is meaningless for an | 158 | This function assumes VT100-compatible escapes; it is meaningless for an |
| 159 | X frame." | 159 | X 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 | ||
| 121 | There are a number of support modes that may be used to speed up Font Lock mode | 121 | Where major modes support different levels of fontification, you can use |
| 122 | in various ways, specified via the variable `font-lock-support-mode'. Where | 122 | the variable `font-lock-maximum-decoration' to specify which level you |
| 123 | major modes support different levels of fontification, you can use the variable | 123 | generally prefer. When you turn Font Lock mode on/off the buffer is |
| 124 | `font-lock-maximum-decoration' to specify which level you generally prefer. | 124 | fontified/defontified, though fontification occurs only if the buffer is |
| 125 | When you turn Font Lock mode on/off the buffer is fontified/defontified, though | 125 | less than `font-lock-maximum-size'. |
| 126 | fontification occurs only if the buffer is less than `font-lock-maximum-size'. | ||
| 127 | 126 | ||
| 128 | For example, to specify that Font Lock mode uses Lazy Lock mode as a support | 127 | For example, to use maximum levels of fontification, put in your ~/.emacs: |
| 129 | mode 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 | ||
| 134 | To add your own highlighting for some major mode, and modify the highlighting | 131 | To 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 | |||
| 49 | with one argument, a string containing the image data. If PREDICATE returns | 49 | with one argument, a string containing the image data. If PREDICATE returns |
| 50 | a non-nil value, TYPE is the image's type.") | 50 | a 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. | ||
| 63 | When the name of an image file match REGEXP, it is assumed to | ||
| 64 | be 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. |
| 88 | Value is a symbol specifying the image type or nil if type cannot | 103 | Value is a symbol specifying the image type or nil if type cannot |
| 89 | be determined." | 104 | be 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. | ||
| 124 | Value is a symbol specifying the image type or nil if type cannot | ||
| 125 | be 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. |
| 108 | Value is a symbol specifying the image type, or nil if type cannot | 155 | Value is a symbol specifying the image type, or nil if type cannot |
| 109 | be determined." | 156 | be 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. | ||
| 171 | Value is a symbol specifying the image type, or nil if type cannot | ||
| 172 | be 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. | |||
| 135 | Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data. | 199 | Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data. |
| 136 | Optional PROPS are additional image attributes to assign to the image, | 200 | Optional PROPS are additional image attributes to assign to the image, |
| 137 | like, e.g. `:mask MASK'. | 201 | like, e.g. `:mask MASK'. |
| 138 | Value is the image created, or nil if images of type TYPE are not supported." | 202 | Value is the image created, or nil if images of type TYPE are not supported. |
| 203 | |||
| 204 | Images 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 | |||
| 317 | specification to be returned. Return nil if no specification is | 385 | specification to be returned. Return nil if no specification is |
| 318 | satisfied. | 386 | satisfied. |
| 319 | 387 | ||
| 320 | The image is looked for in `image-load-path'." | 388 | The image is looked for in `image-load-path'. |
| 389 | |||
| 390 | Image 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. |
| 57 | FILE can be a file name, or a library name. | ||
| 58 | A 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. |
| 71 | FILE can be a file name, or a library name. | ||
| 72 | A 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. |
| 83 | FILE can be a file name, or a library name. | ||
| 84 | A 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. |
| 101 | This can include FILE itself." | 102 | This can include FILE itself. |
| 103 | FILE can be a file name, or a library name. | ||
| 104 | A 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. |
| 190 | The function `mail-setup' runs this hook." | 191 | The 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, |
| 197 | or t meaning should be initialized from your mail aliases file. | 199 | or 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. |
| 208 | nil means use indentation." | 211 | nil 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. |
| 214 | Used by `mail-yank-original' via `mail-indent-citation'." | 218 | Used 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. |
| 219 | Each hook function can find the citation between (point) and (mark t). | 224 | Each hook function can find the citation between (point) and (mark t). |
| @@ -242,6 +247,7 @@ instead of no action." | |||
| 242 | This enables the hook functions to see the whole message header | 247 | This enables the hook functions to see the whole message header |
| 243 | regardless of what part of it (if any) is included in the cited text.") | 248 | regardless 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. |
| 247 | It should match whatever sort of citation prefixes you want to handle, | 253 | It 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. |
| 306 | It is inserted before you edit the message, | 314 | It 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. |
| 313 | The functions \\[mail-send-on-exit] or \\[mail-dont-send] select | 322 | The 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. |
| 321 | If t, that means do allow it. nil means don't allow it. | 331 | If 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 |
| 2691 | directory listing. This regular expression is designed to recognize dates | 2696 | directory listing. This regular expression is designed to recognize dates |
| 2692 | regardless of the language.") | 2697 | regardless 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. | ||
| 63 | Each 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. | ||
| 73 | If nil, calculate the prefix dynamically to line up text | ||
| 74 | underneath 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. | ||
| 85 | Used 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. | ||
| 95 | Channel buffers are truncated from the top to be no greater than this | ||
| 96 | number. If zero or nil, no truncating is done.") | ||
| 97 | |||
| 98 | (defvar rcirc-authinfo-file-name | ||
| 99 | "~/.rcirc-authinfo" | ||
| 100 | "File containing rcirc authentication passwords. | ||
| 101 | The file consists of a single list, with each element itself a | ||
| 102 | list with a SERVER-REGEXP string, a NICK-REGEXP string, a METHOD | ||
| 103 | and the remaining method specific ARGUMENTS. The valid METHOD | ||
| 104 | symbols are `nickserv', `chanserv' and `bitlbee'. | ||
| 105 | |||
| 106 | The required ARGUMENTS for each METHOD symbol are: | ||
| 107 | `nickserv': PASSWORD | ||
| 108 | `chanserv': CHANNEL PASSWORD | ||
| 109 | `bitlbee': PASSWORD | ||
| 110 | |||
| 111 | Example: | ||
| 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. | ||
| 118 | See also `rcirc-authinfo-file-name'.") | ||
| 119 | |||
| 120 | (defvar rcirc-print-hooks nil | ||
| 121 | "Hook run after text is printed. | ||
| 122 | Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT.") | ||
| 123 | |||
| 124 | (defvar rcirc-prompt "%n> " | ||
| 125 | "Prompt string to use in irc buffers. | ||
| 126 | |||
| 127 | The 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 | |||
| 132 | Setting this alone will not affect the prompt; | ||
| 133 | use `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. | ||
| 168 | If 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 | |||
| 182 | If any of the the optional SERVER, PORT, NICK or CHANNELS are not | ||
| 183 | supplied, they are taken from the variables `rcirc-server', | ||
| 184 | `rcirc-port', `rcirc-nick', and `rcirc-startup-channels', | ||
| 185 | respectively." | ||
| 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 | |||
| 223 | User will identify using the values of NICK, USER-NAME and | ||
| 224 | FULL-NAME. The variable list of channel names in | ||
| 225 | STARTUP-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. | ||
| 288 | Debug text is written to `rcirc-log-buffer' if `rcirc-log-p' is | ||
| 289 | non-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. | ||
| 303 | Functions 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. | ||
| 340 | Function 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. | ||
| 409 | If 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. | ||
| 483 | If 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. | ||
| 617 | If 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. | ||
| 628 | Create the buffer if it doesn't exist. If TARGET is nil, return | ||
| 629 | the 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. | ||
| 773 | Used 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. | ||
| 829 | Format based on SENDER and RESPONSE. If ACTIVITY is non-nil, | ||
| 830 | record 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'. | ||
| 1026 | If 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. | ||
| 1044 | Possible 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. | ||
| 1063 | The function given by `rcirc-switch-to-buffer-function' is used to | ||
| 1064 | show 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 | |||
| 1086 | Functions are called with a single argument, the buffer with the | ||
| 1087 | activity. 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. | ||
| 1211 | If 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. | ||
| 1223 | With 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. | ||
| 1314 | FUNCTION 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. | ||
| 1586 | Passwords 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. |
| 279 | FILE should be the name of a file created with the `etags' program. | 287 | FILE 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." | |||
| 922 | START is the position of <<. | 932 | START is the position of <<. |
| 923 | STRING is the actual word used as delimiter (f.ex. \"EOF\"). | 933 | STRING is the actual word used as delimiter (f.ex. \"EOF\"). |
| 924 | INDENTED is non-nil if the here document's content (and the EOF mark) can | 934 | INDENTED is non-nil if the here document's content (and the EOF mark) can |
| 925 | be indented (i.e. a <<- was used rather than just <<)." | 935 | be indented (i.e. a <<- was used rather than just <<). |
| 936 | Point 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. |
| 143 | Changing this value while Emacs is running is supported, but considered | 148 | Changing this value while Emacs is running is supported, but considered |
| 144 | unwise, unless you know what you are doing.") | 149 | unwise, 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. | |||
| 4576 | With a prefix argument, set VARIABLE to VALUE buffer-locally." | 4576 | With 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. |
| 1020 | The value is normally a string that was passed to `load': | 1020 | The value is an absolute file name. |
| 1021 | either an absolute file name, or a library name | ||
| 1022 | \(with no directory name and no `.el' or `.elc' at the end). | ||
| 1023 | It can also be nil, if the definition is not associated with any file. | 1021 | It can also be nil, if the definition is not associated with any file. |
| 1024 | 1022 | ||
| 1025 | If TYPE is nil, then any kind of definition is acceptable. | 1023 | If 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. |
| 779 | When nil, the entire headline is fontified. | 783 | When nil, the entire headline is fontified. |
| 780 | After changin this, requires restart of Emacs to become effective." | 784 | After 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. | ||
| 1499 | This 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. | ||
| 9448 | The iCalendar file will be located in the same directory as the Org-mode | ||
| 9449 | file, 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. | ||
| 9456 | Each iCalendar file will be located in the same directory as the Org-mode | ||
| 9457 | file, 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. | ||
| 9464 | The 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. | ||
| 9470 | If COMBINE is non-nil, combine all calendar entries into a single large | ||
| 9471 | file 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. | ||
| 9505 | The iCalendar buffer is still current when this hook is run. | ||
| 9506 | A good way to use this is to tell a desktop calenndar application to re-read | ||
| 9507 | the 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'. | ||
| 9511 | When 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 | ||
| 9545 | SUMMARY:%s | ||
| 9546 | END: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 | ||
| 9566 | SUMMARY:%s | ||
| 9567 | SEQUENCE:1 | ||
| 9568 | PRIORITY:%d | ||
| 9569 | END: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 | ||
| 9580 | VERSION:2.0 | ||
| 9581 | X-WR-CALNAME:%s | ||
| 9582 | PRODID:-//%s//Emacs with Org-mode//EN | ||
| 9583 | X-WR-TIMEZONE:Europe/Amsterdam | ||
| 9584 | CALSCALE: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. | ||
| 9592 | KEYWORD is added in front, to make a complete line like DTSTART.... | ||
| 9593 | When INC is non-nil, increase the hour by two (if time string contains | ||
| 9594 | a 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 | ||
| 165 | This function returns either the value of the variable `sentence-end' | 171 | This function returns either the value of the variable `sentence-end' |
| 166 | if it is non-nil, or the default value constructed from the | 172 | if it is non-nil, or the default value constructed from the |
| 167 | variables `sentence-end-double-space', `sentence-end-without-period' | 173 | variables `sentence-end-base', `sentence-end-double-space', |
| 168 | and `sentence-end-without-space'. The default value specifies | 174 | `sentence-end-without-period' and `sentence-end-without-space'. |
| 169 | that in order to be recognized as the end of a sentence, the | 175 | |
| 170 | ending period, question mark, or exclamation point must be | 176 | The default value specifies that in order to be recognized as the |
| 171 | followed by two spaces, unless it's inside some sort of quotes or | 177 | end of a sentence, the ending period, question mark, or exclamation point |
| 172 | parenthesis. See Info node `(elisp)Standard Regexps'." | 178 | must be followed by two spaces, with perhaps some closing delimiters |
| 179 | in 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 @@ | |||
| 1 | 2005-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 | |||
| 1 | 2005-10-15 Richard M. Stallman <rms@gnu.org> | 10 | 2005-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 | ||