diff options
| author | Miles Bader | 2008-01-30 07:57:28 +0000 |
|---|---|---|
| committer | Miles Bader | 2008-01-30 07:57:28 +0000 |
| commit | d235ca2ff8fab139ce797757fcb159d1e28fa7e0 (patch) | |
| tree | 96c5cd1a06a0d9dc26e8470c6eabfc032c0046f3 /lisp | |
| parent | 3709a060f679dba14df71ae64a0035fa2b5b3106 (diff) | |
| parent | 02cbe062bee38a6705bafb1699d77e3c44cfafcf (diff) | |
| download | emacs-d235ca2ff8fab139ce797757fcb159d1e28fa7e0.tar.gz emacs-d235ca2ff8fab139ce797757fcb159d1e28fa7e0.zip | |
Merge from emacs--devo--0
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-324
Diffstat (limited to 'lisp')
189 files changed, 13286 insertions, 5072 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index bb1d32d66bf..d99acacccf2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,7 +1,1291 @@ | |||
| 1 | 2008-01-17 Mark A. Hershberger <mah@everybody.org> | 1 | 2008-01-30 Richard Stallman <rms@gnu.org> |
| 2 | 2 | ||
| 3 | * xml.el (xml-escape-string): Don't do any encoding changes on the | 3 | * progmodes/etags.el (tags-query-replace): Delete unused optional args. |
| 4 | string. | 4 | Doc fix. |
| 5 | |||
| 6 | * files.el (hack-local-variables): Don't query about fake variables. | ||
| 7 | |||
| 8 | 2008-01-30 Markus Triska <markus.triska@gmx.at> | ||
| 9 | |||
| 10 | * linum.el: New file. | ||
| 11 | |||
| 12 | 2008-01-29 Michael Albinus <michael.albinus@gmx.de> | ||
| 13 | |||
| 14 | * net/tramp.el (tramp-methods): Use "-H" option for "sudo". Suggested | ||
| 15 | by Trent W. Buck <trentbuck@gmail.com>. Make ("%h") a single | ||
| 16 | element in "plinkx". | ||
| 17 | (tramp-handle-shell-command): Reuse "*Async Shell Command*" or | ||
| 18 | "*Shell Command Output*" buffers. Check, whether there is already | ||
| 19 | an asynchronous process running. Display always the buffer of the | ||
| 20 | asynchronous process. | ||
| 21 | (tramp-compute-multi-hops): Adapt error message. | ||
| 22 | |||
| 23 | 2008-01-29 Alan Mackenzie <acm@muc.de> | ||
| 24 | |||
| 25 | * progmodes/cc-langs.el (c-specifier-key): Exclude "template" | ||
| 26 | from this regexp; part of same fix as next change to cc-engine.el. | ||
| 27 | |||
| 28 | * progmodes/cc-engine.el (c-guess-basic-syntax, CASE 5A.5): Anchor | ||
| 29 | the "{" of a template function correctly on "template", not the | ||
| 30 | following "<". | ||
| 31 | |||
| 32 | * progmodes/cc-defs.el (c-version): Increase to 5.31.5. | ||
| 33 | |||
| 34 | 2008-01-29 Tassilo Horn <tassilo@member.fsf.org> | ||
| 35 | |||
| 36 | * doc-view.el (doc-view-mode): Adapt to i-m-current-[vh]scroll | ||
| 37 | being an alist now. | ||
| 38 | |||
| 39 | * image-mode.el (image-mode-current-vscroll) | ||
| 40 | (image-mode-current-hscroll): Add doc strings. | ||
| 41 | (image-set-window-vscroll, image-set-window-hscroll) | ||
| 42 | (image-reset-current-vhscroll, image-mode): Adapt to | ||
| 43 | i-m-current-[vh]scroll being an alist now. | ||
| 44 | |||
| 45 | 2008-01-29 Martin Rudalics <rudalics@gmx.at> | ||
| 46 | |||
| 47 | * emacs-lisp/find-func.el (find-function-search-for-symbol): | ||
| 48 | Strip extension from .emacs.el to make sure symbol is searched | ||
| 49 | in .emacs too. | ||
| 50 | |||
| 51 | 2008-01-29 Tassilo Horn <tassilo@member.fsf.org> | ||
| 52 | |||
| 53 | * doc-view.el (doc-view-mode): Use facilities below to | ||
| 54 | restore [vh]scroll when switching buffers. | ||
| 55 | |||
| 56 | * image-mode.el (image-mode-current-vscroll) | ||
| 57 | (image-mode-current-hscroll): New variables. | ||
| 58 | (image-set-window-hscroll, image-set-window-vscroll): New | ||
| 59 | functions. | ||
| 60 | (image-forward-hscroll, image-next-line, image-bol, image-eol) | ||
| 61 | (image-bob, image-eob): Use them. | ||
| 62 | (image-reset-current-vhscroll): New function. | ||
| 63 | (image-mode): Make new variables buffer-local and reset [vh]scroll | ||
| 64 | on window configuration changes. | ||
| 65 | |||
| 66 | 2008-01-27 Nick Roberts <nickrob@snap.net.nz> | ||
| 67 | |||
| 68 | * progmodes/gdb-ui.el (gdb-create-define-alist): Don't call | ||
| 69 | gdb-cpp-define-alist-program if file is nil (currently only | ||
| 70 | " *partial-output-..."). | ||
| 71 | |||
| 72 | 2008-01-27 Richard Stallman <rms@gnu.org> | ||
| 73 | |||
| 74 | * allout.el: Many doc fixes. | ||
| 75 | (allout-encrypt-string): Fix error message. | ||
| 76 | |||
| 77 | 2008-01-26 Eli Zaretskii <eliz@gnu.org> | ||
| 78 | |||
| 79 | * progmodes/etags.el (tags-query-replace): Doc fix. | ||
| 80 | |||
| 81 | 2008-01-25 Juanma Barranquero <lekktu@gmail.com> | ||
| 82 | |||
| 83 | * allout.el (allout-unload-function): New function. | ||
| 84 | |||
| 85 | 2008-01-25 Juanma Barranquero <lekktu@gmail.com> | ||
| 86 | |||
| 87 | * allout.el (allout-prefix-data): Doc fix. | ||
| 88 | (allout-show-current-subtree): Reflow docstring. | ||
| 89 | (allout-use-mode-specific-leader, allout-use-hanging-indents) | ||
| 90 | (produce-allout-mode-map, allout-overlay-interior-modification-handler) | ||
| 91 | (allout-next-heading, allout-previous-heading, allout-rebullet-heading) | ||
| 92 | (allout-rebullet-topic, allout-rebullet-topic-grunt, allout-kill-topic) | ||
| 93 | (allout-copy-topic-as-kill, allout-listify-exposed) | ||
| 94 | (allout-process-exposed, allout-encrypted-key-info) | ||
| 95 | (allout-update-passphrase-mnemonic-aids) | ||
| 96 | (allout-next-topic-pending-encryption) | ||
| 97 | (allout-tests-globally-true): Fix typos in docstrings. | ||
| 98 | |||
| 99 | 2008-01-23 Jason Rumney <jasonr@gnu.org> | ||
| 100 | |||
| 101 | * lpr.el (printer-name): Do not set on MS Windows. | ||
| 102 | |||
| 103 | 2008-01-28 Michael Albinus <michael.albinus@gmx.de> | ||
| 104 | |||
| 105 | * net/tramp.el (tramp-handle-shell-command): Use "/bin/sh -c" for | ||
| 106 | the command. | ||
| 107 | |||
| 108 | 2008-01-28 Vinicius Jose Latorre <viniciusjl@ig.com.br> | ||
| 109 | |||
| 110 | * whitespace.el: Moved to obsolete dir. | ||
| 111 | |||
| 112 | * blank-mode.el: New version 9.2. Replace whitespace funs by aliases | ||
| 113 | in blank-mode. | ||
| 114 | (whitespace-buffer): New fun. | ||
| 115 | (whitespace-region): Alias for whitespace-buffer, because there is no | ||
| 116 | blank-region fun. | ||
| 117 | (whitespace-cleanup): Alias for blank-cleanup. | ||
| 118 | (whitespace-cleanup-region): Alias for blank-cleanup-region. | ||
| 119 | |||
| 120 | 2008-01-27 Juanma Barranquero <lekktu@gmail.com> | ||
| 121 | |||
| 122 | * server.el (server-log-time-function): Doc fix. | ||
| 123 | (server-buffer): Fix typo in docstring. | ||
| 124 | |||
| 125 | 2008-01-27 Martin Rudalics <rudalics@gmx.at> | ||
| 126 | |||
| 127 | * view.el (view-buffer): Explain in doc-string why exit-action | ||
| 128 | should not be set to kill-buffer. | ||
| 129 | |||
| 130 | * arc-mode.el (archive-extract): | ||
| 131 | * tar-mode.el (tar-extract): Use kill-buffer-if-not-modified as | ||
| 132 | exit-action when viewing the buffer. | ||
| 133 | |||
| 134 | 2008-01-27 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 135 | |||
| 136 | * add-log.el (change-log-search-file-name): Work harder to find | ||
| 137 | the correct file name. | ||
| 138 | (change-log-find-file): Fix typo. | ||
| 139 | (change-log-start-entry-re): Move definition earlier. | ||
| 140 | |||
| 141 | 2007-01-27 Jan Nieuwenhuizen <janneke@gnu.org> | ||
| 142 | |||
| 143 | * add-log.el (change-log-search-file-name, change-log-find-file): | ||
| 144 | New function. | ||
| 145 | (change-log-font-lock-keywords): Move file name matching ... | ||
| 146 | (change-log-file-names-re): ... here. New defconst. | ||
| 147 | (change-log-mode-map): New binding C-c C-f to change-log-find-file. | ||
| 148 | |||
| 149 | 2008-01-27 Alan Mackenzie <acm@muc.de> | ||
| 150 | |||
| 151 | * progmodes/cc-awk.el, progmodes/cc-engine.el: Correct typos, | ||
| 152 | enhance comments. | ||
| 153 | |||
| 154 | 2008-01-27 Michael Albinus <michael.albinus@gmx.de> | ||
| 155 | |||
| 156 | * net/tramp.el (tramp-compute-multi-hops): In case of su(do)? | ||
| 157 | methods, the host name must be a local host. | ||
| 158 | |||
| 159 | 2008-01-27 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 160 | |||
| 161 | * vc.el: Add TODO item about not defaulting to RCS. | ||
| 162 | |||
| 163 | * server.el (server-process-filter): Check for non-nil before | ||
| 164 | calling file-directory-p. | ||
| 165 | |||
| 166 | 2008-01-27 Alan Mackenzie <acm@muc.de> | ||
| 167 | |||
| 168 | * progmodes/cc-vars.el (c-hanging-braces-alist): New element for | ||
| 169 | arglist-cont-nonempty. | ||
| 170 | |||
| 171 | * progmodes/cc-cmds.el (c-brace-newlines): Determine the newlines | ||
| 172 | for a brace with syntax arglist-cont-nonempty. | ||
| 173 | |||
| 174 | * progmodes/cc-styles.el (c-style-alist): Add elements for | ||
| 175 | arglist-cont-nonempty into 5 styles (gnu, ellemtel, linux, python, | ||
| 176 | awk). | ||
| 177 | |||
| 178 | 2008-01-27 Thien-Thi Nguyen <ttn@gnuvola.org> | ||
| 179 | |||
| 180 | * button.el (define-button-type): Clarify type of NAME in docstring. | ||
| 181 | |||
| 182 | 2008-01-26 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 183 | |||
| 184 | * server.el (server-buffer): New const. | ||
| 185 | (server-log): New var. | ||
| 186 | (server-log): Use them. | ||
| 187 | (server-process-filter): (Try to) run the continuation in the same cwd | ||
| 188 | as the client's. | ||
| 189 | |||
| 190 | 2008-01-26 Alan Mackenzie <acm@muc.de> | ||
| 191 | |||
| 192 | * progmodes/cc-defs.el (c-save-buffer-state): | ||
| 193 | Bind buffer-file-name and buffer-file-truename to nil, to prevent | ||
| 194 | primitives generating "buffer is read only" messages. | ||
| 195 | |||
| 196 | 2008-01-20 Ulf Jasper <ulf.jasper@web.de> | ||
| 197 | |||
| 198 | * icalendar.el (icalendar-version): Increase to "0.17". | ||
| 199 | (icalendar-import-format): Doc fix. Allow function type. | ||
| 200 | (icalendar--read-element): Doc fix. | ||
| 201 | (icalendar--parse-summary-and-rest): Doc fix. Handle function | ||
| 202 | type icalendar-import-format. Make regexps non-greedy. | ||
| 203 | (icalendar--format-ical-event): Handle function type | ||
| 204 | icalendar-import-format. | ||
| 205 | (icalendar-import-format-sample): New function. | ||
| 206 | |||
| 207 | 2008-01-26 Thien-Thi Nguyen <ttn@gnuvola.org> | ||
| 208 | |||
| 209 | * vc.el (vc-exec-after): For mode-line-process highlighting, if | ||
| 210 | `compile' is not available, fall back to font-lock-warning-face. | ||
| 211 | |||
| 212 | 2008-01-26 Phil Sung <psung@mit.edu> (tiny change) | ||
| 213 | |||
| 214 | * wdired.el (wdired-get-filename): Change `(1+ beg)' to `beg' so | ||
| 215 | that the filename end is found even when the filename is empty. | ||
| 216 | Fixes error and spurious newlines when marking files for deletion. | ||
| 217 | |||
| 218 | 2008-01-26 Martin Rudalics <rudalics@gmx.at> | ||
| 219 | |||
| 220 | * subr.el (find-tag-default): Simplify using exclusively | ||
| 221 | skip-syntax-backward/-forward. | ||
| 222 | |||
| 223 | 2008-01-26 Michael Albinus <michael.albinus@gmx.de> | ||
| 224 | |||
| 225 | * vc.el (vc-directory, vc-update-change-log): Remove check for | ||
| 226 | Tramp. Both functions work for it, though pretty slow | ||
| 227 | (`vc-directory'). Maybe the implementation can be optimized. | ||
| 228 | |||
| 229 | * net/tramp.el (tramp-dissect-file-name): Raise an error when | ||
| 230 | Tramp 2.0 syntax is used. | ||
| 231 | Suggested by Trent W. Buck <trentbuck@gmail.com>. | ||
| 232 | |||
| 233 | 2008-01-26 Eli Zaretskii <eliz@gnu.org> | ||
| 234 | |||
| 235 | * ls-lisp.el (ls-lisp-insert-directory): If -n switch is used, | ||
| 236 | invoke directory-files-and-attributes with last argument `integer' | ||
| 237 | instead of `string'. | ||
| 238 | (insert-directory): Add -n to the list of supported switches | ||
| 239 | mentioned in the doc string. | ||
| 240 | |||
| 241 | 2008-01-26 Vinicius Jose Latorre <viniciusjl@ig.com.br> | ||
| 242 | |||
| 243 | * blank-mode.el: New version 9.1. Handle "long" line tail | ||
| 244 | visualization. Doc fix. | ||
| 245 | (blank-line-length): Rename to blank-line-column. | ||
| 246 | (blank-chars-value-list, blank-toggle-option-alist, blank-help-text): | ||
| 247 | Initialization fix. | ||
| 248 | (blank-replace-spaces-by-tabs): New fun. | ||
| 249 | (blank-cleanup, blank-cleanup-region, blank-color-on): Code fix. | ||
| 250 | |||
| 251 | 2008-01-25 Richard Stallman <rms@gnu.org> | ||
| 252 | |||
| 253 | * subr.el (add-hook): Implement `permanent-local-hook' property. | ||
| 254 | |||
| 255 | * loadhist.el (file-provides, file-requires): Push the filename right. | ||
| 256 | |||
| 257 | 2008-01-25 Martin Rudalics <rudalics@gmx.at> | ||
| 258 | |||
| 259 | * emacs-lisp/find-func.el (find-library): Wrap search for | ||
| 260 | library name in condition-case to avoid reporting a scan-error. | ||
| 261 | |||
| 262 | 2008-01-25 Juanma Barranquero <lekktu@gmail.com> | ||
| 263 | |||
| 264 | * server.el (server-process-filter): Don't force | ||
| 265 | the authentication string to be followed by "\n". | ||
| 266 | |||
| 267 | 2008-01-25 Vinicius Jose Latorre <viniciusjl@ig.com.br> | ||
| 268 | |||
| 269 | * blank-mode.el: New version 9.0. New commands to clean up some blank | ||
| 270 | problems like trailing blanks. New faces and regexp for visualizing | ||
| 271 | the blank problems. Doc fix. | ||
| 272 | (blank-chars, blank-global-modes, blank-chars-value-list) | ||
| 273 | (blank-toggle-option-alist, blank-help-text): Initialization fix. | ||
| 274 | (blank-indentation, blank-empty, blank-space-after-tab): New faces. | ||
| 275 | (blank-indentation, blank-empty, blank-space-after-tab) | ||
| 276 | (blank-indentation-regexp, blank-empty-at-bob-regexp) | ||
| 277 | (blank-empty-at-eob-regexp, blank-space-after-tab-regexp): New options. | ||
| 278 | (blank-cleanup, blank-cleanup-region): New commands. | ||
| 279 | (blank-color-on): Code fix. | ||
| 280 | |||
| 281 | 2008-01-25 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 282 | |||
| 283 | * ibuffer.el (ibuffer-default-sorting-mode): Add option to sort by | ||
| 284 | file name. | ||
| 285 | (ibuffer-mode-map): Add binding to sort by file name. | ||
| 286 | (ibuffer-filename/process-header-map): New variable. | ||
| 287 | (filename-and-process): Add a header that sorts by file name. | ||
| 288 | (ibuffer-mode): Mention sorting by file name. | ||
| 289 | |||
| 290 | * ibuf-ext.el (filename/process): New sorter. | ||
| 291 | |||
| 292 | 2008-01-25 Sven Joachim <svenjoac@gmx.de> | ||
| 293 | |||
| 294 | * view.el (kill-buffer-if-not-modified): Don't pass t to | ||
| 295 | buffer-modified-p. | ||
| 296 | |||
| 297 | 2008-01-24 Michael Albinus <michael.albinus@gmx.de> | ||
| 298 | |||
| 299 | * net/tramp.el (tramp-do-copy-or-rename-file): Flush the cache of | ||
| 300 | the source file in case of `rename'. | ||
| 301 | Reported by Pete Forman <pete.forman@westerngeco.com>. | ||
| 302 | |||
| 303 | 2008-01-24 Ken Manheimer <ken.manheimer@gmail.com> | ||
| 304 | |||
| 305 | * allout.el (allout-keybindings-list): In initial setting, express | ||
| 306 | meta-prefixed allout keys as vectors instead of strings, since the | ||
| 307 | string form is interpreted in some cases as composed key | ||
| 308 | modifiers, eg, accented keys. | ||
| 309 | |||
| 310 | (allout-line-boundary-regexp): Clarify description. | ||
| 311 | |||
| 312 | (set-allout-regexp): Repair the expressions so that the formfeed | ||
| 313 | part is identified as one of the top-level groups, and is | ||
| 314 | included in all the forms, not just the -line-boundary-regexp one. | ||
| 315 | |||
| 316 | (allout-prefix-data): Incorporate information from the various | ||
| 317 | allout regexp's formfeed alternative group, when present. | ||
| 318 | |||
| 319 | (allout-write-file-hook-handler): Rectify mangling of the error | ||
| 320 | handling. It was broken in 2007-12-06T19:56:41Z!deego@gnufans.org, where an `error' | ||
| 321 | condition-case handler was apparently reformatted as if it was a | ||
| 322 | call to the error function. An apparent repair attempt in version | ||
| 323 | 1.101 situated the original body of the error handling code as | ||
| 324 | bogus condition-case handlers. I've returned to just about the | ||
| 325 | working code that was originally there, removing an unnecessary - | ||
| 326 | but benign - enclosing 'progn'. \(Automated or cursory code fixes | ||
| 327 | often aren't.) | ||
| 328 | |||
| 329 | (allout-region-active-p): Fallback to value of mark-active if | ||
| 330 | neither use-region-p nor region-active-p are present, for | ||
| 331 | compatability with current and recent emacs major releases. | ||
| 332 | |||
| 333 | 2008-01-24 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 334 | |||
| 335 | * textmodes/reftex-toc.el (reftex-toc-next, reftex-toc-previous) | ||
| 336 | (reftex-toc-restore-region): | ||
| 337 | * textmodes/reftex-index.el (reftex-index-initialize-phrases-buffer) | ||
| 338 | (reftex-index-phrases-apply-to-region): | ||
| 339 | * textmodes/ispell.el (ispell-word): | ||
| 340 | * progmodes/vhdl-mode.el (vhdl-keep-region-active): | ||
| 341 | * progmodes/pascal.el (pascal-mark-defun): | ||
| 342 | * progmodes/f90.el (f90-mark-subprogram, f90-indent-region) | ||
| 343 | (f90-fill-region): | ||
| 344 | * emulation/tpu-edt.el (tpu-set-mark): | ||
| 345 | * emulation/crisp.el (crisp-region-active): | ||
| 346 | * winner.el (winner-active-region): | ||
| 347 | * ansi-color.el (ansi-color-set-extent-face): Use featurep instead | ||
| 348 | of bound tests in order to resolve conditionals at compile time. | ||
| 349 | |||
| 350 | 2008-01-24 Juanma Barranquero <lekktu@gmail.com> | ||
| 351 | |||
| 352 | * delsel.el (delsel-unload-function): Don't use `remprop'; it is | ||
| 353 | not autoloaded, and we wouldn't want to load CL just to unload | ||
| 354 | delsel.el anyway. Suggested by Martin Rudalics <rudalics@gmx.at>. | ||
| 355 | |||
| 356 | 2008-01-24 Martin Rudalics <rudalics@gmx.at> | ||
| 357 | |||
| 358 | * delsel.el (delete-selection-pre-hook): Avoid clearing out | ||
| 359 | pre-command-hook when text is read-only. | ||
| 360 | |||
| 361 | 2008-01-24 Thien-Thi Nguyen <ttn@gnuvola.org> | ||
| 362 | |||
| 363 | * vc.el (vc-process-filter): Do nothing if buffer not live. | ||
| 364 | (vc-diff-finish): Rename from vc-diff-sentinel. | ||
| 365 | No longer take REV1-NAME and REV2-NAME. | ||
| 366 | Instead, take BUFFER-NAME. Do nothing if buffer not live. | ||
| 367 | Don't do window resize if no window displays buffer. | ||
| 368 | (vc-diff-internal): Use vc-diff-finish. | ||
| 369 | |||
| 370 | * vc.el (vc-next-action): Fix two instances of "free-var file" bug: | ||
| 371 | In both cases, convert single call to one wrapped in dolist. | ||
| 372 | |||
| 373 | 2008-01-24 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 374 | |||
| 375 | * vc.el: Add a TODO item about missing files. | ||
| 376 | (vc-exec-after): Add a tooltip to the new mode-line item. | ||
| 377 | |||
| 378 | 2008-01-24 Glenn Morris <rgm@gnu.org> | ||
| 379 | |||
| 380 | * t-mouse.el (gpm-mouse-start): Declare as a function. | ||
| 381 | |||
| 382 | 2008-01-23 Michael Albinus <michael.albinus@gmx.de> | ||
| 383 | |||
| 384 | * net/tramp.el (tramp-remote-process-environment): Set "LC_ALL=C". | ||
| 385 | (tramp-end-of-output): Add `tramp-rsh-end-of-line' into the regexp. | ||
| 386 | (tramp-find-shell, tramp-open-connection-setup-interactive-shell): | ||
| 387 | Don't send `tramp-rsh-end-of-line' additionally, when setting the | ||
| 388 | prompt. | ||
| 389 | (tramp-wait-for-output): Distinguish different prompt formats. | ||
| 390 | (tramp-get-test-nt-command): Don't check for "\n" in the prompt. | ||
| 391 | (tramp-local-host-p): Check whether temp directory is writable. | ||
| 392 | |||
| 393 | 2008-01-23 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 394 | |||
| 395 | * vc.el: Add TODO items. | ||
| 396 | |||
| 397 | 2008-01-23 Carsten Dominik <dominik@science.uva.nl> | ||
| 398 | |||
| 399 | * replace.el (occur-mode-find-occurrence-hook): New hook that can | ||
| 400 | be used to reveal or highlight the location of a match. | ||
| 401 | (occur-mode-goto-occurrence, occur-mode-goto-occurrence-other-window) | ||
| 402 | (occur-mode-display-occurrence): Run `occur-mode-find-occurrence-hook'. | ||
| 403 | |||
| 404 | 2008-01-23 Martin Rudalics <rudalics@gmx.at> | ||
| 405 | |||
| 406 | * progmodes/hideif.el (hide-ifdef-shadow): Add version number | ||
| 407 | for defcustom. | ||
| 408 | (hide-ifdef-shadow): Add version number for defface. | ||
| 409 | |||
| 410 | 2008-01-23 Glenn Morris <rgm@gnu.org> | ||
| 411 | |||
| 412 | * textmodes/org.el (org-export-latex-cleaned-string): Fix declaration. | ||
| 413 | |||
| 414 | 2008-01-23 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 415 | |||
| 416 | * progmodes/sh-script.el (sh-basic-offset): | ||
| 417 | * progmodes/cc-vars.el (c-syntactic-indentation) | ||
| 418 | (c-syntactic-indentation-in-macros): Mark as safe. | ||
| 419 | |||
| 420 | 2008-01-23 Richard Stallman <rms@gnu.org> | ||
| 421 | |||
| 422 | * icomplete.el (icomplete-get-keys): | ||
| 423 | Look up KEYS using all maps in proper buffer. | ||
| 424 | |||
| 425 | 2008-01-23 Juanma Barranquero <lekktu@gmail.com> | ||
| 426 | |||
| 427 | * frame.el (display-mm-height, display-mm-width): | ||
| 428 | * whitespace.el (whitespace-check-leading-whitespace) | ||
| 429 | (whitespace-check-trailing-whitespace) | ||
| 430 | (whitespace-check-spacetab-whitespace) | ||
| 431 | (whitespace-check-indent-whitespace) | ||
| 432 | (whitespace-check-ateol-whitespace): | ||
| 433 | * progmodes/ada-xref.el (ada-convert-file-name): Fix typo in docstring. | ||
| 434 | |||
| 435 | 2008-01-23 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 436 | |||
| 437 | * vc-arch.el (vc-arch-delete-rej-if-obsolete): Remove the | ||
| 438 | after-save-hook so that it is not called multiple times. | ||
| 439 | |||
| 440 | * vc-svn.el (vc-svn-resolve-when-done): Likewise. | ||
| 441 | |||
| 442 | 2008-01-23 Eli Zaretskii <eliz@gnu.org> | ||
| 443 | |||
| 444 | * view.el (view-file-other-window, view-file-other-frame): | ||
| 445 | Don't kill the buffer if it is modified. Doc fixes. | ||
| 446 | (kill-buffer-if-not-modified): New function. | ||
| 447 | (view-file): Don't kill the buffer if it is modified. | ||
| 448 | |||
| 449 | * progmodes/ebrowse.el (ebrowse-view-file-other-window): Delete. | ||
| 450 | (ebrowse-view/find-file-and-search-pattern): | ||
| 451 | Call view-file-other-window instead of ebrowse-view-file-other-window. | ||
| 452 | (ebrowse-view-file-other-frame): Don't call | ||
| 453 | current-window-configuration. Fix second argument in the call to | ||
| 454 | view-mode-enter. Doc fix. | ||
| 455 | |||
| 456 | 2008-01-23 Richard Stallman <rms@gnu.org> | ||
| 457 | |||
| 458 | * subr.el (atomic-change-group): Prevent undo list truncation. | ||
| 459 | |||
| 460 | 2008-01-23 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 461 | |||
| 462 | * files.el (safe-local-eval-forms): | ||
| 463 | Mark (add-hook 'write-file-hooks 'time-stamp) as safe. | ||
| 464 | |||
| 465 | 2008-01-23 Nick Roberts <nickrob@snap.net.nz> | ||
| 466 | |||
| 467 | * comint.el (comint-insert-input): Set point first. | ||
| 468 | |||
| 469 | * progmodes/gdb-ui.el (gdb-dequeue-input): Make doubly sure | ||
| 470 | session doesn't hang because gdb-pending-triggers is non-nil. | ||
| 471 | (gdb-frame-handler): Use buffer-file-name instead of | ||
| 472 | buffer-name in case of duplicate file names. | ||
| 473 | |||
| 474 | 2008-01-23 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 475 | |||
| 476 | * progmodes/verilog-mode.el (verilog-mode-map): Don't bind C-M-a, | ||
| 477 | C-M-e and C-M-h for emacs, they work by default. | ||
| 478 | (verilog-emacs-features): Remove. | ||
| 479 | (verilog-setup-dual-comments, verilog-populate-syntax-table): | ||
| 480 | Remove. Move syntax table initialization ... | ||
| 481 | (verilog-mode-syntax-table): ... here. | ||
| 482 | (verilog-mode): Don't initialize the syntax table here. | ||
| 483 | (verilog-mark-defun): Only do something useful for XEmacs, Emacs | ||
| 484 | does not need it. | ||
| 485 | |||
| 486 | 2008-01-23 Wilson Snyder <wsnyder@wsnyder.org> | ||
| 487 | |||
| 488 | * progmodes/verilog-mode.el (verilog-booleanp): New function for | ||
| 489 | backward compatibility. Replace all uses of booleanp with | ||
| 490 | verilog-booleanp. | ||
| 491 | |||
| 492 | 2008-01-23 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 493 | |||
| 494 | * vc-hg.el (vc-hg-diff): Don't pass an empty string. | ||
| 495 | |||
| 496 | 2008-01-23 Wilson Snyder <wsnyder@wsnyder.org> | ||
| 497 | |||
| 498 | * progmodes/verilog-mode.el (top-level): Fix spacing. | ||
| 499 | (verilog-mode-version, verilog-mode-release-date): | ||
| 500 | Update version number. | ||
| 501 | (verilog-mode-release-emacs): New variable. | ||
| 502 | (compile-command, reporter-prompt-for-summary-p): | ||
| 503 | Define for byte compiler. | ||
| 504 | (verilog-startup-message-lines, verilog-startup-message-displayed) | ||
| 505 | (verilog-display-startup-message): Remove. | ||
| 506 | (verilog-highlight-p1800-keywords): Improve docstring. | ||
| 507 | (sigs-in, sigs-out, got-sig, got-rvalue, uses-delayed) | ||
| 508 | (vector-skip-list): Only defvar at compile time. | ||
| 509 | (verilog-highlight-translate-off, verilog-indent-level) | ||
| 510 | (verilog-indent-level-module, verilog-indent-level-declaration) | ||
| 511 | (verilog-indent-declaration-macros, verilog-indent-lists) | ||
| 512 | (verilog-indent-level-behavioral, verilog-indent-level-directive) | ||
| 513 | (verilog-cexp-indent, verilog-case-indent, verilog-auto-newline) | ||
| 514 | (verilog-auto-indent-on-newline, verilog-tab-always-indent) | ||
| 515 | (verilog-tab-to-comment, verilog-indent-begin-after-if) | ||
| 516 | (verilog-align-ifelse, verilog-minimum-comment-distance) | ||
| 517 | (verilog-auto-lineup, verilog-highlight-p1800-keywords) | ||
| 518 | (verilog-auto-endcomments, verilog-auto-read-includes) | ||
| 519 | (verilog-auto-star-expand, verilog-auto-star-save) | ||
| 520 | (verilog-library-flags, verilog-library-directories) | ||
| 521 | (verilog-library-files, verilog-library-extensions) | ||
| 522 | (verilog-active-low-regexp, verilog-auto-sense-include-inputs) | ||
| 523 | (verilog-auto-sense-defines-constant, verilog-auto-reset-widths) | ||
| 524 | (verilog-assignment-delay, verilog-auto-inst-vector) | ||
| 525 | (verilog-auto-inst-template-numbers, verilog-auto-input-ignore-regexp) | ||
| 526 | (verilog-auto-inout-ignore-regexp, verilog-auto-output-ignore-regexp) | ||
| 527 | (verilog-auto-unused-ignore-regexp, verilog-typedef-regexp): | ||
| 528 | Add safe-local-variable properties. | ||
| 529 | (verilog-statement-menu, verilog-company, verilog-re-search-forward) | ||
| 530 | (verilog-re-search-backward, verilog-error-regexp-add) | ||
| 531 | (verilog-end-block-re, verilog-emacs-features) | ||
| 532 | (verilog-populate-syntax-table, verilog-setup-dual-comments) | ||
| 533 | (verilog-type-font-keywords, verilog-inside-comment-p) | ||
| 534 | (electric-verilog-backward-sexp, verilog-backward-sexp) | ||
| 535 | (verilog-forward-sexp, verilog-font-lock-init, verilog-mode) | ||
| 536 | (electric-verilog-terminate-line, electric-verilog-semi) | ||
| 537 | (electric-verilog-tab, verilog-insert-1, verilog-insert-indices) | ||
| 538 | (verilog-generate-numbers, verilog-comment-region, verilog-label-be) | ||
| 539 | (verilog-beg-of-statement, verilog-in-case-region-p) | ||
| 540 | (verilog-in-struct-region-p, verilog-in-generate-region-p) | ||
| 541 | (verilog-in-fork-region-p, verilog-backward-case-item) | ||
| 542 | (verilog-set-auto-endcomments, verilog-get-expr) | ||
| 543 | (verilog-expand-vector-internal, verilog-surelint-off) | ||
| 544 | (verilog-batch-execute-func, verilog-calculate-indent) | ||
| 545 | (verilog-calc-1, verilog-calculate-indent-directive) | ||
| 546 | (verilog-leap-to-head, verilog-continued-line) | ||
| 547 | (verilog-backward-token, verilog-backward-syntactic-ws) | ||
| 548 | (verilog-forward-syntactic-ws, verilog-backward-ws&directives) | ||
| 549 | (verilog-forward-ws&directives, verilog-at-constraint-p) | ||
| 550 | (verilog-skip-backward-comments, verilog-indent-line-relative) | ||
| 551 | (verilog-do-indent, verilog-indent-comment, verilog-more-comment) | ||
| 552 | (verilog-pretty-declarations, verilog-pretty-expr) | ||
| 553 | (verilog-just-one-space, verilog-indent-declaration) | ||
| 554 | (verilog-get-completion-decl, verilog-goto-defun, verilog-showscopes) | ||
| 555 | (verilog-header, verilog-signals-combine-bus, verilog-read-decls) | ||
| 556 | (verilog-read-always-signals-recurse, verilog-read-instants) | ||
| 557 | (verilog-read-auto-template, verilog-set-define) | ||
| 558 | (verilog-read-defines, verilog-read-signals, verilog-getopt) | ||
| 559 | (verilog-is-number, verilog-expand-dirnames, verilog-modi-lookup) | ||
| 560 | (verilog-modi-cache-results, verilog-insert-one-definition) | ||
| 561 | (verilog-make-width-expression, verilog-delete-autos-lined) | ||
| 562 | (verilog-auto-save-check, verilog-auto-arg, verilog-auto-inst-port) | ||
| 563 | (verilog-auto-inst, verilog-auto-inst-param, verilog-auto-reg) | ||
| 564 | (verilog-auto-reg-input, verilog-auto-wire, verilog-auto-output) | ||
| 565 | (verilog-auto-output-every, verilog-auto-input, verilog-auto-inout) | ||
| 566 | (verilog-auto-inout-module, verilog-auto-sense, verilog-auto-reset) | ||
| 567 | (verilog-auto-tieoff, verilog-auto-unused, verilog-auto-ascii-enum) | ||
| 568 | (verilog-auto, verilog-sk-define-signal, verilog-mode-mouse-map) | ||
| 569 | (verilog-load-file-at-mouse, verilog-load-file-at-point) | ||
| 570 | (verilog-library-files): Cleanup spacing of )'s they should not be | ||
| 571 | on unique lines. Fix checkdoc warnings. | ||
| 572 | |||
| 573 | 2008-01-22 Glenn Morris <rgm@gnu.org> | ||
| 574 | |||
| 575 | * progmodes/hideif.el (hide-ifdef-initially, hide-ifdef-read-only) | ||
| 576 | (hide-ifdef-lines, hide-ifdef-shadow): Remove autoload cookies | ||
| 577 | from defcustoms. | ||
| 578 | (hide-ifdef-shadow): Remove autoload cookie from defface. | ||
| 579 | |||
| 580 | * vc.el (vc-diff-sentinel): Do not write a footer if there were | ||
| 581 | differences. | ||
| 582 | |||
| 583 | 2008-01-21 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 584 | |||
| 585 | * pcvs-defs.el (cvs-menu): Improve cvs-mode-find-file, | ||
| 586 | cvs-mode-find-file-other-window. Add cvs-mode-diff-yesterday and | ||
| 587 | manual entry. | ||
| 588 | |||
| 589 | 2008-01-21 Michael Albinus <michael.albinus@gmx.de> | ||
| 590 | |||
| 591 | * net/dbus.el (dbus-ignore-errors): New macro. | ||
| 592 | (dbus-unregister-object): New defun. Moved from dbusbind.c. | ||
| 593 | (dbus-handle-event, dbus-list-activatable-names, dbus-list-names) | ||
| 594 | (dbus-list-queued-owners, dbus-get-name-owner, dbus-introspect) | ||
| 595 | (dbus-get-signatures): Apply `dbus-ignore-errors'. | ||
| 596 | |||
| 597 | 2008-01-21 Martin Rudalics <rudalics@gmx.at> | ||
| 598 | |||
| 599 | * outline.el (outline-up-heading): Fix check for top level to | ||
| 600 | avoid infinite looping in hide-other. | ||
| 601 | |||
| 602 | 2008-01-21 Thien-Thi Nguyen <ttn@gnuvola.org> | ||
| 603 | |||
| 604 | * vc.el (vc-process-sentinel): After calling the previous | ||
| 605 | sentinel, do nothing if the process' buffer is not live. | ||
| 606 | |||
| 607 | 2008-01-21 Vinicius Jose Latorre <viniciusjl@ig.com.br> | ||
| 608 | |||
| 609 | * blank-mode.el: Fix a problem of cleaning blank faces when turning off | ||
| 610 | blank-mode in some buffers (like *info* buffers). Reported by Juanma | ||
| 611 | Barranquero <lekktu@gmail.com>. Eliminate `-face' suffix of all | ||
| 612 | blank-mode faces. Doc fix. New version 8.1. | ||
| 613 | (blank-turn-on, blank-turn-off): Replace (and CONDITION BODY) by (when | ||
| 614 | CONDITION BODY). | ||
| 615 | (blank-space-face): Face/option name replaced by blank-space. | ||
| 616 | (blank-hspace-face): Face/option name replaced by blank-hspace. | ||
| 617 | (blank-tab-face): Face/option name replaced by blank-tab. | ||
| 618 | (blank-newline-face): Face/option name replaced by blank-newline. | ||
| 619 | (blank-trailing-face): Face/option name replaced by blank-trailing. | ||
| 620 | (blank-line-face): Face/option name replaced by blank-line. | ||
| 621 | (blank-space-before-tab-face): Face/option name replaced by | ||
| 622 | blank-space-before-tab. | ||
| 623 | (blank-color-on, blank-color-off, blank-display-char-on): Fix code. | ||
| 624 | |||
| 625 | 2008-01-21 Juanma Barranquero <lekktu@gmail.com> | ||
| 626 | |||
| 627 | * blank-mode.el (blank-style, blank-chars, blank-hspace-regexp) | ||
| 628 | (blank-space-regexp, blank-tab-regexp, blank-trailing-regexp) | ||
| 629 | (blank-space-before-tab-regexp, blank-global-modes, blank-mode) | ||
| 630 | (global-blank-mode): Doc fixes. | ||
| 631 | (blank, blank-space-face, blank-hspace-face, blank-tab-face) | ||
| 632 | (blank-newline-face, blank-trailing-face, blank-line-face) | ||
| 633 | (blank-space-before-tab-face, blank-display-mappings) | ||
| 634 | (blank-chars-value-list, blank-style-value-list, blank-toggle-options) | ||
| 635 | (global-blank-toggle-options, blank-help-text, blank-interactive-char) | ||
| 636 | (blank-turn-on, blank-turn-off, blank-color-on, blank-color-off): | ||
| 637 | Fix typos in docstrings. | ||
| 638 | |||
| 639 | 2008-01-21 Juanma Barranquero <lekktu@gmail.com> | ||
| 640 | |||
| 641 | * server.el (server-log-time-function): New variable. | ||
| 642 | (server-log): Use it. | ||
| 643 | |||
| 644 | 2008-01-21 Glenn Morris <rgm@gnu.org> | ||
| 645 | |||
| 646 | * progmodes/hideif.el: Move defcustoms and defface to start of file. | ||
| 647 | |||
| 648 | * textmodes/org.el (org-entry-properties): Let-bind `clocksum'. | ||
| 649 | |||
| 650 | 2008-01-21 Juanma Barranquero <lekktu@gmail.com> | ||
| 651 | |||
| 652 | * textmodes/org.el (org-unmodified, org-cycle-emulate-tab) | ||
| 653 | (org-descriptive-links, org-link-file-path-type) | ||
| 654 | (org-remember-use-refile-when-interactive) | ||
| 655 | (org-agenda-skip-timestamp-if-done, org-agenda-scheduled-leaders) | ||
| 656 | (org-export-ascii-bullets, org-agenda-deadline-faces) | ||
| 657 | (turn-on-orgstruct++, orgtbl-to-texinfo, org-mhe-get-header) | ||
| 658 | (org-batch-agenda, org-batch-agenda-csv, org-fix-agenda-info) | ||
| 659 | (org-kill-note-or-show-branches): Fix typos in docstrings. | ||
| 660 | |||
| 661 | 2008-01-20 Thien-Thi Nguyen <ttn@gnuvola.org> | ||
| 662 | |||
| 663 | * vc.el (vc-process-sentinel): Set mode-line-process. | ||
| 664 | (vc-exec-after): Likewise, for the `run' process status. | ||
| 665 | |||
| 666 | 2008-01-20 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 667 | |||
| 668 | * ibuffer.el (ibuffer-mode): Fix last change. | ||
| 669 | |||
| 670 | 2008-01-20 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 671 | |||
| 672 | * vc-hg.el (vc-hg-registered): | ||
| 673 | * vc-svn.el (vc-svn-registered): Make it work for non-existent files. | ||
| 674 | |||
| 675 | 2008-01-20 Martin Rudalics <rudalics@gmx.at> | ||
| 676 | |||
| 677 | * repeat.el (repeat-undo-count): New variable. | ||
| 678 | (repeat): For self-insertions make undo boundary only after 20 | ||
| 679 | repetitions. Inhibit point recording unless repeat-repeat-char is nil. | ||
| 680 | |||
| 681 | 2008-01-19 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 682 | |||
| 683 | * net/imap.el (imap-ping-server): New variable. | ||
| 684 | (imap-opened): On add extra ping if imap-ping-server is non-nil. | ||
| 685 | (imap-ping-server): Minor doc string fixes. | ||
| 686 | |||
| 687 | 2008-01-19 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change) | ||
| 688 | |||
| 689 | * net/imap.el (imap-ping-server): New function. | ||
| 690 | (imap-opened): Call imap-ping-server. | ||
| 691 | |||
| 692 | 2008-01-20 Glenn Morris <rgm@gnu.org> | ||
| 693 | |||
| 694 | * progmodes/python.el: Quote all calls to "auxiliary skeleton"s to | ||
| 695 | prevent infloops. | ||
| 696 | |||
| 697 | 2008-01-20 Martin Svenson <phromo@gmail.com> (tiny change) | ||
| 698 | |||
| 699 | * progmodes/python.el (python-imports): Default to "None". | ||
| 700 | |||
| 701 | 2008-01-19 Tom Tromey <tromey@redhat.com> | ||
| 702 | |||
| 703 | * vc-svn.el (vc-svn-after-dir-status): New function. | ||
| 704 | (vc-svn-dir-status): Run svn asynchronously. | ||
| 705 | |||
| 706 | 2008-01-19 Martin Rudalics <rudalics@gmx.at> | ||
| 707 | |||
| 708 | * progmodes/hideif.el (hide-ifdef-shadow): New option. | ||
| 709 | (hide-ifdef-shadow): New face. | ||
| 710 | (hide-ifdef-toggle-shadowing): New function to toggle between | ||
| 711 | shadowing and making code invisible. | ||
| 712 | (hide-ifdef-mode-submap): Add binding for hide-ifdef-toggle-shadowing. | ||
| 713 | (hide-ifdef-mode-menu): Add entry for hide-ifdef-toggle-shadowing. | ||
| 714 | (hide-ifdef-region-internal): Give new overlay hide-ifdef | ||
| 715 | property. Shadow text when hide-ifdef-shadow is non-nil. | ||
| 716 | (hif-show-ifdef-region): Remove overlays with hide-ifdef property set. | ||
| 717 | (hif-hide-line): Use when instead of if. | ||
| 718 | (hide-ifdef-initially, hide-ifdef-read-only, hide-ifdef-lines): | ||
| 719 | Remove unneeded * from doc-strings. | ||
| 720 | |||
| 721 | 2008-01-19 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 722 | |||
| 723 | * doc-view.el (doc-view-goto-page): Don't move point any more, now that | ||
| 724 | the hscroll behavior was fixed. | ||
| 725 | (doc-view-mode): Disable auto-hscroll-mode. | ||
| 726 | |||
| 727 | 2008-01-18 Tom Tromey <tromey@redhat.com> | ||
| 728 | |||
| 729 | * vc-svn.el (vc-svn-dir-status): New function. | ||
| 730 | |||
| 731 | 2008-01-18 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 732 | |||
| 733 | * vc.el: Make vc-status asynchronous. | ||
| 734 | (vc-update-vc-status-buffer): New function broken out of ... | ||
| 735 | (vc-status-refresh): ... here. Pass vc-update-vc-status-buffer to | ||
| 736 | the dir-status backend function. | ||
| 737 | |||
| 738 | * vc-hg.el (vc-hg-dir-status): Compute the status asynchronously. | ||
| 739 | Move the output processing to ... | ||
| 740 | (vc-hg-after-dir-status): ... here. Call the function passed as | ||
| 741 | an argument with the results. | ||
| 742 | |||
| 743 | 2008-01-18 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 744 | |||
| 745 | * doc-view.el (doc-view-pdf/ps->png): Make sure we a have a valid cwd. | ||
| 746 | (doc-view-insert-image): Do something if the image is missing. | ||
| 747 | (doc-view-mode): Don't use file-remote-p. | ||
| 748 | |||
| 749 | 2008-01-18 Bastien Guerry <Bastien.Guerry@ens.fr> | ||
| 750 | |||
| 751 | * textmodes/org-export-latex.el (org-export-latex-cleaned-string): Fix. | ||
| 752 | (org-export-latex-special-chars): Convert "..." in \ldots | ||
| 753 | and skip tables. | ||
| 754 | (org-export-latex-fontify-headline): Change parameter name. | ||
| 755 | (org-export-as-latex): Handle export of subtrees. | ||
| 756 | (org-export-latex-make-header): New argument TITLE. | ||
| 757 | (org-export-latex-content): New argument EXCLUDE-LIST. | ||
| 758 | (org-list-parse-list): New name for org-export-latex-parse-list. | ||
| 759 | (org-export-latex-make-header): New name for | ||
| 760 | org-export-latex-make-preamble. | ||
| 761 | (org-list-to-generic): New name of org-export-list-to-generic. | ||
| 762 | (org-list-to-latex): New name of org-export-list-to-latex. | ||
| 763 | (org-list-item-begin, org-list-end, org-list-insert-radio-list) | ||
| 764 | (org-list-send-list, org-list-to-texinfo) | ||
| 765 | (org-list-to-html): New functions. | ||
| 766 | (org-export-latex-tables-column-borders) | ||
| 767 | (org-export-latex-default-class, org-export-latex-classes) | ||
| 768 | (org-export-latex-classes-sectioning) | ||
| 769 | (org-list-radio-list-templates): New options. | ||
| 770 | (org-export-latex-header): New variable. | ||
| 771 | (org-latex-entities): New constant. | ||
| 772 | (org-export-latex-default-sectioning, org-export-latex-preamble) | ||
| 773 | (org-export-latex-prepare-text-option) | ||
| 774 | (org-export-latex-get-sectioning): Remove. | ||
| 775 | |||
| 776 | 2008-01-18 Carsten Dominik <dominik@science.uva.nl> | ||
| 777 | |||
| 778 | * textmodes/org-publish.el (org-publish-current-project): | ||
| 779 | Fix bug with forcing publication. | ||
| 780 | |||
| 781 | * textmodes/org.el (org-export-with-special-strings): New option. | ||
| 782 | (org-export-html-convert-special-strings): New function. | ||
| 783 | (org-html-do-expand): `org-export-html-convert-special-strings' | ||
| 784 | added to the list of conversion. | ||
| 785 | (org-infile-export-plist, org-get-current-options): Add support | ||
| 786 | for "-" in the #+OPTION line to let user switch on/off special | ||
| 787 | strings conversion. | ||
| 788 | (org-export-plist-vars): New :html-table-tag property. | ||
| 789 | (org-export-as-html, org-format-org-table-html) | ||
| 790 | (org-format-table-table-html) Use the :html-table-tag property | ||
| 791 | instead of the `org-export-html-table-tag' global value. | ||
| 792 | (org-additional-option-like-keywords): Add "TBLFM". | ||
| 793 | (org-entry-properties): Include the CLOCKSUM special property. | ||
| 794 | (org-columns-edit-value): Do not allow to edit the special | ||
| 795 | CLOCKSUM property. | ||
| 796 | (org-flag-drawer): Use the original value of `outline-regexp'. | ||
| 797 | (org-remember-handler): Add invisible-ok flag to call to | ||
| 798 | `org-end-of-subtree'. | ||
| 799 | (org-agenda-highlight-todo): Respect | ||
| 800 | `org-agenda-todo-keyword-format'. | ||
| 801 | (org-agenda-todo-keyword-format): New option. | ||
| 802 | (org-infile-export-plist): No restriction while searching for options. | ||
| 803 | (org-remember-handler): Remove comments at the end of the buffer. | ||
| 804 | (org-remember-use-refile-when-interactive): New option. | ||
| 805 | (org-table-sort-lines): Make sure sorting works on link | ||
| 806 | descritions only, and ignores the link. | ||
| 807 | (org-sort-entries-or-items): Make sure the end of the subtree is | ||
| 808 | included. | ||
| 809 | (org-refile-use-outline-path): New allowed values `file' and | ||
| 810 | `full-file-path'. | ||
| 811 | (org-get-refile-targets): Respect new values for | ||
| 812 | `org-refile-use-outline-path'. | ||
| 813 | (org-agenda-get-restriction-and-command): DEL goes back to initial list. | ||
| 814 | (org-export-as-xoxo): Restore point when done. | ||
| 815 | (org-open-file): Allow multiple %s in command. | ||
| 816 | (org-clock-in-switch-to-state): New option. | ||
| 817 | (org-first-list-item-p): New function. | ||
| 818 | (org-last-remember-storage-locations): New variable. | ||
| 819 | (org-get-refile-targets): Interpret the new maxlevel setting. | ||
| 820 | (org-refile-targets): New option `:maxlevel'. | ||
| 821 | (org-copy-subtree): Include empty lines before but not after subtree. | ||
| 822 | (org-back-over-empty-lines, org-skip-whitespace): New functions. | ||
| 823 | (org-move-item-down, org-move-item-up): Include empty lines before | ||
| 824 | but not after item. | ||
| 825 | (org-first-sibling-p): New function. | ||
| 826 | (org-remember-apply-template): Defaults, completions and history | ||
| 827 | for template prompts. Also, interpret new `%!' escape. | ||
| 828 | (org-context-choices): New constant. | ||
| 829 | (org-bound-and-true-p): New macro. | ||
| 830 | (org-imenu-depth): New option. | ||
| 831 | (org-imenu-markers): New variable. | ||
| 832 | (org-imenu-new-marker, org-imenu-get-tree) | ||
| 833 | (org-speedbar-set-agenda-restriction): New functions. | ||
| 834 | (org-agenda-set-restriction-lock) | ||
| 835 | (org-agenda-remove-restriction-lock) | ||
| 836 | (org-agenda-maybe-redo): New functions. | ||
| 837 | (org-agenda-restriction-lock): New face. | ||
| 838 | (org-agenda-restriction-lock-overlay) | ||
| 839 | (org-speedbar-restriction-lock-overlay): New variables. | ||
| 840 | (org-open-at-point): Remove obsolete way to do redirection in | ||
| 841 | shell links. | ||
| 842 | (org-imenu-and-speedbar): New customization group. | ||
| 843 | (org-entry-properties): Return keyword-less time strings. | ||
| 844 | (org-clock-heading-function): New option. | ||
| 845 | (org-clock-in): Use `org-clock-heading-function'. | ||
| 846 | (org-calendar-holiday): Try to use `calendar-check-holidays' | ||
| 847 | instead of the obsolete `check-calendar-holidays'. | ||
| 848 | (org-export-html-special-string-regexps): New constant. | ||
| 849 | (org-massive-special-regexp): New variable. | ||
| 850 | (org-compute-latex-and-specials-regexp) | ||
| 851 | (org-do-latex-and-special-faces): New functions. | ||
| 852 | (org-latex-and-export-specials): New face. | ||
| 853 | (org-highlight-latex-fragments-and-specials): New option. | ||
| 854 | (org-link-escape-chars): Use characters instead of strings. | ||
| 855 | (org-link-escape-chars-browser, org-link-escape) | ||
| 856 | (org-link-unescape): Use characters instead of strings. | ||
| 857 | (org-export-html-convert-sub-super, org-html-do-expand): Check for | ||
| 858 | protected text. | ||
| 859 | (org-emphasis-alist): Additional `verbatim' flag. | ||
| 860 | (org-set-emph-re): Handle the verbatim flag and compute | ||
| 861 | `org-verbatim-re'. | ||
| 862 | (org-cleaned-string-for-export): Protect verbatim elements. | ||
| 863 | (org-verbatim-re): New variable. | ||
| 864 | (org-hide-emphasis-markers): New option. | ||
| 865 | (org-additional-option-like-keywords): Add new keywords. | ||
| 866 | (org-get-entry): Rename from `org-get-cleaned-entry'. | ||
| 867 | (org-icalendar-cleanup-string): New function for quoting icalendar text. | ||
| 868 | (org-agenda-skip-scheduled-if-done): New option. | ||
| 869 | (org-agenda-get-scheduled, org-agenda-get-blocks): Use | ||
| 870 | `org-agenda-skip-scheduled-if-done'. | ||
| 871 | (org-prepare-agenda-buffers): Allow buffers as arguments. | ||
| 872 | (org-entry-properties): Add CATEGORY as a special property. | ||
| 873 | (org-use-property-inheritance): Allow a list of properties as a value. | ||
| 874 | (org-eval-in-calendar): No longer update the prompt. | ||
| 875 | (org-read-date-popup-calendar): Rename from | ||
| 876 | `org-popup-calendar-for-date-prompt'. | ||
| 877 | (org-read-date-display-live): New variable. | ||
| 878 | (org-read-date-display): New function. | ||
| 879 | (org-read-date-analyze): New function. | ||
| 880 | (org-remember-apply-template): Define `remember-finalize' if it is | ||
| 881 | not yet defined. | ||
| 882 | (org-remember-insinuate): New function. | ||
| 883 | (org-read-date-prefer-future): New option. | ||
| 884 | (org-read-date): Respect the setting of | ||
| 885 | `org-read-date-prefer-future'. Use `org-read-date-analyze'. | ||
| 886 | (org-set-font-lock-defaults): Use `org-archive-tag' instead of a | ||
| 887 | hardcoded string. | ||
| 888 | (org-remember-apply-template): Use `remember-finalize' instead of | ||
| 889 | `remember-buffer'. | ||
| 890 | (org-columns-compute, org-column-number-to-string) | ||
| 891 | (org-columns-uncompile-format, org-columns-compile-format) | ||
| 892 | (org-columns-compile-format): Handle printf format specifier. | ||
| 893 | (org-columns-new, org-column-number-to-string) | ||
| 894 | (org-columns-uncompile-format, org-columns-compile-format): | ||
| 895 | Support for new currency summary type. | ||
| 896 | (org-tree-to-indirect-buffer): Do not kill old buffer when | ||
| 897 | `org-indirect-buffer-display' is `new-frame'. | ||
| 898 | (org-indirect-buffer-display): Document that `new-frame' leads to | ||
| 899 | indiret buffer proliferation. | ||
| 900 | (org-agenda-list): Use `org-extend-today-until'. | ||
| 901 | (org-extend-today-until): New option. | ||
| 902 | (org-format-org-table-html): Use lower-case for <col> tag. | ||
| 903 | (org-agenda-execute): New command. | ||
| 904 | (org-agenda-mode-map): Keybindings of "g" "G", "e" modified. | ||
| 905 | (org-select-remember-template): New function. | ||
| 906 | (org-remember-apply-template): Use `org-select-remember-template'. | ||
| 907 | (org-go-to-remember-target): New function. | ||
| 908 | |||
| 909 | 2008-01-18 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 910 | |||
| 911 | * vc.el: Add a TODO note about vc-state. | ||
| 912 | (vc-next-action): Register 'unregistered and 'ignored files. | ||
| 913 | Use when and unless instead of if where appropriate. | ||
| 914 | (vc-start-entry): Fix typo. | ||
| 915 | (vc-status): Autoload it. | ||
| 916 | |||
| 917 | 2008-01-18 Glenn Morris <rgm@gnu.org> | ||
| 918 | |||
| 919 | * ffap.el (ffap-alist): Remove space from RFC regexp. | ||
| 920 | |||
| 921 | 2008-01-18 Richard Stallman <rms@gnu.org> | ||
| 922 | |||
| 923 | * custom.el (custom-theme-recalc-face): Use face-spec-set rather | ||
| 924 | than face-spec-recalc. | ||
| 925 | |||
| 926 | 2008-01-18 Glenn Morris <rgm@gnu.org> | ||
| 927 | |||
| 928 | * ibuffer.el (ibuffer-mode): Fix typo in previous change. | ||
| 929 | |||
| 930 | 2008-01-17 Vinicius Jose Latorre <viniciusjl@ig.com.br> | ||
| 931 | Miles Bader <miles@gnu.org> | ||
| 932 | |||
| 933 | * blank-mode.el: New file. Minor mode to visualise (HARD) SPACE, | ||
| 934 | TAB, NEWLINE. Miles Bader <miles@gnu.org> wrote the original code | ||
| 935 | for handling display table (via visws.el package), his code was | ||
| 936 | modified, but the main idea was kept. | ||
| 937 | |||
| 938 | 2008-01-17 Glenn Morris <rgm@gnu.org> | ||
| 939 | |||
| 940 | * ibuf-ext.el (ibuffer-auto-mode, ibuffer-save-filter-groups) | ||
| 941 | (ibuffer-save-filters): Remove calls to deleted | ||
| 942 | ibuffer-update-mode-name. | ||
| 943 | |||
| 944 | 2008-01-16 Martin Rudalics <rudalics@gmx.at> | ||
| 945 | |||
| 946 | * longlines.el (longlines-mode, longlines-show-region) | ||
| 947 | (longlines-unshow-hard-newlines): Bind buffer-file-name and | ||
| 948 | buffer-file-truename to nil while modifying buffer. | ||
| 949 | |||
| 950 | * cus-edit.el (custom-reset-standard-variables-list) | ||
| 951 | (custom-reset-standard-faces-list): New variables. | ||
| 952 | (custom-reset-standard-save-and-update): New function. | ||
| 953 | (Custom-save): Apply custom-mark-to-save before and | ||
| 954 | custom-state-set-and-redraw after saving options. | ||
| 955 | (Custom-reset-standard): Apply custom-mark-to-reset-standard to | ||
| 956 | options and call custom-reset-standard-save-and-update. | ||
| 957 | (custom-variable, custom-face, custom-group): Provide new | ||
| 958 | entries for custom-mark-to-save, custom-mark-to-reset-standard, | ||
| 959 | and custom-state-set-and-redraw. | ||
| 960 | (custom-variable-mark-to-save) | ||
| 961 | (custom-variable-state-set-and-redraw) | ||
| 962 | (custom-variable-mark-to-reset-standard) | ||
| 963 | (custom-face-mark-to-save, custom-face-state-set-and-redraw) | ||
| 964 | (custom-face-mark-to-reset-standard) | ||
| 965 | (custom-group-mark-to-save, custom-group-state-set-and-redraw) | ||
| 966 | (custom-group-mark-to-reset-standard): New functions. | ||
| 967 | (custom-variable-save): Move save, state-set, and redraw | ||
| 968 | functionality to custom-variable-mark-to-save. | ||
| 969 | (custom-face-save): Move save, state-set, and redraw | ||
| 970 | functionality to custom-face-mark-to-save. | ||
| 971 | (custom-group-save): Move save, state-set, and redraw | ||
| 972 | functionality to custom-group-mark-to-save. | ||
| 973 | (custom-variable-reset-standard, custom-face-reset-standard) | ||
| 974 | (custom-group-reset-standard): Move save, state-set, and redraw | ||
| 975 | functionality to custom-reset-standard-save-and-update. | ||
| 976 | |||
| 977 | (custom-buffer-create-internal): Fix text in verbose help. | ||
| 978 | (custom-face-value-create): Indent doc-strings of faces like | ||
| 979 | those of variables. | ||
| 980 | |||
| 981 | 2008-01-16 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 982 | |||
| 983 | * server.el (server-process-filter): Replace lineno and columnnno | ||
| 984 | which defaulted to 1&0 with filepos which defaults to nil. | ||
| 985 | (server-goto-line-column): Only receive the filepos. | ||
| 986 | Only move if filepos is non-nil. | ||
| 987 | (server-visit-files): Slight restructure to consolidate two calls to | ||
| 988 | server-goto-line-column into just one. | ||
| 989 | |||
| 990 | * nxml/nxml-mode.el (nxml-mode): Use mode-line-process to indicate | ||
| 991 | the use of degraded mode. | ||
| 992 | (nxml-degrade): Don't change mode-name. | ||
| 993 | |||
| 994 | * nxml/rng-nxml.el (rng-nxml-mode-init): | ||
| 995 | Don't overwrite mode-line-process. | ||
| 996 | |||
| 997 | * ibuffer.el (mode): Pass the buffer to format-mode-line. | ||
| 998 | (ibuffer-update-mode-name): Remove. | ||
| 999 | (ibuffer-redisplay, ibuffer-update, ibuffer-mode): Don't call it. | ||
| 1000 | (ibuffer-mode): Use mode-line-process instead. | ||
| 1001 | |||
| 1002 | * ibuf-ext.el (ibuffer-auto-update-changed, ibuffer-auto-mode): | ||
| 1003 | Use derived-mode-p. | ||
| 1004 | (ibuffer-mark-by-mode-regexp): Pass the buffer to format-mode-line. | ||
| 1005 | |||
| 1006 | * help.el (describe-mode): Pass the right buffer to format-mode-line. | ||
| 1007 | |||
| 1008 | 2008-01-16 Glenn Morris <rgm@gnu.org> | ||
| 1009 | |||
| 1010 | * comint.el (comint-regexp-arg): Fix no-input case. | ||
| 1011 | |||
| 1012 | 2008-01-16 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 1013 | |||
| 1014 | * smerge-mode.el (smerge-start-session): Rename from smerge-auto. | ||
| 1015 | * pcvs.el (cvs-revert-if-needed): | ||
| 1016 | * vc.el (vc-maybe-resolve-conflicts): Rename callers. | ||
| 1017 | |||
| 1018 | * vc-svn.el (vc-svn-find-file-hook): | ||
| 1019 | * vc-arch.el (vc-arch-find-file-hook): Undo previous change. | ||
| 1020 | |||
| 1021 | 2008-01-16 Ulf Jasper <ulf.jasper@web.de> | ||
| 1022 | |||
| 1023 | * calendar/icalendar.el (icalendar-version): Increase to 0.16. | ||
| 1024 | (icalendar-export-file, icalendar-import-file): | ||
| 1025 | Restore significant trailing whitespace in `interactive' prompts. | ||
| 1026 | |||
| 1027 | 2008-01-16 Tom Tromey <tromey@redhat.com> | ||
| 1028 | |||
| 1029 | * calendar/icalendar.el (icalendar--convert-tz-offset) | ||
| 1030 | (icalendar--parse-vtimezone, icalendar--convert-all-timezones) | ||
| 1031 | (icalendar--find-time-zone): New functions. | ||
| 1032 | (icalendar--decode-isodatetime): Add `zone' argument, passed to | ||
| 1033 | `decode-time'. Doc fix. | ||
| 1034 | (icalendar--convert-ical-to-diary): Compute zone-map. | ||
| 1035 | Pass timezone to icalendar--decode-isodatetime. | ||
| 1036 | |||
| 1037 | 2008-01-16 Alan Mackenzie <acm@muc.de> | ||
| 1038 | |||
| 1039 | * progmodes/cc-vars.el (c-constant-symbol): Put this defun inside | ||
| 1040 | an eval-and-compile, so as to permit byte-compiling (e.g. in | ||
| 1041 | bootstrap). | ||
| 1042 | |||
| 1043 | 2008-01-15 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 1044 | |||
| 1045 | * emacs-lisp/easymenu.el (easy-menu-avoid-duplicate-keys): New var. | ||
| 1046 | (easy-menu-create-menu, easy-menu-convert-item-1): Use it to avoid | ||
| 1047 | using the same key for different menu entries. | ||
| 1048 | |||
| 1049 | * smerge-mode.el (smerge-refine): Also work on "same change conflicts". | ||
| 1050 | (smerge-makeup-conflict): New command. | ||
| 1051 | |||
| 1052 | 2008-01-15 Thien-Thi Nguyen <ttn@gnuvola.org> | ||
| 1053 | |||
| 1054 | * log-edit.el (log-edit): Doc fix. | ||
| 1055 | |||
| 1056 | 2008-01-15 Glenn Morris <rgm@gnu.org> | ||
| 1057 | |||
| 1058 | * diff-mode.el (diff-end-of-hunk): Revert 2008-01-08 change. | ||
| 1059 | |||
| 1060 | 2008-01-14 Alan Mackenzie <acm@muc.de> | ||
| 1061 | |||
| 1062 | * progmodes/cc-vars.el (c-constant-symbol): New function which | ||
| 1063 | supersedes c-const-symbol. During a customize-.. call it enables | ||
| 1064 | an element of (e.g.) c-hanging-braces alist to have its name | ||
| 1065 | displayed, even when the default value of c-h-b etc. doesn't | ||
| 1066 | include the elemnt. Replace uses of the old function by the new. | ||
| 1067 | |||
| 1068 | * progmodes/cc-vars.el (c-hanging-braces-alist): Remove the | ||
| 1069 | obscure non-working fragment ":value c-". | ||
| 1070 | |||
| 1071 | 2008-01-14 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 1072 | |||
| 1073 | * abbrev.el (clear-abbrev-table): Can't pass a symbol to intern. | ||
| 1074 | |||
| 1075 | 2008-01-14 Michael Albinus <michael.albinus@gmx.de> | ||
| 1076 | |||
| 1077 | * net/tramp.el (tramp-local-host-p): Use `tramp-file-name-host' | ||
| 1078 | instead of `tramp-file-name-real-host'. | ||
| 1079 | |||
| 1080 | * net/trampver.el: Update release number. | ||
| 1081 | |||
| 1082 | 2008-01-14 Alan Mackenzie <acm@muc.de> | ||
| 1083 | |||
| 1084 | * progmodes/cc-engine.el (c-guess-basic-syntax): Prevent a macro | ||
| 1085 | call inside a struct being recognised as a K&R argument. | ||
| 1086 | |||
| 1087 | 2008-01-14 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 1088 | |||
| 1089 | * progmodes/compile.el (compilation-error-regexp-alist-alist): | ||
| 1090 | Accept "fatal error" from MSFT. | ||
| 1091 | Reported by Jared Finder <jfinder@crypticstudios.com>. | ||
| 1092 | |||
| 1093 | 2008-01-14 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 1094 | |||
| 1095 | * smerge-mode.el (smerge-auto): New function. | ||
| 1096 | * vc-svn.el (vc-svn-find-file-hook): | ||
| 1097 | * vc-arch.el (vc-arch-find-file-hook): | ||
| 1098 | * pcvs.el (cvs-revert-if-needed): | ||
| 1099 | * vc.el (vc-maybe-resolve-conflicts): Use it instead of vc-mode. | ||
| 1100 | (top-level): Add a Todo list. | ||
| 1101 | |||
| 1102 | 2008-01-13 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 1103 | |||
| 1104 | * vc.el (vc-update): Resolve conflicts if necessary instead of | ||
| 1105 | just updating the buffer. | ||
| 1106 | |||
| 1107 | * vc-cvs.el (vc-cvs-merge-news): Ignore the error status of the | ||
| 1108 | update command so that we can parse the output. | ||
| 1109 | |||
| 1110 | 2008-01-13 Martin Rudalics <rudalics@gmx.at> | ||
| 1111 | |||
| 1112 | * mail/rmail.el (rmail-convert-to-babyl-format): | ||
| 1113 | Remove save-excursion to avoid infinite looping. | ||
| 1114 | Reported by: dnz <dnz@bk.ru>. | ||
| 1115 | |||
| 1116 | 2008-01-12 Glenn Morris <rgm@gnu.org> | ||
| 1117 | |||
| 1118 | * woman.el (woman-parse-numeric-arg): Change handling of `==': | ||
| 1119 | can be interned without a function definition. | ||
| 1120 | |||
| 1121 | 2008-01-12 Jason Rumney <jasonr@gnu.org> | ||
| 1122 | |||
| 1123 | * nxml/nxml-mode.el (nxml-enable-unicode-char-name-sets) | ||
| 1124 | (rng-nxml-mode-init): Declare. | ||
| 1125 | |||
| 1126 | 2008-01-11 Jason Rumney <jasonr@gnu.org> | ||
| 1127 | |||
| 1128 | * nxml/rng-nxml.el (rng-preferred-prefix-alist): Add some defaults. | ||
| 1129 | (rng-preferred-prefix-alist-default): Remove. | ||
| 1130 | |||
| 1131 | * nxml/nxml-uchnm.el (nxml-internal-unicode-char-name-sets-enabled): | ||
| 1132 | Rename from nxml-enable-unicode-char-name-sets-flag. | ||
| 1133 | (nxml-enable-unicode-char-name-sets-1): Merge into | ||
| 1134 | nxml-enable-unicode-char-name-sets. | ||
| 1135 | (nxml-enable-unicode-char-name-sets): Don't unconditionally set | ||
| 1136 | nxml-char-name-ignore-case here. | ||
| 1137 | |||
| 1138 | * nxml/nxml-mode.el (nxml-mode): Call rng-nxml-mode-init directly. | ||
| 1139 | Update doc string and commentary. | ||
| 1140 | (nxml-char-name-ignore-case): Change default value. | ||
| 1141 | (nxml-mode): Call nxml-enable-unicode-char-name-sets directly. | ||
| 1142 | |||
| 1143 | 2008-01-11 Martin Rudalics <rudalics@gmx.at> | ||
| 1144 | |||
| 1145 | * cus-start.el (all): Add missing version entries. | ||
| 1146 | |||
| 1147 | 2008-01-11 Glenn Morris <rgm@gnu.org> | ||
| 1148 | |||
| 1149 | * language/china-util.el (big5-to-flat-code, flat-code-to-big5) | ||
| 1150 | (euc-to-flat-code, flat-code-to-euc): | ||
| 1151 | * textmodes/org.el (elmo-msgdb-overview-get-entity) | ||
| 1152 | (wl-summary-buffer-msgdb): Declare as funtions. | ||
| 1153 | |||
| 1154 | 2008-01-10 Martin Rudalics <rudalics@gmx.at> | ||
| 1155 | |||
| 1156 | * progmodes/ada-mode.el (ada-set-syntax-table-properties): | ||
| 1157 | Bind buffer-file-name and buffer-file-truename. | ||
| 1158 | |||
| 1159 | * fringe.el (fringe-mode-explicit): New variable. | ||
| 1160 | (set-fringe-mode): Don't alter default-frame-alist when just | ||
| 1161 | loading this file. | ||
| 1162 | |||
| 1163 | 2008-01-10 Tassilo Horn <tassilo@member.fsf.org> | ||
| 1164 | |||
| 1165 | * doc-view.el (doc-view-buffer-file-name): New variable. | ||
| 1166 | (doc-view-convert-current-doc, doc-view-search) | ||
| 1167 | (doc-view-current-cache-dir, doc-view-initiate-display) | ||
| 1168 | (doc-view-mode): Use it. | ||
| 1169 | (doc-view-bookmark-make-cell): Use variable buffer-file-name | ||
| 1170 | instead of function. | ||
| 1171 | |||
| 1172 | 2008-01-10 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 1173 | |||
| 1174 | * vc-svn.el (vc-svn-registered): Return the correct value for | ||
| 1175 | ignored and unregistered files. | ||
| 1176 | |||
| 1177 | 2008-01-10 Tassilo Horn <tassilo@member.fsf.org> | ||
| 1178 | |||
| 1179 | * doc-view.el (tramp): Require tramp because we use tramp-tramp-file-p. | ||
| 1180 | |||
| 1181 | 2008-01-10 Tom Tromey <tromey@redhat.com> | ||
| 1182 | |||
| 1183 | * vc.el (vc-status-unmark-all-files): New function. | ||
| 1184 | (vc-status-unmark-all-files): Likewise. | ||
| 1185 | (vc-status-mode-map): Add bindings. | ||
| 1186 | |||
| 1187 | 2008-01-10 Michael Kifer <kifer@cs.stonybrook.edu> | ||
| 1188 | |||
| 1189 | * ediff*.el: Uncomment declare-function. | ||
| 1190 | |||
| 1191 | * viper*.el: Uncomment declare-function. | ||
| 1192 | |||
| 1193 | 2008-01-09 Tassilo Horn <tassilo@member.fsf.org> | ||
| 1194 | |||
| 1195 | * doc-view.el (doc-view-mode): Support tramp, compressed files and | ||
| 1196 | files inside archives uniformly. | ||
| 1197 | |||
| 1198 | 2008-01-09 Eric S. Raymond <esr@snark.thyrsus.com> | ||
| 1199 | |||
| 1200 | * testmodes/sgml-mode.el (sgml-tag-syntax-table): Initialize this | ||
| 1201 | constant with a computation on sgml-specials rather than a literal | ||
| 1202 | list. Without this change the syntax table is generated | ||
| 1203 | incorrectly, and the mode will think it's in a comment following | ||
| 1204 | any instance of the string "--". | ||
| 1205 | |||
| 1206 | 2008-01-09 Tassilo Horn <tassilo@member.fsf.org> | ||
| 1207 | |||
| 1208 | * doc-view.el (doc-view-mode-p): Add EPS as supported type. | ||
| 1209 | (doc-view-mode): Support document files inside archives. | ||
| 1210 | |||
| 1211 | 2008-01-09 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 1212 | |||
| 1213 | * vc.el (vc-deduce-fileset): Return the currently selected file if | ||
| 1214 | no files are selected when using vc-status. | ||
| 1215 | |||
| 1216 | 2008-01-09 Michael Kifer <kifer@cs.stonybrook.edu> | ||
| 1217 | |||
| 1218 | * ediff*.el: Comment out declare-function. "make bootstrap" | ||
| 1219 | stops with an error and Emacs does not compile with those things in. | ||
| 1220 | Besides, declare-function is not defined in XEmacs. | ||
| 1221 | |||
| 1222 | * ediff-util (eqiff-quit): Autoraise minibuffer. | ||
| 1223 | |||
| 1224 | * ediff-diff (ediff-convert-fine-diffs-to-overlays): Make it a defun. | ||
| 1225 | |||
| 1226 | * viper*.el: Comment out declare-function -- not defined in XEmacs. | ||
| 1227 | |||
| 1228 | * viper-ex.el (viper-info-on-file): Take care of indirect buffers. | ||
| 1229 | |||
| 1230 | * viper.el (viper-set-hooks, set-cursor-color): | ||
| 1231 | Set viper-vi-state-cursor-color. | ||
| 1232 | |||
| 1233 | 2008-01-09 Tom Tromey <tromey@redhat.com> | ||
| 1234 | |||
| 1235 | * vc.el (vc-status-headers): Rename from vc-status-insert-headers. | ||
| 1236 | Just return header. | ||
| 1237 | (vc-status-move-to-goal-column): New function. | ||
| 1238 | (vc-status-mode-map): Define more keys. | ||
| 1239 | (vc-status-mode): Use vc-status-refresh. Now 'special. | ||
| 1240 | (vc-status-refresh): New function. | ||
| 1241 | (vc-status-next-line): Likewise. | ||
| 1242 | (vc-status-previous-line): Likewise. | ||
| 1243 | (vc-status-mark-file): Use vc-status-next-line. | ||
| 1244 | (vc-status-unmark-file): Use vc-status-previous-line. | ||
| 1245 | (vc-status-unmark-file-up): New function. | ||
| 1246 | (vc-status-register): Likewise. | ||
| 1247 | (vc-status-find-file): Likewise. | ||
| 1248 | (vc-status-find-file-other-window): Likewise. | ||
| 1249 | (vc-status-current-file): Likewise. | ||
| 1250 | (vc-ensure-vc-buffer): Understand vc-status mode. | ||
| 1251 | |||
| 1252 | * vc-hg.el (vc-hg-dir-status): Don't pass -A to "hg status". | ||
| 1253 | |||
| 1254 | 2008-01-09 Glenn Morris <rgm@gnu.org> | ||
| 1255 | |||
| 1256 | * ffap.el (ffap-string-at-point-mode-alist): Add `\' to file | ||
| 1257 | entry, for Windows. | ||
| 1258 | |||
| 1259 | 2008-01-09 Tom Tromey <tromey@redhat.com> | ||
| 1260 | |||
| 1261 | * play/blackbox.el (blackbox-mode-map): Add `q' and [return] bindings. | ||
| 1262 | |||
| 1263 | 2008-01-09 Vinicius Jose Latorre <viniciusjl@ig.com.br> | ||
| 1264 | |||
| 1265 | * ps-print.el: Some face attributes (like :strike-through) were not | ||
| 1266 | being recognised. Reported by Leo <sdl.web@gmail.com>. | ||
| 1267 | (ps-print-version): New version 6.8.2. | ||
| 1268 | (ps-face-strikout-p, ps-face-overline-p, ps-face-box-p): New funs. | ||
| 1269 | (ps-screen-to-bit-face): Fix code. | ||
| 1270 | |||
| 1271 | 2008-01-09 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 1272 | |||
| 1273 | * ffap.el (ffap-read-file-or-url): Don't use let-binding to temporarily | ||
| 1274 | add a file-name handler. | ||
| 1275 | |||
| 1276 | 2008-01-08 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> | ||
| 1277 | |||
| 1278 | * textmodes/bibtex.el (bibtex-initialize): New autoloaded command. | ||
| 1279 | Rename from function bibtex-files-expand. New optional arg select. | ||
| 1280 | (bibtex-flash-head): Allow blink-matching-delay being zero. | ||
| 1281 | (bibtex-clean-entry): Use atomic-change-group. | ||
| 1282 | (bibtex-format-entry): Check presence of required fields only | ||
| 1283 | after formatting of fields. Use member-ignore-case. Do not use | ||
| 1284 | bibtex-parse-entry. Do not use booktitle field to set a missing title. | ||
| 1285 | (bibtex-autofill-entry): Do not call undo-boundary. | ||
| 1286 | (bibtex-lessp): Handle crossref keys that point to another bibtex file. | ||
| 1287 | (bibtex-sort-buffer, bibtex-prepare-new-entry, bibtex-validate): | ||
| 1288 | Parse keys if necessary. | ||
| 5 | 1289 | ||
| 6 | 2008-01-08 Nick Roberts <nickrob@snap.net.nz> | 1290 | 2008-01-08 Nick Roberts <nickrob@snap.net.nz> |
| 7 | 1291 | ||
| @@ -10,8 +1294,8 @@ | |||
| 10 | 1294 | ||
| 11 | 2008-01-08 Nick Roberts <nickrob@snap.net.nz> | 1295 | 2008-01-08 Nick Roberts <nickrob@snap.net.nz> |
| 12 | 1296 | ||
| 13 | * progmodes/gdb-ui.el (gud-gdb-command-name): Explain | 1297 | * progmodes/gdb-ui.el (gud-gdb-command-name): |
| 14 | "--annotate=3" option is necessary for the Graphical Interface. | 1298 | Explain "--annotate=3" option is necessary for the Graphical Interface. |
| 15 | 1299 | ||
| 16 | 2008-01-08 Nick Roberts <nickrob@snap.net.nz> | 1300 | 2008-01-08 Nick Roberts <nickrob@snap.net.nz> |
| 17 | 1301 | ||
| @@ -79,10 +1363,8 @@ | |||
| 79 | 1363 | ||
| 80 | * time-stamp.el (time-stamp-time-zone): | 1364 | * time-stamp.el (time-stamp-time-zone): |
| 81 | * whitespace.el (whitespace-check-buffer-leading) | 1365 | * whitespace.el (whitespace-check-buffer-leading) |
| 82 | (whitespace-check-buffer-trailing) | 1366 | (whitespace-check-buffer-trailing, whitespace-check-buffer-indent) |
| 83 | (whitespace-check-buffer-indent) | 1367 | (whitespace-check-buffer-spacetab, whitespace-check-buffer-ateol): |
| 84 | (whitespace-check-buffer-spacetab) | ||
| 85 | (whitespace-check-buffer-ateol): | ||
| 86 | * progmodes/sh-script.el (sh-indentation): | 1368 | * progmodes/sh-script.el (sh-indentation): |
| 87 | * textmodes/ispell.el (ispell-local-pdict): | 1369 | * textmodes/ispell.el (ispell-local-pdict): |
| 88 | Add safe-local-variable properties. | 1370 | Add safe-local-variable properties. |
| @@ -212,8 +1494,7 @@ | |||
| 212 | * vc-arch.el (vc-arch-root): Only set a property if the file is | 1494 | * vc-arch.el (vc-arch-root): Only set a property if the file is |
| 213 | managed by this backend. | 1495 | managed by this backend. |
| 214 | 1496 | ||
| 215 | * vc-hg.el (vc-hg-state): Support the new status code for | 1497 | * vc-hg.el (vc-hg-state): Support the new status code for up-to-date. |
| 216 | up-to-date. | ||
| 217 | 1498 | ||
| 218 | 2008-01-04 Tassilo Horn <tassilo@member.fsf.org> | 1499 | 2008-01-04 Tassilo Horn <tassilo@member.fsf.org> |
| 219 | 1500 | ||
| @@ -223,8 +1504,8 @@ | |||
| 223 | 1504 | ||
| 224 | * doc-view.el (doc-view-scroll-up-or-next-page) | 1505 | * doc-view.el (doc-view-scroll-up-or-next-page) |
| 225 | (doc-view-scroll-down-or-previous-page): Use image-scroll-up and | 1506 | (doc-view-scroll-down-or-previous-page): Use image-scroll-up and |
| 226 | image-scroll-down instead of the non-image equivalents. Don't | 1507 | image-scroll-down instead of the non-image equivalents. |
| 227 | rely on a signalled condition but switch pages when scrolling | 1508 | Don't rely on a signalled condition but switch pages when scrolling |
| 228 | doesn't change the vertical position anymore. | 1509 | doesn't change the vertical position anymore. |
| 229 | (doc-view-mode-map): Remap scroll-{up,down} to | 1510 | (doc-view-mode-map): Remap scroll-{up,down} to |
| 230 | image-scroll-{up,down}. | 1511 | image-scroll-{up,down}. |
| @@ -242,7 +1523,8 @@ | |||
| 242 | * bs.el (bs--sort-by-mode, bs--get-mode-name): | 1523 | * bs.el (bs--sort-by-mode, bs--get-mode-name): |
| 243 | * imenu.el (imenu-add-to-menubar): | 1524 | * imenu.el (imenu-add-to-menubar): |
| 244 | * makesum.el (make-command-summary): | 1525 | * makesum.el (make-command-summary): |
| 245 | * mouse.el (mouse-major-mode-menu, mouse-popup-menubar, mouse-buffer-menu): | 1526 | * mouse.el (mouse-major-mode-menu, mouse-popup-menubar) |
| 1527 | (mouse-buffer-menu): | ||
| 246 | * msb.el (msb--mode-menu-cond): | 1528 | * msb.el (msb--mode-menu-cond): |
| 247 | * calc/calc-embed.el (calc-do-embedded): | 1529 | * calc/calc-embed.el (calc-do-embedded): |
| 248 | * emacs-lisp/helper.el (Helper-describe-mode): | 1530 | * emacs-lisp/helper.el (Helper-describe-mode): |
| @@ -257,7 +1539,8 @@ | |||
| 257 | * progmodes/ada-xref.el (ada-prj-find-prj-file): | 1539 | * progmodes/ada-xref.el (ada-prj-find-prj-file): |
| 258 | * progmodes/ada-mode.el (comment-region): | 1540 | * progmodes/ada-mode.el (comment-region): |
| 259 | * calendar/todo-mode.el (todo-insert-item): | 1541 | * calendar/todo-mode.el (todo-insert-item): |
| 260 | * bookmark.el (bookmark-buffer-name): Test major-mode rather than mode-name. | 1542 | * bookmark.el (bookmark-buffer-name): |
| 1543 | Test major-mode rather than mode-name. | ||
| 261 | 1544 | ||
| 262 | 2008-01-04 Richard Stallman <rms@gnu.org> | 1545 | 2008-01-04 Richard Stallman <rms@gnu.org> |
| 263 | 1546 | ||
| @@ -328,13 +1611,13 @@ | |||
| 328 | * progmodes/grep.el (grep-find-ignored-directories): | 1611 | * progmodes/grep.el (grep-find-ignored-directories): |
| 329 | Initialize from the value of vc-directory-exclusion-list. | 1612 | Initialize from the value of vc-directory-exclusion-list. |
| 330 | 1613 | ||
| 331 | * vc-hooks (vc-directory-exclusion-list): Include "_darcs", | 1614 | * vc-hooks (vc-directory-exclusion-list): Include "_darcs", |
| 332 | even though we don't have a back end for darcs yet. | 1615 | even though we don't have a back end for darcs yet. |
| 333 | 1616 | ||
| 334 | 2008-01-02 Karl Fogel <kfogel@red-bean.com> | 1617 | 2008-01-02 Karl Fogel <kfogel@red-bean.com> |
| 335 | 1618 | ||
| 336 | Change a return type, for greater extensibility. See | 1619 | Change a return type, for greater extensibility. |
| 337 | http://lists.gnu.org/archive/html/emacs-devel/2007-12/msg01077.html | 1620 | See http://lists.gnu.org/archive/html/emacs-devel/2007-12/msg01077.html |
| 338 | and its thread for discussion leading to this change. | 1621 | and its thread for discussion leading to this change. |
| 339 | 1622 | ||
| 340 | * emacs-cvs/lisp/bookmark.el: | 1623 | * emacs-cvs/lisp/bookmark.el: |
| @@ -396,10 +1679,10 @@ | |||
| 396 | 1679 | ||
| 397 | 2008-01-01 Eric S. Raymond <esr@snark.thyrsus.com> | 1680 | 2008-01-01 Eric S. Raymond <esr@snark.thyrsus.com> |
| 398 | 1681 | ||
| 399 | * vc-svn.el (vc-svn-parse-status): Set the 'unregisted property | 1682 | * vc-svn.el (vc-svn-parse-status): Set the `unregisted' property |
| 400 | correctly. | 1683 | correctly. |
| 401 | 1684 | ||
| 402 | * vc.el (vc-dired-hook): Speed tuning. Replace a vc-backend call | 1685 | * vc.el (vc-dired-hook): Speed tuning. Replace a vc-backend call |
| 403 | with vc-state. | 1686 | with vc-state. |
| 404 | (vc-next-action): Fix vc-transfer-file call. | 1687 | (vc-next-action): Fix vc-transfer-file call. |
| 405 | 1688 | ||
| @@ -889,6 +2172,12 @@ | |||
| 889 | * newcomment.el (comment-region-default): Don't triple the | 2172 | * newcomment.el (comment-region-default): Don't triple the |
| 890 | comment starter if the first region line isn't indented enough. | 2173 | comment starter if the first region line isn't indented enough. |
| 891 | 2174 | ||
| 2175 | 2007-12-21 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 2176 | |||
| 2177 | * net/imap.el (imap-authenticate): Use current-buffer instead of | ||
| 2178 | buffer, for the cases where imap-authenticate is called with a nil | ||
| 2179 | buffer parameter. | ||
| 2180 | |||
| 892 | 2007-12-21 Martin Rudalics <rudalics@gmx.at> | 2181 | 2007-12-21 Martin Rudalics <rudalics@gmx.at> |
| 893 | 2182 | ||
| 894 | * autoinsert.el (auto-insert-alist): Remove nonsensical precision | 2183 | * autoinsert.el (auto-insert-alist): Remove nonsensical precision |
| @@ -1579,6 +2868,12 @@ | |||
| 1579 | * textmodes/reftex-toc.el (reftex-make-separate-toc-frame): | 2868 | * textmodes/reftex-toc.el (reftex-make-separate-toc-frame): |
| 1580 | Try x-focus-frame before focus-frame. Only try focus-frame on XEmacs. | 2869 | Try x-focus-frame before focus-frame. Only try focus-frame on XEmacs. |
| 1581 | 2870 | ||
| 2871 | 2007-12-03 Nathan J. Williams <nathanw@MIT.EDU> (tiny change) | ||
| 2872 | |||
| 2873 | * net/imap.el (imap-mailbox-status-asynch): Upcase STATUS items. | ||
| 2874 | (imap-parse-status): Upcase status-att for servers that sends them | ||
| 2875 | lower-case (e.g., MS Exchange 2007). | ||
| 2876 | |||
| 1582 | 2007-12-03 Karl Fogel <kfogel@red-bean.com> | 2877 | 2007-12-03 Karl Fogel <kfogel@red-bean.com> |
| 1583 | 2878 | ||
| 1584 | * saveplace.el (save-place-quiet): Remove, reverting 2007-12-02T19:54:46Z!kfogel@red-bean.com. | 2879 | * saveplace.el (save-place-quiet): Remove, reverting 2007-12-02T19:54:46Z!kfogel@red-bean.com. |
| @@ -4771,7 +6066,7 @@ | |||
| 4771 | Require tramp-cmds.el. | 6066 | Require tramp-cmds.el. |
| 4772 | (tramp-make-tramp-temp-file): We can get rid of DONT-CREATE. | 6067 | (tramp-make-tramp-temp-file): We can get rid of DONT-CREATE. |
| 4773 | (tramp-handle-file-name-all-completions): Expand DIRECTORY. | 6068 | (tramp-handle-file-name-all-completions): Expand DIRECTORY. |
| 4774 | (tramp-do-copy-or-rename-file-directly): Make more rigid checks. | 6069 | (tramp-do-copy-or-rename-file-directly): Make more rigid checks. |
| 4775 | (tramp-do-copy-or-rename-file-out-of-band) | 6070 | (tramp-do-copy-or-rename-file-out-of-band) |
| 4776 | (tramp-maybe-open-connection): Use `make-temp-name'. This is | 6071 | (tramp-maybe-open-connection): Use `make-temp-name'. This is |
| 4777 | possible, because we don't need to create the temporary file, but | 6072 | possible, because we don't need to create the temporary file, but |
| @@ -7117,18 +8412,6 @@ | |||
| 7117 | * net/browse-url.el (browse-url-encode-url): Use copy-sequence. | 8412 | * net/browse-url.el (browse-url-encode-url): Use copy-sequence. |
| 7118 | Reported by Jan Dj,Ad(Brv <jan.h.d@swipnet.se>. | 8413 | Reported by Jan Dj,Ad(Brv <jan.h.d@swipnet.se>. |
| 7119 | 8414 | ||
| 7120 | 2007-09-10 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 7121 | |||
| 7122 | * progmodes/python.el: Merge changes from Dave Love's v2007-Sep-10. | ||
| 7123 | (python-font-lock-keywords): Update to the 2.5 version of the language. | ||
| 7124 | (python-quote-syntax): Let-bind font-lock-syntactic-keywords to nil. | ||
| 7125 | (python-backspace): Only behave funny in code. | ||
| 7126 | (python-compilation-regexp-alist): Add PDB stack trace regexp. | ||
| 7127 | (inferior-python-mode): Add PDB prompt regexp. | ||
| 7128 | (python-fill-paragraph): Refine the fenced-string regexp. | ||
| 7129 | (python-find-imports): Handle imports spanning several lines. | ||
| 7130 | (python-mode): Add `class' to hideshow support. | ||
| 7131 | |||
| 7132 | 2007-09-10 Dave Love <fx@gnu.org> | 8415 | 2007-09-10 Dave Love <fx@gnu.org> |
| 7133 | 8416 | ||
| 7134 | * outline.el (outline-4, outline-5, outline-7): | 8417 | * outline.el (outline-4, outline-5, outline-7): |
diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12 index cb4924a8930..aab55a53678 100644 --- a/lisp/ChangeLog.12 +++ b/lisp/ChangeLog.12 | |||
| @@ -250,7 +250,7 @@ | |||
| 250 | 2007-04-15 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> | 250 | 2007-04-15 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> |
| 251 | 251 | ||
| 252 | * textmodes/bibtex.el (bibtex-field-list): Use functionp. | 252 | * textmodes/bibtex.el (bibtex-field-list): Use functionp. |
| 253 | (bibtex-make-field): Check that INIT is a string. Use functionp. | 253 | (bibtex-make-field): Check that INIT is a string. Use functionp. |
| 254 | 254 | ||
| 255 | 2007-04-14 Glenn Morris <rgm@gnu.org> | 255 | 2007-04-14 Glenn Morris <rgm@gnu.org> |
| 256 | 256 | ||
| @@ -1214,7 +1214,7 @@ | |||
| 1214 | * progmodes/idlw-help.el (idlwave-do-context-help1): Don't visit | 1214 | * progmodes/idlw-help.el (idlwave-do-context-help1): Don't visit |
| 1215 | special help topics for keywords. | 1215 | special help topics for keywords. |
| 1216 | (idlwave-help-assistant-command): Include ".exe" for ms-dos | 1216 | (idlwave-help-assistant-command): Include ".exe" for ms-dos |
| 1217 | etc. Assistant command. | 1217 | etc. Assistant command. |
| 1218 | 1218 | ||
| 1219 | 2007-03-08 Chong Yidong <cyd@stupidchicken.com> | 1219 | 2007-03-08 Chong Yidong <cyd@stupidchicken.com> |
| 1220 | 1220 | ||
| @@ -2133,7 +2133,7 @@ | |||
| 2133 | (newsticker--decode-iso8601-date): Bugfix for datestrings without | 2133 | (newsticker--decode-iso8601-date): Bugfix for datestrings without |
| 2134 | days. | 2134 | days. |
| 2135 | (newsticker--buffer-do-insert-text): Fix. | 2135 | (newsticker--buffer-do-insert-text): Fix. |
| 2136 | (newsticker--buffer-insert-enclosure): Fix. length might be missing. | 2136 | (newsticker--buffer-insert-enclosure): Fix. Length might be missing. |
| 2137 | (newsticker--buffer-make-item-completely-visible): | 2137 | (newsticker--buffer-make-item-completely-visible): |
| 2138 | `switch-to-buffer' not necessary. | 2138 | `switch-to-buffer' not necessary. |
| 2139 | 2139 | ||
| @@ -5365,7 +5365,7 @@ | |||
| 5365 | After 5.3, 5.4: | 5365 | After 5.3, 5.4: |
| 5366 | (cperl-facemenu-add-face-function): Add docs, fix U<>. | 5366 | (cperl-facemenu-add-face-function): Add docs, fix U<>. |
| 5367 | Copyright message updated. | 5367 | Copyright message updated. |
| 5368 | (cperl-init-faces): Work around a bug in `font-lock'. May slow | 5368 | (cperl-init-faces): Work around a bug in `font-lock'. May slow |
| 5369 | facification down a bit. | 5369 | facification down a bit. |
| 5370 | Misprint for my|our|local for old `font-lock' | 5370 | Misprint for my|our|local for old `font-lock' |
| 5371 | "our" was not fontified same as "my|local". | 5371 | "our" was not fontified same as "my|local". |
| @@ -5881,7 +5881,7 @@ | |||
| 5881 | 5881 | ||
| 5882 | 2006-09-26 Vinicius Jose Latorre <viniciusjl@ig.com.br> | 5882 | 2006-09-26 Vinicius Jose Latorre <viniciusjl@ig.com.br> |
| 5883 | 5883 | ||
| 5884 | * progmodes/ebnf2ps.el: Doc fix. Implement arrow spacing and scaling. | 5884 | * progmodes/ebnf2ps.el: Doc fix. Implement arrow spacing and scaling. |
| 5885 | (ebnf-version): New version 4.3. | 5885 | (ebnf-version): New version 4.3. |
| 5886 | (ebnf-arrow-extra-width, ebnf-arrow-scale): New options. | 5886 | (ebnf-arrow-extra-width, ebnf-arrow-scale): New options. |
| 5887 | (ebnf-prologue): Adjust PostScript programming. | 5887 | (ebnf-prologue): Adjust PostScript programming. |
| @@ -33349,7 +33349,7 @@ See ChangeLog.11 for earlier changes. | |||
| 33349 | ;; add-log-time-zone-rule: t | 33349 | ;; add-log-time-zone-rule: t |
| 33350 | ;; End: | 33350 | ;; End: |
| 33351 | 33351 | ||
| 33352 | Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc. | 33352 | Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
| 33353 | 33353 | ||
| 33354 | This file is part of GNU Emacs. | 33354 | This file is part of GNU Emacs. |
| 33355 | 33355 | ||
diff --git a/lisp/ChangeLog.6 b/lisp/ChangeLog.6 index 781122dcb29..2fff1f9a85f 100644 --- a/lisp/ChangeLog.6 +++ b/lisp/ChangeLog.6 | |||
| @@ -2769,7 +2769,7 @@ | |||
| 2769 | (gnus-request-accept-article): Make sure there's a newline at the | 2769 | (gnus-request-accept-article): Make sure there's a newline at the |
| 2770 | end of the buffer. | 2770 | end of the buffer. |
| 2771 | (gnus-adjust-marked-articles): Don't remove illegal ticked | 2771 | (gnus-adjust-marked-articles): Don't remove illegal ticked |
| 2772 | articles (for forwards compatability). | 2772 | articles (for forwards compatibility). |
| 2773 | 2773 | ||
| 2774 | 1996-02-03 Lars Magne Ingebrigtsen <larsi@aegir.ifi.uio.no> | 2774 | 1996-02-03 Lars Magne Ingebrigtsen <larsi@aegir.ifi.uio.no> |
| 2775 | 2775 | ||
diff --git a/lisp/ChangeLog.unicode b/lisp/ChangeLog.unicode index 3a6c726ec60..39bab4abebc 100644 --- a/lisp/ChangeLog.unicode +++ b/lisp/ChangeLog.unicode | |||
| @@ -8,6 +8,11 @@ | |||
| 8 | 8 | ||
| 9 | * international/characters.el (script-list): Add cham. | 9 | * international/characters.el (script-list): Add cham. |
| 10 | 10 | ||
| 11 | 2008-01-17 Mark A. Hershberger <mah@everybody.org> | ||
| 12 | |||
| 13 | * xml.el (xml-escape-string): Don't do any encoding changes on the | ||
| 14 | string. | ||
| 15 | |||
| 11 | 2008-01-16 Kenichi Handa <handa@ni.aist.go.jp> | 16 | 2008-01-16 Kenichi Handa <handa@ni.aist.go.jp> |
| 12 | 17 | ||
| 13 | * language/ind-util.el (in-is13194-post-read-conversion): Delete | 18 | * language/ind-util.el (in-is13194-post-read-conversion): Delete |
diff --git a/lisp/abbrev.el b/lisp/abbrev.el index ff99430e027..5cdd2d0aa8f 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el | |||
| @@ -524,7 +524,9 @@ the current abbrev table before abbrev lookup happens." | |||
| 524 | (aset table i 0)) | 524 | (aset table i 0)) |
| 525 | ;; Preserve the table's properties. | 525 | ;; Preserve the table's properties. |
| 526 | (assert sym) | 526 | (assert sym) |
| 527 | (intern sym table) | 527 | (let ((newsym (intern "" table))) |
| 528 | (set newsym nil) ; Make sure it won't be confused for an abbrev. | ||
| 529 | (setplist newsym (symbol-plist sym))) | ||
| 528 | (abbrev-table-put table :abbrev-table-modiff | 530 | (abbrev-table-put table :abbrev-table-modiff |
| 529 | (1+ (abbrev-table-get table :abbrev-table-modiff))))) | 531 | (1+ (abbrev-table-get table :abbrev-table-modiff))))) |
| 530 | 532 | ||
diff --git a/lisp/add-log.el b/lisp/add-log.el index a52aa519819..c9fdb34bc9a 100644 --- a/lisp/add-log.el +++ b/lisp/add-log.el | |||
| @@ -240,8 +240,11 @@ Note: The search is conducted only within 10%, at the beginning of the file." | |||
| 240 | ;; backward-compatibility alias | 240 | ;; backward-compatibility alias |
| 241 | (put 'change-log-acknowledgement-face 'face-alias 'change-log-acknowledgement) | 241 | (put 'change-log-acknowledgement-face 'face-alias 'change-log-acknowledgement) |
| 242 | 242 | ||
| 243 | (defconst change-log-file-names-re "^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)") | ||
| 244 | (defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*") | ||
| 245 | |||
| 243 | (defvar change-log-font-lock-keywords | 246 | (defvar change-log-font-lock-keywords |
| 244 | '(;; | 247 | `(;; |
| 245 | ;; Date lines, new (2000-01-01) and old (Sat Jan 1 00:00:00 2000) styles. | 248 | ;; Date lines, new (2000-01-01) and old (Sat Jan 1 00:00:00 2000) styles. |
| 246 | ;; Fixme: this regepx is just an approximate one and may match | 249 | ;; Fixme: this regepx is just an approximate one and may match |
| 247 | ;; wrongly with a non-date line existing as a random note. In | 250 | ;; wrongly with a non-date line existing as a random note. In |
| @@ -255,7 +258,7 @@ Note: The search is conducted only within 10%, at the beginning of the file." | |||
| 255 | (2 'change-log-email))) | 258 | (2 'change-log-email))) |
| 256 | ;; | 259 | ;; |
| 257 | ;; File names. | 260 | ;; File names. |
| 258 | ("^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)" | 261 | (,change-log-file-names-re |
| 259 | (2 'change-log-file) | 262 | (2 'change-log-file) |
| 260 | ;; Possibly further names in a list: | 263 | ;; Possibly further names in a list: |
| 261 | ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file)) | 264 | ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file)) |
| @@ -287,10 +290,49 @@ Note: The search is conducted only within 10%, at the beginning of the file." | |||
| 287 | 3 'change-log-acknowledgement)) | 290 | 3 'change-log-acknowledgement)) |
| 288 | "Additional expressions to highlight in Change Log mode.") | 291 | "Additional expressions to highlight in Change Log mode.") |
| 289 | 292 | ||
| 293 | (defun change-log-search-file-name (where) | ||
| 294 | "Return the file-name for the change under point." | ||
| 295 | (save-excursion | ||
| 296 | (goto-char where) | ||
| 297 | (beginning-of-line 1) | ||
| 298 | (if (looking-at change-log-start-entry-re) | ||
| 299 | ;; We are at the start of an entry, search forward for a file | ||
| 300 | ;; name. | ||
| 301 | (progn | ||
| 302 | (re-search-forward change-log-file-names-re nil t) | ||
| 303 | (match-string 2)) | ||
| 304 | (if (looking-at change-log-file-names-re) | ||
| 305 | ;; We found a file name. | ||
| 306 | (match-string 2) | ||
| 307 | ;; Look backwards for either a file name or the log entry start. | ||
| 308 | (if (re-search-backward | ||
| 309 | (concat "\\(" change-log-start-entry-re | ||
| 310 | "\\)\\|\\(" | ||
| 311 | change-log-file-names-re "\\)") nil t) | ||
| 312 | (if (match-beginning 1) | ||
| 313 | ;; We got the start of the entry, look forward for a | ||
| 314 | ;; file name. | ||
| 315 | (progn | ||
| 316 | (re-search-forward change-log-file-names-re nil t) | ||
| 317 | (match-string 2)) | ||
| 318 | (match-string 4)) | ||
| 319 | ;; We must be before any file name, look forward. | ||
| 320 | (re-search-forward change-log-file-names-re nil t) | ||
| 321 | (match-string 2)))))) | ||
| 322 | |||
| 323 | (defun change-log-find-file () | ||
| 324 | "Visit the file for the change under point." | ||
| 325 | (interactive) | ||
| 326 | (let ((file (change-log-search-file-name (point)))) | ||
| 327 | (if (and file (file-exists-p file)) | ||
| 328 | (find-file file) | ||
| 329 | (message "No such file or directory: %s" file)))) | ||
| 330 | |||
| 290 | (defvar change-log-mode-map | 331 | (defvar change-log-mode-map |
| 291 | (let ((map (make-sparse-keymap))) | 332 | (let ((map (make-sparse-keymap))) |
| 292 | (define-key map [?\C-c ?\C-p] 'add-log-edit-prev-comment) | 333 | (define-key map [?\C-c ?\C-p] 'add-log-edit-prev-comment) |
| 293 | (define-key map [?\C-c ?\C-n] 'add-log-edit-next-comment) | 334 | (define-key map [?\C-c ?\C-n] 'add-log-edit-next-comment) |
| 335 | (define-key map [?\C-c ?\C-f] 'change-log-find-file) | ||
| 294 | map) | 336 | map) |
| 295 | "Keymap for Change Log major mode.") | 337 | "Keymap for Change Log major mode.") |
| 296 | 338 | ||
| @@ -1101,8 +1143,6 @@ Has a preference of looking backwards." | |||
| 1101 | (change-log-get-method-definition-1 "")) | 1143 | (change-log-get-method-definition-1 "")) |
| 1102 | (concat change-log-get-method-definition-md "]")))))) | 1144 | (concat change-log-get-method-definition-md "]")))))) |
| 1103 | 1145 | ||
| 1104 | (defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*") | ||
| 1105 | |||
| 1106 | (defun change-log-sortable-date-at () | 1146 | (defun change-log-sortable-date-at () |
| 1107 | "Return date of log entry in a consistent form for sorting. | 1147 | "Return date of log entry in a consistent form for sorting. |
| 1108 | Point is assumed to be at the start of the entry." | 1148 | Point is assumed to be at the start of the entry." |
diff --git a/lisp/allout.el b/lisp/allout.el index 48371938242..a259723d5ba 100644 --- a/lisp/allout.el +++ b/lisp/allout.el | |||
| @@ -5,7 +5,7 @@ | |||
| 5 | 5 | ||
| 6 | ;; Author: Ken Manheimer <ken dot manheimer at gmail dot com> | 6 | ;; Author: Ken Manheimer <ken dot manheimer at gmail dot com> |
| 7 | ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> | 7 | ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> |
| 8 | ;; Created: Dec 1991 - first release to usenet | 8 | ;; Created: Dec 1991 -- first release to usenet |
| 9 | ;; Version: 2.2.1 | 9 | ;; Version: 2.2.1 |
| 10 | ;; Keywords: outlines wp languages | 10 | ;; Keywords: outlines wp languages |
| 11 | ;; Website: http://myriadicity.net/Sundry/EmacsAllout | 11 | ;; Website: http://myriadicity.net/Sundry/EmacsAllout |
| @@ -36,11 +36,11 @@ | |||
| 36 | ;; - Topic-oriented editing including coherent topic and subtopic | 36 | ;; - Topic-oriented editing including coherent topic and subtopic |
| 37 | ;; creation, promotion, demotion, cut/paste across depths, etc. | 37 | ;; creation, promotion, demotion, cut/paste across depths, etc. |
| 38 | ;; - Incremental search with dynamic exposure and reconcealment of text | 38 | ;; - Incremental search with dynamic exposure and reconcealment of text |
| 39 | ;; - Customizable bullet format - enables programming-language specific | 39 | ;; - Customizable bullet format -- enables programming-language specific |
| 40 | ;; outlining, for code-folding editing. (Allout code itself is to try it; | 40 | ;; outlining, for code-folding editing. (Allout code itself is to try it; |
| 41 | ;; formatted as an outline - do ESC-x eval-buffer in allout.el; but | 41 | ;; formatted as an outline -- do ESC-x eval-buffer in allout.el; but |
| 42 | ;; emacs local file variables need to be enabled when the | 42 | ;; emacs local file variables need to be enabled when the |
| 43 | ;; file was visited - see `enable-local-variables'.) | 43 | ;; file was visited -- see `enable-local-variables'.) |
| 44 | ;; - Configurable per-file initial exposure settings | 44 | ;; - Configurable per-file initial exposure settings |
| 45 | ;; - Symmetric-key and key-pair topic encryption, plus symmetric passphrase | 45 | ;; - Symmetric-key and key-pair topic encryption, plus symmetric passphrase |
| 46 | ;; mnemonic support, with verification against an established passphrase | 46 | ;; mnemonic support, with verification against an established passphrase |
| @@ -53,7 +53,7 @@ | |||
| 53 | ;; exposure control (see the allout-mode docstring) | 53 | ;; exposure control (see the allout-mode docstring) |
| 54 | ;; - Easy rendering of exposed portions into numbered, latex, indented, etc | 54 | ;; - Easy rendering of exposed portions into numbered, latex, indented, etc |
| 55 | ;; outline styles | 55 | ;; outline styles |
| 56 | ;; - Careful attention to whitespace - enabling blank lines between items | 56 | ;; - Careful attention to whitespace -- enabling blank lines between items |
| 57 | ;; and maintenance of hanging indentation (in paragraph auto-fill and | 57 | ;; and maintenance of hanging indentation (in paragraph auto-fill and |
| 58 | ;; across topic promotion and demotion) of topic bodies consistent with | 58 | ;; across topic promotion and demotion) of topic bodies consistent with |
| 59 | ;; indentation of their topic header. | 59 | ;; indentation of their topic header. |
| @@ -76,7 +76,7 @@ | |||
| 76 | ;; `allout-mode' as a minor mode. (It has changed since allout | 76 | ;; `allout-mode' as a minor mode. (It has changed since allout |
| 77 | ;; 3.x, for those of you that depend on the old method.) | 77 | ;; 3.x, for those of you that depend on the old method.) |
| 78 | ;; | 78 | ;; |
| 79 | ;; Note - the lines beginning with `;;;_' are outline topic headers. | 79 | ;; Note -- the lines beginning with `;;;_' are outline topic headers. |
| 80 | ;; Just `ESC-x eval-buffer' to give it a whirl. | 80 | ;; Just `ESC-x eval-buffer' to give it a whirl. |
| 81 | 81 | ||
| 82 | ;; ken manheimer (ken dot manheimer at gmail dot com) | 82 | ;; ken manheimer (ken dot manheimer at gmail dot com) |
| @@ -117,12 +117,12 @@ Default is '\C-c<space>'; just '\C-c' is more short-and-sweet, if you're | |||
| 117 | willing to let allout use a bunch of \C-c keybindings." | 117 | willing to let allout use a bunch of \C-c keybindings." |
| 118 | :type 'string | 118 | :type 'string |
| 119 | :group 'allout) | 119 | :group 'allout) |
| 120 | |||
| 120 | ;;;_ = allout-keybindings-list | 121 | ;;;_ = allout-keybindings-list |
| 121 | ;;; You have to reactivate allout-mode - `(allout-mode t)' - to | 122 | ;;; You have to reactivate allout-mode -- `(allout-mode t)' -- to |
| 122 | ;;; institute changes to this var. | 123 | ;;; institute changes to this var. |
| 123 | (defvar allout-keybindings-list () | 124 | (defvar allout-keybindings-list () |
| 124 | "*List of `allout-mode' key / function bindings, for `allout-mode-map'. | 125 | "*List of `allout-mode' key / function bindings, for `allout-mode-map'. |
| 125 | |||
| 126 | String or vector key will be prefaced with `allout-command-prefix', | 126 | String or vector key will be prefaced with `allout-command-prefix', |
| 127 | unless optional third, non-nil element is present.") | 127 | unless optional third, non-nil element is present.") |
| 128 | (setq allout-keybindings-list | 128 | (setq allout-keybindings-list |
| @@ -155,11 +155,11 @@ unless optional third, non-nil element is present.") | |||
| 155 | ("*" allout-rebullet-current-heading) | 155 | ("*" allout-rebullet-current-heading) |
| 156 | ("#" allout-number-siblings) | 156 | ("#" allout-number-siblings) |
| 157 | ("\C-k" allout-kill-line t) | 157 | ("\C-k" allout-kill-line t) |
| 158 | ("\M-k" allout-copy-line-as-kill t) | 158 | ([?\M-k] allout-copy-line-as-kill t) |
| 159 | ("\C-y" allout-yank t) | 159 | ("\C-y" allout-yank t) |
| 160 | ("\M-y" allout-yank-pop t) | 160 | ([?\M-y] allout-yank-pop t) |
| 161 | ("\C-k" allout-kill-topic) | 161 | ("\C-k" allout-kill-topic) |
| 162 | ("\M-k" allout-copy-topic-as-kill) | 162 | ([?\M-k] allout-copy-topic-as-kill) |
| 163 | ; Miscellaneous commands: | 163 | ; Miscellaneous commands: |
| 164 | ;([?\C-\ ] allout-mark-topic) | 164 | ;([?\C-\ ] allout-mark-topic) |
| 165 | ("@" allout-resolve-xref) | 165 | ("@" allout-resolve-xref) |
| @@ -170,7 +170,7 @@ unless optional third, non-nil element is present.") | |||
| 170 | 170 | ||
| 171 | ;;;_ = allout-auto-activation | 171 | ;;;_ = allout-auto-activation |
| 172 | (defcustom allout-auto-activation nil | 172 | (defcustom allout-auto-activation nil |
| 173 | "*Regulates auto-activation modality of allout outlines - see `allout-init'. | 173 | "*Regulates auto-activation modality of allout outlines -- see `allout-init'. |
| 174 | 174 | ||
| 175 | Setq-default by `allout-init' to regulate whether or not allout | 175 | Setq-default by `allout-init' to regulate whether or not allout |
| 176 | outline mode is automatically activated when the buffer-specific | 176 | outline mode is automatically activated when the buffer-specific |
| @@ -212,35 +212,35 @@ value will automatically trigger `allout-mode', provided | |||
| 212 | 212 | ||
| 213 | The types of elements in the layout specification are: | 213 | The types of elements in the layout specification are: |
| 214 | 214 | ||
| 215 | integer - dictate the relative depth to open the corresponding topic(s), | 215 | INTEGER -- dictate the relative depth to open the corresponding topic(s), |
| 216 | where: | 216 | where: |
| 217 | - negative numbers force the topic to be closed before opening | 217 | -- negative numbers force the topic to be closed before opening |
| 218 | to the absolute value of the number, so all siblings are open | 218 | to the absolute value of the number, so all siblings are open |
| 219 | only to that level. | 219 | only to that level. |
| 220 | - positive numbers open to the relative depth indicated by the | 220 | -- positive numbers open to the relative depth indicated by the |
| 221 | number, but do not force already opened subtopics to be closed. | 221 | number, but do not force already opened subtopics to be closed. |
| 222 | - 0 means to close topic - hide all subitems. | 222 | -- 0 means to close topic -- hide all subitems. |
| 223 | : - repeat spec - apply the preceeding element to all siblings at | 223 | : -- repeat spec -- apply the preceeding element to all siblings at |
| 224 | current level, *up to* those siblings that would be covered by specs | 224 | current level, *up to* those siblings that would be covered by specs |
| 225 | following the `:' on the list. Ie, apply to all topics at level but | 225 | following the `:' on the list. Ie, apply to all topics at level but |
| 226 | trailing ones accounted for by trailing specs. (Only the first of | 226 | trailing ones accounted for by trailing specs. (Only the first of |
| 227 | multiple colons at the same level is honored - later ones are ignored.) | 227 | multiple colons at the same level is honored -- later ones are ignored.) |
| 228 | * - completely exposes the topic, including bodies | 228 | * -- completely exposes the topic, including bodies |
| 229 | + - exposes all subtopics, but not the bodies | 229 | + -- exposes all subtopics, but not the bodies |
| 230 | - - exposes the body of the corresponding topic, but not subtopics | 230 | - -- exposes the body of the corresponding topic, but not subtopics |
| 231 | list - a nested layout spec, to be applied intricately to its | 231 | LIST -- a nested layout spec, to be applied intricately to its |
| 232 | corresponding item(s) | 232 | corresponding item(s) |
| 233 | 233 | ||
| 234 | Examples: | 234 | Examples: |
| 235 | '(-2 : 0) | 235 | (-2 : 0) |
| 236 | Collapse the top-level topics to show their children and | 236 | Collapse the top-level topics to show their children and |
| 237 | grandchildren, but completely collapse the final top-level topic. | 237 | grandchildren, but completely collapse the final top-level topic. |
| 238 | '(-1 () : 1 0) | 238 | (-1 () : 1 0) |
| 239 | Close the first topic so only the immediate subtopics are shown, | 239 | Close the first topic so only the immediate subtopics are shown, |
| 240 | leave the subsequent topics exposed as they are until the second | 240 | leave the subsequent topics exposed as they are until the second |
| 241 | second to last topic, which is exposed at least one level, and | 241 | second to last topic, which is exposed at least one level, and |
| 242 | completely close the last topic. | 242 | completely close the last topic. |
| 243 | '(-2 : -1 *) | 243 | (-2 : -1 *) |
| 244 | Expose children and grandchildren of all topics at current | 244 | Expose children and grandchildren of all topics at current |
| 245 | level except the last two; expose children of the second to | 245 | level except the last two; expose children of the second to |
| 246 | last and completely expose the last one, including its subtopics. | 246 | last and completely expose the last one, including its subtopics. |
| @@ -283,7 +283,7 @@ else allout's special hanging-indent maintaining auto-fill function, | |||
| 283 | (defcustom allout-use-hanging-indents t | 283 | (defcustom allout-use-hanging-indents t |
| 284 | "*If non-nil, topic body text auto-indent defaults to indent of the header. | 284 | "*If non-nil, topic body text auto-indent defaults to indent of the header. |
| 285 | Ie, it is indented to be just past the header prefix. This is | 285 | Ie, it is indented to be just past the header prefix. This is |
| 286 | relevant mostly for use with indented-text-mode, or other situations | 286 | relevant mostly for use with `indented-text-mode', or other situations |
| 287 | where auto-fill occurs." | 287 | where auto-fill occurs." |
| 288 | :type 'boolean | 288 | :type 'boolean |
| 289 | :group 'allout) | 289 | :group 'allout) |
| @@ -360,7 +360,7 @@ repeated calls." | |||
| 360 | Cycling only happens on when the command is repeated, not when it | 360 | Cycling only happens on when the command is repeated, not when it |
| 361 | follows a different command. | 361 | follows a different command. |
| 362 | 362 | ||
| 363 | Smart-placement means that repeated calls to this function will | 363 | Smart placement means that repeated calls to this function will |
| 364 | advance as follows: | 364 | advance as follows: |
| 365 | 365 | ||
| 366 | - if the cursor is not on the end-of-line, | 366 | - if the cursor is not on the end-of-line, |
| @@ -442,25 +442,25 @@ persistent until deliberately changed. Their significance is | |||
| 442 | purely by convention, however. Some conventions suggest | 442 | purely by convention, however. Some conventions suggest |
| 443 | themselves: | 443 | themselves: |
| 444 | 444 | ||
| 445 | `(' - open paren - an aside or incidental point | 445 | `(' - open paren -- an aside or incidental point |
| 446 | `?' - question mark - uncertain or outright question | 446 | `?' - question mark -- uncertain or outright question |
| 447 | `!' - exclamation point/bang - emphatic | 447 | `!' - exclamation point/bang -- emphatic |
| 448 | `[' - open square bracket - meta-note, about item instead of item's subject | 448 | `[' - open square bracket -- meta-note, about item instead of item's subject |
| 449 | `\"' - double quote - a quotation or other citation | 449 | `\"' - double quote -- a quotation or other citation |
| 450 | `=' - equal sign - an assignement, equating a name with some connotation | 450 | `=' - equal sign -- an assignement, equating a name with some connotation |
| 451 | `^' - carat - relates to something above | 451 | `^' - carat -- relates to something above |
| 452 | 452 | ||
| 453 | Some are more elusive, but their rationale may be recognizable: | 453 | Some are more elusive, but their rationale may be recognizable: |
| 454 | 454 | ||
| 455 | `+' - plus - pending consideration, completion | 455 | `+' - plus -- pending consideration, completion |
| 456 | `_' - underscore - done, completed | 456 | `_' - underscore -- done, completed |
| 457 | `&' - ampersand - addendum, furthermore | 457 | `&' - ampersand -- addendum, furthermore |
| 458 | 458 | ||
| 459 | \(Some other non-plain bullets have special meaning to the | 459 | \(Some other non-plain bullets have special meaning to the |
| 460 | software. By default: | 460 | software. By default: |
| 461 | 461 | ||
| 462 | `~' marks encryptable topics - see `allout-topic-encryption-bullet' | 462 | `~' marks encryptable topics -- see `allout-topic-encryption-bullet' |
| 463 | `#' marks auto-numbered bullets - see `allout-numbered-bullet'.) | 463 | `#' marks auto-numbered bullets -- see `allout-numbered-bullet'.) |
| 464 | 464 | ||
| 465 | See `allout-plain-bullets-string' for the standard, alternating | 465 | See `allout-plain-bullets-string' for the standard, alternating |
| 466 | bullets. | 466 | bullets. |
| @@ -502,7 +502,7 @@ comment-start strings that do not end in spaces are tripled in | |||
| 502 | the header-prefix, and an `_' underscore is tacked on the end, to | 502 | the header-prefix, and an `_' underscore is tacked on the end, to |
| 503 | distinguish them from regular comment strings. comment-start | 503 | distinguish them from regular comment strings. comment-start |
| 504 | strings that do end in spaces are not tripled, but an underscore | 504 | strings that do end in spaces are not tripled, but an underscore |
| 505 | is substituted for the space. [This presumes that the space is | 505 | is substituted for the space. [This presumes that the space is |
| 506 | for appearance, not comment syntax. You can use | 506 | for appearance, not comment syntax. You can use |
| 507 | `allout-mode-leaders' to override this behavior, when | 507 | `allout-mode-leaders' to override this behavior, when |
| 508 | undesired.]" | 508 | undesired.]" |
| @@ -543,7 +543,7 @@ are always respected by the topic maneuvering functions." | |||
| 543 | ;;;###autoload | 543 | ;;;###autoload |
| 544 | (put 'allout-old-style-prefixes 'safe-local-variable | 544 | (put 'allout-old-style-prefixes 'safe-local-variable |
| 545 | (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil))))) | 545 | (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil))))) |
| 546 | ;;;_ = allout-stylish-prefixes - alternating bullets | 546 | ;;;_ = allout-stylish-prefixes -- alternating bullets |
| 547 | (defcustom allout-stylish-prefixes t | 547 | (defcustom allout-stylish-prefixes t |
| 548 | "*Do fancy stuff with topic prefix bullets according to level, etc. | 548 | "*Do fancy stuff with topic prefix bullets according to level, etc. |
| 549 | 549 | ||
| @@ -707,9 +707,9 @@ variable for details about allout ajustment of file variables." | |||
| 707 | (defcustom allout-passphrase-hint-handling 'always | 707 | (defcustom allout-passphrase-hint-handling 'always |
| 708 | "*Dictate outline encryption passphrase reminder handling: | 708 | "*Dictate outline encryption passphrase reminder handling: |
| 709 | 709 | ||
| 710 | always - always show reminder when prompting | 710 | always -- always show reminder when prompting |
| 711 | needed - show reminder on passphrase entry failure | 711 | needed -- show reminder on passphrase entry failure |
| 712 | disabled - never present or adjust reminder | 712 | disabled -- never present or adjust reminder |
| 713 | 713 | ||
| 714 | See the docstring for the `allout-enable-file-variable-adjustment' | 714 | See the docstring for the `allout-enable-file-variable-adjustment' |
| 715 | variable for details about allout ajustment of file variables." | 715 | variable for details about allout ajustment of file variables." |
| @@ -732,7 +732,7 @@ mostly covers both deliberate file writes and auto-saves. | |||
| 732 | can continue editing but the copy on the file system will be | 732 | can continue editing but the copy on the file system will be |
| 733 | encrypted.) | 733 | encrypted.) |
| 734 | Auto-saves will use the \"All except current topic\" mode if this | 734 | Auto-saves will use the \"All except current topic\" mode if this |
| 735 | one is selected, to avoid practical difficulties - see below. | 735 | one is selected, to avoid practical difficulties -- see below. |
| 736 | - All except current topic: skip the topic currently being edited, even if | 736 | - All except current topic: skip the topic currently being edited, even if |
| 737 | it's pending encryption. This may expose the current topic on the | 737 | it's pending encryption. This may expose the current topic on the |
| 738 | file sytem, but avoids the nuisance of prompts for the encryption | 738 | file sytem, but avoids the nuisance of prompts for the encryption |
| @@ -790,7 +790,7 @@ For details, see `allout-toggle-current-subtree-encryption's docstring." | |||
| 790 | :group 'allout) | 790 | :group 'allout) |
| 791 | (make-variable-buffer-local 'allout-enable-file-variable-adjustment) | 791 | (make-variable-buffer-local 'allout-enable-file-variable-adjustment) |
| 792 | 792 | ||
| 793 | ;;;_* CODE - no user customizations below. | 793 | ;;;_* CODE -- no user customizations below. |
| 794 | 794 | ||
| 795 | ;;;_ #1 Internal Outline Formatting and Configuration | 795 | ;;;_ #1 Internal Outline Formatting and Configuration |
| 796 | ;;;_ : Version | 796 | ;;;_ : Version |
| @@ -810,7 +810,7 @@ For details, see `allout-toggle-current-subtree-encryption's docstring." | |||
| 810 | (defvar allout-mode nil "Allout outline mode minor-mode flag.") | 810 | (defvar allout-mode nil "Allout outline mode minor-mode flag.") |
| 811 | (make-variable-buffer-local 'allout-mode) | 811 | (make-variable-buffer-local 'allout-mode) |
| 812 | ;;;_ = allout-layout nil | 812 | ;;;_ = allout-layout nil |
| 813 | (defvar allout-layout nil ; LEAVE GLOBAL VALUE NIL - see docstring. | 813 | (defvar allout-layout nil ; LEAVE GLOBAL VALUE NIL -- see docstring. |
| 814 | "Buffer-specific setting for allout layout. | 814 | "Buffer-specific setting for allout layout. |
| 815 | 815 | ||
| 816 | In buffers where this is non-nil (and if `allout-init' has been run, to | 816 | In buffers where this is non-nil (and if `allout-init' has been run, to |
| @@ -854,7 +854,7 @@ by `set-allout-regexp'.") | |||
| 854 | (defvar allout-bullets-string "" | 854 | (defvar allout-bullets-string "" |
| 855 | "A string dictating the valid set of outline topic bullets. | 855 | "A string dictating the valid set of outline topic bullets. |
| 856 | 856 | ||
| 857 | This var should *not* be set by the user - it is set by `set-allout-regexp', | 857 | This var should *not* be set by the user -- it is set by `set-allout-regexp', |
| 858 | and is produced from the elements of `allout-plain-bullets-string' | 858 | and is produced from the elements of `allout-plain-bullets-string' |
| 859 | and `allout-distinctive-bullets-string'.") | 859 | and `allout-distinctive-bullets-string'.") |
| 860 | (make-variable-buffer-local 'allout-bullets-string) | 860 | (make-variable-buffer-local 'allout-bullets-string) |
| @@ -886,7 +886,7 @@ topic prefix to be matched.") | |||
| 886 | (make-variable-buffer-local 'allout-depth-one-regexp) | 886 | (make-variable-buffer-local 'allout-depth-one-regexp) |
| 887 | ;;;_ = allout-line-boundary-regexp | 887 | ;;;_ = allout-line-boundary-regexp |
| 888 | (defvar allout-line-boundary-regexp () | 888 | (defvar allout-line-boundary-regexp () |
| 889 | "`allout-regexp' with outline style beginning-of-line anchor. | 889 | "`allout-regexp' prepended with a newline for the search target. |
| 890 | 890 | ||
| 891 | This is properly set by `set-allout-regexp'.") | 891 | This is properly set by `set-allout-regexp'.") |
| 892 | (make-variable-buffer-local 'allout-line-boundary-regexp) | 892 | (make-variable-buffer-local 'allout-line-boundary-regexp) |
| @@ -970,7 +970,7 @@ invoking it directly." | |||
| 970 | comment-start | 970 | comment-start |
| 971 | t))) | 971 | t))) |
| 972 | allout-use-mode-specific-leader | 972 | allout-use-mode-specific-leader |
| 973 | ;; Oops - garbled value, equate with effect of 't: | 973 | ;; Oops -- garbled value, equate with effect of t: |
| 974 | t))) | 974 | t))) |
| 975 | (leader | 975 | (leader |
| 976 | (cond | 976 | (cond |
| @@ -998,8 +998,8 @@ invoking it directly." | |||
| 998 | nil | 998 | nil |
| 999 | (setq allout-header-prefix leader) | 999 | (setq allout-header-prefix leader) |
| 1000 | (if (not allout-old-style-prefixes) | 1000 | (if (not allout-old-style-prefixes) |
| 1001 | ;; setting allout-primary-bullet makes the top level topics use - | 1001 | ;; setting allout-primary-bullet makes the top level topics use -- |
| 1002 | ;; actually, be - the special prefix: | 1002 | ;; actually, be -- the special prefix: |
| 1003 | (setq allout-primary-bullet leader)) | 1003 | (setq allout-primary-bullet leader)) |
| 1004 | allout-header-prefix))) | 1004 | allout-header-prefix))) |
| 1005 | (defalias 'allout-infer-header-lead | 1005 | (defalias 'allout-infer-header-lead |
| @@ -1058,7 +1058,7 @@ Also refresh various data structures that hinge on the regexp." | |||
| 1058 | (setq allout-plain-bullets-string-len (length allout-plain-bullets-string)) | 1058 | (setq allout-plain-bullets-string-len (length allout-plain-bullets-string)) |
| 1059 | (setq allout-header-subtraction (1- (length allout-header-prefix))) | 1059 | (setq allout-header-subtraction (1- (length allout-header-prefix))) |
| 1060 | 1060 | ||
| 1061 | (let (new-part old-part) | 1061 | (let (new-part old-part formfeed-part) |
| 1062 | (setq new-part (concat "\\(" | 1062 | (setq new-part (concat "\\(" |
| 1063 | (regexp-quote allout-header-prefix) | 1063 | (regexp-quote allout-header-prefix) |
| 1064 | "[ \t]*" | 1064 | "[ \t]*" |
| @@ -1072,18 +1072,26 @@ Also refresh various data structures that hinge on the regexp." | |||
| 1072 | "\\)" | 1072 | "\\)" |
| 1073 | "+" | 1073 | "+" |
| 1074 | " ?[^" allout-primary-bullet "]") | 1074 | " ?[^" allout-primary-bullet "]") |
| 1075 | formfeed-part "\\(\^L\\)" | ||
| 1076 | |||
| 1075 | allout-regexp (concat new-part | 1077 | allout-regexp (concat new-part |
| 1076 | "\\|" | 1078 | "\\|" |
| 1077 | old-part | 1079 | old-part |
| 1078 | "\\|\^l") | 1080 | "\\|" |
| 1081 | formfeed-part) | ||
| 1079 | 1082 | ||
| 1080 | allout-line-boundary-regexp (concat "\n" new-part | 1083 | allout-line-boundary-regexp (concat "\n" new-part |
| 1081 | "\\|" | 1084 | "\\|" |
| 1082 | "\n" old-part) | 1085 | "\n" old-part |
| 1086 | "\\|" | ||
| 1087 | "\n" formfeed-part) | ||
| 1083 | 1088 | ||
| 1084 | allout-bob-regexp (concat "\\`" new-part | 1089 | allout-bob-regexp (concat "\\`" new-part |
| 1085 | "\\|" | 1090 | "\\|" |
| 1086 | "\\`" old-part)) | 1091 | "\\`" old-part |
| 1092 | "\\|" | ||
| 1093 | "\\`" formfeed-part | ||
| 1094 | )) | ||
| 1087 | 1095 | ||
| 1088 | (setq allout-depth-specific-regexp | 1096 | (setq allout-depth-specific-regexp |
| 1089 | (concat "\\(^\\|\\`\\)" | 1097 | (concat "\\(^\\|\\`\\)" |
| @@ -1140,10 +1148,10 @@ Also refresh various data structures that hinge on the regexp." | |||
| 1140 | (defvar allout-mode-map nil "Keybindings for (allout) outline minor mode.") | 1148 | (defvar allout-mode-map nil "Keybindings for (allout) outline minor mode.") |
| 1141 | ;;;_ > produce-allout-mode-map (keymap-alist &optional base-map) | 1149 | ;;;_ > produce-allout-mode-map (keymap-alist &optional base-map) |
| 1142 | (defun produce-allout-mode-map (keymap-list &optional base-map) | 1150 | (defun produce-allout-mode-map (keymap-list &optional base-map) |
| 1143 | "Produce keymap for use as allout-mode-map, from KEYMAP-LIST. | 1151 | "Produce keymap for use as `allout-mode-map', from KEYMAP-LIST. |
| 1144 | 1152 | ||
| 1145 | Built on top of optional BASE-MAP, or empty sparse map if none specified. | 1153 | Built on top of optional BASE-MAP, or empty sparse map if none specified. |
| 1146 | See doc string for allout-keybindings-list for format of binding list." | 1154 | See doc string for `allout-keybindings-list' for format of binding list." |
| 1147 | (let ((map (or base-map (make-sparse-keymap))) | 1155 | (let ((map (or base-map (make-sparse-keymap))) |
| 1148 | (pref (list allout-command-prefix))) | 1156 | (pref (list allout-command-prefix))) |
| 1149 | (mapc (function | 1157 | (mapc (function |
| @@ -1255,7 +1263,7 @@ extended from the existing one by `append'ing a list containing the second | |||
| 1255 | element of the pair onto the end of the existing value. | 1263 | element of the pair onto the end of the existing value. |
| 1256 | 1264 | ||
| 1257 | Extension, and resumptions in general, should not be used for hook | 1265 | Extension, and resumptions in general, should not be used for hook |
| 1258 | functions - use the 'local mode of `add-hook' for that, instead. | 1266 | functions -- use the 'local mode of `add-hook' for that, instead. |
| 1259 | 1267 | ||
| 1260 | The settings are stored on `allout-mode-prior-settings'." | 1268 | The settings are stored on `allout-mode-prior-settings'." |
| 1261 | (while pairs | 1269 | (while pairs |
| @@ -1274,7 +1282,7 @@ The settings are stored on `allout-mode-prior-settings'." | |||
| 1274 | (when (not (assoc name allout-mode-prior-settings)) | 1282 | (when (not (assoc name allout-mode-prior-settings)) |
| 1275 | ;; Not already added as a resumption, create the prior setting entry. | 1283 | ;; Not already added as a resumption, create the prior setting entry. |
| 1276 | (if (local-variable-p name) | 1284 | (if (local-variable-p name) |
| 1277 | ;; is already local variable - preserve the prior value: | 1285 | ;; is already local variable -- preserve the prior value: |
| 1278 | (push (list name prior-value) allout-mode-prior-settings) | 1286 | (push (list name prior-value) allout-mode-prior-settings) |
| 1279 | ;; wasn't local variable, indicate so for resumption by killing | 1287 | ;; wasn't local variable, indicate so for resumption by killing |
| 1280 | ;; local value, and make it local: | 1288 | ;; local value, and make it local: |
| @@ -1340,9 +1348,9 @@ It is run at the conclusion of `allout-flag-region'. | |||
| 1340 | 1348 | ||
| 1341 | Functions on the hook must take three arguments: | 1349 | Functions on the hook must take three arguments: |
| 1342 | 1350 | ||
| 1343 | - from - integer indicating the point at the start of the change. | 1351 | - FROM -- integer indicating the point at the start of the change. |
| 1344 | - to - integer indicating the point of the end of the change. | 1352 | - TO -- integer indicating the point of the end of the change. |
| 1345 | - flag - change mode: nil for exposure, otherwise concealment. | 1353 | - FLAG -- change mode: nil for exposure, otherwise concealment. |
| 1346 | 1354 | ||
| 1347 | This hook might be invoked multiple times by a single command. | 1355 | This hook might be invoked multiple times by a single command. |
| 1348 | 1356 | ||
| @@ -1354,10 +1362,10 @@ and eventually will not be invoked.") | |||
| 1354 | 1362 | ||
| 1355 | Functions on the hook should take two arguments: | 1363 | Functions on the hook should take two arguments: |
| 1356 | 1364 | ||
| 1357 | - new-start - integer indicating the point at the start of the first new item. | 1365 | - NEW-START -- integer indicating position of start of the first new item. |
| 1358 | - new-end - integer indicating the point of the end of the last new item. | 1366 | - NEW-END -- integer indicating position of end of the last new item. |
| 1359 | 1367 | ||
| 1360 | Some edits that introduce new items may missed by this hook - | 1368 | Some edits that introduce new items may missed by this hook: |
| 1361 | specifically edits that native allout routines do not control. | 1369 | specifically edits that native allout routines do not control. |
| 1362 | 1370 | ||
| 1363 | This hook might be invoked multiple times by a single command.") | 1371 | This hook might be invoked multiple times by a single command.") |
| @@ -1367,10 +1375,10 @@ This hook might be invoked multiple times by a single command.") | |||
| 1367 | 1375 | ||
| 1368 | Functions on the hook must take two arguments: | 1376 | Functions on the hook must take two arguments: |
| 1369 | 1377 | ||
| 1370 | - depth - integer indicating the depth of the subtree that was deleted. | 1378 | - DEPTH -- integer indicating the depth of the subtree that was deleted. |
| 1371 | - removed-from - integer indicating the point where the subtree was removed. | 1379 | - REMOVED-FROM -- integer indicating the point where the subtree was removed. |
| 1372 | 1380 | ||
| 1373 | Some edits that remove or invalidate items may missed by this hook - | 1381 | Some edits that remove or invalidate items may missed by this hook: |
| 1374 | specifically edits that native allout routines do not control. | 1382 | specifically edits that native allout routines do not control. |
| 1375 | 1383 | ||
| 1376 | This hook might be invoked multiple times by a single command.") | 1384 | This hook might be invoked multiple times by a single command.") |
| @@ -1380,10 +1388,10 @@ This hook might be invoked multiple times by a single command.") | |||
| 1380 | 1388 | ||
| 1381 | Functions on the hook should take two arguments: | 1389 | Functions on the hook should take two arguments: |
| 1382 | 1390 | ||
| 1383 | - depth-change - integer indicating depth increase, negative for decrease | 1391 | - DEPTH-CHANGE -- integer indicating depth increase, negative for decrease |
| 1384 | - start - integer indicating the start point of the shifted parent item. | 1392 | - START -- integer indicating the start point of the shifted parent item. |
| 1385 | 1393 | ||
| 1386 | Some edits that shift items can be missed by this hook - specifically edits | 1394 | Some edits that shift items can be missed by this hook: specifically edits |
| 1387 | that native allout routines do not control. | 1395 | that native allout routines do not control. |
| 1388 | 1396 | ||
| 1389 | This hook might be invoked multiple times by a single command.") | 1397 | This hook might be invoked multiple times by a single command.") |
| @@ -1460,7 +1468,7 @@ substition is used against the regexp matches, a la `replace-match'.") | |||
| 1460 | "Variable for regexps matching plaintext to remove before encryption. | 1468 | "Variable for regexps matching plaintext to remove before encryption. |
| 1461 | 1469 | ||
| 1462 | This is for the sake of redoing encryption in cases where the ciphertext | 1470 | This is for the sake of redoing encryption in cases where the ciphertext |
| 1463 | incidentally contains strings that would disrupt mode operation - | 1471 | incidentally contains strings that would disrupt mode operation -- |
| 1464 | for example, a line that happens to look like an allout-mode topic prefix. | 1472 | for example, a line that happens to look like an allout-mode topic prefix. |
| 1465 | 1473 | ||
| 1466 | Entries must be symbols that are bound to the desired regexp values. | 1474 | Entries must be symbols that are bound to the desired regexp values. |
| @@ -1478,7 +1486,7 @@ See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.") | |||
| 1478 | (make-variable-buffer-local 'allout-encryption-ciphertext-rejection-ceiling) | 1486 | (make-variable-buffer-local 'allout-encryption-ciphertext-rejection-ceiling) |
| 1479 | ;;;_ > allout-mode-p () | 1487 | ;;;_ > allout-mode-p () |
| 1480 | ;; Must define this macro above any uses, or byte compilation will lack | 1488 | ;; Must define this macro above any uses, or byte compilation will lack |
| 1481 | ;; proper def, if file isn't loaded - eg, during emacs build! | 1489 | ;; proper def, if file isn't loaded -- eg, during emacs build! |
| 1482 | (defmacro allout-mode-p () | 1490 | (defmacro allout-mode-p () |
| 1483 | "Return t if `allout-mode' is active in current buffer." | 1491 | "Return t if `allout-mode' is active in current buffer." |
| 1484 | 'allout-mode) | 1492 | 'allout-mode) |
| @@ -1501,13 +1509,12 @@ See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.") | |||
| 1501 | (condition-case failure | 1509 | (condition-case failure |
| 1502 | (setq allout-after-save-decrypt | 1510 | (setq allout-after-save-decrypt |
| 1503 | (allout-encrypt-decrypted except-mark)) | 1511 | (allout-encrypt-decrypted except-mark)) |
| 1504 | (message "allout-write-file-hook-handler suppressing error %s" | 1512 | (error (message |
| 1505 | failure) | 1513 | "allout-write-file-hook-handler suppressing error %s" |
| 1506 | (sit-for 2) | 1514 | failure) |
| 1507 | (error "allout-write-file-hook-handler suppressing error %s" | 1515 | (sit-for 2))))) |
| 1508 | failure)))) | ||
| 1509 | )) | 1516 | )) |
| 1510 | nil) | 1517 | nil) |
| 1511 | ;;;_ > allout-auto-save-hook-handler () | 1518 | ;;;_ > allout-auto-save-hook-handler () |
| 1512 | (defun allout-auto-save-hook-handler () | 1519 | (defun allout-auto-save-hook-handler () |
| 1513 | "Implement `allout-encrypt-unencrypted-on-saves' policy for auto save." | 1520 | "Implement `allout-encrypt-unencrypted-on-saves' policy for auto save." |
| @@ -1653,9 +1660,9 @@ the following two lines in your Emacs init file: | |||
| 1653 | (put 'allout-exposure-category 'invisible 'allout) | 1660 | (put 'allout-exposure-category 'invisible 'allout) |
| 1654 | (put 'allout-exposure-category 'evaporate t) | 1661 | (put 'allout-exposure-category 'evaporate t) |
| 1655 | ;; XXX We use isearch-open-invisible *and* isearch-mode-end-hook. The | 1662 | ;; XXX We use isearch-open-invisible *and* isearch-mode-end-hook. The |
| 1656 | ;; latter would be sufficient, but it seems that a separate behavior - | 1663 | ;; latter would be sufficient, but it seems that a separate behavior -- |
| 1657 | ;; the _transient_ opening of invisible text during isearch - is keyed to | 1664 | ;; the _transient_ opening of invisible text during isearch -- is keyed to |
| 1658 | ;; presence of the isearch-open-invisible property - even though this | 1665 | ;; presence of the isearch-open-invisible property -- even though this |
| 1659 | ;; property controls the isearch _arrival_ behavior. This is the case at | 1666 | ;; property controls the isearch _arrival_ behavior. This is the case at |
| 1660 | ;; least in emacs 21, 22.0, and xemacs 21.4. | 1667 | ;; least in emacs 21, 22.0, and xemacs 21.4. |
| 1661 | (put 'allout-exposure-category 'isearch-open-invisible | 1668 | (put 'allout-exposure-category 'isearch-open-invisible |
| @@ -1709,7 +1716,7 @@ variable. We recommend customizing `allout-command-prefix' to use just | |||
| 1709 | `\\C-c' as the command prefix, if the allout bindings don't conflict with | 1716 | `\\C-c' as the command prefix, if the allout bindings don't conflict with |
| 1710 | any personal bindings you have on \\C-c. In any case, outline structure | 1717 | any personal bindings you have on \\C-c. In any case, outline structure |
| 1711 | navigation and authoring is simplified by positioning the cursor on an | 1718 | navigation and authoring is simplified by positioning the cursor on an |
| 1712 | item's bullet character, the \"hot-spot\" - then you can invoke allout | 1719 | item's bullet character, the \"hot-spot\" -- then you can invoke allout |
| 1713 | commands with just the un-prefixed, un-control-shifted command letters. | 1720 | commands with just the un-prefixed, un-control-shifted command letters. |
| 1714 | This is described further in the HOT-SPOT Operation section. | 1721 | This is described further in the HOT-SPOT Operation section. |
| 1715 | 1722 | ||
| @@ -1730,7 +1737,7 @@ This is described further in the HOT-SPOT Operation section. | |||
| 1730 | \\[allout-backward-current-level] `allout-backward-current-level' | 1737 | \\[allout-backward-current-level] `allout-backward-current-level' |
| 1731 | \\[allout-end-of-entry] `allout-end-of-entry' | 1738 | \\[allout-end-of-entry] `allout-end-of-entry' |
| 1732 | \\[allout-beginning-of-current-entry] `allout-beginning-of-current-entry' (alternately, goes to hot-spot) | 1739 | \\[allout-beginning-of-current-entry] `allout-beginning-of-current-entry' (alternately, goes to hot-spot) |
| 1733 | \\[allout-beginning-of-line] `allout-beginning-of-line' - like regular beginning-of-line, but | 1740 | \\[allout-beginning-of-line] `allout-beginning-of-line' -- like regular beginning-of-line, but |
| 1734 | if immediately repeated cycles to the beginning of the current item | 1741 | if immediately repeated cycles to the beginning of the current item |
| 1735 | and then to the hot-spot (if `allout-beginning-of-line-cycles' is set). | 1742 | and then to the hot-spot (if `allout-beginning-of-line-cycles' is set). |
| 1736 | 1743 | ||
| @@ -1748,9 +1755,9 @@ This is described further in the HOT-SPOT Operation section. | |||
| 1748 | \\[allout-rebullet-current-heading] `allout-rebullet-current-heading' Prompt for alternate bullet for | 1755 | \\[allout-rebullet-current-heading] `allout-rebullet-current-heading' Prompt for alternate bullet for |
| 1749 | current topic | 1756 | current topic |
| 1750 | \\[allout-rebullet-topic] `allout-rebullet-topic' Reconcile bullets of topic and | 1757 | \\[allout-rebullet-topic] `allout-rebullet-topic' Reconcile bullets of topic and |
| 1751 | its' offspring - distinctive bullets are not changed, others | 1758 | its' offspring -- distinctive bullets are not changed, others |
| 1752 | are alternated according to nesting depth. | 1759 | are alternated according to nesting depth. |
| 1753 | \\[allout-number-siblings] `allout-number-siblings' Number bullets of topic and siblings - | 1760 | \\[allout-number-siblings] `allout-number-siblings' Number bullets of topic and siblings -- |
| 1754 | the offspring are not affected. | 1761 | the offspring are not affected. |
| 1755 | With repeat count, revoke numbering. | 1762 | With repeat count, revoke numbering. |
| 1756 | 1763 | ||
| @@ -1779,7 +1786,7 @@ M-x outlineify-sticky Activate outline mode for current buffer, | |||
| 1779 | \\[allout-copy-exposed-to-buffer] `allout-copy-exposed-to-buffer' | 1786 | \\[allout-copy-exposed-to-buffer] `allout-copy-exposed-to-buffer' |
| 1780 | Duplicate outline, sans concealed text, to | 1787 | Duplicate outline, sans concealed text, to |
| 1781 | buffer with name derived from derived from that | 1788 | buffer with name derived from derived from that |
| 1782 | of current buffer - \"*BUFFERNAME exposed*\". | 1789 | of current buffer -- \"*BUFFERNAME exposed*\". |
| 1783 | \\[allout-flatten-exposed-to-buffer] `allout-flatten-exposed-to-buffer' | 1790 | \\[allout-flatten-exposed-to-buffer] `allout-flatten-exposed-to-buffer' |
| 1784 | Like above 'copy-exposed', but convert topic | 1791 | Like above 'copy-exposed', but convert topic |
| 1785 | prefixes to section.subsection... numeric | 1792 | prefixes to section.subsection... numeric |
| @@ -1848,7 +1855,7 @@ without changes to the allout core. Here are key ones: | |||
| 1848 | 1855 | ||
| 1849 | Terminology | 1856 | Terminology |
| 1850 | 1857 | ||
| 1851 | Topic hierarchy constituents - TOPICS and SUBTOPICS: | 1858 | Topic hierarchy constituents -- TOPICS and SUBTOPICS: |
| 1852 | 1859 | ||
| 1853 | ITEM: A unitary outline element, including the HEADER and ENTRY text. | 1860 | ITEM: A unitary outline element, including the HEADER and ENTRY text. |
| 1854 | TOPIC: An ITEM and any ITEMs contained within it, ie having greater DEPTH | 1861 | TOPIC: An ITEM and any ITEMs contained within it, ie having greater DEPTH |
| @@ -1956,7 +1963,7 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." | |||
| 1956 | 1963 | ||
| 1957 | (cond | 1964 | (cond |
| 1958 | 1965 | ||
| 1959 | ;; Provision for v19.18, 19.19 bug - | 1966 | ;; Provision for v19.18, 19.19 bug -- |
| 1960 | ;; Emacs v 19.18, 19.19 file-var code invokes prop-line-designated | 1967 | ;; Emacs v 19.18, 19.19 file-var code invokes prop-line-designated |
| 1961 | ;; modes twice when file is visited. We have to avoid toggling mode | 1968 | ;; modes twice when file is visited. We have to avoid toggling mode |
| 1962 | ;; off on second invocation, so we detect it as best we can, and | 1969 | ;; off on second invocation, so we detect it as best we can, and |
| @@ -2101,7 +2108,7 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." | |||
| 2101 | (progn | 2108 | (progn |
| 2102 | (apply 'allout-expose-topic (list use-layout)) | 2109 | (apply 'allout-expose-topic (list use-layout)) |
| 2103 | (message "Adjusting '%s' exposure... done." (buffer-name))) | 2110 | (message "Adjusting '%s' exposure... done." (buffer-name))) |
| 2104 | ;; Problem applying exposure - notify user, but don't | 2111 | ;; Problem applying exposure -- notify user, but don't |
| 2105 | ;; interrupt, eg, file visit: | 2112 | ;; interrupt, eg, file visit: |
| 2106 | (error (message "%s" (car (cdr err))) | 2113 | (error (message "%s" (car (cdr err))) |
| 2107 | (sit-for 1)))))) | 2114 | (sit-for 1)))))) |
| @@ -2136,6 +2143,16 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." | |||
| 2136 | ;;;_ > allout-minor-mode | 2143 | ;;;_ > allout-minor-mode |
| 2137 | (defalias 'allout-minor-mode 'allout-mode) | 2144 | (defalias 'allout-minor-mode 'allout-mode) |
| 2138 | 2145 | ||
| 2146 | ;;;_ > allout-unload-function | ||
| 2147 | (defun allout-unload-function () | ||
| 2148 | "Unload the allout outline library." | ||
| 2149 | (save-current-buffer | ||
| 2150 | (dolist (buffer (buffer-list)) | ||
| 2151 | (set-buffer buffer) | ||
| 2152 | (when allout-mode (allout-mode -1)))) | ||
| 2153 | ;; continue standard unloading | ||
| 2154 | nil) | ||
| 2155 | |||
| 2139 | ;;;_ - Position Assessment | 2156 | ;;;_ - Position Assessment |
| 2140 | ;;;_ > allout-hidden-p (&optional pos) | 2157 | ;;;_ > allout-hidden-p (&optional pos) |
| 2141 | (defsubst allout-hidden-p (&optional pos) | 2158 | (defsubst allout-hidden-p (&optional pos) |
| @@ -2158,10 +2175,10 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." | |||
| 2158 | "Get confirmation before making arbitrary changes to invisible text. | 2175 | "Get confirmation before making arbitrary changes to invisible text. |
| 2159 | 2176 | ||
| 2160 | We expose the invisible text and ask for confirmation. Refusal or | 2177 | We expose the invisible text and ask for confirmation. Refusal or |
| 2161 | keyboard-quit abandons the changes, with keyboard-quit additionally | 2178 | `keyboard-quit' abandons the changes, with keyboard-quit additionally |
| 2162 | reclosing the opened text. | 2179 | reclosing the opened text. |
| 2163 | 2180 | ||
| 2164 | No confirmation is necessary when inhibit-read-only is set - eg, allout | 2181 | No confirmation is necessary when `inhibit-read-only' is set -- eg, allout |
| 2165 | internal functions use this feature cohesively bunch changes." | 2182 | internal functions use this feature cohesively bunch changes." |
| 2166 | 2183 | ||
| 2167 | (when (and (not inhibit-read-only) (not after)) | 2184 | (when (and (not inhibit-read-only) (not after)) |
| @@ -2199,7 +2216,7 @@ internal functions use this feature cohesively bunch changes." | |||
| 2199 | (defun allout-before-change-handler (beg end) | 2216 | (defun allout-before-change-handler (beg end) |
| 2200 | "Protect against changes to invisible text. | 2217 | "Protect against changes to invisible text. |
| 2201 | 2218 | ||
| 2202 | See allout-overlay-interior-modification-handler for details." | 2219 | See `allout-overlay-interior-modification-handler' for details." |
| 2203 | 2220 | ||
| 2204 | (if (and (allout-mode-p) undo-in-progress (allout-hidden-p)) | 2221 | (if (and (allout-mode-p) undo-in-progress (allout-hidden-p)) |
| 2205 | (allout-show-to-offshoot)) | 2222 | (allout-show-to-offshoot)) |
| @@ -2224,7 +2241,7 @@ function can also be used as an `isearch-mode-end-hook'." | |||
| 2224 | (if (and (allout-mode-p) (allout-hidden-p)) | 2241 | (if (and (allout-mode-p) (allout-hidden-p)) |
| 2225 | (allout-show-to-offshoot))) | 2242 | (allout-show-to-offshoot))) |
| 2226 | 2243 | ||
| 2227 | ;;;_ #3 Internal Position State-Tracking - "allout-recent-*" funcs | 2244 | ;;;_ #3 Internal Position State-Tracking -- "allout-recent-*" funcs |
| 2228 | ;;; All the basic outline functions that directly do string matches to | 2245 | ;;; All the basic outline functions that directly do string matches to |
| 2229 | ;;; evaluate heading prefix location set the variables | 2246 | ;;; evaluate heading prefix location set the variables |
| 2230 | ;;; `allout-recent-prefix-beginning' and `allout-recent-prefix-end' | 2247 | ;;; `allout-recent-prefix-beginning' and `allout-recent-prefix-end' |
| @@ -2252,10 +2269,12 @@ function can also be used as an `isearch-mode-end-hook'." | |||
| 2252 | (defsubst allout-prefix-data () | 2269 | (defsubst allout-prefix-data () |
| 2253 | "Register allout-prefix state data. | 2270 | "Register allout-prefix state data. |
| 2254 | 2271 | ||
| 2255 | For reference by `allout-recent' funcs. Returns BEGINNING." | 2272 | For reference by `allout-recent' funcs. Return |
| 2256 | (setq allout-recent-prefix-end (or (match-end 1) (match-end 2)) | 2273 | the new value of `allout-recent-prefix-beginning'." |
| 2274 | (setq allout-recent-prefix-end (or (match-end 1) (match-end 2) (match-end 3)) | ||
| 2257 | allout-recent-prefix-beginning (or (match-beginning 1) | 2275 | allout-recent-prefix-beginning (or (match-beginning 1) |
| 2258 | (match-beginning 2)) | 2276 | (match-beginning 2) |
| 2277 | (match-beginning 3)) | ||
| 2259 | allout-recent-depth (max 1 (- allout-recent-prefix-end | 2278 | allout-recent-depth (max 1 (- allout-recent-prefix-end |
| 2260 | allout-recent-prefix-beginning | 2279 | allout-recent-prefix-beginning |
| 2261 | allout-header-subtraction))) | 2280 | allout-header-subtraction))) |
| @@ -2306,7 +2325,7 @@ to return the current depth of the most recently matched topic." | |||
| 2306 | (defsubst allout-do-doublecheck () | 2325 | (defsubst allout-do-doublecheck () |
| 2307 | "True if current item conditions qualify for checking on topic aberrance." | 2326 | "True if current item conditions qualify for checking on topic aberrance." |
| 2308 | (and | 2327 | (and |
| 2309 | ;; presume integrity of outline and yanked content during yank - necessary, | 2328 | ;; presume integrity of outline and yanked content during yank -- necessary |
| 2310 | ;; to allow for level disparity of yank location and yanked text: | 2329 | ;; to allow for level disparity of yank location and yanked text: |
| 2311 | (not allout-inhibit-aberrance-doublecheck) | 2330 | (not allout-inhibit-aberrance-doublecheck) |
| 2312 | ;; allout-doublecheck-at-and-shallower is ceiling for doublecheck: | 2331 | ;; allout-doublecheck-at-and-shallower is ceiling for doublecheck: |
| @@ -2344,12 +2363,12 @@ exceeds the topic by more than one." | |||
| 2344 | (allout-prefix-data) | 2363 | (allout-prefix-data) |
| 2345 | (goto-char allout-recent-prefix-beginning) | 2364 | (goto-char allout-recent-prefix-beginning) |
| 2346 | (cond | 2365 | (cond |
| 2347 | ;; sibling - continue: | 2366 | ;; sibling -- continue: |
| 2348 | ((eq allout-recent-depth depth)) | 2367 | ((eq allout-recent-depth depth)) |
| 2349 | ;; first offspring is excessive - aberrant: | 2368 | ;; first offspring is excessive -- aberrant: |
| 2350 | ((> allout-recent-depth (1+ depth)) | 2369 | ((> allout-recent-depth (1+ depth)) |
| 2351 | (setq done t aberrant t)) | 2370 | (setq done t aberrant t)) |
| 2352 | ;; next non-sibling is lower-depth - not aberrant: | 2371 | ;; next non-sibling is lower-depth -- not aberrant: |
| 2353 | (t (setq done t)))))) | 2372 | (t (setq done t)))))) |
| 2354 | (if aberrant | 2373 | (if aberrant |
| 2355 | aberrant | 2374 | aberrant |
| @@ -2384,6 +2403,8 @@ Actually, returns prefix beginning point." | |||
| 2384 | (defun allout-depth () | 2403 | (defun allout-depth () |
| 2385 | "Return depth of topic most immediately containing point. | 2404 | "Return depth of topic most immediately containing point. |
| 2386 | 2405 | ||
| 2406 | Does not do doublecheck for aberrant topic header. | ||
| 2407 | |||
| 2387 | Return zero if point is not within any topic. | 2408 | Return zero if point is not within any topic. |
| 2388 | 2409 | ||
| 2389 | Like `allout-current-depth', but respects hidden as well as visible topics." | 2410 | Like `allout-current-depth', but respects hidden as well as visible topics." |
| @@ -2490,7 +2511,7 @@ Outermost is first." | |||
| 2490 | ;;;_ > allout-end-of-current-line () | 2511 | ;;;_ > allout-end-of-current-line () |
| 2491 | (defun allout-end-of-current-line () | 2512 | (defun allout-end-of-current-line () |
| 2492 | "Move to the end of line, past concealed text if any." | 2513 | "Move to the end of line, past concealed text if any." |
| 2493 | ;; XXX This is for symmetry with `allout-beginning-of-current-line' - | 2514 | ;; XXX This is for symmetry with `allout-beginning-of-current-line' -- |
| 2494 | ;; `move-end-of-line' doesn't suffer the same problem as | 2515 | ;; `move-end-of-line' doesn't suffer the same problem as |
| 2495 | ;; `move-beginning-of-line'. | 2516 | ;; `move-beginning-of-line'. |
| 2496 | (let ((inhibit-field-text-motion t)) | 2517 | (let ((inhibit-field-text-motion t)) |
| @@ -2564,7 +2585,7 @@ Outermost is first." | |||
| 2564 | 2585 | ||
| 2565 | Returns the location of the heading, or nil if none found. | 2586 | Returns the location of the heading, or nil if none found. |
| 2566 | 2587 | ||
| 2567 | We skip anomolous low-level topics, a la `allout-aberrant-container-p'." | 2588 | We skip anomalous low-level topics, a la `allout-aberrant-container-p'." |
| 2568 | (save-match-data | 2589 | (save-match-data |
| 2569 | 2590 | ||
| 2570 | (if (looking-at allout-regexp) | 2591 | (if (looking-at allout-regexp) |
| @@ -2572,10 +2593,14 @@ We skip anomolous low-level topics, a la `allout-aberrant-container-p'." | |||
| 2572 | 2593 | ||
| 2573 | (when (re-search-forward allout-line-boundary-regexp nil 0) | 2594 | (when (re-search-forward allout-line-boundary-regexp nil 0) |
| 2574 | (allout-prefix-data) | 2595 | (allout-prefix-data) |
| 2596 | (goto-char allout-recent-prefix-beginning) | ||
| 2597 | (while (not (bolp)) | ||
| 2598 | (forward-char -1)) | ||
| 2575 | (and (allout-do-doublecheck) | 2599 | (and (allout-do-doublecheck) |
| 2576 | ;; this will set allout-recent-* on the first non-aberrant topic, | 2600 | ;; this will set allout-recent-* on the first non-aberrant topic, |
| 2577 | ;; whether it's the current one or one that disqualifies it: | 2601 | ;; whether it's the current one or one that disqualifies it: |
| 2578 | (allout-aberrant-container-p)) | 2602 | (allout-aberrant-container-p)) |
| 2603 | ;; this may or may not be the same as above depending on doublecheck: | ||
| 2579 | (goto-char allout-recent-prefix-beginning)))) | 2604 | (goto-char allout-recent-prefix-beginning)))) |
| 2580 | ;;;_ > allout-this-or-next-heading | 2605 | ;;;_ > allout-this-or-next-heading |
| 2581 | (defun allout-this-or-next-heading () | 2606 | (defun allout-this-or-next-heading () |
| @@ -2589,7 +2614,7 @@ We skip anomolous low-level topics, a la `allout-aberrant-container-p'." | |||
| 2589 | 2614 | ||
| 2590 | Return the location of the beginning of the heading, or nil if not found. | 2615 | Return the location of the beginning of the heading, or nil if not found. |
| 2591 | 2616 | ||
| 2592 | We skip anomolous low-level topics, a la `allout-aberrant-container-p'." | 2617 | We skip anomalous low-level topics, a la `allout-aberrant-container-p'." |
| 2593 | 2618 | ||
| 2594 | (if (bobp) | 2619 | (if (bobp) |
| 2595 | nil | 2620 | nil |
| @@ -2687,9 +2712,9 @@ starting point, and PREV-DEPTH is depth of prior topic." | |||
| 2687 | ;; Register this one and move on: | 2712 | ;; Register this one and move on: |
| 2688 | (setq chart (cons allout-recent-prefix-beginning chart)) | 2713 | (setq chart (cons allout-recent-prefix-beginning chart)) |
| 2689 | (if (and levels (<= levels 1)) | 2714 | (if (and levels (<= levels 1)) |
| 2690 | ;; At depth limit - skip sublevels: | 2715 | ;; At depth limit -- skip sublevels: |
| 2691 | (or (allout-next-sibling curr-depth) | 2716 | (or (allout-next-sibling curr-depth) |
| 2692 | ;; or no more siblings - proceed to | 2717 | ;; or no more siblings -- proceed to |
| 2693 | ;; next heading at lesser depth: | 2718 | ;; next heading at lesser depth: |
| 2694 | (while (and (<= curr-depth | 2719 | (while (and (<= curr-depth |
| 2695 | allout-recent-depth) | 2720 | allout-recent-depth) |
| @@ -2762,7 +2787,7 @@ start point." | |||
| 2762 | (let ((further (allout-chart-to-reveal here (if (null depth) | 2787 | (let ((further (allout-chart-to-reveal here (if (null depth) |
| 2763 | depth | 2788 | depth |
| 2764 | (1- depth))))) | 2789 | (1- depth))))) |
| 2765 | ;; We're on the start of a subtree - recurse with it, if there's | 2790 | ;; We're on the start of a subtree -- recurse with it, if there's |
| 2766 | ;; more depth to go: | 2791 | ;; more depth to go: |
| 2767 | (if further (setq result (append further result))) | 2792 | (if further (setq result (append further result))) |
| 2768 | (setq chart (cdr chart))) | 2793 | (setq chart (cdr chart))) |
| @@ -3150,7 +3175,7 @@ situation." | |||
| 3150 | (progn (goto-char start-point) | 3175 | (progn (goto-char start-point) |
| 3151 | nil) | 3176 | nil) |
| 3152 | ;; rationale: if any intervening items were at a lower depth, we | 3177 | ;; rationale: if any intervening items were at a lower depth, we |
| 3153 | ;; would now be on the first offspring at the target depth - ie, | 3178 | ;; would now be on the first offspring at the target depth -- ie, |
| 3154 | ;; the preceeding item (per the search direction) must be at a | 3179 | ;; the preceeding item (per the search direction) must be at a |
| 3155 | ;; lesser depth. that's all we need to check. | 3180 | ;; lesser depth. that's all we need to check. |
| 3156 | (if backward (allout-next-heading) (allout-previous-heading)) | 3181 | (if backward (allout-next-heading) (allout-previous-heading)) |
| @@ -3228,7 +3253,7 @@ Move to buffer limit in indicated direction if headings are exhausted." | |||
| 3228 | (allout-aberrant-container-p)) | 3253 | (allout-aberrant-container-p)) |
| 3229 | ;; skip this aberrant prospective header line: | 3254 | ;; skip this aberrant prospective header line: |
| 3230 | t | 3255 | t |
| 3231 | ;; this prospective headerline qualifies - register: | 3256 | ;; this prospective headerline qualifies -- register: |
| 3232 | (setq got allout-recent-prefix-beginning) | 3257 | (setq got allout-recent-prefix-beginning) |
| 3233 | ;; and break the loop: | 3258 | ;; and break the loop: |
| 3234 | nil))))) | 3259 | nil))))) |
| @@ -3396,7 +3421,7 @@ Returns the qualifying command, if any, else nil." | |||
| 3396 | (>= 122 key-num)) ; "z" | 3421 | (>= 122 key-num)) ; "z" |
| 3397 | (- key-num 96) key-num))) | 3422 | (- key-num 96) key-num))) |
| 3398 | t)))) | 3423 | t)))) |
| 3399 | ;; Qualified as an allout command - do hot-spot operation. | 3424 | ;; Qualified as an allout command -- do hot-spot operation. |
| 3400 | (setq allout-post-goto-bullet t) | 3425 | (setq allout-post-goto-bullet t) |
| 3401 | ;; accept-defaults nil, or else we'll get allout-item-icon-key-handler. | 3426 | ;; accept-defaults nil, or else we'll get allout-item-icon-key-handler. |
| 3402 | (setq mapped-binding (key-binding (char-to-string key-num)))) | 3427 | (setq mapped-binding (key-binding (char-to-string key-num)))) |
| @@ -3498,7 +3523,7 @@ Second arg NEW indicates that a new topic is being opened after the | |||
| 3498 | topic at point, if non-nil. Default bullet for new topics, eg, may | 3523 | topic at point, if non-nil. Default bullet for new topics, eg, may |
| 3499 | be set (contingent to other args) to numbered bullets if previous | 3524 | be set (contingent to other args) to numbered bullets if previous |
| 3500 | sibling is one. The implication otherwise is that the current topic | 3525 | sibling is one. The implication otherwise is that the current topic |
| 3501 | is being adjusted - shifted or rebulleted - and we don't consider | 3526 | is being adjusted -- shifted or rebulleted -- and we don't consider |
| 3502 | bullet or previous sibling. | 3527 | bullet or previous sibling. |
| 3503 | 3528 | ||
| 3504 | Third arg DEPTH forces the topic prefix to that depth, regardless of | 3529 | Third arg DEPTH forces the topic prefix to that depth, regardless of |
| @@ -3544,11 +3569,11 @@ index for each successive sibling)." | |||
| 3544 | ;; Getting value for bullet char is practically the whole job: | 3569 | ;; Getting value for bullet char is practically the whole job: |
| 3545 | 3570 | ||
| 3546 | (cond | 3571 | (cond |
| 3547 | ; Simplest situation - level 1: | 3572 | ; Simplest situation -- level 1: |
| 3548 | ((<= depth 1) (setq header-lead "") allout-primary-bullet) | 3573 | ((<= depth 1) (setq header-lead "") allout-primary-bullet) |
| 3549 | ; Simple, too: all asterisks: | 3574 | ; Simple, too: all asterisks: |
| 3550 | (allout-old-style-prefixes | 3575 | (allout-old-style-prefixes |
| 3551 | ;; Cheat - make body the whole thing, null out header-lead and | 3576 | ;; Cheat -- make body the whole thing, null out header-lead and |
| 3552 | ;; bullet-char: | 3577 | ;; bullet-char: |
| 3553 | (setq body (make-string depth | 3578 | (setq body (make-string depth |
| 3554 | (string-to-char allout-primary-bullet))) | 3579 | (string-to-char allout-primary-bullet))) |
| @@ -3626,8 +3651,8 @@ index for each successive sibling)." | |||
| 3626 | "Open a new topic at depth DEPTH. | 3651 | "Open a new topic at depth DEPTH. |
| 3627 | 3652 | ||
| 3628 | New topic is situated after current one, unless optional flag BEFORE | 3653 | New topic is situated after current one, unless optional flag BEFORE |
| 3629 | is non-nil, or unless current line is completely empty - lacking even | 3654 | is non-nil, or unless current line is completely empty -- lacking even |
| 3630 | whitespace - in which case open is done on the current line. | 3655 | whitespace -- in which case open is done on the current line. |
| 3631 | 3656 | ||
| 3632 | When adding an offspring, it will be added immediately after the parent if | 3657 | When adding an offspring, it will be added immediately after the parent if |
| 3633 | the other offspring are exposed, or after the last child if the offspring | 3658 | the other offspring are exposed, or after the last child if the offspring |
| @@ -3692,7 +3717,7 @@ Nuances: | |||
| 3692 | 3717 | ||
| 3693 | (if (not opening-on-blank) | 3718 | (if (not opening-on-blank) |
| 3694 | ; Positioning and vertical | 3719 | ; Positioning and vertical |
| 3695 | ; padding - only if not | 3720 | ; padding -- only if not |
| 3696 | ; opening-on-blank: | 3721 | ; opening-on-blank: |
| 3697 | (progn | 3722 | (progn |
| 3698 | (goto-char ref-topic) | 3723 | (goto-char ref-topic) |
| @@ -3743,7 +3768,7 @@ Nuances: | |||
| 3743 | (open-line 1))) | 3768 | (open-line 1))) |
| 3744 | (allout-end-of-current-subtree) | 3769 | (allout-end-of-current-subtree) |
| 3745 | (if (looking-at "\n\n") (forward-char 1)))) | 3770 | (if (looking-at "\n\n") (forward-char 1)))) |
| 3746 | ;; Going inwards - double-space if first offspring is | 3771 | ;; Going inwards -- double-space if first offspring is |
| 3747 | ;; double-spaced, otherwise snug up. | 3772 | ;; double-spaced, otherwise snug up. |
| 3748 | (allout-end-of-entry) | 3773 | (allout-end-of-entry) |
| 3749 | (if (eobp) | 3774 | (if (eobp) |
| @@ -3753,7 +3778,7 @@ Nuances: | |||
| 3753 | (backward-char 1) | 3778 | (backward-char 1) |
| 3754 | (if (bolp) | 3779 | (if (bolp) |
| 3755 | ;; Blank lines between current header body and next | 3780 | ;; Blank lines between current header body and next |
| 3756 | ;; header - get to last substantive (non-white-space) | 3781 | ;; header -- get to last substantive (non-white-space) |
| 3757 | ;; line in body: | 3782 | ;; line in body: |
| 3758 | (progn (setq dbl-space t) | 3783 | (progn (setq dbl-space t) |
| 3759 | (re-search-backward "[^ \t\n]" nil t))) | 3784 | (re-search-backward "[^ \t\n]" nil t))) |
| @@ -3900,9 +3925,9 @@ Note that refill of indented paragraphs is not done." | |||
| 3900 | (not (looking-at allout-regexp))) | 3925 | (not (looking-at allout-regexp))) |
| 3901 | (if (> 0 (setq excess (- (- old-indent-end old-indent-begin) | 3926 | (if (> 0 (setq excess (- (- old-indent-end old-indent-begin) |
| 3902 | old-margin))) | 3927 | old-margin))) |
| 3903 | ;; Text starts left of old margin - don't adjust: | 3928 | ;; Text starts left of old margin -- don't adjust: |
| 3904 | nil | 3929 | nil |
| 3905 | ;; Text was hanging at or right of old left margin - | 3930 | ;; Text was hanging at or right of old left margin -- |
| 3906 | ;; reindent it, preserving its existing indentation | 3931 | ;; reindent it, preserving its existing indentation |
| 3907 | ;; beyond the old margin: | 3932 | ;; beyond the old margin: |
| 3908 | (delete-region old-indent-begin old-indent-end) | 3933 | (delete-region old-indent-begin old-indent-end) |
| @@ -3963,9 +3988,9 @@ Third arg NUMBER-CONTROL can force the prefix to or away from | |||
| 3963 | numbered form. It has effect only if `allout-numbered-bullet' is | 3988 | numbered form. It has effect only if `allout-numbered-bullet' is |
| 3964 | non-nil and soliciting was not explicitly invoked (via first arg). | 3989 | non-nil and soliciting was not explicitly invoked (via first arg). |
| 3965 | Its effect, numbering or denumbering, then depends on the setting | 3990 | Its effect, numbering or denumbering, then depends on the setting |
| 3966 | of the forth arg, INDEX. | 3991 | of the fourth arg, INDEX. |
| 3967 | 3992 | ||
| 3968 | If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the | 3993 | If NUMBER-CONTROL is non-nil and fourth arg INDEX is nil, then the |
| 3969 | prefix of the topic is forced to be non-numbered. Null index and | 3994 | prefix of the topic is forced to be non-numbered. Null index and |
| 3970 | non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and | 3995 | non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and |
| 3971 | non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil | 3996 | non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil |
| @@ -4050,7 +4075,7 @@ this function." | |||
| 4050 | 4075 | ||
| 4051 | Descends into invisible as well as visible topics, however. | 4076 | Descends into invisible as well as visible topics, however. |
| 4052 | 4077 | ||
| 4053 | When optional sans-offspring is non-nil, subtopics are not | 4078 | When optional SANS-OFFSPRING is non-nil, subtopics are not |
| 4054 | shifted. (Shifting a topic outwards without shifting its | 4079 | shifted. (Shifting a topic outwards without shifting its |
| 4055 | offspring is disallowed, since this would create a \"containment | 4080 | offspring is disallowed, since this would create a \"containment |
| 4056 | discontinuity\", where the depth difference between a topic and | 4081 | discontinuity\", where the depth difference between a topic and |
| @@ -4095,7 +4120,7 @@ Finally, if optional SANS-OFFSPRING is non-nil then the offspring | |||
| 4095 | are not shifted. (Shifting a topic outwards without shifting | 4120 | are not shifted. (Shifting a topic outwards without shifting |
| 4096 | its offspring is disallowed, since this would create a | 4121 | its offspring is disallowed, since this would create a |
| 4097 | \"containment discontinuity\", where the depth difference between | 4122 | \"containment discontinuity\", where the depth difference between |
| 4098 | a topic and its immediate offspring is greater than one..)" | 4123 | a topic and its immediate offspring is greater than one.)" |
| 4099 | 4124 | ||
| 4100 | ;; XXX the recursion here is peculiar, and in general the routine may | 4125 | ;; XXX the recursion here is peculiar, and in general the routine may |
| 4101 | ;; need simplification with refactoring. | 4126 | ;; need simplification with refactoring. |
| @@ -4160,7 +4185,7 @@ a topic and its immediate offspring is greater than one..)" | |||
| 4160 | nil)))) ;;; do-successors | 4185 | nil)))) ;;; do-successors |
| 4161 | 4186 | ||
| 4162 | ((< starting-depth new-depth) | 4187 | ((< starting-depth new-depth) |
| 4163 | ;; Rare case - subtopic more than one level deeper than parent. | 4188 | ;; Rare case -- subtopic more than one level deeper than parent. |
| 4164 | ;; Treat this one at an even deeper level: | 4189 | ;; Treat this one at an even deeper level: |
| 4165 | (allout-rebullet-topic-grunt relative-depth | 4190 | (allout-rebullet-topic-grunt relative-depth |
| 4166 | new-depth | 4191 | new-depth |
| @@ -4222,7 +4247,7 @@ Returns final depth." | |||
| 4222 | (defun allout-number-siblings (&optional denumber) | 4247 | (defun allout-number-siblings (&optional denumber) |
| 4223 | "Assign numbered topic prefix to this topic and its siblings. | 4248 | "Assign numbered topic prefix to this topic and its siblings. |
| 4224 | 4249 | ||
| 4225 | With universal argument, denumber - assign default bullet to this | 4250 | With universal argument, denumber -- assign default bullet to this |
| 4226 | topic and its siblings. | 4251 | topic and its siblings. |
| 4227 | 4252 | ||
| 4228 | With repeated universal argument (`^U^U'), solicit bullet for each | 4253 | With repeated universal argument (`^U^U'), solicit bullet for each |
| @@ -4381,7 +4406,7 @@ Trailing whitespace is killed with a topic if that whitespace: | |||
| 4381 | previous one. | 4406 | previous one. |
| 4382 | 4407 | ||
| 4383 | Topic exposure is marked with text-properties, to be used by | 4408 | Topic exposure is marked with text-properties, to be used by |
| 4384 | allout-yank-processing for exposure recovery." | 4409 | `allout-yank-processing' for exposure recovery." |
| 4385 | 4410 | ||
| 4386 | (interactive) | 4411 | (interactive) |
| 4387 | (let* ((inhibit-field-text-motion t) | 4412 | (let* ((inhibit-field-text-motion t) |
| @@ -4412,7 +4437,7 @@ allout-yank-processing for exposure recovery." | |||
| 4412 | (run-hook-with-args 'allout-structure-deleted-hook depth (point)))) | 4437 | (run-hook-with-args 'allout-structure-deleted-hook depth (point)))) |
| 4413 | ;;;_ > allout-copy-topic-as-kill () | 4438 | ;;;_ > allout-copy-topic-as-kill () |
| 4414 | (defun allout-copy-topic-as-kill () | 4439 | (defun allout-copy-topic-as-kill () |
| 4415 | "Like allout-kill-topic, but save to kill ring instead of deleting." | 4440 | "Like `allout-kill-topic', but save to kill ring instead of deleting." |
| 4416 | (interactive) | 4441 | (interactive) |
| 4417 | (let ((buffer-read-only t)) | 4442 | (let ((buffer-read-only t)) |
| 4418 | (condition-case nil | 4443 | (condition-case nil |
| @@ -4437,7 +4462,7 @@ allout-yank-processing for exposure recovery." | |||
| 4437 | 'invisible | 4462 | 'invisible |
| 4438 | nil end)))) | 4463 | nil end)))) |
| 4439 | (if (or (not next) (eq prev next)) | 4464 | (if (or (not next) (eq prev next)) |
| 4440 | ;; still not at start of hidden area - must not be any left. | 4465 | ;; still not at start of hidden area -- must not be any left. |
| 4441 | (setq done t) | 4466 | (setq done t) |
| 4442 | (goto-char next) | 4467 | (goto-char next) |
| 4443 | (setq prev next) | 4468 | (setq prev next) |
| @@ -4478,7 +4503,7 @@ allout-yank-processing for exposure recovery." | |||
| 4478 | 'allout-was-hidden | 4503 | 'allout-was-hidden |
| 4479 | nil end))) | 4504 | nil end))) |
| 4480 | (if (or (not next) (eq prev next)) | 4505 | (if (or (not next) (eq prev next)) |
| 4481 | ;; no more or not advancing - must not be any left. | 4506 | ;; no more or not advancing -- must not be any left. |
| 4482 | (setq done t) | 4507 | (setq done t) |
| 4483 | (goto-char next) | 4508 | (goto-char next) |
| 4484 | (setq prev next) | 4509 | (setq prev next) |
| @@ -4533,10 +4558,9 @@ however, are left exactly like normal, non-allout-specific yanks." | |||
| 4533 | ;; `rectify-numbering' if resituating (where several topics may | 4558 | ;; `rectify-numbering' if resituating (where several topics may |
| 4534 | ;; be resituating) or yanking a topic into a topic slot (bol): | 4559 | ;; be resituating) or yanking a topic into a topic slot (bol): |
| 4535 | (rectify-numbering (or resituate | 4560 | (rectify-numbering (or resituate |
| 4536 | (and into-bol | 4561 | (and into-bol (looking-at allout-regexp))))) |
| 4537 | (looking-at allout-regexp))))) | ||
| 4538 | (if resituate | 4562 | (if resituate |
| 4539 | ;; Yanking a topic into the start of a topic - reconcile to fit: | 4563 | ;; Yanking a topic into the start of a topic -- reconcile to fit: |
| 4540 | (let* ((inhibit-field-text-motion t) | 4564 | (let* ((inhibit-field-text-motion t) |
| 4541 | (prefix-len (if (not (match-end 1)) | 4565 | (prefix-len (if (not (match-end 1)) |
| 4542 | 1 | 4566 | 1 |
| @@ -4676,7 +4700,7 @@ works with normal `yank' in non-outline buffers." | |||
| 4676 | 4700 | ||
| 4677 | Adapts level of popped topics to level of fresh prefix. | 4701 | Adapts level of popped topics to level of fresh prefix. |
| 4678 | 4702 | ||
| 4679 | Note - prefix changes to distinctive bullets will stick, if followed | 4703 | Note -- prefix changes to distinctive bullets will stick, if followed |
| 4680 | by pops to non-distinctive yanks. Bug..." | 4704 | by pops to non-distinctive yanks. Bug..." |
| 4681 | 4705 | ||
| 4682 | (interactive "*p") | 4706 | (interactive "*p") |
| @@ -4695,7 +4719,7 @@ by pops to non-distinctive yanks. Bug..." | |||
| 4695 | (interactive) | 4719 | (interactive) |
| 4696 | (if (not allout-file-xref-bullet) | 4720 | (if (not allout-file-xref-bullet) |
| 4697 | (error | 4721 | (error |
| 4698 | "Outline cross references disabled - no `allout-file-xref-bullet'") | 4722 | "Outline cross references disabled -- no `allout-file-xref-bullet'") |
| 4699 | (if (not (string= (allout-current-bullet) allout-file-xref-bullet)) | 4723 | (if (not (string= (allout-current-bullet) allout-file-xref-bullet)) |
| 4700 | (error "Current heading lacks cross-reference bullet `%s'" | 4724 | (error "Current heading lacks cross-reference bullet `%s'" |
| 4701 | allout-file-xref-bullet) | 4725 | allout-file-xref-bullet) |
| @@ -4919,16 +4943,16 @@ Useful for coherently exposing to a random point in a hidden region." | |||
| 4919 | ))) | 4943 | ))) |
| 4920 | ;;;_ > allout-show-current-subtree (&optional arg) | 4944 | ;;;_ > allout-show-current-subtree (&optional arg) |
| 4921 | (defun allout-show-current-subtree (&optional arg) | 4945 | (defun allout-show-current-subtree (&optional arg) |
| 4922 | "Show everything within the current topic. With a repeat-count, | 4946 | "Show everything within the current topic. |
| 4923 | expose this topic and its siblings." | 4947 | With a repeat-count, expose this topic and its siblings." |
| 4924 | (interactive "P") | 4948 | (interactive "P") |
| 4925 | (save-excursion | 4949 | (save-excursion |
| 4926 | (if (<= (allout-current-depth) 0) | 4950 | (if (<= (allout-current-depth) 0) |
| 4927 | ;; Outside any topics - try to get to the first: | 4951 | ;; Outside any topics -- try to get to the first: |
| 4928 | (if (not (allout-next-heading)) | 4952 | (if (not (allout-next-heading)) |
| 4929 | (error "No topics") | 4953 | (error "No topics") |
| 4930 | ;; got to first, outermost topic - set to expose it and siblings: | 4954 | ;; got to first, outermost topic -- set to expose it and siblings: |
| 4931 | (message "Above outermost topic - exposing all.") | 4955 | (message "Above outermost topic -- exposing all.") |
| 4932 | (allout-flag-region (point-min)(point-max) nil)) | 4956 | (allout-flag-region (point-min)(point-max) nil)) |
| 4933 | (allout-beginning-of-current-line) | 4957 | (allout-beginning-of-current-line) |
| 4934 | (if (not arg) | 4958 | (if (not arg) |
| @@ -4966,7 +4990,7 @@ siblings, even if the target topic is already closed." | |||
| 4966 | 4990 | ||
| 4967 | (interactive) | 4991 | (interactive) |
| 4968 | (let* ((from (point)) | 4992 | (let* ((from (point)) |
| 4969 | (sibs-msg "Top-level topic already closed - closing siblings...") | 4993 | (sibs-msg "Top-level topic already closed -- closing siblings...") |
| 4970 | (current-exposed (not (allout-current-topic-collapsed-p t)))) | 4994 | (current-exposed (not (allout-current-topic-collapsed-p t)))) |
| 4971 | (cond (current-exposed (allout-flag-current-subtree t)) | 4995 | (cond (current-exposed (allout-flag-current-subtree t)) |
| 4972 | (just-close nil) | 4996 | (just-close nil) |
| @@ -5065,13 +5089,13 @@ Simple (numeric and null-list) specs are interpreted as follows: | |||
| 5065 | that level. | 5089 | that level. |
| 5066 | - positive numbers open to the relative depth indicated by the | 5090 | - positive numbers open to the relative depth indicated by the |
| 5067 | number, but do not force already opened subtopics to be closed. | 5091 | number, but do not force already opened subtopics to be closed. |
| 5068 | - 0 means to close topic - hide all offspring. | 5092 | - 0 means to close topic -- hide all offspring. |
| 5069 | : - `repeat' | 5093 | : - `repeat' |
| 5070 | apply prior element to all siblings at current level, *up to* | 5094 | apply prior element to all siblings at current level, *up to* |
| 5071 | those siblings that would be covered by specs following the `:' | 5095 | those siblings that would be covered by specs following the `:' |
| 5072 | on the list. Ie, apply to all topics at level but the last | 5096 | on the list. Ie, apply to all topics at level but the last |
| 5073 | ones. (Only first of multiple colons at same level is | 5097 | ones. (Only first of multiple colons at same level is |
| 5074 | respected - subsequent ones are discarded.) | 5098 | respected -- subsequent ones are discarded.) |
| 5075 | * - completely opens the topic, including bodies. | 5099 | * - completely opens the topic, including bodies. |
| 5076 | + - shows all the sub headers, but not the bodies | 5100 | + - shows all the sub headers, but not the bodies |
| 5077 | - - exposes the body of the corresponding topic. | 5101 | - - exposes the body of the corresponding topic. |
| @@ -5119,11 +5143,11 @@ Examples: | |||
| 5119 | ;; Expand the `repeat' spec to an explicit version, | 5143 | ;; Expand the `repeat' spec to an explicit version, |
| 5120 | ;; w.r.t. remaining siblings: | 5144 | ;; w.r.t. remaining siblings: |
| 5121 | (let ((residue ; = # of sibs not covered by remaining spec | 5145 | (let ((residue ; = # of sibs not covered by remaining spec |
| 5122 | ;; Dang - could be nice to make use of the chart, sigh: | 5146 | ;; Dang, could be nice to make use of the chart, sigh: |
| 5123 | (- (length (allout-chart-siblings)) | 5147 | (- (length (allout-chart-siblings)) |
| 5124 | (length spec)))) | 5148 | (length spec)))) |
| 5125 | (if (< 0 residue) | 5149 | (if (< 0 residue) |
| 5126 | ;; Some residue - cover it with prev-elem: | 5150 | ;; Some residue -- cover it with prev-elem: |
| 5127 | (setq spec (append (make-list residue prev-elem) | 5151 | (setq spec (append (make-list residue prev-elem) |
| 5128 | spec))))))) | 5152 | spec))))))) |
| 5129 | ((numberp curr-elem) | 5153 | ((numberp curr-elem) |
| @@ -5257,7 +5281,7 @@ Examples: | |||
| 5257 | (error "allout-new-exposure: Can't find any outline topics")) | 5281 | (error "allout-new-exposure: Can't find any outline topics")) |
| 5258 | (list 'allout-expose-topic (list 'quote spec)))) | 5282 | (list 'allout-expose-topic (list 'quote spec)))) |
| 5259 | 5283 | ||
| 5260 | ;;;_ #7 Systematic outline presentation - copying, printing, flattening | 5284 | ;;;_ #7 Systematic outline presentation -- copying, printing, flattening |
| 5261 | 5285 | ||
| 5262 | ;;;_ - Mapping and processing of topics | 5286 | ;;;_ - Mapping and processing of topics |
| 5263 | ;;;_ ( See also Subtree Charting, in Navigation code.) | 5287 | ;;;_ ( See also Subtree Charting, in Navigation code.) |
| @@ -5345,12 +5369,12 @@ the subject region. | |||
| 5345 | 5369 | ||
| 5346 | Optional START and END indicate bounds of region. | 5370 | Optional START and END indicate bounds of region. |
| 5347 | 5371 | ||
| 5348 | optional arg, FORMAT, designates an alternate presentation form for | 5372 | Optional arg, FORMAT, designates an alternate presentation form for |
| 5349 | the prefix: | 5373 | the prefix: |
| 5350 | 5374 | ||
| 5351 | list - Present prefix as numeric section.subsection..., starting with | 5375 | list -- Present prefix as numeric section.subsection..., starting with |
| 5352 | section indicated by the list, innermost nesting first. | 5376 | section indicated by the list, innermost nesting first. |
| 5353 | `indent' (symbol) - Convert header prefixes to all white space, | 5377 | `indent' (symbol) -- Convert header prefixes to all white space, |
| 5354 | except for distinctive bullets. | 5378 | except for distinctive bullets. |
| 5355 | 5379 | ||
| 5356 | The elements of the list produced are lists that represents a topic | 5380 | The elements of the list produced are lists that represents a topic |
| @@ -5375,7 +5399,7 @@ header and body. The elements of that list are: | |||
| 5375 | (beginning-of-line) | 5399 | (beginning-of-line) |
| 5376 | ;; Goto initial topic, and register preceeding stuff, if any: | 5400 | ;; Goto initial topic, and register preceeding stuff, if any: |
| 5377 | (if (> (allout-goto-prefix-doublechecked) start) | 5401 | (if (> (allout-goto-prefix-doublechecked) start) |
| 5378 | ;; First topic follows beginning point - register preliminary stuff: | 5402 | ;; First topic follows beginning point -- register preliminary stuff: |
| 5379 | (setq result (list (list 0 "" nil | 5403 | (setq result (list (list 0 "" nil |
| 5380 | (buffer-substring start (1- (point))))))) | 5404 | (buffer-substring start (1- (point))))))) |
| 5381 | (while (and (not done) | 5405 | (while (and (not done) |
| @@ -5443,7 +5467,7 @@ header and body. The elements of that list are: | |||
| 5443 | (cond ((= new-depth depth) | 5467 | (cond ((= new-depth depth) |
| 5444 | (setq format (cons (1+ (car format)) | 5468 | (setq format (cons (1+ (car format)) |
| 5445 | (cdr format)))) | 5469 | (cdr format)))) |
| 5446 | ((> new-depth depth) ; descending - assume by 1: | 5470 | ((> new-depth depth) ; descending -- assume by 1: |
| 5447 | (setq format (cons 1 format))) | 5471 | (setq format (cons 1 format))) |
| 5448 | (t | 5472 | (t |
| 5449 | ; Pop the residue: | 5473 | ; Pop the residue: |
| @@ -5459,10 +5483,10 @@ header and body. The elements of that list are: | |||
| 5459 | (nreverse result)))) | 5483 | (nreverse result)))) |
| 5460 | ;;;_ > allout-region-active-p () | 5484 | ;;;_ > allout-region-active-p () |
| 5461 | (defmacro allout-region-active-p () | 5485 | (defmacro allout-region-active-p () |
| 5462 | (if (fboundp 'use-region-p) | 5486 | (cond ((fboundp 'use-region-p) '(use-region-p)) |
| 5463 | '(use-region-p) | 5487 | ((fboundp 'region-active-p) '(region-active-p)) |
| 5464 | '(region-active-p))) | 5488 | (t 'mark-active))) |
| 5465 | ;;;_ > allout-process-exposed (&optional func from to frombuf | 5489 | ;;_ > allout-process-exposed (&optional func from to frombuf |
| 5466 | ;;; tobuf format) | 5490 | ;;; tobuf format) |
| 5467 | (defun allout-process-exposed (&optional func from to frombuf tobuf | 5491 | (defun allout-process-exposed (&optional func from to frombuf tobuf |
| 5468 | format start-num) | 5492 | format start-num) |
| @@ -5474,12 +5498,12 @@ Apply FUNCTION to exposed portions FROM position TO position in buffer | |||
| 5474 | FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an | 5498 | FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an |
| 5475 | alternate presentation form: | 5499 | alternate presentation form: |
| 5476 | 5500 | ||
| 5477 | `flat' - Present prefix as numeric section.subsection..., starting with | 5501 | `flat' -- Present prefix as numeric section.subsection..., starting with |
| 5478 | section indicated by the start-num, innermost nesting first. | 5502 | section indicated by the START-NUM, innermost nesting first. |
| 5479 | X`flat-indented' - Prefix is like `flat' for first topic at each | 5503 | X`flat-indented' -- Prefix is like `flat' for first topic at each |
| 5480 | X level, but subsequent topics have only leaf topic | 5504 | X level, but subsequent topics have only leaf topic |
| 5481 | X number, padded with blanks to line up with first. | 5505 | X number, padded with blanks to line up with first. |
| 5482 | `indent' (symbol) - Convert header prefixes to all white space, | 5506 | `indent' (symbol) -- Convert header prefixes to all white space, |
| 5483 | except for distinctive bullets. | 5507 | except for distinctive bullets. |
| 5484 | 5508 | ||
| 5485 | Defaults: | 5509 | Defaults: |
| @@ -5499,19 +5523,19 @@ Defaults: | |||
| 5499 | (setq from (point-min) to (point-max)))) | 5523 | (setq from (point-min) to (point-max)))) |
| 5500 | (if frombuf | 5524 | (if frombuf |
| 5501 | (if (not (bufferp frombuf)) | 5525 | (if (not (bufferp frombuf)) |
| 5502 | ;; Specified but not a buffer - get it: | 5526 | ;; Specified but not a buffer -- get it: |
| 5503 | (let ((got (get-buffer frombuf))) | 5527 | (let ((got (get-buffer frombuf))) |
| 5504 | (if (not got) | 5528 | (if (not got) |
| 5505 | (error (concat "allout-process-exposed: source buffer " | 5529 | (error (concat "allout-process-exposed: source buffer " |
| 5506 | frombuf | 5530 | frombuf |
| 5507 | " not found.")) | 5531 | " not found.")) |
| 5508 | (setq frombuf got)))) | 5532 | (setq frombuf got)))) |
| 5509 | ;; not specified - default it: | 5533 | ;; not specified -- default it: |
| 5510 | (setq frombuf (current-buffer))) | 5534 | (setq frombuf (current-buffer))) |
| 5511 | (if tobuf | 5535 | (if tobuf |
| 5512 | (if (not (bufferp tobuf)) | 5536 | (if (not (bufferp tobuf)) |
| 5513 | (setq tobuf (get-buffer-create tobuf))) | 5537 | (setq tobuf (get-buffer-create tobuf))) |
| 5514 | ;; not specified - default it: | 5538 | ;; not specified -- default it: |
| 5515 | (setq tobuf (concat "*" (buffer-name frombuf) " exposed*"))) | 5539 | (setq tobuf (concat "*" (buffer-name frombuf) " exposed*"))) |
| 5516 | (if (listp format) | 5540 | (if (listp format) |
| 5517 | (nreverse format)) | 5541 | (nreverse format)) |
| @@ -5598,7 +5622,7 @@ alternate presentation format for the outline: | |||
| 5598 | (defun allout-flatten-exposed-to-buffer (&optional arg tobuf) | 5622 | (defun allout-flatten-exposed-to-buffer (&optional arg tobuf) |
| 5599 | "Present numeric outline of outline's exposed portions in another buffer. | 5623 | "Present numeric outline of outline's exposed portions in another buffer. |
| 5600 | 5624 | ||
| 5601 | The resulting outline is not compatible with outline mode - use | 5625 | The resulting outline is not compatible with outline mode -- use |
| 5602 | `allout-copy-exposed-to-buffer' if you want that. | 5626 | `allout-copy-exposed-to-buffer' if you want that. |
| 5603 | 5627 | ||
| 5604 | Use `allout-indented-exposed-to-buffer' for indented presentation. | 5628 | Use `allout-indented-exposed-to-buffer' for indented presentation. |
| @@ -5614,7 +5638,7 @@ used verbatim." | |||
| 5614 | (defun allout-indented-exposed-to-buffer (&optional arg tobuf) | 5638 | (defun allout-indented-exposed-to-buffer (&optional arg tobuf) |
| 5615 | "Present indented outline of outline's exposed portions in another buffer. | 5639 | "Present indented outline of outline's exposed portions in another buffer. |
| 5616 | 5640 | ||
| 5617 | The resulting outline is not compatible with outline mode - use | 5641 | The resulting outline is not compatible with outline mode -- use |
| 5618 | `allout-copy-exposed-to-buffer' if you want that. | 5642 | `allout-copy-exposed-to-buffer' if you want that. |
| 5619 | 5643 | ||
| 5620 | Use `allout-flatten-exposed-to-buffer' for numeric sectional presentation. | 5644 | Use `allout-flatten-exposed-to-buffer' for numeric sectional presentation. |
| @@ -5843,7 +5867,7 @@ encryption are encrypted. See allout-encrypt-unencrypted-on-saves for | |||
| 5843 | auto-encryption specifics. | 5867 | auto-encryption specifics. |
| 5844 | 5868 | ||
| 5845 | \*NOTE WELL* that automatic encryption that happens during saves will | 5869 | \*NOTE WELL* that automatic encryption that happens during saves will |
| 5846 | default to symmetric encryption - you must deliberately (re)encrypt key-pair | 5870 | default to symmetric encryption -- you must deliberately (re)encrypt key-pair |
| 5847 | encrypted topics if you want them to continue to use the key-pair cipher. | 5871 | encrypted topics if you want them to continue to use the key-pair cipher. |
| 5848 | 5872 | ||
| 5849 | Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be | 5873 | Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be |
| @@ -5930,7 +5954,7 @@ See `allout-toggle-current-subtree-encryption' for more details." | |||
| 5930 | subtree-end)) | 5954 | subtree-end)) |
| 5931 | (subtree-end-char (char-after (1- subtree-end))) | 5955 | (subtree-end-char (char-after (1- subtree-end))) |
| 5932 | (subtree-trailing-char (char-after subtree-end)) | 5956 | (subtree-trailing-char (char-after subtree-end)) |
| 5933 | ;; kluge - result-text needs to be nil, but we also want to | 5957 | ;; kluge -- result-text needs to be nil, but we also want to |
| 5934 | ;; check for the error condition | 5958 | ;; check for the error condition |
| 5935 | (result-text (if (or (string= "" subject-text) | 5959 | (result-text (if (or (string= "" subject-text) |
| 5936 | (string= "\n" subject-text)) | 5960 | (string= "\n" subject-text)) |
| @@ -6017,18 +6041,19 @@ If DECRYPT is true (default false), then decrypt instead of encrypt. | |||
| 6017 | 6041 | ||
| 6018 | FETCH-PASS (default false) forces fresh prompting for the passphrase. | 6042 | FETCH-PASS (default false) forces fresh prompting for the passphrase. |
| 6019 | 6043 | ||
| 6020 | KEY-TYPE indicates whether to use a 'symmetric or 'keypair cipher. | 6044 | KEY-TYPE, either `symmetric' or `keypair', specifies which type |
| 6045 | of cypher to use. | ||
| 6021 | 6046 | ||
| 6022 | FOR-KEY is human readable identification of the first of the user's | 6047 | FOR-KEY is human readable identification of the first of the user's |
| 6023 | eligible secret keys a keypair decryption targets, or else nil. | 6048 | eligible secret keys a keypair decryption targets, or else nil. |
| 6024 | 6049 | ||
| 6025 | Optional RETRIED is for internal use - conveys the number of failed keys | 6050 | Optional RETRIED is for internal use -- conveys the number of failed keys |
| 6026 | that have been solicited in sequence leading to this current call. | 6051 | that have been solicited in sequence leading to this current call. |
| 6027 | 6052 | ||
| 6028 | Optional PASSPHRASE enables explicit delivery of the decryption passphrase, | 6053 | Optional PASSPHRASE enables explicit delivery of the decryption passphrase, |
| 6029 | for verification purposes. | 6054 | for verification purposes. |
| 6030 | 6055 | ||
| 6031 | Optional REJECTED is for internal use - conveys the number of | 6056 | Optional REJECTED is for internal use -- conveys the number of |
| 6032 | rejections due to matches against | 6057 | rejections due to matches against |
| 6033 | `allout-encryption-ciphertext-rejection-regexps', as limited by | 6058 | `allout-encryption-ciphertext-rejection-regexps', as limited by |
| 6034 | `allout-encryption-ciphertext-rejection-ceiling'. | 6059 | `allout-encryption-ciphertext-rejection-ceiling'. |
| @@ -6126,15 +6151,15 @@ Returns the resulting string, or nil if the transformation fails." | |||
| 6126 | 6151 | ||
| 6127 | (if status | 6152 | (if status |
| 6128 | (pgg-situate-output (point-min) (point-max)) | 6153 | (pgg-situate-output (point-min) (point-max)) |
| 6129 | ;; failed - handle passphrase caching | 6154 | ;; failed -- handle passphrase caching |
| 6130 | (if verifying | 6155 | (if verifying |
| 6131 | (throw 'encryption-failed nil) | 6156 | (throw 'encryption-failed nil) |
| 6132 | (pgg-remove-passphrase-from-cache target-cache-id t) | 6157 | (pgg-remove-passphrase-from-cache target-cache-id t) |
| 6133 | (error "Symmetric-cipher %scryption failed - %s" | 6158 | (error "Symmetric-cipher %scryption failed -- %s" |
| 6134 | (if decrypt "de" "en") | 6159 | (if decrypt "de" "en") |
| 6135 | "try again with different passphrase.")))) | 6160 | "try again with different passphrase")))) |
| 6136 | 6161 | ||
| 6137 | ;; encrypt 'keypair: | 6162 | ;; encrypt `keypair': |
| 6138 | ((not decrypt) | 6163 | ((not decrypt) |
| 6139 | 6164 | ||
| 6140 | (setq status | 6165 | (setq status |
| @@ -6147,7 +6172,7 @@ Returns the resulting string, or nil if the transformation fails." | |||
| 6147 | (error (pgg-remove-passphrase-from-cache target-cache-id t) | 6172 | (error (pgg-remove-passphrase-from-cache target-cache-id t) |
| 6148 | (error "encryption failed")))) | 6173 | (error "encryption failed")))) |
| 6149 | 6174 | ||
| 6150 | ;; decrypt 'keypair: | 6175 | ;; decrypt `keypair': |
| 6151 | (t | 6176 | (t |
| 6152 | 6177 | ||
| 6153 | (setq status | 6178 | (setq status |
| @@ -6163,7 +6188,7 @@ Returns the resulting string, or nil if the transformation fails." | |||
| 6163 | 1 (- (point-max) (if decrypt 0 1)))) | 6188 | 1 (- (point-max) (if decrypt 0 1)))) |
| 6164 | ) | 6189 | ) |
| 6165 | 6190 | ||
| 6166 | ;; validate result - non-empty | 6191 | ;; validate result -- non-empty |
| 6167 | (cond ((not result-text) | 6192 | (cond ((not result-text) |
| 6168 | (if verifying | 6193 | (if verifying |
| 6169 | nil | 6194 | nil |
| @@ -6199,7 +6224,7 @@ Returns the resulting string, or nil if the transformation fails." | |||
| 6199 | (string-match "[\C-a\C-k\C-o-\C-z\C-@]" | 6224 | (string-match "[\C-a\C-k\C-o-\C-z\C-@]" |
| 6200 | result-text)) | 6225 | result-text)) |
| 6201 | (error (concat "Encryption produced non-armored text, which" | 6226 | (error (concat "Encryption produced non-armored text, which" |
| 6202 | "conflicts with allout mode - reconfigure!"))) | 6227 | "conflicts with allout mode -- reconfigure!"))) |
| 6203 | 6228 | ||
| 6204 | ;; valid result and just verifying or non-symmetric: | 6229 | ;; valid result and just verifying or non-symmetric: |
| 6205 | ((or verifying (not (equal key-type 'symmetric))) | 6230 | ((or verifying (not (equal key-type 'symmetric))) |
| @@ -6208,7 +6233,7 @@ Returns the resulting string, or nil if the transformation fails." | |||
| 6208 | passphrase t)) | 6233 | passphrase t)) |
| 6209 | result-text) | 6234 | result-text) |
| 6210 | 6235 | ||
| 6211 | ;; valid result and regular symmetric - "register" | 6236 | ;; valid result and regular symmetric -- "register" |
| 6212 | ;; passphrase with mnemonic aids/cache. | 6237 | ;; passphrase with mnemonic aids/cache. |
| 6213 | (t | 6238 | (t |
| 6214 | (set-buffer allout-buffer) | 6239 | (set-buffer allout-buffer) |
| @@ -6239,7 +6264,7 @@ CACHE-ID is the cache id of the key for the passphrase. | |||
| 6239 | 6264 | ||
| 6240 | PROMPT-ID is the id for use when prompting the user. | 6265 | PROMPT-ID is the id for use when prompting the user. |
| 6241 | 6266 | ||
| 6242 | KEY-TYPE is either 'symmetric or 'keypair. | 6267 | KEY-TYPE is either `symmetric' or `keypair'. |
| 6243 | 6268 | ||
| 6244 | ALLOUT-BUFFER is the buffer containing the entry being en/decrypted. | 6269 | ALLOUT-BUFFER is the buffer containing the entry being en/decrypted. |
| 6245 | 6270 | ||
| @@ -6302,7 +6327,7 @@ of the availability of a cached copy." | |||
| 6302 | (if (and (not confirmation) | 6327 | (if (and (not confirmation) |
| 6303 | (if (yes-or-no-p | 6328 | (if (yes-or-no-p |
| 6304 | (concat "Passphrase differs from established" | 6329 | (concat "Passphrase differs from established" |
| 6305 | " - use new one instead? ")) | 6330 | " -- use new one instead? ")) |
| 6306 | ;; deactivate password for subsequent | 6331 | ;; deactivate password for subsequent |
| 6307 | ;; confirmation: | 6332 | ;; confirmation: |
| 6308 | (progn | 6333 | (progn |
| @@ -6312,11 +6337,11 @@ of the availability of a cached copy." | |||
| 6312 | t)) | 6337 | t)) |
| 6313 | (progn (pgg-remove-passphrase-from-cache cache-id t) | 6338 | (progn (pgg-remove-passphrase-from-cache cache-id t) |
| 6314 | (error "Wrong passphrase.")))) | 6339 | (error "Wrong passphrase.")))) |
| 6315 | ;; No verifier string - force confirmation by repetition of | 6340 | ;; No verifier string -- force confirmation by repetition of |
| 6316 | ;; (new) passphrase: | 6341 | ;; (new) passphrase: |
| 6317 | ((or fetch-pass (not cached)) | 6342 | ((or fetch-pass (not cached)) |
| 6318 | (pgg-remove-passphrase-from-cache cache-id t)))) | 6343 | (pgg-remove-passphrase-from-cache cache-id t)))) |
| 6319 | ;; confirmation vs new input - doing pgg-read-passphrase will do the | 6344 | ;; confirmation vs new input -- doing pgg-read-passphrase will do the |
| 6320 | ;; right thing, in either case: | 6345 | ;; right thing, in either case: |
| 6321 | (if (not confirmation) | 6346 | (if (not confirmation) |
| 6322 | (setq confirmation | 6347 | (setq confirmation |
| @@ -6327,7 +6352,7 @@ of the availability of a cached copy." | |||
| 6327 | (if (equal got-pass confirmation) | 6352 | (if (equal got-pass confirmation) |
| 6328 | confirmation | 6353 | confirmation |
| 6329 | (if (yes-or-no-p (concat "spelling of original and" | 6354 | (if (yes-or-no-p (concat "spelling of original and" |
| 6330 | " confirmation differ - retry? ")) | 6355 | " confirmation differ -- retry? ")) |
| 6331 | (progn (setq retried (if retried (1+ retried) 1)) | 6356 | (progn (setq retried (if retried (1+ retried) 1)) |
| 6332 | (pgg-remove-passphrase-from-cache cache-id t) | 6357 | (pgg-remove-passphrase-from-cache cache-id t) |
| 6333 | ;; recurse to this routine: | 6358 | ;; recurse to this routine: |
| @@ -6349,10 +6374,10 @@ of the availability of a cached copy." | |||
| 6349 | (defun allout-encrypted-key-info (text) | 6374 | (defun allout-encrypted-key-info (text) |
| 6350 | "Return a pair of the key type and identity of a recipient's secret key. | 6375 | "Return a pair of the key type and identity of a recipient's secret key. |
| 6351 | 6376 | ||
| 6352 | The key type is one of 'symmetric or 'keypair. | 6377 | The key type is one of `symmetric' or `keypair'. |
| 6353 | 6378 | ||
| 6354 | if 'keypair, and some of the user's secret keys are among those for which | 6379 | If `keypair', and some of the user's secret keys are among those for which |
| 6355 | the message was encoded, return the identity of the first. otherwise, | 6380 | the message was encoded, return the identity of the first. Otherwise, |
| 6356 | return nil for the second item of the pair. | 6381 | return nil for the second item of the pair. |
| 6357 | 6382 | ||
| 6358 | An error is raised if the text is not encrypted." | 6383 | An error is raised if the text is not encrypted." |
| @@ -6397,7 +6422,7 @@ An error is raised if the text is not encrypted." | |||
| 6397 | See `allout-passphrase-verifier-string' and `allout-passphrase-hint-string' | 6422 | See `allout-passphrase-verifier-string' and `allout-passphrase-hint-string' |
| 6398 | settings. | 6423 | settings. |
| 6399 | 6424 | ||
| 6400 | PASSPHRASE is the passphrase being mnemonicized | 6425 | PASSPHRASE is the passphrase being mnemonicized. |
| 6401 | 6426 | ||
| 6402 | OUTLINE-BUFFER is the buffer of the outline being adjusted. | 6427 | OUTLINE-BUFFER is the buffer of the outline being adjusted. |
| 6403 | 6428 | ||
| @@ -6475,7 +6500,7 @@ EXCEPT-MARK identifies a point whose containing topics should be excluded | |||
| 6475 | from encryption. This supports 'except-current mode of | 6500 | from encryption. This supports 'except-current mode of |
| 6476 | `allout-encrypt-unencrypted-on-saves'. | 6501 | `allout-encrypt-unencrypted-on-saves'. |
| 6477 | 6502 | ||
| 6478 | Such a topic has the allout-topic-encryption-bullet without an | 6503 | Such a topic has the `allout-topic-encryption-bullet' without an |
| 6479 | immediately following '*' that would mark the topic as being encrypted. It | 6504 | immediately following '*' that would mark the topic as being encrypted. It |
| 6480 | must also have content." | 6505 | must also have content." |
| 6481 | (let (done got content-beg) | 6506 | (let (done got content-beg) |
| @@ -6529,7 +6554,7 @@ must also have content." | |||
| 6529 | "Encrypt topics pending encryption except those containing exemption point. | 6554 | "Encrypt topics pending encryption except those containing exemption point. |
| 6530 | 6555 | ||
| 6531 | EXCEPT-MARK identifies a point whose containing topics should be excluded | 6556 | EXCEPT-MARK identifies a point whose containing topics should be excluded |
| 6532 | from encryption. This supports 'except-current mode of | 6557 | from encryption. This supports the `except-current' mode of |
| 6533 | `allout-encrypt-unencrypted-on-saves'. | 6558 | `allout-encrypt-unencrypted-on-saves'. |
| 6534 | 6559 | ||
| 6535 | If a topic that is currently being edited was encrypted, we return a list | 6560 | If a topic that is currently being edited was encrypted, we return a list |
| @@ -6597,7 +6622,7 @@ setup for auto-startup." | |||
| 6597 | (if (allout-goto-prefix) | 6622 | (if (allout-goto-prefix) |
| 6598 | t | 6623 | t |
| 6599 | (allout-open-topic 2) | 6624 | (allout-open-topic 2) |
| 6600 | (insert (concat "Dummy outline topic header - see" | 6625 | (insert (concat "Dummy outline topic header -- see" |
| 6601 | "`allout-mode' docstring: `^Hm'.")) | 6626 | "`allout-mode' docstring: `^Hm'.")) |
| 6602 | (allout-adjust-file-variable | 6627 | (allout-adjust-file-variable |
| 6603 | "allout-layout" (or allout-layout '(-1 : 0)))))) | 6628 | "allout-layout" (or allout-layout '(-1 : 0)))))) |
| @@ -6605,7 +6630,7 @@ setup for auto-startup." | |||
| 6605 | (defun allout-file-vars-section-data () | 6630 | (defun allout-file-vars-section-data () |
| 6606 | "Return data identifying the file-vars section, or nil if none. | 6631 | "Return data identifying the file-vars section, or nil if none. |
| 6607 | 6632 | ||
| 6608 | Returns list `(beginning-point prefix-string suffix-string)'." | 6633 | Returns a list of the form (BEGINNING-POINT PREFIX-STRING SUFFIX-STRING)." |
| 6609 | ;; minimally gleaned from emacs 21.4 files.el hack-local-variables function. | 6634 | ;; minimally gleaned from emacs 21.4 files.el hack-local-variables function. |
| 6610 | (let (beg prefix suffix) | 6635 | (let (beg prefix suffix) |
| 6611 | (save-excursion | 6636 | (save-excursion |
| @@ -6707,7 +6732,7 @@ not its value." | |||
| 6707 | got) | 6732 | got) |
| 6708 | (dolist (sym configvar-value) | 6733 | (dolist (sym configvar-value) |
| 6709 | (if (not (boundp sym)) | 6734 | (if (not (boundp sym)) |
| 6710 | (if (yes-or-no-p (format "%s entry `%s' is unbound - remove it? " | 6735 | (if (yes-or-no-p (format "%s entry `%s' is unbound -- remove it? " |
| 6711 | configvar-name sym)) | 6736 | configvar-name sym)) |
| 6712 | (delq sym (symbol-value configvar-name))) | 6737 | (delq sym (symbol-value configvar-name))) |
| 6713 | (push (symbol-value sym) got))) | 6738 | (push (symbol-value sym) got))) |
| @@ -6754,7 +6779,7 @@ Optional arg DO-DEFAULTING indicates to accept empty input (CR)." | |||
| 6754 | string | 6779 | string |
| 6755 | "")) | 6780 | "")) |
| 6756 | nil)))) | 6781 | nil)))) |
| 6757 | ;; got something out of loop - return it: | 6782 | ;; got something out of loop -- return it: |
| 6758 | got) | 6783 | got) |
| 6759 | ) | 6784 | ) |
| 6760 | ;;;_ : Strings: | 6785 | ;;;_ : Strings: |
| @@ -6762,7 +6787,7 @@ Optional arg DO-DEFAULTING indicates to accept empty input (CR)." | |||
| 6762 | (defun regexp-sans-escapes (regexp &optional successive-backslashes) | 6787 | (defun regexp-sans-escapes (regexp &optional successive-backslashes) |
| 6763 | "Return a copy of REGEXP with all character escapes stripped out. | 6788 | "Return a copy of REGEXP with all character escapes stripped out. |
| 6764 | 6789 | ||
| 6765 | Representations of actual backslashes - '\\\\\\\\' - are left as a | 6790 | Representations of actual backslashes -- '\\\\\\\\' -- are left as a |
| 6766 | single backslash. | 6791 | single backslash. |
| 6767 | 6792 | ||
| 6768 | Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion." | 6793 | Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion." |
| @@ -6810,7 +6835,7 @@ If BEG is bigger than END we return 0." | |||
| 6810 | (cond ((null list) nil) | 6835 | (cond ((null list) nil) |
| 6811 | ((atom (car list)) (cons (car list) (allout-flatten (cdr list)))) | 6836 | ((atom (car list)) (cons (car list) (allout-flatten (cdr list)))) |
| 6812 | (t (append (allout-flatten (car list)) (allout-flatten (cdr list)))))) | 6837 | (t (append (allout-flatten (car list)) (allout-flatten (cdr list)))))) |
| 6813 | ;;;_ : Compatability: | 6838 | ;;;_ : Compatibility: |
| 6814 | ;;;_ > allout-mark-marker to accommodate divergent emacsen: | 6839 | ;;;_ > allout-mark-marker to accommodate divergent emacsen: |
| 6815 | (defun allout-mark-marker (&optional force buffer) | 6840 | (defun allout-mark-marker (&optional force buffer) |
| 6816 | "Accommodate the different signature for `mark-marker' across Emacsen. | 6841 | "Accommodate the different signature for `mark-marker' across Emacsen. |
| @@ -6862,7 +6887,7 @@ BEG and END default respectively to the beginning and end of buffer." | |||
| 6862 | (move-overlay o end (overlay-end o)) | 6887 | (move-overlay o end (overlay-end o)) |
| 6863 | (delete-overlay o))))))) | 6888 | (delete-overlay o))))))) |
| 6864 | ) | 6889 | ) |
| 6865 | ;;;_ > copy-overlay if necessary - xemacs ~ 21.4 | 6890 | ;;;_ > copy-overlay if necessary -- xemacs ~ 21.4 |
| 6866 | (if (not (fboundp 'copy-overlay)) | 6891 | (if (not (fboundp 'copy-overlay)) |
| 6867 | (defun copy-overlay (o) | 6892 | (defun copy-overlay (o) |
| 6868 | "Return a copy of overlay O." | 6893 | "Return a copy of overlay O." |
| @@ -6874,7 +6899,7 @@ BEG and END default respectively to the beginning and end of buffer." | |||
| 6874 | (while props | 6899 | (while props |
| 6875 | (overlay-put o1 (pop props) (pop props))) | 6900 | (overlay-put o1 (pop props) (pop props))) |
| 6876 | o1))) | 6901 | o1))) |
| 6877 | ;;;_ > add-to-invisibility-spec if necessary - xemacs ~ 21.4 | 6902 | ;;;_ > add-to-invisibility-spec if necessary -- xemacs ~ 21.4 |
| 6878 | (if (not (fboundp 'add-to-invisibility-spec)) | 6903 | (if (not (fboundp 'add-to-invisibility-spec)) |
| 6879 | (defun add-to-invisibility-spec (element) | 6904 | (defun add-to-invisibility-spec (element) |
| 6880 | "Add ELEMENT to `buffer-invisibility-spec'. | 6905 | "Add ELEMENT to `buffer-invisibility-spec'. |
| @@ -6884,14 +6909,14 @@ that can be added." | |||
| 6884 | (setq buffer-invisibility-spec (list t))) | 6909 | (setq buffer-invisibility-spec (list t))) |
| 6885 | (setq buffer-invisibility-spec | 6910 | (setq buffer-invisibility-spec |
| 6886 | (cons element buffer-invisibility-spec)))) | 6911 | (cons element buffer-invisibility-spec)))) |
| 6887 | ;;;_ > remove-from-invisibility-spec if necessary - xemacs ~ 21.4 | 6912 | ;;;_ > remove-from-invisibility-spec if necessary -- xemacs ~ 21.4 |
| 6888 | (if (not (fboundp 'remove-from-invisibility-spec)) | 6913 | (if (not (fboundp 'remove-from-invisibility-spec)) |
| 6889 | (defun remove-from-invisibility-spec (element) | 6914 | (defun remove-from-invisibility-spec (element) |
| 6890 | "Remove ELEMENT from `buffer-invisibility-spec'." | 6915 | "Remove ELEMENT from `buffer-invisibility-spec'." |
| 6891 | (if (consp buffer-invisibility-spec) | 6916 | (if (consp buffer-invisibility-spec) |
| 6892 | (setq buffer-invisibility-spec (delete element | 6917 | (setq buffer-invisibility-spec (delete element |
| 6893 | buffer-invisibility-spec))))) | 6918 | buffer-invisibility-spec))))) |
| 6894 | ;;;_ > move-beginning-of-line if necessary - older emacs, xemacs | 6919 | ;;;_ > move-beginning-of-line if necessary -- older emacs, xemacs |
| 6895 | (if (not (fboundp 'move-beginning-of-line)) | 6920 | (if (not (fboundp 'move-beginning-of-line)) |
| 6896 | (defun move-beginning-of-line (arg) | 6921 | (defun move-beginning-of-line (arg) |
| 6897 | "Move point to beginning of current line as displayed. | 6922 | "Move point to beginning of current line as displayed. |
| @@ -6921,7 +6946,7 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." | |||
| 6921 | (skip-chars-backward "^\n")) | 6946 | (skip-chars-backward "^\n")) |
| 6922 | (vertical-motion 0)) | 6947 | (vertical-motion 0)) |
| 6923 | ) | 6948 | ) |
| 6924 | ;;;_ > move-end-of-line if necessary - older emacs, xemacs | 6949 | ;;;_ > move-end-of-line if necessary -- older emacs, xemacs |
| 6925 | (if (not (fboundp 'move-end-of-line)) | 6950 | (if (not (fboundp 'move-end-of-line)) |
| 6926 | (defun move-end-of-line (arg) | 6951 | (defun move-end-of-line (arg) |
| 6927 | "Move point to end of current line as displayed. | 6952 | "Move point to end of current line as displayed. |
| @@ -6990,7 +7015,7 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." | |||
| 6990 | (isearch-repeat 'forward) | 7015 | (isearch-repeat 'forward) |
| 6991 | (isearch-mode t))) | 7016 | (isearch-mode t))) |
| 6992 | 7017 | ||
| 6993 | ;;;_ #11 Unit tests - this should be last item before "Provide" | 7018 | ;;;_ #11 Unit tests -- this should be last item before "Provide" |
| 6994 | ;;;_ > allout-run-unit-tests () | 7019 | ;;;_ > allout-run-unit-tests () |
| 6995 | (defun allout-run-unit-tests () | 7020 | (defun allout-run-unit-tests () |
| 6996 | "Run the various allout unit tests." | 7021 | "Run the various allout unit tests." |
| @@ -7006,11 +7031,11 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." | |||
| 7006 | (while (boundp name) (makunbound name))) | 7031 | (while (boundp name) (makunbound name))) |
| 7007 | ;;;_ > allout-test-resumptions () | 7032 | ;;;_ > allout-test-resumptions () |
| 7008 | (defvar allout-tests-globally-unbound nil | 7033 | (defvar allout-tests-globally-unbound nil |
| 7009 | "Fodder for allout resumptions tests - defvar just for byte compiler.") | 7034 | "Fodder for allout resumptions tests -- defvar just for byte compiler.") |
| 7010 | (defvar allout-tests-globally-true nil | 7035 | (defvar allout-tests-globally-true nil |
| 7011 | "Fodder for allout resumptions tests - defvar just just for byte compiler.") | 7036 | "Fodder for allout resumptions tests -- defvar just for byte compiler.") |
| 7012 | (defvar allout-tests-locally-true nil | 7037 | (defvar allout-tests-locally-true nil |
| 7013 | "Fodder for allout resumptions tests - defvar just for byte compiler.") | 7038 | "Fodder for allout resumptions tests -- defvar just for byte compiler.") |
| 7014 | (defun allout-test-resumptions () | 7039 | (defun allout-test-resumptions () |
| 7015 | "Exercise allout resumptions." | 7040 | "Exercise allout resumptions." |
| 7016 | ;; for each resumption case, we also test that the right local/global | 7041 | ;; for each resumption case, we also test that the right local/global |
| @@ -7046,10 +7071,10 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." | |||
| 7046 | (allout-tests-obliterate-variable 'allout-tests-locally-true) | 7071 | (allout-tests-obliterate-variable 'allout-tests-locally-true) |
| 7047 | (set (make-local-variable 'allout-tests-locally-true) t) | 7072 | (set (make-local-variable 'allout-tests-locally-true) t) |
| 7048 | (assert (not (default-boundp 'allout-tests-locally-true)) | 7073 | (assert (not (default-boundp 'allout-tests-locally-true)) |
| 7049 | nil (concat "Test setup mistake - variable supposed to" | 7074 | nil (concat "Test setup mistake -- variable supposed to" |
| 7050 | " not have global binding, but it does.")) | 7075 | " not have global binding, but it does.")) |
| 7051 | (assert (local-variable-p 'allout-tests-locally-true) | 7076 | (assert (local-variable-p 'allout-tests-locally-true) |
| 7052 | nil (concat "Test setup mistake - variable supposed to have" | 7077 | nil (concat "Test setup mistake -- variable supposed to have" |
| 7053 | " local binding, but it lacks one.")) | 7078 | " local binding, but it lacks one.")) |
| 7054 | (allout-add-resumptions '(allout-tests-locally-true nil)) | 7079 | (allout-add-resumptions '(allout-tests-locally-true nil)) |
| 7055 | (assert (not (default-boundp 'allout-tests-locally-true))) | 7080 | (assert (not (default-boundp 'allout-tests-locally-true))) |
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 530325cd24e..db2818f31ed 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el | |||
| @@ -513,7 +513,7 @@ property." | |||
| 513 | (defun ansi-color-set-extent-face (extent face) | 513 | (defun ansi-color-set-extent-face (extent face) |
| 514 | "Set the `face' property of EXTENT to FACE. | 514 | "Set the `face' property of EXTENT to FACE. |
| 515 | XEmacs uses `set-extent-face', Emacs uses `overlay-put'." | 515 | XEmacs uses `set-extent-face', Emacs uses `overlay-put'." |
| 516 | (if (fboundp 'set-extent-face) | 516 | (if (featurep 'xemacs) |
| 517 | (set-extent-face extent face) | 517 | (set-extent-face extent face) |
| 518 | (overlay-put extent 'face face))) | 518 | (overlay-put extent 'face face))) |
| 519 | 519 | ||
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 2b417b06398..3e5cef9fec9 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el | |||
| @@ -1019,7 +1019,8 @@ using `make-temp-file', and the generated name is returned." | |||
| 1019 | (archive-maybe-update t)) | 1019 | (archive-maybe-update t)) |
| 1020 | (or (not (buffer-name buffer)) | 1020 | (or (not (buffer-name buffer)) |
| 1021 | (cond | 1021 | (cond |
| 1022 | (view-p (view-buffer buffer (and just-created 'kill-buffer))) | 1022 | (view-p (view-buffer |
| 1023 | buffer (and just-created 'kill-buffer-if-not-modified))) | ||
| 1023 | ((eq other-window-p 'display) (display-buffer buffer)) | 1024 | ((eq other-window-p 'display) (display-buffer buffer)) |
| 1024 | (other-window-p (switch-to-buffer-other-window buffer)) | 1025 | (other-window-p (switch-to-buffer-other-window buffer)) |
| 1025 | (t (switch-to-buffer buffer)))))) | 1026 | (t (switch-to-buffer buffer)))))) |
| @@ -1968,7 +1969,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." | |||
| 1968 | (archive-rar-extract tmpfile name)) | 1969 | (archive-rar-extract tmpfile name)) |
| 1969 | (if tmpbuf (kill-buffer tmpbuf)) | 1970 | (if tmpbuf (kill-buffer tmpbuf)) |
| 1970 | (delete-file tmpfile)))) | 1971 | (delete-file tmpfile)))) |
| 1971 | 1972 | ||
| 1972 | 1973 | ||
| 1973 | ;; ------------------------------------------------------------------------- | 1974 | ;; ------------------------------------------------------------------------- |
| 1974 | ;; This line was a mistake; it is kept now for compatibility. | 1975 | ;; This line was a mistake; it is kept now for compatibility. |
diff --git a/lisp/blank-mode.el b/lisp/blank-mode.el new file mode 100644 index 00000000000..8956e95ac1e --- /dev/null +++ b/lisp/blank-mode.el | |||
| @@ -0,0 +1,1726 @@ | |||
| 1 | ;;; blank-mode.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE | ||
| 2 | |||
| 3 | ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 | ||
| 4 | ;; Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> | ||
| 7 | ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> | ||
| 8 | ;; Keywords: data, wp | ||
| 9 | ;; Version: 9.2 | ||
| 10 | ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre | ||
| 11 | |||
| 12 | ;; This file is part of GNU Emacs. | ||
| 13 | |||
| 14 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 15 | ;; it under the terms of the GNU General Public License as published | ||
| 16 | ;; by the Free Software Foundation; either version 3, or (at your | ||
| 17 | ;; option) any later version. | ||
| 18 | |||
| 19 | ;; GNU Emacs is distributed in the hope that it will be useful, but | ||
| 20 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | ||
| 22 | ;; General Public License for more details. | ||
| 23 | |||
| 24 | ;; You should have received a copy of the GNU General Public License | ||
| 25 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 26 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | ||
| 27 | ;; Boston, MA 02110-1301, USA. | ||
| 28 | |||
| 29 | ;;; Commentary: | ||
| 30 | |||
| 31 | ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 32 | ;; | ||
| 33 | ;; Introduction | ||
| 34 | ;; ------------ | ||
| 35 | ;; | ||
| 36 | ;; This package is a minor mode to visualize blanks (TAB, (HARD) SPACE | ||
| 37 | ;; and NEWLINE). | ||
| 38 | ;; | ||
| 39 | ;; blank-mode uses two ways to visualize blanks: faces and display | ||
| 40 | ;; table. | ||
| 41 | ;; | ||
| 42 | ;; * Faces are used to highlight the background with a color. | ||
| 43 | ;; blank-mode uses font-lock to highlight blank characters. | ||
| 44 | ;; | ||
| 45 | ;; * Display table changes the way a character is displayed, that is, | ||
| 46 | ;; it provides a visual mark for characters, for example, at the end | ||
| 47 | ;; of line (?\xB6), at SPACEs (?\xB7) and at TABs (?\xBB). | ||
| 48 | ;; | ||
| 49 | ;; The `blank-style' and `blank-chars' variables are used to select | ||
| 50 | ;; which way should be used to visualize blanks. | ||
| 51 | ;; | ||
| 52 | ;; Note that when blank-mode is turned on, blank-mode saves the | ||
| 53 | ;; font-lock state, that is, if font-lock is on or off. And | ||
| 54 | ;; blank-mode restores the font-lock state when it is turned off. So, | ||
| 55 | ;; if blank-mode is turned on and font-lock is off, blank-mode also | ||
| 56 | ;; turns on the font-lock to highlight blanks, but the font-lock will | ||
| 57 | ;; be turned off when blank-mode is turned off. Thus, turn on | ||
| 58 | ;; font-lock before blank-mode is on, if you want that font-lock | ||
| 59 | ;; continues on after blank-mode is turned off. | ||
| 60 | ;; | ||
| 61 | ;; When blank-mode is on, it takes care of highlighting some special | ||
| 62 | ;; characters over the default mechanism of `nobreak-char-display' | ||
| 63 | ;; (which see) and `show-trailing-whitespace' (which see). | ||
| 64 | ;; | ||
| 65 | ;; There are two ways of using blank-mode: local and global. | ||
| 66 | ;; | ||
| 67 | ;; * Local blank-mode affects only the current buffer. | ||
| 68 | ;; | ||
| 69 | ;; * Global blank-mode affects all current and future buffers. That | ||
| 70 | ;; is, if you turn on global blank-mode and then create a new | ||
| 71 | ;; buffer, the new buffer will also have blank-mode on. The | ||
| 72 | ;; `blank-global-modes' variable controls which major-mode will be | ||
| 73 | ;; automagically turned on. | ||
| 74 | ;; | ||
| 75 | ;; You can mix the local and global usage without any conflict. But | ||
| 76 | ;; local blank-mode has priority over global blank-mode. Blank mode | ||
| 77 | ;; is active in a buffer if you have enabled it in that buffer or if | ||
| 78 | ;; you have enabled it globally. | ||
| 79 | ;; | ||
| 80 | ;; When global and local blank-mode are on: | ||
| 81 | ;; | ||
| 82 | ;; * if local blank-mode is turned off, blank-mode is turned off for | ||
| 83 | ;; the current buffer only. | ||
| 84 | ;; | ||
| 85 | ;; * if global blank-mode is turned off, blank-mode continues on only | ||
| 86 | ;; in the buffers in which local blank-mode is on. | ||
| 87 | ;; | ||
| 88 | ;; To use blank-mode, insert in your ~/.emacs: | ||
| 89 | ;; | ||
| 90 | ;; (require 'blank-mode) | ||
| 91 | ;; | ||
| 92 | ;; Or autoload at least one of the commands`blank-mode', | ||
| 93 | ;; `blank-toggle-options', `global-blank-mode' or | ||
| 94 | ;; `global-blank-toggle-options'. For example: | ||
| 95 | ;; | ||
| 96 | ;; (autoload 'blank-mode "blank-mode" | ||
| 97 | ;; "Toggle blank visualization." t) | ||
| 98 | ;; (autoload 'blank-toggle-options "blank-mode" | ||
| 99 | ;; "Toggle local `blank-mode' options." t) | ||
| 100 | ;; | ||
| 101 | ;; blank-mode was inspired by: | ||
| 102 | ;; | ||
| 103 | ;; whitespace.el Rajesh Vaidheeswarran <rv@gnu.org> | ||
| 104 | ;; Warn about and clean bogus whitespaces in the file | ||
| 105 | ;; (inspired the idea to warn and clean some blanks) | ||
| 106 | ;; | ||
| 107 | ;; show-whitespace-mode.el Aurelien Tisne <aurelien.tisne@free.fr> | ||
| 108 | ;; Simple mode to highlight whitespaces | ||
| 109 | ;; (inspired the idea to use font-lock) | ||
| 110 | ;; | ||
| 111 | ;; whitespace-mode.el Lawrence Mitchell <wence@gmx.li> | ||
| 112 | ;; Major mode for editing Whitespace | ||
| 113 | ;; (inspired the idea to use display table) | ||
| 114 | ;; | ||
| 115 | ;; visws.el Miles Bader <miles@gnu.org> | ||
| 116 | ;; Make whitespace visible | ||
| 117 | ;; (handle display table, his code was modified, but the main | ||
| 118 | ;; idea was kept) | ||
| 119 | ;; | ||
| 120 | ;; | ||
| 121 | ;; Using blank-mode | ||
| 122 | ;; ---------------- | ||
| 123 | ;; | ||
| 124 | ;; There is no problem if you mix local and global minor mode usage. | ||
| 125 | ;; | ||
| 126 | ;; * LOCAL blank-mode: | ||
| 127 | ;; + To toggle blank-mode options locally, type: | ||
| 128 | ;; | ||
| 129 | ;; M-x blank-toggle-options RET | ||
| 130 | ;; | ||
| 131 | ;; + To activate blank-mode locally, type: | ||
| 132 | ;; | ||
| 133 | ;; C-u 1 M-x blank-mode RET | ||
| 134 | ;; | ||
| 135 | ;; + To deactivate blank-mode locally, type: | ||
| 136 | ;; | ||
| 137 | ;; C-u 0 M-x blank-mode RET | ||
| 138 | ;; | ||
| 139 | ;; + To toggle blank-mode locally, type: | ||
| 140 | ;; | ||
| 141 | ;; M-x blank-mode RET | ||
| 142 | ;; | ||
| 143 | ;; * GLOBAL blank-mode: | ||
| 144 | ;; + To toggle blank-mode options globally, type: | ||
| 145 | ;; | ||
| 146 | ;; M-x global-blank-toggle-options RET | ||
| 147 | ;; | ||
| 148 | ;; + To activate blank-mode globally, type: | ||
| 149 | ;; | ||
| 150 | ;; C-u 1 M-x global-blank-mode RET | ||
| 151 | ;; | ||
| 152 | ;; + To deactivate blank-mode globally, type: | ||
| 153 | ;; | ||
| 154 | ;; C-u 0 M-x global-blank-mode RET | ||
| 155 | ;; | ||
| 156 | ;; + To toggle blank-mode globally, type: | ||
| 157 | ;; | ||
| 158 | ;; M-x global-blank-mode RET | ||
| 159 | ;; | ||
| 160 | ;; There are also the following useful commands: | ||
| 161 | ;; | ||
| 162 | ;; `blank-cleanup' | ||
| 163 | ;; Cleanup some blank problems in all buffer or at region. | ||
| 164 | ;; | ||
| 165 | ;; `blank-cleanup-region' | ||
| 166 | ;; Cleanup some blank problems at region. | ||
| 167 | ;; | ||
| 168 | ;; The problems, which are cleaned up, are: | ||
| 169 | ;; | ||
| 170 | ;; 1. empty lines at beginning of buffer. | ||
| 171 | ;; 2. empty lines at end of buffer. | ||
| 172 | ;; If `blank-chars' has `empty' as an element, remove all empty | ||
| 173 | ;; lines at beginning and/or end of buffer. | ||
| 174 | ;; | ||
| 175 | ;; 3. 8 or more SPACEs at beginning of line. | ||
| 176 | ;; If `blank-chars' has `indentation' as an element, replace 8 or | ||
| 177 | ;; more SPACEs at beginning of line by TABs. | ||
| 178 | ;; | ||
| 179 | ;; 4. SPACEs before TAB. | ||
| 180 | ;; If `blank-chars' has `space-before-tab' as an element, replace | ||
| 181 | ;; SPACEs by TABs. | ||
| 182 | ;; | ||
| 183 | ;; 5. SPACEs or TABs at end of line. | ||
| 184 | ;; If `blank-chars' has `trailing' as an element, remove all | ||
| 185 | ;; SPACEs or TABs at end of line." | ||
| 186 | ;; | ||
| 187 | ;; 6. 8 or more SPACEs after TAB. | ||
| 188 | ;; If `blank-chars' has `space-after-tab' as an element, replace | ||
| 189 | ;; SPACEs by TABs. | ||
| 190 | ;; | ||
| 191 | ;; | ||
| 192 | ;; Hooks | ||
| 193 | ;; ----- | ||
| 194 | ;; | ||
| 195 | ;; blank-mode has the following hook variables: | ||
| 196 | ;; | ||
| 197 | ;; `blank-mode-hook' | ||
| 198 | ;; It is evaluated always when blank-mode is turned on locally. | ||
| 199 | ;; | ||
| 200 | ;; `global-blank-mode-hook' | ||
| 201 | ;; It is evaluated always when blank-mode is turned on globally. | ||
| 202 | ;; | ||
| 203 | ;; `blank-load-hook' | ||
| 204 | ;; It is evaluated after blank-mode package is loaded. | ||
| 205 | ;; | ||
| 206 | ;; | ||
| 207 | ;; Options | ||
| 208 | ;; ------- | ||
| 209 | ;; | ||
| 210 | ;; Below it's shown a brief description of blank-mode options, please, | ||
| 211 | ;; see the options declaration in the code for a long documentation. | ||
| 212 | ;; | ||
| 213 | ;; `blank-style' Specify the visualization style. | ||
| 214 | ;; | ||
| 215 | ;; `blank-chars' Specify which kind of blank is | ||
| 216 | ;; visualized. | ||
| 217 | ;; | ||
| 218 | ;; `blank-space' Face used to visualize SPACE. | ||
| 219 | ;; | ||
| 220 | ;; `blank-hspace' Face used to visualize HARD SPACE. | ||
| 221 | ;; | ||
| 222 | ;; `blank-tab' Face used to visualize TAB. | ||
| 223 | ;; | ||
| 224 | ;; `blank-newline' Face used to visualize NEWLINE char | ||
| 225 | ;; mapping. | ||
| 226 | ;; | ||
| 227 | ;; `blank-trailing' Face used to visualize trailing | ||
| 228 | ;; blanks. | ||
| 229 | ;; | ||
| 230 | ;; `blank-line' Face used to visualize "long" lines. | ||
| 231 | ;; | ||
| 232 | ;; `blank-space-before-tab' Face used to visualize SPACEs before | ||
| 233 | ;; TAB. | ||
| 234 | ;; | ||
| 235 | ;; `blank-indentation' Face used to visualize 8 or more | ||
| 236 | ;; SPACEs at beginning of line. | ||
| 237 | ;; | ||
| 238 | ;; `blank-empty' Face used to visualize empty lines at | ||
| 239 | ;; beginning and/or end of buffer. | ||
| 240 | ;; | ||
| 241 | ;; `blank-space-after-tab' Face used to visualize 8 or more | ||
| 242 | ;; SPACEs after TAB. | ||
| 243 | ;; | ||
| 244 | ;; `blank-space-regexp' Specify SPACE characters regexp. | ||
| 245 | ;; | ||
| 246 | ;; `blank-hspace-regexp' Specify HARD SPACE characters regexp. | ||
| 247 | ;; | ||
| 248 | ;; `blank-tab-regexp' Specify TAB characters regexp. | ||
| 249 | ;; | ||
| 250 | ;; `blank-trailing-regexp' Specify trailing characters regexp. | ||
| 251 | ;; | ||
| 252 | ;; `blank-space-before-tab-regexp' Specify SPACEs before TAB | ||
| 253 | ;; regexp. | ||
| 254 | ;; | ||
| 255 | ;; `blank-indentation-regexp' Specify regexp for 8 or more SPACEs at | ||
| 256 | ;; beginning of line. | ||
| 257 | ;; | ||
| 258 | ;; `blank-empty-at-bob-regexp' Specify regexp for empty lines at | ||
| 259 | ;; beginning of buffer. | ||
| 260 | ;; | ||
| 261 | ;; `blank-empty-at-eob-regexp' Specify regexp for empty lines at end | ||
| 262 | ;; of buffer. | ||
| 263 | ;; | ||
| 264 | ;; `blank-space-after-tab-regexp' Specify regexp for 8 or more | ||
| 265 | ;; SPACEs after TAB. | ||
| 266 | ;; | ||
| 267 | ;; `blank-line-column' Specify column beyond which the line | ||
| 268 | ;; is highlighted. | ||
| 269 | ;; | ||
| 270 | ;; `blank-display-mappings' Specify an alist of mappings for | ||
| 271 | ;; displaying characters. | ||
| 272 | ;; | ||
| 273 | ;; `blank-global-modes' Modes for which global `blank-mode' is | ||
| 274 | ;; automagically turned on. | ||
| 275 | ;; | ||
| 276 | ;; | ||
| 277 | ;; Acknowledgements | ||
| 278 | ;; ---------------- | ||
| 279 | ;; | ||
| 280 | ;; Thanks to nschum (EmacsWiki) for the idea about highlight "long" | ||
| 281 | ;; lines tail. See EightyColumnRule (EmacsWiki). | ||
| 282 | ;; | ||
| 283 | ;; Thanks to Juri Linkov <juri@jurta.org> for suggesting: | ||
| 284 | ;; * `define-minor-mode'. | ||
| 285 | ;; * `global-blank-*' name for global commands. | ||
| 286 | ;; | ||
| 287 | ;; Thanks to Robert J. Chassell <bob@gnu.org> for doc fix and testing. | ||
| 288 | ;; | ||
| 289 | ;; Thanks to Drew Adams <drew.adams@oracle.com> for toggle commands | ||
| 290 | ;; suggestion. | ||
| 291 | ;; | ||
| 292 | ;; Thanks to Antti Kaihola <antti.kaihola@linux-aktivaattori.org> for | ||
| 293 | ;; helping to fix `find-file-hooks' reference. | ||
| 294 | ;; | ||
| 295 | ;; Thanks to Andreas Roehler <andreas.roehler@easy-emacs.de> for | ||
| 296 | ;; indicating defface byte-compilation warnings. | ||
| 297 | ;; | ||
| 298 | ;; Thanks to TimOCallaghan (EmacsWiki) for the idea about highlight | ||
| 299 | ;; "long" lines. See EightyColumnRule (EmacsWiki). | ||
| 300 | ;; | ||
| 301 | ;; Thanks to Yanghui Bian <yanghuibian@gmail.com> for indicating a new | ||
| 302 | ;; newline character mapping. | ||
| 303 | ;; | ||
| 304 | ;; Thanks to Pete Forman <pete.forman@westgeo.com> for indicating | ||
| 305 | ;; whitespace-mode on XEmacs. | ||
| 306 | ;; | ||
| 307 | ;; Thanks to Miles Bader <miles@gnu.org> for handling display table via | ||
| 308 | ;; visws.el (his code was modified, but the main idea was kept). | ||
| 309 | ;; | ||
| 310 | ;; Thanks to: | ||
| 311 | ;; Rajesh Vaidheeswarran <rv@gnu.org> whitespace.el | ||
| 312 | ;; Aurelien Tisne <aurelien.tisne@free.fr> show-whitespace-mode.el | ||
| 313 | ;; Lawrence Mitchell <wence@gmx.li> whitespace-mode.el | ||
| 314 | ;; Miles Bader <miles@gnu.org> visws.el | ||
| 315 | ;; And to all people who contributed with them. | ||
| 316 | ;; | ||
| 317 | ;; | ||
| 318 | ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 319 | |||
| 320 | ;;; code: | ||
| 321 | |||
| 322 | |||
| 323 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 324 | ;;;; User Variables: | ||
| 325 | |||
| 326 | |||
| 327 | ;;; Interface to the command system | ||
| 328 | |||
| 329 | |||
| 330 | (defgroup blank nil | ||
| 331 | "Visualize blanks (TAB, (HARD) SPACE and NEWLINE)." | ||
| 332 | :link '(emacs-library-link :tag "Source Lisp File" "blank-mode.el") | ||
| 333 | :version "22.2" | ||
| 334 | :group 'wp | ||
| 335 | :group 'data) | ||
| 336 | |||
| 337 | |||
| 338 | (defcustom blank-style '(mark color) | ||
| 339 | "*Specify the visualization style. | ||
| 340 | |||
| 341 | It's a list which element value can be: | ||
| 342 | |||
| 343 | mark display mappings are visualized. | ||
| 344 | |||
| 345 | color faces are visualized. | ||
| 346 | |||
| 347 | Any other value is ignored. | ||
| 348 | |||
| 349 | If nil, don't visualize TABs, (HARD) SPACEs and NEWLINEs. | ||
| 350 | |||
| 351 | See also `blank-display-mappings' for documentation." | ||
| 352 | :type '(repeat :tag "Style of Blank" | ||
| 353 | (choice :tag "Style of Blank" | ||
| 354 | (const :tag "Display Table" mark) | ||
| 355 | (const :tag "Faces" color))) | ||
| 356 | :group 'blank) | ||
| 357 | |||
| 358 | |||
| 359 | (defcustom blank-chars | ||
| 360 | '(tabs spaces trailing lines space-before-tab newline | ||
| 361 | indentation empty space-after-tab) | ||
| 362 | "*Specify which kind of blank is visualized. | ||
| 363 | |||
| 364 | It's a list which element value can be: | ||
| 365 | |||
| 366 | trailing trailing blanks are visualized. | ||
| 367 | |||
| 368 | tabs TABs are visualized. | ||
| 369 | |||
| 370 | spaces SPACEs and HARD SPACEs are visualized. | ||
| 371 | |||
| 372 | lines lines whose have columns beyond | ||
| 373 | `blank-line-column' are highlighted. | ||
| 374 | Whole line is highlighted. | ||
| 375 | It has precedence over | ||
| 376 | `lines-tail' (see below). | ||
| 377 | |||
| 378 | lines-tail lines whose have columns beyond | ||
| 379 | `blank-line-column' are highlighted. | ||
| 380 | But only the part of line which goes | ||
| 381 | beyond `blank-line-column' column. | ||
| 382 | It has effect only if `lines' (see above) | ||
| 383 | is not present in `blank-chars'. | ||
| 384 | |||
| 385 | space-before-tab SPACEs before TAB are visualized. | ||
| 386 | |||
| 387 | newline NEWLINEs are visualized. | ||
| 388 | |||
| 389 | indentation 8 or more SPACEs at beginning of line are | ||
| 390 | visualized. | ||
| 391 | |||
| 392 | empty empty lines at beginning and/or end of buffer | ||
| 393 | are visualized. | ||
| 394 | |||
| 395 | space-after-tab 8 or more SPACEs after a TAB are visualized. | ||
| 396 | |||
| 397 | Any other value is ignored. | ||
| 398 | |||
| 399 | If nil, don't visualize TABs, (HARD) SPACEs and NEWLINEs. | ||
| 400 | |||
| 401 | Used when `blank-style' has `color' as an element. | ||
| 402 | If `blank-chars' has `newline' as an element, used when `blank-style' | ||
| 403 | has `mark' as an element." | ||
| 404 | :type '(repeat :tag "Kind of Blank" | ||
| 405 | (choice :tag "Kind of Blank" | ||
| 406 | (const :tag "Trailing TABs, SPACEs and HARD SPACEs" | ||
| 407 | trailing) | ||
| 408 | (const :tag "SPACEs and HARD SPACEs" spaces) | ||
| 409 | (const :tag "TABs" tabs) | ||
| 410 | (const :tag "Lines" lines) | ||
| 411 | (const :tag "SPACEs before TAB" | ||
| 412 | space-before-tab) | ||
| 413 | (const :tag "NEWLINEs" newline) | ||
| 414 | (const :tag "Indentation SPACEs" indentation) | ||
| 415 | (const :tag "Empty Lines At BOB And/Or EOB" | ||
| 416 | empty) | ||
| 417 | (const :tag "SPACEs after TAB" | ||
| 418 | space-after-tab))) | ||
| 419 | :group 'blank) | ||
| 420 | |||
| 421 | |||
| 422 | (defcustom blank-space 'blank-space | ||
| 423 | "*Symbol face used to visualize SPACE. | ||
| 424 | |||
| 425 | Used when `blank-style' has `color' as an element." | ||
| 426 | :type 'face | ||
| 427 | :group 'blank) | ||
| 428 | |||
| 429 | |||
| 430 | (defface blank-space | ||
| 431 | '((((class color) (background dark)) | ||
| 432 | (:background "grey20" :foreground "aquamarine3")) | ||
| 433 | (((class color) (background light)) | ||
| 434 | (:background "LightYellow" :foreground "aquamarine3")) | ||
| 435 | (t (:inverse-video t))) | ||
| 436 | "Face used to visualize SPACE." | ||
| 437 | :group 'blank) | ||
| 438 | |||
| 439 | |||
| 440 | (defcustom blank-hspace 'blank-hspace | ||
| 441 | "*Symbol face used to visualize HARD SPACE. | ||
| 442 | |||
| 443 | Used when `blank-style' has `color' as an element." | ||
| 444 | :type 'face | ||
| 445 | :group 'blank) | ||
| 446 | |||
| 447 | |||
| 448 | (defface blank-hspace ; 'nobreak-space | ||
| 449 | '((((class color) (background dark)) | ||
| 450 | (:background "grey24" :foreground "aquamarine3")) | ||
| 451 | (((class color) (background light)) | ||
| 452 | (:background "LemonChiffon3" :foreground "aquamarine3")) | ||
| 453 | (t (:inverse-video t))) | ||
| 454 | "Face used to visualize HARD SPACE." | ||
| 455 | :group 'blank) | ||
| 456 | |||
| 457 | |||
| 458 | (defcustom blank-tab 'blank-tab | ||
| 459 | "*Symbol face used to visualize TAB. | ||
| 460 | |||
| 461 | Used when `blank-style' has `color' as an element." | ||
| 462 | :type 'face | ||
| 463 | :group 'blank) | ||
| 464 | |||
| 465 | |||
| 466 | (defface blank-tab | ||
| 467 | '((((class color) (background dark)) | ||
| 468 | (:background "grey22" :foreground "aquamarine3")) | ||
| 469 | (((class color) (background light)) | ||
| 470 | (:background "beige" :foreground "aquamarine3")) | ||
| 471 | (t (:inverse-video t))) | ||
| 472 | "Face used to visualize TAB." | ||
| 473 | :group 'blank) | ||
| 474 | |||
| 475 | |||
| 476 | (defcustom blank-newline 'blank-newline | ||
| 477 | "*Symbol face used to visualize NEWLINE char mapping. | ||
| 478 | |||
| 479 | See `blank-display-mappings'. | ||
| 480 | |||
| 481 | Used when `blank-style' has `mark' and `color' as elements | ||
| 482 | and `blank-chars' has `newline' as an element." | ||
| 483 | :type 'face | ||
| 484 | :group 'blank) | ||
| 485 | |||
| 486 | |||
| 487 | (defface blank-newline | ||
| 488 | '((((class color) (background dark)) | ||
| 489 | (:background "grey26" :foreground "aquamarine3" :bold t)) | ||
| 490 | (((class color) (background light)) | ||
| 491 | (:background "linen" :foreground "aquamarine3" :bold t)) | ||
| 492 | (t (:bold t :underline t))) | ||
| 493 | "Face used to visualize NEWLINE char mapping. | ||
| 494 | |||
| 495 | See `blank-display-mappings'." | ||
| 496 | :group 'blank) | ||
| 497 | |||
| 498 | |||
| 499 | (defcustom blank-trailing 'blank-trailing | ||
| 500 | "*Symbol face used to visualize traling blanks. | ||
| 501 | |||
| 502 | Used when `blank-style' has `color' as an element." | ||
| 503 | :type 'face | ||
| 504 | :group 'blank) | ||
| 505 | |||
| 506 | |||
| 507 | (defface blank-trailing ; 'trailing-whitespace | ||
| 508 | '((((class mono)) (:inverse-video t :bold t :underline t)) | ||
| 509 | (t (:background "red1" :foreground "yellow" :bold t))) | ||
| 510 | "Face used to visualize trailing blanks." | ||
| 511 | :group 'blank) | ||
| 512 | |||
| 513 | |||
| 514 | (defcustom blank-line 'blank-line | ||
| 515 | "*Symbol face used to visualize \"long\" lines. | ||
| 516 | |||
| 517 | See `blank-line-column'. | ||
| 518 | |||
| 519 | Used when `blank-style' has `color' as an element." | ||
| 520 | :type 'face | ||
| 521 | :group 'blank) | ||
| 522 | |||
| 523 | |||
| 524 | (defface blank-line | ||
| 525 | '((((class mono)) (:inverse-video t :bold t :underline t)) | ||
| 526 | (t (:background "gray20" :foreground "violet"))) | ||
| 527 | "Face used to visualize \"long\" lines. | ||
| 528 | |||
| 529 | See `blank-line-column'." | ||
| 530 | :group 'blank) | ||
| 531 | |||
| 532 | |||
| 533 | (defcustom blank-space-before-tab 'blank-space-before-tab | ||
| 534 | "*Symbol face used to visualize SPACEs before TAB. | ||
| 535 | |||
| 536 | Used when `blank-style' has `color' as an element." | ||
| 537 | :type 'face | ||
| 538 | :group 'blank) | ||
| 539 | |||
| 540 | |||
| 541 | (defface blank-space-before-tab | ||
| 542 | '((((class mono)) (:inverse-video t :bold t :underline t)) | ||
| 543 | (t (:background "DarkOrange" :foreground "firebrick"))) | ||
| 544 | "Face used to visualize SPACEs before TAB." | ||
| 545 | :group 'blank) | ||
| 546 | |||
| 547 | |||
| 548 | (defcustom blank-indentation 'blank-indentation | ||
| 549 | "*Symbol face used to visualize 8 or more SPACEs at beginning of line. | ||
| 550 | |||
| 551 | Used when `blank-style' has `color' as an element." | ||
| 552 | :type 'face | ||
| 553 | :group 'blank) | ||
| 554 | |||
| 555 | |||
| 556 | (defface blank-indentation | ||
| 557 | '((((class mono)) (:inverse-video t :bold t :underline t)) | ||
| 558 | (t (:background "yellow" :foreground "firebrick"))) | ||
| 559 | "Face used to visualize 8 or more SPACEs at beginning of line." | ||
| 560 | :group 'blank) | ||
| 561 | |||
| 562 | |||
| 563 | (defcustom blank-empty 'blank-empty | ||
| 564 | "*Symbol face used to visualize empty lines at beginning and/or end of buffer. | ||
| 565 | |||
| 566 | Used when `blank-style' has `color' as an element." | ||
| 567 | :type 'face | ||
| 568 | :group 'blank) | ||
| 569 | |||
| 570 | |||
| 571 | (defface blank-empty | ||
| 572 | '((((class mono)) (:inverse-video t :bold t :underline t)) | ||
| 573 | (t (:background "yellow" :foreground "firebrick"))) | ||
| 574 | "Face used to visualize empty lines at beginning and/or end of buffer." | ||
| 575 | :group 'blank) | ||
| 576 | |||
| 577 | |||
| 578 | (defcustom blank-space-after-tab 'blank-space-after-tab | ||
| 579 | "*Symbol face used to visualize 8 or more SPACEs after TAB. | ||
| 580 | |||
| 581 | Used when `blank-style' has `color' as an element." | ||
| 582 | :type 'face | ||
| 583 | :group 'blank) | ||
| 584 | |||
| 585 | |||
| 586 | (defface blank-space-after-tab | ||
| 587 | '((((class mono)) (:inverse-video t :bold t :underline t)) | ||
| 588 | (t (:background "yellow" :foreground "firebrick"))) | ||
| 589 | "Face used to visualize 8 or more SPACEs after TAB." | ||
| 590 | :group 'blank) | ||
| 591 | |||
| 592 | |||
| 593 | (defcustom blank-hspace-regexp | ||
| 594 | "\\(\\(\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20\\)+\\)" | ||
| 595 | "*Specify HARD SPACE characters regexp. | ||
| 596 | |||
| 597 | If you're using `mule' package, it may exist other characters besides: | ||
| 598 | |||
| 599 | \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \"\\xF20\" | ||
| 600 | |||
| 601 | that should be considered HARD SPACE. | ||
| 602 | |||
| 603 | Here are some examples: | ||
| 604 | |||
| 605 | \"\\\\(^\\xA0+\\\\)\" \ | ||
| 606 | visualize only leading HARD SPACEs. | ||
| 607 | \"\\\\(\\xA0+$\\\\)\" \ | ||
| 608 | visualize only trailing HARD SPACEs. | ||
| 609 | \"\\\\(^\\xA0+\\\\|\\xA0+$\\\\)\" \ | ||
| 610 | visualize leading and/or trailing HARD SPACEs. | ||
| 611 | \"\\t\\\\(\\xA0+\\\\)\\t\" \ | ||
| 612 | visualize only HARD SPACEs between TABs. | ||
| 613 | |||
| 614 | NOTE: Enclose always by \\\\( and \\\\) the elements to highlight. | ||
| 615 | Use exactly one pair of enclosing \\\\( and \\\\). | ||
| 616 | |||
| 617 | Used when `blank-style' has `color' as an element, and | ||
| 618 | `blank-chars' has `spaces' as an element." | ||
| 619 | :type '(regexp :tag "HARD SPACE Chars") | ||
| 620 | :group 'blank) | ||
| 621 | |||
| 622 | |||
| 623 | (defcustom blank-space-regexp "\\( +\\)" | ||
| 624 | "*Specify SPACE characters regexp. | ||
| 625 | |||
| 626 | If you're using `mule' package, it may exist other characters | ||
| 627 | besides \" \" that should be considered SPACE. | ||
| 628 | |||
| 629 | Here are some examples: | ||
| 630 | |||
| 631 | \"\\\\(^ +\\\\)\" visualize only leading SPACEs. | ||
| 632 | \"\\\\( +$\\\\)\" visualize only trailing SPACEs. | ||
| 633 | \"\\\\(^ +\\\\| +$\\\\)\" \ | ||
| 634 | visualize leading and/or trailing SPACEs. | ||
| 635 | \"\\t\\\\( +\\\\)\\t\" visualize only SPACEs between TABs. | ||
| 636 | |||
| 637 | NOTE: Enclose always by \\\\( and \\\\) the elements to highlight. | ||
| 638 | Use exactly one pair of enclosing \\\\( and \\\\). | ||
| 639 | |||
| 640 | Used when `blank-style' has `color' as an element, and | ||
| 641 | `blank-chars' has `spaces' as an element." | ||
| 642 | :type '(regexp :tag "SPACE Chars") | ||
| 643 | :group 'blank) | ||
| 644 | |||
| 645 | |||
| 646 | (defcustom blank-tab-regexp "\\(\t+\\)" | ||
| 647 | "*Specify TAB characters regexp. | ||
| 648 | |||
| 649 | If you're using `mule' package, it may exist other characters | ||
| 650 | besides \"\\t\" that should be considered TAB. | ||
| 651 | |||
| 652 | Here are some examples: | ||
| 653 | |||
| 654 | \"\\\\(^\\t+\\\\)\" visualize only leading TABs. | ||
| 655 | \"\\\\(\\t+$\\\\)\" visualize only trailing TABs. | ||
| 656 | \"\\\\(^\\t+\\\\|\\t+$\\\\)\" \ | ||
| 657 | visualize leading and/or trailing TABs. | ||
| 658 | \" \\\\(\\t+\\\\) \" visualize only TABs between SPACEs. | ||
| 659 | |||
| 660 | NOTE: Enclose always by \\\\( and \\\\) the elements to highlight. | ||
| 661 | Use exactly one pair of enclosing \\\\( and \\\\). | ||
| 662 | |||
| 663 | Used when `blank-style' has `color' as an element, and | ||
| 664 | `blank-chars' has `tabs' as an element." | ||
| 665 | :type '(regexp :tag "TAB Chars") | ||
| 666 | :group 'blank) | ||
| 667 | |||
| 668 | |||
| 669 | (defcustom blank-trailing-regexp | ||
| 670 | "\t\\| \\|\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20" | ||
| 671 | "*Specify trailing characters regexp. | ||
| 672 | |||
| 673 | If you're using `mule' package, it may exist other characters besides: | ||
| 674 | |||
| 675 | \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ | ||
| 676 | \"\\xF20\" | ||
| 677 | |||
| 678 | that should be considered blank. | ||
| 679 | |||
| 680 | NOTE: DO NOT enclose by \\\\( and \\\\) the elements to highlight. | ||
| 681 | `blank-mode' surrounds this regexp by \"\\\\(\\\\(\" and | ||
| 682 | \"\\\\)+\\\\)$\". | ||
| 683 | |||
| 684 | Used when `blank-style' has `color' as an element, and | ||
| 685 | `blank-chars' has `trailing' as an element." | ||
| 686 | :type '(regexp :tag "Trailing Chars") | ||
| 687 | :group 'blank) | ||
| 688 | |||
| 689 | |||
| 690 | (defcustom blank-space-before-tab-regexp "\\( +\\)\t" | ||
| 691 | "*Specify SPACEs before TAB regexp. | ||
| 692 | |||
| 693 | If you're using `mule' package, it may exist other characters besides: | ||
| 694 | |||
| 695 | \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ | ||
| 696 | \"\\xF20\" | ||
| 697 | |||
| 698 | that should be considered blank. | ||
| 699 | |||
| 700 | Used when `blank-style' has `color' as an element, and | ||
| 701 | `blank-chars' has `space-before-tab' as an element." | ||
| 702 | :type '(regexp :tag "SPACEs Before TAB") | ||
| 703 | :group 'blank) | ||
| 704 | |||
| 705 | |||
| 706 | (defcustom blank-indentation-regexp "^\t*\\(\\( \\{8\\}\\)+\\)[^\n\t]" | ||
| 707 | "*Specify regexp for 8 or more SPACEs at beginning of line. | ||
| 708 | |||
| 709 | If you're using `mule' package, it may exist other characters besides: | ||
| 710 | |||
| 711 | \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ | ||
| 712 | \"\\xF20\" | ||
| 713 | |||
| 714 | that should be considered blank. | ||
| 715 | |||
| 716 | Used when `blank-style' has `color' as an element, and | ||
| 717 | `blank-chars' has `indentation' as an element." | ||
| 718 | :type '(regexp :tag "Indentation SPACEs") | ||
| 719 | :group 'blank) | ||
| 720 | |||
| 721 | |||
| 722 | (defcustom blank-empty-at-bob-regexp "\\`\\(\\([ \t]*\n\\)+\\)" | ||
| 723 | "*Specify regexp for empty lines at beginning of buffer. | ||
| 724 | |||
| 725 | If you're using `mule' package, it may exist other characters besides: | ||
| 726 | |||
| 727 | \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ | ||
| 728 | \"\\xF20\" | ||
| 729 | |||
| 730 | that should be considered blank. | ||
| 731 | |||
| 732 | Used when `blank-style' has `color' as an element, and | ||
| 733 | `blank-chars' has `empty' as an element." | ||
| 734 | :type '(regexp :tag "Empty Lines At Beginning Of Buffer") | ||
| 735 | :group 'blank) | ||
| 736 | |||
| 737 | |||
| 738 | (defcustom blank-empty-at-eob-regexp "^\\([ \t\n]+\\)\\'" | ||
| 739 | "*Specify regexp for empty lines at end of buffer. | ||
| 740 | |||
| 741 | If you're using `mule' package, it may exist other characters besides: | ||
| 742 | |||
| 743 | \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ | ||
| 744 | \"\\xF20\" | ||
| 745 | |||
| 746 | that should be considered blank. | ||
| 747 | |||
| 748 | Used when `blank-style' has `color' as an element, and | ||
| 749 | `blank-chars' has `empty' as an element." | ||
| 750 | :type '(regexp :tag "Empty Lines At End Of Buffer") | ||
| 751 | :group 'blank) | ||
| 752 | |||
| 753 | |||
| 754 | (defcustom blank-space-after-tab-regexp "\t\\(\\( \\{8\\}\\)+\\)" | ||
| 755 | "*Specify regexp for 8 or more SPACEs after TAB. | ||
| 756 | |||
| 757 | If you're using `mule' package, it may exist other characters besides: | ||
| 758 | |||
| 759 | \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ | ||
| 760 | \"\\xF20\" | ||
| 761 | |||
| 762 | that should be considered blank. | ||
| 763 | |||
| 764 | Used when `blank-style' has `color' as an element, and | ||
| 765 | `blank-chars' has `space-after-tab' as an element." | ||
| 766 | :type '(regexp :tag "SPACEs After TAB") | ||
| 767 | :group 'blank) | ||
| 768 | |||
| 769 | |||
| 770 | (defcustom blank-line-column 80 | ||
| 771 | "*Specify column beyond which the line is highlighted. | ||
| 772 | |||
| 773 | Used when `blank-style' has `color' as an element, and | ||
| 774 | `blank-chars' has `lines' or `lines-tail' as an element." | ||
| 775 | :type '(integer :tag "Line Length") | ||
| 776 | :group 'blank) | ||
| 777 | |||
| 778 | |||
| 779 | ;; Hacked from `visible-whitespace-mappings' in visws.el | ||
| 780 | (defcustom blank-display-mappings | ||
| 781 | ;; Due to limitations of glyph representation, the char code can not | ||
| 782 | ;; be above ?\x1FFFF. Probably, this will be fixed after Emacs | ||
| 783 | ;; unicode merging. | ||
| 784 | '( | ||
| 785 | (?\ [?\xB7] [?.]) ; space - centered dot | ||
| 786 | (?\xA0 [?\xA4] [?_]) ; hard space - currency | ||
| 787 | (?\x8A0 [?\x8A4] [?_]) ; hard space - currency | ||
| 788 | (?\x920 [?\x924] [?_]) ; hard space - currency | ||
| 789 | (?\xE20 [?\xE24] [?_]) ; hard space - currency | ||
| 790 | (?\xF20 [?\xF24] [?_]) ; hard space - currency | ||
| 791 | ;; NEWLINE is displayed using the face `blank-newline' | ||
| 792 | (?\n [?$ ?\n]) ; end-of-line - dollar sign | ||
| 793 | ;; (?\n [?\u21B5 ?\n] [?$ ?\n]) ; end-of-line - downwards arrow | ||
| 794 | ;; (?\n [?\xB6 ?\n] [?$ ?\n]) ; end-of-line - pilcrow | ||
| 795 | ;; (?\n [?\x8AF ?\n] [?$ ?\n]) ; end-of-line - overscore | ||
| 796 | ;; (?\n [?\x8AC ?\n] [?$ ?\n]) ; end-of-line - negation | ||
| 797 | ;; (?\n [?\x8B0 ?\n] [?$ ?\n]) ; end-of-line - grade | ||
| 798 | ;; | ||
| 799 | ;; WARNING: the mapping below has a problem. | ||
| 800 | ;; When a TAB occupies exactly one column, it will display the | ||
| 801 | ;; character ?\xBB at that column followed by a TAB which goes to | ||
| 802 | ;; the next TAB column. | ||
| 803 | ;; If this is a problem for you, please, comment the line below. | ||
| 804 | (?\t [?\xBB ?\t] [?\\ ?\t]) ; tab - left quote mark | ||
| 805 | ) | ||
| 806 | "*Specify an alist of mappings for displaying characters. | ||
| 807 | |||
| 808 | Each element has the following form: | ||
| 809 | |||
| 810 | (CHAR VECTOR...) | ||
| 811 | |||
| 812 | Where: | ||
| 813 | |||
| 814 | CHAR is the character to be mapped. | ||
| 815 | |||
| 816 | VECTOR is a vector of characters to be displayed in place of CHAR. | ||
| 817 | The first display vector that can be displayed is used; | ||
| 818 | if no display vector for a mapping can be displayed, then | ||
| 819 | that character is displayed unmodified. | ||
| 820 | |||
| 821 | The NEWLINE character is displayed using the face given by | ||
| 822 | `blank-newline' variable. The characters in the vector to be | ||
| 823 | displayed will not have this face applied if the character code | ||
| 824 | is above #x1FFFF. | ||
| 825 | |||
| 826 | Used when `blank-style' has `mark' as an element." | ||
| 827 | :type '(repeat | ||
| 828 | (list :tag "Character Mapping" | ||
| 829 | (character :tag "Char") | ||
| 830 | (repeat :inline t :tag "Vector List" | ||
| 831 | (vector :tag "" | ||
| 832 | (repeat :inline t | ||
| 833 | :tag "Vector Characters" | ||
| 834 | (character :tag "Char")))))) | ||
| 835 | :group 'blank) | ||
| 836 | |||
| 837 | |||
| 838 | (defcustom blank-global-modes t | ||
| 839 | "*Modes for which global `blank-mode' is automagically turned on. | ||
| 840 | |||
| 841 | Global `blank-mode' is controlled by the command `global-blank-mode'. | ||
| 842 | |||
| 843 | If nil, means no modes have `blank-mode' automatically turned on. | ||
| 844 | If t, all modes that support `blank-mode' have it automatically | ||
| 845 | turned on. | ||
| 846 | Else it should be a list of `major-mode' symbol names for | ||
| 847 | which `blank-mode' should be automatically turned on. The sense | ||
| 848 | of the list is negated if it begins with `not'. For example: | ||
| 849 | |||
| 850 | (c-mode c++-mode) | ||
| 851 | |||
| 852 | means that `blank-mode' is turned on for buffers in C and C++ | ||
| 853 | modes only." | ||
| 854 | :type '(choice (const :tag "None" nil) | ||
| 855 | (const :tag "All" t) | ||
| 856 | (set :menu-tag "Mode Specific" :tag "Modes" | ||
| 857 | :value (not) | ||
| 858 | (const :tag "Except" not) | ||
| 859 | (repeat :inline t | ||
| 860 | (symbol :tag "Mode")))) | ||
| 861 | :group 'blank) | ||
| 862 | |||
| 863 | |||
| 864 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 865 | ;;;; User commands - Local mode | ||
| 866 | |||
| 867 | |||
| 868 | ;;;###autoload | ||
| 869 | (define-minor-mode blank-mode | ||
| 870 | "Toggle blank minor mode visualization (\"bl\" on modeline). | ||
| 871 | |||
| 872 | If ARG is null, toggle blank visualization. | ||
| 873 | If ARG is a number greater than zero, turn on visualization; | ||
| 874 | otherwise, turn off visualization. | ||
| 875 | Only useful with a windowing system." | ||
| 876 | :lighter " bl" | ||
| 877 | :init-value nil | ||
| 878 | :global nil | ||
| 879 | :group 'blank | ||
| 880 | (cond | ||
| 881 | (noninteractive ; running a batch job | ||
| 882 | (setq blank-mode nil)) | ||
| 883 | (blank-mode ; blank-mode on | ||
| 884 | (blank-turn-on)) | ||
| 885 | (t ; blank-mode off | ||
| 886 | (blank-turn-off)))) | ||
| 887 | |||
| 888 | |||
| 889 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 890 | ;;;; User commands - Global mode | ||
| 891 | |||
| 892 | |||
| 893 | (define-minor-mode global-blank-mode | ||
| 894 | "Toggle blank global minor mode visualization (\"BL\" on modeline). | ||
| 895 | |||
| 896 | If ARG is null, toggle blank visualization. | ||
| 897 | If ARG is a number greater than zero, turn on visualization; | ||
| 898 | otherwise, turn off visualization. | ||
| 899 | Only useful with a windowing system." | ||
| 900 | :lighter " BL" | ||
| 901 | :init-value nil | ||
| 902 | :global t | ||
| 903 | :group 'blank | ||
| 904 | (cond | ||
| 905 | (noninteractive ; running a batch job | ||
| 906 | (setq global-blank-mode nil)) | ||
| 907 | (global-blank-mode ; global-blank-mode on | ||
| 908 | (save-excursion | ||
| 909 | (if (boundp 'find-file-hook) | ||
| 910 | (add-hook 'find-file-hook 'blank-turn-on-if-enabled t) | ||
| 911 | (add-hook 'find-file-hooks 'blank-turn-on-if-enabled t)) | ||
| 912 | (dolist (buffer (buffer-list)) ; adjust all local mode | ||
| 913 | (set-buffer buffer) | ||
| 914 | (unless blank-mode | ||
| 915 | (blank-turn-on-if-enabled))))) | ||
| 916 | (t ; global-blank-mode off | ||
| 917 | (save-excursion | ||
| 918 | (if (boundp 'find-file-hook) | ||
| 919 | (remove-hook 'find-file-hook 'blank-turn-on-if-enabled) | ||
| 920 | (remove-hook 'find-file-hooks 'blank-turn-on-if-enabled)) | ||
| 921 | (dolist (buffer (buffer-list)) ; adjust all local mode | ||
| 922 | (set-buffer buffer) | ||
| 923 | (unless blank-mode | ||
| 924 | (blank-turn-off))))))) | ||
| 925 | |||
| 926 | |||
| 927 | (defun blank-turn-on-if-enabled () | ||
| 928 | (when (cond | ||
| 929 | ((eq blank-global-modes t)) | ||
| 930 | ((listp blank-global-modes) | ||
| 931 | (if (eq (car-safe blank-global-modes) 'not) | ||
| 932 | (not (memq major-mode (cdr blank-global-modes))) | ||
| 933 | (memq major-mode blank-global-modes))) | ||
| 934 | (t nil)) | ||
| 935 | (let (inhibit-quit) | ||
| 936 | ;; Don't turn on blank mode if... | ||
| 937 | (or | ||
| 938 | ;; ...we don't have a display (we're running a batch job) | ||
| 939 | noninteractive | ||
| 940 | ;; ...or if the buffer is invisible (name starts with a space) | ||
| 941 | (eq (aref (buffer-name) 0) ?\ ) | ||
| 942 | ;; ...or if the buffer is temporary (name starts with *) | ||
| 943 | (and (eq (aref (buffer-name) 0) ?*) | ||
| 944 | ;; except the scratch buffer. | ||
| 945 | (not (string= (buffer-name) "*scratch*"))) | ||
| 946 | ;; Otherwise, turn on blank mode. | ||
| 947 | (blank-turn-on))))) | ||
| 948 | |||
| 949 | |||
| 950 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 951 | ;;;; User commands - Toggle | ||
| 952 | |||
| 953 | |||
| 954 | (defconst blank-chars-value-list | ||
| 955 | '(tabs | ||
| 956 | spaces | ||
| 957 | trailing | ||
| 958 | space-before-tab | ||
| 959 | lines | ||
| 960 | lines-tail | ||
| 961 | newline | ||
| 962 | indentation | ||
| 963 | empty | ||
| 964 | space-after-tab | ||
| 965 | ) | ||
| 966 | "List of valid `blank-chars' values.") | ||
| 967 | |||
| 968 | |||
| 969 | (defconst blank-style-value-list | ||
| 970 | '(color | ||
| 971 | mark | ||
| 972 | ) | ||
| 973 | "List of valid `blank-style' values.") | ||
| 974 | |||
| 975 | |||
| 976 | (defconst blank-toggle-option-alist | ||
| 977 | '((?t . tabs) | ||
| 978 | (?s . spaces) | ||
| 979 | (?r . trailing) | ||
| 980 | (?b . space-before-tab) | ||
| 981 | (?l . lines) | ||
| 982 | (?L . lines-tail) | ||
| 983 | (?n . newline) | ||
| 984 | (?i . indentation) | ||
| 985 | (?e . empty) | ||
| 986 | (?a . space-after-tab) | ||
| 987 | (?c . color) | ||
| 988 | (?m . mark) | ||
| 989 | (?x . blank-chars) | ||
| 990 | (?z . blank-style) | ||
| 991 | ) | ||
| 992 | "Alist of toggle options. | ||
| 993 | |||
| 994 | Each element has the form: | ||
| 995 | |||
| 996 | (CHAR . SYMBOL) | ||
| 997 | |||
| 998 | Where: | ||
| 999 | |||
| 1000 | CHAR is a char which the user will have to type. | ||
| 1001 | |||
| 1002 | SYMBOL is a valid symbol associated with CHAR. | ||
| 1003 | See `blank-chars-value-list' and `blank-style-value-list'.") | ||
| 1004 | |||
| 1005 | |||
| 1006 | (defvar blank-active-chars nil | ||
| 1007 | "Used to save locally `blank-chars' value.") | ||
| 1008 | (make-variable-buffer-local 'blank-active-chars) | ||
| 1009 | |||
| 1010 | (defvar blank-active-style nil | ||
| 1011 | "Used to save locally `blank-style' value.") | ||
| 1012 | (make-variable-buffer-local 'blank-active-style) | ||
| 1013 | |||
| 1014 | |||
| 1015 | ;;;###autoload | ||
| 1016 | (defun blank-toggle-options (arg) | ||
| 1017 | "Toggle local `blank-mode' options. | ||
| 1018 | |||
| 1019 | If local blank-mode is off, toggle the option given by ARG and | ||
| 1020 | turn on local blank-mode. | ||
| 1021 | |||
| 1022 | If local blank-mode is on, toggle the option given by ARG and | ||
| 1023 | restart local blank-mode. | ||
| 1024 | |||
| 1025 | Interactively, it reads one of the following chars: | ||
| 1026 | |||
| 1027 | CHAR MEANING | ||
| 1028 | t toggle TAB visualization | ||
| 1029 | s toggle SPACE and HARD SPACE visualization | ||
| 1030 | r toggle trailing blanks visualization | ||
| 1031 | b toggle SPACEs before TAB visualization | ||
| 1032 | l toggle \"long lines\" visualization | ||
| 1033 | L toggle \"long lines\" tail visualization | ||
| 1034 | n toggle NEWLINE visualization | ||
| 1035 | i toggle indentation SPACEs visualization | ||
| 1036 | e toggle empty line at bob and/or eob visualization | ||
| 1037 | a toggle SPACEs after TAB visualization | ||
| 1038 | c toggle color faces | ||
| 1039 | m toggle visual mark | ||
| 1040 | x restore `blank-chars' value | ||
| 1041 | z restore `blank-style' value | ||
| 1042 | ? display brief help | ||
| 1043 | |||
| 1044 | Non-interactively, ARG should be a symbol or a list of symbols. | ||
| 1045 | The valid symbols are: | ||
| 1046 | |||
| 1047 | tabs toggle TAB visualization | ||
| 1048 | spaces toggle SPACE and HARD SPACE visualization | ||
| 1049 | trailing toggle trailing blanks visualization | ||
| 1050 | space-before-tab toggle SPACEs before TAB visualization | ||
| 1051 | lines toggle \"long lines\" visualization | ||
| 1052 | lines-tail toggle \"long lines\" tail visualization | ||
| 1053 | newline toggle NEWLINE visualization | ||
| 1054 | indentation toggle indentation SPACEs visualization | ||
| 1055 | empty toggle empty line at bob and/or eob visualization | ||
| 1056 | space-after-tab toggle SPACEs after TAB visualization | ||
| 1057 | color toggle color faces | ||
| 1058 | mark toggle visual mark | ||
| 1059 | blank-chars restore `blank-chars' value | ||
| 1060 | blank-style restore `blank-style' value | ||
| 1061 | |||
| 1062 | Only useful with a windowing system." | ||
| 1063 | (interactive (blank-interactive-char t)) | ||
| 1064 | (let ((blank-chars | ||
| 1065 | (blank-toggle-list t arg blank-active-chars blank-chars | ||
| 1066 | 'blank-chars blank-chars-value-list)) | ||
| 1067 | (blank-style | ||
| 1068 | (blank-toggle-list t arg blank-active-style blank-style | ||
| 1069 | 'blank-style blank-style-value-list))) | ||
| 1070 | (blank-mode 0) | ||
| 1071 | (blank-mode 1))) | ||
| 1072 | |||
| 1073 | |||
| 1074 | (defvar blank-toggle-chars nil | ||
| 1075 | "Used to toggle the global `blank-chars' value.") | ||
| 1076 | (defvar blank-toggle-style nil | ||
| 1077 | "Used to toggle the global `blank-style' value.") | ||
| 1078 | |||
| 1079 | |||
| 1080 | ;;;###autoload | ||
| 1081 | (defun global-blank-toggle-options (arg) | ||
| 1082 | "Toggle global `blank-mode' options. | ||
| 1083 | |||
| 1084 | If global blank-mode is off, toggle the option given by ARG and | ||
| 1085 | turn on global blank-mode. | ||
| 1086 | |||
| 1087 | If global blank-mode is on, toggle the option given by ARG and | ||
| 1088 | restart global blank-mode. | ||
| 1089 | |||
| 1090 | Interactively, it reads one of the following chars: | ||
| 1091 | |||
| 1092 | CHAR MEANING | ||
| 1093 | t toggle TAB visualization | ||
| 1094 | s toggle SPACE and HARD SPACE visualization | ||
| 1095 | r toggle trailing blanks visualization | ||
| 1096 | b toggle SPACEs before TAB visualization | ||
| 1097 | l toggle \"long lines\" visualization | ||
| 1098 | L toggle \"long lines\" tail visualization | ||
| 1099 | n toggle NEWLINE visualization | ||
| 1100 | i toggle indentation SPACEs visualization | ||
| 1101 | e toggle empty line at bob and/or eob visualization | ||
| 1102 | a toggle SPACEs after TAB visualization | ||
| 1103 | c toggle color faces | ||
| 1104 | m toggle visual mark | ||
| 1105 | x restore `blank-chars' value | ||
| 1106 | z restore `blank-style' value | ||
| 1107 | ? display brief help | ||
| 1108 | |||
| 1109 | Non-interactively, ARG should be a symbol or a list of symbols. | ||
| 1110 | The valid symbols are: | ||
| 1111 | |||
| 1112 | tabs toggle TAB visualization | ||
| 1113 | spaces toggle SPACE and HARD SPACE visualization | ||
| 1114 | trailing toggle trailing blanks visualization | ||
| 1115 | space-before-tab toggle SPACEs before TAB visualization | ||
| 1116 | lines toggle \"long lines\" visualization | ||
| 1117 | lines-tail toggle \"long lines\" tail visualization | ||
| 1118 | newline toggle NEWLINE visualization | ||
| 1119 | indentation toggle indentation SPACEs visualization | ||
| 1120 | empty toggle empty line at bob and/or eob visualization | ||
| 1121 | space-after-tab toggle SPACEs after TAB visualization | ||
| 1122 | color toggle color faces | ||
| 1123 | mark toggle visual mark | ||
| 1124 | blank-chars restore `blank-chars' value | ||
| 1125 | blank-style restore `blank-style' value | ||
| 1126 | |||
| 1127 | Only useful with a windowing system." | ||
| 1128 | (interactive (blank-interactive-char nil)) | ||
| 1129 | (let ((blank-chars | ||
| 1130 | (blank-toggle-list nil arg blank-toggle-chars blank-chars | ||
| 1131 | 'blank-chars blank-chars-value-list)) | ||
| 1132 | (blank-style | ||
| 1133 | (blank-toggle-list nil arg blank-toggle-style blank-style | ||
| 1134 | 'blank-style blank-style-value-list))) | ||
| 1135 | (setq blank-toggle-chars blank-chars | ||
| 1136 | blank-toggle-style blank-style) | ||
| 1137 | (global-blank-mode 0) | ||
| 1138 | (global-blank-mode 1))) | ||
| 1139 | |||
| 1140 | |||
| 1141 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 1142 | ;;;; User commands - Cleanup | ||
| 1143 | |||
| 1144 | |||
| 1145 | ;;;###autoload | ||
| 1146 | (defun blank-cleanup () | ||
| 1147 | "Cleanup some blank problems in all buffer or at region. | ||
| 1148 | |||
| 1149 | It usually applies to the whole buffer, but in transient mark | ||
| 1150 | mode when the mark is active, it applies to the region. It also | ||
| 1151 | applies to the region when it is not in transiente mark mode, the | ||
| 1152 | mark is active and it was pressed `C-u' just before calling | ||
| 1153 | `blank-cleanup' interactively. | ||
| 1154 | |||
| 1155 | See also `blank-cleanup-region'. | ||
| 1156 | |||
| 1157 | The problems, which are cleaned up, are: | ||
| 1158 | |||
| 1159 | 1. empty lines at beginning of buffer. | ||
| 1160 | 2. empty lines at end of buffer. | ||
| 1161 | If `blank-chars' has `empty' as an element, remove all empty | ||
| 1162 | lines at beginning and/or end of buffer. | ||
| 1163 | |||
| 1164 | 3. 8 or more SPACEs at beginning of line. | ||
| 1165 | If `blank-chars' has `indentation' as an element, replace 8 or | ||
| 1166 | more SPACEs at beginning of line by TABs. | ||
| 1167 | |||
| 1168 | 4. SPACEs before TAB. | ||
| 1169 | If `blank-chars' has `space-before-tab' as an element, replace | ||
| 1170 | SPACEs by TABs. | ||
| 1171 | |||
| 1172 | 5. SPACEs or TABs at end of line. | ||
| 1173 | If `blank-chars' has `trailing' as an element, remove all | ||
| 1174 | SPACEs or TABs at end of line. | ||
| 1175 | |||
| 1176 | 6. 8 or more SPACEs after TAB. | ||
| 1177 | If `blank-chars' has `space-after-tab' as an element, replace | ||
| 1178 | SPACEs by TABs." | ||
| 1179 | (interactive "@*") | ||
| 1180 | (if (and (or transient-mark-mode | ||
| 1181 | current-prefix-arg) | ||
| 1182 | mark-active) | ||
| 1183 | ;; region active | ||
| 1184 | ;; problems 1 and 2 are not handled in region | ||
| 1185 | ;; problem 3: 8 or more SPACEs at bol | ||
| 1186 | ;; problem 4: SPACEs before TAB | ||
| 1187 | ;; problem 5: SPACEs or TABs at eol | ||
| 1188 | ;; problem 6: 8 or more SPACEs after TAB | ||
| 1189 | (blank-cleanup-region (region-beginning) (region-end)) | ||
| 1190 | ;; whole buffer | ||
| 1191 | (save-excursion | ||
| 1192 | (save-match-data | ||
| 1193 | ;; problem 1: empty lines at bob | ||
| 1194 | ;; problem 2: empty lines at eob | ||
| 1195 | ;; action: remove all empty lines at bob and/or eob | ||
| 1196 | (when (memq 'empty blank-chars) | ||
| 1197 | (let (overwrite-mode) ; enforce no overwrite | ||
| 1198 | (goto-char (point-min)) | ||
| 1199 | (when (re-search-forward blank-empty-at-bob-regexp nil t) | ||
| 1200 | (delete-region (match-beginning 1) (match-end 1))) | ||
| 1201 | (when (re-search-forward blank-empty-at-eob-regexp nil t) | ||
| 1202 | (delete-region (match-beginning 1) (match-end 1))))))) | ||
| 1203 | ;; problem 3: 8 or more SPACEs at bol | ||
| 1204 | ;; problem 4: SPACEs before TAB | ||
| 1205 | ;; problem 5: SPACEs or TABs at eol | ||
| 1206 | ;; problem 6: 8 or more SPACEs after TAB | ||
| 1207 | (blank-cleanup-region (point-min) (point-max)))) | ||
| 1208 | |||
| 1209 | |||
| 1210 | ;;;###autoload | ||
| 1211 | (defun blank-cleanup-region (start end) | ||
| 1212 | "Cleanup some blank problems at region. | ||
| 1213 | |||
| 1214 | The problems, which are cleaned up, are: | ||
| 1215 | |||
| 1216 | 1. 8 or more SPACEs at beginning of line. | ||
| 1217 | If `blank-chars' has `indentation' as an element, replace 8 or | ||
| 1218 | more SPACEs at beginning of line by TABs. | ||
| 1219 | |||
| 1220 | 2. SPACEs before TAB. | ||
| 1221 | If `blank-chars' has `space-before-tab' as an element, replace | ||
| 1222 | SPACEs by TABs. | ||
| 1223 | |||
| 1224 | 3. SPACEs or TABs at end of line. | ||
| 1225 | If `blank-chars' has `trailing' as an element, remove all | ||
| 1226 | SPACEs or TABs at end of line. | ||
| 1227 | |||
| 1228 | 4. 8 or more SPACEs after TAB. | ||
| 1229 | If `blank-chars' has `space-after-tab' as an element, replace | ||
| 1230 | SPACEs by TABs." | ||
| 1231 | (interactive "@*r") | ||
| 1232 | (let ((rstart (min start end)) | ||
| 1233 | (rend (copy-marker (max start end))) | ||
| 1234 | (tab-width 8) ; assure TAB width | ||
| 1235 | (indent-tabs-mode t) ; always insert TABs | ||
| 1236 | overwrite-mode ; enforce no overwrite | ||
| 1237 | tmp) | ||
| 1238 | (save-excursion | ||
| 1239 | (save-match-data | ||
| 1240 | ;; problem 1: 8 or more SPACEs at bol | ||
| 1241 | ;; action: replace 8 or more SPACEs at bol by TABs | ||
| 1242 | (when (memq 'indentation blank-chars) | ||
| 1243 | (goto-char rstart) | ||
| 1244 | (while (re-search-forward blank-indentation-regexp rend t) | ||
| 1245 | (setq tmp (current-indentation)) | ||
| 1246 | (delete-horizontal-space) | ||
| 1247 | (unless (eolp) | ||
| 1248 | (indent-to tmp)))) | ||
| 1249 | ;; problem 3: SPACEs or TABs at eol | ||
| 1250 | ;; action: remove all SPACEs or TABs at eol | ||
| 1251 | (when (memq 'trailing blank-chars) | ||
| 1252 | (let ((regexp (concat "\\(\\(" blank-trailing-regexp | ||
| 1253 | "\\)+\\)$"))) | ||
| 1254 | (goto-char rstart) | ||
| 1255 | (while (re-search-forward regexp rend t) | ||
| 1256 | (delete-region (match-beginning 1) (match-end 1))))) | ||
| 1257 | ;; problem 4: 8 or more SPACEs after TAB | ||
| 1258 | ;; action: replace 8 or more SPACEs by TABs | ||
| 1259 | (when (memq 'space-after-tab blank-chars) | ||
| 1260 | (blank-replace-spaces-by-tabs | ||
| 1261 | rstart rend blank-space-after-tab-regexp)) | ||
| 1262 | ;; problem 2: SPACEs before TAB | ||
| 1263 | ;; action: replace SPACEs before TAB by TABs | ||
| 1264 | (when (memq 'space-before-tab blank-chars) | ||
| 1265 | (blank-replace-spaces-by-tabs | ||
| 1266 | rstart rend blank-space-before-tab-regexp)))) | ||
| 1267 | (set-marker rend nil))) ; point marker to nowhere | ||
| 1268 | |||
| 1269 | |||
| 1270 | (defun blank-replace-spaces-by-tabs (rstart rend regexp) | ||
| 1271 | "Replace all SPACEs by TABs matched by REGEXP between RSTART and REND." | ||
| 1272 | (goto-char rstart) | ||
| 1273 | (while (re-search-forward regexp rend t) | ||
| 1274 | (goto-char (match-beginning 1)) | ||
| 1275 | (let* ((scol (current-column)) | ||
| 1276 | (ecol (save-excursion | ||
| 1277 | (goto-char (match-end 1)) | ||
| 1278 | (current-column)))) | ||
| 1279 | (delete-region (match-beginning 1) (match-end 1)) | ||
| 1280 | (insert-char ?\t | ||
| 1281 | (/ (- (- ecol (% ecol 8)) ; prev end col | ||
| 1282 | (- scol (% scol 8))) ; prev start col | ||
| 1283 | 8))))) | ||
| 1284 | |||
| 1285 | |||
| 1286 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 1287 | ;;;; Internal functions | ||
| 1288 | |||
| 1289 | |||
| 1290 | (defvar blank-font-lock-mode nil | ||
| 1291 | "Used to remember whether a buffer had font lock mode on or not.") | ||
| 1292 | (make-variable-buffer-local 'blank-font-lock-mode) | ||
| 1293 | |||
| 1294 | (defvar blank-font-lock nil | ||
| 1295 | "Used to remember whether a buffer initially had font lock on or not.") | ||
| 1296 | (make-variable-buffer-local 'blank-font-lock) | ||
| 1297 | |||
| 1298 | (defvar blank-font-lock-keywords nil | ||
| 1299 | "Used to save locally `font-lock-keywords' value.") | ||
| 1300 | (make-variable-buffer-local 'blank-font-lock-keywords) | ||
| 1301 | |||
| 1302 | |||
| 1303 | (defconst blank-help-text | ||
| 1304 | "\ | ||
| 1305 | blank-mode toggle options: | ||
| 1306 | |||
| 1307 | [] t - toggle TAB visualization | ||
| 1308 | [] s - toggle SPACE and HARD SPACE visualization | ||
| 1309 | [] r - toggle trailing blanks visualization | ||
| 1310 | [] b - toggle SPACEs before TAB visualization | ||
| 1311 | [] l - toggle \"long lines\" visualization | ||
| 1312 | [] L - toggle \"long lines\" tail visualization | ||
| 1313 | [] n - toggle NEWLINE visualization | ||
| 1314 | [] i - toggle indentation SPACEs visualization | ||
| 1315 | [] e - toggle empty line at bob and/or eob visualization | ||
| 1316 | [] a - toggle SPACEs after TAB visualization | ||
| 1317 | |||
| 1318 | [] c - toggle color faces | ||
| 1319 | [] m - toggle visual mark | ||
| 1320 | |||
| 1321 | x - restore `blank-chars' value | ||
| 1322 | z - restore `blank-style' value | ||
| 1323 | |||
| 1324 | ? - display this text\n\n" | ||
| 1325 | "Text for blank toggle options.") | ||
| 1326 | |||
| 1327 | |||
| 1328 | (defconst blank-help-buffer-name "*Blank Toggle Options*" | ||
| 1329 | "The buffer name for blank toggle options.") | ||
| 1330 | |||
| 1331 | |||
| 1332 | (defun blank-insert-option-mark (the-list the-value) | ||
| 1333 | "Insert the option mark ('X' or ' ') in toggle options buffer." | ||
| 1334 | (forward-line 1) | ||
| 1335 | (dolist (sym the-list) | ||
| 1336 | (forward-line 1) | ||
| 1337 | (forward-char 2) | ||
| 1338 | (insert (if (memq sym the-value) "X" " ")))) | ||
| 1339 | |||
| 1340 | |||
| 1341 | (defun blank-help-on (chars style) | ||
| 1342 | "Display the blank toggle options." | ||
| 1343 | (unless (get-buffer blank-help-buffer-name) | ||
| 1344 | (delete-other-windows) | ||
| 1345 | (let ((buffer (get-buffer-create blank-help-buffer-name))) | ||
| 1346 | (save-excursion | ||
| 1347 | (set-buffer buffer) | ||
| 1348 | (erase-buffer) | ||
| 1349 | (insert blank-help-text) | ||
| 1350 | (goto-char (point-min)) | ||
| 1351 | (blank-insert-option-mark blank-chars-value-list chars) | ||
| 1352 | (blank-insert-option-mark blank-style-value-list style) | ||
| 1353 | (goto-char (point-min)) | ||
| 1354 | (set-buffer-modified-p nil) | ||
| 1355 | (let ((size (- (window-height) | ||
| 1356 | (max window-min-height | ||
| 1357 | (1+ (count-lines (point-min) (point-max))))))) | ||
| 1358 | (when (<= size 0) | ||
| 1359 | (kill-buffer buffer) | ||
| 1360 | (error "Frame height is too small; \ | ||
| 1361 | can't split window to display blank toggle options")) | ||
| 1362 | (set-window-buffer (split-window nil size) buffer)))))) | ||
| 1363 | |||
| 1364 | |||
| 1365 | (defun blank-help-off () | ||
| 1366 | "Remove the buffer and window of the blank toggle options." | ||
| 1367 | (let ((buffer (get-buffer blank-help-buffer-name))) | ||
| 1368 | (when buffer | ||
| 1369 | (delete-windows-on buffer) | ||
| 1370 | (kill-buffer buffer)))) | ||
| 1371 | |||
| 1372 | |||
| 1373 | (defun blank-interactive-char (local-p) | ||
| 1374 | "Interactive function to read a char and return a symbol. | ||
| 1375 | |||
| 1376 | If LOCAL-P is non-nil, it uses a local context; otherwise, it | ||
| 1377 | uses a global context. | ||
| 1378 | |||
| 1379 | It reads one of the following chars: | ||
| 1380 | |||
| 1381 | CHAR MEANING | ||
| 1382 | t toggle TAB visualization | ||
| 1383 | s toggle SPACE and HARD SPACE visualization | ||
| 1384 | r toggle trailing blanks visualization | ||
| 1385 | b toggle SPACEs before TAB visualization | ||
| 1386 | l toggle \"long lines\" visualization | ||
| 1387 | L toggle \"long lines\" tail visualization | ||
| 1388 | n toggle NEWLINE visualization | ||
| 1389 | i toggle indentation SPACEs visualization | ||
| 1390 | e toggle empty line at bob and/or eob visualization | ||
| 1391 | a toggle SPACEs after TAB visualization | ||
| 1392 | c toggle color faces | ||
| 1393 | m toggle visual mark | ||
| 1394 | x restore `blank-chars' value | ||
| 1395 | z restore `blank-style' value | ||
| 1396 | ? display brief help | ||
| 1397 | |||
| 1398 | See also `blank-toggle-option-alist'." | ||
| 1399 | (let* ((is-off (not (if local-p blank-mode global-blank-mode))) | ||
| 1400 | (chars (cond (is-off blank-chars) ; use default value | ||
| 1401 | (local-p blank-active-chars) | ||
| 1402 | (t blank-toggle-chars))) | ||
| 1403 | (style (cond (is-off blank-style) ; use default value | ||
| 1404 | (local-p blank-active-style) | ||
| 1405 | (t blank-toggle-style))) | ||
| 1406 | (prompt | ||
| 1407 | (format "Blank Toggle %s (type ? for further options)-" | ||
| 1408 | (if local-p "Local" "Global"))) | ||
| 1409 | ch sym) | ||
| 1410 | ;; read a valid option and get the corresponding symbol | ||
| 1411 | (save-window-excursion | ||
| 1412 | (condition-case data | ||
| 1413 | (progn | ||
| 1414 | (while | ||
| 1415 | ;; while condition | ||
| 1416 | (progn | ||
| 1417 | (setq ch (read-char prompt)) | ||
| 1418 | (not | ||
| 1419 | (setq sym | ||
| 1420 | (cdr (assq ch blank-toggle-option-alist))))) | ||
| 1421 | ;; while body | ||
| 1422 | (if (eq ch ?\?) | ||
| 1423 | (blank-help-on chars style) | ||
| 1424 | (ding))) | ||
| 1425 | (blank-help-off) | ||
| 1426 | (message " ")) ; clean echo area | ||
| 1427 | ;; handler | ||
| 1428 | ((quit error) | ||
| 1429 | (blank-help-off) | ||
| 1430 | (error (error-message-string data))))) | ||
| 1431 | (list sym))) ; return the apropriate symbol | ||
| 1432 | |||
| 1433 | |||
| 1434 | (defun blank-toggle-list (local-p arg the-list default-list | ||
| 1435 | sym-restore sym-list) | ||
| 1436 | "Toggle options in THE-LIST based on list ARG. | ||
| 1437 | |||
| 1438 | If LOCAL-P is non-nil, it uses a local context; otherwise, it | ||
| 1439 | uses a global context. | ||
| 1440 | |||
| 1441 | ARG is a list of options to be toggled. | ||
| 1442 | |||
| 1443 | THE-LIST is a list of options. This list will be toggled and the | ||
| 1444 | resultant list will be returned. | ||
| 1445 | |||
| 1446 | DEFAULT-LIST is the default list of options. It is used to | ||
| 1447 | restore the options in THE-LIST. | ||
| 1448 | |||
| 1449 | SYM-RESTORE is the symbol which indicates to restore the options | ||
| 1450 | in THE-LIST. | ||
| 1451 | |||
| 1452 | SYM-LIST is a list of valid options, used to check if the ARG's | ||
| 1453 | options are valid." | ||
| 1454 | (unless (if local-p blank-mode global-blank-mode) | ||
| 1455 | (setq the-list default-list)) | ||
| 1456 | (setq the-list (copy-sequence the-list)) ; keep original list | ||
| 1457 | (dolist (sym (if (listp arg) arg (list arg))) | ||
| 1458 | (cond | ||
| 1459 | ;; restore default values | ||
| 1460 | ((eq sym sym-restore) | ||
| 1461 | (setq the-list default-list)) | ||
| 1462 | ;; toggle valid values | ||
| 1463 | ((memq sym sym-list) | ||
| 1464 | (setq the-list (if (memq sym the-list) | ||
| 1465 | (delq sym the-list) | ||
| 1466 | (cons sym the-list)))))) | ||
| 1467 | the-list) | ||
| 1468 | |||
| 1469 | |||
| 1470 | (defun blank-turn-on () | ||
| 1471 | "Turn on blank visualization." | ||
| 1472 | (setq blank-active-style (if (listp blank-style) | ||
| 1473 | blank-style | ||
| 1474 | (list blank-style))) | ||
| 1475 | (setq blank-active-chars (if (listp blank-chars) | ||
| 1476 | blank-chars | ||
| 1477 | (list blank-chars))) | ||
| 1478 | (when (memq 'color blank-active-style) | ||
| 1479 | (blank-color-on)) | ||
| 1480 | (when (memq 'mark blank-active-style) | ||
| 1481 | (blank-display-char-on))) | ||
| 1482 | |||
| 1483 | |||
| 1484 | (defun blank-turn-off () | ||
| 1485 | "Turn off blank visualization." | ||
| 1486 | (when (memq 'color blank-active-style) | ||
| 1487 | (blank-color-off)) | ||
| 1488 | (when (memq 'mark blank-active-style) | ||
| 1489 | (blank-display-char-off))) | ||
| 1490 | |||
| 1491 | |||
| 1492 | (defun blank-color-on () | ||
| 1493 | "Turn on color visualization." | ||
| 1494 | (when blank-active-chars | ||
| 1495 | (unless blank-font-lock | ||
| 1496 | (setq blank-font-lock t | ||
| 1497 | blank-font-lock-keywords | ||
| 1498 | (copy-sequence font-lock-keywords))) | ||
| 1499 | ;; turn off font lock | ||
| 1500 | (setq blank-font-lock-mode font-lock-mode) | ||
| 1501 | (font-lock-mode 0) | ||
| 1502 | ;; add blank-mode color into font lock | ||
| 1503 | (when (memq 'spaces blank-active-chars) | ||
| 1504 | (font-lock-add-keywords | ||
| 1505 | nil | ||
| 1506 | (list | ||
| 1507 | ;; Show SPACEs | ||
| 1508 | (list blank-space-regexp 1 blank-space t) | ||
| 1509 | ;; Show HARD SPACEs | ||
| 1510 | (list blank-hspace-regexp 1 blank-hspace t)) | ||
| 1511 | t)) | ||
| 1512 | (when (memq 'tabs blank-active-chars) | ||
| 1513 | (font-lock-add-keywords | ||
| 1514 | nil | ||
| 1515 | (list | ||
| 1516 | ;; Show TABs | ||
| 1517 | (list blank-tab-regexp 1 blank-tab t)) | ||
| 1518 | t)) | ||
| 1519 | (when (memq 'trailing blank-active-chars) | ||
| 1520 | (font-lock-add-keywords | ||
| 1521 | nil | ||
| 1522 | (list | ||
| 1523 | ;; Show trailing blanks | ||
| 1524 | (list (concat "\\(\\(" blank-trailing-regexp "\\)+\\)$") | ||
| 1525 | 1 blank-trailing t)) | ||
| 1526 | t)) | ||
| 1527 | (when (or (memq 'lines blank-active-chars) | ||
| 1528 | (memq 'lines-tail blank-active-chars)) | ||
| 1529 | (font-lock-add-keywords | ||
| 1530 | nil | ||
| 1531 | (list | ||
| 1532 | ;; Show "long" lines | ||
| 1533 | (list | ||
| 1534 | (format | ||
| 1535 | "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$" | ||
| 1536 | tab-width (1- tab-width) | ||
| 1537 | (/ blank-line-column tab-width) | ||
| 1538 | (let ((rem (% blank-line-column tab-width))) | ||
| 1539 | (if (zerop rem) | ||
| 1540 | "" | ||
| 1541 | (format ".\\{%d\\}" rem)))) | ||
| 1542 | (if (memq 'lines blank-active-chars) | ||
| 1543 | 0 ; whole line | ||
| 1544 | 2) ; line tail | ||
| 1545 | blank-line t)) | ||
| 1546 | t)) | ||
| 1547 | (when (memq 'space-before-tab blank-active-chars) | ||
| 1548 | (font-lock-add-keywords | ||
| 1549 | nil | ||
| 1550 | (list | ||
| 1551 | ;; Show SPACEs before TAB | ||
| 1552 | (list blank-space-before-tab-regexp | ||
| 1553 | 1 blank-space-before-tab t)) | ||
| 1554 | t)) | ||
| 1555 | (when (memq 'indentation blank-active-chars) | ||
| 1556 | (font-lock-add-keywords | ||
| 1557 | nil | ||
| 1558 | (list | ||
| 1559 | ;; Show indentation SPACEs | ||
| 1560 | (list blank-indentation-regexp | ||
| 1561 | 1 blank-indentation t)) | ||
| 1562 | t)) | ||
| 1563 | (when (memq 'empty blank-active-chars) | ||
| 1564 | (font-lock-add-keywords | ||
| 1565 | nil | ||
| 1566 | (list | ||
| 1567 | ;; Show empty lines at beginning of buffer | ||
| 1568 | (list blank-empty-at-bob-regexp | ||
| 1569 | 1 blank-empty t)) | ||
| 1570 | t) | ||
| 1571 | (font-lock-add-keywords | ||
| 1572 | nil | ||
| 1573 | (list | ||
| 1574 | ;; Show empty lines at end of buffer | ||
| 1575 | (list blank-empty-at-eob-regexp | ||
| 1576 | 1 blank-empty t)) | ||
| 1577 | t)) | ||
| 1578 | (when (memq 'space-after-tab blank-active-chars) | ||
| 1579 | (font-lock-add-keywords | ||
| 1580 | nil | ||
| 1581 | (list | ||
| 1582 | ;; Show SPACEs after TAB | ||
| 1583 | (list blank-space-after-tab-regexp | ||
| 1584 | 1 blank-space-after-tab t)) | ||
| 1585 | t)) | ||
| 1586 | ;; now turn on font lock and highlight blanks | ||
| 1587 | (font-lock-mode 1))) | ||
| 1588 | |||
| 1589 | |||
| 1590 | (defun blank-color-off () | ||
| 1591 | "Turn off color visualization." | ||
| 1592 | (when blank-active-chars | ||
| 1593 | ;; turn off font lock | ||
| 1594 | (font-lock-mode 0) | ||
| 1595 | (when blank-font-lock | ||
| 1596 | (setq blank-font-lock nil | ||
| 1597 | font-lock-keywords blank-font-lock-keywords)) | ||
| 1598 | ;; restore original font lock state | ||
| 1599 | (font-lock-mode blank-font-lock-mode))) | ||
| 1600 | |||
| 1601 | |||
| 1602 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 1603 | ;;;; Hacked from visws.el (Miles Bader <miles@gnu.org>) | ||
| 1604 | |||
| 1605 | |||
| 1606 | (defvar blank-display-table nil | ||
| 1607 | "Used to save a local display table.") | ||
| 1608 | (make-variable-buffer-local 'blank-display-table) | ||
| 1609 | |||
| 1610 | (defvar blank-display-table-was-local nil | ||
| 1611 | "Used to remember whether a buffer initially had a local display table or not.") | ||
| 1612 | (make-variable-buffer-local 'blank-display-table-was-local) | ||
| 1613 | |||
| 1614 | |||
| 1615 | (defsubst blank-char-valid-p (char) | ||
| 1616 | ;; This check should be improved!!! | ||
| 1617 | (or (< char 256) | ||
| 1618 | (char-valid-p char))) | ||
| 1619 | |||
| 1620 | |||
| 1621 | (defun blank-legal-display-vector-p (vec) | ||
| 1622 | "Return true if every character in vector VEC can be displayed." | ||
| 1623 | (let ((i (length vec))) | ||
| 1624 | (when (> i 0) | ||
| 1625 | (while (and (>= (setq i (1- i)) 0) | ||
| 1626 | (blank-char-valid-p (aref vec i)))) | ||
| 1627 | (< i 0)))) | ||
| 1628 | |||
| 1629 | |||
| 1630 | (defun blank-display-char-on () | ||
| 1631 | "Turn on character display mapping." | ||
| 1632 | (when blank-display-mappings | ||
| 1633 | (let (vecs vec) | ||
| 1634 | ;; Remember whether a buffer has a local display table. | ||
| 1635 | (unless blank-display-table-was-local | ||
| 1636 | (setq blank-display-table-was-local t | ||
| 1637 | blank-display-table | ||
| 1638 | (copy-sequence buffer-display-table))) | ||
| 1639 | (unless buffer-display-table | ||
| 1640 | (setq buffer-display-table (make-display-table))) | ||
| 1641 | (dolist (entry blank-display-mappings) | ||
| 1642 | (setq vecs (cdr entry)) | ||
| 1643 | ;; Get a displayable mapping. | ||
| 1644 | (while (and vecs | ||
| 1645 | (not (blank-legal-display-vector-p (car vecs)))) | ||
| 1646 | (setq vecs (cdr vecs))) | ||
| 1647 | ;; Display a valid mapping. | ||
| 1648 | (when vecs | ||
| 1649 | (setq vec (copy-sequence (car vecs))) | ||
| 1650 | (cond | ||
| 1651 | ;; Any char except newline | ||
| 1652 | ((not (eq (car entry) ?\n)) | ||
| 1653 | (aset buffer-display-table (car entry) vec)) | ||
| 1654 | ;; Newline char - display it | ||
| 1655 | ((memq 'newline blank-active-chars) | ||
| 1656 | ;; Only insert face bits on NEWLINE char mapping to avoid | ||
| 1657 | ;; obstruction of other faces like TABs and (HARD) SPACEs | ||
| 1658 | ;; faces, font-lock faces, etc. | ||
| 1659 | (when (memq 'color blank-active-style) | ||
| 1660 | (dotimes (i (length vec)) | ||
| 1661 | ;; Due to limitations of glyph representation, the char | ||
| 1662 | ;; code can not be above ?\x1FFFF. Probably, this will | ||
| 1663 | ;; be fixed after Emacs unicode merging. | ||
| 1664 | (or (eq (aref vec i) ?\n) | ||
| 1665 | (> (aref vec i) #x1FFFF) | ||
| 1666 | (aset vec i (make-glyph-code (aref vec i) | ||
| 1667 | blank-newline))))) | ||
| 1668 | ;; Display mapping | ||
| 1669 | (aset buffer-display-table (car entry) vec)) | ||
| 1670 | ;; Newline char - don't display it | ||
| 1671 | (t | ||
| 1672 | ;; Do nothing | ||
| 1673 | ))))))) | ||
| 1674 | |||
| 1675 | |||
| 1676 | (defun blank-display-char-off () | ||
| 1677 | "Turn off character display mapping." | ||
| 1678 | (and blank-display-mappings | ||
| 1679 | blank-display-table-was-local | ||
| 1680 | (setq blank-display-table-was-local nil | ||
| 1681 | buffer-display-table blank-display-table))) | ||
| 1682 | |||
| 1683 | |||
| 1684 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 1685 | ;;;; Aliases for whitespace compatibility | ||
| 1686 | |||
| 1687 | |||
| 1688 | ;;;###autoload | ||
| 1689 | (defun whitespace-buffer () | ||
| 1690 | (interactive) | ||
| 1691 | (blank-mode 0) ; assure is off | ||
| 1692 | ;; keep original values | ||
| 1693 | (let ((blank-style (copy-sequence blank-style)) | ||
| 1694 | (blank-chars (copy-sequence blank-chars))) | ||
| 1695 | ;; adjust options for whitespace bogus blanks | ||
| 1696 | (add-to-list 'blank-style 'color) | ||
| 1697 | (mapc #'(lambda (option) | ||
| 1698 | (add-to-list 'blank-chars option)) | ||
| 1699 | '(trailing | ||
| 1700 | indentation | ||
| 1701 | space-before-tab | ||
| 1702 | empty | ||
| 1703 | space-after-tab)) | ||
| 1704 | (blank-mode 1))) | ||
| 1705 | |||
| 1706 | ;;;###autoload | ||
| 1707 | (defalias 'whitespace-region 'whitespace-buffer) ; there is no `blank-region' | ||
| 1708 | |||
| 1709 | ;;;###autoload | ||
| 1710 | (defalias 'whitespace-cleanup 'blank-cleanup) | ||
| 1711 | |||
| 1712 | ;;;###autoload | ||
| 1713 | (defalias 'whitespace-cleanup-region 'blank-cleanup-region) | ||
| 1714 | |||
| 1715 | |||
| 1716 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 1717 | |||
| 1718 | |||
| 1719 | (provide 'blank-mode) | ||
| 1720 | |||
| 1721 | |||
| 1722 | (run-hooks 'blank-load-hook) | ||
| 1723 | |||
| 1724 | |||
| 1725 | ;; arch-tag: 1b1e2500-dbd4-4a26-8f7a-5a5edfd3c97e | ||
| 1726 | ;;; blank-mode.el ends here | ||
diff --git a/lisp/button.el b/lisp/button.el index 5129df9b44f..0b45f2cec41 100644 --- a/lisp/button.el +++ b/lisp/button.el | |||
| @@ -116,7 +116,7 @@ Buttons inherit them by setting their `category' property to that symbol." | |||
| 116 | 116 | ||
| 117 | ;;;###autoload | 117 | ;;;###autoload |
| 118 | (defun define-button-type (name &rest properties) | 118 | (defun define-button-type (name &rest properties) |
| 119 | "Define a `button type' called NAME. | 119 | "Define a `button type' called NAME (a symbol). |
| 120 | The remaining arguments form a sequence of PROPERTY VALUE pairs, | 120 | The remaining arguments form a sequence of PROPERTY VALUE pairs, |
| 121 | specifying properties to use as defaults for buttons with this type | 121 | specifying properties to use as defaults for buttons with this type |
| 122 | \(a button's type may be set by giving it a `type' property when | 122 | \(a button's type may be set by giving it a `type' property when |
diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el index ca67b65abfa..973a6a0c9d2 100644 --- a/lisp/calc/calc-menu.el +++ b/lisp/calc/calc-menu.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; calc-menu.el --- a menu for Calc | 1 | ;;; calc-menu.el --- a menu for Calc |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> | 5 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> |
| 6 | 6 | ||
diff --git a/lisp/calc/calc-nlfit.el b/lisp/calc/calc-nlfit.el index 4019058a567..4eb1093af18 100644 --- a/lisp/calc/calc-nlfit.el +++ b/lisp/calc/calc-nlfit.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; calc-nlfit.el --- nonlinear curve fitting for Calc | 1 | ;;; calc-nlfit.el --- nonlinear curve fitting for Calc |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> | 5 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> |
| 6 | 6 | ||
diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el index 2846c283c15..38c14c80b14 100644 --- a/lisp/calendar/cal-menu.el +++ b/lisp/calendar/cal-menu.el | |||
| @@ -141,7 +141,10 @@ | |||
| 141 | "--" | 141 | "--" |
| 142 | ,@(let ((l ())) | 142 | ,@(let ((l ())) |
| 143 | ;; Show 11 years--5 before, 5 after year of middle month. | 143 | ;; Show 11 years--5 before, 5 after year of middle month. |
| 144 | ;; We used to use :suffix rather than :label and bumped into | ||
| 145 | ;; an easymenu bug: | ||
| 144 | ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01813.html | 146 | ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01813.html |
| 147 | ;; The bug has since been fixed. | ||
| 145 | (dotimes (i 11) | 148 | (dotimes (i 11) |
| 146 | (push (vector (format "hol-year-%d" i) | 149 | (push (vector (format "hol-year-%d" i) |
| 147 | `(lambda () | 150 | `(lambda () |
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index 46b16a54c89..62cc247e8de 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el | |||
| @@ -1,6 +1,7 @@ | |||
| 1 | ;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*- | 1 | ;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 |
| 4 | ;; Free Software Foundation, Inc. | ||
| 4 | 5 | ||
| 5 | ;; Author: Ulf Jasper <ulf.jasper@web.de> | 6 | ;; Author: Ulf Jasper <ulf.jasper@web.de> |
| 6 | ;; Created: August 2002 | 7 | ;; Created: August 2002 |
| @@ -40,33 +41,36 @@ | |||
| 40 | 41 | ||
| 41 | ;; 0.07 onwards: see lisp/ChangeLog | 42 | ;; 0.07 onwards: see lisp/ChangeLog |
| 42 | 43 | ||
| 43 | ;; 0.06: Bugfixes regarding icalendar-import-format-*. | 44 | ;; 0.06: (2004-10-06) |
| 44 | ;; Fix in icalendar-convert-diary-to-ical -- thanks to Philipp | 45 | ;; - Bugfixes regarding icalendar-import-format-*. |
| 45 | ;; Grau. | 46 | ;; - Fix in icalendar-convert-diary-to-ical -- thanks to Philipp Grau. |
| 46 | 47 | ||
| 47 | ;; 0.05: New import format scheme: Replaced icalendar-import-prefix-*, | 48 | ;; 0.05: (2003-06-19) |
| 48 | ;; icalendar-import-ignored-properties, and | 49 | ;; - New import format scheme: Replaced icalendar-import-prefix-*, |
| 49 | ;; icalendar-import-separator with icalendar-import-format(-*). | 50 | ;; icalendar-import-ignored-properties, and |
| 50 | ;; icalendar-import-file and icalendar-convert-diary-to-ical | 51 | ;; icalendar-import-separator with icalendar-import-format(-*). |
| 51 | ;; have an extra parameter which should prevent them from | 52 | ;; - icalendar-import-file and icalendar-convert-diary-to-ical |
| 52 | ;; erasing their target files (untested!). | 53 | ;; have an extra parameter which should prevent them from |
| 53 | ;; Tested with Emacs 21.3.2 | 54 | ;; erasing their target files (untested!). |
| 54 | 55 | ;; - Tested with Emacs 21.3.2 | |
| 55 | ;; 0.04: Bugfix: import: double quoted param values did not work | 56 | |
| 56 | ;; Read DURATION property when importing. | 57 | ;; 0.04: |
| 57 | ;; Added parameter icalendar-duration-correction. | 58 | ;; - Bugfix: import: double quoted param values did not work |
| 58 | 59 | ;; - Read DURATION property when importing. | |
| 59 | ;; 0.03: Export takes care of european-calendar-style. | 60 | ;; - Added parameter icalendar-duration-correction. |
| 60 | ;; Tested with Emacs 21.3.2 and XEmacs 21.4.12 | 61 | |
| 61 | 62 | ;; 0.03: (2003-05-07) | |
| 62 | ;; 0.02: Should work in XEmacs now. Thanks to Len Trigg for the | 63 | ;; - Export takes care of european-calendar-style. |
| 63 | ;; XEmacs patches! | 64 | ;; - Tested with Emacs 21.3.2 and XEmacs 21.4.12 |
| 64 | ;; Added exporting from Emacs diary to ical. | 65 | |
| 65 | ;; Some bugfixes, after testing with calendars from | 66 | ;; 0.02: |
| 66 | ;; http://icalshare.com. | 67 | ;; - Should work in XEmacs now. Thanks to Len Trigg for the XEmacs patches! |
| 67 | ;; Tested with Emacs 21.3.2 and XEmacs 21.4.12 | 68 | ;; - Added exporting from Emacs diary to ical. |
| 68 | 69 | ;; - Some bugfixes, after testing with calendars from http://icalshare.com. | |
| 69 | ;; 0.01: First published version. Trial version. Alpha version. | 70 | ;; - Tested with Emacs 21.3.2 and XEmacs 21.4.12 |
| 71 | |||
| 72 | ;; 0.01: (2003-03-21) | ||
| 73 | ;; - First published version. Trial version. Alpha version. | ||
| 70 | 74 | ||
| 71 | ;; ====================================================================== | 75 | ;; ====================================================================== |
| 72 | ;; To Do: | 76 | ;; To Do: |
| @@ -86,7 +90,7 @@ | |||
| 86 | ;; + the parser is too soft | 90 | ;; + the parser is too soft |
| 87 | ;; + error log is incomplete | 91 | ;; + error log is incomplete |
| 88 | ;; + nice to have: #include "webcal://foo.com/some-calendar.ics" | 92 | ;; + nice to have: #include "webcal://foo.com/some-calendar.ics" |
| 89 | ;; + timezones, currently all times are local! | 93 | ;; + timezones probably still need some improvements. |
| 90 | 94 | ||
| 91 | ;; * Export from diary to ical | 95 | ;; * Export from diary to ical |
| 92 | ;; + diary-date, diary-float, and self-made sexp entries are not | 96 | ;; + diary-date, diary-float, and self-made sexp entries are not |
| @@ -101,7 +105,7 @@ | |||
| 101 | 105 | ||
| 102 | ;;; Code: | 106 | ;;; Code: |
| 103 | 107 | ||
| 104 | (defconst icalendar-version "0.15" | 108 | (defconst icalendar-version "0.17" |
| 105 | "Version number of icalendar.el.") | 109 | "Version number of icalendar.el.") |
| 106 | 110 | ||
| 107 | ;; ====================================================================== | 111 | ;; ====================================================================== |
| @@ -114,17 +118,25 @@ | |||
| 114 | 118 | ||
| 115 | (defcustom icalendar-import-format | 119 | (defcustom icalendar-import-format |
| 116 | "%s%d%l%o" | 120 | "%s%d%l%o" |
| 117 | "Format string for importing events from iCalendar into Emacs diary. | 121 | "Format for importing events from iCalendar into Emacs diary. |
| 118 | This string defines how iCalendar events are inserted into diary | 122 | It defines how iCalendar events are inserted into diary file. |
| 119 | file. Meaning of the specifiers: | 123 | This may either be a string or a function. |
| 124 | |||
| 125 | In case of a formatting STRING the following specifiers can be used: | ||
| 120 | %c Class, see `icalendar-import-format-class' | 126 | %c Class, see `icalendar-import-format-class' |
| 121 | %d Description, see `icalendar-import-format-description' | 127 | %d Description, see `icalendar-import-format-description' |
| 122 | %l Location, see `icalendar-import-format-location' | 128 | %l Location, see `icalendar-import-format-location' |
| 123 | %o Organizer, see `icalendar-import-format-organizer' | 129 | %o Organizer, see `icalendar-import-format-organizer' |
| 124 | %s Summary, see `icalendar-import-format-summary' | 130 | %s Summary, see `icalendar-import-format-summary' |
| 125 | %t Status, see `icalendar-import-format-status' | 131 | %t Status, see `icalendar-import-format-status' |
| 126 | %u URL, see `icalendar-import-format-url'" | 132 | %u URL, see `icalendar-import-format-url' |
| 127 | :type 'string | 133 | |
| 134 | A formatting FUNCTION will be called with a VEVENT as its only | ||
| 135 | argument. It must return a string. See | ||
| 136 | `icalendar-import-format-sample' for an example." | ||
| 137 | :type '(choice | ||
| 138 | (string :tag "String") | ||
| 139 | (function :tag "Function")) | ||
| 128 | :group 'icalendar) | 140 | :group 'icalendar) |
| 129 | 141 | ||
| 130 | (defcustom icalendar-import-format-summary | 142 | (defcustom icalendar-import-format-summary |
| @@ -243,7 +255,7 @@ Pass arguments REGEXP REP STRING FIXEDCASE LITERAL to | |||
| 243 | INVALUE gives the current iCalendar element we are reading. | 255 | INVALUE gives the current iCalendar element we are reading. |
| 244 | INPARAMS gives the current parameters..... | 256 | INPARAMS gives the current parameters..... |
| 245 | This function calls itself recursively for each nested calendar element | 257 | This function calls itself recursively for each nested calendar element |
| 246 | it finds" | 258 | it finds." |
| 247 | (let (element children line name params param param-name param-value | 259 | (let (element children line name params param param-name param-value |
| 248 | value | 260 | value |
| 249 | (continue t)) | 261 | (continue t)) |
| @@ -390,15 +402,90 @@ children." | |||
| 390 | (append result (list (list param-name param-value))))))) | 402 | (append result (list (list param-name param-value))))))) |
| 391 | result)) | 403 | result)) |
| 392 | 404 | ||
| 393 | (defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift) | 405 | (defun icalendar--convert-tz-offset (alist dst-p) |
| 406 | "Return a cons of two strings representing a timezone start. | ||
| 407 | ALIST is an alist entry from a VTIMEZONE, like STANDARD. | ||
| 408 | DST-P is non-nil if this is for daylight savings time. | ||
| 409 | The strings are suitable for assembling into a TZ variable." | ||
| 410 | (let ((offset (car (cddr (assq 'TZOFFSETTO alist)))) | ||
| 411 | (rrule-value (car (cddr (assq 'RRULE alist)))) | ||
| 412 | (dtstart (car (cddr (assq 'DTSTART alist))))) | ||
| 413 | ;; FIXME: for now we only handle RRULE and not RDATE here. | ||
| 414 | (when (and offset rrule-value dtstart) | ||
| 415 | (let* ((rrule (icalendar--split-value rrule-value)) | ||
| 416 | (freq (cadr (assq 'FREQ rrule))) | ||
| 417 | (bymonth (cadr (assq 'BYMONTH rrule))) | ||
| 418 | (byday (cadr (assq 'BYDAY rrule)))) | ||
| 419 | ;; FIXME: we don't correctly handle WKST here. | ||
| 420 | (if (and (string= freq "YEARLY") bymonth) | ||
| 421 | (cons | ||
| 422 | (concat | ||
| 423 | ;; Fake a name. | ||
| 424 | (if dst-p "(DST?)" "(STD?)") | ||
| 425 | ;; For TZ, OFFSET is added to the local time. So, | ||
| 426 | ;; invert the values. | ||
| 427 | (if (eq (aref offset 0) ?-) "+" "-") | ||
| 428 | (substring offset 1 3) | ||
| 429 | ":" | ||
| 430 | (substring offset 3 5)) | ||
| 431 | ;; The start time. | ||
| 432 | (let* ((day (icalendar--get-weekday-number (substring byday -2))) | ||
| 433 | (week (if (eq day -1) | ||
| 434 | byday | ||
| 435 | (substring byday 0 -2)))) | ||
| 436 | (concat "M" bymonth "." week "." (if (eq day -1) "0" | ||
| 437 | (int-to-string day)) | ||
| 438 | ;; Start time. | ||
| 439 | "/" | ||
| 440 | (substring dtstart -6 -4) | ||
| 441 | ":" | ||
| 442 | (substring dtstart -4 -2) | ||
| 443 | ":" | ||
| 444 | (substring dtstart -2))))))))) | ||
| 445 | |||
| 446 | (defun icalendar--parse-vtimezone (alist) | ||
| 447 | "Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING). | ||
| 448 | Return nil if timezone cannot be parsed." | ||
| 449 | (let* ((tz-id (icalendar--get-event-property alist 'TZID)) | ||
| 450 | (daylight (cadr (cdar (icalendar--get-children alist 'DAYLIGHT)))) | ||
| 451 | (day (and daylight (icalendar--convert-tz-offset daylight t))) | ||
| 452 | (standard (cadr (cdar (icalendar--get-children alist 'STANDARD)))) | ||
| 453 | (std (and standard (icalendar--convert-tz-offset standard nil)))) | ||
| 454 | (if (and tz-id std) | ||
| 455 | (cons tz-id | ||
| 456 | (if day | ||
| 457 | (concat (car std) (car day) | ||
| 458 | "," (cdr day) "," (cdr std)) | ||
| 459 | (car std)))))) | ||
| 460 | |||
| 461 | (defun icalendar--convert-all-timezones (icalendar) | ||
| 462 | "Convert all timezones in the ICALENDAR into an alist. | ||
| 463 | Each element of the alist is a cons (ID . TZ-STRING), | ||
| 464 | like `icalendar--parse-vtimezone'." | ||
| 465 | (let (result) | ||
| 466 | (dolist (zone (icalendar--get-children (car icalendar) 'VTIMEZONE)) | ||
| 467 | (setq zone (icalendar--parse-vtimezone zone)) | ||
| 468 | (if zone | ||
| 469 | (setq result (cons zone result)))) | ||
| 470 | result)) | ||
| 471 | |||
| 472 | (defun icalendar--find-time-zone (prop-list zone-map) | ||
| 473 | "Return a timezone string for the time zone in PROP-LIST, or nil if none. | ||
| 474 | ZONE-MAP is a timezone alist as returned by `icalendar--convert-all-timezones'." | ||
| 475 | (let ((id (plist-get prop-list 'TZID))) | ||
| 476 | (if id | ||
| 477 | (cdr (assoc id zone-map))))) | ||
| 478 | |||
| 479 | (defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift | ||
| 480 | zone) | ||
| 394 | "Return ISODATETIMESTRING in format like `decode-time'. | 481 | "Return ISODATETIMESTRING in format like `decode-time'. |
| 395 | Converts from ISO-8601 to Emacs representation. If | 482 | Converts from ISO-8601 to Emacs representation. If |
| 396 | ISODATETIMESTRING specifies UTC time (trailing letter Z) the | 483 | ISODATETIMESTRING specifies UTC time (trailing letter Z) the |
| 397 | decoded time is given in the local time zone! If optional | 484 | decoded time is given in the local time zone! If optional |
| 398 | parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT | 485 | parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT |
| 399 | days. | 486 | days. |
| 487 | ZONE, if provided, is the timezone, in any format understood by `encode-time'. | ||
| 400 | 488 | ||
| 401 | FIXME: TZID-attributes are ignored....! | ||
| 402 | FIXME: multiple comma-separated values should be allowed!" | 489 | FIXME: multiple comma-separated values should be allowed!" |
| 403 | (icalendar--dmsg isodatetimestring) | 490 | (icalendar--dmsg isodatetimestring) |
| 404 | (if isodatetimestring | 491 | (if isodatetimestring |
| @@ -433,7 +520,7 @@ FIXME: multiple comma-separated values should be allowed!" | |||
| 433 | ;; create the decoded date-time | 520 | ;; create the decoded date-time |
| 434 | ;; FIXME!?! | 521 | ;; FIXME!?! |
| 435 | (condition-case nil | 522 | (condition-case nil |
| 436 | (decode-time (encode-time second minute hour day month year)) | 523 | (decode-time (encode-time second minute hour day month year zone)) |
| 437 | (error | 524 | (error |
| 438 | (message "Cannot decode \"%s\"" isodatetimestring) | 525 | (message "Cannot decode \"%s\"" isodatetimestring) |
| 439 | ;; hope for the best... | 526 | ;; hope for the best... |
| @@ -710,7 +797,7 @@ would be \"pm\"." | |||
| 710 | "Export diary file to iCalendar format. | 797 | "Export diary file to iCalendar format. |
| 711 | All diary entries in the file DIARY-FILENAME are converted to iCalendar | 798 | All diary entries in the file DIARY-FILENAME are converted to iCalendar |
| 712 | format. The result is appended to the file ICAL-FILENAME." | 799 | format. The result is appended to the file ICAL-FILENAME." |
| 713 | (interactive "FExport diary data from file: | 800 | (interactive "FExport diary data from file: |
| 714 | Finto iCalendar file: ") | 801 | Finto iCalendar file: ") |
| 715 | (save-current-buffer | 802 | (save-current-buffer |
| 716 | (set-buffer (find-file diary-filename)) | 803 | (set-buffer (find-file diary-filename)) |
| @@ -844,89 +931,95 @@ entries. ENTRY-MAIN is the first line of the diary entry." | |||
| 844 | (error "Could not parse entry"))) | 931 | (error "Could not parse entry"))) |
| 845 | 932 | ||
| 846 | (defun icalendar--parse-summary-and-rest (summary-and-rest) | 933 | (defun icalendar--parse-summary-and-rest (summary-and-rest) |
| 847 | "Parse SUMMARY-AND-REST from a diary to fill iCalendar properties." | 934 | "Parse SUMMARY-AND-REST from a diary to fill iCalendar properties. |
| 935 | Returns an alist." | ||
| 848 | (save-match-data | 936 | (save-match-data |
| 849 | (let* ((s icalendar-import-format) | 937 | (if (functionp icalendar-import-format) |
| 850 | (p-cla (or (string-match "%c" icalendar-import-format) -1)) | 938 | ;; can't do anything |
| 851 | (p-des (or (string-match "%d" icalendar-import-format) -1)) | 939 | nil |
| 852 | (p-loc (or (string-match "%l" icalendar-import-format) -1)) | 940 | ;; split summary-and-rest |
| 853 | (p-org (or (string-match "%o" icalendar-import-format) -1)) | 941 | (let* ((s icalendar-import-format) |
| 854 | (p-sum (or (string-match "%s" icalendar-import-format) -1)) | 942 | (p-cla (or (string-match "%c" icalendar-import-format) -1)) |
| 855 | (p-sta (or (string-match "%t" icalendar-import-format) -1)) | 943 | (p-des (or (string-match "%d" icalendar-import-format) -1)) |
| 856 | (p-url (or (string-match "%u" icalendar-import-format) -1)) | 944 | (p-loc (or (string-match "%l" icalendar-import-format) -1)) |
| 857 | (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url) '<)) | 945 | (p-org (or (string-match "%o" icalendar-import-format) -1)) |
| 858 | pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url) | 946 | (p-sum (or (string-match "%s" icalendar-import-format) -1)) |
| 859 | (dotimes (i (length p-list)) | 947 | (p-sta (or (string-match "%t" icalendar-import-format) -1)) |
| 860 | (cond ((and (>= p-cla 0) (= (nth i p-list) p-cla)) | 948 | (p-url (or (string-match "%u" icalendar-import-format) -1)) |
| 861 | (setq pos-cla (+ 2 (* 2 i)))) | 949 | (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url) '<)) |
| 862 | ((and (>= p-des 0) (= (nth i p-list) p-des)) | 950 | pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url) |
| 863 | (setq pos-des (+ 2 (* 2 i)))) | 951 | (dotimes (i (length p-list)) |
| 864 | ((and (>= p-loc 0) (= (nth i p-list) p-loc)) | 952 | (cond ((and (>= p-cla 0) (= (nth i p-list) p-cla)) |
| 865 | (setq pos-loc (+ 2 (* 2 i)))) | 953 | (setq pos-cla (+ 2 (* 2 i)))) |
| 866 | ((and (>= p-org 0) (= (nth i p-list) p-org)) | 954 | ((and (>= p-des 0) (= (nth i p-list) p-des)) |
| 867 | (setq pos-org (+ 2 (* 2 i)))) | 955 | (setq pos-des (+ 2 (* 2 i)))) |
| 868 | ((and (>= p-sta 0) (= (nth i p-list) p-sta)) | 956 | ((and (>= p-loc 0) (= (nth i p-list) p-loc)) |
| 869 | (setq pos-sta (+ 2 (* 2 i)))) | 957 | (setq pos-loc (+ 2 (* 2 i)))) |
| 870 | ((and (>= p-sum 0) (= (nth i p-list) p-sum)) | 958 | ((and (>= p-org 0) (= (nth i p-list) p-org)) |
| 871 | (setq pos-sum (+ 2 (* 2 i)))) | 959 | (setq pos-org (+ 2 (* 2 i)))) |
| 872 | ((and (>= p-url 0) (= (nth i p-list) p-url)) | 960 | ((and (>= p-sta 0) (= (nth i p-list) p-sta)) |
| 873 | (setq pos-url (+ 2 (* 2 i)))))) | 961 | (setq pos-sta (+ 2 (* 2 i)))) |
| 874 | (mapc (lambda (ij) | 962 | ((and (>= p-sum 0) (= (nth i p-list) p-sum)) |
| 875 | (setq s (icalendar--rris (car ij) (cadr ij) s t t))) | 963 | (setq pos-sum (+ 2 (* 2 i)))) |
| 876 | (list | 964 | ((and (>= p-url 0) (= (nth i p-list) p-url)) |
| 877 | ;; summary must be first! because of %s | 965 | (setq pos-url (+ 2 (* 2 i)))))) |
| 878 | (list "%s" | 966 | (mapc (lambda (ij) |
| 879 | (concat "\\(" icalendar-import-format-summary "\\)?")) | 967 | (setq s (icalendar--rris (car ij) (cadr ij) s t t))) |
| 880 | (list "%c" | 968 | (list |
| 881 | (concat "\\(" icalendar-import-format-class "\\)?")) | 969 | ;; summary must be first! because of %s |
| 882 | (list "%d" | 970 | (list "%s" |
| 883 | (concat "\\(" icalendar-import-format-description "\\)?")) | 971 | (concat "\\(" icalendar-import-format-summary "\\)??")) |
| 884 | (list "%l" | 972 | (list "%c" |
| 885 | (concat "\\(" icalendar-import-format-location "\\)?")) | 973 | (concat "\\(" icalendar-import-format-class "\\)??")) |
| 886 | (list "%o" | 974 | (list "%d" |
| 887 | (concat "\\(" icalendar-import-format-organizer "\\)?")) | 975 | (concat "\\(" icalendar-import-format-description "\\)??")) |
| 888 | (list "%t" | 976 | (list "%l" |
| 889 | (concat "\\(" icalendar-import-format-status "\\)?")) | 977 | (concat "\\(" icalendar-import-format-location "\\)??")) |
| 890 | (list "%u" | 978 | (list "%o" |
| 891 | (concat "\\(" icalendar-import-format-url "\\)?")))) | 979 | (concat "\\(" icalendar-import-format-organizer "\\)??")) |
| 892 | (setq s (concat (icalendar--rris "%s" "\\(.*\\)" s nil t) " ")) | 980 | (list "%t" |
| 893 | (if (string-match s summary-and-rest) | 981 | (concat "\\(" icalendar-import-format-status "\\)??")) |
| 894 | (let (cla des loc org sta sum url) | 982 | (list "%u" |
| 895 | (if (and pos-sum (match-beginning pos-sum)) | 983 | (concat "\\(" icalendar-import-format-url "\\)??")))) |
| 896 | (setq sum (substring summary-and-rest | 984 | (setq s (concat "^" (icalendar--rris "%s" "\\(.*?\\)" s nil t) |
| 897 | (match-beginning pos-sum) | 985 | " $")) |
| 898 | (match-end pos-sum)))) | 986 | (if (string-match s summary-and-rest) |
| 899 | (if (and pos-cla (match-beginning pos-cla)) | 987 | (let (cla des loc org sta sum url) |
| 900 | (setq cla (substring summary-and-rest | 988 | (if (and pos-sum (match-beginning pos-sum)) |
| 901 | (match-beginning pos-cla) | 989 | (setq sum (substring summary-and-rest |
| 902 | (match-end pos-cla)))) | 990 | (match-beginning pos-sum) |
| 903 | (if (and pos-des (match-beginning pos-des)) | 991 | (match-end pos-sum)))) |
| 904 | (setq des (substring summary-and-rest | 992 | (if (and pos-cla (match-beginning pos-cla)) |
| 905 | (match-beginning pos-des) | 993 | (setq cla (substring summary-and-rest |
| 906 | (match-end pos-des)))) | 994 | (match-beginning pos-cla) |
| 907 | (if (and pos-loc (match-beginning pos-loc)) | 995 | (match-end pos-cla)))) |
| 908 | (setq loc (substring summary-and-rest | 996 | (if (and pos-des (match-beginning pos-des)) |
| 909 | (match-beginning pos-loc) | 997 | (setq des (substring summary-and-rest |
| 910 | (match-end pos-loc)))) | 998 | (match-beginning pos-des) |
| 911 | (if (and pos-org (match-beginning pos-org)) | 999 | (match-end pos-des)))) |
| 912 | (setq org (substring summary-and-rest | 1000 | (if (and pos-loc (match-beginning pos-loc)) |
| 913 | (match-beginning pos-org) | 1001 | (setq loc (substring summary-and-rest |
| 914 | (match-end pos-org)))) | 1002 | (match-beginning pos-loc) |
| 915 | (if (and pos-sta (match-beginning pos-sta)) | 1003 | (match-end pos-loc)))) |
| 916 | (setq sta (substring summary-and-rest | 1004 | (if (and pos-org (match-beginning pos-org)) |
| 917 | (match-beginning pos-sta) | 1005 | (setq org (substring summary-and-rest |
| 918 | (match-end pos-sta)))) | 1006 | (match-beginning pos-org) |
| 919 | (if (and pos-url (match-beginning pos-url)) | 1007 | (match-end pos-org)))) |
| 920 | (setq url (substring summary-and-rest | 1008 | (if (and pos-sta (match-beginning pos-sta)) |
| 921 | (match-beginning pos-url) | 1009 | (setq sta (substring summary-and-rest |
| 922 | (match-end pos-url)))) | 1010 | (match-beginning pos-sta) |
| 923 | (list (if cla (cons 'cla cla) nil) | 1011 | (match-end pos-sta)))) |
| 924 | (if des (cons 'des des) nil) | 1012 | (if (and pos-url (match-beginning pos-url)) |
| 925 | (if loc (cons 'loc loc) nil) | 1013 | (setq url (substring summary-and-rest |
| 926 | (if org (cons 'org org) nil) | 1014 | (match-beginning pos-url) |
| 927 | (if sta (cons 'sta sta) nil) | 1015 | (match-end pos-url)))) |
| 928 | ;;(if sum (cons 'sum sum) nil) | 1016 | (list (if cla (cons 'cla cla) nil) |
| 929 | (if url (cons 'url url) nil))))))) | 1017 | (if des (cons 'des des) nil) |
| 1018 | (if loc (cons 'loc loc) nil) | ||
| 1019 | (if org (cons 'org org) nil) | ||
| 1020 | (if sta (cons 'sta sta) nil) | ||
| 1021 | ;;(if sum (cons 'sum sum) nil) | ||
| 1022 | (if url (cons 'url url) nil)))))))) | ||
| 930 | 1023 | ||
| 931 | ;; subroutines for icalendar-export-region | 1024 | ;; subroutines for icalendar-export-region |
| 932 | (defun icalendar--convert-ordinary-to-ical (nonmarker entry-main) | 1025 | (defun icalendar--convert-ordinary-to-ical (nonmarker entry-main) |
| @@ -1454,8 +1547,8 @@ Argument ICAL-FILENAME output iCalendar file. | |||
| 1454 | Argument DIARY-FILENAME input `diary-file'. | 1547 | Argument DIARY-FILENAME input `diary-file'. |
| 1455 | Optional argument NON-MARKING determines whether events are created as | 1548 | Optional argument NON-MARKING determines whether events are created as |
| 1456 | non-marking or not." | 1549 | non-marking or not." |
| 1457 | (interactive "fImport iCalendar data from file: | 1550 | (interactive "fImport iCalendar data from file: |
| 1458 | Finto diary file: | 1551 | Finto diary file: |
| 1459 | p") | 1552 | p") |
| 1460 | ;; clean up the diary file | 1553 | ;; clean up the diary file |
| 1461 | (save-current-buffer | 1554 | (save-current-buffer |
| @@ -1521,7 +1614,9 @@ buffer `*icalendar-errors*'." | |||
| 1521 | 1614 | ||
| 1522 | (defun icalendar--format-ical-event (event) | 1615 | (defun icalendar--format-ical-event (event) |
| 1523 | "Create a string representation of an iCalendar EVENT." | 1616 | "Create a string representation of an iCalendar EVENT." |
| 1524 | (let ((string icalendar-import-format) | 1617 | (if (functionp icalendar-import-format) |
| 1618 | (funcall icalendar-import-format event) | ||
| 1619 | (let ((string icalendar-import-format) | ||
| 1525 | (conversion-list | 1620 | (conversion-list |
| 1526 | '(("%c" CLASS icalendar-import-format-class) | 1621 | '(("%c" CLASS icalendar-import-format-class) |
| 1527 | ("%d" DESCRIPTION icalendar-import-format-description) | 1622 | ("%d" DESCRIPTION icalendar-import-format-description) |
| @@ -1549,7 +1644,7 @@ buffer `*icalendar-errors*'." | |||
| 1549 | string | 1644 | string |
| 1550 | t t)))) | 1645 | t t)))) |
| 1551 | conversion-list) | 1646 | conversion-list) |
| 1552 | string)) | 1647 | string))) |
| 1553 | 1648 | ||
| 1554 | (defun icalendar--convert-ical-to-diary (ical-list diary-file | 1649 | (defun icalendar--convert-ical-to-diary (ical-list diary-file |
| 1555 | &optional do-not-ask | 1650 | &optional do-not-ask |
| @@ -1566,6 +1661,7 @@ written into the buffer `*icalendar-errors*'." | |||
| 1566 | (error-string "") | 1661 | (error-string "") |
| 1567 | (event-ok t) | 1662 | (event-ok t) |
| 1568 | (found-error nil) | 1663 | (found-error nil) |
| 1664 | (zone-map (icalendar--convert-all-timezones ical-list)) | ||
| 1569 | e diary-string) | 1665 | e diary-string) |
| 1570 | ;; step through all events/appointments | 1666 | ;; step through all events/appointments |
| 1571 | (while ev | 1667 | (while ev |
| @@ -1574,13 +1670,24 @@ written into the buffer `*icalendar-errors*'." | |||
| 1574 | (setq event-ok nil) | 1670 | (setq event-ok nil) |
| 1575 | (condition-case error-val | 1671 | (condition-case error-val |
| 1576 | (let* ((dtstart (icalendar--get-event-property e 'DTSTART)) | 1672 | (let* ((dtstart (icalendar--get-event-property e 'DTSTART)) |
| 1577 | (dtstart-dec (icalendar--decode-isodatetime dtstart)) | 1673 | (dtstart-zone (icalendar--find-time-zone |
| 1674 | (icalendar--get-event-property-attributes | ||
| 1675 | e 'DTSTART) | ||
| 1676 | zone-map)) | ||
| 1677 | (dtstart-dec (icalendar--decode-isodatetime dtstart nil | ||
| 1678 | dtstart-zone)) | ||
| 1578 | (start-d (icalendar--datetime-to-diary-date | 1679 | (start-d (icalendar--datetime-to-diary-date |
| 1579 | dtstart-dec)) | 1680 | dtstart-dec)) |
| 1580 | (start-t (icalendar--datetime-to-colontime dtstart-dec)) | 1681 | (start-t (icalendar--datetime-to-colontime dtstart-dec)) |
| 1581 | (dtend (icalendar--get-event-property e 'DTEND)) | 1682 | (dtend (icalendar--get-event-property e 'DTEND)) |
| 1582 | (dtend-dec (icalendar--decode-isodatetime dtend)) | 1683 | (dtend-zone (icalendar--find-time-zone |
| 1583 | (dtend-1-dec (icalendar--decode-isodatetime dtend -1)) | 1684 | (icalendar--get-event-property-attributes |
| 1685 | e 'DTEND) | ||
| 1686 | zone-map)) | ||
| 1687 | (dtend-dec (icalendar--decode-isodatetime dtend | ||
| 1688 | nil dtend-zone)) | ||
| 1689 | (dtend-1-dec (icalendar--decode-isodatetime dtend -1 | ||
| 1690 | dtend-zone)) | ||
| 1584 | end-d | 1691 | end-d |
| 1585 | end-1-d | 1692 | end-1-d |
| 1586 | end-t | 1693 | end-t |
| @@ -1953,6 +2060,21 @@ the entry." | |||
| 1953 | ;; return diary-file in case it has been changed interactively | 2060 | ;; return diary-file in case it has been changed interactively |
| 1954 | diary-file) | 2061 | diary-file) |
| 1955 | 2062 | ||
| 2063 | ;; ====================================================================== | ||
| 2064 | ;; Examples | ||
| 2065 | ;; ====================================================================== | ||
| 2066 | (defun icalendar-import-format-sample (event) | ||
| 2067 | "Example function for formatting an icalendar EVENT." | ||
| 2068 | (format (concat "SUMMARY=`%s' DESCRIPTION=`%s' LOCATION=`%s' ORGANIZER=`%s' " | ||
| 2069 | "STATUS=`%s' URL=`%s' CLASS=`%s'") | ||
| 2070 | (or (icalendar--get-event-property event 'SUMMARY) "") | ||
| 2071 | (or (icalendar--get-event-property event 'DESCRIPTION) "") | ||
| 2072 | (or (icalendar--get-event-property event 'LOCATION) "") | ||
| 2073 | (or (icalendar--get-event-property event 'ORGANIZER) "") | ||
| 2074 | (or (icalendar--get-event-property event 'STATUS) "") | ||
| 2075 | (or (icalendar--get-event-property event 'URL) "") | ||
| 2076 | (or (icalendar--get-event-property event 'CLASS) ""))) | ||
| 2077 | |||
| 1956 | (provide 'icalendar) | 2078 | (provide 'icalendar) |
| 1957 | 2079 | ||
| 1958 | ;; arch-tag: 74fdbe8e-0451-4e38-bb61-4416e822f4fc | 2080 | ;; arch-tag: 74fdbe8e-0451-4e38-bb61-4416e822f4fc |
diff --git a/lisp/comint.el b/lisp/comint.el index 6fb89e28181..e4ee37c50f9 100644 --- a/lisp/comint.el +++ b/lisp/comint.el | |||
| @@ -822,6 +822,7 @@ buffer. The hook `comint-exec-hook' is run after each exec." | |||
| 822 | If there is no previous input at point, run the command specified | 822 | If there is no previous input at point, run the command specified |
| 823 | by the global keymap (usually `mouse-yank-at-point')." | 823 | by the global keymap (usually `mouse-yank-at-point')." |
| 824 | (interactive "e") | 824 | (interactive "e") |
| 825 | (mouse-set-point event) | ||
| 825 | (let ((pos (posn-point (event-end event))) | 826 | (let ((pos (posn-point (event-end event))) |
| 826 | field input) | 827 | field input) |
| 827 | (with-selected-window (posn-window (event-end event)) | 828 | (with-selected-window (posn-window (event-end event)) |
| @@ -1022,9 +1023,11 @@ See also `comint-read-input-ring'." | |||
| 1022 | (last-command last-command) | 1023 | (last-command last-command) |
| 1023 | (regexp (read-from-minibuffer prompt nil nil nil | 1024 | (regexp (read-from-minibuffer prompt nil nil nil |
| 1024 | 'minibuffer-history-search-history))) | 1025 | 'minibuffer-history-search-history))) |
| 1026 | ;; If the user didn't enter anything, nothing is added to m-h-s-h. | ||
| 1027 | ;; Use the previous search regexp, if there is one. | ||
| 1025 | (list (if (string-equal regexp "") | 1028 | (list (if (string-equal regexp "") |
| 1026 | (setcar minibuffer-history-search-history | 1029 | (or (car minibuffer-history-search-history) |
| 1027 | (nth 1 minibuffer-history-search-history)) | 1030 | regexp) |
| 1028 | regexp) | 1031 | regexp) |
| 1029 | (prefix-numeric-value current-prefix-arg)))) | 1032 | (prefix-numeric-value current-prefix-arg)))) |
| 1030 | 1033 | ||
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index c1071f3b3ef..7e014b4f7bd 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el | |||
| @@ -826,16 +826,19 @@ and `yes-or-no-p' otherwise." | |||
| 826 | 826 | ||
| 827 | (defun Custom-save (&rest ignore) | 827 | (defun Custom-save (&rest ignore) |
| 828 | "Set all edited settings, then save all settings that have been set. | 828 | "Set all edited settings, then save all settings that have been set. |
| 829 | If a setting was edited and set before, this saves it. | 829 | If a setting was edited and set before, this saves it. If a |
| 830 | If a setting was merely edited before, this sets it then saves it." | 830 | setting was merely edited before, this sets it then saves it." |
| 831 | (interactive) | 831 | (interactive) |
| 832 | (if (custom-command-apply | 832 | (when (custom-command-apply |
| 833 | (lambda (child) | 833 | (lambda (child) |
| 834 | (when (memq (widget-get child :custom-state) | 834 | (when (memq (widget-get child :custom-state) |
| 835 | '(modified set changed rogue)) | 835 | '(modified set changed rogue)) |
| 836 | (widget-apply child :custom-save))) | 836 | (widget-apply child :custom-mark-to-save))) |
| 837 | "Save all settings in this buffer? " t) | 837 | "Save all settings in this buffer? " t) |
| 838 | (custom-save-all))) | 838 | ;; Save changes to buffer and redraw. |
| 839 | (custom-save-all) | ||
| 840 | (dolist (child custom-options) | ||
| 841 | (widget-apply child :custom-state-set-and-redraw)))) | ||
| 839 | 842 | ||
| 840 | (defun custom-reset (widget &optional event) | 843 | (defun custom-reset (widget &optional event) |
| 841 | "Select item from reset menu." | 844 | "Select item from reset menu." |
| @@ -865,20 +868,67 @@ This also shows the saved values in the buffer." | |||
| 865 | (widget-apply widget :custom-reset-saved))) | 868 | (widget-apply widget :custom-reset-saved))) |
| 866 | "Reset all settings (current values and buffer text) to saved values? ")) | 869 | "Reset all settings (current values and buffer text) to saved values? ")) |
| 867 | 870 | ||
| 871 | ;; The next two variables are bound to '(t) by `Custom-reset-standard' | ||
| 872 | ;; and `custom-group-reset-standard'. If these variables are nil, both | ||
| 873 | ;; `custom-variable-reset-standard' and `custom-face-reset-standard' | ||
| 874 | ;; save, reset and redraw the handled widget immediately. Otherwise, | ||
| 875 | ;; they add the widget to the corresponding list and leave it to | ||
| 876 | ;; `custom-reset-standard-save-and-update' to save, reset and redraw it. | ||
| 877 | (defvar custom-reset-standard-variables-list nil) | ||
| 878 | (defvar custom-reset-standard-faces-list nil) | ||
| 879 | |||
| 880 | ;; The next function was excerpted from `custom-variable-reset-standard' | ||
| 881 | ;; and `custom-face-reset-standard' and is used to avoid calling | ||
| 882 | ;; `custom-save-all' repeatedly (and thus saving settings to file one by | ||
| 883 | ;; one) when erasing all customizations. | ||
| 884 | (defun custom-reset-standard-save-and-update () | ||
| 885 | "Save settings and redraw after erasing customizations." | ||
| 886 | (when (or (and custom-reset-standard-variables-list | ||
| 887 | (not (eq custom-reset-standard-variables-list '(t)))) | ||
| 888 | (and custom-reset-standard-faces-list | ||
| 889 | (not (eq custom-reset-standard-faces-list '(t))))) | ||
| 890 | ;; Save settings to file. | ||
| 891 | (custom-save-all) | ||
| 892 | ;; Set state of and redraw variables. | ||
| 893 | (dolist (widget custom-reset-standard-variables-list) | ||
| 894 | (unless (eq widget t) | ||
| 895 | (widget-put widget :custom-state 'unknown) | ||
| 896 | (custom-redraw widget))) | ||
| 897 | ;; Set state of and redraw faces. | ||
| 898 | (dolist (widget custom-reset-standard-faces-list) | ||
| 899 | (unless (eq widget t) | ||
| 900 | (let* ((symbol (widget-value widget)) | ||
| 901 | (child (car (widget-get widget :children))) | ||
| 902 | (value (get symbol 'face-defface-spec)) | ||
| 903 | (comment-widget (widget-get widget :comment-widget))) | ||
| 904 | (put symbol 'face-comment nil) | ||
| 905 | (widget-value-set child | ||
| 906 | (custom-pre-filter-face-spec | ||
| 907 | (list (list t (custom-face-attributes-get | ||
| 908 | symbol nil))))) | ||
| 909 | ;; This call manages the comment visibility | ||
| 910 | (widget-value-set comment-widget "") | ||
| 911 | (custom-face-state-set widget) | ||
| 912 | (custom-redraw-magic widget)))))) | ||
| 913 | |||
| 868 | (defun Custom-reset-standard (&rest ignore) | 914 | (defun Custom-reset-standard (&rest ignore) |
| 869 | "Erase all customization (either current or saved) for the group members. | 915 | "Erase all customizations (either current or saved) in current buffer. |
| 870 | The immediate result is to restore them to their standard values. | 916 | The immediate result is to restore them to their standard values. |
| 871 | This operation eliminates any saved values for the group members, | 917 | This operation eliminates any saved values for the group members, |
| 872 | making them as if they had never been customized at all." | 918 | making them as if they had never been customized at all." |
| 873 | (interactive) | 919 | (interactive) |
| 874 | (custom-command-apply | 920 | ;; Bind these temporarily. |
| 875 | (lambda (widget) | 921 | (let ((custom-reset-standard-variables-list '(t)) |
| 876 | (and (or (null (widget-get widget :custom-standard-value)) | 922 | (custom-reset-standard-faces-list '(t))) |
| 877 | (widget-apply widget :custom-standard-value)) | 923 | (custom-command-apply |
| 878 | (memq (widget-get widget :custom-state) | 924 | (lambda (widget) |
| 879 | '(modified set changed saved rogue)) | 925 | (and (or (null (widget-get widget :custom-standard-value)) |
| 880 | (widget-apply widget :custom-reset-standard))) | 926 | (widget-apply widget :custom-standard-value)) |
| 881 | "Erase all customizations for settings in this buffer? " t)) | 927 | (memq (widget-get widget :custom-state) |
| 928 | '(modified set changed saved rogue)) | ||
| 929 | (widget-apply widget :custom-mark-to-reset-standard))) | ||
| 930 | "Erase all customizations for settings in this buffer? " t) | ||
| 931 | (custom-reset-standard-save-and-update))) | ||
| 882 | 932 | ||
| 883 | ;;; The Customize Commands | 933 | ;;; The Customize Commands |
| 884 | 934 | ||
| @@ -1535,7 +1585,7 @@ Otherwise use brackets." | |||
| 1535 | (widget-insert "Editing a setting changes only the text in this buffer." | 1585 | (widget-insert "Editing a setting changes only the text in this buffer." |
| 1536 | (if init-file | 1586 | (if init-file |
| 1537 | " | 1587 | " |
| 1538 | To set apply your changes, use the Save or Set buttons. | 1588 | To apply your changes, use the Save or Set buttons. |
| 1539 | Saving a change normally works by editing your init file." | 1589 | Saving a change normally works by editing your init file." |
| 1540 | " | 1590 | " |
| 1541 | Currently, these settings cannot be saved for future Emacs sessions, | 1591 | Currently, these settings cannot be saved for future Emacs sessions, |
| @@ -2441,11 +2491,13 @@ However, setting it through Custom sets the default value.") | |||
| 2441 | :value-create 'custom-variable-value-create | 2491 | :value-create 'custom-variable-value-create |
| 2442 | :action 'custom-variable-action | 2492 | :action 'custom-variable-action |
| 2443 | :custom-set 'custom-variable-set | 2493 | :custom-set 'custom-variable-set |
| 2444 | :custom-save 'custom-variable-save | 2494 | :custom-mark-to-save 'custom-variable-mark-to-save |
| 2445 | :custom-reset-current 'custom-redraw | 2495 | :custom-reset-current 'custom-redraw |
| 2446 | :custom-reset-saved 'custom-variable-reset-saved | 2496 | :custom-reset-saved 'custom-variable-reset-saved |
| 2447 | :custom-reset-standard 'custom-variable-reset-standard | 2497 | :custom-reset-standard 'custom-variable-reset-standard |
| 2448 | :custom-standard-value 'custom-variable-standard-value) | 2498 | :custom-mark-to-reset-standard 'custom-variable-mark-to-reset-standard |
| 2499 | :custom-standard-value 'custom-variable-standard-value | ||
| 2500 | :custom-state-set-and-redraw 'custom-variable-state-set-and-redraw) | ||
| 2449 | 2501 | ||
| 2450 | (defun custom-variable-type (symbol) | 2502 | (defun custom-variable-type (symbol) |
| 2451 | "Return a widget suitable for editing the value of SYMBOL. | 2503 | "Return a widget suitable for editing the value of SYMBOL. |
| @@ -2807,8 +2859,8 @@ Optional EVENT is the location for the menu." | |||
| 2807 | (custom-variable-state-set widget) | 2859 | (custom-variable-state-set widget) |
| 2808 | (custom-redraw-magic widget))) | 2860 | (custom-redraw-magic widget))) |
| 2809 | 2861 | ||
| 2810 | (defun custom-variable-save (widget) | 2862 | (defun custom-variable-mark-to-save (widget) |
| 2811 | "Set and save the value for the variable being edited by WIDGET." | 2863 | "Set value and mark for saving the variable edited by WIDGET." |
| 2812 | (let* ((form (widget-get widget :custom-form)) | 2864 | (let* ((form (widget-get widget :custom-form)) |
| 2813 | (state (widget-get widget :custom-state)) | 2865 | (state (widget-get widget :custom-state)) |
| 2814 | (child (car (widget-get widget :children))) | 2866 | (child (car (widget-get widget :children))) |
| @@ -2846,10 +2898,18 @@ Optional EVENT is the location for the menu." | |||
| 2846 | (put symbol 'variable-comment comment) | 2898 | (put symbol 'variable-comment comment) |
| 2847 | (put symbol 'saved-variable-comment comment))) | 2899 | (put symbol 'saved-variable-comment comment))) |
| 2848 | (put symbol 'customized-value nil) | 2900 | (put symbol 'customized-value nil) |
| 2849 | (put symbol 'customized-variable-comment nil) | 2901 | (put symbol 'customized-variable-comment nil))) |
| 2850 | (custom-save-all) | 2902 | |
| 2851 | (custom-variable-state-set widget) | 2903 | (defsubst custom-variable-state-set-and-redraw (widget) |
| 2852 | (custom-redraw-magic widget))) | 2904 | "Set state of variable widget WIDGET and redraw with current settings." |
| 2905 | (custom-variable-state-set widget) | ||
| 2906 | (custom-redraw-magic widget)) | ||
| 2907 | |||
| 2908 | (defun custom-variable-save (widget) | ||
| 2909 | "Save value of variable edited by widget WIDGET." | ||
| 2910 | (custom-variable-mark-to-save widget) | ||
| 2911 | (custom-save-all) | ||
| 2912 | (custom-variable-state-set-and-redraw widget)) | ||
| 2853 | 2913 | ||
| 2854 | (defun custom-variable-reset-saved (widget) | 2914 | (defun custom-variable-reset-saved (widget) |
| 2855 | "Restore the saved value for the variable being edited by WIDGET. | 2915 | "Restore the saved value for the variable being edited by WIDGET. |
| @@ -2875,12 +2935,10 @@ becomes the backup value, so you can get it again." | |||
| 2875 | ;; This call will possibly make the comment invisible | 2935 | ;; This call will possibly make the comment invisible |
| 2876 | (custom-redraw widget))) | 2936 | (custom-redraw widget))) |
| 2877 | 2937 | ||
| 2878 | (defun custom-variable-reset-standard (widget) | 2938 | (defun custom-variable-mark-to-reset-standard (widget) |
| 2879 | "Restore the standard setting for the variable being edited by WIDGET. | 2939 | "Mark to restore standard setting for the variable edited by widget WIDGET. |
| 2880 | This operation eliminates any saved setting for the variable, | 2940 | If `custom-reset-standard-variables-list' is nil, save, reset and |
| 2881 | restoring it to the state of a variable that has never been customized. | 2941 | redraw the widget immediately." |
| 2882 | The value that was current before this operation | ||
| 2883 | becomes the backup value, so you can get it again." | ||
| 2884 | (let* ((symbol (widget-value widget))) | 2942 | (let* ((symbol (widget-value widget))) |
| 2885 | (if (get symbol 'standard-value) | 2943 | (if (get symbol 'standard-value) |
| 2886 | (custom-variable-backup-value widget) | 2944 | (custom-variable-backup-value widget) |
| @@ -2890,13 +2948,32 @@ becomes the backup value, so you can get it again." | |||
| 2890 | (put symbol 'customized-variable-comment nil) | 2948 | (put symbol 'customized-variable-comment nil) |
| 2891 | (custom-push-theme 'theme-value symbol 'user 'reset) | 2949 | (custom-push-theme 'theme-value symbol 'user 'reset) |
| 2892 | (custom-theme-recalc-variable symbol) | 2950 | (custom-theme-recalc-variable symbol) |
| 2893 | (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment)) | 2951 | (if (and custom-reset-standard-variables-list |
| 2894 | (put symbol 'saved-value nil) | 2952 | (or (get symbol 'saved-value) (get symbol 'saved-variable-comment))) |
| 2895 | (put symbol 'saved-variable-comment nil) | 2953 | (progn |
| 2896 | (custom-save-all)) | 2954 | (put symbol 'saved-value nil) |
| 2897 | (widget-put widget :custom-state 'unknown) | 2955 | (put symbol 'saved-variable-comment nil) |
| 2898 | ;; This call will possibly make the comment invisible | 2956 | ;; Append this to `custom-reset-standard-variables-list' to |
| 2899 | (custom-redraw widget))) | 2957 | ;; have `custom-reset-standard-save-and-update' save setting |
| 2958 | ;; to the file, update the widget's state, and redraw it. | ||
| 2959 | (setq custom-reset-standard-variables-list | ||
| 2960 | (cons widget custom-reset-standard-variables-list))) | ||
| 2961 | (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment)) | ||
| 2962 | (put symbol 'saved-value nil) | ||
| 2963 | (put symbol 'saved-variable-comment nil) | ||
| 2964 | (custom-save-all)) | ||
| 2965 | (widget-put widget :custom-state 'unknown) | ||
| 2966 | ;; This call will possibly make the comment invisible | ||
| 2967 | (custom-redraw widget)))) | ||
| 2968 | |||
| 2969 | (defun custom-variable-reset-standard (widget) | ||
| 2970 | "Restore standard setting for the variable edited by WIDGET. | ||
| 2971 | This operation eliminates any saved setting for the variable, | ||
| 2972 | restoring it to the state of a variable that has never been customized. | ||
| 2973 | The value that was current before this operation | ||
| 2974 | becomes the backup value, so you can get it again." | ||
| 2975 | (let (custom-reset-standard-variables-list) | ||
| 2976 | (custom-variable-mark-to-reset-standard widget))) | ||
| 2900 | 2977 | ||
| 2901 | (defun custom-variable-backup-value (widget) | 2978 | (defun custom-variable-backup-value (widget) |
| 2902 | "Back up the current value for WIDGET's variable. | 2979 | "Back up the current value for WIDGET's variable. |
| @@ -3172,11 +3249,13 @@ Only match frames that support the specified face attributes.") | |||
| 3172 | :custom-category 'face | 3249 | :custom-category 'face |
| 3173 | :custom-form nil ; defaults to value of `custom-face-default-form' | 3250 | :custom-form nil ; defaults to value of `custom-face-default-form' |
| 3174 | :custom-set 'custom-face-set | 3251 | :custom-set 'custom-face-set |
| 3175 | :custom-save 'custom-face-save | 3252 | :custom-mark-to-save 'custom-face-mark-to-save |
| 3176 | :custom-reset-current 'custom-redraw | 3253 | :custom-reset-current 'custom-redraw |
| 3177 | :custom-reset-saved 'custom-face-reset-saved | 3254 | :custom-reset-saved 'custom-face-reset-saved |
| 3178 | :custom-reset-standard 'custom-face-reset-standard | 3255 | :custom-reset-standard 'custom-face-reset-standard |
| 3256 | :custom-mark-to-reset-standard 'custom-face-mark-to-reset-standard | ||
| 3179 | :custom-standard-value 'custom-face-standard-value | 3257 | :custom-standard-value 'custom-face-standard-value |
| 3258 | :custom-state-set-and-redraw 'custom-face-state-set-and-redraw | ||
| 3180 | :custom-menu 'custom-face-menu-create) | 3259 | :custom-menu 'custom-face-menu-create) |
| 3181 | 3260 | ||
| 3182 | (define-widget 'custom-face-all 'editable-list | 3261 | (define-widget 'custom-face-all 'editable-list |
| @@ -3321,6 +3400,7 @@ SPEC must be a full face spec." | |||
| 3321 | ;; Update buttons. | 3400 | ;; Update buttons. |
| 3322 | (widget-put widget :buttons buttons) | 3401 | (widget-put widget :buttons buttons) |
| 3323 | ;; Insert documentation. | 3402 | ;; Insert documentation. |
| 3403 | (widget-put widget :documentation-indent 3) | ||
| 3324 | (widget-add-documentation-string-button | 3404 | (widget-add-documentation-string-button |
| 3325 | widget :visibility-widget 'custom-visibility) | 3405 | widget :visibility-widget 'custom-visibility) |
| 3326 | 3406 | ||
| @@ -3510,8 +3590,8 @@ Optional EVENT is the location for the menu." | |||
| 3510 | (custom-face-state-set widget) | 3590 | (custom-face-state-set widget) |
| 3511 | (custom-redraw-magic widget))) | 3591 | (custom-redraw-magic widget))) |
| 3512 | 3592 | ||
| 3513 | (defun custom-face-save (widget) | 3593 | (defun custom-face-mark-to-save (widget) |
| 3514 | "Save in `.emacs' the face attributes in WIDGET." | 3594 | "Mark for saving the face edited by WIDGET." |
| 3515 | (let* ((symbol (widget-value widget)) | 3595 | (let* ((symbol (widget-value widget)) |
| 3516 | (child (car (widget-get widget :children))) | 3596 | (child (car (widget-get widget :children))) |
| 3517 | (value (custom-post-filter-face-spec (widget-value child))) | 3597 | (value (custom-post-filter-face-spec (widget-value child))) |
| @@ -3532,10 +3612,18 @@ Optional EVENT is the location for the menu." | |||
| 3532 | (put symbol 'customized-face nil) | 3612 | (put symbol 'customized-face nil) |
| 3533 | (put symbol 'face-comment comment) | 3613 | (put symbol 'face-comment comment) |
| 3534 | (put symbol 'customized-face-comment nil) | 3614 | (put symbol 'customized-face-comment nil) |
| 3535 | (put symbol 'saved-face-comment comment) | 3615 | (put symbol 'saved-face-comment comment))) |
| 3536 | (custom-save-all) | 3616 | |
| 3537 | (custom-face-state-set widget) | 3617 | (defsubst custom-face-state-set-and-redraw (widget) |
| 3538 | (custom-redraw-magic widget))) | 3618 | "Set state of face widget WIDGET and redraw with current settings." |
| 3619 | (custom-face-state-set widget) | ||
| 3620 | (custom-redraw-magic widget)) | ||
| 3621 | |||
| 3622 | (defun custom-face-save (widget) | ||
| 3623 | "Save the face edited by WIDGET." | ||
| 3624 | (custom-face-mark-to-save widget) | ||
| 3625 | (custom-save-all) | ||
| 3626 | (custom-face-state-set-and-redraw widget)) | ||
| 3539 | 3627 | ||
| 3540 | ;; For backward compatibility. | 3628 | ;; For backward compatibility. |
| 3541 | (define-obsolete-function-alias 'custom-face-save-command 'custom-face-save | 3629 | (define-obsolete-function-alias 'custom-face-save-command 'custom-face-save |
| @@ -3564,10 +3652,10 @@ Optional EVENT is the location for the menu." | |||
| 3564 | (defun custom-face-standard-value (widget) | 3652 | (defun custom-face-standard-value (widget) |
| 3565 | (get (widget-value widget) 'face-defface-spec)) | 3653 | (get (widget-value widget) 'face-defface-spec)) |
| 3566 | 3654 | ||
| 3567 | (defun custom-face-reset-standard (widget) | 3655 | (defun custom-face-mark-to-reset-standard (widget) |
| 3568 | "Restore WIDGET to the face's standard attribute values. | 3656 | "Restore widget WIDGET to the face's standard attribute values. |
| 3569 | This operation eliminates any saved attributes for the face, | 3657 | If `custom-reset-standard-faces-list' is nil, save, reset and |
| 3570 | restoring it to the state of a face that has never been customized." | 3658 | redraw the widget immediately." |
| 3571 | (let* ((symbol (widget-value widget)) | 3659 | (let* ((symbol (widget-value widget)) |
| 3572 | (child (car (widget-get widget :children))) | 3660 | (child (car (widget-get widget :children))) |
| 3573 | (value (get symbol 'face-defface-spec)) | 3661 | (value (get symbol 'face-defface-spec)) |
| @@ -3579,19 +3667,37 @@ restoring it to the state of a face that has never been customized." | |||
| 3579 | (custom-push-theme 'theme-face symbol 'user 'reset) | 3667 | (custom-push-theme 'theme-face symbol 'user 'reset) |
| 3580 | (face-spec-set symbol value t) | 3668 | (face-spec-set symbol value t) |
| 3581 | (custom-theme-recalc-face symbol) | 3669 | (custom-theme-recalc-face symbol) |
| 3582 | (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment)) | 3670 | (if (and custom-reset-standard-faces-list |
| 3583 | (put symbol 'saved-face nil) | 3671 | (or (get symbol 'saved-face) (get symbol 'saved-face-comment))) |
| 3584 | (put symbol 'saved-face-comment nil) | 3672 | ;; Do this later. |
| 3585 | (custom-save-all)) | 3673 | (progn |
| 3586 | (put symbol 'face-comment nil) | 3674 | (put symbol 'saved-face nil) |
| 3587 | (widget-value-set child | 3675 | (put symbol 'saved-face-comment nil) |
| 3588 | (custom-pre-filter-face-spec | 3676 | ;; Append this to `custom-reset-standard-faces-list' and have |
| 3589 | (list (list t (custom-face-attributes-get | 3677 | ;; `custom-reset-standard-save-and-update' save setting to the |
| 3590 | symbol nil))))) | 3678 | ;; file, update the widget's state, and redraw it. |
| 3591 | ;; This call manages the comment visibility | 3679 | (setq custom-reset-standard-faces-list |
| 3592 | (widget-value-set comment-widget "") | 3680 | (cons widget custom-reset-standard-faces-list))) |
| 3593 | (custom-face-state-set widget) | 3681 | (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment)) |
| 3594 | (custom-redraw-magic widget))) | 3682 | (put symbol 'saved-face nil) |
| 3683 | (put symbol 'saved-face-comment nil) | ||
| 3684 | (custom-save-all)) | ||
| 3685 | (put symbol 'face-comment nil) | ||
| 3686 | (widget-value-set child | ||
| 3687 | (custom-pre-filter-face-spec | ||
| 3688 | (list (list t (custom-face-attributes-get | ||
| 3689 | symbol nil))))) | ||
| 3690 | ;; This call manages the comment visibility | ||
| 3691 | (widget-value-set comment-widget "") | ||
| 3692 | (custom-face-state-set widget) | ||
| 3693 | (custom-redraw-magic widget)))) | ||
| 3694 | |||
| 3695 | (defun custom-face-reset-standard (widget) | ||
| 3696 | "Restore WIDGET to the face's standard attribute values. | ||
| 3697 | This operation eliminates any saved attributes for the face, | ||
| 3698 | restoring it to the state of a face that has never been customized." | ||
| 3699 | (let (custom-reset-standard-faces-list) | ||
| 3700 | (custom-face-mark-to-reset-standard widget))) | ||
| 3595 | 3701 | ||
| 3596 | ;;; The `face' Widget. | 3702 | ;;; The `face' Widget. |
| 3597 | 3703 | ||
| @@ -3736,10 +3842,12 @@ and so forth. The remaining group tags are shown with `custom-group-tag'." | |||
| 3736 | :action 'custom-group-action | 3842 | :action 'custom-group-action |
| 3737 | :custom-category 'group | 3843 | :custom-category 'group |
| 3738 | :custom-set 'custom-group-set | 3844 | :custom-set 'custom-group-set |
| 3739 | :custom-save 'custom-group-save | 3845 | :custom-mark-to-save 'custom-group-mark-to-save |
| 3740 | :custom-reset-current 'custom-group-reset-current | 3846 | :custom-reset-current 'custom-group-reset-current |
| 3741 | :custom-reset-saved 'custom-group-reset-saved | 3847 | :custom-reset-saved 'custom-group-reset-saved |
| 3742 | :custom-reset-standard 'custom-group-reset-standard | 3848 | :custom-reset-standard 'custom-group-reset-standard |
| 3849 | :custom-mark-to-reset-standard 'custom-group-mark-to-reset-standard | ||
| 3850 | :custom-state-set-and-redraw 'custom-group-state-set-and-redraw | ||
| 3743 | :custom-menu 'custom-group-menu-create) | 3851 | :custom-menu 'custom-group-menu-create) |
| 3744 | 3852 | ||
| 3745 | (defun custom-group-sample-face-get (widget) | 3853 | (defun custom-group-sample-face-get (widget) |
| @@ -4034,11 +4142,23 @@ Optional EVENT is the location for the menu." | |||
| 4034 | (when (eq (widget-get child :custom-state) 'modified) | 4142 | (when (eq (widget-get child :custom-state) 'modified) |
| 4035 | (widget-apply child :custom-set)))) | 4143 | (widget-apply child :custom-set)))) |
| 4036 | 4144 | ||
| 4037 | (defun custom-group-save (widget) | 4145 | (defun custom-group-mark-to-save (widget) |
| 4038 | "Save all modified group members." | 4146 | "Mark all modified group members for saving." |
| 4039 | (dolist (child (widget-get widget :children)) | 4147 | (dolist (child (widget-get widget :children)) |
| 4040 | (when (memq (widget-get child :custom-state) '(modified set)) | 4148 | (when (memq (widget-get child :custom-state) '(modified set)) |
| 4041 | (widget-apply child :custom-save)))) | 4149 | (widget-apply child :custom-mark-to-save)))) |
| 4150 | |||
| 4151 | (defsubst custom-group-state-set-and-redraw (widget) | ||
| 4152 | "Set state of group widget WIDGET and redraw with current settings." | ||
| 4153 | (dolist (child (widget-get widget :children)) | ||
| 4154 | (when (memq (widget-get child :custom-state) '(modified set)) | ||
| 4155 | (widget-apply child :custom-state-set-and-redraw)))) | ||
| 4156 | |||
| 4157 | (defun custom-group-save (widget) | ||
| 4158 | "Save all modified group members." | ||
| 4159 | (custom-group-mark-to-save widget) | ||
| 4160 | (custom-save-all) | ||
| 4161 | (custom-group-state-set-and-redraw widget)) | ||
| 4042 | 4162 | ||
| 4043 | (defun custom-group-reset-current (widget) | 4163 | (defun custom-group-reset-current (widget) |
| 4044 | "Reset all modified group members." | 4164 | "Reset all modified group members." |
| @@ -4054,10 +4174,17 @@ Optional EVENT is the location for the menu." | |||
| 4054 | 4174 | ||
| 4055 | (defun custom-group-reset-standard (widget) | 4175 | (defun custom-group-reset-standard (widget) |
| 4056 | "Reset all modified, set, or saved group members." | 4176 | "Reset all modified, set, or saved group members." |
| 4177 | (let ((custom-reset-standard-variables-list '(t)) | ||
| 4178 | (custom-reset-standard-faces-list '(t))) | ||
| 4179 | (custom-group-mark-to-reset-standard widget) | ||
| 4180 | (custom-reset-standard-save-and-update))) | ||
| 4181 | |||
| 4182 | (defun custom-group-mark-to-reset-standard (widget) | ||
| 4183 | "Mark to reset all modified, set, or saved group members." | ||
| 4057 | (dolist (child (widget-get widget :children)) | 4184 | (dolist (child (widget-get widget :children)) |
| 4058 | (when (memq (widget-get child :custom-state) | 4185 | (when (memq (widget-get child :custom-state) |
| 4059 | '(modified set saved)) | 4186 | '(modified set saved)) |
| 4060 | (widget-apply child :custom-reset-standard)))) | 4187 | (widget-apply child :custom-mark-to-reset-standard)))) |
| 4061 | 4188 | ||
| 4062 | (defun custom-group-state-update (widget) | 4189 | (defun custom-group-state-update (widget) |
| 4063 | "Update magic." | 4190 | "Update magic." |
diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 5094eebc7ca..e87f8806df2 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el | |||
| @@ -95,7 +95,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of | |||
| 95 | (scroll-down-aggressively windows | 95 | (scroll-down-aggressively windows |
| 96 | (choice (const :tag "off" nil) number) | 96 | (choice (const :tag "off" nil) number) |
| 97 | "21.1") | 97 | "21.1") |
| 98 | (line-spacing display (choice (const :tag "none" nil) integer)) | 98 | (line-spacing display (choice (const :tag "none" nil) integer) |
| 99 | "22.1") | ||
| 99 | ;; callint.c | 100 | ;; callint.c |
| 100 | (mark-even-if-inactive editing-basics boolean) | 101 | (mark-even-if-inactive editing-basics boolean) |
| 101 | ;; callproc.c | 102 | ;; callproc.c |
| @@ -128,7 +129,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of | |||
| 128 | :match (lambda (widget value) | 129 | :match (lambda (widget value) |
| 129 | (and value (not (functionp value))))) | 130 | (and value (not (functionp value))))) |
| 130 | (function :value ignore)))) | 131 | (function :value ignore)))) |
| 131 | (selection-coding-system mule coding-system) | 132 | (selection-coding-system mule coding-system "22.1") |
| 132 | ;; dired.c | 133 | ;; dired.c |
| 133 | (completion-ignored-extensions dired | 134 | (completion-ignored-extensions dired |
| 134 | (repeat (string :format "%v"))) | 135 | (repeat (string :format "%v"))) |
| @@ -144,7 +145,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of | |||
| 144 | (max-lisp-eval-depth limits integer) | 145 | (max-lisp-eval-depth limits integer) |
| 145 | (max-mini-window-height limits | 146 | (max-mini-window-height limits |
| 146 | (choice (const :tag "quarter screen" nil) | 147 | (choice (const :tag "quarter screen" nil) |
| 147 | number)) | 148 | number) "23.1") |
| 148 | (stack-trace-on-error debug | 149 | (stack-trace-on-error debug |
| 149 | (choice (const :tag "off") | 150 | (choice (const :tag "off") |
| 150 | (repeat :menu-tag "When" | 151 | (repeat :menu-tag "When" |
| @@ -178,7 +179,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of | |||
| 178 | (sexp :tag "Value")))) | 179 | (sexp :tag "Value")))) |
| 179 | (mouse-highlight mouse (choice (const :tag "disabled" nil) | 180 | (mouse-highlight mouse (choice (const :tag "disabled" nil) |
| 180 | (const :tag "always shown" t) | 181 | (const :tag "always shown" t) |
| 181 | (other :tag "hidden by keypress" 1))) | 182 | (other :tag "hidden by keypress" 1)) |
| 183 | "22.1") | ||
| 182 | ;; fringe.c | 184 | ;; fringe.c |
| 183 | (overflow-newline-into-fringe fringe boolean) | 185 | (overflow-newline-into-fringe fringe boolean) |
| 184 | ;; indent.c | 186 | ;; indent.c |
| @@ -192,7 +194,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of | |||
| 192 | (polling-period keyboard integer) | 194 | (polling-period keyboard integer) |
| 193 | (double-click-time mouse (restricted-sexp | 195 | (double-click-time mouse (restricted-sexp |
| 194 | :match-alternatives (integerp 'nil 't))) | 196 | :match-alternatives (integerp 'nil 't))) |
| 195 | (double-click-fuzz mouse integer) | 197 | (double-click-fuzz mouse integer "22.1") |
| 196 | (inhibit-local-menu-bar-menus menu boolean) | 198 | (inhibit-local-menu-bar-menus menu boolean) |
| 197 | (help-char keyboard character) | 199 | (help-char keyboard character) |
| 198 | (help-event-list keyboard (repeat (sexp :format "%v"))) | 200 | (help-event-list keyboard (repeat (sexp :format "%v"))) |
| @@ -250,9 +252,9 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of | |||
| 250 | (completion-auto-help minibuffer boolean) | 252 | (completion-auto-help minibuffer boolean) |
| 251 | (enable-recursive-minibuffers minibuffer boolean) | 253 | (enable-recursive-minibuffers minibuffer boolean) |
| 252 | (history-length minibuffer | 254 | (history-length minibuffer |
| 253 | (choice (const :tag "Infinite" t) | 255 | (choice (const :tag "Infinite" t) integer) |
| 254 | integer)) | 256 | "22.1") |
| 255 | (history-delete-duplicates minibuffer boolean) | 257 | (history-delete-duplicates minibuffer boolean "22.1") |
| 256 | (minibuffer-prompt-properties | 258 | (minibuffer-prompt-properties |
| 257 | minibuffer | 259 | minibuffer |
| 258 | (list | 260 | (list |
| @@ -351,14 +353,15 @@ since it could result in memory overflow and make Emacs crash." | |||
| 351 | ;; and shape of the window. | 353 | ;; and shape of the window. |
| 352 | (const :tag "horizontally" | 354 | (const :tag "horizontally" |
| 353 | (lambda (window) | 355 | (lambda (window) |
| 354 | (split-window window nil 'horiz))))) | 356 | (split-window window nil 'horiz)))) |
| 357 | "23.1") | ||
| 355 | (window-min-height windows integer) | 358 | (window-min-height windows integer) |
| 356 | (window-min-width windows integer) | 359 | (window-min-width windows integer) |
| 357 | (scroll-preserve-screen-position | 360 | (scroll-preserve-screen-position |
| 358 | windows (choice | 361 | windows (choice |
| 359 | (const :tag "Off (nil)" :value nil) | 362 | (const :tag "Off (nil)" :value nil) |
| 360 | (const :tag "Full screen (t)" :value t) | 363 | (const :tag "Full screen (t)" :value t) |
| 361 | (other :tag "Always" 1))) | 364 | (other :tag "Always" 1)) "22.1") |
| 362 | (display-buffer-reuse-frames windows boolean "21.1") | 365 | (display-buffer-reuse-frames windows boolean "21.1") |
| 363 | ;; xdisp.c | 366 | ;; xdisp.c |
| 364 | (scroll-step windows integer) | 367 | (scroll-step windows integer) |
| @@ -372,7 +375,7 @@ since it could result in memory overflow and make Emacs crash." | |||
| 372 | (line-number-display-limit display | 375 | (line-number-display-limit display |
| 373 | (choice integer | 376 | (choice integer |
| 374 | (const :tag "No limit" nil))) | 377 | (const :tag "No limit" nil))) |
| 375 | (line-number-display-limit-width display integer) | 378 | (line-number-display-limit-width display integer "22.1") |
| 376 | (highlight-nonselected-windows display boolean) | 379 | (highlight-nonselected-windows display boolean) |
| 377 | (message-log-max debug (choice (const :tag "Disable" nil) | 380 | (message-log-max debug (choice (const :tag "Disable" nil) |
| 378 | (integer :menu-tag "lines" | 381 | (integer :menu-tag "lines" |
| @@ -387,7 +390,7 @@ since it could result in memory overflow and make Emacs crash." | |||
| 387 | (const :tag "Immediate" :value t) | 390 | (const :tag "Immediate" :value t) |
| 388 | (number :tag "Delay by secs" :value 0.5)) "22.1") | 391 | (number :tag "Delay by secs" :value 0.5)) "22.1") |
| 389 | ;; xfaces.c | 392 | ;; xfaces.c |
| 390 | (scalable-fonts-allowed display boolean) | 393 | (scalable-fonts-allowed display boolean "22.1") |
| 391 | ;; xfns.c | 394 | ;; xfns.c |
| 392 | (x-bitmap-file-path installation | 395 | (x-bitmap-file-path installation |
| 393 | (repeat (directory :format "%v"))) | 396 | (repeat (directory :format "%v"))) |
diff --git a/lisp/custom.el b/lisp/custom.el index a0b1db517a2..7466913eb9a 100644 --- a/lisp/custom.el +++ b/lisp/custom.el | |||
| @@ -1176,7 +1176,9 @@ This function returns nil if no custom theme specifies a value for VARIABLE." | |||
| 1176 | (defun custom-theme-recalc-face (face) | 1176 | (defun custom-theme-recalc-face (face) |
| 1177 | "Set FACE according to currently enabled custom themes." | 1177 | "Set FACE according to currently enabled custom themes." |
| 1178 | (if (facep face) | 1178 | (if (facep face) |
| 1179 | (face-spec-recalc face))) | 1179 | (face-spec-set face |
| 1180 | (get (or (get face 'face-alias) face) | ||
| 1181 | 'face-override-spec)))) | ||
| 1180 | 1182 | ||
| 1181 | ;;; XEmacs compability functions | 1183 | ;;; XEmacs compability functions |
| 1182 | 1184 | ||
diff --git a/lisp/delsel.el b/lisp/delsel.el index 6427c39eecb..3f9a0c7b32a 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el | |||
| @@ -113,7 +113,23 @@ any selection." | |||
| 113 | ;; stop safe_run_hooks from clearing out pre-command-hook. | 113 | ;; stop safe_run_hooks from clearing out pre-command-hook. |
| 114 | (and (eq inhibit-quit 'pre-command-hook) | 114 | (and (eq inhibit-quit 'pre-command-hook) |
| 115 | (setq inhibit-quit 'delete-selection-dummy)) | 115 | (setq inhibit-quit 'delete-selection-dummy)) |
| 116 | (signal 'file-supersession (cdr data))))))) | 116 | (signal 'file-supersession (cdr data))) |
| 117 | (text-read-only | ||
| 118 | ;; This signal may come either from `delete-active-region' or | ||
| 119 | ;; `self-insert-command' (when `overwrite-mode' is non-nil). | ||
| 120 | ;; To avoid clearing out `pre-command-hook' we handle this case | ||
| 121 | ;; by issuing a simple message. Note, however, that we do not | ||
| 122 | ;; handle all related problems: When read-only text ends before | ||
| 123 | ;; the end of the region, the latter is not deleted but any | ||
| 124 | ;; subsequent insertion will succeed. We could avoid this case | ||
| 125 | ;; by doing a (setq this-command 'ignore) here. This would, | ||
| 126 | ;; however, still not handle the case where read-only text ends | ||
| 127 | ;; precisely where the region starts: In that case the deletion | ||
| 128 | ;; would succeed but the subsequent insertion would fail with a | ||
| 129 | ;; text-read-only error. To handle that case we would have to | ||
| 130 | ;; investigate text properties at both ends of the region and | ||
| 131 | ;; skip the deletion when inserting text is forbidden there. | ||
| 132 | (message "Text is read-only") (ding)))))) | ||
| 117 | 133 | ||
| 118 | (put 'self-insert-command 'delete-selection t) | 134 | (put 'self-insert-command 'delete-selection t) |
| 119 | (put 'self-insert-iso 'delete-selection t) | 135 | (put 'self-insert-iso 'delete-selection t) |
| @@ -157,7 +173,7 @@ then it takes a second \\[keyboard-quit] to abort the minibuffer." | |||
| 157 | (dolist (sym '(self-insert-command self-insert-iso yank clipboard-yank | 173 | (dolist (sym '(self-insert-command self-insert-iso yank clipboard-yank |
| 158 | insert-register delete-backward-char backward-delete-char-untabify | 174 | insert-register delete-backward-char backward-delete-char-untabify |
| 159 | delete-char newline-and-indent newline open-line)) | 175 | delete-char newline-and-indent newline open-line)) |
| 160 | (remprop sym 'delete-selection)) | 176 | (put sym 'delete-selection nil)) |
| 161 | ;; continue standard unloading | 177 | ;; continue standard unloading |
| 162 | nil) | 178 | nil) |
| 163 | 179 | ||
diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el index 6291453ba17..b8b6a009e2b 100644 --- a/lisp/diff-mode.el +++ b/lisp/diff-mode.el | |||
| @@ -401,13 +401,9 @@ when editing big diffs)." | |||
| 401 | (defun diff-end-of-hunk (&optional style) | 401 | (defun diff-end-of-hunk (&optional style) |
| 402 | ;; Especially important for unified (because headers are ambiguous). | 402 | ;; Especially important for unified (because headers are ambiguous). |
| 403 | (setq style (diff-hunk-style style)) | 403 | (setq style (diff-hunk-style style)) |
| 404 | ;; Some versions of diff replace all-blank context lines in unified | ||
| 405 | ;; format with empty lines. The use of \n below avoids matching such | ||
| 406 | ;; lines as headers. | ||
| 407 | ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html | ||
| 408 | (let ((end (and (re-search-forward (case style | 404 | (let ((end (and (re-search-forward (case style |
| 409 | ;; A `unified' header is ambiguous. | 405 | ;; A `unified' header is ambiguous. |
| 410 | (unified (concat "^[^-+# \\\n]\\|" | 406 | (unified (concat "^[^-+# \\]\\|" |
| 411 | diff-file-header-re)) | 407 | diff-file-header-re)) |
| 412 | (context "^[^-+#! \\]") | 408 | (context "^[^-+#! \\]") |
| 413 | (normal "^[^<>#\\]") | 409 | (normal "^[^<>#\\]") |
diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 9c153dc584f..aaa68bf6387 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el | |||
| @@ -99,11 +99,11 @@ | |||
| 99 | 99 | ||
| 100 | ;;; Todo: | 100 | ;;; Todo: |
| 101 | 101 | ||
| 102 | ;; - share more code with image-mode again. | ||
| 102 | ;; - better menu. | 103 | ;; - better menu. |
| 103 | ;; - don't use `find-file'. | ||
| 104 | ;; - Bind slicing to a drag event. | 104 | ;; - Bind slicing to a drag event. |
| 105 | ;; - doc-view-fit-doc-to-window and doc-view-fit-window-to-doc. | 105 | ;; - doc-view-fit-doc-to-window and doc-view-fit-window-to-doc. |
| 106 | ;; - zoom a the region around the cursor (like xdvi). | 106 | ;; - zoom the region around the cursor (like xdvi). |
| 107 | ;; - get rid of the silly arrow in the fringe. | 107 | ;; - get rid of the silly arrow in the fringe. |
| 108 | ;; - improve anti-aliasing (pdf-utils gets it better). | 108 | ;; - improve anti-aliasing (pdf-utils gets it better). |
| 109 | 109 | ||
| @@ -247,6 +247,14 @@ has finished." | |||
| 247 | (defvar doc-view-previous-major-mode nil | 247 | (defvar doc-view-previous-major-mode nil |
| 248 | "Only used internally.") | 248 | "Only used internally.") |
| 249 | 249 | ||
| 250 | (defvar doc-view-buffer-file-name nil | ||
| 251 | "Only used internally. | ||
| 252 | The file name used for conversion. Normally it's the same as | ||
| 253 | `buffer-file-name', but for remote files, compressed files and | ||
| 254 | files inside an archive it is a temporary copy of | ||
| 255 | the (uncompressed, extracted) file residing in | ||
| 256 | `doc-view-cache-directory'.") | ||
| 257 | |||
| 250 | ;;;; DocView Keymaps | 258 | ;;;; DocView Keymaps |
| 251 | 259 | ||
| 252 | (defvar doc-view-mode-map | 260 | (defvar doc-view-mode-map |
| @@ -349,12 +357,7 @@ has finished." | |||
| 349 | ;; Update the buffer | 357 | ;; Update the buffer |
| 350 | (doc-view-insert-image (nth (1- page) doc-view-current-files) | 358 | (doc-view-insert-image (nth (1- page) doc-view-current-files) |
| 351 | :pointer 'arrow) | 359 | :pointer 'arrow) |
| 352 | (overlay-put doc-view-current-overlay 'help-echo doc-view-current-info) | 360 | (overlay-put doc-view-current-overlay 'help-echo doc-view-current-info))) |
| 353 | (goto-char (point-min)) | ||
| 354 | ;; This seems to be needed for set-window-hscroll (in | ||
| 355 | ;; image-forward-hscroll) to do something useful, I don't have time to | ||
| 356 | ;; debug this now. :-( --Stef | ||
| 357 | (forward-char))) | ||
| 358 | 361 | ||
| 359 | (defun doc-view-next-page (&optional arg) | 362 | (defun doc-view-next-page (&optional arg) |
| 360 | "Browse ARG pages forward." | 363 | "Browse ARG pages forward." |
| @@ -450,12 +453,12 @@ It's a subdirectory of `doc-view-cache-directory'." | |||
| 450 | (setq doc-view-current-cache-dir | 453 | (setq doc-view-current-cache-dir |
| 451 | (file-name-as-directory | 454 | (file-name-as-directory |
| 452 | (expand-file-name | 455 | (expand-file-name |
| 453 | (let ((doc buffer-file-name)) | 456 | (concat (file-name-nondirectory buffer-file-name) |
| 454 | (concat (file-name-nondirectory doc) | 457 | "-" |
| 455 | "-" | 458 | (let ((file doc-view-buffer-file-name)) |
| 456 | (with-temp-buffer | 459 | (with-temp-buffer |
| 457 | (insert-file-contents-literally doc) | 460 | (insert-file-contents-literally file) |
| 458 | (md5 (current-buffer))))) | 461 | (md5 (current-buffer))))) |
| 459 | doc-view-cache-directory))))) | 462 | doc-view-cache-directory))))) |
| 460 | 463 | ||
| 461 | (defun doc-view-remove-if (predicate list) | 464 | (defun doc-view-remove-if (predicate list) |
| @@ -476,7 +479,7 @@ Image types are symbols like `dvi', `postscript' or `pdf'." | |||
| 476 | (and (doc-view-mode-p 'pdf) | 479 | (and (doc-view-mode-p 'pdf) |
| 477 | doc-view-dvipdfm-program | 480 | doc-view-dvipdfm-program |
| 478 | (executable-find doc-view-dvipdfm-program))) | 481 | (executable-find doc-view-dvipdfm-program))) |
| 479 | ((or (eq type 'postscript) (eq type 'ps) | 482 | ((or (eq type 'postscript) (eq type 'ps) (eq type 'eps) |
| 480 | (eq type 'pdf)) | 483 | (eq type 'pdf)) |
| 481 | (and doc-view-ghostscript-program | 484 | (and doc-view-ghostscript-program |
| 482 | (executable-find doc-view-ghostscript-program))) | 485 | (executable-find doc-view-ghostscript-program))) |
| @@ -550,13 +553,16 @@ Should be invoked when the cached images aren't up-to-date." | |||
| 550 | (defun doc-view-pdf/ps->png (pdf-ps png) | 553 | (defun doc-view-pdf/ps->png (pdf-ps png) |
| 551 | "Convert PDF-PS to PNG asynchronously." | 554 | "Convert PDF-PS to PNG asynchronously." |
| 552 | (setq doc-view-current-converter-process | 555 | (setq doc-view-current-converter-process |
| 553 | (apply 'start-process | 556 | ;; Make sure the process is started in an existing directory, |
| 554 | (append (list "pdf/ps->png" doc-view-conversion-buffer | 557 | ;; (rather than some file-name-handler-managed dir, for example). |
| 555 | doc-view-ghostscript-program) | 558 | (let ((default-directory (file-name-directory pdf-ps))) |
| 556 | doc-view-ghostscript-options | 559 | (apply 'start-process |
| 557 | (list (format "-r%d" (round doc-view-resolution))) | 560 | (append (list "pdf/ps->png" doc-view-conversion-buffer |
| 558 | (list (concat "-sOutputFile=" png)) | 561 | doc-view-ghostscript-program) |
| 559 | (list pdf-ps))) | 562 | doc-view-ghostscript-options |
| 563 | (list (format "-r%d" (round doc-view-resolution))) | ||
| 564 | (list (concat "-sOutputFile=" png)) | ||
| 565 | (list pdf-ps)))) | ||
| 560 | mode-line-process (list (format ":%s" doc-view-current-converter-process))) | 566 | mode-line-process (list (format ":%s" doc-view-current-converter-process))) |
| 561 | (process-put doc-view-current-converter-process | 567 | (process-put doc-view-current-converter-process |
| 562 | 'buffer (current-buffer)) | 568 | 'buffer (current-buffer)) |
| @@ -620,7 +626,7 @@ Should be invoked when the cached images aren't up-to-date." | |||
| 620 | (process-put doc-view-current-converter-process 'pdf-file pdf)) | 626 | (process-put doc-view-current-converter-process 'pdf-file pdf)) |
| 621 | 627 | ||
| 622 | (defun doc-view-convert-current-doc () | 628 | (defun doc-view-convert-current-doc () |
| 623 | "Convert `buffer-file-name' to a set of png files, one file per page. | 629 | "Convert `doc-view-buffer-file-name' to a set of png files, one file per page. |
| 624 | Those files are saved in the directory given by the function | 630 | Those files are saved in the directory given by the function |
| 625 | `doc-view-current-cache-dir'." | 631 | `doc-view-current-cache-dir'." |
| 626 | ;; Let stale files still display while we recompute the new ones, so only | 632 | ;; Let stale files still display while we recompute the new ones, so only |
| @@ -632,12 +638,12 @@ Those files are saved in the directory given by the function | |||
| 632 | (let ((png-file (expand-file-name "page-%d.png" | 638 | (let ((png-file (expand-file-name "page-%d.png" |
| 633 | (doc-view-current-cache-dir)))) | 639 | (doc-view-current-cache-dir)))) |
| 634 | (make-directory (doc-view-current-cache-dir)) | 640 | (make-directory (doc-view-current-cache-dir)) |
| 635 | (if (not (string= (file-name-extension buffer-file-name) "dvi")) | 641 | (if (not (string= (file-name-extension doc-view-buffer-file-name) "dvi")) |
| 636 | ;; Convert to PNG images. | 642 | ;; Convert to PNG images. |
| 637 | (doc-view-pdf/ps->png buffer-file-name png-file) | 643 | (doc-view-pdf/ps->png doc-view-buffer-file-name png-file) |
| 638 | ;; DVI files have to be converted to PDF before Ghostscript can process | 644 | ;; DVI files have to be converted to PDF before Ghostscript can process |
| 639 | ;; it. | 645 | ;; it. |
| 640 | (doc-view-dvi->pdf buffer-file-name | 646 | (doc-view-dvi->pdf doc-view-buffer-file-name |
| 641 | (expand-file-name "doc.pdf" | 647 | (expand-file-name "doc.pdf" |
| 642 | doc-view-current-cache-dir))))) | 648 | doc-view-current-cache-dir))))) |
| 643 | 649 | ||
| @@ -697,13 +703,23 @@ ARGS is a list of image descriptors." | |||
| 697 | (when doc-view-pending-cache-flush | 703 | (when doc-view-pending-cache-flush |
| 698 | (clear-image-cache) | 704 | (clear-image-cache) |
| 699 | (setq doc-view-pending-cache-flush nil)) | 705 | (setq doc-view-pending-cache-flush nil)) |
| 700 | (let ((image (apply 'create-image file 'png nil args))) | 706 | (if (null file) |
| 701 | (setq doc-view-current-image image) | 707 | ;; We're trying to display a page that doesn't exist. Typically happens |
| 702 | (move-overlay doc-view-current-overlay (point-min) (point-max)) | 708 | ;; if the conversion process somehow failed. Better not signal an |
| 703 | (overlay-put doc-view-current-overlay 'display | 709 | ;; error here because it could prevent a subsequent reconversion from |
| 704 | (if doc-view-current-slice | 710 | ;; fixing the problem. |
| 705 | (list (cons 'slice doc-view-current-slice) image) | 711 | (progn |
| 706 | image)))) | 712 | (setq doc-view-current-image nil) |
| 713 | (move-overlay doc-view-current-overlay (point-min) (point-max)) | ||
| 714 | (overlay-put doc-view-current-overlay 'display | ||
| 715 | "Cannot display this page! Probably a conversion failure!")) | ||
| 716 | (let ((image (apply 'create-image file 'png nil args))) | ||
| 717 | (setq doc-view-current-image image) | ||
| 718 | (move-overlay doc-view-current-overlay (point-min) (point-max)) | ||
| 719 | (overlay-put doc-view-current-overlay 'display | ||
| 720 | (if doc-view-current-slice | ||
| 721 | (list (cons 'slice doc-view-current-slice) image) | ||
| 722 | image))))) | ||
| 707 | 723 | ||
| 708 | (defun doc-view-sort (a b) | 724 | (defun doc-view-sort (a b) |
| 709 | "Return non-nil if A should be sorted before B. | 725 | "Return non-nil if A should be sorted before B. |
| @@ -847,15 +863,15 @@ If BACKWARD is non-nil, jump to the previous match." | |||
| 847 | ;; We must convert to TXT first! | 863 | ;; We must convert to TXT first! |
| 848 | (if doc-view-current-converter-process | 864 | (if doc-view-current-converter-process |
| 849 | (message "DocView: please wait till conversion finished.") | 865 | (message "DocView: please wait till conversion finished.") |
| 850 | (let ((ext (file-name-extension buffer-file-name))) | 866 | (let ((ext (file-name-extension doc-view-buffer-file-name))) |
| 851 | (cond | 867 | (cond |
| 852 | ((string= ext "pdf") | 868 | ((string= ext "pdf") |
| 853 | ;; Doc is a PDF, so convert it to TXT | 869 | ;; Doc is a PDF, so convert it to TXT |
| 854 | (doc-view-pdf->txt buffer-file-name txt)) | 870 | (doc-view-pdf->txt doc-view-buffer-file-name txt)) |
| 855 | ((string= ext "ps") | 871 | ((string= ext "ps") |
| 856 | ;; Doc is a PS, so convert it to PDF (which will be converted to | 872 | ;; Doc is a PS, so convert it to PDF (which will be converted to |
| 857 | ;; TXT thereafter). | 873 | ;; TXT thereafter). |
| 858 | (doc-view-ps->pdf buffer-file-name | 874 | (doc-view-ps->pdf doc-view-buffer-file-name |
| 859 | (expand-file-name "doc.pdf" | 875 | (expand-file-name "doc.pdf" |
| 860 | (doc-view-current-cache-dir)))) | 876 | (doc-view-current-cache-dir)))) |
| 861 | ((string= ext "dvi") | 877 | ((string= ext "dvi") |
| @@ -900,7 +916,7 @@ If BACKWARD is non-nil, jump to the previous match." | |||
| 900 | 916 | ||
| 901 | (defun doc-view-initiate-display () | 917 | (defun doc-view-initiate-display () |
| 902 | ;; Switch to image display if possible | 918 | ;; Switch to image display if possible |
| 903 | (if (doc-view-mode-p (intern (file-name-extension buffer-file-name))) | 919 | (if (doc-view-mode-p (intern (file-name-extension doc-view-buffer-file-name))) |
| 904 | (progn | 920 | (progn |
| 905 | (doc-view-buffer-message) | 921 | (doc-view-buffer-message) |
| 906 | (setq doc-view-current-page (or doc-view-current-page 1)) | 922 | (setq doc-view-current-page (or doc-view-current-page 1)) |
| @@ -918,7 +934,7 @@ If BACKWARD is non-nil, jump to the previous match." | |||
| 918 | "%s" | 934 | "%s" |
| 919 | (substitute-command-keys | 935 | (substitute-command-keys |
| 920 | (concat "No image (png) support available or some conversion utility for " | 936 | (concat "No image (png) support available or some conversion utility for " |
| 921 | (file-name-extension buffer-file-name)" files is missing. " | 937 | (file-name-extension doc-view-buffer-file-name)" files is missing. " |
| 922 | "Type \\[doc-view-toggle-display] to switch to an editing mode."))))) | 938 | "Type \\[doc-view-toggle-display] to switch to an editing mode."))))) |
| 923 | 939 | ||
| 924 | (defvar bookmark-make-cell-function) | 940 | (defvar bookmark-make-cell-function) |
| @@ -929,49 +945,72 @@ If BACKWARD is non-nil, jump to the previous match." | |||
| 929 | You can use \\<doc-view-mode-map>\\[doc-view-toggle-display] to | 945 | You can use \\<doc-view-mode-map>\\[doc-view-toggle-display] to |
| 930 | toggle between displaying the document or editing it as text." | 946 | toggle between displaying the document or editing it as text." |
| 931 | (interactive) | 947 | (interactive) |
| 932 | (if jka-compr-really-do-compress | 948 | |
| 933 | ;; This is a compressed file uncompressed by auto-compression-mode. | 949 | (let* ((prev-major-mode (if (eq major-mode 'doc-view-mode) |
| 934 | (when (y-or-n-p (concat "DocView: Cannot convert compressed file. " | 950 | doc-view-previous-major-mode |
| 935 | "Save it uncompressed first? ")) | 951 | major-mode))) |
| 936 | (let ((file (read-file-name | 952 | (kill-all-local-variables) |
| 937 | "File: " | 953 | (set (make-local-variable 'doc-view-previous-major-mode) prev-major-mode)) |
| 938 | (file-name-directory buffer-file-name)))) | 954 | |
| 939 | (write-region (point-min) (point-max) file) | 955 | ;; Handle compressed files, remote files, files inside archives |
| 940 | (kill-buffer nil) | 956 | (set (make-local-variable 'doc-view-buffer-file-name) |
| 941 | (find-file file) | 957 | (cond |
| 942 | (doc-view-mode))) | 958 | (jka-compr-really-do-compress |
| 943 | (let* ((prev-major-mode (if (eq major-mode 'doc-view-mode) | 959 | (expand-file-name |
| 944 | doc-view-previous-major-mode | 960 | (file-name-nondirectory |
| 945 | major-mode))) | 961 | (file-name-sans-extension buffer-file-name)) |
| 946 | (kill-all-local-variables) | 962 | doc-view-cache-directory)) |
| 947 | (set (make-local-variable 'doc-view-previous-major-mode) prev-major-mode)) | 963 | ;; Is the file readable by local processes? |
| 948 | (make-local-variable 'doc-view-current-files) | 964 | ;; We used to use `file-remote-p' but it's unclear what it's |
| 949 | (make-local-variable 'doc-view-current-image) | 965 | ;; supposed to return nil for things like local files accessed via |
| 950 | (make-local-variable 'doc-view-current-page) | 966 | ;; `su' or via file://... |
| 951 | (make-local-variable 'doc-view-current-converter-process) | 967 | ((let ((file-name-handler-alist nil)) |
| 952 | (make-local-variable 'doc-view-current-timer) | 968 | (not (file-readable-p buffer-file-name))) |
| 953 | (make-local-variable 'doc-view-current-slice) | 969 | (expand-file-name |
| 954 | (make-local-variable 'doc-view-current-cache-dir) | 970 | (file-name-nondirectory buffer-file-name) |
| 955 | (make-local-variable 'doc-view-current-info) | 971 | doc-view-cache-directory)) |
| 956 | (make-local-variable 'doc-view-current-search-matches) | 972 | (t buffer-file-name))) |
| 957 | (set (make-local-variable 'doc-view-current-overlay) | 973 | (when (not (string= doc-view-buffer-file-name buffer-file-name)) |
| 958 | (make-overlay (point-min) (point-max) nil t)) | 974 | (write-region nil nil doc-view-buffer-file-name)) |
| 959 | (add-hook 'change-major-mode-hook | 975 | |
| 960 | (lambda () (delete-overlay doc-view-current-overlay)) | 976 | (make-local-variable 'doc-view-current-files) |
| 961 | nil t) | 977 | (make-local-variable 'doc-view-current-image) |
| 962 | (set (make-local-variable 'mode-line-position) | 978 | (make-local-variable 'doc-view-current-page) |
| 963 | '(" P" (:eval (number-to-string doc-view-current-page)) | 979 | (make-local-variable 'doc-view-current-converter-process) |
| 964 | "/" (:eval (number-to-string (length doc-view-current-files))))) | 980 | (make-local-variable 'doc-view-current-timer) |
| 965 | (set (make-local-variable 'cursor-type) nil) | 981 | (make-local-variable 'doc-view-current-slice) |
| 966 | (use-local-map doc-view-mode-map) | 982 | (make-local-variable 'doc-view-current-cache-dir) |
| 967 | (set (make-local-variable 'after-revert-hook) 'doc-view-reconvert-doc) | 983 | (make-local-variable 'doc-view-current-info) |
| 968 | (set (make-local-variable 'bookmark-make-cell-function) | 984 | (make-local-variable 'doc-view-current-search-matches) |
| 969 | 'doc-view-bookmark-make-cell) | 985 | (set (make-local-variable 'doc-view-current-overlay) |
| 970 | (setq mode-name "DocView" | 986 | (make-overlay (point-min) (point-max) nil t)) |
| 971 | buffer-read-only t | 987 | (add-hook 'change-major-mode-hook |
| 972 | major-mode 'doc-view-mode) | 988 | (lambda () (delete-overlay doc-view-current-overlay)) |
| 973 | (doc-view-initiate-display) | 989 | nil t) |
| 974 | (run-mode-hooks 'doc-view-mode-hook))) | 990 | |
| 991 | ;; Keep track of [vh]scroll when switching buffers | ||
| 992 | (make-local-variable 'image-mode-current-hscroll) | ||
| 993 | (make-local-variable 'image-mode-current-vscroll) | ||
| 994 | (image-set-window-hscroll (selected-window) (window-hscroll)) | ||
| 995 | (image-set-window-vscroll (selected-window) (window-vscroll)) | ||
| 996 | (add-hook 'window-configuration-change-hook | ||
| 997 | 'image-reset-current-vhscroll nil t) | ||
| 998 | |||
| 999 | (set (make-local-variable 'mode-line-position) | ||
| 1000 | '(" P" (:eval (number-to-string doc-view-current-page)) | ||
| 1001 | "/" (:eval (number-to-string (length doc-view-current-files))))) | ||
| 1002 | ;; Don't scroll unless the user specifically asked for it. | ||
| 1003 | (set (make-local-variable 'auto-hscroll-mode) nil) | ||
| 1004 | (set (make-local-variable 'cursor-type) nil) | ||
| 1005 | (use-local-map doc-view-mode-map) | ||
| 1006 | (set (make-local-variable 'after-revert-hook) 'doc-view-reconvert-doc) | ||
| 1007 | (set (make-local-variable 'bookmark-make-cell-function) | ||
| 1008 | 'doc-view-bookmark-make-cell) | ||
| 1009 | (setq mode-name "DocView" | ||
| 1010 | buffer-read-only t | ||
| 1011 | major-mode 'doc-view-mode) | ||
| 1012 | (doc-view-initiate-display) | ||
| 1013 | (run-mode-hooks 'doc-view-mode-hook)) | ||
| 975 | 1014 | ||
| 976 | ;;;###autoload | 1015 | ;;;###autoload |
| 977 | (define-minor-mode doc-view-minor-mode | 1016 | (define-minor-mode doc-view-minor-mode |
| @@ -1003,7 +1042,7 @@ See the command `doc-view-mode' for more information on this mode." | |||
| 1003 | 1042 | ||
| 1004 | (defun doc-view-bookmark-make-cell (annotation &rest args) | 1043 | (defun doc-view-bookmark-make-cell (annotation &rest args) |
| 1005 | (let ((the-record | 1044 | (let ((the-record |
| 1006 | `((filename . ,(buffer-file-name)) | 1045 | `((filename . ,buffer-file-name) |
| 1007 | (page . ,doc-view-current-page) | 1046 | (page . ,doc-view-current-page) |
| 1008 | (handler . doc-view-bookmark-jump)))) | 1047 | (handler . doc-view-bookmark-jump)))) |
| 1009 | 1048 | ||
diff --git a/lisp/ediff-diff.el b/lisp/ediff-diff.el index 685543b5369..b690bfbe4e1 100644 --- a/lisp/ediff-diff.el +++ b/lisp/ediff-diff.el | |||
| @@ -948,7 +948,7 @@ delimiter regions")) | |||
| 948 | ))) | 948 | ))) |
| 949 | 949 | ||
| 950 | 950 | ||
| 951 | (defsubst ediff-convert-fine-diffs-to-overlays (diff-list region-num) | 951 | (defun ediff-convert-fine-diffs-to-overlays (diff-list region-num) |
| 952 | (ediff-set-fine-overlays-in-one-buffer 'A diff-list region-num) | 952 | (ediff-set-fine-overlays-in-one-buffer 'A diff-list region-num) |
| 953 | (ediff-set-fine-overlays-in-one-buffer 'B diff-list region-num) | 953 | (ediff-set-fine-overlays-in-one-buffer 'B diff-list region-num) |
| 954 | (if ediff-3way-job | 954 | (if ediff-3way-job |
diff --git a/lisp/ediff-util.el b/lisp/ediff-util.el index dd844c9a542..058e20f6a19 100644 --- a/lisp/ediff-util.el +++ b/lisp/ediff-util.el | |||
| @@ -41,6 +41,9 @@ | |||
| 41 | 41 | ||
| 42 | (defvar ediff-after-quit-hook-internal nil) | 42 | (defvar ediff-after-quit-hook-internal nil) |
| 43 | 43 | ||
| 44 | (eval-and-compile | ||
| 45 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 46 | |||
| 44 | (eval-when-compile | 47 | (eval-when-compile |
| 45 | (let ((load-path (cons (expand-file-name ".") load-path))) | 48 | (let ((load-path (cons (expand-file-name ".") load-path))) |
| 46 | (provide 'ediff-util) ; to break recursive load cycle | 49 | (provide 'ediff-util) ; to break recursive load cycle |
| @@ -2406,7 +2409,9 @@ If it is t, they will be preserved unconditionally. A prefix argument, | |||
| 2406 | temporarily reverses the meaning of this variable." | 2409 | temporarily reverses the meaning of this variable." |
| 2407 | (interactive "P") | 2410 | (interactive "P") |
| 2408 | (ediff-barf-if-not-control-buffer) | 2411 | (ediff-barf-if-not-control-buffer) |
| 2409 | (let ((ctl-buf (current-buffer))) | 2412 | (let ((ctl-buf (current-buffer)) |
| 2413 | (ctl-frm (selected-frame)) | ||
| 2414 | (minibuffer-auto-raise t)) | ||
| 2410 | (if (y-or-n-p (format "Quit this Ediff session%s? " | 2415 | (if (y-or-n-p (format "Quit this Ediff session%s? " |
| 2411 | (if (ediff-buffer-live-p ediff-meta-buffer) | 2416 | (if (ediff-buffer-live-p ediff-meta-buffer) |
| 2412 | " & show containing session group" ""))) | 2417 | " & show containing session group" ""))) |
| @@ -2414,6 +2419,8 @@ temporarily reverses the meaning of this variable." | |||
| 2414 | (message "") | 2419 | (message "") |
| 2415 | (set-buffer ctl-buf) | 2420 | (set-buffer ctl-buf) |
| 2416 | (ediff-really-quit reverse-default-keep-variants)) | 2421 | (ediff-really-quit reverse-default-keep-variants)) |
| 2422 | (select-frame ctl-frm) | ||
| 2423 | (raise-frame ctl-frm) | ||
| 2417 | (message "")))) | 2424 | (message "")))) |
| 2418 | 2425 | ||
| 2419 | 2426 | ||
| @@ -2816,7 +2823,6 @@ up an appropriate window config." | |||
| 2816 | (message | 2823 | (message |
| 2817 | "To resume, type M-x eregistry and select the desired Ediff session")) | 2824 | "To resume, type M-x eregistry and select the desired Ediff session")) |
| 2818 | 2825 | ||
| 2819 | |||
| 2820 | ;; ediff-barf-if-not-control-buffer ensures only called from ediff. | 2826 | ;; ediff-barf-if-not-control-buffer ensures only called from ediff. |
| 2821 | (declare-function ediff-version "ediff" ()) | 2827 | (declare-function ediff-version "ediff" ()) |
| 2822 | 2828 | ||
diff --git a/lisp/ediff-wind.el b/lisp/ediff-wind.el index c5a53b47b3b..26aa19f38a4 100644 --- a/lisp/ediff-wind.el +++ b/lisp/ediff-wind.el | |||
| @@ -40,6 +40,11 @@ | |||
| 40 | (defvar frame-icon-title-format) | 40 | (defvar frame-icon-title-format) |
| 41 | (defvar ediff-diff-status) | 41 | (defvar ediff-diff-status) |
| 42 | 42 | ||
| 43 | ;; declare-function does not exist in XEmacs | ||
| 44 | (eval-and-compile | ||
| 45 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 46 | |||
| 47 | |||
| 43 | (eval-when-compile | 48 | (eval-when-compile |
| 44 | (let ((load-path (cons (expand-file-name ".") load-path))) | 49 | (let ((load-path (cons (expand-file-name ".") load-path))) |
| 45 | (or (featurep 'ediff-init) | 50 | (or (featurep 'ediff-init) |
diff --git a/lisp/ediff.el b/lisp/ediff.el index 353c6a14d47..cdfb66d9c00 100644 --- a/lisp/ediff.el +++ b/lisp/ediff.el | |||
| @@ -8,7 +8,7 @@ | |||
| 8 | ;; Keywords: comparing, merging, patching, tools, unix | 8 | ;; Keywords: comparing, merging, patching, tools, unix |
| 9 | 9 | ||
| 10 | (defconst ediff-version "2.81.2" "The current version of Ediff") | 10 | (defconst ediff-version "2.81.2" "The current version of Ediff") |
| 11 | (defconst ediff-date "August 18, 2007" "Date of last update") | 11 | (defconst ediff-date "January 09, 2008" "Date of last update") |
| 12 | 12 | ||
| 13 | 13 | ||
| 14 | ;; This file is part of GNU Emacs. | 14 | ;; This file is part of GNU Emacs. |
| @@ -113,6 +113,9 @@ | |||
| 113 | (defvar ediff-last-dir-patch) | 113 | (defvar ediff-last-dir-patch) |
| 114 | (defvar ediff-patch-default-directory) | 114 | (defvar ediff-patch-default-directory) |
| 115 | 115 | ||
| 116 | (eval-and-compile | ||
| 117 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 118 | |||
| 116 | 119 | ||
| 117 | (eval-when-compile | 120 | (eval-when-compile |
| 118 | (and noninteractive | 121 | (and noninteractive |
diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index b8cf8362386..f2eb06710e1 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; avl-tree.el --- balanced binary trees, AVL-trees | 1 | ;;; avl-tree.el --- balanced binary trees, AVL-trees |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1995, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1995, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Per Cederqvist <ceder@lysator.liu.se> | 5 | ;; Author: Per Cederqvist <ceder@lysator.liu.se> |
| 6 | ;; Inge Wallin <inge@lysator.liu.se> | 6 | ;; Inge Wallin <inge@lysator.liu.se> |
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index fe7f774c7e9..9f81cebaca8 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; check-declare.el --- Check declare-function statements | 1 | ;;; check-declare.el --- Check declare-function statements |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Glenn Morris <rgm@gnu.org> | 5 | ;; Author: Glenn Morris <rgm@gnu.org> |
| 6 | ;; Keywords: lisp, tools, maint | 6 | ;; Keywords: lisp, tools, maint |
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 7b0f1961530..2297314af87 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el | |||
| @@ -10,16 +10,16 @@ | |||
| 10 | ;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p | 10 | ;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p |
| 11 | ;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively | 11 | ;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively |
| 12 | ;;;;;; notevery notany every some mapcon mapcan mapl maplist map | 12 | ;;;;;; notevery notany every some mapcon mapcan mapl maplist map |
| 13 | ;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "53c2b3ede19dac62cff13a37f58cdf9c") | 13 | ;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "2f89c94c42629315419a9d7404469c42") |
| 14 | ;;; Generated autoloads from cl-extra.el | 14 | ;;; Generated autoloads from cl-extra.el |
| 15 | 15 | ||
| 16 | (autoload (quote coerce) "cl-extra" "\ | 16 | (autoload 'coerce "cl-extra" "\ |
| 17 | Coerce OBJECT to type TYPE. | 17 | Coerce OBJECT to type TYPE. |
| 18 | TYPE is a Common Lisp type specifier. | 18 | TYPE is a Common Lisp type specifier. |
| 19 | 19 | ||
| 20 | \(fn OBJECT TYPE)" nil nil) | 20 | \(fn OBJECT TYPE)" nil nil) |
| 21 | 21 | ||
| 22 | (autoload (quote equalp) "cl-extra" "\ | 22 | (autoload 'equalp "cl-extra" "\ |
| 23 | Return t if two Lisp objects have similar structures and contents. | 23 | Return t if two Lisp objects have similar structures and contents. |
| 24 | This is like `equal', except that it accepts numerically equal | 24 | This is like `equal', except that it accepts numerically equal |
| 25 | numbers of different types (float vs. integer), and also compares | 25 | numbers of different types (float vs. integer), and also compares |
| @@ -27,246 +27,246 @@ strings case-insensitively. | |||
| 27 | 27 | ||
| 28 | \(fn X Y)" nil nil) | 28 | \(fn X Y)" nil nil) |
| 29 | 29 | ||
| 30 | (autoload (quote cl-mapcar-many) "cl-extra" "\ | 30 | (autoload 'cl-mapcar-many "cl-extra" "\ |
| 31 | Not documented | 31 | Not documented |
| 32 | 32 | ||
| 33 | \(fn CL-FUNC CL-SEQS)" nil nil) | 33 | \(fn CL-FUNC CL-SEQS)" nil nil) |
| 34 | 34 | ||
| 35 | (autoload (quote map) "cl-extra" "\ | 35 | (autoload 'map "cl-extra" "\ |
| 36 | Map a FUNCTION across one or more SEQUENCEs, returning a sequence. | 36 | Map a FUNCTION across one or more SEQUENCEs, returning a sequence. |
| 37 | TYPE is the sequence type to return. | 37 | TYPE is the sequence type to return. |
| 38 | 38 | ||
| 39 | \(fn TYPE FUNCTION SEQUENCE...)" nil nil) | 39 | \(fn TYPE FUNCTION SEQUENCE...)" nil nil) |
| 40 | 40 | ||
| 41 | (autoload (quote maplist) "cl-extra" "\ | 41 | (autoload 'maplist "cl-extra" "\ |
| 42 | Map FUNCTION to each sublist of LIST or LISTs. | 42 | Map FUNCTION to each sublist of LIST or LISTs. |
| 43 | Like `mapcar', except applies to lists and their cdr's rather than to | 43 | Like `mapcar', except applies to lists and their cdr's rather than to |
| 44 | the elements themselves. | 44 | the elements themselves. |
| 45 | 45 | ||
| 46 | \(fn FUNCTION LIST...)" nil nil) | 46 | \(fn FUNCTION LIST...)" nil nil) |
| 47 | 47 | ||
| 48 | (autoload (quote mapl) "cl-extra" "\ | 48 | (autoload 'mapl "cl-extra" "\ |
| 49 | Like `maplist', but does not accumulate values returned by the function. | 49 | Like `maplist', but does not accumulate values returned by the function. |
| 50 | 50 | ||
| 51 | \(fn FUNCTION LIST...)" nil nil) | 51 | \(fn FUNCTION LIST...)" nil nil) |
| 52 | 52 | ||
| 53 | (autoload (quote mapcan) "cl-extra" "\ | 53 | (autoload 'mapcan "cl-extra" "\ |
| 54 | Like `mapcar', but nconc's together the values returned by the function. | 54 | Like `mapcar', but nconc's together the values returned by the function. |
| 55 | 55 | ||
| 56 | \(fn FUNCTION SEQUENCE...)" nil nil) | 56 | \(fn FUNCTION SEQUENCE...)" nil nil) |
| 57 | 57 | ||
| 58 | (autoload (quote mapcon) "cl-extra" "\ | 58 | (autoload 'mapcon "cl-extra" "\ |
| 59 | Like `maplist', but nconc's together the values returned by the function. | 59 | Like `maplist', but nconc's together the values returned by the function. |
| 60 | 60 | ||
| 61 | \(fn FUNCTION LIST...)" nil nil) | 61 | \(fn FUNCTION LIST...)" nil nil) |
| 62 | 62 | ||
| 63 | (autoload (quote some) "cl-extra" "\ | 63 | (autoload 'some "cl-extra" "\ |
| 64 | Return true if PREDICATE is true of any element of SEQ or SEQs. | 64 | Return true if PREDICATE is true of any element of SEQ or SEQs. |
| 65 | If so, return the true (non-nil) value returned by PREDICATE. | 65 | If so, return the true (non-nil) value returned by PREDICATE. |
| 66 | 66 | ||
| 67 | \(fn PREDICATE SEQ...)" nil nil) | 67 | \(fn PREDICATE SEQ...)" nil nil) |
| 68 | 68 | ||
| 69 | (autoload (quote every) "cl-extra" "\ | 69 | (autoload 'every "cl-extra" "\ |
| 70 | Return true if PREDICATE is true of every element of SEQ or SEQs. | 70 | Return true if PREDICATE is true of every element of SEQ or SEQs. |
| 71 | 71 | ||
| 72 | \(fn PREDICATE SEQ...)" nil nil) | 72 | \(fn PREDICATE SEQ...)" nil nil) |
| 73 | 73 | ||
| 74 | (autoload (quote notany) "cl-extra" "\ | 74 | (autoload 'notany "cl-extra" "\ |
| 75 | Return true if PREDICATE is false of every element of SEQ or SEQs. | 75 | Return true if PREDICATE is false of every element of SEQ or SEQs. |
| 76 | 76 | ||
| 77 | \(fn PREDICATE SEQ...)" nil nil) | 77 | \(fn PREDICATE SEQ...)" nil nil) |
| 78 | 78 | ||
| 79 | (autoload (quote notevery) "cl-extra" "\ | 79 | (autoload 'notevery "cl-extra" "\ |
| 80 | Return true if PREDICATE is false of some element of SEQ or SEQs. | 80 | Return true if PREDICATE is false of some element of SEQ or SEQs. |
| 81 | 81 | ||
| 82 | \(fn PREDICATE SEQ...)" nil nil) | 82 | \(fn PREDICATE SEQ...)" nil nil) |
| 83 | 83 | ||
| 84 | (defalias (quote cl-map-keymap) (quote map-keymap)) | 84 | (defalias 'cl-map-keymap 'map-keymap) |
| 85 | 85 | ||
| 86 | (autoload (quote cl-map-keymap-recursively) "cl-extra" "\ | 86 | (autoload 'cl-map-keymap-recursively "cl-extra" "\ |
| 87 | Not documented | 87 | Not documented |
| 88 | 88 | ||
| 89 | \(fn CL-FUNC-REC CL-MAP &optional CL-BASE)" nil nil) | 89 | \(fn CL-FUNC-REC CL-MAP &optional CL-BASE)" nil nil) |
| 90 | 90 | ||
| 91 | (autoload (quote cl-map-intervals) "cl-extra" "\ | 91 | (autoload 'cl-map-intervals "cl-extra" "\ |
| 92 | Not documented | 92 | Not documented |
| 93 | 93 | ||
| 94 | \(fn CL-FUNC &optional CL-WHAT CL-PROP CL-START CL-END)" nil nil) | 94 | \(fn CL-FUNC &optional CL-WHAT CL-PROP CL-START CL-END)" nil nil) |
| 95 | 95 | ||
| 96 | (autoload (quote cl-map-overlays) "cl-extra" "\ | 96 | (autoload 'cl-map-overlays "cl-extra" "\ |
| 97 | Not documented | 97 | Not documented |
| 98 | 98 | ||
| 99 | \(fn CL-FUNC &optional CL-BUFFER CL-START CL-END CL-ARG)" nil nil) | 99 | \(fn CL-FUNC &optional CL-BUFFER CL-START CL-END CL-ARG)" nil nil) |
| 100 | 100 | ||
| 101 | (autoload (quote cl-set-frame-visible-p) "cl-extra" "\ | 101 | (autoload 'cl-set-frame-visible-p "cl-extra" "\ |
| 102 | Not documented | 102 | Not documented |
| 103 | 103 | ||
| 104 | \(fn FRAME VAL)" nil nil) | 104 | \(fn FRAME VAL)" nil nil) |
| 105 | 105 | ||
| 106 | (autoload (quote cl-progv-before) "cl-extra" "\ | 106 | (autoload 'cl-progv-before "cl-extra" "\ |
| 107 | Not documented | 107 | Not documented |
| 108 | 108 | ||
| 109 | \(fn SYMS VALUES)" nil nil) | 109 | \(fn SYMS VALUES)" nil nil) |
| 110 | 110 | ||
| 111 | (autoload (quote gcd) "cl-extra" "\ | 111 | (autoload 'gcd "cl-extra" "\ |
| 112 | Return the greatest common divisor of the arguments. | 112 | Return the greatest common divisor of the arguments. |
| 113 | 113 | ||
| 114 | \(fn &rest ARGS)" nil nil) | 114 | \(fn &rest ARGS)" nil nil) |
| 115 | 115 | ||
| 116 | (autoload (quote lcm) "cl-extra" "\ | 116 | (autoload 'lcm "cl-extra" "\ |
| 117 | Return the least common multiple of the arguments. | 117 | Return the least common multiple of the arguments. |
| 118 | 118 | ||
| 119 | \(fn &rest ARGS)" nil nil) | 119 | \(fn &rest ARGS)" nil nil) |
| 120 | 120 | ||
| 121 | (autoload (quote isqrt) "cl-extra" "\ | 121 | (autoload 'isqrt "cl-extra" "\ |
| 122 | Return the integer square root of the argument. | 122 | Return the integer square root of the argument. |
| 123 | 123 | ||
| 124 | \(fn X)" nil nil) | 124 | \(fn X)" nil nil) |
| 125 | 125 | ||
| 126 | (autoload (quote floor*) "cl-extra" "\ | 126 | (autoload 'floor* "cl-extra" "\ |
| 127 | Return a list of the floor of X and the fractional part of X. | 127 | Return a list of the floor of X and the fractional part of X. |
| 128 | With two arguments, return floor and remainder of their quotient. | 128 | With two arguments, return floor and remainder of their quotient. |
| 129 | 129 | ||
| 130 | \(fn X &optional Y)" nil nil) | 130 | \(fn X &optional Y)" nil nil) |
| 131 | 131 | ||
| 132 | (autoload (quote ceiling*) "cl-extra" "\ | 132 | (autoload 'ceiling* "cl-extra" "\ |
| 133 | Return a list of the ceiling of X and the fractional part of X. | 133 | Return a list of the ceiling of X and the fractional part of X. |
| 134 | With two arguments, return ceiling and remainder of their quotient. | 134 | With two arguments, return ceiling and remainder of their quotient. |
| 135 | 135 | ||
| 136 | \(fn X &optional Y)" nil nil) | 136 | \(fn X &optional Y)" nil nil) |
| 137 | 137 | ||
| 138 | (autoload (quote truncate*) "cl-extra" "\ | 138 | (autoload 'truncate* "cl-extra" "\ |
| 139 | Return a list of the integer part of X and the fractional part of X. | 139 | Return a list of the integer part of X and the fractional part of X. |
| 140 | With two arguments, return truncation and remainder of their quotient. | 140 | With two arguments, return truncation and remainder of their quotient. |
| 141 | 141 | ||
| 142 | \(fn X &optional Y)" nil nil) | 142 | \(fn X &optional Y)" nil nil) |
| 143 | 143 | ||
| 144 | (autoload (quote round*) "cl-extra" "\ | 144 | (autoload 'round* "cl-extra" "\ |
| 145 | Return a list of X rounded to the nearest integer and the remainder. | 145 | Return a list of X rounded to the nearest integer and the remainder. |
| 146 | With two arguments, return rounding and remainder of their quotient. | 146 | With two arguments, return rounding and remainder of their quotient. |
| 147 | 147 | ||
| 148 | \(fn X &optional Y)" nil nil) | 148 | \(fn X &optional Y)" nil nil) |
| 149 | 149 | ||
| 150 | (autoload (quote mod*) "cl-extra" "\ | 150 | (autoload 'mod* "cl-extra" "\ |
| 151 | The remainder of X divided by Y, with the same sign as Y. | 151 | The remainder of X divided by Y, with the same sign as Y. |
| 152 | 152 | ||
| 153 | \(fn X Y)" nil nil) | 153 | \(fn X Y)" nil nil) |
| 154 | 154 | ||
| 155 | (autoload (quote rem*) "cl-extra" "\ | 155 | (autoload 'rem* "cl-extra" "\ |
| 156 | The remainder of X divided by Y, with the same sign as X. | 156 | The remainder of X divided by Y, with the same sign as X. |
| 157 | 157 | ||
| 158 | \(fn X Y)" nil nil) | 158 | \(fn X Y)" nil nil) |
| 159 | 159 | ||
| 160 | (autoload (quote signum) "cl-extra" "\ | 160 | (autoload 'signum "cl-extra" "\ |
| 161 | Return 1 if X is positive, -1 if negative, 0 if zero. | 161 | Return 1 if X is positive, -1 if negative, 0 if zero. |
| 162 | 162 | ||
| 163 | \(fn X)" nil nil) | 163 | \(fn X)" nil nil) |
| 164 | 164 | ||
| 165 | (autoload (quote random*) "cl-extra" "\ | 165 | (autoload 'random* "cl-extra" "\ |
| 166 | Return a random nonnegative number less than LIM, an integer or float. | 166 | Return a random nonnegative number less than LIM, an integer or float. |
| 167 | Optional second arg STATE is a random-state object. | 167 | Optional second arg STATE is a random-state object. |
| 168 | 168 | ||
| 169 | \(fn LIM &optional STATE)" nil nil) | 169 | \(fn LIM &optional STATE)" nil nil) |
| 170 | 170 | ||
| 171 | (autoload (quote make-random-state) "cl-extra" "\ | 171 | (autoload 'make-random-state "cl-extra" "\ |
| 172 | Return a copy of random-state STATE, or of `*random-state*' if omitted. | 172 | Return a copy of random-state STATE, or of `*random-state*' if omitted. |
| 173 | If STATE is t, return a new state object seeded from the time of day. | 173 | If STATE is t, return a new state object seeded from the time of day. |
| 174 | 174 | ||
| 175 | \(fn &optional STATE)" nil nil) | 175 | \(fn &optional STATE)" nil nil) |
| 176 | 176 | ||
| 177 | (autoload (quote random-state-p) "cl-extra" "\ | 177 | (autoload 'random-state-p "cl-extra" "\ |
| 178 | Return t if OBJECT is a random-state object. | 178 | Return t if OBJECT is a random-state object. |
| 179 | 179 | ||
| 180 | \(fn OBJECT)" nil nil) | 180 | \(fn OBJECT)" nil nil) |
| 181 | 181 | ||
| 182 | (autoload (quote cl-float-limits) "cl-extra" "\ | 182 | (autoload 'cl-float-limits "cl-extra" "\ |
| 183 | Not documented | 183 | Not documented |
| 184 | 184 | ||
| 185 | \(fn)" nil nil) | 185 | \(fn)" nil nil) |
| 186 | 186 | ||
| 187 | (autoload (quote subseq) "cl-extra" "\ | 187 | (autoload 'subseq "cl-extra" "\ |
| 188 | Return the subsequence of SEQ from START to END. | 188 | Return the subsequence of SEQ from START to END. |
| 189 | If END is omitted, it defaults to the length of the sequence. | 189 | If END is omitted, it defaults to the length of the sequence. |
| 190 | If START or END is negative, it counts from the end. | 190 | If START or END is negative, it counts from the end. |
| 191 | 191 | ||
| 192 | \(fn SEQ START &optional END)" nil nil) | 192 | \(fn SEQ START &optional END)" nil nil) |
| 193 | 193 | ||
| 194 | (autoload (quote concatenate) "cl-extra" "\ | 194 | (autoload 'concatenate "cl-extra" "\ |
| 195 | Concatenate, into a sequence of type TYPE, the argument SEQUENCEs. | 195 | Concatenate, into a sequence of type TYPE, the argument SEQUENCEs. |
| 196 | 196 | ||
| 197 | \(fn TYPE SEQUENCE...)" nil nil) | 197 | \(fn TYPE SEQUENCE...)" nil nil) |
| 198 | 198 | ||
| 199 | (autoload (quote revappend) "cl-extra" "\ | 199 | (autoload 'revappend "cl-extra" "\ |
| 200 | Equivalent to (append (reverse X) Y). | 200 | Equivalent to (append (reverse X) Y). |
| 201 | 201 | ||
| 202 | \(fn X Y)" nil nil) | 202 | \(fn X Y)" nil nil) |
| 203 | 203 | ||
| 204 | (autoload (quote nreconc) "cl-extra" "\ | 204 | (autoload 'nreconc "cl-extra" "\ |
| 205 | Equivalent to (nconc (nreverse X) Y). | 205 | Equivalent to (nconc (nreverse X) Y). |
| 206 | 206 | ||
| 207 | \(fn X Y)" nil nil) | 207 | \(fn X Y)" nil nil) |
| 208 | 208 | ||
| 209 | (autoload (quote list-length) "cl-extra" "\ | 209 | (autoload 'list-length "cl-extra" "\ |
| 210 | Return the length of list X. Return nil if list is circular. | 210 | Return the length of list X. Return nil if list is circular. |
| 211 | 211 | ||
| 212 | \(fn X)" nil nil) | 212 | \(fn X)" nil nil) |
| 213 | 213 | ||
| 214 | (autoload (quote tailp) "cl-extra" "\ | 214 | (autoload 'tailp "cl-extra" "\ |
| 215 | Return true if SUBLIST is a tail of LIST. | 215 | Return true if SUBLIST is a tail of LIST. |
| 216 | 216 | ||
| 217 | \(fn SUBLIST LIST)" nil nil) | 217 | \(fn SUBLIST LIST)" nil nil) |
| 218 | 218 | ||
| 219 | (autoload (quote get*) "cl-extra" "\ | 219 | (autoload 'get* "cl-extra" "\ |
| 220 | Return the value of SYMBOL's PROPNAME property, or DEFAULT if none. | 220 | Return the value of SYMBOL's PROPNAME property, or DEFAULT if none. |
| 221 | 221 | ||
| 222 | \(fn SYMBOL PROPNAME &optional DEFAULT)" nil nil) | 222 | \(fn SYMBOL PROPNAME &optional DEFAULT)" nil nil) |
| 223 | 223 | ||
| 224 | (autoload (quote getf) "cl-extra" "\ | 224 | (autoload 'getf "cl-extra" "\ |
| 225 | Search PROPLIST for property PROPNAME; return its value or DEFAULT. | 225 | Search PROPLIST for property PROPNAME; return its value or DEFAULT. |
| 226 | PROPLIST is a list of the sort returned by `symbol-plist'. | 226 | PROPLIST is a list of the sort returned by `symbol-plist'. |
| 227 | 227 | ||
| 228 | \(fn PROPLIST PROPNAME &optional DEFAULT)" nil nil) | 228 | \(fn PROPLIST PROPNAME &optional DEFAULT)" nil nil) |
| 229 | 229 | ||
| 230 | (autoload (quote cl-set-getf) "cl-extra" "\ | 230 | (autoload 'cl-set-getf "cl-extra" "\ |
| 231 | Not documented | 231 | Not documented |
| 232 | 232 | ||
| 233 | \(fn PLIST TAG VAL)" nil nil) | 233 | \(fn PLIST TAG VAL)" nil nil) |
| 234 | 234 | ||
| 235 | (autoload (quote cl-do-remf) "cl-extra" "\ | 235 | (autoload 'cl-do-remf "cl-extra" "\ |
| 236 | Not documented | 236 | Not documented |
| 237 | 237 | ||
| 238 | \(fn PLIST TAG)" nil nil) | 238 | \(fn PLIST TAG)" nil nil) |
| 239 | 239 | ||
| 240 | (autoload (quote cl-remprop) "cl-extra" "\ | 240 | (autoload 'cl-remprop "cl-extra" "\ |
| 241 | Remove from SYMBOL's plist the property PROPNAME and its value. | 241 | Remove from SYMBOL's plist the property PROPNAME and its value. |
| 242 | 242 | ||
| 243 | \(fn SYMBOL PROPNAME)" nil nil) | 243 | \(fn SYMBOL PROPNAME)" nil nil) |
| 244 | 244 | ||
| 245 | (defalias (quote remprop) (quote cl-remprop)) | 245 | (defalias 'remprop 'cl-remprop) |
| 246 | 246 | ||
| 247 | (defalias (quote cl-gethash) (quote gethash)) | 247 | (defalias 'cl-gethash 'gethash) |
| 248 | 248 | ||
| 249 | (defalias (quote cl-puthash) (quote puthash)) | 249 | (defalias 'cl-puthash 'puthash) |
| 250 | 250 | ||
| 251 | (defalias (quote cl-remhash) (quote remhash)) | 251 | (defalias 'cl-remhash 'remhash) |
| 252 | 252 | ||
| 253 | (defalias (quote cl-clrhash) (quote clrhash)) | 253 | (defalias 'cl-clrhash 'clrhash) |
| 254 | 254 | ||
| 255 | (defalias (quote cl-maphash) (quote maphash)) | 255 | (defalias 'cl-maphash 'maphash) |
| 256 | 256 | ||
| 257 | (defalias (quote cl-make-hash-table) (quote make-hash-table)) | 257 | (defalias 'cl-make-hash-table 'make-hash-table) |
| 258 | 258 | ||
| 259 | (defalias (quote cl-hash-table-p) (quote hash-table-p)) | 259 | (defalias 'cl-hash-table-p 'hash-table-p) |
| 260 | 260 | ||
| 261 | (defalias (quote cl-hash-table-count) (quote hash-table-count)) | 261 | (defalias 'cl-hash-table-count 'hash-table-count) |
| 262 | 262 | ||
| 263 | (autoload (quote cl-macroexpand-all) "cl-extra" "\ | 263 | (autoload 'cl-macroexpand-all "cl-extra" "\ |
| 264 | Expand all macro calls through a Lisp FORM. | 264 | Expand all macro calls through a Lisp FORM. |
| 265 | This also does some trivial optimizations to make the form prettier. | 265 | This also does some trivial optimizations to make the form prettier. |
| 266 | 266 | ||
| 267 | \(fn FORM &optional ENV)" nil nil) | 267 | \(fn FORM &optional ENV)" nil nil) |
| 268 | 268 | ||
| 269 | (autoload (quote cl-prettyexpand) "cl-extra" "\ | 269 | (autoload 'cl-prettyexpand "cl-extra" "\ |
| 270 | Not documented | 270 | Not documented |
| 271 | 271 | ||
| 272 | \(fn FORM &optional FULL)" nil nil) | 272 | \(fn FORM &optional FULL)" nil nil) |
| @@ -745,7 +745,7 @@ Not documented | |||
| 745 | ;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not | 745 | ;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not |
| 746 | ;;;;;; substitute-if substitute delete-duplicates remove-duplicates | 746 | ;;;;;; substitute-if substitute delete-duplicates remove-duplicates |
| 747 | ;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove* | 747 | ;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove* |
| 748 | ;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "77bee7df392948b6ab0699e391e8abc1") | 748 | ;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "e3c349e5231811c1c0482dd378dae56a") |
| 749 | ;;; Generated autoloads from cl-seq.el | 749 | ;;; Generated autoloads from cl-seq.el |
| 750 | 750 | ||
| 751 | (autoload 'reduce "cl-seq" "\ | 751 | (autoload 'reduce "cl-seq" "\ |
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 9a70c8bf778..9dc0bbc4abb 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el | |||
| @@ -2508,11 +2508,12 @@ They are not evaluated unless the assertion fails. If STRING is | |||
| 2508 | omitted, a default message listing FORM itself is used." | 2508 | omitted, a default message listing FORM itself is used." |
| 2509 | (and (or (not (cl-compiling-file)) | 2509 | (and (or (not (cl-compiling-file)) |
| 2510 | (< cl-optimize-speed 3) (= cl-optimize-safety 3)) | 2510 | (< cl-optimize-speed 3) (= cl-optimize-safety 3)) |
| 2511 | (let ((sargs (and show-args (delq nil (mapcar | 2511 | (let ((sargs (and show-args |
| 2512 | (function | 2512 | (delq nil (mapcar |
| 2513 | (lambda (x) | 2513 | (lambda (x) |
| 2514 | (and (not (cl-const-expr-p x)) | 2514 | (unless (cl-const-expr-p x) |
| 2515 | x))) (cdr form)))))) | 2515 | x)) |
| 2516 | (cdr form)))))) | ||
| 2516 | (list 'progn | 2517 | (list 'progn |
| 2517 | (list 'or form | 2518 | (list 'or form |
| 2518 | (if string | 2519 | (if string |
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index fa19ecd9c0f..ca5151fa984 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el | |||
| @@ -216,12 +216,18 @@ If NAME is provided, it is used for the keymap." | |||
| 216 | (setq menu (cdr (easy-menu-convert-item menu))))) | 216 | (setq menu (cdr (easy-menu-convert-item menu))))) |
| 217 | menu) | 217 | menu) |
| 218 | 218 | ||
| 219 | (defvar easy-menu-avoid-duplicate-keys t | ||
| 220 | "Dynamically scoped var to register already used keys in a menu. | ||
| 221 | If it holds a list, this is expected to be a list of keys already seen in the | ||
| 222 | menu we're processing. Else it means we're not processing a menu.") | ||
| 223 | |||
| 219 | ;;;###autoload | 224 | ;;;###autoload |
| 220 | (defun easy-menu-create-menu (menu-name menu-items) | 225 | (defun easy-menu-create-menu (menu-name menu-items) |
| 221 | "Create a menu called MENU-NAME with items described in MENU-ITEMS. | 226 | "Create a menu called MENU-NAME with items described in MENU-ITEMS. |
| 222 | MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items | 227 | MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items |
| 223 | possibly preceded by keyword pairs as described in `easy-menu-define'." | 228 | possibly preceded by keyword pairs as described in `easy-menu-define'." |
| 224 | (let ((menu (make-sparse-keymap menu-name)) | 229 | (let ((menu (make-sparse-keymap menu-name)) |
| 230 | (easy-menu-avoid-duplicate-keys nil) | ||
| 225 | prop keyword arg label enable filter visible help) | 231 | prop keyword arg label enable filter visible help) |
| 226 | ;; Look for keywords. | 232 | ;; Look for keywords. |
| 227 | (while (and menu-items | 233 | (while (and menu-items |
| @@ -341,22 +347,22 @@ ITEM defines an item as in `easy-menu-define'." | |||
| 341 | (setq prop (cons :button | 347 | (setq prop (cons :button |
| 342 | (cons (cons (cdr style) selected) prop))))) | 348 | (cons (cons (cdr style) selected) prop))))) |
| 343 | (when (stringp keys) | 349 | (when (stringp keys) |
| 344 | (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$" | 350 | (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$" |
| 345 | keys) | 351 | keys) |
| 346 | (let ((prefix | 352 | (let ((prefix |
| 347 | (if (< (match-beginning 0) (match-beginning 1)) | 353 | (if (< (match-beginning 0) (match-beginning 1)) |
| 348 | (substring keys 0 (match-beginning 1)))) | 354 | (substring keys 0 (match-beginning 1)))) |
| 349 | (postfix | 355 | (postfix |
| 350 | (if (< (match-end 1) (match-end 0)) | 356 | (if (< (match-end 1) (match-end 0)) |
| 351 | (substring keys (match-end 1)))) | 357 | (substring keys (match-end 1)))) |
| 352 | (cmd (intern (match-string 2 keys)))) | 358 | (cmd (intern (match-string 2 keys)))) |
| 353 | (setq keys (and (or prefix postfix) | 359 | (setq keys (and (or prefix postfix) |
| 354 | (cons prefix postfix))) | 360 | (cons prefix postfix))) |
| 355 | (setq keys | 361 | (setq keys |
| 356 | (and (or keys (not (eq command cmd))) | 362 | (and (or keys (not (eq command cmd))) |
| 357 | (cons cmd keys)))) | 363 | (cons cmd keys)))) |
| 358 | (setq cache-specified nil)) | 364 | (setq cache-specified nil)) |
| 359 | (if keys (setq prop (cons :keys (cons keys prop))))) | 365 | (if keys (setq prop (cons :keys (cons keys prop))))) |
| 360 | (if (and visible (not (easy-menu-always-true-p visible))) | 366 | (if (and visible (not (easy-menu-always-true-p visible))) |
| 361 | (if (equal visible ''nil) | 367 | (if (equal visible ''nil) |
| 362 | ;; Invisible menu item. Don't insert into keymap. | 368 | ;; Invisible menu item. Don't insert into keymap. |
| @@ -371,12 +377,27 @@ ITEM defines an item as in `easy-menu-define'." | |||
| 371 | ;; `intern' the name so as to merge multiple entries with the same name. | 377 | ;; `intern' the name so as to merge multiple entries with the same name. |
| 372 | ;; It also makes it easier/possible to lookup/change menu bindings | 378 | ;; It also makes it easier/possible to lookup/change menu bindings |
| 373 | ;; via keymap functions. | 379 | ;; via keymap functions. |
| 374 | (cons (easy-menu-intern name) | 380 | (let ((key (easy-menu-intern name))) |
| 375 | (and (not remove) | 381 | (when (listp easy-menu-avoid-duplicate-keys) |
| 376 | (cons 'menu-item | 382 | ;; Merging multiple entries with the same name is sometimes what we |
| 377 | (cons label | 383 | ;; want, but not when the entries are actually different (e.g. same |
| 378 | (and name | 384 | ;; name but different :suffix as seen in cal-menu.el) and appear in |
| 379 | (cons command prop)))))))) | 385 | ;; the same menu. So we try to detect and resolve conflicts. |
| 386 | (while (and (stringp name) | ||
| 387 | (memq key easy-menu-avoid-duplicate-keys)) | ||
| 388 | ;; We need to use some distinct object, ideally a symbol, ideally | ||
| 389 | ;; related to the `name'. Uninterned symbols do not work (they | ||
| 390 | ;; are apparently turned into strings and re-interned later on). | ||
| 391 | (setq key (intern (format "%s (%d)" (symbol-name key) | ||
| 392 | (length easy-menu-avoid-duplicate-keys))))) | ||
| 393 | (push key easy-menu-avoid-duplicate-keys)) | ||
| 394 | |||
| 395 | (cons key | ||
| 396 | (and (not remove) | ||
| 397 | (cons 'menu-item | ||
| 398 | (cons label | ||
| 399 | (and name | ||
| 400 | (cons command prop))))))))) | ||
| 380 | 401 | ||
| 381 | (defun easy-menu-define-key (menu key item &optional before) | 402 | (defun easy-menu-define-key (menu key item &optional before) |
| 382 | "Add binding in MENU for KEY => ITEM. Similar to `define-key-after'. | 403 | "Add binding in MENU for KEY => ITEM. Similar to `define-key-after'. |
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 7c4c01a6e32..85f3fe941b7 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el | |||
| @@ -200,11 +200,17 @@ TYPE should be nil to find a function, or `defvar' to find a variable." | |||
| 200 | (let* ((path (cons (or find-function-source-path load-path) | 200 | (let* ((path (cons (or find-function-source-path load-path) |
| 201 | (find-library-suffixes))) | 201 | (find-library-suffixes))) |
| 202 | (def (if (eq (function-called-at-point) 'require) | 202 | (def (if (eq (function-called-at-point) 'require) |
| 203 | (save-excursion | 203 | ;; `function-called-at-point' may return 'require |
| 204 | (backward-up-list) | 204 | ;; with `point' anywhere on this line. So wrap the |
| 205 | (forward-char) | 205 | ;; `save-excursion' below in a `condition-case' to |
| 206 | (backward-sexp -2) | 206 | ;; avoid reporting a scan-error here. |
| 207 | (thing-at-point 'symbol)) | 207 | (condition-case nil |
| 208 | (save-excursion | ||
| 209 | (backward-up-list) | ||
| 210 | (forward-char) | ||
| 211 | (forward-sexp 2) | ||
| 212 | (thing-at-point 'symbol)) | ||
| 213 | (error nil)) | ||
| 208 | (thing-at-point 'symbol)))) | 214 | (thing-at-point 'symbol)))) |
| 209 | (when def | 215 | (when def |
| 210 | (setq def (and (locate-file-completion def path 'test) def))) | 216 | (setq def (and (locate-file-completion def path 'test) def))) |
| @@ -233,8 +239,12 @@ The search is done in the source for library LIBRARY." | |||
| 233 | (setq symbol (get symbol 'definition-name))) | 239 | (setq symbol (get symbol 'definition-name))) |
| 234 | (if (string-match "\\`src/\\(.*\\.c\\)\\'" library) | 240 | (if (string-match "\\`src/\\(.*\\.c\\)\\'" library) |
| 235 | (find-function-C-source symbol (match-string 1 library) type) | 241 | (find-function-C-source symbol (match-string 1 library) type) |
| 236 | (if (string-match "\\.el\\(c\\)\\'" library) | 242 | (when (string-match "\\.el\\(c\\)\\'" library) |
| 237 | (setq library (substring library 0 (match-beginning 1)))) | 243 | (setq library (substring library 0 (match-beginning 1)))) |
| 244 | ;; Strip extension from .emacs.el to make sure symbol is searched in | ||
| 245 | ;; .emacs too. | ||
| 246 | (when (string-match "\\.emacs\\(.el\\)" library) | ||
| 247 | (setq library (substring library 0 (match-beginning 1)))) | ||
| 238 | (let* ((filename (find-library-name library)) | 248 | (let* ((filename (find-library-name library)) |
| 239 | (regexp-symbol (cdr (assq type find-function-regexp-alist)))) | 249 | (regexp-symbol (cdr (assq type find-function-regexp-alist)))) |
| 240 | (with-current-buffer (find-file-noselect filename) | 250 | (with-current-buffer (find-file-noselect filename) |
diff --git a/lisp/emulation/crisp.el b/lisp/emulation/crisp.el index b5fd7ee602c..7c254da869a 100644 --- a/lisp/emulation/crisp.el +++ b/lisp/emulation/crisp.el | |||
| @@ -148,7 +148,7 @@ does not load the scroll-all package." | |||
| 148 | 148 | ||
| 149 | (defun crisp-region-active () | 149 | (defun crisp-region-active () |
| 150 | "Compatibility function to test for an active region." | 150 | "Compatibility function to test for an active region." |
| 151 | (if (boundp 'zmacs-region-active-p) | 151 | (if (featurep 'xemacs) |
| 152 | zmacs-region-active-p | 152 | zmacs-region-active-p |
| 153 | mark-active)) | 153 | mark-active)) |
| 154 | 154 | ||
diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el index 686a79c9350..e9de0409aa4 100644 --- a/lisp/emulation/tpu-edt.el +++ b/lisp/emulation/tpu-edt.el | |||
| @@ -751,9 +751,7 @@ version of Emacs." | |||
| 751 | Sets the mark at POS and activates the region according to the | 751 | Sets the mark at POS and activates the region according to the |
| 752 | current version of Emacs." | 752 | current version of Emacs." |
| 753 | (set-mark pos) | 753 | (set-mark pos) |
| 754 | ;; We use a separate `if' for the fboundp so the byte-compiler notices it | 754 | (when (featurep 'xemacs) (when pos (zmacs-activate-region)))) |
| 755 | ;; and doesn't complain about the subsequent call. | ||
| 756 | (if (fboundp 'zmacs-activate-region) (if pos (zmacs-activate-region)))) | ||
| 757 | 755 | ||
| 758 | (defun tpu-string-prompt (prompt history-symbol) | 756 | (defun tpu-string-prompt (prompt history-symbol) |
| 759 | "Read a string with PROMPT." | 757 | "Read a string with PROMPT." |
| @@ -2439,7 +2437,7 @@ If FILE is nil, try to load a default file. The default file names are | |||
| 2439 | 2437 | ||
| 2440 | 2438 | ||
| 2441 | ;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins | 2439 | ;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins |
| 2442 | ;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "e0629234f1abe076917a303456b48329") | 2440 | ;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "c7ce8bad68736a5682eb3f5f5edc48db") |
| 2443 | ;;; Generated autoloads from tpu-extras.el | 2441 | ;;; Generated autoloads from tpu-extras.el |
| 2444 | 2442 | ||
| 2445 | (autoload 'tpu-cursor-free-mode "tpu-extras" "\ | 2443 | (autoload 'tpu-cursor-free-mode "tpu-extras" "\ |
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 3d74286589c..68116cde092 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el | |||
| @@ -47,6 +47,9 @@ | |||
| 47 | (defvar initial) | 47 | (defvar initial) |
| 48 | (defvar undo-beg-posn) | 48 | (defvar undo-beg-posn) |
| 49 | (defvar undo-end-posn) | 49 | (defvar undo-end-posn) |
| 50 | |||
| 51 | (eval-and-compile | ||
| 52 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 50 | ;; end pacifier | 53 | ;; end pacifier |
| 51 | 54 | ||
| 52 | 55 | ||
| @@ -2773,7 +2776,9 @@ On reaching beginning of line, stop and signal error." | |||
| 2773 | (defun viper-next-line-carefully (arg) | 2776 | (defun viper-next-line-carefully (arg) |
| 2774 | (condition-case nil | 2777 | (condition-case nil |
| 2775 | ;; do not use forward-line! need to keep column | 2778 | ;; do not use forward-line! need to keep column |
| 2776 | (with-no-warnings (next-line arg)) | 2779 | (if (featurep 'emacs) |
| 2780 | (with-no-warnings (next-line arg)) | ||
| 2781 | (next-line arg)) | ||
| 2777 | (error nil))) | 2782 | (error nil))) |
| 2778 | 2783 | ||
| 2779 | 2784 | ||
| @@ -3073,7 +3078,9 @@ On reaching beginning of line, stop and signal error." | |||
| 3073 | (com (viper-getCom arg))) | 3078 | (com (viper-getCom arg))) |
| 3074 | (if com (viper-move-marker-locally 'viper-com-point (point))) | 3079 | (if com (viper-move-marker-locally 'viper-com-point (point))) |
| 3075 | ;; do not use forward-line! need to keep column | 3080 | ;; do not use forward-line! need to keep column |
| 3076 | (with-no-warnings (next-line val)) | 3081 | (if (featurep 'emacs) |
| 3082 | (with-no-warnings (next-line val)) | ||
| 3083 | (next-line val)) | ||
| 3077 | (if viper-ex-style-motion | 3084 | (if viper-ex-style-motion |
| 3078 | (if (and (eolp) (not (bolp))) (backward-char 1))) | 3085 | (if (and (eolp) (not (bolp))) (backward-char 1))) |
| 3079 | (setq this-command 'next-line) | 3086 | (setq this-command 'next-line) |
| @@ -3120,7 +3127,9 @@ If point is on a widget or a button, simulate clicking on that widget/button." | |||
| 3120 | (com (viper-getCom arg))) | 3127 | (com (viper-getCom arg))) |
| 3121 | (if com (viper-move-marker-locally 'viper-com-point (point))) | 3128 | (if com (viper-move-marker-locally 'viper-com-point (point))) |
| 3122 | ;; do not use forward-line! need to keep column | 3129 | ;; do not use forward-line! need to keep column |
| 3123 | (with-no-warnings (previous-line val)) | 3130 | (if (featurep 'emacs) |
| 3131 | (with-no-warnings (previous-line val)) | ||
| 3132 | (previous-line val)) | ||
| 3124 | (if viper-ex-style-motion | 3133 | (if viper-ex-style-motion |
| 3125 | (if (and (eolp) (not (bolp))) (backward-char 1))) | 3134 | (if (and (eolp) (not (bolp))) (backward-char 1))) |
| 3126 | (setq this-command 'previous-line) | 3135 | (setq this-command 'previous-line) |
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el index 6ce34852235..8e19a0b50bd 100644 --- a/lisp/emulation/viper-ex.el +++ b/lisp/emulation/viper-ex.el | |||
| @@ -2216,9 +2216,11 @@ Type 'mak ' (including the space) to run make with no args." | |||
| 2216 | (pos2 (viper-line-pos 'end)) | 2216 | (pos2 (viper-line-pos 'end)) |
| 2217 | lines file info) | 2217 | lines file info) |
| 2218 | (setq lines (count-lines (point-min) (viper-line-pos 'end)) | 2218 | (setq lines (count-lines (point-min) (viper-line-pos 'end)) |
| 2219 | file (if (buffer-file-name) | 2219 | file (cond ((buffer-file-name) |
| 2220 | (concat (viper-abbreviate-file-name (buffer-file-name)) ":") | 2220 | (concat (viper-abbreviate-file-name (buffer-file-name)) ":")) |
| 2221 | (concat (buffer-name) " [Not visiting any file]:")) | 2221 | ((buffer-file-name (buffer-base-buffer)) |
| 2222 | (concat (viper-abbreviate-file-name (buffer-file-name (buffer-base-buffer))) " (indirect buffer):")) | ||
| 2223 | (t (concat (buffer-name) " [Not visiting any file]:"))) | ||
| 2222 | info (format "line=%d/%d pos=%d/%d col=%d %s" | 2224 | info (format "line=%d/%d pos=%d/%d col=%d %s" |
| 2223 | (if (= pos1 pos2) | 2225 | (if (= pos1 pos2) |
| 2224 | (1+ lines) | 2226 | (1+ lines) |
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index f76a9310518..05c90f995ab 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el | |||
| @@ -33,6 +33,9 @@ | |||
| 33 | (defvar viper-expert-level) | 33 | (defvar viper-expert-level) |
| 34 | (defvar viper-ex-style-editing) | 34 | (defvar viper-ex-style-editing) |
| 35 | (defvar viper-ex-style-motion) | 35 | (defvar viper-ex-style-motion) |
| 36 | |||
| 37 | (eval-and-compile | ||
| 38 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 36 | ;; end pacifier | 39 | ;; end pacifier |
| 37 | 40 | ||
| 38 | (require 'viper-util) | 41 | (require 'viper-util) |
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index 33061565196..b838d8ce80e 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el | |||
| @@ -44,6 +44,9 @@ | |||
| 44 | 44 | ||
| 45 | (require 'ring) | 45 | (require 'ring) |
| 46 | 46 | ||
| 47 | (eval-and-compile | ||
| 48 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 49 | |||
| 47 | ;; end pacifier | 50 | ;; end pacifier |
| 48 | 51 | ||
| 49 | (require 'viper-init) | 52 | (require 'viper-init) |
| @@ -713,7 +716,7 @@ | |||
| 713 | (not (memq (vc-state file) '(edited needs-merge))) | 716 | (not (memq (vc-state file) '(edited needs-merge))) |
| 714 | (not (stringp (vc-state file)))) | 717 | (not (stringp (vc-state file)))) |
| 715 | ;; XEmacs has no vc-state | 718 | ;; XEmacs has no vc-state |
| 716 | (if (featurep 'xemacs)(not (vc-locking-user file)))) | 719 | (if (featurep 'xemacs) (not (vc-locking-user file)))) |
| 717 | )) | 720 | )) |
| 718 | 721 | ||
| 719 | ;; checkout if visited file is checked in | 722 | ;; checkout if visited file is checked in |
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 19d3a7f018a..9d2acac4ce7 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el | |||
| @@ -9,7 +9,7 @@ | |||
| 9 | ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> | 9 | ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> |
| 10 | ;; Keywords: emulations | 10 | ;; Keywords: emulations |
| 11 | 11 | ||
| 12 | (defconst viper-version "3.14 of August 18, 2007" | 12 | (defconst viper-version "3.14 of January 09, 2008" |
| 13 | "The current version of Viper") | 13 | "The current version of Viper") |
| 14 | 14 | ||
| 15 | ;; This file is part of GNU Emacs. | 15 | ;; This file is part of GNU Emacs. |
| @@ -857,7 +857,9 @@ It also can't undo some Viper settings." | |||
| 857 | (modify-frame-parameters | 857 | (modify-frame-parameters |
| 858 | (selected-frame) | 858 | (selected-frame) |
| 859 | (list (cons 'viper-vi-state-cursor-color | 859 | (list (cons 'viper-vi-state-cursor-color |
| 860 | (viper-get-cursor-color)))))) | 860 | (viper-get-cursor-color)))) |
| 861 | (setq viper-vi-state-cursor-color (viper-get-cursor-color)) | ||
| 862 | )) | ||
| 861 | 863 | ||
| 862 | ;; Tell vc-diff to put *vc* in Vi mode | 864 | ;; Tell vc-diff to put *vc* in Vi mode |
| 863 | (if (featurep 'vc) | 865 | (if (featurep 'vc) |
| @@ -900,6 +902,7 @@ It also can't undo some Viper settings." | |||
| 900 | (modify-frame-parameters | 902 | (modify-frame-parameters |
| 901 | (selected-frame) | 903 | (selected-frame) |
| 902 | (list (cons 'viper-vi-state-cursor-color (ad-get-arg 0)))) | 904 | (list (cons 'viper-vi-state-cursor-color (ad-get-arg 0)))) |
| 905 | (setq viper-vi-state-cursor-color (ad-get-arg 0)) | ||
| 903 | ) | 906 | ) |
| 904 | 907 | ||
| 905 | (when (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) | 908 | (when (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) |
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index b7d1d1bfe30..23057faa0b6 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog | |||
| @@ -1,828 +1,288 @@ | |||
| 1 | 2008-01-04 Stefan Monnier <monnier@iro.umontreal.ca> | 1 | 2008-01-26 Michael Olson <mwolson@gnu.org> |
| 2 | |||
| 3 | * erc-ibuffer.el (erc-channel-modes): | ||
| 4 | Pass mode-name through format-mode-line | ||
| 5 | |||
| 6 | 2007-12-09 Michael Olson <mwolson@gnu.org> | ||
| 7 | |||
| 8 | * erc-services.el (erc-nickserv-alist): Fix regexps for GRnet. | ||
| 9 | |||
| 10 | 2007-12-09 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change) | ||
| 11 | |||
| 12 | * erc-backend.el, erc.el: | ||
| 13 | Parse 275 (secure connection) responses. | ||
| 14 | |||
| 15 | * erc-services.el: Add identification hooks for GRnet, the Greek | ||
| 16 | IRC network <http://www.irc.gr>. | ||
| 17 | |||
| 18 | 2007-12-08 David Kastrup <dak@gnu.org> | ||
| 19 | |||
| 20 | * erc-stamp.el (erc-echo-timestamp): | ||
| 21 | * erc-lang.el (language): | ||
| 22 | * erc-backend.el (erc-server-connect): Fix buggy call to `message'. | ||
| 23 | |||
| 24 | 2007-12-07 Edward O'Connor <ted@oconnor.cx> | ||
| 25 | |||
| 26 | * erc-services.el: Provide a hook that runs when nickserv confirms | ||
| 27 | that the user has successfully identified. | ||
| 28 | (services, erc-nickserv-identify-mode): Add and remove | ||
| 29 | erc-nickserv-identification-autodetect from | ||
| 30 | erc-server-NOTICE-functions. | ||
| 31 | (erc-nickserv-alist): Add SUCCESS-REGEXP to each entry. | ||
| 32 | (erc-nickserv-alist-identified-regexp) | ||
| 33 | (erc-nickserv-identification-autodetect): New functions. | ||
| 34 | (erc-nickserv-identified-hook): New hook. | ||
| 35 | |||
| 36 | 2007-12-06 D. Goel <deego3@gmail.com> | ||
| 37 | |||
| 38 | * erc-match.el (erc-add-entry-to-list): Fix buggy call to `error'. | ||
| 39 | |||
| 40 | 2007-12-01 Glenn Morris <rgm@gnu.org> | ||
| 41 | |||
| 42 | * erc-backend.el (erc-server-send-ping): Move after definition of | ||
| 43 | erc-server-send. | ||
| 44 | |||
| 45 | * erc.el (iswitchb-temp-buflist, iswitchb-read-buffer) | ||
| 46 | (erc-controls-strip): Declare for compiler. | ||
| 47 | (erc-iswitchb): Don't require iswitchb when compiling. Test | ||
| 48 | iswitchb-mode is bound. | ||
| 49 | |||
| 50 | 2007-11-30 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 51 | |||
| 52 | * erc.el (open-ssl-stream, open-tls-stream, erc-network-name): | ||
| 53 | Declare as functions. | ||
| 54 | |||
| 55 | 2007-11-29 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change) | ||
| 56 | |||
| 57 | * erc-backend.el, erc.el: | ||
| 58 | Parse 307 (nick has identified) responses. | ||
| 59 | |||
| 60 | 2007-11-15 Juanma Barranquero <lekktu@gmail.com> | ||
| 61 | |||
| 62 | * erc.el (erc-open): | ||
| 63 | * erc-backend.el (define-erc-response-handler): | ||
| 64 | * erc-log.el (log): | ||
| 65 | * erc-match.el (erc-log-matches): Fix typos in docstrings. | ||
| 66 | |||
| 67 | 2007-11-11 Michael Olson <mwolson@gnu.org> | ||
| 68 | |||
| 69 | * erc-autoaway.el (erc-autoaway-possibly-set-away): | ||
| 70 | * erc-netsplit.el (erc-netsplit-timer): | ||
| 71 | * erc-notify.el (erc-notify-timer): | ||
| 72 | * erc-track.el (erc-user-is-active): Only run if we have | ||
| 73 | successfully established a connection to the server and have | ||
| 74 | logged in. I suspect that sending messages too soon may make some | ||
| 75 | IRC servers not respond well, particularly when the network | ||
| 76 | connection is iffy or subject to traffic-shaping. | ||
| 77 | |||
| 78 | 2007-11-01 Michael Olson <mwolson@gnu.org> | ||
| 79 | |||
| 80 | * erc-compat.el (erc-set-write-file-functions): New compatibility | ||
| 81 | function to set the write hooks appropriately. | ||
| 82 | |||
| 83 | * erc-log.el (erc-log-setup-logging): Use | ||
| 84 | erc-set-write-file-functions. This fixes a byte-compiler warning. | ||
| 85 | |||
| 86 | * erc-stamp.el: Silence byte-compiler warning about | ||
| 87 | erc-fill-column. | ||
| 88 | |||
| 89 | * erc.el (erc-with-all-buffers-of-server): Bind the result of | ||
| 90 | mapcar to a variable in order to silence a byte-compiler warning. | ||
| 91 | |||
| 92 | 2007-10-29 Michael Olson <mwolson@gnu.org> | ||
| 93 | |||
| 94 | * erc-ibuffer.el (erc-modified-channels-alist): Use | ||
| 95 | eval-when-compile, and explain why we are doing this. | ||
| 96 | |||
| 97 | 2007-10-25 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 98 | |||
| 99 | * erc-ibuffer.el (erc-modified-channels-alist): Pacify | ||
| 100 | byte-compiler. | ||
| 101 | |||
| 102 | 2007-10-13 Glenn Morris <rgm@gnu.org> | ||
| 103 | |||
| 104 | * erc-track.el (erc-modified-channels-update): Use mapc rather | ||
| 105 | than mapcar. | ||
| 106 | |||
| 107 | 2007-10-12 Diane Murray <disumu@x3y2z1.net> | ||
| 108 | |||
| 109 | * erc.el (erc-join-channel): Prompt for channel key if C-u or | ||
| 110 | another prefix-arg was typed. | ||
| 111 | |||
| 112 | * NEWS: Noted this change. | ||
| 113 | |||
| 114 | 2007-10-07 Michael Olson <mwolson@gnu.org> | ||
| 115 | |||
| 116 | * erc.el (erc-cmd-ME'S): New command that handles the case where | ||
| 117 | someone types "/me's". It concatenates the text " 's" to the | ||
| 118 | beginning of the input and then sends the result like a normal | ||
| 119 | "/me" command. | ||
| 120 | (erc-command-regexp): Permit single-quote character. | ||
| 121 | |||
| 122 | 2007-09-30 Aidan Kehoe <kehoea@parhasard.net> (tiny change) | ||
| 123 | |||
| 124 | * erc-log.el (erc-save-buffer-in-logs): Prevent spurious warnings | ||
| 125 | when looking at a log file and concurrently saving to it. | ||
| 126 | |||
| 127 | 2007-09-18 Exal de Jesus Garcia Carrillo <exal@gnu.org> (tiny change) | ||
| 128 | |||
| 129 | * erc.texi (Special-Features): Fix small typo. | ||
| 130 | |||
| 131 | 2007-09-16 Michael Olson <mwolson@gnu.org> | ||
| 132 | |||
| 133 | * erc-track.el (erc-track-switch-direction): Mention | ||
| 134 | erc-track-faces-priority-list. Thanks to Leo for the suggestion. | ||
| 135 | |||
| 136 | 2007-09-11 Exal de Jesus Garcia Carrillo <exal@gnu.org> (tiny change) | ||
| 137 | |||
| 138 | * erc-sound.el: Fix typo in setting up instructions. | ||
| 139 | |||
| 140 | 2007-09-10 Michael Olson <mwolson@gnu.org> | ||
| 141 | |||
| 142 | * Makefile (elpa): Copy dir template rather than echoing a few | ||
| 143 | lines. The reason for this is that the ELPA package for ERC was | ||
| 144 | getting a corrupt dir entry. | ||
| 145 | |||
| 146 | * dir-template: Template for the ELPA dir file. | ||
| 147 | |||
| 148 | 2007-09-08 Michael Olson <mwolson@gnu.org> | ||
| 149 | |||
| 150 | * erc-log.el (erc-log-filter-function): New option that specifies | ||
| 151 | the function to call for filtering text before writing it to a log | ||
| 152 | file. Thanks to David O'Toole for the suggestion. | ||
| 153 | (erc-save-buffer-in-logs): Use erc-log-filter-function. Make sure | ||
| 154 | we carry along the value of coding-system-for-write, because this | ||
| 155 | could potentially be shadowed by the temporary buffer. | ||
| 156 | |||
| 157 | * erc.el (erc-version-string): Update to 5.3, development version. | ||
| 158 | |||
| 159 | 2007-09-07 Glenn Morris <rgm@gnu.org> | ||
| 160 | |||
| 161 | * erc.el (erc-toggle-debug-irc-protocol): Fix call to | ||
| 162 | erc-view-mode-enter. | ||
| 163 | |||
| 164 | 2007-08-08 Glenn Morris <rgm@gnu.org> | ||
| 165 | |||
| 166 | * erc-log.el, erc.el: Replace `iff' in doc-strings and comments. | ||
| 167 | |||
| 168 | 2007-09-03 Michael Olson <mwolson@gnu.org> | ||
| 169 | |||
| 170 | * erc.el (erc-default-port): Make this an integer value rather | ||
| 171 | than a string. Thanks to Luca Capello for the report. | ||
| 172 | |||
| 173 | 2007-08-27 Michael Olson <mwolson@gnu.org> | ||
| 174 | |||
| 175 | * erc.el (erc-cmd-GQUIT): If erc-kill-queries-on-quit is non-nil, | ||
| 176 | kill all query buffers after 4 seconds. | ||
| 177 | |||
| 178 | 2007-08-16 Michael Olson <mwolson@gnu.org> | ||
| 179 | |||
| 180 | * NEWS: Add ERC 5.3 changes section, and mention jbms' erc-track | ||
| 181 | compatibility note. | ||
| 182 | |||
| 183 | * erc-track.el (erc-track-list-changed-hook): Turn this into a | ||
| 184 | customizable option. | ||
| 185 | (erc-track-switch-direction): Add 'importance option. | ||
| 186 | (erc-modified-channels-display): If erc-track-switch-direction is | ||
| 187 | 'importance, call erc-track-sort-by-importance. | ||
| 188 | (erc-track-face-priority): New function that returns a number | ||
| 189 | indicating the position of a face in erc-track-faces-priority-list. | ||
| 190 | (erc-track-sort-by-importance): New function that sorts | ||
| 191 | erc-modified-channels-list according to erc-track-face-priority. | ||
| 192 | (erc-track-get-active-buffer): Make 'oldest a rough opposite of | ||
| 193 | 'importance. | ||
| 194 | |||
| 195 | 2007-08-14 Jeremy Maitin-Shepard <jbms@cmu.edu> | ||
| 196 | |||
| 197 | * erc-track.el (erc-track-remove-disconnected-buffers): New | ||
| 198 | variable which controls whether buffers associated with a server | ||
| 199 | that is disconnected should be removed from | ||
| 200 | `erc-modified-channels-alist'. Existing behavior is to | ||
| 201 | unconditionally remove such buffers, which is achieved by setting | ||
| 202 | `erc-track-removed-disconnected-buffers' to t. When set to t, | ||
| 203 | which is the new default value, such buffers remain in the list, | ||
| 204 | which I think is often the desired behavior, since the user may | ||
| 205 | likely wish to find out about activity that occurred in a channel | ||
| 206 | prior to it being disconnected. | ||
| 207 | (erc-track-list-changed-hook): New hook that is run whenever the | ||
| 208 | contents of `erc-modified-channels-alist' changes; it is useful | ||
| 209 | for users such as myself that don't use the default mode-line | ||
| 210 | notification but instead use a separate mechanism (which is tied | ||
| 211 | to my window manager) to provide notification of channel activity. | ||
| 212 | (erc-track-get-buffer-window): New function that acts as a wrapper | ||
| 213 | around `get-buffer-window' that handles the `selected-visible' | ||
| 214 | option of `erc-track-visibility'; previously, the value of | ||
| 215 | `erc-track-visibility' was passed directly to `get-buffer-window', | ||
| 216 | which does not support `selected-visible'; consequently, | ||
| 217 | `selected-visible' was not properly supported. | ||
| 218 | (erc-track-modified-channels): Fix a bug in the logic for removing | ||
| 219 | buffers from the list in certain cases. | ||
| 220 | (erc-track-position-in-mode-line): Add a supported value that | ||
| 221 | specifies that the tracking information should not be added to the | ||
| 222 | mode line at all. The value of nil is used to indicate that the | ||
| 223 | information should not be added at all to the mode line. | ||
| 224 | (erc-track-add-to-mode-line): Check for position eq to t, rather | ||
| 225 | than non-nil. | ||
| 226 | (erc-buffer-visible): Use erc-track-get-buffer-window. | ||
| 227 | (erc-modified-channels-update): Take | ||
| 228 | erc-track-remove-disconnected-buffers into account. | ||
| 229 | (erc-modified-channels-display): Run `erc-track-list-changed-hook'. | ||
| 230 | |||
| 231 | * erc.el (erc-reuse-frames): New option that determines whether | ||
| 232 | new frames are always created. Defaults to t. This only has an | ||
| 233 | effect when erc-join-buffer is set to 'frame. | ||
| 234 | (erc-setup-buffer): Use it. | ||
| 235 | |||
| 236 | 2007-08-14 Michael Olson <mwolson@gnu.org> | ||
| 237 | |||
| 238 | * erc-backend.el (erc-server-reconnect): If the server buffer has | ||
| 239 | been killed, use the current buffer instead. If the current | ||
| 240 | buffer is not an ERC buffer, give an error. This fixes a bug when | ||
| 241 | /reconnect is run from a channel buffer whose server buffer has | ||
| 242 | been deleted. Thanks to jbms for the report. | ||
| 243 | (erc-process-sentinel-1): Take server buffer as an argument, so | ||
| 244 | that we can make sure that it is current. | ||
| 245 | (erc-process-sentinel): Pass buffer to erc-process-sentinel-1. | ||
| 246 | (erc-process-sentinel-2): New function split from | ||
| 247 | erc-process-sentinel-1. If server buffer is deleted during a | ||
| 248 | reconnect attempt, stop trying to reconnect. Fix bug where | ||
| 249 | reconnect was not happening when erc-server-reconnect-attempts was | ||
| 250 | t. Call erc-server-reconnect-p only once each time. If we are | ||
| 251 | instructed to try connecting indefinitely, tell the user that they | ||
| 252 | can stop this by killing the server buffer. Call the process | ||
| 253 | sentinel by means of run-at-time, so that there is time to kill | ||
| 254 | the buffer if need be; this also removes the need for a while | ||
| 255 | loop. Refuse to reconnect again if erc-server-reconnect-timeout | ||
| 256 | is not an number. | ||
| 257 | |||
| 258 | * erc.el (erc-command-no-process-p): Fix bug: the return value of | ||
| 259 | erc-extract-command-from-line is a list rather than a single | ||
| 260 | symbol. Thanks to jbms for the report. | ||
| 261 | (erc-cmd-RECONNECT): Use simpler logic, and use buffer-live-p | ||
| 262 | rather than bufferp. | ||
| 263 | (erc-send-current-line, erc-display-command, erc-display-msg): | ||
| 264 | Handle case where erc-server-process is nil, so that /reconnect | ||
| 265 | works. | ||
| 266 | |||
| 267 | 2007-08-12 Michael Olson <mwolson@gnu.org> | ||
| 268 | |||
| 269 | * erc-identd.el (erc-identd-filter): Instead of sending an EOF | ||
| 270 | character, which now confuses freenode, stop the server process, | ||
| 271 | so that no new connections are accepted, and kill the current | ||
| 272 | client process. | ||
| 273 | |||
| 274 | 2007-07-30 Michael Olson <mwolson@gnu.org> | ||
| 275 | |||
| 276 | * erc-nicklist.el: Remove from the Emacs source tree. This file | ||
| 277 | is not release quality, and relies heavily on a module which | ||
| 278 | cannot be distributed with ERC due to licensing reasons. | ||
| 279 | |||
| 280 | 2007-07-29 Michael Olson <mwolson@gnu.org> | ||
| 281 | |||
| 282 | * erc-list.el: Relicense to GPLv3. Since the file was already | ||
| 283 | licensed under version 2 or later, it turns out that we do not | ||
| 284 | need the permission of all of the authors in order to proceed. | ||
| 285 | |||
| 286 | 2007-07-25 Glenn Morris <rgm@gnu.org> | ||
| 287 | |||
| 288 | * Relicense all FSF files to GPLv3 or later. | ||
| 289 | |||
| 290 | 2007-07-13 Michael Olson <mwolson@gnu.org> | ||
| 291 | |||
| 292 | * erc-goodies.el (erc-get-bg-color-face, erc-get-fg-color-face): | ||
| 293 | Use erc-error rather than message and beep. | ||
| 294 | |||
| 295 | * erc-sound.el: Indentation fix. | ||
| 296 | |||
| 297 | * erc.el (erc-command-no-process-p): New function that determines | ||
| 298 | if its argument is an ERC command that can be run when the server | ||
| 299 | process is not alive. | ||
| 300 | (erc-cmd-SET, erc-cmd-CLEAR, erc-cmd-COUNTRY, erc-cmd-HELP) | ||
| 301 | (erc-cmd-LASTLOG, erc-cmd-QUIT, erc-cmd-GQUIT) | ||
| 302 | (erc-cmd-RECONNECT, erc-cmd-SERVER): Denote that these commands | ||
| 303 | can be run even when the server process is not alive. | ||
| 304 | (erc-send-current-line): Call erc-command-no-process-p if the | ||
| 305 | server process is not alive, to determine if we have a command | ||
| 306 | that can be run anyway. Thanks to Tom Tromey for the bug report. | ||
| 307 | (erc-error): New function that either displays a message or throws | ||
| 308 | an error, depending on whether debug-on-error is non-nil. | ||
| 309 | (erc-cmd-SERVER, erc-send-current-line): Use it. | ||
| 310 | |||
| 311 | 2007-07-10 Michael Olson <mwolson@gnu.org> | ||
| 312 | |||
| 313 | * Relicense all FSF-assigned code to GPLv3. | ||
| 314 | |||
| 315 | 2007-06-25 Michael Olson <mwolson@gnu.org> | ||
| 316 | |||
| 317 | * erc.texi (Options): Fix typo. | ||
| 318 | (Getting Help and Reporting Bugs): Update webpage URL. Make Gmane | ||
| 319 | part more readable. | ||
| 320 | |||
| 321 | 2007-06-20 Michael Olson <mwolson@gnu.org> | ||
| 322 | |||
| 323 | * erc-stamp.el (erc-timestamp-format-left): New option that | ||
| 324 | specifies the left timestamp to use for | ||
| 325 | erc-insert-timestamp-left-and-right. | ||
| 326 | (erc-timestamp-format-right): New option that specifies the right | ||
| 327 | timestamp to use for erc-insert-timestamp-left-and-right. | ||
| 328 | (erc-insert-timestamp-function): Change default to | ||
| 329 | erc-insert-timestamp-left-and-right. | ||
| 330 | (erc-insert-away-timestamp-function): Ditto. | ||
| 331 | (erc-timestamp-last-inserted-left) | ||
| 332 | (erc-timestamp-last-inserted-right): New variables to keep track | ||
| 333 | of data for erc-insert-timestamp-left-and-right. | ||
| 334 | (erc-insert-timestamp-left-and-right): New function that places | ||
| 335 | timestamps on both the left and right sides of the screen, but | ||
| 336 | only if each timestamp has changed since it was last computed. | ||
| 337 | Thanks to offby1 for urging me to merge this. | ||
| 338 | |||
| 339 | * erc.el (erc-open-ssl-stream): Display informative error when | ||
| 340 | ssl.el not found. | ||
| 341 | (erc-tls): New function to connect using tls.el. | ||
| 342 | (erc-open-tls-stream): New function to initiate tls connection. | ||
| 343 | Display informative error when tls.el not found. | ||
| 344 | |||
| 345 | 2007-06-19 Michael Olson <mwolson@gnu.org> | ||
| 346 | 2 | ||
| 347 | * erc-log.el: Update header with accurate instructions. | 3 | * erc.el (erc-version-string): Release ERC 5.3. |
| 348 | 4 | ||
| 349 | 2007-06-17 Michael Olson <mwolson@gnu.org> | 5 | * Makefile (VERSION): Update. |
| 6 | (EXTRAS): Remove erc-list.el after all, because this is mainly for | ||
| 7 | users of the version that comes with Emacs, and they will have | ||
| 8 | erc-list.el by Emacs 23. | ||
| 9 | (MISC): Add ChangeLog.07. | ||
| 350 | 10 | ||
| 351 | * erc-pkg.el: Update description to match what is currently in ELPA. | 11 | * README.extras: Mention Emacs 23. |
| 352 | 12 | ||
| 353 | 2007-06-14 Juanma Barranquero <lekktu@gmail.com> | 13 | * erc.texi (Obtaining ERC): Update extras URLs for 5.3. |
| 14 | (Development): Write instructions for git, and remove those for | ||
| 15 | Arch. | ||
| 16 | (History): Mention the switch to git. | ||
| 354 | 17 | ||
| 355 | * erc-goodies.el (erc-scroll-to-bottom): Remove redundant check. | 18 | 2008-01-25 Michael Olson <mwolson@gnu.org> |
| 356 | 19 | ||
| 357 | 2007-06-13 Michael Olson <mwolson@gnu.org> | 20 | * NEWS: Update. |
| 358 | 21 | ||
| 359 | * erc-compat.el (erc-with-selected-window): New compatibility | 22 | * erc-goodies.el (keep-place): New module which keeps your place |
| 360 | macro that implements `with-selected-window'. | 23 | in unvisited ERC buffers when new messages arrive. This is mostly |
| 24 | taken from Johan Bockgård's init file. | ||
| 25 | (erc-noncommands-list): Move to correct place. | ||
| 26 | |||
| 27 | * erc-networks.el: Add a module definition. | ||
| 28 | |||
| 29 | * erc-services.el (erc-nickserv-identify-mode): Force-enable the | ||
| 30 | networks module, because we need it to set erc-network for us. | ||
| 31 | |||
| 32 | * erc-track.el (erc-track-faces-normal-list): Indicate in the | ||
| 33 | docstring that this variable can be set to nil. | ||
| 34 | |||
| 35 | * erc.el: On second thought, don't load erc-networks. Just enable | ||
| 36 | the networks module by default. | ||
| 37 | (erc-modules): Add option for keep-place and networks. Enable | ||
| 38 | networks by default. | ||
| 39 | (erc-version-string): Make release candidate 1 available. | ||
| 40 | |||
| 41 | 2008-01-24 Michael Olson <mwolson@gnu.org> | ||
| 42 | |||
| 43 | * erc.el: Load erc-networks.el so that functions get access to the | ||
| 44 | `erc-network-name' function. | ||
| 45 | |||
| 46 | * erc-track.el (erc-track-faces-normal-list): Add | ||
| 47 | erc-dangerous-host-face. | ||
| 48 | (erc-track-exclude-types): Add 333 and 353 to the default list of | ||
| 49 | things to ignore, and explain what they are in the docstring. | ||
| 50 | |||
| 51 | 2008-01-23 Michael Olson <mwolson@gnu.org> | ||
| 52 | |||
| 53 | * erc-track.el (erc-track-faces-priority-list): Move | ||
| 54 | erc-nick-default-face higher, so that it can be used for the | ||
| 55 | activity indication effect. Add erc-current-nick-face, | ||
| 56 | erc-pal-face, erc-dangerous-host-face, and erc-fool-face by | ||
| 57 | themselves. | ||
| 58 | (erc-track-faces-normal-list): New option that contains a list of | ||
| 59 | faces to consider "normal". | ||
| 60 | (erc-track-position-in-mode-line): Minor docfix. | ||
| 61 | (erc-track-find-face): Use erc-track-faces-normal-list to produce | ||
| 62 | a sort of blinking activity effect. | ||
| 63 | |||
| 64 | 2008-01-22 Michael Olson <mwolson@gnu.org> | ||
| 65 | |||
| 66 | * erc-button.el (erc-button-add-nickname-buttons): When in a | ||
| 67 | channel buffer, only look at nicks from the current channel. | ||
| 68 | Thanks to e1f for the report. | ||
| 69 | |||
| 70 | 2008-01-21 Michael Olson <mwolson@gnu.org> | ||
| 71 | |||
| 72 | * erc-compat.el (erc-const-expr-p, erc-list*, erc-assert): Remove, | ||
| 73 | since we can use the default `assert' function without it causing | ||
| 74 | us any problems, even in Emacs 21. Thanks to bojohan for the | ||
| 75 | suggestion. | ||
| 76 | |||
| 77 | * erc-goodies.el (move-to-prompt): Use the "XEmacs" method | ||
| 78 | instead, because the [remap ...] method interferes with | ||
| 79 | delete-selection-mode. | ||
| 80 | (erc-move-to-prompt): Rename from erc-move-to-prompt-xemacs. | ||
| 81 | Deactivate mark and call push-mark before moving point. Thanks to | ||
| 82 | bojohan for the suggestion. | ||
| 83 | (erc-move-to-prompt-setup): Rename from | ||
| 84 | erc-move-to-prompt-init-xemacs. | ||
| 85 | |||
| 86 | * erc-track.el (erc-track-faces-priority-list): Replace erc-button | ||
| 87 | with '(erc-button erc-default-face) so that we only care about | ||
| 88 | buttons that are part of normal text. Adjust customization type | ||
| 89 | to handle this case. Make erc-nick-default-face a list. Handle | ||
| 90 | pals, fools, current nick, and dangerous hosts. | ||
| 91 | (erc-track-find-face): Simplify. Adapt for list of faces case. | ||
| 92 | (erc-faces-in): Don't deflate lists of faces. Add them as-is. | ||
| 93 | (erc-track-face-priority): Use equal instead of eq. | ||
| 94 | |||
| 95 | 2008-01-20 Michael Olson <mwolson@gnu.org> | ||
| 96 | |||
| 97 | * erc-goodies.el (erc-move-to-prompt, erc-move-to-prompt-xemacs): | ||
| 98 | Fix off-by-one error that caused the point to move when placed at | ||
| 99 | the beginning of some already-typed text. Thanks to e1f for the | ||
| 100 | report. | ||
| 101 | |||
| 102 | * erc-dcc.el, erc-xdcc.el: Add simple module definitions. | ||
| 103 | |||
| 104 | * erc.el (erc-modules): Add dcc and xdcc. | ||
| 105 | |||
| 106 | 2008-01-19 Michael Olson <mwolson@gnu.org> | ||
| 107 | |||
| 108 | * erc-bbdb.el (erc-bbdb-insinuate-and-show-entry): Work around bug | ||
| 109 | in XEmacs 21.4 that throws an error when the first argument to | ||
| 110 | run-at-time is nil. | ||
| 111 | |||
| 112 | * erc-button.el (button): Undo XEmacs-specific change to all ERC | ||
| 113 | buffers when module is removed. | ||
| 114 | (erc-button-setup): Rename from erc-button-add-keys, and move | ||
| 115 | XEmacs-specific stuff here. | ||
| 116 | |||
| 117 | * erc-goodies.el (erc-unmorse): Improve regexp for detecting | ||
| 118 | morse. Deal with the morse style that has "/ " at the end of | ||
| 119 | every letter. | ||
| 120 | (erc-imenu-setup): New function that sets up Imenu support. Add | ||
| 121 | it instead of a lambda form to erc-mode-hook. | ||
| 122 | (scrolltobottom): Remove erc-scroll-to-bottom from all ERC buffers | ||
| 123 | when module is removed. Activate the functionality in all ERC | ||
| 124 | buffers when the module is activated, rather than leaving it up to | ||
| 125 | the user. | ||
| 126 | (move-to-prompt): New module that moves to the ERC prompt if a | ||
| 127 | user tries to type elsewhere in the buffer, and then inserts their | ||
| 128 | keystrokes there. This is mostly taken from Johan Bockgård's init | ||
| 129 | file. | ||
| 130 | (erc-move-to-prompt): New function that implements this. | ||
| 131 | (erc-move-to-prompt-xemacs): New function that implements this for | ||
| 132 | XEmacs. | ||
| 133 | (erc-move-to-prompt-init-xemacs): New function to perform the | ||
| 134 | extra initialization step needed for XEmacs. | ||
| 135 | |||
| 136 | * erc-page.el, erc-replace.el: Fix header and footer. | ||
| 137 | |||
| 138 | * erc-track.el (erc-track-minor-mode-maybe): Take an optional | ||
| 139 | buffer arg so that we can put this in erc-connect-pre-hook. If | ||
| 140 | given this argument, include it in the check to determine whether | ||
| 141 | to activate erc-track-minor-mode. | ||
| 142 | (track): Add erc-track-minor-mode-maybe to erc-connect-pre-hook, | ||
| 143 | so that we can use it as soon as a connection is attempted. | ||
| 144 | |||
| 145 | * erc.el (erc-format-network, erc-format-target-and/or-network): | ||
| 146 | Use erc-network-name function instead, and check to see whether | ||
| 147 | that function is bound. This fixes an error in process filter for | ||
| 148 | people who did not have erc-services or erc-networks loaded. | ||
| 149 | (erc-modules): Add move-to-prompt module and enable it by | ||
| 150 | default. Thanks to e1f for the suggestion. | ||
| 151 | |||
| 152 | 2008-01-18 Michael Olson <mwolson@gnu.org> | ||
| 153 | |||
| 154 | * Makefile (EXTRAS): Include erc-list-old.el. | ||
| 155 | |||
| 156 | * erc-dcc.el (erc-dcc-verbose): Rename from erc-verbose-dcc. | ||
| 157 | (erc-pack-int): Rewrite to not depend on a count argument. | ||
| 158 | (erc-unpack-int): Rewrite to remove 4-character limitation. | ||
| 159 | (erc-dcc-server): Call set-process-coding-system and | ||
| 160 | set-process-filter-multibyte so that the contents get sent out | ||
| 161 | without modification. | ||
| 162 | (erc-dcc-send-filter): Don't take a substring -- just pass the | ||
| 163 | whole string to erc-unpack-int. | ||
| 164 | (erc-dcc-receive-cache): New option that indicates the number of | ||
| 165 | bytes to let the receive buffer grow before flushing it. | ||
| 166 | (erc-dcc-file-name): New buffer-local variable to keep track of | ||
| 167 | the filename of the currently-received file. | ||
| 168 | (erc-dcc-get-file): Disable undo for a speed increase. Set | ||
| 169 | erc-dcc-file-name. Truncate the file before writing to it. | ||
| 170 | (erc-dcc-append-contents): New function to append the contents of | ||
| 171 | a buffer to a file and then erase the contents of the buffer. | ||
| 172 | (erc-dcc-get-filter): Flush buffer contents after exceeding | ||
| 173 | erc-dcc-receive-cache. This allows large files to be downloaded | ||
| 174 | without storing the whole thing in memory. | ||
| 175 | (erc-dcc-get-sentinel): Flush any remaining contents before | ||
| 176 | closing. No need to save buffer. | ||
| 177 | (erc-dcc-listen-host): New option that determines which IP address | ||
| 178 | to listen on. | ||
| 179 | (erc-dcc-public-host): New option that determines which IP address | ||
| 180 | to advertise when sending a file. This is useful for people who | ||
| 181 | are on a local subnet. Together, these two options replace | ||
| 182 | erc-dcc-host. | ||
| 183 | |||
| 184 | * erc.el (erc-mode-line-format): Add %N and %S. %N is the name of | ||
| 185 | the network, and %S is much like %s but with the network name | ||
| 186 | trumping the server name. Default to "%S %a". Thanks to e1f for | ||
| 187 | the suggestion. | ||
| 188 | (erc-format-network): New function that formats the network name. | ||
| 189 | (erc-format-target-and/or-network): New function that formats both | ||
| 190 | the network name and target, falling back on the server name if | ||
| 191 | the network name is not available. | ||
| 192 | (erc-update-mode-line-buffer): Add the new format spec items. | ||
| 193 | |||
| 194 | 2008-01-17 Michael Olson <mwolson@gnu.org> | ||
| 195 | |||
| 196 | * erc.el (erc-join-buffer): Improve documentation. | ||
| 197 | (erc-query-display): New option indicating how to display a query | ||
| 198 | buffer that is made by using the /QUERY command. The default is | ||
| 199 | to display the query in a new window. | ||
| 200 | (erc-cmd-QUERY): Use it. Improve docstring. | ||
| 201 | (erc-auto-query): Default this to 'window-noselect instead, | ||
| 202 | because I've already seen bug reports about new users thinking | ||
| 203 | that ERC didn't display their test messages. Improve | ||
| 204 | customization type. | ||
| 205 | (erc-notice-face): Make this work with XEmacs. | ||
| 206 | (erc-join-buffer): Mention 'buffer in docstring. Improve | ||
| 207 | customization type. | ||
| 208 | |||
| 209 | * erc-dcc.el (erc-dcc-send-sentinel): Better handle case where elt | ||
| 210 | is nil, in order to avoid an error. Thanks to Brent Goodrick for | ||
| 211 | the initial patch. | ||
| 212 | (erc-dcc-display-send): New function split from erc-dcc-send-hook. | ||
| 213 | (erc-dcc-send-connect-hook): Use it -- we don't like lambda forms | ||
| 214 | in hooks. | ||
| 215 | (erc-dcc-send-filter): Display byte count if the client confirmed | ||
| 216 | too much, and kill the buffer. Otherwise a DoS might be possible | ||
| 217 | by making Emacs run out of RAM. | ||
| 218 | |||
| 219 | * erc-backend.el (erc-server-connect): Detect early on whether the | ||
| 220 | connection attempt has failed in order to avoid confusing error | ||
| 221 | messages. | ||
| 222 | |||
| 223 | * erc-networks.el (erc-server-alist): Add Rizon network. | ||
| 224 | |||
| 225 | * erc-services.el (erc-nickserv-passwords): Add Rizon to options. | ||
| 226 | (erc-nickserv-alist): Add support for Rizon. | ||
| 227 | |||
| 228 | * erc-track.el (erc-track-find-face): Don't let buttons in notices | ||
| 229 | trump default text. Use catch/throw. Default to first element of | ||
| 230 | FACES is nothing is found. | ||
| 231 | |||
| 232 | * erc-xdcc.el: Add local variables for proper indentation setup. | ||
| 233 | |||
| 234 | 2008-01-15 Michael Olson <mwolson@gnu.org> | ||
| 235 | |||
| 236 | * erc-backend.el (erc-server-coding-system): Docfix. | ||
| 237 | (erc-coding-system-for-target): Pass the `target' argument along | ||
| 238 | as the first and only argument. It's not good to just depend on a | ||
| 239 | dynamic binding. | ||
| 240 | |||
| 241 | 2008-01-10 Michael Olson <mwolson@gnu.org> | ||
| 242 | |||
| 243 | * erc-backend.el (321, 322): Split message-displaying parts into | ||
| 244 | new functions, which are added to each response's respective | ||
| 245 | hook. This makes them easier to disable. | ||
| 246 | |||
| 247 | * erc-list.el: New file from Tom Tromey. Use erc-propertize | ||
| 248 | instead of propertize. Require 'erc. | ||
| 249 | (list): New module definition. Remove message-displaying | ||
| 250 | functions for 321 and 322 response handlers when enabling the | ||
| 251 | module, and restore them when disabling. As a sanity check, | ||
| 252 | remove the erc-list-handle-322 function when disabling the module. | ||
| 253 | (erc-list-handle-322): Handle the case where we run the LIST | ||
| 254 | command, but do not go through the normal steps. | ||
| 255 | (erc-cmd-LIST): Add docstring. Strip initial space from line if | ||
| 256 | it is non-nil. Use make-local-variable to silence compiler | ||
| 257 | warning. Capture current buffer and pass it to | ||
| 258 | erc-list-install-322-handler. | ||
| 259 | (erc-list-install-322-handler): Take server-buffer argument, so | ||
| 260 | that we are certain of being in the right buffer. Use 4th | ||
| 261 | argument to add-hook, so that erc-server-322-functions is only | ||
| 262 | modified in one buffer. | ||
| 263 | |||
| 264 | * erc-list-old.el: Renamed from old erc-list.el. | ||
| 265 | |||
| 266 | * erc.el (erc-modules): Add list-old. | ||
| 267 | (erc-set-topic): Handle case where there are no newlines in the | ||
| 268 | existing topic, which happens when /LIST is run. | ||
| 269 | (erc-notice-face): If we have less than 88 colors, make this | ||
| 270 | blue. Otherwise the text will be pink in a tty, which looks | ||
| 271 | dreadful. Thanks to e1f for the report. | ||
| 272 | (erc-remove-parsed-property): New option that determines whether | ||
| 273 | to remove the erc-parsed property after displaying a message. | ||
| 274 | This should have the effect of making ERC take up less memory. | ||
| 275 | (erc-display-line-1): Use it. | ||
| 361 | 276 | ||
| 362 | * erc-goodies.el (erc-scroll-to-bottom): Use it. This fixes a bug | 277 | 2008-01-04 Stefan Monnier <monnier@iro.umontreal.ca> |
| 363 | with buffer ordering where ERC buffers would move to the top. | ||
| 364 | Thanks to Ivan Kanis for the patch. | ||
| 365 | |||
| 366 | 2007-06-10 Michael Olson <mwolson@gnu.org> | ||
| 367 | |||
| 368 | * erc-log.el (erc-logging-enabled): Fix a bug that occurred when | ||
| 369 | `erc-log-channels-directory' had the name of a function. | ||
| 370 | |||
| 371 | 2007-06-06 Juanma Barranquero <lekktu@gmail.com> | ||
| 372 | |||
| 373 | * erc.el (erc-show-channel-key-p, erc-startup-file-list): | ||
| 374 | Fix typo in docstring. | ||
| 375 | |||
| 376 | 2007-06-03 Michael Olson <mwolson@gnu.org> | ||
| 377 | |||
| 378 | * erc-compat.el (erc-view-mode-enter): Make this its own function, | ||
| 379 | in order to document what we do, and provide sane fallback | ||
| 380 | behavior. | ||
| 381 | |||
| 382 | * erc.el (erc-toggle-debug-irc-protocol): Don't pass any arguments | ||
| 383 | to erc-view-mode-enter, since we don't do anything special with | ||
| 384 | the exit function. This fixes a bug with Emacs 21 and Emacs 22. | ||
| 385 | Thanks to Leo for noticing. | ||
| 386 | |||
| 387 | 2007-05-30 Michael Olson <mwolson@gnu.org> | ||
| 388 | |||
| 389 | * erc-compat.el (erc-user-emacs-directory): New variable that | ||
| 390 | determines where to find user-specific Emacs settings. For Emacs, | ||
| 391 | this is usually ~/.emacs.d, and for XEmacs this is usually | ||
| 392 | ~/.xemacs. | ||
| 393 | |||
| 394 | * erc.el (erc-startup-file-list): Use erc-user-emacs-directory. | ||
| 395 | |||
| 396 | 2007-05-28 Michael Olson <mwolson@gnu.org> | ||
| 397 | |||
| 398 | * erc-button.el (erc-button-url-regexp): Recognize parentheses as | ||
| 399 | part of URLs. Thanks to Lawrence Mitchell for the fix. | ||
| 400 | |||
| 401 | 2007-05-26 Michael Olson <mwolson@gnu.org> | ||
| 402 | |||
| 403 | * erc.texi (Modules): Fix references to completion modules. | ||
| 404 | |||
| 405 | 2007-05-21 Michael Olson <mwolson@gnu.org> | ||
| 406 | |||
| 407 | * Makefile (SOURCE): Remove erc-pkg.el. | ||
| 408 | (debclean): New rule to clean old Debian packages of ERC. | ||
| 409 | (debprepare): Don't modify the released tarball, but copy it as | ||
| 410 | the .orig.tar.gz file. | ||
| 411 | (debrelease, debrevision): Remove. | ||
| 412 | (debinstall): New target that copies the generated Debian file to | ||
| 413 | a distro-specific location. | ||
| 414 | (deb): New rule that chains together the stages in building a | ||
| 415 | Debian package. | ||
| 416 | (EXTRAS): Add erc-nicklist.el, since it is not release-quality. | ||
| 417 | (extras): Copy images directory. | ||
| 418 | |||
| 419 | * erc-nicklist.el (erc-nicklist-icons-directory): Use | ||
| 420 | locate-library to find the "images" directory. This should be | ||
| 421 | more failsafe. Thanks to Tom Tromey for the idea. | ||
| 422 | |||
| 423 | 2007-05-19 Michael Olson <mwolson@gnu.org> | ||
| 424 | |||
| 425 | * Makefile (ELPA): New variable that contains the location of my | ||
| 426 | local ELPA repository. | ||
| 427 | (elpa): New rule that makes an ELPA package for ERC. | ||
| 428 | |||
| 429 | 2007-04-19 Michael Olson <mwolson@gnu.org> | ||
| 430 | |||
| 431 | * erc.el (erc-parse-prefix): New function that retrieves the | ||
| 432 | PREFIX server parameter from the current server and returns an | ||
| 433 | alist of prefix type to prefix character. | ||
| 434 | (erc-channel-receive-names): Use `erc-parse-prefix' to determine | ||
| 435 | whether the first character of a nick is a prefix character or | ||
| 436 | not. This should fix a bug reported by bromine about needing to | ||
| 437 | type "%" first to complete nicks of people who are "hops" on | ||
| 438 | Slashnet. This should also support for very exotic IRC server | ||
| 439 | setups, if any exist. | ||
| 440 | (erc-update-current-channel-member): Indentation. | ||
| 441 | |||
| 442 | 2007-04-15 Michael Olson <mwolson@gnu.org> | ||
| 443 | |||
| 444 | * erc-log.el (erc-generate-log-file-name-function): Docfix. | ||
| 445 | Mention how to deal with the case for putting log files in | ||
| 446 | different directories. Change a customization type from `symbol' | ||
| 447 | to `function'. | ||
| 448 | (erc-log-channels-directory): Allow this to contain a function | ||
| 449 | name, which is called with the same args as in | ||
| 450 | `erc-generate-log-file-name-function'. Thanks to andrewy for the | ||
| 451 | report and use case. | ||
| 452 | (erc-current-logfile): Detect if `erc-log-channels-directory' is a | ||
| 453 | function and call it with arguments if so. | ||
| 454 | |||
| 455 | 2007-04-12 Michael Olson <mwolson@gnu.org> | ||
| 456 | |||
| 457 | * erc-backend.el (define-erc-response-handler): Mention that hook | ||
| 458 | processing stops when the function returns non-nil. This should | ||
| 459 | help avoid a nasty "gotcha" when making custom functions. Thanks | ||
| 460 | to John Sullivan for the report. | ||
| 461 | |||
| 462 | 2007-04-08 Diane Murray <disumu@x3y2z1.net> | ||
| 463 | |||
| 464 | * erc-nicklist.el (erc-nicklist-voiced-position): Fixed | ||
| 465 | customization mismatch. | ||
| 466 | |||
| 467 | 2007-04-01 Michael Olson <mwolson@gnu.org> | ||
| 468 | |||
| 469 | * erc.el (erc-version-string): Release ERC 5.2. | ||
| 470 | |||
| 471 | * erc-auto.in, erc-chess.el, erc-list.el, erc-speak.el: | ||
| 472 | * erc-viper.el: Update copyright notices. | ||
| 473 | |||
| 474 | * erc.texi: Make Emacs Lisp source code in this document | ||
| 475 | essentially public domain. Update version to 5.2. | ||
| 476 | (Obtaining ERC): Mention extras tarball. | ||
| 477 | (Releases): Mention local GNU mirror. | ||
| 478 | (Sample Configuration): Remove notice. | ||
| 479 | |||
| 480 | * FOR-RELEASE (5.3): Add item for erc-nicklist. | ||
| 481 | Mark NEWS as done. Mark extras tarball as done. | ||
| 482 | |||
| 483 | * Makefile (VERSION): Increment to 5.2. | ||
| 484 | (TESTING): Remove. | ||
| 485 | (EXTRAS): New variable containing the contents of our "Emacs 22 | ||
| 486 | extras" tarball. | ||
| 487 | (SOURCE): Remove $(TESTING). | ||
| 488 | (MISC): Add COPYING and ChangeLog.06. Fix ChangeLog.NNNN -> | ||
| 489 | ChangeLog.NN. | ||
| 490 | (release): Use $(SNAPDIR) instead of erc-$(VERSION). | ||
| 491 | (extras): New rule which implements the building of the extras | ||
| 492 | tarball. | ||
| 493 | (upload-extras): New rule to upload the extras tarball. It's | ||
| 494 | yucky to replicate upload, but oh well. | ||
| 495 | (DISTRIBUTOR): New variable used to differentiate between building | ||
| 496 | packages for Ubuntu and Debian. | ||
| 497 | (debrelease, debrevision): Use it. | ||
| 498 | (debbuild): Run linda in addition to lintian. | ||
| 499 | |||
| 500 | * NEWS: Mention extras tarball. Note which files have been | ||
| 501 | renamed. Note that erc-list is enabled by default, except in | ||
| 502 | Emacs 22. | ||
| 503 | |||
| 504 | * README.extras: New file which serves as a README for the extras | ||
| 505 | tarball. | ||
| 506 | |||
| 507 | 2007-03-31 Michael Olson <mwolson@gnu.org> | ||
| 508 | |||
| 509 | * NEWS: Update for the 5.2 release. | ||
| 510 | |||
| 511 | * FOR-RELEASE: Finish up 5.2 manual item. Add documentation item | ||
| 512 | for 5.3. | ||
| 513 | |||
| 514 | * erc.texi (Sample Session): Flesh out. Mention #erc. | ||
| 515 | (Modules): Defer to 5.3 release. | ||
| 516 | (Advanced Usage): Move Sample Configuration chapter ahead of | ||
| 517 | unfinished chapters. | ||
| 518 | (Sample Configuration): Write. | ||
| 519 | (Options): Mention how to see available ERC options. Defer to 5.3 | ||
| 520 | release. | ||
| 521 | (Tips and Tricks): Remove, since it seems better to just include | ||
| 522 | tips and tricks in the sample configuration, commented out. | ||
| 523 | |||
| 524 | * erc-bbdb.el (erc-bbdb-search-name-and-create): Make prompt more | ||
| 525 | informative about how to skip merging. | ||
| 526 | (erc-bbdb-insinuate-and-show-entry-1): Move contents of | ||
| 527 | erc-bbdb-insinuate-and-show-entry here. | ||
| 528 | (erc-bbdb-insinuate-and-show-entry): Run | ||
| 529 | erc-bbdb-insinuate-and-show-entry-1 "outside" of the calling | ||
| 530 | function, so that we can avoid triggering a process-filter error | ||
| 531 | if the user hits C-g. | ||
| 532 | |||
| 533 | 2007-03-30 Michael Olson <mwolson@gnu.org> | ||
| 534 | |||
| 535 | * FOR-RELEASE: Solve C-c C-SPC keybinding dilemma. | ||
| 536 | |||
| 537 | * erc-autoaway.el (erc-autoaway-idle-method): Use `if' rather than | ||
| 538 | `cond' and `set' rather than `set-default'. | ||
| 539 | |||
| 540 | * erc-log.el: Avoid compiler warning by requiring erc-network | ||
| 541 | during compilation. | ||
| 542 | (erc-generate-log-file-name-function): Add tag to each option. | ||
| 543 | Add erc-generate-log-file-name-network. | ||
| 544 | (erc-generate-log-file-name-network): New function which generates | ||
| 545 | a log file name that uses network name rather than server name, | ||
| 546 | when possible. | ||
| 547 | |||
| 548 | * erc-track.el (track): Assimilate track-when-inactive module, | ||
| 549 | since there's no need to have two modules in one file -- an option | ||
| 550 | will do. Remove track-modified-channels alias. Call | ||
| 551 | erc-track-minor-mode-maybe, and tear down the minor mode when | ||
| 552 | disabling. | ||
| 553 | (erc-track-when-inactive): New option which determines whether to | ||
| 554 | track visible buffers when inactive. The default is not to do so. | ||
| 555 | (erc-track-visibility): Mention erc-track-when-inactive. | ||
| 556 | (erc-buffer-visible): Use erc-track-when-inactive. | ||
| 557 | (erc-track-enable-keybindings): New option which determines | ||
| 558 | whether to enable the global-level tracking keybindings. The | ||
| 559 | default is to do so, unless they would override another binding, | ||
| 560 | in which case we prompt the user about it. | ||
| 561 | (erc-track-minor-mode-map): Move global keybindings here. | ||
| 562 | (erc-track-minor-mode): New minor mode which only enables the | ||
| 563 | keybindings and does nothing else. | ||
| 564 | (erc-track-minor-mode-maybe): New function which starts | ||
| 565 | erc-track-minor-mode, but only if it hasn't already been started, | ||
| 566 | an ERC buffer exists, and the user OK's it, depending on the value | ||
| 567 | of `erc-track-enable-keybindings'. | ||
| 568 | (erc-track-switch-buffer): Display a message if someone calls this | ||
| 569 | without first enabling erc-track-mode. | ||
| 570 | |||
| 571 | 2007-03-17 Michael Olson <mwolson@gnu.org> | ||
| 572 | |||
| 573 | * erc.texi (Development): Mention ErcDevelopment page on | ||
| 574 | emacswiki. | ||
| 575 | (Getting Started): Mention ~/.emacs.d/.ercrc.el and the Customize | ||
| 576 | interface. | ||
| 577 | (Sample Session): New section that has a very rough draft for a | ||
| 578 | sample ERC session. | ||
| 579 | (Special Features): New section that explains some of the special | ||
| 580 | features of ERC. Taken from ErcFeatures on emacswiki, with | ||
| 581 | enhancements. | ||
| 582 | |||
| 583 | 2007-03-12 Diane Murray <disumu@x3y2z1.net> | ||
| 584 | |||
| 585 | * erc-autoaway.el (erc-autoaway-idle-method): When setting the new | ||
| 586 | value, disable and re-enable `erc-autoaway-mode' only if it was | ||
| 587 | already enabled. This fixes a bug where autoaway was enabled just | ||
| 588 | by loading the file. | ||
| 589 | |||
| 590 | 2007-03-10 Diane Murray <disumu@x3y2z1.net> | ||
| 591 | |||
| 592 | * erc-capab.el: Added more information to the Usage section. | ||
| 593 | (erc-capab-identify-prefix): Doc fix. | ||
| 594 | (erc-capab-identify-unidentified): New face. | ||
| 595 | (290): Removed. Definition moved to erc-backend.el. | ||
| 596 | (erc-capab-identify-send-messages): Renamed from | ||
| 597 | `erc-capab-send-identify-messages'. | ||
| 598 | (erc-capab-identify-setup): Use it. | ||
| 599 | (erc-capab-identify-get-unidentified-nickname): Renamed from | ||
| 600 | `erc-capab-get-unidentified-nickname'. | ||
| 601 | (erc-capab-identify-add-prefix): Use it. Use | ||
| 602 | `erc-capab-identify-unidentified' as the face. | ||
| 603 | |||
| 604 | * erc-backend.el (290): Moved here from erc-capab.el. | ||
| 605 | |||
| 606 | * erc.el (erc-select): Added an autoload cookie. | ||
| 607 | (erc-message-type-member, erc-restore-text-properties): Use | ||
| 608 | `erc-get-parsed-vector'. | ||
| 609 | (erc-auto-query): Set the default to 'bury since many new users | ||
| 610 | expect private messages from others to be in dedicated query | ||
| 611 | buffers, not the server buffer. | ||
| 612 | (erc-common-server-suffixes): Use "freenode" for freenode.net, not | ||
| 613 | "OPN". Added oftc.net. | ||
| 614 | |||
| 615 | * NEWS: Added note about erc-auto-query's new default setting. | ||
| 616 | |||
| 617 | 2007-03-03 Michael Olson <mwolson@gnu.org> | ||
| 618 | |||
| 619 | * erc.el (erc-open, erc): Docfixes. | ||
| 620 | |||
| 621 | 2007-03-02 Michael Olson <mwolson@gnu.org> | ||
| 622 | |||
| 623 | * FOR-RELEASE: Make section for 5.3 release and move erc-backend | ||
| 624 | cleanup there. Awaiting discussion before doing other things. | ||
| 625 | Add tasks for merging filename changes from the 5.2 release | ||
| 626 | branch, and for making a tarball of modules not in Emacs 22. Add | ||
| 627 | item to remind me to update NEWS. Mark backtab entry as done. | ||
| 628 | |||
| 629 | * erc-button.el (button): Add call to `erc-button-add-keys'. | ||
| 630 | (erc-button-keys-added): New variable tracking whether we've added | ||
| 631 | the keys yet. | ||
| 632 | (erc-button-add-keys): New function that adds the <backtab> key to | ||
| 633 | erc-mode-map. | ||
| 634 | |||
| 635 | * erc.texi: Change version to 5.2 (pre-release). | ||
| 636 | |||
| 637 | 2007-02-15 Michael Olson <mwolson@gnu.org> | ||
| 638 | |||
| 639 | * CREDITS: Update. | ||
| 640 | |||
| 641 | * erc-backend.el (erc-server-send-ping-interval): Change to use a | ||
| 642 | default of 30 seconds. Improve customize interface. | ||
| 643 | (erc-server-send-ping-timeout): New option that determines when to | ||
| 644 | consider a connection stalled and restart it. The default is | ||
| 645 | after 120 seconds. | ||
| 646 | (erc-server-send-ping): Use erc-server-send-ping-timeout instead | ||
| 647 | of erc-server-send-ping-interval. If | ||
| 648 | erc-server-send-ping-timeout is nil, do not ever kill and restart | ||
| 649 | a hung IRC process. | ||
| 650 | |||
| 651 | * erc.el (erc-modules): Include the name of the module in its | ||
| 652 | description. This should make it easier for people to find and | ||
| 653 | enable a particular module. | ||
| 654 | |||
| 655 | 2007-02-15 Vivek Dasmohapatra <vivek@etla.org> | ||
| 656 | |||
| 657 | * erc.el (erc-cmd-RECONNECT): Kill old process if it is still | ||
| 658 | alive. | ||
| 659 | (erc-message-english-PART): Properly escape "%" characters in | ||
| 660 | reason. | ||
| 661 | |||
| 662 | * erc-backend.el (erc-server-reconnecting): New variable that is | ||
| 663 | set when the user requests a reconnect, but the old process is | ||
| 664 | still alive. This forces the reconnect to work even though the | ||
| 665 | process is killed manually during reconnect. | ||
| 666 | (erc-server-connect): Initialize it. | ||
| 667 | (erc-server-reconnect-p): Use it. | ||
| 668 | (erc-process-sentinel-1): Set it to nil after the first reconnect | ||
| 669 | attempt. | ||
| 670 | |||
| 671 | 2007-02-07 Diane Murray <disumu@x3y2z1.net> | ||
| 672 | |||
| 673 | * erc-menu.el (erc-menu-definition): Fixed so that the separator | ||
| 674 | is between "Current channel" and "Pals, fools and other keywords", | ||
| 675 | not at the bottom of the "Current channel" submenu. | ||
| 676 | |||
| 677 | 2007-01-25 Diane Murray <disumu@x3y2z1.net> | ||
| 678 | |||
| 679 | * erc-networks.el (erc-server-alist): Removed SSL server for now | ||
| 680 | since `erc-server-select' doesn't know to use `erc-ssl'. | ||
| 681 | |||
| 682 | * erc-networks.el (erc-server-alist, erc-networks-alist): Added | ||
| 683 | definitions for oftc.net. | ||
| 684 | |||
| 685 | * erc-services.el (erc-nickserv-alist): Fixed OFTC message regexp. | ||
| 686 | |||
| 687 | 2007-01-22 Michael Olson <mwolson@gnu.org> | ||
| 688 | |||
| 689 | * erc-backend.el (erc-server-error-occurred): New variable that | ||
| 690 | indicates when an error has been signaled by the server. This | ||
| 691 | should fix an infinite reconnect bug when giving some servers a | ||
| 692 | bogus :full-name. Thanks to Angelina Carlton for the report. | ||
| 693 | (erc-server-connect): Initialize erc-server-error-occurred. | ||
| 694 | (erc-server-reconnect-p): Use it. | ||
| 695 | (ERROR): Set it. | ||
| 696 | |||
| 697 | * erc-services.el (erc-nickserv-alist): Alphabetize and add Ars | ||
| 698 | and QuakeNet. Standardize look of entries. Fix type mismatch | ||
| 699 | error in customize interface. | ||
| 700 | (erc-nickserv-passwords): Alphabetize and add missing entries from | ||
| 701 | erc-nickserv-alist. | ||
| 702 | |||
| 703 | 2007-01-21 Michael Olson <mwolson@gnu.org> | ||
| 704 | |||
| 705 | * erc.el (erc-header-line-format): Document how to disable the | ||
| 706 | header line, and add a customization type for it. Also, make the | ||
| 707 | changes take effect immediately. | ||
| 708 | |||
| 709 | 2007-01-19 Michael Olson <mwolson@gnu.org> | ||
| 710 | |||
| 711 | * erc.texi (Modules): Document new menu module. Thanks to Leo | ||
| 712 | for noticing. | ||
| 713 | |||
| 714 | 2007-01-16 Diane Murray <disumu@x3y2z1.net> | ||
| 715 | |||
| 716 | * erc-stamp.el (erc-insert-timestamp-left): Fixed so that the | ||
| 717 | whitespace string filler is hidden correctly when timestamps are | ||
| 718 | hidden. | ||
| 719 | (erc-toggle-timestamps): New function to use instead of | ||
| 720 | `erc-show-timestamps' and `erc-hide-timestamps'. | ||
| 721 | |||
| 722 | * erc.el (erc-restore-text-properties): Moved here from | ||
| 723 | erc-fill.el since it could be useful in general. | ||
| 724 | |||
| 725 | * erc-fill.el (erc-restore-text-properties): Removed. | ||
| 726 | |||
| 727 | 2007-01-13 Michael Olson <mwolson@gnu.org> | ||
| 728 | |||
| 729 | * erc.el (erc-command-regexp): New variable that is used to match | ||
| 730 | a command. | ||
| 731 | (erc-send-input): Use it. This fixes a bug where paths -- | ||
| 732 | "/usr/bin/foo", for example -- were being displayed as commands, | ||
| 733 | but still sent correctly. | ||
| 734 | (erc-extract-command-from-line): Use it. | ||
| 735 | |||
| 736 | * erc.texi (Modules): Document erc-capab-identify. | ||
| 737 | |||
| 738 | 2007-01-11 Diane Murray <disumu@x3y2z1.net> | ||
| 739 | |||
| 740 | * erc.el (erc-find-parsed-property): Moved here from erc-track.el | ||
| 741 | since it can be useful in general. | ||
| 742 | |||
| 743 | * erc-track.el (erc-find-parsed-property): Removed. | ||
| 744 | |||
| 745 | * erc-capab.el (erc-capab-find-parsed): Removed. | ||
| 746 | (erc-capab-identify-add-prefix): Use `erc-find-parsed-property'. | ||
| 747 | |||
| 748 | * erc.el (erc-open): Run `erc-before-connect' hook here. This | ||
| 749 | makes sure the hook always gets called before a connection is | ||
| 750 | made, as some functions, like `erc-handle-irc-url', use `erc-open' | ||
| 751 | instead of `erc'. | ||
| 752 | (erc): Removed `erc-before-connect' hook. | ||
| 753 | |||
| 754 | * erc-menu.el (erc-menu-definition): Put items specific to | ||
| 755 | channels in a "Current channel" submenu. | ||
| 756 | |||
| 757 | * erc-backend.el (321, 323): Display channel list in server buffer | ||
| 758 | when not using the channel list module. | ||
| 759 | |||
| 760 | * erc.el: Updated copyright years. | ||
| 761 | (erc-version-string): Set to 5.2 (devel). | ||
| 762 | (erc-format-lag-time): Fixed to work when `erc-server-lag' is nil. | ||
| 763 | (erc-update-mode-line-buffer): Set the header face. | ||
| 764 | |||
| 765 | 2007-01-11 Michael Olson <mwolson@gnu.org> | ||
| 766 | |||
| 767 | * erc-bbdb.el (erc-bbdb-popup-type): Fix customization type and | ||
| 768 | documentation. | ||
| 769 | |||
| 770 | * erc-services.el (erc-nickserv-identify-mode): Improve | ||
| 771 | documentation for nick-change option and move higher to fix | ||
| 772 | compiler warning. Avoid a recursive load error. | ||
| 773 | (erc-nickserv-alist): Add simple entry for BitlBee, to avoid | ||
| 774 | "NickServ is AWAY: User is offline" error. Oddly enough, bitlbee | ||
| 775 | was smart enough to recognize that as an authentication request | ||
| 776 | and log in regardless, which is why I didn't notice this earlier. | ||
| 777 | (erc-nickserv-alist-sender, erc-nickserv-alist-regexp) | ||
| 778 | (erc-nickserv-alist-nickserv, erc-nickserv-alist-ident-keyword) | ||
| 779 | (erc-nickserv-alist-use-nick-p) | ||
| 780 | (erc-nickserv-alist-ident-command): New accessors for | ||
| 781 | erc-nickserv-alist. Using nth is unwieldy. | ||
| 782 | (erc-nickserv-identify-autodetect) | ||
| 783 | (erc-nickserv-identify-on-connect) | ||
| 784 | (erc-nickserv-identify-on-nick-change, erc-nickserv-identify): Use | ||
| 785 | the new accessors. | ||
| 786 | |||
| 787 | 2007-01-11 Diane Murray <disumu@x3y2z1.net> | ||
| 788 | |||
| 789 | * NEWS: Added note for `erc-my-nick-face'. Fixed capab-identify | ||
| 790 | wording. | ||
| 791 | |||
| 792 | 2007-01-10 Diane Murray <disumu@x3y2z1.net> | ||
| 793 | |||
| 794 | * erc.el (erc-mode-line-format): Added %l to documentation. | ||
| 795 | (erc-header-line-format): Removed "[IRC]". Use the new %l | ||
| 796 | replacement character. Doc fix. | ||
| 797 | (erc-format-channel-modes): Removed lag code. Removed parentheses | ||
| 798 | from mode string. | ||
| 799 | (erc-format-lag-time): New function. | ||
| 800 | (erc-update-mode-line-buffer): Use it. | ||
| 801 | |||
| 802 | 2007-01-10 Michael Olson <mwolson@gnu.org> | ||
| 803 | |||
| 804 | * erc.el: Fix typo in url-irc-function instructions. | ||
| 805 | |||
| 806 | 2007-01-09 Michael Olson <mwolson@gnu.org> | ||
| 807 | |||
| 808 | * erc.el (erc-system-name): New option that determines the system | ||
| 809 | name to use when logging in. The default is to figure this out by | ||
| 810 | calling `system-name'. | ||
| 811 | (erc-login): Use it. | ||
| 812 | |||
| 813 | 2007-01-07 Michael Olson <mwolson@gnu.org> | ||
| 814 | |||
| 815 | * erc.el (erc-modules): Add the menu module. This should fix a | ||
| 816 | bug with incorrect ERC submenus being displayed. | ||
| 817 | 278 | ||
| 818 | * erc-menu.el: Turn this into a module. | 279 | * erc-ibuffer.el (erc-channel-modes): |
| 819 | (erc-menu-add, erc-menu-remove): New functions that add and remove | 280 | Pass mode-name through format-mode-line |
| 820 | the ERC menu. | ||
| 821 | 281 | ||
| 822 | 282 | ||
| 823 | See ChangeLog.06 for earlier changes. | 283 | See ChangeLog.07 for earlier changes. |
| 824 | 284 | ||
| 825 | Copyright (C) 2007, 2008 Free Software Foundation, Inc. | 285 | Copyright (C) 2008 Free Software Foundation, Inc. |
| 826 | 286 | ||
| 827 | This file is part of GNU Emacs. | 287 | This file is part of GNU Emacs. |
| 828 | 288 | ||
| @@ -846,4 +306,4 @@ See ChangeLog.06 for earlier changes. | |||
| 846 | ;; add-log-time-zone-rule: t | 306 | ;; add-log-time-zone-rule: t |
| 847 | ;; End: | 307 | ;; End: |
| 848 | 308 | ||
| 849 | ;; arch-tag: 3369b6e5-96b1-4b32-96cd-9a905c747496 | 309 | ;; arch-tag: 15787dfd-e091-4c8c-8b88-747b474e1ac7 |
diff --git a/lisp/erc/ChangeLog.07 b/lisp/erc/ChangeLog.07 new file mode 100644 index 00000000000..c317fe62177 --- /dev/null +++ b/lisp/erc/ChangeLog.07 | |||
| @@ -0,0 +1,839 @@ | |||
| 1 | 2007-12-16 Diane Murray <disumu@x3y2z1.net> | ||
| 2 | |||
| 3 | * erc-services.el (erc-nickserv-alist): Removed autodetect regexp, | ||
| 4 | added identified regexp for OFTC. | ||
| 5 | (erc-nickserv-identification-autodetect): Make sure success-regex | ||
| 6 | is non-nil. | ||
| 7 | (erc-nickserv-identify-autodetect): Make sure identify-regex is | ||
| 8 | non-nil. Doc fix. | ||
| 9 | |||
| 10 | 2007-12-13 Diane Murray <disumu@x3y2z1.net> | ||
| 11 | |||
| 12 | * erc-backend.el (PRIVMSG, QUIT, TOPIC, WALLOPS, 376, 004, 221) | ||
| 13 | (312, 315, 319, 330, 331, 333, 367, 368, 391, 405, 406, 412) | ||
| 14 | (421, 432, 433, 437, 442, 461, 474, 477, 482, 431): Doc fix. | ||
| 15 | |||
| 16 | 2007-12-09 Michael Olson <mwolson@gnu.org> | ||
| 17 | |||
| 18 | * erc-services.el (erc-nickserv-alist): Fix regexps for GRnet. | ||
| 19 | |||
| 20 | 2007-12-09 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change) | ||
| 21 | |||
| 22 | * erc-backend.el, erc.el: | ||
| 23 | Parse 275 (secure connection) responses. | ||
| 24 | |||
| 25 | * erc-services.el: Add identification hooks for GRnet, the Greek | ||
| 26 | IRC network <http://www.irc.gr>. | ||
| 27 | |||
| 28 | 2007-12-08 David Kastrup <dak@gnu.org> | ||
| 29 | |||
| 30 | * erc-stamp.el (erc-echo-timestamp): | ||
| 31 | * erc-lang.el (language): | ||
| 32 | * erc-backend.el (erc-server-connect): Fix buggy call to `message'. | ||
| 33 | |||
| 34 | 2007-12-07 Edward O'Connor <ted@oconnor.cx> | ||
| 35 | |||
| 36 | * erc-services.el: Provide a hook that runs when nickserv confirms | ||
| 37 | that the user has successfully identified. | ||
| 38 | (services, erc-nickserv-identify-mode): Add and remove | ||
| 39 | erc-nickserv-identification-autodetect from | ||
| 40 | erc-server-NOTICE-functions. | ||
| 41 | (erc-nickserv-alist): Add SUCCESS-REGEXP to each entry. | ||
| 42 | (erc-nickserv-alist-identified-regexp) | ||
| 43 | (erc-nickserv-identification-autodetect): New functions. | ||
| 44 | (erc-nickserv-identified-hook): New hook. | ||
| 45 | |||
| 46 | 2007-12-06 D. Goel <deego3@gmail.com> | ||
| 47 | |||
| 48 | * erc-match.el (erc-add-entry-to-list): Fix buggy call to `error'. | ||
| 49 | |||
| 50 | 2007-12-01 Glenn Morris <rgm@gnu.org> | ||
| 51 | |||
| 52 | * erc-backend.el (erc-server-send-ping): Move after definition of | ||
| 53 | erc-server-send. | ||
| 54 | |||
| 55 | 2007-11-29 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change) | ||
| 56 | |||
| 57 | * erc-backend.el, erc.el: | ||
| 58 | Parse 307 (nick has identified) responses. | ||
| 59 | |||
| 60 | 2007-11-15 Juanma Barranquero <lekktu@gmail.com> | ||
| 61 | |||
| 62 | * erc.el (erc-open): | ||
| 63 | * erc-backend.el (define-erc-response-handler): | ||
| 64 | * erc-log.el (log): | ||
| 65 | * erc-match.el (erc-log-matches): Fix typos in docstrings. | ||
| 66 | |||
| 67 | 2007-11-11 Michael Olson <mwolson@gnu.org> | ||
| 68 | |||
| 69 | * erc-autoaway.el (erc-autoaway-possibly-set-away): | ||
| 70 | * erc-netsplit.el (erc-netsplit-timer): | ||
| 71 | * erc-notify.el (erc-notify-timer): | ||
| 72 | * erc-track.el (erc-user-is-active): Only run if we have | ||
| 73 | successfully established a connection to the server and have | ||
| 74 | logged in. I suspect that sending messages too soon may make some | ||
| 75 | IRC servers not respond well, particularly when the network | ||
| 76 | connection is iffy or subject to traffic-shaping. | ||
| 77 | |||
| 78 | 2007-11-01 Michael Olson <mwolson@gnu.org> | ||
| 79 | |||
| 80 | * erc-compat.el (erc-set-write-file-functions): New compatibility | ||
| 81 | function to set the write hooks appropriately. | ||
| 82 | |||
| 83 | * erc-log.el (erc-log-setup-logging): Use | ||
| 84 | erc-set-write-file-functions. This fixes a byte-compiler warning. | ||
| 85 | |||
| 86 | * erc-stamp.el: Silence byte-compiler warning about | ||
| 87 | erc-fill-column. | ||
| 88 | |||
| 89 | * erc.el (erc-with-all-buffers-of-server): Bind the result of | ||
| 90 | mapcar to a variable in order to silence a byte-compiler warning. | ||
| 91 | |||
| 92 | 2007-10-29 Michael Olson <mwolson@gnu.org> | ||
| 93 | |||
| 94 | * erc-ibuffer.el (erc-modified-channels-alist): Use | ||
| 95 | eval-when-compile, and explain why we are doing this. | ||
| 96 | |||
| 97 | 2007-10-25 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 98 | |||
| 99 | * erc-ibuffer.el (erc-modified-channels-alist): Pacify | ||
| 100 | byte-compiler. | ||
| 101 | |||
| 102 | 2007-10-13 Glenn Morris <rgm@gnu.org> | ||
| 103 | |||
| 104 | * erc-track.el (erc-modified-channels-update): Use mapc rather | ||
| 105 | than mapcar. | ||
| 106 | |||
| 107 | 2007-10-12 Diane Murray <disumu@x3y2z1.net> | ||
| 108 | |||
| 109 | * erc.el (erc-join-channel): Prompt for channel key if C-u or | ||
| 110 | another prefix-arg was typed. | ||
| 111 | |||
| 112 | * NEWS: Noted this change. | ||
| 113 | |||
| 114 | 2007-10-07 Michael Olson <mwolson@gnu.org> | ||
| 115 | |||
| 116 | * erc.el (erc-cmd-ME'S): New command that handles the case where | ||
| 117 | someone types "/me's". It concatenates the text " 's" to the | ||
| 118 | beginning of the input and then sends the result like a normal | ||
| 119 | "/me" command. | ||
| 120 | (erc-command-regexp): Permit single-quote character. | ||
| 121 | |||
| 122 | 2007-09-30 Aidan Kehoe <kehoea@parhasard.net> (tiny change) | ||
| 123 | |||
| 124 | * erc-log.el (erc-save-buffer-in-logs): Prevent spurious warnings | ||
| 125 | when looking at a log file and concurrently saving to it. | ||
| 126 | |||
| 127 | 2007-09-18 Exal de Jesus Garcia Carrillo <exal@gnu.org> (tiny change) | ||
| 128 | |||
| 129 | * erc.texi (Special-Features): Fix small typo. | ||
| 130 | |||
| 131 | 2007-09-16 Michael Olson <mwolson@gnu.org> | ||
| 132 | |||
| 133 | * erc-track.el (erc-track-switch-direction): Mention | ||
| 134 | erc-track-faces-priority-list. Thanks to Leo for the suggestion. | ||
| 135 | |||
| 136 | 2007-09-11 Exal de Jesus Garcia Carrillo <exal@gnu.org> (tiny change) | ||
| 137 | |||
| 138 | * erc-sound.el: Fix typo in setting up instructions. | ||
| 139 | |||
| 140 | 2007-09-10 Michael Olson <mwolson@gnu.org> | ||
| 141 | |||
| 142 | * Makefile (elpa): Copy dir template rather than echoing a few | ||
| 143 | lines. The reason for this is that the ELPA package for ERC was | ||
| 144 | getting a corrupt dir entry. | ||
| 145 | |||
| 146 | * dir-template: Template for the ELPA dir file. | ||
| 147 | |||
| 148 | 2007-09-08 Michael Olson <mwolson@gnu.org> | ||
| 149 | |||
| 150 | * erc-log.el (erc-log-filter-function): New option that specifies | ||
| 151 | the function to call for filtering text before writing it to a log | ||
| 152 | file. Thanks to David O'Toole for the suggestion. | ||
| 153 | (erc-save-buffer-in-logs): Use erc-log-filter-function. Make sure | ||
| 154 | we carry along the value of coding-system-for-write, because this | ||
| 155 | could potentially be shadowed by the temporary buffer. | ||
| 156 | |||
| 157 | * erc.el (erc-version-string): Update to 5.3, development version. | ||
| 158 | |||
| 159 | 2007-09-07 Glenn Morris <rgm@gnu.org> | ||
| 160 | |||
| 161 | * erc.el (erc-toggle-debug-irc-protocol): Fix call to | ||
| 162 | erc-view-mode-enter. | ||
| 163 | |||
| 164 | 2007-08-08 Glenn Morris <rgm@gnu.org> | ||
| 165 | |||
| 166 | * erc-log.el, erc.el: Replace `iff' in doc-strings and comments. | ||
| 167 | |||
| 168 | 2007-09-03 Michael Olson <mwolson@gnu.org> | ||
| 169 | |||
| 170 | * erc.el (erc-default-port): Make this an integer value rather | ||
| 171 | than a string. Thanks to Luca Capello for the report. | ||
| 172 | |||
| 173 | 2007-08-27 Michael Olson <mwolson@gnu.org> | ||
| 174 | |||
| 175 | * erc.el (erc-cmd-GQUIT): If erc-kill-queries-on-quit is non-nil, | ||
| 176 | kill all query buffers after 4 seconds. | ||
| 177 | |||
| 178 | 2007-08-16 Michael Olson <mwolson@gnu.org> | ||
| 179 | |||
| 180 | * NEWS: Add ERC 5.3 changes section, and mention jbms' erc-track | ||
| 181 | compatibility note. | ||
| 182 | |||
| 183 | * erc-track.el (erc-track-list-changed-hook): Turn this into a | ||
| 184 | customizable option. | ||
| 185 | (erc-track-switch-direction): Add 'importance option. | ||
| 186 | (erc-modified-channels-display): If erc-track-switch-direction is | ||
| 187 | 'importance, call erc-track-sort-by-importance. | ||
| 188 | (erc-track-face-priority): New function that returns a number | ||
| 189 | indicating the position of a face in erc-track-faces-priority-list. | ||
| 190 | (erc-track-sort-by-importance): New function that sorts | ||
| 191 | erc-modified-channels-list according to erc-track-face-priority. | ||
| 192 | (erc-track-get-active-buffer): Make 'oldest a rough opposite of | ||
| 193 | 'importance. | ||
| 194 | |||
| 195 | 2007-08-14 Jeremy Maitin-Shepard <jbms@cmu.edu> | ||
| 196 | |||
| 197 | * erc-track.el (erc-track-remove-disconnected-buffers): New | ||
| 198 | variable which controls whether buffers associated with a server | ||
| 199 | that is disconnected should be removed from | ||
| 200 | `erc-modified-channels-alist'. Existing behavior is to | ||
| 201 | unconditionally remove such buffers, which is achieved by setting | ||
| 202 | `erc-track-removed-disconnected-buffers' to t. When set to t, | ||
| 203 | which is the new default value, such buffers remain in the list, | ||
| 204 | which I think is often the desired behavior, since the user may | ||
| 205 | likely wish to find out about activity that occurred in a channel | ||
| 206 | prior to it being disconnected. | ||
| 207 | (erc-track-list-changed-hook): New hook that is run whenever the | ||
| 208 | contents of `erc-modified-channels-alist' changes; it is useful | ||
| 209 | for users such as myself that don't use the default mode-line | ||
| 210 | notification but instead use a separate mechanism (which is tied | ||
| 211 | to my window manager) to provide notification of channel activity. | ||
| 212 | (erc-track-get-buffer-window): New function that acts as a wrapper | ||
| 213 | around `get-buffer-window' that handles the `selected-visible' | ||
| 214 | option of `erc-track-visibility'; previously, the value of | ||
| 215 | `erc-track-visibility' was passed directly to `get-buffer-window', | ||
| 216 | which does not support `selected-visible'; consequently, | ||
| 217 | `selected-visible' was not properly supported. | ||
| 218 | (erc-track-modified-channels): Fix a bug in the logic for removing | ||
| 219 | buffers from the list in certain cases. | ||
| 220 | (erc-track-position-in-mode-line): Add a supported value that | ||
| 221 | specifies that the tracking information should not be added to the | ||
| 222 | mode line at all. The value of nil is used to indicate that the | ||
| 223 | information should not be added at all to the mode line. | ||
| 224 | (erc-track-add-to-mode-line): Check for position eq to t, rather | ||
| 225 | than non-nil. | ||
| 226 | (erc-buffer-visible): Use erc-track-get-buffer-window. | ||
| 227 | (erc-modified-channels-update): Take | ||
| 228 | erc-track-remove-disconnected-buffers into account. | ||
| 229 | (erc-modified-channels-display): Run `erc-track-list-changed-hook'. | ||
| 230 | |||
| 231 | * erc.el (erc-reuse-frames): New option that determines whether | ||
| 232 | new frames are always created. Defaults to t. This only has an | ||
| 233 | effect when erc-join-buffer is set to 'frame. | ||
| 234 | (erc-setup-buffer): Use it. | ||
| 235 | |||
| 236 | 2007-08-14 Michael Olson <mwolson@gnu.org> | ||
| 237 | |||
| 238 | * erc-backend.el (erc-server-reconnect): If the server buffer has | ||
| 239 | been killed, use the current buffer instead. If the current | ||
| 240 | buffer is not an ERC buffer, give an error. This fixes a bug when | ||
| 241 | /reconnect is run from a channel buffer whose server buffer has | ||
| 242 | been deleted. Thanks to jbms for the report. | ||
| 243 | (erc-process-sentinel-1): Take server buffer as an argument, so | ||
| 244 | that we can make sure that it is current. | ||
| 245 | (erc-process-sentinel): Pass buffer to erc-process-sentinel-1. | ||
| 246 | (erc-process-sentinel-2): New function split from | ||
| 247 | erc-process-sentinel-1. If server buffer is deleted during a | ||
| 248 | reconnect attempt, stop trying to reconnect. Fix bug where | ||
| 249 | reconnect was not happening when erc-server-reconnect-attempts was | ||
| 250 | t. Call erc-server-reconnect-p only once each time. If we are | ||
| 251 | instructed to try connecting indefinitely, tell the user that they | ||
| 252 | can stop this by killing the server buffer. Call the process | ||
| 253 | sentinel by means of run-at-time, so that there is time to kill | ||
| 254 | the buffer if need be; this also removes the need for a while | ||
| 255 | loop. Refuse to reconnect again if erc-server-reconnect-timeout | ||
| 256 | is not an number. | ||
| 257 | |||
| 258 | * erc.el (erc-command-no-process-p): Fix bug: the return value of | ||
| 259 | erc-extract-command-from-line is a list rather than a single | ||
| 260 | symbol. Thanks to jbms for the report. | ||
| 261 | (erc-cmd-RECONNECT): Use simpler logic, and use buffer-live-p | ||
| 262 | rather than bufferp. | ||
| 263 | (erc-send-current-line, erc-display-command, erc-display-msg): | ||
| 264 | Handle case where erc-server-process is nil, so that /reconnect | ||
| 265 | works. | ||
| 266 | |||
| 267 | 2007-08-12 Michael Olson <mwolson@gnu.org> | ||
| 268 | |||
| 269 | * erc-identd.el (erc-identd-filter): Instead of sending an EOF | ||
| 270 | character, which now confuses freenode, stop the server process, | ||
| 271 | so that no new connections are accepted, and kill the current | ||
| 272 | client process. | ||
| 273 | |||
| 274 | 2007-07-29 Michael Olson <mwolson@gnu.org> | ||
| 275 | |||
| 276 | * erc-list.el: Relicense to GPLv3. Since the file was already | ||
| 277 | licensed under version 2 or later, it turns out that we do not | ||
| 278 | need the permission of all of the authors in order to proceed. | ||
| 279 | |||
| 280 | 2007-07-13 Michael Olson <mwolson@gnu.org> | ||
| 281 | |||
| 282 | * erc-goodies.el (erc-get-bg-color-face, erc-get-fg-color-face): | ||
| 283 | Use erc-error rather than message and beep. | ||
| 284 | |||
| 285 | * erc-sound.el: Indentation fix. | ||
| 286 | |||
| 287 | * erc.el (erc-command-no-process-p): New function that determines | ||
| 288 | if its argument is an ERC command that can be run when the server | ||
| 289 | process is not alive. | ||
| 290 | (erc-cmd-SET, erc-cmd-CLEAR, erc-cmd-COUNTRY, erc-cmd-HELP) | ||
| 291 | (erc-cmd-LASTLOG, erc-cmd-QUIT, erc-cmd-GQUIT) | ||
| 292 | (erc-cmd-RECONNECT, erc-cmd-SERVER): Denote that these commands | ||
| 293 | can be run even when the server process is not alive. | ||
| 294 | (erc-send-current-line): Call erc-command-no-process-p if the | ||
| 295 | server process is not alive, to determine if we have a command | ||
| 296 | that can be run anyway. Thanks to Tom Tromey for the bug report. | ||
| 297 | (erc-error): New function that either displays a message or throws | ||
| 298 | an error, depending on whether debug-on-error is non-nil. | ||
| 299 | (erc-cmd-SERVER, erc-send-current-line): Use it. | ||
| 300 | |||
| 301 | 2007-07-10 Michael Olson <mwolson@gnu.org> | ||
| 302 | |||
| 303 | * Relicense all FSF-assigned code to GPLv3. | ||
| 304 | |||
| 305 | 2007-06-25 Michael Olson <mwolson@gnu.org> | ||
| 306 | |||
| 307 | * erc.texi (Options): Fix typo. | ||
| 308 | (Getting Help and Reporting Bugs): Update webpage URL. Make Gmane | ||
| 309 | part more readable. | ||
| 310 | |||
| 311 | 2007-06-20 Michael Olson <mwolson@gnu.org> | ||
| 312 | |||
| 313 | * erc-stamp.el (erc-timestamp-format-left): New option that | ||
| 314 | specifies the left timestamp to use for | ||
| 315 | erc-insert-timestamp-left-and-right. | ||
| 316 | (erc-timestamp-format-right): New option that specifies the right | ||
| 317 | timestamp to use for erc-insert-timestamp-left-and-right. | ||
| 318 | (erc-insert-timestamp-function): Change default to | ||
| 319 | erc-insert-timestamp-left-and-right. | ||
| 320 | (erc-insert-away-timestamp-function): Ditto. | ||
| 321 | (erc-timestamp-last-inserted-left) | ||
| 322 | (erc-timestamp-last-inserted-right): New variables to keep track | ||
| 323 | of data for erc-insert-timestamp-left-and-right. | ||
| 324 | (erc-insert-timestamp-left-and-right): New function that places | ||
| 325 | timestamps on both the left and right sides of the screen, but | ||
| 326 | only if each timestamp has changed since it was last computed. | ||
| 327 | Thanks to offby1 for urging me to merge this. | ||
| 328 | |||
| 329 | * erc.el (erc-open-ssl-stream): Display informative error when | ||
| 330 | ssl.el not found. | ||
| 331 | (erc-tls): New function to connect using tls.el. | ||
| 332 | (erc-open-tls-stream): New function to initiate tls connection. | ||
| 333 | Display informative error when tls.el not found. | ||
| 334 | |||
| 335 | 2007-06-19 Michael Olson <mwolson@gnu.org> | ||
| 336 | |||
| 337 | * erc-log.el: Update header with accurate instructions. | ||
| 338 | |||
| 339 | 2007-06-17 Michael Olson <mwolson@gnu.org> | ||
| 340 | |||
| 341 | * erc-pkg.el: Update description to match what is currently in ELPA. | ||
| 342 | |||
| 343 | 2007-06-14 Juanma Barranquero <lekktu@gmail.com> | ||
| 344 | |||
| 345 | * erc-goodies.el (erc-scroll-to-bottom): Remove redundant check. | ||
| 346 | |||
| 347 | 2007-06-13 Michael Olson <mwolson@gnu.org> | ||
| 348 | |||
| 349 | * erc-compat.el (erc-with-selected-window): New compatibility | ||
| 350 | macro that implements `with-selected-window'. | ||
| 351 | |||
| 352 | * erc-goodies.el (erc-scroll-to-bottom): Use it. This fixes a bug | ||
| 353 | with buffer ordering where ERC buffers would move to the top. | ||
| 354 | Thanks to Ivan Kanis for the patch. | ||
| 355 | |||
| 356 | 2007-06-10 Michael Olson <mwolson@gnu.org> | ||
| 357 | |||
| 358 | * erc-log.el (erc-logging-enabled): Fix a bug that occurred when | ||
| 359 | `erc-log-channels-directory' had the name of a function. | ||
| 360 | |||
| 361 | 2007-06-06 Juanma Barranquero <lekktu@gmail.com> | ||
| 362 | |||
| 363 | * erc.el (erc-show-channel-key-p, erc-startup-file-list): | ||
| 364 | Fix typo in docstring. | ||
| 365 | |||
| 366 | 2007-06-03 Michael Olson <mwolson@gnu.org> | ||
| 367 | |||
| 368 | * erc-compat.el (erc-view-mode-enter): Make this its own function, | ||
| 369 | in order to document what we do, and provide sane fallback | ||
| 370 | behavior. | ||
| 371 | |||
| 372 | * erc.el (erc-toggle-debug-irc-protocol): Don't pass any arguments | ||
| 373 | to erc-view-mode-enter, since we don't do anything special with | ||
| 374 | the exit function. This fixes a bug with Emacs 21 and Emacs 22. | ||
| 375 | Thanks to Leo for noticing. | ||
| 376 | |||
| 377 | 2007-05-30 Michael Olson <mwolson@gnu.org> | ||
| 378 | |||
| 379 | * erc-compat.el (erc-user-emacs-directory): New variable that | ||
| 380 | determines where to find user-specific Emacs settings. For Emacs, | ||
| 381 | this is usually ~/.emacs.d, and for XEmacs this is usually | ||
| 382 | ~/.xemacs. | ||
| 383 | |||
| 384 | * erc.el (erc-startup-file-list): Use erc-user-emacs-directory. | ||
| 385 | |||
| 386 | 2007-05-28 Michael Olson <mwolson@gnu.org> | ||
| 387 | |||
| 388 | * erc-button.el (erc-button-url-regexp): Recognize parentheses as | ||
| 389 | part of URLs. Thanks to Lawrence Mitchell for the fix. | ||
| 390 | |||
| 391 | 2007-05-26 Michael Olson <mwolson@gnu.org> | ||
| 392 | |||
| 393 | * erc.texi (Modules): Fix references to completion modules. | ||
| 394 | |||
| 395 | 2007-05-21 Michael Olson <mwolson@gnu.org> | ||
| 396 | |||
| 397 | * Makefile (SOURCE): Remove erc-pkg.el. | ||
| 398 | (debclean): New rule to clean old Debian packages of ERC. | ||
| 399 | (debprepare): Don't modify the released tarball, but copy it as | ||
| 400 | the .orig.tar.gz file. | ||
| 401 | (debrelease, debrevision): Remove. | ||
| 402 | (debinstall): New target that copies the generated Debian file to | ||
| 403 | a distro-specific location. | ||
| 404 | (deb): New rule that chains together the stages in building a | ||
| 405 | Debian package. | ||
| 406 | (EXTRAS): Add erc-nicklist.el, since it is not release-quality. | ||
| 407 | (extras): Copy images directory. | ||
| 408 | |||
| 409 | * erc-nicklist.el (erc-nicklist-icons-directory): Use | ||
| 410 | locate-library to find the "images" directory. This should be | ||
| 411 | more failsafe. Thanks to Tom Tromey for the idea. | ||
| 412 | |||
| 413 | 2007-05-19 Michael Olson <mwolson@gnu.org> | ||
| 414 | |||
| 415 | * Makefile (ELPA): New variable that contains the location of my | ||
| 416 | local ELPA repository. | ||
| 417 | (elpa): New rule that makes an ELPA package for ERC. | ||
| 418 | |||
| 419 | 2007-04-19 Michael Olson <mwolson@gnu.org> | ||
| 420 | |||
| 421 | * erc.el (erc-parse-prefix): New function that retrieves the | ||
| 422 | PREFIX server parameter from the current server and returns an | ||
| 423 | alist of prefix type to prefix character. | ||
| 424 | (erc-channel-receive-names): Use `erc-parse-prefix' to determine | ||
| 425 | whether the first character of a nick is a prefix character or | ||
| 426 | not. This should fix a bug reported by bromine about needing to | ||
| 427 | type "%" first to complete nicks of people who are "hops" on | ||
| 428 | Slashnet. This should also support for very exotic IRC server | ||
| 429 | setups, if any exist. | ||
| 430 | (erc-update-current-channel-member): Indentation. | ||
| 431 | |||
| 432 | 2007-04-15 Michael Olson <mwolson@gnu.org> | ||
| 433 | |||
| 434 | * erc-log.el (erc-generate-log-file-name-function): Docfix. | ||
| 435 | Mention how to deal with the case for putting log files in | ||
| 436 | different directories. Change a customization type from `symbol' | ||
| 437 | to `function'. | ||
| 438 | (erc-log-channels-directory): Allow this to contain a function | ||
| 439 | name, which is called with the same args as in | ||
| 440 | `erc-generate-log-file-name-function'. Thanks to andrewy for the | ||
| 441 | report and use case. | ||
| 442 | (erc-current-logfile): Detect if `erc-log-channels-directory' is a | ||
| 443 | function and call it with arguments if so. | ||
| 444 | |||
| 445 | 2007-04-12 Michael Olson <mwolson@gnu.org> | ||
| 446 | |||
| 447 | * erc-backend.el (define-erc-response-handler): Mention that hook | ||
| 448 | processing stops when the function returns non-nil. This should | ||
| 449 | help avoid a nasty "gotcha" when making custom functions. Thanks | ||
| 450 | to John Sullivan for the report. | ||
| 451 | |||
| 452 | 2007-04-08 Diane Murray <disumu@x3y2z1.net> | ||
| 453 | |||
| 454 | * erc-nicklist.el (erc-nicklist-voiced-position): Fixed | ||
| 455 | customization mismatch. | ||
| 456 | |||
| 457 | 2007-04-01 Michael Olson <mwolson@gnu.org> | ||
| 458 | |||
| 459 | * erc.el (erc-version-string): Release ERC 5.2. | ||
| 460 | |||
| 461 | * erc-auto.in, erc-chess.el, erc-list.el, erc-speak.el: | ||
| 462 | * erc-viper.el: Update copyright notices. | ||
| 463 | |||
| 464 | * erc.texi: Make Emacs Lisp source code in this document | ||
| 465 | essentially public domain. Update version to 5.2. | ||
| 466 | (Obtaining ERC): Mention extras tarball. | ||
| 467 | (Releases): Mention local GNU mirror. | ||
| 468 | (Sample Configuration): Remove notice. | ||
| 469 | |||
| 470 | * FOR-RELEASE (5.3): Add item for erc-nicklist. | ||
| 471 | Mark NEWS as done. Mark extras tarball as done. | ||
| 472 | |||
| 473 | * Makefile (VERSION): Increment to 5.2. | ||
| 474 | (TESTING): Remove. | ||
| 475 | (EXTRAS): New variable containing the contents of our "Emacs 22 | ||
| 476 | extras" tarball. | ||
| 477 | (SOURCE): Remove $(TESTING). | ||
| 478 | (MISC): Add COPYING and ChangeLog.06. Fix ChangeLog.NNNN -> | ||
| 479 | ChangeLog.NN. | ||
| 480 | (release): Use $(SNAPDIR) instead of erc-$(VERSION). | ||
| 481 | (extras): New rule which implements the building of the extras | ||
| 482 | tarball. | ||
| 483 | (upload-extras): New rule to upload the extras tarball. It's | ||
| 484 | yucky to replicate upload, but oh well. | ||
| 485 | (DISTRIBUTOR): New variable used to differentiate between building | ||
| 486 | packages for Ubuntu and Debian. | ||
| 487 | (debrelease, debrevision): Use it. | ||
| 488 | (debbuild): Run linda in addition to lintian. | ||
| 489 | |||
| 490 | * NEWS: Mention extras tarball. Note which files have been | ||
| 491 | renamed. Note that erc-list is enabled by default, except in | ||
| 492 | Emacs 22. | ||
| 493 | |||
| 494 | * README.extras: New file which serves as a README for the extras | ||
| 495 | tarball. | ||
| 496 | |||
| 497 | 2007-03-31 Michael Olson <mwolson@gnu.org> | ||
| 498 | |||
| 499 | * NEWS: Update for the 5.2 release. | ||
| 500 | |||
| 501 | * FOR-RELEASE: Finish up 5.2 manual item. Add documentation item | ||
| 502 | for 5.3. | ||
| 503 | |||
| 504 | * erc.texi (Sample Session): Flesh out. Mention #erc. | ||
| 505 | (Modules): Defer to 5.3 release. | ||
| 506 | (Advanced Usage): Move Sample Configuration chapter ahead of | ||
| 507 | unfinished chapters. | ||
| 508 | (Sample Configuration): Write. | ||
| 509 | (Options): Mention how to see available ERC options. Defer to 5.3 | ||
| 510 | release. | ||
| 511 | (Tips and Tricks): Remove, since it seems better to just include | ||
| 512 | tips and tricks in the sample configuration, commented out. | ||
| 513 | |||
| 514 | * erc-bbdb.el (erc-bbdb-search-name-and-create): Make prompt more | ||
| 515 | informative about how to skip merging. | ||
| 516 | (erc-bbdb-insinuate-and-show-entry-1): Move contents of | ||
| 517 | erc-bbdb-insinuate-and-show-entry here. | ||
| 518 | (erc-bbdb-insinuate-and-show-entry): Run | ||
| 519 | erc-bbdb-insinuate-and-show-entry-1 "outside" of the calling | ||
| 520 | function, so that we can avoid triggering a process-filter error | ||
| 521 | if the user hits C-g. | ||
| 522 | |||
| 523 | 2007-03-30 Michael Olson <mwolson@gnu.org> | ||
| 524 | |||
| 525 | * FOR-RELEASE: Solve C-c C-SPC keybinding dilemma. | ||
| 526 | |||
| 527 | * erc-autoaway.el (erc-autoaway-idle-method): Use `if' rather than | ||
| 528 | `cond' and `set' rather than `set-default'. | ||
| 529 | |||
| 530 | * erc-log.el: Avoid compiler warning by requiring erc-network | ||
| 531 | during compilation. | ||
| 532 | (erc-generate-log-file-name-function): Add tag to each option. | ||
| 533 | Add erc-generate-log-file-name-network. | ||
| 534 | (erc-generate-log-file-name-network): New function which generates | ||
| 535 | a log file name that uses network name rather than server name, | ||
| 536 | when possible. | ||
| 537 | |||
| 538 | * erc-track.el (track): Assimilate track-when-inactive module, | ||
| 539 | since there's no need to have two modules in one file -- an option | ||
| 540 | will do. Remove track-modified-channels alias. Call | ||
| 541 | erc-track-minor-mode-maybe, and tear down the minor mode when | ||
| 542 | disabling. | ||
| 543 | (erc-track-when-inactive): New option which determines whether to | ||
| 544 | track visible buffers when inactive. The default is not to do so. | ||
| 545 | (erc-track-visibility): Mention erc-track-when-inactive. | ||
| 546 | (erc-buffer-visible): Use erc-track-when-inactive. | ||
| 547 | (erc-track-enable-keybindings): New option which determines | ||
| 548 | whether to enable the global-level tracking keybindings. The | ||
| 549 | default is to do so, unless they would override another binding, | ||
| 550 | in which case we prompt the user about it. | ||
| 551 | (erc-track-minor-mode-map): Move global keybindings here. | ||
| 552 | (erc-track-minor-mode): New minor mode which only enables the | ||
| 553 | keybindings and does nothing else. | ||
| 554 | (erc-track-minor-mode-maybe): New function which starts | ||
| 555 | erc-track-minor-mode, but only if it hasn't already been started, | ||
| 556 | an ERC buffer exists, and the user OK's it, depending on the value | ||
| 557 | of `erc-track-enable-keybindings'. | ||
| 558 | (erc-track-switch-buffer): Display a message if someone calls this | ||
| 559 | without first enabling erc-track-mode. | ||
| 560 | |||
| 561 | 2007-03-17 Michael Olson <mwolson@gnu.org> | ||
| 562 | |||
| 563 | * erc.texi (Development): Mention ErcDevelopment page on | ||
| 564 | emacswiki. | ||
| 565 | (Getting Started): Mention ~/.emacs.d/.ercrc.el and the Customize | ||
| 566 | interface. | ||
| 567 | (Sample Session): New section that has a very rough draft for a | ||
| 568 | sample ERC session. | ||
| 569 | (Special Features): New section that explains some of the special | ||
| 570 | features of ERC. Taken from ErcFeatures on emacswiki, with | ||
| 571 | enhancements. | ||
| 572 | |||
| 573 | 2007-03-12 Diane Murray <disumu@x3y2z1.net> | ||
| 574 | |||
| 575 | * erc-autoaway.el (erc-autoaway-idle-method): When setting the new | ||
| 576 | value, disable and re-enable `erc-autoaway-mode' only if it was | ||
| 577 | already enabled. This fixes a bug where autoaway was enabled just | ||
| 578 | by loading the file. | ||
| 579 | |||
| 580 | 2007-03-10 Diane Murray <disumu@x3y2z1.net> | ||
| 581 | |||
| 582 | * erc-capab.el: Added more information to the Usage section. | ||
| 583 | (erc-capab-identify-prefix): Doc fix. | ||
| 584 | (erc-capab-identify-unidentified): New face. | ||
| 585 | (290): Removed. Definition moved to erc-backend.el. | ||
| 586 | (erc-capab-identify-send-messages): Renamed from | ||
| 587 | `erc-capab-send-identify-messages'. | ||
| 588 | (erc-capab-identify-setup): Use it. | ||
| 589 | (erc-capab-identify-get-unidentified-nickname): Renamed from | ||
| 590 | `erc-capab-get-unidentified-nickname'. | ||
| 591 | (erc-capab-identify-add-prefix): Use it. Use | ||
| 592 | `erc-capab-identify-unidentified' as the face. | ||
| 593 | |||
| 594 | * erc-backend.el (290): Moved here from erc-capab.el. | ||
| 595 | |||
| 596 | * erc.el (erc-select): Added an autoload cookie. | ||
| 597 | (erc-message-type-member, erc-restore-text-properties): Use | ||
| 598 | `erc-get-parsed-vector'. | ||
| 599 | (erc-auto-query): Set the default to 'bury since many new users | ||
| 600 | expect private messages from others to be in dedicated query | ||
| 601 | buffers, not the server buffer. | ||
| 602 | (erc-common-server-suffixes): Use "freenode" for freenode.net, not | ||
| 603 | "OPN". Added oftc.net. | ||
| 604 | |||
| 605 | * NEWS: Added note about erc-auto-query's new default setting. | ||
| 606 | |||
| 607 | 2007-03-03 Michael Olson <mwolson@gnu.org> | ||
| 608 | |||
| 609 | * erc.el (erc-open, erc): Docfixes. | ||
| 610 | |||
| 611 | 2007-03-02 Michael Olson <mwolson@gnu.org> | ||
| 612 | |||
| 613 | * FOR-RELEASE: Make section for 5.3 release and move erc-backend | ||
| 614 | cleanup there. Awaiting discussion before doing other things. | ||
| 615 | Add tasks for merging filename changes from the 5.2 release | ||
| 616 | branch, and for making a tarball of modules not in Emacs 22. Add | ||
| 617 | item to remind me to update NEWS. Mark backtab entry as done. | ||
| 618 | |||
| 619 | * erc-button.el (button): Add call to `erc-button-add-keys'. | ||
| 620 | (erc-button-keys-added): New variable tracking whether we've added | ||
| 621 | the keys yet. | ||
| 622 | (erc-button-add-keys): New function that adds the <backtab> key to | ||
| 623 | erc-mode-map. | ||
| 624 | |||
| 625 | * erc.texi: Change version to 5.2 (pre-release). | ||
| 626 | |||
| 627 | 2007-02-15 Michael Olson <mwolson@gnu.org> | ||
| 628 | |||
| 629 | * CREDITS: Update. | ||
| 630 | |||
| 631 | * erc-backend.el (erc-server-send-ping-interval): Change to use a | ||
| 632 | default of 30 seconds. Improve customize interface. | ||
| 633 | (erc-server-send-ping-timeout): New option that determines when to | ||
| 634 | consider a connection stalled and restart it. The default is | ||
| 635 | after 120 seconds. | ||
| 636 | (erc-server-send-ping): Use erc-server-send-ping-timeout instead | ||
| 637 | of erc-server-send-ping-interval. If | ||
| 638 | erc-server-send-ping-timeout is nil, do not ever kill and restart | ||
| 639 | a hung IRC process. | ||
| 640 | |||
| 641 | * erc.el (erc-modules): Include the name of the module in its | ||
| 642 | description. This should make it easier for people to find and | ||
| 643 | enable a particular module. | ||
| 644 | |||
| 645 | 2007-02-15 Vivek Dasmohapatra <vivek@etla.org> | ||
| 646 | |||
| 647 | * erc.el (erc-cmd-RECONNECT): Kill old process if it is still | ||
| 648 | alive. | ||
| 649 | (erc-message-english-PART): Properly escape "%" characters in | ||
| 650 | reason. | ||
| 651 | |||
| 652 | * erc-backend.el (erc-server-reconnecting): New variable that is | ||
| 653 | set when the user requests a reconnect, but the old process is | ||
| 654 | still alive. This forces the reconnect to work even though the | ||
| 655 | process is killed manually during reconnect. | ||
| 656 | (erc-server-connect): Initialize it. | ||
| 657 | (erc-server-reconnect-p): Use it. | ||
| 658 | (erc-process-sentinel-1): Set it to nil after the first reconnect | ||
| 659 | attempt. | ||
| 660 | |||
| 661 | 2007-02-07 Diane Murray <disumu@x3y2z1.net> | ||
| 662 | |||
| 663 | * erc-menu.el (erc-menu-definition): Fixed so that the separator | ||
| 664 | is between "Current channel" and "Pals, fools and other keywords", | ||
| 665 | not at the bottom of the "Current channel" submenu. | ||
| 666 | |||
| 667 | 2007-01-25 Diane Murray <disumu@x3y2z1.net> | ||
| 668 | |||
| 669 | * erc-networks.el (erc-server-alist): Removed SSL server for now | ||
| 670 | since `erc-server-select' doesn't know to use `erc-ssl'. | ||
| 671 | |||
| 672 | * erc-networks.el (erc-server-alist, erc-networks-alist): Added | ||
| 673 | definitions for oftc.net. | ||
| 674 | |||
| 675 | * erc-services.el (erc-nickserv-alist): Fixed OFTC message regexp. | ||
| 676 | |||
| 677 | 2007-01-22 Michael Olson <mwolson@gnu.org> | ||
| 678 | |||
| 679 | * erc-backend.el (erc-server-error-occurred): New variable that | ||
| 680 | indicates when an error has been signaled by the server. This | ||
| 681 | should fix an infinite reconnect bug when giving some servers a | ||
| 682 | bogus :full-name. Thanks to Angelina Carlton for the report. | ||
| 683 | (erc-server-connect): Initialize erc-server-error-occurred. | ||
| 684 | (erc-server-reconnect-p): Use it. | ||
| 685 | (ERROR): Set it. | ||
| 686 | |||
| 687 | * erc-services.el (erc-nickserv-alist): Alphabetize and add Ars | ||
| 688 | and QuakeNet. Standardize look of entries. Fix type mismatch | ||
| 689 | error in customize interface. | ||
| 690 | (erc-nickserv-passwords): Alphabetize and add missing entries from | ||
| 691 | erc-nickserv-alist. | ||
| 692 | |||
| 693 | 2007-01-21 Michael Olson <mwolson@gnu.org> | ||
| 694 | |||
| 695 | * erc.el (erc-header-line-format): Document how to disable the | ||
| 696 | header line, and add a customization type for it. Also, make the | ||
| 697 | changes take effect immediately. | ||
| 698 | |||
| 699 | 2007-01-19 Michael Olson <mwolson@gnu.org> | ||
| 700 | |||
| 701 | * erc.texi (Modules): Document new menu module. Thanks to Leo | ||
| 702 | for noticing. | ||
| 703 | |||
| 704 | 2007-01-16 Diane Murray <disumu@x3y2z1.net> | ||
| 705 | |||
| 706 | * erc-stamp.el (erc-insert-timestamp-left): Fixed so that the | ||
| 707 | whitespace string filler is hidden correctly when timestamps are | ||
| 708 | hidden. | ||
| 709 | (erc-toggle-timestamps): New function to use instead of | ||
| 710 | `erc-show-timestamps' and `erc-hide-timestamps'. | ||
| 711 | |||
| 712 | * erc.el (erc-restore-text-properties): Moved here from | ||
| 713 | erc-fill.el since it could be useful in general. | ||
| 714 | |||
| 715 | * erc-fill.el (erc-restore-text-properties): Removed. | ||
| 716 | |||
| 717 | 2007-01-13 Michael Olson <mwolson@gnu.org> | ||
| 718 | |||
| 719 | * erc.el (erc-command-regexp): New variable that is used to match | ||
| 720 | a command. | ||
| 721 | (erc-send-input): Use it. This fixes a bug where paths -- | ||
| 722 | "/usr/bin/foo", for example -- were being displayed as commands, | ||
| 723 | but still sent correctly. | ||
| 724 | (erc-extract-command-from-line): Use it. | ||
| 725 | |||
| 726 | * erc.texi (Modules): Document erc-capab-identify. | ||
| 727 | |||
| 728 | 2007-01-11 Diane Murray <disumu@x3y2z1.net> | ||
| 729 | |||
| 730 | * erc.el (erc-find-parsed-property): Moved here from erc-track.el | ||
| 731 | since it can be useful in general. | ||
| 732 | |||
| 733 | * erc-track.el (erc-find-parsed-property): Removed. | ||
| 734 | |||
| 735 | * erc-capab.el (erc-capab-find-parsed): Removed. | ||
| 736 | (erc-capab-identify-add-prefix): Use `erc-find-parsed-property'. | ||
| 737 | |||
| 738 | * erc.el (erc-open): Run `erc-before-connect' hook here. This | ||
| 739 | makes sure the hook always gets called before a connection is | ||
| 740 | made, as some functions, like `erc-handle-irc-url', use `erc-open' | ||
| 741 | instead of `erc'. | ||
| 742 | (erc): Removed `erc-before-connect' hook. | ||
| 743 | |||
| 744 | * erc-menu.el (erc-menu-definition): Put items specific to | ||
| 745 | channels in a "Current channel" submenu. | ||
| 746 | |||
| 747 | * erc-backend.el (321, 323): Display channel list in server buffer | ||
| 748 | when not using the channel list module. | ||
| 749 | |||
| 750 | * erc.el: Updated copyright years. | ||
| 751 | (erc-version-string): Set to 5.2 (devel). | ||
| 752 | (erc-format-lag-time): Fixed to work when `erc-server-lag' is nil. | ||
| 753 | (erc-update-mode-line-buffer): Set the header face. | ||
| 754 | |||
| 755 | 2007-01-11 Michael Olson <mwolson@gnu.org> | ||
| 756 | |||
| 757 | * erc-bbdb.el (erc-bbdb-popup-type): Fix customization type and | ||
| 758 | documentation. | ||
| 759 | |||
| 760 | * erc-services.el (erc-nickserv-identify-mode): Improve | ||
| 761 | documentation for nick-change option and move higher to fix | ||
| 762 | compiler warning. Avoid a recursive load error. | ||
| 763 | (erc-nickserv-alist): Add simple entry for BitlBee, to avoid | ||
| 764 | "NickServ is AWAY: User is offline" error. Oddly enough, bitlbee | ||
| 765 | was smart enough to recognize that as an authentication request | ||
| 766 | and log in regardless, which is why I didn't notice this earlier. | ||
| 767 | (erc-nickserv-alist-sender, erc-nickserv-alist-regexp) | ||
| 768 | (erc-nickserv-alist-nickserv, erc-nickserv-alist-ident-keyword) | ||
| 769 | (erc-nickserv-alist-use-nick-p) | ||
| 770 | (erc-nickserv-alist-ident-command): New accessors for | ||
| 771 | erc-nickserv-alist. Using nth is unwieldy. | ||
| 772 | (erc-nickserv-identify-autodetect) | ||
| 773 | (erc-nickserv-identify-on-connect) | ||
| 774 | (erc-nickserv-identify-on-nick-change, erc-nickserv-identify): Use | ||
| 775 | the new accessors. | ||
| 776 | |||
| 777 | 2007-01-11 Diane Murray <disumu@x3y2z1.net> | ||
| 778 | |||
| 779 | * NEWS: Added note for `erc-my-nick-face'. Fixed capab-identify | ||
| 780 | wording. | ||
| 781 | |||
| 782 | 2007-01-10 Diane Murray <disumu@x3y2z1.net> | ||
| 783 | |||
| 784 | * erc.el (erc-mode-line-format): Added %l to documentation. | ||
| 785 | (erc-header-line-format): Removed "[IRC]". Use the new %l | ||
| 786 | replacement character. Doc fix. | ||
| 787 | (erc-format-channel-modes): Removed lag code. Removed parentheses | ||
| 788 | from mode string. | ||
| 789 | (erc-format-lag-time): New function. | ||
| 790 | (erc-update-mode-line-buffer): Use it. | ||
| 791 | |||
| 792 | 2007-01-10 Michael Olson <mwolson@gnu.org> | ||
| 793 | |||
| 794 | * erc.el: Fix typo in url-irc-function instructions. | ||
| 795 | |||
| 796 | 2007-01-09 Michael Olson <mwolson@gnu.org> | ||
| 797 | |||
| 798 | * erc.el (erc-system-name): New option that determines the system | ||
| 799 | name to use when logging in. The default is to figure this out by | ||
| 800 | calling `system-name'. | ||
| 801 | (erc-login): Use it. | ||
| 802 | |||
| 803 | 2007-01-07 Michael Olson <mwolson@gnu.org> | ||
| 804 | |||
| 805 | * erc.el (erc-modules): Add the menu module. This should fix a | ||
| 806 | bug with incorrect ERC submenus being displayed. | ||
| 807 | |||
| 808 | * erc-menu.el: Turn this into a module. | ||
| 809 | (erc-menu-add, erc-menu-remove): New functions that add and remove | ||
| 810 | the ERC menu. | ||
| 811 | |||
| 812 | |||
| 813 | See ChangeLog.06 for earlier changes. | ||
| 814 | |||
| 815 | Copyright (C) 2007, 2008 Free Software Foundation, Inc. | ||
| 816 | |||
| 817 | This file is part of GNU Emacs. | ||
| 818 | |||
| 819 | GNU Emacs is free software; you can redistribute it and/or modify | ||
| 820 | it under the terms of the GNU General Public License as published by | ||
| 821 | the Free Software Foundation; either version 3, or (at your option) | ||
| 822 | any later version. | ||
| 823 | |||
| 824 | GNU Emacs is distributed in the hope that it will be useful, | ||
| 825 | but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 826 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 827 | GNU General Public License for more details. | ||
| 828 | |||
| 829 | You should have received a copy of the GNU General Public License | ||
| 830 | along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 831 | Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | ||
| 832 | Boston, MA 02110-1301, USA. | ||
| 833 | |||
| 834 | ;; Local Variables: | ||
| 835 | ;; coding: utf-8 | ||
| 836 | ;; add-log-time-zone-rule: t | ||
| 837 | ;; End: | ||
| 838 | |||
| 839 | ;; arch-tag: 3369b6e5-96b1-4b32-96cd-9a905c747496 | ||
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 0fead116d8f..1bb3e4aada2 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el | |||
| @@ -332,11 +332,10 @@ This is either a coding system, a cons, a function, or nil. | |||
| 332 | 332 | ||
| 333 | If a cons, the encoding system for outgoing text is in the car | 333 | If a cons, the encoding system for outgoing text is in the car |
| 334 | and the decoding system for incoming text is in the cdr. The most | 334 | and the decoding system for incoming text is in the cdr. The most |
| 335 | interesting use for this is to put `undecided' in the cdr. If a | 335 | interesting use for this is to put `undecided' in the cdr. |
| 336 | function, it is called with no arguments and should return a | 336 | |
| 337 | coding system or a cons as described above. Note that you can use | 337 | If a function, it is called with the argument `target' and should |
| 338 | the dynamically bound variable `target' to get the current | 338 | return a coding system or a cons as described above. |
| 339 | target. See `erc-coding-system-for-target'. | ||
| 340 | 339 | ||
| 341 | If you need to send non-ASCII text to people not using a client that | 340 | If you need to send non-ASCII text to people not using a client that |
| 342 | does decoding on its own, you must tell ERC what encoding to use. | 341 | does decoding on its own, you must tell ERC what encoding to use. |
| @@ -491,6 +490,8 @@ We will store server variables in the buffer given by BUFFER." | |||
| 491 | (let ((process (funcall erc-server-connect-function | 490 | (let ((process (funcall erc-server-connect-function |
| 492 | (format "erc-%s-%s" server port) | 491 | (format "erc-%s-%s" server port) |
| 493 | nil server port))) | 492 | nil server port))) |
| 493 | (unless (processp process) | ||
| 494 | (error "Connection attempt failed")) | ||
| 494 | (message "%s...done" msg) | 495 | (message "%s...done" msg) |
| 495 | ;; Misc server variables | 496 | ;; Misc server variables |
| 496 | (with-current-buffer buffer | 497 | (with-current-buffer buffer |
| @@ -686,7 +687,7 @@ This is determined via `erc-encoding-coding-alist' or | |||
| 686 | (when (string-match (car pat) target) | 687 | (when (string-match (car pat) target) |
| 687 | (throw 'match (cdr pat))))))) | 688 | (throw 'match (cdr pat))))))) |
| 688 | (and (functionp erc-server-coding-system) | 689 | (and (functionp erc-server-coding-system) |
| 689 | (funcall erc-server-coding-system)) | 690 | (funcall erc-server-coding-system target)) |
| 690 | erc-server-coding-system)) | 691 | erc-server-coding-system)) |
| 691 | 692 | ||
| 692 | (defun erc-decode-string-from-target (str target) | 693 | (defun erc-decode-string-from-target (str target) |
| @@ -1349,7 +1350,7 @@ add things to `%s' instead." | |||
| 1349 | (erc-update-mode-line)))) | 1350 | (erc-update-mode-line)))) |
| 1350 | 1351 | ||
| 1351 | (define-erc-response-handler (PRIVMSG NOTICE) | 1352 | (define-erc-response-handler (PRIVMSG NOTICE) |
| 1352 | nil nil | 1353 | "Handle private messages, including messages in channels." nil |
| 1353 | (let ((sender-spec (erc-response.sender parsed)) | 1354 | (let ((sender-spec (erc-response.sender parsed)) |
| 1354 | (cmd (erc-response.command parsed)) | 1355 | (cmd (erc-response.command parsed)) |
| 1355 | (tgt (car (erc-response.command-args parsed))) | 1356 | (tgt (car (erc-response.command-args parsed))) |
| @@ -1413,7 +1414,7 @@ add things to `%s' instead." | |||
| 1413 | (add-hook 'erc-server-PRIVMSG-functions 'erc-auto-query) | 1414 | (add-hook 'erc-server-PRIVMSG-functions 'erc-auto-query) |
| 1414 | 1415 | ||
| 1415 | (define-erc-response-handler (QUIT) | 1416 | (define-erc-response-handler (QUIT) |
| 1416 | nil nil | 1417 | "Another user has quit IRC." nil |
| 1417 | (let ((reason (erc-response.contents parsed)) | 1418 | (let ((reason (erc-response.contents parsed)) |
| 1418 | bufs) | 1419 | bufs) |
| 1419 | (multiple-value-bind (nick login host) | 1420 | (multiple-value-bind (nick login host) |
| @@ -1426,7 +1427,7 @@ add things to `%s' instead." | |||
| 1426 | ?h host ?r reason)))) | 1427 | ?h host ?r reason)))) |
| 1427 | 1428 | ||
| 1428 | (define-erc-response-handler (TOPIC) | 1429 | (define-erc-response-handler (TOPIC) |
| 1429 | nil nil | 1430 | "The channel topic has changed." nil |
| 1430 | (let* ((ch (first (erc-response.command-args parsed))) | 1431 | (let* ((ch (first (erc-response.command-args parsed))) |
| 1431 | (topic (erc-trim-string (erc-response.contents parsed))) | 1432 | (topic (erc-trim-string (erc-response.contents parsed))) |
| 1432 | (time (format-time-string "%T %m/%d/%y" (current-time)))) | 1433 | (time (format-time-string "%T %m/%d/%y" (current-time)))) |
| @@ -1439,7 +1440,7 @@ add things to `%s' instead." | |||
| 1439 | ?c ch ?T topic)))) | 1440 | ?c ch ?T topic)))) |
| 1440 | 1441 | ||
| 1441 | (define-erc-response-handler (WALLOPS) | 1442 | (define-erc-response-handler (WALLOPS) |
| 1442 | nil nil | 1443 | "Display a WALLOPS message." nil |
| 1443 | (let ((message (erc-response.contents parsed))) | 1444 | (let ((message (erc-response.contents parsed))) |
| 1444 | (multiple-value-bind (nick login host) | 1445 | (multiple-value-bind (nick login host) |
| 1445 | (erc-parse-user (erc-response.sender parsed)) | 1446 | (erc-parse-user (erc-response.sender parsed)) |
| @@ -1465,12 +1466,12 @@ add things to `%s' instead." | |||
| 1465 | (erc-response.contents parsed))) | 1466 | (erc-response.contents parsed))) |
| 1466 | 1467 | ||
| 1467 | (define-erc-response-handler (376 422) | 1468 | (define-erc-response-handler (376 422) |
| 1468 | nil nil | 1469 | "End of MOTD/MOTD is missing." nil |
| 1469 | (erc-server-MOTD proc parsed) | 1470 | (erc-server-MOTD proc parsed) |
| 1470 | (erc-connection-established proc parsed)) | 1471 | (erc-connection-established proc parsed)) |
| 1471 | 1472 | ||
| 1472 | (define-erc-response-handler (004) | 1473 | (define-erc-response-handler (004) |
| 1473 | nil nil | 1474 | "Display the server's identification." nil |
| 1474 | (multiple-value-bind (server-name server-version) | 1475 | (multiple-value-bind (server-name server-version) |
| 1475 | (cdr (erc-response.command-args parsed)) | 1476 | (cdr (erc-response.command-args parsed)) |
| 1476 | (setq erc-server-version server-version) | 1477 | (setq erc-server-version server-version) |
| @@ -1510,7 +1511,7 @@ A server may send more than one 005 message." | |||
| 1510 | (erc-display-message parsed 'notice proc line))) | 1511 | (erc-display-message parsed 'notice proc line))) |
| 1511 | 1512 | ||
| 1512 | (define-erc-response-handler (221) | 1513 | (define-erc-response-handler (221) |
| 1513 | nil nil | 1514 | "Display the current user modes." nil |
| 1514 | (let* ((nick (first (erc-response.command-args parsed))) | 1515 | (let* ((nick (first (erc-response.command-args parsed))) |
| 1515 | (modes (mapconcat 'identity | 1516 | (modes (mapconcat 'identity |
| 1516 | (cdr (erc-response.command-args parsed)) " "))) | 1517 | (cdr (erc-response.command-args parsed)) " "))) |
| @@ -1596,7 +1597,7 @@ See `erc-display-server-message'." nil | |||
| 1596 | ?n nick ?f fname ?u user ?h host)))) | 1597 | ?n nick ?f fname ?u user ?h host)))) |
| 1597 | 1598 | ||
| 1598 | (define-erc-response-handler (312) | 1599 | (define-erc-response-handler (312) |
| 1599 | nil nil | 1600 | "Server name response in WHOIS." nil |
| 1600 | (multiple-value-bind (nick server-host) | 1601 | (multiple-value-bind (nick server-host) |
| 1601 | (cdr (erc-response.command-args parsed)) | 1602 | (cdr (erc-response.command-args parsed)) |
| 1602 | (erc-display-message | 1603 | (erc-display-message |
| @@ -1614,7 +1615,7 @@ See `erc-display-server-message'." nil | |||
| 1614 | ;; 318 - End of WHOIS list | 1615 | ;; 318 - End of WHOIS list |
| 1615 | ;; 323 - End of channel LIST | 1616 | ;; 323 - End of channel LIST |
| 1616 | ;; 369 - End of WHOWAS | 1617 | ;; 369 - End of WHOWAS |
| 1617 | nil nil | 1618 | "End of WHO/WHOIS/LIST/WHOWAS notices." nil |
| 1618 | (ignore proc parsed)) | 1619 | (ignore proc parsed)) |
| 1619 | 1620 | ||
| 1620 | (define-erc-response-handler (317) | 1621 | (define-erc-response-handler (317) |
| @@ -1635,7 +1636,7 @@ See `erc-display-server-message'." nil | |||
| 1635 | ?n nick ?i (erc-sec-to-time (string-to-number seconds-idle)))))) | 1636 | ?n nick ?i (erc-sec-to-time (string-to-number seconds-idle)))))) |
| 1636 | 1637 | ||
| 1637 | (define-erc-response-handler (319) | 1638 | (define-erc-response-handler (319) |
| 1638 | nil nil | 1639 | "Channel names in WHOIS response." nil |
| 1639 | (erc-display-message | 1640 | (erc-display-message |
| 1640 | parsed 'notice 'active 's319 | 1641 | parsed 'notice 'active 's319 |
| 1641 | ?n (second (erc-response.command-args parsed)) | 1642 | ?n (second (erc-response.command-args parsed)) |
| @@ -1649,8 +1650,13 @@ See `erc-display-server-message'." nil | |||
| 1649 | 1650 | ||
| 1650 | (define-erc-response-handler (321) | 1651 | (define-erc-response-handler (321) |
| 1651 | "LIST header." nil | 1652 | "LIST header." nil |
| 1652 | (setq erc-channel-list nil) | 1653 | (setq erc-channel-list nil)) |
| 1653 | (erc-display-message parsed 'notice proc 's321)) | 1654 | |
| 1655 | (defun erc-server-321-message (proc parsed) | ||
| 1656 | "Display a message for the 321 event." | ||
| 1657 | (erc-display-message parsed 'notice proc 's321) | ||
| 1658 | nil) | ||
| 1659 | (add-hook 'erc-server-321-functions 'erc-server-321-message t) | ||
| 1654 | 1660 | ||
| 1655 | (define-erc-response-handler (322) | 1661 | (define-erc-response-handler (322) |
| 1656 | "LIST notice." nil | 1662 | "LIST notice." nil |
| @@ -1658,10 +1664,17 @@ See `erc-display-server-message'." nil | |||
| 1658 | (multiple-value-bind (channel num-users) | 1664 | (multiple-value-bind (channel num-users) |
| 1659 | (cdr (erc-response.command-args parsed)) | 1665 | (cdr (erc-response.command-args parsed)) |
| 1660 | (add-to-list 'erc-channel-list (list channel)) | 1666 | (add-to-list 'erc-channel-list (list channel)) |
| 1661 | (erc-update-channel-topic channel topic) | 1667 | (erc-update-channel-topic channel topic)))) |
| 1668 | |||
| 1669 | (defun erc-server-322-message (proc parsed) | ||
| 1670 | "Display a message for the 322 event." | ||
| 1671 | (let ((topic (erc-response.contents parsed))) | ||
| 1672 | (multiple-value-bind (channel num-users) | ||
| 1673 | (cdr (erc-response.command-args parsed)) | ||
| 1662 | (erc-display-message | 1674 | (erc-display-message |
| 1663 | parsed 'notice proc 's322 | 1675 | parsed 'notice proc 's322 |
| 1664 | ?c channel ?u num-users ?t (or topic ""))))) | 1676 | ?c channel ?u num-users ?t (or topic ""))))) |
| 1677 | (add-hook 'erc-server-322-functions 'erc-server-322-message t) | ||
| 1665 | 1678 | ||
| 1666 | (define-erc-response-handler (324) | 1679 | (define-erc-response-handler (324) |
| 1667 | "Channel or nick modes." nil | 1680 | "Channel or nick modes." nil |
| @@ -1683,7 +1696,7 @@ See `erc-display-server-message'." nil | |||
| 1683 | 's329 ?c channel ?t (format-time-string "%A %Y/%m/%d %X" time)))) | 1696 | 's329 ?c channel ?t (format-time-string "%A %Y/%m/%d %X" time)))) |
| 1684 | 1697 | ||
| 1685 | (define-erc-response-handler (330) | 1698 | (define-erc-response-handler (330) |
| 1686 | nil nil | 1699 | "Nick is authed as (on Quakenet network)." nil |
| 1687 | ;; FIXME: I don't know what the magic numbers mean. Mummy, make | 1700 | ;; FIXME: I don't know what the magic numbers mean. Mummy, make |
| 1688 | ;; the magic numbers go away. | 1701 | ;; the magic numbers go away. |
| 1689 | ;; No seriously, I have no clue about the format of this command, | 1702 | ;; No seriously, I have no clue about the format of this command, |
| @@ -1699,10 +1712,9 @@ See `erc-display-server-message'." nil | |||
| 1699 | ?n nick ?a authmsg ?i authaccount))) | 1712 | ?n nick ?a authmsg ?i authaccount))) |
| 1700 | 1713 | ||
| 1701 | (define-erc-response-handler (331) | 1714 | (define-erc-response-handler (331) |
| 1702 | "Channel topic." nil | 1715 | "No topic set for channel." nil |
| 1703 | (let ((channel (second (erc-response.command-args parsed))) | 1716 | (let ((channel (second (erc-response.command-args parsed))) |
| 1704 | (topic (erc-response.contents parsed))) | 1717 | (topic (erc-response.contents parsed))) |
| 1705 | ;; FIXME: why don't we do anything with the topic? -- Lawrence 2004/05/10 | ||
| 1706 | (erc-display-message parsed 'notice (erc-get-buffer channel proc) | 1718 | (erc-display-message parsed 'notice (erc-get-buffer channel proc) |
| 1707 | 's331 ?c channel))) | 1719 | 's331 ?c channel))) |
| 1708 | 1720 | ||
| @@ -1715,8 +1727,7 @@ See `erc-display-server-message'." nil | |||
| 1715 | 's332 ?c channel ?T topic))) | 1727 | 's332 ?c channel ?T topic))) |
| 1716 | 1728 | ||
| 1717 | (define-erc-response-handler (333) | 1729 | (define-erc-response-handler (333) |
| 1718 | ;; Who set the topic, and when | 1730 | "Who set the topic, and when." nil |
| 1719 | nil nil | ||
| 1720 | (multiple-value-bind (channel nick time) | 1731 | (multiple-value-bind (channel nick time) |
| 1721 | (cdr (erc-response.command-args parsed)) | 1732 | (cdr (erc-response.command-args parsed)) |
| 1722 | (setq time (format-time-string "%T %Y/%m/%d" | 1733 | (setq time (format-time-string "%T %Y/%m/%d" |
| @@ -1766,7 +1777,7 @@ See `erc-display-server-message'." nil | |||
| 1766 | (erc-channel-end-receiving-names))) | 1777 | (erc-channel-end-receiving-names))) |
| 1767 | 1778 | ||
| 1768 | (define-erc-response-handler (367) | 1779 | (define-erc-response-handler (367) |
| 1769 | "Channel ban list entries" nil | 1780 | "Channel ban list entries." nil |
| 1770 | (multiple-value-bind (channel banmask setter time) | 1781 | (multiple-value-bind (channel banmask setter time) |
| 1771 | (cdr (erc-response.command-args parsed)) | 1782 | (cdr (erc-response.command-args parsed)) |
| 1772 | ;; setter and time are not standard | 1783 | ;; setter and time are not standard |
| @@ -1781,7 +1792,7 @@ See `erc-display-server-message'." nil | |||
| 1781 | ?b banmask)))) | 1792 | ?b banmask)))) |
| 1782 | 1793 | ||
| 1783 | (define-erc-response-handler (368) | 1794 | (define-erc-response-handler (368) |
| 1784 | "End of channel ban list" nil | 1795 | "End of channel ban list." nil |
| 1785 | (let ((channel (second (erc-response.command-args parsed)))) | 1796 | (let ((channel (second (erc-response.command-args parsed)))) |
| 1786 | (erc-display-message parsed 'notice 'active 's368 | 1797 | (erc-display-message parsed 'notice 'active 's368 |
| 1787 | ?c channel))) | 1798 | ?c channel))) |
| @@ -1797,7 +1808,7 @@ See `erc-display-server-message'." nil | |||
| 1797 | 's379 ?c from ?f to))) | 1808 | 's379 ?c from ?f to))) |
| 1798 | 1809 | ||
| 1799 | (define-erc-response-handler (391) | 1810 | (define-erc-response-handler (391) |
| 1800 | "Server's time string" nil | 1811 | "Server's time string." nil |
| 1801 | (erc-display-message | 1812 | (erc-display-message |
| 1802 | parsed 'notice 'active | 1813 | parsed 'notice 'active |
| 1803 | 's391 ?s (second (erc-response.command-args parsed)) | 1814 | 's391 ?s (second (erc-response.command-args parsed)) |
| @@ -1824,56 +1835,47 @@ See `erc-display-server-message'." nil | |||
| 1824 | 1835 | ||
| 1825 | 1836 | ||
| 1826 | (define-erc-response-handler (405) | 1837 | (define-erc-response-handler (405) |
| 1827 | ;; Can't join that many channels. | 1838 | "Can't join that many channels." nil |
| 1828 | nil nil | ||
| 1829 | (erc-display-message parsed '(notice error) 'active | 1839 | (erc-display-message parsed '(notice error) 'active |
| 1830 | 's405 ?c (second (erc-response.command-args parsed)))) | 1840 | 's405 ?c (second (erc-response.command-args parsed)))) |
| 1831 | 1841 | ||
| 1832 | (define-erc-response-handler (406) | 1842 | (define-erc-response-handler (406) |
| 1833 | ;; No such nick | 1843 | "No such nick." nil |
| 1834 | nil nil | ||
| 1835 | (erc-display-message parsed '(notice error) 'active | 1844 | (erc-display-message parsed '(notice error) 'active |
| 1836 | 's406 ?n (second (erc-response.command-args parsed)))) | 1845 | 's406 ?n (second (erc-response.command-args parsed)))) |
| 1837 | 1846 | ||
| 1838 | (define-erc-response-handler (412) | 1847 | (define-erc-response-handler (412) |
| 1839 | ;; No text to send | 1848 | "No text to send." nil |
| 1840 | nil nil | ||
| 1841 | (erc-display-message parsed '(notice error) 'active 's412)) | 1849 | (erc-display-message parsed '(notice error) 'active 's412)) |
| 1842 | 1850 | ||
| 1843 | (define-erc-response-handler (421) | 1851 | (define-erc-response-handler (421) |
| 1844 | ;; Unknown command | 1852 | "Unknown command." nil |
| 1845 | nil nil | ||
| 1846 | (erc-display-message parsed '(notice error) 'active 's421 | 1853 | (erc-display-message parsed '(notice error) 'active 's421 |
| 1847 | ?c (second (erc-response.command-args parsed)))) | 1854 | ?c (second (erc-response.command-args parsed)))) |
| 1848 | 1855 | ||
| 1849 | (define-erc-response-handler (432) | 1856 | (define-erc-response-handler (432) |
| 1850 | ;; Bad nick. | 1857 | "Bad nick." nil |
| 1851 | nil nil | ||
| 1852 | (erc-display-message parsed '(notice error) 'active 's432 | 1858 | (erc-display-message parsed '(notice error) 'active 's432 |
| 1853 | ?n (second (erc-response.command-args parsed)))) | 1859 | ?n (second (erc-response.command-args parsed)))) |
| 1854 | 1860 | ||
| 1855 | (define-erc-response-handler (433) | 1861 | (define-erc-response-handler (433) |
| 1856 | ;; Login-time "nick in use" | 1862 | "Login-time \"nick in use\"." nil |
| 1857 | nil nil | ||
| 1858 | (erc-nickname-in-use (second (erc-response.command-args parsed)) | 1863 | (erc-nickname-in-use (second (erc-response.command-args parsed)) |
| 1859 | "already in use")) | 1864 | "already in use")) |
| 1860 | 1865 | ||
| 1861 | (define-erc-response-handler (437) | 1866 | (define-erc-response-handler (437) |
| 1862 | ;; Nick temporarily unavailable (IRCnet) | 1867 | "Nick temporarily unavailable (on IRCnet)." nil |
| 1863 | nil nil | ||
| 1864 | (let ((nick/channel (second (erc-response.command-args parsed)))) | 1868 | (let ((nick/channel (second (erc-response.command-args parsed)))) |
| 1865 | (unless (erc-channel-p nick/channel) | 1869 | (unless (erc-channel-p nick/channel) |
| 1866 | (erc-nickname-in-use nick/channel "temporarily unavailable")))) | 1870 | (erc-nickname-in-use nick/channel "temporarily unavailable")))) |
| 1867 | 1871 | ||
| 1868 | (define-erc-response-handler (442) | 1872 | (define-erc-response-handler (442) |
| 1869 | ;; Not on channel | 1873 | "Not on channel." nil |
| 1870 | nil nil | ||
| 1871 | (erc-display-message parsed '(notice error) 'active 's442 | 1874 | (erc-display-message parsed '(notice error) 'active 's442 |
| 1872 | ?c (second (erc-response.command-args parsed)))) | 1875 | ?c (second (erc-response.command-args parsed)))) |
| 1873 | 1876 | ||
| 1874 | (define-erc-response-handler (461) | 1877 | (define-erc-response-handler (461) |
| 1875 | ;; Not enough params for command. | 1878 | "Not enough parameters for command." nil |
| 1876 | nil nil | ||
| 1877 | (erc-display-message parsed '(notice error) 'active 's461 | 1879 | (erc-display-message parsed '(notice error) 'active 's461 |
| 1878 | ?c (second (erc-response.command-args parsed)) | 1880 | ?c (second (erc-response.command-args parsed)) |
| 1879 | ?m (erc-response.contents parsed))) | 1881 | ?m (erc-response.contents parsed))) |
| @@ -1887,7 +1889,7 @@ See `erc-display-server-message'." nil | |||
| 1887 | (erc-response.contents parsed))) | 1889 | (erc-response.contents parsed))) |
| 1888 | 1890 | ||
| 1889 | (define-erc-response-handler (474) | 1891 | (define-erc-response-handler (474) |
| 1890 | "Banned from channel errors" nil | 1892 | "Banned from channel errors." nil |
| 1891 | (erc-display-message parsed '(notice error) nil | 1893 | (erc-display-message parsed '(notice error) nil |
| 1892 | (intern (format "s%s" | 1894 | (intern (format "s%s" |
| 1893 | (erc-response.command parsed))) | 1895 | (erc-response.command parsed))) |
| @@ -1906,14 +1908,14 @@ See `erc-display-server-message'." nil | |||
| 1906 | (erc-cmd-JOIN channel key))))) | 1908 | (erc-cmd-JOIN channel key))))) |
| 1907 | 1909 | ||
| 1908 | (define-erc-response-handler (477) | 1910 | (define-erc-response-handler (477) |
| 1909 | nil nil | 1911 | "Channel doesn't support modes." nil |
| 1910 | (let ((channel (second (erc-response.command-args parsed))) | 1912 | (let ((channel (second (erc-response.command-args parsed))) |
| 1911 | (message (erc-response.contents parsed))) | 1913 | (message (erc-response.contents parsed))) |
| 1912 | (erc-display-message parsed 'notice (erc-get-buffer channel proc) | 1914 | (erc-display-message parsed 'notice (erc-get-buffer channel proc) |
| 1913 | (format "%s: %s" channel message)))) | 1915 | (format "%s: %s" channel message)))) |
| 1914 | 1916 | ||
| 1915 | (define-erc-response-handler (482) | 1917 | (define-erc-response-handler (482) |
| 1916 | nil nil | 1918 | "You need to be a channel operator to do that." nil |
| 1917 | (let ((channel (second (erc-response.command-args parsed))) | 1919 | (let ((channel (second (erc-response.command-args parsed))) |
| 1918 | (message (erc-response.contents parsed))) | 1920 | (message (erc-response.contents parsed))) |
| 1919 | (erc-display-message parsed '(error notice) 'active 's482 | 1921 | (erc-display-message parsed '(error notice) 'active 's482 |
| @@ -1935,7 +1937,9 @@ See `erc-display-server-message'." nil | |||
| 1935 | ;; 491 - No O-lines for your host | 1937 | ;; 491 - No O-lines for your host |
| 1936 | ;; 501 - Unknown MODE flag | 1938 | ;; 501 - Unknown MODE flag |
| 1937 | ;; 502 - Cannot change mode for other users | 1939 | ;; 502 - Cannot change mode for other users |
| 1938 | nil nil | 1940 | "Generic display of server error messages. |
| 1941 | |||
| 1942 | See `erc-display-error-notice'." nil | ||
| 1939 | (erc-display-error-notice | 1943 | (erc-display-error-notice |
| 1940 | parsed | 1944 | parsed |
| 1941 | (intern (format "s%s" (erc-response.command parsed))))) | 1945 | (intern (format "s%s" (erc-response.command parsed))))) |
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index a74d56b90bd..7e45c6cd4ea 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el | |||
| @@ -57,16 +57,15 @@ | |||
| 57 | ((add-hook 'erc-insert-modify-hook 'erc-button-add-buttons 'append) | 57 | ((add-hook 'erc-insert-modify-hook 'erc-button-add-buttons 'append) |
| 58 | (add-hook 'erc-send-modify-hook 'erc-button-add-buttons 'append) | 58 | (add-hook 'erc-send-modify-hook 'erc-button-add-buttons 'append) |
| 59 | (add-hook 'erc-complete-functions 'erc-button-next) | 59 | (add-hook 'erc-complete-functions 'erc-button-next) |
| 60 | (add-hook 'erc-mode-hook 'erc-button-add-keys)) | 60 | (add-hook 'erc-mode-hook 'erc-button-setup)) |
| 61 | ((remove-hook 'erc-insert-modify-hook 'erc-button-add-buttons) | 61 | ((remove-hook 'erc-insert-modify-hook 'erc-button-add-buttons) |
| 62 | (remove-hook 'erc-send-modify-hook 'erc-button-add-buttons) | 62 | (remove-hook 'erc-send-modify-hook 'erc-button-add-buttons) |
| 63 | (remove-hook 'erc-complete-functions 'erc-button-next) | 63 | (remove-hook 'erc-complete-functions 'erc-button-next) |
| 64 | (remove-hook 'erc-mode-hook 'erc-button-add-keys))) | 64 | (remove-hook 'erc-mode-hook 'erc-button-setup) |
| 65 | 65 | (when (featurep 'xemacs) | |
| 66 | ;; Make XEmacs use `erc-button-face'. | 66 | (dolist (buffer (erc-buffer-list)) |
| 67 | (when (featurep 'xemacs) | 67 | (with-current-buffer buffer |
| 68 | (add-hook 'erc-mode-hook | 68 | (kill-local-variable 'widget-button-face)))))) |
| 69 | (lambda () (set (make-local-variable 'widget-button-face) nil)))) | ||
| 70 | 69 | ||
| 71 | ;;; Variables | 70 | ;;; Variables |
| 72 | 71 | ||
| @@ -247,8 +246,12 @@ constituents.") | |||
| 247 | "Internal variable used to keep track of whether we've added the | 246 | "Internal variable used to keep track of whether we've added the |
| 248 | global-level ERC button keys yet.") | 247 | global-level ERC button keys yet.") |
| 249 | 248 | ||
| 250 | (defun erc-button-add-keys () | 249 | (defun erc-button-setup () |
| 251 | "Add ERC mode-level button movement keys. This is only done once." | 250 | "Add ERC mode-level button movement keys. This is only done once." |
| 251 | ;; Make XEmacs use `erc-button-face'. | ||
| 252 | (when (featurep 'xemacs) | ||
| 253 | (set (make-local-variable 'widget-button-face) nil)) | ||
| 254 | ;; Add keys. | ||
| 252 | (unless erc-button-keys-added | 255 | (unless erc-button-keys-added |
| 253 | (define-key erc-mode-map (kbd "<backtab>") 'erc-button-previous) | 256 | (define-key erc-mode-map (kbd "<backtab>") 'erc-button-previous) |
| 254 | (setq erc-button-keys-added t))) | 257 | (setq erc-button-keys-added t))) |
| @@ -299,9 +302,10 @@ specified by `erc-button-alist'." | |||
| 299 | (setq bounds (bounds-of-thing-at-point 'word)) | 302 | (setq bounds (bounds-of-thing-at-point 'word)) |
| 300 | (setq word (buffer-substring-no-properties | 303 | (setq word (buffer-substring-no-properties |
| 301 | (car bounds) (cdr bounds))) | 304 | (car bounds) (cdr bounds))) |
| 302 | (if (erc-get-server-user word) | 305 | (when (or (and (erc-server-buffer-p) (erc-get-server-user word)) |
| 303 | (erc-button-add-button (car bounds) (cdr bounds) | 306 | (and erc-channel-users (erc-get-channel-user word))) |
| 304 | fun t (list word))))))) | 307 | (erc-button-add-button (car bounds) (cdr bounds) |
| 308 | fun t (list word))))))) | ||
| 305 | 309 | ||
| 306 | (defun erc-button-add-buttons-1 (regexp entry) | 310 | (defun erc-button-add-buttons-1 (regexp entry) |
| 307 | "Search through the buffer for matches to ENTRY and add buttons." | 311 | "Search through the buffer for matches to ENTRY and add buttons." |
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index d99d8fca7da..dd01280b3aa 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el | |||
| @@ -88,53 +88,6 @@ See `replace-match' for explanations of FIXEDCASE and LITERAL." | |||
| 88 | (defalias 'erc-make-obsolete 'make-obsolete) | 88 | (defalias 'erc-make-obsolete 'make-obsolete) |
| 89 | (defalias 'erc-make-obsolete-variable 'make-obsolete-variable) | 89 | (defalias 'erc-make-obsolete-variable 'make-obsolete-variable) |
| 90 | 90 | ||
| 91 | ;; Provde an equivalent of `assert', based on the code from cl-macs.el | ||
| 92 | (defun erc-const-expr-p (x) | ||
| 93 | (cond ((consp x) | ||
| 94 | (or (eq (car x) 'quote) | ||
| 95 | (and (memq (car x) '(function function*)) | ||
| 96 | (or (symbolp (nth 1 x)) | ||
| 97 | (and (eq (and (consp (nth 1 x)) | ||
| 98 | (car (nth 1 x))) 'lambda) 'func))))) | ||
| 99 | ((symbolp x) (and (memq x '(nil t)) t)) | ||
| 100 | (t t))) | ||
| 101 | |||
| 102 | (put 'erc-assertion-failed 'error-conditions '(error)) | ||
| 103 | (put 'erc-assertion-failed 'error-message "Assertion failed") | ||
| 104 | |||
| 105 | (defun erc-list* (arg &rest rest) | ||
| 106 | "Return a new list with specified args as elements, cons'd to last arg. | ||
| 107 | Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to | ||
| 108 | `(cons A (cons B (cons C D)))'." | ||
| 109 | (cond ((not rest) arg) | ||
| 110 | ((not (cdr rest)) (cons arg (car rest))) | ||
| 111 | (t (let* ((n (length rest)) | ||
| 112 | (copy (copy-sequence rest)) | ||
| 113 | (last (nthcdr (- n 2) copy))) | ||
| 114 | (setcdr last (car (cdr last))) | ||
| 115 | (cons arg copy))))) | ||
| 116 | |||
| 117 | (defmacro erc-assert (form &optional show-args string &rest args) | ||
| 118 | "Verify that FORM returns non-nil; signal an error if not. | ||
| 119 | Second arg SHOW-ARGS means to include arguments of FORM in message. | ||
| 120 | Other args STRING and ARGS... are arguments to be passed to `error'. | ||
| 121 | They are not evaluated unless the assertion fails. If STRING is | ||
| 122 | omitted, a default message listing FORM itself is used." | ||
| 123 | (let ((sargs | ||
| 124 | (and show-args | ||
| 125 | (delq nil (mapcar | ||
| 126 | (function | ||
| 127 | (lambda (x) | ||
| 128 | (and (not (erc-const-expr-p x)) x))) | ||
| 129 | (cdr form)))))) | ||
| 130 | (list 'progn | ||
| 131 | (list 'or form | ||
| 132 | (if string | ||
| 133 | (erc-list* 'error string (append sargs args)) | ||
| 134 | (list 'signal '(quote erc-assertion-failed) | ||
| 135 | (erc-list* 'list (list 'quote form) sargs)))) | ||
| 136 | nil))) | ||
| 137 | |||
| 138 | ;; Provide a simpler replacement for `member-if' | 91 | ;; Provide a simpler replacement for `member-if' |
| 139 | (defun erc-member-if (predicate list) | 92 | (defun erc-member-if (predicate list) |
| 140 | "Find the first item satisfying PREDICATE in LIST. | 93 | "Find the first item satisfying PREDICATE in LIST. |
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 8158c0999d3..2aca06479f6 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el | |||
| @@ -60,6 +60,12 @@ | |||
| 60 | (require 'cl) | 60 | (require 'cl) |
| 61 | (require 'pcomplete)) | 61 | (require 'pcomplete)) |
| 62 | 62 | ||
| 63 | ;;;###autoload (autoload 'erc-dcc-mode "erc-dcc") | ||
| 64 | (define-erc-module dcc nil | ||
| 65 | "Provide Direct Client-to-Client support for ERC." | ||
| 66 | ((add-hook 'erc-server-401-functions 'erc-dcc-no-such-nick)) | ||
| 67 | ((remove-hook 'erc-server-401-functions 'erc-dcc-no-such-nick))) | ||
| 68 | |||
| 63 | (defgroup erc-dcc nil | 69 | (defgroup erc-dcc nil |
| 64 | "DCC stands for Direct Client Communication, where you and your | 70 | "DCC stands for Direct Client Communication, where you and your |
| 65 | friend's client programs connect directly to each other, | 71 | friend's client programs connect directly to each other, |
| @@ -70,7 +76,7 @@ Using DCC get and send, you can transfer files directly from and to other | |||
| 70 | IRC users." | 76 | IRC users." |
| 71 | :group 'erc) | 77 | :group 'erc) |
| 72 | 78 | ||
| 73 | (defcustom erc-verbose-dcc t | 79 | (defcustom erc-dcc-verbose nil |
| 74 | "*If non-nil, be verbose about DCC activity reporting." | 80 | "*If non-nil, be verbose about DCC activity reporting." |
| 75 | :group 'erc-dcc | 81 | :group 'erc-dcc |
| 76 | :type 'boolean) | 82 | :type 'boolean) |
| @@ -195,20 +201,22 @@ compared with `erc-nick-equal-p' which is IRC case-insensitive." | |||
| 195 | (setq list (cdr list))))) | 201 | (setq list (cdr list))))) |
| 196 | result)) | 202 | result)) |
| 197 | 203 | ||
| 198 | ;; msa wrote this nifty little frob to convert an n-byte integer to a packed | 204 | (defun erc-pack-int (value) |
| 199 | ;; string. | 205 | "Convert an integer into a packed string." |
| 200 | (defun erc-pack-int (value count) | 206 | (let* ((len (ceiling (/ value 256.0))) |
| 201 | (if (> count 0) | 207 | (str (make-string len ?a)) |
| 202 | (concat (erc-pack-int (/ value 256) (1- count)) | 208 | (i (1- len))) |
| 203 | (char-to-string (% value 256))) | 209 | (while (>= i 0) |
| 204 | "")) | 210 | (aset str i (% value 256)) |
| 211 | (setq value (/ value 256)) | ||
| 212 | (setq i (1- i))) | ||
| 213 | str)) | ||
| 205 | 214 | ||
| 206 | (defun erc-unpack-int (str) | 215 | (defun erc-unpack-int (str) |
| 207 | "Unpack a 1-4 character packed string into an integer." | 216 | "Unpack a packed string into an integer." |
| 208 | (let ((len (length str)) | 217 | (let ((len (length str)) |
| 209 | (num 0) | 218 | (num 0) |
| 210 | (count 0)) | 219 | (count 0)) |
| 211 | (erc-assert (<= len 4)) ;; this isn't going to fit in elisp bounds | ||
| 212 | (while (< count len) | 220 | (while (< count len) |
| 213 | (setq num (+ num (lsh (aref str (- len count 1)) (* 8 count)))) | 221 | (setq num (+ num (lsh (aref str (- len count 1)) (* 8 count)))) |
| 214 | (setq count (1+ count))) | 222 | (setq count (1+ count))) |
| @@ -256,15 +264,24 @@ The result is also a string." | |||
| 256 | 264 | ||
| 257 | ;;; Server code | 265 | ;;; Server code |
| 258 | 266 | ||
| 259 | (defcustom erc-dcc-host nil | 267 | (defcustom erc-dcc-listen-host nil |
| 260 | "*IP address to use for outgoing DCC offers. | 268 | "IP address to listen on when offering files. |
| 261 | Should be set to a string or nil, if nil, automatic detection of the | 269 | Should be set to a string or nil. If nil, automatic detection of |
| 262 | host interface to use will be attempted." | 270 | the host interface to use will be attempted." |
| 263 | :group 'erc-dcc | 271 | :group 'erc-dcc |
| 264 | :type (list 'choice (list 'const :tag "Auto-detect" nil) | 272 | :type (list 'choice (list 'const :tag "Auto-detect" nil) |
| 265 | (list 'string :tag "IP-address" | 273 | (list 'string :tag "IP-address" |
| 266 | :valid-regexp erc-dcc-ipv4-regexp))) | 274 | :valid-regexp erc-dcc-ipv4-regexp))) |
| 267 | 275 | ||
| 276 | (defcustom erc-dcc-public-host nil | ||
| 277 | "IP address to use for outgoing DCC offers. | ||
| 278 | Should be set to a string or nil. If nil, use the value of | ||
| 279 | `erc-dcc-listen-host'." | ||
| 280 | :group 'erc-dcc | ||
| 281 | :type (list 'choice (list 'const :tag "Same as erc-dcc-listen-host" nil) | ||
| 282 | (list 'string :tag "IP-address" | ||
| 283 | :valid-regexp erc-dcc-ipv4-regexp))) | ||
| 284 | |||
| 268 | (defcustom erc-dcc-send-request 'ask | 285 | (defcustom erc-dcc-send-request 'ask |
| 269 | "*How to treat incoming DCC Send requests. | 286 | "*How to treat incoming DCC Send requests. |
| 270 | 'ask - Report the Send request, and wait for the user to manually accept it | 287 | 'ask - Report the Send request, and wait for the user to manually accept it |
| @@ -282,7 +299,7 @@ host interface to use will be attempted." | |||
| 282 | "Determine the IP address we are using. | 299 | "Determine the IP address we are using. |
| 283 | If variable `erc-dcc-host' is non-nil, use it. Otherwise call | 300 | If variable `erc-dcc-host' is non-nil, use it. Otherwise call |
| 284 | `erc-dcc-get-host' on the erc-server-process." | 301 | `erc-dcc-get-host' on the erc-server-process." |
| 285 | (or erc-dcc-host (erc-dcc-get-host erc-server-process) | 302 | (or erc-dcc-listen-host (erc-dcc-get-host erc-server-process) |
| 286 | (error "Unable to determine local address"))) | 303 | (error "Unable to determine local address"))) |
| 287 | 304 | ||
| 288 | (defcustom erc-dcc-port-range nil | 305 | (defcustom erc-dcc-port-range nil |
| @@ -311,6 +328,7 @@ created subprocess, or nil." | |||
| 311 | process) | 328 | process) |
| 312 | (while (not process) | 329 | (while (not process) |
| 313 | (condition-case err | 330 | (condition-case err |
| 331 | (progn | ||
| 314 | (setq process | 332 | (setq process |
| 315 | (make-network-process :name name | 333 | (make-network-process :name name |
| 316 | :buffer nil | 334 | :buffer nil |
| @@ -322,6 +340,11 @@ created subprocess, or nil." | |||
| 322 | :sentinel sentinel | 340 | :sentinel sentinel |
| 323 | :log #'erc-dcc-server-accept | 341 | :log #'erc-dcc-server-accept |
| 324 | :server t)) | 342 | :server t)) |
| 343 | (when (processp process) | ||
| 344 | (when (fboundp 'set-process-coding-system) | ||
| 345 | (set-process-coding-system process 'binary 'binary)) | ||
| 346 | (when (fboundp 'set-process-filter-multibyte) | ||
| 347 | (set-process-filter-multibyte process nil)))) | ||
| 325 | (file-error | 348 | (file-error |
| 326 | (unless (and (string= "Cannot bind server socket" (cadr err)) | 349 | (unless (and (string= "Cannot bind server socket" (cadr err)) |
| 327 | (string= "address already in use" (caddr err))) | 350 | (string= "address already in use" (caddr err))) |
| @@ -698,7 +721,7 @@ bytes sent." | |||
| 698 | (confirmed-marker (plist-get elt :sent)) | 721 | (confirmed-marker (plist-get elt :sent)) |
| 699 | (sent-marker (plist-get elt :sent))) | 722 | (sent-marker (plist-get elt :sent))) |
| 700 | (with-current-buffer (process-buffer proc) | 723 | (with-current-buffer (process-buffer proc) |
| 701 | (when erc-verbose-dcc | 724 | (when erc-dcc-verbose |
| 702 | (erc-display-message | 725 | (erc-display-message |
| 703 | nil 'notice (erc-dcc-get-parent proc) | 726 | nil 'notice (erc-dcc-get-parent proc) |
| 704 | (format "DCC: Confirmed %d, sent %d, sending block now" | 727 | (format "DCC: Confirmed %d, sent %d, sending block now" |
| @@ -713,8 +736,7 @@ bytes sent." | |||
| 713 | (length string))))) | 736 | (length string))))) |
| 714 | 737 | ||
| 715 | (defun erc-dcc-send-filter (proc string) | 738 | (defun erc-dcc-send-filter (proc string) |
| 716 | (erc-assert (= (% (length string) 4) 0)) | 739 | (let* ((size (erc-unpack-int string)) |
| 717 | (let* ((size (erc-unpack-int (substring string (- (length string) 4)))) | ||
| 718 | (elt (erc-dcc-member :peer proc)) | 740 | (elt (erc-dcc-member :peer proc)) |
| 719 | (parent (plist-get elt :parent)) | 741 | (parent (plist-get elt :parent)) |
| 720 | (sent-marker (plist-get elt :sent)) | 742 | (sent-marker (plist-get elt :sent)) |
| @@ -742,16 +764,21 @@ bytes sent." | |||
| 742 | ((> confirmed-marker sent-marker) | 764 | ((> confirmed-marker sent-marker) |
| 743 | (erc-display-message | 765 | (erc-display-message |
| 744 | nil 'notice parent | 766 | nil 'notice parent |
| 745 | (format "DCC: Client confirmed too much!")) | 767 | (format "DCC: Client confirmed too much (%s vs %s)!" |
| 768 | (marker-position confirmed-marker) | ||
| 769 | (marker-position sent-marker))) | ||
| 770 | (set-buffer-modified-p nil) | ||
| 771 | (kill-buffer (current-buffer)) | ||
| 746 | (delete-process proc)))))) | 772 | (delete-process proc)))))) |
| 747 | 773 | ||
| 774 | (defun erc-dcc-display-send (proc) | ||
| 775 | (erc-display-message | ||
| 776 | nil 'notice (erc-dcc-get-parent proc) | ||
| 777 | (format "DCC: SEND connect from %s" | ||
| 778 | (format-network-address (process-contact proc :remote))))) | ||
| 779 | |||
| 748 | (defcustom erc-dcc-send-connect-hook | 780 | (defcustom erc-dcc-send-connect-hook |
| 749 | '((lambda (proc) | 781 | '(erc-dcc-display-send erc-dcc-send-block) |
| 750 | (erc-display-message | ||
| 751 | nil 'notice (erc-dcc-get-parent proc) | ||
| 752 | (format "DCC: SEND connect from %s" | ||
| 753 | (format-network-address (process-contact proc :remote))))) | ||
| 754 | erc-dcc-send-block) | ||
| 755 | "*Hook run whenever the remote end of a DCC SEND offer connected to your | 782 | "*Hook run whenever the remote end of a DCC SEND offer connected to your |
| 756 | listening port." | 783 | listening port." |
| 757 | :group 'erc-dcc | 784 | :group 'erc-dcc |
| @@ -762,14 +789,14 @@ listening port." | |||
| 762 | (erc-extract-nick (plist-get plist :nick))) | 789 | (erc-extract-nick (plist-get plist :nick))) |
| 763 | 790 | ||
| 764 | (defun erc-dcc-send-sentinel (proc event) | 791 | (defun erc-dcc-send-sentinel (proc event) |
| 765 | (let* ((elt (erc-dcc-member :peer proc)) | 792 | (let* ((elt (erc-dcc-member :peer proc))) |
| 766 | (buf (marker-buffer (plist-get elt :sent)))) | ||
| 767 | (cond | 793 | (cond |
| 768 | ((string-match "^open from " event) | 794 | ((string-match "^open from " event) |
| 769 | (when elt | 795 | (when elt |
| 770 | (with-current-buffer buf | 796 | (let ((buf (marker-buffer (plist-get elt :sent)))) |
| 771 | (set-process-buffer proc buf) | 797 | (with-current-buffer buf |
| 772 | (setq erc-dcc-entry-data elt)) | 798 | (set-process-buffer proc buf) |
| 799 | (setq erc-dcc-entry-data elt))) | ||
| 773 | (run-hook-with-args 'erc-dcc-send-connect-hook proc)))))) | 800 | (run-hook-with-args 'erc-dcc-send-connect-hook proc)))))) |
| 774 | 801 | ||
| 775 | (defun erc-dcc-find-file (file) | 802 | (defun erc-dcc-find-file (file) |
| @@ -807,15 +834,23 @@ other client." | |||
| 807 | (process-send-string | 834 | (process-send-string |
| 808 | pproc (format "PRIVMSG %s :\C-aDCC SEND %s %s %d %d\C-a\n" | 835 | pproc (format "PRIVMSG %s :\C-aDCC SEND %s %s %d %d\C-a\n" |
| 809 | nick (erc-dcc-file-to-name file) | 836 | nick (erc-dcc-file-to-name file) |
| 810 | (erc-ip-to-decimal (nth 0 contact)) | 837 | (erc-ip-to-decimal (or erc-dcc-public-host |
| 838 | (nth 0 contact))) | ||
| 811 | (nth 1 contact) | 839 | (nth 1 contact) |
| 812 | size))) | 840 | size))) |
| 813 | (error "`make-network-process' not supported by your Emacs"))) | 841 | (error "`make-network-process' not supported by your Emacs"))) |
| 814 | 842 | ||
| 815 | ;;; GET handling | 843 | ;;; GET handling |
| 816 | 844 | ||
| 845 | (defcustom erc-dcc-receive-cache (* 1024 512) | ||
| 846 | "Number of bytes to let the receive buffer grow before flushing it." | ||
| 847 | :group 'erc-dcc | ||
| 848 | :type 'integer) | ||
| 849 | |||
| 817 | (defvar erc-dcc-byte-count nil) | 850 | (defvar erc-dcc-byte-count nil) |
| 818 | (make-variable-buffer-local 'erc-dcc-byte-count) | 851 | (make-variable-buffer-local 'erc-dcc-byte-count) |
| 852 | (defvar erc-dcc-file-name nil) | ||
| 853 | (make-variable-buffer-local 'erc-dcc-file-name) | ||
| 819 | 854 | ||
| 820 | (defun erc-dcc-get-file (entry file parent-proc) | 855 | (defun erc-dcc-get-file (entry file parent-proc) |
| 821 | "This function does the work of setting up a transfer from the remote client | 856 | "This function does the work of setting up a transfer from the remote client |
| @@ -825,6 +860,7 @@ filter and a process sentinel, and making the connection." | |||
| 825 | proc) | 860 | proc) |
| 826 | (with-current-buffer buffer | 861 | (with-current-buffer buffer |
| 827 | (fundamental-mode) | 862 | (fundamental-mode) |
| 863 | (buffer-disable-undo (current-buffer)) | ||
| 828 | ;; This is necessary to have the buffer saved as-is in GNU | 864 | ;; This is necessary to have the buffer saved as-is in GNU |
| 829 | ;; Emacs. | 865 | ;; Emacs. |
| 830 | ;; XEmacs change: We don't have `set-buffer-multibyte', setting | 866 | ;; XEmacs change: We don't have `set-buffer-multibyte', setting |
| @@ -835,7 +871,10 @@ filter and a process sentinel, and making the connection." | |||
| 835 | (setq mode-line-process '(":%s") | 871 | (setq mode-line-process '(":%s") |
| 836 | buffer-file-type t | 872 | buffer-file-type t |
| 837 | buffer-read-only t) | 873 | buffer-read-only t) |
| 838 | (set-visited-file-name file) | 874 | (setq erc-dcc-file-name file) |
| 875 | |||
| 876 | ;; Truncate the given file to size 0 before appending to it. | ||
| 877 | (write-region (point) (point) erc-dcc-file-name nil 'nomessage) | ||
| 839 | 878 | ||
| 840 | (setq erc-server-process parent-proc | 879 | (setq erc-server-process parent-proc |
| 841 | erc-dcc-entry-data entry) | 880 | erc-dcc-entry-data entry) |
| @@ -847,7 +886,6 @@ filter and a process sentinel, and making the connection." | |||
| 847 | (string-to-number (plist-get entry :port)) | 886 | (string-to-number (plist-get entry :port)) |
| 848 | entry)) | 887 | entry)) |
| 849 | (set-process-buffer proc buffer) | 888 | (set-process-buffer proc buffer) |
| 850 | ;; The following two lines make saving as-is work under Windows | ||
| 851 | (set-process-coding-system proc 'binary 'binary) | 889 | (set-process-coding-system proc 'binary 'binary) |
| 852 | (set-buffer-file-coding-system 'binary t) | 890 | (set-buffer-file-coding-system 'binary t) |
| 853 | 891 | ||
| @@ -856,6 +894,14 @@ filter and a process sentinel, and making the connection." | |||
| 856 | (setq entry (plist-put entry :start-time (erc-current-time))) | 894 | (setq entry (plist-put entry :start-time (erc-current-time))) |
| 857 | (setq entry (plist-put entry :peer proc))))) | 895 | (setq entry (plist-put entry :peer proc))))) |
| 858 | 896 | ||
| 897 | (defun erc-dcc-append-contents (buffer file) | ||
| 898 | "Append the contents of BUFFER to FILE. | ||
| 899 | The contents of the BUFFER will then be erased." | ||
| 900 | (with-current-buffer buffer | ||
| 901 | (let ((coding-system-for-write 'binary)) | ||
| 902 | (write-region (point-min) (point-max) erc-dcc-file-name t 'nomessage) | ||
| 903 | (erase-buffer)))) | ||
| 904 | |||
| 859 | (defun erc-dcc-get-filter (proc str) | 905 | (defun erc-dcc-get-filter (proc str) |
| 860 | "This is the process filter for transfers from other clients to this one. | 906 | "This is the process filter for transfers from other clients to this one. |
| 861 | It reads incoming bytes from the network and stores them in the DCC | 907 | It reads incoming bytes from the network and stores them in the DCC |
| @@ -868,8 +914,10 @@ rather than every 1024 byte block, but nobody seems to care." | |||
| 868 | (insert (string-make-unibyte str)) | 914 | (insert (string-make-unibyte str)) |
| 869 | 915 | ||
| 870 | (setq erc-dcc-byte-count (+ (length str) erc-dcc-byte-count)) | 916 | (setq erc-dcc-byte-count (+ (length str) erc-dcc-byte-count)) |
| 871 | (erc-assert (= erc-dcc-byte-count (1- (point-max)))) | 917 | (when (> (point-max) erc-dcc-receive-cache) |
| 872 | (and erc-verbose-dcc | 918 | (erc-dcc-append-contents (current-buffer) erc-dcc-file-name)) |
| 919 | |||
| 920 | (and erc-dcc-verbose | ||
| 873 | (erc-display-message | 921 | (erc-display-message |
| 874 | nil 'notice erc-server-process | 922 | nil 'notice erc-server-process |
| 875 | 'dcc-get-bytes-received | 923 | 'dcc-get-bytes-received |
| @@ -885,7 +933,7 @@ rather than every 1024 byte block, but nobody seems to care." | |||
| 885 | (delete-process proc)) | 933 | (delete-process proc)) |
| 886 | (t | 934 | (t |
| 887 | (process-send-string | 935 | (process-send-string |
| 888 | proc (erc-pack-int erc-dcc-byte-count 4))))))) | 936 | proc (erc-pack-int erc-dcc-byte-count))))))) |
| 889 | 937 | ||
| 890 | 938 | ||
| 891 | (defun erc-dcc-get-sentinel (proc event) | 939 | (defun erc-dcc-get-sentinel (proc event) |
| @@ -895,17 +943,18 @@ transfer is complete." | |||
| 895 | ;; FIXME, we should look at EVENT, and also check size. | 943 | ;; FIXME, we should look at EVENT, and also check size. |
| 896 | (with-current-buffer (process-buffer proc) | 944 | (with-current-buffer (process-buffer proc) |
| 897 | (delete-process proc) | 945 | (delete-process proc) |
| 898 | (setq buffer-read-only nil) | ||
| 899 | (setq erc-dcc-list (delete erc-dcc-entry-data erc-dcc-list)) | 946 | (setq erc-dcc-list (delete erc-dcc-entry-data erc-dcc-list)) |
| 947 | (unless (= (point-min) (point-max)) | ||
| 948 | (setq erc-dcc-byte-count (+ (buffer-size) erc-dcc-byte-count)) | ||
| 949 | (erc-dcc-append-contents (current-buffer) erc-dcc-file-name)) | ||
| 900 | (erc-display-message | 950 | (erc-display-message |
| 901 | nil 'notice erc-server-process | 951 | nil 'notice erc-server-process |
| 902 | 'dcc-get-complete | 952 | 'dcc-get-complete |
| 903 | ?f (file-name-nondirectory buffer-file-name) | 953 | ?f erc-dcc-file-name |
| 904 | ?s (number-to-string (buffer-size)) | 954 | ?s (number-to-string erc-dcc-byte-count) |
| 905 | ?t (format "%.0f" | 955 | ?t (format "%.0f" |
| 906 | (erc-time-diff (plist-get erc-dcc-entry-data :start-time) | 956 | (erc-time-diff (plist-get erc-dcc-entry-data :start-time) |
| 907 | (erc-current-time)))) | 957 | (erc-current-time))))) |
| 908 | (save-buffer)) | ||
| 909 | (kill-buffer (process-buffer proc)) | 958 | (kill-buffer (process-buffer proc)) |
| 910 | (delete-process proc)) | 959 | (delete-process proc)) |
| 911 | 960 | ||
| @@ -1126,8 +1175,6 @@ other client." | |||
| 1126 | (if (processp peer) (delete-process peer))) | 1175 | (if (processp peer) (delete-process peer))) |
| 1127 | nil)) | 1176 | nil)) |
| 1128 | 1177 | ||
| 1129 | (add-hook 'erc-server-401-functions 'erc-dcc-no-such-nick) | ||
| 1130 | |||
| 1131 | (provide 'erc-dcc) | 1178 | (provide 'erc-dcc) |
| 1132 | 1179 | ||
| 1133 | ;;; erc-dcc.el ends here | 1180 | ;;; erc-dcc.el ends here |
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 9612b001156..ff065467f84 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el | |||
| @@ -33,10 +33,14 @@ | |||
| 33 | 33 | ||
| 34 | (require 'erc) | 34 | (require 'erc) |
| 35 | 35 | ||
| 36 | ;; Imenu Autoload | 36 | ;;; Imenu support |
| 37 | (add-hook 'erc-mode-hook | 37 | |
| 38 | (lambda () | 38 | (defun erc-imenu-setup () |
| 39 | (setq imenu-create-index-function 'erc-create-imenu-index))) | 39 | "Setup Imenu support in an ERC buffer." |
| 40 | (set (make-local-variable 'imenu-create-index-function) | ||
| 41 | 'erc-create-imenu-index)) | ||
| 42 | |||
| 43 | (add-hook 'erc-mode-hook 'erc-imenu-setup) | ||
| 40 | (autoload 'erc-create-imenu-index "erc-imenu" "Imenu index creation function") | 44 | (autoload 'erc-create-imenu-index "erc-imenu" "Imenu index creation function") |
| 41 | 45 | ||
| 42 | ;;; Automatically scroll to bottom | 46 | ;;; Automatically scroll to bottom |
| @@ -51,11 +55,15 @@ argument to `recenter'." | |||
| 51 | :type '(choice integer (const nil))) | 55 | :type '(choice integer (const nil))) |
| 52 | 56 | ||
| 53 | (define-erc-module scrolltobottom nil | 57 | (define-erc-module scrolltobottom nil |
| 54 | "This mode causes the prompt to stay at the end of the window. | 58 | "This mode causes the prompt to stay at the end of the window." |
| 55 | You have to activate or deactivate it in already created windows | 59 | ((add-hook 'erc-mode-hook 'erc-add-scroll-to-bottom) |
| 56 | separately." | 60 | (dolist (buffer (erc-buffer-list)) |
| 57 | ((add-hook 'erc-mode-hook 'erc-add-scroll-to-bottom)) | 61 | (with-current-buffer buffer |
| 58 | ((remove-hook 'erc-mode-hook 'erc-add-scroll-to-bottom))) | 62 | (erc-add-scroll-to-bottom)))) |
| 63 | ((remove-hook 'erc-mode-hook 'erc-add-scroll-to-bottom) | ||
| 64 | (dolist (buffer (erc-buffer-list)) | ||
| 65 | (with-current-buffer buffer | ||
| 66 | (remove-hook 'window-scroll-functions 'erc-scroll-to-bottom t))))) | ||
| 59 | 67 | ||
| 60 | (defun erc-add-scroll-to-bottom () | 68 | (defun erc-add-scroll-to-bottom () |
| 61 | "A hook function for `erc-mode-hook' to recenter output at bottom of window. | 69 | "A hook function for `erc-mode-hook' to recenter output at bottom of window. |
| @@ -110,7 +118,46 @@ Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'." | |||
| 110 | (put-text-property (point-min) (point-max) 'front-sticky t) | 118 | (put-text-property (point-min) (point-max) 'front-sticky t) |
| 111 | (put-text-property (point-min) (point-max) 'rear-nonsticky t)) | 119 | (put-text-property (point-min) (point-max) 'rear-nonsticky t)) |
| 112 | 120 | ||
| 113 | ;; Distinguish non-commands | 121 | ;;; Move to prompt when typing text |
| 122 | (define-erc-module move-to-prompt nil | ||
| 123 | "This mode causes the point to be moved to the prompt when typing text." | ||
| 124 | ((add-hook 'erc-mode-hook 'erc-move-to-prompt-setup) | ||
| 125 | (dolist (buffer (erc-buffer-list)) | ||
| 126 | (with-current-buffer buffer | ||
| 127 | (erc-move-to-prompt-setup)))) | ||
| 128 | ((remove-hook 'erc-mode-hook 'erc-move-to-prompt-setup) | ||
| 129 | (dolist (buffer (erc-buffer-list)) | ||
| 130 | (with-current-buffer buffer | ||
| 131 | (remove-hook 'pre-command-hook 'erc-move-to-prompt t))))) | ||
| 132 | |||
| 133 | (defun erc-move-to-prompt () | ||
| 134 | "Move the point to the ERC prompt if this is a self-inserting command." | ||
| 135 | (when (and erc-input-marker (< (point) erc-input-marker) | ||
| 136 | (eq 'self-insert-command this-command)) | ||
| 137 | (deactivate-mark) | ||
| 138 | (push-mark) | ||
| 139 | (goto-char (point-max)))) | ||
| 140 | |||
| 141 | (defun erc-move-to-prompt-setup () | ||
| 142 | "Initialize the move-to-prompt module for XEmacs." | ||
| 143 | (add-hook 'pre-command-hook 'erc-move-to-prompt nil t)) | ||
| 144 | |||
| 145 | ;;; Keep place in unvisited channels | ||
| 146 | (define-erc-module keep-place nil | ||
| 147 | "Leave point above un-viewed text in other channels." | ||
| 148 | ((add-hook 'erc-insert-pre-hook 'erc-keep-place)) | ||
| 149 | ((remove-hook 'erc-insert-pre-hook 'erc-keep-place))) | ||
| 150 | |||
| 151 | (defun erc-keep-place (ignored) | ||
| 152 | "Move point away from the last line in a non-selected ERC buffer." | ||
| 153 | (when (and (not (eq (window-buffer (selected-window)) | ||
| 154 | (current-buffer))) | ||
| 155 | (>= (point) erc-insert-marker)) | ||
| 156 | (deactivate-mark) | ||
| 157 | (goto-char (erc-beg-of-input-line)) | ||
| 158 | (forward-line -1))) | ||
| 159 | |||
| 160 | ;;; Distinguish non-commands | ||
| 114 | (defvar erc-noncommands-list '(erc-cmd-ME | 161 | (defvar erc-noncommands-list '(erc-cmd-ME |
| 115 | erc-cmd-COUNTRY | 162 | erc-cmd-COUNTRY |
| 116 | erc-cmd-SV | 163 | erc-cmd-SV |
| @@ -496,8 +543,19 @@ channel that has weird people talking in morse to each other. | |||
| 496 | 543 | ||
| 497 | See also `unmorse-region'." | 544 | See also `unmorse-region'." |
| 498 | (goto-char (point-min)) | 545 | (goto-char (point-min)) |
| 499 | (when (re-search-forward "[.-]+\\([.-]+[/ ]\\)+[.-]+" nil t) | 546 | (when (re-search-forward "[.-]+\\([.-]*/? *\\)+[.-]+/?" nil t) |
| 500 | (unmorse-region (match-beginning 0) (match-end 0)))) | 547 | (save-restriction |
| 548 | (narrow-to-region (match-beginning 0) (match-end 0)) | ||
| 549 | ;; Turn " / " into " " | ||
| 550 | (goto-char (point-min)) | ||
| 551 | (while (re-search-forward " / " nil t) | ||
| 552 | (replace-match " ")) | ||
| 553 | ;; Turn "/ " into "/" | ||
| 554 | (goto-char (point-min)) | ||
| 555 | (while (re-search-forward "/ " nil t) | ||
| 556 | (replace-match "/")) | ||
| 557 | ;; Unmorse region | ||
| 558 | (unmorse-region (point-min) (point-max))))) | ||
| 501 | 559 | ||
| 502 | ;;; erc-occur | 560 | ;;; erc-occur |
| 503 | (defun erc-occur (string &optional proc) | 561 | (defun erc-occur (string &optional proc) |
diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el new file mode 100644 index 00000000000..586c720dd19 --- /dev/null +++ b/lisp/erc/erc-list.el | |||
| @@ -0,0 +1,229 @@ | |||
| 1 | ;;; erc-list.el --- /list support for ERC | ||
| 2 | |||
| 3 | ;; Copyright (C) 2008 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Tom Tromey <tromey@redhat.com> | ||
| 6 | ;; Version: 0.1 | ||
| 7 | ;; Keywords: comm | ||
| 8 | |||
| 9 | ;; This file is part of ERC. | ||
| 10 | |||
| 11 | ;; ERC is free software; you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation; either version 3, or (at your option) | ||
| 14 | ;; any later version. | ||
| 15 | |||
| 16 | ;; ERC is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with ERC; see the file COPYING. If not, write to the | ||
| 23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | ||
| 24 | ;; Boston, MA 02110-1301, USA. | ||
| 25 | |||
| 26 | ;;; Commentary: | ||
| 27 | |||
| 28 | ;; This file provides nice support for /list in ERC. | ||
| 29 | |||
| 30 | ;;; Code: | ||
| 31 | |||
| 32 | (require 'erc) | ||
| 33 | |||
| 34 | ;; This is implicitly the width of the channel name column. Pick | ||
| 35 | ;; something small enough that the topic has a chance of being | ||
| 36 | ;; readable, but long enough that most channel names won't make for | ||
| 37 | ;; strange formatting. | ||
| 38 | (defconst erc-list-nusers-column 25) | ||
| 39 | |||
| 40 | ;; Width of the number-of-users column. | ||
| 41 | (defconst erc-list-topic-column (+ erc-list-nusers-column 10)) | ||
| 42 | |||
| 43 | ;; The list buffer. This is buffer local in the server buffer. | ||
| 44 | (defvar erc-list-buffer nil) | ||
| 45 | |||
| 46 | ;; The argument to the last "/list". This is buffer local in the | ||
| 47 | ;; server buffer. | ||
| 48 | (defvar erc-list-last-argument nil) | ||
| 49 | |||
| 50 | ;; The server buffer corresponding to the list buffer. This is buffer | ||
| 51 | ;; local in the list buffer. | ||
| 52 | (defvar erc-list-server-buffer nil) | ||
| 53 | |||
| 54 | ;; Define module: | ||
| 55 | ;;;###autoload (autoload 'erc-list-mode "erc-list") | ||
| 56 | (define-erc-module list nil | ||
| 57 | "List channels nicely in a separate buffer." | ||
| 58 | ((remove-hook 'erc-server-321-functions 'erc-server-321-message) | ||
| 59 | (remove-hook 'erc-server-322-functions 'erc-server-322-message)) | ||
| 60 | ((erc-with-all-buffers-of-server nil | ||
| 61 | #'erc-open-server-buffer-p | ||
| 62 | (remove-hook 'erc-server-322-functions 'erc-list-handle-322 t)) | ||
| 63 | (add-hook 'erc-server-321-functions 'erc-server-321-message t) | ||
| 64 | (add-hook 'erc-server-322-functions 'erc-server-322-message t))) | ||
| 65 | |||
| 66 | ;; Format a record for display. | ||
| 67 | (defun erc-list-make-string (channel users topic) | ||
| 68 | (concat | ||
| 69 | channel | ||
| 70 | (erc-propertize " " | ||
| 71 | 'display (list 'space :align-to erc-list-nusers-column) | ||
| 72 | 'face 'fixed-pitch) | ||
| 73 | users | ||
| 74 | (erc-propertize " " | ||
| 75 | 'display (list 'space :align-to erc-list-topic-column) | ||
| 76 | 'face 'fixed-pitch) | ||
| 77 | topic)) | ||
| 78 | |||
| 79 | ;; Insert a record into the list buffer. | ||
| 80 | (defun erc-list-insert-item (channel users topic) | ||
| 81 | (save-excursion | ||
| 82 | (let ((buffer-read-only nil)) | ||
| 83 | (goto-char (point-max)) | ||
| 84 | (insert (erc-list-make-string channel users topic) "\n")))) | ||
| 85 | |||
| 86 | (defun erc-list-join () | ||
| 87 | "Join the irc channel named on this line." | ||
| 88 | (interactive) | ||
| 89 | (unless (eobp) | ||
| 90 | (beginning-of-line) | ||
| 91 | (unless (looking-at "\\([&#+!][^ \n]+\\)") | ||
| 92 | (error "Not looking at channel name?")) | ||
| 93 | (let ((chan (match-string 1))) | ||
| 94 | (with-current-buffer erc-list-server-buffer | ||
| 95 | (erc-join-channel chan))))) | ||
| 96 | |||
| 97 | (defun erc-list-kill () | ||
| 98 | "Kill the current ERC list buffer." | ||
| 99 | (interactive) | ||
| 100 | (kill-buffer (current-buffer))) | ||
| 101 | |||
| 102 | (defun erc-list-revert () | ||
| 103 | "Refresh the list of channels." | ||
| 104 | (interactive) | ||
| 105 | (with-current-buffer erc-list-server-buffer | ||
| 106 | (erc-cmd-LIST erc-list-last-argument))) | ||
| 107 | |||
| 108 | (defun erc-list-menu-sort-by-column (&optional e) | ||
| 109 | "Sort the channel list by the column clicked on." | ||
| 110 | (interactive (list last-input-event)) | ||
| 111 | (if e (mouse-select-window e)) | ||
| 112 | (let* ((pos (event-start e)) | ||
| 113 | (obj (posn-object pos)) | ||
| 114 | (col (if obj | ||
| 115 | (get-text-property (cdr obj) 'column-number (car obj)) | ||
| 116 | (get-text-property (posn-point pos) 'column-number)))) | ||
| 117 | (let ((buffer-read-only nil)) | ||
| 118 | (if (= col 1) | ||
| 119 | (sort-fields col (point-min) (point-max)) | ||
| 120 | (sort-numeric-fields col (point-min) (point-max)))))) | ||
| 121 | |||
| 122 | (defvar erc-list-menu-mode-map nil | ||
| 123 | "Local keymap for `erc-list-mode' buffers.") | ||
| 124 | |||
| 125 | (unless erc-list-menu-mode-map | ||
| 126 | (setq erc-list-menu-mode-map (make-keymap)) | ||
| 127 | (suppress-keymap erc-list-menu-mode-map) | ||
| 128 | (define-key erc-list-menu-mode-map "k" 'erc-list-kill) | ||
| 129 | (define-key erc-list-menu-mode-map "j" 'erc-list-join) | ||
| 130 | (define-key erc-list-menu-mode-map "g" 'erc-list-revert) | ||
| 131 | (define-key erc-list-menu-mode-map "n" 'next-line) | ||
| 132 | (define-key erc-list-menu-mode-map "p" 'previous-line) | ||
| 133 | (define-key erc-list-menu-mode-map "q" 'quit-window)) | ||
| 134 | |||
| 135 | (defvar erc-list-menu-sort-button-map nil | ||
| 136 | "Local keymap for ERC list menu mode sorting buttons.") | ||
| 137 | |||
| 138 | (unless erc-list-menu-sort-button-map | ||
| 139 | (let ((map (make-sparse-keymap))) | ||
| 140 | (define-key map [header-line mouse-1] 'erc-list-menu-sort-by-column) | ||
| 141 | (define-key map [follow-link] 'mouse-face) | ||
| 142 | (setq erc-list-menu-sort-button-map map))) | ||
| 143 | |||
| 144 | ;; Helper function that makes a buttonized column header. | ||
| 145 | (defun erc-list-button (title column) | ||
| 146 | (erc-propertize title | ||
| 147 | 'column-number column | ||
| 148 | 'help-echo "mouse-1: sort by column" | ||
| 149 | 'mouse-face 'highlight | ||
| 150 | 'keymap erc-list-menu-sort-button-map)) | ||
| 151 | |||
| 152 | (define-derived-mode erc-list-menu-mode nil "ERC-List" | ||
| 153 | "Major mode for editing a list of irc channels." | ||
| 154 | (setq header-line-format | ||
| 155 | (concat | ||
| 156 | (erc-propertize " " | ||
| 157 | 'display '(space :align-to 0) | ||
| 158 | 'face 'fixed-pitch) | ||
| 159 | (erc-list-make-string (erc-list-button "Channel" 1) | ||
| 160 | (erc-list-button "# Users" 2) | ||
| 161 | "Topic"))) | ||
| 162 | (setq truncate-lines t)) | ||
| 163 | |||
| 164 | (put 'erc-list-menu-mode 'mode-class 'special) | ||
| 165 | |||
| 166 | ;; Handle a "322" response. This response tells us about a single | ||
| 167 | ;; channel. | ||
| 168 | (defun erc-list-handle-322 (proc parsed) | ||
| 169 | (let* ((args (cdr (erc-response.command-args parsed))) | ||
| 170 | (channel (car args)) | ||
| 171 | (nusers (car (cdr args))) | ||
| 172 | (topic (erc-response.contents parsed))) | ||
| 173 | (when (buffer-live-p erc-list-buffer) | ||
| 174 | (with-current-buffer erc-list-buffer | ||
| 175 | (erc-list-insert-item channel nusers topic)))) | ||
| 176 | ;; Don't let another hook run. | ||
| 177 | t) | ||
| 178 | |||
| 179 | ;; Helper function to install our 322 handler and make our buffer. | ||
| 180 | (defun erc-list-install-322-handler (server-buffer) | ||
| 181 | (with-current-buffer server-buffer | ||
| 182 | ;; Arrange for 322 responses to insert into our buffer. | ||
| 183 | (add-hook 'erc-server-322-functions 'erc-list-handle-322 t t) | ||
| 184 | ;; Arrange for 323 (end of list) to end this. | ||
| 185 | (erc-once-with-server-event | ||
| 186 | 323 | ||
| 187 | '(progn | ||
| 188 | (remove-hook 'erc-server-322-functions 'erc-list-handle-322 t))) | ||
| 189 | ;; Find the list buffer, empty it, and display it. | ||
| 190 | (set (make-local-variable 'erc-list-buffer) | ||
| 191 | (get-buffer-create (concat "*Channels of " | ||
| 192 | erc-server-announced-name | ||
| 193 | "*"))) | ||
| 194 | (with-current-buffer erc-list-buffer | ||
| 195 | (erc-list-menu-mode) | ||
| 196 | (setq buffer-read-only nil) | ||
| 197 | (erase-buffer) | ||
| 198 | (set (make-local-variable 'erc-list-server-buffer) server-buffer) | ||
| 199 | (setq buffer-read-only t)) | ||
| 200 | (pop-to-buffer erc-list-buffer)) | ||
| 201 | t) | ||
| 202 | |||
| 203 | ;; The main entry point. | ||
| 204 | (defun erc-cmd-LIST (&optional line) | ||
| 205 | "Show a listing of channels on the current server in a separate window. | ||
| 206 | |||
| 207 | If LINE is specified, include it with the /LIST command. It | ||
| 208 | should usually be one or more channels, separated by commas. | ||
| 209 | |||
| 210 | Please note that this function only works with IRC servers which conform | ||
| 211 | to RFC and send the LIST header (#321) at start of list transmission." | ||
| 212 | (erc-with-server-buffer | ||
| 213 | (set (make-local-variable 'erc-list-last-argument) line) | ||
| 214 | (erc-once-with-server-event | ||
| 215 | 321 | ||
| 216 | (list 'progn | ||
| 217 | (list 'erc-list-install-322-handler (current-buffer))))) | ||
| 218 | (erc-server-send (concat "LIST :" (or (and line (substring line 1)) | ||
| 219 | "")))) | ||
| 220 | (put 'erc-cmd-LIST 'do-not-parse-args t) | ||
| 221 | |||
| 222 | ;;; erc-list.el ends here | ||
| 223 | ;; | ||
| 224 | ;; Local Variables: | ||
| 225 | ;; indent-tabs-mode: t | ||
| 226 | ;; tab-width: 8 | ||
| 227 | ;; End: | ||
| 228 | |||
| 229 | ;; arch-tag: 99c5f9cb-6bac-4224-86bf-e394768cd1d0 | ||
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 48efd41791f..b74fdb245a4 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el | |||
| @@ -28,9 +28,7 @@ | |||
| 28 | ;; | 28 | ;; |
| 29 | ;; Usage: | 29 | ;; Usage: |
| 30 | ;; | 30 | ;; |
| 31 | ;; Put into your .emacs: | 31 | ;; This is the "networks" module. |
| 32 | ;; | ||
| 33 | ;; (require 'erc-networks) | ||
| 34 | ;; | 32 | ;; |
| 35 | ;; M-x erc-server-select provides an alternative way to connect to servers by | 33 | ;; M-x erc-server-select provides an alternative way to connect to servers by |
| 36 | ;; choosing networks. | 34 | ;; choosing networks. |
| @@ -351,6 +349,7 @@ | |||
| 351 | ("Relicnet: Random server" Relicnet "irc.relic.net" 6667) | 349 | ("Relicnet: Random server" Relicnet "irc.relic.net" 6667) |
| 352 | ("Rezosup: Random server" Rezosup "irc.rezosup.org" 6667) | 350 | ("Rezosup: Random server" Rezosup "irc.rezosup.org" 6667) |
| 353 | ("Risanet: Random server" Risanet "irc.risanet.com" ((6667 6669))) | 351 | ("Risanet: Random server" Risanet "irc.risanet.com" ((6667 6669))) |
| 352 | ("Rizon: Random server" Rizon "irc.rizon.net" (6633 (6660 6669) 6697 7000 8080 9999)) | ||
| 354 | ("Rubiks: Random server" Rubiks "irc.rubiks.net" 6667) | 353 | ("Rubiks: Random server" Rubiks "irc.rubiks.net" 6667) |
| 355 | ("Rusnet: EU, RU, Tomsk" Rusnet "irc.tsk.ru" ((6667 6669) (7770 7775) )) | 354 | ("Rusnet: EU, RU, Tomsk" Rusnet "irc.tsk.ru" ((6667 6669) (7770 7775) )) |
| 356 | ("Rusnet: EU, RU, Vladivostok" Rusnet "irc.vladivostok.ru" ((6667 6669) (7770 7775) )) | 355 | ("Rusnet: EU, RU, Vladivostok" Rusnet "irc.vladivostok.ru" ((6667 6669) (7770 7775) )) |
| @@ -765,9 +764,14 @@ network as a symbol." | |||
| 765 | (setq erc-network nil) | 764 | (setq erc-network nil) |
| 766 | nil) | 765 | nil) |
| 767 | 766 | ||
| 768 | (add-hook 'erc-server-375-functions 'erc-set-network-name) | 767 | (define-erc-module networks nil |
| 769 | (add-hook 'erc-server-422-functions 'erc-set-network-name) | 768 | "Provide data about IRC networks." |
| 770 | (add-hook 'erc-disconnected-hook 'erc-unset-network-name) | 769 | ((add-hook 'erc-server-375-functions 'erc-set-network-name) |
| 770 | (add-hook 'erc-server-422-functions 'erc-set-network-name) | ||
| 771 | (add-hook 'erc-disconnected-hook 'erc-unset-network-name)) | ||
| 772 | ((remove-hook 'erc-server-375-functions 'erc-set-network-name) | ||
| 773 | (remove-hook 'erc-server-422-functions 'erc-set-network-name) | ||
| 774 | (remove-hook 'erc-disconnected-hook 'erc-unset-network-name))) | ||
| 771 | 775 | ||
| 772 | (defun erc-ports-list (ports) | 776 | (defun erc-ports-list (ports) |
| 773 | "Return a list of PORTS. | 777 | "Return a list of PORTS. |
diff --git a/lisp/erc/erc-page.el b/lisp/erc/erc-page.el index 90a2009106f..ff30bcab209 100644 --- a/lisp/erc/erc-page.el +++ b/lisp/erc/erc-page.el | |||
| @@ -104,5 +104,11 @@ receive pages if `erc-page-mode' is on." | |||
| 104 | 104 | ||
| 105 | (provide 'erc-page) | 105 | (provide 'erc-page) |
| 106 | 106 | ||
| 107 | ;; arch-tag: 82fd2e0e-6060-4dd2-9788-8c1411e844de | ||
| 108 | ;;; erc-page.el ends here | 107 | ;;; erc-page.el ends here |
| 108 | ;; | ||
| 109 | ;; Local Variables: | ||
| 110 | ;; indent-tabs-mode: t | ||
| 111 | ;; tab-width: 8 | ||
| 112 | ;; End: | ||
| 113 | |||
| 114 | ;; arch-tag: 82fd2e0e-6060-4dd2-9788-8c1411e844de | ||
diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el index d6713c6a442..45ce20e7fa7 100644 --- a/lisp/erc/erc-replace.el +++ b/lisp/erc/erc-replace.el | |||
| @@ -1,6 +1,7 @@ | |||
| 1 | ;; erc-replace.el -- wash and massage messages inserted into the buffer | 1 | ;; erc-replace.el -- wash and massage messages inserted into the buffer |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2001, 2002, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2001, 2002, 2004, 2006, 2007, |
| 4 | ;; 2008 Free Software Foundation, Inc. | ||
| 4 | 5 | ||
| 5 | ;; Author: Andreas Fuchs <asf@void.at> | 6 | ;; Author: Andreas Fuchs <asf@void.at> |
| 6 | ;; Maintainer: Mario Lang (mlang@delysid.org) | 7 | ;; Maintainer: Mario Lang (mlang@delysid.org) |
| @@ -88,5 +89,11 @@ It replaces text according to `erc-replace-alist'." | |||
| 88 | 89 | ||
| 89 | (provide 'erc-replace) | 90 | (provide 'erc-replace) |
| 90 | 91 | ||
| 91 | ;; arch-tag: dd904a59-d8a6-47f8-ac3a-76b698289a18 | ||
| 92 | ;;; erc-replace.el ends here | 92 | ;;; erc-replace.el ends here |
| 93 | ;; | ||
| 94 | ;; Local Variables: | ||
| 95 | ;; indent-tabs-mode: t | ||
| 96 | ;; tab-width: 8 | ||
| 97 | ;; End: | ||
| 98 | |||
| 99 | ;; arch-tag: dd904a59-d8a6-47f8-ac3a-76b698289a18 | ||
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el index ac57de9cd15..b25a10dc5ca 100644 --- a/lisp/erc/erc-services.el +++ b/lisp/erc/erc-services.el | |||
| @@ -123,6 +123,10 @@ You can also use M-x erc-nickserv-identify-mode to change modes." | |||
| 123 | '(("autodetect") ("nick-change") ("both")) nil t)))) | 123 | '(("autodetect") ("nick-change") ("both")) nil t)))) |
| 124 | (add-hook 'erc-server-NOTICE-functions | 124 | (add-hook 'erc-server-NOTICE-functions |
| 125 | 'erc-nickserv-identification-autodetect) | 125 | 'erc-nickserv-identification-autodetect) |
| 126 | (unless erc-networks-mode | ||
| 127 | ;; Force-enable networks module, because we need it to set | ||
| 128 | ;; erc-network for us. | ||
| 129 | (erc-networks-enable)) | ||
| 126 | (cond ((eq mode 'autodetect) | 130 | (cond ((eq mode 'autodetect) |
| 127 | (setq erc-nickserv-identify-mode 'autodetect) | 131 | (setq erc-nickserv-identify-mode 'autodetect) |
| 128 | (add-hook 'erc-server-NOTICE-functions | 132 | (add-hook 'erc-server-NOTICE-functions |
| @@ -187,6 +191,7 @@ Example of use: | |||
| 187 | (const iip) | 191 | (const iip) |
| 188 | (const OFTC) | 192 | (const OFTC) |
| 189 | (const QuakeNet) | 193 | (const QuakeNet) |
| 194 | (const Rizon) | ||
| 190 | (const SlashNET) | 195 | (const SlashNET) |
| 191 | (symbol :tag "Network name")) | 196 | (symbol :tag "Network name")) |
| 192 | (repeat :tag "Nickname and password" | 197 | (repeat :tag "Nickname and password" |
| @@ -227,6 +232,8 @@ Example of use: | |||
| 227 | "IDENTIFY" nil nil nil) | 232 | "IDENTIFY" nil nil nil) |
| 228 | (freenode | 233 | (freenode |
| 229 | "NickServ!NickServ@services." | 234 | "NickServ!NickServ@services." |
| 235 | ;; freenode also accepts a password at login, see the `erc' | ||
| 236 | ;; :password argument. | ||
| 230 | "/msg\\s-NickServ\\s-IDENTIFY\\s-<password>" | 237 | "/msg\\s-NickServ\\s-IDENTIFY\\s-<password>" |
| 231 | "NickServ" | 238 | "NickServ" |
| 232 | "IDENTIFY" nil nil | 239 | "IDENTIFY" nil nil |
| @@ -249,9 +256,17 @@ Example of use: | |||
| 249 | "IDENTIFY" nil "SQUERY" nil) | 256 | "IDENTIFY" nil "SQUERY" nil) |
| 250 | (OFTC | 257 | (OFTC |
| 251 | "NickServ!services@services.oftc.net" | 258 | "NickServ!services@services.oftc.net" |
| 252 | "type\\s-/msg\\s-NickServ\\s-IDENTIFY\\s-password." | 259 | ;; OFTC's NickServ doesn't ask you to identify anymore. |
| 260 | nil | ||
| 253 | "NickServ" | 261 | "NickServ" |
| 254 | "IDENTIFY" nil nil nil) | 262 | "IDENTIFY" nil nil |
| 263 | "You\\s-are\\s-successfully\\s-identified\\s-as\\s-") | ||
| 264 | (Rizon | ||
| 265 | "NickServ!service@rizon.net" | ||
| 266 | "This\\s-nickname\\s-is\\s-registered\\s-and\\s-protected." | ||
| 267 | "NickServ" | ||
| 268 | "IDENTIFY" nil nil | ||
| 269 | "Password\\s-accepted\\s--\\s-you\\s-are\\s-now\\s-recognized.") | ||
| 255 | (QuakeNet | 270 | (QuakeNet |
| 256 | nil nil | 271 | nil nil |
| 257 | "Q@CServe.quakenet.org" | 272 | "Q@CServe.quakenet.org" |
| @@ -334,15 +349,15 @@ If this is the case, run `erc-nickserv-identified-hook'." | |||
| 334 | ;; continue only if we're sure it's the real nickserv for this network | 349 | ;; continue only if we're sure it's the real nickserv for this network |
| 335 | ;; and it's told us we've successfully identified | 350 | ;; and it's told us we've successfully identified |
| 336 | (when (and sender (equal sspec sender) | 351 | (when (and sender (equal sspec sender) |
| 352 | success-regex | ||
| 337 | (string-match success-regex msg)) | 353 | (string-match success-regex msg)) |
| 338 | (erc-log "NickServ IDENTIFY success notification detected") | 354 | (erc-log "NickServ IDENTIFY success notification detected") |
| 339 | (run-hook-with-args 'erc-nickserv-identified-hook network nick) | 355 | (run-hook-with-args 'erc-nickserv-identified-hook network nick) |
| 340 | nil))) | 356 | nil))) |
| 341 | 357 | ||
| 342 | (defun erc-nickserv-identify-autodetect (proc parsed) | 358 | (defun erc-nickserv-identify-autodetect (proc parsed) |
| 343 | "Check for a NickServ identify request everytime a notice is received. | 359 | "Identify to NickServ when an identify request is received. |
| 344 | Make sure it is the real NickServ for this network and that it has | 360 | Make sure it is the real NickServ for this network. |
| 345 | specifically asked the user to IDENTIFY. | ||
| 346 | If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the | 361 | If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the |
| 347 | password for this nickname, otherwise try to send it automatically." | 362 | password for this nickname, otherwise try to send it automatically." |
| 348 | (unless (and (null erc-nickserv-passwords) | 363 | (unless (and (null erc-nickserv-passwords) |
| @@ -356,6 +371,7 @@ password for this nickname, otherwise try to send it automatically." | |||
| 356 | ;; continue only if we're sure it's the real nickserv for this network | 371 | ;; continue only if we're sure it's the real nickserv for this network |
| 357 | ;; and it's asked us to identify | 372 | ;; and it's asked us to identify |
| 358 | (when (and sender (equal sspec sender) | 373 | (when (and sender (equal sspec sender) |
| 374 | identify-regex | ||
| 359 | (string-match identify-regex msg)) | 375 | (string-match identify-regex msg)) |
| 360 | (erc-log "NickServ IDENTIFY request detected") | 376 | (erc-log "NickServ IDENTIFY request detected") |
| 361 | (erc-nickserv-call-identify-function nick) | 377 | (erc-nickserv-call-identify-function nick) |
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 76a692219ca..360d92c32c5 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el | |||
| @@ -101,9 +101,13 @@ disconnected from `erc-modified-channels-alist'." | |||
| 101 | :group 'erc-track | 101 | :group 'erc-track |
| 102 | :type 'boolean) | 102 | :type 'boolean) |
| 103 | 103 | ||
| 104 | (defcustom erc-track-exclude-types '("NICK") | 104 | (defcustom erc-track-exclude-types '("NICK" "333" "353") |
| 105 | "*List of message types to be ignored. | 105 | "*List of message types to be ignored. |
| 106 | This list could look like '(\"JOIN\" \"PART\")." | 106 | This list could look like '(\"JOIN\" \"PART\"). |
| 107 | |||
| 108 | By default, exclude changes of nicknames (NICK), display of who | ||
| 109 | set the channel topic (333), and listing of users on the current | ||
| 110 | channel (353)." | ||
| 107 | :group 'erc-track | 111 | :group 'erc-track |
| 108 | :type 'erc-message-type) | 112 | :type 'erc-message-type) |
| 109 | 113 | ||
| @@ -175,15 +179,32 @@ The faces used are the same as used for text in the buffers. | |||
| 175 | :type 'boolean) | 179 | :type 'boolean) |
| 176 | 180 | ||
| 177 | (defcustom erc-track-faces-priority-list | 181 | (defcustom erc-track-faces-priority-list |
| 178 | '(erc-error-face erc-current-nick-face erc-keyword-face erc-pal-face | 182 | '(erc-error-face |
| 179 | erc-nick-msg-face erc-direct-msg-face erc-button erc-dangerous-host-face | 183 | (erc-nick-default-face erc-current-nick-face) |
| 180 | erc-default-face erc-action-face erc-nick-default-face erc-fool-face | 184 | erc-current-nick-face |
| 181 | erc-notice-face erc-input-face erc-prompt-face) | 185 | erc-keyword-face |
| 186 | (erc-nick-default-face erc-pal-face) | ||
| 187 | erc-pal-face | ||
| 188 | erc-nick-msg-face | ||
| 189 | erc-direct-msg-face | ||
| 190 | (erc-button erc-default-face) | ||
| 191 | (erc-nick-default-face erc-dangerous-host-face) | ||
| 192 | erc-dangerous-host-face | ||
| 193 | erc-nick-default-face | ||
| 194 | (erc-nick-default-face erc-default-face) | ||
| 195 | erc-default-face | ||
| 196 | erc-action-face | ||
| 197 | (erc-nick-default-face erc-fool-face) | ||
| 198 | erc-fool-face | ||
| 199 | erc-notice-face | ||
| 200 | erc-input-face | ||
| 201 | erc-prompt-face) | ||
| 182 | "A list of faces used to highlight active buffer names in the modeline. | 202 | "A list of faces used to highlight active buffer names in the modeline. |
| 183 | If a message contains one of the faces in this list, the buffer name will | 203 | If a message contains one of the faces in this list, the buffer name will |
| 184 | be highlighted using that face. The first matching face is used." | 204 | be highlighted using that face. The first matching face is used." |
| 185 | :group 'erc-track | 205 | :group 'erc-track |
| 186 | :type '(repeat face)) | 206 | :type '(repeat (choice face |
| 207 | (repeat :tag "Combination" face)))) | ||
| 187 | 208 | ||
| 188 | (defcustom erc-track-priority-faces-only nil | 209 | (defcustom erc-track-priority-faces-only nil |
| 189 | "Only track text highlighted with a priority face. | 210 | "Only track text highlighted with a priority face. |
| @@ -193,6 +214,7 @@ this variable. You can set a list of channel name strings, so those | |||
| 193 | will be ignored while all other channels will be tracked as normal. | 214 | will be ignored while all other channels will be tracked as normal. |
| 194 | Other options are 'all, to apply this to all channels or nil, to disable | 215 | Other options are 'all, to apply this to all channels or nil, to disable |
| 195 | this feature. | 216 | this feature. |
| 217 | |||
| 196 | Note: If you have a lot of faces listed in `erc-track-faces-priority-list', | 218 | Note: If you have a lot of faces listed in `erc-track-faces-priority-list', |
| 197 | setting this variable might not be very useful." | 219 | setting this variable might not be very useful." |
| 198 | :group 'erc-track | 220 | :group 'erc-track |
| @@ -200,17 +222,38 @@ setting this variable might not be very useful." | |||
| 200 | (repeat string) | 222 | (repeat string) |
| 201 | (const all))) | 223 | (const all))) |
| 202 | 224 | ||
| 225 | (defcustom erc-track-faces-normal-list | ||
| 226 | '((erc-button erc-default-face) | ||
| 227 | (erc-nick-default-face erc-dangerous-host-face) | ||
| 228 | erc-dangerous-host-face | ||
| 229 | erc-nick-default-face | ||
| 230 | (erc-nick-default-face erc-default-face) | ||
| 231 | erc-default-face | ||
| 232 | erc-action-face) | ||
| 233 | "A list of faces considered to be part of normal conversations. | ||
| 234 | This list is used to highlight active buffer names in the modeline. | ||
| 235 | |||
| 236 | If a message contains one of the faces in this list, and the | ||
| 237 | previous modeline face for this buffer is also in this list, then | ||
| 238 | the buffer name will be highlighted using the face from the | ||
| 239 | message. This gives a rough indication that active conversations | ||
| 240 | are occurring in these channels. | ||
| 241 | |||
| 242 | The effect may be disabled by setting this variable to nil." | ||
| 243 | :group 'erc-track | ||
| 244 | :type '(repeat (choice face | ||
| 245 | (repeat :tag "Combination" face)))) | ||
| 246 | |||
| 203 | (defcustom erc-track-position-in-mode-line 'before-modes | 247 | (defcustom erc-track-position-in-mode-line 'before-modes |
| 204 | "Where to show modified channel information in the mode-line. | 248 | "Where to show modified channel information in the mode-line. |
| 205 | 249 | ||
| 206 | Setting this variable only has effects in GNU Emacs versions above 21.3. | 250 | Setting this variable only has effects in GNU Emacs versions above 21.3. |
| 207 | 251 | ||
| 208 | Choices are: | 252 | Choices are: |
| 209 | 'before-modes - add to the beginning of `mode-line-modes' | 253 | 'before-modes - add to the beginning of `mode-line-modes', |
| 210 | 'after-modes - add to the end of `mode-line-modes' | 254 | 'after-modes - add to the end of `mode-line-modes', |
| 211 | t - add to the end of `global-mode-string'. | 255 | t - add to the end of `global-mode-string', |
| 212 | nil - don't add to mode line | 256 | nil - don't add to mode line." |
| 213 | " | ||
| 214 | :group 'erc-track | 257 | :group 'erc-track |
| 215 | :type '(choice (const :tag "Just before mode information" before-modes) | 258 | :type '(choice (const :tag "Just before mode information" before-modes) |
| 216 | (const :tag "Just after mode information" after-modes) | 259 | (const :tag "Just after mode information" after-modes) |
| @@ -443,7 +486,7 @@ START is the minimum length of the name used." | |||
| 443 | 486 | ||
| 444 | ;;; Test: | 487 | ;;; Test: |
| 445 | 488 | ||
| 446 | (erc-assert | 489 | (assert |
| 447 | (and | 490 | (and |
| 448 | ;; verify examples from the doc strings | 491 | ;; verify examples from the doc strings |
| 449 | (equal (let ((erc-track-shorten-aggressively nil)) | 492 | (equal (let ((erc-track-shorten-aggressively nil)) |
| @@ -560,13 +603,15 @@ module, otherwise the keybindings will not do anything useful." | |||
| 560 | :global t | 603 | :global t |
| 561 | :group 'erc-track) | 604 | :group 'erc-track) |
| 562 | 605 | ||
| 563 | (defun erc-track-minor-mode-maybe () | 606 | (defun erc-track-minor-mode-maybe (&optional buffer) |
| 564 | "Enable `erc-track-minor-mode', depending on `erc-track-enable-keybindings'." | 607 | "Enable `erc-track-minor-mode', depending on `erc-track-enable-keybindings'." |
| 565 | (unless (or erc-track-minor-mode | 608 | (when (and (not erc-track-minor-mode) |
| 566 | ;; don't start the minor mode until we have an ERC | 609 | ;; don't start the minor mode until we have an ERC |
| 567 | ;; process running, because we don't want to prompt the | 610 | ;; process running, because we don't want to prompt the |
| 568 | ;; user while starting Emacs | 611 | ;; user while starting Emacs |
| 569 | (null (erc-buffer-list))) | 612 | (or (and (buffer-live-p buffer) |
| 613 | (with-current-buffer buffer (eq major-mode 'erc-mode))) | ||
| 614 | (erc-buffer-list))) | ||
| 570 | (cond ((eq erc-track-enable-keybindings 'ask) | 615 | (cond ((eq erc-track-enable-keybindings 'ask) |
| 571 | (let ((key (or (and (key-binding (kbd "C-c C-SPC")) "C-SPC") | 616 | (let ((key (or (and (key-binding (kbd "C-c C-SPC")) "C-SPC") |
| 572 | (and (key-binding (kbd "C-c C-@")) "C-@")))) | 617 | (and (key-binding (kbd "C-c C-@")) "C-@")))) |
| @@ -616,6 +661,7 @@ module, otherwise the keybindings will not do anything useful." | |||
| 616 | (add-hook 'erc-insert-post-hook 'erc-track-modified-channels) | 661 | (add-hook 'erc-insert-post-hook 'erc-track-modified-channels) |
| 617 | (add-hook 'erc-disconnected-hook 'erc-modified-channels-update)) | 662 | (add-hook 'erc-disconnected-hook 'erc-modified-channels-update)) |
| 618 | ;; enable the tracking keybindings | 663 | ;; enable the tracking keybindings |
| 664 | (add-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe) | ||
| 619 | (erc-track-minor-mode-maybe))) | 665 | (erc-track-minor-mode-maybe))) |
| 620 | ;; Disable: | 666 | ;; Disable: |
| 621 | ((when (boundp 'erc-track-when-inactive) | 667 | ((when (boundp 'erc-track-when-inactive) |
| @@ -637,6 +683,7 @@ module, otherwise the keybindings will not do anything useful." | |||
| 637 | (remove-hook 'erc-disconnected-hook 'erc-modified-channels-update) | 683 | (remove-hook 'erc-disconnected-hook 'erc-modified-channels-update) |
| 638 | (remove-hook 'erc-insert-post-hook 'erc-track-modified-channels)) | 684 | (remove-hook 'erc-insert-post-hook 'erc-track-modified-channels)) |
| 639 | ;; disable the tracking keybindings | 685 | ;; disable the tracking keybindings |
| 686 | (remove-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe) | ||
| 640 | (when erc-track-minor-mode | 687 | (when erc-track-minor-mode |
| 641 | (erc-track-minor-mode -1))))) | 688 | (erc-track-minor-mode -1))))) |
| 642 | 689 | ||
| @@ -821,15 +868,36 @@ Use `erc-make-mode-line-buffer-name' to create buttons." | |||
| 821 | (defun erc-track-find-face (faces) | 868 | (defun erc-track-find-face (faces) |
| 822 | "Return the face to use in the modeline from the faces in FACES. | 869 | "Return the face to use in the modeline from the faces in FACES. |
| 823 | If `erc-track-faces-priority-list' is set, the one from FACES who is | 870 | If `erc-track-faces-priority-list' is set, the one from FACES who is |
| 824 | first in that list will be used." | 871 | first in that list will be used. |
| 825 | (let ((candidates erc-track-faces-priority-list) | 872 | |
| 826 | candidate face) | 873 | If `erc-track-faces-normal-list' is non-nil, use it to produce a |
| 827 | (while (and candidates (not face)) | 874 | blinking effect that indicates channel activity when the first |
| 828 | (setq candidate (car candidates) | 875 | element in FACES and the highest-ranking face among the rest of |
| 829 | candidates (cdr candidates)) | 876 | FACES are both members of `erc-track-faces-normal-list'. |
| 830 | (when (memq candidate faces) | 877 | |
| 831 | (setq face candidate))) | 878 | If `erc-track-faces-priority-list' is not set, the first element |
| 832 | face)) | 879 | in FACES will be used. |
| 880 | |||
| 881 | If one of the faces is a list, then it will be ranked according | ||
| 882 | to its highest-tanking face member. A list of faces including | ||
| 883 | that member will take priority over just the single member | ||
| 884 | element." | ||
| 885 | (let ((choice (catch 'face | ||
| 886 | (dolist (candidate erc-track-faces-priority-list) | ||
| 887 | (when (member candidate faces) | ||
| 888 | (throw 'face candidate))))) | ||
| 889 | (no-first (and erc-track-faces-normal-list | ||
| 890 | (catch 'face | ||
| 891 | (dolist (candidate erc-track-faces-priority-list) | ||
| 892 | (when (member candidate (cdr faces)) | ||
| 893 | (throw 'face candidate))))))) | ||
| 894 | (cond ((null choice) | ||
| 895 | (car faces)) | ||
| 896 | ((and (member choice erc-track-faces-normal-list) | ||
| 897 | (member no-first erc-track-faces-normal-list)) | ||
| 898 | no-first) | ||
| 899 | (t | ||
| 900 | choice)))) | ||
| 833 | 901 | ||
| 834 | (defun erc-track-modified-channels () | 902 | (defun erc-track-modified-channels () |
| 835 | "Hook function for `erc-insert-post-hook' to check if the current | 903 | "Hook function for `erc-insert-post-hook' to check if the current |
| @@ -898,14 +966,15 @@ is in `erc-mode'." | |||
| 898 | "Return a list of all faces used in STR." | 966 | "Return a list of all faces used in STR." |
| 899 | (let ((i 0) | 967 | (let ((i 0) |
| 900 | (m (length str)) | 968 | (m (length str)) |
| 901 | (faces (erc-list (get-text-property 0 'face str)))) | 969 | (faces (erc-list (get-text-property 0 'face str))) |
| 970 | cur) | ||
| 902 | (while (and (setq i (next-single-property-change i 'face str m)) | 971 | (while (and (setq i (next-single-property-change i 'face str m)) |
| 903 | (not (= i m))) | 972 | (not (= i m))) |
| 904 | (dolist (face (erc-list (get-text-property i 'face str))) | 973 | (when (setq cur (get-text-property i 'face str)) |
| 905 | (add-to-list 'faces face))) | 974 | (add-to-list 'faces cur))) |
| 906 | faces)) | 975 | faces)) |
| 907 | 976 | ||
| 908 | (erc-assert | 977 | (assert |
| 909 | (let ((str "is bold")) | 978 | (let ((str "is bold")) |
| 910 | (put-text-property 3 (length str) | 979 | (put-text-property 3 (length str) |
| 911 | 'face '(bold erc-current-nick-face) | 980 | 'face '(bold erc-current-nick-face) |
| @@ -935,7 +1004,7 @@ higher number than any other face in that list." | |||
| 935 | (let ((count 0)) | 1004 | (let ((count 0)) |
| 936 | (catch 'done | 1005 | (catch 'done |
| 937 | (dolist (item erc-track-faces-priority-list) | 1006 | (dolist (item erc-track-faces-priority-list) |
| 938 | (if (eq item face) | 1007 | (if (equal item face) |
| 939 | (throw 'done t) | 1008 | (throw 'done t) |
| 940 | (setq count (1+ count))))) | 1009 | (setq count (1+ count))))) |
| 941 | count)) | 1010 | count)) |
diff --git a/lisp/erc/erc-xdcc.el b/lisp/erc/erc-xdcc.el index ed1d0c948b6..b58a7b61713 100644 --- a/lisp/erc/erc-xdcc.el +++ b/lisp/erc/erc-xdcc.el | |||
| @@ -62,6 +62,11 @@ being evaluated and should return stings." | |||
| 62 | :group 'erc-dcc | 62 | :group 'erc-dcc |
| 63 | :type '(repeat (repeat :tag "Message" (choice string sexp)))) | 63 | :type '(repeat (repeat :tag "Message" (choice string sexp)))) |
| 64 | 64 | ||
| 65 | ;;;###autoload (autoload 'erc-xdcc-mode "erc-xdcc") | ||
| 66 | (define-erc-module xdcc nil | ||
| 67 | "Act as an XDCC file-server." | ||
| 68 | nil nil) | ||
| 69 | |||
| 65 | ;;;###autoload | 70 | ;;;###autoload |
| 66 | (defun erc-xdcc-add-file (file) | 71 | (defun erc-xdcc-add-file (file) |
| 67 | "Add a file to `erc-xdcc-files'." | 72 | "Add a file to `erc-xdcc-files'." |
| @@ -126,5 +131,11 @@ being evaluated and should return stings." | |||
| 126 | 131 | ||
| 127 | (provide 'erc-xdcc) | 132 | (provide 'erc-xdcc) |
| 128 | 133 | ||
| 129 | ;; arch-tag: a13b62fe-2399-4562-af4e-f18a8dd4b9c8 | ||
| 130 | ;;; erc-xdcc.el ends here | 134 | ;;; erc-xdcc.el ends here |
| 135 | ;; | ||
| 136 | ;; Local Variables: | ||
| 137 | ;; indent-tabs-mode: t | ||
| 138 | ;; tab-width: 8 | ||
| 139 | ;; End: | ||
| 140 | |||
| 141 | ;; arch-tag: a13b62fe-2399-4562-af4e-f18a8dd4b9c8 | ||
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index c197f618442..e98c9d29baa 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el | |||
| @@ -66,7 +66,7 @@ | |||
| 66 | 66 | ||
| 67 | ;;; Code: | 67 | ;;; Code: |
| 68 | 68 | ||
| 69 | (defconst erc-version-string "Version 5.3 (devel)" | 69 | (defconst erc-version-string "Version 5.3" |
| 70 | "ERC version. This is used by function `erc-version'.") | 70 | "ERC version. This is used by function `erc-version'.") |
| 71 | 71 | ||
| 72 | (eval-when-compile (require 'cl)) | 72 | (eval-when-compile (require 'cl)) |
| @@ -1167,7 +1167,12 @@ This will only be used if `erc-header-line-face-method' is non-nil." | |||
| 1167 | See the variable `erc-command-indicator'." | 1167 | See the variable `erc-command-indicator'." |
| 1168 | :group 'erc-faces) | 1168 | :group 'erc-faces) |
| 1169 | 1169 | ||
| 1170 | (defface erc-notice-face '((t (:bold t :foreground "SlateBlue"))) | 1170 | (defface erc-notice-face |
| 1171 | (if (featurep 'xemacs) | ||
| 1172 | '((t (:bold t :foreground "blue"))) | ||
| 1173 | '((((class color) (min-colors 88)) | ||
| 1174 | (:bold t :foreground "SlateBlue")) | ||
| 1175 | (t (:bold t :foreground "blue")))) | ||
| 1171 | "ERC face for notices." | 1176 | "ERC face for notices." |
| 1172 | :group 'erc-faces) | 1177 | :group 'erc-faces) |
| 1173 | 1178 | ||
| @@ -1465,18 +1470,23 @@ Turning on `erc-mode' runs the hook `erc-mode-hook'." | |||
| 1465 | "IRC port to use if it cannot be detected otherwise.") | 1470 | "IRC port to use if it cannot be detected otherwise.") |
| 1466 | 1471 | ||
| 1467 | (defcustom erc-join-buffer 'buffer | 1472 | (defcustom erc-join-buffer 'buffer |
| 1468 | "Determines how to display the newly created IRC buffer. | 1473 | "Determines how to display a newly created IRC buffer. |
| 1469 | 'window - in another window, | 1474 | |
| 1470 | 'window-noselect - in another window, but don't select that one, | 1475 | The available choices are: |
| 1471 | 'frame - in another frame, | 1476 | |
| 1472 | 'bury - bury it in a new buffer, | 1477 | 'window - in another window, |
| 1473 | any other value - in place of the current buffer." | 1478 | 'window-noselect - in another window, but don't select that one, |
| 1479 | 'frame - in another frame, | ||
| 1480 | 'bury - bury it in a new buffer, | ||
| 1481 | 'buffer - in place of the current buffer, | ||
| 1482 | any other value - in place of the current buffer." | ||
| 1474 | :group 'erc-buffers | 1483 | :group 'erc-buffers |
| 1475 | :type '(choice (const window) | 1484 | :type '(choice (const :tag "Split window and select" window) |
| 1476 | (const window-noselect) | 1485 | (const :tag "Split window, don't select" window-noselect) |
| 1477 | (const frame) | 1486 | (const :tag "New frame" frame) |
| 1478 | (const bury) | 1487 | (const :tag "Bury in new buffer" bury) |
| 1479 | (const buffer))) | 1488 | (const :tag "Use current buffer" buffer) |
| 1489 | (const :tag "Use current buffer" t))) | ||
| 1480 | 1490 | ||
| 1481 | (defcustom erc-frame-alist nil | 1491 | (defcustom erc-frame-alist nil |
| 1482 | "*Alist of frame parameters for creating erc frames. | 1492 | "*Alist of frame parameters for creating erc frames. |
| @@ -1804,8 +1814,8 @@ buffer rather than a server buffer.") | |||
| 1804 | mods)))) | 1814 | mods)))) |
| 1805 | 1815 | ||
| 1806 | (defcustom erc-modules '(netsplit fill button match track completion readonly | 1816 | (defcustom erc-modules '(netsplit fill button match track completion readonly |
| 1807 | ring autojoin noncommands irccontrols | 1817 | networks ring autojoin noncommands irccontrols |
| 1808 | stamp menu) | 1818 | move-to-prompt stamp menu list) |
| 1809 | "A list of modules which ERC should enable. | 1819 | "A list of modules which ERC should enable. |
| 1810 | If you set the value of this without using `customize' remember to call | 1820 | If you set the value of this without using `customize' remember to call |
| 1811 | \(erc-update-modules) after you change it. When using `customize', modules | 1821 | \(erc-update-modules) after you change it. When using `customize', modules |
| @@ -1837,14 +1847,20 @@ removed from the list will be disabled." | |||
| 1837 | (const :tag "completion: Complete nicknames and commands (programmable)" | 1847 | (const :tag "completion: Complete nicknames and commands (programmable)" |
| 1838 | completion) | 1848 | completion) |
| 1839 | (const :tag "hecomplete: Complete nicknames and commands (old)" hecomplete) | 1849 | (const :tag "hecomplete: Complete nicknames and commands (old)" hecomplete) |
| 1850 | (const :tag "dcc: Provide Direct Client-to-Client support" dcc) | ||
| 1840 | (const :tag "fill: Wrap long lines" fill) | 1851 | (const :tag "fill: Wrap long lines" fill) |
| 1841 | (const :tag "identd: Launch an identd server on port 8113" identd) | 1852 | (const :tag "identd: Launch an identd server on port 8113" identd) |
| 1842 | (const :tag "irccontrols: Highlight or remove IRC control characters" | 1853 | (const :tag "irccontrols: Highlight or remove IRC control characters" |
| 1843 | irccontrols) | 1854 | irccontrols) |
| 1855 | (const :tag "keep-place: Leave point above un-viewed text" keep-place) | ||
| 1856 | (const :tag "list: List channels in a separate buffer" list) | ||
| 1844 | (const :tag "log: Save buffers in logs" log) | 1857 | (const :tag "log: Save buffers in logs" log) |
| 1845 | (const :tag "match: Highlight pals, fools, and other keywords" match) | 1858 | (const :tag "match: Highlight pals, fools, and other keywords" match) |
| 1846 | (const :tag "menu: Display a menu in ERC buffers" menu) | 1859 | (const :tag "menu: Display a menu in ERC buffers" menu) |
| 1860 | (const :tag "move-to-prompt: Move to the prompt when typing text" | ||
| 1861 | move-to-prompt) | ||
| 1847 | (const :tag "netsplit: Detect netsplits" netsplit) | 1862 | (const :tag "netsplit: Detect netsplits" netsplit) |
| 1863 | (const :tag "networks: Provide data about IRC networks" networks) | ||
| 1848 | (const :tag "noncommands: Don't display non-IRC commands after evaluation" | 1864 | (const :tag "noncommands: Don't display non-IRC commands after evaluation" |
| 1849 | noncommands) | 1865 | noncommands) |
| 1850 | (const :tag | 1866 | (const :tag |
| @@ -1866,6 +1882,7 @@ removed from the list will be disabled." | |||
| 1866 | (const :tag "track: Track channel activity in the mode-line" track) | 1882 | (const :tag "track: Track channel activity in the mode-line" track) |
| 1867 | (const :tag "truncate: Truncate buffers to a certain size" truncate) | 1883 | (const :tag "truncate: Truncate buffers to a certain size" truncate) |
| 1868 | (const :tag "unmorse: Translate morse code in messages" unmorse) | 1884 | (const :tag "unmorse: Translate morse code in messages" unmorse) |
| 1885 | (const :tag "xdcc: Act as an XDCC file-server" xdcc) | ||
| 1869 | (repeat :tag "Others" :inline t symbol)) | 1886 | (repeat :tag "Others" :inline t symbol)) |
| 1870 | :group 'erc) | 1887 | :group 'erc) |
| 1871 | 1888 | ||
| @@ -2324,6 +2341,15 @@ If ARG is non-nil, show the *erc-protocol* buffer." | |||
| 2324 | I.e. any char in it has the `invisible' property set." | 2341 | I.e. any char in it has the `invisible' property set." |
| 2325 | (text-property-any 0 (length string) 'invisible t string)) | 2342 | (text-property-any 0 (length string) 'invisible t string)) |
| 2326 | 2343 | ||
| 2344 | (defcustom erc-remove-parsed-property t | ||
| 2345 | "Whether to remove the erc-parsed text property after displaying a message. | ||
| 2346 | |||
| 2347 | The default is to remove it, since it causes ERC to take up extra | ||
| 2348 | memory. If you have code that relies on this property, then set | ||
| 2349 | this option to nil." | ||
| 2350 | :type 'boolean | ||
| 2351 | :group 'erc) | ||
| 2352 | |||
| 2327 | (defun erc-display-line-1 (string buffer) | 2353 | (defun erc-display-line-1 (string buffer) |
| 2328 | "Display STRING in `erc-mode' BUFFER. | 2354 | "Display STRING in `erc-mode' BUFFER. |
| 2329 | Auxiliary function used in `erc-display-line'. The line gets filtered to | 2355 | Auxiliary function used in `erc-display-line'. The line gets filtered to |
| @@ -2364,7 +2390,10 @@ If STRING is nil, the function does nothing." | |||
| 2364 | (save-restriction | 2390 | (save-restriction |
| 2365 | (narrow-to-region insert-position (point)) | 2391 | (narrow-to-region insert-position (point)) |
| 2366 | (run-hooks 'erc-insert-modify-hook) | 2392 | (run-hooks 'erc-insert-modify-hook) |
| 2367 | (run-hooks 'erc-insert-post-hook)))))) | 2393 | (run-hooks 'erc-insert-post-hook) |
| 2394 | (when erc-remove-parsed-property | ||
| 2395 | (remove-text-properties (point-min) (point-max) | ||
| 2396 | '(erc-parsed nil)))))))) | ||
| 2368 | (erc-update-undo-list (- (or (marker-position erc-insert-marker) | 2397 | (erc-update-undo-list (- (or (marker-position erc-insert-marker) |
| 2369 | (point-max)) | 2398 | (point-max)) |
| 2370 | insert-position)))))) | 2399 | insert-position)))))) |
| @@ -3161,14 +3190,35 @@ just as you provided it. Use this command with care!" | |||
| 3161 | (t nil))) | 3190 | (t nil))) |
| 3162 | (put 'erc-cmd-QUOTE 'do-not-parse-args t) | 3191 | (put 'erc-cmd-QUOTE 'do-not-parse-args t) |
| 3163 | 3192 | ||
| 3193 | (defcustom erc-query-display 'window | ||
| 3194 | "Indicates how to display query buffers when using the /QUERY | ||
| 3195 | command to talk to someone. | ||
| 3196 | |||
| 3197 | The default behavior is to display the message in a new window | ||
| 3198 | and bring it to the front. See the documentation for | ||
| 3199 | `erc-join-buffer' for a description of the available choices. | ||
| 3200 | |||
| 3201 | See also `erc-auto-query' to decide how private messages from | ||
| 3202 | other people should be displayed." | ||
| 3203 | :group 'erc-query | ||
| 3204 | :type '(choice (const :tag "Split window and select" window) | ||
| 3205 | (const :tag "Split window, don't select" window-noselect) | ||
| 3206 | (const :tag "New frame" frame) | ||
| 3207 | (const :tag "Bury in new buffer" bury) | ||
| 3208 | (const :tag "Use current buffer" buffer) | ||
| 3209 | (const :tag "Use current buffer" t))) | ||
| 3210 | |||
| 3164 | (defun erc-cmd-QUERY (&optional user) | 3211 | (defun erc-cmd-QUERY (&optional user) |
| 3165 | "Open a query with USER. | 3212 | "Open a query with USER. |
| 3166 | The type of query window/frame/etc will depend on the value of | 3213 | The type of query window/frame/etc will depend on the value of |
| 3167 | `erc-join-buffer'. If USER is omitted, close the current query buffer if one | 3214 | `erc-query-display'. |
| 3168 | exists - except this is broken now ;-)" | 3215 | |
| 3216 | If USER is omitted, close the current query buffer if one exists | ||
| 3217 | - except this is broken now ;-)" | ||
| 3169 | (interactive | 3218 | (interactive |
| 3170 | (list (read-from-minibuffer "Start a query with: " nil))) | 3219 | (list (read-from-minibuffer "Start a query with: " nil))) |
| 3171 | (let ((session-buffer (erc-server-buffer))) | 3220 | (let ((session-buffer (erc-server-buffer)) |
| 3221 | (erc-join-buffer erc-query-display)) | ||
| 3172 | (if user | 3222 | (if user |
| 3173 | (erc-query user session-buffer) | 3223 | (erc-query user session-buffer) |
| 3174 | ;; currently broken, evil hack to display help anyway | 3224 | ;; currently broken, evil hack to display help anyway |
| @@ -3707,8 +3757,9 @@ If `point' is at the beginning of a channel name, use that as default." | |||
| 3707 | (read-from-minibuffer | 3757 | (read-from-minibuffer |
| 3708 | (concat "Set topic of " (erc-default-target) ": ") | 3758 | (concat "Set topic of " (erc-default-target) ": ") |
| 3709 | (when erc-channel-topic | 3759 | (when erc-channel-topic |
| 3710 | (cons (apply 'concat (butlast (split-string erc-channel-topic "\C-o"))) | 3760 | (let ((ss (split-string erc-channel-topic "\C-o"))) |
| 3711 | 0))))) | 3761 | (cons (apply 'concat (if (cdr ss) (butlast ss) ss)) |
| 3762 | 0)))))) | ||
| 3712 | (let ((topic-list (split-string topic "\C-o"))) ; strip off the topic setter | 3763 | (let ((topic-list (split-string topic "\C-o"))) ; strip off the topic setter |
| 3713 | (erc-cmd-TOPIC (concat (erc-default-target) " " (car topic-list))))) | 3764 | (erc-cmd-TOPIC (concat (erc-default-target) " " (car topic-list))))) |
| 3714 | 3765 | ||
| @@ -3841,20 +3892,22 @@ To change how this query window is displayed, use `let' to bind | |||
| 3841 | (erc-update-mode-line) | 3892 | (erc-update-mode-line) |
| 3842 | buf)) | 3893 | buf)) |
| 3843 | 3894 | ||
| 3844 | (defcustom erc-auto-query 'bury | 3895 | (defcustom erc-auto-query 'window-noselect |
| 3845 | "If non-nil, create a query buffer each time you receive a private message. | 3896 | "If non-nil, create a query buffer each time you receive a private message. |
| 3897 | If the buffer doesn't already exist, it is created. | ||
| 3846 | 3898 | ||
| 3847 | If the buffer doesn't already exist it is created. This can be | 3899 | This can be set to a symbol, to control how the new query window |
| 3848 | set to a symbol, to control how the new query window should | 3900 | should appear. The default behavior is to display the buffer in |
| 3849 | appear. See the documentation for `erc-join-buffer' for | 3901 | a new window, but not to select it. See the documentation for |
| 3850 | available choices." | 3902 | `erc-join-buffer' for a description of the available choices." |
| 3851 | :group 'erc-query | 3903 | :group 'erc-query |
| 3852 | :type '(choice (const nil) | 3904 | :type '(choice (const :tag "Don't create query window" nil) |
| 3853 | (const buffer) | 3905 | (const :tag "Split window and select" window) |
| 3854 | (const window) | 3906 | (const :tag "Split window, don't select" window-noselect) |
| 3855 | (const window-noselect) | 3907 | (const :tag "New frame" frame) |
| 3856 | (const bury) | 3908 | (const :tag "Bury in new buffer" bury) |
| 3857 | (const frame))) | 3909 | (const :tag "Use current buffer" buffer) |
| 3910 | (const :tag "Use current buffer" t))) | ||
| 3858 | 3911 | ||
| 3859 | (defcustom erc-query-on-unjoined-chan-privmsg t | 3912 | (defcustom erc-query-on-unjoined-chan-privmsg t |
| 3860 | "If non-nil create query buffer on receiving any PRIVMSG at all. | 3913 | "If non-nil create query buffer on receiving any PRIVMSG at all. |
| @@ -5822,7 +5875,7 @@ See `current-time' for details on the time format." | |||
| 5822 | 5875 | ||
| 5823 | ;; Mode line handling | 5876 | ;; Mode line handling |
| 5824 | 5877 | ||
| 5825 | (defcustom erc-mode-line-format "%s %a" | 5878 | (defcustom erc-mode-line-format "%S %a" |
| 5826 | "A string to be formatted and shown in the mode-line in `erc-mode'. | 5879 | "A string to be formatted and shown in the mode-line in `erc-mode'. |
| 5827 | 5880 | ||
| 5828 | The string is formatted using `format-spec' and the result is set as the value | 5881 | The string is formatted using `format-spec' and the result is set as the value |
| @@ -5833,12 +5886,16 @@ The following characters are replaced: | |||
| 5833 | %l: The estimated lag time to the server | 5886 | %l: The estimated lag time to the server |
| 5834 | %m: The modes of the channel | 5887 | %m: The modes of the channel |
| 5835 | %n: The current nick name | 5888 | %n: The current nick name |
| 5889 | %N: The name of the network | ||
| 5836 | %o: The topic of the channel | 5890 | %o: The topic of the channel |
| 5837 | %p: The session port | 5891 | %p: The session port |
| 5838 | %t: The name of the target (channel, nickname, or servername:port) | 5892 | %t: The name of the target (channel, nickname, or servername:port) |
| 5839 | %s: In the server-buffer, this gets filled with the value of | 5893 | %s: In the server-buffer, this gets filled with the value of |
| 5840 | `erc-server-announced-name', in a channel, the value of | 5894 | `erc-server-announced-name', in a channel, the value of |
| 5841 | (erc-default-target) also get concatenated." | 5895 | (erc-default-target) also get concatenated. |
| 5896 | %S: In the server-buffer, this gets filled with the value of | ||
| 5897 | `erc-network', in a channel, the value of (erc-default-target) | ||
| 5898 | also get concatenated." | ||
| 5842 | :group 'erc-mode-line-and-header | 5899 | :group 'erc-mode-line-and-header |
| 5843 | :type 'string) | 5900 | :type 'string) |
| 5844 | 5901 | ||
| @@ -5932,6 +5989,29 @@ This should be a string with substitution variables recognized by | |||
| 5932 | (server-name server-name) | 5989 | (server-name server-name) |
| 5933 | (t (buffer-name (current-buffer)))))) | 5990 | (t (buffer-name (current-buffer)))))) |
| 5934 | 5991 | ||
| 5992 | (defun erc-format-network () | ||
| 5993 | "Return the name of the network we are currently on." | ||
| 5994 | (let ((network (and (fboundp 'erc-network-name) (erc-network-name)))) | ||
| 5995 | (if (and network (symbolp network)) | ||
| 5996 | (symbol-name network) | ||
| 5997 | ""))) | ||
| 5998 | |||
| 5999 | (defun erc-format-target-and/or-network () | ||
| 6000 | "Return the network or the current target and network combined. | ||
| 6001 | If the name of the network is not available, then use the | ||
| 6002 | shortened server name instead." | ||
| 6003 | (let ((network-name (or (and (fboundp 'erc-network-name) (erc-network-name)) | ||
| 6004 | (erc-shorten-server-name | ||
| 6005 | (or erc-server-announced-name | ||
| 6006 | erc-session-server))))) | ||
| 6007 | (when (and network-name (symbolp network-name)) | ||
| 6008 | (setq network-name (symbol-name network-name))) | ||
| 6009 | (cond ((erc-default-target) | ||
| 6010 | (concat (erc-string-no-properties (erc-default-target)) | ||
| 6011 | "@" network-name)) | ||
| 6012 | (network-name network-name) | ||
| 6013 | (t (buffer-name (current-buffer)))))) | ||
| 6014 | |||
| 5935 | (defun erc-format-away-status () | 6015 | (defun erc-format-away-status () |
| 5936 | "Return a formatted `erc-mode-line-away-status-format' | 6016 | "Return a formatted `erc-mode-line-away-status-format' |
| 5937 | if `erc-away' is non-nil." | 6017 | if `erc-away' is non-nil." |
| @@ -5975,9 +6055,11 @@ if `erc-away' is non-nil." | |||
| 5975 | ?l (erc-format-lag-time) | 6055 | ?l (erc-format-lag-time) |
| 5976 | ?m (erc-format-channel-modes) | 6056 | ?m (erc-format-channel-modes) |
| 5977 | ?n (or (erc-current-nick) "") | 6057 | ?n (or (erc-current-nick) "") |
| 6058 | ?N (erc-format-network) | ||
| 5978 | ?o (erc-controls-strip erc-channel-topic) | 6059 | ?o (erc-controls-strip erc-channel-topic) |
| 5979 | ?p (erc-port-to-string erc-session-port) | 6060 | ?p (erc-port-to-string erc-session-port) |
| 5980 | ?s (erc-format-target-and/or-server) | 6061 | ?s (erc-format-target-and/or-server) |
| 6062 | ?S (erc-format-target-and/or-network) | ||
| 5981 | ?t (erc-format-target))) | 6063 | ?t (erc-format-target))) |
| 5982 | (process-status (cond ((and (erc-server-process-alive) | 6064 | (process-status (cond ((and (erc-server-process-alive) |
| 5983 | (not erc-server-connected)) | 6065 | (not erc-server-connected)) |
diff --git a/lisp/ffap.el b/lisp/ffap.el index 52fb372b8cd..c34478a30de 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el | |||
| @@ -797,7 +797,10 @@ This uses ffap-file-exists-string, which may try adding suffixes from | |||
| 797 | ("\\.bib\\'" . ffap-bib) ; search ffap-bib-path | 797 | ("\\.bib\\'" . ffap-bib) ; search ffap-bib-path |
| 798 | ("\\`\\." . ffap-home) ; .emacs, .bashrc, .profile | 798 | ("\\`\\." . ffap-home) ; .emacs, .bashrc, .profile |
| 799 | ("\\`~/" . ffap-lcd) ; |~/misc/ffap.el.Z| | 799 | ("\\`~/" . ffap-lcd) ; |~/misc/ffap.el.Z| |
| 800 | ("^[Rr][Ff][Cc][- #]?\\([0-9]+\\)" ; no $ | 800 | ;; This uses to have a blank, but ffap-string-at-point doesn't |
| 801 | ;; handle blanks. | ||
| 802 | ;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg01058.html | ||
| 803 | ("^[Rr][Ff][Cc][-#]?\\([0-9]+\\)" ; no $ | ||
| 801 | . ffap-rfc) ; "100% RFC2100 compliant" | 804 | . ffap-rfc) ; "100% RFC2100 compliant" |
| 802 | (dired-mode . ffap-dired) ; maybe in a subdirectory | 805 | (dired-mode . ffap-dired) ; maybe in a subdirectory |
| 803 | ) | 806 | ) |
| @@ -969,7 +972,7 @@ If t, `ffap-tex-init' will initialize this when needed.") | |||
| 969 | ;; Slightly controversial decisions: | 972 | ;; Slightly controversial decisions: |
| 970 | ;; * strip trailing "@" and ":" | 973 | ;; * strip trailing "@" and ":" |
| 971 | ;; * no commas (good for latex) | 974 | ;; * no commas (good for latex) |
| 972 | (file "--:$+<>@-Z_[:lower:]~*?" "<@" "@>;.,!:") | 975 | (file "--:\\\\$+<>@-Z_[:lower:]~*?" "<@" "@>;.,!:") |
| 973 | ;; An url, or maybe a email/news message-id: | 976 | ;; An url, or maybe a email/news message-id: |
| 974 | (url "--:=&?$+@-Z_[:lower:]~#,%;*" "^[:alnum:]" ":;.,!?") | 977 | (url "--:=&?$+@-Z_[:lower:]~#,%;*" "^[:alnum:]" ":;.,!?") |
| 975 | ;; Find a string that does *not* contain a colon: | 978 | ;; Find a string that does *not* contain a colon: |
| @@ -1263,20 +1266,25 @@ which may actually result in an url rather than a filename." | |||
| 1263 | (setq dir (file-name-directory guess)))) | 1266 | (setq dir (file-name-directory guess)))) |
| 1264 | (let ((minibuffer-completing-file-name t) | 1267 | (let ((minibuffer-completing-file-name t) |
| 1265 | (completion-ignore-case read-file-name-completion-ignore-case) | 1268 | (completion-ignore-case read-file-name-completion-ignore-case) |
| 1266 | ;; because of `rfn-eshadow-update-overlay'. | 1269 | (fnh-elem (cons ffap-url-regexp 'url-file-handler))) |
| 1267 | (file-name-handler-alist | 1270 | ;; Explain to `rfn-eshadow' that we can use URLs here. |
| 1268 | (cons (cons ffap-url-regexp 'url-file-handler) | 1271 | (push fnh-elem file-name-handler-alist) |
| 1269 | file-name-handler-alist))) | 1272 | (unwind-protect |
| 1270 | (setq guess | 1273 | (setq guess |
| 1271 | (completing-read | 1274 | (completing-read |
| 1272 | prompt | 1275 | prompt |
| 1273 | 'ffap-read-file-or-url-internal | 1276 | 'ffap-read-file-or-url-internal |
| 1274 | dir | 1277 | dir |
| 1275 | nil | 1278 | nil |
| 1276 | (if dir (cons guess (length dir)) guess) | 1279 | (if dir (cons guess (length dir)) guess) |
| 1277 | (list 'file-name-history) | 1280 | (list 'file-name-history) |
| 1278 | (and buffer-file-name | 1281 | (and buffer-file-name |
| 1279 | (abbreviate-file-name buffer-file-name))))) | 1282 | (abbreviate-file-name buffer-file-name)))) |
| 1283 | ;; Remove the special handler manually. We used to just let-bind | ||
| 1284 | ;; file-name-handler-alist to preserve its value, but that caused | ||
| 1285 | ;; other modifications to be lost (e.g. when Tramp gets loaded | ||
| 1286 | ;; during the completing-read call). | ||
| 1287 | (setq file-name-handler-alist (delq fnh-elem file-name-handler-alist)))) | ||
| 1280 | ;; Do file substitution like (interactive "F"), suggested by MCOOK. | 1288 | ;; Do file substitution like (interactive "F"), suggested by MCOOK. |
| 1281 | (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess))) | 1289 | (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess))) |
| 1282 | ;; Should not do it on url's, where $ is a common (VMS?) character. | 1290 | ;; Should not do it on url's, where $ is a common (VMS?) character. |
diff --git a/lisp/files.el b/lisp/files.el index bc74ecf4667..c790aa58810 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -2488,13 +2488,13 @@ symbol and VAL is a value that is considered safe." | |||
| 2488 | :group 'find-file | 2488 | :group 'find-file |
| 2489 | :type 'alist) | 2489 | :type 'alist) |
| 2490 | 2490 | ||
| 2491 | (defcustom safe-local-eval-forms nil | 2491 | (defcustom safe-local-eval-forms '((add-hook 'write-file-hooks 'time-stamp)) |
| 2492 | "Expressions that are considered safe in an `eval:' local variable. | 2492 | "Expressions that are considered safe in an `eval:' local variable. |
| 2493 | Add expressions to this list if you want Emacs to evaluate them, when | 2493 | Add expressions to this list if you want Emacs to evaluate them, when |
| 2494 | they appear in an `eval' local variable specification, without first | 2494 | they appear in an `eval' local variable specification, without first |
| 2495 | asking you for confirmation." | 2495 | asking you for confirmation." |
| 2496 | :group 'find-file | 2496 | :group 'find-file |
| 2497 | :version "22.1" | 2497 | :version "22.2" |
| 2498 | :type '(repeat sexp)) | 2498 | :type '(repeat sexp)) |
| 2499 | 2499 | ||
| 2500 | ;; Risky local variables: | 2500 | ;; Risky local variables: |
| @@ -2839,7 +2839,8 @@ is specified, returning t if it is specified." | |||
| 2839 | (dolist (elt result) | 2839 | (dolist (elt result) |
| 2840 | (let ((var (car elt)) | 2840 | (let ((var (car elt)) |
| 2841 | (val (cdr elt))) | 2841 | (val (cdr elt))) |
| 2842 | (or (eq var 'mode) | 2842 | ;; Don't query about the fake variables. |
| 2843 | (or (memq var '(mode unibyte coding)) | ||
| 2843 | (and (eq var 'eval) | 2844 | (and (eq var 'eval) |
| 2844 | (or (eq enable-local-eval t) | 2845 | (or (eq enable-local-eval t) |
| 2845 | (hack-one-local-variable-eval-safep | 2846 | (hack-one-local-variable-eval-safep |
diff --git a/lisp/frame.el b/lisp/frame.el index 64e504d1c07..92b102a0878 100644 --- a/lisp/frame.el +++ b/lisp/frame.el | |||
| @@ -1254,7 +1254,7 @@ displays not explicitely specified." | |||
| 1254 | 1254 | ||
| 1255 | (defun display-mm-height (&optional display) | 1255 | (defun display-mm-height (&optional display) |
| 1256 | "Return the height of DISPLAY's screen in millimeters. | 1256 | "Return the height of DISPLAY's screen in millimeters. |
| 1257 | System values can be overriden by `display-mm-dimensions-alist'. | 1257 | System values can be overridden by `display-mm-dimensions-alist'. |
| 1258 | If the information is unavailable, value is nil." | 1258 | If the information is unavailable, value is nil." |
| 1259 | (and (memq (framep-on-display display) '(x w32 mac)) | 1259 | (and (memq (framep-on-display display) '(x w32 mac)) |
| 1260 | (or (cddr (assoc (or display (frame-parameter nil 'display)) | 1260 | (or (cddr (assoc (or display (frame-parameter nil 'display)) |
| @@ -1264,7 +1264,7 @@ If the information is unavailable, value is nil." | |||
| 1264 | 1264 | ||
| 1265 | (defun display-mm-width (&optional display) | 1265 | (defun display-mm-width (&optional display) |
| 1266 | "Return the width of DISPLAY's screen in millimeters. | 1266 | "Return the width of DISPLAY's screen in millimeters. |
| 1267 | System values can be overriden by `display-mm-dimensions-alist'. | 1267 | System values can be overridden by `display-mm-dimensions-alist'. |
| 1268 | If the information is unavailable, value is nil." | 1268 | If the information is unavailable, value is nil." |
| 1269 | (and (memq (framep-on-display display) '(x w32 mac)) | 1269 | (and (memq (framep-on-display display) '(x w32 mac)) |
| 1270 | (or (cadr (assoc (or display (frame-parameter nil 'display)) | 1270 | (or (cadr (assoc (or display (frame-parameter nil 'display)) |
diff --git a/lisp/fringe.el b/lisp/fringe.el index e2eb5d2d98b..2762dbe617a 100644 --- a/lisp/fringe.el +++ b/lisp/fringe.el | |||
| @@ -93,6 +93,10 @@ | |||
| 93 | 93 | ||
| 94 | (defvar fringe-mode) | 94 | (defvar fringe-mode) |
| 95 | 95 | ||
| 96 | (defvar fringe-mode-explicit nil | ||
| 97 | "Non-nil means `set-fringe-mode' should really do something. | ||
| 98 | This is nil while loading `fringe.el', and t afterward.") | ||
| 99 | |||
| 96 | (defun set-fringe-mode-1 (ignore value) | 100 | (defun set-fringe-mode-1 (ignore value) |
| 97 | "Call `set-fringe-mode' with VALUE. | 101 | "Call `set-fringe-mode' with VALUE. |
| 98 | See `fringe-mode' for valid values and their effect. | 102 | See `fringe-mode' for valid values and their effect. |
| @@ -104,13 +108,14 @@ This is usually invoked when setting `fringe-mode' via customize." | |||
| 104 | See `fringe-mode' for possible values and their effect." | 108 | See `fringe-mode' for possible values and their effect." |
| 105 | (setq fringe-mode value) | 109 | (setq fringe-mode value) |
| 106 | 110 | ||
| 107 | (modify-all-frames-parameters | 111 | (when fringe-mode-explicit |
| 108 | (list (cons 'left-fringe (if (consp fringe-mode) | 112 | (modify-all-frames-parameters |
| 109 | (car fringe-mode) | 113 | (list (cons 'left-fringe (if (consp fringe-mode) |
| 110 | fringe-mode)) | 114 | (car fringe-mode) |
| 111 | (cons 'right-fringe (if (consp fringe-mode) | 115 | fringe-mode)) |
| 112 | (cdr fringe-mode) | 116 | (cons 'right-fringe (if (consp fringe-mode) |
| 113 | fringe-mode))))) | 117 | (cdr fringe-mode) |
| 118 | fringe-mode)))))) | ||
| 114 | 119 | ||
| 115 | ;; For initialization of fringe-mode, take account of changes | 120 | ;; For initialization of fringe-mode, take account of changes |
| 116 | ;; made explicitly to default-frame-alist. | 121 | ;; made explicitly to default-frame-alist. |
| @@ -159,6 +164,10 @@ you can use the interactive function `set-fringe-style'." | |||
| 159 | :initialize 'fringe-mode-initialize | 164 | :initialize 'fringe-mode-initialize |
| 160 | :set 'set-fringe-mode-1) | 165 | :set 'set-fringe-mode-1) |
| 161 | 166 | ||
| 167 | ;; We just set fringe-mode, but that was the default. | ||
| 168 | ;; If it is set again, that is for real. | ||
| 169 | (setq fringe-mode-explicit t) | ||
| 170 | |||
| 162 | (defun fringe-query-style (&optional all-frames) | 171 | (defun fringe-query-style (&optional all-frames) |
| 163 | "Query user for fringe style. | 172 | "Query user for fringe style. |
| 164 | Returns values suitable for left-fringe and right-fringe frame parameters. | 173 | Returns values suitable for left-fringe and right-fringe frame parameters. |
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 728ea9a424a..f3b41740f3e 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,107 @@ | |||
| 1 | 2008-01-24 Michael Sperber <sperber@deinprogramm.de> | ||
| 2 | |||
| 3 | * mail-source.el (mail-sources): Add `group' choice. | ||
| 4 | |||
| 5 | * nnmail.el (nnmail-get-new-mail-1): Abstract this out to add another | ||
| 6 | parameter `in-group' to control into which group the articles go. | ||
| 7 | Add treatment of `group' mail-source. | ||
| 8 | |||
| 9 | 2008-01-24 Dan Nicolaescu <dann@ics.uci.edu> | ||
| 10 | |||
| 11 | * sieve.el (sieve-make-overlay, sieve-overlay-put, sieve-overlays-at): | ||
| 12 | * message.el (message-beginning-of-line): Use featurep instead of bound | ||
| 13 | tests in order to resolve conditionals at compile time. | ||
| 14 | |||
| 15 | 2008-01-23 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 16 | |||
| 17 | * gnus-art.el (gnus-insert-mime-button): Don't decode description. | ||
| 18 | |||
| 19 | * mm-decode.el (mm-dissect-buffer): Decode description. | ||
| 20 | |||
| 21 | * mml.el (mml-to-mime): Encode message header first. | ||
| 22 | |||
| 23 | 2008-01-18 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 24 | |||
| 25 | * gnus-art.el (gnus-article-describe-bindings): Make it possible to use | ||
| 26 | xrefs, i.e. [back] and [forward] buttons, in *Help* buffer. | ||
| 27 | |||
| 28 | 2008-01-18 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 29 | |||
| 30 | * gnus-registry.el (gnus-registry-trim): Use append, not concat. | ||
| 31 | |||
| 32 | 2008-01-17 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 33 | |||
| 34 | * gnus-art.el (gnus-article-read-summary-keys): Work for some `A' | ||
| 35 | prefix keys. | ||
| 36 | (gnus-article-read-summary-send-keys): Use gnus-character-to-event. | ||
| 37 | (gnus-article-describe-bindings): Simplify; move XEmacs stuff to | ||
| 38 | gnus-xmas.el. | ||
| 39 | |||
| 40 | 2008-01-16 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 41 | |||
| 42 | * gnus-registry.el (gnus-registry-marks, gnus-registry-default-mark): | ||
| 43 | Add new variables for article mark management. | ||
| 44 | (gnus-registry-extra-entries-precious, gnus-registry-trim): Define a | ||
| 45 | list of extra data entries which, when present, will indicate that the | ||
| 46 | article ID should not be trimmed from the registry. | ||
| 47 | (gnus-registry-mark-article, gnus-registry-article-marks): Remove these | ||
| 48 | functions. | ||
| 49 | (gnus-registry-read-mark): New function to read a mark name from the | ||
| 50 | user. | ||
| 51 | (gnus-registry-set-article-mark, gnus-registry-remove-article-mark) | ||
| 52 | (gnus-registry-set-article-mark-internal): New functions to add and | ||
| 53 | remove marks. | ||
| 54 | (gnus-registry-get-article-marks): New function to show the marks for | ||
| 55 | an article, or retrieve them for further use. | ||
| 56 | |||
| 57 | 2008-01-16 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 58 | |||
| 59 | * gnus-art.el (gnus-article-describe-bindings): Show all `S' prefix | ||
| 60 | keys when no argument is given. | ||
| 61 | |||
| 62 | 2008-01-12 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 63 | |||
| 64 | * gnus-sum.el (gnus-article-sort-by-random) | ||
| 65 | (gnus-thread-sort-by-random): Fix doc strings. Reported by | ||
| 66 | jidanni@jidanni.org. | ||
| 67 | |||
| 68 | 2008-01-11 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 69 | |||
| 70 | * gnus-art.el (gnus-article-describe-bindings): New function. | ||
| 71 | (gnus-article-read-summary-keys): Use it. | ||
| 72 | (gnus-article-mode-map): Bind `C-h b' to it. | ||
| 73 | |||
| 74 | 2008-01-10 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 75 | |||
| 76 | * gnus-art.el (gnus-article-read-summary-keys): Work for `C-h' on | ||
| 77 | XEmacs. | ||
| 78 | (gnus-article-describe-key, gnus-article-describe-key-briefly): Protect | ||
| 79 | against non-character events. | ||
| 80 | |||
| 81 | 2008-01-09 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 82 | |||
| 83 | * gnus-group.el (gnus-group-read-ephemeral-gmane-group-url): New | ||
| 84 | command. | ||
| 85 | (gnus-group-read-ephemeral-gmane-group): Use optional argument RANGE | ||
| 86 | instead of END. Change name of the temp file. | ||
| 87 | (gnus-group-gmane-group-download-format): Add doc string. Make it | ||
| 88 | customizable. | ||
| 89 | |||
| 90 | 2008-01-09 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 91 | |||
| 92 | * gnus-art.el (gnus-article-send-map): New keymap for `S' prefix keys; | ||
| 93 | bind `S W' to gnus-article-wide-reply-with-original; set default | ||
| 94 | binding to gnus-article-read-summary-send-keys. | ||
| 95 | (gnus-article-read-summary-keys): Fix the order of keys; display | ||
| 96 | continuation keys correctly in the echo area; describe bindings | ||
| 97 | correctly when keys end with `C-h'. | ||
| 98 | (gnus-article-read-summary-send-keys): New function. | ||
| 99 | (gnus-article-describe-key, gnus-article-describe-key-briefly): Work | ||
| 100 | for gnus-article-read-summary-send-keys; display continuation keys | ||
| 101 | correctly in the echo area. | ||
| 102 | (gnus-article-reply-with-original): Ignore prefix argument. | ||
| 103 | (gnus-article-wide-reply-with-original): New function. | ||
| 104 | |||
| 1 | 2008-01-08 Katsumi Yamaoka <yamaoka@jpl.org> | 105 | 2008-01-08 Katsumi Yamaoka <yamaoka@jpl.org> |
| 2 | 106 | ||
| 3 | * gnus-bookmark.el (gnus-bookmark-mouse-available-p): Don't test for | 107 | * gnus-bookmark.el (gnus-bookmark-mouse-available-p): Don't test for |
| @@ -19,12 +123,6 @@ | |||
| 19 | * mml-sec.el, sieve-manage.el, smime.el: Simplify loading of | 123 | * mml-sec.el, sieve-manage.el, smime.el: Simplify loading of |
| 20 | password-cache or password. Suggested by Glenn Morris <rgm@gnu.org>. | 124 | password-cache or password. Suggested by Glenn Morris <rgm@gnu.org>. |
| 21 | 125 | ||
| 22 | 2007-12-21 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 23 | |||
| 24 | * imap.el (imap-authenticate): Use current-buffer instead of buffer, | ||
| 25 | for the cases where imap-authenticate is called with a nil buffer | ||
| 26 | parameter. | ||
| 27 | |||
| 28 | 2007-12-19 Katsumi Yamaoka <yamaoka@jpl.org> | 126 | 2007-12-19 Katsumi Yamaoka <yamaoka@jpl.org> |
| 29 | 127 | ||
| 30 | * gnus-art.el (gnus-article-browse-html-parts): Work for two or more | 128 | * gnus-art.el (gnus-article-browse-html-parts): Work for two or more |
| @@ -328,12 +426,6 @@ | |||
| 328 | 426 | ||
| 329 | * message.el (message-ignored-supersedes-headers): Add "X-ID". | 427 | * message.el (message-ignored-supersedes-headers): Add "X-ID". |
| 330 | 428 | ||
| 331 | 2007-12-03 Nathan J. Williams <nathanw@MIT.EDU> (tiny change) | ||
| 332 | |||
| 333 | * imap.el (imap-mailbox-status-asynch): Upcase STATUS items. | ||
| 334 | (imap-parse-status): Upcase status-att for servers that sends them | ||
| 335 | lower-case (e.g., MS Exchange 2007). | ||
| 336 | |||
| 337 | 2007-12-03 Lars Magne Ingebrigtsen <larsi@gnus.org> | 429 | 2007-12-03 Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 338 | 430 | ||
| 339 | * gnus-sum.el (gnus-uu-extract-map): Add a command for the yenc | 431 | * gnus-sum.el (gnus-uu-extract-map): Add a command for the yenc |
| @@ -801,9 +893,6 @@ | |||
| 801 | * webmail.el (webmail-debug): Replace mapcar called for effect with | 893 | * webmail.el (webmail-debug): Replace mapcar called for effect with |
| 802 | dolist. | 894 | dolist. |
| 803 | 895 | ||
| 804 | * gnus-xmas.el (gnus-group-add-icon): Replace mapcar called for effect | ||
| 805 | with mapc. | ||
| 806 | |||
| 807 | 2007-10-24 Katsumi Yamaoka <yamaoka@jpl.org> | 896 | 2007-10-24 Katsumi Yamaoka <yamaoka@jpl.org> |
| 808 | 897 | ||
| 809 | * gnus-agent.el (gnus-agent-read-agentview, gnus-agent-save-alist) | 898 | * gnus-agent.el (gnus-agent-read-agentview, gnus-agent-save-alist) |
diff --git a/lisp/gnus/ecomplete.el b/lisp/gnus/ecomplete.el index 285aca4270a..e0b759c33eb 100644 --- a/lisp/gnus/ecomplete.el +++ b/lisp/gnus/ecomplete.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; ecomplete.el --- electric completion of addresses and the like | 1 | ;;; ecomplete.el --- electric completion of addresses and the like |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | 5 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 6 | ;; Keywords: mail | 6 | ;; Keywords: mail |
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index fda62bc79aa..f93a304be46 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el | |||
| @@ -4215,6 +4215,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is | |||
| 4215 | "F" gnus-article-followup-with-original | 4215 | "F" gnus-article-followup-with-original |
| 4216 | "\C-hk" gnus-article-describe-key | 4216 | "\C-hk" gnus-article-describe-key |
| 4217 | "\C-hc" gnus-article-describe-key-briefly | 4217 | "\C-hc" gnus-article-describe-key-briefly |
| 4218 | "\C-hb" gnus-article-describe-bindings | ||
| 4218 | 4219 | ||
| 4219 | "\C-d" gnus-article-read-summary-keys | 4220 | "\C-d" gnus-article-read-summary-keys |
| 4220 | "\M-*" gnus-article-read-summary-keys | 4221 | "\M-*" gnus-article-read-summary-keys |
| @@ -4225,6 +4226,13 @@ If variable `gnus-use-long-file-name' is non-nil, it is | |||
| 4225 | (substitute-key-definition | 4226 | (substitute-key-definition |
| 4226 | 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) | 4227 | 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) |
| 4227 | 4228 | ||
| 4229 | (gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map) | ||
| 4230 | "W" gnus-article-wide-reply-with-original) | ||
| 4231 | (if (featurep 'xemacs) | ||
| 4232 | (set-keymap-default-binding gnus-article-send-map | ||
| 4233 | 'gnus-article-read-summary-send-keys) | ||
| 4234 | (define-key gnus-article-send-map [t] 'gnus-article-read-summary-send-keys)) | ||
| 4235 | |||
| 4228 | (defun gnus-article-make-menu-bar () | 4236 | (defun gnus-article-make-menu-bar () |
| 4229 | (unless (boundp 'gnus-article-commands-menu) | 4237 | (unless (boundp 'gnus-article-commands-menu) |
| 4230 | (gnus-summary-make-menu-bar)) | 4238 | (gnus-summary-make-menu-bar)) |
| @@ -5447,9 +5455,7 @@ N is the numerical prefix." | |||
| 5447 | (mail-content-type-get (mm-handle-type handle) 'url) | 5455 | (mail-content-type-get (mm-handle-type handle) 'url) |
| 5448 | "")) | 5456 | "")) |
| 5449 | (gnus-tmp-type (mm-handle-media-type handle)) | 5457 | (gnus-tmp-type (mm-handle-media-type handle)) |
| 5450 | (gnus-tmp-description | 5458 | (gnus-tmp-description (or (mm-handle-description handle) "")) |
| 5451 | (mail-decode-encoded-word-string (or (mm-handle-description handle) | ||
| 5452 | ""))) | ||
| 5453 | (gnus-tmp-dots | 5459 | (gnus-tmp-dots |
| 5454 | (if (if displayed (car displayed) | 5460 | (if (if displayed (car displayed) |
| 5455 | (mm-handle-displayed-p handle)) | 5461 | (mm-handle-displayed-p handle)) |
| @@ -6234,26 +6240,27 @@ not have a face in `gnus-article-boring-faces'." | |||
| 6234 | "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" | 6240 | "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" |
| 6235 | "=" "^" "\M-^" "|")) | 6241 | "=" "^" "\M-^" "|")) |
| 6236 | (nosave-but-article | 6242 | (nosave-but-article |
| 6237 | '("A\r")) | 6243 | '("A " "A<" "A>" "AM" "AP" "AR" "AT" "A\C-?" "A\M-\r" "A\r" "Ab" "Ae" |
| 6244 | "An" "Ap" [?A (meta return)] [?A delete])) | ||
| 6238 | (nosave-in-article | 6245 | (nosave-in-article |
| 6239 | '("\C-d")) | 6246 | '("AS" "\C-d")) |
| 6240 | (up-to-top | 6247 | (up-to-top |
| 6241 | '("n" "Gn" "p" "Gp")) | 6248 | '("n" "Gn" "p" "Gp")) |
| 6242 | keys new-sum-point) | 6249 | keys new-sum-point) |
| 6243 | (save-excursion | 6250 | (save-excursion |
| 6244 | (set-buffer gnus-article-current-summary) | 6251 | (set-buffer gnus-article-current-summary) |
| 6245 | (let (gnus-pick-mode) | 6252 | (let (gnus-pick-mode) |
| 6246 | (push (or key last-command-event) unread-command-events) | 6253 | (setq unread-command-events (nconc unread-command-events |
| 6247 | (setq keys (if (featurep 'xemacs) | 6254 | (list (or key last-command-event))) |
| 6248 | (events-to-keys (read-key-sequence nil)) | 6255 | keys (if (featurep 'xemacs) |
| 6249 | (read-key-sequence nil))))) | 6256 | (events-to-keys (read-key-sequence nil t)) |
| 6257 | (read-key-sequence nil t))))) | ||
| 6250 | 6258 | ||
| 6251 | (message "") | 6259 | (message "") |
| 6252 | 6260 | ||
| 6253 | (cond | 6261 | (cond |
| 6254 | ((eq (aref keys (1- (length keys))) ?\C-h) | 6262 | ((eq (aref keys (1- (length keys))) ?\C-h) |
| 6255 | (with-current-buffer gnus-article-current-summary | 6263 | (gnus-article-describe-bindings (substring keys 0 -1))) |
| 6256 | (describe-bindings (substring keys 0 -1)))) | ||
| 6257 | ((or (member keys nosaves) | 6264 | ((or (member keys nosaves) |
| 6258 | (member keys nosave-but-article) | 6265 | (member keys nosave-but-article) |
| 6259 | (member keys nosave-in-article)) | 6266 | (member keys nosave-in-article)) |
| @@ -6339,53 +6346,98 @@ not have a face in `gnus-article-boring-faces'." | |||
| 6339 | (signal (car err) (cdr err)) | 6346 | (signal (car err) (cdr err)) |
| 6340 | (ding)))))))) | 6347 | (ding)))))))) |
| 6341 | 6348 | ||
| 6349 | (defun gnus-article-read-summary-send-keys () | ||
| 6350 | (interactive) | ||
| 6351 | (let ((unread-command-events (list (gnus-character-to-event ?S)))) | ||
| 6352 | (gnus-article-read-summary-keys))) | ||
| 6353 | |||
| 6342 | (defun gnus-article-describe-key (key) | 6354 | (defun gnus-article-describe-key (key) |
| 6343 | "Display documentation of the function invoked by KEY. KEY is a string." | 6355 | "Display documentation of the function invoked by KEY. |
| 6344 | (interactive "kDescribe key: ") | 6356 | KEY is a string or a vector." |
| 6357 | (interactive (list (let ((cursor-in-echo-area t)) ;; better for XEmacs. | ||
| 6358 | (read-key-sequence "Describe key: ")))) | ||
| 6345 | (gnus-article-check-buffer) | 6359 | (gnus-article-check-buffer) |
| 6346 | (if (eq (key-binding key) 'gnus-article-read-summary-keys) | 6360 | (if (memq (key-binding key t) '(gnus-article-read-summary-keys |
| 6361 | gnus-article-read-summary-send-keys)) | ||
| 6347 | (save-excursion | 6362 | (save-excursion |
| 6348 | (set-buffer gnus-article-current-summary) | 6363 | (set-buffer gnus-article-current-summary) |
| 6349 | (let (gnus-pick-mode) | 6364 | (setq unread-command-events |
| 6350 | (if (featurep 'xemacs) | 6365 | (if (featurep 'xemacs) |
| 6351 | (progn | 6366 | (append key nil) |
| 6352 | (push (elt key 0) unread-command-events) | 6367 | (mapcar (lambda (x) (if (and (integerp x) (>= x 128)) |
| 6353 | (setq key (events-to-keys | 6368 | (list 'meta (- x 128)) |
| 6354 | (read-key-sequence "Describe key: ")))) | 6369 | x)) |
| 6355 | (setq unread-command-events | 6370 | key))) |
| 6356 | (mapcar | 6371 | (let ((cursor-in-echo-area t) |
| 6357 | (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x)) | 6372 | gnus-pick-mode) |
| 6358 | (string-to-list key))) | 6373 | (describe-key (read-key-sequence nil t)))) |
| 6359 | (setq key (read-key-sequence "Describe key: ")))) | ||
| 6360 | (describe-key key)) | ||
| 6361 | (describe-key key))) | 6374 | (describe-key key))) |
| 6362 | 6375 | ||
| 6363 | (defun gnus-article-describe-key-briefly (key &optional insert) | 6376 | (defun gnus-article-describe-key-briefly (key &optional insert) |
| 6364 | "Display documentation of the function invoked by KEY. KEY is a string." | 6377 | "Display documentation of the function invoked by KEY. |
| 6365 | (interactive "kDescribe key: \nP") | 6378 | KEY is a string or a vector." |
| 6379 | (interactive (list (let ((cursor-in-echo-area t)) ;; better for XEmacs. | ||
| 6380 | (read-key-sequence "Describe key: ")) | ||
| 6381 | current-prefix-arg)) | ||
| 6366 | (gnus-article-check-buffer) | 6382 | (gnus-article-check-buffer) |
| 6367 | (if (eq (key-binding key) 'gnus-article-read-summary-keys) | 6383 | (if (memq (key-binding key t) '(gnus-article-read-summary-keys |
| 6384 | gnus-article-read-summary-send-keys)) | ||
| 6368 | (save-excursion | 6385 | (save-excursion |
| 6369 | (set-buffer gnus-article-current-summary) | 6386 | (set-buffer gnus-article-current-summary) |
| 6370 | (let (gnus-pick-mode) | 6387 | (setq unread-command-events |
| 6371 | (if (featurep 'xemacs) | 6388 | (if (featurep 'xemacs) |
| 6372 | (progn | 6389 | (append key nil) |
| 6373 | (push (elt key 0) unread-command-events) | 6390 | (mapcar (lambda (x) (if (and (integerp x) (>= x 128)) |
| 6374 | (setq key (events-to-keys | 6391 | (list 'meta (- x 128)) |
| 6375 | (read-key-sequence "Describe key: ")))) | 6392 | x)) |
| 6376 | (setq unread-command-events | 6393 | key))) |
| 6377 | (mapcar | 6394 | (let ((cursor-in-echo-area t) |
| 6378 | (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x)) | 6395 | gnus-pick-mode) |
| 6379 | (string-to-list key))) | 6396 | (describe-key-briefly (read-key-sequence nil t) insert))) |
| 6380 | (setq key (read-key-sequence "Describe key: ")))) | ||
| 6381 | (describe-key-briefly key insert)) | ||
| 6382 | (describe-key-briefly key insert))) | 6397 | (describe-key-briefly key insert))) |
| 6383 | 6398 | ||
| 6399 | ;;`gnus-agent-mode' in gnus-agent.el will define it. | ||
| 6400 | (defvar gnus-agent-summary-mode) | ||
| 6401 | |||
| 6402 | (defun gnus-article-describe-bindings (&optional prefix) | ||
| 6403 | "Show a list of all defined keys, and their definitions. | ||
| 6404 | The optional argument PREFIX, if non-nil, should be a key sequence; | ||
| 6405 | then we display only bindings that start with that prefix." | ||
| 6406 | (interactive) | ||
| 6407 | (gnus-article-check-buffer) | ||
| 6408 | (let ((keymap (copy-keymap gnus-article-mode-map)) | ||
| 6409 | (map (copy-keymap gnus-article-send-map)) | ||
| 6410 | (sumkeys (where-is-internal 'gnus-article-read-summary-keys)) | ||
| 6411 | agent) | ||
| 6412 | (define-key keymap "S" map) | ||
| 6413 | (define-key map [t] nil) | ||
| 6414 | (with-current-buffer gnus-article-current-summary | ||
| 6415 | (set-keymap-parent map (key-binding "S")) | ||
| 6416 | (let (def gnus-pick-mode) | ||
| 6417 | (dolist (key sumkeys) | ||
| 6418 | (when (setq def (key-binding key)) | ||
| 6419 | (define-key keymap key def)))) | ||
| 6420 | (when (boundp 'gnus-agent-summary-mode) | ||
| 6421 | (setq agent gnus-agent-summary-mode))) | ||
| 6422 | (with-temp-buffer | ||
| 6423 | (use-local-map keymap) | ||
| 6424 | (set (make-local-variable 'gnus-agent-summary-mode) agent) | ||
| 6425 | (describe-bindings prefix)) | ||
| 6426 | (let ((item `((lambda (prefix) | ||
| 6427 | (save-excursion | ||
| 6428 | (set-buffer ,(current-buffer)) | ||
| 6429 | (gnus-article-describe-bindings prefix))) | ||
| 6430 | ,prefix))) | ||
| 6431 | (with-current-buffer (if (fboundp 'help-buffer) | ||
| 6432 | (let (help-xref-following) (help-buffer)) | ||
| 6433 | "*Help*") ;; Emacs 21 | ||
| 6434 | (setq help-xref-stack-item item))))) | ||
| 6435 | |||
| 6384 | (defun gnus-article-reply-with-original (&optional wide) | 6436 | (defun gnus-article-reply-with-original (&optional wide) |
| 6385 | "Start composing a reply mail to the current message. | 6437 | "Start composing a reply mail to the current message. |
| 6386 | The text in the region will be yanked. If the region isn't active, | 6438 | The text in the region will be yanked. If the region isn't active, |
| 6387 | the entire article will be yanked." | 6439 | the entire article will be yanked." |
| 6388 | (interactive "P") | 6440 | (interactive) |
| 6389 | (let ((article (cdr gnus-article-current)) | 6441 | (let ((article (cdr gnus-article-current)) |
| 6390 | contents) | 6442 | contents) |
| 6391 | (if (not (gnus-region-active-p)) | 6443 | (if (not (gnus-region-active-p)) |
| @@ -6400,6 +6452,13 @@ the entire article will be yanked." | |||
| 6400 | (gnus-summary-reply | 6452 | (gnus-summary-reply |
| 6401 | (list (list article contents)) wide))))) | 6453 | (list (list article contents)) wide))))) |
| 6402 | 6454 | ||
| 6455 | (defun gnus-article-wide-reply-with-original () | ||
| 6456 | "Start composing a wide reply mail to the current message. | ||
| 6457 | The text in the region will be yanked. If the region isn't active, | ||
| 6458 | the entire article will be yanked." | ||
| 6459 | (interactive) | ||
| 6460 | (gnus-article-reply-with-original t)) | ||
| 6461 | |||
| 6403 | (defun gnus-article-followup-with-original () | 6462 | (defun gnus-article-followup-with-original () |
| 6404 | "Compose a followup to the current article. | 6463 | "Compose a followup to the current article. |
| 6405 | The text in the region will be yanked. If the region isn't active, | 6464 | The text in the region will be yanked. If the region isn't active, |
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index 41f9dd0baca..ddfc559e12e 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; gnus-bookmark.el --- Bookmarks in Gnus | 1 | ;;; gnus-bookmark.el --- Bookmarks in Gnus |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Bastien Guerry <bzg AT altern DOT org> | 5 | ;; Author: Bastien Guerry <bzg AT altern DOT org> |
| 6 | ;; Keywords: news | 6 | ;; Keywords: news |
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 2be0b6e5c80..ee5068e980d 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el | |||
| @@ -2320,44 +2320,94 @@ Return the name of the group if selection was successful." | |||
| 2320 | (message "Quit reading the ephemeral group") | 2320 | (message "Quit reading the ephemeral group") |
| 2321 | nil))))) | 2321 | nil))))) |
| 2322 | 2322 | ||
| 2323 | (defvar gnus-group-gmane-group-download-format | 2323 | (defcustom gnus-group-gmane-group-download-format |
| 2324 | "http://download.gmane.org/%s/%s/%s") | 2324 | "http://download.gmane.org/%s/%s/%s" |
| 2325 | (autoload 'url-insert-file-contents "url-handlers") | 2325 | "URL for downloading mbox files. |
| 2326 | It must contain three \"%s\". They correspond to the group, the | ||
| 2327 | minimal and maximal article numbers, respectively." | ||
| 2328 | :group 'gnus-group-foreign | ||
| 2329 | :version "23.0" ;; No Gnus | ||
| 2330 | :type 'string) | ||
| 2326 | 2331 | ||
| 2327 | ;; FIXME: Make gnus-group-gmane-group-download-format customizable. Add | 2332 | (autoload 'url-insert-file-contents "url-handlers") |
| 2328 | ;; documentation, menu, key bindings... | 2333 | ;; FIXME: |
| 2334 | ;; - Add documentation, menu, key bindings, ... | ||
| 2329 | 2335 | ||
| 2330 | (defun gnus-group-read-ephemeral-gmane-group (group start end) | 2336 | (defun gnus-group-read-ephemeral-gmane-group (group start &optional range) |
| 2331 | "Read articles from Gmane group GROUP as an ephemeral group. | 2337 | "Read articles from Gmane group GROUP as an ephemeral group. |
| 2332 | START and END specify the articles range. The articles are | 2338 | START is the first article. RANGE specifies how many articles |
| 2333 | downloaded via HTTP using the URL specified by | 2339 | are fetched. The articles are downloaded via HTTP using the URL |
| 2334 | `gnus-group-gmane-group-download-format'." | 2340 | specified by `gnus-group-gmane-group-download-format'." |
| 2335 | ;; See <http://gmane.org/export.php> for more information. | 2341 | ;; See <http://gmane.org/export.php> for more information. |
| 2336 | (interactive | 2342 | (interactive |
| 2337 | (list | 2343 | (list |
| 2338 | (gnus-group-completing-read "Gmane group: ") | 2344 | (gnus-group-completing-read "Gmane group: ") |
| 2339 | (read-number "Start article number: ") | 2345 | (read-number "Start article number: ") |
| 2340 | (read-number "End article number: "))) | 2346 | (read-number "How many articles: "))) |
| 2341 | (when (< (- end start) 0) | 2347 | (unless range (setq range 500)) |
| 2342 | (error "Invalid range.")) | 2348 | (when (< range 1) |
| 2343 | (when (> (- end start) | 2349 | (error "Invalid range: %s" range)) |
| 2344 | (min (or gnus-large-ephemeral-newsgroup 100) 100)) | 2350 | (let ((tmpfile (make-temp-file |
| 2345 | (unless (y-or-n-p | 2351 | (format "%s.start-%s.range-%s." group start range))) |
| 2346 | (format "Large range (%s to %s), continue anyway? " | 2352 | (gnus-thread-sort-functions '(gnus-thread-sort-by-number))) |
| 2347 | start end)) | ||
| 2348 | (error "Range too large. Aborted."))) | ||
| 2349 | (let ((tmpfile (make-temp-file "gmane.gnus-temp-group-"))) | ||
| 2350 | (with-temp-file tmpfile | 2353 | (with-temp-file tmpfile |
| 2351 | (url-insert-file-contents | 2354 | (url-insert-file-contents |
| 2352 | (format gnus-group-gmane-group-download-format | 2355 | (format gnus-group-gmane-group-download-format |
| 2353 | group start end)) | 2356 | group start (+ start range))) |
| 2354 | (write-region (point-min) (point-max) tmpfile) | 2357 | (write-region (point-min) (point-max) tmpfile) |
| 2355 | (gnus-group-read-ephemeral-group | 2358 | (gnus-group-read-ephemeral-group |
| 2356 | "rs-gnus-read-gmane" | 2359 | (format "%s.start-%s.range-%s" group start range) |
| 2357 | `(nndoc ,tmpfile | 2360 | `(nndoc ,tmpfile |
| 2358 | (nndoc-article-type guess)))) | 2361 | (nndoc-article-type guess)))) |
| 2359 | (delete-file tmpfile))) | 2362 | (delete-file tmpfile))) |
| 2360 | 2363 | ||
| 2364 | (defun gnus-group-read-ephemeral-gmane-group-url (url) | ||
| 2365 | "Create an ephemeral Gmane group from URL. | ||
| 2366 | |||
| 2367 | Valid input formats include: | ||
| 2368 | \"http://thread.gmane.org/gmane.foo.bar/12300/focus=12399\", | ||
| 2369 | \"http://thread.gmane.org/gmane.foo.bar/12345/\", | ||
| 2370 | \"http://article.gmane.org/gmane.foo.bar/12345/\", | ||
| 2371 | \"http://news.gmane.org/group/gmane.foo.bar/thread=12345\"" | ||
| 2372 | ;; - Feel free to add other useful Gmane URLs here! Maybe the URLs should | ||
| 2373 | ;; be customizable? | ||
| 2374 | ;; - The URLs should be added to `gnus-button-alist'. Probably we should | ||
| 2375 | ;; prompt the user to decide: "View via `browse-url' or in Gnus? " | ||
| 2376 | ;; (`gnus-group-read-ephemeral-gmane-group-url') | ||
| 2377 | (interactive | ||
| 2378 | (list (gnus-group-completing-read "Gmane URL: "))) | ||
| 2379 | (let (group start range) | ||
| 2380 | (cond | ||
| 2381 | ;; URLs providing `group', `start' and `range': | ||
| 2382 | ((string-match | ||
| 2383 | ;; http://thread.gmane.org/gmane.emacs.devel/86326/focus=86525 | ||
| 2384 | "^http://thread\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)/focus=\\([0-9]+\\)$" | ||
| 2385 | url) | ||
| 2386 | (setq group (match-string 1 url) | ||
| 2387 | start (string-to-number (match-string 2 url)) | ||
| 2388 | ;; Ensure that `range' is large enough to ensure focus article is | ||
| 2389 | ;; included. | ||
| 2390 | range (- (string-to-number (match-string 3 url)) | ||
| 2391 | start -1))) | ||
| 2392 | ;; URLs providing `group' and `start': | ||
| 2393 | ((or (string-match | ||
| 2394 | ;; http://article.gmane.org/gmane.comp.gnu.make.bugs/3584 | ||
| 2395 | "^http://\\(?:thread\\|article\\)\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)" | ||
| 2396 | url) | ||
| 2397 | (string-match | ||
| 2398 | ;; Don't advertize these in the doc string yet: | ||
| 2399 | "^\\(?:nntp\\|news\\)://news\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)" | ||
| 2400 | url) | ||
| 2401 | (string-match | ||
| 2402 | ;; http://news.gmane.org/group/gmane.emacs.gnus.general/thread=65099/force_load=t | ||
| 2403 | "^http://news\.gmane\.org/group/\\([^/]+\\)/thread=\\([0-9]+\\)" | ||
| 2404 | url)) | ||
| 2405 | (setq group (match-string 1 url) | ||
| 2406 | start (string-to-number (match-string 2 url)))) | ||
| 2407 | (t | ||
| 2408 | (error "Can't parse URL %s" url))) | ||
| 2409 | (gnus-group-read-ephemeral-gmane-group group start range))) | ||
| 2410 | |||
| 2361 | (defun gnus-group-jump-to-group (group &optional prompt) | 2411 | (defun gnus-group-jump-to-group (group &optional prompt) |
| 2362 | "Jump to newsgroup GROUP. | 2412 | "Jump to newsgroup GROUP. |
| 2363 | 2413 | ||
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index b879c90e91f..4c2e77e4d46 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el | |||
| @@ -78,6 +78,17 @@ | |||
| 78 | :test 'equal) | 78 | :test 'equal) |
| 79 | "*The article registry by Message ID.") | 79 | "*The article registry by Message ID.") |
| 80 | 80 | ||
| 81 | (defcustom gnus-registry-marks | ||
| 82 | '(Important Work Personal To-Do Later) | ||
| 83 | "List of marks that `gnus-registry-mark-article' will offer for completion." | ||
| 84 | :group 'gnus-registry | ||
| 85 | :type '(repeat symbol)) | ||
| 86 | |||
| 87 | (defcustom gnus-registry-default-mark 'To-Do | ||
| 88 | "The default mark." | ||
| 89 | :group 'gnus-registry | ||
| 90 | :type 'symbol) | ||
| 91 | |||
| 81 | (defcustom gnus-registry-unfollowed-groups '("delayed$" "drafts$" "queue$" "INBOX$") | 92 | (defcustom gnus-registry-unfollowed-groups '("delayed$" "drafts$" "queue$" "INBOX$") |
| 82 | "List of groups that gnus-registry-split-fancy-with-parent won't return. | 93 | "List of groups that gnus-registry-split-fancy-with-parent won't return. |
| 83 | The group names are matched, they don't have to be fully | 94 | The group names are matched, they don't have to be fully |
| @@ -129,6 +140,16 @@ way." | |||
| 129 | :group 'gnus-registry | 140 | :group 'gnus-registry |
| 130 | :type 'boolean) | 141 | :type 'boolean) |
| 131 | 142 | ||
| 143 | (defcustom gnus-registry-extra-entries-precious '(marks) | ||
| 144 | "What extra entries are precious, meaning they won't get trimmed. | ||
| 145 | When you save the Gnus registry, it's trimmed to be no longer | ||
| 146 | than `gnus-registry-max-entries' (which is nil by default, so no | ||
| 147 | trimming happens). Any entries with extra data in this list (by | ||
| 148 | default, marks are included, so articles with marks are | ||
| 149 | considered precious) will not be trimmed." | ||
| 150 | :group 'gnus-registry | ||
| 151 | :type '(repeat symbol)) | ||
| 152 | |||
| 132 | (defcustom gnus-registry-cache-file | 153 | (defcustom gnus-registry-cache-file |
| 133 | (nnheader-concat | 154 | (nnheader-concat |
| 134 | (or gnus-dribble-directory gnus-home-directory "~/") | 155 | (or gnus-dribble-directory gnus-home-directory "~/") |
| @@ -313,30 +334,50 @@ way." | |||
| 313 | 334 | ||
| 314 | (defun gnus-registry-trim (alist) | 335 | (defun gnus-registry-trim (alist) |
| 315 | "Trim alist to size, using gnus-registry-max-entries. | 336 | "Trim alist to size, using gnus-registry-max-entries. |
| 316 | Also, drop all gnus-registry-ignored-groups matches." | 337 | Also, drop all gnus-registry-ignored-groups matches. |
| 317 | (if (null gnus-registry-max-entries) | 338 | Any entries with extra data (marks, currently) are left alone." |
| 339 | (if (null gnus-registry-max-entries) | ||
| 318 | alist ; just return the alist | 340 | alist ; just return the alist |
| 319 | ;; else, when given max-entries, trim the alist | 341 | ;; else, when given max-entries, trim the alist |
| 320 | (let* ((timehash (make-hash-table | 342 | (let* ((timehash (make-hash-table |
| 321 | :size 4096 | 343 | :size 20000 |
| 344 | :test 'equal)) | ||
| 345 | (precious (make-hash-table | ||
| 346 | :size 20000 | ||
| 322 | :test 'equal)) | 347 | :test 'equal)) |
| 323 | (trim-length (- (length alist) gnus-registry-max-entries)) | 348 | (trim-length (- (length alist) gnus-registry-max-entries)) |
| 324 | (trim-length (if (natnump trim-length) trim-length 0))) | 349 | (trim-length (if (natnump trim-length) trim-length 0)) |
| 350 | precious-list junk-list) | ||
| 325 | (maphash | 351 | (maphash |
| 326 | (lambda (key value) | 352 | (lambda (key value) |
| 327 | (puthash key (gnus-registry-fetch-extra key 'mtime) timehash)) | 353 | (let ((extra (gnus-registry-fetch-extra key))) |
| 354 | (dolist (item gnus-registry-extra-entries-precious) | ||
| 355 | (dolist (e extra) | ||
| 356 | (when (equal (nth 0 e) item) | ||
| 357 | (puthash key t precious) | ||
| 358 | (return)))) | ||
| 359 | (puthash key (gnus-registry-fetch-extra key 'mtime) timehash))) | ||
| 328 | gnus-registry-hashtb) | 360 | gnus-registry-hashtb) |
| 329 | |||
| 330 | ;; we use the return value of this setq, which is the trimmed alist | ||
| 331 | (setq alist | ||
| 332 | (nthcdr | ||
| 333 | trim-length | ||
| 334 | (sort alist | ||
| 335 | (lambda (a b) | ||
| 336 | (time-less-p | ||
| 337 | (or (cdr (gethash (car a) timehash)) '(0 0 0)) | ||
| 338 | (or (cdr (gethash (car b) timehash)) '(0 0 0)))))))))) | ||
| 339 | 361 | ||
| 362 | (dolist (item alist) | ||
| 363 | (let ((key (nth 0 item))) | ||
| 364 | (if (gethash key precious) | ||
| 365 | (push item precious-list) | ||
| 366 | (push item junk-list)))) | ||
| 367 | |||
| 368 | (sort | ||
| 369 | junk-list | ||
| 370 | (lambda (a b) | ||
| 371 | (let ((t1 (or (cdr (gethash (car a) timehash)) | ||
| 372 | '(0 0 0))) | ||
| 373 | (t2 (or (cdr (gethash (car b) timehash)) | ||
| 374 | '(0 0 0)))) | ||
| 375 | (time-less-p t1 t2)))) | ||
| 376 | |||
| 377 | ;; we use the return value of this setq, which is the trimmed alist | ||
| 378 | (setq alist (append precious-list | ||
| 379 | (nthcdr trim-length junk-list)))))) | ||
| 380 | |||
| 340 | (defun gnus-registry-action (action data-header from &optional to method) | 381 | (defun gnus-registry-action (action data-header from &optional to method) |
| 341 | (let* ((id (mail-header-id data-header)) | 382 | (let* ((id (mail-header-id data-header)) |
| 342 | (subject (gnus-string-remove-all-properties | 383 | (subject (gnus-string-remove-all-properties |
| @@ -577,6 +618,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." | |||
| 577 | (assoc article (gnus-data-list nil))))) | 618 | (assoc article (gnus-data-list nil))))) |
| 578 | nil)) | 619 | nil)) |
| 579 | 620 | ||
| 621 | ;;; this should be redone with catch/throw | ||
| 580 | (defun gnus-registry-grep-in-list (word list) | 622 | (defun gnus-registry-grep-in-list (word list) |
| 581 | (when word | 623 | (when word |
| 582 | (memq nil | 624 | (memq nil |
| @@ -586,80 +628,91 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." | |||
| 586 | (string-match word x)) | 628 | (string-match word x)) |
| 587 | list))))) | 629 | list))))) |
| 588 | 630 | ||
| 589 | (defun gnus-registry-mark-article (article &optional mark remove) | 631 | |
| 590 | "Mark ARTICLE with MARK in the Gnus registry or remove MARK. | 632 | (defun gnus-registry-read-mark () |
| 591 | MARK can be any symbol. If ARTICLE is nil, then the | 633 | "Read a mark name from the user with completion." |
| 592 | `gnus-current-article' will be marked. If MARK is nil, | 634 | (let ((mark (gnus-completing-read-with-default |
| 593 | `gnus-registry-flag-default' will be used." | 635 | (symbol-name gnus-registry-default-mark) |
| 594 | (interactive "nArticle number: ") | 636 | "Label" |
| 595 | (let ((article (or article gnus-current-article)) | 637 | (mapcar (lambda (x) ; completion list |
| 596 | (mark (or mark 'gnus-registry-flag-default)) | 638 | (cons (symbol-name x) x)) |
| 597 | article-id) | 639 | gnus-registry-marks)))) |
| 598 | (unless article | 640 | (when (stringp mark) |
| 599 | (error "No article on current line")) | 641 | (intern mark)))) |
| 600 | (setq article-id | 642 | |
| 601 | (gnus-registry-fetch-message-id-fast gnus-current-article)) | 643 | (defun gnus-registry-set-article-mark (&rest articles) |
| 602 | (unless article-id | 644 | "Apply a mark to process-marked ARTICLES." |
| 603 | (error "No article ID could be retrieved")) | 645 | (interactive (gnus-summary-work-articles current-prefix-arg)) |
| 604 | (let* ( | 646 | (gnus-registry-set-article-mark-internal (gnus-registry-read-mark) articles nil t)) |
| 605 | ;; all the marks for this article | 647 | |
| 606 | (marks (gnus-registry-fetch-extra-flags article-id)) | 648 | (defun gnus-registry-remove-article-mark (&rest articles) |
| 607 | ;; the marks without the mark of interest | 649 | "Remove a mark from process-marked ARTICLES." |
| 608 | (cleaned-marks (delq mark marks)) | 650 | (interactive (gnus-summary-work-articles current-prefix-arg)) |
| 609 | ;; the new marks we want to use | 651 | (gnus-registry-set-article-mark-internal (gnus-registry-read-mark) articles t t)) |
| 610 | (new-marks (if remove | 652 | |
| 611 | cleaned-marks | 653 | (defun gnus-registry-set-article-mark-internal (mark articles &optional remove show-message) |
| 612 | (cons mark cleaned-marks)))) | 654 | "Apply a mark to a list of ARTICLES." |
| 613 | (apply 'gnus-registry-store-extra-flags ; set the extra flags | 655 | (let ((article-id-list |
| 614 | article-id ; for the message ID | 656 | (mapcar 'gnus-registry-fetch-message-id-fast articles))) |
| 615 | new-marks) | 657 | (dolist (id article-id-list) |
| 616 | (gnus-registry-fetch-extra-flags article-id)))) | 658 | (let* ( |
| 617 | 659 | ;; all the marks for this article without the mark of | |
| 618 | (defun gnus-registry-article-marks (article) | 660 | ;; interest |
| 619 | "Get the Gnus registry marks for ARTICLE. | 661 | (marks |
| 620 | If ARTICLE is nil, then the `gnus-current-article' will be | 662 | (delq mark (gnus-registry-fetch-extra-marks id))) |
| 621 | used." | 663 | ;; the new marks we want to use |
| 622 | (interactive "nArticle number: ") | 664 | (new-marks (if remove |
| 623 | (let ((article (or article gnus-current-article)) | 665 | marks |
| 624 | article-id) | 666 | (cons mark marks)))) |
| 625 | (unless article | 667 | (when show-message |
| 626 | (error "No article on current line")) | 668 | (gnus-message 1 "%s mark %s with message ID %s, resulting in %S" |
| 627 | (setq article-id | 669 | (if remove "Removing" "Adding") |
| 628 | (gnus-registry-fetch-message-id-fast gnus-current-article)) | 670 | mark id new-marks)) |
| 629 | (unless article-id | 671 | |
| 630 | (error "No article ID could be retrieved")) | 672 | (apply 'gnus-registry-store-extra-marks ; set the extra marks |
| 631 | (gnus-message 1 | 673 | id ; for the message ID |
| 632 | "Message ID %s, Registry flags: %s" | 674 | new-marks))))) |
| 633 | article-id | 675 | |
| 634 | (concat (gnus-registry-fetch-extra-flags article-id))))) | 676 | (defun gnus-registry-get-article-marks (&rest articles) |
| 635 | 677 | "Get the Gnus registry marks for ARTICLES and show them if interactive. | |
| 636 | 678 | Uses process/prefix conventions. For multiple articles, | |
| 637 | ;;; if this extends to more than 'flags, it should be improved to be more generic. | 679 | only the last one's marks are returned." |
| 638 | (defun gnus-registry-fetch-extra-flags (id) | 680 | (interactive (gnus-summary-work-articles 1)) |
| 639 | "Get the flags of a message, based on the message ID. | 681 | (let (marks) |
| 640 | Returns a list of symbol flags or nil." | 682 | (dolist (article articles) |
| 641 | (car-safe (cdr (gnus-registry-fetch-extra id 'flags)))) | 683 | (let ((article-id |
| 642 | 684 | (gnus-registry-fetch-message-id-fast article))) | |
| 643 | (defun gnus-registry-has-extra-flag (id flag) | 685 | (setq marks (gnus-registry-fetch-extra-marks article-id)))) |
| 644 | "Checks if a message has `flag', based on the message ID." | 686 | (when (interactive-p) |
| 645 | (memq flag (gnus-registry-fetch-extra-flags id))) | 687 | (gnus-message 1 "Marks are %S" marks)) |
| 646 | 688 | marks)) | |
| 647 | (defun gnus-registry-store-extra-flags (id &rest flag-list) | 689 | |
| 648 | "Set the flags of a message, based on the message ID. | 690 | ;;; if this extends to more than 'marks, it should be improved to be more generic. |
| 649 | The `flag-list' can be nil, in which case no flags are left." | 691 | (defun gnus-registry-fetch-extra-marks (id) |
| 650 | (gnus-registry-store-extra-entry id 'flags (list flag-list))) | 692 | "Get the marks of a message, based on the message ID. |
| 651 | 693 | Returns a list of symbol marks or nil." | |
| 652 | (defun gnus-registry-delete-extra-flags (id &rest flag-delete-list) | 694 | (car-safe (cdr (gnus-registry-fetch-extra id 'marks)))) |
| 653 | "Delete the message flags in `flag-delete-list', based on the message ID." | 695 | |
| 654 | (let ((flags (gnus-registry-fetch-extra-flags id))) | 696 | (defun gnus-registry-has-extra-mark (id mark) |
| 655 | (when flags | 697 | "Checks if a message has `mark', based on the message ID `id'." |
| 656 | (dolist (flag flag-delete-list) | 698 | (memq mark (gnus-registry-fetch-extra-marks id))) |
| 657 | (setq flags (delq flag flags)))) | 699 | |
| 658 | (gnus-registry-store-extra-flags id (car flags)))) | 700 | (defun gnus-registry-store-extra-marks (id &rest mark-list) |
| 659 | 701 | "Set the marks of a message, based on the message ID. | |
| 660 | (defun gnus-registry-delete-all-extra-flags (id) | 702 | The `mark-list' can be nil, in which case no marks are left." |
| 661 | "Delete all the flags for a message ID." | 703 | (gnus-registry-store-extra-entry id 'marks (list mark-list))) |
| 662 | (gnus-registry-store-extra-flags id nil)) | 704 | |
| 705 | (defun gnus-registry-delete-extra-marks (id &rest mark-delete-list) | ||
| 706 | "Delete the message marks in `mark-delete-list', based on the message ID." | ||
| 707 | (let ((marks (gnus-registry-fetch-extra-marks id))) | ||
| 708 | (when marks | ||
| 709 | (dolist (mark mark-delete-list) | ||
| 710 | (setq marks (delq mark marks)))) | ||
| 711 | (gnus-registry-store-extra-marks id (car marks)))) | ||
| 712 | |||
| 713 | (defun gnus-registry-delete-all-extra-marks (id) | ||
| 714 | "Delete all the marks for a message ID." | ||
| 715 | (gnus-registry-store-extra-marks id nil)) | ||
| 663 | 716 | ||
| 664 | (defun gnus-registry-fetch-extra (id &optional entry) | 717 | (defun gnus-registry-fetch-extra (id &optional entry) |
| 665 | "Get the extra data of a message, based on the message ID. | 718 | "Get the extra data of a message, based on the message ID. |
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index beccca289bc..52eab645d4e 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el | |||
| @@ -4797,11 +4797,11 @@ using some other form will lead to serious barfage." | |||
| 4797 | (gnus-thread-header h1) (gnus-thread-header h2))) | 4797 | (gnus-thread-header h1) (gnus-thread-header h2))) |
| 4798 | 4798 | ||
| 4799 | (defsubst gnus-article-sort-by-random (h1 h2) | 4799 | (defsubst gnus-article-sort-by-random (h1 h2) |
| 4800 | "Sort articles by article number." | 4800 | "Sort articles randomly." |
| 4801 | (zerop (random 2))) | 4801 | (zerop (random 2))) |
| 4802 | 4802 | ||
| 4803 | (defun gnus-thread-sort-by-random (h1 h2) | 4803 | (defun gnus-thread-sort-by-random (h1 h2) |
| 4804 | "Sort threads by root article number." | 4804 | "Sort threads randomly." |
| 4805 | (gnus-article-sort-by-random | 4805 | (gnus-article-sort-by-random |
| 4806 | (gnus-thread-header h1) (gnus-thread-header h2))) | 4806 | (gnus-thread-header h1) (gnus-thread-header h2))) |
| 4807 | 4807 | ||
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 9f9f9733110..01463c55628 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el | |||
| @@ -74,6 +74,8 @@ See Info node `(gnus)Mail Source Specifiers'." | |||
| 74 | (repeat :tag "List" | 74 | (repeat :tag "List" |
| 75 | (choice :format "%[Value Menu%] %v" | 75 | (choice :format "%[Value Menu%] %v" |
| 76 | :value (file) | 76 | :value (file) |
| 77 | (cons :tag "Group parameter `mail-source'" | ||
| 78 | (const :format "" group)) | ||
| 77 | (cons :tag "Spool file" | 79 | (cons :tag "Spool file" |
| 78 | (const :format "" file) | 80 | (const :format "" file) |
| 79 | (checklist :tag "Options" :greedy t | 81 | (checklist :tag "Options" :greedy t |
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 731d9924286..273d1c4ec5b 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el | |||
| @@ -5952,7 +5952,7 @@ beginning of header value. Therefore, repeated calls will toggle point | |||
| 5952 | between beginning of field and beginning of line." | 5952 | between beginning of field and beginning of line." |
| 5953 | (interactive "p") | 5953 | (interactive "p") |
| 5954 | (let ((zrs 'zmacs-region-stays)) | 5954 | (let ((zrs 'zmacs-region-stays)) |
| 5955 | (when (and (interactive-p) (boundp zrs)) | 5955 | (when (and (featurep 'xemacs) (interactive-p) (boundp zrs)) |
| 5956 | (set zrs t))) | 5956 | (set zrs t))) |
| 5957 | (if (and message-beginning-of-line | 5957 | (if (and message-beginning-of-line |
| 5958 | (message-point-in-header-p)) | 5958 | (message-point-in-header-p)) |
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 8e88ffca6bb..f832a9c28e1 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el | |||
| @@ -570,7 +570,10 @@ Postpone undisplaying of viewers for types in | |||
| 570 | ;; creates unibyte buffers. This `if', though not a perfect | 570 | ;; creates unibyte buffers. This `if', though not a perfect |
| 571 | ;; solution, avoids most of them. | 571 | ;; solution, avoids most of them. |
| 572 | (if from | 572 | (if from |
| 573 | (setq from (cadr (mail-extract-address-components from)))))) | 573 | (setq from (cadr (mail-extract-address-components from)))) |
| 574 | (if description | ||
| 575 | (setq description (mail-decode-encoded-word-string | ||
| 576 | description))))) | ||
| 574 | (if (or (not ctl) | 577 | (if (or (not ctl) |
| 575 | (not (string-match "/" (car ctl)))) | 578 | (not (string-match "/" (car ctl)))) |
| 576 | (mm-dissect-singlepart | 579 | (mm-dissect-singlepart |
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index da2e5bbbfc9..c335e985d0e 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el | |||
| @@ -874,14 +874,19 @@ If HANDLES is non-nil, use it instead reparsing the buffer." | |||
| 874 | 874 | ||
| 875 | (defun mml-to-mime () | 875 | (defun mml-to-mime () |
| 876 | "Translate the current buffer from MML to MIME." | 876 | "Translate the current buffer from MML to MIME." |
| 877 | (message-encode-message-body) | 877 | ;; `message-encode-message-body' will insert an encoded Content-Description |
| 878 | ;; header in the message header if the body contains a single part | ||
| 879 | ;; that is specified by a user with a MML tag containing a description | ||
| 880 | ;; token. So, we encode the message header first to prevent the encoded | ||
| 881 | ;; Content-Description header from being encoded again. | ||
| 878 | (save-restriction | 882 | (save-restriction |
| 879 | (message-narrow-to-headers-or-head) | 883 | (message-narrow-to-headers-or-head) |
| 880 | ;; Skip past any From_ headers. | 884 | ;; Skip past any From_ headers. |
| 881 | (while (looking-at "From ") | 885 | (while (looking-at "From ") |
| 882 | (forward-line 1)) | 886 | (forward-line 1)) |
| 883 | (let ((mail-parse-charset message-default-charset)) | 887 | (let ((mail-parse-charset message-default-charset)) |
| 884 | (mail-encode-encoded-word-buffer)))) | 888 | (mail-encode-encoded-word-buffer))) |
| 889 | (message-encode-message-body)) | ||
| 885 | 890 | ||
| 886 | (defun mml-insert-mime (handle &optional no-markup) | 891 | (defun mml-insert-mime (handle &optional no-markup) |
| 887 | (let (textp buffer mmlp) | 892 | (let (textp buffer mmlp) |
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index f0f90218aab..a6ed7190351 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el | |||
| @@ -1766,11 +1766,15 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." | |||
| 1766 | (symbol-value sym)))) | 1766 | (symbol-value sym)))) |
| 1767 | 1767 | ||
| 1768 | (defun nnmail-get-new-mail (method exit-func temp | 1768 | (defun nnmail-get-new-mail (method exit-func temp |
| 1769 | &optional group spool-func) | 1769 | &optional group spool-func) |
| 1770 | "Read new incoming mail." | 1770 | "Read new incoming mail." |
| 1771 | (nnmail-get-new-mail-1 method exit-func temp group nil spool-func)) | ||
| 1772 | |||
| 1773 | (defun nnmail-get-new-mail-1 (method exit-func temp | ||
| 1774 | group in-group spool-func) | ||
| 1775 | |||
| 1771 | (let* ((sources mail-sources) | 1776 | (let* ((sources mail-sources) |
| 1772 | fetching-sources | 1777 | fetching-sources |
| 1773 | (group-in group) | ||
| 1774 | (i 0) | 1778 | (i 0) |
| 1775 | (new 0) | 1779 | (new 0) |
| 1776 | (total 0) | 1780 | (total 0) |
| @@ -1778,6 +1782,18 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." | |||
| 1778 | (when (and (nnmail-get-value "%s-get-new-mail" method) | 1782 | (when (and (nnmail-get-value "%s-get-new-mail" method) |
| 1779 | sources) | 1783 | sources) |
| 1780 | (while (setq source (pop sources)) | 1784 | (while (setq source (pop sources)) |
| 1785 | |||
| 1786 | ;; Use group's parameter | ||
| 1787 | (when (eq (car source) 'group) | ||
| 1788 | (let ((mail-sources | ||
| 1789 | (list | ||
| 1790 | (gnus-group-find-parameter | ||
| 1791 | (concat (symbol-name method) ":" group) | ||
| 1792 | 'mail-source t)))) | ||
| 1793 | (nnmail-get-new-mail-1 method exit-func temp | ||
| 1794 | group group spool-func)) | ||
| 1795 | (setq source nil)) | ||
| 1796 | |||
| 1781 | ;; Hack to only fetch the contents of a single group's spool file. | 1797 | ;; Hack to only fetch the contents of a single group's spool file. |
| 1782 | (when (and (eq (car source) 'directory) | 1798 | (when (and (eq (car source) 'directory) |
| 1783 | (null nnmail-scan-directory-mail-source-once) | 1799 | (null nnmail-scan-directory-mail-source-once) |
| @@ -1816,9 +1832,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." | |||
| 1816 | (nnmail-split-incoming | 1832 | (nnmail-split-incoming |
| 1817 | file ',(intern (format "%s-save-mail" method)) | 1833 | file ',(intern (format "%s-save-mail" method)) |
| 1818 | ',spool-func | 1834 | ',spool-func |
| 1819 | (if (equal file orig-file) | 1835 | (or in-group |
| 1820 | nil | 1836 | (if (equal file orig-file) |
| 1821 | (nnmail-get-split-group orig-file ',source)) | 1837 | nil |
| 1838 | (nnmail-get-split-group orig-file ',source))) | ||
| 1822 | ',(intern (format "%s-active-number" method))))))) | 1839 | ',(intern (format "%s-active-number" method))))))) |
| 1823 | (incf total new) | 1840 | (incf total new) |
| 1824 | (incf i))) | 1841 | (incf i))) |
diff --git a/lisp/gnus/sieve.el b/lisp/gnus/sieve.el index c05e9d1a356..c32c44ae505 100644 --- a/lisp/gnus/sieve.el +++ b/lisp/gnus/sieve.el | |||
| @@ -290,15 +290,15 @@ Server : " server ":" (or port "2000") " | |||
| 290 | (get-char-property (or pos (point)) 'script-name)) | 290 | (get-char-property (or pos (point)) 'script-name)) |
| 291 | 291 | ||
| 292 | (eval-and-compile | 292 | (eval-and-compile |
| 293 | (defalias 'sieve-make-overlay (if (fboundp 'make-overlay) | 293 | (defalias 'sieve-make-overlay (if (featurep 'xemacs) |
| 294 | 'make-overlay | 294 | 'make-extent |
| 295 | 'make-extent)) | 295 | 'make-overlay)) |
| 296 | (defalias 'sieve-overlay-put (if (fboundp 'overlay-put) | 296 | (defalias 'sieve-overlay-put (if (featurep 'xemacs) |
| 297 | 'overlay-put | 297 | 'set-extent-property |
| 298 | 'set-extent-property)) | 298 | 'overlay-put)) |
| 299 | (defalias 'sieve-overlays-at (if (fboundp 'overlays-at) | 299 | (defalias 'sieve-overlays-at (if (featurep 'xemacs) |
| 300 | 'overlays-at | 300 | 'extents-at |
| 301 | 'extents-at))) | 301 | 'overlays-at))) |
| 302 | 302 | ||
| 303 | (defun sieve-highlight (on) | 303 | (defun sieve-highlight (on) |
| 304 | "Turn ON or off highlighting on the current language overlay." | 304 | "Turn ON or off highlighting on the current language overlay." |
diff --git a/lisp/gnus/spam-wash.el b/lisp/gnus/spam-wash.el index be9a822dd2f..70192e06c1a 100644 --- a/lisp/gnus/spam-wash.el +++ b/lisp/gnus/spam-wash.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; spam-wash.el --- wash spam before analysis | 1 | ;;; spam-wash.el --- wash spam before analysis |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2004, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2004, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Andrew Cohen <cohen@andy.bu.edu> | 5 | ;; Author: Andrew Cohen <cohen@andy.bu.edu> |
| 6 | ;; Keywords: mail | 6 | ;; Keywords: mail |
diff --git a/lisp/help.el b/lisp/help.el index 68d3e33fe0a..24f1e74d71a 100644 --- a/lisp/help.el +++ b/lisp/help.el | |||
| @@ -860,7 +860,7 @@ whose documentation describes the minor mode." | |||
| 860 | (let ((mode mode-name)) | 860 | (let ((mode mode-name)) |
| 861 | (with-current-buffer standard-output | 861 | (with-current-buffer standard-output |
| 862 | (let ((start (point))) | 862 | (let ((start (point))) |
| 863 | (insert (format-mode-line mode)) | 863 | (insert (format-mode-line mode nil nil buffer)) |
| 864 | (add-text-properties start (point) '(face bold))))) | 864 | (add-text-properties start (point) '(face bold))))) |
| 865 | (princ " mode:\n") | 865 | (princ " mode:\n") |
| 866 | (princ (documentation major-mode)))))) | 866 | (princ (documentation major-mode)))))) |
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 0b2586d0fce..82face5eccb 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el | |||
| @@ -228,7 +228,7 @@ Currently, this only applies to `ibuffer-saved-filters' and | |||
| 228 | (ignore-errors | 228 | (ignore-errors |
| 229 | (with-current-buffer buf | 229 | (with-current-buffer buf |
| 230 | (when (and ibuffer-auto-mode | 230 | (when (and ibuffer-auto-mode |
| 231 | (eq major-mode 'ibuffer-mode)) | 231 | (derived-mode-p 'ibuffer-mode)) |
| 232 | (ibuffer-update nil t))))))) | 232 | (ibuffer-update nil t))))))) |
| 233 | 233 | ||
| 234 | ;;;###autoload | 234 | ;;;###autoload |
| @@ -236,15 +236,14 @@ Currently, this only applies to `ibuffer-saved-filters' and | |||
| 236 | "Toggle use of Ibuffer's auto-update facility. | 236 | "Toggle use of Ibuffer's auto-update facility. |
| 237 | With numeric ARG, enable auto-update if and only if ARG is positive." | 237 | With numeric ARG, enable auto-update if and only if ARG is positive." |
| 238 | (interactive) | 238 | (interactive) |
| 239 | (unless (eq major-mode 'ibuffer-mode) | 239 | (unless (derived-mode-p 'ibuffer-mode) |
| 240 | (error "This buffer is not in Ibuffer mode")) | 240 | (error "This buffer is not in Ibuffer mode")) |
| 241 | (set (make-local-variable 'ibuffer-auto-mode) | 241 | (set (make-local-variable 'ibuffer-auto-mode) |
| 242 | (if arg | 242 | (if arg |
| 243 | (plusp arg) | 243 | (plusp arg) |
| 244 | (not ibuffer-auto-mode))) | 244 | (not ibuffer-auto-mode))) |
| 245 | (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) ; Initialize state vector | 245 | (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) ; Initialize state vector |
| 246 | (add-hook 'post-command-hook 'ibuffer-auto-update-changed) | 246 | (add-hook 'post-command-hook 'ibuffer-auto-update-changed)) |
| 247 | (ibuffer-update-mode-name)) | ||
| 248 | 247 | ||
| 249 | ;;;###autoload | 248 | ;;;###autoload |
| 250 | (defun ibuffer-mouse-filter-by-mode (event) | 249 | (defun ibuffer-mouse-filter-by-mode (event) |
| @@ -731,8 +730,7 @@ prompt for NAME, and use the current filters." | |||
| 731 | (ibuffer-aif (assoc name ibuffer-saved-filter-groups) | 730 | (ibuffer-aif (assoc name ibuffer-saved-filter-groups) |
| 732 | (setcdr it groups) | 731 | (setcdr it groups) |
| 733 | (push (cons name groups) ibuffer-saved-filter-groups)) | 732 | (push (cons name groups) ibuffer-saved-filter-groups)) |
| 734 | (ibuffer-maybe-save-stuff) | 733 | (ibuffer-maybe-save-stuff)) |
| 735 | (ibuffer-update-mode-name)) | ||
| 736 | 734 | ||
| 737 | ;;;###autoload | 735 | ;;;###autoload |
| 738 | (defun ibuffer-delete-saved-filter-groups (name) | 736 | (defun ibuffer-delete-saved-filter-groups (name) |
| @@ -897,8 +895,7 @@ Interactively, prompt for NAME, and use the current filters." | |||
| 897 | (ibuffer-aif (assoc name ibuffer-saved-filters) | 895 | (ibuffer-aif (assoc name ibuffer-saved-filters) |
| 898 | (setcdr it filters) | 896 | (setcdr it filters) |
| 899 | (push (list name filters) ibuffer-saved-filters)) | 897 | (push (list name filters) ibuffer-saved-filters)) |
| 900 | (ibuffer-maybe-save-stuff) | 898 | (ibuffer-maybe-save-stuff)) |
| 901 | (ibuffer-update-mode-name)) | ||
| 902 | 899 | ||
| 903 | ;;;###autoload | 900 | ;;;###autoload |
| 904 | (defun ibuffer-delete-saved-filters (name) | 901 | (defun ibuffer-delete-saved-filters (name) |
| @@ -1158,6 +1155,20 @@ Ordering is lexicographic." | |||
| 1158 | (with-current-buffer (car b) | 1155 | (with-current-buffer (car b) |
| 1159 | (buffer-size)))) | 1156 | (buffer-size)))) |
| 1160 | 1157 | ||
| 1158 | ;;;###autoload (autoload 'ibuffer-do-sort-by-filename/process "ibuf-ext") | ||
| 1159 | (define-ibuffer-sorter filename/process | ||
| 1160 | "Sort the buffers by their file name/process name." | ||
| 1161 | (:description "file name") | ||
| 1162 | (string-lessp | ||
| 1163 | ;; FIXME: For now just compare the file name and the process name | ||
| 1164 | ;; (if it exists). Is there a better way to do this? | ||
| 1165 | (or (buffer-file-name (car a)) | ||
| 1166 | (let ((pr-a (get-buffer-process (car a)))) | ||
| 1167 | (and (processp pr-a) (process-name pr-a)))) | ||
| 1168 | (or (buffer-file-name (car b)) | ||
| 1169 | (let ((pr-b (get-buffer-process (car b)))) | ||
| 1170 | (and (processp pr-b) (process-name pr-b)))))) | ||
| 1171 | |||
| 1161 | ;;; Functions to emulate bs.el | 1172 | ;;; Functions to emulate bs.el |
| 1162 | 1173 | ||
| 1163 | ;;;###autoload | 1174 | ;;;###autoload |
| @@ -1386,7 +1397,7 @@ You can then feed the file name(s) to other commands with \\[yank]." | |||
| 1386 | (ibuffer-mark-on-buffer | 1397 | (ibuffer-mark-on-buffer |
| 1387 | #'(lambda (buf) | 1398 | #'(lambda (buf) |
| 1388 | (with-current-buffer buf | 1399 | (with-current-buffer buf |
| 1389 | (string-match regexp (format-mode-line mode-name)))))) | 1400 | (string-match regexp (format-mode-line mode-name nil nil buf)))))) |
| 1390 | 1401 | ||
| 1391 | ;;;###autoload | 1402 | ;;;###autoload |
| 1392 | (defun ibuffer-mark-by-file-name-regexp (regexp) | 1403 | (defun ibuffer-mark-by-file-name-regexp (regexp) |
| @@ -1539,5 +1550,5 @@ defaults to one." | |||
| 1539 | 1550 | ||
| 1540 | (provide 'ibuf-ext) | 1551 | (provide 'ibuf-ext) |
| 1541 | 1552 | ||
| 1542 | ;;; arch-tag: 9af21953-deda-4c30-b76d-f81d9128e76d | 1553 | ;; arch-tag: 9af21953-deda-4c30-b76d-f81d9128e76d |
| 1543 | ;;; ibuf-ext.el ends here | 1554 | ;;; ibuf-ext.el ends here |
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 9e6918e8020..7c6da00cf0f 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el | |||
| @@ -209,6 +209,7 @@ view of the buffers." | |||
| 209 | :type '(choice (const :tag "Last view time" :value recency) | 209 | :type '(choice (const :tag "Last view time" :value recency) |
| 210 | (const :tag "Lexicographic" :value alphabetic) | 210 | (const :tag "Lexicographic" :value alphabetic) |
| 211 | (const :tag "Buffer size" :value size) | 211 | (const :tag "Buffer size" :value size) |
| 212 | (const :tag "File name" :value filename/process) | ||
| 212 | (const :tag "Major mode" :value major-mode)) | 213 | (const :tag "Major mode" :value major-mode)) |
| 213 | :group 'ibuffer) | 214 | :group 'ibuffer) |
| 214 | (defvar ibuffer-sorting-mode nil) | 215 | (defvar ibuffer-sorting-mode nil) |
| @@ -447,6 +448,7 @@ directory, like `default-directory'." | |||
| 447 | (define-key map (kbd "s a") 'ibuffer-do-sort-by-alphabetic) | 448 | (define-key map (kbd "s a") 'ibuffer-do-sort-by-alphabetic) |
| 448 | (define-key map (kbd "s v") 'ibuffer-do-sort-by-recency) | 449 | (define-key map (kbd "s v") 'ibuffer-do-sort-by-recency) |
| 449 | (define-key map (kbd "s s") 'ibuffer-do-sort-by-size) | 450 | (define-key map (kbd "s s") 'ibuffer-do-sort-by-size) |
| 451 | (define-key map (kbd "s f") 'ibuffer-do-sort-by-filename/process) | ||
| 450 | (define-key map (kbd "s m") 'ibuffer-do-sort-by-major-mode) | 452 | (define-key map (kbd "s m") 'ibuffer-do-sort-by-major-mode) |
| 451 | 453 | ||
| 452 | (define-key map (kbd "/ m") 'ibuffer-filter-by-mode) | 454 | (define-key map (kbd "/ m") 'ibuffer-filter-by-mode) |
| @@ -828,6 +830,11 @@ directory, like `default-directory'." | |||
| 828 | (define-key map [down-mouse-3] 'ibuffer-mouse-popup-menu) | 830 | (define-key map [down-mouse-3] 'ibuffer-mouse-popup-menu) |
| 829 | map)) | 831 | map)) |
| 830 | 832 | ||
| 833 | (defvar ibuffer-filename/process-header-map | ||
| 834 | (let ((map (make-sparse-keymap))) | ||
| 835 | (define-key map [(mouse-1)] 'ibuffer-do-sort-by-filename/process) | ||
| 836 | map)) | ||
| 837 | |||
| 831 | (defvar ibuffer-mode-name-map | 838 | (defvar ibuffer-mode-name-map |
| 832 | (let ((map (make-sparse-keymap))) | 839 | (let ((map (make-sparse-keymap))) |
| 833 | (define-key map [(mouse-2)] 'ibuffer-mouse-filter-by-mode) | 840 | (define-key map [(mouse-2)] 'ibuffer-mouse-filter-by-mode) |
| @@ -1722,7 +1729,7 @@ If point is on a group name, this function operates on that group." | |||
| 1722 | ('mouse-face 'highlight | 1729 | ('mouse-face 'highlight |
| 1723 | 'keymap ibuffer-mode-name-map | 1730 | 'keymap ibuffer-mode-name-map |
| 1724 | 'help-echo "mouse-2: filter by this mode")) | 1731 | 'help-echo "mouse-2: filter by this mode")) |
| 1725 | (format-mode-line mode-name)) | 1732 | (format-mode-line mode-name nil nil (current-buffer))) |
| 1726 | 1733 | ||
| 1727 | (define-ibuffer-column process | 1734 | (define-ibuffer-column process |
| 1728 | (:summarizer | 1735 | (:summarizer |
| @@ -1753,6 +1760,7 @@ If point is on a group name, this function operates on that group." | |||
| 1753 | 1760 | ||
| 1754 | (define-ibuffer-column filename-and-process | 1761 | (define-ibuffer-column filename-and-process |
| 1755 | (:name "Filename/Process" | 1762 | (:name "Filename/Process" |
| 1763 | :header-mouse-map ibuffer-filename/process-header-map | ||
| 1756 | :summarizer | 1764 | :summarizer |
| 1757 | (lambda (strings) | 1765 | (lambda (strings) |
| 1758 | (setq strings (delete "" strings)) | 1766 | (setq strings (delete "" strings)) |
| @@ -2097,29 +2105,6 @@ the value of point at the beginning of the line for that buffer." | |||
| 2097 | (point)) | 2105 | (point)) |
| 2098 | `(ibuffer-summary t))))) | 2106 | `(ibuffer-summary t))))) |
| 2099 | 2107 | ||
| 2100 | (defun ibuffer-update-mode-name () | ||
| 2101 | (setq mode-name (format "Ibuffer by %s" (if ibuffer-sorting-mode | ||
| 2102 | ibuffer-sorting-mode | ||
| 2103 | "view time"))) | ||
| 2104 | (when ibuffer-sorting-reversep | ||
| 2105 | (setq mode-name (concat mode-name " [rev]"))) | ||
| 2106 | (when (and (featurep 'ibuf-ext) | ||
| 2107 | ibuffer-auto-mode) | ||
| 2108 | (setq mode-name (concat mode-name " (Auto)"))) | ||
| 2109 | (let ((result "")) | ||
| 2110 | (when (featurep 'ibuf-ext) | ||
| 2111 | (dolist (qualifier ibuffer-filtering-qualifiers) | ||
| 2112 | (setq result | ||
| 2113 | (concat result (ibuffer-format-qualifier qualifier)))) | ||
| 2114 | (if ibuffer-use-header-line | ||
| 2115 | (setq header-line-format | ||
| 2116 | (when ibuffer-filtering-qualifiers | ||
| 2117 | (replace-regexp-in-string "%" "%%" | ||
| 2118 | (concat mode-name result)))) | ||
| 2119 | (progn | ||
| 2120 | (setq mode-name (concat mode-name result)) | ||
| 2121 | (when (boundp 'header-line-format) | ||
| 2122 | (setq header-line-format nil))))))) | ||
| 2123 | 2108 | ||
| 2124 | (defun ibuffer-redisplay (&optional silent) | 2109 | (defun ibuffer-redisplay (&optional silent) |
| 2125 | "Redisplay the current list of buffers. | 2110 | "Redisplay the current list of buffers. |
| @@ -2137,7 +2122,6 @@ If optional arg SILENT is non-nil, do not display progress messages." | |||
| 2137 | (message "No buffers! (note: filtering in effect)") | 2122 | (message "No buffers! (note: filtering in effect)") |
| 2138 | (error "No buffers!"))) | 2123 | (error "No buffers!"))) |
| 2139 | (ibuffer-redisplay-engine blist t) | 2124 | (ibuffer-redisplay-engine blist t) |
| 2140 | (ibuffer-update-mode-name) | ||
| 2141 | (unless silent | 2125 | (unless silent |
| 2142 | (message "Redisplaying current buffer list...done")) | 2126 | (message "Redisplaying current buffer list...done")) |
| 2143 | (ibuffer-forward-line 0))) | 2127 | (ibuffer-forward-line 0))) |
| @@ -2174,7 +2158,6 @@ If optional arg SILENT is non-nil, do not display progress messages." | |||
| 2174 | (unless silent | 2158 | (unless silent |
| 2175 | (message "Updating buffer list...")) | 2159 | (message "Updating buffer list...")) |
| 2176 | (ibuffer-redisplay-engine blist arg) | 2160 | (ibuffer-redisplay-engine blist arg) |
| 2177 | (ibuffer-update-mode-name) | ||
| 2178 | (unless silent | 2161 | (unless silent |
| 2179 | (message "Updating buffer list...done"))) | 2162 | (message "Updating buffer list...done"))) |
| 2180 | (if (eq ibuffer-shrink-to-minimum-size 'onewindow) | 2163 | (if (eq ibuffer-shrink-to-minimum-size 'onewindow) |
| @@ -2458,6 +2441,7 @@ Sorting commands: | |||
| 2458 | '\\[ibuffer-toggle-sorting-mode]' - Rotate between the various sorting modes. | 2441 | '\\[ibuffer-toggle-sorting-mode]' - Rotate between the various sorting modes. |
| 2459 | '\\[ibuffer-invert-sorting]' - Reverse the current sorting order. | 2442 | '\\[ibuffer-invert-sorting]' - Reverse the current sorting order. |
| 2460 | '\\[ibuffer-do-sort-by-alphabetic]' - Sort the buffers lexicographically. | 2443 | '\\[ibuffer-do-sort-by-alphabetic]' - Sort the buffers lexicographically. |
| 2444 | '\\[ibuffer-do-sort-by-filename/process]' - Sort the buffers by the file name. | ||
| 2461 | '\\[ibuffer-do-sort-by-recency]' - Sort the buffers by last viewing time. | 2445 | '\\[ibuffer-do-sort-by-recency]' - Sort the buffers by last viewing time. |
| 2462 | '\\[ibuffer-do-sort-by-size]' - Sort the buffers by size. | 2446 | '\\[ibuffer-do-sort-by-size]' - Sort the buffers by size. |
| 2463 | '\\[ibuffer-do-sort-by-major-mode]' - Sort the buffers by major mode. | 2447 | '\\[ibuffer-do-sort-by-major-mode]' - Sort the buffers by major mode. |
| @@ -2540,6 +2524,28 @@ will be inserted before the group at point." | |||
| 2540 | (use-local-map ibuffer-mode-map) | 2524 | (use-local-map ibuffer-mode-map) |
| 2541 | (setq major-mode 'ibuffer-mode) | 2525 | (setq major-mode 'ibuffer-mode) |
| 2542 | (setq mode-name "Ibuffer") | 2526 | (setq mode-name "Ibuffer") |
| 2527 | ;; Include state info next to the mode name. | ||
| 2528 | (set (make-local-variable 'mode-line-process) | ||
| 2529 | '(" by " | ||
| 2530 | (ibuffer-sorting-mode (:eval (symbol-name ibuffer-sorting-mode)) | ||
| 2531 | "view time") | ||
| 2532 | (ibuffer-sorting-reversep " [rev]") | ||
| 2533 | (ibuffer-auto-mode " (Auto)") | ||
| 2534 | ;; Only list the filters if they're not already in the header-line. | ||
| 2535 | (header-line-format | ||
| 2536 | "" | ||
| 2537 | (:eval (if (functionp 'ibuffer-format-qualifier) | ||
| 2538 | (mapconcat 'ibuffer-format-qualifier | ||
| 2539 | ibuffer-filtering-qualifiers "")))))) | ||
| 2540 | (setq header-line-format | ||
| 2541 | (if ibuffer-use-header-line | ||
| 2542 | ;; Display the part that won't be in the mode-line. | ||
| 2543 | (list* "" mode-name | ||
| 2544 | (mapcar (lambda (elem) | ||
| 2545 | (if (eq (car-safe elem) 'header-line-format) | ||
| 2546 | (nth 2 elem) elem)) | ||
| 2547 | mode-line-process)))) | ||
| 2548 | |||
| 2543 | (setq buffer-read-only t) | 2549 | (setq buffer-read-only t) |
| 2544 | (buffer-disable-undo) | 2550 | (buffer-disable-undo) |
| 2545 | (setq truncate-lines ibuffer-truncate-lines) | 2551 | (setq truncate-lines ibuffer-truncate-lines) |
| @@ -2578,9 +2584,7 @@ will be inserted before the group at point." | |||
| 2578 | (when ibuffer-default-directory | 2584 | (when ibuffer-default-directory |
| 2579 | (setq default-directory ibuffer-default-directory)) | 2585 | (setq default-directory ibuffer-default-directory)) |
| 2580 | (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) | 2586 | (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) |
| 2581 | (run-mode-hooks 'ibuffer-mode-hook) | 2587 | (run-mode-hooks 'ibuffer-mode-hook)) |
| 2582 | ;; called after mode hooks to allow the user to add filters | ||
| 2583 | (ibuffer-update-mode-name)) | ||
| 2584 | 2588 | ||
| 2585 | (provide 'ibuffer) | 2589 | (provide 'ibuffer) |
| 2586 | 2590 | ||
| @@ -2590,5 +2594,5 @@ will be inserted before the group at point." | |||
| 2590 | ;; coding: iso-8859-1 | 2594 | ;; coding: iso-8859-1 |
| 2591 | ;; End: | 2595 | ;; End: |
| 2592 | 2596 | ||
| 2593 | ;;; arch-tag: 72581688-0603-4954-b8cf-837c700f62e8 | 2597 | ;; arch-tag: 72581688-0603-4954-b8cf-837c700f62e8 |
| 2594 | ;;; ibuffer.el ends here | 2598 | ;;; ibuffer.el ends here |
diff --git a/lisp/icomplete.el b/lisp/icomplete.el index b1e8fa5ebb5..3eb4b4babf2 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el | |||
| @@ -147,8 +147,7 @@ is minibuffer." | |||
| 147 | (save-excursion | 147 | (save-excursion |
| 148 | (let* ((sym (intern func-name)) | 148 | (let* ((sym (intern func-name)) |
| 149 | (buf (other-buffer nil t)) | 149 | (buf (other-buffer nil t)) |
| 150 | (map (save-excursion (set-buffer buf) (current-local-map))) | 150 | (keys (with-current-buffer buf (where-is-internal sym)))) |
| 151 | (keys (where-is-internal sym map))) | ||
| 152 | (if keys | 151 | (if keys |
| 153 | (concat "<" | 152 | (concat "<" |
| 154 | (mapconcat 'key-description | 153 | (mapconcat 'key-description |
diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 6b02db50134..55caae9a91d 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el | |||
| @@ -50,22 +50,49 @@ | |||
| 50 | 50 | ||
| 51 | ;;; Image scrolling functions | 51 | ;;; Image scrolling functions |
| 52 | 52 | ||
| 53 | (defvar image-mode-current-vscroll nil | ||
| 54 | "An alist with elements (WINDOW . VSCROLL).") | ||
| 55 | |||
| 56 | (defvar image-mode-current-hscroll nil | ||
| 57 | "An alist with elements (WINDOW . HSCROLL).") | ||
| 58 | |||
| 59 | (defun image-set-window-vscroll (window vscroll &optional pixels-p) | ||
| 60 | (setq image-mode-current-vscroll | ||
| 61 | (append (list (cons window vscroll)) | ||
| 62 | (delete (assoc window image-mode-current-vscroll) | ||
| 63 | image-mode-current-vscroll))) | ||
| 64 | (set-window-vscroll window vscroll pixels-p)) | ||
| 65 | |||
| 66 | (defun image-set-window-hscroll (window ncol) | ||
| 67 | (setq image-mode-current-hscroll | ||
| 68 | (append (list (cons window ncol)) | ||
| 69 | (delete (assoc window image-mode-current-hscroll) | ||
| 70 | image-mode-current-hscroll))) | ||
| 71 | (set-window-hscroll window ncol)) | ||
| 72 | |||
| 73 | (defun image-reset-current-vhscroll () | ||
| 74 | (let ((win (selected-window))) | ||
| 75 | (when (assoc win image-mode-current-hscroll) | ||
| 76 | (set-window-hscroll win (cdr (assoc win image-mode-current-hscroll)))) | ||
| 77 | (when (assoc win image-mode-current-vscroll) | ||
| 78 | (set-window-vscroll win (cdr (assoc win image-mode-current-vscroll)))))) | ||
| 79 | |||
| 53 | (defun image-forward-hscroll (&optional n) | 80 | (defun image-forward-hscroll (&optional n) |
| 54 | "Scroll image in current window to the left by N character widths. | 81 | "Scroll image in current window to the left by N character widths. |
| 55 | Stop if the right edge of the image is reached." | 82 | Stop if the right edge of the image is reached." |
| 56 | (interactive "p") | 83 | (interactive "p") |
| 57 | (cond ((= n 0) nil) | 84 | (cond ((= n 0) nil) |
| 58 | ((< n 0) | 85 | ((< n 0) |
| 59 | (set-window-hscroll (selected-window) | 86 | (image-set-window-hscroll (selected-window) |
| 60 | (max 0 (+ (window-hscroll) n)))) | 87 | (max 0 (+ (window-hscroll) n)))) |
| 61 | (t | 88 | (t |
| 62 | (let* ((image (get-char-property (point-min) 'display)) | 89 | (let* ((image (get-char-property (point-min) 'display)) |
| 63 | (edges (window-inside-edges)) | 90 | (edges (window-inside-edges)) |
| 64 | (win-width (- (nth 2 edges) (nth 0 edges))) | 91 | (win-width (- (nth 2 edges) (nth 0 edges))) |
| 65 | (img-width (ceiling (car (image-size image))))) | 92 | (img-width (ceiling (car (image-size image))))) |
| 66 | (set-window-hscroll (selected-window) | 93 | (image-set-window-hscroll (selected-window) |
| 67 | (min (max 0 (- img-width win-width)) | 94 | (min (max 0 (- img-width win-width)) |
| 68 | (+ n (window-hscroll)))))))) | 95 | (+ n (window-hscroll)))))))) |
| 69 | 96 | ||
| 70 | (defun image-backward-hscroll (&optional n) | 97 | (defun image-backward-hscroll (&optional n) |
| 71 | "Scroll image in current window to the right by N character widths. | 98 | "Scroll image in current window to the right by N character widths. |
| @@ -79,16 +106,16 @@ Stop if the bottom edge of the image is reached." | |||
| 79 | (interactive "p") | 106 | (interactive "p") |
| 80 | (cond ((= n 0) nil) | 107 | (cond ((= n 0) nil) |
| 81 | ((< n 0) | 108 | ((< n 0) |
| 82 | (set-window-vscroll (selected-window) | 109 | (image-set-window-vscroll (selected-window) |
| 83 | (max 0 (+ (window-vscroll) n)))) | 110 | (max 0 (+ (window-vscroll) n)))) |
| 84 | (t | 111 | (t |
| 85 | (let* ((image (get-char-property (point-min) 'display)) | 112 | (let* ((image (get-char-property (point-min) 'display)) |
| 86 | (edges (window-inside-edges)) | 113 | (edges (window-inside-edges)) |
| 87 | (win-height (- (nth 3 edges) (nth 1 edges))) | 114 | (win-height (- (nth 3 edges) (nth 1 edges))) |
| 88 | (img-height (ceiling (cdr (image-size image))))) | 115 | (img-height (ceiling (cdr (image-size image))))) |
| 89 | (set-window-vscroll (selected-window) | 116 | (image-set-window-vscroll (selected-window) |
| 90 | (min (max 0 (- img-height win-height)) | 117 | (min (max 0 (- img-height win-height)) |
| 91 | (+ n (window-vscroll)))))))) | 118 | (+ n (window-vscroll)))))))) |
| 92 | 119 | ||
| 93 | (defun image-previous-line (&optional n) | 120 | (defun image-previous-line (&optional n) |
| 94 | "Scroll image in current window downward by N lines. | 121 | "Scroll image in current window downward by N lines. |
| @@ -146,7 +173,7 @@ stopping if the top or bottom edge of the image is reached." | |||
| 146 | (and arg | 173 | (and arg |
| 147 | (/= (setq arg (prefix-numeric-value arg)) 1) | 174 | (/= (setq arg (prefix-numeric-value arg)) 1) |
| 148 | (image-next-line (- arg 1))) | 175 | (image-next-line (- arg 1))) |
| 149 | (set-window-hscroll (selected-window) 0)) | 176 | (image-set-window-hscroll (selected-window) 0)) |
| 150 | 177 | ||
| 151 | (defun image-eol (arg) | 178 | (defun image-eol (arg) |
| 152 | "Scroll horizontally to the right edge of the image in the current window. | 179 | "Scroll horizontally to the right edge of the image in the current window. |
| @@ -160,14 +187,14 @@ stopping if the top or bottom edge of the image is reached." | |||
| 160 | (edges (window-inside-edges)) | 187 | (edges (window-inside-edges)) |
| 161 | (win-width (- (nth 2 edges) (nth 0 edges))) | 188 | (win-width (- (nth 2 edges) (nth 0 edges))) |
| 162 | (img-width (ceiling (car (image-size image))))) | 189 | (img-width (ceiling (car (image-size image))))) |
| 163 | (set-window-hscroll (selected-window) | 190 | (image-set-window-hscroll (selected-window) |
| 164 | (max 0 (- img-width win-width))))) | 191 | (max 0 (- img-width win-width))))) |
| 165 | 192 | ||
| 166 | (defun image-bob () | 193 | (defun image-bob () |
| 167 | "Scroll to the top-left corner of the image in the current window." | 194 | "Scroll to the top-left corner of the image in the current window." |
| 168 | (interactive) | 195 | (interactive) |
| 169 | (set-window-hscroll (selected-window) 0) | 196 | (image-set-window-hscroll (selected-window) 0) |
| 170 | (set-window-vscroll (selected-window) 0)) | 197 | (image-set-window-vscroll (selected-window) 0)) |
| 171 | 198 | ||
| 172 | (defun image-eob () | 199 | (defun image-eob () |
| 173 | "Scroll to the bottom-right corner of the image in the current window." | 200 | "Scroll to the bottom-right corner of the image in the current window." |
| @@ -178,8 +205,8 @@ stopping if the top or bottom edge of the image is reached." | |||
| 178 | (img-width (ceiling (car (image-size image)))) | 205 | (img-width (ceiling (car (image-size image)))) |
| 179 | (win-height (- (nth 3 edges) (nth 1 edges))) | 206 | (win-height (- (nth 3 edges) (nth 1 edges))) |
| 180 | (img-height (ceiling (cdr (image-size image))))) | 207 | (img-height (ceiling (cdr (image-size image))))) |
| 181 | (set-window-hscroll (selected-window) (max 0 (- img-width win-width))) | 208 | (image-set-window-hscroll (selected-window) (max 0 (- img-width win-width))) |
| 182 | (set-window-vscroll (selected-window) (max 0 (- img-height win-height))))) | 209 | (image-set-window-vscroll (selected-window) (max 0 (- img-height win-height))))) |
| 183 | 210 | ||
| 184 | ;;; Image Mode setup | 211 | ;;; Image Mode setup |
| 185 | 212 | ||
| @@ -224,6 +251,15 @@ to toggle between display as an image and display as text." | |||
| 224 | ;; Use our own bookmarking function for images. | 251 | ;; Use our own bookmarking function for images. |
| 225 | (set (make-local-variable 'bookmark-make-cell-function) | 252 | (set (make-local-variable 'bookmark-make-cell-function) |
| 226 | 'image-bookmark-make-cell) | 253 | 'image-bookmark-make-cell) |
| 254 | |||
| 255 | ;; Keep track of [vh]scroll when switching buffers | ||
| 256 | (make-local-variable 'image-mode-current-hscroll) | ||
| 257 | (make-local-variable 'image-mode-current-vscroll) | ||
| 258 | (image-set-window-hscroll (selected-window) (window-hscroll)) | ||
| 259 | (image-set-window-vscroll (selected-window) (window-vscroll)) | ||
| 260 | (add-hook 'window-configuration-change-hook | ||
| 261 | 'image-reset-current-vhscroll nil t) | ||
| 262 | |||
| 227 | (add-hook 'change-major-mode-hook 'image-toggle-display-text nil t) | 263 | (add-hook 'change-major-mode-hook 'image-toggle-display-text nil t) |
| 228 | (if (and (display-images-p) | 264 | (if (and (display-images-p) |
| 229 | (not (get-char-property (point-min) 'display))) | 265 | (not (get-char-property (point-min) 'display))) |
| @@ -255,9 +291,9 @@ See the command `image-mode' for more information on this mode." | |||
| 255 | (setq image-type "text")) | 291 | (setq image-type "text")) |
| 256 | (add-hook 'change-major-mode-hook (lambda () (image-minor-mode -1)) nil t) | 292 | (add-hook 'change-major-mode-hook (lambda () (image-minor-mode -1)) nil t) |
| 257 | (message "%s" (concat (substitute-command-keys | 293 | (message "%s" (concat (substitute-command-keys |
| 258 | "Type \\[image-toggle-display] to view the image as ") | 294 | "Type \\[image-toggle-display] to view the image as ") |
| 259 | (if (get-char-property (point-min) 'display) | 295 | (if (get-char-property (point-min) 'display) |
| 260 | "text" "an image") ".")))) | 296 | "text" "an image") ".")))) |
| 261 | 297 | ||
| 262 | ;;;###autoload | 298 | ;;;###autoload |
| 263 | (defun image-mode-maybe () | 299 | (defun image-mode-maybe () |
| @@ -333,9 +369,9 @@ and showing the image as an image." | |||
| 333 | (image (create-image file-or-data type data-p)) | 369 | (image (create-image file-or-data type data-p)) |
| 334 | (props | 370 | (props |
| 335 | `(display ,image | 371 | `(display ,image |
| 336 | intangible ,image | 372 | intangible ,image |
| 337 | rear-nonsticky (display intangible) | 373 | rear-nonsticky (display intangible) |
| 338 | read-only t front-sticky (read-only))) | 374 | read-only t front-sticky (read-only))) |
| 339 | (inhibit-read-only t) | 375 | (inhibit-read-only t) |
| 340 | (buffer-undo-list t) | 376 | (buffer-undo-list t) |
| 341 | (modified (buffer-modified-p))) | 377 | (modified (buffer-modified-p))) |
diff --git a/lisp/isearch-multi.el b/lisp/isearch-multi.el index 9161ef82c7e..1cac7bb9b9e 100644 --- a/lisp/isearch-multi.el +++ b/lisp/isearch-multi.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; isearch-multi.el --- isearch extensions for multi-buffer search | 1 | ;;; isearch-multi.el --- isearch extensions for multi-buffer search |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Juri Linkov <juri@jurta.org> | 5 | ;; Author: Juri Linkov <juri@jurta.org> |
| 6 | ;; Keywords: matching | 6 | ;; Keywords: matching |
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 450c5f219f9..7f2b22a4385 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el | |||
| @@ -249,7 +249,6 @@ This is just like `add-change-log-entry' except that it displays | |||
| 249 | the change log file in another window. | 249 | the change log file in another window. |
| 250 | 250 | ||
| 251 | \(fn &optional WHOAMI FILE-NAME)" t nil) | 251 | \(fn &optional WHOAMI FILE-NAME)" t nil) |
| 252 | (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window) | ||
| 253 | 252 | ||
| 254 | (autoload 'change-log-mode "add-log" "\ | 253 | (autoload 'change-log-mode "add-log" "\ |
| 255 | Major mode for editing change logs; like Indented Text Mode. | 254 | Major mode for editing change logs; like Indented Text Mode. |
| @@ -945,48 +944,48 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'. | |||
| 945 | ;;; Generated autoloads from calendar/appt.el | 944 | ;;; Generated autoloads from calendar/appt.el |
| 946 | 945 | ||
| 947 | (defvar appt-issue-message t "\ | 946 | (defvar appt-issue-message t "\ |
| 948 | *Non-nil means check for appointments in the diary buffer. | 947 | Non-nil means check for appointments in the diary buffer. |
| 949 | To be detected, the diary entry must have the format described in the | 948 | To be detected, the diary entry must have the format described in the |
| 950 | documentation of the function `appt-check'.") | 949 | documentation of the function `appt-check'.") |
| 951 | 950 | ||
| 952 | (custom-autoload 'appt-issue-message "appt" t) | 951 | (custom-autoload 'appt-issue-message "appt" t) |
| 953 | 952 | ||
| 954 | (defvar appt-message-warning-time 12 "\ | 953 | (defvar appt-message-warning-time 12 "\ |
| 955 | *Time in minutes before an appointment that the warning begins.") | 954 | Time in minutes before an appointment that the warning begins.") |
| 956 | 955 | ||
| 957 | (custom-autoload 'appt-message-warning-time "appt" t) | 956 | (custom-autoload 'appt-message-warning-time "appt" t) |
| 958 | 957 | ||
| 959 | (defvar appt-audible t "\ | 958 | (defvar appt-audible t "\ |
| 960 | *Non-nil means beep to indicate appointment.") | 959 | Non-nil means beep to indicate appointment.") |
| 961 | 960 | ||
| 962 | (custom-autoload 'appt-audible "appt" t) | 961 | (custom-autoload 'appt-audible "appt" t) |
| 963 | 962 | ||
| 964 | (defvar appt-visible t "\ | 963 | (defvar appt-visible t "\ |
| 965 | *Non-nil means display appointment message in echo area. | 964 | Non-nil means display appointment message in echo area. |
| 966 | This variable is only relevant if `appt-msg-window' is nil.") | 965 | This variable is only relevant if `appt-msg-window' is nil.") |
| 967 | 966 | ||
| 968 | (custom-autoload 'appt-visible "appt" t) | 967 | (custom-autoload 'appt-visible "appt" t) |
| 969 | 968 | ||
| 970 | (defvar appt-msg-window t "\ | 969 | (defvar appt-msg-window t "\ |
| 971 | *Non-nil means display appointment message in another window. | 970 | Non-nil means display appointment message in another window. |
| 972 | If non-nil, this variable overrides `appt-visible'.") | 971 | If non-nil, this variable overrides `appt-visible'.") |
| 973 | 972 | ||
| 974 | (custom-autoload 'appt-msg-window "appt" t) | 973 | (custom-autoload 'appt-msg-window "appt" t) |
| 975 | 974 | ||
| 976 | (defvar appt-display-mode-line t "\ | 975 | (defvar appt-display-mode-line t "\ |
| 977 | *Non-nil means display minutes to appointment and time on the mode line. | 976 | Non-nil means display minutes to appointment and time on the mode line. |
| 978 | This is in addition to any other display of appointment messages.") | 977 | This is in addition to any other display of appointment messages.") |
| 979 | 978 | ||
| 980 | (custom-autoload 'appt-display-mode-line "appt" t) | 979 | (custom-autoload 'appt-display-mode-line "appt" t) |
| 981 | 980 | ||
| 982 | (defvar appt-display-duration 10 "\ | 981 | (defvar appt-display-duration 10 "\ |
| 983 | *The number of seconds an appointment message is displayed. | 982 | The number of seconds an appointment message is displayed. |
| 984 | Only relevant if reminders are to be displayed in their own window.") | 983 | Only relevant if reminders are to be displayed in their own window.") |
| 985 | 984 | ||
| 986 | (custom-autoload 'appt-display-duration "appt" t) | 985 | (custom-autoload 'appt-display-duration "appt" t) |
| 987 | 986 | ||
| 988 | (defvar appt-display-diary t "\ | 987 | (defvar appt-display-diary t "\ |
| 989 | *Non-nil displays the diary when the appointment list is first initialized. | 988 | Non-nil displays the diary when the appointment list is first initialized. |
| 990 | This will occur at midnight when the appointment list is updated.") | 989 | This will occur at midnight when the appointment list is updated.") |
| 991 | 990 | ||
| 992 | (custom-autoload 'appt-display-diary "appt" t) | 991 | (custom-autoload 'appt-display-diary "appt" t) |
| @@ -1732,7 +1731,7 @@ b => (ba bb bc) ; assume b has this value | |||
| 1732 | 1731 | ||
| 1733 | Vectors work just like lists. Nested backquotes are permitted. | 1732 | Vectors work just like lists. Nested backquotes are permitted. |
| 1734 | 1733 | ||
| 1735 | \(fn ARG)" nil (quote macro)) | 1734 | \(fn STRUCTURE)" nil (quote macro)) |
| 1736 | 1735 | ||
| 1737 | (defalias '\` (symbol-function 'backquote)) | 1736 | (defalias '\` (symbol-function 'backquote)) |
| 1738 | 1737 | ||
| @@ -1807,6 +1806,19 @@ non-interactive use see also `benchmark-run' and | |||
| 1807 | ;;;;;; 875)) | 1806 | ;;;;;; 875)) |
| 1808 | ;;; Generated autoloads from textmodes/bibtex.el | 1807 | ;;; Generated autoloads from textmodes/bibtex.el |
| 1809 | 1808 | ||
| 1809 | (autoload 'bibtex-initialize "bibtex" "\ | ||
| 1810 | (Re)Initialize BibTeX buffers. | ||
| 1811 | Visit the BibTeX files defined by `bibtex-files' and return a list | ||
| 1812 | of corresponding buffers. | ||
| 1813 | Initialize in these buffers `bibtex-reference-keys' if not yet set. | ||
| 1814 | List of BibTeX buffers includes current buffer if CURRENT is non-nil. | ||
| 1815 | If FORCE is non-nil, (re)initialize `bibtex-reference-keys' even if | ||
| 1816 | already set. If SELECT is non-nil interactively select a BibTeX buffer. | ||
| 1817 | When called interactively, FORCE is t, CURRENT is t if current buffer uses | ||
| 1818 | `bibtex-mode', and SELECT is t if current buffer does not use `bibtex-mode', | ||
| 1819 | |||
| 1820 | \(fn &optional CURRENT FORCE SELECT)" t nil) | ||
| 1821 | |||
| 1810 | (autoload 'bibtex-mode "bibtex" "\ | 1822 | (autoload 'bibtex-mode "bibtex" "\ |
| 1811 | Major mode for editing BibTeX files. | 1823 | Major mode for editing BibTeX files. |
| 1812 | 1824 | ||
| @@ -2828,7 +2840,7 @@ Must be used only with `-batch', and kills Emacs on completion. | |||
| 2828 | For example, invoke `emacs -batch -f batch-byte-recompile-directory .'. | 2840 | For example, invoke `emacs -batch -f batch-byte-recompile-directory .'. |
| 2829 | 2841 | ||
| 2830 | Optional argument ARG is passed as second argument ARG to | 2842 | Optional argument ARG is passed as second argument ARG to |
| 2831 | `batch-recompile-directory'; see there for its possible values | 2843 | `byte-recompile-directory'; see there for its possible values |
| 2832 | and corresponding effects. | 2844 | and corresponding effects. |
| 2833 | 2845 | ||
| 2834 | \(fn &optional ARG)" nil nil) | 2846 | \(fn &optional ARG)" nil nil) |
| @@ -3371,7 +3383,7 @@ List of functions called for listing diary file and included files. | |||
| 3371 | As the files are processed for diary entries, these functions are used | 3383 | As the files are processed for diary entries, these functions are used |
| 3372 | to cull relevant entries. You can use either or both of | 3384 | to cull relevant entries. You can use either or both of |
| 3373 | `list-hebrew-diary-entries', `list-islamic-diary-entries' and | 3385 | `list-hebrew-diary-entries', `list-islamic-diary-entries' and |
| 3374 | `list-bahai-diary-entries'. The documentation for these functions | 3386 | `diary-bahai-list-entries'. The documentation for these functions |
| 3375 | describes the style of such diary entries.") | 3387 | describes the style of such diary entries.") |
| 3376 | 3388 | ||
| 3377 | (custom-autoload 'nongregorian-diary-listing-hook "calendar" t) | 3389 | (custom-autoload 'nongregorian-diary-listing-hook "calendar" t) |
| @@ -3825,7 +3837,29 @@ and exists only for compatibility reasons. | |||
| 3825 | ;;;### (autoloads nil "cc-subword" "progmodes/cc-subword.el" (18177 | 3837 | ;;;### (autoloads nil "cc-subword" "progmodes/cc-subword.el" (18177 |
| 3826 | ;;;;;; 872)) | 3838 | ;;;;;; 872)) |
| 3827 | ;;; Generated autoloads from progmodes/cc-subword.el | 3839 | ;;; Generated autoloads from progmodes/cc-subword.el |
| 3828 | (autoload 'c-subword-mode "cc-subword" "Mode enabling subword movement and editing keys." t) | 3840 | |
| 3841 | (autoload 'c-subword-mode "cc-subword" "\ | ||
| 3842 | Mode enabling subword movement and editing keys. | ||
| 3843 | In spite of GNU Coding Standards, it is popular to name a symbol by | ||
| 3844 | mixing uppercase and lowercase letters, e.g. \"GtkWidget\", | ||
| 3845 | \"EmacsFrameClass\", \"NSGraphicsContext\", etc. Here we call these | ||
| 3846 | mixed case symbols `nomenclatures'. Also, each capitalized (or | ||
| 3847 | completely uppercase) part of a nomenclature is called a `subword'. | ||
| 3848 | Here are some examples: | ||
| 3849 | |||
| 3850 | Nomenclature Subwords | ||
| 3851 | =========================================================== | ||
| 3852 | GtkWindow => \"Gtk\" and \"Window\" | ||
| 3853 | EmacsFrameClass => \"Emacs\", \"Frame\" and \"Class\" | ||
| 3854 | NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\" | ||
| 3855 | |||
| 3856 | The subword oriented commands activated in this minor mode recognize | ||
| 3857 | subwords in a nomenclature to move between subwords and to edit them | ||
| 3858 | as words. | ||
| 3859 | |||
| 3860 | \\{c-subword-mode-map} | ||
| 3861 | |||
| 3862 | \(fn &optional ARG)" t nil) | ||
| 3829 | 3863 | ||
| 3830 | ;;;*** | 3864 | ;;;*** |
| 3831 | 3865 | ||
| @@ -4112,6 +4146,26 @@ to the action header. | |||
| 4112 | 4146 | ||
| 4113 | ;;;*** | 4147 | ;;;*** |
| 4114 | 4148 | ||
| 4149 | ;;;### (autoloads (check-declare-directory check-declare-file) "check-declare" | ||
| 4150 | ;;;;;; "emacs-lisp/check-declare.el" (18308 19808)) | ||
| 4151 | ;;; Generated autoloads from emacs-lisp/check-declare.el | ||
| 4152 | |||
| 4153 | (autoload 'check-declare-file "check-declare" "\ | ||
| 4154 | Check veracity of all `declare-function' statements in FILE. | ||
| 4155 | See `check-declare-directory' for more information. | ||
| 4156 | |||
| 4157 | \(fn FILE)" t nil) | ||
| 4158 | |||
| 4159 | (autoload 'check-declare-directory "check-declare" "\ | ||
| 4160 | Check veracity of all `declare-function' statements under directory ROOT. | ||
| 4161 | Returns non-nil if any false statements are found. For this to | ||
| 4162 | work correctly, the statements must adhere to the format | ||
| 4163 | described in the documentation of `declare-function'. | ||
| 4164 | |||
| 4165 | \(fn ROOT)" t nil) | ||
| 4166 | |||
| 4167 | ;;;*** | ||
| 4168 | |||
| 4115 | ;;;### (autoloads (checkdoc-minor-mode checkdoc-ispell-defun checkdoc-ispell-comments | 4169 | ;;;### (autoloads (checkdoc-minor-mode checkdoc-ispell-defun checkdoc-ispell-comments |
| 4116 | ;;;;;; checkdoc-ispell-continue checkdoc-ispell-start checkdoc-ispell-message-text | 4170 | ;;;;;; checkdoc-ispell-continue checkdoc-ispell-start checkdoc-ispell-message-text |
| 4117 | ;;;;;; checkdoc-ispell-message-interactive checkdoc-ispell-interactive | 4171 | ;;;;;; checkdoc-ispell-message-interactive checkdoc-ispell-interactive |
| @@ -5091,6 +5145,12 @@ Insert a copyright by $ORGANIZATION notice at cursor. | |||
| 5091 | ;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (18231 31069)) | 5145 | ;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (18231 31069)) |
| 5092 | ;;; Generated autoloads from progmodes/cperl-mode.el | 5146 | ;;; Generated autoloads from progmodes/cperl-mode.el |
| 5093 | (put 'cperl-indent-level 'safe-local-variable 'integerp) | 5147 | (put 'cperl-indent-level 'safe-local-variable 'integerp) |
| 5148 | (put 'cperl-brace-offset 'safe-local-variable 'integerp) | ||
| 5149 | (put 'cperl-continued-brace-offset 'safe-local-variable 'integerp) | ||
| 5150 | (put 'cperl-label-offset 'safe-local-variable 'integerp) | ||
| 5151 | (put 'cperl-continued-statement-offset 'safe-local-variable 'integerp) | ||
| 5152 | (put 'cperl-extra-newline-before-brace 'safe-local-variable 'booleanp) | ||
| 5153 | (put 'cperl-merge-trailing-else 'safe-local-variable 'booleanp) | ||
| 5094 | 5154 | ||
| 5095 | (autoload 'cperl-mode "cperl-mode" "\ | 5155 | (autoload 'cperl-mode "cperl-mode" "\ |
| 5096 | Major mode for editing Perl code. | 5156 | Major mode for editing Perl code. |
| @@ -5628,7 +5688,7 @@ that are not customizable options, as well as faces and groups | |||
| 5628 | (autoload 'customize-apropos-options "cus-edit" "\ | 5688 | (autoload 'customize-apropos-options "cus-edit" "\ |
| 5629 | Customize all loaded customizable options matching REGEXP. | 5689 | Customize all loaded customizable options matching REGEXP. |
| 5630 | With prefix arg, include variables that are not customizable options | 5690 | With prefix arg, include variables that are not customizable options |
| 5631 | \(but we recommend using `apropos-variable' instead). | 5691 | \(but it is better to use `apropos-variable' if you want to find those). |
| 5632 | 5692 | ||
| 5633 | \(fn REGEXP &optional ARG)" t nil) | 5693 | \(fn REGEXP &optional ARG)" t nil) |
| 5634 | 5694 | ||
| @@ -6230,8 +6290,8 @@ or call the function `delete-selection-mode'.") | |||
| 6230 | 6290 | ||
| 6231 | (autoload 'delete-selection-mode "delsel" "\ | 6291 | (autoload 'delete-selection-mode "delsel" "\ |
| 6232 | Toggle Delete Selection mode. | 6292 | Toggle Delete Selection mode. |
| 6233 | With prefix ARG, turn Delete Selection mode on if and only if ARG is | 6293 | With prefix ARG, turn Delete Selection mode on if ARG is |
| 6234 | positive. | 6294 | positive, off if ARG is not positive. |
| 6235 | 6295 | ||
| 6236 | When Delete Selection mode is enabled, Transient Mark mode is also | 6296 | When Delete Selection mode is enabled, Transient Mark mode is also |
| 6237 | enabled and typed text replaces the selection if the selection is | 6297 | enabled and typed text replaces the selection if the selection is |
| @@ -6701,7 +6761,7 @@ some of the `ls' switches are not supported; see the doc string of | |||
| 6701 | 6761 | ||
| 6702 | (custom-autoload 'dired-listing-switches "dired" t) | 6762 | (custom-autoload 'dired-listing-switches "dired" t) |
| 6703 | 6763 | ||
| 6704 | (defvar dired-chown-program (if (memq system-type '(hpux dgux usg-unix-v irix linux gnu/linux cygwin)) "chown" (if (file-exists-p "/usr/sbin/chown") "/usr/sbin/chown" "/etc/chown")) "\ | 6764 | (defvar dired-chown-program (if (memq system-type '(hpux usg-unix-v irix linux gnu/linux cygwin)) "chown" (if (file-exists-p "/usr/sbin/chown") "/usr/sbin/chown" "/etc/chown")) "\ |
| 6705 | Name of chown command (usually `chown' or `/etc/chown').") | 6765 | Name of chown command (usually `chown' or `/etc/chown').") |
| 6706 | 6766 | ||
| 6707 | (defvar dired-ls-F-marks-symlinks nil "\ | 6767 | (defvar dired-ls-F-marks-symlinks nil "\ |
| @@ -7564,6 +7624,12 @@ Locate SOA record and increment the serial field. | |||
| 7564 | ;;;;;; "doc-view.el" (18231 31060)) | 7624 | ;;;;;; "doc-view.el" (18231 31060)) |
| 7565 | ;;; Generated autoloads from doc-view.el | 7625 | ;;; Generated autoloads from doc-view.el |
| 7566 | 7626 | ||
| 7627 | (autoload 'doc-view-mode-p "doc-view" "\ | ||
| 7628 | Return non-nil if image type TYPE is available for `doc-view'. | ||
| 7629 | Image types are symbols like `dvi', `postscript' or `pdf'. | ||
| 7630 | |||
| 7631 | \(fn TYPE)" nil nil) | ||
| 7632 | |||
| 7567 | (autoload 'doc-view-mode "doc-view" "\ | 7633 | (autoload 'doc-view-mode "doc-view" "\ |
| 7568 | Major mode in DocView buffers. | 7634 | Major mode in DocView buffers. |
| 7569 | You can use \\<doc-view-mode-map>\\[doc-view-toggle-display] to | 7635 | You can use \\<doc-view-mode-map>\\[doc-view-toggle-display] to |
| @@ -7796,10 +7862,15 @@ whenever this expression's value is non-nil. | |||
| 7796 | INCLUDE is an expression; this item is only visible if this | 7862 | INCLUDE is an expression; this item is only visible if this |
| 7797 | expression has a non-nil value. `:included' is an alias for `:visible'. | 7863 | expression has a non-nil value. `:included' is an alias for `:visible'. |
| 7798 | 7864 | ||
| 7865 | :label FORM | ||
| 7866 | |||
| 7867 | FORM is an expression that will be dynamically evaluated and whose | ||
| 7868 | value will be used for the menu entry's text label (the default is NAME). | ||
| 7869 | |||
| 7799 | :suffix FORM | 7870 | :suffix FORM |
| 7800 | 7871 | ||
| 7801 | FORM is an expression that will be dynamically evaluated and whose | 7872 | FORM is an expression that will be dynamically evaluated and whose |
| 7802 | value will be concatenated to the menu entry's NAME. | 7873 | value will be concatenated to the menu entry's label. |
| 7803 | 7874 | ||
| 7804 | :style STYLE | 7875 | :style STYLE |
| 7805 | 7876 | ||
| @@ -9602,12 +9673,7 @@ corresponding to a successful execution. | |||
| 9602 | 9673 | ||
| 9603 | \(fn COMMAND &optional STATUS-VAR)" nil nil) | 9674 | \(fn COMMAND &optional STATUS-VAR)" nil nil) |
| 9604 | 9675 | ||
| 9605 | (autoload 'eshell-report-bug "eshell" "\ | 9676 | (define-obsolete-function-alias 'eshell-report-bug 'report-emacs-bug "23.1") |
| 9606 | Report a bug in Eshell. | ||
| 9607 | Prompts for the TOPIC. Leaves you in a mail buffer. | ||
| 9608 | Please include any configuration details that might be involved. | ||
| 9609 | |||
| 9610 | \(fn TOPIC)" t nil) | ||
| 9611 | 9677 | ||
| 9612 | ;;;*** | 9678 | ;;;*** |
| 9613 | 9679 | ||
| @@ -10773,9 +10839,6 @@ the name is considered already unique; only the second substitution | |||
| 10773 | \(directories) is done. | 10839 | \(directories) is done. |
| 10774 | 10840 | ||
| 10775 | \(fn ARG)" t nil) | 10841 | \(fn ARG)" t nil) |
| 10776 | (define-key minibuffer-local-completion-map [C-tab] 'file-cache-minibuffer-complete) | ||
| 10777 | (define-key minibuffer-local-map [C-tab] 'file-cache-minibuffer-complete) | ||
| 10778 | (define-key minibuffer-local-must-match-map [C-tab] 'file-cache-minibuffer-complete) | ||
| 10779 | 10842 | ||
| 10780 | ;;;*** | 10843 | ;;;*** |
| 10781 | 10844 | ||
| @@ -10825,6 +10888,13 @@ On other systems, the closest you can come is to use `-l'.") | |||
| 10825 | 10888 | ||
| 10826 | (custom-autoload 'find-grep-options "find-dired" t) | 10889 | (custom-autoload 'find-grep-options "find-dired" t) |
| 10827 | 10890 | ||
| 10891 | (defvar find-name-arg (if read-file-name-completion-ignore-case "-iname" "-name") "\ | ||
| 10892 | *Argument used to specify file name pattern. | ||
| 10893 | If `read-file-name-completion-ignore-case' is non-nil, -iname is used so that | ||
| 10894 | find also ignores case. Otherwise, -name is used.") | ||
| 10895 | |||
| 10896 | (custom-autoload 'find-name-arg "find-dired" t) | ||
| 10897 | |||
| 10828 | (autoload 'find-dired "find-dired" "\ | 10898 | (autoload 'find-dired "find-dired" "\ |
| 10829 | Run `find' and go into Dired mode on a buffer of the output. | 10899 | Run `find' and go into Dired mode on a buffer of the output. |
| 10830 | The command run (after changing into DIR) is | 10900 | The command run (after changing into DIR) is |
| @@ -11551,7 +11621,6 @@ Run gdb on program FILE in buffer *gud-FILE*. | |||
| 11551 | The directory containing FILE becomes the initial working | 11621 | The directory containing FILE becomes the initial working |
| 11552 | directory and source-file directory for your debugger. | 11622 | directory and source-file directory for your debugger. |
| 11553 | 11623 | ||
| 11554 | |||
| 11555 | If `gdb-many-windows' is nil (the default value) then gdb just | 11624 | If `gdb-many-windows' is nil (the default value) then gdb just |
| 11556 | pops up the GUD buffer unless `gdb-show-main' is t. In this case | 11625 | pops up the GUD buffer unless `gdb-show-main' is t. In this case |
| 11557 | it starts with two windows: one displaying the GUD buffer and the | 11626 | it starts with two windows: one displaying the GUD buffer and the |
| @@ -12049,7 +12118,7 @@ Not documented | |||
| 12049 | (autoload 'turn-on-gnus-dired-mode "gnus-dired" "\ | 12118 | (autoload 'turn-on-gnus-dired-mode "gnus-dired" "\ |
| 12050 | Convenience method to turn on gnus-dired-mode. | 12119 | Convenience method to turn on gnus-dired-mode. |
| 12051 | 12120 | ||
| 12052 | \(fn)" nil nil) | 12121 | \(fn)" t nil) |
| 12053 | 12122 | ||
| 12054 | ;;;*** | 12123 | ;;;*** |
| 12055 | 12124 | ||
| @@ -12622,6 +12691,11 @@ This variable's value takes effect when `grep-compute-defaults' is called.") | |||
| 12622 | The default find program for `grep-find-command'. | 12691 | The default find program for `grep-find-command'. |
| 12623 | This variable's value takes effect when `grep-compute-defaults' is called.") | 12692 | This variable's value takes effect when `grep-compute-defaults' is called.") |
| 12624 | 12693 | ||
| 12694 | (defvar xargs-program "xargs" "\ | ||
| 12695 | The default xargs program for `grep-find-command'. | ||
| 12696 | See `grep-find-use-xargs'. | ||
| 12697 | This variable's value takes effect when `grep-compute-defaults' is called.") | ||
| 12698 | |||
| 12625 | (defvar grep-find-use-xargs nil "\ | 12699 | (defvar grep-find-use-xargs nil "\ |
| 12626 | Non-nil means that `grep-find' uses the `xargs' utility by default. | 12700 | Non-nil means that `grep-find' uses the `xargs' utility by default. |
| 12627 | If `exec', use `find -exec'. | 12701 | If `exec', use `find -exec'. |
| @@ -12653,19 +12727,19 @@ Sets `grep-last-buffer' and `compilation-window-height'. | |||
| 12653 | (autoload 'grep "grep" "\ | 12727 | (autoload 'grep "grep" "\ |
| 12654 | Run grep, with user-specified args, and collect output in a buffer. | 12728 | Run grep, with user-specified args, and collect output in a buffer. |
| 12655 | While grep runs asynchronously, you can use \\[next-error] (M-x next-error), | 12729 | While grep runs asynchronously, you can use \\[next-error] (M-x next-error), |
| 12656 | or \\<grep-mode-map>\\[compile-goto-error] in the grep output buffer, to go to the lines | 12730 | or \\<grep-mode-map>\\[compile-goto-error] in the grep output buffer, to go to the lines where grep |
| 12657 | where grep found matches. | 12731 | found matches. |
| 12658 | 12732 | ||
| 12659 | For doing a recursive `grep', see the `rgrep' command. For running | 12733 | For doing a recursive `grep', see the `rgrep' command. For running |
| 12660 | `grep' in a specific directory, see `lgrep'. | 12734 | `grep' in a specific directory, see `lgrep'. |
| 12661 | 12735 | ||
| 12662 | This command uses a special history list for its COMMAND-ARGS, so you can | 12736 | This command uses a special history list for its COMMAND-ARGS, so you |
| 12663 | easily repeat a grep command. | 12737 | can easily repeat a grep command. |
| 12664 | 12738 | ||
| 12665 | A prefix argument says to default the argument based upon the current | 12739 | A prefix argument says to default the argument based upon the current |
| 12666 | tag the cursor is over, substituting it into the last grep command | 12740 | tag the cursor is over, substituting it into the last grep command |
| 12667 | in the grep command history (or into `grep-command' | 12741 | in the grep command history (or into `grep-command' if that history |
| 12668 | if that history list is empty). | 12742 | list is empty). |
| 12669 | 12743 | ||
| 12670 | \(fn COMMAND-ARGS)" t nil) | 12744 | \(fn COMMAND-ARGS)" t nil) |
| 12671 | 12745 | ||
| @@ -12693,8 +12767,8 @@ before it is executed. | |||
| 12693 | With two \\[universal-argument] prefixes, directly edit and run `grep-command'. | 12767 | With two \\[universal-argument] prefixes, directly edit and run `grep-command'. |
| 12694 | 12768 | ||
| 12695 | Collect output in a buffer. While grep runs asynchronously, you | 12769 | Collect output in a buffer. While grep runs asynchronously, you |
| 12696 | can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] | 12770 | can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] in the grep output buffer, |
| 12697 | in the grep output buffer, to go to the lines where grep found matches. | 12771 | to go to the lines where grep found matches. |
| 12698 | 12772 | ||
| 12699 | This command shares argument histories with \\[rgrep] and \\[grep]. | 12773 | This command shares argument histories with \\[rgrep] and \\[grep]. |
| 12700 | 12774 | ||
| @@ -12711,8 +12785,8 @@ before it is executed. | |||
| 12711 | With two \\[universal-argument] prefixes, directly edit and run `grep-find-command'. | 12785 | With two \\[universal-argument] prefixes, directly edit and run `grep-find-command'. |
| 12712 | 12786 | ||
| 12713 | Collect output in a buffer. While find runs asynchronously, you | 12787 | Collect output in a buffer. While find runs asynchronously, you |
| 12714 | can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] | 12788 | can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] in the grep output buffer, |
| 12715 | in the grep output buffer, to go to the lines where grep found matches. | 12789 | to go to the lines where grep found matches. |
| 12716 | 12790 | ||
| 12717 | This command shares argument histories with \\[lgrep] and \\[grep-find]. | 12791 | This command shares argument histories with \\[lgrep] and \\[grep-find]. |
| 12718 | 12792 | ||
| @@ -13833,6 +13907,8 @@ The optional LABEL is used to label the buffer created. | |||
| 13833 | 13907 | ||
| 13834 | \(fn Y1 Y2 &optional L LABEL)" t nil) | 13908 | \(fn Y1 Y2 &optional L LABEL)" t nil) |
| 13835 | 13909 | ||
| 13910 | (defalias 'holiday-list 'list-holidays) | ||
| 13911 | |||
| 13836 | ;;;*** | 13912 | ;;;*** |
| 13837 | 13913 | ||
| 13838 | ;;;### (autoloads (html2text) "html2text" "gnus/html2text.el" (18231 | 13914 | ;;;### (autoloads (html2text) "html2text" "gnus/html2text.el" (18231 |
| @@ -15348,6 +15424,11 @@ information on these modes. | |||
| 15348 | 15424 | ||
| 15349 | \(fn)" t nil) | 15425 | \(fn)" t nil) |
| 15350 | 15426 | ||
| 15427 | (autoload 'image-bookmark-jump "image-mode" "\ | ||
| 15428 | Not documented | ||
| 15429 | |||
| 15430 | \(fn BMK)" nil nil) | ||
| 15431 | |||
| 15351 | ;;;*** | 15432 | ;;;*** |
| 15352 | 15433 | ||
| 15353 | ;;;### (autoloads (imenu imenu-add-menubar-index imenu-add-to-menubar | 15434 | ;;;### (autoloads (imenu imenu-add-menubar-index imenu-add-to-menubar |
| @@ -15857,15 +15938,15 @@ The value is nil when the search still is in the initial buffer.") | |||
| 15857 | Function to call to get the next buffer to search. | 15938 | Function to call to get the next buffer to search. |
| 15858 | 15939 | ||
| 15859 | When this variable is set to a function that returns a buffer, then | 15940 | When this variable is set to a function that returns a buffer, then |
| 15860 | after typing another C-s or C-r at a failing search, the search goes | 15941 | after typing another \\[isearch-forward] or \\[isearch-backward] at a failing search, the search goes |
| 15861 | to the next buffer in the series and continues searching for the | 15942 | to the next buffer in the series and continues searching for the |
| 15862 | next occurrence. | 15943 | next occurrence. |
| 15863 | 15944 | ||
| 15864 | The first argument of this function is the current buffer where the | 15945 | The first argument of this function is the current buffer where the |
| 15865 | search is currently searching. It defines the base buffer relative to | 15946 | search is currently searching. It defines the base buffer relative to |
| 15866 | which this function should find the next buffer. When the isearch | 15947 | which this function should find the next buffer. When the isearch |
| 15867 | direction is backward (when isearch-forward is nil), this function | 15948 | direction is backward (when `isearch-forward' is nil), this function |
| 15868 | should return the previous buffer to search. If the second argument of | 15949 | should return the previous buffer to search. If the second argument of |
| 15869 | this function WRAP is non-nil, then it should return the first buffer | 15950 | this function WRAP is non-nil, then it should return the first buffer |
| 15870 | in the series; and for the backward search, it should return the last | 15951 | in the series; and for the backward search, it should return the last |
| 15871 | buffer in the series.") | 15952 | buffer in the series.") |
| @@ -16009,14 +16090,14 @@ Optional arg BUFFER is ignored (for use in `format-alist'). | |||
| 16009 | 16090 | ||
| 16010 | (autoload 'iso-iso2sgml "iso-cvt" "\ | 16091 | (autoload 'iso-iso2sgml "iso-cvt" "\ |
| 16011 | Translate ISO 8859-1 characters in the region to SGML entities. | 16092 | Translate ISO 8859-1 characters in the region to SGML entities. |
| 16012 | The entities used are from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\". | 16093 | Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\". |
| 16013 | Optional arg BUFFER is ignored (for use in `format-alist'). | 16094 | Optional arg BUFFER is ignored (for use in `format-alist'). |
| 16014 | 16095 | ||
| 16015 | \(fn FROM TO &optional BUFFER)" t nil) | 16096 | \(fn FROM TO &optional BUFFER)" t nil) |
| 16016 | 16097 | ||
| 16017 | (autoload 'iso-sgml2iso "iso-cvt" "\ | 16098 | (autoload 'iso-sgml2iso "iso-cvt" "\ |
| 16018 | Translate SGML entities in the region to ISO 8859-1 characters. | 16099 | Translate SGML entities in the region to ISO 8859-1 characters. |
| 16019 | The entities used are from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\". | 16100 | Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\". |
| 16020 | Optional arg BUFFER is ignored (for use in `format-alist'). | 16101 | Optional arg BUFFER is ignored (for use in `format-alist'). |
| 16021 | 16102 | ||
| 16022 | \(fn FROM TO &optional BUFFER)" t nil) | 16103 | \(fn FROM TO &optional BUFFER)" t nil) |
| @@ -16177,6 +16258,7 @@ for skipping in latex mode.") | |||
| 16177 | Same format as `ispell-skip-region-alist' | 16258 | Same format as `ispell-skip-region-alist' |
| 16178 | Note - substrings of other matches must come last | 16259 | Note - substrings of other matches must come last |
| 16179 | (e.g. \"<[tT][tT]/\" and \"<[^ \\t\\n>]\").") | 16260 | (e.g. \"<[tT][tT]/\" and \"<[^ \\t\\n>]\").") |
| 16261 | (put 'ispell-local-pdict 'safe-local-variable 'stringp) | ||
| 16180 | (define-key esc-map "$" 'ispell-word) | 16262 | (define-key esc-map "$" 'ispell-word) |
| 16181 | 16263 | ||
| 16182 | (autoload 'ispell-word "ispell" "\ | 16264 | (autoload 'ispell-word "ispell" "\ |
| @@ -17098,17 +17180,22 @@ except that FILTER is not optional. | |||
| 17098 | Setup a buffer to enter a log message. | 17180 | Setup a buffer to enter a log message. |
| 17099 | \\<log-edit-mode-map>The buffer will be put in `log-edit-mode'. | 17181 | \\<log-edit-mode-map>The buffer will be put in `log-edit-mode'. |
| 17100 | If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run. | 17182 | If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run. |
| 17101 | Mark and point will be set around the entire contents of the | 17183 | Mark and point will be set around the entire contents of the buffer so |
| 17102 | buffer so that it is easy to kill the contents of the buffer with \\[kill-region]. | 17184 | that it is easy to kill the contents of the buffer with \\[kill-region]. |
| 17103 | Once you're done editing the message, pressing \\[log-edit-done] will call | 17185 | Once you're done editing the message, pressing \\[log-edit-done] will call |
| 17104 | `log-edit-done' which will end up calling CALLBACK to do the actual commit. | 17186 | `log-edit-done' which will end up calling CALLBACK to do the actual commit. |
| 17105 | LISTFUN if non-nil is a function of no arguments returning the list of files | 17187 | |
| 17106 | that are concerned by the current operation (using relative names). | 17188 | PARAMS if non-nil is an alist. Possible keys and associated values: |
| 17189 | `log-edit-listfun' -- function taking no arguments that returns the list of | ||
| 17190 | files that are concerned by the current operation (using relative names); | ||
| 17191 | `log-edit-diff-function' -- function taking no arguments that | ||
| 17192 | displays a diff of the files concerned by the current operation. | ||
| 17193 | |||
| 17107 | If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the | 17194 | If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the |
| 17108 | log message and go back to the current buffer when done. Otherwise, it | 17195 | log message and go back to the current buffer when done. Otherwise, it |
| 17109 | uses the current buffer. | 17196 | uses the current buffer. |
| 17110 | 17197 | ||
| 17111 | \(fn CALLBACK &optional SETUP LISTFUN BUFFER &rest IGNORE)" nil nil) | 17198 | \(fn CALLBACK &optional SETUP PARAMS BUFFER &rest IGNORE)" nil nil) |
| 17112 | 17199 | ||
| 17113 | ;;;*** | 17200 | ;;;*** |
| 17114 | 17201 | ||
| @@ -17151,7 +17238,7 @@ are indicated with a symbol. | |||
| 17151 | 17238 | ||
| 17152 | (defvar lpr-windows-system (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt))) | 17239 | (defvar lpr-windows-system (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt))) |
| 17153 | 17240 | ||
| 17154 | (defvar lpr-lp-system (memq system-type '(usg-unix-v dgux hpux irix))) | 17241 | (defvar lpr-lp-system (memq system-type '(usg-unix-v hpux irix))) |
| 17155 | 17242 | ||
| 17156 | (defvar printer-name (and lpr-windows-system "PRN") "\ | 17243 | (defvar printer-name (and lpr-windows-system "PRN") "\ |
| 17157 | *The name of a local printer to which data is sent for printing. | 17244 | *The name of a local printer to which data is sent for printing. |
| @@ -19388,6 +19475,95 @@ closing requests for requests that are used in matched pairs. | |||
| 19388 | 19475 | ||
| 19389 | ;;;*** | 19476 | ;;;*** |
| 19390 | 19477 | ||
| 19478 | ;;;### (autoloads (nxml-glyph-display-string) "nxml-glyph" "nxml/nxml-glyph.el" | ||
| 19479 | ;;;;;; (18308 19808)) | ||
| 19480 | ;;; Generated autoloads from nxml/nxml-glyph.el | ||
| 19481 | |||
| 19482 | (autoload 'nxml-glyph-display-string "nxml-glyph" "\ | ||
| 19483 | Return a string that can display a glyph for Unicode code-point N. | ||
| 19484 | FACE gives the face that will be used for displaying the string. | ||
| 19485 | Return nil if the face cannot display a glyph for N. | ||
| 19486 | |||
| 19487 | \(fn N FACE)" nil nil) | ||
| 19488 | |||
| 19489 | ;;;*** | ||
| 19490 | |||
| 19491 | ;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (18313 | ||
| 19492 | ;;;;;; 19474)) | ||
| 19493 | ;;; Generated autoloads from nxml/nxml-mode.el | ||
| 19494 | |||
| 19495 | (autoload 'nxml-mode "nxml-mode" "\ | ||
| 19496 | Major mode for editing XML. | ||
| 19497 | |||
| 19498 | Syntax highlighting is performed unless the variable | ||
| 19499 | `nxml-syntax-highlight-flag' is nil. | ||
| 19500 | |||
| 19501 | \\[nxml-finish-element] finishes the current element by inserting an end-tag. | ||
| 19502 | C-c C-i closes a start-tag with `>' and then inserts a balancing end-tag | ||
| 19503 | leaving point between the start-tag and end-tag. | ||
| 19504 | \\[nxml-balanced-close-start-tag-block] is similar but for block rather than inline elements: | ||
| 19505 | the start-tag, point, and end-tag are all left on separate lines. | ||
| 19506 | If `nxml-slash-auto-complete-flag' is non-nil, then inserting a `</' | ||
| 19507 | automatically inserts the rest of the end-tag. | ||
| 19508 | |||
| 19509 | \\[nxml-complete] performs completion on the symbol preceding point. | ||
| 19510 | |||
| 19511 | \\[nxml-dynamic-markup-word] uses the contents of the current buffer | ||
| 19512 | to choose a tag to put around the word preceding point. | ||
| 19513 | |||
| 19514 | Sections of the document can be displayed in outline form. The | ||
| 19515 | variable `nxml-section-element-name-regexp' controls when an element | ||
| 19516 | is recognized as a section. The same key sequences that change | ||
| 19517 | visibility in outline mode are used except that they start with C-c C-o | ||
| 19518 | instead of C-c. | ||
| 19519 | |||
| 19520 | Validation is provided by the related minor-mode `rng-validate-mode'. | ||
| 19521 | This also makes completion schema- and context- sensitive. Element | ||
| 19522 | names, attribute names, attribute values and namespace URIs can all be | ||
| 19523 | completed. By default, `rng-validate-mode' is automatically enabled. You | ||
| 19524 | can toggle it using \\[rng-validate-mode] or change the default by | ||
| 19525 | customizing `rng-nxml-auto-validate-flag'. | ||
| 19526 | |||
| 19527 | \\[indent-for-tab-command] indents the current line appropriately. | ||
| 19528 | This can be customized using the variable `nxml-child-indent' | ||
| 19529 | and the variable `nxml-attribute-indent'. | ||
| 19530 | |||
| 19531 | \\[nxml-insert-named-char] inserts a character reference using | ||
| 19532 | the character's name (by default, the Unicode name). \\[universal-argument] \\[nxml-insert-named-char] | ||
| 19533 | inserts the character directly. | ||
| 19534 | |||
| 19535 | The Emacs commands that normally operate on balanced expressions will | ||
| 19536 | operate on XML markup items. Thus \\[forward-sexp] will move forward | ||
| 19537 | across one markup item; \\[backward-sexp] will move backward across | ||
| 19538 | one markup item; \\[kill-sexp] will kill the following markup item; | ||
| 19539 | \\[mark-sexp] will mark the following markup item. By default, each | ||
| 19540 | tag each treated as a single markup item; to make the complete element | ||
| 19541 | be treated as a single markup item, set the variable | ||
| 19542 | `nxml-sexp-element-flag' to t. For more details, see the function | ||
| 19543 | `nxml-forward-balanced-item'. | ||
| 19544 | |||
| 19545 | \\[nxml-backward-up-element] and \\[nxml-down-element] move up and down the element structure. | ||
| 19546 | |||
| 19547 | Many aspects this mode can be customized using | ||
| 19548 | \\[customize-group] nxml RET. | ||
| 19549 | |||
| 19550 | \(fn)" t nil) | ||
| 19551 | |||
| 19552 | ;;;*** | ||
| 19553 | |||
| 19554 | ;;;### (autoloads (nxml-enable-unicode-char-name-sets) "nxml-uchnm" | ||
| 19555 | ;;;;;; "nxml/nxml-uchnm.el" (18312 40673)) | ||
| 19556 | ;;; Generated autoloads from nxml/nxml-uchnm.el | ||
| 19557 | |||
| 19558 | (autoload 'nxml-enable-unicode-char-name-sets "nxml-uchnm" "\ | ||
| 19559 | Enable the use of Unicode standard names for characters. | ||
| 19560 | The Unicode blocks for which names are enabled is controlled by | ||
| 19561 | the variable `nxml-enabled-unicode-blocks'. | ||
| 19562 | |||
| 19563 | \(fn)" t nil) | ||
| 19564 | |||
| 19565 | ;;;*** | ||
| 19566 | |||
| 19391 | ;;;### (autoloads (octave-help) "octave-hlp" "progmodes/octave-hlp.el" | 19567 | ;;;### (autoloads (octave-help) "octave-hlp" "progmodes/octave-hlp.el" |
| 19392 | ;;;;;; (18177 873)) | 19568 | ;;;;;; (18177 873)) |
| 19393 | ;;; Generated autoloads from progmodes/octave-hlp.el | 19569 | ;;; Generated autoloads from progmodes/octave-hlp.el |
| @@ -20286,16 +20462,6 @@ but before calling PC Selection mode): | |||
| 20286 | 20462 | ||
| 20287 | \(fn &optional ARG)" t nil) | 20463 | \(fn &optional ARG)" t nil) |
| 20288 | 20464 | ||
| 20289 | (defvar pc-selection-mode nil "\ | ||
| 20290 | Toggle PC Selection mode. | ||
| 20291 | Change mark behavior to emulate Motif, MAC or MS-Windows cut and paste style, | ||
| 20292 | and cursor movement commands. | ||
| 20293 | This mode enables Delete Selection mode and Transient Mark mode. | ||
| 20294 | Setting this variable directly does not take effect; | ||
| 20295 | you must modify it using \\[customize] or \\[pc-selection-mode].") | ||
| 20296 | |||
| 20297 | (custom-autoload 'pc-selection-mode "pc-select" nil) | ||
| 20298 | |||
| 20299 | ;;;*** | 20465 | ;;;*** |
| 20300 | 20466 | ||
| 20301 | ;;;### (autoloads (pcomplete/cvs) "pcmpl-cvs" "pcmpl-cvs.el" (18177 | 20467 | ;;;### (autoloads (pcomplete/cvs) "pcmpl-cvs" "pcmpl-cvs.el" (18177 |
| @@ -20569,6 +20735,11 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp d | |||
| 20569 | ;;;;;; (18177 873)) | 20735 | ;;;;;; (18177 873)) |
| 20570 | ;;; Generated autoloads from progmodes/perl-mode.el | 20736 | ;;; Generated autoloads from progmodes/perl-mode.el |
| 20571 | (put 'perl-indent-level 'safe-local-variable 'integerp) | 20737 | (put 'perl-indent-level 'safe-local-variable 'integerp) |
| 20738 | (put 'perl-continued-statement-offset 'safe-local-variable 'integerp) | ||
| 20739 | (put 'perl-continued-brace-offset 'safe-local-variable 'integerp) | ||
| 20740 | (put 'perl-brace-offset 'safe-local-variable 'integerp) | ||
| 20741 | (put 'perl-brace-imaginary-offset 'safe-local-variable 'integerp) | ||
| 20742 | (put 'perl-label-offset 'safe-local-variable 'integerp) | ||
| 20572 | 20743 | ||
| 20573 | (autoload 'perl-mode "perl-mode" "\ | 20744 | (autoload 'perl-mode "perl-mode" "\ |
| 20574 | Major mode for editing Perl code. | 20745 | Major mode for editing Perl code. |
| @@ -22736,7 +22907,6 @@ comments, including the first comment line, are visible), or to make the | |||
| 22736 | first comment line visible (if point is in a comment). | 22907 | first comment line visible (if point is in a comment). |
| 22737 | 22908 | ||
| 22738 | \(fn &optional ARG)" t nil) | 22909 | \(fn &optional ARG)" t nil) |
| 22739 | (define-key esc-map "\C-l" 'reposition-window) | ||
| 22740 | 22910 | ||
| 22741 | ;;;*** | 22911 | ;;;*** |
| 22742 | 22912 | ||
| @@ -24812,6 +24982,12 @@ Minor mode to simplify editing output from the diff3 program. | |||
| 24812 | 24982 | ||
| 24813 | \(fn &optional ARG)" t nil) | 24983 | \(fn &optional ARG)" t nil) |
| 24814 | 24984 | ||
| 24985 | (autoload 'smerge-start-session "smerge-mode" "\ | ||
| 24986 | Turn on `smerge-mode' and move point to first conflict marker. | ||
| 24987 | If no conflict maker is found, turn off `smerge-mode'. | ||
| 24988 | |||
| 24989 | \(fn)" nil nil) | ||
| 24990 | |||
| 24815 | ;;;*** | 24991 | ;;;*** |
| 24816 | 24992 | ||
| 24817 | ;;;### (autoloads (smiley-buffer smiley-region) "smiley" "gnus/smiley.el" | 24993 | ;;;### (autoloads (smiley-buffer smiley-region) "smiley" "gnus/smiley.el" |
| @@ -25203,9 +25379,9 @@ From a program takes two point or marker arguments, BEG and END. | |||
| 25203 | (autoload 'spam-initialize "spam" "\ | 25379 | (autoload 'spam-initialize "spam" "\ |
| 25204 | Install the spam.el hooks and do other initialization. | 25380 | Install the spam.el hooks and do other initialization. |
| 25205 | When SYMBOLS is given, set those variables to t. This is so you | 25381 | When SYMBOLS is given, set those variables to t. This is so you |
| 25206 | can call spam-initialize before you set spam-use-* variables on | 25382 | can call `spam-initialize' before you set spam-use-* variables on |
| 25207 | explicitly, and matters only if you need the extra headers | 25383 | explicitly, and matters only if you need the extra headers |
| 25208 | installed through spam-necessary-extra-headers. | 25384 | installed through `spam-necessary-extra-headers'. |
| 25209 | 25385 | ||
| 25210 | \(fn &rest SYMBOLS)" t nil) | 25386 | \(fn &rest SYMBOLS)" t nil) |
| 25211 | 25387 | ||
| @@ -27624,6 +27800,7 @@ If DATE is malformed, return a time value of zeros. | |||
| 27624 | ;;;;;; "time-stamp.el" (18177 876)) | 27800 | ;;;;;; "time-stamp.el" (18177 876)) |
| 27625 | ;;; Generated autoloads from time-stamp.el | 27801 | ;;; Generated autoloads from time-stamp.el |
| 27626 | (put 'time-stamp-format 'safe-local-variable 'stringp) | 27802 | (put 'time-stamp-format 'safe-local-variable 'stringp) |
| 27803 | (put 'time-stamp-time-zone 'safe-local-variable 'string-or-null-p) | ||
| 27627 | (put 'time-stamp-line-limit 'safe-local-variable 'integerp) | 27804 | (put 'time-stamp-line-limit 'safe-local-variable 'integerp) |
| 27628 | (put 'time-stamp-start 'safe-local-variable 'stringp) | 27805 | (put 'time-stamp-start 'safe-local-variable 'stringp) |
| 27629 | (put 'time-stamp-end 'safe-local-variable 'stringp) | 27806 | (put 'time-stamp-end 'safe-local-variable 'stringp) |
| @@ -28809,6 +28986,13 @@ Use URL to handle URL-like file names. | |||
| 28809 | 28986 | ||
| 28810 | \(fn &optional ARG)" t nil) | 28987 | \(fn &optional ARG)" t nil) |
| 28811 | 28988 | ||
| 28989 | (autoload 'url-file-handler "url-handlers" "\ | ||
| 28990 | Function called from the `file-name-handler-alist' routines. | ||
| 28991 | OPERATION is what needs to be done (`file-exists-p', etc). ARGS are | ||
| 28992 | the arguments that would have been passed to OPERATION. | ||
| 28993 | |||
| 28994 | \(fn OPERATION &rest ARGS)" nil nil) | ||
| 28995 | |||
| 28812 | (autoload 'url-copy-file "url-handlers" "\ | 28996 | (autoload 'url-copy-file "url-handlers" "\ |
| 28813 | Copy URL to NEWNAME. Both args must be strings. | 28997 | Copy URL to NEWNAME. Both args must be strings. |
| 28814 | Signals a `file-already-exists' error if file NEWNAME already exists, | 28998 | Signals a `file-already-exists' error if file NEWNAME already exists, |
| @@ -29364,7 +29548,8 @@ merge in the changes into your working copy. | |||
| 29364 | \(fn VERBOSE)" t nil) | 29548 | \(fn VERBOSE)" t nil) |
| 29365 | 29549 | ||
| 29366 | (autoload 'vc-register "vc" "\ | 29550 | (autoload 'vc-register "vc" "\ |
| 29367 | Register the current file into a version control system. | 29551 | Register into a version control system. |
| 29552 | If FNAME is given register that file, otherwise register the current file. | ||
| 29368 | With prefix argument SET-REVISION, allow user to specify initial revision | 29553 | With prefix argument SET-REVISION, allow user to specify initial revision |
| 29369 | level. If COMMENT is present, use that as an initial comment. | 29554 | level. If COMMENT is present, use that as an initial comment. |
| 29370 | 29555 | ||
| @@ -29375,7 +29560,7 @@ directory are already registered under that backend) will be used to | |||
| 29375 | register the file. If no backend declares itself responsible, the | 29560 | register the file. If no backend declares itself responsible, the |
| 29376 | first backend that could register the file is used. | 29561 | first backend that could register the file is used. |
| 29377 | 29562 | ||
| 29378 | \(fn &optional SET-REVISION COMMENT)" t nil) | 29563 | \(fn &optional FNAME SET-REVISION COMMENT)" t nil) |
| 29379 | 29564 | ||
| 29380 | (autoload 'vc-version-diff "vc" "\ | 29565 | (autoload 'vc-version-diff "vc" "\ |
| 29381 | Report diffs between revisions of the fileset in the repository history. | 29566 | Report diffs between revisions of the fileset in the repository history. |
| @@ -29753,6 +29938,142 @@ Key bindings: | |||
| 29753 | 29938 | ||
| 29754 | ;;;*** | 29939 | ;;;*** |
| 29755 | 29940 | ||
| 29941 | ;;;### (autoloads (verilog-mode) "verilog-mode" "progmodes/verilog-mode.el" | ||
| 29942 | ;;;;;; (18307 57872)) | ||
| 29943 | ;;; Generated autoloads from progmodes/verilog-mode.el | ||
| 29944 | |||
| 29945 | (autoload 'verilog-mode "verilog-mode" "\ | ||
| 29946 | Major mode for editing Verilog code. | ||
| 29947 | \\<verilog-mode-map> | ||
| 29948 | See \\[describe-function] verilog-auto (\\[verilog-auto]) for details on how | ||
| 29949 | AUTOs can improve coding efficiency. | ||
| 29950 | |||
| 29951 | Use \\[verilog-faq] for a pointer to frequently asked questions. | ||
| 29952 | |||
| 29953 | NEWLINE, TAB indents for Verilog code. | ||
| 29954 | Delete converts tabs to spaces as it moves back. | ||
| 29955 | |||
| 29956 | Supports highlighting. | ||
| 29957 | |||
| 29958 | Turning on Verilog mode calls the value of the variable `verilog-mode-hook' | ||
| 29959 | with no args, if that value is non-nil. | ||
| 29960 | |||
| 29961 | Variables controlling indentation/edit style: | ||
| 29962 | |||
| 29963 | variable `verilog-indent-level' (default 3) | ||
| 29964 | Indentation of Verilog statements with respect to containing block. | ||
| 29965 | `verilog-indent-level-module' (default 3) | ||
| 29966 | Absolute indentation of Module level Verilog statements. | ||
| 29967 | Set to 0 to get initial and always statements lined up | ||
| 29968 | on the left side of your screen. | ||
| 29969 | `verilog-indent-level-declaration' (default 3) | ||
| 29970 | Indentation of declarations with respect to containing block. | ||
| 29971 | Set to 0 to get them list right under containing block. | ||
| 29972 | `verilog-indent-level-behavioral' (default 3) | ||
| 29973 | Indentation of first begin in a task or function block | ||
| 29974 | Set to 0 to get such code to lined up underneath the task or function keyword | ||
| 29975 | `verilog-indent-level-directive' (default 1) | ||
| 29976 | Indentation of `ifdef/`endif blocks | ||
| 29977 | `verilog-cexp-indent' (default 1) | ||
| 29978 | Indentation of Verilog statements broken across lines i.e.: | ||
| 29979 | if (a) | ||
| 29980 | begin | ||
| 29981 | `verilog-case-indent' (default 2) | ||
| 29982 | Indentation for case statements. | ||
| 29983 | `verilog-auto-newline' (default nil) | ||
| 29984 | Non-nil means automatically newline after semicolons and the punctuation | ||
| 29985 | mark after an end. | ||
| 29986 | `verilog-auto-indent-on-newline' (default t) | ||
| 29987 | Non-nil means automatically indent line after newline | ||
| 29988 | `verilog-tab-always-indent' (default t) | ||
| 29989 | Non-nil means TAB in Verilog mode should always reindent the current line, | ||
| 29990 | regardless of where in the line point is when the TAB command is used. | ||
| 29991 | `verilog-indent-begin-after-if' (default t) | ||
| 29992 | Non-nil means to indent begin statements following a preceding | ||
| 29993 | if, else, while, for and repeat statements, if any. otherwise, | ||
| 29994 | the begin is lined up with the preceding token. If t, you get: | ||
| 29995 | if (a) | ||
| 29996 | begin // amount of indent based on `verilog-cexp-indent' | ||
| 29997 | otherwise you get: | ||
| 29998 | if (a) | ||
| 29999 | begin | ||
| 30000 | `verilog-auto-endcomments' (default t) | ||
| 30001 | Non-nil means a comment /* ... */ is set after the ends which ends | ||
| 30002 | cases, tasks, functions and modules. | ||
| 30003 | The type and name of the object will be set between the braces. | ||
| 30004 | `verilog-minimum-comment-distance' (default 10) | ||
| 30005 | Minimum distance (in lines) between begin and end required before a comment | ||
| 30006 | will be inserted. Setting this variable to zero results in every | ||
| 30007 | end acquiring a comment; the default avoids too many redundant | ||
| 30008 | comments in tight quarters. | ||
| 30009 | `verilog-auto-lineup' (default `(all)) | ||
| 30010 | List of contexts where auto lineup of code should be done. | ||
| 30011 | |||
| 30012 | Variables controlling other actions: | ||
| 30013 | |||
| 30014 | `verilog-linter' (default surelint) | ||
| 30015 | Unix program to call to run the lint checker. This is the default | ||
| 30016 | command for \\[compile-command] and \\[verilog-auto-save-compile]. | ||
| 30017 | |||
| 30018 | See \\[customize] for the complete list of variables. | ||
| 30019 | |||
| 30020 | AUTO expansion functions are, in part: | ||
| 30021 | |||
| 30022 | \\[verilog-auto] Expand AUTO statements. | ||
| 30023 | \\[verilog-delete-auto] Remove the AUTOs. | ||
| 30024 | \\[verilog-inject-auto] Insert AUTOs for the first time. | ||
| 30025 | |||
| 30026 | Some other functions are: | ||
| 30027 | |||
| 30028 | \\[verilog-complete-word] Complete word with appropriate possibilities. | ||
| 30029 | \\[verilog-mark-defun] Mark function. | ||
| 30030 | \\[verilog-beg-of-defun] Move to beginning of current function. | ||
| 30031 | \\[verilog-end-of-defun] Move to end of current function. | ||
| 30032 | \\[verilog-label-be] Label matching begin ... end, fork ... join, etc statements. | ||
| 30033 | |||
| 30034 | \\[verilog-comment-region] Put marked area in a comment. | ||
| 30035 | \\[verilog-uncomment-region] Uncomment an area commented with \\[verilog-comment-region]. | ||
| 30036 | \\[verilog-insert-block] Insert begin ... end;. | ||
| 30037 | \\[verilog-star-comment] Insert /* ... */. | ||
| 30038 | |||
| 30039 | \\[verilog-sk-always] Insert a always @(AS) begin .. end block. | ||
| 30040 | \\[verilog-sk-begin] Insert a begin .. end block. | ||
| 30041 | \\[verilog-sk-case] Insert a case block, prompting for details. | ||
| 30042 | \\[verilog-sk-for] Insert a for (...) begin .. end block, prompting for details. | ||
| 30043 | \\[verilog-sk-generate] Insert a generate .. endgenerate block. | ||
| 30044 | \\[verilog-sk-header] Insert a nice header block at the top of file. | ||
| 30045 | \\[verilog-sk-initial] Insert an initial begin .. end block. | ||
| 30046 | \\[verilog-sk-fork] Insert a fork begin .. end .. join block. | ||
| 30047 | \\[verilog-sk-module] Insert a module .. (/*AUTOARG*/);.. endmodule block. | ||
| 30048 | \\[verilog-sk-primitive] Insert a primitive .. (.. );.. endprimitive block. | ||
| 30049 | \\[verilog-sk-repeat] Insert a repeat (..) begin .. end block. | ||
| 30050 | \\[verilog-sk-specify] Insert a specify .. endspecify block. | ||
| 30051 | \\[verilog-sk-task] Insert a task .. begin .. end endtask block. | ||
| 30052 | \\[verilog-sk-while] Insert a while (...) begin .. end block, prompting for details. | ||
| 30053 | \\[verilog-sk-casex] Insert a casex (...) item: begin.. end endcase block, prompting for details. | ||
| 30054 | \\[verilog-sk-casez] Insert a casez (...) item: begin.. end endcase block, prompting for details. | ||
| 30055 | \\[verilog-sk-if] Insert an if (..) begin .. end block. | ||
| 30056 | \\[verilog-sk-else-if] Insert an else if (..) begin .. end block. | ||
| 30057 | \\[verilog-sk-comment] Insert a comment block. | ||
| 30058 | \\[verilog-sk-assign] Insert an assign .. = ..; statement. | ||
| 30059 | \\[verilog-sk-function] Insert a function .. begin .. end endfunction block. | ||
| 30060 | \\[verilog-sk-input] Insert an input declaration, prompting for details. | ||
| 30061 | \\[verilog-sk-output] Insert an output declaration, prompting for details. | ||
| 30062 | \\[verilog-sk-state-machine] Insert a state machine definition, prompting for details. | ||
| 30063 | \\[verilog-sk-inout] Insert an inout declaration, prompting for details. | ||
| 30064 | \\[verilog-sk-wire] Insert a wire declaration, prompting for details. | ||
| 30065 | \\[verilog-sk-reg] Insert a register declaration, prompting for details. | ||
| 30066 | \\[verilog-sk-define-signal] Define signal under point as a register at the top of the module. | ||
| 30067 | |||
| 30068 | All key bindings can be seen in a Verilog-buffer with \\[describe-bindings]. | ||
| 30069 | Key bindings specific to `verilog-mode-map' are: | ||
| 30070 | |||
| 30071 | \\{verilog-mode-map} | ||
| 30072 | |||
| 30073 | \(fn)" t nil) | ||
| 30074 | |||
| 30075 | ;;;*** | ||
| 30076 | |||
| 29756 | ;;;### (autoloads (vhdl-mode) "vhdl-mode" "progmodes/vhdl-mode.el" | 30077 | ;;;### (autoloads (vhdl-mode) "vhdl-mode" "progmodes/vhdl-mode.el" |
| 29757 | ;;;;;; (18213 1260)) | 30078 | ;;;;;; (18213 1260)) |
| 29758 | ;;; Generated autoloads from progmodes/vhdl-mode.el | 30079 | ;;; Generated autoloads from progmodes/vhdl-mode.el |
| @@ -30821,6 +31142,11 @@ and off otherwise. | |||
| 30821 | ;;;;;; whitespace-toggle-leading-check) "whitespace" "whitespace.el" | 31142 | ;;;;;; whitespace-toggle-leading-check) "whitespace" "whitespace.el" |
| 30822 | ;;;;;; (18231 31064)) | 31143 | ;;;;;; (18231 31064)) |
| 30823 | ;;; Generated autoloads from whitespace.el | 31144 | ;;; Generated autoloads from whitespace.el |
| 31145 | (put 'whitespace-check-buffer-leading 'safe-local-variable 'booleanp) | ||
| 31146 | (put 'whitespace-check-buffer-trailing 'safe-local-variable 'booleanp) | ||
| 31147 | (put 'whitespace-check-buffer-indent 'safe-local-variable 'booleanp) | ||
| 31148 | (put 'whitespace-check-buffer-spacetab 'safe-local-variable 'booleanp) | ||
| 31149 | (put 'whitespace-check-buffer-ateol 'safe-local-variable 'booleanp) | ||
| 30824 | 31150 | ||
| 30825 | (autoload 'whitespace-toggle-leading-check "whitespace" "\ | 31151 | (autoload 'whitespace-toggle-leading-check "whitespace" "\ |
| 30826 | Toggle the check for leading space in the local buffer. | 31152 | Toggle the check for leading space in the local buffer. |
| @@ -31371,7 +31697,7 @@ Zone out, completely. | |||
| 31371 | ;;;;;; "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/hex-util.el" "gnus/hmac-def.el" | 31697 | ;;;;;; "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/hex-util.el" "gnus/hmac-def.el" |
| 31372 | ;;;;;; "gnus/hmac-md5.el" "gnus/ietf-drums.el" "gnus/imap.el" "gnus/legacy-gnus-agent.el" | 31698 | ;;;;;; "gnus/hmac-md5.el" "gnus/ietf-drums.el" "gnus/imap.el" "gnus/legacy-gnus-agent.el" |
| 31373 | ;;;;;; "gnus/mail-parse.el" "gnus/mail-prsvr.el" "gnus/mail-source.el" | 31699 | ;;;;;; "gnus/mail-parse.el" "gnus/mail-prsvr.el" "gnus/mail-source.el" |
| 31374 | ;;;;;; "gnus/mailcap.el" "gnus/md4.el" "gnus/messcompat.el" "gnus/mm-bodies.el" | 31700 | ;;;;;; "gnus/mailcap.el" "gnus/messcompat.el" "gnus/mm-bodies.el" |
| 31375 | ;;;;;; "gnus/mm-decode.el" "gnus/mm-encode.el" "gnus/mm-util.el" | 31701 | ;;;;;; "gnus/mm-decode.el" "gnus/mm-encode.el" "gnus/mm-util.el" |
| 31376 | ;;;;;; "gnus/mm-view.el" "gnus/mml-sec.el" "gnus/mml-smime.el" "gnus/mml.el" | 31702 | ;;;;;; "gnus/mm-view.el" "gnus/mml-sec.el" "gnus/mml-smime.el" "gnus/mml.el" |
| 31377 | ;;;;;; "gnus/nnagent.el" "gnus/nnbabyl.el" "gnus/nndb.el" "gnus/nndir.el" | 31703 | ;;;;;; "gnus/nnagent.el" "gnus/nnbabyl.el" "gnus/nndb.el" "gnus/nndir.el" |
| @@ -31380,11 +31706,9 @@ Zone out, completely. | |||
| 31380 | ;;;;;; "gnus/nnmail.el" "gnus/nnmaildir.el" "gnus/nnmbox.el" "gnus/nnmh.el" | 31706 | ;;;;;; "gnus/nnmail.el" "gnus/nnmaildir.el" "gnus/nnmbox.el" "gnus/nnmh.el" |
| 31381 | ;;;;;; "gnus/nnnil.el" "gnus/nnoo.el" "gnus/nnrss.el" "gnus/nnslashdot.el" | 31707 | ;;;;;; "gnus/nnnil.el" "gnus/nnoo.el" "gnus/nnrss.el" "gnus/nnslashdot.el" |
| 31382 | ;;;;;; "gnus/nnspool.el" "gnus/nntp.el" "gnus/nnultimate.el" "gnus/nnvirtual.el" | 31708 | ;;;;;; "gnus/nnspool.el" "gnus/nntp.el" "gnus/nnultimate.el" "gnus/nnvirtual.el" |
| 31383 | ;;;;;; "gnus/nnwarchive.el" "gnus/nnweb.el" "gnus/nnwfm.el" "gnus/ntlm.el" | 31709 | ;;;;;; "gnus/nnwarchive.el" "gnus/nnweb.el" "gnus/nnwfm.el" "gnus/pop3.el" |
| 31384 | ;;;;;; "gnus/password.el" "gnus/pop3.el" "gnus/rfc1843.el" "gnus/rfc2045.el" | 31710 | ;;;;;; "gnus/rfc1843.el" "gnus/rfc2045.el" "gnus/rfc2047.el" "gnus/rfc2104.el" |
| 31385 | ;;;;;; "gnus/rfc2047.el" "gnus/rfc2104.el" "gnus/rfc2231.el" "gnus/sasl-cram.el" | 31711 | ;;;;;; "gnus/rfc2231.el" "gnus/sieve-manage.el" "gnus/smime.el" |
| 31386 | ;;;;;; "gnus/sasl-digest.el" "gnus/sasl-ntlm.el" "gnus/sasl.el" | ||
| 31387 | ;;;;;; "gnus/sieve-manage.el" "gnus/smime-ldap.el" "gnus/smime.el" | ||
| 31388 | ;;;;;; "gnus/spam-stat.el" "gnus/spam-wash.el" "gnus/starttls.el" | 31712 | ;;;;;; "gnus/spam-stat.el" "gnus/spam-wash.el" "gnus/starttls.el" |
| 31389 | ;;;;;; "gnus/utf7.el" "gnus/webmail.el" "help.el" "indent.el" "international/characters.el" | 31713 | ;;;;;; "gnus/utf7.el" "gnus/webmail.el" "help.el" "indent.el" "international/characters.el" |
| 31390 | ;;;;;; "international/charprop.el" "international/cp51932.el" "international/eucjp-ms.el" | 31714 | ;;;;;; "international/charprop.el" "international/cp51932.el" "international/eucjp-ms.el" |
diff --git a/lisp/linum.el b/lisp/linum.el new file mode 100644 index 00000000000..078645c4120 --- /dev/null +++ b/lisp/linum.el | |||
| @@ -0,0 +1,196 @@ | |||
| 1 | ;;; linum.el --- display line numbers in the left margin | ||
| 2 | |||
| 3 | ;; Copyright (C) 2008 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Markus Triska <markus.triska@gmx.at> | ||
| 6 | ;; Maintainer: FSF | ||
| 7 | ;; Keywords: convenience | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation; either version 3, or (at your option) | ||
| 14 | ;; any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | ||
| 24 | ;; Boston, MA 02110-1301, USA. | ||
| 25 | |||
| 26 | ;;; Commentary: | ||
| 27 | |||
| 28 | ;; Display line numbers for the current buffer. | ||
| 29 | ;; | ||
| 30 | ;; Toggle display of line numbers with M-x linum-mode. To enable | ||
| 31 | ;; line numbering in all buffers, use M-x global-linum-mode. | ||
| 32 | |||
| 33 | ;;; Code: | ||
| 34 | |||
| 35 | (defconst linum-version "0.9wx") | ||
| 36 | |||
| 37 | (defvar linum-overlays nil "Overlays used in this buffer.") | ||
| 38 | (defvar linum-available nil "Overlays available for reuse.") | ||
| 39 | (defvar linum-before-numbering-hook nil | ||
| 40 | "Functions run in each buffer before line numbering starts.") | ||
| 41 | |||
| 42 | (mapc #'make-variable-buffer-local '(linum-overlays linum-available)) | ||
| 43 | |||
| 44 | (defgroup linum nil | ||
| 45 | "Show line numbers in the left margin." | ||
| 46 | :group 'convenience) | ||
| 47 | |||
| 48 | ;;;###autoload | ||
| 49 | (defcustom linum-format 'dynamic | ||
| 50 | "Format used to display line numbers. | ||
| 51 | Either a format string like \"%7d\", `dynamic' to adapt the width | ||
| 52 | as needed, or a function that is called with a line number as its | ||
| 53 | argument and should evaluate to a string to be shown on that line. | ||
| 54 | See also `linum-before-numbering-hook'." | ||
| 55 | :group 'linum | ||
| 56 | :type 'sexp) | ||
| 57 | |||
| 58 | (defface linum | ||
| 59 | '((t :inherit shadow)) | ||
| 60 | "Face for displaying line numbers in the display margin." | ||
| 61 | :group 'linum) | ||
| 62 | |||
| 63 | (defcustom linum-eager t | ||
| 64 | "Whether line numbers should be updated after each command. | ||
| 65 | The conservative setting `nil' might miss some buffer changes, | ||
| 66 | and you have to scroll or press \\[recenter-top-bottom] to update the numbers." | ||
| 67 | :group 'linum | ||
| 68 | :type 'boolean) | ||
| 69 | |||
| 70 | (defcustom linum-delay t | ||
| 71 | "Delay updates to give Emacs a chance for other changes." | ||
| 72 | :group 'linum | ||
| 73 | :type 'boolean) | ||
| 74 | |||
| 75 | ;;;###autoload | ||
| 76 | (define-minor-mode linum-mode | ||
| 77 | "Toggle display of line numbers in the left margin." | ||
| 78 | :lighter "" ; for desktop.el | ||
| 79 | (if linum-mode | ||
| 80 | (progn | ||
| 81 | (if linum-eager | ||
| 82 | (add-hook 'post-command-hook (if linum-delay | ||
| 83 | 'linum-schedule | ||
| 84 | 'linum-update-current) nil t) | ||
| 85 | (add-hook 'after-change-functions 'linum-after-change nil t)) | ||
| 86 | (add-hook 'window-scroll-functions 'linum-after-scroll nil t) | ||
| 87 | ;; mistake in Emacs: window-size-change-functions cannot be local | ||
| 88 | (add-hook 'window-size-change-functions 'linum-after-size) | ||
| 89 | (add-hook 'change-major-mode-hook 'linum-delete-overlays nil t) | ||
| 90 | (add-hook 'window-configuration-change-hook | ||
| 91 | 'linum-after-config nil t) | ||
| 92 | (linum-update-current)) | ||
| 93 | (remove-hook 'post-command-hook 'linum-update-current t) | ||
| 94 | (remove-hook 'post-command-hook 'linum-schedule t) | ||
| 95 | (remove-hook 'window-size-change-functions 'linum-after-size) | ||
| 96 | (remove-hook 'window-scroll-functions 'linum-after-scroll t) | ||
| 97 | (remove-hook 'after-change-functions 'linum-after-change t) | ||
| 98 | (remove-hook 'window-configuration-change-hook 'linum-after-config t) | ||
| 99 | (remove-hook 'change-major-mode-hook 'linum-delete-overlays t) | ||
| 100 | (linum-delete-overlays))) | ||
| 101 | |||
| 102 | ;;;###autoload | ||
| 103 | (define-globalized-minor-mode global-linum-mode linum-mode linum-on) | ||
| 104 | |||
| 105 | (defun linum-on () | ||
| 106 | (unless (minibufferp) | ||
| 107 | (linum-mode 1))) | ||
| 108 | |||
| 109 | (defun linum-delete-overlays () | ||
| 110 | "Delete all overlays displaying line numbers for this buffer." | ||
| 111 | (mapc #'delete-overlay linum-overlays) | ||
| 112 | (setq linum-overlays nil) | ||
| 113 | (dolist (w (get-buffer-window-list (current-buffer) nil t)) | ||
| 114 | (set-window-margins w 0))) | ||
| 115 | |||
| 116 | (defun linum-update-current () | ||
| 117 | "Update line numbers for the current buffer." | ||
| 118 | (linum-update (current-buffer))) | ||
| 119 | |||
| 120 | (defun linum-update (buffer) | ||
| 121 | "Update line numbers for all windows displaying BUFFER." | ||
| 122 | (with-current-buffer buffer | ||
| 123 | (when linum-mode | ||
| 124 | (setq linum-available linum-overlays) | ||
| 125 | (setq linum-overlays nil) | ||
| 126 | (save-excursion | ||
| 127 | (mapc #'linum-update-window | ||
| 128 | (get-buffer-window-list buffer nil 'visible))) | ||
| 129 | (mapc #'delete-overlay linum-available) | ||
| 130 | (setq linum-available nil)))) | ||
| 131 | |||
| 132 | (defun linum-update-window (win) | ||
| 133 | "Update line numbers for the portion visible in window WIN." | ||
| 134 | (goto-char (window-start win)) | ||
| 135 | (let ((line (line-number-at-pos)) | ||
| 136 | (limit (1+ (window-end win t))) | ||
| 137 | (fmt (cond ((stringp linum-format) linum-format) | ||
| 138 | ((eq linum-format 'dynamic) | ||
| 139 | (let ((w (length (number-to-string | ||
| 140 | (count-lines (point-min) (point-max)))))) | ||
| 141 | (concat "%" (number-to-string w) "d"))))) | ||
| 142 | (width 0) | ||
| 143 | visited | ||
| 144 | ov) | ||
| 145 | (run-hooks 'linum-before-numbering-hook) | ||
| 146 | ;; Create an overlay (or reuse an existing one) for each | ||
| 147 | ;; line visible in this window, if necessary. | ||
| 148 | (while (and (not (eobp)) (< (point) limit)) | ||
| 149 | (setq visited nil) | ||
| 150 | (dolist (o (overlays-in (point) (point))) | ||
| 151 | (when (eq (overlay-get o 'linum-line) line) | ||
| 152 | (unless (memq o linum-overlays) | ||
| 153 | (push o linum-overlays)) | ||
| 154 | (setq linum-available (delete o linum-available)) | ||
| 155 | (setq visited t))) | ||
| 156 | (let ((str (if fmt | ||
| 157 | (propertize (format fmt line) 'face 'linum) | ||
| 158 | (funcall linum-format line)))) | ||
| 159 | (setq width (max width (length str))) | ||
| 160 | (unless visited | ||
| 161 | (if (null linum-available) | ||
| 162 | (setq ov (make-overlay (point) (point))) | ||
| 163 | (setq ov (pop linum-available)) | ||
| 164 | (move-overlay ov (point) (point))) | ||
| 165 | (push ov linum-overlays) | ||
| 166 | (setq str (propertize " " 'display `((margin left-margin) ,str))) | ||
| 167 | (overlay-put ov 'before-string str) | ||
| 168 | (overlay-put ov 'linum-line line))) | ||
| 169 | (forward-line) | ||
| 170 | (setq line (1+ line))) | ||
| 171 | (set-window-margins win width))) | ||
| 172 | |||
| 173 | (defun linum-after-change (beg end len) | ||
| 174 | ;; update overlays on deletions, and after newlines are inserted | ||
| 175 | (when (or (= beg end) | ||
| 176 | (= end (point-max)) | ||
| 177 | (string-match-p "\n" (buffer-substring-no-properties beg end))) | ||
| 178 | (linum-update-current))) | ||
| 179 | |||
| 180 | (defun linum-after-scroll (win start) | ||
| 181 | (linum-update (window-buffer win))) | ||
| 182 | |||
| 183 | (defun linum-after-size (frame) | ||
| 184 | (linum-after-config)) | ||
| 185 | |||
| 186 | (defun linum-schedule () | ||
| 187 | ;; schedule an update; the delay gives Emacs a chance for display changes | ||
| 188 | (run-with-idle-timer 0 nil #'linum-update-current)) | ||
| 189 | |||
| 190 | (defun linum-after-config () | ||
| 191 | (walk-windows (lambda (w) (linum-update (window-buffer))) nil 'visible)) | ||
| 192 | |||
| 193 | (provide 'linum) | ||
| 194 | |||
| 195 | ;; arch-tag: dea45631-ed3c-4867-8b49-1c41c80aec6a | ||
| 196 | ;;; linum.el ends here | ||
diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 5aaa06b0a11..71e81ae4221 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el | |||
| @@ -74,7 +74,7 @@ A library name is equivalent to the file name that `load-library' would load." | |||
| 74 | (let (provides) | 74 | (let (provides) |
| 75 | (dolist (x (file-loadhist-lookup file) provides) | 75 | (dolist (x (file-loadhist-lookup file) provides) |
| 76 | (when (eq (car-safe x) 'provide) | 76 | (when (eq (car-safe x) 'provide) |
| 77 | (push x provides))))) | 77 | (push (cdr x) provides))))) |
| 78 | 78 | ||
| 79 | (defun file-requires (file) | 79 | (defun file-requires (file) |
| 80 | "Return the list of features required by FILE as it was loaded. | 80 | "Return the list of features required by FILE as it was loaded. |
| @@ -83,7 +83,7 @@ A library name is equivalent to the file name that `load-library' would load." | |||
| 83 | (let (requires) | 83 | (let (requires) |
| 84 | (dolist (x (file-loadhist-lookup file) requires) | 84 | (dolist (x (file-loadhist-lookup file) requires) |
| 85 | (when (eq (car-safe x) 'require) | 85 | (when (eq (car-safe x) 'require) |
| 86 | (push x requires))))) | 86 | (push (cdr x) requires))))) |
| 87 | 87 | ||
| 88 | (defsubst file-set-intersect (p q) | 88 | (defsubst file-set-intersect (p q) |
| 89 | "Return the set intersection of two lists." | 89 | "Return the set intersection of two lists." |
diff --git a/lisp/log-edit.el b/lisp/log-edit.el index b92de701b03..5447cda9f1c 100644 --- a/lisp/log-edit.el +++ b/lisp/log-edit.el | |||
| @@ -309,20 +309,20 @@ automatically." | |||
| 309 | "Setup a buffer to enter a log message. | 309 | "Setup a buffer to enter a log message. |
| 310 | \\<log-edit-mode-map>The buffer will be put in `log-edit-mode'. | 310 | \\<log-edit-mode-map>The buffer will be put in `log-edit-mode'. |
| 311 | If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run. | 311 | If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run. |
| 312 | Mark and point will be set around the entire contents of the | 312 | Mark and point will be set around the entire contents of the buffer so |
| 313 | buffer so that it is easy to kill the contents of the buffer with \\[kill-region]. | 313 | that it is easy to kill the contents of the buffer with \\[kill-region]. |
| 314 | Once you're done editing the message, pressing \\[log-edit-done] will call | 314 | Once you're done editing the message, pressing \\[log-edit-done] will call |
| 315 | `log-edit-done' which will end up calling CALLBACK to do the actual commit. | 315 | `log-edit-done' which will end up calling CALLBACK to do the actual commit. |
| 316 | PARAMS if non-nil is an alist. The keys for the alist can be: | 316 | |
| 317 | `log-edit-listfun' and `log-edit-diff-function'. The associated | 317 | PARAMS if non-nil is an alist. Possible keys and associated values: |
| 318 | value for `log-edit-listfun' should be a function with not | 318 | `log-edit-listfun' -- function taking no arguments that returns the list of |
| 319 | arguments that returns the list of files that are concerned by | 319 | files that are concerned by the current operation (using relative names); |
| 320 | the current operation (using relative names). The associated | 320 | `log-edit-diff-function' -- function taking no arguments that |
| 321 | value for `log-edit-diff-function' should be a function with no | 321 | displays a diff of the files concerned by the current operation. |
| 322 | arguments that displays a diff of the files concerned by the current operation. | 322 | |
| 323 | If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the | 323 | If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the |
| 324 | log message and go back to the current buffer when done. Otherwise, it | 324 | log message and go back to the current buffer when done. Otherwise, it |
| 325 | uses the current buffer." | 325 | uses the current buffer." |
| 326 | (let ((parent (current-buffer))) | 326 | (let ((parent (current-buffer))) |
| 327 | (if buffer (pop-to-buffer buffer)) | 327 | (if buffer (pop-to-buffer buffer)) |
| 328 | (when (and log-edit-setup-invert (not (eq setup 'force))) | 328 | (when (and log-edit-setup-invert (not (eq setup 'force))) |
diff --git a/lisp/longlines.el b/lisp/longlines.el index 932a70480a1..77176a5db24 100644 --- a/lisp/longlines.el +++ b/lisp/longlines.el | |||
| @@ -136,7 +136,8 @@ are indicated with a symbol." | |||
| 136 | (let ((buffer-undo-list t) | 136 | (let ((buffer-undo-list t) |
| 137 | (inhibit-read-only t) | 137 | (inhibit-read-only t) |
| 138 | (after-change-functions nil) | 138 | (after-change-functions nil) |
| 139 | (mod (buffer-modified-p))) | 139 | (mod (buffer-modified-p)) |
| 140 | buffer-file-name buffer-file-truename) | ||
| 140 | ;; Turning off undo is OK since (spaces + newlines) is | 141 | ;; Turning off undo is OK since (spaces + newlines) is |
| 141 | ;; conserved, except for a corner case in | 142 | ;; conserved, except for a corner case in |
| 142 | ;; longlines-wrap-lines that we'll never encounter from here | 143 | ;; longlines-wrap-lines that we'll never encounter from here |
| @@ -176,7 +177,8 @@ are indicated with a symbol." | |||
| 176 | (longlines-unshow-hard-newlines)) | 177 | (longlines-unshow-hard-newlines)) |
| 177 | (let ((buffer-undo-list t) | 178 | (let ((buffer-undo-list t) |
| 178 | (after-change-functions nil) | 179 | (after-change-functions nil) |
| 179 | (inhibit-read-only t)) | 180 | (inhibit-read-only t) |
| 181 | buffer-file-name buffer-file-truename) | ||
| 180 | (if longlines-decoded | 182 | (if longlines-decoded |
| 181 | (save-restriction | 183 | (save-restriction |
| 182 | (widen) | 184 | (widen) |
| @@ -220,7 +222,8 @@ With optional argument ARG, make the hard newlines invisible again." | |||
| 220 | (mod (buffer-modified-p)) | 222 | (mod (buffer-modified-p)) |
| 221 | (buffer-undo-list t) | 223 | (buffer-undo-list t) |
| 222 | (inhibit-read-only t) | 224 | (inhibit-read-only t) |
| 223 | (inhibit-modification-hooks t)) | 225 | (inhibit-modification-hooks t) |
| 226 | buffer-file-name buffer-file-truename) | ||
| 224 | (while pos | 227 | (while pos |
| 225 | (put-text-property pos (1+ pos) 'display | 228 | (put-text-property pos (1+ pos) 'display |
| 226 | (copy-sequence longlines-show-effect)) | 229 | (copy-sequence longlines-show-effect)) |
| @@ -235,7 +238,8 @@ With optional argument ARG, make the hard newlines invisible again." | |||
| 235 | (mod (buffer-modified-p)) | 238 | (mod (buffer-modified-p)) |
| 236 | (buffer-undo-list t) | 239 | (buffer-undo-list t) |
| 237 | (inhibit-read-only t) | 240 | (inhibit-read-only t) |
| 238 | (inhibit-modification-hooks t)) | 241 | (inhibit-modification-hooks t) |
| 242 | buffer-file-name buffer-file-truename) | ||
| 239 | (while pos | 243 | (while pos |
| 240 | (remove-text-properties pos (1+ pos) '(display)) | 244 | (remove-text-properties pos (1+ pos) '(display)) |
| 241 | (setq pos (text-property-not-all (1+ pos) (point-max) 'hard nil))) | 245 | (setq pos (text-property-not-all (1+ pos) (point-max) 'hard nil))) |
diff --git a/lisp/lpr.el b/lisp/lpr.el index 8f4a8679338..9e9de8c4bb9 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el | |||
| @@ -47,7 +47,7 @@ | |||
| 47 | 47 | ||
| 48 | ;;;###autoload | 48 | ;;;###autoload |
| 49 | (defcustom printer-name | 49 | (defcustom printer-name |
| 50 | (and lpr-windows-system "PRN") | 50 | (and (memq system-type '(emx ms-dos)) "PRN") |
| 51 | "*The name of a local printer to which data is sent for printing. | 51 | "*The name of a local printer to which data is sent for printing. |
| 52 | \(Note that PostScript files are sent to `ps-printer-name', which see.\) | 52 | \(Note that PostScript files are sent to `ps-printer-name', which see.\) |
| 53 | 53 | ||
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 302329b9bba..2963168a899 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el | |||
| @@ -209,7 +209,7 @@ The Lisp emulation does not run any external programs or shells. It | |||
| 209 | supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards' | 209 | supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards' |
| 210 | is non-nil; otherwise, it interprets wildcards as regular expressions | 210 | is non-nil; otherwise, it interprets wildcards as regular expressions |
| 211 | to match file names. It does not support all `ls' switches -- those | 211 | to match file names. It does not support all `ls' switches -- those |
| 212 | that work are: A a c i r S s t u U X g G B C R and F partly." | 212 | that work are: A a c i r S s t u U X g G B C R n and F partly." |
| 213 | (if ls-lisp-use-insert-directory-program | 213 | (if ls-lisp-use-insert-directory-program |
| 214 | (funcall original-insert-directory | 214 | (funcall original-insert-directory |
| 215 | file switches wildcard full-directory-p) | 215 | file switches wildcard full-directory-p) |
| @@ -286,7 +286,10 @@ not contain `d', so that a full listing is expected." | |||
| 286 | (let* ((dir (file-name-as-directory file)) | 286 | (let* ((dir (file-name-as-directory file)) |
| 287 | (default-directory dir) ; so that file-attributes works | 287 | (default-directory dir) ; so that file-attributes works |
| 288 | (file-alist | 288 | (file-alist |
| 289 | (directory-files-and-attributes dir nil wildcard-regexp t 'string)) | 289 | (directory-files-and-attributes dir nil wildcard-regexp t |
| 290 | (if (memq ?n switches) | ||
| 291 | 'integer | ||
| 292 | 'string))) | ||
| 290 | (now (current-time)) | 293 | (now (current-time)) |
| 291 | (sum 0) | 294 | (sum 0) |
| 292 | ;; do all bindings here for speed | 295 | ;; do all bindings here for speed |
diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el index 36cd17fe6fc..5b292961b98 100644 --- a/lisp/mail/hashcash.el +++ b/lisp/mail/hashcash.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; hashcash.el --- Add hashcash payments to email | 1 | ;;; hashcash.el --- Add hashcash payments to email |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2004, 2005, 2007 Free Software Foundation | 3 | ;; Copyright (C) 2003, 2004, 2005, 2007, 2008 Free Software Foundation |
| 4 | 4 | ||
| 5 | ;; Written by: Paul Foley <mycroft@actrix.gen.nz> (1997-2002) | 5 | ;; Written by: Paul Foley <mycroft@actrix.gen.nz> (1997-2002) |
| 6 | ;; Maintainer: Paul Foley <mycroft@actrix.gen.nz> | 6 | ;; Maintainer: Paul Foley <mycroft@actrix.gen.nz> |
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 7a6e013e5d0..359088ec2e7 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el | |||
| @@ -1934,7 +1934,7 @@ is non-nil if the user has supplied the password interactively. | |||
| 1934 | (save-restriction | 1934 | (save-restriction |
| 1935 | (while (not (eobp)) | 1935 | (while (not (eobp)) |
| 1936 | (setq start (point)) | 1936 | (setq start (point)) |
| 1937 | (cond ((looking-at "BABYL OPTIONS:");Babyl header | 1937 | (cond ((looking-at "BABYL OPTIONS:") ;Babyl header |
| 1938 | (if (search-forward "\n\^_" nil t) | 1938 | (if (search-forward "\n\^_" nil t) |
| 1939 | ;; If we find the proper terminator, delete through there. | 1939 | ;; If we find the proper terminator, delete through there. |
| 1940 | (delete-region (point-min) (point)) | 1940 | (delete-region (point-min) (point)) |
| @@ -1953,75 +1953,80 @@ is non-nil if the user has supplied the password interactively. | |||
| 1953 | (save-excursion | 1953 | (save-excursion |
| 1954 | (skip-chars-forward " \t\n") | 1954 | (skip-chars-forward " \t\n") |
| 1955 | (point))) | 1955 | (point))) |
| 1956 | (save-excursion | 1956 | ;; The following let* form was wrapped in a `save-excursion' |
| 1957 | (let* ((header-end | 1957 | ;; which in one case caused infinite looping, see: |
| 1958 | (progn | 1958 | ;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00968.html |
| 1959 | (save-excursion | 1959 | ;; Removing that form leaves `point' at the end of the |
| 1960 | (goto-char start) | 1960 | ;; region decoded by `rmail-decode-region' which should |
| 1961 | (forward-line 1) | 1961 | ;; be correct. |
| 1962 | (if (looking-at "0") | 1962 | (let* ((header-end |
| 1963 | (forward-line 1) | 1963 | (progn |
| 1964 | (forward-line 2)) | ||
| 1965 | (save-restriction | ||
| 1966 | (narrow-to-region (point) (point-max)) | ||
| 1967 | (rfc822-goto-eoh) | ||
| 1968 | (point))))) | ||
| 1969 | (case-fold-search t) | ||
| 1970 | (quoted-printable-header-field-end | ||
| 1971 | (save-excursion | ||
| 1972 | (goto-char start) | ||
| 1973 | (re-search-forward | ||
| 1974 | "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*" | ||
| 1975 | header-end t))) | ||
| 1976 | (base64-header-field-end | ||
| 1977 | (save-excursion | 1964 | (save-excursion |
| 1978 | (goto-char start) | 1965 | (goto-char start) |
| 1979 | ;; Don't try to decode non-text data. | 1966 | (forward-line 1) |
| 1980 | (and (re-search-forward | 1967 | (if (looking-at "0") |
| 1981 | "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/" | 1968 | (forward-line 1) |
| 1982 | header-end t) | 1969 | (forward-line 2)) |
| 1983 | (goto-char start) | 1970 | (save-restriction |
| 1984 | (re-search-forward | 1971 | (narrow-to-region (point) (point-max)) |
| 1985 | "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*" | 1972 | (rfc822-goto-eoh) |
| 1986 | header-end t))))) | 1973 | (point))))) |
| 1987 | (if quoted-printable-header-field-end | 1974 | (case-fold-search t) |
| 1975 | (quoted-printable-header-field-end | ||
| 1988 | (save-excursion | 1976 | (save-excursion |
| 1989 | (unless | 1977 | (goto-char start) |
| 1990 | (mail-unquote-printable-region header-end (point) nil t t) | 1978 | (re-search-forward |
| 1991 | (message "Malformed MIME quoted-printable message")) | 1979 | "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*" |
| 1992 | ;; Change "quoted-printable" to "8bit", | 1980 | header-end t))) |
| 1993 | ;; to reflect the decoding we just did. | 1981 | (base64-header-field-end |
| 1994 | (goto-char quoted-printable-header-field-end) | ||
| 1995 | (delete-region (point) (search-backward ":")) | ||
| 1996 | (insert ": 8bit"))) | ||
| 1997 | (if base64-header-field-end | ||
| 1998 | (save-excursion | 1982 | (save-excursion |
| 1999 | (when | 1983 | (goto-char start) |
| 2000 | (condition-case nil | 1984 | ;; Don't try to decode non-text data. |
| 2001 | (progn | 1985 | (and (re-search-forward |
| 2002 | (base64-decode-region (1+ header-end) | 1986 | "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/" |
| 2003 | (- (point) 2)) | 1987 | header-end t) |
| 2004 | t) | 1988 | (goto-char start) |
| 2005 | (error nil)) | 1989 | (re-search-forward |
| 2006 | ;; Change "base64" to "8bit", to reflect the | 1990 | "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*" |
| 2007 | ;; decoding we just did. | 1991 | header-end t))))) |
| 2008 | (goto-char base64-header-field-end) | 1992 | (if quoted-printable-header-field-end |
| 2009 | (delete-region (point) (search-backward ":")) | 1993 | (save-excursion |
| 2010 | (insert ": 8bit")))) | 1994 | (unless |
| 2011 | (setq last-coding-system-used nil) | 1995 | (mail-unquote-printable-region header-end (point) nil t t) |
| 2012 | (or rmail-enable-mime | 1996 | (message "Malformed MIME quoted-printable message")) |
| 2013 | (not rmail-enable-multibyte) | 1997 | ;; Change "quoted-printable" to "8bit", |
| 2014 | (let ((mime-charset | 1998 | ;; to reflect the decoding we just did. |
| 2015 | (if (and rmail-decode-mime-charset | 1999 | (goto-char quoted-printable-header-field-end) |
| 2016 | (save-excursion | 2000 | (delete-region (point) (search-backward ":")) |
| 2017 | (goto-char start) | 2001 | (insert ": 8bit"))) |
| 2018 | (search-forward "\n\n" nil t) | 2002 | (if base64-header-field-end |
| 2019 | (let ((case-fold-search t)) | 2003 | (save-excursion |
| 2020 | (re-search-backward | 2004 | (when |
| 2021 | rmail-mime-charset-pattern | 2005 | (condition-case nil |
| 2022 | start t)))) | 2006 | (progn |
| 2023 | (intern (downcase (match-string 1)))))) | 2007 | (base64-decode-region (1+ header-end) |
| 2024 | (rmail-decode-region start (point) mime-charset))))) | 2008 | (- (point) 2)) |
| 2009 | t) | ||
| 2010 | (error nil)) | ||
| 2011 | ;; Change "base64" to "8bit", to reflect the | ||
| 2012 | ;; decoding we just did. | ||
| 2013 | (goto-char base64-header-field-end) | ||
| 2014 | (delete-region (point) (search-backward ":")) | ||
| 2015 | (insert ": 8bit")))) | ||
| 2016 | (setq last-coding-system-used nil) | ||
| 2017 | (or rmail-enable-mime | ||
| 2018 | (not rmail-enable-multibyte) | ||
| 2019 | (let ((mime-charset | ||
| 2020 | (if (and rmail-decode-mime-charset | ||
| 2021 | (save-excursion | ||
| 2022 | (goto-char start) | ||
| 2023 | (search-forward "\n\n" nil t) | ||
| 2024 | (let ((case-fold-search t)) | ||
| 2025 | (re-search-backward | ||
| 2026 | rmail-mime-charset-pattern | ||
| 2027 | start t)))) | ||
| 2028 | (intern (downcase (match-string 1)))))) | ||
| 2029 | (rmail-decode-region start (point) mime-charset)))) | ||
| 2025 | ;; Add an X-Coding-System: header if we don't have one. | 2030 | ;; Add an X-Coding-System: header if we don't have one. |
| 2026 | (save-excursion | 2031 | (save-excursion |
| 2027 | (goto-char start) | 2032 | (goto-char start) |
| @@ -2051,8 +2056,8 @@ is non-nil if the user has supplied the password interactively. | |||
| 2051 | (save-restriction | 2056 | (save-restriction |
| 2052 | (narrow-to-region start (1- (point))) | 2057 | (narrow-to-region start (1- (point))) |
| 2053 | (goto-char (point-min)) | 2058 | (goto-char (point-min)) |
| 2054 | (while (search-forward "\n\^_" nil t); single char "\^_" | 2059 | (while (search-forward "\n\^_" nil t) ; single char "\^_" |
| 2055 | (replace-match "\n^_")))); 2 chars: "^" and "_" | 2060 | (replace-match "\n^_")))) ; 2 chars: "^" and "_" |
| 2056 | (setq last-coding-system-used nil) | 2061 | (setq last-coding-system-used nil) |
| 2057 | (or rmail-enable-mime | 2062 | (or rmail-enable-mime |
| 2058 | (not rmail-enable-multibyte) | 2063 | (not rmail-enable-multibyte) |
| @@ -2168,8 +2173,8 @@ is non-nil if the user has supplied the password interactively. | |||
| 2168 | (save-restriction | 2173 | (save-restriction |
| 2169 | (narrow-to-region start (point)) | 2174 | (narrow-to-region start (point)) |
| 2170 | (goto-char (point-min)) | 2175 | (goto-char (point-min)) |
| 2171 | (while (search-forward "\n\^_" nil t); single char | 2176 | (while (search-forward "\n\^_" nil t) ; single char |
| 2172 | (replace-match "\n^_")))); 2 chars: "^" and "_" | 2177 | (replace-match "\n^_")))) ; 2 chars: "^" and "_" |
| 2173 | ;; This is for malformed messages that don't end in newline. | 2178 | ;; This is for malformed messages that don't end in newline. |
| 2174 | ;; There shouldn't be any, but some users say occasionally | 2179 | ;; There shouldn't be any, but some users say occasionally |
| 2175 | ;; there are some. | 2180 | ;; there are some. |
diff --git a/lisp/mb-depth.el b/lisp/mb-depth.el index c1fd0780730..d85380ea64c 100644 --- a/lisp/mb-depth.el +++ b/lisp/mb-depth.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; mb-depth.el --- Indicate minibuffer-depth in prompt | 1 | ;;; mb-depth.el --- Indicate minibuffer-depth in prompt |
| 2 | ;; | 2 | ;; |
| 3 | ;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. |
| 4 | ;; | 4 | ;; |
| 5 | ;; Author: Miles Bader <miles@gnu.org> | 5 | ;; Author: Miles Bader <miles@gnu.org> |
| 6 | ;; Keywords: convenience | 6 | ;; Keywords: convenience |
diff --git a/lisp/md4.el b/lisp/md4.el index 7ccb22a20fe..13435097b71 100644 --- a/lisp/md4.el +++ b/lisp/md4.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; md4.el --- MD4 Message Digest Algorithm. | 1 | ;;; md4.el --- MD4 Message Digest Algorithm. |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2001, 2004, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2001, 2004, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Taro Kawagishi <tarok@transpulse.org> | 5 | ;; Author: Taro Kawagishi <tarok@transpulse.org> |
| 6 | ;; Keywords: MD4 | 6 | ;; Keywords: MD4 |
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index 0eba20a9899..96c612da42a 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2008-01-30 Bill Wohler <wohler@newt.com> | ||
| 2 | |||
| 3 | * mh-mime.el (mh-mml-to-mime): Don't look up sender if From | ||
| 4 | absent. Fixes "Wrong type argument: stringp, nil" error. | ||
| 5 | |||
| 1 | 2007-12-02 Glenn Morris <rgm@gnu.org> | 6 | 2007-12-02 Glenn Morris <rgm@gnu.org> |
| 2 | 7 | ||
| 3 | * mh-mime.el (mail-strip-quoted-names): Autoload it. | 8 | * mh-mime.el (mail-strip-quoted-names): Autoload it. |
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index ec0940a5d5e..5713ec8dba4 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el | |||
| @@ -1621,13 +1621,14 @@ This action can be undone by running \\[undo]." | |||
| 1621 | (require 'message) | 1621 | (require 'message) |
| 1622 | (when mh-pgp-support-flag | 1622 | (when mh-pgp-support-flag |
| 1623 | ;; PGP requires actual e-mail addresses, not aliases. | 1623 | ;; PGP requires actual e-mail addresses, not aliases. |
| 1624 | ;; Parse the recipients and sender from the message | 1624 | ;; Parse the recipients and sender from the message. |
| 1625 | (message-options-set-recipient) | 1625 | (message-options-set-recipient) |
| 1626 | ;; Do an alias lookup on sender | 1626 | ;; Do an alias lookup on sender (if From field is present). |
| 1627 | (message-options-set 'message-sender | 1627 | (when (message-options-get 'message-sender) |
| 1628 | (mail-strip-quoted-names | 1628 | (message-options-set 'message-sender |
| 1629 | (mh-alias-expand | 1629 | (mail-strip-quoted-names |
| 1630 | (message-options-get 'message-sender)))) | 1630 | (mh-alias-expand |
| 1631 | (message-options-get 'message-sender))))) | ||
| 1631 | ;; Do an alias lookup on recipients | 1632 | ;; Do an alias lookup on recipients |
| 1632 | (message-options-set 'message-recipients | 1633 | (message-options-set 'message-recipients |
| 1633 | (mapconcat | 1634 | (mapconcat |
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 83075762b73..ef84db1ccf7 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el | |||
| @@ -46,6 +46,17 @@ | |||
| 46 | (defconst dbus-interface-introspectable "org.freedesktop.DBus.Introspectable" | 46 | (defconst dbus-interface-introspectable "org.freedesktop.DBus.Introspectable" |
| 47 | "The interface supported by introspectable objects.") | 47 | "The interface supported by introspectable objects.") |
| 48 | 48 | ||
| 49 | (defmacro dbus-ignore-errors (&rest body) | ||
| 50 | "Execute BODY; signal D-Bus error when `dbus-debug' is non-nil. | ||
| 51 | Otherwise, return result of last form in BODY, or all other errors." | ||
| 52 | `(condition-case err | ||
| 53 | (progn ,@body) | ||
| 54 | (dbus-error (when dbus-debug (signal (car err) (cdr err)))))) | ||
| 55 | |||
| 56 | (put 'dbus-ignore-errors 'lisp-indent-function 0) | ||
| 57 | (put 'dbus-ignore-errors 'edebug-form-spec '(form symbolp body)) | ||
| 58 | (font-lock-add-keywords 'emacs-lisp-mode '("\\<dbus-ignore-errors\\>")) | ||
| 59 | |||
| 49 | 60 | ||
| 50 | ;;; Hash table of registered functions. | 61 | ;;; Hash table of registered functions. |
| 51 | 62 | ||
| @@ -64,6 +75,35 @@ hash table." | |||
| 64 | dbus-registered-functions-table) | 75 | dbus-registered-functions-table) |
| 65 | result)) | 76 | result)) |
| 66 | 77 | ||
| 78 | (defun dbus-unregister-object (object) | ||
| 79 | "Unregister OBJECT from D-Bus. | ||
| 80 | OBJECT must be the result of a preceding `dbus-register-method' | ||
| 81 | or `dbus-register-signal' call. It returns t if OBJECT has been | ||
| 82 | unregistered, nil otherwise." | ||
| 83 | ;; Check parameter. | ||
| 84 | (unless (and (consp object) (not (null (car object))) (consp (cdr object))) | ||
| 85 | (signal 'wrong-type-argument (list 'D-Bus object))) | ||
| 86 | |||
| 87 | ;; Find the corresponding entry in the hash table. | ||
| 88 | (let* ((key (car object)) | ||
| 89 | (value (gethash key dbus-registered-functions-table))) | ||
| 90 | ;; Loop over the registered functions. | ||
| 91 | (while (consp value) | ||
| 92 | ;; (car value) has the structure (UNAME SERVICE PATH HANDLER). | ||
| 93 | ;; (cdr object) has the structure ((SERVICE PATH HANDLER) ...). | ||
| 94 | (if (not (equal (cdr (car value)) (car (cdr object)))) | ||
| 95 | (setq value (cdr value)) | ||
| 96 | ;; Compute new hash value. If it is empty, remove it from | ||
| 97 | ;; hash table. | ||
| 98 | (unless | ||
| 99 | (puthash | ||
| 100 | key | ||
| 101 | (delete (car value) (gethash key dbus-registered-functions-table)) | ||
| 102 | dbus-registered-functions-table) | ||
| 103 | (remhash key dbus-registered-functions-table)) | ||
| 104 | (setq value t))) | ||
| 105 | value)) | ||
| 106 | |||
| 67 | (defun dbus-name-owner-changed-handler (&rest args) | 107 | (defun dbus-name-owner-changed-handler (&rest args) |
| 68 | "Reapplies all member registrations to D-Bus. | 108 | "Reapplies all member registrations to D-Bus. |
| 69 | This handler is applied when a \"NameOwnerChanged\" signal has | 109 | This handler is applied when a \"NameOwnerChanged\" signal has |
| @@ -110,15 +150,13 @@ usage: (dbus-name-owner-changed-handler service old-owner new-owner)" | |||
| 110 | args)))))) | 150 | args)))))) |
| 111 | 151 | ||
| 112 | ;; Register the handler. | 152 | ;; Register the handler. |
| 113 | (condition-case nil | 153 | (dbus-ignore-errors |
| 114 | (progn | 154 | (dbus-register-signal |
| 115 | (dbus-register-signal | 155 | :system dbus-service-dbus dbus-path-dbus dbus-interface-dbus |
| 116 | :system dbus-service-dbus dbus-path-dbus dbus-interface-dbus | 156 | "NameOwnerChanged" 'dbus-name-owner-changed-handler) |
| 117 | "NameOwnerChanged" 'dbus-name-owner-changed-handler) | 157 | (dbus-register-signal |
| 118 | (dbus-register-signal | 158 | :session dbus-service-dbus dbus-path-dbus dbus-interface-dbus |
| 119 | :session dbus-service-dbus dbus-path-dbus dbus-interface-dbus | 159 | "NameOwnerChanged" 'dbus-name-owner-changed-handler)) |
| 120 | "NameOwnerChanged" 'dbus-name-owner-changed-handler)) | ||
| 121 | (dbus-error)) | ||
| 122 | 160 | ||
| 123 | 161 | ||
| 124 | ;;; D-Bus events. | 162 | ;;; D-Bus events. |
| @@ -168,16 +206,15 @@ part of the event, is called with arguments ARGS." | |||
| 168 | (interactive "e") | 206 | (interactive "e") |
| 169 | ;; We don't want to raise an error, because this function is called | 207 | ;; We don't want to raise an error, because this function is called |
| 170 | ;; in the event handling loop. | 208 | ;; in the event handling loop. |
| 171 | (condition-case err | 209 | (dbus-ignore-errors |
| 172 | (let (result) | 210 | (let (result) |
| 173 | (dbus-check-event event) | 211 | (dbus-check-event event) |
| 174 | (setq result (apply (nth 7 event) (nthcdr 8 event))) | 212 | (setq result (apply (nth 7 event) (nthcdr 8 event))) |
| 175 | (unless (consp result) (setq result (cons result nil))) | 213 | (unless (consp result) (setq result (cons result nil))) |
| 176 | ;; Return a message when serial is not nil. | 214 | ;; Return a message when serial is not nil. |
| 177 | (when (not (null (nth 2 event))) | 215 | (when (not (null (nth 2 event))) |
| 178 | (apply 'dbus-method-return | 216 | (apply 'dbus-method-return-internal |
| 179 | (nth 1 event) (nth 2 event) (nth 3 event) result))) | 217 | (nth 1 event) (nth 2 event) (nth 3 event) result))))) |
| 180 | (dbus-error (when dbus-debug (signal (car err) (cdr err)))))) | ||
| 181 | 218 | ||
| 182 | (defun dbus-event-bus-name (event) | 219 | (defun dbus-event-bus-name (event) |
| 183 | "Return the bus name the event is coming from. | 220 | "Return the bus name the event is coming from. |
| @@ -238,11 +275,10 @@ well formed." | |||
| 238 | "Return the D-Bus service names which can be activated as list. | 275 | "Return the D-Bus service names which can be activated as list. |
| 239 | The result is a list of strings, which is nil when there are no | 276 | The result is a list of strings, which is nil when there are no |
| 240 | activatable service names at all." | 277 | activatable service names at all." |
| 241 | (condition-case nil | 278 | (dbus-ignore-errors |
| 242 | (dbus-call-method | 279 | (dbus-call-method |
| 243 | :system dbus-service-dbus | 280 | :system dbus-service-dbus |
| 244 | dbus-path-dbus dbus-interface-dbus "ListActivatableNames") | 281 | dbus-path-dbus dbus-interface-dbus "ListActivatableNames"))) |
| 245 | (dbus-error))) | ||
| 246 | 282 | ||
| 247 | (defun dbus-list-names (bus) | 283 | (defun dbus-list-names (bus) |
| 248 | "Return the service names registered at D-Bus BUS. | 284 | "Return the service names registered at D-Bus BUS. |
| @@ -250,10 +286,9 @@ The result is a list of strings, which is nil when there are no | |||
| 250 | registered service names at all. Well known names are strings like | 286 | registered service names at all. Well known names are strings like |
| 251 | \"org.freedesktop.DBus\". Names starting with \":\" are unique names | 287 | \"org.freedesktop.DBus\". Names starting with \":\" are unique names |
| 252 | for services." | 288 | for services." |
| 253 | (condition-case nil | 289 | (dbus-ignore-errors |
| 254 | (dbus-call-method | 290 | (dbus-call-method |
| 255 | bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames") | 291 | bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames"))) |
| 256 | (dbus-error))) | ||
| 257 | 292 | ||
| 258 | (defun dbus-list-known-names (bus) | 293 | (defun dbus-list-known-names (bus) |
| 259 | "Retrieve all services which correspond to a known name in BUS. | 294 | "Retrieve all services which correspond to a known name in BUS. |
| @@ -267,20 +302,18 @@ A service has a known name if it doesn't start with \":\"." | |||
| 267 | "Return the unique names registered at D-Bus BUS and queued for SERVICE. | 302 | "Return the unique names registered at D-Bus BUS and queued for SERVICE. |
| 268 | The result is a list of strings, or nil when there are no queued name | 303 | The result is a list of strings, or nil when there are no queued name |
| 269 | owners service names at all." | 304 | owners service names at all." |
| 270 | (condition-case nil | 305 | (dbus-ignore-errors |
| 271 | (dbus-call-method | 306 | (dbus-call-method |
| 272 | bus dbus-service-dbus dbus-path-dbus | 307 | bus dbus-service-dbus dbus-path-dbus |
| 273 | dbus-interface-dbus "ListQueuedOwners" service) | 308 | dbus-interface-dbus "ListQueuedOwners" service))) |
| 274 | (dbus-error))) | ||
| 275 | 309 | ||
| 276 | (defun dbus-get-name-owner (bus service) | 310 | (defun dbus-get-name-owner (bus service) |
| 277 | "Return the name owner of SERVICE registered at D-Bus BUS. | 311 | "Return the name owner of SERVICE registered at D-Bus BUS. |
| 278 | The result is either a string, or nil if there is no name owner." | 312 | The result is either a string, or nil if there is no name owner." |
| 279 | (condition-case nil | 313 | (dbus-ignore-errors |
| 280 | (dbus-call-method | 314 | (dbus-call-method |
| 281 | bus dbus-service-dbus dbus-path-dbus | 315 | bus dbus-service-dbus dbus-path-dbus |
| 282 | dbus-interface-dbus "GetNameOwner" service) | 316 | dbus-interface-dbus "GetNameOwner" service))) |
| 283 | (dbus-error))) | ||
| 284 | 317 | ||
| 285 | (defun dbus-introspect (bus service path) | 318 | (defun dbus-introspect (bus service path) |
| 286 | "Return the introspection data of SERVICE in D-Bus BUS at object path PATH. | 319 | "Return the introspection data of SERVICE in D-Bus BUS at object path PATH. |
| @@ -291,10 +324,9 @@ Example: | |||
| 291 | \(dbus-introspect | 324 | \(dbus-introspect |
| 292 | :system \"org.freedesktop.Hal\" | 325 | :system \"org.freedesktop.Hal\" |
| 293 | \"/org/freedesktop/Hal/devices/computer\")" | 326 | \"/org/freedesktop/Hal/devices/computer\")" |
| 294 | (condition-case nil | 327 | (dbus-ignore-errors |
| 295 | (dbus-call-method | 328 | (dbus-call-method |
| 296 | bus service path dbus-interface-introspectable "Introspect") | 329 | bus service path dbus-interface-introspectable "Introspect"))) |
| 297 | (dbus-error))) | ||
| 298 | 330 | ||
| 299 | (if nil ;; Must be reworked. Shall we offer D-Bus signatures at all? | 331 | (if nil ;; Must be reworked. Shall we offer D-Bus signatures at all? |
| 300 | (defun dbus-get-signatures (bus interface signal) | 332 | (defun dbus-get-signatures (bus interface signal) |
| @@ -310,42 +342,39 @@ the third parameter is of type array of integer. | |||
| 310 | If INTERFACE or SIGNAL do not exist, or if they do not support | 342 | If INTERFACE or SIGNAL do not exist, or if they do not support |
| 311 | the D-Bus method org.freedesktop.DBus.Introspectable.Introspect, | 343 | the D-Bus method org.freedesktop.DBus.Introspectable.Introspect, |
| 312 | the function returns nil." | 344 | the function returns nil." |
| 313 | (condition-case nil | 345 | (dbus-ignore-errors |
| 314 | (let ((introspect-xml | 346 | (let ((introspect-xml |
| 315 | (with-temp-buffer | 347 | (with-temp-buffer |
| 316 | (insert (dbus-introspect bus interface)) | 348 | (insert (dbus-introspect bus interface)) |
| 317 | (xml-parse-region (point-min) (point-max)))) | 349 | (xml-parse-region (point-min) (point-max)))) |
| 318 | node interfaces signals args result) | 350 | node interfaces signals args result) |
| 319 | ;; Get the root node. | 351 | ;; Get the root node. |
| 320 | (setq node (xml-node-name introspect-xml)) | 352 | (setq node (xml-node-name introspect-xml)) |
| 321 | ;; Get all interfaces. | 353 | ;; Get all interfaces. |
| 322 | (setq interfaces (xml-get-children node 'interface)) | 354 | (setq interfaces (xml-get-children node 'interface)) |
| 323 | (while interfaces | 355 | (while interfaces |
| 324 | (when (string-equal (xml-get-attribute (car interfaces) 'name) | 356 | (when (string-equal (xml-get-attribute (car interfaces) 'name) |
| 325 | interface) | 357 | interface) |
| 326 | ;; That's the requested interface. Check for signals. | 358 | ;; That's the requested interface. Check for signals. |
| 327 | (setq signals (xml-get-children (car interfaces) 'signal)) | 359 | (setq signals (xml-get-children (car interfaces) 'signal)) |
| 328 | (while signals | 360 | (while signals |
| 329 | (when (string-equal (xml-get-attribute (car signals) 'name) | 361 | (when (string-equal (xml-get-attribute (car signals) 'name) signal) |
| 330 | signal) | 362 | ;; The signal we are looking for. |
| 331 | ;; The signal we are looking for. | 363 | (setq args (xml-get-children (car signals) 'arg)) |
| 332 | (setq args (xml-get-children (car signals) 'arg)) | 364 | (while args |
| 333 | (while args | 365 | (unless (xml-get-attribute (car args) 'type) |
| 334 | (unless (xml-get-attribute (car args) 'type) | 366 | ;; This shouldn't happen, let's escape. |
| 335 | ;; This shouldn't happen, let's escape. | 367 | (signal 'dbus-error nil)) |
| 336 | (signal 'dbus-error "")) | 368 | ;; We append the signature. |
| 337 | ;; We append the signature. | 369 | (setq |
| 338 | (setq | 370 | result (append result |
| 339 | result (append result | 371 | (list (xml-get-attribute (car args) 'type)))) |
| 340 | (list (xml-get-attribute (car args) 'type)))) | 372 | (setq args (cdr args))) |
| 341 | (setq args (cdr args))) | 373 | (setq signals nil)) |
| 342 | (setq signals nil)) | 374 | (setq signals (cdr signals))) |
| 343 | (setq signals (cdr signals))) | 375 | (setq interfaces nil)) |
| 344 | (setq interfaces nil)) | 376 | (setq interfaces (cdr interfaces))) |
| 345 | (setq interfaces (cdr interfaces))) | 377 | result))) |
| 346 | result) | ||
| 347 | ;; We ignore `dbus-error'. There might be no introspectable interface. | ||
| 348 | (dbus-error nil))) | ||
| 349 | ) ;; (if nil ... | 378 | ) ;; (if nil ... |
| 350 | 379 | ||
| 351 | (provide 'dbus) | 380 | (provide 'dbus) |
diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el index bfff7282adf..6b7cb7ddecc 100644 --- a/lisp/net/hmac-def.el +++ b/lisp/net/hmac-def.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; hmac-def.el --- A macro for defining HMAC functions. | 1 | ;;; hmac-def.el --- A macro for defining HMAC functions. |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1999, 2001, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1999, 2001, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> | 5 | ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> |
| 6 | ;; Keywords: HMAC, RFC 2104 | 6 | ;; Keywords: HMAC, RFC 2104 |
diff --git a/lisp/net/hmac-md5.el b/lisp/net/hmac-md5.el index 186708446f0..50a2d2742b7 100644 --- a/lisp/net/hmac-md5.el +++ b/lisp/net/hmac-md5.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; hmac-md5.el --- Compute HMAC-MD5. | 1 | ;;; hmac-md5.el --- Compute HMAC-MD5. |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1999, 2001, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1999, 2001, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> | 5 | ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> |
| 6 | ;; Keywords: HMAC, RFC 2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5 | 6 | ;; Keywords: HMAC, RFC 2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5 |
diff --git a/lisp/net/imap.el b/lisp/net/imap.el index 0ee4de6fee8..27b434541ce 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el | |||
| @@ -1150,6 +1150,13 @@ necessary. If nil, the buffer name is generated." | |||
| 1150 | (when imap-stream | 1150 | (when imap-stream |
| 1151 | buffer)))) | 1151 | buffer)))) |
| 1152 | 1152 | ||
| 1153 | (defcustom imap-ping-server t | ||
| 1154 | "If non-nil, check if IMAP is open. | ||
| 1155 | See the function `imap-ping-server'." | ||
| 1156 | :version "23.0" ;; No Gnus | ||
| 1157 | :group 'imap | ||
| 1158 | :type 'boolean) | ||
| 1159 | |||
| 1153 | (defun imap-opened (&optional buffer) | 1160 | (defun imap-opened (&optional buffer) |
| 1154 | "Return non-nil if connection to imap server in BUFFER is open. | 1161 | "Return non-nil if connection to imap server in BUFFER is open. |
| 1155 | If BUFFER is nil then the current buffer is used." | 1162 | If BUFFER is nil then the current buffer is used." |
| @@ -1157,7 +1164,18 @@ If BUFFER is nil then the current buffer is used." | |||
| 1157 | (buffer-live-p buffer) | 1164 | (buffer-live-p buffer) |
| 1158 | (with-current-buffer buffer | 1165 | (with-current-buffer buffer |
| 1159 | (and imap-process | 1166 | (and imap-process |
| 1160 | (memq (process-status imap-process) '(open run)))))) | 1167 | (memq (process-status imap-process) '(open run)) |
| 1168 | (if imap-ping-server | ||
| 1169 | (imap-ping-server) | ||
| 1170 | t))))) | ||
| 1171 | |||
| 1172 | (defun imap-ping-server (&optional buffer) | ||
| 1173 | "Ping the IMAP server in BUFFER with a \"NOOP\" command. | ||
| 1174 | Return non-nil if the server responds, and nil if it does not | ||
| 1175 | respond. If BUFFER is nil, the current buffer is used." | ||
| 1176 | (condition-case () | ||
| 1177 | (imap-ok-p (imap-send-command-wait "NOOP" buffer)) | ||
| 1178 | (error nil))) | ||
| 1161 | 1179 | ||
| 1162 | (defun imap-authenticate (&optional user passwd buffer) | 1180 | (defun imap-authenticate (&optional user passwd buffer) |
| 1163 | "Authenticate to server in BUFFER, using current buffer if nil. | 1181 | "Authenticate to server in BUFFER, using current buffer if nil. |
diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el index 126f6688f0d..2418338228b 100644 --- a/lisp/net/ntlm.el +++ b/lisp/net/ntlm.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; ntlm.el --- NTLM (NT LanManager) authentication support | 1 | ;;; ntlm.el --- NTLM (NT LanManager) authentication support |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2001, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2001, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Taro Kawagishi <tarok@transpulse.org> | 5 | ;; Author: Taro Kawagishi <tarok@transpulse.org> |
| 6 | ;; Keywords: NTLM, SASL | 6 | ;; Keywords: NTLM, SASL |
diff --git a/lisp/net/sasl-cram.el b/lisp/net/sasl-cram.el index 32f1e69f81f..911c8fe1805 100644 --- a/lisp/net/sasl-cram.el +++ b/lisp/net/sasl-cram.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework | 1 | ;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2000, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2000, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Daiki Ueno <ueno@unixuser.org> | 5 | ;; Author: Daiki Ueno <ueno@unixuser.org> |
| 6 | ;; Kenichi OKADA <okada@opaopa.org> | 6 | ;; Kenichi OKADA <okada@opaopa.org> |
diff --git a/lisp/net/sasl-digest.el b/lisp/net/sasl-digest.el index 6c544518e7f..85417dff31e 100644 --- a/lisp/net/sasl-digest.el +++ b/lisp/net/sasl-digest.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework | 1 | ;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2000, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2000, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Daiki Ueno <ueno@unixuser.org> | 5 | ;; Author: Daiki Ueno <ueno@unixuser.org> |
| 6 | ;; Kenichi OKADA <okada@opaopa.org> | 6 | ;; Kenichi OKADA <okada@opaopa.org> |
diff --git a/lisp/net/sasl-ntlm.el b/lisp/net/sasl-ntlm.el index cd8304db70a..699fd125270 100644 --- a/lisp/net/sasl-ntlm.el +++ b/lisp/net/sasl-ntlm.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework | 1 | ;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2000, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2000, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Taro Kawagishi <tarok@transpulse.org> | 5 | ;; Author: Taro Kawagishi <tarok@transpulse.org> |
| 6 | ;; Keywords: SASL, NTLM | 6 | ;; Keywords: SASL, NTLM |
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el index 9118d288da4..000bca51040 100644 --- a/lisp/net/sasl.el +++ b/lisp/net/sasl.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; sasl.el --- SASL client framework | 1 | ;;; sasl.el --- SASL client framework |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2000, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2000, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Daiki Ueno <ueno@unixuser.org> | 5 | ;; Author: Daiki Ueno <ueno@unixuser.org> |
| 6 | ;; Keywords: SASL | 6 | ;; Keywords: SASL |
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index b28c20263f4..4654c212ee3 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; tramp-cache.el --- file information caching for Tramp | 1 | ;;; tramp-cache.el --- file information caching for Tramp |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2000, 2005, 2006, 2007 by Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2000, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Daniel Pittman <daniel@inanna.danann.net> | 5 | ;; Author: Daniel Pittman <daniel@inanna.danann.net> |
| 6 | ;; Michael Albinus <michael.albinus@gmx.de> | 6 | ;; Michael Albinus <michael.albinus@gmx.de> |
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 7cf2bf3d923..d76e27e443c 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; tramp-cmds.el --- Interactive commands for Tramp | 1 | ;;; tramp-cmds.el --- Interactive commands for Tramp |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> | 5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> |
| 6 | ;; Keywords: comm, processes | 6 | ;; Keywords: comm, processes |
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index b63b8c1e2fb..fcd8ba112b5 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; tramp-compat.el --- Tramp compatibility functions | 1 | ;;; tramp-compat.el --- Tramp compatibility functions |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> | 5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> |
| 6 | ;; Keywords: comm, processes | 6 | ;; Keywords: comm, processes |
diff --git a/lisp/net/tramp-fish.el b/lisp/net/tramp-fish.el index 95091c276bc..f6f455b1823 100644 --- a/lisp/net/tramp-fish.el +++ b/lisp/net/tramp-fish.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; tramp-fish.el --- Tramp access functions for FISH protocol | 1 | ;;; tramp-fish.el --- Tramp access functions for FISH protocol |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> | 5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> |
| 6 | ;; Keywords: comm, processes | 6 | ;; Keywords: comm, processes |
diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el index fa2e9ba68b0..498112c66b1 100644 --- a/lisp/net/tramp-gw.el +++ b/lisp/net/tramp-gw.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; tramp-gw.el --- Tramp utility functions for HTTP tunnels and SOCKS gateways | 1 | ;;; tramp-gw.el --- Tramp utility functions for HTTP tunnels and SOCKS gateways |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> | 5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> |
| 6 | ;; Keywords: comm, processes | 6 | ;; Keywords: comm, processes |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 5a65b95b0f8..5829635d035 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -441,7 +441,7 @@ files conditionalize this setup based on the TERM environment variable." | |||
| 441 | (tramp-password-end-of-line nil)) | 441 | (tramp-password-end-of-line nil)) |
| 442 | ("sudo" (tramp-login-program "sudo") | 442 | ("sudo" (tramp-login-program "sudo") |
| 443 | (tramp-login-args (("-u" "%u") | 443 | (tramp-login-args (("-u" "%u") |
| 444 | ("-s" "-p" "Password:"))) | 444 | ("-s") ("-H") ("-p" "Password:"))) |
| 445 | (tramp-remote-sh "/bin/sh") | 445 | (tramp-remote-sh "/bin/sh") |
| 446 | (tramp-copy-program nil) | 446 | (tramp-copy-program nil) |
| 447 | (tramp-copy-args nil) | 447 | (tramp-copy-args nil) |
| @@ -519,7 +519,9 @@ files conditionalize this setup based on the TERM environment variable." | |||
| 519 | (tramp-default-port 22)) | 519 | (tramp-default-port 22)) |
| 520 | ("plinkx" | 520 | ("plinkx" |
| 521 | (tramp-login-program "plink") | 521 | (tramp-login-program "plink") |
| 522 | (tramp-login-args (("-load" "%h") ("-t") | 522 | ;; ("%h") must be a single element, see |
| 523 | ;; `tramp-compute-multi-hops'. | ||
| 524 | (tramp-login-args (("-load") ("%h") ("-t") | ||
| 523 | (,(format | 525 | (,(format |
| 524 | "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=$ '" | 526 | "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=$ '" |
| 525 | tramp-terminal-type)) | 527 | tramp-terminal-type)) |
| @@ -914,7 +916,7 @@ directories for POSIX compatible commands." | |||
| 914 | (string :tag "Directory")))) | 916 | (string :tag "Directory")))) |
| 915 | 917 | ||
| 916 | (defcustom tramp-remote-process-environment | 918 | (defcustom tramp-remote-process-environment |
| 917 | `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_CTYPE=C" "LC_TIME=C" | 919 | `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_ALL=C" |
| 918 | ,(concat "TERM=" tramp-terminal-type) | 920 | ,(concat "TERM=" tramp-terminal-type) |
| 919 | "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" | 921 | "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" |
| 920 | "autocorrect=" "correct=") | 922 | "autocorrect=" "correct=") |
| @@ -1433,9 +1435,11 @@ means to use always cached values for the directory contents." | |||
| 1433 | ;;; Internal Variables: | 1435 | ;;; Internal Variables: |
| 1434 | 1436 | ||
| 1435 | (defvar tramp-end-of-output | 1437 | (defvar tramp-end-of-output |
| 1436 | (concat | 1438 | (format |
| 1437 | "///" (md5 (concat | 1439 | "%s///%s%s" |
| 1438 | (prin1-to-string process-environment) (current-time-string)))) | 1440 | tramp-rsh-end-of-line |
| 1441 | (md5 (concat (prin1-to-string process-environment) (current-time-string))) | ||
| 1442 | tramp-rsh-end-of-line) | ||
| 1439 | "String used to recognize end of output.") | 1443 | "String used to recognize end of output.") |
| 1440 | 1444 | ||
| 1441 | (defvar tramp-current-method nil | 1445 | (defvar tramp-current-method nil |
| @@ -3032,6 +3036,11 @@ and `rename'. FILENAME and NEWNAME must be absolute file names." | |||
| 3032 | ;; One of them must be a Tramp file. | 3036 | ;; One of them must be a Tramp file. |
| 3033 | (error "Tramp implementation says this cannot happen"))) | 3037 | (error "Tramp implementation says this cannot happen"))) |
| 3034 | 3038 | ||
| 3039 | ;; In case of `rename', we must flush the cache of the source file. | ||
| 3040 | (when (and t1 (eq op 'rename)) | ||
| 3041 | (with-parsed-tramp-file-name filename nil | ||
| 3042 | (tramp-flush-file-property v localname))) | ||
| 3043 | |||
| 3035 | ;; When newname did exist, we have wrong cached values. | 3044 | ;; When newname did exist, we have wrong cached values. |
| 3036 | (when t2 | 3045 | (when t2 |
| 3037 | (with-parsed-tramp-file-name newname nil | 3046 | (with-parsed-tramp-file-name newname nil |
| @@ -3774,13 +3783,15 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1." | |||
| 3774 | (command &optional output-buffer error-buffer) | 3783 | (command &optional output-buffer error-buffer) |
| 3775 | "Like `shell-command' for Tramp files." | 3784 | "Like `shell-command' for Tramp files." |
| 3776 | (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command)) | 3785 | (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command)) |
| 3777 | (args (split-string (substring command 0 asynchronous) " ")) | 3786 | ;; We cannot use `shell-file-name' and `shell-command-switch', |
| 3787 | ;; they are variables of the local host. | ||
| 3788 | (args (list "/bin/sh" "-c" (substring command 0 asynchronous))) | ||
| 3778 | (output-buffer | 3789 | (output-buffer |
| 3779 | (cond | 3790 | (cond |
| 3780 | ((bufferp output-buffer) output-buffer) | 3791 | ((bufferp output-buffer) output-buffer) |
| 3781 | ((stringp output-buffer) (get-buffer-create output-buffer)) | 3792 | ((stringp output-buffer) (get-buffer-create output-buffer)) |
| 3782 | (output-buffer (current-buffer)) | 3793 | (output-buffer (current-buffer)) |
| 3783 | (t (generate-new-buffer | 3794 | (t (get-buffer-create |
| 3784 | (if asynchronous | 3795 | (if asynchronous |
| 3785 | "*Async Shell Command*" | 3796 | "*Async Shell Command*" |
| 3786 | "*Shell Command Output*"))))) | 3797 | "*Shell Command Output*"))))) |
| @@ -3792,22 +3803,42 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1." | |||
| 3792 | (if (and (not asynchronous) error-buffer) | 3803 | (if (and (not asynchronous) error-buffer) |
| 3793 | (with-parsed-tramp-file-name default-directory nil | 3804 | (with-parsed-tramp-file-name default-directory nil |
| 3794 | (list output-buffer (tramp-make-tramp-temp-file v))) | 3805 | (list output-buffer (tramp-make-tramp-temp-file v))) |
| 3795 | output-buffer))) | 3806 | output-buffer)) |
| 3796 | 3807 | (proc (get-buffer-process output-buffer))) | |
| 3797 | (prog1 | 3808 | |
| 3798 | ;; Run the process. | 3809 | ;; Check whether there is another process running. Tramp does not |
| 3799 | (if (integerp asynchronous) | 3810 | ;; support 2 (asynchronous) processes in parallel. |
| 3811 | (when proc | ||
| 3812 | (if (yes-or-no-p "A command is running. Kill it? ") | ||
| 3813 | (ignore-errors (kill-process proc)) | ||
| 3814 | (error "Shell command in progress"))) | ||
| 3815 | |||
| 3816 | (with-current-buffer output-buffer | ||
| 3817 | (setq buffer-read-only nil | ||
| 3818 | buffer-undo-list t) | ||
| 3819 | (erase-buffer)) | ||
| 3820 | |||
| 3821 | (if (integerp asynchronous) | ||
| 3822 | (prog1 | ||
| 3823 | ;; Run the process. | ||
| 3800 | (apply 'start-file-process "*Async Shell*" buffer args) | 3824 | (apply 'start-file-process "*Async Shell*" buffer args) |
| 3801 | (apply 'process-file (car args) nil buffer nil (cdr args))) | 3825 | ;; Display output. |
| 3802 | ;; Insert error messages if they were separated. | 3826 | (pop-to-buffer output-buffer)) |
| 3803 | (when (listp buffer) | 3827 | |
| 3804 | (with-current-buffer error-buffer (insert-file-contents (cadr buffer))) | 3828 | (prog1 |
| 3805 | (delete-file (cadr buffer))) | 3829 | ;; Run the process. |
| 3806 | ;; There's some output, display it. | 3830 | (apply 'process-file (car args) nil buffer nil (cdr args)) |
| 3807 | (when (with-current-buffer output-buffer (> (point-max) (point-min))) | 3831 | ;; Insert error messages if they were separated. |
| 3808 | (if (functionp 'display-message-or-buffer) | 3832 | (when (listp buffer) |
| 3809 | (funcall (symbol-function 'display-message-or-buffer) output-buffer) | 3833 | (with-current-buffer error-buffer |
| 3810 | (pop-to-buffer output-buffer)))))) | 3834 | (insert-file-contents (cadr buffer))) |
| 3835 | (delete-file (cadr buffer))) | ||
| 3836 | ;; There's some output, display it. | ||
| 3837 | (when (with-current-buffer output-buffer (> (point-max) (point-min))) | ||
| 3838 | (if (functionp 'display-message-or-buffer) | ||
| 3839 | (funcall (symbol-function 'display-message-or-buffer) | ||
| 3840 | output-buffer) | ||
| 3841 | (pop-to-buffer output-buffer))))))) | ||
| 3811 | 3842 | ||
| 3812 | ;; File Editing. | 3843 | ;; File Editing. |
| 3813 | 3844 | ||
| @@ -5360,22 +5391,14 @@ file exists and nonzero exit status otherwise." | |||
| 5360 | vec | 5391 | vec |
| 5361 | (format "PROMPT_COMMAND='' PS1='$ ' PS2='' PS3='' exec %s" shell) | 5392 | (format "PROMPT_COMMAND='' PS1='$ ' PS2='' PS3='' exec %s" shell) |
| 5362 | t)) | 5393 | t)) |
| 5394 | ;; Setting prompts. | ||
| 5363 | (tramp-message vec 5 "Setting remote shell prompt...") | 5395 | (tramp-message vec 5 "Setting remote shell prompt...") |
| 5364 | ;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we | 5396 | (tramp-send-command vec (format "PS1='%s'" tramp-end-of-output) t) |
| 5365 | ;; must use "\n" here, not tramp-rsh-end-of-line. Kai left the | ||
| 5366 | ;; last tramp-rsh-end-of-line, Douglas wanted to replace that, | ||
| 5367 | ;; as well. | ||
| 5368 | (tramp-send-command | ||
| 5369 | vec | ||
| 5370 | (format "PS1='%s%s%s'" | ||
| 5371 | tramp-rsh-end-of-line | ||
| 5372 | tramp-end-of-output | ||
| 5373 | tramp-rsh-end-of-line) | ||
| 5374 | t) | ||
| 5375 | (tramp-send-command vec "PS2=''" t) | 5397 | (tramp-send-command vec "PS2=''" t) |
| 5376 | (tramp-send-command vec "PS3=''" t) | 5398 | (tramp-send-command vec "PS3=''" t) |
| 5377 | (tramp-send-command vec "PROMPT_COMMAND=''" t) | 5399 | (tramp-send-command vec "PROMPT_COMMAND=''" t) |
| 5378 | (tramp-message vec 5 "Setting remote shell prompt...done")) | 5400 | (tramp-message vec 5 "Setting remote shell prompt...done")) |
| 5401 | |||
| 5379 | (t (tramp-message | 5402 | (t (tramp-message |
| 5380 | vec 5 "Remote `%s' groks tilde expansion, good" | 5403 | vec 5 "Remote `%s' groks tilde expansion, good" |
| 5381 | (tramp-get-method-parameter | 5404 | (tramp-get-method-parameter |
| @@ -5668,13 +5691,7 @@ process to set up. VEC specifies the connection." | |||
| 5668 | ;; We can set $PS1 to `tramp-end-of-output' only when the echo has | 5691 | ;; We can set $PS1 to `tramp-end-of-output' only when the echo has |
| 5669 | ;; been disabled. Otherwise, the echo of the command would be | 5692 | ;; been disabled. Otherwise, the echo of the command would be |
| 5670 | ;; regarded as prompt already. | 5693 | ;; regarded as prompt already. |
| 5671 | (tramp-send-command | 5694 | (tramp-send-command vec (format "PS1='%s'" tramp-end-of-output) t) |
| 5672 | vec | ||
| 5673 | (format "PS1='%s%s%s'" | ||
| 5674 | tramp-rsh-end-of-line | ||
| 5675 | tramp-end-of-output | ||
| 5676 | tramp-rsh-end-of-line) | ||
| 5677 | t) | ||
| 5678 | (tramp-send-command vec "PS2=''" t) | 5695 | (tramp-send-command vec "PS2=''" t) |
| 5679 | (tramp-send-command vec "PS3=''" t) | 5696 | (tramp-send-command vec "PS3=''" t) |
| 5680 | (tramp-send-command vec "PROMPT_COMMAND=''" t) | 5697 | (tramp-send-command vec "PROMPT_COMMAND=''" t) |
| @@ -6059,6 +6076,29 @@ Gateway hops are already opened." | |||
| 6059 | "Method `%s' is not supported for multi-hops." | 6076 | "Method `%s' is not supported for multi-hops." |
| 6060 | (tramp-file-name-method item))))) | 6077 | (tramp-file-name-method item))))) |
| 6061 | 6078 | ||
| 6079 | ;; In case the host name is not used for the remote shell | ||
| 6080 | ;; command, the user could be misguided by applying a random | ||
| 6081 | ;; hostname. | ||
| 6082 | (let* ((v (car target-alist)) | ||
| 6083 | (method (tramp-file-name-method v)) | ||
| 6084 | (host (tramp-file-name-host v))) | ||
| 6085 | (unless | ||
| 6086 | (or | ||
| 6087 | ;; There are multi-hops. | ||
| 6088 | (cdr target-alist) | ||
| 6089 | ;; The host name is used for the remote shell command. | ||
| 6090 | (member | ||
| 6091 | '("%h") (tramp-get-method-parameter method 'tramp-login-args)) | ||
| 6092 | ;; The host is local. We cannot use `tramp-local-host-p' | ||
| 6093 | ;; here, because it opens a connection as well. | ||
| 6094 | (string-match | ||
| 6095 | (concat "^" (regexp-opt (list "localhost" (system-name)) t) "$") | ||
| 6096 | host)) | ||
| 6097 | (tramp-error | ||
| 6098 | v 'file-error | ||
| 6099 | "Host `%s' looks like a remote host, `%s' can only use the local host" | ||
| 6100 | host method))) | ||
| 6101 | |||
| 6062 | ;; Result. | 6102 | ;; Result. |
| 6063 | target-alist)) | 6103 | target-alist)) |
| 6064 | 6104 | ||
| @@ -6249,7 +6289,11 @@ function waits for output unless NOOUTPUT is set." | |||
| 6249 | (with-current-buffer (process-buffer proc) | 6289 | (with-current-buffer (process-buffer proc) |
| 6250 | ;; Initially, `tramp-end-of-output' is "$ ". There might be | 6290 | ;; Initially, `tramp-end-of-output' is "$ ". There might be |
| 6251 | ;; leading escape sequences, which must be ignored. | 6291 | ;; leading escape sequences, which must be ignored. |
| 6252 | (let* ((regexp (format "^[^$\n]*%s\r?$" (regexp-quote tramp-end-of-output))) | 6292 | (let* ((regexp |
| 6293 | (if (string-match (regexp-quote "\n") tramp-end-of-output) | ||
| 6294 | (mapconcat | ||
| 6295 | 'identity (split-string tramp-end-of-output "\n") "\r?\n") | ||
| 6296 | (format "^[^$\n]*%s\r?$" (regexp-quote tramp-end-of-output)))) | ||
| 6253 | (found (tramp-wait-for-regexp proc timeout regexp))) | 6297 | (found (tramp-wait-for-regexp proc timeout regexp))) |
| 6254 | (if found | 6298 | (if found |
| 6255 | (let (buffer-read-only) | 6299 | (let (buffer-read-only) |
| @@ -6666,6 +6710,10 @@ values." | |||
| 6666 | (user (match-string (nth 2 tramp-file-name-structure) name)) | 6710 | (user (match-string (nth 2 tramp-file-name-structure) name)) |
| 6667 | (host (match-string (nth 3 tramp-file-name-structure) name)) | 6711 | (host (match-string (nth 3 tramp-file-name-structure) name)) |
| 6668 | (localname (match-string (nth 4 tramp-file-name-structure) name))) | 6712 | (localname (match-string (nth 4 tramp-file-name-structure) name))) |
| 6713 | (when (member method '("multi" "multiu")) | ||
| 6714 | (error | ||
| 6715 | "`%s' method is no longer supported, see (info \"(tramp)Multi-hops\")" | ||
| 6716 | method)) | ||
| 6669 | (if nodefault | 6717 | (if nodefault |
| 6670 | (vector method user host localname) | 6718 | (vector method user host localname) |
| 6671 | (vector | 6719 | (vector |
| @@ -6731,11 +6779,20 @@ necessary only. This function will be used in file name completion." | |||
| 6731 | 6779 | ||
| 6732 | (defun tramp-local-host-p (vec) | 6780 | (defun tramp-local-host-p (vec) |
| 6733 | "Return t if this points to the local host, nil otherwise." | 6781 | "Return t if this points to the local host, nil otherwise." |
| 6734 | (let ((host (tramp-file-name-real-host vec))) | 6782 | ;; We cannot use `tramp-file-name-real-host'. A port is an |
| 6783 | ;; indication for an ssh tunnel or alike. | ||
| 6784 | (let ((host (tramp-file-name-host vec))) | ||
| 6735 | (and | 6785 | (and |
| 6736 | (stringp host) | 6786 | (stringp host) |
| 6737 | (string-match | 6787 | (string-match |
| 6738 | (concat "^" (regexp-opt (list "localhost" (system-name)) t) "$") host)))) | 6788 | (concat "^" (regexp-opt (list "localhost" (system-name)) t) "$") host) |
| 6789 | ;; The local temp directory must be writable for the other user. | ||
| 6790 | (file-writable-p | ||
| 6791 | (tramp-make-tramp-file-name | ||
| 6792 | (tramp-file-name-method vec) | ||
| 6793 | (tramp-file-name-user vec) | ||
| 6794 | host | ||
| 6795 | (tramp-compat-temporary-file-directory)))))) | ||
| 6739 | 6796 | ||
| 6740 | ;; Variables local to connection. | 6797 | ;; Variables local to connection. |
| 6741 | 6798 | ||
| @@ -6831,8 +6888,7 @@ necessary only. This function will be used in file name completion." | |||
| 6831 | vec (format "( %s / -nt / )" (tramp-get-test-command vec))) | 6888 | vec (format "( %s / -nt / )" (tramp-get-test-command vec))) |
| 6832 | (with-current-buffer (tramp-get-buffer vec) | 6889 | (with-current-buffer (tramp-get-buffer vec) |
| 6833 | (goto-char (point-min)) | 6890 | (goto-char (point-min)) |
| 6834 | (when (looking-at | 6891 | (when (looking-at (regexp-quote tramp-end-of-output)) |
| 6835 | (format "\n%s\r?\n" (regexp-quote tramp-end-of-output))) | ||
| 6836 | (format "%s %%s -nt %%s" (tramp-get-test-command vec))))) | 6892 | (format "%s %%s -nt %%s" (tramp-get-test-command vec))))) |
| 6837 | (progn | 6893 | (progn |
| 6838 | (tramp-send-command | 6894 | (tramp-send-command |
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 689987faff4..4a5525bd0fa 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el | |||
| @@ -2,7 +2,8 @@ | |||
| 2 | ;;; -*- mode: Emacs-Lisp; coding: utf-8; -*- | 2 | ;;; -*- mode: Emacs-Lisp; coding: utf-8; -*- |
| 3 | ;;; lisp/trampver.el. Generated from trampver.el.in by configure. | 3 | ;;; lisp/trampver.el. Generated from trampver.el.in by configure. |
| 4 | 4 | ||
| 5 | ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. | 5 | ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, |
| 6 | ;; 2008 Free Software Foundation, Inc. | ||
| 6 | 7 | ||
| 7 | ;; Author: Kai Großjohann <kai.grossjohann@gmx.net> | 8 | ;; Author: Kai Großjohann <kai.grossjohann@gmx.net> |
| 8 | ;; Keywords: comm, processes | 9 | ;; Keywords: comm, processes |
| @@ -30,14 +31,14 @@ | |||
| 30 | ;; "autoconf && ./configure" to change them. (X)Emacs version check is defined | 31 | ;; "autoconf && ./configure" to change them. (X)Emacs version check is defined |
| 31 | ;; in macro AC_EMACS_INFO of aclocal.m4; should be changed only there. | 32 | ;; in macro AC_EMACS_INFO of aclocal.m4; should be changed only there. |
| 32 | 33 | ||
| 33 | (defconst tramp-version "2.1.12" | 34 | (defconst tramp-version "2.1.13-pre" |
| 34 | "This version of Tramp.") | 35 | "This version of Tramp.") |
| 35 | 36 | ||
| 36 | (defconst tramp-bug-report-address "tramp-devel@gnu.org" | 37 | (defconst tramp-bug-report-address "tramp-devel@gnu.org" |
| 37 | "Email address to send bug reports to.") | 38 | "Email address to send bug reports to.") |
| 38 | 39 | ||
| 39 | ;; Check for (X)Emacs version. | 40 | ;; Check for (X)Emacs version. |
| 40 | (let ((x (if (or (< emacs-major-version 21) (and (featurep 'xemacs) (< emacs-minor-version 4))) (format "Tramp 2.1.12 is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version)))) "ok"))) | 41 | (let ((x (if (or (< emacs-major-version 21) (and (featurep 'xemacs) (< emacs-minor-version 4))) (format "Tramp 2.1.13-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version)))) "ok"))) |
| 41 | (unless (string-match "\\`ok\\'" x) (error "%s" x))) | 42 | (unless (string-match "\\`ok\\'" x) (error "%s" x))) |
| 42 | 43 | ||
| 43 | (provide 'trampver) | 44 | (provide 'trampver) |
diff --git a/lisp/nxml/nxml-enc.el b/lisp/nxml/nxml-enc.el index 115db17ad70..2210f76ccf5 100644 --- a/lisp/nxml/nxml-enc.el +++ b/lisp/nxml/nxml-enc.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; nxml-enc.el --- XML encoding auto-detection | 1 | ;;; nxml-enc.el --- XML encoding auto-detection |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML | 6 | ;; Keywords: XML |
diff --git a/lisp/nxml/nxml-glyph.el b/lisp/nxml/nxml-glyph.el index 47d7086f246..8e608a32fdc 100644 --- a/lisp/nxml/nxml-glyph.el +++ b/lisp/nxml/nxml-glyph.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; nxml-glyph.el --- glyph-handling for nxml-mode | 1 | ;;; nxml-glyph.el --- glyph-handling for nxml-mode |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML | 6 | ;; Keywords: XML |
diff --git a/lisp/nxml/nxml-maint.el b/lisp/nxml/nxml-maint.el index 7df2bc99f35..d9ba6fff90a 100644 --- a/lisp/nxml/nxml-maint.el +++ b/lisp/nxml/nxml-maint.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; nxml-maint.el --- commands for maintainers of nxml-*.el | 1 | ;;; nxml-maint.el --- commands for maintainers of nxml-*.el |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML | 6 | ;; Keywords: XML |
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index 973197242f3..11fadedd531 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; nxml-mode.el --- a new XML mode | 1 | ;;; nxml-mode.el --- a new XML mode |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2004, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2004, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML | 6 | ;; Keywords: XML |
| @@ -24,8 +24,6 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Commentary: | 25 | ;;; Commentary: |
| 26 | 26 | ||
| 27 | ;; To use this include rng-auto.el in your .emacs. | ||
| 28 | |||
| 29 | ;; See nxml-rap.el for description of parsing strategy. | 27 | ;; See nxml-rap.el for description of parsing strategy. |
| 30 | 28 | ||
| 31 | ;; The font locking here is independent of font-lock.el. We want to | 29 | ;; The font locking here is independent of font-lock.el. We want to |
| @@ -45,6 +43,9 @@ | |||
| 45 | (require 'nxml-rap) | 43 | (require 'nxml-rap) |
| 46 | (require 'nxml-outln) | 44 | (require 'nxml-outln) |
| 47 | 45 | ||
| 46 | (declare-function rng-nxml-mode-init "rng-nxml") | ||
| 47 | (declare-function nxml-enable-unicode-char-name-sets "nxml-uchnm") | ||
| 48 | |||
| 48 | ;;; Customization | 49 | ;;; Customization |
| 49 | 50 | ||
| 50 | (defgroup nxml nil | 51 | (defgroup nxml nil |
| @@ -479,9 +480,9 @@ instead of C-c. | |||
| 479 | Validation is provided by the related minor-mode `rng-validate-mode'. | 480 | Validation is provided by the related minor-mode `rng-validate-mode'. |
| 480 | This also makes completion schema- and context- sensitive. Element | 481 | This also makes completion schema- and context- sensitive. Element |
| 481 | names, attribute names, attribute values and namespace URIs can all be | 482 | names, attribute names, attribute values and namespace URIs can all be |
| 482 | completed. By default, `rng-validate-mode' is automatically enabled by | 483 | completed. By default, `rng-validate-mode' is automatically enabled. You |
| 483 | `rng-nxml-mode-init' which is normally added to `nxml-mode-hook'. You | 484 | can toggle it using \\[rng-validate-mode] or change the default by |
| 484 | can toggle it using \\[rng-validate-mode]. | 485 | customizing `rng-nxml-auto-validate-flag'. |
| 485 | 486 | ||
| 486 | \\[indent-for-tab-command] indents the current line appropriately. | 487 | \\[indent-for-tab-command] indents the current line appropriately. |
| 487 | This can be customized using the variable `nxml-child-indent' | 488 | This can be customized using the variable `nxml-child-indent' |
| @@ -509,6 +510,7 @@ Many aspects this mode can be customized using | |||
| 509 | (kill-all-local-variables) | 510 | (kill-all-local-variables) |
| 510 | (setq major-mode 'nxml-mode) | 511 | (setq major-mode 'nxml-mode) |
| 511 | (setq mode-name "nXML") | 512 | (setq mode-name "nXML") |
| 513 | (set (make-local-variable 'mode-line-process) '((nxml-degraded "/degraded"))) | ||
| 512 | ;; We'll determine the fill prefix ourselves | 514 | ;; We'll determine the fill prefix ourselves |
| 513 | (make-local-variable 'adaptive-fill-mode) | 515 | (make-local-variable 'adaptive-fill-mode) |
| 514 | (setq adaptive-fill-mode nil) | 516 | (setq adaptive-fill-mode nil) |
| @@ -555,6 +557,8 @@ Many aspects this mode can be customized using | |||
| 555 | (setq buffer-file-coding-system nxml-default-buffer-file-coding-system)) | 557 | (setq buffer-file-coding-system nxml-default-buffer-file-coding-system)) |
| 556 | (when nxml-auto-insert-xml-declaration-flag | 558 | (when nxml-auto-insert-xml-declaration-flag |
| 557 | (nxml-insert-xml-declaration))) | 559 | (nxml-insert-xml-declaration))) |
| 560 | (rng-nxml-mode-init) | ||
| 561 | (nxml-enable-unicode-char-name-sets) | ||
| 558 | (run-hooks 'nxml-mode-hook)) | 562 | (run-hooks 'nxml-mode-hook)) |
| 559 | 563 | ||
| 560 | (defun nxml-degrade (context err) | 564 | (defun nxml-degrade (context err) |
| @@ -570,8 +574,7 @@ Many aspects this mode can be customized using | |||
| 570 | (nxml-with-unmodifying-text-property-changes | 574 | (nxml-with-unmodifying-text-property-changes |
| 571 | (nxml-clear-face (point-min) (point-max)) | 575 | (nxml-clear-face (point-min) (point-max)) |
| 572 | (nxml-set-fontified (point-min) (point-max)) | 576 | (nxml-set-fontified (point-min) (point-max)) |
| 573 | (nxml-clear-inside (point-min) (point-max))) | 577 | (nxml-clear-inside (point-min) (point-max)))))) |
| 574 | (setq mode-name "nXML/degraded")))) | ||
| 575 | 578 | ||
| 576 | ;;; Change management | 579 | ;;; Change management |
| 577 | 580 | ||
| @@ -2433,7 +2436,7 @@ and attempts to find another possible way to do the markup." | |||
| 2433 | 2436 | ||
| 2434 | ;;; Character names | 2437 | ;;; Character names |
| 2435 | 2438 | ||
| 2436 | (defvar nxml-char-name-ignore-case nil) | 2439 | (defvar nxml-char-name-ignore-case t) |
| 2437 | 2440 | ||
| 2438 | (defvar nxml-char-name-alist nil | 2441 | (defvar nxml-char-name-alist nil |
| 2439 | "Alist of character names. | 2442 | "Alist of character names. |
diff --git a/lisp/nxml/nxml-ns.el b/lisp/nxml/nxml-ns.el index 0d1b1543b45..f9f5656211d 100644 --- a/lisp/nxml/nxml-ns.el +++ b/lisp/nxml/nxml-ns.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; nxml-ns.el --- XML namespace processing | 1 | ;;; nxml-ns.el --- XML namespace processing |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML | 6 | ;; Keywords: XML |
diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el index 96d8cebf5dc..3363daae15b 100644 --- a/lisp/nxml/nxml-outln.el +++ b/lisp/nxml/nxml-outln.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; nxml-outln.el --- outline support for nXML mode | 1 | ;;; nxml-outln.el --- outline support for nXML mode |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2004, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2004, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML | 6 | ;; Keywords: XML |
diff --git a/lisp/nxml/nxml-parse.el b/lisp/nxml/nxml-parse.el index 267c18cf887..bad7710a3d5 100644 --- a/lisp/nxml/nxml-parse.el +++ b/lisp/nxml/nxml-parse.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; nxml-parse.el --- XML parser, sharing infrastructure with nxml-mode | 1 | ;;; nxml-parse.el --- XML parser, sharing infrastructure with nxml-mode |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML | 6 | ;; Keywords: XML |
diff --git a/lisp/nxml/nxml-rap.el b/lisp/nxml/nxml-rap.el index 907812be4cb..095fe11ff44 100644 --- a/lisp/nxml/nxml-rap.el +++ b/lisp/nxml/nxml-rap.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; nxml-rap.el --- low-level support for random access parsing for nXML mode | 1 | ;;; nxml-rap.el --- low-level support for random access parsing for nXML mode |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2004, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2004, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML | 6 | ;; Keywords: XML |
diff --git a/lisp/nxml/nxml-uchnm.el b/lisp/nxml/nxml-uchnm.el index 9514a7de476..09ae310403d 100644 --- a/lisp/nxml/nxml-uchnm.el +++ b/lisp/nxml/nxml-uchnm.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; nxml-uchnm.el --- support for Unicode standard cha names in nxml-mode | 1 | ;;; nxml-uchnm.el --- support for Unicode standard cha names in nxml-mode |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML | 6 | ;; Keywords: XML |
| @@ -28,9 +28,6 @@ | |||
| 28 | ;; Standard. The use of the names can be controlled on a per-block | 28 | ;; Standard. The use of the names can be controlled on a per-block |
| 29 | ;; basis, so as both to reduce memory usage and loading time, | 29 | ;; basis, so as both to reduce memory usage and loading time, |
| 30 | ;; and to make completion work better. | 30 | ;; and to make completion work better. |
| 31 | ;; The main entry point is `nxml-enable-unicode-char-name-sets'. Typically, | ||
| 32 | ;; this is added to `nxml-mode-hook' (rng-auto.el does this already). | ||
| 33 | ;; To customize the blocks for which names are used | ||
| 34 | 31 | ||
| 35 | ;;; Code: | 32 | ;;; Code: |
| 36 | 33 | ||
| @@ -213,7 +210,9 @@ by a hyphen." | |||
| 213 | data-directory))) | 210 | data-directory))) |
| 214 | nxml-unicode-blocks) | 211 | nxml-unicode-blocks) |
| 215 | 212 | ||
| 216 | (defvar nxml-enable-unicode-char-name-sets-flag nil) | 213 | ;; Internal flag to control whether customize reloads the character tables. |
| 214 | ;; Should be set the first time the | ||
| 215 | (defvar nxml-internal-unicode-char-name-sets-enabled nil) | ||
| 217 | 216 | ||
| 218 | (defcustom nxml-enabled-unicode-blocks nxml-enabled-unicode-blocks-default | 217 | (defcustom nxml-enabled-unicode-blocks nxml-enabled-unicode-blocks-default |
| 219 | "List of Unicode blocks for which Unicode character names are enabled. | 218 | "List of Unicode blocks for which Unicode character names are enabled. |
| @@ -222,8 +221,8 @@ of the block by downcasing and replacing each space by a hyphen." | |||
| 222 | :group 'nxml | 221 | :group 'nxml |
| 223 | :set (lambda (sym value) | 222 | :set (lambda (sym value) |
| 224 | (set-default 'nxml-enabled-unicode-blocks value) | 223 | (set-default 'nxml-enabled-unicode-blocks value) |
| 225 | (when nxml-enable-unicode-char-name-sets-flag | 224 | (when nxml-internal-unicode-char-name-sets-enabled |
| 226 | (nxml-enable-unicode-char-name-sets-1))) | 225 | (nxml-enable-unicode-char-name-sets))) |
| 227 | :type (cons 'set | 226 | :type (cons 'set |
| 228 | (mapcar (lambda (block) | 227 | (mapcar (lambda (block) |
| 229 | `(const :tag ,(format "%s (%04X-%04X)" | 228 | `(const :tag ,(format "%s (%04X-%04X)" |
| @@ -240,11 +239,7 @@ of the block by downcasing and replacing each space by a hyphen." | |||
| 240 | The Unicode blocks for which names are enabled is controlled by | 239 | The Unicode blocks for which names are enabled is controlled by |
| 241 | the variable `nxml-enabled-unicode-blocks'." | 240 | the variable `nxml-enabled-unicode-blocks'." |
| 242 | (interactive) | 241 | (interactive) |
| 243 | (setq nxml-char-name-ignore-case t) | 242 | (setq nxml-internal-unicode-char-name-sets-enabled t) |
| 244 | (setq nxml-enable-unicode-char-name-sets-flag t) | ||
| 245 | (nxml-enable-unicode-char-name-sets-1)) | ||
| 246 | |||
| 247 | (defun nxml-enable-unicode-char-name-sets-1 () | ||
| 248 | (mapc (lambda (block) | 243 | (mapc (lambda (block) |
| 249 | (nxml-disable-char-name-set | 244 | (nxml-disable-char-name-set |
| 250 | (nxml-unicode-block-char-name-set (car block)))) | 245 | (nxml-unicode-block-char-name-set (car block)))) |
diff --git a/lisp/nxml/nxml-util.el b/lisp/nxml/nxml-util.el index 73b8354ddf6..7ea52f34fde 100644 --- a/lisp/nxml/nxml-util.el +++ b/lisp/nxml/nxml-util.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; nxml-util.el --- utility functions for nxml-*.el | 1 | ;;; nxml-util.el --- utility functions for nxml-*.el |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML | 6 | ;; Keywords: XML |
diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el index a83af6ad077..a1915b1d7fe 100644 --- a/lisp/nxml/rng-cmpct.el +++ b/lisp/nxml/rng-cmpct.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; rng-cmpct.el --- parsing of RELAX NG Compact Syntax schemas | 1 | ;;; rng-cmpct.el --- parsing of RELAX NG Compact Syntax schemas |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML, RelaxNG | 6 | ;; Keywords: XML, RelaxNG |
diff --git a/lisp/nxml/rng-dt.el b/lisp/nxml/rng-dt.el index 2ed8e19c7d9..700c53407d4 100644 --- a/lisp/nxml/rng-dt.el +++ b/lisp/nxml/rng-dt.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; rng-dt.el --- datatype library interface for RELAX NG | 1 | ;;; rng-dt.el --- datatype library interface for RELAX NG |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML, RelaxNG | 6 | ;; Keywords: XML, RelaxNG |
diff --git a/lisp/nxml/rng-loc.el b/lisp/nxml/rng-loc.el index 5646a262068..bae99ff8be6 100644 --- a/lisp/nxml/rng-loc.el +++ b/lisp/nxml/rng-loc.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; rng-loc.el --- locate the schema to use for validation | 1 | ;;; rng-loc.el --- locate the schema to use for validation |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML, RelaxNG | 6 | ;; Keywords: XML, RelaxNG |
diff --git a/lisp/nxml/rng-maint.el b/lisp/nxml/rng-maint.el index d535c45691a..e273a536156 100644 --- a/lisp/nxml/rng-maint.el +++ b/lisp/nxml/rng-maint.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; rng-maint.el --- commands for RELAX NG maintainers | 1 | ;;; rng-maint.el --- commands for RELAX NG maintainers |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML, RelaxNG | 6 | ;; Keywords: XML, RelaxNG |
diff --git a/lisp/nxml/rng-match.el b/lisp/nxml/rng-match.el index eb79d999634..1f7501d9f2a 100644 --- a/lisp/nxml/rng-match.el +++ b/lisp/nxml/rng-match.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; rng-match.el --- matching of RELAX NG patterns against XML events | 1 | ;;; rng-match.el --- matching of RELAX NG patterns against XML events |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML, RelaxNG | 6 | ;; Keywords: XML, RelaxNG |
diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el index 5b3f2a7baf8..083c637876b 100644 --- a/lisp/nxml/rng-nxml.el +++ b/lisp/nxml/rng-nxml.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; rng-nxml.el --- make nxml-mode take advantage of rng-validate-mode | 1 | ;;; rng-nxml.el --- make nxml-mode take advantage of rng-validate-mode |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML, RelaxNG | 6 | ;; Keywords: XML, RelaxNG |
| @@ -41,10 +41,12 @@ | |||
| 41 | :type 'boolean | 41 | :type 'boolean |
| 42 | :group 'relax-ng) | 42 | :group 'relax-ng) |
| 43 | 43 | ||
| 44 | (defvar rng-preferred-prefix-alist-default nil | 44 | (defcustom rng-preferred-prefix-alist |
| 45 | "Default value for variable `rng-preferred-prefix-alist'.") | 45 | '(("http://www.w3.org/1999/XSL/Transform" . "xsl") |
| 46 | 46 | ("http://www.w3.org/1999/02/22-rdf-syntax-ns#" . "rdf") | |
| 47 | (defcustom rng-preferred-prefix-alist rng-preferred-prefix-alist-default | 47 | ("http://www.w3.org/1999/xlink" . "xlink") |
| 48 | ("http://www.w3.org/2001/XmlSchema" . "xsd") | ||
| 49 | ("http://www.w3.org/2001/XMLSchema-instance" . "xsi")) | ||
| 48 | "*Alist of namespaces vs preferred prefixes." | 50 | "*Alist of namespaces vs preferred prefixes." |
| 49 | :type '(repeat (cons :tag "With" | 51 | :type '(repeat (cons :tag "With" |
| 50 | (string :tag "this namespace URI") | 52 | (string :tag "this namespace URI") |
| @@ -100,8 +102,9 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil." | |||
| 100 | (easy-menu-define rng-nxml-menu nxml-mode-map | 102 | (easy-menu-define rng-nxml-menu nxml-mode-map |
| 101 | "Menu for nxml-mode used with rng-validate-mode." | 103 | "Menu for nxml-mode used with rng-validate-mode." |
| 102 | rng-nxml-easy-menu) | 104 | rng-nxml-easy-menu) |
| 103 | (setq mode-line-process | 105 | (add-to-list 'mode-line-process |
| 104 | '(rng-validate-mode (:eval (rng-compute-mode-line-string)))) | 106 | '(rng-validate-mode (:eval (rng-compute-mode-line-string))) |
| 107 | 'append) | ||
| 105 | (cond (rng-nxml-auto-validate-flag | 108 | (cond (rng-nxml-auto-validate-flag |
| 106 | (rng-validate-mode 1) | 109 | (rng-validate-mode 1) |
| 107 | (add-hook 'nxml-completion-hook 'rng-complete nil t) | 110 | (add-hook 'nxml-completion-hook 'rng-complete nil t) |
diff --git a/lisp/nxml/rng-parse.el b/lisp/nxml/rng-parse.el index e9d10e03f21..bf8df6314db 100644 --- a/lisp/nxml/rng-parse.el +++ b/lisp/nxml/rng-parse.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; rng-parse.el --- parse an XML file and validate it against a schema | 1 | ;;; rng-parse.el --- parse an XML file and validate it against a schema |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML, RelaxNG | 6 | ;; Keywords: XML, RelaxNG |
diff --git a/lisp/nxml/rng-pttrn.el b/lisp/nxml/rng-pttrn.el index 2ed87943160..bbf28b2b516 100644 --- a/lisp/nxml/rng-pttrn.el +++ b/lisp/nxml/rng-pttrn.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; rng-pttrn.el --- RELAX NG patterns | 1 | ;;; rng-pttrn.el --- RELAX NG patterns |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML, RelaxNG | 6 | ;; Keywords: XML, RelaxNG |
diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el index f18012abcfe..8f454213c12 100644 --- a/lisp/nxml/rng-uri.el +++ b/lisp/nxml/rng-uri.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; rng-uri.el --- URI parsing and manipulation | 1 | ;;; rng-uri.el --- URI parsing and manipulation |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML | 6 | ;; Keywords: XML |
diff --git a/lisp/nxml/rng-util.el b/lisp/nxml/rng-util.el index 7ae75f8a607..545ad425fdf 100644 --- a/lisp/nxml/rng-util.el +++ b/lisp/nxml/rng-util.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; rng-util.el --- utility functions for RELAX NG library | 1 | ;;; rng-util.el --- utility functions for RELAX NG library |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML, RelaxNG | 6 | ;; Keywords: XML, RelaxNG |
diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el index 9b6500e002a..3df0e0e30d2 100644 --- a/lisp/nxml/rng-valid.el +++ b/lisp/nxml/rng-valid.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; rng-valid.el --- real-time validation of XML using RELAX NG | 1 | ;;; rng-valid.el --- real-time validation of XML using RELAX NG |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML, RelaxNG | 6 | ;; Keywords: XML, RelaxNG |
diff --git a/lisp/nxml/rng-xsd.el b/lisp/nxml/rng-xsd.el index 782627c4205..bc9e8a9538e 100644 --- a/lisp/nxml/rng-xsd.el +++ b/lisp/nxml/rng-xsd.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; rng-xsd.el --- W3C XML Schema datatypes library for RELAX NG | 1 | ;;; rng-xsd.el --- W3C XML Schema datatypes library for RELAX NG |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML, RelaxNG | 6 | ;; Keywords: XML, RelaxNG |
diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el index add55bf9840..2fa741c8832 100644 --- a/lisp/nxml/xmltok.el +++ b/lisp/nxml/xmltok.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; xmltok.el --- XML tokenization | 1 | ;;; xmltok.el --- XML tokenization |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML | 6 | ;; Keywords: XML |
diff --git a/lisp/nxml/xsd-regexp.el b/lisp/nxml/xsd-regexp.el index a698ce71e60..185be58388d 100644 --- a/lisp/nxml/xsd-regexp.el +++ b/lisp/nxml/xsd-regexp.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; xsd-regexp.el --- translate W3C XML Schema regexps to Emacs regexps | 1 | ;;; xsd-regexp.el --- translate W3C XML Schema regexps to Emacs regexps |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: James Clark | 5 | ;; Author: James Clark |
| 6 | ;; Keywords: XML, regexp | 6 | ;; Keywords: XML, regexp |
diff --git a/lisp/whitespace.el b/lisp/obsolete/whitespace.el index 3afa2246d45..b2ef06c9584 100644 --- a/lisp/whitespace.el +++ b/lisp/obsolete/whitespace.el | |||
| @@ -159,21 +159,21 @@ visited by the buffers.") | |||
| 159 | 159 | ||
| 160 | (defcustom whitespace-check-leading-whitespace t | 160 | (defcustom whitespace-check-leading-whitespace t |
| 161 | "Flag to check leading whitespace. This is the global for the system. | 161 | "Flag to check leading whitespace. This is the global for the system. |
| 162 | It can be overriden by setting a buffer local variable | 162 | It can be overridden by setting a buffer local variable |
| 163 | `whitespace-check-buffer-leading'." | 163 | `whitespace-check-buffer-leading'." |
| 164 | :type 'boolean | 164 | :type 'boolean |
| 165 | :group 'whitespace) | 165 | :group 'whitespace) |
| 166 | 166 | ||
| 167 | (defcustom whitespace-check-trailing-whitespace t | 167 | (defcustom whitespace-check-trailing-whitespace t |
| 168 | "Flag to check trailing whitespace. This is the global for the system. | 168 | "Flag to check trailing whitespace. This is the global for the system. |
| 169 | It can be overriden by setting a buffer local variable | 169 | It can be overridden by setting a buffer local variable |
| 170 | `whitespace-check-buffer-trailing'." | 170 | `whitespace-check-buffer-trailing'." |
| 171 | :type 'boolean | 171 | :type 'boolean |
| 172 | :group 'whitespace) | 172 | :group 'whitespace) |
| 173 | 173 | ||
| 174 | (defcustom whitespace-check-spacetab-whitespace t | 174 | (defcustom whitespace-check-spacetab-whitespace t |
| 175 | "Flag to check space followed by a TAB. This is the global for the system. | 175 | "Flag to check space followed by a TAB. This is the global for the system. |
| 176 | It can be overriden by setting a buffer local variable | 176 | It can be overridden by setting a buffer local variable |
| 177 | `whitespace-check-buffer-spacetab'." | 177 | `whitespace-check-buffer-spacetab'." |
| 178 | :type 'boolean | 178 | :type 'boolean |
| 179 | :group 'whitespace) | 179 | :group 'whitespace) |
| @@ -185,7 +185,7 @@ It can be overriden by setting a buffer local variable | |||
| 185 | 185 | ||
| 186 | (defcustom whitespace-check-indent-whitespace indent-tabs-mode | 186 | (defcustom whitespace-check-indent-whitespace indent-tabs-mode |
| 187 | "Flag to check indentation whitespace. This is the global for the system. | 187 | "Flag to check indentation whitespace. This is the global for the system. |
| 188 | It can be overriden by setting a buffer local variable | 188 | It can be overridden by setting a buffer local variable |
| 189 | `whitespace-check-buffer-indent'." | 189 | `whitespace-check-buffer-indent'." |
| 190 | :type 'boolean | 190 | :type 'boolean |
| 191 | :group 'whitespace) | 191 | :group 'whitespace) |
| @@ -198,7 +198,7 @@ The default value ignores leading TABs." | |||
| 198 | 198 | ||
| 199 | (defcustom whitespace-check-ateol-whitespace t | 199 | (defcustom whitespace-check-ateol-whitespace t |
| 200 | "Flag to check end-of-line whitespace. This is the global for the system. | 200 | "Flag to check end-of-line whitespace. This is the global for the system. |
| 201 | It can be overriden by setting a buffer local variable | 201 | It can be overridden by setting a buffer local variable |
| 202 | `whitespace-check-buffer-ateol'." | 202 | `whitespace-check-buffer-ateol'." |
| 203 | :type 'boolean | 203 | :type 'boolean |
| 204 | :group 'whitespace) | 204 | :group 'whitespace) |
diff --git a/lisp/outline.el b/lisp/outline.el index f075a474810..40340e10f42 100644 --- a/lisp/outline.el +++ b/lisp/outline.el | |||
| @@ -971,8 +971,8 @@ If INVISIBLE-OK is non-nil, also consider invisible lines." | |||
| 971 | (or (eq last-command 'outline-up-heading) (push-mark))) | 971 | (or (eq last-command 'outline-up-heading) (push-mark))) |
| 972 | (outline-back-to-heading invisible-ok) | 972 | (outline-back-to-heading invisible-ok) |
| 973 | (let ((start-level (funcall outline-level))) | 973 | (let ((start-level (funcall outline-level))) |
| 974 | (if (eq start-level 1) | 974 | (when (<= start-level 1) |
| 975 | (error "Already at top level of the outline")) | 975 | (error "Already at top level of the outline")) |
| 976 | (while (and (> start-level 1) (> arg 0) (not (bobp))) | 976 | (while (and (> start-level 1) (> arg 0) (not (bobp))) |
| 977 | (let ((level start-level)) | 977 | (let ((level start-level)) |
| 978 | (while (not (or (< level start-level) (bobp))) | 978 | (while (not (or (< level start-level) (bobp))) |
diff --git a/lisp/password-cache.el b/lisp/password-cache.el index eeaa31b9a31..e937c45a8b6 100644 --- a/lisp/password-cache.el +++ b/lisp/password-cache.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; password-cache.el --- Read passwords, possibly using a password cache. | 1 | ;;; password-cache.el --- Read passwords, possibly using a password cache. |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1999, 2000, 2003, 2004, 2005, 2006, 2007 | 3 | ;; Copyright (C) 1999, 2000, 2003, 2004, 2005, 2006, 2007, 2008 |
| 4 | ;; Free Software Foundation, Inc. | 4 | ;; Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: Simon Josefsson <simon@josefsson.org> | 6 | ;; Author: Simon Josefsson <simon@josefsson.org> |
diff --git a/lisp/pcvs-defs.el b/lisp/pcvs-defs.el index fa6f2b1c050..a4e7fde0f51 100644 --- a/lisp/pcvs-defs.el +++ b/lisp/pcvs-defs.el | |||
| @@ -404,8 +404,8 @@ This variable is buffer local and only used in the *cvs* buffer.") | |||
| 404 | 404 | ||
| 405 | (easy-menu-define cvs-menu cvs-mode-map "Menu used in `cvs-mode'." | 405 | (easy-menu-define cvs-menu cvs-mode-map "Menu used in `cvs-mode'." |
| 406 | '("CVS" | 406 | '("CVS" |
| 407 | ["Open file.." cvs-mode-find-file t] | 407 | ["Open file" cvs-mode-find-file t] |
| 408 | [" ..other window" cvs-mode-find-file-other-window t] | 408 | ["Open in other window" cvs-mode-find-file-other-window t] |
| 409 | ["Display in other window" cvs-mode-display-file t] | 409 | ["Display in other window" cvs-mode-display-file t] |
| 410 | ["Interactive merge" cvs-mode-imerge t] | 410 | ["Interactive merge" cvs-mode-imerge t] |
| 411 | ("View diff" | 411 | ("View diff" |
| @@ -413,6 +413,7 @@ This variable is buffer local and only used in the *cvs* buffer.") | |||
| 413 | ["Current diff" cvs-mode-diff t] | 413 | ["Current diff" cvs-mode-diff t] |
| 414 | ["Diff with head" cvs-mode-diff-head t] | 414 | ["Diff with head" cvs-mode-diff-head t] |
| 415 | ["Diff with vendor" cvs-mode-diff-vendor t] | 415 | ["Diff with vendor" cvs-mode-diff-vendor t] |
| 416 | ["Diff against yesterday" cvs-mode-diff-yesterday t] | ||
| 416 | ["Diff with backup" cvs-mode-diff-backup t]) | 417 | ["Diff with backup" cvs-mode-diff-backup t]) |
| 417 | ["View log" cvs-mode-log t] | 418 | ["View log" cvs-mode-log t] |
| 418 | ["View status" cvs-mode-status t] | 419 | ["View status" cvs-mode-status t] |
| @@ -437,6 +438,9 @@ This variable is buffer local and only used in the *cvs* buffer.") | |||
| 437 | ["Unmark all" cvs-mode-unmark-all-files t] | 438 | ["Unmark all" cvs-mode-unmark-all-files t] |
| 438 | ["Hide handled" cvs-mode-remove-handled t] | 439 | ["Hide handled" cvs-mode-remove-handled t] |
| 439 | "----" | 440 | "----" |
| 441 | ["PCL-CVS Manual" (lambda () (interactive) | ||
| 442 | (info "(pcl-cvs)Top")) t] | ||
| 443 | "----" | ||
| 440 | ["Quit" cvs-mode-quit t])) | 444 | ["Quit" cvs-mode-quit t])) |
| 441 | 445 | ||
| 442 | ;;;; | 446 | ;;;; |
diff --git a/lisp/pcvs.el b/lisp/pcvs.el index c4a7f67d930..462597a277b 100644 --- a/lisp/pcvs.el +++ b/lisp/pcvs.el | |||
| @@ -2311,7 +2311,7 @@ this file, or a list of arguments to send to the program." | |||
| 2311 | ;; do want to reset the mode for VC, so we do it explicitly. | 2311 | ;; do want to reset the mode for VC, so we do it explicitly. |
| 2312 | (vc-find-file-hook) | 2312 | (vc-find-file-hook) |
| 2313 | (when (eq (cvs-fileinfo->type fileinfo) 'CONFLICT) | 2313 | (when (eq (cvs-fileinfo->type fileinfo) 'CONFLICT) |
| 2314 | (smerge-mode 1)))))))) | 2314 | (smerge-start-session)))))))) |
| 2315 | 2315 | ||
| 2316 | 2316 | ||
| 2317 | (defun cvs-change-cvsroot (newroot) | 2317 | (defun cvs-change-cvsroot (newroot) |
diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el index e54dad675a8..f8ed471beb7 100644 --- a/lisp/play/blackbox.el +++ b/lisp/play/blackbox.el | |||
| @@ -106,7 +106,9 @@ | |||
| 106 | (blackbox-redefine-key map 'move-end-of-line 'bb-eol) | 106 | (blackbox-redefine-key map 'move-end-of-line 'bb-eol) |
| 107 | (blackbox-redefine-key map 'move-beginning-of-line 'bb-bol) | 107 | (blackbox-redefine-key map 'move-beginning-of-line 'bb-bol) |
| 108 | (define-key map " " 'bb-romp) | 108 | (define-key map " " 'bb-romp) |
| 109 | (define-key map "q" 'bury-buffer) | ||
| 109 | (define-key map [insert] 'bb-romp) | 110 | (define-key map [insert] 'bb-romp) |
| 111 | (define-key map [return] 'bb-done) | ||
| 110 | (blackbox-redefine-key map 'newline 'bb-done) | 112 | (blackbox-redefine-key map 'newline 'bb-done) |
| 111 | map)) | 113 | map)) |
| 112 | 114 | ||
diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index 5f8709d17b7..b4997ce4d57 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; bubbles.el --- Puzzle game for Emacs. | 1 | ;;; bubbles.el --- Puzzle game for Emacs. |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Ulf Jasper <ulf.jasper@web.de> | 5 | ;; Author: Ulf Jasper <ulf.jasper@web.de> |
| 6 | ;; URL: http://ulf.epplejasper.de/ | 6 | ;; URL: http://ulf.epplejasper.de/ |
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index 2c3acdda176..39e66b049c0 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el | |||
| @@ -930,7 +930,8 @@ are treated as numbers instead of gnatprep comments." | |||
| 930 | (buffer-undo-list t) | 930 | (buffer-undo-list t) |
| 931 | (inhibit-read-only t) | 931 | (inhibit-read-only t) |
| 932 | (inhibit-point-motion-hooks t) | 932 | (inhibit-point-motion-hooks t) |
| 933 | (inhibit-modification-hooks t)) | 933 | (inhibit-modification-hooks t) |
| 934 | buffer-file-name buffer-file-truename) | ||
| 934 | (remove-text-properties (point-min) (point-max) '(syntax-table nil)) | 935 | (remove-text-properties (point-min) (point-max) '(syntax-table nil)) |
| 935 | (goto-char (point-min)) | 936 | (goto-char (point-min)) |
| 936 | (while (re-search-forward | 937 | (while (re-search-forward |
| @@ -4954,11 +4955,11 @@ The paragraph is indented on the first line." | |||
| 4954 | ;; cursor at the correct position. | 4955 | ;; cursor at the correct position. |
| 4955 | ;; Standard Ada does not force any relation between unit names and file names, | 4956 | ;; Standard Ada does not force any relation between unit names and file names, |
| 4956 | ;; so some of these functions can only be a good approximation. However, they | 4957 | ;; so some of these functions can only be a good approximation. However, they |
| 4957 | ;; are also overriden in `ada-xref'.el when we know that the user is using | 4958 | ;; are also overridden in `ada-xref'.el when we know that the user is using |
| 4958 | ;; GNAT. | 4959 | ;; GNAT. |
| 4959 | ;; --------------------------------------------------- | 4960 | ;; --------------------------------------------------- |
| 4960 | 4961 | ||
| 4961 | ;; Overriden when we work with GNAT, to use gnatkrunch | 4962 | ;; Overridden when we work with GNAT, to use gnatkrunch |
| 4962 | (defun ada-make-filename-from-adaname (adaname) | 4963 | (defun ada-make-filename-from-adaname (adaname) |
| 4963 | "Determine the filename in which ADANAME is found. | 4964 | "Determine the filename in which ADANAME is found. |
| 4964 | This matches the GNAT default naming convention, except for | 4965 | This matches the GNAT default naming convention, except for |
diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index f9b5c026a4e..c63850ee5be 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el | |||
| @@ -617,7 +617,7 @@ If NO-USER-QUESTION, don't prompt user for file. Call | |||
| 617 | 617 | ||
| 618 | (defun ada-convert-file-name (name) | 618 | (defun ada-convert-file-name (name) |
| 619 | "Convert from NAME to a name that can be used by the compilation commands. | 619 | "Convert from NAME to a name that can be used by the compilation commands. |
| 620 | This is overriden on VMS to convert from VMS filenames to Unix filenames." | 620 | This is overridden on VMS to convert from VMS filenames to Unix filenames." |
| 621 | name) | 621 | name) |
| 622 | ;; FIXME: use convert-standard-filename instead | 622 | ;; FIXME: use convert-standard-filename instead |
| 623 | 623 | ||
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index d9a70558697..b361585422a 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el | |||
| @@ -478,7 +478,7 @@ | |||
| 478 | 478 | ||
| 479 | (defun c-awk-get-NL-prop-prev-line (&optional do-lim) | 479 | (defun c-awk-get-NL-prop-prev-line (&optional do-lim) |
| 480 | ;; Get the c-awk-NL-prop text-property from the previous line, calculating | 480 | ;; Get the c-awk-NL-prop text-property from the previous line, calculating |
| 481 | ;; it if necessary. Return nil if we're at BOB. | 481 | ;; it if necessary. Return nil if we're already at BOB. |
| 482 | ;; See c-awk-after-if-for-while-condition-p for a description of DO-LIM. | 482 | ;; See c-awk-after-if-for-while-condition-p for a description of DO-LIM. |
| 483 | ;; | 483 | ;; |
| 484 | ;; This function might do hidden buffer changes. | 484 | ;; This function might do hidden buffer changes. |
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 8d3facb08b6..1a2ee3f0ce5 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el | |||
| @@ -524,7 +524,11 @@ inside a literal or a macro, nothing special happens." | |||
| 524 | ;; This is the list of brace syntactic symbols that can hang. | 524 | ;; This is the list of brace syntactic symbols that can hang. |
| 525 | ;; If any new ones are added to c-offsets-alist, they should be | 525 | ;; If any new ones are added to c-offsets-alist, they should be |
| 526 | ;; added here as well. | 526 | ;; added here as well. |
| 527 | '(class-open class-close defun-open defun-close | 527 | ;; |
| 528 | ;; The order of this list is important; if SYNTAX has several | ||
| 529 | ;; elements, the element that "wins" is the earliest in SYMS. | ||
| 530 | '(arglist-cont-nonempty ; e.g. an array literal. | ||
| 531 | class-open class-close defun-open defun-close | ||
| 528 | inline-open inline-close | 532 | inline-open inline-close |
| 529 | brace-list-open brace-list-close | 533 | brace-list-open brace-list-close |
| 530 | brace-list-intro brace-entry-open | 534 | brace-list-intro brace-entry-open |
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 288aca687aa..2d4cc982714 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el | |||
| @@ -96,7 +96,7 @@ | |||
| 96 | 96 | ||
| 97 | ;;; Variables also used at compile time. | 97 | ;;; Variables also used at compile time. |
| 98 | 98 | ||
| 99 | (defconst c-version "5.31.4" | 99 | (defconst c-version "5.31.5" |
| 100 | "CC Mode version number.") | 100 | "CC Mode version number.") |
| 101 | 101 | ||
| 102 | (defconst c-version-sym (intern c-version)) | 102 | (defconst c-version-sym (intern c-version)) |
| @@ -425,6 +425,8 @@ The return value is the value of the last form in BODY." | |||
| 425 | (inhibit-read-only t) (inhibit-point-motion-hooks t) | 425 | (inhibit-read-only t) (inhibit-point-motion-hooks t) |
| 426 | before-change-functions after-change-functions | 426 | before-change-functions after-change-functions |
| 427 | deactivate-mark | 427 | deactivate-mark |
| 428 | buffer-file-name buffer-file-truename ; Prevent primitives checking | ||
| 429 | ; for file modification | ||
| 428 | ,@varlist) | 430 | ,@varlist) |
| 429 | (unwind-protect | 431 | (unwind-protect |
| 430 | (progn ,@body) | 432 | (progn ,@body) |
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 7cac158166e..48bbcaf18cf 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el | |||
| @@ -5094,7 +5094,8 @@ comment at the start of cc-engine.el for more info." | |||
| 5094 | ;; | 5094 | ;; |
| 5095 | ;; The point is left at the first token after the first complete | 5095 | ;; The point is left at the first token after the first complete |
| 5096 | ;; declarator, if there is one. The return value is a cons where | 5096 | ;; declarator, if there is one. The return value is a cons where |
| 5097 | ;; the car is the position of the first token in the declarator. | 5097 | ;; the car is the position of the first token in the declarator. (See |
| 5098 | ;; below for the cdr.) | ||
| 5098 | ;; Some examples: | 5099 | ;; Some examples: |
| 5099 | ;; | 5100 | ;; |
| 5100 | ;; void foo (int a, char *b) stuff ... | 5101 | ;; void foo (int a, char *b) stuff ... |
| @@ -5118,9 +5119,9 @@ comment at the start of cc-engine.el for more info." | |||
| 5118 | ;; Foo::Foo (int b) : Base (b) {} | 5119 | ;; Foo::Foo (int b) : Base (b) {} |
| 5119 | ;; car ^ ^ point | 5120 | ;; car ^ ^ point |
| 5120 | ;; | 5121 | ;; |
| 5121 | ;; The cdr of the return value is non-nil if a | 5122 | ;; The cdr of the return value is non-nil iff a `c-typedef-decl-kwds' |
| 5122 | ;; `c-typedef-decl-kwds' specifier is found in the declaration, | 5123 | ;; specifier (e.g. class, struct, enum, typedef) is found in the |
| 5123 | ;; i.e. the declared identifier(s) are types. | 5124 | ;; declaration, i.e. the declared identifier(s) are types. |
| 5124 | ;; | 5125 | ;; |
| 5125 | ;; If a cast is parsed: | 5126 | ;; If a cast is parsed: |
| 5126 | ;; | 5127 | ;; |
| @@ -5135,7 +5136,7 @@ comment at the start of cc-engine.el for more info." | |||
| 5135 | ;; the first token in (the visible part of) the buffer. | 5136 | ;; the first token in (the visible part of) the buffer. |
| 5136 | ;; | 5137 | ;; |
| 5137 | ;; CONTEXT is a symbol that describes the context at the point: | 5138 | ;; CONTEXT is a symbol that describes the context at the point: |
| 5138 | ;; 'decl In a comma-separatded declaration context (typically | 5139 | ;; 'decl In a comma-separated declaration context (typically |
| 5139 | ;; inside a function declaration arglist). | 5140 | ;; inside a function declaration arglist). |
| 5140 | ;; '<> In an angle bracket arglist. | 5141 | ;; '<> In an angle bracket arglist. |
| 5141 | ;; 'arglist Some other type of arglist. | 5142 | ;; 'arglist Some other type of arglist. |
| @@ -8032,12 +8033,15 @@ comment at the start of cc-engine.el for more info." | |||
| 8032 | 8033 | ||
| 8033 | ;; CASE 5A.5: ordinary defun open | 8034 | ;; CASE 5A.5: ordinary defun open |
| 8034 | (t | 8035 | (t |
| 8035 | (goto-char placeholder) | 8036 | (save-excursion |
| 8036 | (if (or containing-decl-open macro-start) | 8037 | (c-beginning-of-decl-1 lim) |
| 8037 | (c-add-syntax 'defun-open (c-point 'boi)) | 8038 | (while (looking-at c-specifier-key) |
| 8038 | ;; Bogus to use bol here, but it's the legacy. | 8039 | (goto-char (match-end 1)) |
| 8039 | (c-add-syntax 'defun-open (c-point 'bol))) | 8040 | (c-forward-syntactic-ws indent-point)) |
| 8040 | ))) | 8041 | (c-add-syntax 'defun-open (c-point 'boi)) |
| 8042 | ;; Bogus to use bol here, but it's the legacy. (Resolved, | ||
| 8043 | ;; 2007-11-09) | ||
| 8044 | )))) | ||
| 8041 | 8045 | ||
| 8042 | ;; CASE 5B: After a function header but before the body (or | 8046 | ;; CASE 5B: After a function header but before the body (or |
| 8043 | ;; the ending semicolon if there's no body). | 8047 | ;; the ending semicolon if there's no body). |
| @@ -8296,6 +8300,7 @@ comment at the start of cc-engine.el for more info." | |||
| 8296 | 8300 | ||
| 8297 | ;; CASE 5H: we could be looking at subsequent knr-argdecls | 8301 | ;; CASE 5H: we could be looking at subsequent knr-argdecls |
| 8298 | ((and c-recognize-knr-p | 8302 | ((and c-recognize-knr-p |
| 8303 | (not containing-sexp) ; can't be knr inside braces. | ||
| 8299 | (not (eq char-before-ip ?})) | 8304 | (not (eq char-before-ip ?})) |
| 8300 | (save-excursion | 8305 | (save-excursion |
| 8301 | (setq placeholder (cdr (c-beginning-of-decl-1 lim))) | 8306 | (setq placeholder (cdr (c-beginning-of-decl-1 lim))) |
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index ea527730620..54725c0fd88 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el | |||
| @@ -1771,11 +1771,13 @@ one of `c-type-list-kwds', `c-ref-list-kwds', | |||
| 1771 | (c-lang-defvar c-prefix-spec-kwds-re (c-lang-const c-prefix-spec-kwds-re)) | 1771 | (c-lang-defvar c-prefix-spec-kwds-re (c-lang-const c-prefix-spec-kwds-re)) |
| 1772 | 1772 | ||
| 1773 | (c-lang-defconst c-specifier-key | 1773 | (c-lang-defconst c-specifier-key |
| 1774 | ;; Adorned regexp of the keywords in `c-prefix-spec-kwds' that | 1774 | ;; Adorned regexp of the keywords in `c-prefix-spec-kwds' that aren't |
| 1775 | ;; aren't ambiguous with types or type prefixes. | 1775 | ;; ambiguous with types or type prefixes. These are the keywords (like |
| 1776 | ;; extern, namespace, but NOT template) that can modify a declaration. | ||
| 1776 | t (c-make-keywords-re t | 1777 | t (c-make-keywords-re t |
| 1777 | (set-difference (c-lang-const c-prefix-spec-kwds) | 1778 | (set-difference (c-lang-const c-prefix-spec-kwds) |
| 1778 | (c-lang-const c-type-start-kwds) | 1779 | (append (c-lang-const c-type-start-kwds) |
| 1780 | (c-lang-const c-<>-arglist-kwds)) | ||
| 1779 | :test 'string-equal))) | 1781 | :test 'string-equal))) |
| 1780 | (c-lang-defvar c-specifier-key (c-lang-const c-specifier-key)) | 1782 | (c-lang-defvar c-specifier-key (c-lang-const c-specifier-key)) |
| 1781 | 1783 | ||
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index 41f1836c0a4..26596e42ae8 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el | |||
| @@ -58,7 +58,8 @@ | |||
| 58 | '(("gnu" | 58 | '(("gnu" |
| 59 | (c-basic-offset . 2) | 59 | (c-basic-offset . 2) |
| 60 | (c-comment-only-line-offset . (0 . 0)) | 60 | (c-comment-only-line-offset . (0 . 0)) |
| 61 | (c-hanging-braces-alist . ((substatement-open before after))) | 61 | (c-hanging-braces-alist . ((substatement-open before after) |
| 62 | (arglist-cont-nonempty))) | ||
| 62 | (c-offsets-alist . ((statement-block-intro . +) | 63 | (c-offsets-alist . ((statement-block-intro . +) |
| 63 | (knr-argdecl-intro . 5) | 64 | (knr-argdecl-intro . 5) |
| 64 | (substatement-open . +) | 65 | (substatement-open . +) |
| @@ -170,7 +171,8 @@ | |||
| 170 | (case-label . +) | 171 | (case-label . +) |
| 171 | (access-label . -) | 172 | (access-label . -) |
| 172 | (inclass . ++) | 173 | (inclass . ++) |
| 173 | (inline-open . 0)))) | 174 | (inline-open . 0) |
| 175 | (arglist-cont-nonempty)))) | ||
| 174 | 176 | ||
| 175 | ("linux" | 177 | ("linux" |
| 176 | (c-basic-offset . 8) | 178 | (c-basic-offset . 8) |
| @@ -178,7 +180,8 @@ | |||
| 178 | (c-hanging-braces-alist . ((brace-list-open) | 180 | (c-hanging-braces-alist . ((brace-list-open) |
| 179 | (brace-entry-open) | 181 | (brace-entry-open) |
| 180 | (substatement-open after) | 182 | (substatement-open after) |
| 181 | (block-close . c-snug-do-while))) | 183 | (block-close . c-snug-do-while) |
| 184 | (arglist-cont-nonempty))) | ||
| 182 | (c-cleanup-list . (brace-else-brace)) | 185 | (c-cleanup-list . (brace-else-brace)) |
| 183 | (c-offsets-alist . ((statement-block-intro . +) | 186 | (c-offsets-alist . ((statement-block-intro . +) |
| 184 | (knr-argdecl-intro . 0) | 187 | (knr-argdecl-intro . 0) |
| @@ -200,7 +203,8 @@ | |||
| 200 | (brace-list-close) | 203 | (brace-list-close) |
| 201 | (brace-entry-open) | 204 | (brace-entry-open) |
| 202 | (substatement-open after) | 205 | (substatement-open after) |
| 203 | (block-close . c-snug-do-while))) | 206 | (block-close . c-snug-do-while) |
| 207 | (arglist-cont-nonempty))) | ||
| 204 | (c-block-comment-prefix . "")) | 208 | (c-block-comment-prefix . "")) |
| 205 | 209 | ||
| 206 | ("java" | 210 | ("java" |
| @@ -230,7 +234,8 @@ | |||
| 230 | (c-hanging-braces-alist . ((defun-open after) | 234 | (c-hanging-braces-alist . ((defun-open after) |
| 231 | (defun-close . c-snug-1line-defun-close) | 235 | (defun-close . c-snug-1line-defun-close) |
| 232 | (substatement-open after) | 236 | (substatement-open after) |
| 233 | (block-close . c-snug-do-while))) | 237 | (block-close . c-snug-do-while) |
| 238 | (arglist-cont-nonempty))) | ||
| 234 | (c-hanging-semi&comma-criteria . nil) | 239 | (c-hanging-semi&comma-criteria . nil) |
| 235 | (c-cleanup-list . nil) ; You might want one-liner-defun here. | 240 | (c-cleanup-list . nil) ; You might want one-liner-defun here. |
| 236 | (c-offsets-alist . ((statement-block-intro . +) | 241 | (c-offsets-alist . ((statement-block-intro . +) |
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 25adb2be01b..8b7b9cd24ee 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el | |||
| @@ -73,8 +73,28 @@ Useful as last item in a `choice' widget." | |||
| 73 | :format "%t%n" | 73 | :format "%t%n" |
| 74 | :value 'other)) | 74 | :value 'other)) |
| 75 | 75 | ||
| 76 | ;; The next defun will supersede c-const-symbol. | ||
| 77 | (eval-and-compile | ||
| 78 | (defun c-constant-symbol (sym len) | ||
| 79 | "Create an uneditable symbol for customization buffers. | ||
| 80 | SYM is the name of the symbol, LEN the length of the field (in | ||
| 81 | characters) the symbol will be displayed in. LEN must be big | ||
| 82 | enough. | ||
| 83 | |||
| 84 | This returns a (const ....) structure, suitable for embedding | ||
| 85 | within a customization type." | ||
| 86 | (or (symbolp sym) (error "c-constant-symbol: %s is not a symbol" sym)) | ||
| 87 | (let* ((name (symbol-name sym)) | ||
| 88 | (l (length name)) | ||
| 89 | (disp (concat name ":" (make-string (- len l 1) ?\ )))) | ||
| 90 | `(const | ||
| 91 | :size ,len | ||
| 92 | :format ,disp | ||
| 93 | :value ,sym)))) | ||
| 94 | |||
| 76 | (define-widget 'c-const-symbol 'item | 95 | (define-widget 'c-const-symbol 'item |
| 77 | "An uneditable lisp symbol." | 96 | "An uneditable lisp symbol. This is obsolete - |
| 97 | use c-constant-symbol instead." | ||
| 78 | :value nil | 98 | :value nil |
| 79 | :tag "Symbol" | 99 | :tag "Symbol" |
| 80 | :format "%t: %v\n%d" | 100 | :format "%t: %v\n%d" |
| @@ -305,6 +325,7 @@ e.g. `c-special-indent-hook'." | |||
| 305 | :type 'boolean | 325 | :type 'boolean |
| 306 | :group 'c) | 326 | :group 'c) |
| 307 | (make-variable-buffer-local 'c-syntactic-indentation) | 327 | (make-variable-buffer-local 'c-syntactic-indentation) |
| 328 | (put 'c-syntactic-indentation 'safe-local-variable 'booleanp) | ||
| 308 | 329 | ||
| 309 | (defcustom c-syntactic-indentation-in-macros t | 330 | (defcustom c-syntactic-indentation-in-macros t |
| 310 | "*Enable syntactic analysis inside macros. | 331 | "*Enable syntactic analysis inside macros. |
| @@ -323,6 +344,7 @@ countered easily by surrounding the statements by a block \(or even | |||
| 323 | better with the \"do { ... } while \(0)\" trick)." | 344 | better with the \"do { ... } while \(0)\" trick)." |
| 324 | :type 'boolean | 345 | :type 'boolean |
| 325 | :group 'c) | 346 | :group 'c) |
| 347 | (put 'c-syntactic-indentation-in-macros 'safe-local-variable 'booleanp) | ||
| 326 | 348 | ||
| 327 | (defcustom-c-stylevar c-comment-only-line-offset 0 | 349 | (defcustom-c-stylevar c-comment-only-line-offset 0 |
| 328 | "*Extra offset for line which contains only the start of a comment. | 350 | "*Extra offset for line which contains only the start of a comment. |
| @@ -405,9 +427,7 @@ in that case, i.e. as if \\[c-indent-command] was used instead." | |||
| 405 | `(set ,@(mapcar | 427 | `(set ,@(mapcar |
| 406 | (lambda (elt) | 428 | (lambda (elt) |
| 407 | `(cons :format "%v" | 429 | `(cons :format "%v" |
| 408 | (c-const-symbol :format "%v: " | 430 | ,(c-constant-symbol elt 20) |
| 409 | :size 20 | ||
| 410 | :value ,elt) | ||
| 411 | (choice | 431 | (choice |
| 412 | :format "%[Choice%] %v" | 432 | :format "%[Choice%] %v" |
| 413 | :value (column . nil) | 433 | :value (column . nil) |
| @@ -709,7 +729,8 @@ involve auto-newline inserted newlines: | |||
| 709 | (module-open after) | 729 | (module-open after) |
| 710 | (composition-open after) | 730 | (composition-open after) |
| 711 | (inexpr-class-open after) | 731 | (inexpr-class-open after) |
| 712 | (inexpr-class-close before)) | 732 | (inexpr-class-close before) |
| 733 | (arglist-cont-nonempty)) | ||
| 713 | "*Controls the insertion of newlines before and after braces | 734 | "*Controls the insertion of newlines before and after braces |
| 714 | when the auto-newline feature is active. This variable contains an | 735 | when the auto-newline feature is active. This variable contains an |
| 715 | association list with elements of the following form: | 736 | association list with elements of the following form: |
| @@ -743,18 +764,15 @@ syntactic context for the brace line." | |||
| 743 | `(set ,@(mapcar | 764 | `(set ,@(mapcar |
| 744 | (lambda (elt) | 765 | (lambda (elt) |
| 745 | `(cons :format "%v" | 766 | `(cons :format "%v" |
| 746 | (c-const-symbol :format "%v: " | 767 | ,(c-constant-symbol elt 24) |
| 747 | :size 20 | ||
| 748 | :value ,elt) | ||
| 749 | (choice :format "%[Choice%] %v" | 768 | (choice :format "%[Choice%] %v" |
| 750 | :value (before after) | 769 | :value (before after) |
| 751 | (set :menu-tag "Before/after" | 770 | (set :menu-tag "Before/after" |
| 752 | :format "Newline %v brace\n" | 771 | :format "Newline %v brace\n" |
| 753 | (const :format "%v, " before) | 772 | (const :format "%v, " before) |
| 754 | (const :format "%v" after)) | 773 | (const :format "%v " after)) |
| 755 | (function :menu-tag "Function" | 774 | (function :menu-tag "Function" |
| 756 | :format "Run function: %v" | 775 | :format "Run function: %v")))) |
| 757 | :value c-)))) | ||
| 758 | '(defun-open defun-close | 776 | '(defun-open defun-close |
| 759 | class-open class-close | 777 | class-open class-close |
| 760 | inline-open inline-close | 778 | inline-open inline-close |
| @@ -766,7 +784,8 @@ syntactic context for the brace line." | |||
| 766 | namespace-open namespace-close | 784 | namespace-open namespace-close |
| 767 | module-open module-close | 785 | module-open module-close |
| 768 | composition-open composition-close | 786 | composition-open composition-close |
| 769 | inexpr-class-open inexpr-class-close))) | 787 | inexpr-class-open inexpr-class-close |
| 788 | arglist-cont-nonempty))) | ||
| 770 | :group 'c) | 789 | :group 'c) |
| 771 | 790 | ||
| 772 | (defcustom c-max-one-liner-length 80 | 791 | (defcustom c-max-one-liner-length 80 |
| @@ -790,11 +809,9 @@ currently not supported for this variable." | |||
| 790 | `(set ,@(mapcar | 809 | `(set ,@(mapcar |
| 791 | (lambda (elt) | 810 | (lambda (elt) |
| 792 | `(cons :format "%v" | 811 | `(cons :format "%v" |
| 793 | (c-const-symbol :format "%v: " | 812 | ,(c-constant-symbol elt 20) |
| 794 | :size 20 | 813 | (set :format "Newline %v colon\n" |
| 795 | :value ,elt) | 814 | (const :format "%v, " before) |
| 796 | (set :format "Newline %v brace\n" | ||
| 797 | (const :format "%v, " before) | ||
| 798 | (const :format "%v" after)))) | 815 | (const :format "%v" after)))) |
| 799 | '(case-label label access-label member-init-intro inher-intro))) | 816 | '(case-label label access-label member-init-intro inher-intro))) |
| 800 | :group 'c) | 817 | :group 'c) |
| @@ -1307,8 +1324,7 @@ Here is the current list of valid syntactic element symbols: | |||
| 1307 | (lambda (elt) | 1324 | (lambda (elt) |
| 1308 | `(cons :format "%v" | 1325 | `(cons :format "%v" |
| 1309 | :value ,elt | 1326 | :value ,elt |
| 1310 | (c-const-symbol :format "%v: " | 1327 | ,(c-constant-symbol (car elt) 25) |
| 1311 | :size 25) | ||
| 1312 | (sexp :format "%v" | 1328 | (sexp :format "%v" |
| 1313 | :validate | 1329 | :validate |
| 1314 | (lambda (widget) | 1330 | (lambda (widget) |
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 772d35f94f0..f02a7756419 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el | |||
| @@ -272,8 +272,9 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) | |||
| 272 | " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2) | 272 | " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2) |
| 273 | 273 | ||
| 274 | (msft | 274 | (msft |
| 275 | ;; AFAWK, The message may be a "warning", "error", or "fatal error". | ||
| 275 | "^\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \ | 276 | "^\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \ |
| 276 | : \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 2 3 nil (4)) | 277 | : \\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:" 2 3 nil (4)) |
| 277 | 278 | ||
| 278 | (oracle | 279 | (oracle |
| 279 | "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\ | 280 | "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\ |
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 6bd7e8c780c..eaeabe58aae 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el | |||
| @@ -1614,21 +1614,6 @@ and (b) in the directories named in `ebrowse-search-path'." | |||
| 1614 | file-name)) | 1614 | file-name)) |
| 1615 | 1615 | ||
| 1616 | 1616 | ||
| 1617 | (defun ebrowse-view-file-other-window (file) | ||
| 1618 | "View a file FILE in another window. | ||
| 1619 | This is a replacement for `view-file-other-window' which does not | ||
| 1620 | seem to work. It should be removed when `view.el' is fixed." | ||
| 1621 | (interactive) | ||
| 1622 | (let ((old-arrangement (current-window-configuration)) | ||
| 1623 | (had-a-buf (get-file-buffer file)) | ||
| 1624 | (buf-to-view (find-file-noselect file))) | ||
| 1625 | (switch-to-buffer-other-window buf-to-view) | ||
| 1626 | (view-mode-enter old-arrangement | ||
| 1627 | (and (not had-a-buf) | ||
| 1628 | (not (buffer-modified-p buf-to-view)) | ||
| 1629 | 'kill-buffer)))) | ||
| 1630 | |||
| 1631 | |||
| 1632 | (defun ebrowse-view-exit-fn (buffer) | 1617 | (defun ebrowse-view-exit-fn (buffer) |
| 1633 | "Function called when exiting View mode in BUFFER. | 1618 | "Function called when exiting View mode in BUFFER. |
| 1634 | Restore frame configuration active before viewing the file, | 1619 | Restore frame configuration active before viewing the file, |
| @@ -1649,10 +1634,9 @@ and possibly kill the viewed buffer." | |||
| 1649 | 1634 | ||
| 1650 | (defun ebrowse-view-file-other-frame (file) | 1635 | (defun ebrowse-view-file-other-frame (file) |
| 1651 | "View a file FILE in another frame. | 1636 | "View a file FILE in another frame. |
| 1652 | The new frame is deleted when it is no longer used." | 1637 | The new frame is deleted when you quit viewing the file in that frame." |
| 1653 | (interactive) | 1638 | (interactive) |
| 1654 | (let ((old-frame-configuration (current-frame-configuration)) | 1639 | (let ((old-frame-configuration (current-frame-configuration)) |
| 1655 | (old-arrangement (current-window-configuration)) | ||
| 1656 | (had-a-buf (get-file-buffer file)) | 1640 | (had-a-buf (get-file-buffer file)) |
| 1657 | (buf-to-view (find-file-noselect file))) | 1641 | (buf-to-view (find-file-noselect file))) |
| 1658 | (switch-to-buffer-other-frame buf-to-view) | 1642 | (switch-to-buffer-other-frame buf-to-view) |
| @@ -1663,8 +1647,8 @@ The new frame is deleted when it is no longer used." | |||
| 1663 | (and (not had-a-buf) | 1647 | (and (not had-a-buf) |
| 1664 | (not (buffer-modified-p buf-to-view)) | 1648 | (not (buffer-modified-p buf-to-view)) |
| 1665 | 'kill-buffer)) | 1649 | 'kill-buffer)) |
| 1666 | (view-mode-enter old-arrangement 'ebrowse-view-exit-fn))) | 1650 | (view-mode-enter (cons (selected-window) (cons (selected-window) t)) |
| 1667 | 1651 | 'ebrowse-view-exit-fn))) | |
| 1668 | 1652 | ||
| 1669 | (defun ebrowse-view/find-file-and-search-pattern | 1653 | (defun ebrowse-view/find-file-and-search-pattern |
| 1670 | (struc info file tags-file-name &optional view where) | 1654 | (struc info file tags-file-name &optional view where) |
| @@ -1699,7 +1683,7 @@ specifies where to find/view the result." | |||
| 1699 | (setq view-mode-hook nil)) | 1683 | (setq view-mode-hook nil)) |
| 1700 | (push 'ebrowse-find-pattern view-mode-hook) | 1684 | (push 'ebrowse-find-pattern view-mode-hook) |
| 1701 | (case where | 1685 | (case where |
| 1702 | (other-window (ebrowse-view-file-other-window file)) | 1686 | (other-window (view-file-other-window file)) |
| 1703 | (other-frame (ebrowse-view-file-other-frame file)) | 1687 | (other-frame (ebrowse-view-file-other-frame file)) |
| 1704 | (t (view-file file)))) | 1688 | (t (view-file file)))) |
| 1705 | (t | 1689 | (t |
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 21a5593c659..32aecdd8295 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el | |||
| @@ -1815,13 +1815,19 @@ See documentation of variable `tags-file-name'." | |||
| 1815 | (tags-loop-continue (or file-list-form t)))) | 1815 | (tags-loop-continue (or file-list-form t)))) |
| 1816 | 1816 | ||
| 1817 | ;;;###autoload | 1817 | ;;;###autoload |
| 1818 | (defun tags-query-replace (from to &optional delimited file-list-form start end) | 1818 | (defun tags-query-replace (from to &optional delimited file-list-form) |
| 1819 | "Do `query-replace-regexp' of FROM with TO on all files listed in tags table. | 1819 | "Do `query-replace-regexp' of FROM with TO on all files listed in tags table. |
| 1820 | Third arg DELIMITED (prefix arg) means replace only word-delimited matches. | 1820 | Third arg DELIMITED (prefix arg) means replace only word-delimited matches. |
| 1821 | If you exit (\\[keyboard-quit], RET or q), you can resume the query replace | 1821 | If you exit (\\[keyboard-quit], RET or q), you can resume the query replace |
| 1822 | with the command \\[tags-loop-continue]. | 1822 | with the command \\[tags-loop-continue]. |
| 1823 | Fourth arg FILE-LIST-FORM non-nil means initialize the replacement loop. | ||
| 1824 | Fifth and sixth arguments START and END are accepted, for compatibility | ||
| 1825 | with `query-replace-regexp', and ignored. | ||
| 1823 | 1826 | ||
| 1824 | See documentation of variable `tags-file-name'." | 1827 | If FILE-LIST-FORM is non-nil, it is a form to evaluate to |
| 1828 | produce the list of files to search. | ||
| 1829 | |||
| 1830 | See also the documentation of the variable `tags-file-name'." | ||
| 1825 | (interactive (query-replace-read-args "Tags query replace (regexp)" t t)) | 1831 | (interactive (query-replace-read-args "Tags query replace (regexp)" t t)) |
| 1826 | (setq tags-loop-scan `(let ,(unless (equal from (downcase from)) | 1832 | (setq tags-loop-scan `(let ,(unless (equal from (downcase from)) |
| 1827 | '((case-fold-search nil))) | 1833 | '((case-fold-search nil))) |
diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index df10b5ecd30..2c152d91512 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el | |||
| @@ -1681,7 +1681,7 @@ A block is a subroutine, if-endif, etc." | |||
| 1681 | (push-mark) | 1681 | (push-mark) |
| 1682 | (goto-char pos) | 1682 | (goto-char pos) |
| 1683 | (setq program (f90-beginning-of-subprogram)) | 1683 | (setq program (f90-beginning-of-subprogram)) |
| 1684 | (if (fboundp 'zmacs-activate-region) | 1684 | (if (featurep 'xemacs) |
| 1685 | (zmacs-activate-region) | 1685 | (zmacs-activate-region) |
| 1686 | (setq mark-active t | 1686 | (setq mark-active t |
| 1687 | deactivate-mark nil)) | 1687 | deactivate-mark nil)) |
| @@ -1866,7 +1866,7 @@ If run in the middle of a line, the line is not broken." | |||
| 1866 | (goto-char save-point) | 1866 | (goto-char save-point) |
| 1867 | (set-marker end-region-mark nil) | 1867 | (set-marker end-region-mark nil) |
| 1868 | (set-marker save-point nil) | 1868 | (set-marker save-point nil) |
| 1869 | (if (fboundp 'zmacs-deactivate-region) | 1869 | (if (featurep 'xemacs) |
| 1870 | (zmacs-deactivate-region) | 1870 | (zmacs-deactivate-region) |
| 1871 | (deactivate-mark)))) | 1871 | (deactivate-mark)))) |
| 1872 | 1872 | ||
| @@ -1976,7 +1976,7 @@ Like `join-line', but handles F90 syntax." | |||
| 1976 | f90-cache-position (point))) | 1976 | f90-cache-position (point))) |
| 1977 | (setq f90-cache-position nil) | 1977 | (setq f90-cache-position nil) |
| 1978 | (set-marker end-region-mark nil) | 1978 | (set-marker end-region-mark nil) |
| 1979 | (if (fboundp 'zmacs-deactivate-region) | 1979 | (if (featurep 'xemacs) |
| 1980 | (zmacs-deactivate-region) | 1980 | (zmacs-deactivate-region) |
| 1981 | (deactivate-mark)))) | 1981 | (deactivate-mark)))) |
| 1982 | 1982 | ||
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index eee68fb2b6f..3e29f9732b2 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el | |||
| @@ -435,11 +435,11 @@ otherwise do not." | |||
| 435 | (output | 435 | (output |
| 436 | (with-output-to-string | 436 | (with-output-to-string |
| 437 | (with-current-buffer standard-output | 437 | (with-current-buffer standard-output |
| 438 | (call-process shell-file-name | 438 | (and file (file-exists-p file) |
| 439 | (if (file-exists-p file) file nil) | 439 | (call-process shell-file-name file |
| 440 | (list t nil) nil "-c" | 440 | (list t nil) nil "-c" |
| 441 | (concat gdb-cpp-define-alist-program " " | 441 | (concat gdb-cpp-define-alist-program " " |
| 442 | gdb-cpp-define-alist-flags))))) | 442 | gdb-cpp-define-alist-flags)))))) |
| 443 | (define-list (split-string output "\n" t)) (name)) | 443 | (define-list (split-string output "\n" t)) (name)) |
| 444 | (setq gdb-define-alist nil) | 444 | (setq gdb-define-alist nil) |
| 445 | (dolist (define define-list) | 445 | (dolist (define define-list) |
| @@ -1214,10 +1214,12 @@ This filter may simply queue input for a later time." | |||
| 1214 | 1214 | ||
| 1215 | (defun gdb-dequeue-input () | 1215 | (defun gdb-dequeue-input () |
| 1216 | (let ((queue gdb-input-queue)) | 1216 | (let ((queue gdb-input-queue)) |
| 1217 | (and queue | 1217 | (if queue |
| 1218 | (let ((last (car (last queue)))) | 1218 | (let ((last (car (last queue)))) |
| 1219 | (unless (nbutlast queue) (setq gdb-input-queue '())) | 1219 | (unless (nbutlast queue) (setq gdb-input-queue '())) |
| 1220 | last)))) | 1220 | last) |
| 1221 | ;; This should be nil here anyway but set it just to make sure. | ||
| 1222 | (setq gdb-pending-triggers nil)))) | ||
| 1221 | 1223 | ||
| 1222 | (defun gdb-send-item (item) | 1224 | (defun gdb-send-item (item) |
| 1223 | (setq gdb-flush-pending-output nil) | 1225 | (setq gdb-flush-pending-output nil) |
| @@ -3445,7 +3447,8 @@ BUFFER nil or omitted means use the current buffer." | |||
| 3445 | (let ((buffer (marker-buffer gud-overlay-arrow-position)) | 3447 | (let ((buffer (marker-buffer gud-overlay-arrow-position)) |
| 3446 | (position (marker-position gud-overlay-arrow-position))) | 3448 | (position (marker-position gud-overlay-arrow-position))) |
| 3447 | (when (and buffer | 3449 | (when (and buffer |
| 3448 | (string-equal (buffer-name buffer) | 3450 | (string-equal (file-name-nondirectory |
| 3451 | (buffer-file-name buffer)) | ||
| 3449 | (file-name-nondirectory (match-string 3)))) | 3452 | (file-name-nondirectory (match-string 3)))) |
| 3450 | (with-current-buffer buffer | 3453 | (with-current-buffer buffer |
| 3451 | (setq fringe-indicator-alist | 3454 | (setq fringe-indicator-alist |
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 126b5310ccc..83ffb5f7a0e 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | ;;; hideif.el --- hides selected code within ifdef | 1 | ;;; hideif.el --- hides selected code within ifdef |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1988, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 | 3 | ;; Copyright (C) 1988, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, |
| 4 | ;; Free Software Foundation, Inc. | 4 | ;; 2008 Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: Daniel LaLiberte <liberte@holonexus.org> | 6 | ;; Author: Daniel LaLiberte <liberte@holonexus.org> |
| 7 | ;; Maintainer: FSF | 7 | ;; Maintainer: FSF |
| @@ -99,12 +99,6 @@ | |||
| 99 | ;; | 99 | ;; |
| 100 | ;; Written by Brian Marick, at Gould, Computer Systems Division, Urbana IL. | 100 | ;; Written by Brian Marick, at Gould, Computer Systems Division, Urbana IL. |
| 101 | ;; Extensively modified by Daniel LaLiberte (while at Gould). | 101 | ;; Extensively modified by Daniel LaLiberte (while at Gould). |
| 102 | ;; | ||
| 103 | ;; You may freely modify and distribute this, but keep a record | ||
| 104 | ;; of modifications and send comments to: | ||
| 105 | ;; liberte@a.cs.uiuc.edu or ihnp4!uiucdcs!liberte | ||
| 106 | ;; I will continue to upgrade hide-ifdef-mode | ||
| 107 | ;; with your contributions. | ||
| 108 | 102 | ||
| 109 | ;;; Code: | 103 | ;;; Code: |
| 110 | 104 | ||
| @@ -114,6 +108,33 @@ | |||
| 114 | "Hide selected code within `ifdef'." | 108 | "Hide selected code within `ifdef'." |
| 115 | :group 'c) | 109 | :group 'c) |
| 116 | 110 | ||
| 111 | (defcustom hide-ifdef-initially nil | ||
| 112 | "Non-nil means call `hide-ifdefs' when Hide-Ifdef mode is first activated." | ||
| 113 | :type 'boolean | ||
| 114 | :group 'hide-ifdef) | ||
| 115 | |||
| 116 | (defcustom hide-ifdef-read-only nil | ||
| 117 | "Set to non-nil if you want buffer to be read-only while hiding text." | ||
| 118 | :type 'boolean | ||
| 119 | :group 'hide-ifdef) | ||
| 120 | |||
| 121 | (defcustom hide-ifdef-lines nil | ||
| 122 | "Non-nil means hide the #ifX, #else, and #endif lines." | ||
| 123 | :type 'boolean | ||
| 124 | :group 'hide-ifdef) | ||
| 125 | |||
| 126 | (defcustom hide-ifdef-shadow nil | ||
| 127 | "Non-nil means shadow text instead of hiding it." | ||
| 128 | :type 'boolean | ||
| 129 | :group 'hide-ifdef | ||
| 130 | :version "23.1") | ||
| 131 | |||
| 132 | (defface hide-ifdef-shadow '((t (:inherit shadow))) | ||
| 133 | "Face for shadowing ifdef blocks." | ||
| 134 | :group 'hide-ifdef | ||
| 135 | :version "23.1") | ||
| 136 | |||
| 137 | |||
| 117 | (defvar hide-ifdef-mode-submap | 138 | (defvar hide-ifdef-mode-submap |
| 118 | ;; Set up the submap that goes after the prefix key. | 139 | ;; Set up the submap that goes after the prefix key. |
| 119 | (let ((map (make-sparse-keymap))) | 140 | (let ((map (make-sparse-keymap))) |
| @@ -128,6 +149,7 @@ | |||
| 128 | (define-key map "\C-s" 'show-ifdef-block) | 149 | (define-key map "\C-s" 'show-ifdef-block) |
| 129 | 150 | ||
| 130 | (define-key map "\C-q" 'hide-ifdef-toggle-read-only) | 151 | (define-key map "\C-q" 'hide-ifdef-toggle-read-only) |
| 152 | (define-key map "\C-w" 'hide-ifdef-toggle-shadowing) | ||
| 131 | (substitute-key-definition | 153 | (substitute-key-definition |
| 132 | 'toggle-read-only 'hide-ifdef-toggle-outside-read-only map) | 154 | 'toggle-read-only 'hide-ifdef-toggle-outside-read-only map) |
| 133 | map) | 155 | map) |
| @@ -155,7 +177,9 @@ | |||
| 155 | ["Use an alist" hide-ifdef-use-define-alist t] | 177 | ["Use an alist" hide-ifdef-use-define-alist t] |
| 156 | ["Undefine a variable" hide-ifdef-undef t] | 178 | ["Undefine a variable" hide-ifdef-undef t] |
| 157 | ["Toggle read only" hide-ifdef-toggle-read-only | 179 | ["Toggle read only" hide-ifdef-toggle-read-only |
| 158 | :style toggle :selected hide-ifdef-read-only])) | 180 | :style toggle :selected hide-ifdef-read-only] |
| 181 | ["Toggle shadowing" hide-ifdef-toggle-shadowing | ||
| 182 | :style toggle :selected hide-ifdef-shadow])) | ||
| 159 | 183 | ||
| 160 | (defvar hide-ifdef-hiding nil | 184 | (defvar hide-ifdef-hiding nil |
| 161 | "Non-nil when text may be hidden.") | 185 | "Non-nil when text may be hidden.") |
| @@ -256,9 +280,12 @@ how the hiding is done: | |||
| 256 | (end-of-line 2))) | 280 | (end-of-line 2))) |
| 257 | 281 | ||
| 258 | (defun hide-ifdef-region-internal (start end) | 282 | (defun hide-ifdef-region-internal (start end) |
| 259 | (remove-overlays start end 'invisible 'hide-ifdef) | 283 | (remove-overlays start end 'hide-ifdef t) |
| 260 | (let ((o (make-overlay start end))) | 284 | (let ((o (make-overlay start end))) |
| 261 | (overlay-put o 'invisible 'hide-ifdef))) | 285 | (overlay-put o 'hide-ifdef t) |
| 286 | (if hide-ifdef-shadow | ||
| 287 | (overlay-put o 'face 'hide-ifdef-shadow) | ||
| 288 | (overlay-put o 'invisible 'hide-ifdef)))) | ||
| 262 | 289 | ||
| 263 | (defun hide-ifdef-region (start end) | 290 | (defun hide-ifdef-region (start end) |
| 264 | "START is the start of a #if or #else form. END is the ending part. | 291 | "START is the start of a #if or #else form. END is the ending part. |
| @@ -270,7 +297,7 @@ Everything including these lines is made invisible." | |||
| 270 | 297 | ||
| 271 | (defun hif-show-ifdef-region (start end) | 298 | (defun hif-show-ifdef-region (start end) |
| 272 | "Everything between START and END is made visible." | 299 | "Everything between START and END is made visible." |
| 273 | (remove-overlays start end 'invisible 'hide-ifdef)) | 300 | (remove-overlays start end 'hide-ifdef t)) |
| 274 | 301 | ||
| 275 | 302 | ||
| 276 | ;;===%%SF%% evaluation (Start) === | 303 | ;;===%%SF%% evaluation (Start) === |
| @@ -740,11 +767,11 @@ Point is left unchanged." | |||
| 740 | 767 | ||
| 741 | (defun hif-hide-line (point) | 768 | (defun hif-hide-line (point) |
| 742 | "Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil." | 769 | "Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil." |
| 743 | (if hide-ifdef-lines | 770 | (when hide-ifdef-lines |
| 744 | (save-excursion | 771 | (save-excursion |
| 745 | (goto-char point) | 772 | (goto-char point) |
| 746 | (hide-ifdef-region-internal (line-beginning-position) | 773 | (hide-ifdef-region-internal |
| 747 | (progn (hif-end-of-line) (point)))))) | 774 | (line-beginning-position) (progn (hif-end-of-line) (point)))))) |
| 748 | 775 | ||
| 749 | 776 | ||
| 750 | ;;; Hif-Possibly-Hide | 777 | ;;; Hif-Possibly-Hide |
| @@ -827,24 +854,6 @@ It does not do the work that's pointless to redo on a recursive entry." | |||
| 827 | 854 | ||
| 828 | ;;===%%SF%% exports (Start) === | 855 | ;;===%%SF%% exports (Start) === |
| 829 | 856 | ||
| 830 | ;;;###autoload | ||
| 831 | (defcustom hide-ifdef-initially nil | ||
| 832 | "*Non-nil means call `hide-ifdefs' when Hide-Ifdef mode is first activated." | ||
| 833 | :type 'boolean | ||
| 834 | :group 'hide-ifdef) | ||
| 835 | |||
| 836 | ;;;###autoload | ||
| 837 | (defcustom hide-ifdef-read-only nil | ||
| 838 | "*Set to non-nil if you want buffer to be read-only while hiding text." | ||
| 839 | :type 'boolean | ||
| 840 | :group 'hide-ifdef) | ||
| 841 | |||
| 842 | ;;;###autoload | ||
| 843 | (defcustom hide-ifdef-lines nil | ||
| 844 | "*Non-nil means hide the #ifX, #else, and #endif lines." | ||
| 845 | :type 'boolean | ||
| 846 | :group 'hide-ifdef) | ||
| 847 | |||
| 848 | (defun hide-ifdef-toggle-read-only () | 857 | (defun hide-ifdef-toggle-read-only () |
| 849 | "Toggle `hide-ifdef-read-only'." | 858 | "Toggle `hide-ifdef-read-only'." |
| 850 | (interactive) | 859 | (interactive) |
| @@ -866,6 +875,21 @@ It does not do the work that's pointless to redo on a recursive entry." | |||
| 866 | hif-outside-read-only)) | 875 | hif-outside-read-only)) |
| 867 | (force-mode-line-update)) | 876 | (force-mode-line-update)) |
| 868 | 877 | ||
| 878 | (defun hide-ifdef-toggle-shadowing () | ||
| 879 | "Toggle shadowing." | ||
| 880 | (interactive) | ||
| 881 | (set (make-local-variable 'hide-ifdef-shadow) (not hide-ifdef-shadow)) | ||
| 882 | (message "Shadowing %s" (if hide-ifdef-shadow "ON" "OFF")) | ||
| 883 | (save-restriction | ||
| 884 | (widen) | ||
| 885 | (dolist (overlay (overlays-in (point-min) (point-max))) | ||
| 886 | (when (overlay-get overlay 'hide-ifdef) | ||
| 887 | (if hide-ifdef-shadow | ||
| 888 | (progn | ||
| 889 | (overlay-put overlay 'invisible nil) | ||
| 890 | (overlay-put overlay 'face 'hide-ifdef-shadow)) | ||
| 891 | (overlay-put overlay 'face nil) | ||
| 892 | (overlay-put overlay 'invisible 'hide-ifdef)))))) | ||
| 869 | 893 | ||
| 870 | (defun hide-ifdef-define (var) | 894 | (defun hide-ifdef-define (var) |
| 871 | "Define a VAR so that #ifdef VAR would be included." | 895 | "Define a VAR so that #ifdef VAR would be included." |
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index 6dca919ba25..4c33b6b053c 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el | |||
| @@ -523,8 +523,8 @@ This puts the mark at the end, and point at the beginning." | |||
| 523 | (pascal-end-of-defun) | 523 | (pascal-end-of-defun) |
| 524 | (push-mark (point)) | 524 | (push-mark (point)) |
| 525 | (pascal-beg-of-defun) | 525 | (pascal-beg-of-defun) |
| 526 | (if (fboundp 'zmacs-activate-region) | 526 | (when (featurep 'xemacs) |
| 527 | (zmacs-activate-region))) | 527 | (zmacs-activate-region))) |
| 528 | 528 | ||
| 529 | (defun pascal-comment-area (start end) | 529 | (defun pascal-comment-area (start end) |
| 530 | "Put the region into a Pascal comment. | 530 | "Put the region into a Pascal comment. |
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index bef282f5e98..39fe096309d 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el | |||
| @@ -1889,7 +1889,8 @@ Uses `python-beginning-of-block', `python-end-of-block'." | |||
| 1889 | 1889 | ||
| 1890 | ;;;; Completion. | 1890 | ;;;; Completion. |
| 1891 | 1891 | ||
| 1892 | (defvar python-imports nil | 1892 | ;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2008-01/msg00076.html |
| 1893 | (defvar python-imports "None" | ||
| 1893 | "String of top-level import statements updated by `python-find-imports'.") | 1894 | "String of top-level import statements updated by `python-find-imports'.") |
| 1894 | (make-variable-buffer-local 'python-imports) | 1895 | (make-variable-buffer-local 'python-imports) |
| 1895 | 1896 | ||
| @@ -2076,7 +2077,7 @@ The default contents correspond to the elements of `python-skeletons'." | |||
| 2076 | < ; Avoid wrong indentation after block opening. | 2077 | < ; Avoid wrong indentation after block opening. |
| 2077 | "elif " str ":" \n | 2078 | "elif " str ":" \n |
| 2078 | > _ \n nil) | 2079 | > _ \n nil) |
| 2079 | (python-else) | ^) | 2080 | '(python-else) | ^) |
| 2080 | 2081 | ||
| 2081 | (define-skeleton python-else | 2082 | (define-skeleton python-else |
| 2082 | "Auxiliary skeleton." | 2083 | "Auxiliary skeleton." |
| @@ -2090,24 +2091,24 @@ The default contents correspond to the elements of `python-skeletons'." | |||
| 2090 | "Condition: " | 2091 | "Condition: " |
| 2091 | "while " str ":" \n | 2092 | "while " str ":" \n |
| 2092 | > _ \n | 2093 | > _ \n |
| 2093 | (python-else) | ^) | 2094 | '(python-else) | ^) |
| 2094 | 2095 | ||
| 2095 | (def-python-skeleton for | 2096 | (def-python-skeleton for |
| 2096 | "Target, %s: " | 2097 | "Target, %s: " |
| 2097 | "for " str " in " (skeleton-read "Expression, %s: ") ":" \n | 2098 | "for " str " in " (skeleton-read "Expression, %s: ") ":" \n |
| 2098 | > _ \n | 2099 | > _ \n |
| 2099 | (python-else) | ^) | 2100 | '(python-else) | ^) |
| 2100 | 2101 | ||
| 2101 | (def-python-skeleton try/except | 2102 | (def-python-skeleton try/except |
| 2102 | nil | 2103 | nil |
| 2103 | "try:" \n | 2104 | "try:" \n |
| 2104 | > _ \n | 2105 | > _ \n |
| 2105 | ("Exception, %s: " | 2106 | ("Exception, %s: " |
| 2106 | < "except " str (python-target) ":" \n | 2107 | < "except " str '(python-target) ":" \n |
| 2107 | > _ \n nil) | 2108 | > _ \n nil) |
| 2108 | < "except:" \n | 2109 | < "except:" \n |
| 2109 | > _ \n | 2110 | > _ \n |
| 2110 | (python-else) | ^) | 2111 | '(python-else) | ^) |
| 2111 | 2112 | ||
| 2112 | (define-skeleton python-target | 2113 | (define-skeleton python-target |
| 2113 | "Auxiliary skeleton." | 2114 | "Auxiliary skeleton." |
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 56b4b9b0f38..90b2fda36e2 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el | |||
| @@ -1186,6 +1186,7 @@ Can be set to a number, or to nil which means leave it as is." | |||
| 1186 | This value is used for the `+' and `-' symbols in an indentation variable." | 1186 | This value is used for the `+' and `-' symbols in an indentation variable." |
| 1187 | :type 'integer | 1187 | :type 'integer |
| 1188 | :group 'sh-indentation) | 1188 | :group 'sh-indentation) |
| 1189 | (put 'sh-basic-offset 'safe-local-variable 'integerp) | ||
| 1189 | 1190 | ||
| 1190 | (defcustom sh-indent-comment nil | 1191 | (defcustom sh-indent-comment nil |
| 1191 | "How a comment line is to be indented. | 1192 | "How a comment line is to be indented. |
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 54a3f0f6f80..c177ca1b184 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el | |||
| @@ -11,6 +11,12 @@ | |||
| 11 | ;; http://www.veripool.com | 11 | ;; http://www.veripool.com |
| 12 | ;; Keywords: languages | 12 | ;; Keywords: languages |
| 13 | 13 | ||
| 14 | ;; This code supports Emacs 21.1 and later | ||
| 15 | ;; And XEmacs 21.1 and later | ||
| 16 | ;; Please do not make changes that break Emacs 21. Thanks! | ||
| 17 | ;; | ||
| 18 | ;; | ||
| 19 | |||
| 14 | ;; This file is part of GNU Emacs. | 20 | ;; This file is part of GNU Emacs. |
| 15 | 21 | ||
| 16 | ;; GNU Emacs is free software; you can redistribute it and/or modify | 22 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| @@ -30,12 +36,12 @@ | |||
| 30 | 36 | ||
| 31 | ;;; Commentary: | 37 | ;;; Commentary: |
| 32 | 38 | ||
| 33 | ;; This mode borrows heavily from the Pascal-mode and the cc-mode of emacs | 39 | ;; This mode borrows heavily from the Pascal-mode and the cc-mode of Emacs |
| 34 | 40 | ||
| 35 | ;; USAGE | 41 | ;; USAGE |
| 36 | ;; ===== | 42 | ;; ===== |
| 37 | 43 | ||
| 38 | ;; A major mode for editing Verilog HDL source code. When you have | 44 | ;; A major mode for editing Verilog HDL source code. When you have |
| 39 | ;; entered Verilog mode, you may get more info by pressing C-h m. You | 45 | ;; entered Verilog mode, you may get more info by pressing C-h m. You |
| 40 | ;; may also get online help describing various functions by: C-h f | 46 | ;; may also get online help describing various functions by: C-h f |
| 41 | ;; <Name of function you want described> | 47 | ;; <Name of function you want described> |
| @@ -44,8 +50,8 @@ | |||
| 44 | ;; ======================= | 50 | ;; ======================= |
| 45 | 51 | ||
| 46 | ;; Verilog is a rapidly evolving language, and hence this mode is | 52 | ;; Verilog is a rapidly evolving language, and hence this mode is |
| 47 | ;; under continuous development. Hence this is beta code, and likely | 53 | ;; under continuous development. Hence this is beta code, and likely |
| 48 | ;; has bugs. Please report any and all bugs to me at mac@verilog.com. | 54 | ;; has bugs. Please report any and all bugs to me at mac@verilog.com. |
| 49 | ;; Please use verilog-submit-bug-report to submit a report; type C-c | 55 | ;; Please use verilog-submit-bug-report to submit a report; type C-c |
| 50 | ;; C-b to invoke this and as a result I will have a much easier time | 56 | ;; C-b to invoke this and as a result I will have a much easier time |
| 51 | ;; of reproducing the bug you find, and hence fixing it. | 57 | ;; of reproducing the bug you find, and hence fixing it. |
| @@ -55,7 +61,7 @@ | |||
| 55 | 61 | ||
| 56 | ;; An older version of this mode may be already installed as a part of | 62 | ;; An older version of this mode may be already installed as a part of |
| 57 | ;; your environment, and one method of updating would be to update | 63 | ;; your environment, and one method of updating would be to update |
| 58 | ;; your emacs environment. Sometimes this is difficult for local | 64 | ;; your Emacs environment. Sometimes this is difficult for local |
| 59 | ;; political/control reasons, and hence you can always install a | 65 | ;; political/control reasons, and hence you can always install a |
| 60 | ;; private copy (or even a shared copy) which overrides the system | 66 | ;; private copy (or even a shared copy) which overrides the system |
| 61 | ;; default. | 67 | ;; default. |
| @@ -74,7 +80,7 @@ | |||
| 74 | 80 | ||
| 75 | ;; If you want to customize Verilog mode to fit your needs better, | 81 | ;; If you want to customize Verilog mode to fit your needs better, |
| 76 | ;; you may add these lines (the values of the variables presented | 82 | ;; you may add these lines (the values of the variables presented |
| 77 | ;; here are the defaults). Note also that if you use an emacs that | 83 | ;; here are the defaults). Note also that if you use an Emacs that |
| 78 | ;; supports custom, it's probably better to use the custom menu to | 84 | ;; supports custom, it's probably better to use the custom menu to |
| 79 | ;; edit these. | 85 | ;; edit these. |
| 80 | ;; | 86 | ;; |
| @@ -102,15 +108,19 @@ | |||
| 102 | ;; | 108 | ;; |
| 103 | 109 | ||
| 104 | ;;; History: | 110 | ;;; History: |
| 105 | ;; | 111 | ;; |
| 106 | ;; | 112 | ;; See commit history at http://www.veripool.com/verilog-mode.html |
| 113 | ;; (This section is required to appease checkdoc.) | ||
| 114 | |||
| 107 | ;;; Code: | 115 | ;;; Code: |
| 108 | 116 | ||
| 109 | ;; This variable will always hold the version number of the mode | 117 | ;; This variable will always hold the version number of the mode |
| 110 | (defconst verilog-mode-version "377" | 118 | (defconst verilog-mode-version "383" |
| 111 | "Version of this verilog mode.") | ||
| 112 | (defconst verilog-mode-release-date "2007-12-07" | ||
| 113 | "Version of this verilog mode.") | 119 | "Version of this verilog mode.") |
| 120 | (defconst verilog-mode-release-date "2008-01-07-GNU" | ||
| 121 | "Release date of this verilog mode.") | ||
| 122 | (defconst verilog-mode-release-emacs t | ||
| 123 | "If non-nil, this version of verilog mode was released with Emacs itself.") | ||
| 114 | 124 | ||
| 115 | (defun verilog-version () | 125 | (defun verilog-version () |
| 116 | "Inform caller of the version of this file." | 126 | "Inform caller of the version of this file." |
| @@ -118,7 +128,10 @@ | |||
| 118 | (message "Using verilog-mode version %s" verilog-mode-version)) | 128 | (message "Using verilog-mode version %s" verilog-mode-version)) |
| 119 | 129 | ||
| 120 | ;; Insure we have certain packages, and deal with it if we don't | 130 | ;; Insure we have certain packages, and deal with it if we don't |
| 131 | ;; Be sure to note which Emacs flavor and version added each feature. | ||
| 121 | (eval-when-compile | 132 | (eval-when-compile |
| 133 | ;; The below were disabled when GNU Emacs 22 was released; | ||
| 134 | ;; perhaps some still need to be there to support Emacs 21. | ||
| 122 | (when (featurep 'xemacs) | 135 | (when (featurep 'xemacs) |
| 123 | (condition-case nil | 136 | (condition-case nil |
| 124 | (require 'easymenu) | 137 | (require 'easymenu) |
| @@ -181,8 +194,8 @@ STRING should be given if the last search was by `string-match' on STRING." | |||
| 181 | result) | 194 | result) |
| 182 | (buffer-substring-no-properties (match-beginning num) | 195 | (buffer-substring-no-properties (match-beginning num) |
| 183 | (match-end num) | 196 | (match-end num) |
| 184 | (current-buffer) | 197 | (current-buffer))))) |
| 185 | ))))) | 198 | ) |
| 186 | (error nil)) | 199 | (error nil)) |
| 187 | (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) | 200 | (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) |
| 188 | nil ;; We've got what we needed | 201 | nil ;; We've got what we needed |
| @@ -210,6 +223,8 @@ STRING should be given if the last search was by `string-match' on STRING." | |||
| 210 | ;; Provide a regular expression optimization routine, using regexp-opt | 223 | ;; Provide a regular expression optimization routine, using regexp-opt |
| 211 | ;; if provided by the user's elisp libraries | 224 | ;; if provided by the user's elisp libraries |
| 212 | (eval-and-compile | 225 | (eval-and-compile |
| 226 | ;; The below were disabled when GNU Emacs 22 was released; | ||
| 227 | ;; perhaps some still need to be there to support Emacs 21. | ||
| 213 | (if (featurep 'xemacs) | 228 | (if (featurep 'xemacs) |
| 214 | (if (fboundp 'regexp-opt) | 229 | (if (fboundp 'regexp-opt) |
| 215 | ;; regexp-opt is defined, does it take 3 or 2 arguments? | 230 | ;; regexp-opt is defined, does it take 3 or 2 arguments? |
| @@ -222,8 +237,7 @@ STRING should be given if the last search was by `string-match' on STRING." | |||
| 222 | (defun verilog-regexp-opt (a b) | 237 | (defun verilog-regexp-opt (a b) |
| 223 | "Deal with differing number of required arguments for `regexp-opt'. | 238 | "Deal with differing number of required arguments for `regexp-opt'. |
| 224 | Call 'regexp-opt' on A and B." | 239 | Call 'regexp-opt' on A and B." |
| 225 | (regexp-opt a b 't) | 240 | (regexp-opt a b 't)) |
| 226 | ) | ||
| 227 | (error nil)) | 241 | (error nil)) |
| 228 | ) | 242 | ) |
| 229 | ((eq args 2) ;; It takes 2 | 243 | ((eq args 2) ;; It takes 2 |
| @@ -261,6 +275,12 @@ STRING should be given if the last search was by `string-match' on STRING." | |||
| 261 | (if (fboundp 'customize-apropos) | 275 | (if (fboundp 'customize-apropos) |
| 262 | (customize-apropos "font-lock-*" 'faces))) | 276 | (customize-apropos "font-lock-*" 'faces))) |
| 263 | 277 | ||
| 278 | (defun verilog-booleanp (value) | ||
| 279 | "Return t if VALUE is boolean. | ||
| 280 | This implements GNU Emacs 22.1's `booleanp' function in earlier Emacs. | ||
| 281 | This function may be removed when Emacs 21 is no longer supported." | ||
| 282 | (or (equal value t) (equal value nil))) | ||
| 283 | |||
| 264 | (defgroup verilog-mode nil | 284 | (defgroup verilog-mode nil |
| 265 | "Facilitates easy editing of Verilog source text" | 285 | "Facilitates easy editing of Verilog source text" |
| 266 | :group 'languages) | 286 | :group 'languages) |
| @@ -290,6 +310,7 @@ you type \\[compile]. When the compile completes, \\[next-error] will take | |||
| 290 | you to the next lint error." | 310 | you to the next lint error." |
| 291 | :type 'string | 311 | :type 'string |
| 292 | :group 'verilog-mode-actions) | 312 | :group 'verilog-mode-actions) |
| 313 | ;; We don't mark it safe, as it's used as a shell command | ||
| 293 | 314 | ||
| 294 | (defcustom verilog-coverage | 315 | (defcustom verilog-coverage |
| 295 | "echo 'No verilog-coverage set, see \"M-x describe-variable verilog-coverage\"'" | 316 | "echo 'No verilog-coverage set, see \"M-x describe-variable verilog-coverage\"'" |
| @@ -299,6 +320,7 @@ you type \\[compile]. When the compile completes, \\[next-error] will take | |||
| 299 | you to the next lint error." | 320 | you to the next lint error." |
| 300 | :type 'string | 321 | :type 'string |
| 301 | :group 'verilog-mode-actions) | 322 | :group 'verilog-mode-actions) |
| 323 | ;; We don't mark it safe, as it's used as a shell command | ||
| 302 | 324 | ||
| 303 | (defcustom verilog-simulator | 325 | (defcustom verilog-simulator |
| 304 | "echo 'No verilog-simulator set, see \"M-x describe-variable verilog-simulator\"'" | 326 | "echo 'No verilog-simulator set, see \"M-x describe-variable verilog-simulator\"'" |
| @@ -308,6 +330,7 @@ you type \\[compile]. When the compile completes, \\[next-error] will take | |||
| 308 | you to the next lint error." | 330 | you to the next lint error." |
| 309 | :type 'string | 331 | :type 'string |
| 310 | :group 'verilog-mode-actions) | 332 | :group 'verilog-mode-actions) |
| 333 | ;; We don't mark it safe, as it's used as a shell command | ||
| 311 | 334 | ||
| 312 | (defcustom verilog-compiler | 335 | (defcustom verilog-compiler |
| 313 | "echo 'No verilog-compiler set, see \"M-x describe-variable verilog-compiler\"'" | 336 | "echo 'No verilog-compiler set, see \"M-x describe-variable verilog-compiler\"'" |
| @@ -317,6 +340,7 @@ you type \\[compile]. When the compile completes, \\[next-error] will take | |||
| 317 | you to the next lint error." | 340 | you to the next lint error." |
| 318 | :type 'string | 341 | :type 'string |
| 319 | :group 'verilog-mode-actions) | 342 | :group 'verilog-mode-actions) |
| 343 | ;; We don't mark it safe, as it's used as a shell command | ||
| 320 | 344 | ||
| 321 | (defvar verilog-tool 'verilog-linter | 345 | (defvar verilog-tool 'verilog-linter |
| 322 | "Which tool to use for building compiler-command. | 346 | "Which tool to use for building compiler-command. |
| @@ -336,11 +360,14 @@ Note: Activate the new setting in a Verilog buffer by re-fontifying it (menu | |||
| 336 | entry \"Fontify Buffer\"). XEmacs: turn off and on font locking." | 360 | entry \"Fontify Buffer\"). XEmacs: turn off and on font locking." |
| 337 | :type 'boolean | 361 | :type 'boolean |
| 338 | :group 'verilog-mode-indent) | 362 | :group 'verilog-mode-indent) |
| 363 | ;; Note we don't use :safe, as that would break on Emacsen before 22.0. | ||
| 364 | (put 'verilog-highlight-translate-off 'safe-local-variable 'verilog-booleanp) | ||
| 339 | 365 | ||
| 340 | (defcustom verilog-indent-level 3 | 366 | (defcustom verilog-indent-level 3 |
| 341 | "*Indentation of Verilog statements with respect to containing block." | 367 | "*Indentation of Verilog statements with respect to containing block." |
| 342 | :group 'verilog-mode-indent | 368 | :group 'verilog-mode-indent |
| 343 | :type 'integer) | 369 | :type 'integer) |
| 370 | (put 'verilog-indent-level 'safe-local-variable 'integerp) | ||
| 344 | 371 | ||
| 345 | (defcustom verilog-indent-level-module 3 | 372 | (defcustom verilog-indent-level-module 3 |
| 346 | "*Indentation of Module level Verilog statements. (eg always, initial) | 373 | "*Indentation of Module level Verilog statements. (eg always, initial) |
| @@ -348,12 +375,14 @@ Set to 0 to get initial and always statements lined up on the left side of | |||
| 348 | your screen." | 375 | your screen." |
| 349 | :group 'verilog-mode-indent | 376 | :group 'verilog-mode-indent |
| 350 | :type 'integer) | 377 | :type 'integer) |
| 378 | (put 'verilog-indent-level-module 'safe-local-variable 'integerp) | ||
| 351 | 379 | ||
| 352 | (defcustom verilog-indent-level-declaration 3 | 380 | (defcustom verilog-indent-level-declaration 3 |
| 353 | "*Indentation of declarations with respect to containing block. | 381 | "*Indentation of declarations with respect to containing block. |
| 354 | Set to 0 to get them list right under containing block." | 382 | Set to 0 to get them list right under containing block." |
| 355 | :group 'verilog-mode-indent | 383 | :group 'verilog-mode-indent |
| 356 | :type 'integer) | 384 | :type 'integer) |
| 385 | (put 'verilog-indent-level-declaration 'safe-local-variable 'integerp) | ||
| 357 | 386 | ||
| 358 | (defcustom verilog-indent-declaration-macros nil | 387 | (defcustom verilog-indent-declaration-macros nil |
| 359 | "*How to treat macro expansions in a declaration. | 388 | "*How to treat macro expansions in a declaration. |
| @@ -367,6 +396,7 @@ If non nil, treat as: | |||
| 367 | output c;" | 396 | output c;" |
| 368 | :group 'verilog-mode-indent | 397 | :group 'verilog-mode-indent |
| 369 | :type 'boolean) | 398 | :type 'boolean) |
| 399 | (put 'verilog-indent-declaration-macros 'safe-local-variable 'verilog-booleanp) | ||
| 370 | 400 | ||
| 371 | (defcustom verilog-indent-lists t | 401 | (defcustom verilog-indent-lists t |
| 372 | "*How to treat indenting items in a list. | 402 | "*How to treat indenting items in a list. |
| @@ -379,62 +409,73 @@ If nil, treat as: | |||
| 379 | reset ) begin" | 409 | reset ) begin" |
| 380 | :group 'verilog-mode-indent | 410 | :group 'verilog-mode-indent |
| 381 | :type 'boolean) | 411 | :type 'boolean) |
| 412 | (put 'verilog-indent-lists 'safe-local-variable 'verilog-booleanp) | ||
| 382 | 413 | ||
| 383 | (defcustom verilog-indent-level-behavioral 3 | 414 | (defcustom verilog-indent-level-behavioral 3 |
| 384 | "*Absolute indentation of first begin in a task or function block. | 415 | "*Absolute indentation of first begin in a task or function block. |
| 385 | Set to 0 to get such code to start at the left side of the screen." | 416 | Set to 0 to get such code to start at the left side of the screen." |
| 386 | :group 'verilog-mode-indent | 417 | :group 'verilog-mode-indent |
| 387 | :type 'integer) | 418 | :type 'integer) |
| 419 | (put 'verilog-indent-level-behavioral 'safe-local-variable 'integerp) | ||
| 388 | 420 | ||
| 389 | (defcustom verilog-indent-level-directive 1 | 421 | (defcustom verilog-indent-level-directive 1 |
| 390 | "*Indentation to add to each level of `ifdef declarations. | 422 | "*Indentation to add to each level of `ifdef declarations. |
| 391 | Set to 0 to have all directives start at the left side of the screen." | 423 | Set to 0 to have all directives start at the left side of the screen." |
| 392 | :group 'verilog-mode-indent | 424 | :group 'verilog-mode-indent |
| 393 | :type 'integer) | 425 | :type 'integer) |
| 426 | (put 'verilog-indent-level-directive 'safe-local-variable 'integerp) | ||
| 394 | 427 | ||
| 395 | (defcustom verilog-cexp-indent 2 | 428 | (defcustom verilog-cexp-indent 2 |
| 396 | "*Indentation of Verilog statements split across lines." | 429 | "*Indentation of Verilog statements split across lines." |
| 397 | :group 'verilog-mode-indent | 430 | :group 'verilog-mode-indent |
| 398 | :type 'integer) | 431 | :type 'integer) |
| 432 | (put 'verilog-cexp-indent 'safe-local-variable 'integerp) | ||
| 399 | 433 | ||
| 400 | (defcustom verilog-case-indent 2 | 434 | (defcustom verilog-case-indent 2 |
| 401 | "*Indentation for case statements." | 435 | "*Indentation for case statements." |
| 402 | :group 'verilog-mode-indent | 436 | :group 'verilog-mode-indent |
| 403 | :type 'integer) | 437 | :type 'integer) |
| 438 | (put 'verilog-case-indent 'safe-local-variable 'integerp) | ||
| 404 | 439 | ||
| 405 | (defcustom verilog-auto-newline t | 440 | (defcustom verilog-auto-newline t |
| 406 | "*True means automatically newline after semicolons." | 441 | "*True means automatically newline after semicolons." |
| 407 | :group 'verilog-mode-indent | 442 | :group 'verilog-mode-indent |
| 408 | :type 'boolean) | 443 | :type 'boolean) |
| 444 | (put 'verilog-auto-newline 'safe-local-variable 'verilog-booleanp) | ||
| 409 | 445 | ||
| 410 | (defcustom verilog-auto-indent-on-newline t | 446 | (defcustom verilog-auto-indent-on-newline t |
| 411 | "*True means automatically indent line after newline." | 447 | "*True means automatically indent line after newline." |
| 412 | :group 'verilog-mode-indent | 448 | :group 'verilog-mode-indent |
| 413 | :type 'boolean) | 449 | :type 'boolean) |
| 450 | (put 'verilog-auto-indent-on-newline 'safe-local-variable 'verilog-booleanp) | ||
| 414 | 451 | ||
| 415 | (defcustom verilog-tab-always-indent t | 452 | (defcustom verilog-tab-always-indent t |
| 416 | "*True means TAB should always re-indent the current line. | 453 | "*True means TAB should always re-indent the current line. |
| 417 | Nil means TAB will only reindent when at the beginning of the line." | 454 | Nil means TAB will only reindent when at the beginning of the line." |
| 418 | :group 'verilog-mode-indent | 455 | :group 'verilog-mode-indent |
| 419 | :type 'boolean) | 456 | :type 'boolean) |
| 457 | (put 'verilog-tab-always-indent 'safe-local-variable 'verilog-booleanp) | ||
| 420 | 458 | ||
| 421 | (defcustom verilog-tab-to-comment nil | 459 | (defcustom verilog-tab-to-comment nil |
| 422 | "*True means TAB moves to the right hand column in preparation for a comment." | 460 | "*True means TAB moves to the right hand column in preparation for a comment." |
| 423 | :group 'verilog-mode-actions | 461 | :group 'verilog-mode-actions |
| 424 | :type 'boolean) | 462 | :type 'boolean) |
| 463 | (put 'verilog-tab-to-comment 'safe-local-variable 'verilog-booleanp) | ||
| 425 | 464 | ||
| 426 | (defcustom verilog-indent-begin-after-if t | 465 | (defcustom verilog-indent-begin-after-if t |
| 427 | "*If true, indent begin statements following if, else, while, for and repeat. | 466 | "*If true, indent begin statements following if, else, while, for and repeat. |
| 428 | Otherwise, line them up." | 467 | Otherwise, line them up." |
| 429 | :group 'verilog-mode-indent | 468 | :group 'verilog-mode-indent |
| 430 | :type 'boolean ) | 469 | :type 'boolean) |
| 470 | (put 'verilog-indent-begin-after-if 'safe-local-variable 'verilog-booleanp) | ||
| 431 | 471 | ||
| 432 | 472 | ||
| 433 | (defcustom verilog-align-ifelse nil | 473 | (defcustom verilog-align-ifelse nil |
| 434 | "*If true, align `else' under matching `if'. | 474 | "*If true, align `else' under matching `if'. |
| 435 | Otherwise else is lined up with first character on line holding matching if." | 475 | Otherwise else is lined up with first character on line holding matching if." |
| 436 | :group 'verilog-mode-indent | 476 | :group 'verilog-mode-indent |
| 437 | :type 'boolean ) | 477 | :type 'boolean) |
| 478 | (put 'verilog-align-ifelse 'safe-local-variable 'verilog-booleanp) | ||
| 438 | 479 | ||
| 439 | (defcustom verilog-minimum-comment-distance 10 | 480 | (defcustom verilog-minimum-comment-distance 10 |
| 440 | "*Minimum distance (in lines) between begin and end required before a comment. | 481 | "*Minimum distance (in lines) between begin and end required before a comment. |
| @@ -442,6 +483,7 @@ Setting this variable to zero results in every end acquiring a comment; the | |||
| 442 | default avoids too many redundant comments in tight quarters" | 483 | default avoids too many redundant comments in tight quarters" |
| 443 | :group 'verilog-mode-indent | 484 | :group 'verilog-mode-indent |
| 444 | :type 'integer) | 485 | :type 'integer) |
| 486 | (put 'verilog-minimum-comment-distance 'safe-local-variable 'integerp) | ||
| 445 | 487 | ||
| 446 | (defcustom verilog-auto-lineup '(declaration) | 488 | (defcustom verilog-auto-lineup '(declaration) |
| 447 | "*Algorithm for lining up statements on multiple lines. | 489 | "*Algorithm for lining up statements on multiple lines. |
| @@ -481,23 +523,26 @@ would become | |||
| 481 | ; | 523 | ; |
| 482 | 524 | ||
| 483 | :group 'verilog-mode-indent | 525 | :group 'verilog-mode-indent |
| 484 | :type 'list ) | 526 | :type 'list) |
| 527 | (put 'verilog-auto-lineup 'safe-local-variable 'listp) | ||
| 485 | 528 | ||
| 486 | (defcustom verilog-highlight-p1800-keywords nil | 529 | (defcustom verilog-highlight-p1800-keywords nil |
| 487 | "*If true highlight words newly reserved by IEEE-1800 in | 530 | "*True means highlight words newly reserved by IEEE-1800. |
| 488 | verilog-font-lock-p1800-face in order to gently suggest changing where | 531 | These will appear in `verilog-font-lock-p1800-face' in order to gently |
| 489 | these words are used as variables to something else. Nil means highlight | 532 | suggest changing where these words are used as variables to something else. |
| 490 | these words as appropriate for the SystemVerilog IEEE-1800 standard. Note | 533 | Nil means highlight these words as appropriate for the SystemVerilog |
| 491 | that changing this will require restarting emacs to see the effect as font | 534 | IEEE-1800 standard. Note that changing this will require restarting Emacs |
| 492 | color choices are cached by emacs" | 535 | to see the effect as font color choices are cached by Emacs" |
| 493 | :group 'verilog-mode-indent | 536 | :group 'verilog-mode-indent |
| 494 | :type 'boolean) | 537 | :type 'boolean) |
| 538 | (put 'verilog-highlight-p1800-keywords 'safe-local-variable 'verilog-booleanp) | ||
| 495 | 539 | ||
| 496 | (defcustom verilog-auto-endcomments t | 540 | (defcustom verilog-auto-endcomments t |
| 497 | "*True means insert a comment /* ... */ after 'end's. | 541 | "*True means insert a comment /* ... */ after 'end's. |
| 498 | The name of the function or case will be set between the braces." | 542 | The name of the function or case will be set between the braces." |
| 499 | :group 'verilog-mode-actions | 543 | :group 'verilog-mode-actions |
| 500 | :type 'boolean ) | 544 | :type 'boolean) |
| 545 | (put 'verilog-auto-endcomments 'safe-local-variable 'verilog-booleanp) | ||
| 501 | 546 | ||
| 502 | (defcustom verilog-auto-read-includes nil | 547 | (defcustom verilog-auto-read-includes nil |
| 503 | "*True means to automatically read includes before AUTOs. | 548 | "*True means to automatically read includes before AUTOs. |
| @@ -506,7 +551,8 @@ each AUTO expansion. This makes it easier to embed defines and includes, | |||
| 506 | but can result in very slow reading times if there are many or large | 551 | but can result in very slow reading times if there are many or large |
| 507 | include files." | 552 | include files." |
| 508 | :group 'verilog-mode-actions | 553 | :group 'verilog-mode-actions |
| 509 | :type 'boolean ) | 554 | :type 'boolean) |
| 555 | (put 'verilog-auto-read-includes 'safe-local-variable 'verilog-booleanp) | ||
| 510 | 556 | ||
| 511 | (defcustom verilog-auto-save-policy nil | 557 | (defcustom verilog-auto-save-policy nil |
| 512 | "*Non-nil indicates action to take when saving a Verilog buffer with AUTOs. | 558 | "*Non-nil indicates action to take when saving a Verilog buffer with AUTOs. |
| @@ -527,6 +573,7 @@ They will be expanded in the same way as if there was a AUTOINST in the | |||
| 527 | instantiation. See also `verilog-auto-star' and `verilog-auto-star-save'." | 573 | instantiation. See also `verilog-auto-star' and `verilog-auto-star-save'." |
| 528 | :group 'verilog-mode-actions | 574 | :group 'verilog-mode-actions |
| 529 | :type 'boolean) | 575 | :type 'boolean) |
| 576 | (put 'verilog-auto-star-expand 'safe-local-variable 'verilog-booleanp) | ||
| 530 | 577 | ||
| 531 | (defcustom verilog-auto-star-save nil | 578 | (defcustom verilog-auto-star-save nil |
| 532 | "*Non-nil indicates to save to disk SystemVerilog .* instance expansions. | 579 | "*Non-nil indicates to save to disk SystemVerilog .* instance expansions. |
| @@ -537,6 +584,7 @@ Instead of setting this, you may want to use /*AUTOINST*/, which will | |||
| 537 | always be saved." | 584 | always be saved." |
| 538 | :group 'verilog-mode-actions | 585 | :group 'verilog-mode-actions |
| 539 | :type 'boolean) | 586 | :type 'boolean) |
| 587 | (put 'verilog-auto-star-save 'safe-local-variable 'verilog-booleanp) | ||
| 540 | 588 | ||
| 541 | (defvar verilog-auto-update-tick nil | 589 | (defvar verilog-auto-update-tick nil |
| 542 | "Modification tick at which autos were last performed.") | 590 | "Modification tick at which autos were last performed.") |
| @@ -624,8 +672,7 @@ always be saved." | |||
| 624 | ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 1 bold t) | 672 | ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 1 bold t) |
| 625 | ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 2 bold t) | 673 | ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 2 bold t) |
| 626 | ) | 674 | ) |
| 627 | "*Keywords to also highlight in Verilog *compilation* buffers." | 675 | "*Keywords to also highlight in Verilog *compilation* buffers.") |
| 628 | ) | ||
| 629 | 676 | ||
| 630 | (defcustom verilog-library-flags '("") | 677 | (defcustom verilog-library-flags '("") |
| 631 | "*List of standard Verilog arguments to use for /*AUTOINST*/. | 678 | "*List of standard Verilog arguments to use for /*AUTOINST*/. |
| @@ -656,6 +703,7 @@ have problems, use \\[find-alternate-file] RET to have these take effect. | |||
| 656 | See also the variables mentioned above." | 703 | See also the variables mentioned above." |
| 657 | :group 'verilog-mode-auto | 704 | :group 'verilog-mode-auto |
| 658 | :type '(repeat string)) | 705 | :type '(repeat string)) |
| 706 | (put 'verilog-library-flags 'safe-local-variable 'listp) | ||
| 659 | 707 | ||
| 660 | (defcustom verilog-library-directories '(".") | 708 | (defcustom verilog-library-directories '(".") |
| 661 | "*List of directories when looking for files for /*AUTOINST*/. | 709 | "*List of directories when looking for files for /*AUTOINST*/. |
| @@ -678,9 +726,11 @@ See also `verilog-library-flags', `verilog-library-files' | |||
| 678 | and `verilog-library-extensions'." | 726 | and `verilog-library-extensions'." |
| 679 | :group 'verilog-mode-auto | 727 | :group 'verilog-mode-auto |
| 680 | :type '(repeat file)) | 728 | :type '(repeat file)) |
| 729 | (put 'verilog-library-directories 'safe-local-variable 'listp) | ||
| 681 | 730 | ||
| 682 | (defcustom verilog-library-files '() | 731 | (defcustom verilog-library-files '() |
| 683 | "*List of files to search for modules when looking for AUTOINST files. | 732 | "*List of files to search for modules. |
| 733 | AUTOINST will use this when it needs to resolve a module name. | ||
| 684 | This is a complete path, usually to a technology file with many standard | 734 | This is a complete path, usually to a technology file with many standard |
| 685 | cells defined in it. | 735 | cells defined in it. |
| 686 | 736 | ||
| @@ -698,12 +748,14 @@ have problems, use \\[find-alternate-file] RET to have these take effect. | |||
| 698 | See also `verilog-library-flags', `verilog-library-directories'." | 748 | See also `verilog-library-flags', `verilog-library-directories'." |
| 699 | :group 'verilog-mode-auto | 749 | :group 'verilog-mode-auto |
| 700 | :type '(repeat directory)) | 750 | :type '(repeat directory)) |
| 751 | (put 'verilog-library-files 'safe-local-variable 'listp) | ||
| 701 | 752 | ||
| 702 | (defcustom verilog-library-extensions '(".v") | 753 | (defcustom verilog-library-extensions '(".v") |
| 703 | "*List of extensions to use when looking for files for /*AUTOINST*/. | 754 | "*List of extensions to use when looking for files for /*AUTOINST*/. |
| 704 | See also `verilog-library-flags', `verilog-library-directories'." | 755 | See also `verilog-library-flags', `verilog-library-directories'." |
| 705 | :type '(repeat string) | 756 | :type '(repeat string) |
| 706 | :group 'verilog-mode-auto) | 757 | :group 'verilog-mode-auto) |
| 758 | (put 'verilog-library-extensions 'safe-local-variable 'listp) | ||
| 707 | 759 | ||
| 708 | (defcustom verilog-active-low-regexp nil | 760 | (defcustom verilog-active-low-regexp nil |
| 709 | "*If set, treat signals matching this regexp as active low. | 761 | "*If set, treat signals matching this regexp as active low. |
| @@ -711,21 +763,24 @@ This is used for AUTORESET and AUTOTIEOFF. For proper behavior, | |||
| 711 | you will probably also need `verilog-auto-reset-widths' set." | 763 | you will probably also need `verilog-auto-reset-widths' set." |
| 712 | :group 'verilog-mode-auto | 764 | :group 'verilog-mode-auto |
| 713 | :type 'string) | 765 | :type 'string) |
| 766 | (put 'verilog-active-low-regexp 'safe-local-variable 'stringp) | ||
| 714 | 767 | ||
| 715 | (defcustom verilog-auto-sense-include-inputs nil | 768 | (defcustom verilog-auto-sense-include-inputs nil |
| 716 | "*If true, AUTOSENSE should include all inputs. | 769 | "*If true, AUTOSENSE should include all inputs. |
| 717 | If nil, only inputs that are NOT output signals in the same block are | 770 | If nil, only inputs that are NOT output signals in the same block are |
| 718 | included." | 771 | included." |
| 719 | :type 'boolean | 772 | :group 'verilog-mode-auto |
| 720 | :group 'verilog-mode-auto) | 773 | :type 'boolean) |
| 774 | (put 'verilog-auto-sense-include-inputs 'safe-local-variable 'verilog-booleanp) | ||
| 721 | 775 | ||
| 722 | (defcustom verilog-auto-sense-defines-constant nil | 776 | (defcustom verilog-auto-sense-defines-constant nil |
| 723 | "*If true, AUTOSENSE should assume all defines represent constants. | 777 | "*If true, AUTOSENSE should assume all defines represent constants. |
| 724 | When true, the defines will not be included in sensitivity lists. To | 778 | When true, the defines will not be included in sensitivity lists. To |
| 725 | maintain compatibility with other sites, this should be set at the bottom | 779 | maintain compatibility with other sites, this should be set at the bottom |
| 726 | of each verilog file that requires it, rather than being set globally." | 780 | of each verilog file that requires it, rather than being set globally." |
| 727 | :type 'boolean | 781 | :group 'verilog-mode-auto |
| 728 | :group 'verilog-mode-auto) | 782 | :type 'boolean) |
| 783 | (put 'verilog-auto-sense-defines-constant 'safe-local-variable 'verilog-booleanp) | ||
| 729 | 784 | ||
| 730 | (defcustom verilog-auto-reset-widths t | 785 | (defcustom verilog-auto-reset-widths t |
| 731 | "*If true, AUTORESET should determine the width of signals. | 786 | "*If true, AUTORESET should determine the width of signals. |
| @@ -735,11 +790,13 @@ the constant zero. This may result in ugly code when parameters determine | |||
| 735 | the MSB or LSB of a signal inside a AUTORESET." | 790 | the MSB or LSB of a signal inside a AUTORESET." |
| 736 | :type 'boolean | 791 | :type 'boolean |
| 737 | :group 'verilog-mode-auto) | 792 | :group 'verilog-mode-auto) |
| 793 | (put 'verilog-auto-reset-widths 'safe-local-variable 'verilog-booleanp) | ||
| 738 | 794 | ||
| 739 | (defcustom verilog-assignment-delay "" | 795 | (defcustom verilog-assignment-delay "" |
| 740 | "*Text used for delays in delayed assignments. Add a trailing space if set." | 796 | "*Text used for delays in delayed assignments. Add a trailing space if set." |
| 741 | :type 'string | 797 | :group 'verilog-mode-auto |
| 742 | :group 'verilog-mode-auto) | 798 | :type 'string) |
| 799 | (put 'verilog-assignment-delay 'safe-local-variable 'stringp) | ||
| 743 | 800 | ||
| 744 | (defcustom verilog-auto-inst-vector t | 801 | (defcustom verilog-auto-inst-vector t |
| 745 | "*If true, when creating default ports with AUTOINST, use bus subscripts. | 802 | "*If true, when creating default ports with AUTOINST, use bus subscripts. |
| @@ -748,7 +805,8 @@ the module (AUTOWIRE signals always are subscripted, you must manually | |||
| 748 | declare the wire to have the subscripts removed.) Nil may speed up some | 805 | declare the wire to have the subscripts removed.) Nil may speed up some |
| 749 | simulators, but is less general and harder to read, so avoid." | 806 | simulators, but is less general and harder to read, so avoid." |
| 750 | :group 'verilog-mode-auto | 807 | :group 'verilog-mode-auto |
| 751 | :type 'boolean ) | 808 | :type 'boolean) |
| 809 | (put 'verilog-auto-inst-vector 'safe-local-variable 'verilog-booleanp) | ||
| 752 | 810 | ||
| 753 | (defcustom verilog-auto-inst-template-numbers nil | 811 | (defcustom verilog-auto-inst-template-numbers nil |
| 754 | "*If true, when creating templated ports with AUTOINST, add a comment. | 812 | "*If true, when creating templated ports with AUTOINST, add a comment. |
| @@ -756,7 +814,8 @@ The comment will add the line number of the template that was used for that | |||
| 756 | port declaration. Setting this aids in debugging, but nil is suggested for | 814 | port declaration. Setting this aids in debugging, but nil is suggested for |
| 757 | regular use to prevent large numbers of merge conflicts." | 815 | regular use to prevent large numbers of merge conflicts." |
| 758 | :group 'verilog-mode-auto | 816 | :group 'verilog-mode-auto |
| 759 | :type 'boolean ) | 817 | :type 'boolean) |
| 818 | (put 'verilog-auto-inst-template-numbers 'safe-local-variable 'verilog-booleanp) | ||
| 760 | 819 | ||
| 761 | (defvar verilog-auto-inst-column 40 | 820 | (defvar verilog-auto-inst-column 40 |
| 762 | "Column number for first part of auto-inst.") | 821 | "Column number for first part of auto-inst.") |
| @@ -765,31 +824,36 @@ regular use to prevent large numbers of merge conflicts." | |||
| 765 | "*If set, when creating AUTOINPUT list, ignore signals matching this regexp. | 824 | "*If set, when creating AUTOINPUT list, ignore signals matching this regexp. |
| 766 | See the \\[verilog-faq] for examples on using this." | 825 | See the \\[verilog-faq] for examples on using this." |
| 767 | :group 'verilog-mode-auto | 826 | :group 'verilog-mode-auto |
| 768 | :type 'string ) | 827 | :type 'string) |
| 828 | (put 'verilog-auto-input-ignore-regexp 'safe-local-variable 'stringp) | ||
| 769 | 829 | ||
| 770 | (defcustom verilog-auto-inout-ignore-regexp nil | 830 | (defcustom verilog-auto-inout-ignore-regexp nil |
| 771 | "*If set, when creating AUTOINOUT list, ignore signals matching this regexp. | 831 | "*If set, when creating AUTOINOUT list, ignore signals matching this regexp. |
| 772 | See the \\[verilog-faq] for examples on using this." | 832 | See the \\[verilog-faq] for examples on using this." |
| 773 | :group 'verilog-mode-auto | 833 | :group 'verilog-mode-auto |
| 774 | :type 'string ) | 834 | :type 'string) |
| 835 | (put 'verilog-auto-inout-ignore-regexp 'safe-local-variable 'stringp) | ||
| 775 | 836 | ||
| 776 | (defcustom verilog-auto-output-ignore-regexp nil | 837 | (defcustom verilog-auto-output-ignore-regexp nil |
| 777 | "*If set, when creating AUTOOUTPUT list, ignore signals matching this regexp. | 838 | "*If set, when creating AUTOOUTPUT list, ignore signals matching this regexp. |
| 778 | See the \\[verilog-faq] for examples on using this." | 839 | See the \\[verilog-faq] for examples on using this." |
| 779 | :group 'verilog-mode-auto | 840 | :group 'verilog-mode-auto |
| 780 | :type 'string ) | 841 | :type 'string) |
| 842 | (put 'verilog-auto-output-ignore-regexp 'safe-local-variable 'stringp) | ||
| 781 | 843 | ||
| 782 | (defcustom verilog-auto-unused-ignore-regexp nil | 844 | (defcustom verilog-auto-unused-ignore-regexp nil |
| 783 | "*If set, when creating AUTOUNUSED list, ignore signals matching this regexp. | 845 | "*If set, when creating AUTOUNUSED list, ignore signals matching this regexp. |
| 784 | See the \\[verilog-faq] for examples on using this." | 846 | See the \\[verilog-faq] for examples on using this." |
| 785 | :group 'verilog-mode-auto | 847 | :group 'verilog-mode-auto |
| 786 | :type 'string ) | 848 | :type 'string) |
| 849 | (put 'verilog-auto-unused-ignore-regexp 'safe-local-variable 'stringp) | ||
| 787 | 850 | ||
| 788 | (defcustom verilog-typedef-regexp nil | 851 | (defcustom verilog-typedef-regexp nil |
| 789 | "*If non-nil, regular expression that matches Verilog-2001 typedef names. | 852 | "*If non-nil, regular expression that matches Verilog-2001 typedef names. |
| 790 | For example, \"_t$\" matches typedefs named with _t, as in the C language." | 853 | For example, \"_t$\" matches typedefs named with _t, as in the C language." |
| 791 | :group 'verilog-mode-auto | 854 | :group 'verilog-mode-auto |
| 792 | :type 'string ) | 855 | :type 'string) |
| 856 | (put 'verilog-typedef-regexp 'safe-local-variable 'stringp) | ||
| 793 | 857 | ||
| 794 | (defcustom verilog-mode-hook 'verilog-set-compile-command | 858 | (defcustom verilog-mode-hook 'verilog-set-compile-command |
| 795 | "*Hook (List of functions) run after verilog mode is loaded." | 859 | "*Hook (List of functions) run after verilog mode is loaded." |
| @@ -798,33 +862,33 @@ For example, \"_t$\" matches typedefs named with _t, as in the C language." | |||
| 798 | 862 | ||
| 799 | (defcustom verilog-auto-hook nil | 863 | (defcustom verilog-auto-hook nil |
| 800 | "*Hook run after `verilog-mode' updates AUTOs." | 864 | "*Hook run after `verilog-mode' updates AUTOs." |
| 801 | :type 'hook | 865 | :group 'verilog-mode-auto |
| 802 | :group 'verilog-mode-auto) | 866 | :type 'hook) |
| 803 | 867 | ||
| 804 | (defcustom verilog-before-auto-hook nil | 868 | (defcustom verilog-before-auto-hook nil |
| 805 | "*Hook run before `verilog-mode' updates AUTOs." | 869 | "*Hook run before `verilog-mode' updates AUTOs." |
| 806 | :type 'hook | 870 | :group 'verilog-mode-auto |
| 807 | :group 'verilog-mode-auto) | 871 | :type 'hook) |
| 808 | 872 | ||
| 809 | (defcustom verilog-delete-auto-hook nil | 873 | (defcustom verilog-delete-auto-hook nil |
| 810 | "*Hook run after `verilog-mode' deletes AUTOs." | 874 | "*Hook run after `verilog-mode' deletes AUTOs." |
| 811 | :type 'hook | 875 | :group 'verilog-mode-auto |
| 812 | :group 'verilog-mode-auto) | 876 | :type 'hook) |
| 813 | 877 | ||
| 814 | (defcustom verilog-before-delete-auto-hook nil | 878 | (defcustom verilog-before-delete-auto-hook nil |
| 815 | "*Hook run before `verilog-mode' deletes AUTOs." | 879 | "*Hook run before `verilog-mode' deletes AUTOs." |
| 816 | :type 'hook | 880 | :group 'verilog-mode-auto |
| 817 | :group 'verilog-mode-auto) | 881 | :type 'hook) |
| 818 | 882 | ||
| 819 | (defcustom verilog-getopt-flags-hook nil | 883 | (defcustom verilog-getopt-flags-hook nil |
| 820 | "*Hook run after `verilog-getopt-flags' determines the Verilog option lists." | 884 | "*Hook run after `verilog-getopt-flags' determines the Verilog option lists." |
| 821 | :type 'hook | 885 | :group 'verilog-mode-auto |
| 822 | :group 'verilog-mode-auto) | 886 | :type 'hook) |
| 823 | 887 | ||
| 824 | (defcustom verilog-before-getopt-flags-hook nil | 888 | (defcustom verilog-before-getopt-flags-hook nil |
| 825 | "*Hook run before `verilog-getopt-flags' determines the Verilog option lists." | 889 | "*Hook run before `verilog-getopt-flags' determines the Verilog option lists." |
| 826 | :type 'hook | 890 | :group 'verilog-mode-auto |
| 827 | :group 'verilog-mode-auto) | 891 | :type 'hook) |
| 828 | 892 | ||
| 829 | (defvar verilog-imenu-generic-expression | 893 | (defvar verilog-imenu-generic-expression |
| 830 | '((nil "^\\s-*\\(\\(m\\(odule\\|acromodule\\)\\)\\|primitive\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 4) | 894 | '((nil "^\\s-*\\(\\(m\\(odule\\|acromodule\\)\\)\\|primitive\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 4) |
| @@ -843,13 +907,11 @@ format (e.g. 09/17/1997) is not supported.") | |||
| 843 | (defvar verilog-company nil | 907 | (defvar verilog-company nil |
| 844 | "*Default name of Company for verilog header. | 908 | "*Default name of Company for verilog header. |
| 845 | If set will become buffer local.") | 909 | If set will become buffer local.") |
| 846 | |||
| 847 | (make-variable-buffer-local 'verilog-company) | 910 | (make-variable-buffer-local 'verilog-company) |
| 848 | 911 | ||
| 849 | (defvar verilog-project nil | 912 | (defvar verilog-project nil |
| 850 | "*Default name of Project for verilog header. | 913 | "*Default name of Project for verilog header. |
| 851 | If set will become buffer local.") | 914 | If set will become buffer local.") |
| 852 | |||
| 853 | (make-variable-buffer-local 'verilog-project) | 915 | (make-variable-buffer-local 'verilog-project) |
| 854 | 916 | ||
| 855 | (defvar verilog-mode-map | 917 | (defvar verilog-mode-map |
| @@ -871,7 +933,6 @@ If set will become buffer local.") | |||
| 871 | (define-key map "\M-\r" `electric-verilog-terminate-and-indent) | 933 | (define-key map "\M-\r" `electric-verilog-terminate-and-indent) |
| 872 | (define-key map "\M-\t" 'verilog-complete-word) | 934 | (define-key map "\M-\t" 'verilog-complete-word) |
| 873 | (define-key map "\M-?" 'verilog-show-completions) | 935 | (define-key map "\M-?" 'verilog-show-completions) |
| 874 | (define-key map [(meta control h)] 'verilog-mark-defun) | ||
| 875 | (define-key map "\C-c\`" 'verilog-lint-off) | 936 | (define-key map "\C-c\`" 'verilog-lint-off) |
| 876 | (define-key map "\C-c\*" 'verilog-delete-auto-star-implicit) | 937 | (define-key map "\C-c\*" 'verilog-delete-auto-star-implicit) |
| 877 | (define-key map "\C-c\C-r" 'verilog-label-be) | 938 | (define-key map "\C-c\C-r" 'verilog-label-be) |
| @@ -881,8 +942,10 @@ If set will become buffer local.") | |||
| 881 | (define-key map "\M-*" 'verilog-star-comment) | 942 | (define-key map "\M-*" 'verilog-star-comment) |
| 882 | (define-key map "\C-c\C-c" 'verilog-comment-region) | 943 | (define-key map "\C-c\C-c" 'verilog-comment-region) |
| 883 | (define-key map "\C-c\C-u" 'verilog-uncomment-region) | 944 | (define-key map "\C-c\C-u" 'verilog-uncomment-region) |
| 884 | (define-key map "\M-\C-a" 'verilog-beg-of-defun) | 945 | (when (featurep 'xemacs) |
| 885 | (define-key map "\M-\C-e" 'verilog-end-of-defun) | 946 | (define-key map [(meta control h)] 'verilog-mark-defun) |
| 947 | (define-key map "\M-\C-a" 'verilog-beg-of-defun) | ||
| 948 | (define-key map "\M-\C-e" 'verilog-end-of-defun)) | ||
| 886 | (define-key map "\C-c\C-d" 'verilog-goto-defun) | 949 | (define-key map "\C-c\C-d" 'verilog-goto-defun) |
| 887 | (define-key map "\C-c\C-k" 'verilog-delete-auto) | 950 | (define-key map "\C-c\C-k" 'verilog-delete-auto) |
| 888 | (define-key map "\C-c\C-a" 'verilog-auto) | 951 | (define-key map "\C-c\C-a" 'verilog-auto) |
| @@ -895,7 +958,7 @@ If set will become buffer local.") | |||
| 895 | 958 | ||
| 896 | ;; menus | 959 | ;; menus |
| 897 | (defvar verilog-xemacs-menu | 960 | (defvar verilog-xemacs-menu |
| 898 | '("Verilog" | 961 | `("Verilog" |
| 899 | ("Choose Compilation Action" | 962 | ("Choose Compilation Action" |
| 900 | ["None" | 963 | ["None" |
| 901 | (progn | 964 | (progn |
| @@ -929,9 +992,15 @@ If set will become buffer local.") | |||
| 929 | :selected (equal verilog-tool `verilog-compiler)] | 992 | :selected (equal verilog-tool `verilog-compiler)] |
| 930 | ) | 993 | ) |
| 931 | ("Move" | 994 | ("Move" |
| 932 | ["Beginning of function" verilog-beg-of-defun t] | 995 | ,(if (featurep 'xemacs) |
| 933 | ["End of function" verilog-end-of-defun t] | 996 | (progn |
| 934 | ["Mark function" verilog-mark-defun t] | 997 | ["Beginning of function" verilog-beg-of-defun t] |
| 998 | ["End of function" verilog-end-of-defun t] | ||
| 999 | ["Mark function" verilog-mark-defun t]) | ||
| 1000 | ["Beginning of function" beginning-of-defun t] | ||
| 1001 | ["End of function" end-of-defun t] | ||
| 1002 | ["Mark function" mark-defun t]) | ||
| 1003 | |||
| 935 | ["Goto function/module" verilog-goto-defun t] | 1004 | ["Goto function/module" verilog-goto-defun t] |
| 936 | ["Move to beginning of block" electric-verilog-backward-sexp t] | 1005 | ["Move to beginning of block" electric-verilog-backward-sexp t] |
| 937 | ["Move to end of block" electric-verilog-forward-sexp t] | 1006 | ["Move to end of block" electric-verilog-forward-sexp t] |
| @@ -1025,8 +1094,7 @@ If set will become buffer local.") | |||
| 1025 | ["Casex" verilog-sk-casex t] | 1094 | ["Casex" verilog-sk-casex t] |
| 1026 | ["Casez" verilog-sk-casez t] | 1095 | ["Casez" verilog-sk-casez t] |
| 1027 | ) | 1096 | ) |
| 1028 | "Menu for statement templates in Verilog." | 1097 | "Menu for statement templates in Verilog.") |
| 1029 | ) | ||
| 1030 | 1098 | ||
| 1031 | (easy-menu-define verilog-menu verilog-mode-map "Menu for Verilog mode" | 1099 | (easy-menu-define verilog-menu verilog-mode-map "Menu for Verilog mode" |
| 1032 | verilog-xemacs-menu) | 1100 | verilog-xemacs-menu) |
| @@ -1072,8 +1140,7 @@ will break, as the o's continuously replace. xa -> x works ok though." | |||
| 1072 | (store-match-data '(nil nil)) | 1140 | (store-match-data '(nil nil)) |
| 1073 | (if BOUND | 1141 | (if BOUND |
| 1074 | (< (point) BOUND) | 1142 | (< (point) BOUND) |
| 1075 | t) | 1143 | t))))) |
| 1076 | )))) | ||
| 1077 | (match-end 0)) | 1144 | (match-end 0)) |
| 1078 | 1145 | ||
| 1079 | (defsubst verilog-re-search-backward (REGEXP BOUND NOERROR) | 1146 | (defsubst verilog-re-search-backward (REGEXP BOUND NOERROR) |
| @@ -1087,8 +1154,7 @@ will break, as the o's continuously replace. xa -> x works ok though." | |||
| 1087 | (store-match-data '(nil nil)) | 1154 | (store-match-data '(nil nil)) |
| 1088 | (if BOUND | 1155 | (if BOUND |
| 1089 | (> (point) BOUND) | 1156 | (> (point) BOUND) |
| 1090 | t) | 1157 | t))))) |
| 1091 | )))) | ||
| 1092 | (match-end 0)) | 1158 | (match-end 0)) |
| 1093 | 1159 | ||
| 1094 | (defsubst verilog-re-search-forward-quick (regexp bound noerror) | 1160 | (defsubst verilog-re-search-forward-quick (regexp bound noerror) |
| @@ -1130,6 +1196,8 @@ so there may be a large up front penalty for the first search." | |||
| 1130 | (save-excursion | 1196 | (save-excursion |
| 1131 | (nth 3 (parse-partial-sexp (verilog-get-beg-of-line) (point))))) | 1197 | (nth 3 (parse-partial-sexp (verilog-get-beg-of-line) (point))))) |
| 1132 | 1198 | ||
| 1199 | (defvar compile-command) | ||
| 1200 | |||
| 1133 | ;; compilation program | 1201 | ;; compilation program |
| 1134 | (defun verilog-set-compile-command () | 1202 | (defun verilog-set-compile-command () |
| 1135 | "Function to compute shell command to compile verilog. | 1203 | "Function to compute shell command to compile verilog. |
| @@ -1201,8 +1269,7 @@ find the errors." | |||
| 1201 | (setq compilation-error-regexp-alist | 1269 | (setq compilation-error-regexp-alist |
| 1202 | (default-value 'compilation-error-regexp-alist)) | 1270 | (default-value 'compilation-error-regexp-alist)) |
| 1203 | (set (make-local-variable 'compilation-error-regexp-alist) | 1271 | (set (make-local-variable 'compilation-error-regexp-alist) |
| 1204 | (default-value 'compilation-error-regexp-alist)) | 1272 | (default-value 'compilation-error-regexp-alist))))) |
| 1205 | ))) | ||
| 1206 | 1273 | ||
| 1207 | (add-hook 'compilation-mode-hook 'verilog-error-regexp-add) | 1274 | (add-hook 'compilation-mode-hook 'verilog-error-regexp-add) |
| 1208 | 1275 | ||
| @@ -1330,8 +1397,7 @@ find the errors." | |||
| 1330 | "endprogram" | 1397 | "endprogram" |
| 1331 | "endsequence" | 1398 | "endsequence" |
| 1332 | "endclocking" | 1399 | "endclocking" |
| 1333 | ) | 1400 | )))) |
| 1334 | ))) | ||
| 1335 | 1401 | ||
| 1336 | 1402 | ||
| 1337 | (defconst verilog-endcomment-reason-re | 1403 | (defconst verilog-endcomment-reason-re |
| @@ -1655,157 +1721,37 @@ find the errors." | |||
| 1655 | ) | 1721 | ) |
| 1656 | "List of Verilog keywords.") | 1722 | "List of Verilog keywords.") |
| 1657 | 1723 | ||
| 1658 | |||
| 1659 | (defconst verilog-emacs-features | ||
| 1660 | ;; Documentation at the bottom | ||
| 1661 | (let ((major (and (boundp 'emacs-major-version) | ||
| 1662 | emacs-major-version)) | ||
| 1663 | (minor (and (boundp 'emacs-minor-version) | ||
| 1664 | emacs-minor-version)) | ||
| 1665 | flavor comments flock-syntax) | ||
| 1666 | ;; figure out version numbers if not already discovered | ||
| 1667 | (and (or (not major) (not minor)) | ||
| 1668 | (string-match "\\([0-9]+\\).\\([0-9]+\\)" emacs-version) | ||
| 1669 | (setq major (string-to-number (substring emacs-version | ||
| 1670 | (match-beginning 1) | ||
| 1671 | (match-end 1))) | ||
| 1672 | minor (string-to-number (substring emacs-version | ||
| 1673 | (match-beginning 2) | ||
| 1674 | (match-end 2))))) | ||
| 1675 | (if (not (and major minor)) | ||
| 1676 | (error "Cannot figure out the major and minor version numbers")) | ||
| 1677 | ;; calculate the major version | ||
| 1678 | (cond | ||
| 1679 | ((= major 4) (setq major 'v18)) ;Epoch 4 | ||
| 1680 | ((= major 18) (setq major 'v18)) ;Emacs 18 | ||
| 1681 | ((= major 19) (setq major 'v19 ;Emacs 19 | ||
| 1682 | flavor (if (or (string-match "Lucid" emacs-version) | ||
| 1683 | (string-match "XEmacs" emacs-version)) | ||
| 1684 | 'XEmacs 'FSF))) | ||
| 1685 | ((> major 19) (setq major 'v20 | ||
| 1686 | flavor (if (or (string-match "Lucid" emacs-version) | ||
| 1687 | (string-match "XEmacs" emacs-version)) | ||
| 1688 | 'XEmacs 'FSF))) | ||
| 1689 | ;; I don't know | ||
| 1690 | (t (error "Cannot recognize major version number: %s" major))) | ||
| 1691 | ;; XEmacs 19 uses 8-bit modify-syntax-entry flags, as do all | ||
| 1692 | ;; patched Emacs 19, Emacs 18, Epoch 4's. Only Emacs 19 uses a | ||
| 1693 | ;; 1-bit flag. Let's be as smart as we can about figuring this | ||
| 1694 | ;; out. | ||
| 1695 | (if (or (eq major 'v20) (eq major 'v19)) | ||
| 1696 | (let ((table (copy-syntax-table))) | ||
| 1697 | (modify-syntax-entry ?a ". 12345678" table) | ||
| 1698 | (cond | ||
| 1699 | ;; XEmacs pre 20 and Emacs pre 19.30 use vectors for syntax tables. | ||
| 1700 | ((vectorp table) | ||
| 1701 | (if (= (logand (lsh (aref table ?a) -16) 255) 255) | ||
| 1702 | (setq comments '8-bit) | ||
| 1703 | (setq comments '1-bit))) | ||
| 1704 | ;; XEmacs 20 is known to be 8-bit | ||
| 1705 | ((eq flavor 'XEmacs) (setq comments '8-bit)) | ||
| 1706 | ;; Emacs 19.30 and beyond are known to be 1-bit | ||
| 1707 | ((eq flavor 'FSF) (setq comments '1-bit)) | ||
| 1708 | ;; Don't know what this is | ||
| 1709 | (t (error "Couldn't figure out syntax table format")) | ||
| 1710 | )) | ||
| 1711 | ;; Emacs 18 has no support for dual comments | ||
| 1712 | (setq comments 'no-dual-comments)) | ||
| 1713 | ;; determine whether to use old or new font lock syntax | ||
| 1714 | ;; We can assume 8-bit syntax table emacsen support new syntax, otherwise | ||
| 1715 | ;; look for version > 19.30 | ||
| 1716 | (setq flock-syntax | ||
| 1717 | (if (or (equal comments '8-bit) | ||
| 1718 | (equal major 'v20) | ||
| 1719 | (and (equal major 'v19) (> minor 30))) | ||
| 1720 | 'flock-syntax-after-1930 | ||
| 1721 | 'flock-syntax-before-1930)) | ||
| 1722 | ;; lets do some minimal sanity checking. | ||
| 1723 | (if (or | ||
| 1724 | ;; Emacs before 19.6 had bugs | ||
| 1725 | (and (eq major 'v19) (eq flavor 'XEmacs) (< minor 6)) | ||
| 1726 | ;; Emacs 19 before 19.21 has known bugs | ||
| 1727 | (and (eq major 'v19) (eq flavor 'FSF) (< minor 21)) | ||
| 1728 | ) | ||
| 1729 | (with-output-to-temp-buffer "*verilog-mode warnings*" | ||
| 1730 | (print (format | ||
| 1731 | "The version of Emacs that you are running, %s, | ||
| 1732 | has known bugs in its syntax parsing routines which will affect the | ||
| 1733 | performance of verilog-mode. You should strongly consider upgrading to the | ||
| 1734 | latest available version. verilog-mode may continue to work, after a | ||
| 1735 | fashion, but strange indentation errors could be encountered." | ||
| 1736 | emacs-version)))) | ||
| 1737 | ;; Emacs 18, with no patch is not too good | ||
| 1738 | (if (and (eq major 'v18) (eq comments 'no-dual-comments)) | ||
| 1739 | (with-output-to-temp-buffer "*verilog-mode warnings*" | ||
| 1740 | (print (format | ||
| 1741 | "The version of Emacs 18 you are running, %s, | ||
| 1742 | has known deficiencies in its ability to handle the dual verilog | ||
| 1743 | \(and C++) comments, (e.g. the // and /* */ comments). This will | ||
| 1744 | not be much of a problem for you if you only use the /* */ comments, | ||
| 1745 | but you really should strongly consider upgrading to one of the latest | ||
| 1746 | Emacs 19's. In Emacs 18, you may also experience performance degradations. | ||
| 1747 | Emacs 19 has some new built-in routines which will speed things up for you. | ||
| 1748 | Because of these inherent problems, verilog-mode is not supported | ||
| 1749 | on emacs-18." | ||
| 1750 | emacs-version)))) | ||
| 1751 | ;; Emacs 18 with the syntax patches are no longer supported | ||
| 1752 | (if (and (eq major 'v18) (not (eq comments 'no-dual-comments))) | ||
| 1753 | (with-output-to-temp-buffer "*verilog-mode warnings*" | ||
| 1754 | (print (format | ||
| 1755 | "You are running a syntax patched Emacs 18 variant. While this should | ||
| 1756 | work for you, you may want to consider upgrading to Emacs 19. | ||
| 1757 | The syntax patches are no longer supported either for verilog-mode.")))) | ||
| 1758 | (list major comments flock-syntax)) | ||
| 1759 | "A list of features extant in the Emacs you are using. | ||
| 1760 | There are many flavors of Emacs out there, each with different | ||
| 1761 | features supporting those needed by `verilog-mode'. Here's the current | ||
| 1762 | supported list, along with the values for this variable: | ||
| 1763 | |||
| 1764 | Vanilla Emacs 18/Epoch 4: (v18 no-dual-comments flock-syntax-before-1930) | ||
| 1765 | Emacs 18/Epoch 4 (patch2): (v18 8-bit flock-syntax-after-1930) | ||
| 1766 | XEmacs (formerly Lucid) 19: (v19 8-bit flock-syntax-after-1930) | ||
| 1767 | XEmacs 20: (v20 8-bit flock-syntax-after-1930) | ||
| 1768 | Emacs 19.1-19.30: (v19 8-bit flock-syntax-before-1930) | ||
| 1769 | Emacs 19.31-19.xx: (v19 8-bit flock-syntax-after-1930) | ||
| 1770 | Emacs20 : (v20 1-bit flock-syntax-after-1930).") | ||
| 1771 | |||
| 1772 | (defconst verilog-comment-start-regexp "//\\|/\\*" | 1724 | (defconst verilog-comment-start-regexp "//\\|/\\*" |
| 1773 | "Dual comment value for `comment-start-regexp'.") | 1725 | "Dual comment value for `comment-start-regexp'.") |
| 1774 | 1726 | ||
| 1775 | (defun verilog-populate-syntax-table (table) | 1727 | (defvar verilog-mode-syntax-table |
| 1776 | "Populate the syntax TABLE." | 1728 | (let ((table (make-syntax-table))) |
| 1777 | (modify-syntax-entry ?\\ "\\" table) | 1729 | ;; Populate the syntax TABLE. |
| 1778 | (modify-syntax-entry ?+ "." table) | 1730 | (modify-syntax-entry ?\\ "\\" table) |
| 1779 | (modify-syntax-entry ?- "." table) | 1731 | (modify-syntax-entry ?+ "." table) |
| 1780 | (modify-syntax-entry ?= "." table) | 1732 | (modify-syntax-entry ?- "." table) |
| 1781 | (modify-syntax-entry ?% "." table) | 1733 | (modify-syntax-entry ?= "." table) |
| 1782 | (modify-syntax-entry ?< "." table) | 1734 | (modify-syntax-entry ?% "." table) |
| 1783 | (modify-syntax-entry ?> "." table) | 1735 | (modify-syntax-entry ?< "." table) |
| 1784 | (modify-syntax-entry ?& "." table) | 1736 | (modify-syntax-entry ?> "." table) |
| 1785 | (modify-syntax-entry ?| "." table) | 1737 | (modify-syntax-entry ?& "." table) |
| 1786 | (modify-syntax-entry ?` "w" table) | 1738 | (modify-syntax-entry ?| "." table) |
| 1787 | (modify-syntax-entry ?_ "w" table) | 1739 | (modify-syntax-entry ?` "w" table) |
| 1788 | (modify-syntax-entry ?\' "." table) | 1740 | (modify-syntax-entry ?_ "w" table) |
| 1789 | ) | 1741 | (modify-syntax-entry ?\' "." table) |
| 1790 | 1742 | ||
| 1791 | (defun verilog-setup-dual-comments (table) | 1743 | ;; Set up TABLE to handle block and line style comments. |
| 1792 | "Set up TABLE to handle block and line style comments." | 1744 | (if (featurep 'xemacs) |
| 1793 | (cond | 1745 | (progn |
| 1794 | ((memq '8-bit verilog-emacs-features) | 1746 | ;; XEmacs (formerly Lucid) has the best implementation |
| 1795 | ;; XEmacs (formerly Lucid) has the best implementation | 1747 | (modify-syntax-entry ?/ ". 1456" table) |
| 1796 | (modify-syntax-entry ?/ ". 1456" table) | 1748 | (modify-syntax-entry ?* ". 23" table) |
| 1797 | (modify-syntax-entry ?* ". 23" table) | 1749 | (modify-syntax-entry ?\n "> b" table)) |
| 1798 | (modify-syntax-entry ?\n "> b" table) | 1750 | ;; Emacs 19 does things differently, but we can work with it |
| 1799 | ) | 1751 | (modify-syntax-entry ?/ ". 124b" table) |
| 1800 | ((memq '1-bit verilog-emacs-features) | 1752 | (modify-syntax-entry ?* ". 23" table) |
| 1801 | ;; Emacs 19 does things differently, but we can work with it | 1753 | (modify-syntax-entry ?\n "> b" table)) |
| 1802 | (modify-syntax-entry ?/ ". 124b" table) | 1754 | table) |
| 1803 | (modify-syntax-entry ?* ". 23" table) | ||
| 1804 | (modify-syntax-entry ?\n "> b" table) | ||
| 1805 | ) | ||
| 1806 | )) | ||
| 1807 | |||
| 1808 | (defvar verilog-mode-syntax-table nil | ||
| 1809 | "Syntax table used in `verilog-mode' buffers.") | 1755 | "Syntax table used in `verilog-mode' buffers.") |
| 1810 | 1756 | ||
| 1811 | (defvar verilog-font-lock-keywords nil | 1757 | (defvar verilog-font-lock-keywords nil |
| @@ -1961,8 +1907,7 @@ See also `verilog-font-lock-extra-types'.") | |||
| 1961 | 'font-lock-type-face)) | 1907 | 'font-lock-type-face)) |
| 1962 | ;; Fontify Verilog-AMS keywords | 1908 | ;; Fontify Verilog-AMS keywords |
| 1963 | (cons (concat "\\<\\(" verilog-ams-keywords "\\)\\>") | 1909 | (cons (concat "\\<\\(" verilog-ams-keywords "\\)\\>") |
| 1964 | 'verilog-font-lock-ams-face) | 1910 | 'verilog-font-lock-ams-face))) |
| 1965 | )) | ||
| 1966 | 1911 | ||
| 1967 | (setq verilog-font-lock-keywords-1 | 1912 | (setq verilog-font-lock-keywords-1 |
| 1968 | (append verilog-font-lock-keywords | 1913 | (append verilog-font-lock-keywords |
| @@ -1976,15 +1921,12 @@ See also `verilog-font-lock-extra-types'.") | |||
| 1976 | (list | 1921 | (list |
| 1977 | (concat "\\<function\\>\\s-+\\(integer\\|real\\(time\\)?\\|time\\)\\s-+\\(\\sw+\\)" ) | 1922 | (concat "\\<function\\>\\s-+\\(integer\\|real\\(time\\)?\\|time\\)\\s-+\\(\\sw+\\)" ) |
| 1978 | '(1 font-lock-keyword-face) | 1923 | '(1 font-lock-keyword-face) |
| 1979 | '(3 font-lock-reference-face prepend) | 1924 | '(3 font-lock-reference-face prepend)) |
| 1980 | ) | ||
| 1981 | '("\\<function\\>\\s-+\\(\\[[^]]+\\]\\)\\s-+\\(\\sw+\\)" | 1925 | '("\\<function\\>\\s-+\\(\\[[^]]+\\]\\)\\s-+\\(\\sw+\\)" |
| 1982 | (1 font-lock-keyword-face) | 1926 | (1 font-lock-keyword-face) |
| 1983 | (2 font-lock-reference-face append) | 1927 | (2 font-lock-reference-face append)) |
| 1984 | ) | ||
| 1985 | '("\\<function\\>\\s-+\\(\\sw+\\)" | 1928 | '("\\<function\\>\\s-+\\(\\sw+\\)" |
| 1986 | 1 'font-lock-reference-face append) | 1929 | 1 'font-lock-reference-face append)))) |
| 1987 | ))) | ||
| 1988 | 1930 | ||
| 1989 | (setq verilog-font-lock-keywords-2 | 1931 | (setq verilog-font-lock-keywords-2 |
| 1990 | (append verilog-font-lock-keywords-1 | 1932 | (append verilog-font-lock-keywords-1 |
| @@ -2002,7 +1944,6 @@ See also `verilog-font-lock-extra-types'.") | |||
| 2002 | 0 font-lock-type-face append) | 1944 | 0 font-lock-type-face append) |
| 2003 | ;; Fontify instantiation names | 1945 | ;; Fontify instantiation names |
| 2004 | '("\\([A-Za-z][A-Za-z0-9_]+\\)\\s-*(" 1 font-lock-function-name-face) | 1946 | '("\\([A-Za-z][A-Za-z0-9_]+\\)\\s-*(" 1 font-lock-function-name-face) |
| 2005 | |||
| 2006 | ))) | 1947 | ))) |
| 2007 | 1948 | ||
| 2008 | (setq verilog-font-lock-keywords-3 | 1949 | (setq verilog-font-lock-keywords-3 |
| @@ -2015,15 +1956,14 @@ See also `verilog-font-lock-extra-types'.") | |||
| 2015 | ))))) | 1956 | ))))) |
| 2016 | 1957 | ||
| 2017 | 1958 | ||
| 2018 | |||
| 2019 | (defun verilog-inside-comment-p () | 1959 | (defun verilog-inside-comment-p () |
| 2020 | "Check if point inside a nested comment." | 1960 | "Check if point inside a nested comment." |
| 2021 | (save-excursion | 1961 | (save-excursion |
| 2022 | (let ((st-point (point)) hitbeg) | 1962 | (let ((st-point (point)) hitbeg) |
| 2023 | (or (search-backward "//" (verilog-get-beg-of-line) t) | 1963 | (or (search-backward "//" (verilog-get-beg-of-line) t) |
| 2024 | (if (progn | 1964 | (if (progn |
| 2025 | ;; This is for tricky case //*, we keep searching if /* is | 1965 | ;; This is for tricky case //*, we keep searching if /* |
| 2026 | ;; proceeded by // on same line. | 1966 | ;; is proceeded by // on same line. |
| 2027 | (while | 1967 | (while |
| 2028 | (and (setq hitbeg (search-backward "/*" nil t)) | 1968 | (and (setq hitbeg (search-backward "/*" nil t)) |
| 2029 | (progn | 1969 | (progn |
| @@ -2048,14 +1988,14 @@ Use filename, if current buffer being edited shorten to just buffer name." | |||
| 2048 | "Move backward over a sexp." | 1988 | "Move backward over a sexp." |
| 2049 | (interactive) | 1989 | (interactive) |
| 2050 | ;; before that see if we are in a comment | 1990 | ;; before that see if we are in a comment |
| 2051 | (verilog-backward-sexp) | 1991 | (verilog-backward-sexp)) |
| 2052 | ) | 1992 | |
| 2053 | (defun electric-verilog-forward-sexp () | 1993 | (defun electric-verilog-forward-sexp () |
| 2054 | "Move backward over a sexp." | 1994 | "Move backward over a sexp." |
| 2055 | (interactive) | 1995 | (interactive) |
| 2056 | ;; before that see if we are in a comment | 1996 | ;; before that see if we are in a comment |
| 2057 | (verilog-forward-sexp) | 1997 | (verilog-forward-sexp)) |
| 2058 | ) | 1998 | |
| 2059 | ;;;used by hs-minor-mode | 1999 | ;;;used by hs-minor-mode |
| 2060 | (defun verilog-forward-sexp-function (arg) | 2000 | (defun verilog-forward-sexp-function (arg) |
| 2061 | (if (< arg 0) | 2001 | (if (< arg 0) |
| @@ -2067,19 +2007,16 @@ Use filename, if current buffer being edited shorten to just buffer name." | |||
| 2067 | (let ((reg) | 2007 | (let ((reg) |
| 2068 | (elsec 1) | 2008 | (elsec 1) |
| 2069 | (found nil) | 2009 | (found nil) |
| 2070 | (st (point)) | 2010 | (st (point))) |
| 2071 | ) | ||
| 2072 | (if (not (looking-at "\\<")) | 2011 | (if (not (looking-at "\\<")) |
| 2073 | (forward-word -1)) | 2012 | (forward-word -1)) |
| 2074 | (cond | 2013 | (cond |
| 2075 | ((verilog-skip-backward-comment-or-string) | 2014 | ((verilog-skip-backward-comment-or-string)) |
| 2076 | ) | ||
| 2077 | ((looking-at "\\<else\\>") | 2015 | ((looking-at "\\<else\\>") |
| 2078 | (setq reg (concat | 2016 | (setq reg (concat |
| 2079 | verilog-end-block-re | 2017 | verilog-end-block-re |
| 2080 | "\\|\\(\\<else\\>\\)" | 2018 | "\\|\\(\\<else\\>\\)" |
| 2081 | "\\|\\(\\<if\\>\\)" | 2019 | "\\|\\(\\<if\\>\\)")) |
| 2082 | )) | ||
| 2083 | (while (and (not found) | 2020 | (while (and (not found) |
| 2084 | (verilog-re-search-backward reg nil 'move)) | 2021 | (verilog-re-search-backward reg nil 'move)) |
| 2085 | (cond | 2022 | (cond |
| @@ -2094,11 +2031,7 @@ Use filename, if current buffer being edited shorten to just buffer name." | |||
| 2094 | (setq elsec (1- elsec)) | 2031 | (setq elsec (1- elsec)) |
| 2095 | (if (= 0 elsec) | 2032 | (if (= 0 elsec) |
| 2096 | ;; Now previous line describes syntax | 2033 | ;; Now previous line describes syntax |
| 2097 | (setq found 't) | 2034 | (setq found 't)))))) |
| 2098 | )) | ||
| 2099 | ) | ||
| 2100 | ) | ||
| 2101 | ) | ||
| 2102 | ((looking-at verilog-end-block-re) | 2035 | ((looking-at verilog-end-block-re) |
| 2103 | (verilog-leap-to-head)) | 2036 | (verilog-leap-to-head)) |
| 2104 | ((looking-at "\\(endmodule\\>\\)\\|\\(\\<endprimitive\\>\\)\\|\\(\\<endclass\\>\\)\\|\\(\\<endprogram\\>\\)\\|\\(\\<endinterface\\>\\)\\|\\(\\<endpackage\\>\\)") | 2037 | ((looking-at "\\(endmodule\\>\\)\\|\\(\\<endprimitive\\>\\)\\|\\(\\<endclass\\>\\)\\|\\(\\<endprogram\\>\\)\\|\\(\\<endinterface\\>\\)\\|\\(\\<endpackage\\>\\)") |
| @@ -2120,9 +2053,7 @@ Use filename, if current buffer being edited shorten to just buffer name." | |||
| 2120 | (backward-sexp 1)))) | 2053 | (backward-sexp 1)))) |
| 2121 | (t | 2054 | (t |
| 2122 | (goto-char st) | 2055 | (goto-char st) |
| 2123 | (backward-sexp)) | 2056 | (backward-sexp))))) |
| 2124 | ) ;; cond | ||
| 2125 | )) | ||
| 2126 | 2057 | ||
| 2127 | (defun verilog-forward-sexp () | 2058 | (defun verilog-forward-sexp () |
| 2128 | (let ((reg) | 2059 | (let ((reg) |
| @@ -2132,8 +2063,7 @@ Use filename, if current buffer being edited shorten to just buffer name." | |||
| 2132 | (forward-word -1)) | 2063 | (forward-word -1)) |
| 2133 | (cond | 2064 | (cond |
| 2134 | ((verilog-skip-forward-comment-or-string) | 2065 | ((verilog-skip-forward-comment-or-string) |
| 2135 | (verilog-forward-syntactic-ws) | 2066 | (verilog-forward-syntactic-ws)) |
| 2136 | ) | ||
| 2137 | ((looking-at verilog-beg-block-re-ordered);; begin|case|fork|class|table|specify|function|task|generate|covergroup|property|sequence|clocking | 2067 | ((looking-at verilog-beg-block-re-ordered);; begin|case|fork|class|table|specify|function|task|generate|covergroup|property|sequence|clocking |
| 2138 | (cond | 2068 | (cond |
| 2139 | ((match-end 1) ; end | 2069 | ((match-end 1) ; end |
| @@ -2141,8 +2071,7 @@ Use filename, if current buffer being edited shorten to just buffer name." | |||
| 2141 | (setq reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)" )) | 2071 | (setq reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)" )) |
| 2142 | ((match-end 2) ; endcase | 2072 | ((match-end 2) ; endcase |
| 2143 | ;; Search forward for matching case | 2073 | ;; Search forward for matching case |
| 2144 | (setq reg "\\(\\<randcase\\>\\|\\(\\<unique\\>\\s-+\\|\\<priority\\>\\s-+\\)?\\<case[xz]?\\>[^:]\\)\\|\\(\\<endcase\\>\\)" ) | 2074 | (setq reg "\\(\\<randcase\\>\\|\\(\\<unique\\>\\s-+\\|\\<priority\\>\\s-+\\)?\\<case[xz]?\\>[^:]\\)\\|\\(\\<endcase\\>\\)" )) |
| 2145 | ) | ||
| 2146 | ((match-end 3) ; join | 2075 | ((match-end 3) ; join |
| 2147 | ;; Search forward for matching fork | 2076 | ;; Search forward for matching fork |
| 2148 | (setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" )) | 2077 | (setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" )) |
| @@ -2173,12 +2102,10 @@ Use filename, if current buffer being edited shorten to just buffer name." | |||
| 2173 | ((match-end 12) ; endsequence | 2102 | ((match-end 12) ; endsequence |
| 2174 | ;; Search forward for matching sequence | 2103 | ;; Search forward for matching sequence |
| 2175 | (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)" ) | 2104 | (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)" ) |
| 2176 | (setq md 3) ; 3 to get to endsequence in the reg above | 2105 | (setq md 3)) ; 3 to get to endsequence in the reg above |
| 2177 | ) | ||
| 2178 | ((match-end 13) ; endclocking | 2106 | ((match-end 13) ; endclocking |
| 2179 | ;; Search forward for matching clocking | 2107 | ;; Search forward for matching clocking |
| 2180 | (setq reg "\\(\\<clocking\\>\\)\\|\\(\\<endclocking\\>\\)" )) | 2108 | (setq reg "\\(\\<clocking\\>\\)\\|\\(\\<endclocking\\>\\)" ))) |
| 2181 | ) | ||
| 2182 | (if (forward-word 1) | 2109 | (if (forward-word 1) |
| 2183 | (catch 'skip | 2110 | (catch 'skip |
| 2184 | (let ((nest 1)) | 2111 | (let ((nest 1)) |
| @@ -2189,9 +2116,7 @@ Use filename, if current buffer being edited shorten to just buffer name." | |||
| 2189 | (if (= 0 nest) ; we are out! | 2116 | (if (= 0 nest) ; we are out! |
| 2190 | (throw 'skip 1))) | 2117 | (throw 'skip 1))) |
| 2191 | ((match-end 1) ; the opener in reg, so we are deeper now | 2118 | ((match-end 1) ; the opener in reg, so we are deeper now |
| 2192 | (setq nest (1+ nest))))) | 2119 | (setq nest (1+ nest))))))))) |
| 2193 | ))) | ||
| 2194 | ) | ||
| 2195 | ((looking-at (concat | 2120 | ((looking-at (concat |
| 2196 | "\\(\\<\\(macro\\)?module\\>\\)\\|" | 2121 | "\\(\\<\\(macro\\)?module\\>\\)\\|" |
| 2197 | "\\(\\<primitive\\>\\)\\|" | 2122 | "\\(\\<primitive\\>\\)\\|" |
| @@ -2221,9 +2146,7 @@ Use filename, if current buffer being edited shorten to just buffer name." | |||
| 2221 | (goto-char st) | 2146 | (goto-char st) |
| 2222 | (if (= (following-char) ?\) ) | 2147 | (if (= (following-char) ?\) ) |
| 2223 | (forward-char 1) | 2148 | (forward-char 1) |
| 2224 | (forward-sexp 1))) | 2149 | (forward-sexp 1)))))) |
| 2225 | ) ;; cond | ||
| 2226 | )) | ||
| 2227 | 2150 | ||
| 2228 | (defun verilog-declaration-beg () | 2151 | (defun verilog-declaration-beg () |
| 2229 | (verilog-re-search-backward verilog-declaration-re (bobp) t)) | 2152 | (verilog-re-search-backward verilog-declaration-re (bobp) t)) |
| @@ -2238,8 +2161,7 @@ Use filename, if current buffer being edited shorten to just buffer name." | |||
| 2238 | (list | 2161 | (list |
| 2239 | ;; Fontify things in translate off regions | 2162 | ;; Fontify things in translate off regions |
| 2240 | '(verilog-match-translate-off | 2163 | '(verilog-match-translate-off |
| 2241 | (0 'verilog-font-lock-translate-off-face prepend)) | 2164 | (0 'verilog-font-lock-translate-off-face prepend)))))) |
| 2242 | )))) | ||
| 2243 | (put 'verilog-mode 'font-lock-defaults | 2165 | (put 'verilog-mode 'font-lock-defaults |
| 2244 | '((verilog-font-lock-keywords | 2166 | '((verilog-font-lock-keywords |
| 2245 | verilog-font-lock-keywords-1 | 2167 | verilog-font-lock-keywords-1 |
| @@ -2253,23 +2175,7 @@ Use filename, if current buffer being edited shorten to just buffer name." | |||
| 2253 | 2175 | ||
| 2254 | ;; initialize fontification for Verilog Mode | 2176 | ;; initialize fontification for Verilog Mode |
| 2255 | (verilog-font-lock-init) | 2177 | (verilog-font-lock-init) |
| 2256 | ;; start up message | 2178 | |
| 2257 | (defconst verilog-startup-message-lines | ||
| 2258 | '("Please use \\[verilog-submit-bug-report] to report bugs." | ||
| 2259 | "Visit http://www.verilog.com to check for updates" | ||
| 2260 | )) | ||
| 2261 | (defvar verilog-startup-message-displayed t) | ||
| 2262 | (defun verilog-display-startup-message () | ||
| 2263 | (if (not verilog-startup-message-displayed) | ||
| 2264 | (if (sit-for 5) | ||
| 2265 | (let ((lines verilog-startup-message-lines)) | ||
| 2266 | (message "verilog-mode version %s, released %s; type \\[describe-mode] for help" | ||
| 2267 | verilog-mode-version verilog-mode-release-date) | ||
| 2268 | (setq verilog-startup-message-displayed t) | ||
| 2269 | (while (and (sit-for 4) lines) | ||
| 2270 | (message (substitute-command-keys (car lines))) | ||
| 2271 | (setq lines (cdr lines))))) | ||
| 2272 | (message ""))) | ||
| 2273 | ;; | 2179 | ;; |
| 2274 | ;; | 2180 | ;; |
| 2275 | ;; Mode | 2181 | ;; Mode |
| @@ -2409,14 +2315,10 @@ Key bindings specific to `verilog-mode-map' are: | |||
| 2409 | (setq major-mode 'verilog-mode) | 2315 | (setq major-mode 'verilog-mode) |
| 2410 | (setq mode-name "Verilog") | 2316 | (setq mode-name "Verilog") |
| 2411 | (setq local-abbrev-table verilog-mode-abbrev-table) | 2317 | (setq local-abbrev-table verilog-mode-abbrev-table) |
| 2412 | (setq verilog-mode-syntax-table (make-syntax-table)) | 2318 | (set (make-local-variable 'beginning-of-defun-function) |
| 2413 | (verilog-populate-syntax-table verilog-mode-syntax-table) | ||
| 2414 | (set (make-local-variable 'beginning-of-defun-function) | ||
| 2415 | 'verilog-beg-of-defun) | 2319 | 'verilog-beg-of-defun) |
| 2416 | (set (make-local-variable 'end-of-defun-function) | 2320 | (set (make-local-variable 'end-of-defun-function) |
| 2417 | 'verilog-end-of-defun) | 2321 | 'verilog-end-of-defun) |
| 2418 | ;; add extra comment syntax | ||
| 2419 | (verilog-setup-dual-comments verilog-mode-syntax-table) | ||
| 2420 | (set-syntax-table verilog-mode-syntax-table) | 2322 | (set-syntax-table verilog-mode-syntax-table) |
| 2421 | (make-local-variable 'indent-line-function) | 2323 | (make-local-variable 'indent-line-function) |
| 2422 | (setq indent-line-function 'verilog-indent-line-relative) | 2324 | (setq indent-line-function 'verilog-indent-line-relative) |
| @@ -2444,8 +2346,8 @@ Key bindings specific to `verilog-mode-map' are: | |||
| 2444 | (not (assoc "Verilog" current-menubar))) | 2346 | (not (assoc "Verilog" current-menubar))) |
| 2445 | ;; (set-buffer-menubar (copy-sequence current-menubar)) | 2347 | ;; (set-buffer-menubar (copy-sequence current-menubar)) |
| 2446 | (add-submenu nil verilog-xemacs-menu) | 2348 | (add-submenu nil verilog-xemacs-menu) |
| 2447 | (add-submenu nil verilog-stmt-menu) | 2349 | (add-submenu nil verilog-stmt-menu))) |
| 2448 | )) | 2350 | |
| 2449 | ;; Stuff for GNU emacs | 2351 | ;; Stuff for GNU emacs |
| 2450 | (set (make-local-variable 'font-lock-defaults) | 2352 | (set (make-local-variable 'font-lock-defaults) |
| 2451 | '((verilog-font-lock-keywords verilog-font-lock-keywords-1 | 2353 | '((verilog-font-lock-keywords verilog-font-lock-keywords-1 |
| @@ -2472,8 +2374,6 @@ Key bindings specific to `verilog-mode-map' are: | |||
| 2472 | (cons '(verilog-mode-mode "\\<begin\\>" "\\<end\\>" nil | 2374 | (cons '(verilog-mode-mode "\\<begin\\>" "\\<end\\>" nil |
| 2473 | verilog-forward-sexp-function) | 2375 | verilog-forward-sexp-function) |
| 2474 | hs-special-modes-alist))) | 2376 | hs-special-modes-alist))) |
| 2475 | ;; Display version splash information. | ||
| 2476 | (verilog-display-startup-message) | ||
| 2477 | 2377 | ||
| 2478 | ;; Stuff for autos | 2378 | ;; Stuff for autos |
| 2479 | (add-hook 'write-contents-hooks 'verilog-auto-save-check) ; already local | 2379 | (add-hook 'write-contents-hooks 'verilog-auto-save-check) ; already local |
| @@ -2527,27 +2427,19 @@ With optional ARG, remove existing end of line comments." | |||
| 2527 | (progn | 2427 | (progn |
| 2528 | (end-of-line) | 2428 | (end-of-line) |
| 2529 | (delete-horizontal-space) | 2429 | (delete-horizontal-space) |
| 2530 | 't | 2430 | 't))) |
| 2531 | ) | ||
| 2532 | ) | ||
| 2533 | ) | ||
| 2534 | ;; see if we should line up assignments | 2431 | ;; see if we should line up assignments |
| 2535 | (progn | 2432 | (progn |
| 2536 | (if (or (memq 'all verilog-auto-lineup) | 2433 | (if (or (memq 'all verilog-auto-lineup) |
| 2537 | (memq 'assignments verilog-auto-lineup)) | 2434 | (memq 'assignments verilog-auto-lineup)) |
| 2538 | (verilog-pretty-expr) | 2435 | (verilog-pretty-expr)) |
| 2539 | ) | 2436 | (newline)) |
| 2540 | (newline) | 2437 | (forward-line 1)) |
| 2541 | ) | ||
| 2542 | (forward-line 1) | ||
| 2543 | ) | ||
| 2544 | ;; Indent next line | 2438 | ;; Indent next line |
| 2545 | (if verilog-auto-indent-on-newline | 2439 | (if verilog-auto-indent-on-newline |
| 2546 | (verilog-indent-line)) | 2440 | (verilog-indent-line))) |
| 2547 | ) | ||
| 2548 | (t | 2441 | (t |
| 2549 | (newline)) | 2442 | (newline))))) |
| 2550 | ))) | ||
| 2551 | 2443 | ||
| 2552 | (defun electric-verilog-terminate-and-indent () | 2444 | (defun electric-verilog-terminate-and-indent () |
| 2553 | "Insert a newline and indent for the next statement." | 2445 | "Insert a newline and indent for the next statement." |
| @@ -2565,8 +2457,7 @@ With optional ARG, remove existing end of line comments." | |||
| 2565 | (save-excursion | 2457 | (save-excursion |
| 2566 | (beginning-of-line) | 2458 | (beginning-of-line) |
| 2567 | (verilog-forward-ws&directives) | 2459 | (verilog-forward-ws&directives) |
| 2568 | (verilog-indent-line) | 2460 | (verilog-indent-line)) |
| 2569 | ) | ||
| 2570 | (if (and verilog-auto-newline | 2461 | (if (and verilog-auto-newline |
| 2571 | (not (verilog-parenthesis-depth))) | 2462 | (not (verilog-parenthesis-depth))) |
| 2572 | (electric-verilog-terminate-line)))) | 2463 | (electric-verilog-terminate-line)))) |
| @@ -2648,9 +2539,7 @@ With optional ARG, remove existing end of line comments." | |||
| 2648 | (re-search-forward comment-start-skip oldpnt 'move) | 2539 | (re-search-forward comment-start-skip oldpnt 'move) |
| 2649 | (goto-char (match-beginning 0)) | 2540 | (goto-char (match-beginning 0)) |
| 2650 | (skip-chars-backward " \t") | 2541 | (skip-chars-backward " \t") |
| 2651 | (kill-region (point) oldpnt) | 2542 | (kill-region (point) oldpnt)))))) |
| 2652 | )))) | ||
| 2653 | ) | ||
| 2654 | (progn (insert "\t")))) | 2543 | (progn (insert "\t")))) |
| 2655 | 2544 | ||
| 2656 | 2545 | ||
| @@ -2690,7 +2579,7 @@ To call this from the command line, see \\[verilog-batch-indent]." | |||
| 2690 | (insert " * ")) | 2579 | (insert " * ")) |
| 2691 | 2580 | ||
| 2692 | (defun verilog-insert-1 (fmt max) | 2581 | (defun verilog-insert-1 (fmt max) |
| 2693 | "Insert integers 0 to MAX-1 according to format string FMT. | 2582 | "Use format string FMT to insert integers 0 to MAX - 1. |
| 2694 | Inserts one integer per line, at the current column. Stops early | 2583 | Inserts one integer per line, at the current column. Stops early |
| 2695 | if it reaches the end of the buffer." | 2584 | if it reaches the end of the buffer." |
| 2696 | (let ((col (current-column)) | 2585 | (let ((col (current-column)) |
| @@ -2724,7 +2613,7 @@ located after the first 'a' gives: | |||
| 2724 | a = b a[ 7] = b | 2613 | a = b a[ 7] = b |
| 2725 | a = b a[ 8] = b" | 2614 | a = b a[ 8] = b" |
| 2726 | 2615 | ||
| 2727 | (interactive "NMAX? ") | 2616 | (interactive "NMAX: ") |
| 2728 | (verilog-insert-1 "[%3d]" max)) | 2617 | (verilog-insert-1 "[%3d]" max)) |
| 2729 | 2618 | ||
| 2730 | (defun verilog-generate-numbers (max) | 2619 | (defun verilog-generate-numbers (max) |
| @@ -2744,19 +2633,20 @@ following code fragment: | |||
| 2744 | buf buf buf buf007 | 2633 | buf buf buf buf007 |
| 2745 | buf buf buf buf008" | 2634 | buf buf buf buf008" |
| 2746 | 2635 | ||
| 2747 | (interactive "NMAX? ") | 2636 | (interactive "NMAX: ") |
| 2748 | (verilog-insert-1 "%3.3d" max)) | 2637 | (verilog-insert-1 "%3.3d" max)) |
| 2749 | 2638 | ||
| 2750 | (defun verilog-mark-defun () | 2639 | (defun verilog-mark-defun () |
| 2751 | "Mark the current verilog function (or procedure). | 2640 | "Mark the current verilog function (or procedure). |
| 2752 | This puts the mark at the end, and point at the beginning." | 2641 | This puts the mark at the end, and point at the beginning." |
| 2753 | (interactive) | 2642 | (interactive) |
| 2754 | (push-mark (point)) | 2643 | (when (featurep 'xemacs) |
| 2755 | (verilog-end-of-defun) | 2644 | (push-mark (point)) |
| 2756 | (push-mark (point)) | 2645 | (verilog-end-of-defun) |
| 2757 | (verilog-beg-of-defun) | 2646 | (push-mark (point)) |
| 2758 | (if (fboundp 'zmacs-activate-region) | 2647 | (verilog-beg-of-defun) |
| 2759 | (zmacs-activate-region))) | 2648 | (if (fboundp 'zmacs-activate-region) |
| 2649 | (zmacs-activate-region)))) | ||
| 2760 | 2650 | ||
| 2761 | (defun verilog-comment-region (start end) | 2651 | (defun verilog-comment-region (start end) |
| 2762 | ; checkdoc-params: (start end) | 2652 | ; checkdoc-params: (start end) |
| @@ -2792,8 +2682,7 @@ The commented area starts with `verilog-exclude-str-start', and ends with | |||
| 2792 | (save-excursion | 2682 | (save-excursion |
| 2793 | (let ((s+1 (1+ start))) | 2683 | (let ((s+1 (1+ start))) |
| 2794 | (while (re-search-backward "/\\*" s+1 t) | 2684 | (while (re-search-backward "/\\*" s+1 t) |
| 2795 | (replace-match "/-*" t t)))) | 2685 | (replace-match "/-*" t t)))))) |
| 2796 | )) | ||
| 2797 | 2686 | ||
| 2798 | (defun verilog-uncomment-region () | 2687 | (defun verilog-uncomment-region () |
| 2799 | "Uncomment a commented area; change deformed comments back to normal. | 2688 | "Uncomment a commented area; change deformed comments back to normal. |
| @@ -2869,8 +2758,7 @@ With ARG, first kill any existing labels." | |||
| 2869 | (point-marker))) | 2758 | (point-marker))) |
| 2870 | (e (progn | 2759 | (e (progn |
| 2871 | (verilog-end-of-defun) | 2760 | (verilog-end-of-defun) |
| 2872 | (point-marker))) | 2761 | (point-marker)))) |
| 2873 | ) | ||
| 2874 | (goto-char (marker-position b)) | 2762 | (goto-char (marker-position b)) |
| 2875 | (if (> (- e b) 200) | 2763 | (if (> (- e b) 200) |
| 2876 | (message "Relabeling module...")) | 2764 | (message "Relabeling module...")) |
| @@ -2885,18 +2773,15 @@ With ARG, first kill any existing labels." | |||
| 2885 | (let ((indent-str (verilog-indent-line))) | 2773 | (let ((indent-str (verilog-indent-line))) |
| 2886 | (verilog-set-auto-endcomments indent-str 't) | 2774 | (verilog-set-auto-endcomments indent-str 't) |
| 2887 | (end-of-line) | 2775 | (end-of-line) |
| 2888 | (delete-horizontal-space) | 2776 | (delete-horizontal-space)) |
| 2889 | ) | ||
| 2890 | (setq cnt (1+ cnt)) | 2777 | (setq cnt (1+ cnt)) |
| 2891 | (if (= 9 (% cnt 10)) | 2778 | (if (= 9 (% cnt 10)) |
| 2892 | (message "%d..." cnt)) | 2779 | (message "%d..." cnt))) |
| 2893 | ) | ||
| 2894 | (goto-char oldpos) | 2780 | (goto-char oldpos) |
| 2895 | (if (or | 2781 | (if (or |
| 2896 | (> (- e b) 200) | 2782 | (> (- e b) 200) |
| 2897 | (> cnt 20)) | 2783 | (> cnt 20)) |
| 2898 | (message "%d lines auto commented" cnt)) | 2784 | (message "%d lines auto commented" cnt)))) |
| 2899 | )) | ||
| 2900 | 2785 | ||
| 2901 | (defun verilog-beg-of-statement () | 2786 | (defun verilog-beg-of-statement () |
| 2902 | "Move backward to beginning of statement." | 2787 | "Move backward to beginning of statement." |
| @@ -2919,15 +2804,13 @@ With ARG, first kill any existing labels." | |||
| 2919 | (looking-at verilog-extended-complete-re) | 2804 | (looking-at verilog-extended-complete-re) |
| 2920 | (not (save-excursion | 2805 | (not (save-excursion |
| 2921 | (verilog-backward-token) | 2806 | (verilog-backward-token) |
| 2922 | (looking-at verilog-extended-complete-re))) | 2807 | (looking-at verilog-extended-complete-re)))) |
| 2923 | ) | ||
| 2924 | (looking-at verilog-basic-complete-re) | 2808 | (looking-at verilog-basic-complete-re) |
| 2925 | (save-excursion | 2809 | (save-excursion |
| 2926 | (verilog-backward-token) | 2810 | (verilog-backward-token) |
| 2927 | (or | 2811 | (or |
| 2928 | (looking-at verilog-end-block-re) | 2812 | (looking-at verilog-end-block-re) |
| 2929 | (looking-at verilog-preprocessor-re))) | 2813 | (looking-at verilog-preprocessor-re))))) |
| 2930 | )) | ||
| 2931 | (verilog-backward-syntactic-ws) | 2814 | (verilog-backward-syntactic-ws) |
| 2932 | (verilog-backward-token)) | 2815 | (verilog-backward-token)) |
| 2933 | ;; Now point is where the previous line ended. | 2816 | ;; Now point is where the previous line ended. |
| @@ -3011,9 +2894,9 @@ more specifically, point @ in the line foo : @ begin" | |||
| 3011 | (throw 'found 1)) | 2894 | (throw 'found 1)) |
| 3012 | (setq nest (1- nest))) | 2895 | (setq nest (1- nest))) |
| 3013 | (t | 2896 | (t |
| 3014 | (throw 'found (= nest 0))) | 2897 | (throw 'found (= nest 0))))))) |
| 3015 | )))) | ||
| 3016 | nil))) | 2898 | nil))) |
| 2899 | |||
| 3017 | (defun verilog-in-struct-region-p () | 2900 | (defun verilog-in-struct-region-p () |
| 3018 | "Return TRUE if in a struct region; | 2901 | "Return TRUE if in a struct region; |
| 3019 | more specifically, in a list after a struct|union keyword" | 2902 | more specifically, in a list after a struct|union keyword" |
| @@ -3024,20 +2907,14 @@ more specifically, in a list after a struct|union keyword" | |||
| 3024 | (if depth | 2907 | (if depth |
| 3025 | (progn (backward-up-list depth) | 2908 | (progn (backward-up-list depth) |
| 3026 | (verilog-beg-of-statement) | 2909 | (verilog-beg-of-statement) |
| 3027 | (looking-at "\\<typedef\\>?\\s-*\\<struct\\|union\\>") | 2910 | (looking-at "\\<typedef\\>?\\s-*\\<struct\\|union\\>")))))) |
| 3028 | ) | ||
| 3029 | ) | ||
| 3030 | ) | ||
| 3031 | ) | ||
| 3032 | ) | ||
| 3033 | 2911 | ||
| 3034 | (defun verilog-in-generate-region-p () | 2912 | (defun verilog-in-generate-region-p () |
| 3035 | "Return TRUE if in a generate region; | 2913 | "Return TRUE if in a generate region; |
| 3036 | more specifically, after a generate and before an endgenerate" | 2914 | more specifically, after a generate and before an endgenerate" |
| 3037 | (interactive) | 2915 | (interactive) |
| 3038 | (let ((lim (save-excursion (verilog-beg-of-defun) (point))) | 2916 | (let ((lim (save-excursion (verilog-beg-of-defun) (point))) |
| 3039 | (nest 1) | 2917 | (nest 1)) |
| 3040 | ) | ||
| 3041 | (save-excursion | 2918 | (save-excursion |
| 3042 | (while (and | 2919 | (while (and |
| 3043 | (/= nest 0) | 2920 | (/= nest 0) |
| @@ -3046,17 +2923,14 @@ more specifically, after a generate and before an endgenerate" | |||
| 3046 | ((match-end 1) ; generate | 2923 | ((match-end 1) ; generate |
| 3047 | (setq nest (1- nest))) | 2924 | (setq nest (1- nest))) |
| 3048 | ((match-end 2) ; endgenerate | 2925 | ((match-end 2) ; endgenerate |
| 3049 | (setq nest (1+ nest))) | 2926 | (setq nest (1+ nest))))))) |
| 3050 | )) | ||
| 3051 | )) | ||
| 3052 | (= nest 0) )) ; return nest | 2927 | (= nest 0) )) ; return nest |
| 3053 | 2928 | ||
| 3054 | (defun verilog-in-fork-region-p () | 2929 | (defun verilog-in-fork-region-p () |
| 3055 | "Return true if between a fork and join." | 2930 | "Return true if between a fork and join." |
| 3056 | (interactive) | 2931 | (interactive) |
| 3057 | (let ((lim (save-excursion (verilog-beg-of-defun) (point))) | 2932 | (let ((lim (save-excursion (verilog-beg-of-defun) (point))) |
| 3058 | (nest 1) | 2933 | (nest 1)) |
| 3059 | ) | ||
| 3060 | (save-excursion | 2934 | (save-excursion |
| 3061 | (while (and | 2935 | (while (and |
| 3062 | (/= nest 0) | 2936 | (/= nest 0) |
| @@ -3065,9 +2939,7 @@ more specifically, after a generate and before an endgenerate" | |||
| 3065 | ((match-end 1) ; fork | 2939 | ((match-end 1) ; fork |
| 3066 | (setq nest (1- nest))) | 2940 | (setq nest (1- nest))) |
| 3067 | ((match-end 2) ; join | 2941 | ((match-end 2) ; join |
| 3068 | (setq nest (1+ nest))) | 2942 | (setq nest (1+ nest))))))) |
| 3069 | )) | ||
| 3070 | )) | ||
| 3071 | (= nest 0) )) ; return nest | 2943 | (= nest 0) )) ; return nest |
| 3072 | 2944 | ||
| 3073 | (defun verilog-backward-case-item (lim) | 2945 | (defun verilog-backward-case-item (lim) |
| @@ -3099,8 +2971,7 @@ Limit search to point LIM." | |||
| 3099 | (setq colon (1- colon))) | 2971 | (setq colon (1- colon))) |
| 3100 | 2972 | ||
| 3101 | ((match-end 3) ;; : | 2973 | ((match-end 3) ;; : |
| 3102 | (setq colon (1+ colon))) | 2974 | (setq colon (1+ colon))))) |
| 3103 | )) | ||
| 3104 | ;; Skip back to beginning of case item | 2975 | ;; Skip back to beginning of case item |
| 3105 | (skip-chars-backward "\t ") | 2976 | (skip-chars-backward "\t ") |
| 3106 | (verilog-skip-backward-comment-or-string) | 2977 | (verilog-skip-backward-comment-or-string) |
| @@ -3123,10 +2994,8 @@ Limit search to point LIM." | |||
| 3123 | (t | 2994 | (t |
| 3124 | (goto-char (match-end 0)) | 2995 | (goto-char (match-end 0)) |
| 3125 | (verilog-forward-ws&directives) | 2996 | (verilog-forward-ws&directives) |
| 3126 | (point)) | 2997 | (point)))) |
| 3127 | )) | 2998 | (error "Malformed case item")))) |
| 3128 | (error "Malformed case item") | ||
| 3129 | ))) | ||
| 3130 | (setq str (buffer-substring b e)) | 2999 | (setq str (buffer-substring b e)) |
| 3131 | (if | 3000 | (if |
| 3132 | (setq e | 3001 | (setq e |
| @@ -3178,8 +3047,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter | |||
| 3178 | (search-backward "//" (verilog-get-beg-of-line) t))))) | 3047 | (search-backward "//" (verilog-get-beg-of-line) t))))) |
| 3179 | (let ((nest 1) b e | 3048 | (let ((nest 1) b e |
| 3180 | m | 3049 | m |
| 3181 | (else (if (match-end 2) "!" " ")) | 3050 | (else (if (match-end 2) "!" " "))) |
| 3182 | ) | ||
| 3183 | (end-of-line) | 3051 | (end-of-line) |
| 3184 | (if kill-existing-comment | 3052 | (if kill-existing-comment |
| 3185 | (verilog-kill-existing-comment)) | 3053 | (verilog-kill-existing-comment)) |
| @@ -3199,8 +3067,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter | |||
| 3199 | ((match-end 4) ; `ifdef | 3067 | ((match-end 4) ; `ifdef |
| 3200 | (setq nest (1- nest))) | 3068 | (setq nest (1- nest))) |
| 3201 | ((match-end 5) ; `ifndef | 3069 | ((match-end 5) ; `ifndef |
| 3202 | (setq nest (1- nest))) | 3070 | (setq nest (1- nest))))) |
| 3203 | )) | ||
| 3204 | (if (match-end 0) | 3071 | (if (match-end 0) |
| 3205 | (setq | 3072 | (setq |
| 3206 | m (buffer-substring | 3073 | m (buffer-substring |
| @@ -3212,15 +3079,13 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter | |||
| 3212 | (point)) | 3079 | (point)) |
| 3213 | e (progn | 3080 | e (progn |
| 3214 | (skip-chars-forward "a-zA-Z0-9_") | 3081 | (skip-chars-forward "a-zA-Z0-9_") |
| 3215 | (point) | 3082 | (point))))) |
| 3216 | )))) | ||
| 3217 | (if b | 3083 | (if b |
| 3218 | (if (> (count-lines (point) b) verilog-minimum-comment-distance) | 3084 | (if (> (count-lines (point) b) verilog-minimum-comment-distance) |
| 3219 | (insert (concat " // " else m " " (buffer-substring b e)))) | 3085 | (insert (concat " // " else m " " (buffer-substring b e)))) |
| 3220 | (progn | 3086 | (progn |
| 3221 | (insert " // unmatched `else or `endif") | 3087 | (insert " // unmatched `else or `endif") |
| 3222 | (ding 't)) | 3088 | (ding 't))))) |
| 3223 | ))) | ||
| 3224 | 3089 | ||
| 3225 | (; Comment close case/class/function/task/module and named block | 3090 | (; Comment close case/class/function/task/module and named block |
| 3226 | (and (looking-at "\\<end") | 3091 | (and (looking-at "\\<end") |
| @@ -3269,8 +3134,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter | |||
| 3269 | (err 't) | 3134 | (err 't) |
| 3270 | (here (point)) | 3135 | (here (point)) |
| 3271 | there | 3136 | there |
| 3272 | cntx | 3137 | cntx) |
| 3273 | ) | ||
| 3274 | (save-excursion | 3138 | (save-excursion |
| 3275 | (verilog-leap-to-head) | 3139 | (verilog-leap-to-head) |
| 3276 | (setq there (point)) | 3140 | (setq there (point)) |
| @@ -3282,12 +3146,10 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter | |||
| 3282 | (verilog-kill-existing-comment)) | 3146 | (verilog-kill-existing-comment)) |
| 3283 | (delete-horizontal-space) | 3147 | (delete-horizontal-space) |
| 3284 | (insert str) | 3148 | (insert str) |
| 3285 | (ding 't) | 3149 | (ding 't)) |
| 3286 | ) | ||
| 3287 | (let ((lim | 3150 | (let ((lim |
| 3288 | (save-excursion (verilog-beg-of-defun) (point))) | 3151 | (save-excursion (verilog-beg-of-defun) (point))) |
| 3289 | (here (point)) | 3152 | (here (point))) |
| 3290 | ) | ||
| 3291 | (cond | 3153 | (cond |
| 3292 | (;-- handle named block differently | 3154 | (;-- handle named block differently |
| 3293 | (looking-at verilog-named-block-re) | 3155 | (looking-at verilog-named-block-re) |
| @@ -3336,8 +3198,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter | |||
| 3336 | (;- else | 3198 | (;- else |
| 3337 | (match-end 4) | 3199 | (match-end 4) |
| 3338 | (let ((nest 0) | 3200 | (let ((nest 0) |
| 3339 | ( reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)") | 3201 | ( reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)")) |
| 3340 | ) | ||
| 3341 | (catch 'skip | 3202 | (catch 'skip |
| 3342 | (while (verilog-re-search-backward reg nil 'move) | 3203 | (while (verilog-re-search-backward reg nil 'move) |
| 3343 | (cond | 3204 | (cond |
| @@ -3353,16 +3214,13 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter | |||
| 3353 | (setq err nil) | 3214 | (setq err nil) |
| 3354 | (setq str (verilog-get-expr)) | 3215 | (setq str (verilog-get-expr)) |
| 3355 | (setq str (concat " // else: !if" str )) | 3216 | (setq str (concat " // else: !if" str )) |
| 3356 | (throw 'skip 1)) | 3217 | (throw 'skip 1))))))))) |
| 3357 | ))) | ||
| 3358 | )))) | ||
| 3359 | 3218 | ||
| 3360 | (;- end else | 3219 | (;- end else |
| 3361 | (match-end 5) | 3220 | (match-end 5) |
| 3362 | (goto-char there) | 3221 | (goto-char there) |
| 3363 | (let ((nest 0) | 3222 | (let ((nest 0) |
| 3364 | ( reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)") | 3223 | (reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)")) |
| 3365 | ) | ||
| 3366 | (catch 'skip | 3224 | (catch 'skip |
| 3367 | (while (verilog-re-search-backward reg nil 'move) | 3225 | (while (verilog-re-search-backward reg nil 'move) |
| 3368 | (cond | 3226 | (cond |
| @@ -3378,9 +3236,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter | |||
| 3378 | (setq err nil) | 3236 | (setq err nil) |
| 3379 | (setq str (verilog-get-expr)) | 3237 | (setq str (verilog-get-expr)) |
| 3380 | (setq str (concat " // else: !if" str )) | 3238 | (setq str (concat " // else: !if" str )) |
| 3381 | (throw 'skip 1)) | 3239 | (throw 'skip 1))))))))) |
| 3382 | ))) | ||
| 3383 | )))) | ||
| 3384 | 3240 | ||
| 3385 | (;- task/function/initial et cetera | 3241 | (;- task/function/initial et cetera |
| 3386 | t | 3242 | t |
| @@ -3392,8 +3248,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter | |||
| 3392 | (setq str (concat " // " cntx str ))) | 3248 | (setq str (concat " // " cntx str ))) |
| 3393 | 3249 | ||
| 3394 | (;-- otherwise... | 3250 | (;-- otherwise... |
| 3395 | (setq str " // auto-endcomment confused ")) | 3251 | (setq str " // auto-endcomment confused ")))) |
| 3396 | )) | ||
| 3397 | 3252 | ||
| 3398 | ((and | 3253 | ((and |
| 3399 | (verilog-in-case-region-p) ;-- handle case item differently | 3254 | (verilog-in-case-region-p) ;-- handle case item differently |
| @@ -3431,9 +3286,8 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter | |||
| 3431 | (match-end 11) ;; of verilog-end-block-ordered-re | 3286 | (match-end 11) ;; of verilog-end-block-ordered-re |
| 3432 | ;;(goto-char there) | 3287 | ;;(goto-char there) |
| 3433 | (let ((nest 0) | 3288 | (let ((nest 0) |
| 3434 | ( reg "\\<\\(class\\)\\|\\(endclass\\)\\|\\(package\\|primitive\\|\\(macro\\)?module\\)\\>") | 3289 | (reg "\\<\\(class\\)\\|\\(endclass\\)\\|\\(package\\|primitive\\|\\(macro\\)?module\\)\\>") |
| 3435 | string | 3290 | string) |
| 3436 | ) | ||
| 3437 | (save-excursion | 3291 | (save-excursion |
| 3438 | (catch 'skip | 3292 | (catch 'skip |
| 3439 | (while (verilog-re-search-backward reg nil 'move) | 3293 | (while (verilog-re-search-backward reg nil 'move) |
| @@ -3463,8 +3317,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter | |||
| 3463 | (throw 'skip 1)))) | 3317 | (throw 'skip 1)))) |
| 3464 | )))) | 3318 | )))) |
| 3465 | (end-of-line) | 3319 | (end-of-line) |
| 3466 | (insert (concat " // " string ))) | 3320 | (insert (concat " // " string )))) |
| 3467 | ) | ||
| 3468 | 3321 | ||
| 3469 | (;- this is end{function,generate,task,module,primitive,table,generate} | 3322 | (;- this is end{function,generate,task,module,primitive,table,generate} |
| 3470 | ;- which can not be nested. | 3323 | ;- which can not be nested. |
| @@ -3479,8 +3332,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter | |||
| 3479 | (cond | 3332 | (cond |
| 3480 | ((match-end 5) ;; of verilog-end-block-ordered-re | 3333 | ((match-end 5) ;; of verilog-end-block-ordered-re |
| 3481 | (setq reg "\\(\\<function\\>\\)\\|\\(\\<\\(endfunction\\|task\\|\\(macro\\)?module\\|primitive\\)\\>\\)") | 3334 | (setq reg "\\(\\<function\\>\\)\\|\\(\\<\\(endfunction\\|task\\|\\(macro\\)?module\\|primitive\\)\\>\\)") |
| 3482 | (setq width "\\(\\s-*\\(\\[[^]]*\\]\\)\\|\\(real\\(time\\)?\\)\\|\\(integer\\)\\|\\(time\\)\\)?") | 3335 | (setq width "\\(\\s-*\\(\\[[^]]*\\]\\)\\|\\(real\\(time\\)?\\)\\|\\(integer\\)\\|\\(time\\)\\)?")) |
| 3483 | ) | ||
| 3484 | ((match-end 6) ;; of verilog-end-block-ordered-re | 3336 | ((match-end 6) ;; of verilog-end-block-ordered-re |
| 3485 | (setq reg "\\(\\<task\\>\\)\\|\\(\\<\\(endtask\\|function\\|\\(macro\\)?module\\|primitive\\)\\>\\)")) | 3337 | (setq reg "\\(\\<task\\>\\)\\|\\(\\<\\(endtask\\|function\\|\\(macro\\)?module\\|primitive\\)\\>\\)")) |
| 3486 | ((match-end 7) ;; of verilog-end-block-ordered-re | 3338 | ((match-end 7) ;; of verilog-end-block-ordered-re |
| @@ -3502,8 +3354,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter | |||
| 3502 | ((match-end 15) ;; of verilog-end-block-ordered-re | 3354 | ((match-end 15) ;; of verilog-end-block-ordered-re |
| 3503 | (setq reg "\\(\\<clocking\\>\\)\\|\\<endclocking\\>")) | 3355 | (setq reg "\\(\\<clocking\\>\\)\\|\\<endclocking\\>")) |
| 3504 | 3356 | ||
| 3505 | (t (error "Problem in verilog-set-auto-endcomments")) | 3357 | (t (error "Problem in verilog-set-auto-endcomments"))) |
| 3506 | ) | ||
| 3507 | (let (b e) | 3358 | (let (b e) |
| 3508 | (save-excursion | 3359 | (save-excursion |
| 3509 | (verilog-re-search-backward reg nil 'move) | 3360 | (verilog-re-search-backward reg nil 'move) |
| @@ -3515,8 +3366,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter | |||
| 3515 | (if (and width (looking-at width)) | 3366 | (if (and width (looking-at width)) |
| 3516 | (progn | 3367 | (progn |
| 3517 | (goto-char (match-end 0)) | 3368 | (goto-char (match-end 0)) |
| 3518 | (verilog-forward-ws&directives) | 3369 | (verilog-forward-ws&directives))) |
| 3519 | )) | ||
| 3520 | (point)) | 3370 | (point)) |
| 3521 | e (progn | 3371 | e (progn |
| 3522 | (skip-chars-forward "a-zA-Z0-9_") | 3372 | (skip-chars-forward "a-zA-Z0-9_") |
| @@ -3577,8 +3427,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter | |||
| 3577 | b) | 3427 | b) |
| 3578 | ('t | 3428 | ('t |
| 3579 | (skip-chars-forward "^: \t\n\f") | 3429 | (skip-chars-forward "^: \t\n\f") |
| 3580 | (point) | 3430 | (point))))) |
| 3581 | )))) | ||
| 3582 | (str (buffer-substring b e))) | 3431 | (str (buffer-substring b e))) |
| 3583 | (if (setq e (string-match "[ \t]*\\(\\(\n\\)\\|\\(//\\)\\|\\(/\\*\\)\\)" str)) | 3432 | (if (setq e (string-match "[ \t]*\\(\\(\n\\)\\|\\(//\\)\\|\\(/\\*\\)\\)" str)) |
| 3584 | (setq str (concat (substring str 0 e) "..."))) | 3433 | (setq str (concat (substring str 0 e) "..."))) |
| @@ -3601,8 +3450,8 @@ Useful for creating tri's and other expanded fields." | |||
| 3601 | (concat "\\(.*\\)" | 3450 | (concat "\\(.*\\)" |
| 3602 | (regexp-quote bra) | 3451 | (regexp-quote bra) |
| 3603 | "\\([0-9]*\\)\\(:[0-9]*\\|\\)\\(::[0-9---]*\\|\\)" | 3452 | "\\([0-9]*\\)\\(:[0-9]*\\|\\)\\(::[0-9---]*\\|\\)" |
| 3604 | (regexp-quote ket) | 3453 | (regexp-quote ket) |
| 3605 | "\\(.*\\)$") signal-string) | 3454 | "\\(.*\\)$") signal-string) |
| 3606 | (let* ((sig-head (match-string 1 signal-string)) | 3455 | (let* ((sig-head (match-string 1 signal-string)) |
| 3607 | (vec-start (string-to-number (match-string 2 signal-string))) | 3456 | (vec-start (string-to-number (match-string 2 signal-string))) |
| 3608 | (vec-end (if (= (match-beginning 3) (match-end 3)) | 3457 | (vec-end (if (= (match-beginning 3) (match-end 3)) |
| @@ -3765,8 +3614,7 @@ becomes: | |||
| 3765 | ))) | 3614 | ))) |
| 3766 | ((verilog-in-star-comment-p) | 3615 | ((verilog-in-star-comment-p) |
| 3767 | (re-search-backward "/\*") | 3616 | (re-search-backward "/\*") |
| 3768 | (insert (format " // surefire lint_off_line %6s" code )) | 3617 | (insert (format " // surefire lint_off_line %6s" code ))) |
| 3769 | ) | ||
| 3770 | (t | 3618 | (t |
| 3771 | (insert (format " // surefire lint_off_line %6s" code )) | 3619 | (insert (format " // surefire lint_off_line %6s" code )) |
| 3772 | ))))))))) | 3620 | ))))))))) |
| @@ -3823,11 +3671,11 @@ This lets programs calling batch mode to easily extract error messages." | |||
| 3823 | (setq default-major-mode `verilog-mode) | 3671 | (setq default-major-mode `verilog-mode) |
| 3824 | ;; Ditto files already read in | 3672 | ;; Ditto files already read in |
| 3825 | (mapc (lambda (buf) | 3673 | (mapc (lambda (buf) |
| 3826 | (when (buffer-file-name buf) | 3674 | (when (buffer-file-name buf) |
| 3827 | (save-excursion | 3675 | (save-excursion |
| 3828 | (set-buffer buf) | 3676 | (set-buffer buf) |
| 3829 | (verilog-mode)))) | 3677 | (verilog-mode)))) |
| 3830 | (buffer-list)) | 3678 | (buffer-list)) |
| 3831 | ;; Process the files | 3679 | ;; Process the files |
| 3832 | (mapcar '(lambda (buf) | 3680 | (mapcar '(lambda (buf) |
| 3833 | (when (buffer-file-name buf) | 3681 | (when (buffer-file-name buf) |
| @@ -3943,8 +3791,7 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." | |||
| 3943 | (not (verilog-in-coverage)) | 3791 | (not (verilog-in-coverage)) |
| 3944 | (verilog-in-paren)) | 3792 | (verilog-in-paren)) |
| 3945 | (progn (setq par 1) | 3793 | (progn (setq par 1) |
| 3946 | (throw 'nesting 'block)) | 3794 | (throw 'nesting 'block))) |
| 3947 | ) | ||
| 3948 | 3795 | ||
| 3949 | ;; See if we are continuing a previous line | 3796 | ;; See if we are continuing a previous line |
| 3950 | (while t | 3797 | (while t |
| @@ -4026,8 +3873,7 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." | |||
| 4026 | (setq reg "\\(\\<class\\>\\)\\|\\(\\<endclass\\>\\)" )) | 3873 | (setq reg "\\(\\<class\\>\\)\\|\\(\\<endclass\\>\\)" )) |
| 4027 | ((match-end 12) ; covergroup | 3874 | ((match-end 12) ; covergroup |
| 4028 | ;; Search back for matching covergroup | 3875 | ;; Search back for matching covergroup |
| 4029 | (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<endgroup\\>\\)" )) | 3876 | (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<endgroup\\>\\)" ))) |
| 4030 | ) | ||
| 4031 | (catch 'skip | 3877 | (catch 'skip |
| 4032 | (while (verilog-re-search-backward reg nil 'move) | 3878 | (while (verilog-re-search-backward reg nil 'move) |
| 4033 | (cond | 3879 | (cond |
| @@ -4037,11 +3883,8 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." | |||
| 4037 | (throw 'skip 1))) | 3883 | (throw 'skip 1))) |
| 4038 | ((match-end 2) ; end | 3884 | ((match-end 2) ; end |
| 4039 | (setq nest (1+ nest))))) | 3885 | (setq nest (1+ nest))))) |
| 4040 | ) | 3886 | ))))))) |
| 4041 | )) | 3887 | (throw 'nesting (verilog-calc-1))) |
| 4042 | )))) | ||
| 4043 | (throw 'nesting (verilog-calc-1)) | ||
| 4044 | ) | ||
| 4045 | );; catch nesting | 3888 | );; catch nesting |
| 4046 | );; type | 3889 | );; type |
| 4047 | ) | 3890 | ) |
| @@ -4058,8 +3901,8 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." | |||
| 4058 | ((eq type 'defun) | 3901 | ((eq type 'defun) |
| 4059 | (list type 0)) | 3902 | (list type 0)) |
| 4060 | (t | 3903 | (t |
| 4061 | (list type (verilog-current-indent-level))))) | 3904 | (list type (verilog-current-indent-level)))))))) |
| 4062 | ))) | 3905 | |
| 4063 | (defun verilog-wai () | 3906 | (defun verilog-wai () |
| 4064 | "Show matching nesting block for debugging." | 3907 | "Show matching nesting block for debugging." |
| 4065 | (interactive) | 3908 | (interactive) |
| @@ -4073,8 +3916,7 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." | |||
| 4073 | (cond | 3916 | (cond |
| 4074 | ((equal (char-after) ?\{) | 3917 | ((equal (char-after) ?\{) |
| 4075 | (if (verilog-at-constraint-p) | 3918 | (if (verilog-at-constraint-p) |
| 4076 | (throw 'nesting 'block) | 3919 | (throw 'nesting 'block))) |
| 4077 | )) | ||
| 4078 | ((equal (char-after) ?\}) | 3920 | ((equal (char-after) ?\}) |
| 4079 | 3921 | ||
| 4080 | (let ((there (verilog-at-close-constraint-p))) | 3922 | (let ((there (verilog-at-close-constraint-p))) |
| @@ -4133,8 +3975,7 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." | |||
| 4133 | For speed, the searcher looks at the last directive, not the indent | 3975 | For speed, the searcher looks at the last directive, not the indent |
| 4134 | of the appropriate enclosing block." | 3976 | of the appropriate enclosing block." |
| 4135 | (let ((base -1) ;; Indent of the line that determines our indentation | 3977 | (let ((base -1) ;; Indent of the line that determines our indentation |
| 4136 | (ind 0) ;; Relative offset caused by other directives (like `endif on same line as `else) | 3978 | (ind 0)) ;; Relative offset caused by other directives (like `endif on same line as `else) |
| 4137 | ) | ||
| 4138 | ;; Start at current location, scan back for another directive | 3979 | ;; Start at current location, scan back for another directive |
| 4139 | 3980 | ||
| 4140 | (save-excursion | 3981 | (save-excursion |
| @@ -4142,8 +3983,7 @@ of the appropriate enclosing block." | |||
| 4142 | (while (and (< base 0) | 3983 | (while (and (< base 0) |
| 4143 | (verilog-re-search-backward verilog-directive-re nil t)) | 3984 | (verilog-re-search-backward verilog-directive-re nil t)) |
| 4144 | (cond ((save-excursion (skip-chars-backward " \t") (bolp)) | 3985 | (cond ((save-excursion (skip-chars-backward " \t") (bolp)) |
| 4145 | (setq base (current-indentation)) | 3986 | (setq base (current-indentation)))) |
| 4146 | )) | ||
| 4147 | (cond ((and (looking-at verilog-directive-end) (< base 0)) ;; Only matters when not at BOL | 3987 | (cond ((and (looking-at verilog-directive-end) (< base 0)) ;; Only matters when not at BOL |
| 4148 | (setq ind (- ind verilog-indent-level-directive))) | 3988 | (setq ind (- ind verilog-indent-level-directive))) |
| 4149 | ((and (looking-at verilog-directive-middle) (>= base 0)) ;; Only matters when at BOL | 3989 | ((and (looking-at verilog-directive-middle) (>= base 0)) ;; Only matters when at BOL |
| @@ -4223,8 +4063,7 @@ from endcase to matching case, and so on." | |||
| 4223 | (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)" )) | 4063 | (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)" )) |
| 4224 | ((looking-at "\\<endclocking\\>") | 4064 | ((looking-at "\\<endclocking\\>") |
| 4225 | ;; 12: Search back for matching clocking | 4065 | ;; 12: Search back for matching clocking |
| 4226 | (setq reg "\\(\\<clocking\\)\\|\\(\\<endclocking\\>\\)" )) | 4066 | (setq reg "\\(\\<clocking\\)\\|\\(\\<endclocking\\>\\)" ))) |
| 4227 | ) | ||
| 4228 | (if reg | 4067 | (if reg |
| 4229 | (catch 'skip | 4068 | (catch 'skip |
| 4230 | (let (sreg) | 4069 | (let (sreg) |
| @@ -4268,9 +4107,7 @@ Set point to where line starts" | |||
| 4268 | (save-excursion | 4107 | (save-excursion |
| 4269 | (skip-chars-backward " \t") | 4108 | (skip-chars-backward " \t") |
| 4270 | (not (bolp)))) | 4109 | (not (bolp)))) |
| 4271 | (setq continued (verilog-backward-token)) | 4110 | (setq continued (verilog-backward-token))))) |
| 4272 | ) ;; while | ||
| 4273 | )) | ||
| 4274 | (setq continued nil)) | 4111 | (setq continued nil)) |
| 4275 | continued)) | 4112 | continued)) |
| 4276 | 4113 | ||
| @@ -4289,15 +4126,13 @@ Set point to where line starts" | |||
| 4289 | (= (preceding-char) ?\}) | 4126 | (= (preceding-char) ?\}) |
| 4290 | (progn | 4127 | (progn |
| 4291 | (backward-char) | 4128 | (backward-char) |
| 4292 | (verilog-at-close-constraint-p)) | 4129 | (verilog-at-close-constraint-p))) |
| 4293 | ) | ||
| 4294 | (;-- constraint foo { a = b } | 4130 | (;-- constraint foo { a = b } |
| 4295 | ; is a complete statement. *sigh* | 4131 | ; is a complete statement. *sigh* |
| 4296 | (= (preceding-char) ?\{) | 4132 | (= (preceding-char) ?\{) |
| 4297 | (progn | 4133 | (progn |
| 4298 | (backward-char) | 4134 | (backward-char) |
| 4299 | (not (verilog-at-constraint-p))) | 4135 | (not (verilog-at-constraint-p)))) |
| 4300 | ) | ||
| 4301 | (;-- Could be 'case (foo)' or 'always @(bar)' which is complete | 4136 | (;-- Could be 'case (foo)' or 'always @(bar)' which is complete |
| 4302 | ; also could be simply '@(foo)' | 4137 | ; also could be simply '@(foo)' |
| 4303 | ; or foo u1 #(a=8) | 4138 | ; or foo u1 #(a=8) |
| @@ -4322,10 +4157,8 @@ Set point to where line starts" | |||
| 4322 | (verilog-backward-token) | 4157 | (verilog-backward-token) |
| 4323 | (not (looking-at "\\<\\(always\\(_latch\\|_ff\\|_comb\\)?\\|initial\\|while\\)\\>")))) | 4158 | (not (looking-at "\\<\\(always\\(_latch\\|_ff\\|_comb\\)?\\|initial\\|while\\)\\>")))) |
| 4324 | ((= (preceding-char) ?\#) | 4159 | ((= (preceding-char) ?\#) |
| 4325 | (backward-char) | 4160 | (backward-char)) |
| 4326 | ) | 4161 | (t t))))))) |
| 4327 | (t t)) | ||
| 4328 | ))))) | ||
| 4329 | 4162 | ||
| 4330 | (;-- any of begin|initial|while are complete statements; 'begin : foo' is also complete | 4163 | (;-- any of begin|initial|while are complete statements; 'begin : foo' is also complete |
| 4331 | t | 4164 | t |
| @@ -4346,8 +4179,7 @@ Set point to where line starts" | |||
| 4346 | (backward-sexp) | 4179 | (backward-sexp) |
| 4347 | (if (looking-at verilog-nameable-item-re ) | 4180 | (if (looking-at verilog-nameable-item-re ) |
| 4348 | nil | 4181 | nil |
| 4349 | t) | 4182 | t)) |
| 4350 | ) | ||
| 4351 | ((= (preceding-char) ?\#) | 4183 | ((= (preceding-char) ?\#) |
| 4352 | (backward-char) | 4184 | (backward-char) |
| 4353 | t) | 4185 | t) |
| @@ -4357,8 +4189,7 @@ Set point to where line starts" | |||
| 4357 | 4189 | ||
| 4358 | (t | 4190 | (t |
| 4359 | (goto-char back) | 4191 | (goto-char back) |
| 4360 | t) | 4192 | t)))))))) |
| 4361 | ))))))) | ||
| 4362 | 4193 | ||
| 4363 | (defun verilog-backward-syntactic-ws (&optional bound) | 4194 | (defun verilog-backward-syntactic-ws (&optional bound) |
| 4364 | "Backward skip over syntactic whitespace for Emacs 19. | 4195 | "Backward skip over syntactic whitespace for Emacs 19. |
| @@ -4370,9 +4201,7 @@ Optional BOUND limits search." | |||
| 4370 | (narrow-to-region bound (point)) | 4201 | (narrow-to-region bound (point)) |
| 4371 | (while (/= here (point)) | 4202 | (while (/= here (point)) |
| 4372 | (setq here (point)) | 4203 | (setq here (point)) |
| 4373 | (verilog-skip-backward-comments) | 4204 | (verilog-skip-backward-comments)))))) |
| 4374 | ))) | ||
| 4375 | )) | ||
| 4376 | t) | 4205 | t) |
| 4377 | 4206 | ||
| 4378 | (defun verilog-forward-syntactic-ws (&optional bound) | 4207 | (defun verilog-forward-syntactic-ws (&optional bound) |
| @@ -4380,16 +4209,13 @@ Optional BOUND limits search." | |||
| 4380 | Optional BOUND limits search." | 4209 | Optional BOUND limits search." |
| 4381 | (save-restriction | 4210 | (save-restriction |
| 4382 | (let* ((bound (or bound (point-max))) | 4211 | (let* ((bound (or bound (point-max))) |
| 4383 | (here bound) | 4212 | (here bound)) |
| 4384 | ) | ||
| 4385 | (if (> bound (point)) | 4213 | (if (> bound (point)) |
| 4386 | (progn | 4214 | (progn |
| 4387 | (narrow-to-region (point) bound) | 4215 | (narrow-to-region (point) bound) |
| 4388 | (while (/= here (point)) | 4216 | (while (/= here (point)) |
| 4389 | (setq here (point)) | 4217 | (setq here (point)) |
| 4390 | (forward-comment (buffer-size)) | 4218 | (forward-comment (buffer-size)))))))) |
| 4391 | ))) | ||
| 4392 | ))) | ||
| 4393 | 4219 | ||
| 4394 | (defun verilog-backward-ws&directives (&optional bound) | 4220 | (defun verilog-backward-ws&directives (&optional bound) |
| 4395 | "Backward skip over syntactic whitespace and compiler directives for Emacs 19. | 4221 | "Backward skip over syntactic whitespace and compiler directives for Emacs 19. |
| @@ -4423,9 +4249,7 @@ Optional BOUND limits search." | |||
| 4423 | (point)) | 4249 | (point)) |
| 4424 | (t | 4250 | (t |
| 4425 | nil)))) | 4251 | nil)))) |
| 4426 | (if p (goto-char p)) | 4252 | (if p (goto-char p)))))))) |
| 4427 | ))) | ||
| 4428 | ))) | ||
| 4429 | 4253 | ||
| 4430 | (defun verilog-forward-ws&directives (&optional bound) | 4254 | (defun verilog-forward-ws&directives (&optional bound) |
| 4431 | "Forward skip over syntactic whitespace and compiler directives for Emacs 19. | 4255 | "Forward skip over syntactic whitespace and compiler directives for Emacs 19. |
| @@ -4433,8 +4257,7 @@ Optional BOUND limits search." | |||
| 4433 | (save-restriction | 4257 | (save-restriction |
| 4434 | (let* ((bound (or bound (point-max))) | 4258 | (let* ((bound (or bound (point-max))) |
| 4435 | (here bound) | 4259 | (here bound) |
| 4436 | jump | 4260 | jump) |
| 4437 | ) | ||
| 4438 | (if (> bound (point)) | 4261 | (if (> bound (point)) |
| 4439 | (progn | 4262 | (progn |
| 4440 | (let ((state | 4263 | (let ((state |
| @@ -4455,9 +4278,7 @@ Optional BOUND limits search." | |||
| 4455 | (if (looking-at verilog-directive-re-1) | 4278 | (if (looking-at verilog-directive-re-1) |
| 4456 | (setq jump t))) | 4279 | (setq jump t))) |
| 4457 | (if jump | 4280 | (if jump |
| 4458 | (beginning-of-line 2)) | 4281 | (beginning-of-line 2)))))))) |
| 4459 | ))) | ||
| 4460 | ))) | ||
| 4461 | 4282 | ||
| 4462 | (defun verilog-in-comment-p () | 4283 | (defun verilog-in-comment-p () |
| 4463 | "Return true if in a star or // comment." | 4284 | "Return true if in a star or // comment." |
| @@ -4537,14 +4358,11 @@ Optional BOUND limits search." | |||
| 4537 | (forward-list) | 4358 | (forward-list) |
| 4538 | (progn (backward-char 1) | 4359 | (progn (backward-char 1) |
| 4539 | (verilog-backward-ws&directives) | 4360 | (verilog-backward-ws&directives) |
| 4540 | (equal (char-before) ?\;)) | 4361 | (equal (char-before) ?\;)))) |
| 4541 | )) | ||
| 4542 | ;; maybe | 4362 | ;; maybe |
| 4543 | (verilog-re-search-backward "\\<constraint\\|coverpoint\\|cross\\>" nil 'move) | 4363 | (verilog-re-search-backward "\\<constraint\\|coverpoint\\|cross\\>" nil 'move) |
| 4544 | ;; not | 4364 | ;; not |
| 4545 | nil | 4365 | nil)) |
| 4546 | ) | ||
| 4547 | ) | ||
| 4548 | 4366 | ||
| 4549 | (defun verilog-parenthesis-depth () | 4367 | (defun verilog-parenthesis-depth () |
| 4550 | "Return non zero if in parenthetical-expression." | 4368 | "Return non zero if in parenthetical-expression." |
| @@ -4608,8 +4426,7 @@ Optional BOUND limits search." | |||
| 4608 | t) | 4426 | t) |
| 4609 | ((and (not (bobp)) | 4427 | ((and (not (bobp)) |
| 4610 | (= (char-before) ?\/) | 4428 | (= (char-before) ?\/) |
| 4611 | (= (char-before (1- (point))) ?\*) | 4429 | (= (char-before (1- (point))) ?\*)) |
| 4612 | ) | ||
| 4613 | (goto-char (- (point) 2)) | 4430 | (goto-char (- (point) 2)) |
| 4614 | t) | 4431 | t) |
| 4615 | (t | 4432 | (t |
| @@ -4650,8 +4467,8 @@ Only look at a few lines to determine indent level." | |||
| 4650 | (if (verilog-continued-line) | 4467 | (if (verilog-continued-line) |
| 4651 | (progn | 4468 | (progn |
| 4652 | (goto-char sp) | 4469 | (goto-char sp) |
| 4653 | (setq | 4470 | (setq indent-str |
| 4654 | indent-str (list 'statement (verilog-current-indent-level)))) | 4471 | (list 'statement (verilog-current-indent-level)))) |
| 4655 | (goto-char sp1) | 4472 | (goto-char sp1) |
| 4656 | (setq indent-str (list 'block (verilog-current-indent-level))))) | 4473 | (setq indent-str (list 'block (verilog-current-indent-level))))) |
| 4657 | (goto-char sp)) | 4474 | (goto-char sp)) |
| @@ -4701,16 +4518,13 @@ Only look at a few lines to determine indent level." | |||
| 4701 | (progn | 4518 | (progn |
| 4702 | (forward-char 1) | 4519 | (forward-char 1) |
| 4703 | (backward-up-list -1) | 4520 | (backward-up-list -1) |
| 4704 | (skip-chars-forward " \t"))) | 4521 | (skip-chars-forward " \t")))) |
| 4705 | ) | ||
| 4706 | (current-column)) | 4522 | (current-column)) |
| 4707 | (progn | 4523 | (progn |
| 4708 | (goto-char fst) | 4524 | (goto-char fst) |
| 4709 | (+ (current-column) verilog-cexp-indent)) | 4525 | (+ (current-column) verilog-cexp-indent)))))) |
| 4710 | )))) | ||
| 4711 | (goto-char here) | 4526 | (goto-char here) |
| 4712 | (indent-line-to val)) | 4527 | (indent-line-to val))) |
| 4713 | ) | ||
| 4714 | ((= (preceding-char) ?\) ) | 4528 | ((= (preceding-char) ?\) ) |
| 4715 | (goto-char here) | 4529 | (goto-char here) |
| 4716 | (let ((val (eval (cdr (assoc type verilog-indent-alist))))) | 4530 | (let ((val (eval (cdr (assoc type verilog-indent-alist))))) |
| @@ -4724,8 +4538,7 @@ Only look at a few lines to determine indent level." | |||
| 4724 | (setq val (current-column)) | 4538 | (setq val (current-column)) |
| 4725 | (setq val (eval (cdr (assoc type verilog-indent-alist))))) | 4539 | (setq val (eval (cdr (assoc type verilog-indent-alist))))) |
| 4726 | (goto-char here) | 4540 | (goto-char here) |
| 4727 | (indent-line-to val))) | 4541 | (indent-line-to val)))))) |
| 4728 | ))) | ||
| 4729 | 4542 | ||
| 4730 | (; handle inside parenthetical expressions | 4543 | (; handle inside parenthetical expressions |
| 4731 | (eq type 'cparenexp) | 4544 | (eq type 'cparenexp) |
| @@ -4737,8 +4550,7 @@ Only look at a few lines to determine indent level." | |||
| 4737 | (indent-line-to val) | 4550 | (indent-line-to val) |
| 4738 | (if (and (not (verilog-in-struct-region-p)) | 4551 | (if (and (not (verilog-in-struct-region-p)) |
| 4739 | (looking-at verilog-declaration-re)) | 4552 | (looking-at verilog-declaration-re)) |
| 4740 | (verilog-indent-declaration ind)) | 4553 | (verilog-indent-declaration ind)))) |
| 4741 | )) | ||
| 4742 | 4554 | ||
| 4743 | (;-- Handle the ends | 4555 | (;-- Handle the ends |
| 4744 | (or | 4556 | (or |
| @@ -4774,8 +4586,8 @@ Only look at a few lines to determine indent level." | |||
| 4774 | (;-- Everything else | 4586 | (;-- Everything else |
| 4775 | t | 4587 | t |
| 4776 | (let ((val (eval (cdr (assoc type verilog-indent-alist))))) | 4588 | (let ((val (eval (cdr (assoc type verilog-indent-alist))))) |
| 4777 | (indent-line-to val))) | 4589 | (indent-line-to val)))) |
| 4778 | ) | 4590 | |
| 4779 | (if (looking-at "[ \t]+$") | 4591 | (if (looking-at "[ \t]+$") |
| 4780 | (skip-chars-forward " \t")) | 4592 | (skip-chars-forward " \t")) |
| 4781 | indent-str ; Return indent data | 4593 | indent-str ; Return indent data |
| @@ -4823,8 +4635,7 @@ Do not count named blocks or case-statements." | |||
| 4823 | (t | 4635 | (t |
| 4824 | (save-excursion | 4636 | (save-excursion |
| 4825 | (re-search-backward "//" nil t) | 4637 | (re-search-backward "//" nil t) |
| 4826 | (current-column))) | 4638 | (current-column)))))) |
| 4827 | ))) | ||
| 4828 | (indent-line-to stcol) | 4639 | (indent-line-to stcol) |
| 4829 | stcol)) | 4640 | stcol)) |
| 4830 | 4641 | ||
| @@ -4843,8 +4654,7 @@ Do not count named blocks or case-statements." | |||
| 4843 | (t | 4654 | (t |
| 4844 | (save-excursion | 4655 | (save-excursion |
| 4845 | (re-search-backward "//" nil t) | 4656 | (re-search-backward "//" nil t) |
| 4846 | (current-column))) | 4657 | (current-column)))))) |
| 4847 | ))) | ||
| 4848 | (progn | 4658 | (progn |
| 4849 | (indent-to stcol) | 4659 | (indent-to stcol) |
| 4850 | (if (and star | 4660 | (if (and star |
| @@ -4912,8 +4722,7 @@ ARG is ignored, for `comment-indent-function' compatibility." | |||
| 4912 | (goto-char start) | 4722 | (goto-char start) |
| 4913 | (verilog-do-indent (verilog-calculate-indent)) | 4723 | (verilog-do-indent (verilog-calculate-indent)) |
| 4914 | (verilog-forward-ws&directives) | 4724 | (verilog-forward-ws&directives) |
| 4915 | (current-column))) | 4725 | (current-column)))) |
| 4916 | ) | ||
| 4917 | (goto-char end) | 4726 | (goto-char end) |
| 4918 | (goto-char start) | 4727 | (goto-char start) |
| 4919 | (if (> (- end start) 100) | 4728 | (if (> (- end start) 100) |
| @@ -4927,15 +4736,12 @@ ARG is ignored, for `comment-indent-function' compatibility." | |||
| 4927 | (verilog-forward-ws&directives) | 4736 | (verilog-forward-ws&directives) |
| 4928 | (indent-line-to base-ind) | 4737 | (indent-line-to base-ind) |
| 4929 | (verilog-forward-ws&directives) | 4738 | (verilog-forward-ws&directives) |
| 4930 | (verilog-re-search-forward "[ \t\n\f]" e 'move) | 4739 | (verilog-re-search-forward "[ \t\n\f]" e 'move)) |
| 4931 | ) | ||
| 4932 | (t | 4740 | (t |
| 4933 | (just-one-space) | 4741 | (just-one-space) |
| 4934 | (verilog-re-search-forward "[ \t\n\f]" e 'move) | 4742 | (verilog-re-search-forward "[ \t\n\f]" e 'move))) |
| 4935 | ) | 4743 | ;;(forward-line) |
| 4936 | ) | ||
| 4937 | ) | 4744 | ) |
| 4938 | ;;(forward-line)) | ||
| 4939 | ;; Now find biggest prefix | 4745 | ;; Now find biggest prefix |
| 4940 | (setq ind (verilog-get-lineup-indent start edpos)) | 4746 | (setq ind (verilog-get-lineup-indent start edpos)) |
| 4941 | ;; Now indent each line. | 4747 | ;; Now indent each line. |
| @@ -4960,21 +4766,19 @@ ARG is ignored, for `comment-indent-function' compatibility." | |||
| 4960 | (indent-to ind)) | 4766 | (indent-to ind)) |
| 4961 | (progn | 4767 | (progn |
| 4962 | (just-one-space) | 4768 | (just-one-space) |
| 4963 | (indent-to ind)) | 4769 | (indent-to ind))))) |
| 4964 | ))) | ||
| 4965 | ((verilog-continued-line-1 start) | 4770 | ((verilog-continued-line-1 start) |
| 4966 | (goto-char e) | 4771 | (goto-char e) |
| 4967 | (indent-line-to ind)) | 4772 | (indent-line-to ind)) |
| 4968 | (t ; Must be comment or white space | 4773 | (t ; Must be comment or white space |
| 4969 | (goto-char e) | 4774 | (goto-char e) |
| 4970 | (verilog-forward-ws&directives) | 4775 | (verilog-forward-ws&directives) |
| 4971 | (forward-line -1)) | 4776 | (forward-line -1))) |
| 4972 | ) | ||
| 4973 | (forward-line 1)) | 4777 | (forward-line 1)) |
| 4974 | (message ""))))) | 4778 | (message ""))))) |
| 4975 | 4779 | ||
| 4976 | (defun verilog-pretty-expr (&optional myre) | 4780 | (defun verilog-pretty-expr (&optional myre) |
| 4977 | "Line up expressions around point." | 4781 | "Line up expressions around point, or optional regexp MYRE." |
| 4978 | (interactive "sRegular Expression: ((<|:)?=) ") | 4782 | (interactive "sRegular Expression: ((<|:)?=) ") |
| 4979 | (save-excursion | 4783 | (save-excursion |
| 4980 | (if (or (eq myre nil) | 4784 | (if (or (eq myre nil) |
| @@ -4995,8 +4799,7 @@ ARG is ignored, for `comment-indent-function' compatibility." | |||
| 4995 | (beginning-of-line) | 4799 | (beginning-of-line) |
| 4996 | (while (and (not (looking-at (concat "^\\s-*" verilog-complete-reg))) | 4800 | (while (and (not (looking-at (concat "^\\s-*" verilog-complete-reg))) |
| 4997 | (looking-at myre) | 4801 | (looking-at myre) |
| 4998 | (not (bobp)) | 4802 | (not (bobp))) |
| 4999 | ) | ||
| 5000 | (setq e (point)) | 4803 | (setq e (point)) |
| 5001 | (verilog-backward-syntactic-ws) | 4804 | (verilog-backward-syntactic-ws) |
| 5002 | (beginning-of-line) | 4805 | (beginning-of-line) |
| @@ -5015,12 +4818,10 @@ ARG is ignored, for `comment-indent-function' compatibility." | |||
| 5015 | (end-of-line) | 4818 | (end-of-line) |
| 5016 | (setq e (point)) | 4819 | (setq e (point)) |
| 5017 | (verilog-forward-syntactic-ws) | 4820 | (verilog-forward-syntactic-ws) |
| 5018 | (beginning-of-line) | 4821 | (beginning-of-line)) |
| 5019 | ) | ||
| 5020 | e)) | 4822 | e)) |
| 5021 | (edpos (set-marker (make-marker) end)) | 4823 | (edpos (set-marker (make-marker) end)) |
| 5022 | (ind) | 4824 | (ind)) |
| 5023 | ) | ||
| 5024 | (goto-char start) | 4825 | (goto-char start) |
| 5025 | (verilog-do-indent (verilog-calculate-indent)) | 4826 | (verilog-do-indent (verilog-calculate-indent)) |
| 5026 | (if (> (- end start) 100) | 4827 | (if (> (- end start) 100) |
| @@ -5031,8 +4832,7 @@ ARG is ignored, for `comment-indent-function' compatibility." | |||
| 5031 | (beginning-of-line) | 4832 | (beginning-of-line) |
| 5032 | (verilog-just-one-space myre) | 4833 | (verilog-just-one-space myre) |
| 5033 | (end-of-line) | 4834 | (end-of-line) |
| 5034 | (verilog-forward-syntactic-ws) | 4835 | (verilog-forward-syntactic-ws)) |
| 5035 | ) | ||
| 5036 | 4836 | ||
| 5037 | ;; Now find biggest prefix | 4837 | ;; Now find biggest prefix |
| 5038 | (setq ind (verilog-get-lineup-indent-2 myre start edpos)) | 4838 | (setq ind (verilog-get-lineup-indent-2 myre start edpos)) |
| @@ -5049,20 +4849,16 @@ ARG is ignored, for `comment-indent-function' compatibility." | |||
| 5049 | (goto-char (match-end 1)) | 4849 | (goto-char (match-end 1)) |
| 5050 | (if (eq (char-after) ?=) | 4850 | (if (eq (char-after) ?=) |
| 5051 | (indent-to (1+ ind)) ; line up the = of the <= with surrounding = | 4851 | (indent-to (1+ ind)) ; line up the = of the <= with surrounding = |
| 5052 | (indent-to ind) | 4852 | (indent-to ind))) |
| 5053 | ) | ||
| 5054 | ) | ||
| 5055 | ((verilog-continued-line-1 start) | 4853 | ((verilog-continued-line-1 start) |
| 5056 | (goto-char e) | 4854 | (goto-char e) |
| 5057 | (indent-line-to ind)) | 4855 | (indent-line-to ind)) |
| 5058 | (t ; Must be comment or white space | 4856 | (t ; Must be comment or white space |
| 5059 | (goto-char e) | 4857 | (goto-char e) |
| 5060 | (verilog-forward-ws&directives) | 4858 | (verilog-forward-ws&directives) |
| 5061 | (forward-line -1)) | 4859 | (forward-line -1))) |
| 5062 | ) | ||
| 5063 | (forward-line 1)) | 4860 | (forward-line 1)) |
| 5064 | (message "") | 4861 | (message ""))))) |
| 5065 | )))) | ||
| 5066 | 4862 | ||
| 5067 | (defun verilog-just-one-space (myre) | 4863 | (defun verilog-just-one-space (myre) |
| 5068 | "Remove extra spaces around regular expression MYRE." | 4864 | "Remove extra spaces around regular expression MYRE." |
| @@ -5073,12 +4869,10 @@ ARG is ignored, for `comment-indent-function' compatibility." | |||
| 5073 | (p2 (match-end 2))) | 4869 | (p2 (match-end 2))) |
| 5074 | (progn | 4870 | (progn |
| 5075 | (goto-char p2) | 4871 | (goto-char p2) |
| 5076 | (if (looking-at "\\s-") (just-one-space) ) | 4872 | (if (looking-at "\\s-") (just-one-space)) |
| 5077 | (goto-char p1) | 4873 | (goto-char p1) |
| 5078 | (forward-char -1) | 4874 | (forward-char -1) |
| 5079 | (if (looking-at "\\s-") (just-one-space)) | 4875 | (if (looking-at "\\s-") (just-one-space))))) |
| 5080 | ) | ||
| 5081 | )) | ||
| 5082 | (message "")) | 4876 | (message "")) |
| 5083 | 4877 | ||
| 5084 | (defun verilog-indent-declaration (baseind) | 4878 | (defun verilog-indent-declaration (baseind) |
| @@ -5093,8 +4887,7 @@ BASEIND is the base indent to offset everything." | |||
| 5093 | (point))) | 4887 | (point))) |
| 5094 | (ind) | 4888 | (ind) |
| 5095 | (val) | 4889 | (val) |
| 5096 | (m1 (make-marker)) | 4890 | (m1 (make-marker))) |
| 5097 | ) | ||
| 5098 | (setq val | 4891 | (setq val |
| 5099 | (+ baseind (eval (cdr (assoc 'declaration verilog-indent-alist))))) | 4892 | (+ baseind (eval (cdr (assoc 'declaration verilog-indent-alist))))) |
| 5100 | (indent-line-to val) | 4893 | (indent-line-to val) |
| @@ -5125,13 +4918,11 @@ BASEIND is the base indent to offset everything." | |||
| 5125 | (just-one-space) | 4918 | (just-one-space) |
| 5126 | (goto-char (marker-position m1)) | 4919 | (goto-char (marker-position m1)) |
| 5127 | (just-one-space) | 4920 | (just-one-space) |
| 5128 | (indent-to ind) | 4921 | (indent-to ind)) |
| 5129 | ) | ||
| 5130 | (if (/= (current-column) ind) | 4922 | (if (/= (current-column) ind) |
| 5131 | (progn | 4923 | (progn |
| 5132 | (just-one-space) | 4924 | (just-one-space) |
| 5133 | (indent-to ind)) | 4925 | (indent-to ind))))) |
| 5134 | ))) | ||
| 5135 | (if (looking-at verilog-declaration-re-2-no-macro) | 4926 | (if (looking-at verilog-declaration-re-2-no-macro) |
| 5136 | (let ((p (match-end 0))) | 4927 | (let ((p (match-end 0))) |
| 5137 | (set-marker m1 p) | 4928 | (set-marker m1 p) |
| @@ -5362,11 +5153,8 @@ for matches of `str' and adding the occurrence tp `all' through point END." | |||
| 5362 | (if (or (null verilog-pred) | 5153 | (if (or (null verilog-pred) |
| 5363 | (funcall verilog-pred match)) | 5154 | (funcall verilog-pred match)) |
| 5364 | (setq verilog-all (cons match verilog-all))))) | 5155 | (setq verilog-all (cons match verilog-all))))) |
| 5365 | (forward-line 1) | 5156 | (forward-line 1))) |
| 5366 | ) | 5157 | verilog-all) |
| 5367 | ) | ||
| 5368 | verilog-all | ||
| 5369 | ) | ||
| 5370 | 5158 | ||
| 5371 | (defun verilog-type-completion () | 5159 | (defun verilog-type-completion () |
| 5372 | "Calculate all possible completions for types." | 5160 | "Calculate all possible completions for types." |
| @@ -5663,8 +5451,7 @@ If search fails, other files are checked based on | |||
| 5663 | (goto-char pt) | 5451 | (goto-char pt) |
| 5664 | (beginning-of-line)) | 5452 | (beginning-of-line)) |
| 5665 | pt) | 5453 | pt) |
| 5666 | (verilog-goto-defun-file label) | 5454 | (verilog-goto-defun-file label)))) |
| 5667 | ))) | ||
| 5668 | 5455 | ||
| 5669 | ;; Eliminate compile warning | 5456 | ;; Eliminate compile warning |
| 5670 | (eval-when-compile | 5457 | (eval-when-compile |
| @@ -5680,8 +5467,7 @@ If search fails, other files are checked based on | |||
| 5680 | (first 1) | 5467 | (first 1) |
| 5681 | (prevpos (point-min)) | 5468 | (prevpos (point-min)) |
| 5682 | (final-context-start (make-marker)) | 5469 | (final-context-start (make-marker)) |
| 5683 | (regexp "\\(module\\s-+\\w+\\s-*(\\)\\|\\(\\w+\\s-+\\w+\\s-*(\\)") | 5470 | (regexp "\\(module\\s-+\\w+\\s-*(\\)\\|\\(\\w+\\s-+\\w+\\s-*(\\)")) |
| 5684 | ) | ||
| 5685 | (with-output-to-temp-buffer "*Occur*" | 5471 | (with-output-to-temp-buffer "*Occur*" |
| 5686 | (save-excursion | 5472 | (save-excursion |
| 5687 | (message (format "Searching for %s ..." regexp)) | 5473 | (message (format "Searching for %s ..." regexp)) |
| @@ -5854,8 +5640,7 @@ Bound search by LIMIT. Adapted from | |||
| 5854 | (search-forward "<company>") | 5640 | (search-forward "<company>") |
| 5855 | (replace-match string t t) | 5641 | (replace-match string t t) |
| 5856 | (search-backward "<description>") | 5642 | (search-backward "<description>") |
| 5857 | (replace-match "" t t) | 5643 | (replace-match "" t t)))) |
| 5858 | ))) | ||
| 5859 | 5644 | ||
| 5860 | ;; verilog-header Uses the verilog-insert-date function | 5645 | ;; verilog-header Uses the verilog-insert-date function |
| 5861 | 5646 | ||
| @@ -5994,8 +5779,7 @@ Duplicate signals are also removed. For example A[2] and A[1] become A[2:1]." | |||
| 5994 | sv-type (verilog-sig-type sig) | 5779 | sv-type (verilog-sig-type sig) |
| 5995 | sv-multidim (verilog-sig-multidim sig) | 5780 | sv-multidim (verilog-sig-multidim sig) |
| 5996 | combo "" | 5781 | combo "" |
| 5997 | buswarn "" | 5782 | buswarn "")) |
| 5998 | )) | ||
| 5999 | ;; Extract bus details | 5783 | ;; Extract bus details |
| 6000 | (setq bus (verilog-sig-bits sig)) | 5784 | (setq bus (verilog-sig-bits sig)) |
| 6001 | (cond ((and bus | 5785 | (cond ((and bus |
| @@ -6043,16 +5827,15 @@ Duplicate signals are also removed. For example A[2] and A[1] become A[2:1]." | |||
| 6043 | (if sv-highbit | 5827 | (if sv-highbit |
| 6044 | (concat "[" (int-to-string sv-highbit) ":" | 5828 | (concat "[" (int-to-string sv-highbit) ":" |
| 6045 | (int-to-string sv-lowbit) "]"))) | 5829 | (int-to-string sv-lowbit) "]"))) |
| 6046 | (concat sv-comment combo buswarn) | 5830 | (concat sv-comment combo buswarn) |
| 6047 | sv-memory sv-enum sv-signed sv-type sv-multidim) | 5831 | sv-memory sv-enum sv-signed sv-type sv-multidim) |
| 6048 | out-list) | 5832 | out-list) |
| 6049 | sv-name nil))) | 5833 | sv-name nil)))) |
| 6050 | ) | ||
| 6051 | ;; | 5834 | ;; |
| 6052 | out-list)) | 5835 | out-list)) |
| 6053 | 5836 | ||
| 6054 | (defun verilog-sig-tieoff (sig &optional no-width) | 5837 | (defun verilog-sig-tieoff (sig &optional no-width) |
| 6055 | "Return tieoff expression for given SIGNAL, with appropriate width. | 5838 | "Return tieoff expression for given SIG, with appropriate width. |
| 6056 | Ignore width if optional NO-WIDTH is set." | 5839 | Ignore width if optional NO-WIDTH is set." |
| 6057 | (let* ((width (if no-width nil (verilog-sig-width sig)))) | 5840 | (let* ((width (if no-width nil (verilog-sig-width sig)))) |
| 6058 | (concat | 5841 | (concat |
| @@ -6189,8 +5972,7 @@ Return a array of [outputs inouts inputs wire reg assign const]." | |||
| 6189 | (forward-char 1) | 5972 | (forward-char 1) |
| 6190 | (when (< paren sig-paren) | 5973 | (when (< paren sig-paren) |
| 6191 | (setq expect-signal nil)) ; ) that ends variables inside v2k arg list | 5974 | (setq expect-signal nil)) ; ) that ends variables inside v2k arg list |
| 6192 | t) | 5975 | t)))) |
| 6193 | ))) | ||
| 6194 | ((looking-at "\\s-*\\(\\[[^]]+\\]\\)") | 5976 | ((looking-at "\\s-*\\(\\[[^]]+\\]\\)") |
| 6195 | (goto-char (match-end 0)) | 5977 | (goto-char (match-end 0)) |
| 6196 | (cond (newsig ; Memory, not just width. Patch last signal added's memory (nth 3) | 5978 | (cond (newsig ; Memory, not just width. Patch last signal added's memory (nth 3) |
| @@ -6272,12 +6054,15 @@ Return a array of [outputs inouts inputs wire reg assign const]." | |||
| 6272 | (nreverse sigs-reg) | 6054 | (nreverse sigs-reg) |
| 6273 | (nreverse sigs-assign) | 6055 | (nreverse sigs-assign) |
| 6274 | (nreverse sigs-const) | 6056 | (nreverse sigs-const) |
| 6275 | (nreverse sigs-gparam) | 6057 | (nreverse sigs-gparam))))) |
| 6276 | )))) | ||
| 6277 | 6058 | ||
| 6278 | (defvar sigs-in) ; Prevent compile warning | 6059 | (eval-when-compile |
| 6279 | (defvar sigs-inout) ; Prevent compile warning | 6060 | ;; Prevent compile warnings; these are let's, not globals |
| 6280 | (defvar sigs-out) ; Prevent compile warning | 6061 | ;; Do not remove the eval-when-compile |
| 6062 | ;; - we want a error when we are debugging this code if they are refed. | ||
| 6063 | (defvar sigs-in) | ||
| 6064 | (defvar sigs-inout) | ||
| 6065 | (defvar sigs-out)) | ||
| 6281 | 6066 | ||
| 6282 | 6067 | ||
| 6283 | (defsubst verilog-modi-get-decls (modi) | 6068 | (defsubst verilog-modi-get-decls (modi) |
| @@ -6524,10 +6309,16 @@ For example if declare A A (.B(SIG)) then B will be included in the list." | |||
| 6524 | (end-pt (point))) | 6309 | (end-pt (point))) |
| 6525 | (eval-region beg-pt end-pt nil))))) | 6310 | (eval-region beg-pt end-pt nil))))) |
| 6526 | 6311 | ||
| 6527 | ;; These are passed in a let, not global | 6312 | (eval-when-compile |
| 6528 | (defvar got-sig) | 6313 | ;; Prevent compile warnings; these are let's, not globals |
| 6529 | (defvar got-rvalue) | 6314 | ;; Do not remove the eval-when-compile |
| 6530 | (defvar uses-delayed) | 6315 | ;; - we want a error when we are debugging this code if they are refed. |
| 6316 | (defvar sigs-in) | ||
| 6317 | (defvar sigs-out) | ||
| 6318 | (defvar got-sig) | ||
| 6319 | (defvar got-rvalue) | ||
| 6320 | (defvar uses-delayed) | ||
| 6321 | (defvar vector-skip-list)) | ||
| 6531 | 6322 | ||
| 6532 | (defun verilog-read-always-signals-recurse | 6323 | (defun verilog-read-always-signals-recurse |
| 6533 | (exit-keywd rvalue ignore-next) | 6324 | (exit-keywd rvalue ignore-next) |
| @@ -6653,8 +6444,7 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." | |||
| 6653 | (t | 6444 | (t |
| 6654 | (forward-char 1))) | 6445 | (forward-char 1))) |
| 6655 | ;; End of non-comment token | 6446 | ;; End of non-comment token |
| 6656 | (setq last-keywd keywd) | 6447 | (setq last-keywd keywd))) |
| 6657 | )) | ||
| 6658 | (skip-syntax-forward " ")) | 6448 | (skip-syntax-forward " ")) |
| 6659 | ;; Append the final pending signal | 6449 | ;; Append the final pending signal |
| 6660 | (when got-sig | 6450 | (when got-sig |
| @@ -6700,8 +6490,7 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." | |||
| 6700 | (instant (match-string 2))) | 6490 | (instant (match-string 2))) |
| 6701 | (if (not (member module verilog-keywords)) | 6491 | (if (not (member module verilog-keywords)) |
| 6702 | (setq instants-list (cons (list module instant) instants-list))))) | 6492 | (setq instants-list (cons (list module instant) instants-list))))) |
| 6703 | (forward-line 1) | 6493 | (forward-line 1))) |
| 6704 | )) | ||
| 6705 | instants-list)) | 6494 | instants-list)) |
| 6706 | 6495 | ||
| 6707 | 6496 | ||
| @@ -6776,8 +6565,7 @@ list of ( (signal_name connection_name)... )" | |||
| 6776 | (t | 6565 | (t |
| 6777 | (error "%s: AUTO_TEMPLATE parsing error: %s" | 6566 | (error "%s: AUTO_TEMPLATE parsing error: %s" |
| 6778 | (verilog-point-text) | 6567 | (verilog-point-text) |
| 6779 | (progn (looking-at ".*$") (match-string 0)))) | 6568 | (progn (looking-at ".*$") (match-string 0)))))) |
| 6780 | )) | ||
| 6781 | ;; Return | 6569 | ;; Return |
| 6782 | (vector tpl-regexp | 6570 | (vector tpl-regexp |
| 6783 | (list tpl-sig-list tpl-wild-list))) | 6571 | (list tpl-sig-list tpl-wild-list))) |
| @@ -6799,8 +6587,7 @@ Optionally associate it with the specified enumeration ENUMNAME." | |||
| 6799 | (let ((enumvar (intern (concat "venum-" enumname)))) | 6587 | (let ((enumvar (intern (concat "venum-" enumname)))) |
| 6800 | ;;(message "Define %s=%s" defname defvalue) (sleep-for 1) | 6588 | ;;(message "Define %s=%s" defname defvalue) (sleep-for 1) |
| 6801 | (make-variable-buffer-local enumvar) | 6589 | (make-variable-buffer-local enumvar) |
| 6802 | (add-to-list enumvar defname))) | 6590 | (add-to-list enumvar defname))))) |
| 6803 | )) | ||
| 6804 | 6591 | ||
| 6805 | (defun verilog-read-defines (&optional filename recurse subcall) | 6592 | (defun verilog-read-defines (&optional filename recurse subcall) |
| 6806 | "Read `defines and parameters for the current file, or optional FILENAME. | 6593 | "Read `defines and parameters for the current file, or optional FILENAME. |
| @@ -6884,8 +6671,7 @@ warning message, you need to add to your .emacs file: | |||
| 6884 | (while (looking-at "\\s-*,?\\s-*\\([a-zA-Z0-9_$]+\\)\\s-*=\\s-*\\([^;,]*\\),?\\s-*") | 6671 | (while (looking-at "\\s-*,?\\s-*\\([a-zA-Z0-9_$]+\\)\\s-*=\\s-*\\([^;,]*\\),?\\s-*") |
| 6885 | (verilog-set-define (match-string-no-properties 1) (match-string-no-properties 2) origbuf enumname) | 6672 | (verilog-set-define (match-string-no-properties 1) (match-string-no-properties 2) origbuf enumname) |
| 6886 | (goto-char (match-end 0)) | 6673 | (goto-char (match-end 0)) |
| 6887 | (forward-comment 999)))) | 6674 | (forward-comment 999))))))) |
| 6888 | ))) | ||
| 6889 | 6675 | ||
| 6890 | (defun verilog-read-includes () | 6676 | (defun verilog-read-includes () |
| 6891 | "Read `includes for the current file. | 6677 | "Read `includes for the current file. |
| @@ -6950,8 +6736,7 @@ Some macros and such are also found and included. For dinotrace.el" | |||
| 6950 | (or (member keywd verilog-keywords) | 6736 | (or (member keywd verilog-keywords) |
| 6951 | (member keywd sigs-all) | 6737 | (member keywd sigs-all) |
| 6952 | (setq sigs-all (cons keywd sigs-all)))) | 6738 | (setq sigs-all (cons keywd sigs-all)))) |
| 6953 | (t (forward-char 1))) | 6739 | (t (forward-char 1)))) |
| 6954 | ) | ||
| 6955 | ;; Return list | 6740 | ;; Return list |
| 6956 | sigs-all))) | 6741 | sigs-all))) |
| 6957 | 6742 | ||
| @@ -7019,10 +6804,7 @@ Some macros and such are also found and included. For dinotrace.el" | |||
| 7019 | ((string-match "^[^-+]" arg) | 6804 | ((string-match "^[^-+]" arg) |
| 7020 | (verilog-add-list-unique `verilog-library-files arg)) | 6805 | (verilog-add-list-unique `verilog-library-files arg)) |
| 7021 | ;; Default - ignore; no warning | 6806 | ;; Default - ignore; no warning |
| 7022 | ) | 6807 | )))) |
| 7023 | ) | ||
| 7024 | ) | ||
| 7025 | ) | ||
| 7026 | ;;(verilog-getopt (list "+libext+.a+.b" "+incdir+foodir" "+define+a+aval" "-f" "otherf" "-v" "library" "-y" "dir")) | 6808 | ;;(verilog-getopt (list "+libext+.a+.b" "+incdir+foodir" "+define+a+aval" "-f" "otherf" "-v" "library" "-y" "dir")) |
| 7027 | 6809 | ||
| 7028 | (defun verilog-getopt-file (filename) | 6810 | (defun verilog-getopt-file (filename) |
| @@ -7096,8 +6878,7 @@ Allows version control to check out the file if need be." | |||
| 7096 | "Return true if SYMBOL is number-like." | 6878 | "Return true if SYMBOL is number-like." |
| 7097 | (or (string-match "^[0-9 \t:]+$" symbol) | 6879 | (or (string-match "^[0-9 \t:]+$" symbol) |
| 7098 | (string-match "^[---]*[0-9]+$" symbol) | 6880 | (string-match "^[---]*[0-9]+$" symbol) |
| 7099 | (string-match "^[0-9 \t]+'s?[hdxbo][0-9a-fA-F_xz? \t]*$" symbol) | 6881 | (string-match "^[0-9 \t]+'s?[hdxbo][0-9a-fA-F_xz? \t]*$" symbol))) |
| 7100 | )) | ||
| 7101 | 6882 | ||
| 7102 | (defun verilog-symbol-detick (symbol wing-it) | 6883 | (defun verilog-symbol-detick (symbol wing-it) |
| 7103 | "Return a expanded SYMBOL name without any defines. | 6884 | "Return a expanded SYMBOL name without any defines. |
| @@ -7185,13 +6966,11 @@ Or, just the existing dirnames themselves if there are no wildcards." | |||
| 7185 | (setq dirfile (expand-file-name (concat (car dirfiles) rest)) | 6966 | (setq dirfile (expand-file-name (concat (car dirfiles) rest)) |
| 7186 | dirfiles (cdr dirfiles)) | 6967 | dirfiles (cdr dirfiles)) |
| 7187 | (if (file-directory-p dirfile) | 6968 | (if (file-directory-p dirfile) |
| 7188 | (setq dirlist (cons dirfile dirlist)))) | 6969 | (setq dirlist (cons dirfile dirlist))))) |
| 7189 | ) | ||
| 7190 | ;; Defaults | 6970 | ;; Defaults |
| 7191 | (t | 6971 | (t |
| 7192 | (if (file-directory-p dirname) | 6972 | (if (file-directory-p dirname) |
| 7193 | (setq dirlist (cons dirname dirlist)))) | 6973 | (setq dirlist (cons dirname dirlist)))))) |
| 7194 | )) | ||
| 7195 | dirlist)) | 6974 | dirlist)) |
| 7196 | ;;(verilog-expand-dirnames (list "." ".." "nonexist" "../*" "/home/wsnyder/*/v")) | 6975 | ;;(verilog-expand-dirnames (list "." ".." "nonexist" "../*" "/home/wsnyder/*/v")) |
| 7197 | 6976 | ||
| @@ -7295,13 +7074,11 @@ Return modi if successful, else print message unless IGNORE-ERROR is true." | |||
| 7295 | "") | 7074 | "") |
| 7296 | "\n Check the verilog-library-directories variable." | 7075 | "\n Check the verilog-library-directories variable." |
| 7297 | "\n I looked in (if not listed, doesn't exist):\n\t" | 7076 | "\n I looked in (if not listed, doesn't exist):\n\t" |
| 7298 | (mapconcat 'concat orig-filenames "\n\t"))))) | 7077 | (mapconcat 'concat orig-filenames "\n\t")))))) |
| 7299 | ) | ||
| 7300 | (setq verilog-modi-lookup-last-mod module | 7078 | (setq verilog-modi-lookup-last-mod module |
| 7301 | verilog-modi-lookup-last-current current | 7079 | verilog-modi-lookup-last-current current |
| 7302 | verilog-modi-lookup-last-tick (buffer-modified-tick))))) | 7080 | verilog-modi-lookup-last-tick (buffer-modified-tick))))) |
| 7303 | verilog-modi-lookup-last-modi | 7081 | verilog-modi-lookup-last-modi)) |
| 7304 | )) | ||
| 7305 | 7082 | ||
| 7306 | (defsubst verilog-modi-name (modi) | 7083 | (defsubst verilog-modi-name (modi) |
| 7307 | (aref modi 0)) | 7084 | (aref modi 0)) |
| @@ -7370,8 +7147,7 @@ Cache the output of function so next call may have faster access." | |||
| 7370 | (buffer-modified-tick) | 7147 | (buffer-modified-tick) |
| 7371 | (visited-file-modtime) | 7148 | (visited-file-modtime) |
| 7372 | func-returns) | 7149 | func-returns) |
| 7373 | verilog-modi-cache-list))) | 7150 | verilog-modi-cache-list))))) |
| 7374 | )) | ||
| 7375 | ;; | 7151 | ;; |
| 7376 | func-returns)) | 7152 | func-returns)) |
| 7377 | 7153 | ||
| @@ -7483,7 +7259,7 @@ and invalidating the cache." | |||
| 7483 | (funcall func)))) | 7259 | (funcall func)))) |
| 7484 | 7260 | ||
| 7485 | (defun verilog-insert-one-definition (sig type indent-pt) | 7261 | (defun verilog-insert-one-definition (sig type indent-pt) |
| 7486 | "Print out a definition for SIGNAL of the given TYPE, | 7262 | "Print out a definition for SIG of the given TYPE, |
| 7487 | with appropriate INDENT-PT indentation." | 7263 | with appropriate INDENT-PT indentation." |
| 7488 | (indent-to indent-pt) | 7264 | (indent-to indent-pt) |
| 7489 | (insert type) | 7265 | (insert type) |
| @@ -7594,9 +7370,8 @@ This repairs those mis-inserted by a AUTOARG." | |||
| 7594 | (string-to-number (match-string 2 range-exp))))))) | 7370 | (string-to-number (match-string 2 range-exp))))))) |
| 7595 | ((string-match "^\\(.*\\)\\s *:\\s *\\(.*\\)\\s *$" range-exp) | 7371 | ((string-match "^\\(.*\\)\\s *:\\s *\\(.*\\)\\s *$" range-exp) |
| 7596 | (concat "(1+(" (match-string 1 range-exp) ")" | 7372 | (concat "(1+(" (match-string 1 range-exp) ")" |
| 7597 | (if (equal "0" (match-string 2 range-exp)) | 7373 | (if (equal "0" (match-string 2 range-exp)) |
| 7598 | ;; Don't bother with -(0) | 7374 | "" ;; Don't bother with -(0) |
| 7599 | "" | ||
| 7600 | (concat "-(" (match-string 2 range-exp) ")")) | 7375 | (concat "-(" (match-string 2 range-exp) ")")) |
| 7601 | ")")) | 7376 | ")")) |
| 7602 | (t nil))))) | 7377 | (t nil))))) |
| @@ -7621,8 +7396,7 @@ This repairs those mis-inserted by a AUTOARG." | |||
| 7621 | ;; End exists | 7396 | ;; End exists |
| 7622 | (end-of-line) | 7397 | (end-of-line) |
| 7623 | (delete-region pt (point)) | 7398 | (delete-region pt (point)) |
| 7624 | (forward-line 1)) | 7399 | (forward-line 1)))) |
| 7625 | )) | ||
| 7626 | 7400 | ||
| 7627 | (defun verilog-forward-close-paren () | 7401 | (defun verilog-forward-close-paren () |
| 7628 | "Find the close parenthesis that match the current point, | 7402 | "Find the close parenthesis that match the current point, |
| @@ -7897,8 +7671,7 @@ Typing \\[verilog-inject-auto] will make this into: | |||
| 7897 | (when (yes-or-no-p "AUTO statements not recomputed, do it now? ") | 7671 | (when (yes-or-no-p "AUTO statements not recomputed, do it now? ") |
| 7898 | (verilog-auto)) | 7672 | (verilog-auto)) |
| 7899 | ;; Don't ask again if didn't update | 7673 | ;; Don't ask again if didn't update |
| 7900 | (set (make-local-variable 'verilog-auto-update-tick) (buffer-modified-tick)) | 7674 | (set (make-local-variable 'verilog-auto-update-tick) (buffer-modified-tick)))) |
| 7901 | )) | ||
| 7902 | (when (not verilog-auto-star-save) | 7675 | (when (not verilog-auto-star-save) |
| 7903 | (verilog-delete-auto-star-implicit)) | 7676 | (verilog-delete-auto-star-implicit)) |
| 7904 | nil) ;; Always return nil -- we don't write the file ourselves | 7677 | nil) ;; Always return nil -- we don't write the file ourselves |
| @@ -8008,13 +7781,11 @@ Avoid declaring ports manually, as it makes code harder to maintain." | |||
| 8008 | (verilog-repair-close-comma) | 7781 | (verilog-repair-close-comma) |
| 8009 | (unless (eq (char-before) ?/ ) | 7782 | (unless (eq (char-before) ?/ ) |
| 8010 | (insert "\n")) | 7783 | (insert "\n")) |
| 8011 | (indent-to verilog-indent-level-declaration) | 7784 | (indent-to verilog-indent-level-declaration)))) |
| 8012 | ))) | ||
| 8013 | 7785 | ||
| 8014 | (defun verilog-auto-inst-port-map (port-st) | 7786 | (defun verilog-auto-inst-port-map (port-st) |
| 8015 | nil) | 7787 | nil) |
| 8016 | 7788 | ||
| 8017 | (defvar vector-skip-list nil) ; Prevent compile warning | ||
| 8018 | (defvar vl-cell-type nil "See `verilog-auto-inst'.") ; Prevent compile warning | 7789 | (defvar vl-cell-type nil "See `verilog-auto-inst'.") ; Prevent compile warning |
| 8019 | (defvar vl-cell-name nil "See `verilog-auto-inst'.") ; Prevent compile warning | 7790 | (defvar vl-cell-name nil "See `verilog-auto-inst'.") ; Prevent compile warning |
| 8020 | (defvar vl-name nil "See `verilog-auto-inst'.") ; Prevent compile warning | 7791 | (defvar vl-name nil "See `verilog-auto-inst'.") ; Prevent compile warning |
| @@ -8025,7 +7796,8 @@ Avoid declaring ports manually, as it makes code harder to maintain." | |||
| 8025 | "Print out a instantiation connection for this PORT-ST. | 7796 | "Print out a instantiation connection for this PORT-ST. |
| 8026 | Insert to INDENT-PT, use template TPL-LIST. | 7797 | Insert to INDENT-PT, use template TPL-LIST. |
| 8027 | @ are instantiation numbers, replaced with TPL-NUM. | 7798 | @ are instantiation numbers, replaced with TPL-NUM. |
| 8028 | @\"(expression @)\" are evaluated, with @ as a variable." | 7799 | @\"(expression @)\" are evaluated, with @ as a variable. |
| 7800 | If FOR-STAR add comment it is a .* expansion." | ||
| 8029 | (let* ((port (verilog-sig-name port-st)) | 7801 | (let* ((port (verilog-sig-name port-st)) |
| 8030 | (tpl-ass (or (assoc port (car tpl-list)) | 7802 | (tpl-ass (or (assoc port (car tpl-list)) |
| 8031 | (verilog-auto-inst-port-map port-st))) | 7803 | (verilog-auto-inst-port-map port-st))) |
| @@ -8072,13 +7844,11 @@ Insert to INDENT-PT, use template TPL-LIST. | |||
| 8072 | (prin1 (eval (car (read-from-string expr))) | 7844 | (prin1 (eval (car (read-from-string expr))) |
| 8073 | (lambda (ch) ()))))) | 7845 | (lambda (ch) ()))))) |
| 8074 | (if (numberp value) (setq value (number-to-string value))) | 7846 | (if (numberp value) (setq value (number-to-string value))) |
| 8075 | value | 7847 | value)) |
| 8076 | )) | ||
| 8077 | (substring tpl-net (match-end 0)))))) | 7848 | (substring tpl-net (match-end 0)))))) |
| 8078 | ;; Replace @ and [] magic variables in final output | 7849 | ;; Replace @ and [] magic variables in final output |
| 8079 | (setq tpl-net (verilog-string-replace-matches "@" tpl-num nil nil tpl-net)) | 7850 | (setq tpl-net (verilog-string-replace-matches "@" tpl-num nil nil tpl-net)) |
| 8080 | (setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net)) | 7851 | (setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net))) |
| 8081 | ) | ||
| 8082 | (indent-to indent-pt) | 7852 | (indent-to indent-pt) |
| 8083 | (insert "." port) | 7853 | (insert "." port) |
| 8084 | (indent-to verilog-auto-inst-column) | 7854 | (indent-to verilog-auto-inst-column) |
| @@ -8462,9 +8232,7 @@ Lisp Templates: | |||
| 8462 | (if (search-forward ")" nil t) ;; From user, moved up a line | 8232 | (if (search-forward ")" nil t) ;; From user, moved up a line |
| 8463 | (delete-backward-char 1)) | 8233 | (delete-backward-char 1)) |
| 8464 | (if (search-forward ";" nil t) ;; Don't error if user had syntax error and forgot it | 8234 | (if (search-forward ";" nil t) ;; Don't error if user had syntax error and forgot it |
| 8465 | (delete-backward-char 1)) | 8235 | (delete-backward-char 1))))))))) |
| 8466 | ))) | ||
| 8467 | )))) | ||
| 8468 | 8236 | ||
| 8469 | (defun verilog-auto-inst-param () | 8237 | (defun verilog-auto-inst-param () |
| 8470 | "Expand AUTOINSTPARAM statements, as part of \\[verilog-auto]. | 8238 | "Expand AUTOINSTPARAM statements, as part of \\[verilog-auto]. |
| @@ -8566,9 +8334,7 @@ Templates: | |||
| 8566 | (search-forward "\n") ;; Added by inst-port | 8334 | (search-forward "\n") ;; Added by inst-port |
| 8567 | (delete-backward-char 1) | 8335 | (delete-backward-char 1) |
| 8568 | (if (search-forward ")" nil t) ;; From user, moved up a line | 8336 | (if (search-forward ")" nil t) ;; From user, moved up a line |
| 8569 | (delete-backward-char 1)) | 8337 | (delete-backward-char 1))))))))) |
| 8570 | ))) | ||
| 8571 | )))) | ||
| 8572 | 8338 | ||
| 8573 | (defun verilog-auto-reg () | 8339 | (defun verilog-auto-reg () |
| 8574 | "Expand AUTOREG statements, as part of \\[verilog-auto]. | 8340 | "Expand AUTOREG statements, as part of \\[verilog-auto]. |
| @@ -8612,15 +8378,13 @@ Typing \\[verilog-auto] will make this into: | |||
| 8612 | (verilog-modi-get-consts modi) | 8378 | (verilog-modi-get-consts modi) |
| 8613 | (verilog-modi-get-gparams modi) | 8379 | (verilog-modi-get-gparams modi) |
| 8614 | (verilog-modi-get-sub-outputs modi) | 8380 | (verilog-modi-get-sub-outputs modi) |
| 8615 | (verilog-modi-get-sub-inouts modi) | 8381 | (verilog-modi-get-sub-inouts modi))))) |
| 8616 | )))) | ||
| 8617 | (forward-line 1) | 8382 | (forward-line 1) |
| 8618 | (when sig-list | 8383 | (when sig-list |
| 8619 | (verilog-insert-indent "// Beginning of automatic regs (for this module's undeclared outputs)\n") | 8384 | (verilog-insert-indent "// Beginning of automatic regs (for this module's undeclared outputs)\n") |
| 8620 | (verilog-insert-definition sig-list "reg" indent-pt nil) | 8385 | (verilog-insert-definition sig-list "reg" indent-pt nil) |
| 8621 | (verilog-modi-cache-add-regs modi sig-list) | 8386 | (verilog-modi-cache-add-regs modi sig-list) |
| 8622 | (verilog-insert-indent "// End of automatics\n")) | 8387 | (verilog-insert-indent "// End of automatics\n"))))) |
| 8623 | ))) | ||
| 8624 | 8388 | ||
| 8625 | (defun verilog-auto-reg-input () | 8389 | (defun verilog-auto-reg-input () |
| 8626 | "Expand AUTOREGINPUT statements, as part of \\[verilog-auto]. | 8390 | "Expand AUTOREGINPUT statements, as part of \\[verilog-auto]. |
| @@ -8665,15 +8429,13 @@ Typing \\[verilog-auto] will make this into: | |||
| 8665 | (verilog-signals-not-in | 8429 | (verilog-signals-not-in |
| 8666 | (append (verilog-modi-get-sub-inputs modi) | 8430 | (append (verilog-modi-get-sub-inputs modi) |
| 8667 | (verilog-modi-get-sub-inouts modi)) | 8431 | (verilog-modi-get-sub-inouts modi)) |
| 8668 | (verilog-modi-get-signals modi) | 8432 | (verilog-modi-get-signals modi))))) |
| 8669 | )))) | ||
| 8670 | (forward-line 1) | 8433 | (forward-line 1) |
| 8671 | (when sig-list | 8434 | (when sig-list |
| 8672 | (verilog-insert-indent "// Beginning of automatic reg inputs (for undeclared instantiated-module inputs)\n") | 8435 | (verilog-insert-indent "// Beginning of automatic reg inputs (for undeclared instantiated-module inputs)\n") |
| 8673 | (verilog-insert-definition sig-list "reg" indent-pt nil) | 8436 | (verilog-insert-definition sig-list "reg" indent-pt nil) |
| 8674 | (verilog-modi-cache-add-regs modi sig-list) | 8437 | (verilog-modi-cache-add-regs modi sig-list) |
| 8675 | (verilog-insert-indent "// End of automatics\n")) | 8438 | (verilog-insert-indent "// End of automatics\n"))))) |
| 8676 | ))) | ||
| 8677 | 8439 | ||
| 8678 | (defun verilog-auto-wire () | 8440 | (defun verilog-auto-wire () |
| 8679 | "Expand AUTOWIRE statements, as part of \\[verilog-auto]. | 8441 | "Expand AUTOWIRE statements, as part of \\[verilog-auto]. |
| @@ -8726,8 +8488,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 8726 | (verilog-signals-not-in | 8488 | (verilog-signals-not-in |
| 8727 | (append (verilog-modi-get-sub-outputs modi) | 8489 | (append (verilog-modi-get-sub-outputs modi) |
| 8728 | (verilog-modi-get-sub-inouts modi)) | 8490 | (verilog-modi-get-sub-inouts modi)) |
| 8729 | (verilog-modi-get-signals modi) | 8491 | (verilog-modi-get-signals modi))))) |
| 8730 | )))) | ||
| 8731 | (forward-line 1) | 8492 | (forward-line 1) |
| 8732 | (when sig-list | 8493 | (when sig-list |
| 8733 | (verilog-insert-indent "// Beginning of automatic wires (for undeclared instantiated-module outputs)\n") | 8494 | (verilog-insert-indent "// Beginning of automatic wires (for undeclared instantiated-module outputs)\n") |
| @@ -8739,8 +8500,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 8739 | (setq pnt (point)) | 8500 | (setq pnt (point)) |
| 8740 | (verilog-pretty-declarations) | 8501 | (verilog-pretty-declarations) |
| 8741 | (goto-char pnt) | 8502 | (goto-char pnt) |
| 8742 | (verilog-pretty-expr "//"))) | 8503 | (verilog-pretty-expr "//")))))) |
| 8743 | ))) | ||
| 8744 | 8504 | ||
| 8745 | (defun verilog-auto-output () | 8505 | (defun verilog-auto-output () |
| 8746 | "Expand AUTOOUTPUT statements, as part of \\[verilog-auto]. | 8506 | "Expand AUTOOUTPUT statements, as part of \\[verilog-auto]. |
| @@ -8793,8 +8553,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 8793 | (append (verilog-modi-get-outputs modi) | 8553 | (append (verilog-modi-get-outputs modi) |
| 8794 | (verilog-modi-get-inouts modi) | 8554 | (verilog-modi-get-inouts modi) |
| 8795 | (verilog-modi-get-sub-inputs modi) | 8555 | (verilog-modi-get-sub-inputs modi) |
| 8796 | (verilog-modi-get-sub-inouts modi) | 8556 | (verilog-modi-get-sub-inouts modi))))) |
| 8797 | )))) | ||
| 8798 | (setq sig-list (verilog-signals-not-matching-regexp | 8557 | (setq sig-list (verilog-signals-not-matching-regexp |
| 8799 | sig-list verilog-auto-output-ignore-regexp)) | 8558 | sig-list verilog-auto-output-ignore-regexp)) |
| 8800 | (forward-line 1) | 8559 | (forward-line 1) |
| @@ -8804,8 +8563,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 8804 | (verilog-insert-definition sig-list "output" indent-pt v2k) | 8563 | (verilog-insert-definition sig-list "output" indent-pt v2k) |
| 8805 | (verilog-modi-cache-add-outputs modi sig-list) | 8564 | (verilog-modi-cache-add-outputs modi sig-list) |
| 8806 | (verilog-insert-indent "// End of automatics\n")) | 8565 | (verilog-insert-indent "// End of automatics\n")) |
| 8807 | (when v2k (verilog-repair-close-comma)) | 8566 | (when v2k (verilog-repair-close-comma))))) |
| 8808 | ))) | ||
| 8809 | 8567 | ||
| 8810 | (defun verilog-auto-output-every () | 8568 | (defun verilog-auto-output-every () |
| 8811 | "Expand AUTOOUTPUTEVERY statements, as part of \\[verilog-auto]. | 8569 | "Expand AUTOOUTPUTEVERY statements, as part of \\[verilog-auto]. |
| @@ -8847,8 +8605,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 8847 | (sig-list (verilog-signals-combine-bus | 8605 | (sig-list (verilog-signals-combine-bus |
| 8848 | (verilog-signals-not-in | 8606 | (verilog-signals-not-in |
| 8849 | (verilog-modi-get-signals modi) | 8607 | (verilog-modi-get-signals modi) |
| 8850 | (verilog-modi-get-ports modi) | 8608 | (verilog-modi-get-ports modi))))) |
| 8851 | )))) | ||
| 8852 | (forward-line 1) | 8609 | (forward-line 1) |
| 8853 | (when v2k (verilog-repair-open-comma)) | 8610 | (when v2k (verilog-repair-open-comma)) |
| 8854 | (when sig-list | 8611 | (when sig-list |
| @@ -8856,8 +8613,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 8856 | (verilog-insert-definition sig-list "output" indent-pt v2k) | 8613 | (verilog-insert-definition sig-list "output" indent-pt v2k) |
| 8857 | (verilog-modi-cache-add-outputs modi sig-list) | 8614 | (verilog-modi-cache-add-outputs modi sig-list) |
| 8858 | (verilog-insert-indent "// End of automatics\n")) | 8615 | (verilog-insert-indent "// End of automatics\n")) |
| 8859 | (when v2k (verilog-repair-close-comma)) | 8616 | (when v2k (verilog-repair-close-comma))))) |
| 8860 | ))) | ||
| 8861 | 8617 | ||
| 8862 | (defun verilog-auto-input () | 8618 | (defun verilog-auto-input () |
| 8863 | "Expand AUTOINPUT statements, as part of \\[verilog-auto]. | 8619 | "Expand AUTOINPUT statements, as part of \\[verilog-auto]. |
| @@ -8913,8 +8669,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 8913 | (verilog-modi-get-consts modi) | 8669 | (verilog-modi-get-consts modi) |
| 8914 | (verilog-modi-get-gparams modi) | 8670 | (verilog-modi-get-gparams modi) |
| 8915 | (verilog-modi-get-sub-outputs modi) | 8671 | (verilog-modi-get-sub-outputs modi) |
| 8916 | (verilog-modi-get-sub-inouts modi) | 8672 | (verilog-modi-get-sub-inouts modi))))) |
| 8917 | )))) | ||
| 8918 | (setq sig-list (verilog-signals-not-matching-regexp | 8673 | (setq sig-list (verilog-signals-not-matching-regexp |
| 8919 | sig-list verilog-auto-input-ignore-regexp)) | 8674 | sig-list verilog-auto-input-ignore-regexp)) |
| 8920 | (forward-line 1) | 8675 | (forward-line 1) |
| @@ -8924,8 +8679,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 8924 | (verilog-insert-definition sig-list "input" indent-pt v2k) | 8679 | (verilog-insert-definition sig-list "input" indent-pt v2k) |
| 8925 | (verilog-modi-cache-add-inputs modi sig-list) | 8680 | (verilog-modi-cache-add-inputs modi sig-list) |
| 8926 | (verilog-insert-indent "// End of automatics\n")) | 8681 | (verilog-insert-indent "// End of automatics\n")) |
| 8927 | (when v2k (verilog-repair-close-comma)) | 8682 | (when v2k (verilog-repair-close-comma))))) |
| 8928 | ))) | ||
| 8929 | 8683 | ||
| 8930 | (defun verilog-auto-inout () | 8684 | (defun verilog-auto-inout () |
| 8931 | "Expand AUTOINOUT statements, as part of \\[verilog-auto]. | 8685 | "Expand AUTOINOUT statements, as part of \\[verilog-auto]. |
| @@ -8978,8 +8732,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 8978 | (verilog-modi-get-inouts modi) | 8732 | (verilog-modi-get-inouts modi) |
| 8979 | (verilog-modi-get-inputs modi) | 8733 | (verilog-modi-get-inputs modi) |
| 8980 | (verilog-modi-get-sub-inputs modi) | 8734 | (verilog-modi-get-sub-inputs modi) |
| 8981 | (verilog-modi-get-sub-outputs modi) | 8735 | (verilog-modi-get-sub-outputs modi))))) |
| 8982 | )))) | ||
| 8983 | (setq sig-list (verilog-signals-not-matching-regexp | 8736 | (setq sig-list (verilog-signals-not-matching-regexp |
| 8984 | sig-list verilog-auto-inout-ignore-regexp)) | 8737 | sig-list verilog-auto-inout-ignore-regexp)) |
| 8985 | (forward-line 1) | 8738 | (forward-line 1) |
| @@ -8989,8 +8742,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 8989 | (verilog-insert-definition sig-list "inout" indent-pt v2k) | 8742 | (verilog-insert-definition sig-list "inout" indent-pt v2k) |
| 8990 | (verilog-modi-cache-add-inouts modi sig-list) | 8743 | (verilog-modi-cache-add-inouts modi sig-list) |
| 8991 | (verilog-insert-indent "// End of automatics\n")) | 8744 | (verilog-insert-indent "// End of automatics\n")) |
| 8992 | (when v2k (verilog-repair-close-comma)) | 8745 | (when v2k (verilog-repair-close-comma))))) |
| 8993 | ))) | ||
| 8994 | 8746 | ||
| 8995 | (defun verilog-auto-inout-module () | 8747 | (defun verilog-auto-inout-module () |
| 8996 | "Expand AUTOINOUTMODULE statements, as part of \\[verilog-auto]. | 8748 | "Expand AUTOINOUTMODULE statements, as part of \\[verilog-auto]. |
| @@ -9062,8 +8814,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 9062 | (verilog-modi-cache-add-outputs modi sig-list-o) | 8814 | (verilog-modi-cache-add-outputs modi sig-list-o) |
| 9063 | (verilog-modi-cache-add-inouts modi sig-list-io) | 8815 | (verilog-modi-cache-add-inouts modi sig-list-io) |
| 9064 | (verilog-insert-indent "// End of automatics\n")) | 8816 | (verilog-insert-indent "// End of automatics\n")) |
| 9065 | (when v2k (verilog-repair-close-comma)) | 8817 | (when v2k (verilog-repair-close-comma))))))) |
| 9066 | ))))) | ||
| 9067 | 8818 | ||
| 9068 | (defun verilog-auto-sense-sigs (modi presense-sigs) | 8819 | (defun verilog-auto-sense-sigs (modi presense-sigs) |
| 9069 | "Return list of signals for current AUTOSENSE block." | 8820 | "Return list of signals for current AUTOSENSE block." |
| @@ -9164,8 +8915,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 9164 | (not-first (insert " or "))) | 8915 | (not-first (insert " or "))) |
| 9165 | (insert (verilog-sig-name (car sig-list))) | 8916 | (insert (verilog-sig-name (car sig-list))) |
| 9166 | (setq sig-list (cdr sig-list) | 8917 | (setq sig-list (cdr sig-list) |
| 9167 | not-first t)) | 8918 | not-first t))))) |
| 9168 | ))) | ||
| 9169 | 8919 | ||
| 9170 | (defun verilog-auto-reset () | 8920 | (defun verilog-auto-reset () |
| 9171 | "Expand AUTORESET statements, as part of \\[verilog-auto]. | 8921 | "Expand AUTORESET statements, as part of \\[verilog-auto]. |
| @@ -9260,8 +9010,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 9260 | ";\n") | 9010 | ";\n") |
| 9261 | (indent-to indent-pt) | 9011 | (indent-to indent-pt) |
| 9262 | (setq sig-list (cdr sig-list)))) | 9012 | (setq sig-list (cdr sig-list)))) |
| 9263 | (insert "// End of automatics")) | 9013 | (insert "// End of automatics"))))) |
| 9264 | ))) | ||
| 9265 | 9014 | ||
| 9266 | (defun verilog-auto-tieoff () | 9015 | (defun verilog-auto-tieoff () |
| 9267 | "Expand AUTOTIEOFF statements, as part of \\[verilog-auto]. | 9016 | "Expand AUTOTIEOFF statements, as part of \\[verilog-auto]. |
| @@ -9316,8 +9065,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 9316 | (verilog-modi-get-consts modi) | 9065 | (verilog-modi-get-consts modi) |
| 9317 | (verilog-modi-get-gparams modi) | 9066 | (verilog-modi-get-gparams modi) |
| 9318 | (verilog-modi-get-sub-outputs modi) | 9067 | (verilog-modi-get-sub-outputs modi) |
| 9319 | (verilog-modi-get-sub-inouts modi) | 9068 | (verilog-modi-get-sub-inouts modi))))) |
| 9320 | )))) | ||
| 9321 | (when sig-list | 9069 | (when sig-list |
| 9322 | (forward-line 1) | 9070 | (forward-line 1) |
| 9323 | (verilog-insert-indent "// Beginning of automatic tieoffs (for this module's unterminated outputs)\n") | 9071 | (verilog-insert-indent "// Beginning of automatic tieoffs (for this module's unterminated outputs)\n") |
| @@ -9330,8 +9078,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 9330 | (insert "= " (verilog-sig-tieoff sig) | 9078 | (insert "= " (verilog-sig-tieoff sig) |
| 9331 | ";\n") | 9079 | ";\n") |
| 9332 | (setq sig-list (cdr sig-list)))) | 9080 | (setq sig-list (cdr sig-list)))) |
| 9333 | (verilog-insert-indent "// End of automatics\n") | 9081 | (verilog-insert-indent "// End of automatics\n"))))) |
| 9334 | )))) | ||
| 9335 | 9082 | ||
| 9336 | (defun verilog-auto-unused () | 9083 | (defun verilog-auto-unused () |
| 9337 | "Expand AUTOUNUSED statements, as part of \\[verilog-auto]. | 9084 | "Expand AUTOUNUSED statements, as part of \\[verilog-auto]. |
| @@ -9395,8 +9142,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 9395 | (append (verilog-modi-get-inputs modi) | 9142 | (append (verilog-modi-get-inputs modi) |
| 9396 | (verilog-modi-get-inouts modi)) | 9143 | (verilog-modi-get-inouts modi)) |
| 9397 | (append (verilog-modi-get-sub-inputs modi) | 9144 | (append (verilog-modi-get-sub-inputs modi) |
| 9398 | (verilog-modi-get-sub-inouts modi) | 9145 | (verilog-modi-get-sub-inouts modi))))) |
| 9399 | )))) | ||
| 9400 | (setq sig-list (verilog-signals-not-matching-regexp | 9146 | (setq sig-list (verilog-signals-not-matching-regexp |
| 9401 | sig-list verilog-auto-unused-ignore-regexp)) | 9147 | sig-list verilog-auto-unused-ignore-regexp)) |
| 9402 | (when sig-list | 9148 | (when sig-list |
| @@ -9408,8 +9154,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 9408 | (indent-to indent-pt) | 9154 | (indent-to indent-pt) |
| 9409 | (insert (verilog-sig-name sig) ",\n") | 9155 | (insert (verilog-sig-name sig) ",\n") |
| 9410 | (setq sig-list (cdr sig-list)))) | 9156 | (setq sig-list (cdr sig-list)))) |
| 9411 | (verilog-insert-indent "// End of automatics\n") | 9157 | (verilog-insert-indent "// End of automatics\n"))))) |
| 9412 | )))) | ||
| 9413 | 9158 | ||
| 9414 | (defun verilog-enum-ascii (signm elim-regexp) | 9159 | (defun verilog-enum-ascii (signm elim-regexp) |
| 9415 | "Convert a enum name SIGNM to a ascii string for insertion. | 9160 | "Convert a enum name SIGNM to a ascii string for insertion. |
| @@ -9543,8 +9288,7 @@ Typing \\[verilog-auto] will make this into: | |||
| 9543 | (verilog-insert-indent "endcase\n") | 9288 | (verilog-insert-indent "endcase\n") |
| 9544 | (setq indent-pt (- indent-pt verilog-indent-level)) | 9289 | (setq indent-pt (- indent-pt verilog-indent-level)) |
| 9545 | (verilog-insert-indent "end\n" | 9290 | (verilog-insert-indent "end\n" |
| 9546 | "// End of automatics\n") | 9291 | "// End of automatics\n")))) |
| 9547 | ))) | ||
| 9548 | 9292 | ||
| 9549 | (defun verilog-auto-templated-rel () | 9293 | (defun verilog-auto-templated-rel () |
| 9550 | "Replace Templated relative line numbers with absolute line numbers. | 9294 | "Replace Templated relative line numbers with absolute line numbers. |
| @@ -9694,8 +9438,7 @@ Wilson Snyder (wsnyder@wsnyder.org), and/or see http://www.veripool.com." | |||
| 9694 | ;; Must be after all inputs outputs are generated | 9438 | ;; Must be after all inputs outputs are generated |
| 9695 | (verilog-auto-search-do "/*AUTOARG*/" 'verilog-auto-arg) | 9439 | (verilog-auto-search-do "/*AUTOARG*/" 'verilog-auto-arg) |
| 9696 | ;; Fix line numbers (comments only) | 9440 | ;; Fix line numbers (comments only) |
| 9697 | (verilog-auto-templated-rel) | 9441 | (verilog-auto-templated-rel)) |
| 9698 | ) | ||
| 9699 | ;; | 9442 | ;; |
| 9700 | (run-hooks 'verilog-auto-hook) | 9443 | (run-hooks 'verilog-auto-hook) |
| 9701 | ;; | 9444 | ;; |
| @@ -9709,14 +9452,13 @@ Wilson Snyder (wsnyder@wsnyder.org), and/or see http://www.veripool.com." | |||
| 9709 | ;; Unwind forms | 9452 | ;; Unwind forms |
| 9710 | (progn | 9453 | (progn |
| 9711 | ;; Restore font-lock | 9454 | ;; Restore font-lock |
| 9712 | (when fontlocked (font-lock-mode t))) | 9455 | (when fontlocked (font-lock-mode t)))))) |
| 9713 | ))) | ||
| 9714 | 9456 | ||
| 9715 | 9457 | ||
| 9716 | ;; | 9458 | ;; |
| 9717 | ;; Skeleton based code insertion | 9459 | ;; Skeleton based code insertion |
| 9718 | ;; | 9460 | ;; |
| 9719 | (defvar verilog-template-map | 9461 | (defvar verilog-template-map |
| 9720 | (let ((map (make-sparse-keymap))) | 9462 | (let ((map (make-sparse-keymap))) |
| 9721 | (define-key map "a" 'verilog-sk-always) | 9463 | (define-key map "a" 'verilog-sk-always) |
| 9722 | (define-key map "b" 'verilog-sk-begin) | 9464 | (define-key map "b" 'verilog-sk-begin) |
| @@ -9985,16 +9727,14 @@ and the case items." | |||
| 9985 | (defun verilog-sk-define-signal () | 9727 | (defun verilog-sk-define-signal () |
| 9986 | "Insert a definition of signal under point at top of module." | 9728 | "Insert a definition of signal under point at top of module." |
| 9987 | (interactive "*") | 9729 | (interactive "*") |
| 9988 | (let* ( | 9730 | (let* ((sig-re "[a-zA-Z0-9_]*") |
| 9989 | (sig-re "[a-zA-Z0-9_]*") | ||
| 9990 | (v1 (buffer-substring | 9731 | (v1 (buffer-substring |
| 9991 | (save-excursion | 9732 | (save-excursion |
| 9992 | (skip-chars-backward sig-re) | 9733 | (skip-chars-backward sig-re) |
| 9993 | (point)) | 9734 | (point)) |
| 9994 | (save-excursion | 9735 | (save-excursion |
| 9995 | (skip-chars-forward sig-re) | 9736 | (skip-chars-forward sig-re) |
| 9996 | (point)))) | 9737 | (point))))) |
| 9997 | ) | ||
| 9998 | (if (not (member v1 verilog-keywords)) | 9738 | (if (not (member v1 verilog-keywords)) |
| 9999 | (save-excursion | 9739 | (save-excursion |
| 10000 | (setq verilog-sk-signal v1) | 9740 | (setq verilog-sk-signal v1) |
| @@ -10003,10 +9743,7 @@ and the case items." | |||
| 10003 | (verilog-forward-syntactic-ws) | 9743 | (verilog-forward-syntactic-ws) |
| 10004 | (verilog-sk-def-reg) | 9744 | (verilog-sk-def-reg) |
| 10005 | (message "signal at point is %s" v1)) | 9745 | (message "signal at point is %s" v1)) |
| 10006 | (message "object at point (%s) is a keyword" v1)) | 9746 | (message "object at point (%s) is a keyword" v1)))) |
| 10007 | ) | ||
| 10008 | ) | ||
| 10009 | |||
| 10010 | 9747 | ||
| 10011 | (define-skeleton verilog-sk-wire | 9748 | (define-skeleton verilog-sk-wire |
| 10012 | "Insert a wire definition." | 9749 | "Insert a wire definition." |
| @@ -10109,7 +9846,7 @@ and the case items." | |||
| 10109 | "^`include\\s-+\"\\([^\n\"]*\\)\"" | 9846 | "^`include\\s-+\"\\([^\n\"]*\\)\"" |
| 10110 | "Regexp that matches the include file.") | 9847 | "Regexp that matches the include file.") |
| 10111 | 9848 | ||
| 10112 | (defvar verilog-mode-mouse-map | 9849 | (defvar verilog-mode-mouse-map |
| 10113 | (let ((map (make-sparse-keymap))) ; as described in info pages, make a map | 9850 | (let ((map (make-sparse-keymap))) ; as described in info pages, make a map |
| 10114 | (set-keymap-parent map verilog-mode-map) | 9851 | (set-keymap-parent map verilog-mode-map) |
| 10115 | ;; mouse button bindings | 9852 | ;; mouse button bindings |
| @@ -10189,8 +9926,7 @@ Files are checked based on `verilog-library-directories'." | |||
| 10189 | (progn | 9926 | (progn |
| 10190 | (message | 9927 | (message |
| 10191 | "File '%s' isn't readable, use shift-mouse2 to paste in this field" | 9928 | "File '%s' isn't readable, use shift-mouse2 to paste in this field" |
| 10192 | (match-string 1)))) | 9929 | (match-string 1))))))) |
| 10193 | ))) | ||
| 10194 | 9930 | ||
| 10195 | ;; ffap isn't useable for verilog mode. It uses library paths. | 9931 | ;; ffap isn't useable for verilog mode. It uses library paths. |
| 10196 | ;; so define this function to do more or less the same as ffap | 9932 | ;; so define this function to do more or less the same as ffap |
| @@ -10208,8 +9944,7 @@ Files are checked based on `verilog-library-directories'." | |||
| 10208 | (file-readable-p (car (verilog-library-filenames | 9944 | (file-readable-p (car (verilog-library-filenames |
| 10209 | (match-string 1) (buffer-file-name))))) | 9945 | (match-string 1) (buffer-file-name))))) |
| 10210 | (find-file (car (verilog-library-filenames | 9946 | (find-file (car (verilog-library-filenames |
| 10211 | (match-string 1) (buffer-file-name)))))) | 9947 | (match-string 1) (buffer-file-name)))))))) |
| 10212 | )) | ||
| 10213 | 9948 | ||
| 10214 | 9949 | ||
| 10215 | ;; | 9950 | ;; |
| @@ -10230,6 +9965,7 @@ Files are checked based on `verilog-library-directories'." | |||
| 10230 | (princ "\n"))) | 9965 | (princ "\n"))) |
| 10231 | 9966 | ||
| 10232 | (autoload 'reporter-submit-bug-report "reporter") | 9967 | (autoload 'reporter-submit-bug-report "reporter") |
| 9968 | (defvar reporter-prompt-for-summary-p) | ||
| 10233 | 9969 | ||
| 10234 | (defun verilog-submit-bug-report () | 9970 | (defun verilog-submit-bug-report () |
| 10235 | "Submit via mail a bug report on verilog-mode.el." | 9971 | "Submit via mail a bug report on verilog-mode.el." |
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 98818ea8354..72fda808053 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el | |||
| @@ -2047,7 +2047,7 @@ your style, only those that are different from the default.") | |||
| 2047 | (defun vhdl-keep-region-active () | 2047 | (defun vhdl-keep-region-active () |
| 2048 | "Do whatever is necessary to keep the region active in XEmacs. | 2048 | "Do whatever is necessary to keep the region active in XEmacs. |
| 2049 | Ignore byte-compiler warnings you might see." | 2049 | Ignore byte-compiler warnings you might see." |
| 2050 | (and (boundp 'zmacs-region-stays) | 2050 | (and (featurep 'xemacs) |
| 2051 | (setq zmacs-region-stays t))) | 2051 | (setq zmacs-region-stays t))) |
| 2052 | 2052 | ||
| 2053 | ;; `wildcard-to-regexp' is included only in XEmacs 21 | 2053 | ;; `wildcard-to-regexp' is included only in XEmacs 21 |
diff --git a/lisp/repeat.el b/lisp/repeat.el index 8e97abf32e9..fdeec47f7c4 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el | |||
| @@ -200,6 +200,14 @@ this function is always whether the value of `this-command' would've been | |||
| 200 | (defvar repeat-previous-repeated-command nil | 200 | (defvar repeat-previous-repeated-command nil |
| 201 | "The previous repeated command.") | 201 | "The previous repeated command.") |
| 202 | 202 | ||
| 203 | ;; The following variable counts repeated self-insertions. The idea is | ||
| 204 | ;; that repeating a self-insertion command and subsequently undoing it | ||
| 205 | ;; should have almost the same effect as if the characters were inserted | ||
| 206 | ;; manually. The basic difference is that we leave in one undo-boundary | ||
| 207 | ;; between the original insertion and its first repetition. | ||
| 208 | (defvar repeat-undo-count nil | ||
| 209 | "Number of self-insertions since last `undo-boundary'.") | ||
| 210 | |||
| 203 | ;;;###autoload | 211 | ;;;###autoload |
| 204 | (defun repeat (repeat-arg) | 212 | (defun repeat (repeat-arg) |
| 205 | "Repeat most recently executed command. | 213 | "Repeat most recently executed command. |
| @@ -246,12 +254,6 @@ recently executed command not bound to an input event\"." | |||
| 246 | ;; needs to be saved. | 254 | ;; needs to be saved. |
| 247 | (let ((repeat-repeat-char | 255 | (let ((repeat-repeat-char |
| 248 | (if (eq repeat-on-final-keystroke t) | 256 | (if (eq repeat-on-final-keystroke t) |
| 249 | ;; The following commented out since it's equivalent to | ||
| 250 | ;; last-comment-char (martin 2007-08-29). | ||
| 251 | ;;; ;; allow any final input event that was a character | ||
| 252 | ;;; (when (eq last-command-char | ||
| 253 | ;;; last-command-event) | ||
| 254 | ;;; last-command-char) | ||
| 255 | last-command-char | 257 | last-command-char |
| 256 | ;; allow only specified final keystrokes | 258 | ;; allow only specified final keystrokes |
| 257 | (car (memq last-command-char | 259 | (car (memq last-command-char |
| @@ -293,11 +295,22 @@ recently executed command not bound to an input event\"." | |||
| 293 | (i 0)) | 295 | (i 0)) |
| 294 | ;; Run pre- and post-command hooks for self-insertion too. | 296 | ;; Run pre- and post-command hooks for self-insertion too. |
| 295 | (run-hooks 'pre-command-hook) | 297 | (run-hooks 'pre-command-hook) |
| 298 | (cond | ||
| 299 | ((not repeat-undo-count)) | ||
| 300 | ((< repeat-undo-count 20) | ||
| 301 | ;; Don't make an undo-boundary here. | ||
| 302 | (setq repeat-undo-count (1+ repeat-undo-count))) | ||
| 303 | (t | ||
| 304 | ;; Make an undo-boundary after 20 repetitions only. | ||
| 305 | (undo-boundary) | ||
| 306 | (setq repeat-undo-count 1))) | ||
| 296 | (while (< i count) | 307 | (while (< i count) |
| 297 | (repeat-self-insert insertion) | 308 | (repeat-self-insert insertion) |
| 298 | (setq i (1+ i))) | 309 | (setq i (1+ i))) |
| 299 | (run-hooks 'post-command-hook))) | 310 | (run-hooks 'post-command-hook))) |
| 300 | (let ((indirect (indirect-function last-repeatable-command))) | 311 | (let ((indirect (indirect-function last-repeatable-command))) |
| 312 | ;; Make each repetition undo separately. | ||
| 313 | (undo-boundary) | ||
| 301 | (if (or (stringp indirect) | 314 | (if (or (stringp indirect) |
| 302 | (vectorp indirect)) | 315 | (vectorp indirect)) |
| 303 | ;; Bind real-last-command so that executing the macro does | 316 | ;; Bind real-last-command so that executing the macro does |
| @@ -314,12 +327,20 @@ recently executed command not bound to an input event\"." | |||
| 314 | ;; (only 32 repetitions are possible given the default value of 200 for | 327 | ;; (only 32 repetitions are possible given the default value of 200 for |
| 315 | ;; max-lisp-eval-depth), but if I now locally disable the repeat char I | 328 | ;; max-lisp-eval-depth), but if I now locally disable the repeat char I |
| 316 | ;; can iterate indefinitely here around a single level of recursion. | 329 | ;; can iterate indefinitely here around a single level of recursion. |
| 317 | (let (repeat-on-final-keystroke) | 330 | (let (repeat-on-final-keystroke |
| 331 | ;; Bind `undo-inhibit-record-point' to t in order to avoid | ||
| 332 | ;; recording point in `buffer-undo-list' here. We have to | ||
| 333 | ;; do this since the command loop does not set the last | ||
| 334 | ;; position of point thus confusing the point recording | ||
| 335 | ;; mechanism when inserting or deleting text. | ||
| 336 | (undo-inhibit-record-point t)) | ||
| 318 | (setq real-last-command 'repeat) | 337 | (setq real-last-command 'repeat) |
| 319 | (while (eq (read-event) repeat-repeat-char) | 338 | (setq repeat-undo-count 1) |
| 320 | ;; Make each repetition undo separately. | 339 | (unwind-protect |
| 321 | (undo-boundary) | 340 | (while (eq (read-event) repeat-repeat-char) |
| 322 | (repeat repeat-arg)) | 341 | (repeat repeat-arg)) |
| 342 | ;; Make sure `repeat-undo-count' is reset. | ||
| 343 | (setq repeat-undo-count nil)) | ||
| 323 | (setq unread-command-events (list last-input-event)))))) | 344 | (setq unread-command-events (list last-input-event)))))) |
| 324 | 345 | ||
| 325 | (defun repeat-self-insert (string) | 346 | (defun repeat-self-insert (string) |
diff --git a/lisp/replace.el b/lisp/replace.el index 0217e73e44c..3680d574e8c 100644 --- a/lisp/replace.el +++ b/lisp/replace.el | |||
| @@ -789,6 +789,13 @@ See `occur-revert-function'.") | |||
| 789 | :type 'hook | 789 | :type 'hook |
| 790 | :group 'matching) | 790 | :group 'matching) |
| 791 | 791 | ||
| 792 | (defcustom occur-mode-find-occurrence-hook nil | ||
| 793 | "Hook run by Occur after locating an occurrence. | ||
| 794 | This will be called with the cursor position at the occurrence. An application | ||
| 795 | for this is to reveal context in an outline-mode when the occurrence is hidden." | ||
| 796 | :type 'hook | ||
| 797 | :group 'matching) | ||
| 798 | |||
| 792 | (put 'occur-mode 'mode-class 'special) | 799 | (put 'occur-mode 'mode-class 'special) |
| 793 | (defun occur-mode () | 800 | (defun occur-mode () |
| 794 | "Major mode for output from \\[occur]. | 801 | "Major mode for output from \\[occur]. |
| @@ -837,14 +844,16 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. | |||
| 837 | same-window-buffer-names | 844 | same-window-buffer-names |
| 838 | same-window-regexps) | 845 | same-window-regexps) |
| 839 | (pop-to-buffer (marker-buffer pos)) | 846 | (pop-to-buffer (marker-buffer pos)) |
| 840 | (goto-char pos))) | 847 | (goto-char pos) |
| 848 | (run-hooks 'occur-mode-find-occurrence-hook))) | ||
| 841 | 849 | ||
| 842 | (defun occur-mode-goto-occurrence-other-window () | 850 | (defun occur-mode-goto-occurrence-other-window () |
| 843 | "Go to the occurrence the current line describes, in another window." | 851 | "Go to the occurrence the current line describes, in another window." |
| 844 | (interactive) | 852 | (interactive) |
| 845 | (let ((pos (occur-mode-find-occurrence))) | 853 | (let ((pos (occur-mode-find-occurrence))) |
| 846 | (switch-to-buffer-other-window (marker-buffer pos)) | 854 | (switch-to-buffer-other-window (marker-buffer pos)) |
| 847 | (goto-char pos))) | 855 | (goto-char pos) |
| 856 | (run-hooks 'occur-mode-find-occurrence-hook))) | ||
| 848 | 857 | ||
| 849 | (defun occur-mode-display-occurrence () | 858 | (defun occur-mode-display-occurrence () |
| 850 | "Display in another window the occurrence the current line describes." | 859 | "Display in another window the occurrence the current line describes." |
| @@ -858,7 +867,8 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. | |||
| 858 | ;; This is the way to set point in the proper window. | 867 | ;; This is the way to set point in the proper window. |
| 859 | (save-selected-window | 868 | (save-selected-window |
| 860 | (select-window window) | 869 | (select-window window) |
| 861 | (goto-char pos)))) | 870 | (goto-char pos) |
| 871 | (run-hooks 'occur-mode-find-occurrence-hook)))) | ||
| 862 | 872 | ||
| 863 | (defun occur-find-match (n search message) | 873 | (defun occur-find-match (n search message) |
| 864 | (if (not n) (setq n 1)) | 874 | (if (not n) (setq n 1)) |
diff --git a/lisp/server.el b/lisp/server.el index 63245135347..024df504779 100644 --- a/lisp/server.el +++ b/lisp/server.el | |||
| @@ -291,17 +291,29 @@ If NOFRAME is non-nil, let the frames live. (To be used from | |||
| 291 | 291 | ||
| 292 | (server-log "Deleted" proc)))) | 292 | (server-log "Deleted" proc)))) |
| 293 | 293 | ||
| 294 | (defvar server-log-time-function 'current-time-string | ||
| 295 | "Function to generate timestamps for `server-buffer'.") | ||
| 296 | |||
| 297 | (defconst server-buffer " *server*" | ||
| 298 | "Buffer used internally by Emacs's server. | ||
| 299 | One use is to log the I/O for debugging purposes (see `server-log'), | ||
| 300 | the other is to provide a current buffer in which the process filter can | ||
| 301 | safely let-bind buffer-local variables like `default-directory'.") | ||
| 302 | |||
| 303 | (defvar server-log nil | ||
| 304 | "If non-nil, log the server's inputs and outputs in the `server-buffer'.") | ||
| 305 | |||
| 294 | (defun server-log (string &optional client) | 306 | (defun server-log (string &optional client) |
| 295 | "If a *server* buffer exists, write STRING to it for logging purposes. | 307 | "If `server-log' is non-nil, log STRING to `server-buffer'. |
| 296 | If CLIENT is non-nil, add a description of it to the logged message." | 308 | If CLIENT is non-nil, add a description of it to the logged message." |
| 297 | (when (get-buffer "*server*") | 309 | (when server-log |
| 298 | (with-current-buffer "*server*" | 310 | (with-current-buffer (get-buffer-create server-buffer) |
| 299 | (goto-char (point-max)) | 311 | (goto-char (point-max)) |
| 300 | (insert (current-time-string) | 312 | (insert (funcall server-log-time-function) |
| 301 | (cond | 313 | (cond |
| 302 | ((null client) " ") | 314 | ((null client) " ") |
| 303 | ((listp client) (format " %s: " (car client))) | 315 | ((listp client) (format " %s: " (car client))) |
| 304 | (t (format " %s: " client))) | 316 | (t (format " %s: " client))) |
| 305 | string) | 317 | string) |
| 306 | (or (bolp) (newline))))) | 318 | (or (bolp) (newline))))) |
| 307 | 319 | ||
| @@ -494,7 +506,7 @@ kill any existing server communications subprocess." | |||
| 494 | ;; Those are decoded by server-process-filter according | 506 | ;; Those are decoded by server-process-filter according |
| 495 | ;; to file-name-coding-system. | 507 | ;; to file-name-coding-system. |
| 496 | :coding 'raw-text | 508 | :coding 'raw-text |
| 497 | ;; The rest of the args depends on the kind of socket used. | 509 | ;; The other args depend on the kind of socket used. |
| 498 | (if server-use-tcp | 510 | (if server-use-tcp |
| 499 | (list :family nil | 511 | (list :family nil |
| 500 | :service t | 512 | :service t |
| @@ -764,7 +776,7 @@ The following commands are accepted by the client: | |||
| 764 | (server-log (concat "Received " string) proc) | 776 | (server-log (concat "Received " string) proc) |
| 765 | ;; First things first: let's check the authentication | 777 | ;; First things first: let's check the authentication |
| 766 | (unless (process-get proc :authenticated) | 778 | (unless (process-get proc :authenticated) |
| 767 | (if (and (string-match "-auth \\(.*?\\)\n" string) | 779 | (if (and (string-match "-auth \\([!-~]+\\)\n?" string) |
| 768 | (equal (match-string 1 string) (process-get proc :auth-key))) | 780 | (equal (match-string 1 string) (process-get proc :auth-key))) |
| 769 | (progn | 781 | (progn |
| 770 | (setq string (substring string (match-end 0))) | 782 | (setq string (substring string (match-end 0))) |
| @@ -805,8 +817,7 @@ The following commands are accepted by the client: | |||
| 805 | (tty-name nil) ;nil, `window-system', or the tty name. | 817 | (tty-name nil) ;nil, `window-system', or the tty name. |
| 806 | tty-type ;string. | 818 | tty-type ;string. |
| 807 | (files nil) | 819 | (files nil) |
| 808 | (lineno 1) | 820 | (filepos nil) |
| 809 | (columnno 0) | ||
| 810 | command-line-args-left | 821 | command-line-args-left |
| 811 | arg) | 822 | arg) |
| 812 | ;; Remove this line from STRING. | 823 | ;; Remove this line from STRING. |
| @@ -876,9 +887,9 @@ The following commands are accepted by the client: | |||
| 876 | (string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?" | 887 | (string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?" |
| 877 | (car command-line-args-left))) | 888 | (car command-line-args-left))) |
| 878 | (setq arg (pop command-line-args-left)) | 889 | (setq arg (pop command-line-args-left)) |
| 879 | (setq lineno (string-to-number (match-string 1 arg)) | 890 | (setq filepos |
| 880 | columnno (if (null (match-end 2)) 0 | 891 | (cons (string-to-number (match-string 1 arg)) |
| 881 | (string-to-number (match-string 2 arg))))) | 892 | (string-to-number (or (match-string 2 arg) ""))))) |
| 882 | 893 | ||
| 883 | ;; -file FILENAME: Load the given file. | 894 | ;; -file FILENAME: Load the given file. |
| 884 | ((and (equal "-file" arg) | 895 | ((and (equal "-file" arg) |
| @@ -887,11 +898,10 @@ The following commands are accepted by the client: | |||
| 887 | (if coding-system | 898 | (if coding-system |
| 888 | (setq file (decode-coding-string file coding-system))) | 899 | (setq file (decode-coding-string file coding-system))) |
| 889 | (setq file (command-line-normalize-file-name file)) | 900 | (setq file (command-line-normalize-file-name file)) |
| 890 | (push (list file lineno columnno) files) | 901 | (push (cons file filepos) files) |
| 891 | (server-log (format "New file: %s (%d:%d)" | 902 | (server-log (format "New file: %s %s" |
| 892 | file lineno columnno) proc)) | 903 | file (or filepos "")) proc)) |
| 893 | (setq lineno 1 | 904 | (setq filepos nil)) |
| 894 | columnno 0)) | ||
| 895 | 905 | ||
| 896 | ;; -eval EXPR: Evaluate a Lisp expression. | 906 | ;; -eval EXPR: Evaluate a Lisp expression. |
| 897 | ((and (equal "-eval" arg) | 907 | ((and (equal "-eval" arg) |
| @@ -901,8 +911,7 @@ The following commands are accepted by the client: | |||
| 901 | (setq expr (decode-coding-string expr coding-system))) | 911 | (setq expr (decode-coding-string expr coding-system))) |
| 902 | (push (lambda () (server-eval-and-print expr proc)) | 912 | (push (lambda () (server-eval-and-print expr proc)) |
| 903 | commands) | 913 | commands) |
| 904 | (setq lineno 1 | 914 | (setq filepos nil))) |
| 905 | columnno 0))) | ||
| 906 | 915 | ||
| 907 | ;; -env NAME=VALUE: An environment variable. | 916 | ;; -env NAME=VALUE: An environment variable. |
| 908 | ((and (equal "-env" arg) command-line-args-left) | 917 | ((and (equal "-env" arg) command-line-args-left) |
| @@ -928,17 +937,25 @@ The following commands are accepted by the client: | |||
| 928 | (server-create-window-system-frame display nowait proc)) | 937 | (server-create-window-system-frame display nowait proc)) |
| 929 | (t (server-create-tty-frame tty-name tty-type proc)))) | 938 | (t (server-create-tty-frame tty-name tty-type proc)))) |
| 930 | 939 | ||
| 931 | (process-put proc 'continuation | 940 | (process-put |
| 932 | (lexical-let ((proc proc) | 941 | proc 'continuation |
| 933 | (files files) | 942 | (lexical-let ((proc proc) |
| 934 | (nowait nowait) | 943 | (files files) |
| 935 | (commands commands) | 944 | (nowait nowait) |
| 936 | (dontkill dontkill) | 945 | (commands commands) |
| 937 | (frame frame) | 946 | (dontkill dontkill) |
| 938 | (tty-name tty-name)) | 947 | (frame frame) |
| 939 | (lambda () | 948 | (dir dir) |
| 940 | (server-execute proc files nowait commands | 949 | (tty-name tty-name)) |
| 941 | dontkill frame tty-name)))) | 950 | (lambda () |
| 951 | (with-current-buffer (get-buffer-create server-buffer) | ||
| 952 | ;; Use the same cwd as the emacsclient, if possible, so | ||
| 953 | ;; relative file names work correctly, even in `eval'. | ||
| 954 | (let ((default-directory | ||
| 955 | (if (and dir (file-directory-p dir)) | ||
| 956 | dir default-directory))) | ||
| 957 | (server-execute proc files nowait commands | ||
| 958 | dontkill frame tty-name)))))) | ||
| 942 | 959 | ||
| 943 | (when (or frame files) | 960 | (when (or frame files) |
| 944 | (server-goto-toplevel proc)) | 961 | (server-goto-toplevel proc)) |
| @@ -991,18 +1008,19 @@ The following commands are accepted by the client: | |||
| 991 | (server-log (error-message-string err) proc) | 1008 | (server-log (error-message-string err) proc) |
| 992 | (delete-process proc))) | 1009 | (delete-process proc))) |
| 993 | 1010 | ||
| 994 | (defun server-goto-line-column (file-line-col) | 1011 | (defun server-goto-line-column (line-col) |
| 995 | "Move point to the position indicated in FILE-LINE-COL. | 1012 | "Move point to the position indicated in LINE-COL. |
| 996 | FILE-LINE-COL should be a three-element list as described in | 1013 | LINE-COL should be a pair (LINE . COL)." |
| 997 | `server-visit-files'." | 1014 | (when line-col |
| 998 | (goto-line (nth 1 file-line-col)) | 1015 | (goto-line (car line-col)) |
| 999 | (let ((column-number (nth 2 file-line-col))) | 1016 | (let ((column-number (cdr line-col))) |
| 1000 | (when (> column-number 0) | 1017 | (when (> column-number 0) |
| 1001 | (move-to-column (1- column-number))))) | 1018 | (move-to-column (1- column-number)))))) |
| 1002 | 1019 | ||
| 1003 | (defun server-visit-files (files proc &optional nowait) | 1020 | (defun server-visit-files (files proc &optional nowait) |
| 1004 | "Find FILES and return a list of buffers created. | 1021 | "Find FILES and return a list of buffers created. |
| 1005 | FILES is an alist whose elements are (FILENAME LINENUMBER COLUMNNUMBER). | 1022 | FILES is an alist whose elements are (FILENAME . FILEPOS) |
| 1023 | where FILEPOS can be nil or a pair (LINENUMBER . COLUMNNUMBER). | ||
| 1006 | PROC is the client that requested this operation. | 1024 | PROC is the client that requested this operation. |
| 1007 | NOWAIT non-nil means this client is not waiting for the results, | 1025 | NOWAIT non-nil means this client is not waiting for the results, |
| 1008 | so don't mark these buffers specially, just visit them normally." | 1026 | so don't mark these buffers specially, just visit them normally." |
| @@ -1021,22 +1039,21 @@ so don't mark these buffers specially, just visit them normally." | |||
| 1021 | (filen (car file)) | 1039 | (filen (car file)) |
| 1022 | (obuf (get-file-buffer filen))) | 1040 | (obuf (get-file-buffer filen))) |
| 1023 | (add-to-history 'file-name-history filen) | 1041 | (add-to-history 'file-name-history filen) |
| 1024 | (if (and obuf (set-buffer obuf)) | 1042 | (if (null obuf) |
| 1025 | (progn | 1043 | (set-buffer (find-file-noselect filen)) |
| 1026 | (cond ((file-exists-p filen) | 1044 | (set-buffer obuf) |
| 1027 | (when (not (verify-visited-file-modtime obuf)) | 1045 | (cond ((file-exists-p filen) |
| 1028 | (revert-buffer t nil))) | 1046 | (when (not (verify-visited-file-modtime obuf)) |
| 1029 | (t | 1047 | (revert-buffer t nil))) |
| 1030 | (when (y-or-n-p | 1048 | (t |
| 1031 | (concat "File no longer exists: " filen | 1049 | (when (y-or-n-p |
| 1032 | ", write buffer to file? ")) | 1050 | (concat "File no longer exists: " filen |
| 1033 | (write-file filen)))) | 1051 | ", write buffer to file? ")) |
| 1034 | (unless server-buffer-clients | 1052 | (write-file filen)))) |
| 1035 | (setq server-existing-buffer t)) | 1053 | (unless server-buffer-clients |
| 1036 | (server-goto-line-column file)) | 1054 | (setq server-existing-buffer t))) |
| 1037 | (set-buffer (find-file-noselect filen)) | 1055 | (server-goto-line-column (cdr file)) |
| 1038 | (server-goto-line-column file) | 1056 | (run-hooks 'server-visit-hook)) |
| 1039 | (run-hooks 'server-visit-hook))) | ||
| 1040 | (unless nowait | 1057 | (unless nowait |
| 1041 | ;; When the buffer is killed, inform the clients. | 1058 | ;; When the buffer is killed, inform the clients. |
| 1042 | (add-hook 'kill-buffer-hook 'server-kill-buffer nil t) | 1059 | (add-hook 'kill-buffer-hook 'server-kill-buffer nil t) |
diff --git a/lisp/smerge-mode.el b/lisp/smerge-mode.el index b72107eb6c3..f2a7a9caf9e 100644 --- a/lisp/smerge-mode.el +++ b/lisp/smerge-mode.el | |||
| @@ -851,10 +851,12 @@ replace chars to try and eliminate some spurious differences." | |||
| 851 | (remove-overlays (match-beginning 0) (match-end 0) 'smerge 'refine) | 851 | (remove-overlays (match-beginning 0) (match-end 0) 'smerge 'refine) |
| 852 | (smerge-ensure-match 1) | 852 | (smerge-ensure-match 1) |
| 853 | (smerge-ensure-match 3) | 853 | (smerge-ensure-match 3) |
| 854 | (smerge-refine-subst (match-beginning 1) (match-end 1) | 854 | ;; Match 1 and 3 may be one and the same in case of trivial diff3 -A conflict. |
| 855 | (match-beginning 3) (match-end 3) | 855 | (let ((n1 (if (eq (match-end 1) (match-end 3)) 2 1))) |
| 856 | '((smerge . refine) | 856 | (smerge-refine-subst (match-beginning n1) (match-end n1) |
| 857 | (face . smerge-refined-change)))) | 857 | (match-beginning 3) (match-end 3) |
| 858 | '((smerge . refine) | ||
| 859 | (face . smerge-refined-change))))) | ||
| 858 | 860 | ||
| 859 | (defun smerge-diff (n1 n2) | 861 | (defun smerge-diff (n1 n2) |
| 860 | (smerge-match-conflict) | 862 | (smerge-match-conflict) |
| @@ -992,6 +994,32 @@ buffer names." | |||
| 992 | (message "Conflict resolution finished; you may save the buffer"))))) | 994 | (message "Conflict resolution finished; you may save the buffer"))))) |
| 993 | (message "Please resolve conflicts now; exit ediff when done"))) | 995 | (message "Please resolve conflicts now; exit ediff when done"))) |
| 994 | 996 | ||
| 997 | (defun smerge-makeup-conflict (pt1 pt2 pt3 &optional pt4) | ||
| 998 | "Insert diff3 markers to make a new conflict. | ||
| 999 | Uses point and mark for 2 of the relevant positions and previous marks | ||
| 1000 | for the other ones. | ||
| 1001 | By default, makes up a 2-way conflict, | ||
| 1002 | with a \\[universal-argument] prefix, makes up a 3-way conflict." | ||
| 1003 | (interactive | ||
| 1004 | (list (point) | ||
| 1005 | (mark) | ||
| 1006 | (progn (pop-mark) (mark)) | ||
| 1007 | (when current-prefix-arg (pop-mark) (mark)))) | ||
| 1008 | ;; Start from the end so as to avoid problems with pos-changes. | ||
| 1009 | (destructuring-bind (pt1 pt2 pt3 &optional pt4) | ||
| 1010 | (sort (list* pt1 pt2 pt3 (if pt4 (list pt4))) '>=) | ||
| 1011 | (goto-char pt1) (beginning-of-line) | ||
| 1012 | (insert ">>>>>>> OTHER\n") | ||
| 1013 | (goto-char pt2) (beginning-of-line) | ||
| 1014 | (insert "=======\n") | ||
| 1015 | (goto-char pt3) (beginning-of-line) | ||
| 1016 | (when pt4 | ||
| 1017 | (insert "||||||| BASE\n") | ||
| 1018 | (goto-char pt4) (beginning-of-line)) | ||
| 1019 | (insert "<<<<<<< MINE\n")) | ||
| 1020 | (if smerge-mode nil (smerge-mode 1)) | ||
| 1021 | (smerge-refine)) | ||
| 1022 | |||
| 995 | 1023 | ||
| 996 | (defconst smerge-parsep-re | 1024 | (defconst smerge-parsep-re |
| 997 | (concat smerge-begin-re "\\|" smerge-end-re "\\|" | 1025 | (concat smerge-begin-re "\\|" smerge-end-re "\\|" |
| @@ -1021,6 +1049,14 @@ buffer names." | |||
| 1021 | (unless smerge-mode | 1049 | (unless smerge-mode |
| 1022 | (smerge-remove-props (point-min) (point-max)))) | 1050 | (smerge-remove-props (point-min) (point-max)))) |
| 1023 | 1051 | ||
| 1052 | ;;;###autoload | ||
| 1053 | (defun smerge-start-session () | ||
| 1054 | "Turn on `smerge-mode' and move point to first conflict marker. | ||
| 1055 | If no conflict maker is found, turn off `smerge-mode'." | ||
| 1056 | (smerge-mode 1) | ||
| 1057 | (condition-case nil | ||
| 1058 | (smerge-next) | ||
| 1059 | (error (smerge-auto-leave)))) | ||
| 1024 | 1060 | ||
| 1025 | (provide 'smerge-mode) | 1061 | (provide 'smerge-mode) |
| 1026 | 1062 | ||
diff --git a/lisp/subr.el b/lisp/subr.el index 2ce5fff571d..8c7d89591d9 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -1103,7 +1103,17 @@ function, it is changed to a list of functions." | |||
| 1103 | (append hook-value (list function)) | 1103 | (append hook-value (list function)) |
| 1104 | (cons function hook-value)))) | 1104 | (cons function hook-value)))) |
| 1105 | ;; Set the actual variable | 1105 | ;; Set the actual variable |
| 1106 | (if local (set hook hook-value) (set-default hook hook-value)))) | 1106 | (if local |
| 1107 | (progn | ||
| 1108 | ;; If HOOK isn't a permanent local, | ||
| 1109 | ;; but FUNCTION wants to survive a change of modes, | ||
| 1110 | ;; mark HOOK as partially permanent. | ||
| 1111 | (and (symbolp function) | ||
| 1112 | (get function 'permanent-local-hook) | ||
| 1113 | (not (get hook 'permanent-local)) | ||
| 1114 | (put hook 'permanent-local 'permanent-local-hook)) | ||
| 1115 | (set hook hook-value)) | ||
| 1116 | (set-default hook hook-value)))) | ||
| 1107 | 1117 | ||
| 1108 | (defun remove-hook (hook function &optional local) | 1118 | (defun remove-hook (hook function &optional local) |
| 1109 | "Remove from the value of HOOK the function FUNCTION. | 1119 | "Remove from the value of HOOK the function FUNCTION. |
| @@ -1860,6 +1870,10 @@ user can undo the change normally." | |||
| 1860 | (let ((handle (make-symbol "--change-group-handle--")) | 1870 | (let ((handle (make-symbol "--change-group-handle--")) |
| 1861 | (success (make-symbol "--change-group-success--"))) | 1871 | (success (make-symbol "--change-group-success--"))) |
| 1862 | `(let ((,handle (prepare-change-group)) | 1872 | `(let ((,handle (prepare-change-group)) |
| 1873 | ;; Don't truncate any undo data in the middle of this. | ||
| 1874 | (undo-outer-limit nil) | ||
| 1875 | (undo-limit most-positive-fixnum) | ||
| 1876 | (undo-strong-limit most-positive-fixnum) | ||
| 1863 | (,success nil)) | 1877 | (,success nil)) |
| 1864 | (unwind-protect | 1878 | (unwind-protect |
| 1865 | (progn | 1879 | (progn |
| @@ -2113,26 +2127,29 @@ Note that this should end with a directory separator.") | |||
| 2113 | (defun find-tag-default () | 2127 | (defun find-tag-default () |
| 2114 | "Determine default tag to search for, based on text at point. | 2128 | "Determine default tag to search for, based on text at point. |
| 2115 | If there is no plausible default, return nil." | 2129 | If there is no plausible default, return nil." |
| 2116 | (save-excursion | 2130 | (let (from to bound) |
| 2117 | (while (looking-at "\\sw\\|\\s_") | 2131 | (when (or (progn |
| 2118 | (forward-char 1)) | 2132 | ;; Look at text around `point'. |
| 2119 | (if (or (re-search-backward "\\sw\\|\\s_" | 2133 | (save-excursion |
| 2120 | (save-excursion (beginning-of-line) (point)) | 2134 | (skip-syntax-backward "w_") (setq from (point))) |
| 2121 | t) | 2135 | (save-excursion |
| 2122 | (re-search-forward "\\(\\sw\\|\\s_\\)+" | 2136 | (skip-syntax-forward "w_") (setq to (point))) |
| 2123 | (save-excursion (end-of-line) (point)) | 2137 | (> to from)) |
| 2124 | t)) | 2138 | ;; Look between `line-beginning-position' and `point'. |
| 2125 | (progn | 2139 | (save-excursion |
| 2126 | (goto-char (match-end 0)) | 2140 | (and (setq bound (line-beginning-position)) |
| 2127 | (condition-case nil | 2141 | (skip-syntax-backward "^w_" bound) |
| 2128 | (buffer-substring-no-properties | 2142 | (> (setq to (point)) bound) |
| 2129 | (point) | 2143 | (skip-syntax-backward "w_") |
| 2130 | (progn (forward-sexp -1) | 2144 | (setq from (point)))) |
| 2131 | (while (looking-at "\\s'") | 2145 | ;; Look between `point' and `line-end-position'. |
| 2132 | (forward-char 1)) | 2146 | (save-excursion |
| 2133 | (point))) | 2147 | (and (setq bound (line-end-position)) |
| 2134 | (error nil))) | 2148 | (skip-syntax-forward "^w_" bound) |
| 2135 | nil))) | 2149 | (< (setq from (point)) bound) |
| 2150 | (skip-syntax-forward "w_") | ||
| 2151 | (setq to (point))))) | ||
| 2152 | (buffer-substring-no-properties from to)))) | ||
| 2136 | 2153 | ||
| 2137 | (defun play-sound (sound) | 2154 | (defun play-sound (sound) |
| 2138 | "SOUND is a list of the form `(sound KEYWORD VALUE...)'. | 2155 | "SOUND is a list of the form `(sound KEYWORD VALUE...)'. |
diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el index 1a000f37470..a89fe142551 100644 --- a/lisp/t-mouse.el +++ b/lisp/t-mouse.el | |||
| @@ -4,7 +4,8 @@ | |||
| 4 | ;; Maintainer: FSF | 4 | ;; Maintainer: FSF |
| 5 | ;; Keywords: mouse gpm linux | 5 | ;; Keywords: mouse gpm linux |
| 6 | 6 | ||
| 7 | ;; Copyright (C) 1994, 1995, 1998, 2006, 2007, 2008 Free Software Foundation, Inc. | 7 | ;; Copyright (C) 1994, 1995, 1998, 2006, 2007, 2008 |
| 8 | ;; Free Software Foundation, Inc. | ||
| 8 | 9 | ||
| 9 | ;; This file is part of GNU Emacs. | 10 | ;; This file is part of GNU Emacs. |
| 10 | 11 | ||
| @@ -39,6 +40,9 @@ | |||
| 39 | 40 | ||
| 40 | ;;; Code: | 41 | ;;; Code: |
| 41 | 42 | ||
| 43 | ;; Prevent warning when compiling in an Emacs without gpm support. | ||
| 44 | (declare-function gpm-mouse-start "term.c" ()) | ||
| 45 | |||
| 42 | ;;;###autoload | 46 | ;;;###autoload |
| 43 | (define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1") | 47 | (define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1") |
| 44 | ;;;###autoload | 48 | ;;;###autoload |
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 23d5af1bc63..ed974160382 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el | |||
| @@ -785,7 +785,8 @@ appear on disk when you save the tar-file's buffer." | |||
| 785 | (narrow-to-region (point-min) tar-header-offset) | 785 | (narrow-to-region (point-min) tar-header-offset) |
| 786 | (goto-char pos))) | 786 | (goto-char pos))) |
| 787 | (if view-p | 787 | (if view-p |
| 788 | (view-buffer buffer (and just-created 'kill-buffer)) | 788 | (view-buffer |
| 789 | buffer (and just-created 'kill-buffer-if-not-modified)) | ||
| 789 | (if (eq other-window-p 'display) | 790 | (if (eq other-window-p 'display) |
| 790 | (display-buffer buffer) | 791 | (display-buffer buffer) |
| 791 | (if other-window-p | 792 | (if other-window-p |
diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el index f45d7e0ad7a..c5f34a668b0 100644 --- a/lisp/term/w32console.el +++ b/lisp/term/w32console.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; w32console.el -- Setup w32 console keys and colors. | 1 | ;;; w32console.el -- Setup w32 console keys and colors. |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: FSF | 5 | ;; Author: FSF |
| 6 | ;; Keywords: terminals | 6 | ;; Keywords: terminals |
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 9cdd3082168..1544e4fd24f 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el | |||
| @@ -119,6 +119,7 @@ inherit-booktitle If entry contains a crossref field and the booktitle | |||
| 119 | realign Realign entries, so that field texts and perhaps equal | 119 | realign Realign entries, so that field texts and perhaps equal |
| 120 | signs (depending on the value of | 120 | signs (depending on the value of |
| 121 | `bibtex-align-at-equal-sign') begin in the same column. | 121 | `bibtex-align-at-equal-sign') begin in the same column. |
| 122 | Also fill fields. | ||
| 122 | last-comma Add or delete comma on end of last field in entry, | 123 | last-comma Add or delete comma on end of last field in entry, |
| 123 | according to value of `bibtex-comma-after-last-field'. | 124 | according to value of `bibtex-comma-after-last-field'. |
| 124 | delimiters Change delimiters according to variables | 125 | delimiters Change delimiters according to variables |
| @@ -1085,6 +1086,7 @@ Used by `bibtex-find-crossref' and for font-locking." | |||
| 1085 | "--" | 1086 | "--" |
| 1086 | ["Convert Alien Buffer" bibtex-convert-alien t]) | 1087 | ["Convert Alien Buffer" bibtex-convert-alien t]) |
| 1087 | ("Operating on Multiple Buffers" | 1088 | ("Operating on Multiple Buffers" |
| 1089 | ["(Re)Initialize BibTeX Buffers" bibtex-initialize t] | ||
| 1088 | ["Validate Entries" bibtex-validate-globally t]))) | 1090 | ["Validate Entries" bibtex-validate-globally t]))) |
| 1089 | 1091 | ||
| 1090 | (easy-menu-define | 1092 | (easy-menu-define |
| @@ -1782,7 +1784,7 @@ If FLAG is nil, a message is echoed if point was incremented at least | |||
| 1782 | ")")) | 1784 | ")")) |
| 1783 | 1785 | ||
| 1784 | (defun bibtex-flash-head (prompt) | 1786 | (defun bibtex-flash-head (prompt) |
| 1785 | "Flash at BibTeX entry head before point, if exists." | 1787 | "Flash at BibTeX entry head before point, if it exists." |
| 1786 | (let ((case-fold-search t) | 1788 | (let ((case-fold-search t) |
| 1787 | (pnt (point))) | 1789 | (pnt (point))) |
| 1788 | (save-excursion | 1790 | (save-excursion |
| @@ -1790,7 +1792,8 @@ If FLAG is nil, a message is echoed if point was incremented at least | |||
| 1790 | (when (and (looking-at bibtex-any-entry-maybe-empty-head) | 1792 | (when (and (looking-at bibtex-any-entry-maybe-empty-head) |
| 1791 | (< (point) pnt)) | 1793 | (< (point) pnt)) |
| 1792 | (goto-char (match-beginning bibtex-type-in-head)) | 1794 | (goto-char (match-beginning bibtex-type-in-head)) |
| 1793 | (if (pos-visible-in-window-p (point)) | 1795 | (if (and (< 0 blink-matching-delay) |
| 1796 | (pos-visible-in-window-p (point))) | ||
| 1794 | (sit-for blink-matching-delay) | 1797 | (sit-for blink-matching-delay) |
| 1795 | (message "%s%s" prompt (buffer-substring-no-properties | 1798 | (message "%s%s" prompt (buffer-substring-no-properties |
| 1796 | (point) (match-end bibtex-key-in-head)))))))) | 1799 | (point) (match-end bibtex-key-in-head)))))))) |
| @@ -1875,38 +1878,42 @@ Optional arg COMMA is as in `bibtex-enclosing-field'." | |||
| 1875 | (defun bibtex-format-entry () | 1878 | (defun bibtex-format-entry () |
| 1876 | "Helper function for `bibtex-clean-entry'. | 1879 | "Helper function for `bibtex-clean-entry'. |
| 1877 | Formats current entry according to variable `bibtex-entry-format'." | 1880 | Formats current entry according to variable `bibtex-entry-format'." |
| 1881 | ;; initialize `bibtex-field-braces-opt' if necessary | ||
| 1882 | (if (and bibtex-field-braces-alist (not bibtex-field-braces-opt)) | ||
| 1883 | (setq bibtex-field-braces-opt | ||
| 1884 | (bibtex-field-re-init bibtex-field-braces-alist 'braces))) | ||
| 1885 | ;; initialize `bibtex-field-strings-opt' if necessary | ||
| 1886 | (if (and bibtex-field-strings-alist (not bibtex-field-strings-opt)) | ||
| 1887 | (setq bibtex-field-strings-opt | ||
| 1888 | (bibtex-field-re-init bibtex-field-strings-alist 'strings))) | ||
| 1889 | |||
| 1878 | (save-excursion | 1890 | (save-excursion |
| 1879 | (save-restriction | 1891 | (save-restriction |
| 1880 | (bibtex-narrow-to-entry) | 1892 | (bibtex-narrow-to-entry) |
| 1881 | (let ((case-fold-search t) | 1893 | (let ((case-fold-search t) |
| 1882 | (format (if (eq bibtex-entry-format t) | 1894 | (format (if (eq bibtex-entry-format t) |
| 1883 | '(realign opts-or-alts required-fields | 1895 | '(realign opts-or-alts required-fields numerical-fields |
| 1884 | numerical-fields | 1896 | page-dashes whitespace inherit-booktitle |
| 1885 | last-comma page-dashes delimiters | 1897 | last-comma delimiters unify-case braces |
| 1886 | unify-case inherit-booktitle) | 1898 | strings) |
| 1887 | bibtex-entry-format)) | 1899 | bibtex-entry-format)) |
| 1888 | crossref-key bounds alternatives-there non-empty-alternative | 1900 | bounds crossref-key req-field-list default-field-list field-list) |
| 1889 | entry-list req-field-list field-list) | 1901 | |
| 1890 | 1902 | ;; There are more elegant high-level functions for several tasks | |
| 1891 | ;; Initialize `bibtex-field-braces-opt' and `bibtex-field-strings-opt' | 1903 | ;; done by `bibtex-format-entry'. However, they contain some |
| 1892 | ;; if necessary. | 1904 | ;; redundancy compared with what we need to do anyway. |
| 1893 | (unless bibtex-field-braces-opt | 1905 | ;; So for speed-up we avoid using them. |
| 1894 | (setq bibtex-field-braces-opt | 1906 | ;; (`bibtex-format-entry' is called many times by `bibtex-reformat'.) |
| 1895 | (bibtex-field-re-init bibtex-field-braces-alist 'braces))) | ||
| 1896 | (unless bibtex-field-strings-opt | ||
| 1897 | (setq bibtex-field-strings-opt | ||
| 1898 | (bibtex-field-re-init bibtex-field-strings-alist 'strings))) | ||
| 1899 | 1907 | ||
| 1900 | ;; identify entry type | 1908 | ;; identify entry type |
| 1901 | (goto-char (point-min)) | 1909 | (goto-char (point-min)) |
| 1902 | (or (re-search-forward bibtex-entry-type nil t) | 1910 | (or (re-search-forward bibtex-entry-type nil t) |
| 1903 | (error "Not inside a BibTeX entry")) | 1911 | (error "Not inside a BibTeX entry")) |
| 1904 | (let ((beg-type (1+ (match-beginning 0))) | 1912 | (let* ((beg-type (1+ (match-beginning 0))) |
| 1905 | (end-type (match-end 0))) | 1913 | (end-type (match-end 0)) |
| 1906 | (setq entry-list (assoc-string (buffer-substring-no-properties | 1914 | (entry-list (assoc-string (buffer-substring-no-properties |
| 1907 | beg-type end-type) | 1915 | beg-type end-type) |
| 1908 | bibtex-entry-field-alist | 1916 | bibtex-entry-field-alist t))) |
| 1909 | t)) | ||
| 1910 | 1917 | ||
| 1911 | ;; unify case of entry name | 1918 | ;; unify case of entry name |
| 1912 | (when (memq 'unify-case format) | 1919 | (when (memq 'unify-case format) |
| @@ -1918,35 +1925,24 @@ Formats current entry according to variable `bibtex-entry-format'." | |||
| 1918 | (goto-char end-type) | 1925 | (goto-char end-type) |
| 1919 | (skip-chars-forward " \t\n") | 1926 | (skip-chars-forward " \t\n") |
| 1920 | (delete-char 1) | 1927 | (delete-char 1) |
| 1921 | (insert (bibtex-entry-left-delimiter)))) | 1928 | (insert (bibtex-entry-left-delimiter))) |
| 1922 | 1929 | ||
| 1923 | ;; determine if entry has crossref field and if at least | 1930 | ;; Do we have a crossref key? |
| 1924 | ;; one alternative is non-empty | 1931 | (goto-char (point-min)) |
| 1925 | (goto-char (point-min)) | 1932 | (if (setq bounds (bibtex-search-forward-field "crossref")) |
| 1926 | (let* ((fields-alist (bibtex-parse-entry t)) | 1933 | (let ((text (bibtex-text-in-field-bounds bounds t))) |
| 1927 | (field (assoc-string "crossref" fields-alist t))) | 1934 | (unless (equal "" text) |
| 1928 | (setq crossref-key (and field | 1935 | (setq crossref-key text)))) |
| 1929 | (not (equal "" (cdr field))) | 1936 | |
| 1930 | (cdr field)) | 1937 | ;; list of required fields appropriate for an entry with |
| 1931 | req-field-list (if crossref-key | 1938 | ;; or without crossref key. |
| 1932 | (nth 0 (nth 2 entry-list)) ; crossref part | 1939 | (setq req-field-list (if (and crossref-key (nth 2 entry-list)) |
| 1933 | (nth 0 (nth 1 entry-list)))) ; required part | 1940 | (car (nth 2 entry-list)) |
| 1934 | 1941 | (car (nth 1 entry-list))) | |
| 1935 | (dolist (rfield req-field-list) | 1942 | ;; default list of fields that may appear in this entry |
| 1936 | (when (nth 3 rfield) ; we should have an alternative | 1943 | default-field-list (append (nth 0 (nth 1 entry-list)) |
| 1937 | (setq alternatives-there t | 1944 | (nth 1 (nth 1 entry-list)) |
| 1938 | field (assoc-string (car rfield) fields-alist t)) | 1945 | bibtex-user-optional-fields))) |
| 1939 | (if (and field | ||
| 1940 | (not (equal "" (cdr field)))) | ||
| 1941 | (cond ((not non-empty-alternative) | ||
| 1942 | (setq non-empty-alternative t)) | ||
| 1943 | ((memq 'required-fields format) | ||
| 1944 | (error "More than one non-empty alternative"))))))) | ||
| 1945 | |||
| 1946 | (if (and alternatives-there | ||
| 1947 | (not non-empty-alternative) | ||
| 1948 | (memq 'required-fields format)) | ||
| 1949 | (error "All alternatives are empty")) | ||
| 1950 | 1946 | ||
| 1951 | ;; process all fields | 1947 | ;; process all fields |
| 1952 | (bibtex-beginning-first-field (point-min)) | 1948 | (bibtex-beginning-first-field (point-min)) |
| @@ -1965,25 +1961,18 @@ Formats current entry according to variable `bibtex-entry-format'." | |||
| 1965 | (empty-field (equal "" (bibtex-text-in-field-bounds bounds t))) | 1961 | (empty-field (equal "" (bibtex-text-in-field-bounds bounds t))) |
| 1966 | deleted) | 1962 | deleted) |
| 1967 | 1963 | ||
| 1968 | ;; We have more elegant high-level functions for several | ||
| 1969 | ;; tasks done by `bibtex-format-entry'. However, they contain | ||
| 1970 | ;; quite some redundancy compared with what we need to do | ||
| 1971 | ;; anyway. So for speed-up we avoid using them. | ||
| 1972 | |||
| 1973 | (if (memq 'opts-or-alts format) | 1964 | (if (memq 'opts-or-alts format) |
| 1965 | ;; delete empty optional and alternative fields | ||
| 1966 | ;; (but keep empty required fields) | ||
| 1974 | (cond ((and empty-field | 1967 | (cond ((and empty-field |
| 1975 | (or opt-alt | 1968 | (or opt-alt |
| 1976 | (let ((field (assoc-string | 1969 | (let ((field (assoc-string |
| 1977 | field-name req-field-list t))) | 1970 | field-name req-field-list t))) |
| 1978 | (or (not field) ; OPT field | 1971 | (or (not field) ; OPT field |
| 1979 | (nth 3 field))))) ; ALT field | 1972 | (nth 3 field))))) ; ALT field |
| 1980 | ;; Either it is an empty ALT field. Then we have checked | ||
| 1981 | ;; already that we have one non-empty alternative. Or it | ||
| 1982 | ;; is an empty OPT field that we do not miss anyway. | ||
| 1983 | ;; So we can safely delete this field. | ||
| 1984 | (delete-region beg-field end-field) | 1973 | (delete-region beg-field end-field) |
| 1985 | (setq deleted t)) | 1974 | (setq deleted t)) |
| 1986 | ;; otherwise: not empty, delete "OPT" or "ALT" | 1975 | ;; otherwise nonempty field: delete "OPT" or "ALT" |
| 1987 | (opt-alt | 1976 | (opt-alt |
| 1988 | (goto-char beg-name) | 1977 | (goto-char beg-name) |
| 1989 | (delete-char 3)))) | 1978 | (delete-char 3)))) |
| @@ -2087,16 +2076,7 @@ Formats current entry according to variable `bibtex-entry-format'." | |||
| 2087 | (goto-char (1+ beg-text)) | 2076 | (goto-char (1+ beg-text)) |
| 2088 | (insert title)))) | 2077 | (insert title)))) |
| 2089 | 2078 | ||
| 2090 | ;; Use booktitle to set a missing title. | 2079 | ;; if empty field is a required field, complain |
| 2091 | (if (and empty-field | ||
| 2092 | (bibtex-string= field-name "title")) | ||
| 2093 | (let ((booktitle (bibtex-text-in-field "booktitle"))) | ||
| 2094 | (when booktitle | ||
| 2095 | (setq empty-field nil) | ||
| 2096 | (goto-char (1+ beg-text)) | ||
| 2097 | (insert booktitle)))) | ||
| 2098 | |||
| 2099 | ;; if empty field, complain | ||
| 2100 | (if (and empty-field | 2080 | (if (and empty-field |
| 2101 | (memq 'required-fields format) | 2081 | (memq 'required-fields format) |
| 2102 | (assoc-string field-name req-field-list t)) | 2082 | (assoc-string field-name req-field-list t)) |
| @@ -2104,12 +2084,8 @@ Formats current entry according to variable `bibtex-entry-format'." | |||
| 2104 | 2084 | ||
| 2105 | ;; unify case of field name | 2085 | ;; unify case of field name |
| 2106 | (if (memq 'unify-case format) | 2086 | (if (memq 'unify-case format) |
| 2107 | (let ((fname (car (assoc-string | 2087 | (let ((fname (car (assoc-string field-name |
| 2108 | field-name | 2088 | default-field-list t)))) |
| 2109 | (append (nth 0 (nth 1 entry-list)) | ||
| 2110 | (nth 1 (nth 1 entry-list)) | ||
| 2111 | bibtex-user-optional-fields) | ||
| 2112 | t)))) | ||
| 2113 | (if fname | 2089 | (if fname |
| 2114 | (progn | 2090 | (progn |
| 2115 | (delete-region beg-name end-name) | 2091 | (delete-region beg-name end-name) |
| @@ -2123,23 +2099,21 @@ Formats current entry according to variable `bibtex-entry-format'." | |||
| 2123 | 2099 | ||
| 2124 | ;; check whether all required fields are present | 2100 | ;; check whether all required fields are present |
| 2125 | (if (memq 'required-fields format) | 2101 | (if (memq 'required-fields format) |
| 2126 | (let ((found 0) altlist) | 2102 | (let ((found 0) alt-list) |
| 2127 | (dolist (fname req-field-list) | 2103 | (dolist (fname req-field-list) |
| 2128 | (if (nth 3 fname) | 2104 | (cond ((nth 3 fname) ; t if field has alternative flag |
| 2129 | (push (car fname) altlist)) | 2105 | (push (car fname) alt-list) |
| 2130 | (unless (or (member (car fname) field-list) | 2106 | (if (member-ignore-case (car fname) field-list) |
| 2131 | (nth 3 fname)) | 2107 | (setq found (1+ found)))) |
| 2132 | (error "Mandatory field `%s' is missing" (car fname)))) | 2108 | ((not (member-ignore-case (car fname) field-list)) |
| 2133 | (when altlist | 2109 | (error "Mandatory field `%s' is missing" (car fname))))) |
| 2134 | (dolist (fname altlist) | 2110 | (if alt-list |
| 2135 | (if (member fname field-list) | 2111 | (cond ((= found 0) |
| 2136 | (setq found (1+ found)))) | 2112 | (error "Alternative mandatory field `%s' is missing" |
| 2137 | (cond ((= found 0) | 2113 | alt-list)) |
| 2138 | (error "Alternative mandatory field `%s' is missing" | 2114 | ((> found 1) |
| 2139 | altlist)) | 2115 | (error "Alternative fields `%s' are defined %s times" |
| 2140 | ((> found 1) | 2116 | alt-list found)))))) |
| 2141 | (error "Alternative fields `%s' are defined %s times" | ||
| 2142 | altlist found)))))) | ||
| 2143 | 2117 | ||
| 2144 | ;; update comma after last field | 2118 | ;; update comma after last field |
| 2145 | (if (memq 'last-comma format) | 2119 | (if (memq 'last-comma format) |
| @@ -2158,7 +2132,7 @@ Formats current entry according to variable `bibtex-entry-format'." | |||
| 2158 | (delete-char 1) | 2132 | (delete-char 1) |
| 2159 | (insert (bibtex-entry-right-delimiter))) | 2133 | (insert (bibtex-entry-right-delimiter))) |
| 2160 | 2134 | ||
| 2161 | ;; fill entry | 2135 | ;; realign and fill entry |
| 2162 | (if (memq 'realign format) | 2136 | (if (memq 'realign format) |
| 2163 | (bibtex-fill-entry)))))) | 2137 | (bibtex-fill-entry)))))) |
| 2164 | 2138 | ||
| @@ -2426,7 +2400,7 @@ Concatenate the key: | |||
| 2426 | (apply 'append | 2400 | (apply 'append |
| 2427 | (mapcar (lambda (buf) | 2401 | (mapcar (lambda (buf) |
| 2428 | (with-current-buffer buf bibtex-reference-keys)) | 2402 | (with-current-buffer buf bibtex-reference-keys)) |
| 2429 | (bibtex-files-expand t))) | 2403 | (bibtex-initialize t))) |
| 2430 | bibtex-reference-keys)) | 2404 | bibtex-reference-keys)) |
| 2431 | 2405 | ||
| 2432 | (defun bibtex-read-key (prompt &optional key global) | 2406 | (defun bibtex-read-key (prompt &optional key global) |
| @@ -2606,14 +2580,22 @@ Parsing initializes `bibtex-reference-keys' and `bibtex-strings'." | |||
| 2606 | (setq bibtex-buffer-last-parsed-tick (buffer-modified-tick))))) | 2580 | (setq bibtex-buffer-last-parsed-tick (buffer-modified-tick))))) |
| 2607 | (setq buffers (cdr buffers)))))) | 2581 | (setq buffers (cdr buffers)))))) |
| 2608 | 2582 | ||
| 2609 | (defun bibtex-files-expand (&optional current force) | 2583 | ;;;###autoload |
| 2610 | "Return an expanded list of BibTeX buffers based on `bibtex-files'. | 2584 | (defun bibtex-initialize (&optional current force select) |
| 2585 | "(Re)Initialize BibTeX buffers. | ||
| 2586 | Visit the BibTeX files defined by `bibtex-files' and return a list | ||
| 2587 | of corresponding buffers. | ||
| 2611 | Initialize in these buffers `bibtex-reference-keys' if not yet set. | 2588 | Initialize in these buffers `bibtex-reference-keys' if not yet set. |
| 2612 | List of BibTeX buffers includes current buffer if CURRENT is non-nil. | 2589 | List of BibTeX buffers includes current buffer if CURRENT is non-nil. |
| 2613 | If FORCE is non-nil, (re)initialize `bibtex-reference-keys' even if | 2590 | If FORCE is non-nil, (re)initialize `bibtex-reference-keys' even if |
| 2614 | already set." | 2591 | already set. If SELECT is non-nil interactively select a BibTeX buffer. |
| 2592 | When called interactively, FORCE is t, CURRENT is t if current buffer uses | ||
| 2593 | `bibtex-mode', and SELECT is t if current buffer does not use `bibtex-mode'," | ||
| 2594 | (interactive (list (eq major-mode 'bibtex-mode) t | ||
| 2595 | (not (eq major-mode 'bibtex-mode)))) | ||
| 2615 | (let ((file-path (split-string (or bibtex-file-path default-directory) ":+")) | 2596 | (let ((file-path (split-string (or bibtex-file-path default-directory) ":+")) |
| 2616 | file-list dir-list buffer-list) | 2597 | file-list dir-list buffer-list) |
| 2598 | ;; generate list of BibTeX files | ||
| 2617 | (dolist (file bibtex-files) | 2599 | (dolist (file bibtex-files) |
| 2618 | (cond ((eq file 'bibtex-file-path) | 2600 | (cond ((eq file 'bibtex-file-path) |
| 2619 | (setq dir-list (append dir-list file-path))) | 2601 | (setq dir-list (append dir-list file-path))) |
| @@ -2624,34 +2606,46 @@ already set." | |||
| 2624 | (file-name-absolute-p file)) | 2606 | (file-name-absolute-p file)) |
| 2625 | (push file file-list)) | 2607 | (push file file-list)) |
| 2626 | (t | 2608 | (t |
| 2627 | (let (fullfilename found) | 2609 | (let (expanded-file-name found) |
| 2628 | (dolist (dir file-path) | 2610 | (dolist (dir file-path) |
| 2629 | (when (file-readable-p | 2611 | (when (file-readable-p |
| 2630 | (setq fullfilename (expand-file-name file dir))) | 2612 | (setq expanded-file-name (expand-file-name file dir))) |
| 2631 | (push fullfilename file-list) | 2613 | (push expanded-file-name file-list) |
| 2632 | (setq found t))) | 2614 | (setq found t))) |
| 2633 | (unless found | 2615 | (unless found |
| 2634 | (error "File %s not in paths defined via bibtex-file-path" | 2616 | (error "File `%s' not in paths defined via bibtex-file-path" |
| 2635 | file)))))) | 2617 | file)))))) |
| 2636 | (dolist (file file-list) | 2618 | (dolist (file file-list) |
| 2637 | (unless (file-readable-p file) | 2619 | (unless (file-readable-p file) |
| 2638 | (error "BibTeX file %s not found" file))) | 2620 | (error "BibTeX file `%s' not found" file))) |
| 2639 | ;; expand dir-list | 2621 | ;; expand dir-list |
| 2640 | (dolist (dir dir-list) | 2622 | (dolist (dir dir-list) |
| 2641 | (setq file-list | 2623 | (setq file-list |
| 2642 | (append file-list (directory-files dir t "\\.bib\\'" t)))) | 2624 | (append file-list (directory-files dir t "\\.bib\\'" t)))) |
| 2643 | (delete-dups file-list) | 2625 | (delete-dups file-list) |
| 2626 | ;; visit files in FILE-LIST | ||
| 2644 | (dolist (file file-list) | 2627 | (dolist (file file-list) |
| 2645 | (when (file-readable-p file) | 2628 | (if (file-readable-p file) |
| 2646 | (push (find-file-noselect file) buffer-list) | 2629 | (push (find-file-noselect file) buffer-list))) |
| 2647 | (with-current-buffer (car buffer-list) | 2630 | ;; include current buffer iff we want it |
| 2648 | (if (or force (not (listp bibtex-reference-keys))) | ||
| 2649 | (bibtex-parse-keys))))) | ||
| 2650 | (cond ((and current (not (memq (current-buffer) buffer-list))) | 2631 | (cond ((and current (not (memq (current-buffer) buffer-list))) |
| 2651 | (push (current-buffer) buffer-list) | 2632 | (push (current-buffer) buffer-list)) |
| 2652 | (if force (bibtex-parse-keys))) | ||
| 2653 | ((and (not current) (memq (current-buffer) buffer-list)) | 2633 | ((and (not current) (memq (current-buffer) buffer-list)) |
| 2654 | (setq buffer-list (delq (current-buffer) buffer-list)))) | 2634 | (setq buffer-list (delq (current-buffer) buffer-list)))) |
| 2635 | ;; parse keys | ||
| 2636 | (dolist (buffer buffer-list) | ||
| 2637 | (with-current-buffer buffer | ||
| 2638 | (if (or force (nlistp bibtex-reference-keys)) | ||
| 2639 | (bibtex-parse-keys)))) | ||
| 2640 | ;; select BibTeX buffer | ||
| 2641 | (if select | ||
| 2642 | (if buffer-list | ||
| 2643 | (switch-to-buffer | ||
| 2644 | (completing-read "Switch to BibTeX buffer: " | ||
| 2645 | (mapcar 'buffer-name buffer-list) | ||
| 2646 | nil t | ||
| 2647 | (if current (buffer-name (current-buffer))))) | ||
| 2648 | (message "No BibTeX buffers defined"))) | ||
| 2655 | buffer-list)) | 2649 | buffer-list)) |
| 2656 | 2650 | ||
| 2657 | (defun bibtex-complete-internal (completions) | 2651 | (defun bibtex-complete-internal (completions) |
| @@ -3130,7 +3124,6 @@ field contents of the neighboring entry. Finally try to update the text | |||
| 3130 | based on the difference between the keys of the neighboring and the current | 3124 | based on the difference between the keys of the neighboring and the current |
| 3131 | entry (for example, the year parts of the keys)." | 3125 | entry (for example, the year parts of the keys)." |
| 3132 | (interactive) | 3126 | (interactive) |
| 3133 | (undo-boundary) ;So you can easily undo it, if it didn't work right. | ||
| 3134 | (bibtex-beginning-of-entry) | 3127 | (bibtex-beginning-of-entry) |
| 3135 | (when (looking-at bibtex-entry-head) | 3128 | (when (looking-at bibtex-entry-head) |
| 3136 | (let ((type (bibtex-type-in-head)) | 3129 | (let ((type (bibtex-type-in-head)) |
| @@ -3413,13 +3406,18 @@ If its value is nil use plain sorting." | |||
| 3413 | (cond ((not index1) (not index2)) ; indices can be nil | 3406 | (cond ((not index1) (not index2)) ; indices can be nil |
| 3414 | ((not index2) nil) | 3407 | ((not index2) nil) |
| 3415 | ((eq bibtex-maintain-sorted-entries 'crossref) | 3408 | ((eq bibtex-maintain-sorted-entries 'crossref) |
| 3416 | (if (nth 1 index1) | 3409 | ;; CROSSREF-KEY may be nil or it can point to an entry |
| 3417 | (if (nth 1 index2) | 3410 | ;; in another BibTeX file. In both cases we ignore CROSSREF-KEY. |
| 3411 | (if (and (nth 1 index1) | ||
| 3412 | (cdr (assoc-string (nth 1 index1) bibtex-reference-keys))) | ||
| 3413 | (if (and (nth 1 index2) | ||
| 3414 | (cdr (assoc-string (nth 1 index2) bibtex-reference-keys))) | ||
| 3418 | (or (string-lessp (nth 1 index1) (nth 1 index2)) | 3415 | (or (string-lessp (nth 1 index1) (nth 1 index2)) |
| 3419 | (and (string-equal (nth 1 index1) (nth 1 index2)) | 3416 | (and (string-equal (nth 1 index1) (nth 1 index2)) |
| 3420 | (string-lessp (nth 0 index1) (nth 0 index2)))) | 3417 | (string-lessp (nth 0 index1) (nth 0 index2)))) |
| 3421 | (not (string-lessp (nth 0 index2) (nth 1 index1)))) | 3418 | (not (string-lessp (nth 0 index2) (nth 1 index1)))) |
| 3422 | (if (nth 1 index2) | 3419 | (if (and (nth 1 index2) |
| 3420 | (cdr (assoc-string (nth 1 index2) bibtex-reference-keys))) | ||
| 3423 | (string-lessp (nth 0 index1) (nth 1 index2)) | 3421 | (string-lessp (nth 0 index1) (nth 1 index2)) |
| 3424 | (string-lessp (nth 0 index1) (nth 0 index2))))) | 3422 | (string-lessp (nth 0 index1) (nth 0 index2))))) |
| 3425 | ((eq bibtex-maintain-sorted-entries 'entry-class) | 3423 | ((eq bibtex-maintain-sorted-entries 'entry-class) |
| @@ -3444,6 +3442,9 @@ are ignored." | |||
| 3444 | (interactive) | 3442 | (interactive) |
| 3445 | (bibtex-beginning-of-first-entry) ; Needed by `sort-subr' | 3443 | (bibtex-beginning-of-first-entry) ; Needed by `sort-subr' |
| 3446 | (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'. | 3444 | (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'. |
| 3445 | (if (and (eq bibtex-maintain-sorted-entries 'crossref) | ||
| 3446 | (nlistp bibtex-reference-keys)) | ||
| 3447 | (bibtex-parse-keys)) ; Needed by `bibtex-lessp'. | ||
| 3447 | (sort-subr nil | 3448 | (sort-subr nil |
| 3448 | 'bibtex-skip-to-valid-entry ; NEXTREC function | 3449 | 'bibtex-skip-to-valid-entry ; NEXTREC function |
| 3449 | 'bibtex-end-of-entry ; ENDREC function | 3450 | 'bibtex-end-of-entry ; ENDREC function |
| @@ -3539,7 +3540,7 @@ Otherwise, use `set-buffer'. DISPLAY is t when called interactively." | |||
| 3539 | (interactive (list (bibtex-read-key "Find key: " nil current-prefix-arg) | 3540 | (interactive (list (bibtex-read-key "Find key: " nil current-prefix-arg) |
| 3540 | current-prefix-arg nil t)) | 3541 | current-prefix-arg nil t)) |
| 3541 | (if (and global bibtex-files) | 3542 | (if (and global bibtex-files) |
| 3542 | (let ((buffer-list (bibtex-files-expand t)) | 3543 | (let ((buffer-list (bibtex-initialize t)) |
| 3543 | buffer found) | 3544 | buffer found) |
| 3544 | (while (and (not found) | 3545 | (while (and (not found) |
| 3545 | (setq buffer (pop buffer-list))) | 3546 | (setq buffer (pop buffer-list))) |
| @@ -3581,6 +3582,9 @@ search to look for place for KEY. This requires that buffer is sorted, | |||
| 3581 | see `bibtex-validate'. | 3582 | see `bibtex-validate'. |
| 3582 | Return t if preparation was successful or nil if entry KEY already exists." | 3583 | Return t if preparation was successful or nil if entry KEY already exists." |
| 3583 | (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'. | 3584 | (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'. |
| 3585 | (if (and (eq bibtex-maintain-sorted-entries 'crossref) | ||
| 3586 | (nlistp bibtex-reference-keys)) | ||
| 3587 | (bibtex-parse-keys)) ; Needed by `bibtex-lessp'. | ||
| 3584 | (let ((key (nth 0 index)) | 3588 | (let ((key (nth 0 index)) |
| 3585 | key-exist) | 3589 | key-exist) |
| 3586 | (cond ((or (null key) | 3590 | (cond ((or (null key) |
| @@ -3671,6 +3675,9 @@ Return t if test was successful, nil otherwise." | |||
| 3671 | (setq syntax-error t) | 3675 | (setq syntax-error t) |
| 3672 | 3676 | ||
| 3673 | ;; Check for duplicate keys and correct sort order | 3677 | ;; Check for duplicate keys and correct sort order |
| 3678 | (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'. | ||
| 3679 | (bibtex-parse-keys) ; Possibly needed by `bibtex-lessp'. | ||
| 3680 | ; Always needed by subsequent global key check. | ||
| 3674 | (let (previous current key-list) | 3681 | (let (previous current key-list) |
| 3675 | (bibtex-progress-message "Checking for duplicate keys") | 3682 | (bibtex-progress-message "Checking for duplicate keys") |
| 3676 | (bibtex-map-entries | 3683 | (bibtex-map-entries |
| @@ -3692,9 +3699,12 @@ Return t if test was successful, nil otherwise." | |||
| 3692 | (bibtex-progress-message 'done)) | 3699 | (bibtex-progress-message 'done)) |
| 3693 | 3700 | ||
| 3694 | ;; Check for duplicate keys in `bibtex-files'. | 3701 | ;; Check for duplicate keys in `bibtex-files'. |
| 3695 | (bibtex-parse-keys) | 3702 | ;; `bibtex-validate' only compares keys in current buffer with keys |
| 3703 | ;; in `bibtex-files'. `bibtex-validate-globally' compares keys for | ||
| 3704 | ;; each file in `bibtex-files' with keys of all other files in | ||
| 3705 | ;; `bibtex-files'. | ||
| 3696 | ;; We don't want to be fooled by outdated `bibtex-reference-keys'. | 3706 | ;; We don't want to be fooled by outdated `bibtex-reference-keys'. |
| 3697 | (dolist (buffer (bibtex-files-expand nil t)) | 3707 | (dolist (buffer (bibtex-initialize nil t)) |
| 3698 | (dolist (key (with-current-buffer buffer bibtex-reference-keys)) | 3708 | (dolist (key (with-current-buffer buffer bibtex-reference-keys)) |
| 3699 | (when (and (cdr key) | 3709 | (when (and (cdr key) |
| 3700 | (cdr (assoc-string (car key) bibtex-reference-keys))) | 3710 | (cdr (assoc-string (car key) bibtex-reference-keys))) |
| @@ -3792,7 +3802,7 @@ Return t if test was successful, nil otherwise." | |||
| 3792 | With optional prefix arg STRINGS, check for duplicate strings, too. | 3802 | With optional prefix arg STRINGS, check for duplicate strings, too. |
| 3793 | Return t if test was successful, nil otherwise." | 3803 | Return t if test was successful, nil otherwise." |
| 3794 | (interactive "P") | 3804 | (interactive "P") |
| 3795 | (let ((buffer-list (bibtex-files-expand t)) | 3805 | (let ((buffer-list (bibtex-initialize t)) |
| 3796 | buffer-key-list current-buf current-keys error-list) | 3806 | buffer-key-list current-buf current-keys error-list) |
| 3797 | ;; Check for duplicate keys within BibTeX buffer | 3807 | ;; Check for duplicate keys within BibTeX buffer |
| 3798 | (dolist (buffer buffer-list) | 3808 | (dolist (buffer buffer-list) |
| @@ -4133,14 +4143,15 @@ At end of the cleaning process, the functions in | |||
| 4133 | (error "Not inside a BibTeX entry"))) | 4143 | (error "Not inside a BibTeX entry"))) |
| 4134 | (entry-type (bibtex-type-in-head)) | 4144 | (entry-type (bibtex-type-in-head)) |
| 4135 | (key (bibtex-key-in-head))) | 4145 | (key (bibtex-key-in-head))) |
| 4136 | ;; formatting | 4146 | ;; formatting (undone if error occurs) |
| 4137 | (cond ((bibtex-string= entry-type "preamble") | 4147 | (atomic-change-group |
| 4138 | ;; (bibtex-format-preamble) | 4148 | (cond ((bibtex-string= entry-type "preamble") |
| 4139 | (error "No clean up of @Preamble entries")) | 4149 | ;; (bibtex-format-preamble) |
| 4140 | ((bibtex-string= entry-type "string") | 4150 | (error "No clean up of @Preamble entries")) |
| 4141 | (setq entry-type 'string)) | 4151 | ((bibtex-string= entry-type "string") |
| 4142 | ;; (bibtex-format-string) | 4152 | (setq entry-type 'string)) |
| 4143 | (t (bibtex-format-entry))) | 4153 | ;; (bibtex-format-string) |
| 4154 | (t (bibtex-format-entry)))) | ||
| 4144 | ;; set key | 4155 | ;; set key |
| 4145 | (when (or new-key (not key)) | 4156 | (when (or new-key (not key)) |
| 4146 | (setq key (bibtex-generate-autokey)) | 4157 | (setq key (bibtex-generate-autokey)) |
| @@ -4184,7 +4195,7 @@ At end of the cleaning process, the functions in | |||
| 4184 | (bibtex-find-entry key nil end)))) | 4195 | (bibtex-find-entry key nil end)))) |
| 4185 | (if error | 4196 | (if error |
| 4186 | (error "New inserted entry yields duplicate key")) | 4197 | (error "New inserted entry yields duplicate key")) |
| 4187 | (dolist (buffer (bibtex-files-expand)) | 4198 | (dolist (buffer (bibtex-initialize)) |
| 4188 | (with-current-buffer buffer | 4199 | (with-current-buffer buffer |
| 4189 | (if (cdr (assoc-string key bibtex-reference-keys)) | 4200 | (if (cdr (assoc-string key bibtex-reference-keys)) |
| 4190 | (error "Duplicate key in %s" (buffer-file-name))))) | 4201 | (error "Duplicate key in %s" (buffer-file-name))))) |
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 900a2c36893..796a6a6d7e1 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el | |||
| @@ -1597,7 +1597,7 @@ quit spell session exited." | |||
| 1597 | (or quietly | 1597 | (or quietly |
| 1598 | (message "%s is correct" | 1598 | (message "%s is correct" |
| 1599 | (funcall ispell-format-word-function word))) | 1599 | (funcall ispell-format-word-function word))) |
| 1600 | (and (fboundp 'extent-at) | 1600 | (and (featurep 'xemacs) |
| 1601 | (extent-at start) | 1601 | (extent-at start) |
| 1602 | (and (fboundp 'delete-extent) | 1602 | (and (fboundp 'delete-extent) |
| 1603 | (delete-extent (extent-at start))))) | 1603 | (delete-extent (extent-at start))))) |
| @@ -1606,7 +1606,7 @@ quit spell session exited." | |||
| 1606 | (message "%s is correct because of root %s" | 1606 | (message "%s is correct because of root %s" |
| 1607 | (funcall ispell-format-word-function word) | 1607 | (funcall ispell-format-word-function word) |
| 1608 | (funcall ispell-format-word-function poss))) | 1608 | (funcall ispell-format-word-function poss))) |
| 1609 | (and (fboundp 'extent-at) | 1609 | (and (featurep 'xemacs) |
| 1610 | (extent-at start) | 1610 | (extent-at start) |
| 1611 | (and (fboundp 'delete-extent) | 1611 | (and (fboundp 'delete-extent) |
| 1612 | (delete-extent (extent-at start))))) | 1612 | (delete-extent (extent-at start))))) |
diff --git a/lisp/textmodes/org-export-latex.el b/lisp/textmodes/org-export-latex.el index eef1c10e5b6..7624af8aa0e 100644 --- a/lisp/textmodes/org-export-latex.el +++ b/lisp/textmodes/org-export-latex.el | |||
| @@ -1,10 +1,10 @@ | |||
| 1 | ;;; org-export-latex.el --- LaTeX exporter for org-mode | 1 | ;;; org-export-latex.el --- LaTeX exporter for org-mode |
| 2 | ;; | 2 | ;; |
| 3 | ;; Copyright (C) 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (c) 2007, 2008 Free Software Foundation, Inc. |
| 4 | ;; | 4 | ;; |
| 5 | ;; Emacs Lisp Archive Entry | 5 | ;; Emacs Lisp Archive Entry |
| 6 | ;; Filename: org-export-latex.el | 6 | ;; Filename: org-export-latex.el |
| 7 | ;; Version: 5.12 | 7 | ;; Version: 5.19 |
| 8 | ;; Author: Bastien Guerry <bzg AT altern DOT org> | 8 | ;; Author: Bastien Guerry <bzg AT altern DOT org> |
| 9 | ;; Maintainer: Bastien Guerry <bzg AT altern DOT org> | 9 | ;; Maintainer: Bastien Guerry <bzg AT altern DOT org> |
| 10 | ;; Keywords: org, wp, tex | 10 | ;; Keywords: org, wp, tex |
| @@ -18,31 +18,31 @@ | |||
| 18 | ;; Free Software Foundation; either version 3, or (at your option) any | 18 | ;; Free Software Foundation; either version 3, or (at your option) any |
| 19 | ;; later version. | 19 | ;; later version. |
| 20 | ;; | 20 | ;; |
| 21 | ;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT | 21 | ;; GNU Emacs is distributed in the hope that it will be useful, but |
| 22 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | 22 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of |
| 23 | ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for | 23 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| 24 | ;; more details. | 24 | ;; General Public License for more details. |
| 25 | ;; | 25 | ;; |
| 26 | ;; You should have received a copy of the GNU General Public License along | 26 | ;; You should have received a copy of the GNU General Public License |
| 27 | ;; with GNU Emacs; see the file COPYING. If not, write to the Free Software | 27 | ;; along with GNU Emacs; see the file COPYING. If not, write to the Free |
| 28 | ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA | 28 | ;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, |
| 29 | ;; 02110-1301, USA. | 29 | ;; MA 02110-1301, USA. |
| 30 | ;; | 30 | ;; |
| 31 | ;;; Commentary: | 31 | ;;; Commentary: |
| 32 | ;; | 32 | ;; |
| 33 | ;; This library implements a LaTeX exporter for org-mode. | 33 | ;; This library implements a LaTeX exporter for org-mode. |
| 34 | ;; | 34 | ;; |
| 35 | ;; Put this file into your load-path and the following into your ~/.emacs: | 35 | ;; Put this file into your load-path and the following into your ~/.emacs: |
| 36 | ;; (require 'org-export-latex) | 36 | ;; (require 'org-export-latex) |
| 37 | ;; | 37 | ;; |
| 38 | ;; The interactive functions are similar to those of the HTML exporter: | 38 | ;; The interactive functions are similar to those of the HTML exporter: |
| 39 | ;; | 39 | ;; |
| 40 | ;; M-x `org-export-as-latex' | 40 | ;; M-x `org-export-as-latex' |
| 41 | ;; M-x `org-export-as-latex-batch' | 41 | ;; M-x `org-export-as-latex-batch' |
| 42 | ;; M-x `org-export-as-latex-to-buffer' | 42 | ;; M-x `org-export-as-latex-to-buffer' |
| 43 | ;; M-x `org-export-region-as-latex' | 43 | ;; M-x `org-export-region-as-latex' |
| 44 | ;; M-x `org-replace-region-by-latex' | 44 | ;; M-x `org-replace-region-by-latex' |
| 45 | ;; | 45 | ;; |
| 46 | ;;; Code: | 46 | ;;; Code: |
| 47 | 47 | ||
| 48 | (eval-when-compile | 48 | (eval-when-compile |
| @@ -52,15 +52,19 @@ | |||
| 52 | (require 'org) | 52 | (require 'org) |
| 53 | 53 | ||
| 54 | ;;; Variables: | 54 | ;;; Variables: |
| 55 | (defvar org-latex-options-plist nil) | 55 | (defvar org-export-latex-class nil) |
| 56 | (defvar org-latex-todo-keywords-1 nil) | 56 | (defvar org-export-latex-header nil) |
| 57 | (defvar org-latex-all-targets-regexp nil) | 57 | (defvar org-export-latex-append-header nil) |
| 58 | (defvar org-latex-add-level 0) | 58 | (defvar org-export-latex-options-plist nil) |
| 59 | (defvar org-latex-sectioning-depth 0) | 59 | (defvar org-export-latex-todo-keywords-1 nil) |
| 60 | (defvar org-export-latex-all-targets-re nil) | ||
| 61 | (defvar org-export-latex-add-level 0) | ||
| 62 | (defvar org-export-latex-sectioning "") | ||
| 63 | (defvar org-export-latex-sectioning-depth 0) | ||
| 60 | (defvar org-export-latex-list-beginning-re | 64 | (defvar org-export-latex-list-beginning-re |
| 61 | "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) +?") | 65 | "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) +?") |
| 62 | 66 | ||
| 63 | (defvar org-latex-special-string-regexps | 67 | (defvar org-export-latex-special-string-regexps |
| 64 | '(org-ts-regexp | 68 | '(org-ts-regexp |
| 65 | org-scheduled-string | 69 | org-scheduled-string |
| 66 | org-deadline-string | 70 | org-deadline-string |
| @@ -71,28 +75,82 @@ | |||
| 71 | (defvar re-quote) ; dynamically scoped from org.el | 75 | (defvar re-quote) ; dynamically scoped from org.el |
| 72 | (defvar commentsp) ; dynamically scoped from org.el | 76 | (defvar commentsp) ; dynamically scoped from org.el |
| 73 | 77 | ||
| 74 | ;;; Custom variables: | 78 | ;;; User variables: |
| 75 | (defcustom org-export-latex-sectioning-alist | ||
| 76 | '((1 "\\section{%s}" "\\section*{%s}") | ||
| 77 | (2 "\\subsection{%s}" "\\subsection*{%s}") | ||
| 78 | (3 "\\subsubsection{%s}" "\\subsubsection*{%s}") | ||
| 79 | (4 "\\paragraph{%s}" "\\paragraph*{%s}") | ||
| 80 | (5 "\\subparagraph{%s}" "\\subparagraph*{%s}")) | ||
| 81 | "Alist of LaTeX commands for inserting sections. | ||
| 82 | Here is the structure of each cell: | ||
| 83 | 79 | ||
| 84 | \(level unnumbered-section numbered-section\) | 80 | (defcustom org-export-latex-default-class "article" |
| 81 | "The default LaTeX class." | ||
| 82 | :group 'org-export-latex | ||
| 83 | :type '(string :tag "LaTeX class")) | ||
| 85 | 84 | ||
| 86 | The %s formatter will be replaced by the title of the section." | 85 | (defcustom org-export-latex-classes |
| 86 | '(("article" | ||
| 87 | "\\documentclass[11pt,a4paper]{article} | ||
| 88 | \\usepackage[utf8]{inputenc} | ||
| 89 | \\usepackage[T1]{fontenc} | ||
| 90 | \\usepackage{hyperref}" | ||
| 91 | ("\\section{%s}" . "\\section*{%s}") | ||
| 92 | ("\\subsection{%s}" . "\\subsection*{%s}") | ||
| 93 | ("\\subsubsection{%s}" . "\\subsubsection*{%s}") | ||
| 94 | ("\\paragraph{%s}" . "\\paragraph*{%s}") | ||
| 95 | ("\\subparagraph{%s}" . "\\subparagraph*{%s}")) | ||
| 96 | ("report" | ||
| 97 | "\\documentclass[11pt,a4paper]{report} | ||
| 98 | \\usepackage[utf8]{inputenc} | ||
| 99 | \\usepackage[T1]{fontenc} | ||
| 100 | \\usepackage{hyperref}" | ||
| 101 | ("\\part{%s}" . "\\part*{%s}") | ||
| 102 | ("\\chapter{%s}" . "\\chapter*{%s}") | ||
| 103 | ("\\section{%s}" . "\\section*{%s}") | ||
| 104 | ("\\subsection{%s}" . "\\subsection*{%s}") | ||
| 105 | ("\\subsubsection{%s}" . "\\subsubsection*{%s}")) | ||
| 106 | ("book" | ||
| 107 | "\\documentclass[11pt,a4paper]{book} | ||
| 108 | \\usepackage[utf8]{inputenc} | ||
| 109 | \\usepackage[T1]{fontenc} | ||
| 110 | \\usepackage{hyperref}" | ||
| 111 | ("\\part{%s}" . "\\part*{%s}") | ||
| 112 | ("\\chapter{%s}" . "\\chapter*{%s}") | ||
| 113 | ("\\section{%s}" . "\\section*{%s}") | ||
| 114 | ("\\subsection{%s}" . "\\subsection*{%s}") | ||
| 115 | ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))) | ||
| 116 | "Alist of LaTeX classes and associated header and structure. | ||
| 117 | If #+LaTeX_CLASS is set in the buffer, use its value and the | ||
| 118 | associated information. Here is the structure of each cell: | ||
| 119 | |||
| 120 | \(class-name | ||
| 121 | header-string | ||
| 122 | (unnumbered-section numbered-section\) | ||
| 123 | ...\) | ||
| 124 | |||
| 125 | A %s formatter is mandatory in each section string and will be | ||
| 126 | replaced by the title of the section." | ||
| 87 | :group 'org-export-latex | 127 | :group 'org-export-latex |
| 88 | :type 'alist) | 128 | :type '(repeat |
| 129 | (list (string :tag "LaTeX class") | ||
| 130 | (string :tag "LaTeX header") | ||
| 131 | (cons :tag "Level 1" | ||
| 132 | (string :tag "Numbered") | ||
| 133 | (string :tag "Unnumbered")) | ||
| 134 | (cons :tag "Level 2" | ||
| 135 | (string :tag "Numbered") | ||
| 136 | (string :tag "Unnumbered")) | ||
| 137 | (cons :tag "Level 3" | ||
| 138 | (string :tag "Numbered") | ||
| 139 | (string :tag "Unnumbered")) | ||
| 140 | (cons :tag "Level 4" | ||
| 141 | (string :tag "Numbered") | ||
| 142 | (string :tag "Unnumbered")) | ||
| 143 | (cons :tag "Level 5" | ||
| 144 | (string :tag "Numbered") | ||
| 145 | (string :tag "Unnumbered"))))) | ||
| 89 | 146 | ||
| 90 | (defcustom org-export-latex-emphasis-alist | 147 | (defcustom org-export-latex-emphasis-alist |
| 91 | '(("*" "\\textbf{%s}" nil) | 148 | '(("*" "\\textbf{%s}" nil) |
| 92 | ("/" "\\emph{%s}" nil) | 149 | ("/" "\\emph{%s}" nil) |
| 93 | ("_" "\\underline{%s}" nil) | 150 | ("_" "\\underline{%s}" nil) |
| 94 | ("+" "\\texttt{%s}" nil) | 151 | ("+" "\\texttt{%s}" nil) |
| 95 | ("=" "\\texttt{%s}" nil)) | 152 | ("=" "\\texttt{%s}" nil) |
| 153 | ("~" "\\texttt{%s}" t)) | ||
| 96 | "Alist of LaTeX expressions to convert emphasis fontifiers. | 154 | "Alist of LaTeX expressions to convert emphasis fontifiers. |
| 97 | Each element of the list is a list of three elements. | 155 | Each element of the list is a list of three elements. |
| 98 | The first element is the character used as a marker for fontification. | 156 | The first element is the character used as a marker for fontification. |
| @@ -102,15 +160,6 @@ conversions." | |||
| 102 | :group 'org-export-latex | 160 | :group 'org-export-latex |
| 103 | :type 'alist) | 161 | :type 'alist) |
| 104 | 162 | ||
| 105 | (defcustom org-export-latex-preamble | ||
| 106 | "\\documentclass[11pt,a4paper]{article} | ||
| 107 | \\usepackage[utf8]{inputenc} | ||
| 108 | \\usepackage[T1]{fontenc} | ||
| 109 | \\usepackage{hyperref}" | ||
| 110 | "Preamble to be inserted at the very beginning of the LaTeX export." | ||
| 111 | :group 'org-export-latex | ||
| 112 | :type 'string) | ||
| 113 | |||
| 114 | (defcustom org-export-latex-title-command "\\maketitle" | 163 | (defcustom org-export-latex-title-command "\\maketitle" |
| 115 | "The command used to insert the title just after \\begin{document}. | 164 | "The command used to insert the title just after \\begin{document}. |
| 116 | If this string contains the formatting specification \"%s\" then | 165 | If this string contains the formatting specification \"%s\" then |
| @@ -119,7 +168,7 @@ argument." | |||
| 119 | :group 'org-export-latex | 168 | :group 'org-export-latex |
| 120 | :type 'string) | 169 | :type 'string) |
| 121 | 170 | ||
| 122 | (defcustom org-export-latex-date-format | 171 | (defcustom org-export-latex-date-format |
| 123 | "%d %B %Y" | 172 | "%d %B %Y" |
| 124 | "Format string for \\date{...}." | 173 | "Format string for \\date{...}." |
| 125 | :group 'org-export-latex | 174 | :group 'org-export-latex |
| @@ -130,14 +179,15 @@ argument." | |||
| 130 | :group 'org-export-latex | 179 | :group 'org-export-latex |
| 131 | :type 'boolean) | 180 | :type 'boolean) |
| 132 | 181 | ||
| 133 | (defcustom org-export-latex-packages-alist nil | 182 | (defcustom org-export-latex-tables-column-borders nil |
| 134 | "Alist of packages to be inserted in the preamble. | 183 | "When non-nil, group of columns are surrounded with borders, |
| 135 | Each cell is of the forma \( option . package \). | 184 | XSeven if these borders are the outside borders of the table." |
| 136 | 185 | :group 'org-export-latex | |
| 137 | For example: | 186 | :type 'boolean) |
| 138 | 187 | ||
| 139 | \(setq org-export-latex-packages-alist | 188 | (defcustom org-export-latex-packages-alist nil |
| 140 | '((\"french\" \"babel\"))" | 189 | "Alist of packages to be inserted in the header. |
| 190 | Each cell is of the forma \( \"option\" . \"package\" \)." | ||
| 141 | :group 'org-export-latex | 191 | :group 'org-export-latex |
| 142 | :type 'alist) | 192 | :type 'alist) |
| 143 | 193 | ||
| @@ -167,17 +217,42 @@ Don't remove the keys, just change their values." | |||
| 167 | (defcustom org-export-latex-image-default-option "width=10em" | 217 | (defcustom org-export-latex-image-default-option "width=10em" |
| 168 | "Default option for images." | 218 | "Default option for images." |
| 169 | :group 'org-export-latex | 219 | :group 'org-export-latex |
| 170 | :type '(string)) | 220 | :type 'string) |
| 171 | 221 | ||
| 172 | (defcustom org-export-latex-coding-system nil | 222 | (defcustom org-export-latex-coding-system nil |
| 173 | "Coding system for the exported LaTex file." | 223 | "Coding system for the exported LaTex file." |
| 174 | :group 'org-export-latex | 224 | :group 'org-export-latex |
| 175 | :type 'coding-system) | 225 | :type 'coding-system) |
| 176 | 226 | ||
| 177 | ;; FIXME Do we want this one? | 227 | (defcustom org-list-radio-list-templates |
| 178 | ;; (defun org-export-as-latex-and-open (arg) ...) | 228 | '((latex-mode "% BEGIN RECEIVE ORGLST %n |
| 229 | % END RECEIVE ORGLST %n | ||
| 230 | \\begin{comment} | ||
| 231 | #+ORGLST: SEND %n org-list-to-latex | ||
| 232 | | | | | ||
| 233 | \\end{comment}\n") | ||
| 234 | (texinfo-mode "@c BEGIN RECEIVE ORGLST %n | ||
| 235 | @c END RECEIVE ORGLST %n | ||
| 236 | @ignore | ||
| 237 | #+ORGLST: SEND %n org-list-to-texinfo | ||
| 238 | | | | | ||
| 239 | @end ignore\n") | ||
| 240 | (html-mode "<!-- BEGIN RECEIVE ORGLST %n --> | ||
| 241 | <!-- END RECEIVE ORGLST %n --> | ||
| 242 | <!-- | ||
| 243 | #+ORGLST: SEND %n org-list-to-html | ||
| 244 | | | | | ||
| 245 | -->\n")) | ||
| 246 | "Templates for radio lists in different major modes. | ||
| 247 | All occurrences of %n in a template will be replaced with the name of the | ||
| 248 | list, obtained by prompting the user." | ||
| 249 | :group 'org-plain-lists | ||
| 250 | :type '(repeat | ||
| 251 | (list (symbol :tag "Major mode") | ||
| 252 | (string :tag "Format")))) | ||
| 179 | 253 | ||
| 180 | ;;; Autoload functions: | 254 | ;;; Autoload functions: |
| 255 | |||
| 181 | ;;;###autoload | 256 | ;;;###autoload |
| 182 | (defun org-export-as-latex-batch () | 257 | (defun org-export-as-latex-batch () |
| 183 | "Call `org-export-as-latex', may be used in batch processing as | 258 | "Call `org-export-as-latex', may be used in batch processing as |
| @@ -199,7 +274,7 @@ No file is created. The prefix ARG is passed through to `org-export-as-latex'." | |||
| 199 | (defun org-replace-region-by-latex (beg end) | 274 | (defun org-replace-region-by-latex (beg end) |
| 200 | "Replace the region from BEG to END with its LaTeX export. | 275 | "Replace the region from BEG to END with its LaTeX export. |
| 201 | It assumes the region has `org-mode' syntax, and then convert it to | 276 | It assumes the region has `org-mode' syntax, and then convert it to |
| 202 | LaTeX. This can be used in any buffer. For example, you could | 277 | LaTeX. This can be used in any buffer. For example, you could |
| 203 | write an itemized list in `org-mode' syntax in an LaTeX buffer and | 278 | write an itemized list in `org-mode' syntax in an LaTeX buffer and |
| 204 | then use this command to convert it." | 279 | then use this command to convert it." |
| 205 | (interactive "r") | 280 | (interactive "r") |
| @@ -255,7 +330,21 @@ in a window. A non-interactive call will only retunr the buffer." | |||
| 255 | ;;;###autoload | 330 | ;;;###autoload |
| 256 | (defun org-export-as-latex (arg &optional hidden ext-plist | 331 | (defun org-export-as-latex (arg &optional hidden ext-plist |
| 257 | to-buffer body-only) | 332 | to-buffer body-only) |
| 258 | "Export current buffer to a LaTeX file." | 333 | "Export current buffer to a LaTeX file. |
| 334 | If there is an active region, export only the region. The prefix | ||
| 335 | ARG specifies how many levels of the outline should become | ||
| 336 | headlines. The default is 3. Lower levels will be exported | ||
| 337 | depending on `org-export-latex-low-levels'. The default is to | ||
| 338 | convert them as description lists. When HIDDEN is non-nil, don't | ||
| 339 | display the LaTeX buffer. EXT-PLIST is a property list with | ||
| 340 | external parameters overriding org-mode's default settings, but | ||
| 341 | still inferior to file-local settings. When TO-BUFFER is | ||
| 342 | non-nil, create a buffer with that name and export to that | ||
| 343 | buffer. If TO-BUFFER is the symbol `string', don't leave any | ||
| 344 | buffer behind but just return the resulting LaTeX as a string. | ||
| 345 | When BODY-ONLY is set, don't produce the file header and footer, | ||
| 346 | simply return the content of \begin{document}...\end{document}, | ||
| 347 | without even the \begin{document} and \end{document} commands." | ||
| 259 | (interactive "P") | 348 | (interactive "P") |
| 260 | ;; Make sure we have a file name when we need it. | 349 | ;; Make sure we have a file name when we need it. |
| 261 | (when (and (not (or to-buffer body-only)) | 350 | (when (and (not (or to-buffer body-only)) |
| @@ -268,9 +357,23 @@ in a window. A non-interactive call will only retunr the buffer." | |||
| 268 | 357 | ||
| 269 | (message "Exporting to LaTeX...") | 358 | (message "Exporting to LaTeX...") |
| 270 | (org-update-radio-target-regexp) | 359 | (org-update-radio-target-regexp) |
| 271 | (org-export-latex-set-initial-vars ext-plist) | 360 | (org-export-latex-set-initial-vars ext-plist arg) |
| 272 | (let* ((wcf (current-window-configuration)) | 361 | (let* ((wcf (current-window-configuration)) |
| 273 | (opt-plist org-latex-options-plist) | 362 | (opt-plist org-export-latex-options-plist) |
| 363 | (region-p (org-region-active-p)) | ||
| 364 | (subtree-p | ||
| 365 | (when region-p | ||
| 366 | (save-excursion | ||
| 367 | (goto-char (region-beginning)) | ||
| 368 | (and (org-at-heading-p) | ||
| 369 | (>= (org-end-of-subtree t t) (region-end)))))) | ||
| 370 | (title (or (and subtree-p (org-export-get-title-from-subtree)) | ||
| 371 | (plist-get opt-plist :title) | ||
| 372 | (and (not | ||
| 373 | (plist-get opt-plist :skip-before-1st-heading)) | ||
| 374 | (org-export-grab-title-from-buffer)) | ||
| 375 | (file-name-sans-extension | ||
| 376 | (file-name-nondirectory buffer-file-name)))) | ||
| 274 | (filename (concat (file-name-as-directory | 377 | (filename (concat (file-name-as-directory |
| 275 | (org-export-directory :LaTeX ext-plist)) | 378 | (org-export-directory :LaTeX ext-plist)) |
| 276 | (file-name-sans-extension | 379 | (file-name-sans-extension |
| @@ -286,10 +389,11 @@ in a window. A non-interactive call will only retunr the buffer." | |||
| 286 | "*Org LaTeX Export*")) | 389 | "*Org LaTeX Export*")) |
| 287 | (t (get-buffer-create to-buffer))) | 390 | (t (get-buffer-create to-buffer))) |
| 288 | (find-file-noselect filename))) | 391 | (find-file-noselect filename))) |
| 289 | (region-p (org-region-active-p)) | ||
| 290 | (odd org-odd-levels-only) | 392 | (odd org-odd-levels-only) |
| 291 | (preamble (org-export-latex-make-preamble opt-plist)) | 393 | (header (org-export-latex-make-header title opt-plist)) |
| 292 | (skip (plist-get opt-plist :skip-before-1st-heading)) | 394 | (skip (if subtree-p nil |
| 395 | ;; never skip first lines when exporting a subtree | ||
| 396 | (plist-get opt-plist :skip-before-1st-heading))) | ||
| 293 | (text (plist-get opt-plist :text)) | 397 | (text (plist-get opt-plist :text)) |
| 294 | (first-lines (if skip "" (org-export-latex-first-lines))) | 398 | (first-lines (if skip "" (org-export-latex-first-lines))) |
| 295 | (coding-system (and (boundp 'buffer-file-coding-system) | 399 | (coding-system (and (boundp 'buffer-file-coding-system) |
| @@ -310,19 +414,21 @@ in a window. A non-interactive call will only retunr the buffer." | |||
| 310 | :skip-before-1st-heading skip | 414 | :skip-before-1st-heading skip |
| 311 | :LaTeX-fragments nil))) | 415 | :LaTeX-fragments nil))) |
| 312 | 416 | ||
| 313 | (set-buffer buffer) | 417 | (set-buffer buffer) |
| 314 | (erase-buffer) | 418 | (erase-buffer) |
| 315 | 419 | ||
| 316 | (and (fboundp 'set-buffer-file-coding-system) | 420 | (and (fboundp 'set-buffer-file-coding-system) |
| 317 | (set-buffer-file-coding-system coding-system-for-write)) | 421 | (set-buffer-file-coding-system coding-system-for-write)) |
| 318 | 422 | ||
| 319 | ;; insert the preamble and initial document commands | 423 | ;; insert the header and initial document commands |
| 320 | (unless (or (eq to-buffer 'string) body-only) | 424 | (unless (or (eq to-buffer 'string) body-only) |
| 321 | (insert preamble)) | 425 | (insert header)) |
| 322 | 426 | ||
| 323 | ;; insert text found in #+TEXT | 427 | ;; insert text found in #+TEXT |
| 324 | (when (and text (not (eq to-buffer 'string))) | 428 | (when (and text (not (eq to-buffer 'string))) |
| 325 | (insert (org-export-latex-content text) "\n\n")) | 429 | (insert (org-export-latex-content |
| 430 | text '(lists tables fixed-width keywords)) | ||
| 431 | "\n\n")) | ||
| 326 | 432 | ||
| 327 | ;; insert lines before the first headline | 433 | ;; insert lines before the first headline |
| 328 | (unless (or skip (eq to-buffer 'string)) | 434 | (unless (or skip (eq to-buffer 'string)) |
| @@ -342,7 +448,7 @@ in a window. A non-interactive call will only retunr the buffer." | |||
| 342 | (when (re-search-forward "^\\(\\*+\\) " nil t) | 448 | (when (re-search-forward "^\\(\\*+\\) " nil t) |
| 343 | (let* ((asters (length (match-string 1))) | 449 | (let* ((asters (length (match-string 1))) |
| 344 | (level (if odd (- asters 2) (- asters 1)))) | 450 | (level (if odd (- asters 2) (- asters 1)))) |
| 345 | (setq org-latex-add-level | 451 | (setq org-export-latex-add-level |
| 346 | (if odd (1- (/ (1+ asters) 2)) (1- asters))) | 452 | (if odd (1- (/ (1+ asters) 2)) (1- asters))) |
| 347 | (org-export-latex-parse-global level odd))))) | 453 | (org-export-latex-parse-global level odd))))) |
| 348 | 454 | ||
| @@ -358,16 +464,16 @@ in a window. A non-interactive call will only retunr the buffer." | |||
| 358 | (current-buffer)) | 464 | (current-buffer)) |
| 359 | (set-window-configuration wcf)))) | 465 | (set-window-configuration wcf)))) |
| 360 | 466 | ||
| 361 | |||
| 362 | ;;; Parsing functions: | 467 | ;;; Parsing functions: |
| 468 | |||
| 363 | (defun org-export-latex-parse-global (level odd) | 469 | (defun org-export-latex-parse-global (level odd) |
| 364 | "Parse the current buffer recursively, starting at LEVEL. | 470 | "Parse the current buffer recursively, starting at LEVEL. |
| 365 | If ODD is non-nil, assume the buffer only contains odd sections. | 471 | If ODD is non-nil, assume the buffer only contains odd sections. |
| 366 | Return A list reflecting the document structure." | 472 | Return a list reflecting the document structure." |
| 367 | (save-excursion | 473 | (save-excursion |
| 368 | (goto-char (point-min)) | 474 | (goto-char (point-min)) |
| 369 | (let* ((cnt 0) output | 475 | (let* ((cnt 0) output |
| 370 | (depth org-latex-sectioning-depth)) | 476 | (depth org-export-latex-sectioning-depth)) |
| 371 | (while (re-search-forward | 477 | (while (re-search-forward |
| 372 | (concat "^\\(\\(?:\\*\\)\\{" | 478 | (concat "^\\(\\(?:\\*\\)\\{" |
| 373 | (number-to-string (+ (if odd 2 1) level)) | 479 | (number-to-string (+ (if odd 2 1) level)) |
| @@ -404,57 +510,11 @@ Return A list reflecting the document structure." | |||
| 404 | `(occur . ,cnt) | 510 | `(occur . ,cnt) |
| 405 | `(heading . ,heading) | 511 | `(heading . ,heading) |
| 406 | `(content . ,(org-export-latex-parse-content)) | 512 | `(content . ,(org-export-latex-parse-content)) |
| 407 | `(subcontent . ,(org-export-latex-parse-subcontent | 513 | `(subcontent . ,(org-export-latex-parse-subcontent |
| 408 | level odd))))))) | 514 | level odd))))))) |
| 409 | (widen))) | 515 | (widen))) |
| 410 | (list output)))) | 516 | (list output)))) |
| 411 | 517 | ||
| 412 | (defun org-export-latex-parse-list (&optional delete) | ||
| 413 | "Parse the list at point. | ||
| 414 | Return a list containing first level items as strings and | ||
| 415 | sublevels as list of strings." | ||
| 416 | (let ((start (point)) | ||
| 417 | ;; Find the end of the list | ||
| 418 | (end (save-excursion | ||
| 419 | (catch 'exit | ||
| 420 | (while (or (looking-at org-export-latex-list-beginning-re) | ||
| 421 | (looking-at "^[ \t]+\\|^$")) | ||
| 422 | (if (eq (point) (point-max)) | ||
| 423 | (throw 'exit (point-max))) | ||
| 424 | (forward-line 1))) (point))) | ||
| 425 | output itemsep) | ||
| 426 | (while (re-search-forward org-export-latex-list-beginning-re end t) | ||
| 427 | (setq itemsep (if (save-match-data | ||
| 428 | (string-match "^[0-9]" (match-string 2))) | ||
| 429 | "[0-9]+\\(?:\\.\\|)\\)" "[-+]")) | ||
| 430 | (let* ((indent1 (match-string 1)) | ||
| 431 | (nextitem (save-excursion | ||
| 432 | (save-match-data | ||
| 433 | (or (and (re-search-forward | ||
| 434 | (concat "^" indent1 itemsep " *?") end t) | ||
| 435 | (match-beginning 0)) end)))) | ||
| 436 | (item (buffer-substring | ||
| 437 | (point) | ||
| 438 | (or (and (re-search-forward | ||
| 439 | org-export-latex-list-beginning-re end t) | ||
| 440 | (goto-char (match-beginning 0))) | ||
| 441 | (goto-char end)))) | ||
| 442 | (nextindent (match-string 1)) | ||
| 443 | (item (org-trim item)) | ||
| 444 | (item (if (string-match "^\\[.+\\]" item) | ||
| 445 | (replace-match "\\\\texttt{\\&}" | ||
| 446 | t nil item) item))) | ||
| 447 | (push item output) | ||
| 448 | (when (> (length nextindent) | ||
| 449 | (length indent1)) | ||
| 450 | (narrow-to-region (point) nextitem) | ||
| 451 | (push (org-export-latex-parse-list) output) | ||
| 452 | (widen)))) | ||
| 453 | (when delete (delete-region start end)) | ||
| 454 | (setq output (nreverse output)) | ||
| 455 | (push (if (string-match "^\\[0" itemsep) | ||
| 456 | 'ordered 'unordered) output))) | ||
| 457 | |||
| 458 | (defun org-export-latex-parse-content () | 518 | (defun org-export-latex-parse-content () |
| 459 | "Extract the content of a section." | 519 | "Extract the content of a section." |
| 460 | (let ((beg (point)) | 520 | (let ((beg (point)) |
| @@ -487,7 +547,7 @@ CONTENT is an element of the list produced by | |||
| 487 | "Export the list SUBCONTENT to LaTeX. | 547 | "Export the list SUBCONTENT to LaTeX. |
| 488 | SUBCONTENT is an alist containing information about the headline | 548 | SUBCONTENT is an alist containing information about the headline |
| 489 | and its content." | 549 | and its content." |
| 490 | (let ((num (plist-get org-latex-options-plist :section-numbers))) | 550 | (let ((num (plist-get org-export-latex-options-plist :section-numbers))) |
| 491 | (mapc (lambda(x) (org-export-latex-subcontent x num)) subcontent))) | 551 | (mapc (lambda(x) (org-export-latex-subcontent x num)) subcontent))) |
| 492 | 552 | ||
| 493 | (defun org-export-latex-subcontent (subcontent num) | 553 | (defun org-export-latex-subcontent (subcontent num) |
| @@ -495,20 +555,20 @@ and its content." | |||
| 495 | (let ((heading (org-export-latex-fontify-headline | 555 | (let ((heading (org-export-latex-fontify-headline |
| 496 | (cdr (assoc 'heading subcontent)))) | 556 | (cdr (assoc 'heading subcontent)))) |
| 497 | (level (- (cdr (assoc 'level subcontent)) | 557 | (level (- (cdr (assoc 'level subcontent)) |
| 498 | org-latex-add-level)) | 558 | org-export-latex-add-level)) |
| 499 | (occur (number-to-string (cdr (assoc 'occur subcontent)))) | 559 | (occur (number-to-string (cdr (assoc 'occur subcontent)))) |
| 500 | (content (cdr (assoc 'content subcontent))) | 560 | (content (cdr (assoc 'content subcontent))) |
| 501 | (subcontent (cadr (assoc 'subcontent subcontent)))) | 561 | (subcontent (cadr (assoc 'subcontent subcontent)))) |
| 502 | (cond | 562 | (cond |
| 503 | ;; Normal conversion | 563 | ;; Normal conversion |
| 504 | ((<= level org-latex-sectioning-depth) | 564 | ((<= level org-export-latex-sectioning-depth) |
| 505 | (let ((sec (assoc level org-export-latex-sectioning-alist))) | 565 | (let ((sec (nth (1- level) org-export-latex-sectioning))) |
| 506 | (insert (format (if num (cadr sec) (caddr sec)) heading) "\n")) | 566 | (insert (format (if num (car sec) (cdr sec)) heading) "\n")) |
| 507 | (insert (org-export-latex-content content)) | 567 | (insert (org-export-latex-content content)) |
| 508 | (cond ((stringp subcontent) (insert subcontent)) | 568 | (cond ((stringp subcontent) (insert subcontent)) |
| 509 | ((listp subcontent) (org-export-latex-sub subcontent)))) | 569 | ((listp subcontent) (org-export-latex-sub subcontent)))) |
| 510 | ;; At a level under the hl option: we can drop this subsection | 570 | ;; At a level under the hl option: we can drop this subsection |
| 511 | ((> level org-latex-sectioning-depth) | 571 | ((> level org-export-latex-sectioning-depth) |
| 512 | (cond ((eq org-export-latex-low-levels 'description) | 572 | (cond ((eq org-export-latex-low-levels 'description) |
| 513 | (insert (format "\\begin{description}\n\n\\item[%s]\n\n" heading)) | 573 | (insert (format "\\begin{description}\n\n\\item[%s]\n\n" heading)) |
| 514 | (insert (org-export-latex-content content)) | 574 | (insert (org-export-latex-content content)) |
| @@ -521,52 +581,47 @@ and its content." | |||
| 521 | (cond ((stringp subcontent) (insert subcontent)) | 581 | (cond ((stringp subcontent) (insert subcontent)) |
| 522 | ((listp subcontent) (org-export-latex-sub subcontent))))))))) | 582 | ((listp subcontent) (org-export-latex-sub subcontent))))))))) |
| 523 | 583 | ||
| 524 | |||
| 525 | ;;; Exporting internals: | 584 | ;;; Exporting internals: |
| 526 | (defun org-export-latex-protect-string (string) | 585 | (defun org-export-latex-set-initial-vars (ext-plist level) |
| 527 | "Prevent further conversion for STRING by adding the | ||
| 528 | org-protect property." | ||
| 529 | (add-text-properties | ||
| 530 | 0 (length string) '(org-protected t) string) string) | ||
| 531 | |||
| 532 | (defun org-export-latex-protect-char-in-string (char-list string) | ||
| 533 | "Add org-protected text-property to char from CHAR-LIST in STRING." | ||
| 534 | (with-temp-buffer | ||
| 535 | (save-match-data | ||
| 536 | (insert string) | ||
| 537 | (goto-char (point-min)) | ||
| 538 | (while (re-search-forward (regexp-opt char-list) nil t) | ||
| 539 | (add-text-properties (match-beginning 0) | ||
| 540 | (match-end 0) '(org-protected t))) | ||
| 541 | (buffer-string)))) | ||
| 542 | |||
| 543 | (defun org-export-latex-set-initial-vars (ext-plist) | ||
| 544 | "Store org local variables required for LaTeX export. | 586 | "Store org local variables required for LaTeX export. |
| 545 | EXT-PLIST is an optional additional plist." | 587 | EXT-PLIST is an optional additional plist. |
| 546 | (setq org-latex-todo-keywords-1 org-todo-keywords-1 | 588 | LEVEL indicates the default depth for export." |
| 547 | org-latex-all-targets-regexp | 589 | (setq org-export-latex-todo-keywords-1 org-todo-keywords-1 |
| 590 | org-export-latex-all-targets-re | ||
| 548 | (org-make-target-link-regexp (org-all-targets)) | 591 | (org-make-target-link-regexp (org-all-targets)) |
| 549 | org-latex-options-plist | 592 | org-export-latex-options-plist |
| 550 | (org-combine-plists (org-default-export-plist) ext-plist | 593 | (org-combine-plists (org-default-export-plist) ext-plist |
| 551 | (org-infile-export-plist)) | 594 | (org-infile-export-plist)) |
| 552 | org-latex-sectioning-depth | 595 | org-export-latex-class |
| 553 | (let ((hl-levels (plist-get org-latex-options-plist :headline-levels)) | 596 | (save-excursion |
| 554 | (sec-depth (length org-export-latex-sectioning-alist))) | 597 | (goto-char (point-min)) |
| 555 | ;; Fall back on org-export-latex-sectioning-alist length if | 598 | (if (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\([a-zA-Z]+\\)" nil t) |
| 556 | ;; headline-levels goes beyond it | 599 | (assoc (match-string 1) org-export-latex-classes)) |
| 557 | (if (> hl-levels sec-depth) sec-depth hl-levels)))) | 600 | (match-string 1) |
| 558 | 601 | org-export-latex-default-class)) | |
| 559 | (defun org-export-latex-make-preamble (opt-plist) | 602 | org-export-latex-header |
| 560 | "Make the LaTeX preamble and return it as a string. | 603 | (cadr (assoc org-export-latex-class org-export-latex-classes)) |
| 561 | Argument OPT-PLIST is the options plist for current buffer." | 604 | org-export-latex-sectioning |
| 562 | (let ((toc (plist-get opt-plist :table-of-contents))) | 605 | (cddr (assoc org-export-latex-class org-export-latex-classes)) |
| 563 | (concat | 606 | org-export-latex-sectioning-depth |
| 607 | (or level | ||
| 608 | (let ((hl-levels | ||
| 609 | (plist-get org-export-latex-options-plist :headline-levels)) | ||
| 610 | (sec-depth (length org-export-latex-sectioning))) | ||
| 611 | (if (> hl-levels sec-depth) sec-depth hl-levels))))) | ||
| 612 | |||
| 613 | (defun org-export-latex-make-header (title opt-plist) | ||
| 614 | "Make the LaTeX header and return it as a string. | ||
| 615 | TITLE is the current title from the buffer or region. | ||
| 616 | OPT-PLIST is the options plist for current buffer." | ||
| 617 | (let ((toc (plist-get opt-plist :table-of-contents)) | ||
| 618 | (author (plist-get opt-plist :author))) | ||
| 619 | (concat | ||
| 564 | (if (plist-get opt-plist :time-stamp-file) | 620 | (if (plist-get opt-plist :time-stamp-file) |
| 565 | (format-time-string "% Created %Y-%m-%d %a %H:%M\n")) | 621 | (format-time-string "% Created %Y-%m-%d %a %H:%M\n")) |
| 566 | 622 | ;; insert LaTeX custom header | |
| 567 | ;; insert LaTeX custom preamble | 623 | org-export-latex-header |
| 568 | org-export-latex-preamble "\n" | 624 | "\n" |
| 569 | |||
| 570 | ;; insert information on LaTeX packages | 625 | ;; insert information on LaTeX packages |
| 571 | (when org-export-latex-packages-alist | 626 | (when org-export-latex-packages-alist |
| 572 | (mapconcat (lambda(p) | 627 | (mapconcat (lambda(p) |
| @@ -575,46 +630,34 @@ Argument OPT-PLIST is the options plist for current buffer." | |||
| 575 | (format "\\usepackage[%s]{%s}" | 630 | (format "\\usepackage[%s]{%s}" |
| 576 | (car p) (cadr p)))) | 631 | (car p) (cadr p)))) |
| 577 | org-export-latex-packages-alist "\n")) | 632 | org-export-latex-packages-alist "\n")) |
| 578 | 633 | ;; insert additional commands in the header | |
| 634 | org-export-latex-append-header | ||
| 579 | ;; insert the title | 635 | ;; insert the title |
| 580 | (format | 636 | (format |
| 581 | "\\title{%s}\n" | 637 | "\n\n\\title{%s}\n" |
| 582 | ;; convert the title | 638 | ;; convert the title |
| 583 | (org-export-latex-content | 639 | (org-export-latex-content |
| 584 | (or (plist-get opt-plist :title) | 640 | title '(lists tables fixed-width keywords))) |
| 585 | (and (not | ||
| 586 | (plist-get opt-plist :skip-before-1st-heading)) | ||
| 587 | (org-export-grab-title-from-buffer)) | ||
| 588 | (and buffer-file-name | ||
| 589 | (file-name-sans-extension | ||
| 590 | (file-name-nondirectory buffer-file-name))) | ||
| 591 | "UNTITLED"))) | ||
| 592 | |||
| 593 | ;; insert author info | 641 | ;; insert author info |
| 594 | (if (plist-get opt-plist :author-info) | 642 | (if (plist-get opt-plist :author-info) |
| 595 | (format "\\author{%s}\n" | 643 | (format "\\author{%s}\n" |
| 596 | (or (plist-get opt-plist :author) user-full-name)) | 644 | (or author user-full-name)) |
| 597 | (format "%%\\author{%s}\n" | 645 | (format "%%\\author{%s}\n" |
| 598 | (or (plist-get opt-plist :author) user-full-name))) | 646 | (or author user-full-name))) |
| 599 | |||
| 600 | ;; insert the date | 647 | ;; insert the date |
| 601 | (format "\\date{%s}\n" | 648 | (format "\\date{%s}\n" |
| 602 | (format-time-string | 649 | (format-time-string |
| 603 | (or (plist-get opt-plist :date) | 650 | (or (plist-get opt-plist :date) |
| 604 | org-export-latex-date-format))) | 651 | org-export-latex-date-format))) |
| 605 | |||
| 606 | ;; beginning of the document | 652 | ;; beginning of the document |
| 607 | "\n\\begin{document}\n\n" | 653 | "\n\\begin{document}\n\n" |
| 608 | |||
| 609 | ;; insert the title command | 654 | ;; insert the title command |
| 610 | (if (string-match "%s" org-export-latex-title-command) | 655 | (if (string-match "%s" org-export-latex-title-command) |
| 611 | (format org-export-latex-title-command | 656 | (format org-export-latex-title-command title) |
| 612 | (plist-get opt-plist :title)) | ||
| 613 | org-export-latex-title-command) | 657 | org-export-latex-title-command) |
| 614 | "\n\n" | 658 | "\n\n" |
| 615 | |||
| 616 | ;; table of contents | 659 | ;; table of contents |
| 617 | (when (and org-export-with-toc | 660 | (when (and org-export-with-toc |
| 618 | (plist-get opt-plist :section-numbers)) | 661 | (plist-get opt-plist :section-numbers)) |
| 619 | (cond ((numberp toc) | 662 | (cond ((numberp toc) |
| 620 | (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\n" | 663 | (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\n" |
| @@ -628,8 +671,9 @@ COMMENTS is either nil to replace them with the empty string or a | |||
| 628 | formatting string like %%%%s if we want to comment them out." | 671 | formatting string like %%%%s if we want to comment them out." |
| 629 | (save-excursion | 672 | (save-excursion |
| 630 | (goto-char (point-min)) | 673 | (goto-char (point-min)) |
| 674 | (if (org-at-heading-p) (beginning-of-line 2)) | ||
| 631 | (let* ((pt (point)) | 675 | (let* ((pt (point)) |
| 632 | (end (if (and (re-search-forward "^\\*" nil t) | 676 | (end (if (and (re-search-forward "^\\* " nil t) |
| 633 | (not (eq pt (match-beginning 0)))) | 677 | (not (eq pt (match-beginning 0)))) |
| 634 | (goto-char (match-beginning 0)) | 678 | (goto-char (match-beginning 0)) |
| 635 | (goto-char (point-max))))) | 679 | (goto-char (point-max))))) |
| @@ -643,10 +687,58 @@ formatting string like %%%%s if we want to comment them out." | |||
| 643 | :skip-before-1st-heading nil | 687 | :skip-before-1st-heading nil |
| 644 | :LaTeX-fragments nil))))) | 688 | :LaTeX-fragments nil))))) |
| 645 | 689 | ||
| 690 | (defun org-export-latex-content (content &optional exclude-list) | ||
| 691 | "Convert CONTENT string to LaTeX. | ||
| 692 | Don't perform conversions that are in EXCLUDE-LIST. Recognized | ||
| 693 | conversion types are: quotation-marks, emphasis, sub-superscript, | ||
| 694 | links, keywords, lists, tables, fixed-width" | ||
| 695 | (with-temp-buffer | ||
| 696 | (insert content) | ||
| 697 | (unless (memq 'quotation-marks exclude-list) | ||
| 698 | (org-export-latex-quotation-marks)) | ||
| 699 | (unless (memq 'emphasis exclude-list) | ||
| 700 | (when (plist-get org-export-latex-options-plist :emphasize) | ||
| 701 | (org-export-latex-fontify))) | ||
| 702 | (unless (memq 'sub-superscript exclude-list) | ||
| 703 | (org-export-latex-special-chars | ||
| 704 | (plist-get org-export-latex-options-plist :sub-superscript))) | ||
| 705 | (unless (memq 'links exclude-list) | ||
| 706 | (org-export-latex-links)) | ||
| 707 | (unless (memq 'keywords exclude-list) | ||
| 708 | (org-export-latex-keywords | ||
| 709 | (plist-get org-export-latex-options-plist :timestamps))) | ||
| 710 | (unless (memq 'lists exclude-list) | ||
| 711 | (org-export-latex-lists)) | ||
| 712 | (unless (memq 'tables exclude-list) | ||
| 713 | (org-export-latex-tables | ||
| 714 | (plist-get org-export-latex-options-plist :tables))) | ||
| 715 | (unless (memq 'fixed-width exclude-list) | ||
| 716 | (org-export-latex-fixed-width | ||
| 717 | (plist-get org-export-latex-options-plist :fixed-width))) | ||
| 718 | ;; return string | ||
| 719 | (buffer-substring (point-min) (point-max)))) | ||
| 720 | |||
| 721 | (defun org-export-latex-protect-string (s) | ||
| 722 | "Prevent further conversion for string S by adding the | ||
| 723 | org-protect property." | ||
| 724 | (add-text-properties 0 (length s) '(org-protected t) s) s) | ||
| 725 | |||
| 726 | (defun org-export-latex-protect-char-in-string (char-list string) | ||
| 727 | "Add org-protected text-property to char from CHAR-LIST in STRING." | ||
| 728 | (with-temp-buffer | ||
| 729 | (save-match-data | ||
| 730 | (insert string) | ||
| 731 | (goto-char (point-min)) | ||
| 732 | (while (re-search-forward (regexp-opt char-list) nil t) | ||
| 733 | (add-text-properties (match-beginning 0) | ||
| 734 | (match-end 0) '(org-protected t))) | ||
| 735 | (buffer-string)))) | ||
| 736 | |||
| 646 | (defun org-export-latex-keywords-maybe (remove-list) | 737 | (defun org-export-latex-keywords-maybe (remove-list) |
| 647 | "Maybe remove keywords depending on rules in REMOVE-LIST." | 738 | "Maybe remove keywords depending on rules in REMOVE-LIST." |
| 648 | (goto-char (point-min)) | 739 | (goto-char (point-min)) |
| 649 | (let ((re-todo (mapconcat 'identity org-latex-todo-keywords-1 "\\|"))) | 740 | (let ((re-todo (mapconcat 'identity org-export-latex-todo-keywords-1 "\\|")) |
| 741 | (case-fold-search nil)) | ||
| 650 | ;; convert TODO keywords | 742 | ;; convert TODO keywords |
| 651 | (when (re-search-forward (concat "^\\(" re-todo "\\)") nil t) | 743 | (when (re-search-forward (concat "^\\(" re-todo "\\)") nil t) |
| 652 | (if (plist-get remove-list :todo) | 744 | (if (plist-get remove-list :todo) |
| @@ -664,48 +756,25 @@ formatting string like %%%%s if we want to comment them out." | |||
| 664 | (replace-match "") | 756 | (replace-match "") |
| 665 | (replace-match (format "\\texttt{%s}" (match-string 0)) t t))))) | 757 | (replace-match (format "\\texttt{%s}" (match-string 0)) t t))))) |
| 666 | 758 | ||
| 667 | (defun org-export-latex-fontify-headline (headline) | 759 | (defun org-export-latex-fontify-headline (string) |
| 668 | "Fontify special words in a HEADLINE." | 760 | "Fontify special words in string." |
| 669 | (with-temp-buffer | 761 | (with-temp-buffer |
| 670 | ;; FIXME: org-inside-LaTeX-fragment-p doesn't work when the $...$ is at | 762 | ;; FIXME: org-inside-LaTeX-fragment-p doesn't work when the $...$ is at |
| 671 | ;; the beginning of the buffer - inserting "\n" is safe here though. | 763 | ;; the beginning of the buffer - inserting "\n" is safe here though. |
| 672 | (insert "\n" headline) | 764 | (insert "\n" string) |
| 673 | (goto-char (point-min)) | 765 | (goto-char (point-min)) |
| 674 | (when (plist-get org-latex-options-plist :emphasize) | 766 | (when (plist-get org-export-latex-options-plist :emphasize) |
| 675 | (org-export-latex-fontify)) | 767 | (org-export-latex-fontify)) |
| 676 | (org-export-latex-special-chars | 768 | (org-export-latex-special-chars |
| 677 | (plist-get org-latex-options-plist :sub-superscript)) | 769 | (plist-get org-export-latex-options-plist :sub-superscript)) |
| 678 | (org-export-latex-keywords-maybe | 770 | (org-export-latex-keywords-maybe |
| 679 | org-export-latex-remove-from-headlines) | 771 | org-export-latex-remove-from-headlines) |
| 680 | (org-export-latex-links) | 772 | (org-export-latex-links) |
| 681 | (org-trim (buffer-substring-no-properties (point-min) (point-max))))) | 773 | (org-trim (buffer-substring-no-properties (point-min) (point-max))))) |
| 682 | 774 | ||
| 683 | (defun org-export-latex-content (content) | ||
| 684 | "Convert CONTENT string to LaTeX." | ||
| 685 | (with-temp-buffer | ||
| 686 | (insert content) | ||
| 687 | (org-export-latex-quotation-marks) | ||
| 688 | (when (plist-get org-latex-options-plist :emphasize) | ||
| 689 | (org-export-latex-fontify)) | ||
| 690 | (org-export-latex-special-chars | ||
| 691 | (plist-get org-latex-options-plist :sub-superscript)) | ||
| 692 | (org-export-latex-links) | ||
| 693 | (org-export-latex-keywords | ||
| 694 | (plist-get org-latex-options-plist :timestamps)) | ||
| 695 | (org-export-latex-lists) | ||
| 696 | (org-export-latex-tables | ||
| 697 | (plist-get org-latex-options-plist :tables)) | ||
| 698 | (org-export-latex-fixed-width | ||
| 699 | (plist-get org-latex-options-plist :fixed-width)) | ||
| 700 | ;; return string | ||
| 701 | (buffer-substring (point-min) (point-max)))) | ||
| 702 | |||
| 703 | (defun org-export-latex-quotation-marks () | 775 | (defun org-export-latex-quotation-marks () |
| 704 | "Export question marks depending on language conventions. | 776 | "Export question marks depending on language conventions." |
| 705 | Local definition of the language overrides | 777 | (let* ((lang (plist-get org-export-latex-options-plist :language)) |
| 706 | `org-export-latex-quotation-marks-convention' which overrides | ||
| 707 | `org-export-default-language'." | ||
| 708 | (let* ((lang (plist-get org-latex-options-plist :language)) | ||
| 709 | (quote-rpl (if (equal lang "fr") | 778 | (quote-rpl (if (equal lang "fr") |
| 710 | '(("\\(\\s-\\)\"" "«~") | 779 | '(("\\(\\s-\\)\"" "«~") |
| 711 | ("\\(\\S-\\)\"" "~»") | 780 | ("\\(\\S-\\)\"" "~»") |
| @@ -720,21 +789,6 @@ Local definition of the language overrides | |||
| 720 | (org-if-unprotected | 789 | (org-if-unprotected |
| 721 | (replace-match rpl t t))))) quote-rpl))) | 790 | (replace-match rpl t t))))) quote-rpl))) |
| 722 | 791 | ||
| 723 | ;; | chars/string in Org | normal environment | math environment | | ||
| 724 | ;; |-----------------------+-----------------------+-----------------------| | ||
| 725 | ;; | & # % $ | \& \# \% \$ | \& \# \% \$ | | ||
| 726 | ;; | { } _ ^ \ | \{ \} \_ \^ \\ | { } _ ^ \ | | ||
| 727 | ;; |-----------------------+-----------------------+-----------------------| | ||
| 728 | ;; | a_b and a^b | $a_b$ and $a^b$ | a_b and a^b | | ||
| 729 | ;; | a_abc and a_{abc} | $a_a$bc and $a_{abc}$ | a_abc and a_{abc} | | ||
| 730 | ;; | \tau and \mu | $\tau$ and $\mu$ | \tau and \mu | | ||
| 731 | ;; |-----------------------+-----------------------+-----------------------| | ||
| 732 | ;; | \_ \^ | \_ \^ | \_ \^ | | ||
| 733 | ;; | \(a=\mu\mbox{m}\) | \(a=\mu\mbox{m}\) | \(a=\mu\mbox{m}\) | | ||
| 734 | ;; | \[\beta^2-a=0\] | \[\beta^2-a=0\] | \[\beta^2-a=0\] | | ||
| 735 | ;; | $x=22\tau$ | $x=22\tau$ | $x=22\tau$ | | ||
| 736 | ;; | $$\alpha=\sqrt{a^3}$$ | $$\alpha=\sqrt{a^3}$$ | $$\alpha=\sqrt{a^3}$$ | | ||
| 737 | |||
| 738 | (defun org-export-latex-special-chars (sub-superscript) | 792 | (defun org-export-latex-special-chars (sub-superscript) |
| 739 | "Export special characters to LaTeX. | 793 | "Export special characters to LaTeX. |
| 740 | If SUB-SUPERSCRIPT is non-nil, convert \\ and ^. | 794 | If SUB-SUPERSCRIPT is non-nil, convert \\ and ^. |
| @@ -744,7 +798,8 @@ See the `org-export-latex.el' code for a complete conversion table." | |||
| 744 | (goto-char (point-min)) | 798 | (goto-char (point-min)) |
| 745 | (while (re-search-forward c nil t) | 799 | (while (re-search-forward c nil t) |
| 746 | ;; Put the point where to check for org-protected | 800 | ;; Put the point where to check for org-protected |
| 747 | (unless (get-text-property (match-beginning 2) 'org-protected) | 801 | (unless (or (get-text-property (match-beginning 2) 'org-protected) |
| 802 | (org-at-table-p)) | ||
| 748 | (cond ((member (match-string 2) '("\\$" "$")) | 803 | (cond ((member (match-string 2) '("\\$" "$")) |
| 749 | (if (equal (match-string 2) "\\$") | 804 | (if (equal (match-string 2) "\\$") |
| 750 | (replace-match (concat (match-string 1) "$" | 805 | (replace-match (concat (match-string 1) "$" |
| @@ -756,11 +811,15 @@ See the `org-export-latex.el' code for a complete conversion table." | |||
| 756 | (replace-match (match-string 2) t t) | 811 | (replace-match (match-string 2) t t) |
| 757 | (replace-match (concat (match-string 1) "\\" | 812 | (replace-match (concat (match-string 1) "\\" |
| 758 | (match-string 2)) t t))) | 813 | (match-string 2)) t t))) |
| 814 | ((equal (match-string 2) "...") | ||
| 815 | (replace-match | ||
| 816 | (concat (match-string 1) | ||
| 817 | (org-export-latex-protect-string "\\ldots{}")) t t)) | ||
| 759 | ((equal (match-string 2) "~") | 818 | ((equal (match-string 2) "~") |
| 760 | (cond ((equal (match-string 1) "\\") nil) | 819 | (cond ((equal (match-string 1) "\\") nil) |
| 761 | ((eq 'org-link (get-text-property 0 'face (match-string 2))) | 820 | ((eq 'org-link (get-text-property 0 'face (match-string 2))) |
| 762 | (replace-match (concat (match-string 1) "\\~") t t)) | 821 | (replace-match (concat (match-string 1) "\\~") t t)) |
| 763 | (t (replace-match | 822 | (t (replace-match |
| 764 | (org-export-latex-protect-string | 823 | (org-export-latex-protect-string |
| 765 | (concat (match-string 1) "\\~{}")) t t)))) | 824 | (concat (match-string 1) "\\~{}")) t t)))) |
| 766 | ((member (match-string 2) '("{" "}")) | 825 | ((member (match-string 2) '("{" "}")) |
| @@ -791,6 +850,7 @@ See the `org-export-latex.el' code for a complete conversion table." | |||
| 791 | "\\(.\\|^\\)\\({\\)" | 850 | "\\(.\\|^\\)\\({\\)" |
| 792 | "\\(.\\|^\\)\\(}\\)" | 851 | "\\(.\\|^\\)\\(}\\)" |
| 793 | "\\(.\\|^\\)\\(~\\)" | 852 | "\\(.\\|^\\)\\(~\\)" |
| 853 | "\\(.\\|^\\)\\(\\.\\.\\.\\)" | ||
| 794 | ;; (?\< . "\\textless{}") | 854 | ;; (?\< . "\\textless{}") |
| 795 | ;; (?\> . "\\textgreater{}") | 855 | ;; (?\> . "\\textgreater{}") |
| 796 | ))) | 856 | ))) |
| @@ -812,7 +872,7 @@ Convert CHAR depending on STRING-BEFORE and STRING-AFTER." | |||
| 812 | (cond ((eq 1 (length string-after)) | 872 | (cond ((eq 1 (length string-after)) |
| 813 | (concat string-before char string-after)) | 873 | (concat string-before char string-after)) |
| 814 | ((string-match "[({]?\\([^)}]+\\)[)}]?" string-after) | 874 | ((string-match "[({]?\\([^)}]+\\)[)}]?" string-after) |
| 815 | (format "%s%s{%s}" string-before char | 875 | (format "%s%s{%s}" string-before char |
| 816 | (match-string 1 string-after)))))) | 876 | (match-string 1 string-after)))))) |
| 817 | ((and subsup | 877 | ((and subsup |
| 818 | (> (length string-after) 1) | 878 | (> (length string-after) 1) |
| @@ -842,7 +902,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." | |||
| 842 | (string-match "^[ \t\n]" string-after))) | 902 | (string-match "^[ \t\n]" string-after))) |
| 843 | ;; backslash might escape a character (like \#) or a user TeX | 903 | ;; backslash might escape a character (like \#) or a user TeX |
| 844 | ;; macro (like \setcounter) | 904 | ;; macro (like \setcounter) |
| 845 | (org-export-latex-protect-string | 905 | (org-export-latex-protect-string |
| 846 | (concat string-before "\\" string-after))) | 906 | (concat string-before "\\" string-after))) |
| 847 | ((and (string-match "^[ \t\n]" string-after) | 907 | ((and (string-match "^[ \t\n]" string-after) |
| 848 | (string-match "[ \t\n]\\'" string-before)) | 908 | (string-match "[ \t\n]\\'" string-before)) |
| @@ -854,19 +914,18 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." | |||
| 854 | 914 | ||
| 855 | (defun org-export-latex-keywords (timestamps) | 915 | (defun org-export-latex-keywords (timestamps) |
| 856 | "Convert special keywords to LaTeX. | 916 | "Convert special keywords to LaTeX. |
| 857 | Regexps are those from `org-latex-special-string-regexps'." | 917 | Regexps are those from `org-export-latex-special-string-regexps'." |
| 858 | (let ((rg org-latex-special-string-regexps) r) | 918 | (let ((rg org-export-latex-special-string-regexps) r) |
| 859 | (while (setq r (pop rg)) | 919 | (while (setq r (pop rg)) |
| 860 | (goto-char (point-min)) | 920 | (goto-char (point-min)) |
| 861 | (while (re-search-forward (eval r) nil t) | 921 | (while (re-search-forward (eval r) nil t) |
| 862 | (if (not timestamps) | 922 | (if (not timestamps) |
| 863 | (replace-match (format "\\\\texttt{%s}" (match-string 0)) t) | 923 | (replace-match (format "\\\\texttt{%s}" (match-string 0)) t) |
| 864 | (replace-match "")))))) | 924 | (replace-match "")))))) |
| 865 | 925 | ||
| 866 | (defun org-export-latex-fixed-width (opt) | 926 | (defun org-export-latex-fixed-width (opt) |
| 867 | "When OPT is non-nil convert fixed-width sections to LaTeX." | 927 | "When OPT is non-nil convert fixed-width sections to LaTeX." |
| 868 | (goto-char (point-min)) | 928 | (goto-char (point-min)) |
| 869 | ;; FIXME the search shouldn't be performed on already converted text | ||
| 870 | (while (re-search-forward "^[ \t]*:" nil t) | 929 | (while (re-search-forward "^[ \t]*:" nil t) |
| 871 | (if opt | 930 | (if opt |
| 872 | (progn (goto-char (match-beginning 0)) | 931 | (progn (goto-char (match-beginning 0)) |
| @@ -882,73 +941,6 @@ Regexps are those from `org-latex-special-string-regexps'." | |||
| 882 | (match-string 2)) t t) | 941 | (match-string 2)) t t) |
| 883 | (forward-line)))))) | 942 | (forward-line)))))) |
| 884 | 943 | ||
| 885 | (defun org-export-latex-lists () | ||
| 886 | "Convert lists to LaTeX." | ||
| 887 | (goto-char (point-min)) | ||
| 888 | (while (re-search-forward org-export-latex-list-beginning-re nil t) | ||
| 889 | (beginning-of-line) | ||
| 890 | (org-export-list-to-latex | ||
| 891 | (org-export-latex-parse-list t)))) | ||
| 892 | |||
| 893 | (defun org-export-list-to-generic (list params) | ||
| 894 | "Convert a LIST parsed through `org-export-latex-parse-list' to other formats. | ||
| 895 | |||
| 896 | Valid parameters are | ||
| 897 | |||
| 898 | :ustart String to start an unordered list | ||
| 899 | :uend String to end an unordered list | ||
| 900 | |||
| 901 | :ostart String to start an ordered list | ||
| 902 | :oend String to end an ordered list | ||
| 903 | |||
| 904 | :splice When set to t, return only list body lines, don't wrap | ||
| 905 | them into :[u/o]start and :[u/o]end. Default is nil. | ||
| 906 | |||
| 907 | :istart String to start a list item | ||
| 908 | :iend String to end a list item | ||
| 909 | :isep String to separate items | ||
| 910 | :lsep String to separate sublists" | ||
| 911 | (interactive) | ||
| 912 | (let* ((p params) sublist | ||
| 913 | (splicep (plist-get p :splice)) | ||
| 914 | (ostart (plist-get p :ostart)) | ||
| 915 | (oend (plist-get p :oend)) | ||
| 916 | (ustart (plist-get p :ustart)) | ||
| 917 | (uend (plist-get p :uend)) | ||
| 918 | (istart (plist-get p :istart)) | ||
| 919 | (iend (plist-get p :iend)) | ||
| 920 | (isep (plist-get p :isep)) | ||
| 921 | (lsep (plist-get p :lsep))) | ||
| 922 | (let ((wrapper | ||
| 923 | (cond ((eq (car list) 'ordered) | ||
| 924 | (concat ostart "\n%s" oend "\n")) | ||
| 925 | ((eq (car list) 'unordered) | ||
| 926 | (concat ustart "\n%s" uend "\n")))) | ||
| 927 | rtn) | ||
| 928 | (while (setq sublist (pop list)) | ||
| 929 | (cond ((symbolp sublist) nil) | ||
| 930 | ((stringp sublist) | ||
| 931 | (setq rtn (concat rtn istart sublist iend isep))) | ||
| 932 | (t | ||
| 933 | (setq rtn (concat rtn ;; previous list | ||
| 934 | lsep ;; list separator | ||
| 935 | (org-export-list-to-generic sublist p) | ||
| 936 | lsep ;; list separator | ||
| 937 | ))))) | ||
| 938 | (format wrapper rtn)))) | ||
| 939 | |||
| 940 | (defun org-export-list-to-latex (list) | ||
| 941 | "Convert LIST into a LaTeX list." | ||
| 942 | (insert | ||
| 943 | (org-export-list-to-generic | ||
| 944 | list '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}" | ||
| 945 | :ustart "\\begin{itemize}" :uend "\\end{itemize}" | ||
| 946 | :istart "\\item " :iend "" | ||
| 947 | :isep "\n" :lsep "\n")) | ||
| 948 | ;; Add a trailing \n after list conversion | ||
| 949 | "\n")) | ||
| 950 | |||
| 951 | ;; FIXME Use org-export-highlight-first-table-line ? | ||
| 952 | (defun org-export-latex-tables (insert) | 944 | (defun org-export-latex-tables (insert) |
| 953 | "Convert tables to LaTeX and INSERT it." | 945 | "Convert tables to LaTeX and INSERT it." |
| 954 | (goto-char (point-min)) | 946 | (goto-char (point-min)) |
| @@ -975,7 +967,7 @@ Valid parameters are | |||
| 975 | (unless (string-match "^[ \t]*|-" line) | 967 | (unless (string-match "^[ \t]*|-" line) |
| 976 | (setq fields (org-split-string line "[ \t]*|[ \t]*")) | 968 | (setq fields (org-split-string line "[ \t]*|[ \t]*")) |
| 977 | (setq fnum (make-vector (length fields) 0)) | 969 | (setq fnum (make-vector (length fields) 0)) |
| 978 | (setq line-fmt | 970 | (setq line-fmt |
| 979 | (mapconcat | 971 | (mapconcat |
| 980 | (lambda (x) | 972 | (lambda (x) |
| 981 | (setq gr (pop org-table-colgroup-info)) | 973 | (setq gr (pop org-table-colgroup-info)) |
| @@ -991,18 +983,21 @@ Valid parameters are | |||
| 991 | (progn (setq colgropen nil) "|") | 983 | (progn (setq colgropen nil) "|") |
| 992 | ""))) | 984 | ""))) |
| 993 | fnum "")))) | 985 | fnum "")))) |
| 986 | ;; fix double || in line-fmt | ||
| 987 | (setq line-fmt (replace-regexp-in-string "||" "|" line-fmt)) | ||
| 994 | ;; maybe remove the first and last "|" | 988 | ;; maybe remove the first and last "|" |
| 995 | (when (string-match "^\\(|\\)?\\(.+\\)|$" line-fmt) | 989 | (when (and (not org-export-latex-tables-column-borders) |
| 990 | (string-match "^\\(|\\)?\\(.+\\)|$" line-fmt)) | ||
| 996 | (setq line-fmt (match-string 2 line-fmt))) | 991 | (setq line-fmt (match-string 2 line-fmt))) |
| 997 | ;; format alignment | 992 | ;; format alignment |
| 998 | (setq align (apply 'format | 993 | (setq align (apply 'format |
| 999 | (cons line-fmt | 994 | (cons line-fmt |
| 1000 | (mapcar (lambda (x) (if x "r" "l")) | 995 | (mapcar (lambda (x) (if x "r" "l")) |
| 1001 | org-table-last-alignment)))) | 996 | org-table-last-alignment)))) |
| 1002 | ;; prepare the table to send to orgtbl-to-latex | 997 | ;; prepare the table to send to orgtbl-to-latex |
| 1003 | (setq lines | 998 | (setq lines |
| 1004 | (mapcar | 999 | (mapcar |
| 1005 | (lambda(elem) | 1000 | (lambda(elem) |
| 1006 | (or (and (string-match "[ \t]*|-+" elem) 'hline) | 1001 | (or (and (string-match "[ \t]*|-+" elem) 'hline) |
| 1007 | (split-string (org-trim elem) "|" t))) | 1002 | (split-string (org-trim elem) "|" t))) |
| 1008 | lines)) | 1003 | lines)) |
| @@ -1016,8 +1011,8 @@ Valid parameters are | |||
| 1016 | (goto-char (point-min)) | 1011 | (goto-char (point-min)) |
| 1017 | (while (re-search-forward org-emph-re nil t) | 1012 | (while (re-search-forward org-emph-re nil t) |
| 1018 | ;; The match goes one char after the *string* | 1013 | ;; The match goes one char after the *string* |
| 1019 | (let ((emph (assoc (match-string 3) | 1014 | (let ((emph (assoc (match-string 3) |
| 1020 | org-export-latex-emphasis-alist)) | 1015 | org-export-latex-emphasis-alist)) |
| 1021 | rpl) | 1016 | rpl) |
| 1022 | (unless (get-text-property (1- (point)) 'org-protected) | 1017 | (unless (get-text-property (1- (point)) 'org-protected) |
| 1023 | (setq rpl (concat (match-string 1) | 1018 | (setq rpl (concat (match-string 1) |
| @@ -1025,7 +1020,7 @@ Valid parameters are | |||
| 1025 | '("\\" "{" "}") (cadr emph)) | 1020 | '("\\" "{" "}") (cadr emph)) |
| 1026 | (match-string 4)) | 1021 | (match-string 4)) |
| 1027 | (match-string 5))) | 1022 | (match-string 5))) |
| 1028 | (if (caddr emph) | 1023 | (if (caddr emph) |
| 1029 | (setq rpl (org-export-latex-protect-string rpl))) | 1024 | (setq rpl (org-export-latex-protect-string rpl))) |
| 1030 | (replace-match rpl t t))) | 1025 | (replace-match rpl t t))) |
| 1031 | (backward-char))) | 1026 | (backward-char))) |
| @@ -1038,7 +1033,7 @@ Valid parameters are | |||
| 1038 | (while (re-search-forward org-bracket-link-analytic-regexp nil t) | 1033 | (while (re-search-forward org-bracket-link-analytic-regexp nil t) |
| 1039 | (org-if-unprotected | 1034 | (org-if-unprotected |
| 1040 | (goto-char (match-beginning 0)) | 1035 | (goto-char (match-beginning 0)) |
| 1041 | (let* ((re-radio org-latex-all-targets-regexp) | 1036 | (let* ((re-radio org-export-latex-all-targets-re) |
| 1042 | (remove (list (match-beginning 0) (match-end 0))) | 1037 | (remove (list (match-beginning 0) (match-end 0))) |
| 1043 | (type (match-string 2)) | 1038 | (type (match-string 2)) |
| 1044 | (raw-path (match-string 3)) | 1039 | (raw-path (match-string 3)) |
| @@ -1063,22 +1058,22 @@ Valid parameters are | |||
| 1063 | (if (file-exists-p raw-path) | 1058 | (if (file-exists-p raw-path) |
| 1064 | (concat type "://" (expand-file-name raw-path)) | 1059 | (concat type "://" (expand-file-name raw-path)) |
| 1065 | (concat type "://" (org-export-directory | 1060 | (concat type "://" (org-export-directory |
| 1066 | :LaTeX org-latex-options-plist) | 1061 | :LaTeX org-export-latex-options-plist) |
| 1067 | raw-path)))))))) | 1062 | raw-path)))))))) |
| 1068 | ;; process with link inserting | 1063 | ;; process with link inserting |
| 1069 | (apply 'delete-region remove) | 1064 | (apply 'delete-region remove) |
| 1070 | (cond ((and imgp (plist-get org-latex-options-plist :inline-images)) | 1065 | (cond ((and imgp (plist-get org-export-latex-options-plist :inline-images)) |
| 1071 | (insert (format "\\includegraphics[%s]{%s}" | 1066 | (insert (format "\\includegraphics[%s]{%s}" |
| 1072 | ;; image option should be set be a comment line | 1067 | ;; image option should be set be a comment line |
| 1073 | org-export-latex-image-default-option | 1068 | org-export-latex-image-default-option |
| 1074 | (expand-file-name raw-path)))) | 1069 | (expand-file-name raw-path)))) |
| 1075 | ;; FIXME: what about caption? image properties? | ||
| 1076 | (radiop (insert (format "\\hyperref[%s]{%s}" raw-path desc))) | 1070 | (radiop (insert (format "\\hyperref[%s]{%s}" raw-path desc))) |
| 1077 | (path (insert (format "\\href{%s}{%s}" path desc))) | 1071 | (path (insert (format "\\href{%s}{%s}" path desc))) |
| 1078 | (t (insert "\\texttt{" desc "}"))))))) | 1072 | (t (insert "\\texttt{" desc "}"))))))) |
| 1079 | 1073 | ||
| 1080 | (defun org-export-latex-cleaned-string (&optional commentsp) | 1074 | (defvar org-latex-entities) ; defined below |
| 1081 | ;; FIXME remove commentsp call in org.el and here | 1075 | |
| 1076 | (defun org-export-latex-cleaned-string () | ||
| 1082 | "Clean stuff in the LaTeX export." | 1077 | "Clean stuff in the LaTeX export." |
| 1083 | 1078 | ||
| 1084 | ;; Preserve line breaks | 1079 | ;; Preserve line breaks |
| @@ -1091,7 +1086,7 @@ Valid parameters are | |||
| 1091 | (goto-char (point-min)) | 1086 | (goto-char (point-min)) |
| 1092 | (let ((case-fold-search nil) rpl) | 1087 | (let ((case-fold-search nil) rpl) |
| 1093 | (while (re-search-forward "\\([^+_]\\)LaTeX" nil t) | 1088 | (while (re-search-forward "\\([^+_]\\)LaTeX" nil t) |
| 1094 | (replace-match (org-export-latex-protect-string | 1089 | (replace-match (org-export-latex-protect-string |
| 1095 | (concat (match-string 1) "\\LaTeX{}")) t t))) | 1090 | (concat (match-string 1) "\\LaTeX{}")) t t))) |
| 1096 | 1091 | ||
| 1097 | ;; Convert horizontal rules | 1092 | ;; Convert horizontal rules |
| @@ -1099,19 +1094,25 @@ Valid parameters are | |||
| 1099 | (while (re-search-forward "^----+.$" nil t) | 1094 | (while (re-search-forward "^----+.$" nil t) |
| 1100 | (replace-match (org-export-latex-protect-string "\\hrule") t t)) | 1095 | (replace-match (org-export-latex-protect-string "\\hrule") t t)) |
| 1101 | 1096 | ||
| 1102 | ;; Protect LaTeX \commands{...} | 1097 | ;; Protect LaTeX commands like \commad[...]{...} or \command{...} |
| 1103 | (goto-char (point-min)) | 1098 | (goto-char (point-min)) |
| 1104 | (while (re-search-forward "\\\\[a-zA-Z]+\\(?:\\[.*\\]\\)?{.*}" nil t) | 1099 | (while (re-search-forward "\\\\[a-zA-Z]+\\(?:\\[.*\\]\\)?{.*}" nil t) |
| 1105 | (add-text-properties (match-beginning 0) (match-end 0) | 1100 | (add-text-properties (match-beginning 0) (match-end 0) |
| 1106 | '(org-protected t))) | 1101 | '(org-protected t))) |
| 1107 | 1102 | ||
| 1103 | ;; Protect LaTeX entities | ||
| 1104 | (goto-char (point-min)) | ||
| 1105 | (while (re-search-forward (regexp-opt org-latex-entities) nil t) | ||
| 1106 | (add-text-properties (match-beginning 0) (match-end 0) | ||
| 1107 | '(org-protected t))) | ||
| 1108 | |||
| 1108 | ;; Replace radio links | 1109 | ;; Replace radio links |
| 1109 | (goto-char (point-min)) | 1110 | (goto-char (point-min)) |
| 1110 | (while (re-search-forward | 1111 | (while (re-search-forward |
| 1111 | (concat "<<<?" org-latex-all-targets-regexp | 1112 | (concat "<<<?" org-export-latex-all-targets-re |
| 1112 | ">>>?\\((INVISIBLE)\\)?") nil t) | 1113 | ">>>?\\((INVISIBLE)\\)?") nil t) |
| 1113 | (replace-match | 1114 | (replace-match |
| 1114 | (org-export-latex-protect-string | 1115 | (org-export-latex-protect-string |
| 1115 | (format "\\label{%s}%s"(match-string 1) | 1116 | (format "\\label{%s}%s"(match-string 1) |
| 1116 | (if (match-string 2) "" (match-string 1)))) t t)) | 1117 | (if (match-string 2) "" (match-string 1)))) t t)) |
| 1117 | 1118 | ||
| @@ -1123,7 +1124,7 @@ Valid parameters are | |||
| 1123 | 1124 | ||
| 1124 | ;; When converting to LaTeX, replace footnotes | 1125 | ;; When converting to LaTeX, replace footnotes |
| 1125 | ;; FIXME: don't protect footnotes from conversion | 1126 | ;; FIXME: don't protect footnotes from conversion |
| 1126 | (when (plist-get org-latex-options-plist :footnotes) | 1127 | (when (plist-get org-export-latex-options-plist :footnotes) |
| 1127 | (goto-char (point-min)) | 1128 | (goto-char (point-min)) |
| 1128 | (while (re-search-forward "\\[[0-9]+\\]" nil t) | 1129 | (while (re-search-forward "\\[[0-9]+\\]" nil t) |
| 1129 | (when (save-match-data | 1130 | (when (save-match-data |
| @@ -1133,34 +1134,402 @@ Valid parameters are | |||
| 1133 | (foot-end (match-end 0)) | 1134 | (foot-end (match-end 0)) |
| 1134 | (foot-prefix (match-string 0)) | 1135 | (foot-prefix (match-string 0)) |
| 1135 | footnote footnote-rpl) | 1136 | footnote footnote-rpl) |
| 1136 | (when (and (re-search-forward (regexp-quote foot-prefix) nil t)) | 1137 | (save-excursion |
| 1137 | (replace-match "") | 1138 | (when (search-forward foot-prefix nil t) |
| 1138 | (let ((end (save-excursion | 1139 | (replace-match "") |
| 1139 | (if (re-search-forward "^$\\|^#.*$\\|\\[[0-9]+\\]" nil t) | 1140 | (let ((end (save-excursion |
| 1140 | (match-beginning 0) (point-max))))) | 1141 | (if (re-search-forward "^$\\|^#.*$\\|\\[[0-9]+\\]" nil t) |
| 1141 | (setq footnote | 1142 | (match-beginning 0) (point-max))))) |
| 1142 | (concat | 1143 | (setq footnote (concat (org-trim (buffer-substring (point) end)) |
| 1143 | (org-trim (buffer-substring (point) end)) | 1144 | " ")) ; prevent last } being part of a link |
| 1144 | ;; FIXME stupid workaround for cases where | 1145 | (delete-region (point) end)) |
| 1145 | ;; `org-bracket-link-analytic-regexp' matches | 1146 | (goto-char foot-beg) |
| 1146 | ;; }. as part of the link. | 1147 | (delete-region foot-beg foot-end) |
| 1147 | " ")) | 1148 | (unless (null footnote) |
| 1148 | (delete-region (point) end))) | 1149 | (setq footnote-rpl (format "\\footnote{%s}" footnote)) |
| 1149 | (goto-char foot-beg) | 1150 | (add-text-properties 0 10 '(org-protected t) footnote-rpl) |
| 1150 | (delete-region foot-beg foot-end) | 1151 | (add-text-properties (1- (length footnote-rpl)) |
| 1151 | (setq footnote-rpl (format "\\footnote{%s}" footnote)) | 1152 | (length footnote-rpl) |
| 1152 | (add-text-properties 0 10 '(org-protected t) footnote-rpl) | 1153 | '(org-protected t) footnote-rpl) |
| 1153 | (add-text-properties (1- (length footnote-rpl)) | 1154 | (insert footnote-rpl))))))) |
| 1154 | (length footnote-rpl) | 1155 | |
| 1155 | '(org-protected t) footnote-rpl) | ||
| 1156 | (insert footnote-rpl)))) | ||
| 1157 | |||
| 1158 | ;; Replace footnote section tag for LaTeX | 1156 | ;; Replace footnote section tag for LaTeX |
| 1159 | (goto-char (point-min)) | 1157 | (goto-char (point-min)) |
| 1160 | (while (re-search-forward | 1158 | (while (re-search-forward |
| 1161 | (concat "^" footnote-section-tag-regexp) nil t) | 1159 | (concat "^" footnote-section-tag-regexp) nil t) |
| 1162 | (replace-match "")))) | 1160 | (replace-match "")))) |
| 1163 | 1161 | ||
| 1162 | ;;; List handling: | ||
| 1163 | |||
| 1164 | (defun org-export-latex-lists () | ||
| 1165 | "Replace plain text lists in current buffer into LaTeX lists." | ||
| 1166 | "Convert lists to LaTeX." | ||
| 1167 | (goto-char (point-min)) | ||
| 1168 | (while (re-search-forward org-export-latex-list-beginning-re nil t) | ||
| 1169 | (beginning-of-line) | ||
| 1170 | (insert (org-list-to-latex (org-list-parse-list t)) "\n"))) | ||
| 1171 | |||
| 1172 | (defun org-list-parse-list (&optional delete) | ||
| 1173 | "Parse the list at point. | ||
| 1174 | Return a list containing first level items as strings and | ||
| 1175 | sublevels as a list of strings." | ||
| 1176 | (let ((start (org-list-item-begin)) | ||
| 1177 | (end (org-list-end)) | ||
| 1178 | output itemsep) | ||
| 1179 | (while (re-search-forward org-export-latex-list-beginning-re end t) | ||
| 1180 | (setq itemsep (if (save-match-data | ||
| 1181 | (string-match "^[0-9]" (match-string 2))) | ||
| 1182 | "[0-9]+\\(?:\\.\\|)\\)" "[-+]")) | ||
| 1183 | (let* ((indent1 (match-string 1)) | ||
| 1184 | (nextitem (save-excursion | ||
| 1185 | (save-match-data | ||
| 1186 | (or (and (re-search-forward | ||
| 1187 | (concat "^" indent1 itemsep " *?") end t) | ||
| 1188 | (match-beginning 0)) end)))) | ||
| 1189 | (item (buffer-substring | ||
| 1190 | (point) | ||
| 1191 | (or (and (re-search-forward | ||
| 1192 | org-export-latex-list-beginning-re end t) | ||
| 1193 | (goto-char (match-beginning 0))) | ||
| 1194 | (goto-char end)))) | ||
| 1195 | (nextindent (match-string 1)) | ||
| 1196 | (item (org-trim item)) | ||
| 1197 | (item (if (string-match "^\\[.+\\]" item) | ||
| 1198 | (replace-match "\\\\texttt{\\&}" | ||
| 1199 | t nil item) item))) | ||
| 1200 | (push item output) | ||
| 1201 | (when (> (length nextindent) | ||
| 1202 | (length indent1)) | ||
| 1203 | (narrow-to-region (point) nextitem) | ||
| 1204 | (push (org-list-parse-list) output) | ||
| 1205 | (widen)))) | ||
| 1206 | (when delete (delete-region start end)) | ||
| 1207 | (setq output (nreverse output)) | ||
| 1208 | (push (if (string-match "^\\[0" itemsep) | ||
| 1209 | 'ordered 'unordered) output))) | ||
| 1210 | |||
| 1211 | (defun org-list-item-begin () | ||
| 1212 | "Find the beginning of the list item and return its position." | ||
| 1213 | (save-excursion | ||
| 1214 | (if (not (or (looking-at org-export-latex-list-beginning-re) | ||
| 1215 | (re-search-backward | ||
| 1216 | org-export-latex-list-beginning-re nil t))) | ||
| 1217 | (progn (goto-char (point-min)) (point)) | ||
| 1218 | (match-beginning 0)))) | ||
| 1219 | |||
| 1220 | (defun org-list-end () | ||
| 1221 | "Find the end of the list and return its position." | ||
| 1222 | (save-excursion | ||
| 1223 | (catch 'exit | ||
| 1224 | (while (or (looking-at org-export-latex-list-beginning-re) | ||
| 1225 | (looking-at "^[ \t]+\\|^$")) | ||
| 1226 | (if (eq (point) (point-max)) | ||
| 1227 | (throw 'exit (point-max))) | ||
| 1228 | (forward-line 1))) (point))) | ||
| 1229 | |||
| 1230 | (defun org-list-insert-radio-list () | ||
| 1231 | "Insert a radio list template appropriate for this major mode." | ||
| 1232 | (interactive) | ||
| 1233 | (let* ((e (assq major-mode org-list-radio-list-templates)) | ||
| 1234 | (txt (nth 1 e)) | ||
| 1235 | name pos) | ||
| 1236 | (unless e (error "No radio list setup defined for %s" major-mode)) | ||
| 1237 | (setq name (read-string "List name: ")) | ||
| 1238 | (while (string-match "%n" txt) | ||
| 1239 | (setq txt (replace-match name t t txt))) | ||
| 1240 | (or (bolp) (insert "\n")) | ||
| 1241 | (setq pos (point)) | ||
| 1242 | (insert txt) | ||
| 1243 | (goto-char pos))) | ||
| 1244 | |||
| 1245 | (defun org-list-send-list (&optional maybe) | ||
| 1246 | "Send a tranformed version of this list to the receiver position. | ||
| 1247 | With argument MAYBE, fail quietly if no transformation is defined for | ||
| 1248 | this list." | ||
| 1249 | (interactive) | ||
| 1250 | (catch 'exit | ||
| 1251 | (unless (org-at-item-p) (error "Not at a list")) | ||
| 1252 | (save-excursion | ||
| 1253 | (goto-char (org-list-item-begin)) | ||
| 1254 | (beginning-of-line 0) | ||
| 1255 | (unless (looking-at "#\\+ORGLST: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?") | ||
| 1256 | (if maybe | ||
| 1257 | (throw 'exit nil) | ||
| 1258 | (error "Don't know how to transform this list")))) | ||
| 1259 | (let* ((name (match-string 1)) | ||
| 1260 | beg | ||
| 1261 | (transform (intern (match-string 2))) | ||
| 1262 | (txt (buffer-substring-no-properties | ||
| 1263 | (org-list-item-begin) | ||
| 1264 | (org-list-end))) | ||
| 1265 | (list (org-list-parse-list))) | ||
| 1266 | (unless (fboundp transform) | ||
| 1267 | (error "No such transformation function %s" transform)) | ||
| 1268 | (setq txt (funcall transform list)) | ||
| 1269 | ;; Find the insertion place | ||
| 1270 | (save-excursion | ||
| 1271 | (goto-char (point-min)) | ||
| 1272 | (unless (re-search-forward | ||
| 1273 | (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t) | ||
| 1274 | (error "Don't know where to insert translated list")) | ||
| 1275 | (goto-char (match-beginning 0)) | ||
| 1276 | (beginning-of-line 2) | ||
| 1277 | (setq beg (point)) | ||
| 1278 | (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t) | ||
| 1279 | (error "Cannot find end of insertion region")) | ||
| 1280 | (beginning-of-line 1) | ||
| 1281 | (delete-region beg (point)) | ||
| 1282 | (goto-char beg) | ||
| 1283 | (insert txt "\n")) | ||
| 1284 | (message "List converted and installed at receiver location")))) | ||
| 1285 | |||
| 1286 | (defun org-list-to-generic (list params) | ||
| 1287 | "Convert a LIST parsed through `org-list-parse-list' to other formats. | ||
| 1288 | |||
| 1289 | Valid parameters are | ||
| 1290 | |||
| 1291 | :ustart String to start an unordered list | ||
| 1292 | :uend String to end an unordered list | ||
| 1293 | |||
| 1294 | :ostart String to start an ordered list | ||
| 1295 | :oend String to end an ordered list | ||
| 1296 | |||
| 1297 | :splice When set to t, return only list body lines, don't wrap | ||
| 1298 | them into :[u/o]start and :[u/o]end. Default is nil. | ||
| 1299 | |||
| 1300 | :istart String to start a list item | ||
| 1301 | :iend String to end a list item | ||
| 1302 | :isep String to separate items | ||
| 1303 | :lsep String to separate sublists" | ||
| 1304 | (interactive) | ||
| 1305 | (let* ((p params) sublist | ||
| 1306 | (splicep (plist-get p :splice)) | ||
| 1307 | (ostart (plist-get p :ostart)) | ||
| 1308 | (oend (plist-get p :oend)) | ||
| 1309 | (ustart (plist-get p :ustart)) | ||
| 1310 | (uend (plist-get p :uend)) | ||
| 1311 | (istart (plist-get p :istart)) | ||
| 1312 | (iend (plist-get p :iend)) | ||
| 1313 | (isep (plist-get p :isep)) | ||
| 1314 | (lsep (plist-get p :lsep))) | ||
| 1315 | (let ((wrapper | ||
| 1316 | (cond ((eq (car list) 'ordered) | ||
| 1317 | (concat ostart "\n%s" oend "\n")) | ||
| 1318 | ((eq (car list) 'unordered) | ||
| 1319 | (concat ustart "\n%s" uend "\n")))) | ||
| 1320 | rtn) | ||
| 1321 | (while (setq sublist (pop list)) | ||
| 1322 | (cond ((symbolp sublist) nil) | ||
| 1323 | ((stringp sublist) | ||
| 1324 | (setq rtn (concat rtn istart sublist iend isep))) | ||
| 1325 | (t | ||
| 1326 | (setq rtn (concat rtn ;; previous list | ||
| 1327 | lsep ;; list separator | ||
| 1328 | (org-list-to-generic sublist p) | ||
| 1329 | lsep ;; list separator | ||
| 1330 | ))))) | ||
| 1331 | (format wrapper rtn)))) | ||
| 1332 | |||
| 1333 | (defun org-list-to-latex (list) | ||
| 1334 | "Convert LIST into a LaTeX list." | ||
| 1335 | (org-list-to-generic | ||
| 1336 | list '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}" | ||
| 1337 | :ustart "\\begin{itemize}" :uend "\\end{itemize}" | ||
| 1338 | :istart "\\item " :iend "" | ||
| 1339 | :isep "\n" :lsep "\n"))) | ||
| 1340 | |||
| 1341 | (defun org-list-to-html (list) | ||
| 1342 | "Convert LIST into a HTML list." | ||
| 1343 | (org-list-to-generic | ||
| 1344 | list '(:splicep nil :ostart "<ol>" :oend "</ol>" | ||
| 1345 | :ustart "<ul>" :uend "</ul>" | ||
| 1346 | :istart "<li>" :iend "</li>" | ||
| 1347 | :isep "\n" :lsep "\n"))) | ||
| 1348 | |||
| 1349 | (defun org-list-to-texinfo (list) | ||
| 1350 | "Convert LIST into a Texinfo list." | ||
| 1351 | (org-list-to-generic | ||
| 1352 | list '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize" | ||
| 1353 | :ustart "@enumerate" :uend "@end enumerate" | ||
| 1354 | :istart "@item\n" :iend "" | ||
| 1355 | :isep "\n" :lsep "\n"))) | ||
| 1356 | |||
| 1357 | (defconst org-latex-entities | ||
| 1358 | '("\\!" | ||
| 1359 | "\\'" | ||
| 1360 | "\\+" | ||
| 1361 | "\\," | ||
| 1362 | "\\-" | ||
| 1363 | "\\:" | ||
| 1364 | "\\;" | ||
| 1365 | "\\<" | ||
| 1366 | "\\=" | ||
| 1367 | "\\>" | ||
| 1368 | "\\Huge" | ||
| 1369 | "\\LARGE" | ||
| 1370 | "\\Large" | ||
| 1371 | "\\Styles" | ||
| 1372 | "\\\\" | ||
| 1373 | "\\`" | ||
| 1374 | "\\addcontentsline" | ||
| 1375 | "\\address" | ||
| 1376 | "\\addtocontents" | ||
| 1377 | "\\addtocounter" | ||
| 1378 | "\\addtolength" | ||
| 1379 | "\\addvspace" | ||
| 1380 | "\\alph" | ||
| 1381 | "\\appendix" | ||
| 1382 | "\\arabic" | ||
| 1383 | "\\author" | ||
| 1384 | "\\begin{array}" | ||
| 1385 | "\\begin{center}" | ||
| 1386 | "\\begin{description}" | ||
| 1387 | "\\begin{enumerate}" | ||
| 1388 | "\\begin{eqnarray}" | ||
| 1389 | "\\begin{equation}" | ||
| 1390 | "\\begin{figure}" | ||
| 1391 | "\\begin{flushleft}" | ||
| 1392 | "\\begin{flushright}" | ||
| 1393 | "\\begin{itemize}" | ||
| 1394 | "\\begin{list}" | ||
| 1395 | "\\begin{minipage}" | ||
| 1396 | "\\begin{picture}" | ||
| 1397 | "\\begin{quotation}" | ||
| 1398 | "\\begin{quote}" | ||
| 1399 | "\\begin{tabbing}" | ||
| 1400 | "\\begin{table}" | ||
| 1401 | "\\begin{tabular}" | ||
| 1402 | "\\begin{thebibliography}" | ||
| 1403 | "\\begin{theorem}" | ||
| 1404 | "\\begin{titlepage}" | ||
| 1405 | "\\begin{verbatim}" | ||
| 1406 | "\\begin{verse}" | ||
| 1407 | "\\bf" | ||
| 1408 | "\\bf" | ||
| 1409 | "\\bibitem" | ||
| 1410 | "\\bigskip" | ||
| 1411 | "\\cdots" | ||
| 1412 | "\\centering" | ||
| 1413 | "\\circle" | ||
| 1414 | "\\cite" | ||
| 1415 | "\\cleardoublepage" | ||
| 1416 | "\\clearpage" | ||
| 1417 | "\\cline" | ||
| 1418 | "\\closing" | ||
| 1419 | "\\dashbox" | ||
| 1420 | "\\date" | ||
| 1421 | "\\ddots" | ||
| 1422 | "\\dotfill" | ||
| 1423 | "\\em" | ||
| 1424 | "\\fbox" | ||
| 1425 | "\\flushbottom" | ||
| 1426 | "\\fnsymbol" | ||
| 1427 | "\\footnote" | ||
| 1428 | "\\footnotemark" | ||
| 1429 | "\\footnotesize" | ||
| 1430 | "\\footnotetext" | ||
| 1431 | "\\frac" | ||
| 1432 | "\\frame" | ||
| 1433 | "\\framebox" | ||
| 1434 | "\\hfill" | ||
| 1435 | "\\hline" | ||
| 1436 | "\\hrulespace" | ||
| 1437 | "\\hspace" | ||
| 1438 | "\\huge" | ||
| 1439 | "\\hyphenation" | ||
| 1440 | "\\include" | ||
| 1441 | "\\includeonly" | ||
| 1442 | "\\indent" | ||
| 1443 | "\\input" | ||
| 1444 | "\\it" | ||
| 1445 | "\\kill" | ||
| 1446 | "\\label" | ||
| 1447 | "\\large" | ||
| 1448 | "\\ldots" | ||
| 1449 | "\\line" | ||
| 1450 | "\\linebreak" | ||
| 1451 | "\\linethickness" | ||
| 1452 | "\\listoffigures" | ||
| 1453 | "\\listoftables" | ||
| 1454 | "\\location" | ||
| 1455 | "\\makebox" | ||
| 1456 | "\\maketitle" | ||
| 1457 | "\\mark" | ||
| 1458 | "\\mbox" | ||
| 1459 | "\\medskip" | ||
| 1460 | "\\multicolumn" | ||
| 1461 | "\\multiput" | ||
| 1462 | "\\newcommand" | ||
| 1463 | "\\newcounter" | ||
| 1464 | "\\newenvironment" | ||
| 1465 | "\\newfont" | ||
| 1466 | "\\newlength" | ||
| 1467 | "\\newline" | ||
| 1468 | "\\newpage" | ||
| 1469 | "\\newsavebox" | ||
| 1470 | "\\newtheorem" | ||
| 1471 | "\\nocite" | ||
| 1472 | "\\nofiles" | ||
| 1473 | "\\noindent" | ||
| 1474 | "\\nolinebreak" | ||
| 1475 | "\\nopagebreak" | ||
| 1476 | "\\normalsize" | ||
| 1477 | "\\onecolumn" | ||
| 1478 | "\\opening" | ||
| 1479 | "\\oval" | ||
| 1480 | "\\overbrace" | ||
| 1481 | "\\overline" | ||
| 1482 | "\\pagebreak" | ||
| 1483 | "\\pagenumbering" | ||
| 1484 | "\\pageref" | ||
| 1485 | "\\pagestyle" | ||
| 1486 | "\\par" | ||
| 1487 | "\\parbox" | ||
| 1488 | "\\put" | ||
| 1489 | "\\raggedbottom" | ||
| 1490 | "\\raggedleft" | ||
| 1491 | "\\raggedright" | ||
| 1492 | "\\raisebox" | ||
| 1493 | "\\ref" | ||
| 1494 | "\\rm" | ||
| 1495 | "\\roman" | ||
| 1496 | "\\rule" | ||
| 1497 | "\\savebox" | ||
| 1498 | "\\sc" | ||
| 1499 | "\\scriptsize" | ||
| 1500 | "\\setcounter" | ||
| 1501 | "\\setlength" | ||
| 1502 | "\\settowidth" | ||
| 1503 | "\\sf" | ||
| 1504 | "\\shortstack" | ||
| 1505 | "\\signature" | ||
| 1506 | "\\sl" | ||
| 1507 | "\\small" | ||
| 1508 | "\\smallskip" | ||
| 1509 | "\\sqrt" | ||
| 1510 | "\\tableofcontents" | ||
| 1511 | "\\telephone" | ||
| 1512 | "\\thanks" | ||
| 1513 | "\\thispagestyle" | ||
| 1514 | "\\tiny" | ||
| 1515 | "\\title" | ||
| 1516 | "\\tt" | ||
| 1517 | "\\twocolumn" | ||
| 1518 | "\\typein" | ||
| 1519 | "\\typeout" | ||
| 1520 | "\\underbrace" | ||
| 1521 | "\\underline" | ||
| 1522 | "\\usebox" | ||
| 1523 | "\\usecounter" | ||
| 1524 | "\\value" | ||
| 1525 | "\\vdots" | ||
| 1526 | "\\vector" | ||
| 1527 | "\\verb" | ||
| 1528 | "\\vfill" | ||
| 1529 | "\\vline" | ||
| 1530 | "\\vspace") | ||
| 1531 | "A list of LaTeX commands to be protected when performing conversion.") | ||
| 1532 | |||
| 1164 | (provide 'org-export-latex) | 1533 | (provide 'org-export-latex) |
| 1165 | 1534 | ||
| 1166 | ;; arch-tag: 23c2b87d-da04-4c2d-ad2d-1eb6487bc3ad | 1535 | ;; arch-tag: 23c2b87d-da04-4c2d-ad2d-1eb6487bc3ad |
diff --git a/lisp/textmodes/org-mouse.el b/lisp/textmodes/org-mouse.el new file mode 100644 index 00000000000..f91dc3af853 --- /dev/null +++ b/lisp/textmodes/org-mouse.el | |||
| @@ -0,0 +1,1110 @@ | |||
| 1 | ;;; org-mouse.el --- Better mouse support for org-mode | ||
| 2 | |||
| 3 | ;; Copyright (C) 2006, 2007, 2008 Free Software Foundation | ||
| 4 | ;; | ||
| 5 | ;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com> | ||
| 6 | ;; Maintainer: Carsten Dominik <carsten at orgmode dot org> | ||
| 7 | ;; Version: 5.19 | ||
| 8 | ;; | ||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | ;; | ||
| 11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation; either version 3, or (at your option) | ||
| 14 | ;; any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | ||
| 24 | ;; Boston, MA 02110-1301, USA. | ||
| 25 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 26 | ;; | ||
| 27 | ;;; Commentary: | ||
| 28 | ;; | ||
| 29 | ;; Org-mouse provides mouse support for org-mode. | ||
| 30 | ;; | ||
| 31 | ;; http://orgmode.org | ||
| 32 | ;; | ||
| 33 | ;; Org-mouse implements the following features: | ||
| 34 | ;; * following links with the left mouse button (in Emacs 22) | ||
| 35 | ;; * subtree expansion/collapse (org-cycle) with the left mouse button | ||
| 36 | ;; * several context menus on the right mouse button: | ||
| 37 | ;; + general text | ||
| 38 | ;; + headlines | ||
| 39 | ;; + timestamps | ||
| 40 | ;; + priorities | ||
| 41 | ;; + links | ||
| 42 | ;; + tags | ||
| 43 | ;; * promoting/demoting/moving subtrees with mouse-3 | ||
| 44 | ;; + if the drag starts and ends in the same line then promote/demote | ||
| 45 | ;; + otherwise move the subtree | ||
| 46 | ;; | ||
| 47 | ;; Use | ||
| 48 | ;; --- | ||
| 49 | ;; | ||
| 50 | ;; To use this package, put the following line in your .emacs: | ||
| 51 | ;; | ||
| 52 | ;; (require 'org-mouse) | ||
| 53 | ;; | ||
| 54 | |||
| 55 | ;; Fixme: | ||
| 56 | ;; + deal with folding / unfolding issues | ||
| 57 | |||
| 58 | ;; TODO (This list is only theoretical, if you'd like to have some | ||
| 59 | ;; feature implemented or a bug fix please send me an email, even if | ||
| 60 | ;; something similar appears in the list below. This will help me get | ||
| 61 | ;; the priorities right.): | ||
| 62 | ;; | ||
| 63 | ;; + org-store-link, insert link | ||
| 64 | ;; + org tables | ||
| 65 | ;; + occur with the current word/tag (same menu item) | ||
| 66 | ;; + ctrl-c ctrl-c, for example, renumber the current list | ||
| 67 | ;; + internal links | ||
| 68 | |||
| 69 | ;; Please email the maintainer with new feature suggestions / bugs | ||
| 70 | |||
| 71 | ;; History: | ||
| 72 | ;; | ||
| 73 | ;; SInce version 5.10: Changes are listed in the general org-mode docs. | ||
| 74 | ;; | ||
| 75 | ;; Version 5.09 | ||
| 76 | ;; + Version number synchronization with Org-mode. | ||
| 77 | ;; | ||
| 78 | ;; Version 0.25 | ||
| 79 | ;; + made compatible with org-mode 4.70 (thanks to Carsten for the patch) | ||
| 80 | ;; | ||
| 81 | ;; Version 0.24 | ||
| 82 | ;; + minor changes to the table menu | ||
| 83 | ;; | ||
| 84 | ;; Version 0.23 | ||
| 85 | ;; + preliminary support for tables and calculation marks | ||
| 86 | ;; + context menu support for org-agenda-undo & org-sort-entries | ||
| 87 | ;; | ||
| 88 | ;; Version 0.22 | ||
| 89 | ;; + handles undo support for the agenda buffer (requires org-mode >=4.58) | ||
| 90 | ;; | ||
| 91 | ;; Version 0.21 | ||
| 92 | ;; + selected text activates its context menu | ||
| 93 | ;; + shift-middleclick or right-drag inserts the text from the clipboard in the form of a link | ||
| 94 | ;; | ||
| 95 | ;; Version 0.20 | ||
| 96 | ;; + the new "TODO Status" submenu replaces the "Cycle TODO" menu item | ||
| 97 | ;; + the TODO menu can now list occurrences of a specific TODO keyword | ||
| 98 | ;; + #+STARTUP line is now recognized | ||
| 99 | ;; | ||
| 100 | ;; Version 0.19 | ||
| 101 | ;; + added support for dragging URLs to the org-buffer | ||
| 102 | ;; | ||
| 103 | ;; Version 0.18 | ||
| 104 | ;; + added support for agenda blocks | ||
| 105 | ;; | ||
| 106 | ;; Version 0.17 | ||
| 107 | ;; + toggle checkboxes with a single click | ||
| 108 | ;; | ||
| 109 | ;; Version 0.16 | ||
| 110 | ;; + added support for checkboxes | ||
| 111 | ;; | ||
| 112 | ;; Version 0.15 | ||
| 113 | ;; + org-mode now works with the Agenda buffer as well | ||
| 114 | ;; | ||
| 115 | ;; Version 0.14 | ||
| 116 | ;; + added a menu option that converts plain list items to outline items | ||
| 117 | ;; | ||
| 118 | ;; Version 0.13 | ||
| 119 | ;; + "Insert Heading" now inserts a sibling heading if the point is | ||
| 120 | ;; on "***" and a child heading otherwise | ||
| 121 | ;; | ||
| 122 | ;; Version 0.12 | ||
| 123 | ;; + compatible with Emacs 21 | ||
| 124 | ;; + custom agenda commands added to the main menu | ||
| 125 | ;; + moving trees should now work between windows in the same frame | ||
| 126 | ;; | ||
| 127 | ;; Version 0.11 | ||
| 128 | ;; + fixed org-mouse-at-link (thanks to Carsten) | ||
| 129 | ;; + removed [follow-link] bindings | ||
| 130 | ;; | ||
| 131 | ;; Version 0.10 | ||
| 132 | ;; + added a menu option to remove highlights | ||
| 133 | ;; + compatible with org-mode 4.21 now | ||
| 134 | ;; | ||
| 135 | ;; Version 0.08: | ||
| 136 | ;; + trees can be moved/promoted/demoted by dragging with the right | ||
| 137 | ;; mouse button (mouse-3) | ||
| 138 | ;; + small changes in the above function | ||
| 139 | ;; | ||
| 140 | ;; Versions 0.01 -- 0.07: (I don't remember) | ||
| 141 | |||
| 142 | (eval-when-compile (require 'cl)) | ||
| 143 | (require 'org) | ||
| 144 | |||
| 145 | (defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " | ||
| 146 | "Regular expression that matches a plain list.") | ||
| 147 | (defvar org-mouse-direct t | ||
| 148 | "Internal variable indicating whether the current action is direct. | ||
| 149 | |||
| 150 | If t, then the current action has been invoked directly through the buffer | ||
| 151 | it is intended to operate on. If nil, then the action has been invoked | ||
| 152 | indirectly, for example, through the agenda buffer.") | ||
| 153 | |||
| 154 | (defgroup org-mouse nil | ||
| 155 | "Mouse support for org-mode." | ||
| 156 | :tag "Org Mouse" | ||
| 157 | :group 'org) | ||
| 158 | |||
| 159 | (defcustom org-mouse-punctuation ":" | ||
| 160 | "Punctuation used when inserting text by drag and drop." | ||
| 161 | :group 'org-mouse | ||
| 162 | :type 'string) | ||
| 163 | |||
| 164 | |||
| 165 | (defun org-mouse-re-search-line (regexp) | ||
| 166 | "Search the current line for a given regular expression." | ||
| 167 | (beginning-of-line) | ||
| 168 | (re-search-forward regexp (point-at-eol) t)) | ||
| 169 | |||
| 170 | (defun org-mouse-end-headline () | ||
| 171 | "Go to the end of current headline (ignoring tags)." | ||
| 172 | (interactive) | ||
| 173 | (end-of-line) | ||
| 174 | (skip-chars-backward "\t ") | ||
| 175 | (when (looking-back ":[A-Za-z]+:") | ||
| 176 | (skip-chars-backward ":A-Za-z") | ||
| 177 | (skip-chars-backward "\t "))) | ||
| 178 | |||
| 179 | (defvar org-mouse-context-menu-function nil | ||
| 180 | "Function to create the context menu. | ||
| 181 | The value of this variable is the function invoked by | ||
| 182 | `org-mouse-context-menu' as the context menu.") | ||
| 183 | (make-variable-buffer-local 'org-mouse-context-menu-function) | ||
| 184 | |||
| 185 | (defun org-mouse-show-context-menu (event prefix) | ||
| 186 | "Invoke the context menu. | ||
| 187 | |||
| 188 | If the value of `org-mouse-context-menu-function' is a function, then | ||
| 189 | this function is called. Otherwise, the current major mode menu is used." | ||
| 190 | (interactive "@e \nP") | ||
| 191 | (if (and (= (event-click-count event) 1) | ||
| 192 | (or (not mark-active) | ||
| 193 | (sit-for (/ double-click-time 1000.0)))) | ||
| 194 | (progn | ||
| 195 | (select-window (posn-window (event-start event))) | ||
| 196 | (when (not (org-mouse-mark-active)) | ||
| 197 | (goto-char (posn-point (event-start event))) | ||
| 198 | (when (not (eolp)) (save-excursion (run-hooks 'post-command-hook))) | ||
| 199 | (let ((redisplay-dont-pause t)) | ||
| 200 | (sit-for 0))) | ||
| 201 | (if (functionp org-mouse-context-menu-function) | ||
| 202 | (funcall org-mouse-context-menu-function event) | ||
| 203 | (mouse-major-mode-menu event prefix))) | ||
| 204 | (setq this-command 'mouse-save-then-kill) | ||
| 205 | (mouse-save-then-kill event))) | ||
| 206 | |||
| 207 | |||
| 208 | (defun org-mouse-line-position () | ||
| 209 | "Returns `:beginning' or `:middle' or `:end', depending on the point position. | ||
| 210 | |||
| 211 | If the point is at the end of the line, return `:end'. | ||
| 212 | If the point is separated from the beginning of the line only by white | ||
| 213 | space and *'s (`org-mouse-bolp'), return `:beginning'. Otherwise, | ||
| 214 | return `:middle'." | ||
| 215 | (cond | ||
| 216 | ((eolp) :end) | ||
| 217 | ((org-mouse-bolp) :beginning) | ||
| 218 | (t :middle))) | ||
| 219 | |||
| 220 | (defun org-mouse-empty-line () | ||
| 221 | "Return non-nil iff the line contains only white space." | ||
| 222 | (save-excursion (beginning-of-line) (looking-at "[ \t]*$"))) | ||
| 223 | |||
| 224 | (defun org-mouse-next-heading () | ||
| 225 | "Go to the next heading. | ||
| 226 | If there is none, ensure that the point is at the beginning of an empty line." | ||
| 227 | (unless (outline-next-heading) | ||
| 228 | (beginning-of-line) | ||
| 229 | (unless (org-mouse-empty-line) | ||
| 230 | (end-of-line) | ||
| 231 | (newline)))) | ||
| 232 | |||
| 233 | (defun org-mouse-insert-heading () | ||
| 234 | "Insert a new heading, as `org-insert-heading'. | ||
| 235 | |||
| 236 | If the point is at the :beginning (`org-mouse-line-position') of the line, | ||
| 237 | insert the new heading before the current line. Otherwise, insert it | ||
| 238 | after the current heading." | ||
| 239 | (interactive) | ||
| 240 | (case (org-mouse-line-position) | ||
| 241 | (:beginning (beginning-of-line) | ||
| 242 | (org-insert-heading)) | ||
| 243 | (t (org-mouse-next-heading) | ||
| 244 | (org-insert-heading)))) | ||
| 245 | |||
| 246 | (defun org-mouse-timestamp-today (&optional shift units) | ||
| 247 | "Change the timestamp into SHIFT UNITS in the future. | ||
| 248 | |||
| 249 | For the acceptable UNITS, see `org-timestamp-change'." | ||
| 250 | (interactive) | ||
| 251 | (flet ((org-read-date (&rest rest) (current-time))) | ||
| 252 | (org-time-stamp nil)) | ||
| 253 | (when shift | ||
| 254 | (org-timestamp-change shift units))) | ||
| 255 | |||
| 256 | (defun org-mouse-keyword-menu (keywords function &optional selected itemformat) | ||
| 257 | "A helper function. | ||
| 258 | |||
| 259 | Returns a menu fragment consisting of KEYWORDS. When a keyword | ||
| 260 | is selected by the user, FUNCTION is called with the selected | ||
| 261 | keyword as the only argument. | ||
| 262 | |||
| 263 | If SELECTED is nil, then all items are normal menu items. If | ||
| 264 | SELECTED is a function, then each item is a checkbox, which is | ||
| 265 | enabled for a given keyword iff (funcall SELECTED keyword) return | ||
| 266 | non-nil. If SELECTED is neither nil nor a function, then the | ||
| 267 | items are radio buttons. A radio button is enabled for the | ||
| 268 | keyword `equal' to SELECTED. | ||
| 269 | |||
| 270 | ITEMFORMAT governs formatting of the elements of KEYWORDS. If it | ||
| 271 | is a function, it is invoked with the keyword as the only | ||
| 272 | argument. If it is a string, it is interpreted as the format | ||
| 273 | string to (format ITEMFORMAT keyword). If it is neither a string | ||
| 274 | nor a function, elements of KEYWORDS are used directly. " | ||
| 275 | (mapcar | ||
| 276 | `(lambda (keyword) | ||
| 277 | (vector (cond | ||
| 278 | ((functionp ,itemformat) (funcall ,itemformat keyword)) | ||
| 279 | ((stringp ,itemformat) (format ,itemformat keyword)) | ||
| 280 | (t keyword)) | ||
| 281 | (list 'funcall ,function keyword) | ||
| 282 | :style (cond | ||
| 283 | ((null ,selected) t) | ||
| 284 | ((functionp ,selected) 'toggle) | ||
| 285 | (t 'radio)) | ||
| 286 | :selected (if (functionp ,selected) | ||
| 287 | (and (funcall ,selected keyword) t) | ||
| 288 | (equal ,selected keyword)))) | ||
| 289 | keywords)) | ||
| 290 | |||
| 291 | (defun org-mouse-remove-match-and-spaces () | ||
| 292 | "Remove the match, make just one space around the point." | ||
| 293 | (interactive) | ||
| 294 | (replace-match "") | ||
| 295 | (just-one-space)) | ||
| 296 | |||
| 297 | (defvar rest) | ||
| 298 | (defun org-mouse-replace-match-and-surround (newtext &optional fixedcase | ||
| 299 | literal string subexp) | ||
| 300 | "The same as `replace-match', but surrounds the replacement with spaces." | ||
| 301 | (apply 'replace-match rest) | ||
| 302 | (save-excursion | ||
| 303 | (goto-char (match-beginning (or subexp 0))) | ||
| 304 | (just-one-space) | ||
| 305 | (goto-char (match-end (or subexp 0))) | ||
| 306 | (just-one-space))) | ||
| 307 | |||
| 308 | |||
| 309 | (defun org-mouse-keyword-replace-menu (keywords &optional group itemformat | ||
| 310 | nosurround) | ||
| 311 | "A helper function. | ||
| 312 | |||
| 313 | Returns a menu fragment consisting of KEYWORDS. When a keyword | ||
| 314 | is selected, group GROUP of the current match is replaced by the | ||
| 315 | keyword. The method ensures that both ends of the replacement | ||
| 316 | are separated from the rest of the text in the buffer by | ||
| 317 | individual spaces (unless NOSURROND is non-nil). | ||
| 318 | |||
| 319 | The final entry of the menu is always \"None\", which removes the | ||
| 320 | match. | ||
| 321 | |||
| 322 | ITEMFORMAT governs formatting of the elements of KEYWORDS. If it | ||
| 323 | is a function, it is invoked with the keyword as the only | ||
| 324 | argument. If it is a string, it is interpreted as the format | ||
| 325 | string to (format ITEMFORMAT keyword). If it is neither a string | ||
| 326 | nor a function, elements of KEYWORDS are used directly. | ||
| 327 | " | ||
| 328 | (setq group (or group 0)) | ||
| 329 | (let ((replace (org-mouse-match-closure | ||
| 330 | (if nosurround 'replace-match | ||
| 331 | 'org-mouse-replace-match-and-surround)))) | ||
| 332 | (append | ||
| 333 | (org-mouse-keyword-menu | ||
| 334 | keywords | ||
| 335 | `(lambda (keyword) (funcall ,replace keyword t t nil ,group)) | ||
| 336 | (match-string group) | ||
| 337 | itemformat) | ||
| 338 | `(["None" org-mouse-remove-match-and-spaces | ||
| 339 | :style radio | ||
| 340 | :selected ,(not (member (match-string group) keywords))])))) | ||
| 341 | |||
| 342 | (defun org-mouse-show-headlines () | ||
| 343 | "Change the visibility of the current org buffer to only show headlines." | ||
| 344 | (interactive) | ||
| 345 | (let ((this-command 'org-cycle) | ||
| 346 | (last-command 'org-cycle) | ||
| 347 | (org-cycle-global-status nil)) | ||
| 348 | (org-cycle '(4)) | ||
| 349 | (org-cycle '(4)))) | ||
| 350 | |||
| 351 | (defun org-mouse-show-overview () | ||
| 352 | "Change visibility of current org buffer to first-level headlines only." | ||
| 353 | (interactive) | ||
| 354 | (let ((org-cycle-global-status nil)) | ||
| 355 | (org-cycle '(4)))) | ||
| 356 | |||
| 357 | (defun org-mouse-set-priority (priority) | ||
| 358 | "Set the priority of the current headline to PRIORITY." | ||
| 359 | (flet ((read-char-exclusive () priority)) | ||
| 360 | (org-priority))) | ||
| 361 | |||
| 362 | (defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]" | ||
| 363 | "Regular expression matching the priority indicator. | ||
| 364 | Differs from `org-priority-regexp' in that it doesn't contain the | ||
| 365 | leading '.*?'.") | ||
| 366 | |||
| 367 | (defun org-mouse-get-priority (&optional default) | ||
| 368 | "Return the priority of the current headline. | ||
| 369 | DEFAULT is returned if no priority is given in the headline." | ||
| 370 | (save-excursion | ||
| 371 | (if (org-mouse-re-search-line org-mouse-priority-regexp) | ||
| 372 | (match-string 1) | ||
| 373 | (when default (char-to-string org-default-priority))))) | ||
| 374 | |||
| 375 | ;; (defun org-mouse-at-link () | ||
| 376 | ;; (and (eq (get-text-property (point) 'face) 'org-link) | ||
| 377 | ;; (save-excursion | ||
| 378 | ;; (goto-char (previous-single-property-change (point) 'face)) | ||
| 379 | ;; (or (looking-at org-bracket-link-regexp) | ||
| 380 | ;; (looking-at org-angle-link-re) | ||
| 381 | ;; (looking-at org-plain-link-re))))) | ||
| 382 | |||
| 383 | |||
| 384 | (defun org-mouse-delete-timestamp () | ||
| 385 | "Deletes the current timestamp as well as the preceding keyword. | ||
| 386 | SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" | ||
| 387 | (when (or (org-at-date-range-p) (org-at-timestamp-p)) | ||
| 388 | (replace-match "") ; delete the timestamp | ||
| 389 | (skip-chars-backward " :A-Z") | ||
| 390 | (when (looking-at " *[A-Z][A-Z]+:") | ||
| 391 | (replace-match "")))) | ||
| 392 | |||
| 393 | (defun org-mouse-looking-at (regexp skipchars &optional movechars) | ||
| 394 | (save-excursion | ||
| 395 | (let ((point (point))) | ||
| 396 | (if (looking-at regexp) t | ||
| 397 | (skip-chars-backward skipchars) | ||
| 398 | (forward-char (or movechars 0)) | ||
| 399 | (when (looking-at regexp) | ||
| 400 | (> (match-end 0) point)))))) | ||
| 401 | |||
| 402 | (defun org-mouse-priority-list () | ||
| 403 | (loop for priority from ?A to org-lowest-priority | ||
| 404 | collect (char-to-string priority))) | ||
| 405 | |||
| 406 | (defun org-mouse-tag-menu () ;todo | ||
| 407 | (append | ||
| 408 | (let ((tags (org-split-string (org-get-tags) ":"))) | ||
| 409 | (org-mouse-keyword-menu | ||
| 410 | (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) | ||
| 411 | `(lambda (tag) | ||
| 412 | (org-mouse-set-tags | ||
| 413 | (sort (if (member tag (quote ,tags)) | ||
| 414 | (delete tag (quote ,tags)) | ||
| 415 | (cons tag (quote ,tags))) | ||
| 416 | 'string-lessp))) | ||
| 417 | `(lambda (tag) (member tag (quote ,tags))) | ||
| 418 | )) | ||
| 419 | '("--" | ||
| 420 | ["Align Tags Here" (org-set-tags nil t) t] | ||
| 421 | ["Align Tags in Buffer" (org-set-tags t t) t] | ||
| 422 | ["Set Tags ..." (org-set-tags) t]))) | ||
| 423 | |||
| 424 | |||
| 425 | |||
| 426 | (defun org-mouse-set-tags (tags) | ||
| 427 | (save-excursion | ||
| 428 | ;; remove existing tags first | ||
| 429 | (beginning-of-line) | ||
| 430 | (when (org-mouse-re-search-line ":\\(\\([A-Za-z_]+:\\)+\\)") | ||
| 431 | (replace-match "")) | ||
| 432 | |||
| 433 | ;; set new tags if any | ||
| 434 | (when tags | ||
| 435 | (end-of-line) | ||
| 436 | (insert " :" (mapconcat 'identity tags ":") ":") | ||
| 437 | (org-set-tags nil t)))) | ||
| 438 | |||
| 439 | (defun org-mouse-insert-checkbox () | ||
| 440 | (interactive) | ||
| 441 | (and (org-at-item-p) | ||
| 442 | (goto-char (match-end 0)) | ||
| 443 | (unless (org-at-item-checkbox-p) | ||
| 444 | (delete-horizontal-space) | ||
| 445 | (insert " [ ] ")))) | ||
| 446 | |||
| 447 | (defun org-mouse-agenda-type (type) | ||
| 448 | (case type | ||
| 449 | ('tags "Tags: ") | ||
| 450 | ('todo "TODO: ") | ||
| 451 | ('tags-tree "Tags tree: ") | ||
| 452 | ('todo-tree "TODO tree: ") | ||
| 453 | ('occur-tree "Occur tree: ") | ||
| 454 | (t "Agenda command ???"))) | ||
| 455 | |||
| 456 | |||
| 457 | (defun org-mouse-list-options-menu (alloptions &optional function) | ||
| 458 | (let ((options (save-match-data | ||
| 459 | (split-string (match-string-no-properties 1))))) | ||
| 460 | (print options) | ||
| 461 | (loop for name in alloptions | ||
| 462 | collect | ||
| 463 | (vector name | ||
| 464 | `(progn | ||
| 465 | (replace-match | ||
| 466 | (mapconcat 'identity | ||
| 467 | (sort (if (member ',name ',options) | ||
| 468 | (delete ',name ',options) | ||
| 469 | (cons ',name ',options)) | ||
| 470 | 'string-lessp) | ||
| 471 | " ") | ||
| 472 | nil nil nil 1) | ||
| 473 | (when (functionp ',function) (funcall ',function))) | ||
| 474 | :style 'toggle | ||
| 475 | :selected (and (member name options) t))))) | ||
| 476 | |||
| 477 | (defun org-mouse-clip-text (text maxlength) | ||
| 478 | (if (> (length text) maxlength) | ||
| 479 | (concat (substring text 0 (- maxlength 3)) "...") | ||
| 480 | text)) | ||
| 481 | |||
| 482 | (defun org-mouse-popup-global-menu () | ||
| 483 | (popup-menu | ||
| 484 | `("Main Menu" | ||
| 485 | ["Show Overview" org-mouse-show-overview t] | ||
| 486 | ["Show Headlines" org-mouse-show-headlines t] | ||
| 487 | ["Show All" show-all t] | ||
| 488 | ["Remove Highlights" org-remove-occur-highlights | ||
| 489 | :visible org-occur-highlights] | ||
| 490 | "--" | ||
| 491 | ["Check Deadlines" | ||
| 492 | (if (functionp 'org-check-deadlines-and-todos) | ||
| 493 | (org-check-deadlines-and-todos org-deadline-warning-days) | ||
| 494 | (org-check-deadlines org-deadline-warning-days)) t] | ||
| 495 | ["Check TODOs" org-show-todo-tree t] | ||
| 496 | ("Check Tags" | ||
| 497 | ,@(org-mouse-keyword-menu | ||
| 498 | (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) | ||
| 499 | '(lambda (tag) (org-tags-sparse-tree nil tag))) | ||
| 500 | "--" | ||
| 501 | ["Custom Tag ..." org-tags-sparse-tree t]) | ||
| 502 | ["Check Phrase ..." org-occur] | ||
| 503 | "--" | ||
| 504 | ["Display Agenda" org-agenda-list t] | ||
| 505 | ["Display Timeline" org-timeline t] | ||
| 506 | ["Display TODO List" org-todo-list t] | ||
| 507 | ("Display Tags" | ||
| 508 | ,@(org-mouse-keyword-menu | ||
| 509 | (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) | ||
| 510 | '(lambda (tag) (org-tags-view nil tag))) | ||
| 511 | "--" | ||
| 512 | ["Custom Tag ..." org-tags-view t]) | ||
| 513 | ["Display Calendar" org-goto-calendar t] | ||
| 514 | "--" | ||
| 515 | ,@(org-mouse-keyword-menu | ||
| 516 | (mapcar 'car org-agenda-custom-commands) | ||
| 517 | '(lambda (key) | ||
| 518 | (eval `(flet ((read-char-exclusive () (string-to-char ,key))) | ||
| 519 | (org-agenda nil)))) | ||
| 520 | nil | ||
| 521 | '(lambda (key) | ||
| 522 | (let ((entry (assoc key org-agenda-custom-commands))) | ||
| 523 | (org-mouse-clip-text | ||
| 524 | (cond | ||
| 525 | ((stringp (nth 1 entry)) (nth 1 entry)) | ||
| 526 | ((stringp (nth 2 entry)) | ||
| 527 | (concat (org-mouse-agenda-type (nth 1 entry)) | ||
| 528 | (nth 2 entry))) | ||
| 529 | (t "Agenda Command '%s'")) | ||
| 530 | 30)))) | ||
| 531 | "--" | ||
| 532 | ["Delete Blank Lines" delete-blank-lines | ||
| 533 | :visible (org-mouse-empty-line)] | ||
| 534 | ["Insert Checkbox" org-mouse-insert-checkbox | ||
| 535 | :visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))] | ||
| 536 | ["Insert Checkboxes" | ||
| 537 | (org-mouse-for-each-item 'org-mouse-insert-checkbox) | ||
| 538 | :visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))] | ||
| 539 | ["Plain List to Outline" org-mouse-transform-to-outline | ||
| 540 | :visible (org-at-item-p)]))) | ||
| 541 | |||
| 542 | |||
| 543 | (defun org-mouse-get-context (contextlist context) | ||
| 544 | (let ((contextdata (assq context contextlist))) | ||
| 545 | (when contextdata | ||
| 546 | (save-excursion | ||
| 547 | (goto-char (second contextdata)) | ||
| 548 | (re-search-forward ".*" (third contextdata)))))) | ||
| 549 | |||
| 550 | (defun org-mouse-for-each-item (function) | ||
| 551 | (save-excursion | ||
| 552 | (ignore-errors | ||
| 553 | (while t (org-previous-item))) | ||
| 554 | (ignore-errors | ||
| 555 | (while t | ||
| 556 | (funcall function) | ||
| 557 | (org-next-item))))) | ||
| 558 | |||
| 559 | (defun org-mouse-bolp () | ||
| 560 | "Returns true if there only spaces, tabs, and '*', between the beginning of line and the point" | ||
| 561 | (save-excursion | ||
| 562 | (skip-chars-backward " \t*") (bolp))) | ||
| 563 | |||
| 564 | (defun org-mouse-insert-item (text) | ||
| 565 | (case (org-mouse-line-position) | ||
| 566 | (:beginning ; insert before | ||
| 567 | (beginning-of-line) | ||
| 568 | (looking-at "[ \t]*") | ||
| 569 | (open-line 1) | ||
| 570 | (indent-to (- (match-end 0) (match-beginning 0))) | ||
| 571 | (insert "+ ")) | ||
| 572 | |||
| 573 | (:middle ; insert after | ||
| 574 | (end-of-line) | ||
| 575 | (newline t) | ||
| 576 | (indent-relative) | ||
| 577 | (insert "+ ")) | ||
| 578 | |||
| 579 | (:end ; insert text here | ||
| 580 | (skip-chars-backward " \t") | ||
| 581 | (kill-region (point) (point-at-eol)) | ||
| 582 | (unless (looking-back org-mouse-punctuation) | ||
| 583 | (insert (concat org-mouse-punctuation " "))))) | ||
| 584 | |||
| 585 | (insert text) | ||
| 586 | (beginning-of-line)) | ||
| 587 | |||
| 588 | (defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate) | ||
| 589 | (if (eq major-mode 'org-mode) | ||
| 590 | (org-mouse-insert-item text) | ||
| 591 | ad-do-it)) | ||
| 592 | |||
| 593 | (defadvice dnd-open-file (around org-mouse-dnd-open-file activate) | ||
| 594 | (if (eq major-mode 'org-mode) | ||
| 595 | (org-mouse-insert-item uri) | ||
| 596 | ad-do-it)) | ||
| 597 | |||
| 598 | (defun org-mouse-match-closure (function) | ||
| 599 | (let ((match (match-data t))) | ||
| 600 | `(lambda (&rest rest) | ||
| 601 | (save-match-data | ||
| 602 | (set-match-data ',match) | ||
| 603 | (apply ',function rest))))) | ||
| 604 | |||
| 605 | (defun org-mouse-todo-keywords () | ||
| 606 | (if (boundp 'org-todo-keywords-1) org-todo-keywords-1 org-todo-keywords)) | ||
| 607 | |||
| 608 | (defun org-mouse-match-todo-keyword () | ||
| 609 | (save-excursion | ||
| 610 | (org-back-to-heading) | ||
| 611 | (if (looking-at outline-regexp) (goto-char (match-end 0))) | ||
| 612 | (or (looking-at (concat " +" org-todo-regexp " *")) | ||
| 613 | (looking-at " \\( *\\)")))) | ||
| 614 | |||
| 615 | (defun org-mouse-yank-link (click) | ||
| 616 | (interactive "e") | ||
| 617 | ;; Give temporary modes such as isearch a chance to turn off. | ||
| 618 | (run-hooks 'mouse-leave-buffer-hook) | ||
| 619 | (mouse-set-point click) | ||
| 620 | (setq mouse-selection-click-count 0) | ||
| 621 | (delete-horizontal-space) | ||
| 622 | (insert-for-yank (concat " [[" (current-kill 0) "]] "))) | ||
| 623 | |||
| 624 | (defun org-mouse-context-menu (&optional event) | ||
| 625 | (let ((stamp-prefixes (list org-deadline-string org-scheduled-string)) | ||
| 626 | (contextlist (org-context))) | ||
| 627 | (flet ((get-context (context) (org-mouse-get-context contextlist context))) | ||
| 628 | (cond | ||
| 629 | ((org-mouse-mark-active) | ||
| 630 | (let ((region-string (buffer-substring (region-beginning) (region-end)))) | ||
| 631 | (popup-menu | ||
| 632 | `(nil | ||
| 633 | ["Sparse Tree" (org-occur ',region-string)] | ||
| 634 | ["Find in Buffer" (occur ',region-string)] | ||
| 635 | ["Grep in Current Dir" | ||
| 636 | (grep (format "grep -rnH -e '%s' *" ',region-string))] | ||
| 637 | ["Grep in Parent Dir" | ||
| 638 | (grep (format "grep -rnH -e '%s' ../*" ',region-string))] | ||
| 639 | "--" | ||
| 640 | ["Convert to Link" | ||
| 641 | (progn (save-excursion (goto-char (region-beginning)) (insert "[[")) | ||
| 642 | (save-excursion (goto-char (region-end)) (insert "]]")))] | ||
| 643 | ["Insert Link Here" (org-mouse-yank-link ',event)])))) | ||
| 644 | |||
| 645 | ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)")) | ||
| 646 | (popup-menu | ||
| 647 | `(nil | ||
| 648 | ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options) | ||
| 649 | 'org-mode-restart)))) | ||
| 650 | ((or (eolp) | ||
| 651 | (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$") | ||
| 652 | (looking-back " \\|\t"))) | ||
| 653 | (org-mouse-popup-global-menu)) | ||
| 654 | ((get-context :checkbox) | ||
| 655 | (popup-menu | ||
| 656 | '(nil | ||
| 657 | ["Toggle" org-toggle-checkbox t] | ||
| 658 | ["Remove" org-mouse-remove-match-and-spaces t] | ||
| 659 | "" | ||
| 660 | ["All Clear" (org-mouse-for-each-item | ||
| 661 | (lambda () | ||
| 662 | (when (save-excursion (org-at-item-checkbox-p)) | ||
| 663 | (replace-match "[ ]"))))] | ||
| 664 | ["All Set" (org-mouse-for-each-item | ||
| 665 | (lambda () | ||
| 666 | (when (save-excursion (org-at-item-checkbox-p)) | ||
| 667 | (replace-match "[X]"))))] | ||
| 668 | ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t] | ||
| 669 | ["All Remove" (org-mouse-for-each-item | ||
| 670 | (lambda () | ||
| 671 | (when (save-excursion (org-at-item-checkbox-p)) | ||
| 672 | (org-mouse-remove-match-and-spaces))))] | ||
| 673 | ))) | ||
| 674 | ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_") | ||
| 675 | (member (match-string 0) (org-mouse-todo-keywords))) | ||
| 676 | (popup-menu | ||
| 677 | `(nil | ||
| 678 | ,@(org-mouse-keyword-replace-menu (org-mouse-todo-keywords)) | ||
| 679 | "--" | ||
| 680 | ["Check TODOs" org-show-todo-tree t] | ||
| 681 | ["List all TODO keywords" org-todo-list t] | ||
| 682 | [,(format "List only %s" (match-string 0)) | ||
| 683 | (org-todo-list (match-string 0)) t] | ||
| 684 | ))) | ||
| 685 | ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z") | ||
| 686 | (member (match-string 0) stamp-prefixes)) | ||
| 687 | (popup-menu | ||
| 688 | `(nil | ||
| 689 | ,@(org-mouse-keyword-replace-menu stamp-prefixes) | ||
| 690 | "--" | ||
| 691 | ["Check Deadlines" org-check-deadlines t] | ||
| 692 | ))) | ||
| 693 | ((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority | ||
| 694 | (popup-menu `(nil ,@(org-mouse-keyword-replace-menu | ||
| 695 | (org-mouse-priority-list) 1 "Priority %s" t)))) | ||
| 696 | ((get-context :link) | ||
| 697 | (popup-menu | ||
| 698 | '(nil | ||
| 699 | ["Open" org-open-at-point t] | ||
| 700 | ["Open in Emacs" (org-open-at-point t) t] | ||
| 701 | "--" | ||
| 702 | ["Copy link" (kill-new (match-string 0))] | ||
| 703 | ["Cut link" | ||
| 704 | (progn | ||
| 705 | (kill-region (match-beginning 0) (match-end 0)) | ||
| 706 | (just-one-space))] | ||
| 707 | "--" | ||
| 708 | ["Grep for TODOs" | ||
| 709 | (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))] | ||
| 710 | ; ["Paste file link" ((insert "file:") (yank))] | ||
| 711 | ))) | ||
| 712 | ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags | ||
| 713 | (popup-menu | ||
| 714 | `(nil | ||
| 715 | [,(format "Display '%s'" (match-string 1)) | ||
| 716 | (org-tags-view nil ,(match-string 1))] | ||
| 717 | [,(format "Sparse Tree '%s'" (match-string 1)) | ||
| 718 | (org-tags-sparse-tree nil ,(match-string 1))] | ||
| 719 | "--" | ||
| 720 | ,@(org-mouse-tag-menu)))) | ||
| 721 | ((org-at-timestamp-p) | ||
| 722 | (popup-menu | ||
| 723 | '(nil | ||
| 724 | ["Show Day" org-open-at-point t] | ||
| 725 | ["Change Timestamp" org-time-stamp t] | ||
| 726 | ["Delete Timestamp" (org-mouse-delete-timestamp) t] | ||
| 727 | ["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)] | ||
| 728 | "--" | ||
| 729 | ["Set for Today" org-mouse-timestamp-today] | ||
| 730 | ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)] | ||
| 731 | ["Set in 1 Week" (org-mouse-timestamp-today 7 'day)] | ||
| 732 | ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)] | ||
| 733 | ["Set in a Month" (org-mouse-timestamp-today 1 'month)] | ||
| 734 | "--" | ||
| 735 | ["+ 1 Day" (org-timestamp-change 1 'day)] | ||
| 736 | ["+ 1 Week" (org-timestamp-change 7 'day)] | ||
| 737 | ["+ 1 Month" (org-timestamp-change 1 'month)] | ||
| 738 | "--" | ||
| 739 | ["- 1 Day" (org-timestamp-change -1 'day)] | ||
| 740 | ["- 1 Week" (org-timestamp-change -7 'day)] | ||
| 741 | ["- 1 Month" (org-timestamp-change -1 'month)]))) | ||
| 742 | ((get-context :table-special) | ||
| 743 | (let ((mdata (match-data))) | ||
| 744 | (incf (car mdata) 2) | ||
| 745 | (store-match-data mdata)) | ||
| 746 | (message "match: %S" (match-string 0)) | ||
| 747 | (popup-menu `(nil ,@(org-mouse-keyword-replace-menu | ||
| 748 | '(" " "!" "^" "_" "$" "#" "*" "'") 0 | ||
| 749 | (lambda (mark) | ||
| 750 | (case (string-to-char mark) | ||
| 751 | (? "( ) Nothing Special") | ||
| 752 | (?! "(!) Column Names") | ||
| 753 | (?^ "(^) Field Names Above") | ||
| 754 | (?_ "(^) Field Names Below") | ||
| 755 | (?$ "($) Formula Parameters") | ||
| 756 | (?# "(#) Recalculation: Auto") | ||
| 757 | (?* "(*) Recalculation: Manual") | ||
| 758 | (?' "(') Recalculation: None"))) t)))) | ||
| 759 | ((assq :table contextlist) | ||
| 760 | (popup-menu | ||
| 761 | '(nil | ||
| 762 | ["Align Table" org-ctrl-c-ctrl-c] | ||
| 763 | ["Blank Field" org-table-blank-field] | ||
| 764 | ["Edit Field" org-table-edit-field] | ||
| 765 | "--" | ||
| 766 | ("Column" | ||
| 767 | ["Move Column Left" org-metaleft] | ||
| 768 | ["Move Column Right" org-metaright] | ||
| 769 | ["Delete Column" org-shiftmetaleft] | ||
| 770 | ["Insert Column" org-shiftmetaright] | ||
| 771 | "--" | ||
| 772 | ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle]) | ||
| 773 | ("Row" | ||
| 774 | ["Move Row Up" org-metaup] | ||
| 775 | ["Move Row Down" org-metadown] | ||
| 776 | ["Delete Row" org-shiftmetaup] | ||
| 777 | ["Insert Row" org-shiftmetadown] | ||
| 778 | ["Sort lines in region" org-table-sort-lines (org-at-table-p)] | ||
| 779 | "--" | ||
| 780 | ["Insert Hline" org-table-insert-hline]) | ||
| 781 | ("Rectangle" | ||
| 782 | ["Copy Rectangle" org-copy-special] | ||
| 783 | ["Cut Rectangle" org-cut-special] | ||
| 784 | ["Paste Rectangle" org-paste-special] | ||
| 785 | ["Fill Rectangle" org-table-wrap-region]) | ||
| 786 | "--" | ||
| 787 | ["Set Column Formula" org-table-eval-formula] | ||
| 788 | ["Set Field Formula" (org-table-eval-formula '(4))] | ||
| 789 | ["Edit Formulas" org-table-edit-formulas] | ||
| 790 | "--" | ||
| 791 | ["Recalculate Line" org-table-recalculate] | ||
| 792 | ["Recalculate All" (org-table-recalculate '(4))] | ||
| 793 | ["Iterate All" (org-table-recalculate '(16))] | ||
| 794 | "--" | ||
| 795 | ["Toggle Recalculate Mark" org-table-rotate-recalc-marks] | ||
| 796 | ["Sum Column/Rectangle" org-table-sum | ||
| 797 | :active (or (org-at-table-p) (org-region-active-p))] | ||
| 798 | ["Field Info" org-table-field-info] | ||
| 799 | ["Debug Formulas" | ||
| 800 | (setq org-table-formula-debug (not org-table-formula-debug)) | ||
| 801 | :style toggle :selected org-table-formula-debug] | ||
| 802 | ))) | ||
| 803 | ((and (assq :headline contextlist) (not (eolp))) | ||
| 804 | (let ((priority (org-mouse-get-priority t))) | ||
| 805 | (popup-menu | ||
| 806 | `("Headline Menu" | ||
| 807 | ("Tags and Priorities" | ||
| 808 | ,@(org-mouse-keyword-menu | ||
| 809 | (org-mouse-priority-list) | ||
| 810 | '(lambda (keyword) | ||
| 811 | (org-mouse-set-priority (string-to-char keyword))) | ||
| 812 | priority "Priority %s") | ||
| 813 | "--" | ||
| 814 | ,@(org-mouse-tag-menu)) | ||
| 815 | ("TODO Status" | ||
| 816 | ,@(progn (org-mouse-match-todo-keyword) | ||
| 817 | (org-mouse-keyword-replace-menu (org-mouse-todo-keywords) | ||
| 818 | 1))) | ||
| 819 | ["Show Tags" | ||
| 820 | (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags)) | ||
| 821 | :visible (not org-mouse-direct)] | ||
| 822 | ["Show Priority" | ||
| 823 | (with-current-buffer org-mouse-main-buffer (org-agenda-show-priority)) | ||
| 824 | :visible (not org-mouse-direct)] | ||
| 825 | ,@(if org-mouse-direct '("--") nil) | ||
| 826 | ["New Heading" org-mouse-insert-heading :visible org-mouse-direct] | ||
| 827 | ["Set Deadline" | ||
| 828 | (progn (org-mouse-end-headline) (insert " ") (org-deadline)) | ||
| 829 | :active (not (save-excursion | ||
| 830 | (org-mouse-re-search-line org-deadline-regexp)))] | ||
| 831 | ["Schedule Task" | ||
| 832 | (progn (org-mouse-end-headline) (insert " ") (org-schedule)) | ||
| 833 | :active (not (save-excursion | ||
| 834 | (org-mouse-re-search-line org-scheduled-regexp)))] | ||
| 835 | ["Insert Timestamp" | ||
| 836 | (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t] | ||
| 837 | ; ["Timestamp (inactive)" org-time-stamp-inactive t] | ||
| 838 | "--" | ||
| 839 | ["Archive Subtree" org-archive-subtree] | ||
| 840 | ["Cut Subtree" org-cut-special] | ||
| 841 | ["Copy Subtree" org-copy-special] | ||
| 842 | ["Paste Subtree" org-paste-special :visible org-mouse-direct] | ||
| 843 | ("Sort Children" | ||
| 844 | ["Alphabetically" (org-sort-entries nil ?a)] | ||
| 845 | ["Numerically" (org-sort-entries nil ?n)] | ||
| 846 | ["By Time/Date" (org-sort-entries nil ?t)] | ||
| 847 | "--" | ||
| 848 | ["Reverse Alphabetically" (org-sort-entries nil ?A)] | ||
| 849 | ["Reverse Numerically" (org-sort-entries nil ?N)] | ||
| 850 | ["Reverse By Time/Date" (org-sort-entries nil ?T)]) | ||
| 851 | "--" | ||
| 852 | ["Move Trees" org-mouse-move-tree :active nil] | ||
| 853 | )))) | ||
| 854 | (t | ||
| 855 | (org-mouse-popup-global-menu)))))) | ||
| 856 | |||
| 857 | ;; (defun org-mouse-at-regexp (regexp) | ||
| 858 | ;; (save-excursion | ||
| 859 | ;; (let ((point (point)) | ||
| 860 | ;; (bol (progn (beginning-of-line) (point))) | ||
| 861 | ;; (eol (progn (end-of-line) (point)))) | ||
| 862 | ;; (goto-char point) | ||
| 863 | ;; (re-search-backward regexp bol 1) | ||
| 864 | ;; (and (not (eolp)) | ||
| 865 | ;; (progn (forward-char) | ||
| 866 | ;; (re-search-forward regexp eol t)) | ||
| 867 | ;; (<= (match-beginning 0) point))))) | ||
| 868 | |||
| 869 | (defun org-mouse-mark-active () | ||
| 870 | (and mark-active transient-mark-mode)) | ||
| 871 | |||
| 872 | (defun org-mouse-in-region-p (pos) | ||
| 873 | (and (org-mouse-mark-active) | ||
| 874 | (>= pos (region-beginning)) | ||
| 875 | (< pos (region-end)))) | ||
| 876 | |||
| 877 | (defun org-mouse-down-mouse (event) | ||
| 878 | (interactive "e") | ||
| 879 | (setq this-command last-command) | ||
| 880 | (unless (and (= 1 (event-click-count event)) | ||
| 881 | (org-mouse-in-region-p (posn-point (event-start event)))) | ||
| 882 | (mouse-drag-region event))) | ||
| 883 | |||
| 884 | (add-hook 'org-mode-hook | ||
| 885 | '(lambda () | ||
| 886 | (setq org-mouse-context-menu-function 'org-mouse-context-menu) | ||
| 887 | |||
| 888 | ; (define-key org-mouse-map [follow-link] 'mouse-face) | ||
| 889 | (define-key org-mouse-map (if (featurep 'xemacs) [button3] [mouse-3]) nil) | ||
| 890 | (define-key org-mode-map [mouse-3] 'org-mouse-show-context-menu) | ||
| 891 | (define-key org-mode-map [down-mouse-1] 'org-mouse-down-mouse) | ||
| 892 | (define-key org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree) | ||
| 893 | (define-key org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start) | ||
| 894 | (define-key org-mode-map [S-mouse-2] 'org-mouse-yank-link) | ||
| 895 | (define-key org-mode-map [drag-mouse-3] 'org-mouse-yank-link) | ||
| 896 | (define-key org-mouse-map [drag-mouse-3] 'org-mouse-move-tree) | ||
| 897 | (define-key org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start) | ||
| 898 | |||
| 899 | (font-lock-add-keywords nil | ||
| 900 | `((,outline-regexp | ||
| 901 | 0 `(face org-link mouse-face highlight keymap ,org-mouse-map) | ||
| 902 | 'prepend) | ||
| 903 | ("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +" | ||
| 904 | (1 `(face org-link keymap ,org-mouse-map mouse-face highlight) 'prepend)) | ||
| 905 | ("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)" | ||
| 906 | (2 `(face bold keymap ,org-mouse-map mouse-face highlight) t))) | ||
| 907 | t) | ||
| 908 | |||
| 909 | (defadvice org-open-at-point (around org-mouse-open-at-point activate) | ||
| 910 | (let ((context (org-context))) | ||
| 911 | (cond | ||
| 912 | ((assq :headline-stars context) (org-cycle)) | ||
| 913 | ((assq :checkbox context) (org-toggle-checkbox)) | ||
| 914 | ((assq :item-bullet context) | ||
| 915 | (let ((org-cycle-include-plain-lists t)) (org-cycle))) | ||
| 916 | (t ad-do-it)))))) | ||
| 917 | |||
| 918 | (defun org-mouse-move-tree-start (event) | ||
| 919 | (interactive "e") | ||
| 920 | (message "Same line: promote/demote, (***):move before, (text): make a child")) | ||
| 921 | |||
| 922 | |||
| 923 | (defun org-mouse-make-marker (position) | ||
| 924 | (with-current-buffer (window-buffer (posn-window position)) | ||
| 925 | (copy-marker (posn-point position)))) | ||
| 926 | |||
| 927 | (defun org-mouse-move-tree (event) | ||
| 928 | ;; todo: handle movements between different buffers | ||
| 929 | (interactive "e") | ||
| 930 | (save-excursion | ||
| 931 | (let* ((start (org-mouse-make-marker (event-start event))) | ||
| 932 | (end (org-mouse-make-marker (event-end event))) | ||
| 933 | (sbuf (marker-buffer start)) | ||
| 934 | (ebuf (marker-buffer end))) | ||
| 935 | |||
| 936 | (when (and sbuf ebuf) | ||
| 937 | (set-buffer sbuf) | ||
| 938 | (goto-char start) | ||
| 939 | (org-back-to-heading) | ||
| 940 | (if (and (eq sbuf ebuf) | ||
| 941 | (equal | ||
| 942 | (point) | ||
| 943 | (save-excursion (goto-char end) (org-back-to-heading) (point)))) | ||
| 944 | ;; if the same line then promote/demote | ||
| 945 | (if (>= end start) (org-demote-subtree) (org-promote-subtree)) | ||
| 946 | ;; if different lines then move | ||
| 947 | (org-cut-subtree) | ||
| 948 | |||
| 949 | (set-buffer ebuf) | ||
| 950 | (goto-char end) | ||
| 951 | (org-back-to-heading) | ||
| 952 | (when (and (eq sbuf ebuf) | ||
| 953 | (equal | ||
| 954 | (point) | ||
| 955 | (save-excursion (goto-char start) | ||
| 956 | (org-back-to-heading) (point)))) | ||
| 957 | (outline-end-of-subtree) | ||
| 958 | (end-of-line) | ||
| 959 | (if (eobp) (newline) (forward-char))) | ||
| 960 | |||
| 961 | (when (looking-at outline-regexp) | ||
| 962 | (let ((level (- (match-end 0) (match-beginning 0)))) | ||
| 963 | (when (> end (match-end 0)) | ||
| 964 | (outline-end-of-subtree) | ||
| 965 | (end-of-line) | ||
| 966 | (if (eobp) (newline) (forward-char)) | ||
| 967 | (setq level (1+ level))) | ||
| 968 | (org-paste-subtree level) | ||
| 969 | (save-excursion | ||
| 970 | (outline-end-of-subtree) | ||
| 971 | (when (bolp) (delete-char -1)))))))))) | ||
| 972 | |||
| 973 | |||
| 974 | (defun org-mouse-transform-to-outline () | ||
| 975 | (interactive) | ||
| 976 | (org-back-to-heading) | ||
| 977 | (let ((minlevel 1000) | ||
| 978 | (replace-text (concat (match-string 0) "* "))) | ||
| 979 | (beginning-of-line 2) | ||
| 980 | (save-excursion | ||
| 981 | (while (not (or (eobp) (looking-at outline-regexp))) | ||
| 982 | (when (looking-at org-mouse-plain-list-regexp) | ||
| 983 | (setq minlevel (min minlevel (- (match-end 1) (match-beginning 1))))) | ||
| 984 | (forward-line))) | ||
| 985 | (while (not (or (eobp) (looking-at outline-regexp))) | ||
| 986 | (when (and (looking-at org-mouse-plain-list-regexp) | ||
| 987 | (eq minlevel (- (match-end 1) (match-beginning 1)))) | ||
| 988 | (replace-match replace-text)) | ||
| 989 | (forward-line)))) | ||
| 990 | |||
| 991 | (defvar _cmd) ;dynamically scoped from `org-with-remote-undo'. | ||
| 992 | |||
| 993 | (defun org-mouse-do-remotely (command) | ||
| 994 | ; (org-agenda-check-no-diary) | ||
| 995 | (when (get-text-property (point) 'org-marker) | ||
| 996 | (let* ((anticol (- (point-at-eol) (point))) | ||
| 997 | (marker (get-text-property (point) 'org-marker)) | ||
| 998 | (buffer (marker-buffer marker)) | ||
| 999 | (pos (marker-position marker)) | ||
| 1000 | (hdmarker (get-text-property (point) 'org-hd-marker)) | ||
| 1001 | (buffer-read-only nil) | ||
| 1002 | (newhead "--- removed ---") | ||
| 1003 | (org-mouse-direct nil) | ||
| 1004 | (org-mouse-main-buffer (current-buffer))) | ||
| 1005 | (when (eq (with-current-buffer buffer major-mode) 'org-mode) | ||
| 1006 | (let ((endmarker (save-excursion | ||
| 1007 | (set-buffer buffer) | ||
| 1008 | (outline-end-of-subtree) | ||
| 1009 | (forward-char 1) | ||
| 1010 | (copy-marker (point))))) | ||
| 1011 | (org-with-remote-undo buffer | ||
| 1012 | (with-current-buffer buffer | ||
| 1013 | (widen) | ||
| 1014 | (goto-char pos) | ||
| 1015 | (org-show-hidden-entry) | ||
| 1016 | (save-excursion | ||
| 1017 | (and (outline-next-heading) | ||
| 1018 | (org-flag-heading nil))) ; show the next heading | ||
| 1019 | (org-back-to-heading) | ||
| 1020 | (setq marker (copy-marker (point))) | ||
| 1021 | (goto-char (max (point-at-bol) (- (point-at-eol) anticol))) | ||
| 1022 | (funcall command) | ||
| 1023 | (message "_cmd: %S" _cmd) | ||
| 1024 | (message "this-command: %S" this-command) | ||
| 1025 | (unless (eq (marker-position marker) (marker-position endmarker)) | ||
| 1026 | (setq newhead (org-get-heading)))) | ||
| 1027 | |||
| 1028 | (beginning-of-line 1) | ||
| 1029 | (save-excursion | ||
| 1030 | (org-agenda-change-all-lines newhead hdmarker 'fixface)))) | ||
| 1031 | t)))) | ||
| 1032 | |||
| 1033 | (defun org-mouse-agenda-context-menu (&optional event) | ||
| 1034 | (or (org-mouse-do-remotely 'org-mouse-context-menu) | ||
| 1035 | (popup-menu | ||
| 1036 | '("Agenda" | ||
| 1037 | ("Agenda Files") | ||
| 1038 | "--" | ||
| 1039 | ["Undo" (progn (message "last command: %S" last-command) (setq this-command 'org-agenda-undo) (org-agenda-undo)) | ||
| 1040 | :visible (if (eq last-command 'org-agenda-undo) | ||
| 1041 | org-agenda-pending-undo-list | ||
| 1042 | org-agenda-undo-list)] | ||
| 1043 | ["Rebuild Buffer" org-agenda-redo t] | ||
| 1044 | ["New Diary Entry" | ||
| 1045 | org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline) t] | ||
| 1046 | "--" | ||
| 1047 | ["Goto Today" org-agenda-goto-today | ||
| 1048 | (org-agenda-check-type nil 'agenda 'timeline) t] | ||
| 1049 | ["Display Calendar" org-agenda-goto-calendar | ||
| 1050 | (org-agenda-check-type nil 'agenda 'timeline) t] | ||
| 1051 | ("Calendar Commands" | ||
| 1052 | ["Phases of the Moon" org-agenda-phases-of-moon | ||
| 1053 | (org-agenda-check-type nil 'agenda 'timeline)] | ||
| 1054 | ["Sunrise/Sunset" org-agenda-sunrise-sunset | ||
| 1055 | (org-agenda-check-type nil 'agenda 'timeline)] | ||
| 1056 | ["Holidays" org-agenda-holidays | ||
| 1057 | (org-agenda-check-type nil 'agenda 'timeline)] | ||
| 1058 | ["Convert" org-agenda-convert-date | ||
| 1059 | (org-agenda-check-type nil 'agenda 'timeline)] | ||
| 1060 | "--" | ||
| 1061 | ["Create iCalendar file" org-export-icalendar-combine-agenda-files t]) | ||
| 1062 | "--" | ||
| 1063 | ["Day View" org-agenda-day-view | ||
| 1064 | :active (org-agenda-check-type nil 'agenda) | ||
| 1065 | :style radio :selected (equal org-agenda-ndays 1)] | ||
| 1066 | ["Week View" org-agenda-week-view | ||
| 1067 | :active (org-agenda-check-type nil 'agenda) | ||
| 1068 | :style radio :selected (equal org-agenda-ndays 7)] | ||
| 1069 | "--" | ||
| 1070 | ["Show Logbook entries" org-agenda-log-mode | ||
| 1071 | :style toggle :selected org-agenda-show-log | ||
| 1072 | :active (org-agenda-check-type nil 'agenda 'timeline)] | ||
| 1073 | ["Include Diary" org-agenda-toggle-diary | ||
| 1074 | :style toggle :selected org-agenda-include-diary | ||
| 1075 | :active (org-agenda-check-type nil 'agenda)] | ||
| 1076 | ["Use Time Grid" org-agenda-toggle-time-grid | ||
| 1077 | :style toggle :selected org-agenda-use-time-grid | ||
| 1078 | :active (org-agenda-check-type nil 'agenda)] | ||
| 1079 | ["Follow Mode" org-agenda-follow-mode | ||
| 1080 | :style toggle :selected org-agenda-follow-mode] | ||
| 1081 | "--" | ||
| 1082 | ["Quit" org-agenda-quit t] | ||
| 1083 | ["Exit and Release Buffers" org-agenda-exit t] | ||
| 1084 | )))) | ||
| 1085 | |||
| 1086 | (defun org-mouse-get-gesture (event) | ||
| 1087 | (let ((startxy (posn-x-y (event-start event))) | ||
| 1088 | (endxy (posn-x-y (event-end event)))) | ||
| 1089 | (if (< (car startxy) (car endxy)) :right :left))) | ||
| 1090 | |||
| 1091 | |||
| 1092 | ; (setq org-agenda-mode-hook nil) | ||
| 1093 | (add-hook 'org-agenda-mode-hook | ||
| 1094 | '(lambda () | ||
| 1095 | (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) | ||
| 1096 | (define-key org-agenda-keymap | ||
| 1097 | (if (featurep 'xemacs) [button3] [mouse-3]) | ||
| 1098 | 'org-mouse-show-context-menu) | ||
| 1099 | (define-key org-agenda-keymap [down-mouse-3] 'org-mouse-move-tree-start) | ||
| 1100 | (define-key org-agenda-keymap [C-mouse-4] 'org-agenda-earlier) | ||
| 1101 | (define-key org-agenda-keymap [C-mouse-5] 'org-agenda-later) | ||
| 1102 | (define-key org-agenda-keymap [drag-mouse-3] | ||
| 1103 | '(lambda (event) (interactive "e") | ||
| 1104 | (case (org-mouse-get-gesture event) | ||
| 1105 | (:left (org-agenda-earlier 1)) | ||
| 1106 | (:right (org-agenda-later 1))))))) | ||
| 1107 | |||
| 1108 | (provide 'org-mouse) | ||
| 1109 | |||
| 1110 | ;; arch-tag: ff1ae557-3529-41a3-95c6-baaebdcc280f | ||
diff --git a/lisp/textmodes/org-publish.el b/lisp/textmodes/org-publish.el index 807a844c425..0a8e9019827 100644 --- a/lisp/textmodes/org-publish.el +++ b/lisp/textmodes/org-publish.el | |||
| @@ -1,28 +1,28 @@ | |||
| 1 | ;;; org-publish.el --- publish related org-mode files as a website | 1 | ;;; org-publish.el --- publish related org-mode files as a website |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: David O'Toole <dto@gnu.org> | 5 | ;; Author: David O'Toole <dto@gnu.org> |
| 6 | ;; Keywords: hypermedia, outlines | 6 | ;; Keywords: hypermedia, outlines |
| 7 | ;; Version: 1.80a | 7 | ;; Version: 1.80b |
| 8 | 8 | ||
| 9 | ;; This file is free software; you can redistribute it and/or modify | 9 | ;; This file is part of GNU Emacs. |
| 10 | ;; | ||
| 11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 10 | ;; it under the terms of the GNU General Public License as published by | 12 | ;; it under the terms of the GNU General Public License as published by |
| 11 | ;; the Free Software Foundation; either version 3, or (at your option) | 13 | ;; the Free Software Foundation; either version 3, or (at your option) |
| 12 | ;; any later version. | 14 | ;; any later version. |
| 13 | 15 | ||
| 14 | ;; This file is distributed in the hope that it will be useful, | 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 17 | ;; GNU General Public License for more details. | 19 | ;; GNU General Public License for more details. |
| 18 | 20 | ||
| 19 | ;; You should have received a copy of the GNU General Public License | 21 | ;; You should have received a copy of the GNU General Public License |
| 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to | 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 21 | ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | 23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
| 22 | ;; Boston, MA 02110-1301, USA. | 24 | ;; Boston, MA 02110-1301, USA. |
| 23 | 25 | ||
| 24 | ;; This file is part of GNU Emacs. | ||
| 25 | |||
| 26 | ;;; Commentary: | 26 | ;;; Commentary: |
| 27 | 27 | ||
| 28 | ;; Requires at least version 4.27 of org.el | 28 | ;; Requires at least version 4.27 of org.el |
| @@ -572,11 +572,10 @@ default is 'index.org'." | |||
| 572 | With prefix argument, force publishing all files in project." | 572 | With prefix argument, force publishing all files in project." |
| 573 | (interactive "P") | 573 | (interactive "P") |
| 574 | (save-window-excursion | 574 | (save-window-excursion |
| 575 | (let* ((project-name (org-publish-get-project-from-filename (buffer-file-name))) | 575 | (let* ((project-name (org-publish-get-project-from-filename (buffer-file-name)))) |
| 576 | (org-publish-use-timestamps-flag (if force nil t))) | ||
| 577 | (if (not project-name) | 576 | (if (not project-name) |
| 578 | (error "File %s is not part of any known project." (buffer-file-name))) | 577 | (error "File %s is not part of any known project." (buffer-file-name))) |
| 579 | (org-publish project-name)))) | 578 | (org-publish project-name (if force nil t))))) |
| 580 | 579 | ||
| 581 | 580 | ||
| 582 | ;;;###autoload | 581 | ;;;###autoload |
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index 15ad87f4f23..bc63a962b9c 100644 --- a/lisp/textmodes/org.el +++ b/lisp/textmodes/org.el | |||
| @@ -5,7 +5,7 @@ | |||
| 5 | ;; Author: Carsten Dominik <carsten at orgmode dot org> | 5 | ;; Author: Carsten Dominik <carsten at orgmode dot org> |
| 6 | ;; Keywords: outlines, hypermedia, calendar, wp | 6 | ;; Keywords: outlines, hypermedia, calendar, wp |
| 7 | ;; Homepage: http://orgmode.org | 7 | ;; Homepage: http://orgmode.org |
| 8 | ;; Version: 5.13i | 8 | ;; Version: 5.19a |
| 9 | ;; | 9 | ;; |
| 10 | ;; This file is part of GNU Emacs. | 10 | ;; This file is part of GNU Emacs. |
| 11 | ;; | 11 | ;; |
| @@ -77,13 +77,14 @@ | |||
| 77 | (require 'outline) (require 'noutline) | 77 | (require 'outline) (require 'noutline) |
| 78 | ;; Other stuff we need. | 78 | ;; Other stuff we need. |
| 79 | (require 'time-date) | 79 | (require 'time-date) |
| 80 | (unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) | ||
| 80 | (require 'easymenu) | 81 | (require 'easymenu) |
| 81 | 82 | ||
| 82 | ;;;; Customization variables | 83 | ;;;; Customization variables |
| 83 | 84 | ||
| 84 | ;;; Version | 85 | ;;; Version |
| 85 | 86 | ||
| 86 | (defconst org-version "5.13i" | 87 | (defconst org-version "5.19a" |
| 87 | "The version number of the file org.el.") | 88 | "The version number of the file org.el.") |
| 88 | (defun org-version () | 89 | (defun org-version () |
| 89 | (interactive) | 90 | (interactive) |
| @@ -97,8 +98,12 @@ | |||
| 97 | (get-text-property 0 'test (format "%s" x))) | 98 | (get-text-property 0 'test (format "%s" x))) |
| 98 | "Does format transport text properties?") | 99 | "Does format transport text properties?") |
| 99 | 100 | ||
| 101 | (defmacro org-bound-and-true-p (var) | ||
| 102 | "Return the value of symbol VAR if it is bound, else nil." | ||
| 103 | `(and (boundp (quote ,var)) ,var)) | ||
| 104 | |||
| 100 | (defmacro org-unmodified (&rest body) | 105 | (defmacro org-unmodified (&rest body) |
| 101 | "Execute body without changing buffer-modified-p." | 106 | "Execute body without changing `buffer-modified-p'." |
| 102 | `(set-buffer-modified-p | 107 | `(set-buffer-modified-p |
| 103 | (prog1 (buffer-modified-p) ,@body))) | 108 | (prog1 (buffer-modified-p) ,@body))) |
| 104 | 109 | ||
| @@ -251,7 +256,7 @@ Or return the original if not disputed." | |||
| 251 | "Define a key, possibly translated, as returned by `org-key'." | 256 | "Define a key, possibly translated, as returned by `org-key'." |
| 252 | (define-key keymap (org-key key) def)) | 257 | (define-key keymap (org-key key) def)) |
| 253 | 258 | ||
| 254 | (defcustom org-ellipsis 'org-ellipsis | 259 | (defcustom org-ellipsis nil |
| 255 | "The ellipsis to use in the Org-mode outline. | 260 | "The ellipsis to use in the Org-mode outline. |
| 256 | When nil, just use the standard three dots. When a string, use that instead, | 261 | When nil, just use the standard three dots. When a string, use that instead, |
| 257 | When a face, use the standart 3 dots, but with the specified face. | 262 | When a face, use the standart 3 dots, but with the specified face. |
| @@ -332,6 +337,25 @@ After a match, group 1 contains the repeat expression.") | |||
| 332 | :tag "Org Reveal Location" | 337 | :tag "Org Reveal Location" |
| 333 | :group 'org-structure) | 338 | :group 'org-structure) |
| 334 | 339 | ||
| 340 | (defconst org-context-choice | ||
| 341 | '(choice | ||
| 342 | (const :tag "Always" t) | ||
| 343 | (const :tag "Never" nil) | ||
| 344 | (repeat :greedy t :tag "Individual contexts" | ||
| 345 | (cons | ||
| 346 | (choice :tag "Context" | ||
| 347 | (const agenda) | ||
| 348 | (const org-goto) | ||
| 349 | (const occur-tree) | ||
| 350 | (const tags-tree) | ||
| 351 | (const link-search) | ||
| 352 | (const mark-goto) | ||
| 353 | (const bookmark-jump) | ||
| 354 | (const isearch) | ||
| 355 | (const default)) | ||
| 356 | (boolean)))) | ||
| 357 | "Contexts for the reveal options.") | ||
| 358 | |||
| 335 | (defcustom org-show-hierarchy-above '((default . t)) | 359 | (defcustom org-show-hierarchy-above '((default . t)) |
| 336 | "Non-nil means, show full hierarchy when revealing a location. | 360 | "Non-nil means, show full hierarchy when revealing a location. |
| 337 | Org-mode often shows locations in an org-mode file which might have | 361 | Org-mode often shows locations in an org-mode file which might have |
| @@ -350,22 +374,7 @@ contexts. Valid contexts are | |||
| 350 | isearch when exiting from an incremental search | 374 | isearch when exiting from an incremental search |
| 351 | default default for all contexts not set explicitly" | 375 | default default for all contexts not set explicitly" |
| 352 | :group 'org-reveal-location | 376 | :group 'org-reveal-location |
| 353 | :type '(choice | 377 | :type org-context-choice) |
| 354 | (const :tag "Always" t) | ||
| 355 | (const :tag "Never" nil) | ||
| 356 | (repeat :greedy t :tag "Individual contexts" | ||
| 357 | (cons | ||
| 358 | (choice :tag "Context" | ||
| 359 | (const agenda) | ||
| 360 | (const org-goto) | ||
| 361 | (const occur-tree) | ||
| 362 | (const tags-tree) | ||
| 363 | (const link-search) | ||
| 364 | (const mark-goto) | ||
| 365 | (const bookmark-jump) | ||
| 366 | (const isearch) | ||
| 367 | (const default)) | ||
| 368 | (boolean))))) | ||
| 369 | 378 | ||
| 370 | (defcustom org-show-following-heading '((default . nil)) | 379 | (defcustom org-show-following-heading '((default . nil)) |
| 371 | "Non-nil means, show following heading when revealing a location. | 380 | "Non-nil means, show following heading when revealing a location. |
| @@ -378,22 +387,7 @@ use the command \\[org-reveal] to show more context. | |||
| 378 | Instead of t, this can also be an alist specifying this option for different | 387 | Instead of t, this can also be an alist specifying this option for different |
| 379 | contexts. See `org-show-hierarchy-above' for valid contexts." | 388 | contexts. See `org-show-hierarchy-above' for valid contexts." |
| 380 | :group 'org-reveal-location | 389 | :group 'org-reveal-location |
| 381 | :type '(choice | 390 | :type org-context-choice) |
| 382 | (const :tag "Always" t) | ||
| 383 | (const :tag "Never" nil) | ||
| 384 | (repeat :greedy t :tag "Individual contexts" | ||
| 385 | (cons | ||
| 386 | (choice :tag "Context" | ||
| 387 | (const agenda) | ||
| 388 | (const org-goto) | ||
| 389 | (const occur-tree) | ||
| 390 | (const tags-tree) | ||
| 391 | (const link-search) | ||
| 392 | (const mark-goto) | ||
| 393 | (const bookmark-jump) | ||
| 394 | (const isearch) | ||
| 395 | (const default)) | ||
| 396 | (boolean))))) | ||
| 397 | 391 | ||
| 398 | (defcustom org-show-siblings '((default . nil) (isearch t)) | 392 | (defcustom org-show-siblings '((default . nil) (isearch t)) |
| 399 | "Non-nil means, show all sibling heading when revealing a location. | 393 | "Non-nil means, show all sibling heading when revealing a location. |
| @@ -409,22 +403,19 @@ use the command \\[org-reveal] to show more context. | |||
| 409 | Instead of t, this can also be an alist specifying this option for different | 403 | Instead of t, this can also be an alist specifying this option for different |
| 410 | contexts. See `org-show-hierarchy-above' for valid contexts." | 404 | contexts. See `org-show-hierarchy-above' for valid contexts." |
| 411 | :group 'org-reveal-location | 405 | :group 'org-reveal-location |
| 412 | :type '(choice | 406 | :type org-context-choice) |
| 413 | (const :tag "Always" t) | 407 | |
| 414 | (const :tag "Never" nil) | 408 | (defcustom org-show-entry-below '((default . nil)) |
| 415 | (repeat :greedy t :tag "Individual contexts" | 409 | "Non-nil means, show the entry below a headline when revealing a location. |
| 416 | (cons | 410 | Org-mode often shows locations in an org-mode file which might have |
| 417 | (choice :tag "Context" | 411 | been invisible before. When this is set, the text below the headline that is |
| 418 | (const agenda) | 412 | exposed is also shown. |
| 419 | (const org-goto) | 413 | |
| 420 | (const occur-tree) | 414 | By default this is off for all contexts. |
| 421 | (const tags-tree) | 415 | Instead of t, this can also be an alist specifying this option for different |
| 422 | (const link-search) | 416 | contexts. See `org-show-hierarchy-above' for valid contexts." |
| 423 | (const mark-goto) | 417 | :group 'org-reveal-location |
| 424 | (const bookmark-jump) | 418 | :type org-context-choice) |
| 425 | (const isearch) | ||
| 426 | (const default)) | ||
| 427 | (boolean))))) | ||
| 428 | 419 | ||
| 429 | (defgroup org-cycle nil | 420 | (defgroup org-cycle nil |
| 430 | "Options concerning visibility cycling in Org-mode." | 421 | "Options concerning visibility cycling in Org-mode." |
| @@ -463,7 +454,7 @@ of the buffer." | |||
| 463 | "Where should `org-cycle' emulate TAB. | 454 | "Where should `org-cycle' emulate TAB. |
| 464 | nil Never | 455 | nil Never |
| 465 | white Only in completely white lines | 456 | white Only in completely white lines |
| 466 | whitestart Only at the beginning of lines, before the first non-white char. | 457 | whitestart Only at the beginning of lines, before the first non-white char |
| 467 | t Everywhere except in headlines | 458 | t Everywhere except in headlines |
| 468 | exc-hl-bol Everywhere except at the start of a headline | 459 | exc-hl-bol Everywhere except at the start of a headline |
| 469 | If TAB is used in a place where it does not emulate TAB, the current subtree | 460 | If TAB is used in a place where it does not emulate TAB, the current subtree |
| @@ -568,7 +559,7 @@ and a boolean flag as cdr." | |||
| 568 | (defcustom org-insert-heading-hook nil | 559 | (defcustom org-insert-heading-hook nil |
| 569 | "Hook being run after inserting a new heading." | 560 | "Hook being run after inserting a new heading." |
| 570 | :group 'org-edit-structure | 561 | :group 'org-edit-structure |
| 571 | :type 'boolean) | 562 | :type 'hook) |
| 572 | 563 | ||
| 573 | (defcustom org-enable-fixed-width-editor t | 564 | (defcustom org-enable-fixed-width-editor t |
| 574 | "Non-nil means, lines starting with \":\" are treated as fixed-width. | 565 | "Non-nil means, lines starting with \":\" are treated as fixed-width. |
| @@ -658,7 +649,9 @@ with \\[org-ctrl-c-ctrl-c\\]." | |||
| 658 | (defcustom org-archive-tag "ARCHIVE" | 649 | (defcustom org-archive-tag "ARCHIVE" |
| 659 | "The tag that marks a subtree as archived. | 650 | "The tag that marks a subtree as archived. |
| 660 | An archived subtree does not open during visibility cycling, and does | 651 | An archived subtree does not open during visibility cycling, and does |
| 661 | not contribute to the agenda listings." | 652 | not contribute to the agenda listings. |
| 653 | After changing this, font-lock must be restarted in the relevant buffers to | ||
| 654 | get the proper fontification." | ||
| 662 | :group 'org-archive | 655 | :group 'org-archive |
| 663 | :group 'org-keywords | 656 | :group 'org-keywords |
| 664 | :type 'string) | 657 | :type 'string) |
| @@ -767,6 +760,17 @@ information." | |||
| 767 | (const :tag "Inherited tags" itags) | 760 | (const :tag "Inherited tags" itags) |
| 768 | (const :tag "Local tags" ltags))) | 761 | (const :tag "Local tags" ltags))) |
| 769 | 762 | ||
| 763 | (defgroup org-imenu-and-speedbar nil | ||
| 764 | "Options concerning imenu and speedbar in Org-mode." | ||
| 765 | :tag "Org Imenu and Speedbar" | ||
| 766 | :group 'org-structure) | ||
| 767 | |||
| 768 | (defcustom org-imenu-depth 2 | ||
| 769 | "The maximum level for Imenu access to Org-mode headlines. | ||
| 770 | This also applied for speedbar access." | ||
| 771 | :group 'org-imenu-and-speedbar | ||
| 772 | :type 'number) | ||
| 773 | |||
| 770 | (defgroup org-table nil | 774 | (defgroup org-table nil |
| 771 | "Options concerning tables in Org-mode." | 775 | "Options concerning tables in Org-mode." |
| 772 | :tag "Org Table" | 776 | :tag "Org Table" |
| @@ -892,7 +896,7 @@ alignment to the right border applies." | |||
| 892 | :type 'number) | 896 | :type 'number) |
| 893 | 897 | ||
| 894 | (defgroup org-table-editing nil | 898 | (defgroup org-table-editing nil |
| 895 | "Bahavior of tables during editing in Org-mode." | 899 | "Behavior of tables during editing in Org-mode." |
| 896 | :tag "Org Table Editing" | 900 | :tag "Org Table Editing" |
| 897 | :group 'org-table) | 901 | :group 'org-table) |
| 898 | 902 | ||
| @@ -1031,15 +1035,18 @@ links in Org-mode buffers can have an optional tag after a double colon, e.g. | |||
| 1031 | [[linkkey:tag][description]] | 1035 | [[linkkey:tag][description]] |
| 1032 | 1036 | ||
| 1033 | If REPLACE is a string, the tag will simply be appended to create the link. | 1037 | If REPLACE is a string, the tag will simply be appended to create the link. |
| 1034 | If the string contains \"%s\", the tag will be inserted there. REPLACE may | 1038 | If the string contains \"%s\", the tag will be inserted there. |
| 1035 | also be a function that will be called with the tag as the only argument to | 1039 | |
| 1036 | create the link. See the manual for examples." | 1040 | REPLACE may also be a function that will be called with the tag as the |
| 1041 | only argument to create the link, which should be returned as a string. | ||
| 1042 | |||
| 1043 | See the manual for examples." | ||
| 1037 | :group 'org-link | 1044 | :group 'org-link |
| 1038 | :type 'alist) | 1045 | :type 'alist) |
| 1039 | 1046 | ||
| 1040 | (defcustom org-descriptive-links t | 1047 | (defcustom org-descriptive-links t |
| 1041 | "Non-nil means, hide link part and only show description of bracket links. | 1048 | "Non-nil means, hide link part and only show description of bracket links. |
| 1042 | Bracket links are like [[link][descritpion]]. This variable sets the initial | 1049 | Bracket links are like [[link][descritpion]]. This variable sets the initial |
| 1043 | state in new org-mode buffers. The setting can then be toggled on a | 1050 | state in new org-mode buffers. The setting can then be toggled on a |
| 1044 | per-buffer basis from the Org->Hyperlinks menu." | 1051 | per-buffer basis from the Org->Hyperlinks menu." |
| 1045 | :group 'org-link | 1052 | :group 'org-link |
| @@ -1049,10 +1056,10 @@ per-buffer basis from the Org->Hyperlinks menu." | |||
| 1049 | "How the path name in file links should be stored. | 1056 | "How the path name in file links should be stored. |
| 1050 | Valid values are: | 1057 | Valid values are: |
| 1051 | 1058 | ||
| 1052 | relative relative to the current directory, i.e. the directory of the file | 1059 | relative Relative to the current directory, i.e. the directory of the file |
| 1053 | into which the link is being inserted. | 1060 | into which the link is being inserted. |
| 1054 | absolute absolute path, if possible with ~ for home directory. | 1061 | absolute Absolute path, if possible with ~ for home directory. |
| 1055 | noabbrev absolute path, no abbreviation of home directory. | 1062 | noabbrev Absolute path, no abbreviation of home directory. |
| 1056 | adaptive Use relative path for files in the current directory and sub- | 1063 | adaptive Use relative path for files in the current directory and sub- |
| 1057 | directories of it. For other files, use an absolute path." | 1064 | directories of it. For other files, use an absolute path." |
| 1058 | :group 'org-link | 1065 | :group 'org-link |
| @@ -1404,6 +1411,14 @@ When this variable is nil, `C-c C-c' give you the prompts, and | |||
| 1404 | :group 'org-remember | 1411 | :group 'org-remember |
| 1405 | :type 'boolean) | 1412 | :type 'boolean) |
| 1406 | 1413 | ||
| 1414 | (defcustom org-remember-use-refile-when-interactive t | ||
| 1415 | "Non-nil means, use refile to file a remember note. | ||
| 1416 | This is only used when the interactive mode for selecting a filing | ||
| 1417 | location is used (see the variable `org-remember-store-without-prompt'). | ||
| 1418 | When nil, the `org-goto' interface is used." | ||
| 1419 | :group 'org-remember | ||
| 1420 | :type 'boolean) | ||
| 1421 | |||
| 1407 | (defcustom org-remember-default-headline "" | 1422 | (defcustom org-remember-default-headline "" |
| 1408 | "The headline that should be the default location in the notes file. | 1423 | "The headline that should be the default location in the notes file. |
| 1409 | When filing remember notes, the cursor will start at that position. | 1424 | When filing remember notes, the cursor will start at that position. |
| @@ -1416,9 +1431,9 @@ You can set this on a per-template basis with the variable | |||
| 1416 | "Templates for the creation of remember buffers. | 1431 | "Templates for the creation of remember buffers. |
| 1417 | When nil, just let remember make the buffer. | 1432 | When nil, just let remember make the buffer. |
| 1418 | When not nil, this is a list of 5-element lists. In each entry, the first | 1433 | When not nil, this is a list of 5-element lists. In each entry, the first |
| 1419 | element is a the name of the template, It should be a single short word. | 1434 | element is the name of the template, which should be a single short word. |
| 1420 | The second element is a character, a unique key to select this template. | 1435 | The second element is a character, a unique key to select this template. |
| 1421 | The third element is the template. The forth element is optional and can | 1436 | The third element is the template. The fourth element is optional and can |
| 1422 | specify a destination file for remember items created with this template. | 1437 | specify a destination file for remember items created with this template. |
| 1423 | The default file is given by `org-default-notes-file'. An optional fifth | 1438 | The default file is given by `org-default-notes-file'. An optional fifth |
| 1424 | element can specify the headline in that file that should be offered | 1439 | element can specify the headline in that file that should be offered |
| @@ -1429,7 +1444,9 @@ The template specifies the structure of the remember buffer. It should have | |||
| 1429 | a first line starting with a star, to act as the org-mode headline. | 1444 | a first line starting with a star, to act as the org-mode headline. |
| 1430 | Furthermore, the following %-escapes will be replaced with content: | 1445 | Furthermore, the following %-escapes will be replaced with content: |
| 1431 | 1446 | ||
| 1432 | %^{prompt} prompt the user for a string and replace this sequence with it. | 1447 | %^{prompt} Prompt the user for a string and replace this sequence with it. |
| 1448 | A default value and a completion table ca be specified like this: | ||
| 1449 | %^{prompt|default|completion2|completion3|...} | ||
| 1433 | %t time stamp, date only | 1450 | %t time stamp, date only |
| 1434 | %T time stamp with date and time | 1451 | %T time stamp with date and time |
| 1435 | %u, %U like the above, but inactive time stamps | 1452 | %u, %U like the above, but inactive time stamps |
| @@ -1440,6 +1457,13 @@ Furthermore, the following %-escapes will be replaced with content: | |||
| 1440 | %i initial content, the region when remember is called with C-u. | 1457 | %i initial content, the region when remember is called with C-u. |
| 1441 | If %i is indented, the entire inserted text will be indented | 1458 | If %i is indented, the entire inserted text will be indented |
| 1442 | as well. | 1459 | as well. |
| 1460 | %c content of the clipboard, or current kill ring head | ||
| 1461 | %^g prompt for tags, with completion on tags in target file | ||
| 1462 | %^G prompt for tags, with completion all tags in all agenda files | ||
| 1463 | %:keyword specific information for certain link types, see below | ||
| 1464 | %[pathname] insert the contents of the file given by `pathname' | ||
| 1465 | %(sexp) evaluate elisp `(sexp)' and replace with the result | ||
| 1466 | %! Store this note immediately after filling the template | ||
| 1443 | 1467 | ||
| 1444 | %? After completing the template, position cursor here. | 1468 | %? After completing the template, position cursor here. |
| 1445 | 1469 | ||
| @@ -1483,7 +1507,9 @@ calendar | %:type %:date" | |||
| 1483 | 1507 | ||
| 1484 | (defcustom org-reverse-note-order nil | 1508 | (defcustom org-reverse-note-order nil |
| 1485 | "Non-nil means, store new notes at the beginning of a file or entry. | 1509 | "Non-nil means, store new notes at the beginning of a file or entry. |
| 1486 | When nil, new notes will be filed to the end of a file or entry." | 1510 | When nil, new notes will be filed to the end of a file or entry. |
| 1511 | This can also be a list with cons cells of regular expressions that | ||
| 1512 | are matched against file names, and values." | ||
| 1487 | :group 'org-remember | 1513 | :group 'org-remember |
| 1488 | :type '(choice | 1514 | :type '(choice |
| 1489 | (const :tag "Reverse always" t) | 1515 | (const :tag "Reverse always" t) |
| @@ -1491,6 +1517,51 @@ When nil, new notes will be filed to the end of a file or entry." | |||
| 1491 | (repeat :tag "By file name regexp" | 1517 | (repeat :tag "By file name regexp" |
| 1492 | (cons regexp boolean)))) | 1518 | (cons regexp boolean)))) |
| 1493 | 1519 | ||
| 1520 | (defcustom org-refile-targets nil | ||
| 1521 | "Targets for refiling entries with \\[org-refile]. | ||
| 1522 | This is list of cons cells. Each cell contains: | ||
| 1523 | - a specification of the files to be considered, either a list of files, | ||
| 1524 | or a symbol whose function or value fields will be used to retrieve | ||
| 1525 | a file name or a list of file names. Nil means, refile to a different | ||
| 1526 | heading in the current buffer. | ||
| 1527 | - A specification of how to find candidate refile targets. This may be | ||
| 1528 | any of | ||
| 1529 | - a cons cell (:tag . \"TAG\") to identify refile targets by a tag. | ||
| 1530 | This tag has to be present in all target headlines, inheritance will | ||
| 1531 | not be considered. | ||
| 1532 | - a cons cell (:todo . \"KEYWORD\") to identify refile targets by | ||
| 1533 | todo keyword. | ||
| 1534 | - a cons cell (:regexp . \"REGEXP\") with a regular expression matching | ||
| 1535 | headlines that are refiling targets. | ||
| 1536 | - a cons cell (:level . N). Any headline of level N is considered a target. | ||
| 1537 | - a cons cell (:maxlevel . N). Any headline with level <= N is a target." | ||
| 1538 | ;; FIXME: what if there are a var and func with same name??? | ||
| 1539 | :group 'org-remember | ||
| 1540 | :type '(repeat | ||
| 1541 | (cons | ||
| 1542 | (choice :value org-agenda-files | ||
| 1543 | (const :tag "All agenda files" org-agenda-files) | ||
| 1544 | (const :tag "Current buffer" nil) | ||
| 1545 | (function) (variable) (file)) | ||
| 1546 | (choice :tag "Identify target headline by" | ||
| 1547 | (cons :tag "Specific tag" (const :tag) (string)) | ||
| 1548 | (cons :tag "TODO keyword" (const :todo) (string)) | ||
| 1549 | (cons :tag "Regular expression" (const :regexp) (regexp)) | ||
| 1550 | (cons :tag "Level number" (const :level) (integer)) | ||
| 1551 | (cons :tag "Max Level number" (const :maxlevel) (integer)))))) | ||
| 1552 | |||
| 1553 | (defcustom org-refile-use-outline-path nil | ||
| 1554 | "Non-nil means, provide refile targets as paths. | ||
| 1555 | So a level 3 headline will be available as level1/level2/level3. | ||
| 1556 | When the value is `file', also include the file name (without directory) | ||
| 1557 | into the path. When `full-file-path', include the full file path." | ||
| 1558 | :group 'org-remember | ||
| 1559 | :type '(choice | ||
| 1560 | (const :tag "Not" nil) | ||
| 1561 | (const :tag "Yes" t) | ||
| 1562 | (const :tag "Start with file name" file) | ||
| 1563 | (const :tag "Start with full file path" full-file-path))) | ||
| 1564 | |||
| 1494 | (defgroup org-todo nil | 1565 | (defgroup org-todo nil |
| 1495 | "Options concerning TODO items in Org-mode." | 1566 | "Options concerning TODO items in Org-mode." |
| 1496 | :tag "Org TODO" | 1567 | :tag "Org TODO" |
| @@ -1712,6 +1783,15 @@ Nil means, clock will keep running until stopped explicitly with | |||
| 1712 | :group 'org-progress | 1783 | :group 'org-progress |
| 1713 | :type 'boolean) | 1784 | :type 'boolean) |
| 1714 | 1785 | ||
| 1786 | (defcustom org-clock-in-switch-to-state nil | ||
| 1787 | "Set task to a special todo state while clocking it. | ||
| 1788 | The value should be the state to which the entry should be switched." | ||
| 1789 | :group 'org-progress | ||
| 1790 | :group 'org-todo | ||
| 1791 | :type '(choice | ||
| 1792 | (const :tag "Don't force a state" nil) | ||
| 1793 | (string :tag "State"))) | ||
| 1794 | |||
| 1715 | (defgroup org-priorities nil | 1795 | (defgroup org-priorities nil |
| 1716 | "Priorities in Org-mode." | 1796 | "Priorities in Org-mode." |
| 1717 | :tag "Org Priorities" | 1797 | :tag "Org Priorities" |
| @@ -1795,13 +1875,52 @@ end of the second format." | |||
| 1795 | (concat "[" (substring f 1 -1) "]") | 1875 | (concat "[" (substring f 1 -1) "]") |
| 1796 | f))) | 1876 | f))) |
| 1797 | 1877 | ||
| 1798 | (defcustom org-popup-calendar-for-date-prompt t | 1878 | (defcustom org-read-date-prefer-future t |
| 1879 | "Non-nil means, assume future for incomplete date input from user. | ||
| 1880 | This affects the following situations: | ||
| 1881 | 1. The user gives a day, but no month. | ||
| 1882 | For example, if today is the 15th, and you enter \"3\", Org-mode will | ||
| 1883 | read this as the third of *next* month. However, if you enter \"17\", | ||
| 1884 | it will be considered as *this* month. | ||
| 1885 | 2. The user gives a month but not a year. | ||
| 1886 | For example, if it is april and you enter \"feb 2\", this will be read | ||
| 1887 | as feb 2, *next* year. \"May 5\", however, will be this year. | ||
| 1888 | |||
| 1889 | When this option is nil, the current month and year will always be used | ||
| 1890 | as defaults." | ||
| 1891 | :group 'org-time | ||
| 1892 | :type 'boolean) | ||
| 1893 | |||
| 1894 | (defcustom org-read-date-display-live t | ||
| 1895 | "Non-nil means, display current interpretation of date prompt live. | ||
| 1896 | This display will be in an overlay, in the minibuffer." | ||
| 1897 | :group 'org-time | ||
| 1898 | :type 'boolean) | ||
| 1899 | |||
| 1900 | (defcustom org-read-date-popup-calendar t | ||
| 1799 | "Non-nil means, pop up a calendar when prompting for a date. | 1901 | "Non-nil means, pop up a calendar when prompting for a date. |
| 1800 | In the calendar, the date can be selected with mouse-1. However, the | 1902 | In the calendar, the date can be selected with mouse-1. However, the |
| 1801 | minibuffer will also be active, and you can simply enter the date as well. | 1903 | minibuffer will also be active, and you can simply enter the date as well. |
| 1802 | When nil, only the minibuffer will be available." | 1904 | When nil, only the minibuffer will be available." |
| 1803 | :group 'org-time | 1905 | :group 'org-time |
| 1804 | :type 'boolean) | 1906 | :type 'boolean) |
| 1907 | (if (fboundp 'defvaralias) | ||
| 1908 | (defvaralias 'org-popup-calendar-for-date-prompt | ||
| 1909 | 'org-read-date-popup-calendar)) | ||
| 1910 | |||
| 1911 | (defcustom org-extend-today-until 0 | ||
| 1912 | "The hour when your day really ends. | ||
| 1913 | This has influence for the following applications: | ||
| 1914 | - When switching the agenda to \"today\". It it is still earlier than | ||
| 1915 | the time given here, the day recognized as TODAY is actually yesterday. | ||
| 1916 | - When a date is read from the user and it is still before the time given | ||
| 1917 | here, the current date and time will be assumed to be yesterday, 23:59. | ||
| 1918 | |||
| 1919 | FIXME: | ||
| 1920 | IMPORTANT: This is still a very experimental feature, it may disappear | ||
| 1921 | again or it may be extended to mean more things." | ||
| 1922 | :group 'org-time | ||
| 1923 | :type 'number) | ||
| 1805 | 1924 | ||
| 1806 | (defcustom org-edit-timestamp-down-means-later nil | 1925 | (defcustom org-edit-timestamp-down-means-later nil |
| 1807 | "Non-nil means, S-down will increase the time in a time stamp. | 1926 | "Non-nil means, S-down will increase the time in a time stamp. |
| @@ -1816,6 +1935,13 @@ moved to the new date." | |||
| 1816 | :group 'org-time | 1935 | :group 'org-time |
| 1817 | :type 'boolean) | 1936 | :type 'boolean) |
| 1818 | 1937 | ||
| 1938 | (defcustom org-clock-heading-function nil | ||
| 1939 | "When non-nil, should be a function to create `org-clock-heading'. | ||
| 1940 | This is the string shown in the mode line when a clock is running. | ||
| 1941 | The function is called with point at the beginning of the headline." | ||
| 1942 | :group 'org-time ; FIXME: Should we have a separate group???? | ||
| 1943 | :type 'function) | ||
| 1944 | |||
| 1819 | (defgroup org-tags nil | 1945 | (defgroup org-tags nil |
| 1820 | "Options concerning tags in Org-mode." | 1946 | "Options concerning tags in Org-mode." |
| 1821 | :tag "Org Tags" | 1947 | :tag "Org Tags" |
| @@ -1929,16 +2055,23 @@ lined-up with respect to each other." | |||
| 1929 | 2055 | ||
| 1930 | (defcustom org-use-property-inheritance nil | 2056 | (defcustom org-use-property-inheritance nil |
| 1931 | "Non-nil means, properties apply also for sublevels. | 2057 | "Non-nil means, properties apply also for sublevels. |
| 1932 | This can cause significant overhead when doing a search, so this is turned | 2058 | This setting is only relevant during property searches, not when querying |
| 1933 | off by default. | 2059 | an entry with `org-entry-get'. To retrieve a property with inheritance, |
| 2060 | you need to call `org-entry-get' with the inheritance flag. | ||
| 2061 | Turning this on can cause significant overhead when doing a search, so | ||
| 2062 | this is turned off by default. | ||
| 1934 | When nil, only the properties directly given in the current entry count. | 2063 | When nil, only the properties directly given in the current entry count. |
| 2064 | The value may also be a list of properties that shouldhave inheritance. | ||
| 1935 | 2065 | ||
| 1936 | However, note that some special properties use inheritance under special | 2066 | However, note that some special properties use inheritance under special |
| 1937 | circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS, | 2067 | circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS, |
| 1938 | and the properties ending in \"_ALL\" when they are used as descriptor | 2068 | and the properties ending in \"_ALL\" when they are used as descriptor |
| 1939 | for valid values of a property." | 2069 | for valid values of a property." |
| 1940 | :group 'org-properties | 2070 | :group 'org-properties |
| 1941 | :type 'boolean) | 2071 | :type '(choice |
| 2072 | (const :tag "Not" nil) | ||
| 2073 | (const :tag "Always" nil) | ||
| 2074 | (repeat :tag "Specific properties" (string :tag "Property")))) | ||
| 1942 | 2075 | ||
| 1943 | (defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS" | 2076 | (defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS" |
| 1944 | "The default column format, if no other format has been defined. | 2077 | "The default column format, if no other format has been defined. |
| @@ -1998,7 +2131,7 @@ agenda file per line." | |||
| 1998 | (repeat :tag "List of files and directories" file) | 2131 | (repeat :tag "List of files and directories" file) |
| 1999 | (file :tag "Store list in a file\n" :value "~/.agenda_files"))) | 2132 | (file :tag "Store list in a file\n" :value "~/.agenda_files"))) |
| 2000 | 2133 | ||
| 2001 | (defcustom org-agenda-file-regexp "\\.org\\'" | 2134 | (defcustom org-agenda-file-regexp "\\`[^.].*\\.org\\'" |
| 2002 | "Regular expression to match files for `org-agenda-files'. | 2135 | "Regular expression to match files for `org-agenda-files'. |
| 2003 | If any element in the list in that variable contains a directory instead | 2136 | If any element in the list in that variable contains a directory instead |
| 2004 | of a normal file, all files in that directory that are matched by this | 2137 | of a normal file, all files in that directory that are matched by this |
| @@ -2318,6 +2451,11 @@ deadlines are always turned off when the item is DONE." | |||
| 2318 | :group 'org-agenda-skip | 2451 | :group 'org-agenda-skip |
| 2319 | :type 'boolean) | 2452 | :type 'boolean) |
| 2320 | 2453 | ||
| 2454 | (defcustom org-agenda-skip-timestamp-if-done nil | ||
| 2455 | "Non-nil means don't select item by timestamp or -range if it is DONE." | ||
| 2456 | :group 'org-agenda-skip | ||
| 2457 | :type 'boolean) | ||
| 2458 | |||
| 2321 | (defcustom org-timeline-show-empty-dates 3 | 2459 | (defcustom org-timeline-show-empty-dates 3 |
| 2322 | "Non-nil means, `org-timeline' also shows dates without an entry. | 2460 | "Non-nil means, `org-timeline' also shows dates without an entry. |
| 2323 | When nil, only the days which actually have entries are shown. | 2461 | When nil, only the days which actually have entries are shown. |
| @@ -2400,7 +2538,9 @@ Valid values are: | |||
| 2400 | current-window Display in the current window | 2538 | current-window Display in the current window |
| 2401 | other-window Just display in another window. | 2539 | other-window Just display in another window. |
| 2402 | dedicated-frame Create one new frame, and re-use it each time. | 2540 | dedicated-frame Create one new frame, and re-use it each time. |
| 2403 | new-frame Make a new frame each time." | 2541 | new-frame Make a new frame each time. Note that in this case |
| 2542 | previously-made indirect buffers are kept, and you need to | ||
| 2543 | kill these buffers yourself." | ||
| 2404 | :group 'org-structure | 2544 | :group 'org-structure |
| 2405 | :group 'org-agenda-windows | 2545 | :group 'org-agenda-windows |
| 2406 | :type '(choice | 2546 | :type '(choice |
| @@ -2542,18 +2682,19 @@ a grid line." | |||
| 2542 | :tag "Org Agenda Sorting" | 2682 | :tag "Org Agenda Sorting" |
| 2543 | :group 'org-agenda) | 2683 | :group 'org-agenda) |
| 2544 | 2684 | ||
| 2545 | (let ((sorting-choice | 2685 | (defconst org-sorting-choice |
| 2546 | '(choice | 2686 | '(choice |
| 2547 | (const time-up) (const time-down) | 2687 | (const time-up) (const time-down) |
| 2548 | (const category-keep) (const category-up) (const category-down) | 2688 | (const category-keep) (const category-up) (const category-down) |
| 2549 | (const tag-down) (const tag-up) | 2689 | (const tag-down) (const tag-up) |
| 2550 | (const priority-up) (const priority-down)))) | 2690 | (const priority-up) (const priority-down)) |
| 2551 | 2691 | "Sorting choices.") | |
| 2552 | (defcustom org-agenda-sorting-strategy | 2692 | |
| 2553 | '((agenda time-up category-keep priority-down) | 2693 | (defcustom org-agenda-sorting-strategy |
| 2554 | (todo category-keep priority-down) | 2694 | '((agenda time-up category-keep priority-down) |
| 2555 | (tags category-keep priority-down)) | 2695 | (todo category-keep priority-down) |
| 2556 | "Sorting structure for the agenda items of a single day. | 2696 | (tags category-keep priority-down)) |
| 2697 | "Sorting structure for the agenda items of a single day. | ||
| 2557 | This is a list of symbols which will be used in sequence to determine | 2698 | This is a list of symbols which will be used in sequence to determine |
| 2558 | if an entry should be listed before another entry. The following | 2699 | if an entry should be listed before another entry. The following |
| 2559 | symbols are recognized: | 2700 | symbols are recognized: |
| @@ -2580,17 +2721,21 @@ the sequence given in `org-agenda-files'. Within each category sort by | |||
| 2580 | priority. | 2721 | priority. |
| 2581 | 2722 | ||
| 2582 | Leaving out `category-keep' would mean that items will be sorted across | 2723 | Leaving out `category-keep' would mean that items will be sorted across |
| 2583 | categories by priority." | 2724 | categories by priority. |
| 2725 | |||
| 2726 | Instead of a single list, this can also be a set of list for specific | ||
| 2727 | contents, with a context symbol in the car of the list, any of | ||
| 2728 | `agenda', `todo', `tags' for the corresponding agenda views." | ||
| 2584 | :group 'org-agenda-sorting | 2729 | :group 'org-agenda-sorting |
| 2585 | :type `(choice | 2730 | :type `(choice |
| 2586 | (repeat :tag "General" ,sorting-choice) | 2731 | (repeat :tag "General" ,org-sorting-choice) |
| 2587 | (list :tag "Individually" | 2732 | (list :tag "Individually" |
| 2588 | (cons (const :tag "Strategy for Weekly/Daily agenda" agenda) | 2733 | (cons (const :tag "Strategy for Weekly/Daily agenda" agenda) |
| 2589 | (repeat ,sorting-choice)) | 2734 | (repeat ,org-sorting-choice)) |
| 2590 | (cons (const :tag "Strategy for TODO lists" todo) | 2735 | (cons (const :tag "Strategy for TODO lists" todo) |
| 2591 | (repeat ,sorting-choice)) | 2736 | (repeat ,org-sorting-choice)) |
| 2592 | (cons (const :tag "Strategy for Tags matches" tags) | 2737 | (cons (const :tag "Strategy for Tags matches" tags) |
| 2593 | (repeat ,sorting-choice)))))) | 2738 | (repeat ,org-sorting-choice))))) |
| 2594 | 2739 | ||
| 2595 | (defcustom org-sort-agenda-notime-is-late t | 2740 | (defcustom org-sort-agenda-notime-is-late t |
| 2596 | "Non-nil means, items without time are considered late. | 2741 | "Non-nil means, items without time are considered late. |
| @@ -2673,9 +2818,16 @@ See also the variables `org-agenda-remove-times-when-in-prefix' and | |||
| 2673 | "The compiled version of the most recently used prefix format. | 2818 | "The compiled version of the most recently used prefix format. |
| 2674 | See the variable `org-agenda-prefix-format'.") | 2819 | See the variable `org-agenda-prefix-format'.") |
| 2675 | 2820 | ||
| 2821 | (defcustom org-agenda-todo-keyword-format "%-1s" | ||
| 2822 | "Format for the TODO keyword in agenda lines. | ||
| 2823 | Set this to something like \"%-12s\" if you want all TODO keywords | ||
| 2824 | to occupy a fixed space in the agenda display." | ||
| 2825 | :group 'org-agenda-line-format | ||
| 2826 | :type 'string) | ||
| 2827 | |||
| 2676 | (defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") | 2828 | (defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") |
| 2677 | "Text preceeding scheduled items in the agenda view. | 2829 | "Text preceeding scheduled items in the agenda view. |
| 2678 | THis is a list with two strings. The first applies when the item is | 2830 | This is a list with two strings. The first applies when the item is |
| 2679 | scheduled on the current day. The second applies when it has been scheduled | 2831 | scheduled on the current day. The second applies when it has been scheduled |
| 2680 | previously, it may contain a %d to capture how many days ago the item was | 2832 | previously, it may contain a %d to capture how many days ago the item was |
| 2681 | scheduled." | 2833 | scheduled." |
| @@ -2811,23 +2963,23 @@ This is a property list with the following properties: | |||
| 2811 | :tag "Org Export General" | 2963 | :tag "Org Export General" |
| 2812 | :group 'org-export) | 2964 | :group 'org-export) |
| 2813 | 2965 | ||
| 2814 | (defcustom org-export-publishing-directory "." | 2966 | ;; FIXME |
| 2815 | "Path to the location where exported files should be located. | 2967 | (defvar org-export-publishing-directory nil) |
| 2816 | This path may be relative to the directory where the Org-mode file lives. | 2968 | |
| 2817 | The default is to put them into the same directory as the Org-mode file. | 2969 | (defcustom org-export-with-special-strings t |
| 2818 | The variable may also be an alist with export types `:html', `:ascii', | 2970 | "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export. |
| 2819 | `:ical', `:LaTeX', or `:xoxo' and the corresponding directories. | 2971 | When this option is turned on, these strings will be exported as: |
| 2820 | If a directory path is relative, it is interpreted relative to the | 2972 | |
| 2821 | directory where the exported Org-mode files lives." | 2973 | Org HTML LaTeX |
| 2822 | :group 'org-export-general | 2974 | -----+----------+-------- |
| 2823 | :type '(choice | 2975 | \\- ­ \\- |
| 2824 | (directory) | 2976 | -- – -- |
| 2825 | (repeat | 2977 | --- — --- |
| 2826 | (cons | 2978 | ... … \ldots |
| 2827 | (choice :tag "Type" | 2979 | |
| 2828 | (const :html) (const :LaTeX) | 2980 | This option can also be set with the +OPTIONS line, e.g. \"-:nil\"." |
| 2829 | (const :ascii) (const :ical) (const :xoxo)) | 2981 | :group 'org-export-translation |
| 2830 | (directory))))) | 2982 | :type 'boolean) |
| 2831 | 2983 | ||
| 2832 | (defcustom org-export-language-setup | 2984 | (defcustom org-export-language-setup |
| 2833 | '(("en" "Author" "Date" "Table of Contents") | 2985 | '(("en" "Author" "Date" "Table of Contents") |
| @@ -3032,6 +3184,20 @@ This option can also be set with the +OPTIONS line, e.g. \"^:nil\"." | |||
| 3032 | (const :tag "Only with braces" {}) | 3184 | (const :tag "Only with braces" {}) |
| 3033 | (const :tag "Never interpret" nil))) | 3185 | (const :tag "Never interpret" nil))) |
| 3034 | 3186 | ||
| 3187 | (defcustom org-export-with-special-strings t | ||
| 3188 | "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export. | ||
| 3189 | When this option is turned on, these strings will be exported as: | ||
| 3190 | |||
| 3191 | \\- : ­ | ||
| 3192 | -- : – | ||
| 3193 | --- : — | ||
| 3194 | |||
| 3195 | Not all export backends support this, but HTML does. | ||
| 3196 | |||
| 3197 | This option can also be set with the +OPTIONS line, e.g. \"-:nil\"." | ||
| 3198 | :group 'org-export-translation | ||
| 3199 | :type 'boolean) | ||
| 3200 | |||
| 3035 | (defcustom org-export-with-TeX-macros t | 3201 | (defcustom org-export-with-TeX-macros t |
| 3036 | "Non-nil means, interpret simple TeX-like macros when exporting. | 3202 | "Non-nil means, interpret simple TeX-like macros when exporting. |
| 3037 | For example, HTML export converts \\alpha to α and \\AA to Å. | 3203 | For example, HTML export converts \\alpha to α and \\AA to Å. |
| @@ -3138,7 +3304,7 @@ In the given sequence, these characters will be used for level 1, 2, ..." | |||
| 3138 | 3304 | ||
| 3139 | (defcustom org-export-ascii-bullets '(?* ?+ ?-) | 3305 | (defcustom org-export-ascii-bullets '(?* ?+ ?-) |
| 3140 | "Bullet characters for headlines converted to lists in ASCII export. | 3306 | "Bullet characters for headlines converted to lists in ASCII export. |
| 3141 | The first character is is used for the first lest level generated in this | 3307 | The first character is used for the first lest level generated in this |
| 3142 | way, and so on. If there are more levels than characters given here, | 3308 | way, and so on. If there are more levels than characters given here, |
| 3143 | the list will be repeated. | 3309 | the list will be repeated. |
| 3144 | Note that plain lists will keep the same bullets as the have in the | 3310 | Note that plain lists will keep the same bullets as the have in the |
| @@ -3377,8 +3543,20 @@ Changing this variable requires a restart of Emacs to take effect." | |||
| 3377 | :group 'org-font-lock | 3543 | :group 'org-font-lock |
| 3378 | :type 'boolean) | 3544 | :type 'boolean) |
| 3379 | 3545 | ||
| 3546 | (defcustom org-highlight-latex-fragments-and-specials nil | ||
| 3547 | "Non-nil means, fontify what is treated specially by the exporters." | ||
| 3548 | :group 'org-font-lock | ||
| 3549 | :type 'boolean) | ||
| 3550 | |||
| 3551 | (defcustom org-hide-emphasis-markers nil | ||
| 3552 | "Non-nil mean font-lock should hide the emphasis marker characters." | ||
| 3553 | :group 'org-font-lock | ||
| 3554 | :type 'boolean) | ||
| 3555 | |||
| 3380 | (defvar org-emph-re nil | 3556 | (defvar org-emph-re nil |
| 3381 | "Regular expression for matching emphasis.") | 3557 | "Regular expression for matching emphasis.") |
| 3558 | (defvar org-verbatim-re nil | ||
| 3559 | "Regular expression for matching verbatim text.") | ||
| 3382 | (defvar org-emphasis-regexp-components) ; defined just below | 3560 | (defvar org-emphasis-regexp-components) ; defined just below |
| 3383 | (defvar org-emphasis-alist) ; defined just below | 3561 | (defvar org-emphasis-alist) ; defined just below |
| 3384 | (defun org-set-emph-re (var val) | 3562 | (defun org-set-emph-re (var val) |
| @@ -3393,33 +3571,53 @@ Changing this variable requires a restart of Emacs to take effect." | |||
| 3393 | (border (nth 2 e)) | 3571 | (border (nth 2 e)) |
| 3394 | (body (nth 3 e)) | 3572 | (body (nth 3 e)) |
| 3395 | (nl (nth 4 e)) | 3573 | (nl (nth 4 e)) |
| 3396 | (stacked (nth 5 e)) | 3574 | (stacked (and nil (nth 5 e))) ; stacked is no longer allowed, forced to nil |
| 3397 | (body1 (concat body "*?")) | 3575 | (body1 (concat body "*?")) |
| 3398 | (markers (mapconcat 'car org-emphasis-alist ""))) | 3576 | (markers (mapconcat 'car org-emphasis-alist "")) |
| 3577 | (vmarkers (mapconcat | ||
| 3578 | (lambda (x) (if (eq (nth 4 x) 'verbatim) (car x) "")) | ||
| 3579 | org-emphasis-alist ""))) | ||
| 3399 | ;; make sure special characters appear at the right position in the class | 3580 | ;; make sure special characters appear at the right position in the class |
| 3400 | (if (string-match "\\^" markers) | 3581 | (if (string-match "\\^" markers) |
| 3401 | (setq markers (concat (replace-match "" t t markers) "^"))) | 3582 | (setq markers (concat (replace-match "" t t markers) "^"))) |
| 3402 | (if (string-match "-" markers) | 3583 | (if (string-match "-" markers) |
| 3403 | (setq markers (concat (replace-match "" t t markers) "-"))) | 3584 | (setq markers (concat (replace-match "" t t markers) "-"))) |
| 3585 | (if (string-match "\\^" vmarkers) | ||
| 3586 | (setq vmarkers (concat (replace-match "" t t vmarkers) "^"))) | ||
| 3587 | (if (string-match "-" vmarkers) | ||
| 3588 | (setq vmarkers (concat (replace-match "" t t vmarkers) "-"))) | ||
| 3404 | (if (> nl 0) | 3589 | (if (> nl 0) |
| 3405 | (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0," | 3590 | (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0," |
| 3406 | (int-to-string nl) "\\}"))) | 3591 | (int-to-string nl) "\\}"))) |
| 3407 | ;; Make the regexp | 3592 | ;; Make the regexp |
| 3408 | (setq org-emph-re | 3593 | (setq org-emph-re |
| 3409 | (concat "\\([" pre (if stacked markers) "]\\|^\\)" | 3594 | (concat "\\([" pre (if (and nil stacked) markers) "]\\|^\\)" |
| 3410 | "\\(" | 3595 | "\\(" |
| 3411 | "\\([" markers "]\\)" | 3596 | "\\([" markers "]\\)" |
| 3412 | "\\(" | 3597 | "\\(" |
| 3598 | "[^" border "]\\|" | ||
| 3413 | "[^" border (if (and nil stacked) markers) "]" | 3599 | "[^" border (if (and nil stacked) markers) "]" |
| 3414 | body1 | 3600 | body1 |
| 3415 | "[^" border (if (and nil stacked) markers) "]" | 3601 | "[^" border (if (and nil stacked) markers) "]" |
| 3416 | "\\)" | 3602 | "\\)" |
| 3417 | "\\3\\)" | 3603 | "\\3\\)" |
| 3418 | "\\([" post (if stacked markers) "]\\|$\\)"))))) | 3604 | "\\([" post (if (and nil stacked) markers) "]\\|$\\)")) |
| 3605 | (setq org-verbatim-re | ||
| 3606 | (concat "\\([" pre "]\\|^\\)" | ||
| 3607 | "\\(" | ||
| 3608 | "\\([" vmarkers "]\\)" | ||
| 3609 | "\\(" | ||
| 3610 | "[^" border "]\\|" | ||
| 3611 | "[^" border "]" | ||
| 3612 | body1 | ||
| 3613 | "[^" border "]" | ||
| 3614 | "\\)" | ||
| 3615 | "\\3\\)" | ||
| 3616 | "\\([" post "]\\|$\\)"))))) | ||
| 3419 | 3617 | ||
| 3420 | (defcustom org-emphasis-regexp-components | 3618 | (defcustom org-emphasis-regexp-components |
| 3421 | '(" \t('\"" "- \t.,:?;'\")" " \t\r\n,\"'" "." 1 nil) | 3619 | '(" \t('\"" "- \t.,:?;'\")" " \t\r\n,\"'" "." 1) |
| 3422 | "Components used to build the reqular expression for emphasis. | 3620 | "Components used to build the regular expression for emphasis. |
| 3423 | This is a list with 6 entries. Terminology: In an emphasis string | 3621 | This is a list with 6 entries. Terminology: In an emphasis string |
| 3424 | like \" *strong word* \", we call the initial space PREMATCH, the final | 3622 | like \" *strong word* \", we call the initial space PREMATCH, the final |
| 3425 | space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters | 3623 | space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters |
| @@ -3432,10 +3630,7 @@ border The chars *forbidden* as border characters. | |||
| 3432 | body-regexp A regexp like \".\" to match a body character. Don't use | 3630 | body-regexp A regexp like \".\" to match a body character. Don't use |
| 3433 | non-shy groups here, and don't allow newline here. | 3631 | non-shy groups here, and don't allow newline here. |
| 3434 | newline The maximum number of newlines allowed in an emphasis exp. | 3632 | newline The maximum number of newlines allowed in an emphasis exp. |
| 3435 | stacked Non-nil means, allow stacked styles. This works only in HTML | 3633 | |
| 3436 | export. When this is set, all marker characters (as given in | ||
| 3437 | `org-emphasis-alist') will be allowed as pre/post, aiding | ||
| 3438 | inside-out matching. | ||
| 3439 | Use customize to modify this, or restart Emacs after changing it." | 3634 | Use customize to modify this, or restart Emacs after changing it." |
| 3440 | :group 'org-font-lock | 3635 | :group 'org-font-lock |
| 3441 | :set 'org-set-emph-re | 3636 | :set 'org-set-emph-re |
| @@ -3445,16 +3640,17 @@ Use customize to modify this, or restart Emacs after changing it." | |||
| 3445 | (sexp :tag "Forbidden chars in border ") | 3640 | (sexp :tag "Forbidden chars in border ") |
| 3446 | (sexp :tag "Regexp for body ") | 3641 | (sexp :tag "Regexp for body ") |
| 3447 | (integer :tag "number of newlines allowed") | 3642 | (integer :tag "number of newlines allowed") |
| 3448 | (boolean :tag "Stacking allowed "))) | 3643 | (option (boolean :tag "Stacking (DISABLED) ")))) |
| 3449 | 3644 | ||
| 3450 | (defcustom org-emphasis-alist | 3645 | (defcustom org-emphasis-alist |
| 3451 | '(("*" bold "<b>" "</b>") | 3646 | '(("*" bold "<b>" "</b>") |
| 3452 | ("/" italic "<i>" "</i>") | 3647 | ("/" italic "<i>" "</i>") |
| 3453 | ("_" underline "<u>" "</u>") | 3648 | ("_" underline "<u>" "</u>") |
| 3454 | ("=" org-code "<code>" "</code>") | 3649 | ("=" org-code "<code>" "</code>" verbatim) |
| 3650 | ("~" org-verbatim "" "" verbatim) | ||
| 3455 | ("+" (:strike-through t) "<del>" "</del>") | 3651 | ("+" (:strike-through t) "<del>" "</del>") |
| 3456 | ) | 3652 | ) |
| 3457 | "Special syntax for emphasized text. | 3653 | "Special syntax for emphasized text. |
| 3458 | Text starting and ending with a special character will be emphasized, for | 3654 | Text starting and ending with a special character will be emphasized, for |
| 3459 | example *bold*, _underlined_ and /italic/. This variable sets the marker | 3655 | example *bold*, _underlined_ and /italic/. This variable sets the marker |
| 3460 | characters, the face to be used by font-lock for highlighting in Org-mode | 3656 | characters, the face to be used by font-lock for highlighting in Org-mode |
| @@ -3469,7 +3665,8 @@ Use customize to modify this, or restart Emacs after changing it." | |||
| 3469 | (face :tag "Font-lock-face") | 3665 | (face :tag "Font-lock-face") |
| 3470 | (plist :tag "Face property list")) | 3666 | (plist :tag "Face property list")) |
| 3471 | (string :tag "HTML start tag") | 3667 | (string :tag "HTML start tag") |
| 3472 | (string :tag "HTML end tag")))) | 3668 | (string :tag "HTML end tag") |
| 3669 | (option (const verbatim))))) | ||
| 3473 | 3670 | ||
| 3474 | ;;; The faces | 3671 | ;;; The faces |
| 3475 | 3672 | ||
| @@ -3508,6 +3705,7 @@ any other entries, and any resulting duplicates will be removed entirely." | |||
| 3508 | (t (or (assoc (car e) r) (push e r))))) | 3705 | (t (or (assoc (car e) r) (push e r))))) |
| 3509 | (nreverse r))) | 3706 | (nreverse r))) |
| 3510 | (t specs))) | 3707 | (t specs))) |
| 3708 | (put 'org-compatible-face 'lisp-indent-function 1) | ||
| 3511 | 3709 | ||
| 3512 | (defface org-hide | 3710 | (defface org-hide |
| 3513 | '((((background light)) (:foreground "white")) | 3711 | '((((background light)) (:foreground "white")) |
| @@ -3518,108 +3716,98 @@ color of the frame." | |||
| 3518 | :group 'org-faces) | 3716 | :group 'org-faces) |
| 3519 | 3717 | ||
| 3520 | (defface org-level-1 ;; font-lock-function-name-face | 3718 | (defface org-level-1 ;; font-lock-function-name-face |
| 3521 | (org-compatible-face | 3719 | (org-compatible-face 'outline-1 |
| 3522 | 'outline-1 | 3720 | '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) |
| 3523 | '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) | 3721 | (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) |
| 3524 | (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) | 3722 | (((class color) (min-colors 16) (background light)) (:foreground "Blue")) |
| 3525 | (((class color) (min-colors 16) (background light)) (:foreground "Blue")) | 3723 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) |
| 3526 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) | 3724 | (((class color) (min-colors 8)) (:foreground "blue" :bold t)) |
| 3527 | (((class color) (min-colors 8)) (:foreground "blue" :bold t)) | 3725 | (t (:bold t)))) |
| 3528 | (t (:bold t)))) | ||
| 3529 | "Face used for level 1 headlines." | 3726 | "Face used for level 1 headlines." |
| 3530 | :group 'org-faces) | 3727 | :group 'org-faces) |
| 3531 | 3728 | ||
| 3532 | (defface org-level-2 ;; font-lock-variable-name-face | 3729 | (defface org-level-2 ;; font-lock-variable-name-face |
| 3533 | (org-compatible-face | 3730 | (org-compatible-face 'outline-2 |
| 3534 | 'outline-2 | 3731 | '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) |
| 3535 | '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) | 3732 | (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) |
| 3536 | (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) | 3733 | (((class color) (min-colors 8) (background light)) (:foreground "yellow")) |
| 3537 | (((class color) (min-colors 8) (background light)) (:foreground "yellow")) | 3734 | (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t)) |
| 3538 | (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t)) | 3735 | (t (:bold t)))) |
| 3539 | (t (:bold t)))) | ||
| 3540 | "Face used for level 2 headlines." | 3736 | "Face used for level 2 headlines." |
| 3541 | :group 'org-faces) | 3737 | :group 'org-faces) |
| 3542 | 3738 | ||
| 3543 | (defface org-level-3 ;; font-lock-keyword-face | 3739 | (defface org-level-3 ;; font-lock-keyword-face |
| 3544 | (org-compatible-face | 3740 | (org-compatible-face 'outline-3 |
| 3545 | 'outline-3 | 3741 | '((((class color) (min-colors 88) (background light)) (:foreground "Purple")) |
| 3546 | '((((class color) (min-colors 88) (background light)) (:foreground "Purple")) | 3742 | (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) |
| 3547 | (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) | 3743 | (((class color) (min-colors 16) (background light)) (:foreground "Purple")) |
| 3548 | (((class color) (min-colors 16) (background light)) (:foreground "Purple")) | 3744 | (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) |
| 3549 | (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) | 3745 | (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t)) |
| 3550 | (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t)) | 3746 | (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t)) |
| 3551 | (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t)) | 3747 | (t (:bold t)))) |
| 3552 | (t (:bold t)))) | ||
| 3553 | "Face used for level 3 headlines." | 3748 | "Face used for level 3 headlines." |
| 3554 | :group 'org-faces) | 3749 | :group 'org-faces) |
| 3555 | 3750 | ||
| 3556 | (defface org-level-4 ;; font-lock-comment-face | 3751 | (defface org-level-4 ;; font-lock-comment-face |
| 3557 | (org-compatible-face | 3752 | (org-compatible-face 'outline-4 |
| 3558 | 'outline-4 | 3753 | '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) |
| 3559 | '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) | 3754 | (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) |
| 3560 | (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) | 3755 | (((class color) (min-colors 16) (background light)) (:foreground "red")) |
| 3561 | (((class color) (min-colors 16) (background light)) (:foreground "red")) | 3756 | (((class color) (min-colors 16) (background dark)) (:foreground "red1")) |
| 3562 | (((class color) (min-colors 16) (background dark)) (:foreground "red1")) | 3757 | (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) |
| 3563 | (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) | 3758 | (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) |
| 3564 | (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) | 3759 | (t (:bold t)))) |
| 3565 | (t (:bold t)))) | ||
| 3566 | "Face used for level 4 headlines." | 3760 | "Face used for level 4 headlines." |
| 3567 | :group 'org-faces) | 3761 | :group 'org-faces) |
| 3568 | 3762 | ||
| 3569 | (defface org-level-5 ;; font-lock-type-face | 3763 | (defface org-level-5 ;; font-lock-type-face |
| 3570 | (org-compatible-face | 3764 | (org-compatible-face 'outline-5 |
| 3571 | 'outline-5 | 3765 | '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) |
| 3572 | '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) | 3766 | (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) |
| 3573 | (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) | 3767 | (((class color) (min-colors 8)) (:foreground "green")))) |
| 3574 | (((class color) (min-colors 8)) (:foreground "green")))) | ||
| 3575 | "Face used for level 5 headlines." | 3768 | "Face used for level 5 headlines." |
| 3576 | :group 'org-faces) | 3769 | :group 'org-faces) |
| 3577 | 3770 | ||
| 3578 | (defface org-level-6 ;; font-lock-constant-face | 3771 | (defface org-level-6 ;; font-lock-constant-face |
| 3579 | (org-compatible-face | 3772 | (org-compatible-face 'outline-6 |
| 3580 | 'outline-6 | 3773 | '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) |
| 3581 | '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) | 3774 | (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) |
| 3582 | (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) | 3775 | (((class color) (min-colors 8)) (:foreground "magenta")))) |
| 3583 | (((class color) (min-colors 8)) (:foreground "magenta")))) | ||
| 3584 | "Face used for level 6 headlines." | 3776 | "Face used for level 6 headlines." |
| 3585 | :group 'org-faces) | 3777 | :group 'org-faces) |
| 3586 | 3778 | ||
| 3587 | (defface org-level-7 ;; font-lock-builtin-face | 3779 | (defface org-level-7 ;; font-lock-builtin-face |
| 3588 | (org-compatible-face | 3780 | (org-compatible-face 'outline-7 |
| 3589 | 'outline-7 | 3781 | '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) |
| 3590 | '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) | 3782 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) |
| 3591 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) | 3783 | (((class color) (min-colors 8)) (:foreground "blue")))) |
| 3592 | (((class color) (min-colors 8)) (:foreground "blue")))) | ||
| 3593 | "Face used for level 7 headlines." | 3784 | "Face used for level 7 headlines." |
| 3594 | :group 'org-faces) | 3785 | :group 'org-faces) |
| 3595 | 3786 | ||
| 3596 | (defface org-level-8 ;; font-lock-string-face | 3787 | (defface org-level-8 ;; font-lock-string-face |
| 3597 | (org-compatible-face | 3788 | (org-compatible-face 'outline-8 |
| 3598 | 'outline-8 | 3789 | '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) |
| 3599 | '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) | 3790 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) |
| 3600 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) | 3791 | (((class color) (min-colors 8)) (:foreground "green")))) |
| 3601 | (((class color) (min-colors 8)) (:foreground "green")))) | ||
| 3602 | "Face used for level 8 headlines." | 3792 | "Face used for level 8 headlines." |
| 3603 | :group 'org-faces) | 3793 | :group 'org-faces) |
| 3604 | 3794 | ||
| 3605 | (defface org-special-keyword ;; font-lock-string-face | 3795 | (defface org-special-keyword ;; font-lock-string-face |
| 3606 | (org-compatible-face | 3796 | (org-compatible-face nil |
| 3607 | nil | 3797 | '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) |
| 3608 | '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) | 3798 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) |
| 3609 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) | 3799 | (t (:italic t)))) |
| 3610 | (t (:italic t)))) | ||
| 3611 | "Face used for special keywords." | 3800 | "Face used for special keywords." |
| 3612 | :group 'org-faces) | 3801 | :group 'org-faces) |
| 3613 | 3802 | ||
| 3614 | (defface org-drawer ;; font-lock-function-name-face | 3803 | (defface org-drawer ;; font-lock-function-name-face |
| 3615 | (org-compatible-face | 3804 | (org-compatible-face nil |
| 3616 | nil | 3805 | '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) |
| 3617 | '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) | 3806 | (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) |
| 3618 | (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) | 3807 | (((class color) (min-colors 16) (background light)) (:foreground "Blue")) |
| 3619 | (((class color) (min-colors 16) (background light)) (:foreground "Blue")) | 3808 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) |
| 3620 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) | 3809 | (((class color) (min-colors 8)) (:foreground "blue" :bold t)) |
| 3621 | (((class color) (min-colors 8)) (:foreground "blue" :bold t)) | 3810 | (t (:bold t)))) |
| 3622 | (t (:bold t)))) | ||
| 3623 | "Face used for drawers." | 3811 | "Face used for drawers." |
| 3624 | :group 'org-faces) | 3812 | :group 'org-faces) |
| 3625 | 3813 | ||
| @@ -3628,15 +3816,14 @@ color of the frame." | |||
| 3628 | :group 'org-faces) | 3816 | :group 'org-faces) |
| 3629 | 3817 | ||
| 3630 | (defface org-column | 3818 | (defface org-column |
| 3631 | (org-compatible-face | 3819 | (org-compatible-face nil |
| 3632 | nil | 3820 | '((((class color) (min-colors 16) (background light)) |
| 3633 | '((((class color) (min-colors 16) (background light)) | 3821 | (:background "grey90")) |
| 3634 | (:background "grey90")) | 3822 | (((class color) (min-colors 16) (background dark)) |
| 3635 | (((class color) (min-colors 16) (background dark)) | 3823 | (:background "grey30")) |
| 3636 | (:background "grey30")) | 3824 | (((class color) (min-colors 8)) |
| 3637 | (((class color) (min-colors 8)) | 3825 | (:background "cyan" :foreground "black")) |
| 3638 | (:background "cyan" :foreground "black")) | 3826 | (t (:inverse-video t)))) |
| 3639 | (t (:inverse-video t)))) | ||
| 3640 | "Face for column display of entry properties." | 3827 | "Face for column display of entry properties." |
| 3641 | :group 'org-faces) | 3828 | :group 'org-faces) |
| 3642 | 3829 | ||
| @@ -3647,29 +3834,27 @@ color of the frame." | |||
| 3647 | :family (face-attribute 'default :family))) | 3834 | :family (face-attribute 'default :family))) |
| 3648 | 3835 | ||
| 3649 | (defface org-warning | 3836 | (defface org-warning |
| 3650 | (org-compatible-face | 3837 | (org-compatible-face 'font-lock-warning-face |
| 3651 | 'font-lock-warning-face | 3838 | '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) |
| 3652 | '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) | 3839 | (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) |
| 3653 | (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) | 3840 | (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) |
| 3654 | (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) | 3841 | (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) |
| 3655 | (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) | 3842 | (t (:bold t)))) |
| 3656 | (t (:bold t)))) | ||
| 3657 | "Face for deadlines and TODO keywords." | 3843 | "Face for deadlines and TODO keywords." |
| 3658 | :group 'org-faces) | 3844 | :group 'org-faces) |
| 3659 | 3845 | ||
| 3660 | (defface org-archived ; similar to shadow | 3846 | (defface org-archived ; similar to shadow |
| 3661 | (org-compatible-face | 3847 | (org-compatible-face 'shadow |
| 3662 | 'shadow | 3848 | '((((class color grayscale) (min-colors 88) (background light)) |
| 3663 | '((((class color grayscale) (min-colors 88) (background light)) | 3849 | (:foreground "grey50")) |
| 3664 | (:foreground "grey50")) | 3850 | (((class color grayscale) (min-colors 88) (background dark)) |
| 3665 | (((class color grayscale) (min-colors 88) (background dark)) | 3851 | (:foreground "grey70")) |
| 3666 | (:foreground "grey70")) | 3852 | (((class color) (min-colors 8) (background light)) |
| 3667 | (((class color) (min-colors 8) (background light)) | 3853 | (:foreground "green")) |
| 3668 | (:foreground "green")) | 3854 | (((class color) (min-colors 8) (background dark)) |
| 3669 | (((class color) (min-colors 8) (background dark)) | 3855 | (:foreground "yellow")))) |
| 3670 | (:foreground "yellow")))) | 3856 | "Face for headline with the ARCHIVE tag." |
| 3671 | "Face for headline with the ARCHIVE tag." | 3857 | :group 'org-faces) |
| 3672 | :group 'org-faces) | ||
| 3673 | 3858 | ||
| 3674 | (defface org-link | 3859 | (defface org-link |
| 3675 | '((((class color) (background light)) (:foreground "Purple" :underline t)) | 3860 | '((((class color) (background light)) (:foreground "Purple" :underline t)) |
| @@ -3679,8 +3864,8 @@ color of the frame." | |||
| 3679 | :group 'org-faces) | 3864 | :group 'org-faces) |
| 3680 | 3865 | ||
| 3681 | (defface org-ellipsis | 3866 | (defface org-ellipsis |
| 3682 | '((((class color) (background light)) (:foreground "DarkGoldenrod" :strike-through t)) | 3867 | '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t)) |
| 3683 | (((class color) (background dark)) (:foreground "LightGoldenrod" :strike-through t)) | 3868 | (((class color) (background dark)) (:foreground "LightGoldenrod" :underline t)) |
| 3684 | (t (:strike-through t))) | 3869 | (t (:strike-through t))) |
| 3685 | "Face for the ellipsis in folded text." | 3870 | "Face for the ellipsis in folded text." |
| 3686 | :group 'org-faces) | 3871 | :group 'org-faces) |
| @@ -3712,32 +3897,29 @@ color of the frame." | |||
| 3712 | :group 'org-faces) | 3897 | :group 'org-faces) |
| 3713 | 3898 | ||
| 3714 | (defface org-todo ; font-lock-warning-face | 3899 | (defface org-todo ; font-lock-warning-face |
| 3715 | (org-compatible-face | 3900 | (org-compatible-face nil |
| 3716 | nil | 3901 | '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) |
| 3717 | '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) | 3902 | (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) |
| 3718 | (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) | 3903 | (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) |
| 3719 | (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) | 3904 | (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) |
| 3720 | (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) | 3905 | (t (:inverse-video t :bold t)))) |
| 3721 | (t (:inverse-video t :bold t)))) | ||
| 3722 | "Face for TODO keywords." | 3906 | "Face for TODO keywords." |
| 3723 | :group 'org-faces) | 3907 | :group 'org-faces) |
| 3724 | 3908 | ||
| 3725 | (defface org-done ;; font-lock-type-face | 3909 | (defface org-done ;; font-lock-type-face |
| 3726 | (org-compatible-face | 3910 | (org-compatible-face nil |
| 3727 | nil | 3911 | '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t)) |
| 3728 | '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t)) | 3912 | (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) |
| 3729 | (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) | 3913 | (((class color) (min-colors 8)) (:foreground "green")) |
| 3730 | (((class color) (min-colors 8)) (:foreground "green")) | 3914 | (t (:bold t)))) |
| 3731 | (t (:bold t)))) | ||
| 3732 | "Face used for todo keywords that indicate DONE items." | 3915 | "Face used for todo keywords that indicate DONE items." |
| 3733 | :group 'org-faces) | 3916 | :group 'org-faces) |
| 3734 | 3917 | ||
| 3735 | (defface org-headline-done ;; font-lock-string-face | 3918 | (defface org-headline-done ;; font-lock-string-face |
| 3736 | (org-compatible-face | 3919 | (org-compatible-face nil |
| 3737 | nil | 3920 | '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) |
| 3738 | '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) | 3921 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) |
| 3739 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) | 3922 | (((class color) (min-colors 8) (background light)) (:bold nil)))) |
| 3740 | (((class color) (min-colors 8) (background light)) (:bold nil)))) | ||
| 3741 | "Face used to indicate that a headline is DONE. | 3923 | "Face used to indicate that a headline is DONE. |
| 3742 | This face is only used if `org-fontify-done-headline' is set. If applies | 3924 | This face is only used if `org-fontify-done-headline' is set. If applies |
| 3743 | to the part of the headline after the DONE keyword." | 3925 | to the part of the headline after the DONE keyword." |
| @@ -3756,84 +3938,91 @@ list of attributes, like (:foreground \"blue\" :weight bold :underline t)." | |||
| 3756 | (sexp :tag "face")))) | 3938 | (sexp :tag "face")))) |
| 3757 | 3939 | ||
| 3758 | (defface org-table ;; font-lock-function-name-face | 3940 | (defface org-table ;; font-lock-function-name-face |
| 3759 | (org-compatible-face | 3941 | (org-compatible-face nil |
| 3760 | nil | 3942 | '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) |
| 3761 | '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) | 3943 | (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) |
| 3762 | (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) | 3944 | (((class color) (min-colors 16) (background light)) (:foreground "Blue")) |
| 3763 | (((class color) (min-colors 16) (background light)) (:foreground "Blue")) | 3945 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) |
| 3764 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) | 3946 | (((class color) (min-colors 8) (background light)) (:foreground "blue")) |
| 3765 | (((class color) (min-colors 8) (background light)) (:foreground "blue")) | 3947 | (((class color) (min-colors 8) (background dark))))) |
| 3766 | (((class color) (min-colors 8) (background dark))))) | ||
| 3767 | "Face used for tables." | 3948 | "Face used for tables." |
| 3768 | :group 'org-faces) | 3949 | :group 'org-faces) |
| 3769 | 3950 | ||
| 3770 | (defface org-formula | 3951 | (defface org-formula |
| 3771 | (org-compatible-face | 3952 | (org-compatible-face nil |
| 3772 | nil | 3953 | '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) |
| 3773 | '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) | 3954 | (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) |
| 3774 | (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) | 3955 | (((class color) (min-colors 8) (background light)) (:foreground "red")) |
| 3775 | (((class color) (min-colors 8) (background light)) (:foreground "red")) | 3956 | (((class color) (min-colors 8) (background dark)) (:foreground "red")) |
| 3776 | (((class color) (min-colors 8) (background dark)) (:foreground "red")) | 3957 | (t (:bold t :italic t)))) |
| 3777 | (t (:bold t :italic t)))) | ||
| 3778 | "Face for formulas." | 3958 | "Face for formulas." |
| 3779 | :group 'org-faces) | 3959 | :group 'org-faces) |
| 3780 | 3960 | ||
| 3781 | (defface org-code | 3961 | (defface org-code |
| 3782 | (org-compatible-face | 3962 | (org-compatible-face nil |
| 3783 | nil | 3963 | '((((class color grayscale) (min-colors 88) (background light)) |
| 3784 | '((((class color grayscale) (min-colors 88) (background light)) | 3964 | (:foreground "grey50")) |
| 3785 | (:foreground "grey50")) | 3965 | (((class color grayscale) (min-colors 88) (background dark)) |
| 3786 | (((class color grayscale) (min-colors 88) (background dark)) | 3966 | (:foreground "grey70")) |
| 3787 | (:foreground "grey70")) | 3967 | (((class color) (min-colors 8) (background light)) |
| 3788 | (((class color) (min-colors 8) (background light)) | 3968 | (:foreground "green")) |
| 3789 | (:foreground "green")) | 3969 | (((class color) (min-colors 8) (background dark)) |
| 3790 | (((class color) (min-colors 8) (background dark)) | 3970 | (:foreground "yellow")))) |
| 3791 | (:foreground "yellow")))) | 3971 | "Face for fixed-with text like code snippets." |
| 3792 | "Face for fixed-with text like code snippets." | 3972 | :group 'org-faces |
| 3793 | :group 'org-faces | 3973 | :version "22.1") |
| 3794 | :version "22.1") | 3974 | |
| 3975 | (defface org-verbatim | ||
| 3976 | (org-compatible-face nil | ||
| 3977 | '((((class color grayscale) (min-colors 88) (background light)) | ||
| 3978 | (:foreground "grey50" :underline t)) | ||
| 3979 | (((class color grayscale) (min-colors 88) (background dark)) | ||
| 3980 | (:foreground "grey70" :underline t)) | ||
| 3981 | (((class color) (min-colors 8) (background light)) | ||
| 3982 | (:foreground "green" :underline t)) | ||
| 3983 | (((class color) (min-colors 8) (background dark)) | ||
| 3984 | (:foreground "yellow" :underline t)))) | ||
| 3985 | "Face for fixed-with text like code snippets." | ||
| 3986 | :group 'org-faces | ||
| 3987 | :version "22.1") | ||
| 3795 | 3988 | ||
| 3796 | (defface org-agenda-structure ;; font-lock-function-name-face | 3989 | (defface org-agenda-structure ;; font-lock-function-name-face |
| 3797 | (org-compatible-face | 3990 | (org-compatible-face nil |
| 3798 | nil | 3991 | '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) |
| 3799 | '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) | 3992 | (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) |
| 3800 | (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) | 3993 | (((class color) (min-colors 16) (background light)) (:foreground "Blue")) |
| 3801 | (((class color) (min-colors 16) (background light)) (:foreground "Blue")) | 3994 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) |
| 3802 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) | 3995 | (((class color) (min-colors 8)) (:foreground "blue" :bold t)) |
| 3803 | (((class color) (min-colors 8)) (:foreground "blue" :bold t)) | 3996 | (t (:bold t)))) |
| 3804 | (t (:bold t)))) | ||
| 3805 | "Face used in agenda for captions and dates." | 3997 | "Face used in agenda for captions and dates." |
| 3806 | :group 'org-faces) | 3998 | :group 'org-faces) |
| 3807 | 3999 | ||
| 3808 | (defface org-scheduled-today | 4000 | (defface org-scheduled-today |
| 3809 | (org-compatible-face | 4001 | (org-compatible-face nil |
| 3810 | nil | 4002 | '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) |
| 3811 | '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) | 4003 | (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) |
| 3812 | (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) | 4004 | (((class color) (min-colors 8)) (:foreground "green")) |
| 3813 | (((class color) (min-colors 8)) (:foreground "green")) | 4005 | (t (:bold t :italic t)))) |
| 3814 | (t (:bold t :italic t)))) | ||
| 3815 | "Face for items scheduled for a certain day." | 4006 | "Face for items scheduled for a certain day." |
| 3816 | :group 'org-faces) | 4007 | :group 'org-faces) |
| 3817 | 4008 | ||
| 3818 | (defface org-scheduled-previously | 4009 | (defface org-scheduled-previously |
| 3819 | (org-compatible-face | 4010 | (org-compatible-face nil |
| 3820 | nil | 4011 | '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) |
| 3821 | '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) | 4012 | (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) |
| 3822 | (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) | 4013 | (((class color) (min-colors 8) (background light)) (:foreground "red")) |
| 3823 | (((class color) (min-colors 8) (background light)) (:foreground "red")) | 4014 | (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) |
| 3824 | (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) | 4015 | (t (:bold t)))) |
| 3825 | (t (:bold t)))) | ||
| 3826 | "Face for items scheduled previously, and not yet done." | 4016 | "Face for items scheduled previously, and not yet done." |
| 3827 | :group 'org-faces) | 4017 | :group 'org-faces) |
| 3828 | 4018 | ||
| 3829 | (defface org-upcoming-deadline | 4019 | (defface org-upcoming-deadline |
| 3830 | (org-compatible-face | 4020 | (org-compatible-face nil |
| 3831 | nil | 4021 | '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) |
| 3832 | '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) | 4022 | (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) |
| 3833 | (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) | 4023 | (((class color) (min-colors 8) (background light)) (:foreground "red")) |
| 3834 | (((class color) (min-colors 8) (background light)) (:foreground "red")) | 4024 | (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) |
| 3835 | (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) | 4025 | (t (:bold t)))) |
| 3836 | (t (:bold t)))) | ||
| 3837 | "Face for items scheduled previously, and not yet done." | 4026 | "Face for items scheduled previously, and not yet done." |
| 3838 | :group 'org-faces) | 4027 | :group 'org-faces) |
| 3839 | 4028 | ||
| @@ -3842,8 +4031,8 @@ list of attributes, like (:foreground \"blue\" :weight bold :underline t)." | |||
| 3842 | (0.5 . org-upcoming-deadline) | 4031 | (0.5 . org-upcoming-deadline) |
| 3843 | (0.0 . default)) | 4032 | (0.0 . default)) |
| 3844 | "Faces for showing deadlines in the agenda. | 4033 | "Faces for showing deadlines in the agenda. |
| 3845 | This is a list of cons cells. The cdr of each cess is a face to be used, | 4034 | This is a list of cons cells. The cdr of each cell is a face to be used, |
| 3846 | and it can also just be a like like '(:foreground \"yellow\"). | 4035 | and it can also just be like '(:foreground \"yellow\"). |
| 3847 | Each car is a fraction of the head-warning time that must have passed for | 4036 | Each car is a fraction of the head-warning time that must have passed for |
| 3848 | this the face in the cdr to be used for display. The numbers must be | 4037 | this the face in the cdr to be used for display. The numbers must be |
| 3849 | given in descending order. The head-warning time is normally taken | 4038 | given in descending order. The head-warning time is normally taken |
| @@ -3862,12 +4051,23 @@ month and 365.24 days for a year)." | |||
| 3862 | (number :tag "Fraction of head-warning time passed") | 4051 | (number :tag "Fraction of head-warning time passed") |
| 3863 | (sexp :tag "Face")))) | 4052 | (sexp :tag "Face")))) |
| 3864 | 4053 | ||
| 4054 | ;; FIXME: this is not a good face yet. | ||
| 4055 | (defface org-agenda-restriction-lock | ||
| 4056 | (org-compatible-face nil | ||
| 4057 | '((((class color) (min-colors 88) (background light)) (:background "yellow1")) | ||
| 4058 | (((class color) (min-colors 88) (background dark)) (:background "skyblue4")) | ||
| 4059 | (((class color) (min-colors 16) (background light)) (:background "yellow1")) | ||
| 4060 | (((class color) (min-colors 16) (background dark)) (:background "skyblue4")) | ||
| 4061 | (((class color) (min-colors 8)) (:background "cyan" :foreground "black")) | ||
| 4062 | (t (:inverse-video t)))) | ||
| 4063 | "Face for showing the agenda restriction lock." | ||
| 4064 | :group 'org-faces) | ||
| 4065 | |||
| 3865 | (defface org-time-grid ;; font-lock-variable-name-face | 4066 | (defface org-time-grid ;; font-lock-variable-name-face |
| 3866 | (org-compatible-face | 4067 | (org-compatible-face nil |
| 3867 | nil | 4068 | '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) |
| 3868 | '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) | 4069 | (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) |
| 3869 | (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) | 4070 | (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) |
| 3870 | (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) | ||
| 3871 | "Face used for time grids." | 4071 | "Face used for time grids." |
| 3872 | :group 'org-faces) | 4072 | :group 'org-faces) |
| 3873 | 4073 | ||
| @@ -3883,7 +4083,24 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc." | |||
| 3883 | :type 'number | 4083 | :type 'number |
| 3884 | :group 'org-faces) | 4084 | :group 'org-faces) |
| 3885 | 4085 | ||
| 3886 | ;;; Function declarations. | 4086 | ;;; Functions and variables from ther packages |
| 4087 | ;; Declared here to avoid compiler warnings | ||
| 4088 | |||
| 4089 | (eval-and-compile | ||
| 4090 | (unless (fboundp 'declare-function) | ||
| 4091 | (defmacro declare-function (fn file &optional arglist fileonly)))) | ||
| 4092 | |||
| 4093 | ;; XEmacs only | ||
| 4094 | (defvar outline-mode-menu-heading) | ||
| 4095 | (defvar outline-mode-menu-show) | ||
| 4096 | (defvar outline-mode-menu-hide) | ||
| 4097 | (defvar zmacs-regions) ; XEmacs regions | ||
| 4098 | |||
| 4099 | ;; Emacs only | ||
| 4100 | (defvar mark-active) | ||
| 4101 | |||
| 4102 | ;; Various packages | ||
| 4103 | ;; FIXME: get the argument lists for the UNKNOWN stuff | ||
| 3887 | (declare-function add-to-diary-list "diary-lib" | 4104 | (declare-function add-to-diary-list "diary-lib" |
| 3888 | (date string specifier &optional marker globcolor literal)) | 4105 | (date string specifier &optional marker globcolor literal)) |
| 3889 | (declare-function table--at-cell-p "table" (position &optional object at-column)) | 4106 | (declare-function table--at-cell-p "table" (position &optional object at-column)) |
| @@ -3899,6 +4116,8 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc." | |||
| 3899 | (declare-function bibtex-generate-autokey "bibtex" ()) | 4116 | (declare-function bibtex-generate-autokey "bibtex" ()) |
| 3900 | (declare-function bibtex-parse-entry "bibtex" (&optional content)) | 4117 | (declare-function bibtex-parse-entry "bibtex" (&optional content)) |
| 3901 | (declare-function bibtex-url "bibtex" (&optional pos no-browse)) | 4118 | (declare-function bibtex-url "bibtex" (&optional pos no-browse)) |
| 4119 | (defvar calc-embedded-close-formula) | ||
| 4120 | (defvar calc-embedded-open-formula) | ||
| 3902 | (declare-function calendar-astro-date-string "cal-julian" (&optional date)) | 4121 | (declare-function calendar-astro-date-string "cal-julian" (&optional date)) |
| 3903 | (declare-function calendar-bahai-date-string "cal-bahai" (&optional date)) | 4122 | (declare-function calendar-bahai-date-string "cal-bahai" (&optional date)) |
| 3904 | (declare-function calendar-check-holidays "holidays" (date)) | 4123 | (declare-function calendar-check-holidays "holidays" (date)) |
| @@ -3915,10 +4134,23 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc." | |||
| 3915 | (declare-function calendar-julian-date-string "cal-julian" (&optional date)) | 4134 | (declare-function calendar-julian-date-string "cal-julian" (&optional date)) |
| 3916 | (declare-function calendar-mayan-date-string "cal-mayan" (&optional date)) | 4135 | (declare-function calendar-mayan-date-string "cal-mayan" (&optional date)) |
| 3917 | (declare-function calendar-persian-date-string "cal-persia" (&optional date)) | 4136 | (declare-function calendar-persian-date-string "cal-persia" (&optional date)) |
| 4137 | (defvar calendar-mode-map) | ||
| 4138 | (defvar original-date) ; dynamically scoped in calendar.el does scope this | ||
| 3918 | (declare-function cdlatex-tab "ext:cdlatex" ()) | 4139 | (declare-function cdlatex-tab "ext:cdlatex" ()) |
| 3919 | (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) | 4140 | (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) |
| 4141 | (declare-function elmo-folder-exists-p "ext:elmo" (folder) t) | ||
| 4142 | (declare-function elmo-message-entity-field "ext:elmo-msgdb" (entity field &optional type)) | ||
| 4143 | (declare-function elmo-message-field "ext:elmo" (folder number field &optional type) t) | ||
| 4144 | ;; backward compatibility to old version of elmo | ||
| 4145 | (declare-function elmo-msgdb-overview-get-entity "ext:elmo" (&rest unknown) t) | ||
| 4146 | (defvar font-lock-unfontify-region-function) | ||
| 3920 | (declare-function gnus-article-show-summary "gnus-art" ()) | 4147 | (declare-function gnus-article-show-summary "gnus-art" ()) |
| 3921 | (declare-function gnus-summary-last-subject "gnus-sum" ()) | 4148 | (declare-function gnus-summary-last-subject "gnus-sum" ()) |
| 4149 | (defvar gnus-other-frame-object) | ||
| 4150 | (defvar gnus-group-name) | ||
| 4151 | (defvar gnus-article-current) | ||
| 4152 | (defvar Info-current-file) | ||
| 4153 | (defvar Info-current-node) | ||
| 3922 | (declare-function mh-display-msg "mh-show" (msg-num folder-name)) | 4154 | (declare-function mh-display-msg "mh-show" (msg-num folder-name)) |
| 3923 | (declare-function mh-find-path "mh-utils" ()) | 4155 | (declare-function mh-find-path "mh-utils" ()) |
| 3924 | (declare-function mh-get-header-field "mh-utils" (field)) | 4156 | (declare-function mh-get-header-field "mh-utils" (field)) |
| @@ -3934,16 +4166,25 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc." | |||
| 3934 | (declare-function mh-show-msg "mh-show" (msg)) | 4166 | (declare-function mh-show-msg "mh-show" (msg)) |
| 3935 | (declare-function mh-show-show "mh-show" t t) | 4167 | (declare-function mh-show-show "mh-show" t t) |
| 3936 | (declare-function mh-visit-folder "mh-folder" (folder &optional range index-data)) | 4168 | (declare-function mh-visit-folder "mh-folder" (folder &optional range index-data)) |
| 3937 | (declare-function org-export-latex-cleaned-string "org-export-latex" (&optional commentsp)) | 4169 | (defvar mh-progs) |
| 4170 | (defvar mh-current-folder) | ||
| 4171 | (defvar mh-show-folder-buffer) | ||
| 4172 | (defvar mh-index-folder) | ||
| 4173 | (defvar mh-searcher) | ||
| 4174 | (declare-function org-export-latex-cleaned-string "org-export-latex" ()) | ||
| 3938 | (declare-function parse-time-string "parse-time" (string)) | 4175 | (declare-function parse-time-string "parse-time" (string)) |
| 3939 | (declare-function remember "remember" (&optional initial)) | 4176 | (declare-function remember "remember" (&optional initial)) |
| 3940 | (declare-function remember-buffer-desc "remember" ()) | 4177 | (declare-function remember-buffer-desc "remember" ()) |
| 4178 | (defvar remember-save-after-remembering) | ||
| 4179 | (defvar remember-data-file) | ||
| 4180 | (defvar remember-register) | ||
| 4181 | (defvar remember-buffer) | ||
| 4182 | (defvar remember-handler-functions) | ||
| 4183 | (defvar remember-annotation-functions) | ||
| 3941 | (declare-function rmail-narrow-to-non-pruned-header "rmail" ()) | 4184 | (declare-function rmail-narrow-to-non-pruned-header "rmail" ()) |
| 3942 | (declare-function rmail-show-message "rmail" (&optional n no-summary)) | 4185 | (declare-function rmail-show-message "rmail" (&optional n no-summary)) |
| 3943 | (declare-function rmail-what-message "rmail" ()) | 4186 | (declare-function rmail-what-message "rmail" ()) |
| 3944 | (declare-function elmo-folder-exists-p "ext:elmo" (folder) t) | 4187 | (defvar texmathp-why) |
| 3945 | (declare-function elmo-message-entity-field "ext:elmo-msgdb" (entity field &optional type)) | ||
| 3946 | (declare-function elmo-message-field "ext:elmo" (folder number field &optional type) t) | ||
| 3947 | (declare-function vm-beginning-of-message "ext:vm-page" ()) | 4188 | (declare-function vm-beginning-of-message "ext:vm-page" ()) |
| 3948 | (declare-function vm-follow-summary-cursor "ext:vm-motion" ()) | 4189 | (declare-function vm-follow-summary-cursor "ext:vm-motion" ()) |
| 3949 | (declare-function vm-get-header-contents "ext:vm-summary" (message header-name-regexp &optional clump-sep)) | 4190 | (declare-function vm-get-header-contents "ext:vm-summary" (message header-name-regexp &optional clump-sep)) |
| @@ -3953,6 +4194,12 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc." | |||
| 3953 | (declare-function vm-su-message-id "ext:vm-summary" (m)) | 4194 | (declare-function vm-su-message-id "ext:vm-summary" (m)) |
| 3954 | (declare-function vm-su-subject "ext:vm-summary" (m)) | 4195 | (declare-function vm-su-subject "ext:vm-summary" (m)) |
| 3955 | (declare-function vm-summarize "ext:vm-summary" (&optional display raise)) | 4196 | (declare-function vm-summarize "ext:vm-summary" (&optional display raise)) |
| 4197 | (defvar vm-message-pointer) | ||
| 4198 | (defvar vm-folder-directory) | ||
| 4199 | (defvar w3m-current-url) | ||
| 4200 | (defvar w3m-current-title) | ||
| 4201 | ;; backward compatibility to old version of wl | ||
| 4202 | (declare-function wl-summary-buffer-msgdb "ext:wl-folder" (&rest unknown) t) | ||
| 3956 | (declare-function wl-folder-get-elmo-folder "ext:wl-folder" (entity &optional no-cache)) | 4203 | (declare-function wl-folder-get-elmo-folder "ext:wl-folder" (entity &optional no-cache)) |
| 3957 | (declare-function wl-summary-goto-folder-subr "ext:wl-summary" (&optional name scan-type other-window sticky interactive scoring force-exit)) | 4204 | (declare-function wl-summary-goto-folder-subr "ext:wl-summary" (&optional name scan-type other-window sticky interactive scoring force-exit)) |
| 3958 | (declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary" (&optional id)) | 4205 | (declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary" (&optional id)) |
| @@ -3960,6 +4207,12 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc." | |||
| 3960 | (declare-function wl-summary-line-subject "ext:wl-summary" ()) | 4207 | (declare-function wl-summary-line-subject "ext:wl-summary" ()) |
| 3961 | (declare-function wl-summary-message-number "ext:wl-summary" ()) | 4208 | (declare-function wl-summary-message-number "ext:wl-summary" ()) |
| 3962 | (declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg)) | 4209 | (declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg)) |
| 4210 | (defvar wl-summary-buffer-elmo-folder) | ||
| 4211 | (defvar wl-summary-buffer-folder-name) | ||
| 4212 | (declare-function speedbar-line-directory "speedbar" (&optional depth)) | ||
| 4213 | |||
| 4214 | (defvar org-latex-regexps) | ||
| 4215 | (defvar constants-unit-system) | ||
| 3963 | 4216 | ||
| 3964 | ;;; Variables for pre-computed regular expressions, all buffer local | 4217 | ;;; Variables for pre-computed regular expressions, all buffer local |
| 3965 | 4218 | ||
| @@ -4134,7 +4387,7 @@ means to push this value onto the list in the variable.") | |||
| 4134 | ((equal key "CATEGORY") | 4387 | ((equal key "CATEGORY") |
| 4135 | (if (string-match "[ \t]+$" value) | 4388 | (if (string-match "[ \t]+$" value) |
| 4136 | (setq value (replace-match "" t t value))) | 4389 | (setq value (replace-match "" t t value))) |
| 4137 | (setq cat (intern value))) | 4390 | (setq cat value)) |
| 4138 | ((member key '("SEQ_TODO" "TODO")) | 4391 | ((member key '("SEQ_TODO" "TODO")) |
| 4139 | (push (cons 'sequence (org-split-string value splitre)) kwds)) | 4392 | (push (cons 'sequence (org-split-string value splitre)) kwds)) |
| 4140 | ((equal key "TYP_TODO") | 4393 | ((equal key "TYP_TODO") |
| @@ -4176,7 +4429,9 @@ means to push this value onto the list in the variable.") | |||
| 4176 | (remove-text-properties 0 (length arch) | 4429 | (remove-text-properties 0 (length arch) |
| 4177 | '(face t fontified t) arch))) | 4430 | '(face t fontified t) arch))) |
| 4178 | ))) | 4431 | ))) |
| 4179 | (and cat (org-set-local 'org-category cat)) | 4432 | (when cat |
| 4433 | (org-set-local 'org-category (intern cat)) | ||
| 4434 | (push (cons "CATEGORY" cat) props)) | ||
| 4180 | (when prio | 4435 | (when prio |
| 4181 | (if (< (length prio) 3) (setq prio '("A" "C" "B"))) | 4436 | (if (< (length prio) 3) (setq prio '("A" "C" "B"))) |
| 4182 | (setq prio (mapcar 'string-to-char prio)) | 4437 | (setq prio (mapcar 'string-to-char prio)) |
| @@ -4332,7 +4587,7 @@ means to push this value onto the list in the variable.") | |||
| 4332 | "\\|" org-closed-string "\\|" org-clock-string | 4587 | "\\|" org-closed-string "\\|" org-clock-string |
| 4333 | "\\)\\>\\)") | 4588 | "\\)\\>\\)") |
| 4334 | ) | 4589 | ) |
| 4335 | 4590 | (org-compute-latex-and-specials-regexp) | |
| 4336 | (org-set-font-lock-defaults))) | 4591 | (org-set-font-lock-defaults))) |
| 4337 | 4592 | ||
| 4338 | (defun org-remove-keyword-keys (list) | 4593 | (defun org-remove-keyword-keys (list) |
| @@ -4342,6 +4597,31 @@ means to push this value onto the list in the variable.") | |||
| 4342 | x)) | 4597 | x)) |
| 4343 | list)) | 4598 | list)) |
| 4344 | 4599 | ||
| 4600 | ;; FIXME: this could be done much better, using second characters etc. | ||
| 4601 | (defun org-assign-fast-keys (alist) | ||
| 4602 | "Assign fast keys to a keyword-key alist. | ||
| 4603 | Respect keys that are already there." | ||
| 4604 | (let (new e k c c1 c2 (char ?a)) | ||
| 4605 | (while (setq e (pop alist)) | ||
| 4606 | (cond | ||
| 4607 | ((equal e '(:startgroup)) (push e new)) | ||
| 4608 | ((equal e '(:endgroup)) (push e new)) | ||
| 4609 | (t | ||
| 4610 | (setq k (car e) c2 nil) | ||
| 4611 | (if (cdr e) | ||
| 4612 | (setq c (cdr e)) | ||
| 4613 | ;; automatically assign a character. | ||
| 4614 | (setq c1 (string-to-char | ||
| 4615 | (downcase (substring | ||
| 4616 | k (if (= (string-to-char k) ?@) 1 0))))) | ||
| 4617 | (if (or (rassoc c1 new) (rassoc c1 alist)) | ||
| 4618 | (while (or (rassoc char new) (rassoc char alist)) | ||
| 4619 | (setq char (1+ char))) | ||
| 4620 | (setq c2 c1)) | ||
| 4621 | (setq c (or c2 char))) | ||
| 4622 | (push (cons k c) new)))) | ||
| 4623 | (nreverse new))) | ||
| 4624 | |||
| 4345 | ;;; Some variables ujsed in various places | 4625 | ;;; Some variables ujsed in various places |
| 4346 | 4626 | ||
| 4347 | (defvar org-window-configuration nil | 4627 | (defvar org-window-configuration nil |
| @@ -4350,49 +4630,6 @@ means to push this value onto the list in the variable.") | |||
| 4350 | "Function to be called when `C-c C-c' is used. | 4630 | "Function to be called when `C-c C-c' is used. |
| 4351 | This is for getting out of special buffers like remember.") | 4631 | This is for getting out of special buffers like remember.") |
| 4352 | 4632 | ||
| 4353 | ;;; Foreign variables, to inform the compiler | ||
| 4354 | |||
| 4355 | ;; XEmacs only | ||
| 4356 | (defvar outline-mode-menu-heading) | ||
| 4357 | (defvar outline-mode-menu-show) | ||
| 4358 | (defvar outline-mode-menu-hide) | ||
| 4359 | (defvar zmacs-regions) ; XEmacs regions | ||
| 4360 | ;; Emacs only | ||
| 4361 | (defvar mark-active) | ||
| 4362 | |||
| 4363 | ;; Packages that org-mode interacts with | ||
| 4364 | (defvar calc-embedded-close-formula) | ||
| 4365 | (defvar calc-embedded-open-formula) | ||
| 4366 | (defvar font-lock-unfontify-region-function) | ||
| 4367 | (defvar org-goto-start-pos) | ||
| 4368 | (defvar vm-message-pointer) | ||
| 4369 | (defvar vm-folder-directory) | ||
| 4370 | (defvar wl-summary-buffer-elmo-folder) | ||
| 4371 | (defvar wl-summary-buffer-folder-name) | ||
| 4372 | (defvar gnus-other-frame-object) | ||
| 4373 | (defvar gnus-group-name) | ||
| 4374 | (defvar gnus-article-current) | ||
| 4375 | (defvar w3m-current-url) | ||
| 4376 | (defvar w3m-current-title) | ||
| 4377 | (defvar mh-progs) | ||
| 4378 | (defvar mh-current-folder) | ||
| 4379 | (defvar mh-show-folder-buffer) | ||
| 4380 | (defvar mh-index-folder) | ||
| 4381 | (defvar mh-searcher) | ||
| 4382 | (defvar calendar-mode-map) | ||
| 4383 | (defvar Info-current-file) | ||
| 4384 | (defvar Info-current-node) | ||
| 4385 | (defvar texmathp-why) | ||
| 4386 | (defvar remember-save-after-remembering) | ||
| 4387 | (defvar remember-data-file) | ||
| 4388 | (defvar remember-register) | ||
| 4389 | (defvar remember-buffer) | ||
| 4390 | (defvar annotation) ; from remember.el, dynamically scoped in `remember-mode' | ||
| 4391 | (defvar initial) ; from remember.el, dynamically scoped in `remember-mode' | ||
| 4392 | (defvar org-latex-regexps) | ||
| 4393 | (defvar constants-unit-system) | ||
| 4394 | |||
| 4395 | (defvar original-date) ; dynamically scoped in calendar.el does scope this | ||
| 4396 | 4633 | ||
| 4397 | ;; FIXME: Occasionally check by commenting these, to make sure | 4634 | ;; FIXME: Occasionally check by commenting these, to make sure |
| 4398 | ;; no other functions uses these, forgetting to let-bind them. | 4635 | ;; no other functions uses these, forgetting to let-bind them. |
| @@ -4402,7 +4639,6 @@ This is for getting out of special buffers like remember.") | |||
| 4402 | (defvar date) | 4639 | (defvar date) |
| 4403 | (defvar description) | 4640 | (defvar description) |
| 4404 | 4641 | ||
| 4405 | |||
| 4406 | ;; Defined somewhere in this file, but used before definition. | 4642 | ;; Defined somewhere in this file, but used before definition. |
| 4407 | (defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized | 4643 | (defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized |
| 4408 | (defvar org-agenda-buffer-name) | 4644 | (defvar org-agenda-buffer-name) |
| @@ -4495,8 +4731,10 @@ Works on both Emacs and XEmacs." | |||
| 4495 | (if org-ignore-region | 4731 | (if org-ignore-region |
| 4496 | nil | 4732 | nil |
| 4497 | (if (featurep 'xemacs) | 4733 | (if (featurep 'xemacs) |
| 4498 | (region-active-p) | 4734 | (and zmacs-regions (region-active-p)) |
| 4499 | (use-region-p)))) | 4735 | (if (fboundp 'use-region-p) |
| 4736 | (use-region-p) | ||
| 4737 | (and transient-mark-mode mark-active))))) ; Emacs 22 and before | ||
| 4500 | 4738 | ||
| 4501 | ;; Invisibility compatibility | 4739 | ;; Invisibility compatibility |
| 4502 | 4740 | ||
| @@ -4624,6 +4862,10 @@ The following commands are available: | |||
| 4624 | ; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping | 4862 | ; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping |
| 4625 | (org-set-local 'comment-padding " ") | 4863 | (org-set-local 'comment-padding " ") |
| 4626 | 4864 | ||
| 4865 | ;; Imenu | ||
| 4866 | (org-set-local 'imenu-create-index-function | ||
| 4867 | 'org-imenu-get-tree) | ||
| 4868 | |||
| 4627 | ;; Make isearch reveal context | 4869 | ;; Make isearch reveal context |
| 4628 | (if (or (featurep 'xemacs) | 4870 | (if (or (featurep 'xemacs) |
| 4629 | (not (boundp 'outline-isearch-open-invisible-function))) | 4871 | (not (boundp 'outline-isearch-open-invisible-function))) |
| @@ -4704,7 +4946,7 @@ that will be added to PLIST. Returns the string that was modified." | |||
| 4704 | 4946 | ||
| 4705 | (defconst org-non-link-chars "]\t\n\r<>") | 4947 | (defconst org-non-link-chars "]\t\n\r<>") |
| 4706 | (defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" "bbdb" "vm" | 4948 | (defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" "bbdb" "vm" |
| 4707 | "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp")) | 4949 | "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp" "message")) |
| 4708 | (defvar org-link-re-with-space nil | 4950 | (defvar org-link-re-with-space nil |
| 4709 | "Matches a link with spaces, optional angular brackets around it.") | 4951 | "Matches a link with spaces, optional angular brackets around it.") |
| 4710 | (defvar org-link-re-with-space2 nil | 4952 | (defvar org-link-re-with-space2 nil |
| @@ -4749,7 +4991,7 @@ This should be called after the variable `org-link-types' has changed." | |||
| 4749 | "\\)>") | 4991 | "\\)>") |
| 4750 | org-plain-link-re | 4992 | org-plain-link-re |
| 4751 | (concat | 4993 | (concat |
| 4752 | "\\(" (mapconcat 'identity org-link-types "\\|") "\\):" | 4994 | "\\<\\(" (mapconcat 'identity org-link-types "\\|") "\\):" |
| 4753 | "\\([^]\t\n\r<>,;() ]+\\)") | 4995 | "\\([^]\t\n\r<>,;() ]+\\)") |
| 4754 | org-bracket-link-regexp | 4996 | org-bracket-link-regexp |
| 4755 | "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" | 4997 | "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" |
| @@ -4810,7 +5052,12 @@ The time stamps may be either active or inactive.") | |||
| 4810 | org-emphasis-alist))) | 5052 | org-emphasis-alist))) |
| 4811 | (add-text-properties (match-beginning 2) (match-end 2) | 5053 | (add-text-properties (match-beginning 2) (match-end 2) |
| 4812 | '(font-lock-multiline t)) | 5054 | '(font-lock-multiline t)) |
| 4813 | (backward-char 1)))) | 5055 | (when org-hide-emphasis-markers |
| 5056 | (add-text-properties (match-end 4) (match-beginning 5) | ||
| 5057 | '(invisible org-link)) | ||
| 5058 | (add-text-properties (match-beginning 3) (match-end 3) | ||
| 5059 | '(invisible org-link))))) | ||
| 5060 | (backward-char 1)) | ||
| 4814 | rtn)) | 5061 | rtn)) |
| 4815 | 5062 | ||
| 4816 | (defun org-emphasize (&optional char) | 5063 | (defun org-emphasize (&optional char) |
| @@ -4925,10 +5172,10 @@ We use a macro so that the test can happen at compilation time." | |||
| 4925 | (ip (org-maybe-intangible | 5172 | (ip (org-maybe-intangible |
| 4926 | (list 'invisible 'org-link 'rear-nonsticky org-nonsticky-props | 5173 | (list 'invisible 'org-link 'rear-nonsticky org-nonsticky-props |
| 4927 | 'keymap org-mouse-map 'mouse-face 'highlight | 5174 | 'keymap org-mouse-map 'mouse-face 'highlight |
| 4928 | 'help-echo help))) | 5175 | 'font-lock-multiline t 'help-echo help))) |
| 4929 | (vp (list 'rear-nonsticky org-nonsticky-props | 5176 | (vp (list 'rear-nonsticky org-nonsticky-props |
| 4930 | 'keymap org-mouse-map 'mouse-face 'highlight | 5177 | 'keymap org-mouse-map 'mouse-face 'highlight |
| 4931 | 'help-echo help))) | 5178 | ' font-lock-multiline t 'help-echo help))) |
| 4932 | ;; We need to remove the invisible property here. Table narrowing | 5179 | ;; We need to remove the invisible property here. Table narrowing |
| 4933 | ;; may have made some of this invisible. | 5180 | ;; may have made some of this invisible. |
| 4934 | (remove-text-properties (match-beginning 0) (match-end 0) | 5181 | (remove-text-properties (match-beginning 0) (match-end 0) |
| @@ -4998,6 +5245,97 @@ We use a macro so that the test can happen at compilation time." | |||
| 4998 | (goto-char e) | 5245 | (goto-char e) |
| 4999 | t))) | 5246 | t))) |
| 5000 | 5247 | ||
| 5248 | (defvar org-latex-and-specials-regexp nil | ||
| 5249 | "Regular expression for highlighting export special stuff.") | ||
| 5250 | (defvar org-match-substring-regexp) | ||
| 5251 | (defvar org-match-substring-with-braces-regexp) | ||
| 5252 | (defvar org-export-html-special-string-regexps) | ||
| 5253 | |||
| 5254 | (defun org-compute-latex-and-specials-regexp () | ||
| 5255 | "Compute regular expression for stuff treated specially by exporters." | ||
| 5256 | (if (not org-highlight-latex-fragments-and-specials) | ||
| 5257 | (org-set-local 'org-latex-and-specials-regexp nil) | ||
| 5258 | (let* | ||
| 5259 | ((matchers (plist-get org-format-latex-options :matchers)) | ||
| 5260 | (latexs (delq nil (mapcar (lambda (x) (if (member (car x) matchers) x)) | ||
| 5261 | org-latex-regexps))) | ||
| 5262 | (options (org-combine-plists (org-default-export-plist) | ||
| 5263 | (org-infile-export-plist))) | ||
| 5264 | (org-export-with-sub-superscripts (plist-get options :sub-superscript)) | ||
| 5265 | (org-export-with-LaTeX-fragments (plist-get options :LaTeX-fragments)) | ||
| 5266 | (org-export-with-TeX-macros (plist-get options :TeX-macros)) | ||
| 5267 | (org-export-html-expand (plist-get options :expand-quoted-html)) | ||
| 5268 | (org-export-with-special-strings (plist-get options :special-strings)) | ||
| 5269 | (re-sub | ||
| 5270 | (cond | ||
| 5271 | ((equal org-export-with-sub-superscripts '{}) | ||
| 5272 | (list org-match-substring-with-braces-regexp)) | ||
| 5273 | (org-export-with-sub-superscripts | ||
| 5274 | (list org-match-substring-regexp)) | ||
| 5275 | (t nil))) | ||
| 5276 | (re-latex | ||
| 5277 | (if org-export-with-LaTeX-fragments | ||
| 5278 | (mapcar (lambda (x) (nth 1 x)) latexs))) | ||
| 5279 | (re-macros | ||
| 5280 | (if org-export-with-TeX-macros | ||
| 5281 | (list (concat "\\\\" | ||
| 5282 | (regexp-opt | ||
| 5283 | (append (mapcar 'car org-html-entities) | ||
| 5284 | (if (boundp 'org-latex-entities) | ||
| 5285 | org-latex-entities nil)) | ||
| 5286 | 'words))) ; FIXME | ||
| 5287 | )) | ||
| 5288 | ;; (list "\\\\\\(?:[a-zA-Z]+\\)"))) | ||
| 5289 | (re-special (if org-export-with-special-strings | ||
| 5290 | (mapcar (lambda (x) (car x)) | ||
| 5291 | org-export-html-special-string-regexps))) | ||
| 5292 | (re-rest | ||
| 5293 | (delq nil | ||
| 5294 | (list | ||
| 5295 | (if org-export-html-expand "@<[^>\n]+>") | ||
| 5296 | )))) | ||
| 5297 | (org-set-local | ||
| 5298 | 'org-latex-and-specials-regexp | ||
| 5299 | (mapconcat 'identity (append re-latex re-sub re-macros re-special | ||
| 5300 | re-rest) "\\|"))))) | ||
| 5301 | |||
| 5302 | (defface org-latex-and-export-specials | ||
| 5303 | (let ((font (cond ((assq :inherit custom-face-attributes) | ||
| 5304 | '(:inherit underline)) | ||
| 5305 | (t '(:underline t))))) | ||
| 5306 | `((((class grayscale) (background light)) | ||
| 5307 | (:foreground "DimGray" ,@font)) | ||
| 5308 | (((class grayscale) (background dark)) | ||
| 5309 | (:foreground "LightGray" ,@font)) | ||
| 5310 | (((class color) (background light)) | ||
| 5311 | (:foreground "SaddleBrown")) | ||
| 5312 | (((class color) (background dark)) | ||
| 5313 | (:foreground "burlywood")) | ||
| 5314 | (t (,@font)))) | ||
| 5315 | "Face used to highlight math latex and other special exporter stuff." | ||
| 5316 | :group 'org-faces) | ||
| 5317 | |||
| 5318 | (defun org-do-latex-and-special-faces (limit) | ||
| 5319 | "Run through the buffer and add overlays to links." | ||
| 5320 | (when org-latex-and-specials-regexp | ||
| 5321 | (let (rtn d) | ||
| 5322 | (while (and (not rtn) (re-search-forward org-latex-and-specials-regexp | ||
| 5323 | limit t)) | ||
| 5324 | (if (not (memq (car-safe (get-text-property (1+ (match-beginning 0)) | ||
| 5325 | 'face)) | ||
| 5326 | '(org-code org-verbatim underline))) | ||
| 5327 | (progn | ||
| 5328 | (setq rtn t | ||
| 5329 | d (cond ((member (char-after (1+ (match-beginning 0))) | ||
| 5330 | '(?_ ?^)) 1) | ||
| 5331 | (t 0))) | ||
| 5332 | (font-lock-prepend-text-property | ||
| 5333 | (+ d (match-beginning 0)) (match-end 0) | ||
| 5334 | 'face 'org-latex-and-export-specials) | ||
| 5335 | (add-text-properties (+ d (match-beginning 0)) (match-end 0) | ||
| 5336 | '(font-lock-multiline t))))) | ||
| 5337 | rtn))) | ||
| 5338 | |||
| 5001 | (defun org-restart-font-lock () | 5339 | (defun org-restart-font-lock () |
| 5002 | "Restart font-lock-mode, to force refontification." | 5340 | "Restart font-lock-mode, to force refontification." |
| 5003 | (when (and (boundp 'font-lock-mode) font-lock-mode) | 5341 | (when (and (boundp 'font-lock-mode) font-lock-mode) |
| @@ -5064,7 +5402,7 @@ between words." | |||
| 5064 | '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" | 5402 | '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" |
| 5065 | (1 'org-table t)) | 5403 | (1 'org-table t)) |
| 5066 | ;; Table internals | 5404 | ;; Table internals |
| 5067 | '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t)) | 5405 | '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t)) |
| 5068 | '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) | 5406 | '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) |
| 5069 | '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) | 5407 | '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) |
| 5070 | ;; Drawers | 5408 | ;; Drawers |
| @@ -5113,14 +5451,17 @@ between words." | |||
| 5113 | (if org-provide-checkbox-statistics | 5451 | (if org-provide-checkbox-statistics |
| 5114 | '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" | 5452 | '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" |
| 5115 | (0 (org-get-checkbox-statistics-face) t))) | 5453 | (0 (org-get-checkbox-statistics-face) t))) |
| 5454 | (list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)") | ||
| 5455 | '(1 'org-archived prepend)) | ||
| 5456 | ;; Specials | ||
| 5457 | '(org-do-latex-and-special-faces) | ||
| 5458 | ;; Code | ||
| 5459 | '(org-activate-code (1 'org-code t)) | ||
| 5116 | ;; COMMENT | 5460 | ;; COMMENT |
| 5117 | (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string | 5461 | (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string |
| 5118 | "\\|" org-quote-string "\\)\\>") | 5462 | "\\|" org-quote-string "\\)\\>") |
| 5119 | '(1 'org-special-keyword t)) | 5463 | '(1 'org-special-keyword t)) |
| 5120 | '("^#.*" (0 'font-lock-comment-face t)) | 5464 | '("^#.*" (0 'font-lock-comment-face t)) |
| 5121 | '("^\\*+ \\(.*:ARCHIVE:.*\\)" (1 'org-archived prepend)) | ||
| 5122 | ;; Code | ||
| 5123 | '(org-activate-code (1 'org-code t)) | ||
| 5124 | ))) | 5465 | ))) |
| 5125 | (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) | 5466 | (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) |
| 5126 | ;; Now set the full font-lock-keywords | 5467 | ;; Now set the full font-lock-keywords |
| @@ -5345,12 +5686,12 @@ If KWD is a number, get the corresponding match group." | |||
| 5345 | (>= (match-end 0) pos)))) | 5686 | (>= (match-end 0) pos)))) |
| 5346 | t | 5687 | t |
| 5347 | (eq org-cycle-emulate-tab t)) | 5688 | (eq org-cycle-emulate-tab t)) |
| 5348 | (if (and (looking-at "[ \n\r\t]") | 5689 | ; (if (and (looking-at "[ \n\r\t]") |
| 5349 | (string-match "^[ \t]*$" (buffer-substring | 5690 | ; (string-match "^[ \t]*$" (buffer-substring |
| 5350 | (point-at-bol) (point)))) | 5691 | ; (point-at-bol) (point)))) |
| 5351 | (progn | 5692 | ; (progn |
| 5352 | (beginning-of-line 1) | 5693 | ; (beginning-of-line 1) |
| 5353 | (and (looking-at "[ \t]+") (replace-match "")))) | 5694 | ; (and (looking-at "[ \t]+") (replace-match "")))) |
| 5354 | (call-interactively (global-key-binding "\t"))) | 5695 | (call-interactively (global-key-binding "\t"))) |
| 5355 | 5696 | ||
| 5356 | (t (save-excursion | 5697 | (t (save-excursion |
| @@ -5418,6 +5759,17 @@ This function is the default value of the hook `org-cycle-hook'." | |||
| 5418 | ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) | 5759 | ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) |
| 5419 | ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) | 5760 | ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) |
| 5420 | 5761 | ||
| 5762 | (defun org-compact-display-after-subtree-move () | ||
| 5763 | (let (beg end) | ||
| 5764 | (save-excursion | ||
| 5765 | (if (org-up-heading-safe) | ||
| 5766 | (progn | ||
| 5767 | (hide-subtree) | ||
| 5768 | (show-entry) | ||
| 5769 | (show-children) | ||
| 5770 | (org-cycle-show-empty-lines 'children) | ||
| 5771 | (org-cycle-hide-drawers 'children)) | ||
| 5772 | (org-overview))))) | ||
| 5421 | 5773 | ||
| 5422 | (defun org-cycle-show-empty-lines (state) | 5774 | (defun org-cycle-show-empty-lines (state) |
| 5423 | "Show empty lines above all visible headlines. | 5775 | "Show empty lines above all visible headlines. |
| @@ -5508,6 +5860,8 @@ RET=jump to location [Q]uit and return to previous location | |||
| 5508 | \[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur" | 5860 | \[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur" |
| 5509 | ) | 5861 | ) |
| 5510 | 5862 | ||
| 5863 | (defvar org-goto-start-pos) ; dynamically scoped parameter | ||
| 5864 | |||
| 5511 | (defun org-goto () | 5865 | (defun org-goto () |
| 5512 | "Look up a different location in the current file, keeping current visibility. | 5866 | "Look up a different location in the current file, keeping current visibility. |
| 5513 | 5867 | ||
| @@ -5631,8 +5985,10 @@ or nil." | |||
| 5631 | "Create indirect buffer and narrow it to current subtree. | 5985 | "Create indirect buffer and narrow it to current subtree. |
| 5632 | With numerical prefix ARG, go up to this level and then take that tree. | 5986 | With numerical prefix ARG, go up to this level and then take that tree. |
| 5633 | If ARG is negative, go up that many levels. | 5987 | If ARG is negative, go up that many levels. |
| 5634 | Normally this command removes the indirect buffer previously made | 5988 | If `org-indirect-buffer-display' is not `new-frame', the command removes the |
| 5635 | with this command. However, when called with a C-u prefix, the last buffer | 5989 | indirect buffer previously made with this command, to avoid proliferation of |
| 5990 | indirect buffers. However, when you call the command with a `C-u' prefix, or | ||
| 5991 | when `org-indirect-buffer-display' is `new-frame', the last buffer | ||
| 5636 | is kept so that you can work with several indirect buffers at the same time. | 5992 | is kept so that you can work with several indirect buffers at the same time. |
| 5637 | If `org-indirect-buffer-display' is `dedicated-frame', the C-u prefix also | 5993 | If `org-indirect-buffer-display' is `dedicated-frame', the C-u prefix also |
| 5638 | requests that a new frame be made for the new buffer, so that the dedicated | 5994 | requests that a new frame be made for the new buffer, so that the dedicated |
| @@ -5652,8 +6008,9 @@ frame is not changed." | |||
| 5652 | (setq beg (point) | 6008 | (setq beg (point) |
| 5653 | heading (org-get-heading)) | 6009 | heading (org-get-heading)) |
| 5654 | (org-end-of-subtree t) (setq end (point))) | 6010 | (org-end-of-subtree t) (setq end (point))) |
| 5655 | (if (and (not arg) | 6011 | (if (and (buffer-live-p org-last-indirect-buffer) |
| 5656 | (buffer-live-p org-last-indirect-buffer)) | 6012 | (not (eq org-indirect-buffer-display 'new-frame)) |
| 6013 | (not arg)) | ||
| 5657 | (kill-buffer org-last-indirect-buffer)) | 6014 | (kill-buffer org-last-indirect-buffer)) |
| 5658 | (setq ibuf (org-get-indirect-buffer cbuf) | 6015 | (setq ibuf (org-get-indirect-buffer cbuf) |
| 5659 | org-last-indirect-buffer ibuf) | 6016 | org-last-indirect-buffer ibuf) |
| @@ -5917,7 +6274,8 @@ would end up with no indentation after the change, nothing at all is done." | |||
| 5917 | col) | 6274 | col) |
| 5918 | (unless (save-excursion (end-of-line 1) | 6275 | (unless (save-excursion (end-of-line 1) |
| 5919 | (re-search-forward prohibit end t)) | 6276 | (re-search-forward prohibit end t)) |
| 5920 | (while (re-search-forward "^[ \t]+" end t) | 6277 | (while (and (< (point) end) |
| 6278 | (re-search-forward "^[ \t]+" end t)) | ||
| 5921 | (goto-char (match-end 0)) | 6279 | (goto-char (match-end 0)) |
| 5922 | (setq col (current-column)) | 6280 | (setq col (current-column)) |
| 5923 | (if (< diff 0) (replace-match "")) | 6281 | (if (< diff 0) (replace-match "")) |
| @@ -5980,38 +6338,65 @@ is signaled in this case." | |||
| 5980 | 'outline-get-last-sibling)) | 6338 | 'outline-get-last-sibling)) |
| 5981 | (ins-point (make-marker)) | 6339 | (ins-point (make-marker)) |
| 5982 | (cnt (abs arg)) | 6340 | (cnt (abs arg)) |
| 5983 | beg end txt folded) | 6341 | beg beg0 end txt folded ne-beg ne-end ne-ins ins-end) |
| 5984 | ;; Select the tree | 6342 | ;; Select the tree |
| 5985 | (org-back-to-heading) | 6343 | (org-back-to-heading) |
| 5986 | (setq beg (point)) | 6344 | (setq beg0 (point)) |
| 6345 | (save-excursion | ||
| 6346 | (setq ne-beg (org-back-over-empty-lines)) | ||
| 6347 | (setq beg (point))) | ||
| 5987 | (save-match-data | 6348 | (save-match-data |
| 5988 | (save-excursion (outline-end-of-heading) | 6349 | (save-excursion (outline-end-of-heading) |
| 5989 | (setq folded (org-invisible-p))) | 6350 | (setq folded (org-invisible-p))) |
| 5990 | (outline-end-of-subtree)) | 6351 | (outline-end-of-subtree)) |
| 5991 | (outline-next-heading) | 6352 | (outline-next-heading) |
| 6353 | (setq ne-end (org-back-over-empty-lines)) | ||
| 5992 | (setq end (point)) | 6354 | (setq end (point)) |
| 6355 | (goto-char beg0) | ||
| 6356 | (when (and (> arg 0) (org-first-sibling-p) (< ne-end ne-beg)) | ||
| 6357 | ;; include less whitespace | ||
| 6358 | (save-excursion | ||
| 6359 | (goto-char beg) | ||
| 6360 | (forward-line (- ne-beg ne-end)) | ||
| 6361 | (setq beg (point)))) | ||
| 5993 | ;; Find insertion point, with error handling | 6362 | ;; Find insertion point, with error handling |
| 5994 | (goto-char beg) | ||
| 5995 | (while (> cnt 0) | 6363 | (while (> cnt 0) |
| 5996 | (or (and (funcall movfunc) (looking-at outline-regexp)) | 6364 | (or (and (funcall movfunc) (looking-at outline-regexp)) |
| 5997 | (progn (goto-char beg) | 6365 | (progn (goto-char beg0) |
| 5998 | (error "Cannot move past superior level or buffer limit"))) | 6366 | (error "Cannot move past superior level or buffer limit"))) |
| 5999 | (setq cnt (1- cnt))) | 6367 | (setq cnt (1- cnt))) |
| 6000 | (if (> arg 0) | 6368 | (if (> arg 0) |
| 6001 | ;; Moving forward - still need to move over subtree | 6369 | ;; Moving forward - still need to move over subtree |
| 6002 | (progn (outline-end-of-subtree) | 6370 | (progn (org-end-of-subtree t t) |
| 6003 | (outline-next-heading) | 6371 | (save-excursion |
| 6004 | (if (not (or (looking-at (concat "^" outline-regexp)) | 6372 | (org-back-over-empty-lines) |
| 6005 | (bolp))) | 6373 | (or (bolp) (newline))))) |
| 6006 | (newline)))) | 6374 | (setq ne-ins (org-back-over-empty-lines)) |
| 6007 | (move-marker ins-point (point)) | 6375 | (move-marker ins-point (point)) |
| 6008 | (setq txt (buffer-substring beg end)) | 6376 | (setq txt (buffer-substring beg end)) |
| 6009 | (delete-region beg end) | 6377 | (delete-region beg end) |
| 6378 | (outline-flag-region (1- beg) beg nil) | ||
| 6379 | (outline-flag-region (1- (point)) (point) nil) | ||
| 6010 | (insert txt) | 6380 | (insert txt) |
| 6011 | (or (bolp) (insert "\n")) | 6381 | (or (bolp) (insert "\n")) |
| 6382 | (setq ins-end (point)) | ||
| 6012 | (goto-char ins-point) | 6383 | (goto-char ins-point) |
| 6013 | (if folded (hide-subtree)) | 6384 | (org-skip-whitespace) |
| 6014 | (move-marker ins-point nil))) | 6385 | (when (and (< arg 0) |
| 6386 | (org-first-sibling-p) | ||
| 6387 | (> ne-ins ne-beg)) | ||
| 6388 | ;; Move whitespace back to beginning | ||
| 6389 | (save-excursion | ||
| 6390 | (goto-char ins-end) | ||
| 6391 | (let ((kill-whole-line t)) | ||
| 6392 | (kill-line (- ne-ins ne-beg)) (point))) | ||
| 6393 | (insert (make-string (- ne-ins ne-beg) ?\n))) | ||
| 6394 | (move-marker ins-point nil) | ||
| 6395 | (org-compact-display-after-subtree-move) | ||
| 6396 | (unless folded | ||
| 6397 | (org-show-entry) | ||
| 6398 | (show-children) | ||
| 6399 | (org-cycle-hide-drawers 'children)))) | ||
| 6015 | 6400 | ||
| 6016 | (defvar org-subtree-clip "" | 6401 | (defvar org-subtree-clip "" |
| 6017 | "Clipboard for cut and paste of subtrees. | 6402 | "Clipboard for cut and paste of subtrees. |
| @@ -6035,11 +6420,13 @@ With prefix arg N, cut this many sequential subtrees. | |||
| 6035 | This is a short-hand for marking the subtree and then copying it. | 6420 | This is a short-hand for marking the subtree and then copying it. |
| 6036 | If CUT is non-nil, actually cut the subtree." | 6421 | If CUT is non-nil, actually cut the subtree." |
| 6037 | (interactive "p") | 6422 | (interactive "p") |
| 6038 | (let (beg end folded) | 6423 | (let (beg end folded (beg0 (point))) |
| 6039 | (if (interactive-p) | 6424 | (if (interactive-p) |
| 6040 | (org-back-to-heading nil) ; take what looks like a subtree | 6425 | (org-back-to-heading nil) ; take what looks like a subtree |
| 6041 | (org-back-to-heading t)) ; take what is really there | 6426 | (org-back-to-heading t)) ; take what is really there |
| 6427 | (org-back-over-empty-lines) | ||
| 6042 | (setq beg (point)) | 6428 | (setq beg (point)) |
| 6429 | (skip-chars-forward " \t\r\n") | ||
| 6043 | (save-match-data | 6430 | (save-match-data |
| 6044 | (save-excursion (outline-end-of-heading) | 6431 | (save-excursion (outline-end-of-heading) |
| 6045 | (setq folded (org-invisible-p))) | 6432 | (setq folded (org-invisible-p))) |
| @@ -6047,8 +6434,9 @@ If CUT is non-nil, actually cut the subtree." | |||
| 6047 | (outline-forward-same-level (1- n)) | 6434 | (outline-forward-same-level (1- n)) |
| 6048 | (error nil)) | 6435 | (error nil)) |
| 6049 | (org-end-of-subtree t t)) | 6436 | (org-end-of-subtree t t)) |
| 6437 | (org-back-over-empty-lines) | ||
| 6050 | (setq end (point)) | 6438 | (setq end (point)) |
| 6051 | (goto-char beg) | 6439 | (goto-char beg0) |
| 6052 | (when (> end beg) | 6440 | (when (> end beg) |
| 6053 | (setq org-subtree-clip-folded folded) | 6441 | (setq org-subtree-clip-folded folded) |
| 6054 | (if cut (kill-region beg end) (copy-region-as-kill beg end)) | 6442 | (if cut (kill-region beg end) (copy-region-as-kill beg end)) |
| @@ -6124,11 +6512,14 @@ If optional TREE is given, use this text instead of the kill ring." | |||
| 6124 | (delete-region (point-at-bol) (point))) | 6512 | (delete-region (point-at-bol) (point))) |
| 6125 | ;; Paste | 6513 | ;; Paste |
| 6126 | (beginning-of-line 1) | 6514 | (beginning-of-line 1) |
| 6515 | (org-back-over-empty-lines) ;; FIXME: correct fix???? | ||
| 6127 | (setq beg (point)) | 6516 | (setq beg (point)) |
| 6128 | (insert txt) | 6517 | (insert-before-markers txt) ;; FIXME: correct fix???? |
| 6129 | (unless (string-match "\n[ \t]*\\'" txt) (insert "\n")) | 6518 | (unless (string-match "\n\\'" txt) (insert "\n")) |
| 6130 | (setq end (point)) | 6519 | (setq end (point)) |
| 6131 | (goto-char beg) | 6520 | (goto-char beg) |
| 6521 | (skip-chars-forward " \t\n\r") | ||
| 6522 | (setq beg (point)) | ||
| 6132 | ;; Shift if necessary | 6523 | ;; Shift if necessary |
| 6133 | (unless (= shift 0) | 6524 | (unless (= shift 0) |
| 6134 | (save-restriction | 6525 | (save-restriction |
| @@ -6154,10 +6545,12 @@ which is OK for `org-paste-subtree'. | |||
| 6154 | If optional TXT is given, check this string instead of the current kill." | 6545 | If optional TXT is given, check this string instead of the current kill." |
| 6155 | (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) | 6546 | (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) |
| 6156 | (start-level (and kill | 6547 | (start-level (and kill |
| 6157 | (string-match (concat "\\`" org-outline-regexp) kill) | 6548 | (string-match (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" |
| 6158 | (- (match-end 0) (match-beginning 0) 1))) | 6549 | org-outline-regexp "\\)") |
| 6550 | kill) | ||
| 6551 | (- (match-end 2) (match-beginning 2) 1))) | ||
| 6159 | (re (concat "^" org-outline-regexp)) | 6552 | (re (concat "^" org-outline-regexp)) |
| 6160 | (start 1)) | 6553 | (start (1+ (match-beginning 2)))) |
| 6161 | (if (not start-level) | 6554 | (if (not start-level) |
| 6162 | (progn | 6555 | (progn |
| 6163 | nil) ;; does not even start with a heading | 6556 | nil) ;; does not even start with a heading |
| @@ -6228,7 +6621,11 @@ WITH-CASE, the sorting considers case as well." | |||
| 6228 | (condition-case nil (progn (org-back-to-heading) t) (error nil))) | 6621 | (condition-case nil (progn (org-back-to-heading) t) (error nil))) |
| 6229 | ;; we will sort the children of the current headline | 6622 | ;; we will sort the children of the current headline |
| 6230 | (org-back-to-heading) | 6623 | (org-back-to-heading) |
| 6231 | (setq start (point) end (org-end-of-subtree) what "children") | 6624 | (setq start (point) |
| 6625 | end (progn (org-end-of-subtree t t) | ||
| 6626 | (org-back-over-empty-lines) | ||
| 6627 | (point)) | ||
| 6628 | what "children") | ||
| 6232 | (goto-char start) | 6629 | (goto-char start) |
| 6233 | (show-subtree) | 6630 | (show-subtree) |
| 6234 | (outline-next-heading)) | 6631 | (outline-next-heading)) |
| @@ -6309,12 +6706,12 @@ WITH-CASE, the sorting considers case as well." | |||
| 6309 | (cond | 6706 | (cond |
| 6310 | ((= dcst ?n) | 6707 | ((= dcst ?n) |
| 6311 | (string-to-number (buffer-substring (match-end 0) | 6708 | (string-to-number (buffer-substring (match-end 0) |
| 6312 | (line-end-position)))) | 6709 | (point-at-eol)))) |
| 6313 | ((= dcst ?a) | 6710 | ((= dcst ?a) |
| 6314 | (buffer-substring (match-end 0) (line-end-position))) | 6711 | (buffer-substring (match-end 0) (point-at-eol))) |
| 6315 | ((= dcst ?t) | 6712 | ((= dcst ?t) |
| 6316 | (if (re-search-forward org-ts-regexp | 6713 | (if (re-search-forward org-ts-regexp |
| 6317 | (line-end-position) t) | 6714 | (point-at-eol) t) |
| 6318 | (org-time-string-to-time (match-string 0)) | 6715 | (org-time-string-to-time (match-string 0)) |
| 6319 | now)) | 6716 | now)) |
| 6320 | ((= dcst ?f) | 6717 | ((= dcst ?f) |
| @@ -6330,11 +6727,11 @@ WITH-CASE, the sorting considers case as well." | |||
| 6330 | ((= dcst ?n) | 6727 | ((= dcst ?n) |
| 6331 | (if (looking-at outline-regexp) | 6728 | (if (looking-at outline-regexp) |
| 6332 | (string-to-number (buffer-substring (match-end 0) | 6729 | (string-to-number (buffer-substring (match-end 0) |
| 6333 | (line-end-position))) | 6730 | (point-at-eol))) |
| 6334 | nil)) | 6731 | nil)) |
| 6335 | ((= dcst ?a) | 6732 | ((= dcst ?a) |
| 6336 | (funcall case-func (buffer-substring (line-beginning-position) | 6733 | (funcall case-func (buffer-substring (point-at-bol) |
| 6337 | (line-end-position)))) | 6734 | (point-at-eol)))) |
| 6338 | ((= dcst ?t) | 6735 | ((= dcst ?t) |
| 6339 | (if (re-search-forward org-ts-regexp | 6736 | (if (re-search-forward org-ts-regexp |
| 6340 | (save-excursion | 6737 | (save-excursion |
| @@ -6343,7 +6740,7 @@ WITH-CASE, the sorting considers case as well." | |||
| 6343 | (org-time-string-to-time (match-string 0)) | 6740 | (org-time-string-to-time (match-string 0)) |
| 6344 | now)) | 6741 | now)) |
| 6345 | ((= dcst ?p) | 6742 | ((= dcst ?p) |
| 6346 | (if (re-search-forward org-priority-regexp (line-end-position) t) | 6743 | (if (re-search-forward org-priority-regexp (point-at-eol) t) |
| 6347 | (string-to-char (match-string 2)) | 6744 | (string-to-char (match-string 2)) |
| 6348 | org-default-priority)) | 6745 | org-default-priority)) |
| 6349 | ((= dcst ?r) | 6746 | ((= dcst ?r) |
| @@ -6383,7 +6780,8 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." | |||
| 6383 | (setq extractfun 'string-to-number | 6780 | (setq extractfun 'string-to-number |
| 6384 | comparefun (if (= dcst sorting-type) '< '>))) | 6781 | comparefun (if (= dcst sorting-type) '< '>))) |
| 6385 | ((= dcst ?a) | 6782 | ((= dcst ?a) |
| 6386 | (setq extractfun (if with-case 'identity 'downcase) | 6783 | (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x)) |
| 6784 | (lambda(x) (downcase (org-sort-remove-invisible x)))) | ||
| 6387 | comparefun (if (= dcst sorting-type) | 6785 | comparefun (if (= dcst sorting-type) |
| 6388 | 'string< | 6786 | 'string< |
| 6389 | (lambda (a b) (and (not (string< a b)) | 6787 | (lambda (a b) (and (not (string< a b)) |
| @@ -6483,12 +6881,13 @@ Return t when things worked, nil when we are not in an item." | |||
| 6483 | ((org-on-heading-p) | 6881 | ((org-on-heading-p) |
| 6484 | (setq beg (point) end (save-excursion (outline-next-heading) (point)))) | 6882 | (setq beg (point) end (save-excursion (outline-next-heading) (point)))) |
| 6485 | ((org-at-item-checkbox-p) | 6883 | ((org-at-item-checkbox-p) |
| 6486 | (save-excursion | 6884 | (let ((pos (point))) |
| 6487 | (replace-match | 6885 | (replace-match |
| 6488 | (cond (arg "[-]") | 6886 | (cond (arg "[-]") |
| 6489 | ((member (match-string 0) '("[ ]" "[-]")) "[X]") | 6887 | ((member (match-string 0) '("[ ]" "[-]")) "[X]") |
| 6490 | (t "[ ]")) | 6888 | (t "[ ]")) |
| 6491 | t t)) | 6889 | t t) |
| 6890 | (goto-char pos)) | ||
| 6492 | (throw 'exit t)) | 6891 | (throw 'exit t)) |
| 6493 | (t (error "Not at a checkbox or heading, and no active region"))) | 6892 | (t (error "Not at a checkbox or heading, and no active region"))) |
| 6494 | (save-excursion | 6893 | (save-excursion |
| @@ -6707,27 +7106,49 @@ Error if not at a plain list, or if this is the first item in the list." | |||
| 6707 | (error (goto-char pos) | 7106 | (error (goto-char pos) |
| 6708 | (error "On first item"))))) | 7107 | (error "On first item"))))) |
| 6709 | 7108 | ||
| 7109 | (defun org-first-list-item-p () | ||
| 7110 | "Is this heading the item in a plain list?" | ||
| 7111 | (unless (org-at-item-p) | ||
| 7112 | (error "Not at a plain list item")) | ||
| 7113 | (org-beginning-of-item) | ||
| 7114 | (= (point) (save-excursion (org-beginning-of-item-list)))) | ||
| 7115 | |||
| 6710 | (defun org-move-item-down () | 7116 | (defun org-move-item-down () |
| 6711 | "Move the plain list item at point down, i.e. swap with following item. | 7117 | "Move the plain list item at point down, i.e. swap with following item. |
| 6712 | Subitems (items with larger indentation) are considered part of the item, | 7118 | Subitems (items with larger indentation) are considered part of the item, |
| 6713 | so this really moves item trees." | 7119 | so this really moves item trees." |
| 6714 | (interactive) | 7120 | (interactive) |
| 6715 | (let (beg end ind ind1 (pos (point)) txt) | 7121 | (let (beg beg0 end end0 ind ind1 (pos (point)) txt ne-end ne-beg) |
| 6716 | (org-beginning-of-item) | 7122 | (org-beginning-of-item) |
| 6717 | (setq beg (point)) | 7123 | (setq beg0 (point)) |
| 7124 | (save-excursion | ||
| 7125 | (setq ne-beg (org-back-over-empty-lines)) | ||
| 7126 | (setq beg (point))) | ||
| 7127 | (goto-char beg0) | ||
| 6718 | (setq ind (org-get-indentation)) | 7128 | (setq ind (org-get-indentation)) |
| 6719 | (org-end-of-item) | 7129 | (org-end-of-item) |
| 6720 | (setq end (point)) | 7130 | (setq end0 (point)) |
| 6721 | (setq ind1 (org-get-indentation)) | 7131 | (setq ind1 (org-get-indentation)) |
| 7132 | (setq ne-end (org-back-over-empty-lines)) | ||
| 7133 | (setq end (point)) | ||
| 7134 | (goto-char beg0) | ||
| 7135 | (when (and (org-first-list-item-p) (< ne-end ne-beg)) | ||
| 7136 | ;; include less whitespace | ||
| 7137 | (save-excursion | ||
| 7138 | (goto-char beg) | ||
| 7139 | (forward-line (- ne-beg ne-end)) | ||
| 7140 | (setq beg (point)))) | ||
| 7141 | (goto-char end0) | ||
| 6722 | (if (and (org-at-item-p) (= ind ind1)) | 7142 | (if (and (org-at-item-p) (= ind ind1)) |
| 6723 | (progn | 7143 | (progn |
| 6724 | (org-end-of-item) | 7144 | (org-end-of-item) |
| 7145 | (org-back-over-empty-lines) | ||
| 6725 | (setq txt (buffer-substring beg end)) | 7146 | (setq txt (buffer-substring beg end)) |
| 6726 | (save-excursion | 7147 | (save-excursion |
| 6727 | (delete-region beg end)) | 7148 | (delete-region beg end)) |
| 6728 | (setq pos (point)) | 7149 | (setq pos (point)) |
| 6729 | (insert txt) | 7150 | (insert txt) |
| 6730 | (goto-char pos) | 7151 | (goto-char pos) (org-skip-whitespace) |
| 6731 | (org-maybe-renumber-ordered-list)) | 7152 | (org-maybe-renumber-ordered-list)) |
| 6732 | (goto-char pos) | 7153 | (goto-char pos) |
| 6733 | (error "Cannot move this item further down")))) | 7154 | (error "Cannot move this item further down")))) |
| @@ -6737,13 +7158,19 @@ so this really moves item trees." | |||
| 6737 | Subitems (items with larger indentation) are considered part of the item, | 7158 | Subitems (items with larger indentation) are considered part of the item, |
| 6738 | so this really moves item trees." | 7159 | so this really moves item trees." |
| 6739 | (interactive "p") | 7160 | (interactive "p") |
| 6740 | (let (beg end ind ind1 (pos (point)) txt) | 7161 | (let (beg beg0 end end0 ind ind1 (pos (point)) txt |
| 7162 | ne-beg ne-end ne-ins ins-end) | ||
| 6741 | (org-beginning-of-item) | 7163 | (org-beginning-of-item) |
| 6742 | (setq beg (point)) | 7164 | (setq beg0 (point)) |
| 6743 | (setq ind (org-get-indentation)) | 7165 | (setq ind (org-get-indentation)) |
| 7166 | (save-excursion | ||
| 7167 | (setq ne-beg (org-back-over-empty-lines)) | ||
| 7168 | (setq beg (point))) | ||
| 7169 | (goto-char beg0) | ||
| 6744 | (org-end-of-item) | 7170 | (org-end-of-item) |
| 7171 | (setq ne-end (org-back-over-empty-lines)) | ||
| 6745 | (setq end (point)) | 7172 | (setq end (point)) |
| 6746 | (goto-char beg) | 7173 | (goto-char beg0) |
| 6747 | (catch 'exit | 7174 | (catch 'exit |
| 6748 | (while t | 7175 | (while t |
| 6749 | (beginning-of-line 0) | 7176 | (beginning-of-line 0) |
| @@ -6762,12 +7189,23 @@ so this really moves item trees." | |||
| 6762 | (setq ind1 (org-get-indentation)) | 7189 | (setq ind1 (org-get-indentation)) |
| 6763 | (if (and (org-at-item-p) (= ind ind1)) | 7190 | (if (and (org-at-item-p) (= ind ind1)) |
| 6764 | (progn | 7191 | (progn |
| 7192 | (setq ne-ins (org-back-over-empty-lines)) | ||
| 6765 | (setq txt (buffer-substring beg end)) | 7193 | (setq txt (buffer-substring beg end)) |
| 6766 | (save-excursion | 7194 | (save-excursion |
| 6767 | (delete-region beg end)) | 7195 | (delete-region beg end)) |
| 6768 | (setq pos (point)) | 7196 | (setq pos (point)) |
| 6769 | (insert txt) | 7197 | (insert txt) |
| 6770 | (goto-char pos) | 7198 | (setq ins-end (point)) |
| 7199 | (goto-char pos) (org-skip-whitespace) | ||
| 7200 | |||
| 7201 | (when (and (org-first-list-item-p) (> ne-ins ne-beg)) | ||
| 7202 | ;; Move whitespace back to beginning | ||
| 7203 | (save-excursion | ||
| 7204 | (goto-char ins-end) | ||
| 7205 | (let ((kill-whole-line t)) | ||
| 7206 | (kill-line (- ne-ins ne-beg)) (point))) | ||
| 7207 | (insert (make-string (- ne-ins ne-beg) ?\n))) | ||
| 7208 | |||
| 6771 | (org-maybe-renumber-ordered-list)) | 7209 | (org-maybe-renumber-ordered-list)) |
| 6772 | (goto-char pos) | 7210 | (goto-char pos) |
| 6773 | (error "Cannot move this item further up")))) | 7211 | (error "Cannot move this item further up")))) |
| @@ -7090,7 +7528,7 @@ C-c C-c Set tags / toggle checkbox" | |||
| 7090 | "Unconditionally turn on `orgstruct-mode', and force org-mode indentations. | 7528 | "Unconditionally turn on `orgstruct-mode', and force org-mode indentations. |
| 7091 | In addition to setting orgstruct-mode, this also exports all indentation and | 7529 | In addition to setting orgstruct-mode, this also exports all indentation and |
| 7092 | autofilling variables from org-mode into the buffer. Note that turning | 7530 | autofilling variables from org-mode into the buffer. Note that turning |
| 7093 | off orgstruct-mode will *not* remove these additonal settings." | 7531 | off orgstruct-mode will *not* remove these additional settings." |
| 7094 | (orgstruct-mode 1) | 7532 | (orgstruct-mode 1) |
| 7095 | (let (var val) | 7533 | (let (var val) |
| 7096 | (mapc | 7534 | (mapc |
| @@ -7105,7 +7543,7 @@ off orgstruct-mode will *not* remove these additonal settings." | |||
| 7105 | (defun orgstruct-error () | 7543 | (defun orgstruct-error () |
| 7106 | "Error when there is no default binding for a structure key." | 7544 | "Error when there is no default binding for a structure key." |
| 7107 | (interactive) | 7545 | (interactive) |
| 7108 | (error "This key is has no function outside structure elements")) | 7546 | (error "This key has no function outside structure elements")) |
| 7109 | 7547 | ||
| 7110 | (defun orgstruct-setup () | 7548 | (defun orgstruct-setup () |
| 7111 | "Setup orgstruct keymaps." | 7549 | "Setup orgstruct keymaps." |
| @@ -7252,7 +7690,8 @@ this heading." | |||
| 7252 | (this-buffer (current-buffer)) | 7690 | (this-buffer (current-buffer)) |
| 7253 | (org-archive-location org-archive-location) | 7691 | (org-archive-location org-archive-location) |
| 7254 | (re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$") | 7692 | (re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$") |
| 7255 | ;; start of variables that will be used for savind context | 7693 | ;; start of variables that will be used for saving context |
| 7694 | ;; The compiler complains about them - keep them anyway! | ||
| 7256 | (file (abbreviate-file-name (buffer-file-name))) | 7695 | (file (abbreviate-file-name (buffer-file-name))) |
| 7257 | (time (format-time-string | 7696 | (time (format-time-string |
| 7258 | (substring (cdr org-time-stamp-formats) 1 -1) | 7697 | (substring (cdr org-time-stamp-formats) 1 -1) |
| @@ -7469,7 +7908,8 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." | |||
| 7469 | (save-excursion | 7908 | (save-excursion |
| 7470 | (beginning-of-line 1) | 7909 | (beginning-of-line 1) |
| 7471 | (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") | 7910 | (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") |
| 7472 | (let ((b (match-end 0))) | 7911 | (let ((b (match-end 0)) |
| 7912 | (outline-regexp org-outline-regexp)) | ||
| 7473 | (if (re-search-forward | 7913 | (if (re-search-forward |
| 7474 | "^[ \t]*:END:" | 7914 | "^[ \t]*:END:" |
| 7475 | (save-excursion (outline-next-heading) (point)) t) | 7915 | (save-excursion (outline-next-heading) (point)) t) |
| @@ -7488,7 +7928,7 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." | |||
| 7488 | (goto-char beg) | 7928 | (goto-char beg) |
| 7489 | (if (looking-at (concat ".*:" org-archive-tag ":")) | 7929 | (if (looking-at (concat ".*:" org-archive-tag ":")) |
| 7490 | (message "%s" (substitute-command-keys | 7930 | (message "%s" (substitute-command-keys |
| 7491 | "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway."))))))) | 7931 | "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway."))))))) |
| 7492 | 7932 | ||
| 7493 | (defun org-force-cycle-archived () | 7933 | (defun org-force-cycle-archived () |
| 7494 | "Cycle subtree even if it is archived." | 7934 | "Cycle subtree even if it is archived." |
| @@ -7830,19 +8270,23 @@ This is being used to correctly align a single field after TAB or RET.") | |||
| 7830 | (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) | 8270 | (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) |
| 7831 | (hfmt1 (concat | 8271 | (hfmt1 (concat |
| 7832 | (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) | 8272 | (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) |
| 7833 | emptystrings links dates narrow fmax f1 len c e) | 8273 | emptystrings links dates emph narrow fmax f1 len c e) |
| 7834 | (untabify beg end) | 8274 | (untabify beg end) |
| 7835 | (remove-text-properties beg end '(org-cwidth t org-dwidth t display t)) | 8275 | (remove-text-properties beg end '(org-cwidth t org-dwidth t display t)) |
| 7836 | ;; Check if we have links or dates | 8276 | ;; Check if we have links or dates |
| 7837 | (goto-char beg) | 8277 | (goto-char beg) |
| 7838 | (setq links (re-search-forward org-bracket-link-regexp end t)) | 8278 | (setq links (re-search-forward org-bracket-link-regexp end t)) |
| 7839 | (goto-char beg) | 8279 | (goto-char beg) |
| 8280 | (setq emph (and org-hide-emphasis-markers | ||
| 8281 | (re-search-forward org-emph-re end t))) | ||
| 8282 | (goto-char beg) | ||
| 7840 | (setq dates (and org-display-custom-times | 8283 | (setq dates (and org-display-custom-times |
| 7841 | (re-search-forward org-ts-regexp-both end t))) | 8284 | (re-search-forward org-ts-regexp-both end t))) |
| 7842 | ;; Make sure the link properties are right | 8285 | ;; Make sure the link properties are right |
| 7843 | (when links (goto-char beg) (while (org-activate-bracket-links end))) | 8286 | (when links (goto-char beg) (while (org-activate-bracket-links end))) |
| 7844 | ;; Make sure the date properties are right | 8287 | ;; Make sure the date properties are right |
| 7845 | (when dates (goto-char beg) (while (org-activate-dates end))) | 8288 | (when dates (goto-char beg) (while (org-activate-dates end))) |
| 8289 | (when emph (goto-char beg) (while (org-do-emphasis-faces end))) | ||
| 7846 | 8290 | ||
| 7847 | ;; Check if we are narrowing any columns | 8291 | ;; Check if we are narrowing any columns |
| 7848 | (goto-char beg) | 8292 | (goto-char beg) |
| @@ -7923,13 +8367,14 @@ This is being used to correctly align a single field after TAB or RET.") | |||
| 7923 | 8367 | ||
| 7924 | ;; With invisible characters, `format' does not get the field width right | 8368 | ;; With invisible characters, `format' does not get the field width right |
| 7925 | ;; So we need to make these fields wide by hand. | 8369 | ;; So we need to make these fields wide by hand. |
| 7926 | (when links | 8370 | (when (or links emph) |
| 7927 | (loop for i from 0 upto (1- maxfields) do | 8371 | (loop for i from 0 upto (1- maxfields) do |
| 7928 | (setq len (nth i lengths)) | 8372 | (setq len (nth i lengths)) |
| 7929 | (loop for j from 0 upto (1- (length fields)) do | 8373 | (loop for j from 0 upto (1- (length fields)) do |
| 7930 | (setq c (nthcdr i (car (nthcdr j fields)))) | 8374 | (setq c (nthcdr i (car (nthcdr j fields)))) |
| 7931 | (if (and (stringp (car c)) | 8375 | (if (and (stringp (car c)) |
| 7932 | (string-match org-bracket-link-regexp (car c)) | 8376 | (text-property-any 0 (length (car c)) 'invisible 'org-link (car c)) |
| 8377 | ; (string-match org-bracket-link-regexp (car c)) | ||
| 7933 | (< (org-string-width (car c)) len)) | 8378 | (< (org-string-width (car c)) len)) |
| 7934 | (setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ ))))))) | 8379 | (setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ ))))))) |
| 7935 | 8380 | ||
| @@ -8653,7 +9098,11 @@ should be done in reverse order." | |||
| 8653 | (skip-chars-backward "^|") | 9098 | (skip-chars-backward "^|") |
| 8654 | (setq ecol (1- (current-column))) | 9099 | (setq ecol (1- (current-column))) |
| 8655 | (org-table-goto-column column) | 9100 | (org-table-goto-column column) |
| 8656 | (setq lns (mapcar (lambda(x) (cons (org-trim (substring x bcol ecol)) x)) | 9101 | (setq lns (mapcar (lambda(x) (cons |
| 9102 | (org-sort-remove-invisible | ||
| 9103 | (nth (1- column) | ||
| 9104 | (org-split-string x "[ \t]*|[ \t]*"))) | ||
| 9105 | x)) | ||
| 8657 | (org-split-string (buffer-substring beg end) "\n"))) | 9106 | (org-split-string (buffer-substring beg end) "\n"))) |
| 8658 | (setq lns (org-do-sort lns "Table" with-case sorting-type)) | 9107 | (setq lns (org-do-sort lns "Table" with-case sorting-type)) |
| 8659 | (delete-region beg end) | 9108 | (delete-region beg end) |
| @@ -8664,6 +9113,15 @@ should be done in reverse order." | |||
| 8664 | (org-table-goto-column thiscol) | 9113 | (org-table-goto-column thiscol) |
| 8665 | (message "%d lines sorted, based on column %d" (length lns) column))) | 9114 | (message "%d lines sorted, based on column %d" (length lns) column))) |
| 8666 | 9115 | ||
| 9116 | ;; FIXME: maybe we will not need this? Table sorting is broken.... | ||
| 9117 | (defun org-sort-remove-invisible (s) | ||
| 9118 | (remove-text-properties 0 (length s) org-rm-props s) | ||
| 9119 | (while (string-match org-bracket-link-regexp s) | ||
| 9120 | (setq s (replace-match (if (match-end 2) | ||
| 9121 | (match-string 3 s) | ||
| 9122 | (match-string 1 s)) t t s))) | ||
| 9123 | s) | ||
| 9124 | |||
| 8667 | (defun org-table-cut-region (beg end) | 9125 | (defun org-table-cut-region (beg end) |
| 8668 | "Copy region in table to the clipboard and blank all relevant fields." | 9126 | "Copy region in table to the clipboard and blank all relevant fields." |
| 8669 | (interactive "r") | 9127 | (interactive "r") |
| @@ -9366,8 +9824,7 @@ of the new mark." | |||
| 9366 | (goto-line l1))) | 9824 | (goto-line l1))) |
| 9367 | (if (not (= epos (point-at-eol))) (org-table-align)) | 9825 | (if (not (= epos (point-at-eol))) (org-table-align)) |
| 9368 | (goto-line l) | 9826 | (goto-line l) |
| 9369 | (and (interactive-p) | 9827 | (and (interactive-p) (message "%s" (cdr (assoc new org-recalc-marks)))))) |
| 9370 | (message "%s" (or (cdr (assoc new org-recalc-marks)) ""))))) | ||
| 9371 | 9828 | ||
| 9372 | (defun org-table-maybe-recalculate-line () | 9829 | (defun org-table-maybe-recalculate-line () |
| 9373 | "Recompute the current line if marked for it, and if we haven't just done it." | 9830 | "Recompute the current line if marked for it, and if we haven't just done it." |
| @@ -10679,7 +11136,7 @@ to execute outside of tables." | |||
| 10679 | (defun orgtbl-error () | 11136 | (defun orgtbl-error () |
| 10680 | "Error when there is no default binding for a table key." | 11137 | "Error when there is no default binding for a table key." |
| 10681 | (interactive) | 11138 | (interactive) |
| 10682 | (error "This key is has no function outside tables")) | 11139 | (error "This key has no function outside tables")) |
| 10683 | 11140 | ||
| 10684 | (defun orgtbl-setup () | 11141 | (defun orgtbl-setup () |
| 10685 | "Setup orgtbl keymaps." | 11142 | "Setup orgtbl keymaps." |
| @@ -11202,9 +11659,9 @@ TeXInfo are: | |||
| 11202 | %s for the original field value. For example, to wrap | 11659 | %s for the original field value. For example, to wrap |
| 11203 | everything in @kbd{}, you could use :fmt \"@kbd{%s}\". | 11660 | everything in @kbd{}, you could use :fmt \"@kbd{%s}\". |
| 11204 | This may also be a property list with column numbers and | 11661 | This may also be a property list with column numbers and |
| 11205 | formats. for example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\"). | 11662 | formats. For example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\"). |
| 11206 | 11663 | ||
| 11207 | :cf \"f1 f2..\" The column fractions for the table. Bye default these | 11664 | :cf \"f1 f2..\" The column fractions for the table. By default these |
| 11208 | are computed automatically from the width of the columns | 11665 | are computed automatically from the width of the columns |
| 11209 | under org-mode. | 11666 | under org-mode. |
| 11210 | 11667 | ||
| @@ -11265,7 +11722,7 @@ value. Each function should check if it is responsible for creating | |||
| 11265 | this link (for example by looking at the major mode). | 11722 | this link (for example by looking at the major mode). |
| 11266 | If not, it must exit and return nil. | 11723 | If not, it must exit and return nil. |
| 11267 | If yes, it should return a non-nil value after a calling | 11724 | If yes, it should return a non-nil value after a calling |
| 11268 | `org-store-link-properties' with a list of properties and values. | 11725 | `org-store-link-props' with a list of properties and values. |
| 11269 | Special properties are: | 11726 | Special properties are: |
| 11270 | 11727 | ||
| 11271 | :type The link prefix. like \"http\". This must be given. | 11728 | :type The link prefix. like \"http\". This must be given. |
| @@ -11285,8 +11742,9 @@ FOLLOW and PUBLISH are two functions. Both take the link path as | |||
| 11285 | an argument. | 11742 | an argument. |
| 11286 | FOLLOW should do whatever is necessary to follow the link, for example | 11743 | FOLLOW should do whatever is necessary to follow the link, for example |
| 11287 | to find a file or display a mail message. | 11744 | to find a file or display a mail message. |
| 11745 | |||
| 11288 | PUBLISH takes the path and retuns the string that should be used when | 11746 | PUBLISH takes the path and retuns the string that should be used when |
| 11289 | this document is published." | 11747 | this document is published. FIMXE: This is actually not yet implemented." |
| 11290 | (add-to-list 'org-link-types type t) | 11748 | (add-to-list 'org-link-types type t) |
| 11291 | (org-make-link-regexps) | 11749 | (org-make-link-regexps) |
| 11292 | (add-to-list 'org-link-protocols | 11750 | (add-to-list 'org-link-protocols |
| @@ -11374,10 +11832,10 @@ For file links, arg negates `org-context-in-file-links'." | |||
| 11374 | (if (fboundp 'elmo-message-entity) | 11832 | (if (fboundp 'elmo-message-entity) |
| 11375 | (elmo-message-entity | 11833 | (elmo-message-entity |
| 11376 | wl-summary-buffer-elmo-folder msgnum) | 11834 | wl-summary-buffer-elmo-folder msgnum) |
| 11377 | (elmo-msgdb-overview-get-entity | 11835 | (elmo-msgdb-overview-get-entity |
| 11378 | msgnum (wl-summary-buffer-msgdb)))) | 11836 | msgnum (wl-summary-buffer-msgdb)))) |
| 11379 | (from (wl-summary-line-from)) | 11837 | (from (wl-summary-line-from)) |
| 11380 | (to (elmo-message-entity-field wl-message-entity 'to)) | 11838 | (to (car (elmo-message-entity-field wl-message-entity 'to))) |
| 11381 | (subject (let (wl-thr-indent-string wl-parent-message-entity) | 11839 | (subject (let (wl-thr-indent-string wl-parent-message-entity) |
| 11382 | (wl-summary-line-subject)))) | 11840 | (wl-summary-line-subject)))) |
| 11383 | (org-store-link-props :type "wl" :from from :to to | 11841 | (org-store-link-props :type "wl" :from from :to to |
| @@ -11613,8 +12071,10 @@ according to FMT (default from `org-email-link-description-format')." | |||
| 11613 | (error "Empty link")) | 12071 | (error "Empty link")) |
| 11614 | (when (stringp description) | 12072 | (when (stringp description) |
| 11615 | ;; Remove brackets from the description, they are fatal. | 12073 | ;; Remove brackets from the description, they are fatal. |
| 11616 | (while (string-match "\\[\\|\\]" description) | 12074 | (while (string-match "\\[" description) |
| 11617 | (setq description (replace-match "" t t description)))) | 12075 | (setq description (replace-match "{" t t description))) |
| 12076 | (while (string-match "\\]" description) | ||
| 12077 | (setq description (replace-match "}" t t description)))) | ||
| 11618 | (when (equal (org-link-escape link) description) | 12078 | (when (equal (org-link-escape link) description) |
| 11619 | ;; No description needed, it is identical | 12079 | ;; No description needed, it is identical |
| 11620 | (setq description nil)) | 12080 | (setq description nil)) |
| @@ -11626,29 +12086,29 @@ according to FMT (default from `org-email-link-description-format')." | |||
| 11626 | "]")) | 12086 | "]")) |
| 11627 | 12087 | ||
| 11628 | (defconst org-link-escape-chars | 12088 | (defconst org-link-escape-chars |
| 11629 | '((" " . "%20") | 12089 | '((?\ . "%20") |
| 11630 | ("[" . "%5B") | 12090 | (?\[ . "%5B") |
| 11631 | ("]" . "%5d") | 12091 | (?\] . "%5D") |
| 11632 | ("\340" . "%E0") ; `a | 12092 | (?\340 . "%E0") ; `a |
| 11633 | ("\342" . "%E2") ; ^a | 12093 | (?\342 . "%E2") ; ^a |
| 11634 | ("\347" . "%E7") ; ,c | 12094 | (?\347 . "%E7") ; ,c |
| 11635 | ("\350" . "%E8") ; `e | 12095 | (?\350 . "%E8") ; `e |
| 11636 | ("\351" . "%E9") ; 'e | 12096 | (?\351 . "%E9") ; 'e |
| 11637 | ("\352" . "%EA") ; ^e | 12097 | (?\352 . "%EA") ; ^e |
| 11638 | ("\356" . "%EE") ; ^i | 12098 | (?\356 . "%EE") ; ^i |
| 11639 | ("\364" . "%F4") ; ^o | 12099 | (?\364 . "%F4") ; ^o |
| 11640 | ("\371" . "%F9") ; `u | 12100 | (?\371 . "%F9") ; `u |
| 11641 | ("\373" . "%FB") ; ^u | 12101 | (?\373 . "%FB") ; ^u |
| 11642 | (";" . "%3B") | 12102 | (?\; . "%3B") |
| 11643 | ("?" . "%3F") | 12103 | (?? . "%3F") |
| 11644 | ("=" . "%3D") | 12104 | (?= . "%3D") |
| 11645 | ("+" . "%2B") | 12105 | (?+ . "%2B") |
| 11646 | ) | 12106 | ) |
| 11647 | "Association list of escapes for some characters problematic in links. | 12107 | "Association list of escapes for some characters problematic in links. |
| 11648 | This is the list that is used for internal purposes.") | 12108 | This is the list that is used for internal purposes.") |
| 11649 | 12109 | ||
| 11650 | (defconst org-link-escape-chars-browser | 12110 | (defconst org-link-escape-chars-browser |
| 11651 | '((" " . "%20")) | 12111 | '((?\ . "%20")) ; 32 for the SPC char |
| 11652 | "Association list of escapes for some characters problematic in links. | 12112 | "Association list of escapes for some characters problematic in links. |
| 11653 | This is the list that is used before handing over to the browser.") | 12113 | This is the list that is used before handing over to the browser.") |
| 11654 | 12114 | ||
| @@ -11656,12 +12116,14 @@ This is the list that is used before handing over to the browser.") | |||
| 11656 | "Escape charaters in TEXT that are problematic for links." | 12116 | "Escape charaters in TEXT that are problematic for links." |
| 11657 | (setq table (or table org-link-escape-chars)) | 12117 | (setq table (or table org-link-escape-chars)) |
| 11658 | (when text | 12118 | (when text |
| 11659 | (let ((re (mapconcat (lambda (x) (regexp-quote (car x))) | 12119 | (let ((re (mapconcat (lambda (x) (regexp-quote |
| 12120 | (char-to-string (car x)))) | ||
| 11660 | table "\\|"))) | 12121 | table "\\|"))) |
| 11661 | (while (string-match re text) | 12122 | (while (string-match re text) |
| 11662 | (setq text | 12123 | (setq text |
| 11663 | (replace-match | 12124 | (replace-match |
| 11664 | (cdr (assoc (match-string 0 text) table)) | 12125 | (cdr (assoc (string-to-char (match-string 0 text)) |
| 12126 | table)) | ||
| 11665 | t t text))) | 12127 | t t text))) |
| 11666 | text))) | 12128 | text))) |
| 11667 | 12129 | ||
| @@ -11674,7 +12136,7 @@ This is the list that is used before handing over to the browser.") | |||
| 11674 | (while (string-match re text) | 12136 | (while (string-match re text) |
| 11675 | (setq text | 12137 | (setq text |
| 11676 | (replace-match | 12138 | (replace-match |
| 11677 | (car (rassoc (match-string 0 text) table)) | 12139 | (char-to-string (car (rassoc (match-string 0 text) table))) |
| 11678 | t t text))) | 12140 | t t text))) |
| 11679 | text))) | 12141 | text))) |
| 11680 | 12142 | ||
| @@ -11957,189 +12419,192 @@ the end of the current subtree. | |||
| 11957 | Normally, files will be opened by an appropriate application. If the | 12419 | Normally, files will be opened by an appropriate application. If the |
| 11958 | optional argument IN-EMACS is non-nil, Emacs will visit the file." | 12420 | optional argument IN-EMACS is non-nil, Emacs will visit the file." |
| 11959 | (interactive "P") | 12421 | (interactive "P") |
| 11960 | (move-marker org-open-link-marker (point)) | 12422 | (catch 'abort |
| 11961 | (setq org-window-config-before-follow-link (current-window-configuration)) | 12423 | (move-marker org-open-link-marker (point)) |
| 11962 | (org-remove-occur-highlights nil nil t) | 12424 | (setq org-window-config-before-follow-link (current-window-configuration)) |
| 11963 | (if (org-at-timestamp-p t) | 12425 | (org-remove-occur-highlights nil nil t) |
| 11964 | (org-follow-timestamp-link) | 12426 | (if (org-at-timestamp-p t) |
| 11965 | (let (type path link line search (pos (point))) | 12427 | (org-follow-timestamp-link) |
| 11966 | (catch 'match | 12428 | (let (type path link line search (pos (point))) |
| 11967 | (save-excursion | 12429 | (catch 'match |
| 11968 | (skip-chars-forward "^]\n\r") | 12430 | (save-excursion |
| 11969 | (when (org-in-regexp org-bracket-link-regexp) | 12431 | (skip-chars-forward "^]\n\r") |
| 11970 | (setq link (org-link-unescape (org-match-string-no-properties 1))) | 12432 | (when (org-in-regexp org-bracket-link-regexp) |
| 11971 | (while (string-match " *\n *" link) | 12433 | (setq link (org-link-unescape (org-match-string-no-properties 1))) |
| 11972 | (setq link (replace-match " " t t link))) | 12434 | (while (string-match " *\n *" link) |
| 11973 | (setq link (org-link-expand-abbrev link)) | 12435 | (setq link (replace-match " " t t link))) |
| 11974 | (if (string-match org-link-re-with-space2 link) | 12436 | (setq link (org-link-expand-abbrev link)) |
| 11975 | (setq type (match-string 1 link) path (match-string 2 link)) | 12437 | (if (string-match org-link-re-with-space2 link) |
| 11976 | (setq type "thisfile" path link)) | 12438 | (setq type (match-string 1 link) path (match-string 2 link)) |
| 11977 | (throw 'match t))) | 12439 | (setq type "thisfile" path link)) |
| 11978 | 12440 | (throw 'match t))) | |
| 11979 | (when (get-text-property (point) 'org-linked-text) | 12441 | |
| 11980 | (setq type "thisfile" | 12442 | (when (get-text-property (point) 'org-linked-text) |
| 11981 | pos (if (get-text-property (1+ (point)) 'org-linked-text) | 12443 | (setq type "thisfile" |
| 11982 | (1+ (point)) (point)) | 12444 | pos (if (get-text-property (1+ (point)) 'org-linked-text) |
| 11983 | path (buffer-substring | 12445 | (1+ (point)) (point)) |
| 11984 | (previous-single-property-change pos 'org-linked-text) | 12446 | path (buffer-substring |
| 11985 | (next-single-property-change pos 'org-linked-text))) | 12447 | (previous-single-property-change pos 'org-linked-text) |
| 11986 | (throw 'match t)) | 12448 | (next-single-property-change pos 'org-linked-text))) |
| 12449 | (throw 'match t)) | ||
| 11987 | 12450 | ||
| 11988 | (save-excursion | 12451 | (save-excursion |
| 11989 | (when (or (org-in-regexp org-angle-link-re) | 12452 | (when (or (org-in-regexp org-angle-link-re) |
| 11990 | (org-in-regexp org-plain-link-re)) | 12453 | (org-in-regexp org-plain-link-re)) |
| 11991 | (setq type (match-string 1) path (match-string 2)) | 12454 | (setq type (match-string 1) path (match-string 2)) |
| 11992 | (throw 'match t))) | 12455 | (throw 'match t))) |
| 11993 | (when (org-in-regexp "\\<\\([^><\n]+\\)\\>") | 12456 | (when (org-in-regexp "\\<\\([^><\n]+\\)\\>") |
| 11994 | (setq type "tree-match" | 12457 | (setq type "tree-match" |
| 11995 | path (match-string 1)) | ||
| 11996 | (throw 'match t)) | ||
| 11997 | (save-excursion | ||
| 11998 | (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$")) | ||
| 11999 | (setq type "tags" | ||
| 12000 | path (match-string 1)) | 12458 | path (match-string 1)) |
| 12001 | (while (string-match ":" path) | 12459 | (throw 'match t)) |
| 12002 | (setq path (replace-match "+" t t path))) | 12460 | (save-excursion |
| 12003 | (throw 'match t)))) | 12461 | (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$")) |
| 12004 | (unless path | 12462 | (setq type "tags" |
| 12005 | (error "No link found")) | 12463 | path (match-string 1)) |
| 12006 | ;; Remove any trailing spaces in path | 12464 | (while (string-match ":" path) |
| 12007 | (if (string-match " +\\'" path) | 12465 | (setq path (replace-match "+" t t path))) |
| 12008 | (setq path (replace-match "" t t path))) | 12466 | (throw 'match t)))) |
| 12467 | (unless path | ||
| 12468 | (error "No link found")) | ||
| 12469 | ;; Remove any trailing spaces in path | ||
| 12470 | (if (string-match " +\\'" path) | ||
| 12471 | (setq path (replace-match "" t t path))) | ||
| 12009 | 12472 | ||
| 12010 | (cond | 12473 | (cond |
| 12011 | 12474 | ||
| 12012 | ((assoc type org-link-protocols) | 12475 | ((assoc type org-link-protocols) |
| 12013 | (funcall (nth 1 (assoc type org-link-protocols)) path)) | 12476 | (funcall (nth 1 (assoc type org-link-protocols)) path)) |
| 12014 | 12477 | ||
| 12015 | ((equal type "mailto") | 12478 | ((equal type "mailto") |
| 12016 | (let ((cmd (car org-link-mailto-program)) | 12479 | (let ((cmd (car org-link-mailto-program)) |
| 12017 | (args (cdr org-link-mailto-program)) args1 | 12480 | (args (cdr org-link-mailto-program)) args1 |
| 12018 | (address path) (subject "") a) | 12481 | (address path) (subject "") a) |
| 12019 | (if (string-match "\\(.*\\)::\\(.*\\)" path) | 12482 | (if (string-match "\\(.*\\)::\\(.*\\)" path) |
| 12020 | (setq address (match-string 1 path) | 12483 | (setq address (match-string 1 path) |
| 12021 | subject (org-link-escape (match-string 2 path)))) | 12484 | subject (org-link-escape (match-string 2 path)))) |
| 12022 | (while args | 12485 | (while args |
| 12023 | (cond | 12486 | (cond |
| 12024 | ((not (stringp (car args))) (push (pop args) args1)) | 12487 | ((not (stringp (car args))) (push (pop args) args1)) |
| 12025 | (t (setq a (pop args)) | 12488 | (t (setq a (pop args)) |
| 12026 | (if (string-match "%a" a) | 12489 | (if (string-match "%a" a) |
| 12027 | (setq a (replace-match address t t a))) | 12490 | (setq a (replace-match address t t a))) |
| 12028 | (if (string-match "%s" a) | 12491 | (if (string-match "%s" a) |
| 12029 | (setq a (replace-match subject t t a))) | 12492 | (setq a (replace-match subject t t a))) |
| 12030 | (push a args1)))) | 12493 | (push a args1)))) |
| 12031 | (apply cmd (nreverse args1)))) | 12494 | (apply cmd (nreverse args1)))) |
| 12032 | 12495 | ||
| 12033 | ((member type '("http" "https" "ftp" "news")) | 12496 | ((member type '("http" "https" "ftp" "news")) |
| 12034 | (browse-url (concat type ":" (org-link-escape | 12497 | (browse-url (concat type ":" (org-link-escape |
| 12035 | path org-link-escape-chars-browser)))) | 12498 | path org-link-escape-chars-browser)))) |
| 12036 | 12499 | ||
| 12037 | ((string= type "tags") | 12500 | ((member type '("message")) |
| 12038 | (org-tags-view in-emacs path)) | 12501 | (browse-url (concat type ":" path))) |
| 12039 | ((string= type "thisfile") | 12502 | |
| 12040 | (if in-emacs | 12503 | ((string= type "tags") |
| 12041 | (switch-to-buffer-other-window | 12504 | (org-tags-view in-emacs path)) |
| 12042 | (org-get-buffer-for-internal-link (current-buffer))) | 12505 | ((string= type "thisfile") |
| 12043 | (org-mark-ring-push)) | 12506 | (if in-emacs |
| 12044 | (let ((cmd `(org-link-search | 12507 | (switch-to-buffer-other-window |
| 12045 | ,path | 12508 | (org-get-buffer-for-internal-link (current-buffer))) |
| 12046 | ,(cond ((equal in-emacs '(4)) 'occur) | 12509 | (org-mark-ring-push)) |
| 12047 | ((equal in-emacs '(16)) 'org-occur) | 12510 | (let ((cmd `(org-link-search |
| 12048 | (t nil)) | 12511 | ,path |
| 12049 | ,pos))) | 12512 | ,(cond ((equal in-emacs '(4)) 'occur) |
| 12050 | (condition-case nil (eval cmd) | 12513 | ((equal in-emacs '(16)) 'org-occur) |
| 12051 | (error (progn (widen) (eval cmd)))))) | 12514 | (t nil)) |
| 12052 | 12515 | ,pos))) | |
| 12053 | ((string= type "tree-match") | 12516 | (condition-case nil (eval cmd) |
| 12054 | (org-occur (concat "\\[" (regexp-quote path) "\\]"))) | 12517 | (error (progn (widen) (eval cmd)))))) |
| 12055 | 12518 | ||
| 12056 | ((string= type "file") | 12519 | ((string= type "tree-match") |
| 12057 | (if (string-match "::\\([0-9]+\\)\\'" path) | 12520 | (org-occur (concat "\\[" (regexp-quote path) "\\]"))) |
| 12058 | (setq line (string-to-number (match-string 1 path)) | 12521 | |
| 12059 | path (substring path 0 (match-beginning 0))) | 12522 | ((string= type "file") |
| 12060 | (if (string-match "::\\(.+\\)\\'" path) | 12523 | (if (string-match "::\\([0-9]+\\)\\'" path) |
| 12061 | (setq search (match-string 1 path) | 12524 | (setq line (string-to-number (match-string 1 path)) |
| 12062 | path (substring path 0 (match-beginning 0))))) | 12525 | path (substring path 0 (match-beginning 0))) |
| 12063 | (org-open-file path in-emacs line search)) | 12526 | (if (string-match "::\\(.+\\)\\'" path) |
| 12064 | 12527 | (setq search (match-string 1 path) | |
| 12065 | ((string= type "news") | 12528 | path (substring path 0 (match-beginning 0))))) |
| 12066 | (org-follow-gnus-link path)) | 12529 | (if (string-match "[*?{]" (file-name-nondirectory path)) |
| 12067 | 12530 | (dired path) | |
| 12068 | ((string= type "bbdb") | 12531 | (org-open-file path in-emacs line search))) |
| 12069 | (org-follow-bbdb-link path)) | 12532 | |
| 12070 | 12533 | ((string= type "news") | |
| 12071 | ((string= type "info") | 12534 | (org-follow-gnus-link path)) |
| 12072 | (org-follow-info-link path)) | 12535 | |
| 12073 | 12536 | ((string= type "bbdb") | |
| 12074 | ((string= type "gnus") | 12537 | (org-follow-bbdb-link path)) |
| 12075 | (let (group article) | 12538 | |
| 12076 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | 12539 | ((string= type "info") |
| 12077 | (error "Error in Gnus link")) | 12540 | (org-follow-info-link path)) |
| 12078 | (setq group (match-string 1 path) | 12541 | |
| 12079 | article (match-string 3 path)) | 12542 | ((string= type "gnus") |
| 12080 | (org-follow-gnus-link group article))) | 12543 | (let (group article) |
| 12081 | 12544 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
| 12082 | ((string= type "vm") | 12545 | (error "Error in Gnus link")) |
| 12083 | (let (folder article) | 12546 | (setq group (match-string 1 path) |
| 12084 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | 12547 | article (match-string 3 path)) |
| 12085 | (error "Error in VM link")) | 12548 | (org-follow-gnus-link group article))) |
| 12086 | (setq folder (match-string 1 path) | 12549 | |
| 12087 | article (match-string 3 path)) | 12550 | ((string= type "vm") |
| 12088 | ;; in-emacs is the prefix arg, will be interpreted as read-only | 12551 | (let (folder article) |
| 12089 | (org-follow-vm-link folder article in-emacs))) | 12552 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) |
| 12090 | 12553 | (error "Error in VM link")) | |
| 12091 | ((string= type "wl") | 12554 | (setq folder (match-string 1 path) |
| 12092 | (let (folder article) | 12555 | article (match-string 3 path)) |
| 12093 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | 12556 | ;; in-emacs is the prefix arg, will be interpreted as read-only |
| 12094 | (error "Error in Wanderlust link")) | 12557 | (org-follow-vm-link folder article in-emacs))) |
| 12095 | (setq folder (match-string 1 path) | 12558 | |
| 12096 | article (match-string 3 path)) | 12559 | ((string= type "wl") |
| 12097 | (org-follow-wl-link folder article))) | 12560 | (let (folder article) |
| 12098 | 12561 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
| 12099 | ((string= type "mhe") | 12562 | (error "Error in Wanderlust link")) |
| 12100 | (let (folder article) | 12563 | (setq folder (match-string 1 path) |
| 12101 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | 12564 | article (match-string 3 path)) |
| 12102 | (error "Error in MHE link")) | 12565 | (org-follow-wl-link folder article))) |
| 12103 | (setq folder (match-string 1 path) | 12566 | |
| 12104 | article (match-string 3 path)) | 12567 | ((string= type "mhe") |
| 12105 | (org-follow-mhe-link folder article))) | 12568 | (let (folder article) |
| 12106 | 12569 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
| 12107 | ((string= type "rmail") | 12570 | (error "Error in MHE link")) |
| 12108 | (let (folder article) | 12571 | (setq folder (match-string 1 path) |
| 12109 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | 12572 | article (match-string 3 path)) |
| 12110 | (error "Error in RMAIL link")) | 12573 | (org-follow-mhe-link folder article))) |
| 12111 | (setq folder (match-string 1 path) | 12574 | |
| 12112 | article (match-string 3 path)) | 12575 | ((string= type "rmail") |
| 12113 | (org-follow-rmail-link folder article))) | 12576 | (let (folder article) |
| 12114 | 12577 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
| 12115 | ((string= type "shell") | 12578 | (error "Error in RMAIL link")) |
| 12116 | (let ((cmd path)) | 12579 | (setq folder (match-string 1 path) |
| 12117 | ;; The following is only for backward compatibility | 12580 | article (match-string 3 path)) |
| 12118 | (while (string-match "@{" cmd) (setq cmd (replace-match "<" t t cmd))) | 12581 | (org-follow-rmail-link folder article))) |
| 12119 | (while (string-match "@}" cmd) (setq cmd (replace-match ">" t t cmd))) | 12582 | |
| 12120 | (if (or (not org-confirm-shell-link-function) | 12583 | ((string= type "shell") |
| 12121 | (funcall org-confirm-shell-link-function | 12584 | (let ((cmd path)) |
| 12122 | (format "Execute \"%s\" in shell? " | 12585 | (if (or (not org-confirm-shell-link-function) |
| 12123 | (org-add-props cmd nil | 12586 | (funcall org-confirm-shell-link-function |
| 12124 | 'face 'org-warning)))) | 12587 | (format "Execute \"%s\" in shell? " |
| 12125 | (progn | 12588 | (org-add-props cmd nil |
| 12126 | (message "Executing %s" cmd) | 12589 | 'face 'org-warning)))) |
| 12127 | (shell-command cmd)) | 12590 | (progn |
| 12128 | (error "Abort")))) | 12591 | (message "Executing %s" cmd) |
| 12129 | 12592 | (shell-command cmd)) | |
| 12130 | ((string= type "elisp") | 12593 | (error "Abort")))) |
| 12131 | (let ((cmd path)) | 12594 | |
| 12132 | (if (or (not org-confirm-elisp-link-function) | 12595 | ((string= type "elisp") |
| 12133 | (funcall org-confirm-elisp-link-function | 12596 | (let ((cmd path)) |
| 12134 | (format "Execute \"%s\" as elisp? " | 12597 | (if (or (not org-confirm-elisp-link-function) |
| 12135 | (org-add-props cmd nil | 12598 | (funcall org-confirm-elisp-link-function |
| 12136 | 'face 'org-warning)))) | 12599 | (format "Execute \"%s\" as elisp? " |
| 12137 | (message "%s => %s" cmd (eval (read cmd))) | 12600 | (org-add-props cmd nil |
| 12138 | (error "Abort")))) | 12601 | 'face 'org-warning)))) |
| 12602 | (message "%s => %s" cmd (eval (read cmd))) | ||
| 12603 | (error "Abort")))) | ||
| 12139 | 12604 | ||
| 12140 | (t | 12605 | (t |
| 12141 | (browse-url-at-point))))) | 12606 | (browse-url-at-point))))) |
| 12142 | (move-marker org-open-link-marker nil)) | 12607 | (move-marker org-open-link-marker nil))) |
| 12143 | 12608 | ||
| 12144 | ;;; File search | 12609 | ;;; File search |
| 12145 | 12610 | ||
| @@ -12575,8 +13040,8 @@ use sequences." | |||
| 12575 | (mh-show-buffer-message-number)))) | 13040 | (mh-show-buffer-message-number)))) |
| 12576 | 13041 | ||
| 12577 | (defun org-mhe-get-header (header) | 13042 | (defun org-mhe-get-header (header) |
| 12578 | "Return a header of the message in folder mode. This will create a | 13043 | "Return a header of the message in folder mode. This will create a |
| 12579 | show buffer for the corresponding message. If you have a more clever | 13044 | show buffer for the corresponding message. If you have a more clever |
| 12580 | idea..." | 13045 | idea..." |
| 12581 | (let* ((folder (org-mhe-get-message-folder)) | 13046 | (let* ((folder (org-mhe-get-message-folder)) |
| 12582 | (num (org-mhe-get-message-num)) | 13047 | (num (org-mhe-get-message-num)) |
| @@ -12727,9 +13192,10 @@ If the file does not exist, an error is thrown." | |||
| 12727 | (cond | 13192 | (cond |
| 12728 | ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) | 13193 | ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) |
| 12729 | ;; Remove quotes around the file name - we'll use shell-quote-argument. | 13194 | ;; Remove quotes around the file name - we'll use shell-quote-argument. |
| 12730 | (if (string-match "['\"]%s['\"]" cmd) | 13195 | (while (string-match "['\"]%s['\"]" cmd) |
| 12731 | (setq cmd (replace-match "%s" t t cmd))) | 13196 | (setq cmd (replace-match "%s" t t cmd))) |
| 12732 | (setq cmd (format cmd (shell-quote-argument file))) | 13197 | (while (string-match "%s" cmd) |
| 13198 | (setq cmd (replace-match (shell-quote-argument file) t t cmd))) | ||
| 12733 | (save-window-excursion | 13199 | (save-window-excursion |
| 12734 | (start-process-shell-command cmd nil cmd))) | 13200 | (start-process-shell-command cmd nil cmd))) |
| 12735 | ((or (stringp cmd) | 13201 | ((or (stringp cmd) |
| @@ -12772,7 +13238,18 @@ on the system \"/user@host:\"." | |||
| 12772 | (t nil))) | 13238 | (t nil))) |
| 12773 | 13239 | ||
| 12774 | 13240 | ||
| 12775 | ;;;; Hooks for remember.el | 13241 | ;;;; Hooks for remember.el, and refiling |
| 13242 | |||
| 13243 | (defvar annotation) ; from remember.el, dynamically scoped in `remember-mode' | ||
| 13244 | (defvar initial) ; from remember.el, dynamically scoped in `remember-mode' | ||
| 13245 | |||
| 13246 | ;;;###autoload | ||
| 13247 | (defun org-remember-insinuate () | ||
| 13248 | "Setup remember.el for use wiht Org-mode." | ||
| 13249 | (require 'remember) | ||
| 13250 | (setq remember-annotation-functions '(org-remember-annotation)) | ||
| 13251 | (setq remember-handler-functions '(org-remember-handler)) | ||
| 13252 | (add-hook 'remember-mode-hook 'org-remember-apply-template)) | ||
| 12776 | 13253 | ||
| 12777 | ;;;###autoload | 13254 | ;;;###autoload |
| 12778 | (defun org-remember-annotation () | 13255 | (defun org-remember-annotation () |
| @@ -12792,44 +13269,54 @@ RET at beg-of-buf -> Append to file as level 2 headline | |||
| 12792 | (defvar org-remember-previous-location nil) | 13269 | (defvar org-remember-previous-location nil) |
| 12793 | (defvar org-force-remember-template-char) ;; dynamically scoped | 13270 | (defvar org-force-remember-template-char) ;; dynamically scoped |
| 12794 | 13271 | ||
| 13272 | (defun org-select-remember-template (&optional use-char) | ||
| 13273 | (when org-remember-templates | ||
| 13274 | (let* ((templates (mapcar (lambda (x) | ||
| 13275 | (if (stringp (car x)) | ||
| 13276 | (append (list (nth 1 x) (car x)) (cddr x)) | ||
| 13277 | (append (list (car x) "") (cdr x)))) | ||
| 13278 | org-remember-templates)) | ||
| 13279 | (char (or use-char | ||
| 13280 | (cond | ||
| 13281 | ((= (length templates) 1) | ||
| 13282 | (caar templates)) | ||
| 13283 | ((and (boundp 'org-force-remember-template-char) | ||
| 13284 | org-force-remember-template-char) | ||
| 13285 | (if (stringp org-force-remember-template-char) | ||
| 13286 | (string-to-char org-force-remember-template-char) | ||
| 13287 | org-force-remember-template-char)) | ||
| 13288 | (t | ||
| 13289 | (message "Select template: %s" | ||
| 13290 | (mapconcat | ||
| 13291 | (lambda (x) | ||
| 13292 | (cond | ||
| 13293 | ((not (string-match "\\S-" (nth 1 x))) | ||
| 13294 | (format "[%c]" (car x))) | ||
| 13295 | ((equal (downcase (car x)) | ||
| 13296 | (downcase (aref (nth 1 x) 0))) | ||
| 13297 | (format "[%c]%s" (car x) | ||
| 13298 | (substring (nth 1 x) 1))) | ||
| 13299 | (t (format "[%c]%s" (car x) (nth 1 x))))) | ||
| 13300 | templates " ")) | ||
| 13301 | (let ((inhibit-quit t) (char0 (read-char-exclusive))) | ||
| 13302 | (when (equal char0 ?\C-g) | ||
| 13303 | (jump-to-register remember-register) | ||
| 13304 | (kill-buffer remember-buffer)) | ||
| 13305 | char0)))))) | ||
| 13306 | (cddr (assoc char templates))))) | ||
| 13307 | |||
| 13308 | (defvar x-last-selected-text) | ||
| 13309 | (defvar x-last-selected-text-primary) | ||
| 13310 | |||
| 12795 | ;;;###autoload | 13311 | ;;;###autoload |
| 12796 | (defun org-remember-apply-template (&optional use-char skip-interactive) | 13312 | (defun org-remember-apply-template (&optional use-char skip-interactive) |
| 12797 | "Initialize *remember* buffer with template, invoke `org-mode'. | 13313 | "Initialize *remember* buffer with template, invoke `org-mode'. |
| 12798 | This function should be placed into `remember-mode-hook' and in fact requires | 13314 | This function should be placed into `remember-mode-hook' and in fact requires |
| 12799 | to be run from that hook to fucntion properly." | 13315 | to be run from that hook to function properly." |
| 13316 | (unless (fboundp 'remember-finalize) | ||
| 13317 | (defalias 'remember-finalize 'remember-buffer)) | ||
| 12800 | (if org-remember-templates | 13318 | (if org-remember-templates |
| 12801 | (let* ((templates (mapcar (lambda (x) | 13319 | (let* ((entry (org-select-remember-template use-char)) |
| 12802 | (if (stringp (car x)) | ||
| 12803 | (append (list (nth 1 x) (car x)) (cddr x)) | ||
| 12804 | (append (list (car x) "") (cdr x)))) | ||
| 12805 | org-remember-templates)) | ||
| 12806 | (char (or use-char | ||
| 12807 | (cond | ||
| 12808 | ((= (length templates) 1) | ||
| 12809 | (caar templates)) | ||
| 12810 | ((and (boundp 'org-force-remember-template-char) | ||
| 12811 | org-force-remember-template-char) | ||
| 12812 | (if (stringp org-force-remember-template-char) | ||
| 12813 | (string-to-char org-force-remember-template-char) | ||
| 12814 | org-force-remember-template-char)) | ||
| 12815 | (t | ||
| 12816 | (message "Select template: %s" | ||
| 12817 | (mapconcat | ||
| 12818 | (lambda (x) | ||
| 12819 | (cond | ||
| 12820 | ((not (string-match "\\S-" (nth 1 x))) | ||
| 12821 | (format "[%c]" (car x))) | ||
| 12822 | ((equal (downcase (car x)) | ||
| 12823 | (downcase (aref (nth 1 x) 0))) | ||
| 12824 | (format "[%c]%s" (car x) (substring (nth 1 x) 1))) | ||
| 12825 | (t (format "[%c]%s" (car x) (nth 1 x))))) | ||
| 12826 | templates " ")) | ||
| 12827 | (let ((inhibit-quit t) (char0 (read-char-exclusive))) | ||
| 12828 | (when (equal char0 ?\C-g) | ||
| 12829 | (jump-to-register remember-register) | ||
| 12830 | (kill-buffer remember-buffer)) | ||
| 12831 | char0))))) | ||
| 12832 | (entry (cddr (assoc char templates))) | ||
| 12833 | (tpl (car entry)) | 13320 | (tpl (car entry)) |
| 12834 | (plist-p (if org-store-link-plist t nil)) | 13321 | (plist-p (if org-store-link-plist t nil)) |
| 12835 | (file (if (and (nth 1 entry) (stringp (nth 1 entry)) | 13322 | (file (if (and (nth 1 entry) (stringp (nth 1 entry)) |
| @@ -12837,6 +13324,12 @@ to be run from that hook to fucntion properly." | |||
| 12837 | (nth 1 entry) | 13324 | (nth 1 entry) |
| 12838 | org-default-notes-file)) | 13325 | org-default-notes-file)) |
| 12839 | (headline (nth 2 entry)) | 13326 | (headline (nth 2 entry)) |
| 13327 | (v-c (or (and (eq window-system 'x) | ||
| 13328 | (fboundp 'x-cut-buffer-or-selection-value) | ||
| 13329 | (x-cut-buffer-or-selection-value)) | ||
| 13330 | (org-bound-and-true-p x-last-selected-text) | ||
| 13331 | (org-bound-and-true-p x-last-selected-text-primary) | ||
| 13332 | (and (> (length kill-ring) 0) (current-kill 0)))) | ||
| 12840 | (v-t (format-time-string (car org-time-stamp-formats) (org-current-time))) | 13333 | (v-t (format-time-string (car org-time-stamp-formats) (org-current-time))) |
| 12841 | (v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time))) | 13334 | (v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time))) |
| 12842 | (v-u (concat "[" (substring v-t 1 -1) "]")) | 13335 | (v-u (concat "[" (substring v-t 1 -1) "]")) |
| @@ -12852,11 +13345,12 @@ to be run from that hook to fucntion properly." | |||
| 12852 | v-a)) | 13345 | v-a)) |
| 12853 | (v-n user-full-name) | 13346 | (v-n user-full-name) |
| 12854 | (org-startup-folded nil) | 13347 | (org-startup-folded nil) |
| 12855 | org-time-was-given org-end-time-was-given x prompt char time) | 13348 | org-time-was-given org-end-time-was-given x |
| 13349 | prompt completions char time pos default histvar) | ||
| 12856 | (setq org-store-link-plist | 13350 | (setq org-store-link-plist |
| 12857 | (append (list :annotation v-a :initial v-i) | 13351 | (append (list :annotation v-a :initial v-i) |
| 12858 | org-store-link-plist)) | 13352 | org-store-link-plist)) |
| 12859 | (unless tpl (setq tpl "") (message "No template") (ding)) | 13353 | (unless tpl (setq tpl "") (message "No template") (ding) (sit-for 1)) |
| 12860 | (erase-buffer) | 13354 | (erase-buffer) |
| 12861 | (insert (substitute-command-keys | 13355 | (insert (substitute-command-keys |
| 12862 | (format | 13356 | (format |
| @@ -12873,7 +13367,7 @@ to be run from that hook to fucntion properly." | |||
| 12873 | (or (cdr org-remember-previous-location) "???")))) | 13367 | (or (cdr org-remember-previous-location) "???")))) |
| 12874 | (insert tpl) (goto-char (point-min)) | 13368 | (insert tpl) (goto-char (point-min)) |
| 12875 | ;; Simple %-escapes | 13369 | ;; Simple %-escapes |
| 12876 | (while (re-search-forward "%\\([tTuUaiA]\\)" nil t) | 13370 | (while (re-search-forward "%\\([tTuUaiAc]\\)" nil t) |
| 12877 | (when (and initial (equal (match-string 0) "%i")) | 13371 | (when (and initial (equal (match-string 0) "%i")) |
| 12878 | (save-match-data | 13372 | (save-match-data |
| 12879 | (let* ((lead (buffer-substring | 13373 | (let* ((lead (buffer-substring |
| @@ -12884,16 +13378,43 @@ to be run from that hook to fucntion properly." | |||
| 12884 | (replace-match | 13378 | (replace-match |
| 12885 | (or (eval (intern (concat "v-" (match-string 1)))) "") | 13379 | (or (eval (intern (concat "v-" (match-string 1)))) "") |
| 12886 | t t)) | 13380 | t t)) |
| 13381 | |||
| 13382 | ;; %[] Insert contents of a file. | ||
| 13383 | (goto-char (point-min)) | ||
| 13384 | (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) | ||
| 13385 | (let ((start (match-beginning 0)) | ||
| 13386 | (end (match-end 0)) | ||
| 13387 | (filename (expand-file-name (match-string 1)))) | ||
| 13388 | (goto-char start) | ||
| 13389 | (delete-region start end) | ||
| 13390 | (condition-case error | ||
| 13391 | (insert-file-contents filename) | ||
| 13392 | (error (insert (format "%%![Couldn't insert %s: %s]" | ||
| 13393 | filename error)))))) | ||
| 13394 | ;; %() embedded elisp | ||
| 13395 | (goto-char (point-min)) | ||
| 13396 | (while (re-search-forward "%\\((.+)\\)" nil t) | ||
| 13397 | (goto-char (match-beginning 0)) | ||
| 13398 | (let ((template-start (point))) | ||
| 13399 | (forward-char 1) | ||
| 13400 | (let ((result | ||
| 13401 | (condition-case error | ||
| 13402 | (eval (read (current-buffer))) | ||
| 13403 | (error (format "%%![Error: %s]" error))))) | ||
| 13404 | (delete-region template-start (point)) | ||
| 13405 | (insert result)))) | ||
| 13406 | |||
| 12887 | ;; From the property list | 13407 | ;; From the property list |
| 12888 | (when plist-p | 13408 | (when plist-p |
| 12889 | (goto-char (point-min)) | 13409 | (goto-char (point-min)) |
| 12890 | (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) | 13410 | (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) |
| 12891 | (and (setq x (plist-get org-store-link-plist | 13411 | (and (setq x (or (plist-get org-store-link-plist |
| 12892 | (intern (match-string 1)))) | 13412 | (intern (match-string 1))) "")) |
| 12893 | (replace-match x t t)))) | 13413 | (replace-match x t t)))) |
| 13414 | |||
| 12894 | ;; Turn on org-mode in the remember buffer, set local variables | 13415 | ;; Turn on org-mode in the remember buffer, set local variables |
| 12895 | (org-mode) | 13416 | (org-mode) |
| 12896 | (org-set-local 'org-finish-function 'remember-buffer) | 13417 | (org-set-local 'org-finish-function 'remember-finalize) |
| 12897 | (if (and file (string-match "\\S-" file) (not (file-directory-p file))) | 13418 | (if (and file (string-match "\\S-" file) (not (file-directory-p file))) |
| 12898 | (org-set-local 'org-default-notes-file file)) | 13419 | (org-set-local 'org-default-notes-file file)) |
| 12899 | (if (and headline (stringp headline) (string-match "\\S-" headline)) | 13420 | (if (and headline (stringp headline) (string-match "\\S-" headline)) |
| @@ -12905,6 +13426,15 @@ to be run from that hook to fucntion properly." | |||
| 12905 | prompt (if (match-end 2) (match-string 2))) | 13426 | prompt (if (match-end 2) (match-string 2))) |
| 12906 | (goto-char (match-beginning 0)) | 13427 | (goto-char (match-beginning 0)) |
| 12907 | (replace-match "") | 13428 | (replace-match "") |
| 13429 | (setq completions nil default nil) | ||
| 13430 | (when prompt | ||
| 13431 | (setq completions (org-split-string prompt "|") | ||
| 13432 | prompt (pop completions) | ||
| 13433 | default (car completions) | ||
| 13434 | histvar (intern (concat | ||
| 13435 | "org-remember-template-prompt-history::" | ||
| 13436 | (or prompt ""))) | ||
| 13437 | completions (mapcar 'list completions))) | ||
| 12908 | (cond | 13438 | (cond |
| 12909 | ((member char '("G" "g")) | 13439 | ((member char '("G" "g")) |
| 12910 | (let* ((org-last-tags-completion-table | 13440 | (let* ((org-last-tags-completion-table |
| @@ -12930,33 +13460,92 @@ to be run from that hook to fucntion properly." | |||
| 12930 | (member char '("u" "U")) | 13460 | (member char '("u" "U")) |
| 12931 | nil nil (list org-end-time-was-given))) | 13461 | nil nil (list org-end-time-was-given))) |
| 12932 | (t | 13462 | (t |
| 12933 | (insert (read-string | 13463 | (insert (org-completing-read |
| 12934 | (if prompt (concat prompt ": ") "Enter string")))))) | 13464 | (concat (if prompt prompt "Enter string") |
| 13465 | (if default (concat " [" default "]")) | ||
| 13466 | ": ") | ||
| 13467 | completions nil nil nil histvar default))))) | ||
| 12935 | (goto-char (point-min)) | 13468 | (goto-char (point-min)) |
| 12936 | (if (re-search-forward "%\\?" nil t) | 13469 | (if (re-search-forward "%\\?" nil t) |
| 12937 | (replace-match "") | 13470 | (replace-match "") |
| 12938 | (and (re-search-forward "^[^#\n]" nil t) (backward-char 1)))) | 13471 | (and (re-search-forward "^[^#\n]" nil t) (backward-char 1)))) |
| 12939 | (org-mode) | 13472 | (org-mode) |
| 12940 | (org-set-local 'org-finish-function 'remember-buffer))) | 13473 | (org-set-local 'org-finish-function 'remember-finalize)) |
| 13474 | (when (save-excursion | ||
| 13475 | (goto-char (point-min)) | ||
| 13476 | (re-search-forward "%!" nil t)) | ||
| 13477 | (replace-match "") | ||
| 13478 | (add-hook 'post-command-hook 'org-remember-finish-immediately 'append))) | ||
| 13479 | |||
| 13480 | (defun org-remember-finish-immediately () | ||
| 13481 | "File remember note immediately. | ||
| 13482 | This should be run in `post-command-hook' and will remove itself | ||
| 13483 | from that hook." | ||
| 13484 | (remove-hook 'post-command-hook 'org-remember-finish-immediately) | ||
| 13485 | (when org-finish-function | ||
| 13486 | (funcall org-finish-function))) | ||
| 13487 | |||
| 12941 | 13488 | ||
| 12942 | ;;;###autoload | 13489 | ;;;###autoload |
| 12943 | (defun org-remember (&optional org-force-remember-template-char) | 13490 | (defun org-remember (&optional goto org-force-remember-template-char) |
| 12944 | "Call `remember'. If this is already a remember buffer, re-apply template. | 13491 | "Call `remember'. If this is already a remember buffer, re-apply template. |
| 12945 | If there is an active region, make sure remember uses it as initial content | 13492 | If there is an active region, make sure remember uses it as initial content |
| 12946 | of the remember buffer." | 13493 | of the remember buffer. |
| 13494 | |||
| 13495 | When called interactively with a `C-u' prefix argument GOTO, don't remember | ||
| 13496 | anything, just go to the file/headline where the selected template usually | ||
| 13497 | stores its notes. With a double prefix arg `C-u C-u', go to the last | ||
| 13498 | note stored by remember. | ||
| 13499 | |||
| 13500 | Lisp programs can set ORG-FORCE-REMEMBER-TEMPLATE-CHAR to a character | ||
| 13501 | associated with a template in `org-remember-templates'." | ||
| 13502 | (interactive "P") | ||
| 13503 | (cond | ||
| 13504 | ((equal goto '(4)) (org-go-to-remember-target)) | ||
| 13505 | ((equal goto '(16)) (org-remember-goto-last-stored)) | ||
| 13506 | (t | ||
| 13507 | (if (memq org-finish-function '(remember-buffer remember-finalize)) | ||
| 13508 | (progn | ||
| 13509 | (when (< (length org-remember-templates) 2) | ||
| 13510 | (error "No other template available")) | ||
| 13511 | (erase-buffer) | ||
| 13512 | (let ((annotation (plist-get org-store-link-plist :annotation)) | ||
| 13513 | (initial (plist-get org-store-link-plist :initial))) | ||
| 13514 | (org-remember-apply-template)) | ||
| 13515 | (message "Press C-c C-c to remember data")) | ||
| 13516 | (if (org-region-active-p) | ||
| 13517 | (remember (buffer-substring (point) (mark))) | ||
| 13518 | (call-interactively 'remember)))))) | ||
| 13519 | |||
| 13520 | (defun org-remember-goto-last-stored () | ||
| 13521 | "Go to the location where the last remember note was stored." | ||
| 12947 | (interactive) | 13522 | (interactive) |
| 12948 | (if (eq org-finish-function 'remember-buffer) | 13523 | (bookmark-jump "org-remember-last-stored") |
| 12949 | (progn | 13524 | (message "This is the last note stored by remember")) |
| 12950 | (when (< (length org-remember-templates) 2) | 13525 | |
| 12951 | (error "No other template available")) | 13526 | (defun org-go-to-remember-target (&optional template-key) |
| 12952 | (erase-buffer) | 13527 | "Go to the target location of a remember template. |
| 12953 | (let ((annotation (plist-get org-store-link-plist :annotation)) | 13528 | The user is queried for the template." |
| 12954 | (initial (plist-get org-store-link-plist :initial))) | 13529 | (interactive) |
| 12955 | (org-remember-apply-template)) | 13530 | (let* ((entry (org-select-remember-template template-key)) |
| 12956 | (message "Press C-c C-c to remember data")) | 13531 | (file (nth 1 entry)) |
| 12957 | (if (org-region-active-p) | 13532 | (heading (nth 2 entry)) |
| 12958 | (remember (buffer-substring (point) (mark))) | 13533 | visiting) |
| 12959 | (call-interactively 'remember)))) | 13534 | (unless (and file (stringp file) (string-match "\\S-" file)) |
| 13535 | (setq file org-default-notes-file)) | ||
| 13536 | (unless (and heading (stringp heading) (string-match "\\S-" heading)) | ||
| 13537 | (setq heading org-remember-default-headline)) | ||
| 13538 | (setq visiting (org-find-base-buffer-visiting file)) | ||
| 13539 | (if (not visiting) (find-file-noselect file)) | ||
| 13540 | (switch-to-buffer (or visiting (get-file-buffer file))) | ||
| 13541 | (widen) | ||
| 13542 | (goto-char (point-min)) | ||
| 13543 | (if (re-search-forward | ||
| 13544 | (concat "^\\*+[ \t]+" (regexp-quote heading) | ||
| 13545 | (org-re "\\([ \t]+:[[:alnum:]@_:]*\\)?[ \t]*$")) | ||
| 13546 | nil t) | ||
| 13547 | (goto-char (match-beginning 0)) | ||
| 13548 | (error "Target headline not found: %s" heading)))) | ||
| 12960 | 13549 | ||
| 12961 | (defvar org-note-abort nil) ; dynamically scoped | 13550 | (defvar org-note-abort nil) ; dynamically scoped |
| 12962 | 13551 | ||
| @@ -13000,23 +13589,34 @@ See also the variable `org-reverse-note-order'." | |||
| 13000 | (while (looking-at "^[ \t]*\n\\|^##.*\n") | 13589 | (while (looking-at "^[ \t]*\n\\|^##.*\n") |
| 13001 | (replace-match "")) | 13590 | (replace-match "")) |
| 13002 | (goto-char (point-max)) | 13591 | (goto-char (point-max)) |
| 13003 | (unless (equal (char-before) ?\n) (insert "\n")) | 13592 | (beginning-of-line 1) |
| 13593 | (while (looking-at "[ \t]*$\\|##.*") | ||
| 13594 | (delete-region (1- (point)) (point-max)) | ||
| 13595 | (beginning-of-line 1)) | ||
| 13004 | (catch 'quit | 13596 | (catch 'quit |
| 13005 | (if org-note-abort (throw 'quit nil)) | 13597 | (if org-note-abort (throw 'quit nil)) |
| 13006 | (let* ((txt (buffer-substring (point-min) (point-max))) | 13598 | (let* ((txt (buffer-substring (point-min) (point-max))) |
| 13007 | (fastp (org-xor (equal current-prefix-arg '(4)) | 13599 | (fastp (org-xor (equal current-prefix-arg '(4)) |
| 13008 | org-remember-store-without-prompt)) | 13600 | org-remember-store-without-prompt)) |
| 13009 | (file (if fastp org-default-notes-file (org-get-org-file))) | 13601 | (file (cond |
| 13602 | (fastp org-default-notes-file) | ||
| 13603 | ((and org-remember-use-refile-when-interactive | ||
| 13604 | org-refile-targets) | ||
| 13605 | org-default-notes-file) | ||
| 13606 | (t (org-get-org-file)))) | ||
| 13010 | (heading org-remember-default-headline) | 13607 | (heading org-remember-default-headline) |
| 13011 | (visiting (org-find-base-buffer-visiting file)) | 13608 | (visiting (and file (org-find-base-buffer-visiting file))) |
| 13012 | (org-startup-folded nil) | 13609 | (org-startup-folded nil) |
| 13013 | (org-startup-align-all-tables nil) | 13610 | (org-startup-align-all-tables nil) |
| 13014 | (org-goto-start-pos 1) | 13611 | (org-goto-start-pos 1) |
| 13015 | spos exitcmd level indent reversed) | 13612 | spos exitcmd level indent reversed) |
| 13016 | (if (and (equal current-prefix-arg '(16)) org-remember-previous-location) | 13613 | (if (and (equal current-prefix-arg '(16)) org-remember-previous-location) |
| 13017 | (setq file (car org-remember-previous-location) | 13614 | (setq file (car org-remember-previous-location) |
| 13018 | heading (cdr org-remember-previous-location))) | 13615 | heading (cdr org-remember-previous-location) |
| 13616 | fastp t)) | ||
| 13019 | (setq current-prefix-arg nil) | 13617 | (setq current-prefix-arg nil) |
| 13618 | (if (string-match "[ \t\n]+\\'" txt) | ||
| 13619 | (setq txt (replace-match "" t t txt))) | ||
| 13020 | ;; Modify text so that it becomes a nice subtree which can be inserted | 13620 | ;; Modify text so that it becomes a nice subtree which can be inserted |
| 13021 | ;; into an org tree. | 13621 | ;; into an org tree. |
| 13022 | (let* ((lines (split-string txt "\n")) | 13622 | (let* ((lines (split-string txt "\n")) |
| @@ -13031,9 +13631,25 @@ See also the variable `org-reverse-note-order'." | |||
| 13031 | " (" (remember-buffer-desc) ")") | 13631 | " (" (remember-buffer-desc) ")") |
| 13032 | indent " ")) | 13632 | indent " ")) |
| 13033 | (if (and org-adapt-indentation indent) | 13633 | (if (and org-adapt-indentation indent) |
| 13034 | (setq lines (mapcar (lambda (x) (concat indent x)) lines))) | 13634 | (setq lines (mapcar |
| 13635 | (lambda (x) | ||
| 13636 | (if (string-match "\\S-" x) | ||
| 13637 | (concat indent x) x)) | ||
| 13638 | lines))) | ||
| 13035 | (setq txt (concat first "\n" | 13639 | (setq txt (concat first "\n" |
| 13036 | (mapconcat 'identity lines "\n")))) | 13640 | (mapconcat 'identity lines "\n")))) |
| 13641 | (if (string-match "\n[ \t]*\n[ \t\n]*\\'" txt) | ||
| 13642 | (setq txt (replace-match "\n\n" t t txt)) | ||
| 13643 | (if (string-match "[ \t\n]*\\'" txt) | ||
| 13644 | (setq txt (replace-match "\n" t t txt)))) | ||
| 13645 | ;; Put the modified text back into the remember buffer, for refile. | ||
| 13646 | (erase-buffer) | ||
| 13647 | (insert txt) | ||
| 13648 | (goto-char (point-min)) | ||
| 13649 | (when (and org-remember-use-refile-when-interactive | ||
| 13650 | (not fastp)) | ||
| 13651 | (org-refile nil (or visiting (find-file-noselect file))) | ||
| 13652 | (throw 'quit t)) | ||
| 13037 | ;; Find the file | 13653 | ;; Find the file |
| 13038 | (if (not visiting) (find-file-noselect file)) | 13654 | (if (not visiting) (find-file-noselect file)) |
| 13039 | (with-current-buffer (or visiting (get-file-buffer file)) | 13655 | (with-current-buffer (or visiting (get-file-buffer file)) |
| @@ -13082,19 +13698,22 @@ See also the variable `org-reverse-note-order'." | |||
| 13082 | (org-get-heading 'notags))) | 13698 | (org-get-heading 'notags))) |
| 13083 | (if reversed | 13699 | (if reversed |
| 13084 | (outline-next-heading) | 13700 | (outline-next-heading) |
| 13085 | (org-end-of-subtree) | 13701 | (org-end-of-subtree t) |
| 13086 | (if (not (bolp)) | 13702 | (if (not (bolp)) |
| 13087 | (if (looking-at "[ \t]*\n") | 13703 | (if (looking-at "[ \t]*\n") |
| 13088 | (beginning-of-line 2) | 13704 | (beginning-of-line 2) |
| 13089 | (end-of-line 1) | 13705 | (end-of-line 1) |
| 13090 | (insert "\n")))) | 13706 | (insert "\n")))) |
| 13707 | (bookmark-set "org-remember-last-stored") | ||
| 13091 | (org-paste-subtree (org-get-legal-level level 1) txt)) | 13708 | (org-paste-subtree (org-get-legal-level level 1) txt)) |
| 13092 | ((eq exitcmd 'left) | 13709 | ((eq exitcmd 'left) |
| 13093 | ;; before current | 13710 | ;; before current |
| 13711 | (bookmark-set "org-remember-last-stored") | ||
| 13094 | (org-paste-subtree level txt)) | 13712 | (org-paste-subtree level txt)) |
| 13095 | ((eq exitcmd 'right) | 13713 | ((eq exitcmd 'right) |
| 13096 | ;; after current | 13714 | ;; after current |
| 13097 | (org-end-of-subtree t) | 13715 | (org-end-of-subtree t) |
| 13716 | (bookmark-set "org-remember-last-stored") | ||
| 13098 | (org-paste-subtree level txt)) | 13717 | (org-paste-subtree level txt)) |
| 13099 | (t (error "This should not happen")))) | 13718 | (t (error "This should not happen")))) |
| 13100 | 13719 | ||
| @@ -13104,6 +13723,7 @@ See also the variable `org-reverse-note-order'." | |||
| 13104 | (widen) | 13723 | (widen) |
| 13105 | (goto-char (point-max)) | 13724 | (goto-char (point-max)) |
| 13106 | (if (not (bolp)) (newline)) | 13725 | (if (not (bolp)) (newline)) |
| 13726 | (bookmark-set "org-remember-last-stored") | ||
| 13107 | (org-paste-subtree (org-get-legal-level 1 1) txt))) | 13727 | (org-paste-subtree (org-get-legal-level 1 1) txt))) |
| 13108 | 13728 | ||
| 13109 | ((and (bobp) reversed) | 13729 | ((and (bobp) reversed) |
| @@ -13113,16 +13733,19 @@ See also the variable `org-reverse-note-order'." | |||
| 13113 | (goto-char (point-min)) | 13733 | (goto-char (point-min)) |
| 13114 | (re-search-forward "^\\*+ " nil t) | 13734 | (re-search-forward "^\\*+ " nil t) |
| 13115 | (beginning-of-line 1) | 13735 | (beginning-of-line 1) |
| 13736 | (bookmark-set "org-remember-last-stored") | ||
| 13116 | (org-paste-subtree 1 txt))) | 13737 | (org-paste-subtree 1 txt))) |
| 13117 | (t | 13738 | (t |
| 13118 | ;; Put it right there, with automatic level determined by | 13739 | ;; Put it right there, with automatic level determined by |
| 13119 | ;; org-paste-subtree or from prefix arg | 13740 | ;; org-paste-subtree or from prefix arg |
| 13741 | (bookmark-set "org-remember-last-stored") | ||
| 13120 | (org-paste-subtree | 13742 | (org-paste-subtree |
| 13121 | (if (numberp current-prefix-arg) current-prefix-arg) | 13743 | (if (numberp current-prefix-arg) current-prefix-arg) |
| 13122 | txt))) | 13744 | txt))) |
| 13123 | (when remember-save-after-remembering | 13745 | (when remember-save-after-remembering |
| 13124 | (save-buffer) | 13746 | (save-buffer) |
| 13125 | (if (not visiting) (kill-buffer (current-buffer))))))))) | 13747 | (if (not visiting) (kill-buffer (current-buffer))))))))) |
| 13748 | |||
| 13126 | t) ;; return t to indicate that we took care of this note. | 13749 | t) ;; return t to indicate that we took care of this note. |
| 13127 | 13750 | ||
| 13128 | (defun org-get-org-file () | 13751 | (defun org-get-org-file () |
| @@ -13146,6 +13769,160 @@ See also the variable `org-reverse-note-order'." | |||
| 13146 | (throw 'exit (cdr entry)))) | 13769 | (throw 'exit (cdr entry)))) |
| 13147 | nil))))) | 13770 | nil))))) |
| 13148 | 13771 | ||
| 13772 | ;;; Refiling | ||
| 13773 | |||
| 13774 | (defvar org-refile-target-table nil | ||
| 13775 | "The list of refile targets, created by `org-refile'.") | ||
| 13776 | |||
| 13777 | (defvar org-agenda-new-buffers nil | ||
| 13778 | "Buffers created to visit agenda files.") | ||
| 13779 | |||
| 13780 | (defun org-get-refile-targets (&optional default-buffer) | ||
| 13781 | "Produce a table with refile targets." | ||
| 13782 | (let ((entries (or org-refile-targets '((nil . (:level . 1))))) | ||
| 13783 | org-agenda-new-buffers targets txt re files f desc descre) | ||
| 13784 | (with-current-buffer (or default-buffer (current-buffer)) | ||
| 13785 | (while (setq entry (pop entries)) | ||
| 13786 | (setq files (car entry) desc (cdr entry)) | ||
| 13787 | (cond | ||
| 13788 | ((null files) (setq files (list (current-buffer)))) | ||
| 13789 | ((eq files 'org-agenda-files) | ||
| 13790 | (setq files (org-agenda-files 'unrestricted))) | ||
| 13791 | ((and (symbolp files) (fboundp files)) | ||
| 13792 | (setq files (funcall files))) | ||
| 13793 | ((and (symbolp files) (boundp files)) | ||
| 13794 | (setq files (symbol-value files)))) | ||
| 13795 | (if (stringp files) (setq files (list files))) | ||
| 13796 | (cond | ||
| 13797 | ((eq (car desc) :tag) | ||
| 13798 | (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":"))) | ||
| 13799 | ((eq (car desc) :todo) | ||
| 13800 | (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]"))) | ||
| 13801 | ((eq (car desc) :regexp) | ||
| 13802 | (setq descre (cdr desc))) | ||
| 13803 | ((eq (car desc) :level) | ||
| 13804 | (setq descre (concat "^\\*\\{" (number-to-string | ||
| 13805 | (if org-odd-levels-only | ||
| 13806 | (1- (* 2 (cdr desc))) | ||
| 13807 | (cdr desc))) | ||
| 13808 | "\\}[ \t]"))) | ||
| 13809 | ((eq (car desc) :maxlevel) | ||
| 13810 | (setq descre (concat "^\\*\\{1," (number-to-string | ||
| 13811 | (if org-odd-levels-only | ||
| 13812 | (1- (* 2 (cdr desc))) | ||
| 13813 | (cdr desc))) | ||
| 13814 | "\\}[ \t]"))) | ||
| 13815 | (t (error "Bad refiling target description %s" desc))) | ||
| 13816 | (while (setq f (pop files)) | ||
| 13817 | (save-excursion | ||
| 13818 | (set-buffer (if (bufferp f) f (org-get-agenda-file-buffer f))) | ||
| 13819 | (if (bufferp f) (setq f (buffer-file-name (buffer-base-buffer f)))) | ||
| 13820 | (save-excursion | ||
| 13821 | (save-restriction | ||
| 13822 | (widen) | ||
| 13823 | (goto-char (point-min)) | ||
| 13824 | (while (re-search-forward descre nil t) | ||
| 13825 | (goto-char (point-at-bol)) | ||
| 13826 | (when (looking-at org-complex-heading-regexp) | ||
| 13827 | (setq txt (match-string 4) | ||
| 13828 | re (concat "^" (regexp-quote | ||
| 13829 | (buffer-substring (match-beginning 1) | ||
| 13830 | (match-end 4))))) | ||
| 13831 | (if (match-end 5) (setq re (concat re "[ \t]+" | ||
| 13832 | (regexp-quote | ||
| 13833 | (match-string 5))))) | ||
| 13834 | (setq re (concat re "[ \t]*$")) | ||
| 13835 | (when org-refile-use-outline-path | ||
| 13836 | (setq txt (mapconcat 'identity | ||
| 13837 | (append | ||
| 13838 | (if (eq org-refile-use-outline-path 'file) | ||
| 13839 | (list (file-name-nondirectory | ||
| 13840 | (buffer-file-name (buffer-base-buffer)))) | ||
| 13841 | (if (eq org-refile-use-outline-path 'full-file-path) | ||
| 13842 | (list (buffer-file-name (buffer-base-buffer))))) | ||
| 13843 | (org-get-outline-path) | ||
| 13844 | (list txt)) | ||
| 13845 | "/"))) | ||
| 13846 | (push (list txt f re (point)) targets)) | ||
| 13847 | (goto-char (point-at-eol)))))))) | ||
| 13848 | (org-release-buffers org-agenda-new-buffers) | ||
| 13849 | (nreverse targets)))) | ||
| 13850 | |||
| 13851 | (defun org-get-outline-path () | ||
| 13852 | (let (rtn) | ||
| 13853 | (save-excursion | ||
| 13854 | (while (org-up-heading-safe) | ||
| 13855 | (when (looking-at org-complex-heading-regexp) | ||
| 13856 | (push (org-match-string-no-properties 4) rtn))) | ||
| 13857 | rtn))) | ||
| 13858 | |||
| 13859 | (defvar org-refile-history nil | ||
| 13860 | "History for refiling operations.") | ||
| 13861 | |||
| 13862 | (defun org-refile (&optional reversed-or-update default-buffer) | ||
| 13863 | "Move the entry at point to another heading. | ||
| 13864 | The list of target headings is compiled using the information in | ||
| 13865 | `org-refile-targets', which see. This list is created upon first use, and | ||
| 13866 | you can update it by calling this command with a double prefix (`C-u C-u'). | ||
| 13867 | FIXME: Can we find a better way of updating? | ||
| 13868 | |||
| 13869 | At the target location, the entry is filed as a subitem of the target heading. | ||
| 13870 | Depending on `org-reverse-note-order', the new subitem will either be the | ||
| 13871 | first of the last subitem. A single C-u prefix will toggle the value of this | ||
| 13872 | variable for the duration of the command." | ||
| 13873 | (interactive "P") | ||
| 13874 | (if (equal reversed-or-update '(16)) | ||
| 13875 | (progn | ||
| 13876 | (setq org-refile-target-table (org-get-refile-targets default-buffer)) | ||
| 13877 | (message "Refile targets updated (%d targets)" | ||
| 13878 | (length org-refile-target-table))) | ||
| 13879 | (when (or (not org-refile-target-table) | ||
| 13880 | (assq nil org-refile-targets)) | ||
| 13881 | (setq org-refile-target-table (org-get-refile-targets default-buffer))) | ||
| 13882 | (unless org-refile-target-table | ||
| 13883 | (error "No refile targets")) | ||
| 13884 | (let* ((cbuf (current-buffer)) | ||
| 13885 | (filename (buffer-file-name (buffer-base-buffer cbuf))) | ||
| 13886 | (fname (and filename (file-truename filename))) | ||
| 13887 | (tbl (mapcar | ||
| 13888 | (lambda (x) | ||
| 13889 | (if (not (equal fname (file-truename (nth 1 x)))) | ||
| 13890 | (cons (concat (car x) " (" (file-name-nondirectory | ||
| 13891 | (nth 1 x)) ")") | ||
| 13892 | (cdr x)) | ||
| 13893 | x)) | ||
| 13894 | org-refile-target-table)) | ||
| 13895 | (completion-ignore-case t) | ||
| 13896 | pos it nbuf file re level reversed) | ||
| 13897 | (when (setq it (completing-read "Refile to: " tbl | ||
| 13898 | nil t nil 'org-refile-history)) | ||
| 13899 | (setq it (assoc it tbl) | ||
| 13900 | file (nth 1 it) | ||
| 13901 | re (nth 2 it)) | ||
| 13902 | (org-copy-special) | ||
| 13903 | (save-excursion | ||
| 13904 | (set-buffer (setq nbuf (or (find-buffer-visiting file) | ||
| 13905 | (find-file-noselect file)))) | ||
| 13906 | (setq reversed (org-notes-order-reversed-p)) | ||
| 13907 | (if (equal reversed-or-update '(16)) (setq reversed (not reversed))) | ||
| 13908 | (save-excursion | ||
| 13909 | (save-restriction | ||
| 13910 | (widen) | ||
| 13911 | (goto-char (point-min)) | ||
| 13912 | (unless (re-search-forward re nil t) | ||
| 13913 | (error "Cannot find target location - try again with `C-u' prefix.")) | ||
| 13914 | (goto-char (match-beginning 0)) | ||
| 13915 | (looking-at outline-regexp) | ||
| 13916 | (setq level (org-get-legal-level (funcall outline-level) 1)) | ||
| 13917 | (goto-char (or (save-excursion | ||
| 13918 | (if reversed | ||
| 13919 | (outline-next-heading) | ||
| 13920 | (outline-get-next-sibling))) | ||
| 13921 | (point-max))) | ||
| 13922 | (org-paste-subtree level)))) | ||
| 13923 | (org-cut-special) | ||
| 13924 | (message "Entry refiled to \"%s\"" (car it)))))) | ||
| 13925 | |||
| 13149 | ;;;; Dynamic blocks | 13926 | ;;;; Dynamic blocks |
| 13150 | 13927 | ||
| 13151 | (defun org-find-dblock (name) | 13928 | (defun org-find-dblock (name) |
| @@ -13264,7 +14041,8 @@ This function can be used in a hook." | |||
| 13264 | 14041 | ||
| 13265 | (defconst org-additional-option-like-keywords | 14042 | (defconst org-additional-option-like-keywords |
| 13266 | '("BEGIN_HTML" "BEGIN_LaTeX" "END_HTML" "END_LaTeX" | 14043 | '("BEGIN_HTML" "BEGIN_LaTeX" "END_HTML" "END_LaTeX" |
| 13267 | "ORGTBL" "HTML:" "LaTeX:" "BEGIN:" "END:" "DATE:")) | 14044 | "ORGTBL" "HTML:" "LaTeX:" "BEGIN:" "END:" "DATE:" "TBLFM" |
| 14045 | "BEGIN_EXAMPLE" "END_EXAMPLE")) | ||
| 13268 | 14046 | ||
| 13269 | (defun org-complete (&optional arg) | 14047 | (defun org-complete (&optional arg) |
| 13270 | "Perform completion on word at point. | 14048 | "Perform completion on word at point. |
| @@ -13385,13 +14163,14 @@ At all other locations, this simply calls the value of | |||
| 13385 | (interactive) | 14163 | (interactive) |
| 13386 | (save-excursion | 14164 | (save-excursion |
| 13387 | (org-back-to-heading) | 14165 | (org-back-to-heading) |
| 13388 | (if (looking-at (concat outline-regexp | 14166 | (let (case-fold-search) |
| 13389 | "\\( *\\<" org-comment-string "\\>[ \t]*\\)")) | 14167 | (if (looking-at (concat outline-regexp |
| 13390 | (replace-match "" t t nil 1) | 14168 | "\\( *\\<" org-comment-string "\\>[ \t]*\\)")) |
| 13391 | (if (looking-at outline-regexp) | 14169 | (replace-match "" t t nil 1) |
| 13392 | (progn | 14170 | (if (looking-at outline-regexp) |
| 13393 | (goto-char (match-end 0)) | 14171 | (progn |
| 13394 | (insert org-comment-string " ")))))) | 14172 | (goto-char (match-end 0)) |
| 14173 | (insert org-comment-string " "))))))) | ||
| 13395 | 14174 | ||
| 13396 | (defvar org-last-todo-state-is-todo nil | 14175 | (defvar org-last-todo-state-is-todo nil |
| 13397 | "This is non-nil when the last TODO state change led to a TODO state. | 14176 | "This is non-nil when the last TODO state change led to a TODO state. |
| @@ -13491,7 +14270,7 @@ For calling through lisp, arg is also interpreted in the following way: | |||
| 13491 | (or (looking-at (concat " +" org-todo-regexp " *")) | 14270 | (or (looking-at (concat " +" org-todo-regexp " *")) |
| 13492 | (looking-at " *")) | 14271 | (looking-at " *")) |
| 13493 | (let* ((match-data (match-data)) | 14272 | (let* ((match-data (match-data)) |
| 13494 | (startpos (line-beginning-position)) | 14273 | (startpos (point-at-bol)) |
| 13495 | (logging (save-match-data (org-entry-get nil "LOGGING" t))) | 14274 | (logging (save-match-data (org-entry-get nil "LOGGING" t))) |
| 13496 | (org-log-done (org-parse-local-options logging 'org-log-done)) | 14275 | (org-log-done (org-parse-local-options logging 'org-log-done)) |
| 13497 | (org-log-repeat (org-parse-local-options logging 'org-log-repeat)) | 14276 | (org-log-repeat (org-parse-local-options logging 'org-log-repeat)) |
| @@ -13666,8 +14445,6 @@ Returns the new TODO keyword, or nil if no state change should occur." | |||
| 13666 | (save-window-excursion | 14445 | (save-window-excursion |
| 13667 | (if expert | 14446 | (if expert |
| 13668 | (set-buffer (get-buffer-create " *Org todo*")) | 14447 | (set-buffer (get-buffer-create " *Org todo*")) |
| 13669 | ; (delete-other-windows) | ||
| 13670 | ; (split-window-vertically) | ||
| 13671 | (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*"))) | 14448 | (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*"))) |
| 13672 | (erase-buffer) | 14449 | (erase-buffer) |
| 13673 | (org-set-local 'org-done-keywords done-keywords) | 14450 | (org-set-local 'org-done-keywords done-keywords) |
| @@ -13968,7 +14745,7 @@ The auto-repeater uses this.") | |||
| 13968 | (end-of-line 1) | 14745 | (end-of-line 1) |
| 13969 | (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) | 14746 | (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) |
| 13970 | (indent-relative nil) | 14747 | (indent-relative nil) |
| 13971 | (insert " - " (pop lines)) | 14748 | (insert "- " (pop lines)) |
| 13972 | (org-indent-line-function) | 14749 | (org-indent-line-function) |
| 13973 | (beginning-of-line 1) | 14750 | (beginning-of-line 1) |
| 13974 | (looking-at "[ \t]*") | 14751 | (looking-at "[ \t]*") |
| @@ -13994,12 +14771,17 @@ t Show entries with a specific TODO keyword. | |||
| 13994 | T Show entries selected by a tags match. | 14771 | T Show entries selected by a tags match. |
| 13995 | p Enter a property name and its value (both with completion on existing | 14772 | p Enter a property name and its value (both with completion on existing |
| 13996 | names/values) and show entries with that property. | 14773 | names/values) and show entries with that property. |
| 13997 | r Show entries matching a regular expression" | 14774 | r Show entries matching a regular expression |
| 14775 | d Show deadlines due within `org-deadline-warning-days'." | ||
| 13998 | (interactive "P") | 14776 | (interactive "P") |
| 13999 | (let (ans kwd value) | 14777 | (let (ans kwd value) |
| 14000 | (message "Sparse tree: [r]egexp [t]odo-kwd [T]ag [p]roperty") | 14778 | (message "Sparse tree: [/]regexp [t]odo-kwd [T]ag [p]roperty [d]eadlines [b]efore-date") |
| 14001 | (setq ans (read-char-exclusive)) | 14779 | (setq ans (read-char-exclusive)) |
| 14002 | (cond | 14780 | (cond |
| 14781 | ((equal ans ?d) | ||
| 14782 | (call-interactively 'org-check-deadlines)) | ||
| 14783 | ((equal ans ?b) | ||
| 14784 | (call-interactively 'org-check-before-date)) | ||
| 14003 | ((equal ans ?t) | 14785 | ((equal ans ?t) |
| 14004 | (org-show-todo-tree '(4))) | 14786 | (org-show-todo-tree '(4))) |
| 14005 | ((equal ans ?T) | 14787 | ((equal ans ?T) |
| @@ -14012,7 +14794,7 @@ r Show entries matching a regular expression" | |||
| 14012 | (unless (string-match "\\`{.*}\\'" value) | 14794 | (unless (string-match "\\`{.*}\\'" value) |
| 14013 | (setq value (concat "\"" value "\""))) | 14795 | (setq value (concat "\"" value "\""))) |
| 14014 | (org-tags-sparse-tree arg (concat kwd "=" value))) | 14796 | (org-tags-sparse-tree arg (concat kwd "=" value))) |
| 14015 | ((member ans '(?r ?R)) | 14797 | ((member ans '(?r ?R ?/)) |
| 14016 | (call-interactively 'org-occur)) | 14798 | (call-interactively 'org-occur)) |
| 14017 | (t (error "No such sparse tree command \"%c\"" ans))))) | 14799 | (t (error "No such sparse tree command \"%c\"" ans))))) |
| 14018 | 14800 | ||
| @@ -14063,12 +14845,13 @@ How much context is shown depends upon the variables | |||
| 14063 | (let ((heading-p (org-on-heading-p t)) | 14845 | (let ((heading-p (org-on-heading-p t)) |
| 14064 | (hierarchy-p (org-get-alist-option org-show-hierarchy-above key)) | 14846 | (hierarchy-p (org-get-alist-option org-show-hierarchy-above key)) |
| 14065 | (following-p (org-get-alist-option org-show-following-heading key)) | 14847 | (following-p (org-get-alist-option org-show-following-heading key)) |
| 14848 | (entry-p (org-get-alist-option org-show-entry-below key)) | ||
| 14066 | (siblings-p (org-get-alist-option org-show-siblings key))) | 14849 | (siblings-p (org-get-alist-option org-show-siblings key))) |
| 14067 | (catch 'exit | 14850 | (catch 'exit |
| 14068 | ;; Show heading or entry text | 14851 | ;; Show heading or entry text |
| 14069 | (if heading-p | 14852 | (if (and heading-p (not entry-p)) |
| 14070 | (org-flag-heading nil) ; only show the heading | 14853 | (org-flag-heading nil) ; only show the heading |
| 14071 | (and (or (org-invisible-p) (org-invisible-p2)) | 14854 | (and (or entry-p (org-invisible-p) (org-invisible-p2)) |
| 14072 | (org-show-hidden-entry))) ; show entire entry | 14855 | (org-show-hidden-entry))) ; show entire entry |
| 14073 | (when following-p | 14856 | (when following-p |
| 14074 | ;; Show next sibling, or heading below text | 14857 | ;; Show next sibling, or heading below text |
| @@ -14303,11 +15086,13 @@ MATCH can contain positive and negative selection of tags, like | |||
| 14303 | If optional argument TODO_ONLY is non-nil, only select lines that are | 15086 | If optional argument TODO_ONLY is non-nil, only select lines that are |
| 14304 | also TODO lines." | 15087 | also TODO lines." |
| 14305 | (interactive "P") | 15088 | (interactive "P") |
| 15089 | (org-prepare-agenda-buffers (list (current-buffer))) | ||
| 14306 | (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) | 15090 | (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) |
| 14307 | 15091 | ||
| 14308 | (defvar org-cached-props nil) | 15092 | (defvar org-cached-props nil) |
| 14309 | (defun org-cached-entry-get (pom property) | 15093 | (defun org-cached-entry-get (pom property) |
| 14310 | (if org-use-property-inheritance | 15094 | (if (or (eq t org-use-property-inheritance) |
| 15095 | (member property org-use-property-inheritance)) | ||
| 14311 | ;; Caching is not possible, check it directly | 15096 | ;; Caching is not possible, check it directly |
| 14312 | (org-entry-get pom property 'inherit) | 15097 | (org-entry-get pom property 'inherit) |
| 14313 | ;; Get all properties, so that we can do complicated checks easily | 15098 | ;; Get all properties, so that we can do complicated checks easily |
| @@ -14345,7 +15130,7 @@ also TODO lines." | |||
| 14345 | (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL=\\([0-9]+\\)\\|\\([[:alnum:]_]+\\)=\\({[^}]+}\\|\"[^\"]+\"\\)\\|[[:alnum:]_@]+\\)")) | 15130 | (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL=\\([0-9]+\\)\\|\\([[:alnum:]_]+\\)=\\({[^}]+}\\|\"[^\"]+\"\\)\\|[[:alnum:]_@]+\\)")) |
| 14346 | minus tag mm | 15131 | minus tag mm |
| 14347 | tagsmatch todomatch tagsmatcher todomatcher kwd matcher | 15132 | tagsmatch todomatch tagsmatcher todomatcher kwd matcher |
| 14348 | orterms term orlist re-p level-p prop-p pn pv) | 15133 | orterms term orlist re-p level-p prop-p pn pv cat-p gv) |
| 14349 | (if (string-match "/+" match) | 15134 | (if (string-match "/+" match) |
| 14350 | ;; match contains also a todo-matching request | 15135 | ;; match contains also a todo-matching request |
| 14351 | (progn | 15136 | (progn |
| @@ -14379,11 +15164,15 @@ also TODO lines." | |||
| 14379 | (prop-p | 15164 | (prop-p |
| 14380 | (setq pn (match-string 4 term) | 15165 | (setq pn (match-string 4 term) |
| 14381 | pv (match-string 5 term) | 15166 | pv (match-string 5 term) |
| 15167 | cat-p (equal pn "CATEGORY") | ||
| 14382 | re-p (equal (string-to-char pv) ?{) | 15168 | re-p (equal (string-to-char pv) ?{) |
| 14383 | pv (substring pv 1 -1)) | 15169 | pv (substring pv 1 -1)) |
| 15170 | (if (equal pn "CATEGORY") | ||
| 15171 | (setq gv '(get-text-property (point) 'org-category)) | ||
| 15172 | (setq gv `(org-cached-entry-get nil ,pn))) | ||
| 14384 | (if re-p | 15173 | (if re-p |
| 14385 | `(string-match ,pv (or (org-cached-entry-get nil ,pn) "")) | 15174 | `(string-match ,pv (or ,gv "")) |
| 14386 | `(equal ,pv (org-cached-entry-get nil ,pn)))) | 15175 | `(equal ,pv ,gv))) |
| 14387 | (t `(member ,(downcase tag) tags-list))) | 15176 | (t `(member ,(downcase tag) tags-list))) |
| 14388 | mm (if minus (list 'not mm) mm) | 15177 | mm (if minus (list 'not mm) mm) |
| 14389 | term (substring term (match-end 0))) | 15178 | term (substring term (match-end 0))) |
| @@ -14839,7 +15628,8 @@ Returns the new tags string, or nil to not change the current settings." | |||
| 14839 | ;;; Setting and retrieving properties | 15628 | ;;; Setting and retrieving properties |
| 14840 | 15629 | ||
| 14841 | (defconst org-special-properties | 15630 | (defconst org-special-properties |
| 14842 | '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "PRIORITY") | 15631 | '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "PRIORITY" |
| 15632 | "TIMESTAMP" "TIMESTAMP_IA") | ||
| 14843 | "The special properties valid in Org-mode. | 15633 | "The special properties valid in Org-mode. |
| 14844 | 15634 | ||
| 14845 | These are properties that are not defined in the property drawer, | 15635 | These are properties that are not defined in the property drawer, |
| @@ -14935,11 +15725,12 @@ If WHICH is nil or `all', get all properties. If WHICH is | |||
| 14935 | (org-with-point-at pom | 15725 | (org-with-point-at pom |
| 14936 | (let ((clockstr (substring org-clock-string 0 -1)) | 15726 | (let ((clockstr (substring org-clock-string 0 -1)) |
| 14937 | (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY")) | 15727 | (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY")) |
| 14938 | beg end range props sum-props key value) | 15728 | beg end range props sum-props key value string clocksum) |
| 14939 | (save-excursion | 15729 | (save-excursion |
| 14940 | (when (condition-case nil (org-back-to-heading t) (error nil)) | 15730 | (when (condition-case nil (org-back-to-heading t) (error nil)) |
| 14941 | (setq beg (point)) | 15731 | (setq beg (point)) |
| 14942 | (setq sum-props (get-text-property (point) 'org-summaries)) | 15732 | (setq sum-props (get-text-property (point) 'org-summaries)) |
| 15733 | (setq clocksum (get-text-property (point) :org-clock-minutes)) | ||
| 14943 | (outline-next-heading) | 15734 | (outline-next-heading) |
| 14944 | (setq end (point)) | 15735 | (setq end (point)) |
| 14945 | (when (memq which '(all special)) | 15736 | (when (memq which '(all special)) |
| @@ -14955,17 +15746,23 @@ If WHICH is nil or `all', get all properties. If WHICH is | |||
| 14955 | (when (setq value (org-get-tags-at)) | 15746 | (when (setq value (org-get-tags-at)) |
| 14956 | (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") ":")) | 15747 | (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") ":")) |
| 14957 | props)) | 15748 | props)) |
| 14958 | (while (re-search-forward org-keyword-time-regexp end t) | 15749 | (while (re-search-forward org-maybe-keyword-time-regexp end t) |
| 14959 | (setq key (substring (org-match-string-no-properties 1) 0 -1)) | 15750 | (setq key (if (match-end 1) (substring (org-match-string-no-properties 1) 0 -1)) |
| 14960 | (unless (member key excluded) (push key excluded)) | 15751 | string (if (equal key clockstr) |
| 14961 | (push (cons key | 15752 | (org-no-properties |
| 14962 | (if (equal key clockstr) | 15753 | (org-trim |
| 14963 | (org-no-properties | 15754 | (buffer-substring |
| 14964 | (org-trim | 15755 | (match-beginning 3) (goto-char (point-at-eol))))) |
| 14965 | (buffer-substring | 15756 | (substring (org-match-string-no-properties 3) 1 -1))) |
| 14966 | (match-beginning 2) (point-at-eol)))) | 15757 | (unless key |
| 14967 | (org-match-string-no-properties 2))) | 15758 | (if (= (char-after (match-beginning 3)) ?\[) |
| 14968 | props))) | 15759 | (setq key "TIMESTAMP_IA") |
| 15760 | (setq key "TIMESTAMP"))) | ||
| 15761 | (when (or (equal key clockstr) (not (assoc key props))) | ||
| 15762 | (push (cons key string) props))) | ||
| 15763 | |||
| 15764 | ) | ||
| 15765 | |||
| 14969 | (when (memq which '(all standard)) | 15766 | (when (memq which '(all standard)) |
| 14970 | ;; Get the standard properties, like :PORP: ... | 15767 | ;; Get the standard properties, like :PORP: ... |
| 14971 | (setq range (org-get-property-block beg end)) | 15768 | (setq range (org-get-property-block beg end)) |
| @@ -14978,6 +15775,11 @@ If WHICH is nil or `all', get all properties. If WHICH is | |||
| 14978 | value (org-trim (or (org-match-string-no-properties 2) ""))) | 15775 | value (org-trim (or (org-match-string-no-properties 2) ""))) |
| 14979 | (unless (member key excluded) | 15776 | (unless (member key excluded) |
| 14980 | (push (cons key (or value "")) props))))) | 15777 | (push (cons key (or value "")) props))))) |
| 15778 | (if clocksum | ||
| 15779 | (push (cons "CLOCKSUM" | ||
| 15780 | (org-column-number-to-string (/ (float clocksum) 60.) | ||
| 15781 | 'add_times)) | ||
| 15782 | props)) | ||
| 14981 | (append sum-props (nreverse props))))))) | 15783 | (append sum-props (nreverse props))))))) |
| 14982 | 15784 | ||
| 14983 | (defun org-entry-get (pom property &optional inherit) | 15785 | (defun org-entry-get (pom property &optional inherit) |
| @@ -15175,6 +15977,7 @@ internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING." | |||
| 15175 | (and (equal (char-after) ?\n) (forward-char 1)) | 15977 | (and (equal (char-after) ?\n) (forward-char 1)) |
| 15176 | (org-skip-over-state-notes) | 15978 | (org-skip-over-state-notes) |
| 15177 | (skip-chars-backward " \t\n\r") | 15979 | (skip-chars-backward " \t\n\r") |
| 15980 | (if (eq (char-before) ?*) (forward-char 1)) | ||
| 15178 | (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:")) | 15981 | (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:")) |
| 15179 | (beginning-of-line 0) | 15982 | (beginning-of-line 0) |
| 15180 | (indent-to-column indent) | 15983 | (indent-to-column indent) |
| @@ -15610,6 +16413,8 @@ Where possible, use the standard interface for changing this line." | |||
| 15610 | org-columns-overlays))) | 16413 | org-columns-overlays))) |
| 15611 | nval eval allowed) | 16414 | nval eval allowed) |
| 15612 | (cond | 16415 | (cond |
| 16416 | ((equal key "CLOCKSUM") | ||
| 16417 | (error "This special column cannot be edited")) | ||
| 15613 | ((equal key "ITEM") | 16418 | ((equal key "ITEM") |
| 15614 | (setq eval '(org-with-point-at pom | 16419 | (setq eval '(org-with-point-at pom |
| 15615 | (org-edit-headline)))) | 16420 | (org-edit-headline)))) |
| @@ -15680,7 +16485,7 @@ Where possible, use the standard interface for changing this line." | |||
| 15680 | (key1 (concat key "_ALL")) | 16485 | (key1 (concat key "_ALL")) |
| 15681 | (allowed (org-entry-get (point) key1 t)) | 16486 | (allowed (org-entry-get (point) key1 t)) |
| 15682 | nval) | 16487 | nval) |
| 15683 | ;; FIXME: Cover editing TODO, TAGS etc inbiffer settings.???? | 16488 | ;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.???? |
| 15684 | (setq nval (read-string "Allowed: " allowed)) | 16489 | (setq nval (read-string "Allowed: " allowed)) |
| 15685 | (org-entry-put | 16490 | (org-entry-put |
| 15686 | (cond ((marker-position org-entry-property-inherited-from) | 16491 | (cond ((marker-position org-entry-property-inherited-from) |
| @@ -15697,7 +16502,7 @@ Where possible, use the standard interface for changing this line." | |||
| 15697 | (save-excursion | 16502 | (save-excursion |
| 15698 | (beginning-of-line 1) | 16503 | (beginning-of-line 1) |
| 15699 | ;; `next-line' is needed here, because it skips invisible line. | 16504 | ;; `next-line' is needed here, because it skips invisible line. |
| 15700 | (condition-case nil (org-no-warnings (next-line 1)) (error nil)) | 16505 | (condition-case nil (org-no-warnings (next-line 1)) (error nil)) |
| 15701 | (setq hidep (org-on-heading-p 1))) | 16506 | (setq hidep (org-on-heading-p 1))) |
| 15702 | (eval form) | 16507 | (eval form) |
| 15703 | (and hidep (hide-entry)))) | 16508 | (and hidep (hide-entry)))) |
| @@ -15797,7 +16602,7 @@ Where possible, use the standard interface for changing this line." | |||
| 15797 | (org-verify-version 'columns) | 16602 | (org-verify-version 'columns) |
| 15798 | (org-columns-remove-overlays) | 16603 | (org-columns-remove-overlays) |
| 15799 | (move-marker org-columns-begin-marker (point)) | 16604 | (move-marker org-columns-begin-marker (point)) |
| 15800 | (let (beg end fmt cache maxwidths) | 16605 | (let (beg end fmt cache maxwidths clocksump) |
| 15801 | (setq fmt (org-columns-get-format-and-top-level)) | 16606 | (setq fmt (org-columns-get-format-and-top-level)) |
| 15802 | (save-excursion | 16607 | (save-excursion |
| 15803 | (goto-char org-columns-top-level-marker) | 16608 | (goto-char org-columns-top-level-marker) |
| @@ -15806,8 +16611,14 @@ Where possible, use the standard interface for changing this line." | |||
| 15806 | (org-columns-compute-all)) | 16611 | (org-columns-compute-all)) |
| 15807 | (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil)) | 16612 | (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil)) |
| 15808 | (point-max))) | 16613 | (point-max))) |
| 15809 | (goto-char beg) | ||
| 15810 | ;; Get and cache the properties | 16614 | ;; Get and cache the properties |
| 16615 | (goto-char beg) | ||
| 16616 | (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled) | ||
| 16617 | (setq clocksump t) | ||
| 16618 | (save-excursion | ||
| 16619 | (save-restriction | ||
| 16620 | (narrow-to-region beg end) | ||
| 16621 | (org-clock-sum)))) | ||
| 15811 | (while (re-search-forward (concat "^" outline-regexp) end t) | 16622 | (while (re-search-forward (concat "^" outline-regexp) end t) |
| 15812 | (push (cons (org-current-line) (org-entry-properties)) cache)) | 16623 | (push (cons (org-current-line) (org-entry-properties)) cache)) |
| 15813 | (when cache | 16624 | (when cache |
| @@ -15819,7 +16630,7 @@ Where possible, use the standard interface for changing this line." | |||
| 15819 | (org-columns-display-here (cdr x))) | 16630 | (org-columns-display-here (cdr x))) |
| 15820 | cache))))) | 16631 | cache))))) |
| 15821 | 16632 | ||
| 15822 | (defun org-columns-new (&optional prop title width op fmt) | 16633 | (defun org-columns-new (&optional prop title width op fmt &rest rest) |
| 15823 | "Insert a new column, to the leeft o the current column." | 16634 | "Insert a new column, to the leeft o the current column." |
| 15824 | (interactive) | 16635 | (interactive) |
| 15825 | (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled))) | 16636 | (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled))) |
| @@ -15833,7 +16644,7 @@ Where possible, use the standard interface for changing this line." | |||
| 15833 | (setq width (string-to-number width)) | 16644 | (setq width (string-to-number width)) |
| 15834 | (setq width nil)) | 16645 | (setq width nil)) |
| 15835 | (setq fmt (completing-read "Summary [none]: " | 16646 | (setq fmt (completing-read "Summary [none]: " |
| 15836 | '(("none") ("add_numbers") ("add_times") ("checkbox")) | 16647 | '(("none") ("add_numbers") ("currency") ("add_times") ("checkbox")) |
| 15837 | nil t)) | 16648 | nil t)) |
| 15838 | (if (string-match "\\S-" fmt) | 16649 | (if (string-match "\\S-" fmt) |
| 15839 | (setq fmt (intern fmt)) | 16650 | (setq fmt (intern fmt)) |
| @@ -16036,6 +16847,7 @@ display, or in the #+COLUMNS line of the current buffer." | |||
| 16036 | (level 0) | 16847 | (level 0) |
| 16037 | (ass (assoc property org-columns-current-fmt-compiled)) | 16848 | (ass (assoc property org-columns-current-fmt-compiled)) |
| 16038 | (format (nth 4 ass)) | 16849 | (format (nth 4 ass)) |
| 16850 | (printf (nth 5 ass)) | ||
| 16039 | (beg org-columns-top-level-marker) | 16851 | (beg org-columns-top-level-marker) |
| 16040 | last-level val valflag flag end sumpos sum-alist sum str str1 useval) | 16852 | last-level val valflag flag end sumpos sum-alist sum str str1 useval) |
| 16041 | (save-excursion | 16853 | (save-excursion |
| @@ -16055,7 +16867,7 @@ display, or in the #+COLUMNS line of the current buffer." | |||
| 16055 | ;; put the sum of lower levels here as a property | 16867 | ;; put the sum of lower levels here as a property |
| 16056 | (setq sum (aref lsum last-level) ; current sum | 16868 | (setq sum (aref lsum last-level) ; current sum |
| 16057 | flag (aref lflag last-level) ; any valid entries from children? | 16869 | flag (aref lflag last-level) ; any valid entries from children? |
| 16058 | str (org-column-number-to-string sum format) | 16870 | str (org-column-number-to-string sum format printf) |
| 16059 | str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold) | 16871 | str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold) |
| 16060 | useval (if flag str1 (if valflag val "")) | 16872 | useval (if flag str1 (if valflag val "")) |
| 16061 | sum-alist (get-text-property sumpos 'org-summaries)) | 16873 | sum-alist (get-text-property sumpos 'org-summaries)) |
| @@ -16069,7 +16881,6 @@ display, or in the #+COLUMNS line of the current buffer." | |||
| 16069 | (org-entry-put nil property (if flag str val))) | 16881 | (org-entry-put nil property (if flag str val))) |
| 16070 | ;; add current to current level accumulator | 16882 | ;; add current to current level accumulator |
| 16071 | (when (or flag valflag) | 16883 | (when (or flag valflag) |
| 16072 | ;; FIXME: is this ok????????? | ||
| 16073 | (aset lsum level (+ (aref lsum level) | 16884 | (aset lsum level (+ (aref lsum level) |
| 16074 | (if flag sum (org-column-string-to-number | 16885 | (if flag sum (org-column-string-to-number |
| 16075 | (if flag str val) format)))) | 16886 | (if flag str val) format)))) |
| @@ -16112,7 +16923,7 @@ display, or in the #+COLUMNS line of the current buffer." | |||
| 16112 | (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) | 16923 | (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) |
| 16113 | sum))) | 16924 | sum))) |
| 16114 | 16925 | ||
| 16115 | (defun org-column-number-to-string (n fmt) | 16926 | (defun org-column-number-to-string (n fmt &optional printf) |
| 16116 | "Convert a computed column number to a string value, according to FMT." | 16927 | "Convert a computed column number to a string value, according to FMT." |
| 16117 | (cond | 16928 | (cond |
| 16118 | ((eq fmt 'add_times) | 16929 | ((eq fmt 'add_times) |
| @@ -16122,6 +16933,9 @@ display, or in the #+COLUMNS line of the current buffer." | |||
| 16122 | (cond ((= n (floor n)) "[X]") | 16933 | (cond ((= n (floor n)) "[X]") |
| 16123 | ((> n 1.) "[-]") | 16934 | ((> n 1.) "[-]") |
| 16124 | (t "[ ]"))) | 16935 | (t "[ ]"))) |
| 16936 | (printf (format printf n)) | ||
| 16937 | ((eq fmt 'currency) | ||
| 16938 | (format "%.2f" n)) | ||
| 16125 | (t (number-to-string n)))) | 16939 | (t (number-to-string n)))) |
| 16126 | 16940 | ||
| 16127 | (defun org-column-string-to-number (s fmt) | 16941 | (defun org-column-string-to-number (s fmt) |
| @@ -16138,17 +16952,20 @@ display, or in the #+COLUMNS line of the current buffer." | |||
| 16138 | 16952 | ||
| 16139 | (defun org-columns-uncompile-format (cfmt) | 16953 | (defun org-columns-uncompile-format (cfmt) |
| 16140 | "Turn the compiled columns format back into a string representation." | 16954 | "Turn the compiled columns format back into a string representation." |
| 16141 | (let ((rtn "") e s prop title op width fmt) | 16955 | (let ((rtn "") e s prop title op width fmt printf) |
| 16142 | (while (setq e (pop cfmt)) | 16956 | (while (setq e (pop cfmt)) |
| 16143 | (setq prop (car e) | 16957 | (setq prop (car e) |
| 16144 | title (nth 1 e) | 16958 | title (nth 1 e) |
| 16145 | width (nth 2 e) | 16959 | width (nth 2 e) |
| 16146 | op (nth 3 e) | 16960 | op (nth 3 e) |
| 16147 | fmt (nth 4 e)) | 16961 | fmt (nth 4 e) |
| 16962 | printf (nth 5 e)) | ||
| 16148 | (cond | 16963 | (cond |
| 16149 | ((eq fmt 'add_times) (setq op ":")) | 16964 | ((eq fmt 'add_times) (setq op ":")) |
| 16150 | ((eq fmt 'checkbox) (setq op "X")) | 16965 | ((eq fmt 'checkbox) (setq op "X")) |
| 16151 | ((eq fmt 'add_numbers) (setq op "+"))) | 16966 | ((eq fmt 'add_numbers) (setq op "+")) |
| 16967 | ((eq fmt 'currency) (setq op "$"))) | ||
| 16968 | (if (and op printf) (setq op (concat op ";" printf))) | ||
| 16152 | (if (equal title prop) (setq title nil)) | 16969 | (if (equal title prop) (setq title nil)) |
| 16153 | (setq s (concat "%" (if width (number-to-string width)) | 16970 | (setq s (concat "%" (if width (number-to-string width)) |
| 16154 | prop | 16971 | prop |
| @@ -16165,8 +16982,9 @@ property the property | |||
| 16165 | title the title field for the columns | 16982 | title the title field for the columns |
| 16166 | width the column width in characters, can be nil for automatic | 16983 | width the column width in characters, can be nil for automatic |
| 16167 | operator the operator if any | 16984 | operator the operator if any |
| 16168 | format the output format for computed results, derived from operator" | 16985 | format the output format for computed results, derived from operator |
| 16169 | (let ((start 0) width prop title op f) | 16986 | printf a printf format for computed values" |
| 16987 | (let ((start 0) width prop title op f printf) | ||
| 16170 | (setq org-columns-current-fmt-compiled nil) | 16988 | (setq org-columns-current-fmt-compiled nil) |
| 16171 | (while (string-match | 16989 | (while (string-match |
| 16172 | (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*") | 16990 | (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*") |
| @@ -16176,13 +16994,18 @@ format the output format for computed results, derived from operator" | |||
| 16176 | prop (match-string 2 fmt) | 16994 | prop (match-string 2 fmt) |
| 16177 | title (or (match-string 3 fmt) prop) | 16995 | title (or (match-string 3 fmt) prop) |
| 16178 | op (match-string 4 fmt) | 16996 | op (match-string 4 fmt) |
| 16179 | f nil) | 16997 | f nil |
| 16998 | printf nil) | ||
| 16180 | (if width (setq width (string-to-number width))) | 16999 | (if width (setq width (string-to-number width))) |
| 17000 | (when (and op (string-match ";" op)) | ||
| 17001 | (setq printf (substring op (match-end 0)) | ||
| 17002 | op (substring op 0 (match-beginning 0)))) | ||
| 16181 | (cond | 17003 | (cond |
| 16182 | ((equal op "+") (setq f 'add_numbers)) | 17004 | ((equal op "+") (setq f 'add_numbers)) |
| 17005 | ((equal op "$") (setq f 'currency)) | ||
| 16183 | ((equal op ":") (setq f 'add_times)) | 17006 | ((equal op ":") (setq f 'add_times)) |
| 16184 | ((equal op "X") (setq f 'checkbox))) | 17007 | ((equal op "X") (setq f 'checkbox))) |
| 16185 | (push (list prop title width op f) org-columns-current-fmt-compiled)) | 17008 | (push (list prop title width op f printf) org-columns-current-fmt-compiled)) |
| 16186 | (setq org-columns-current-fmt-compiled | 17009 | (setq org-columns-current-fmt-compiled |
| 16187 | (nreverse org-columns-current-fmt-compiled)))) | 17010 | (nreverse org-columns-current-fmt-compiled)))) |
| 16188 | 17011 | ||
| @@ -16311,28 +17134,30 @@ So if you press just return without typing anything, the time stamp | |||
| 16311 | will represent the current date/time. If there is already a timestamp | 17134 | will represent the current date/time. If there is already a timestamp |
| 16312 | at the cursor, it will be modified." | 17135 | at the cursor, it will be modified." |
| 16313 | (interactive "P") | 17136 | (interactive "P") |
| 16314 | (let ((default-time | 17137 | (let* ((ts nil) |
| 16315 | ;; Default time is either today, or, when entering a range, | 17138 | (default-time |
| 16316 | ;; the range start. | 17139 | ;; Default time is either today, or, when entering a range, |
| 16317 | (if (or (org-at-timestamp-p t) | 17140 | ;; the range start. |
| 16318 | (save-excursion | 17141 | (if (or (and (org-at-timestamp-p t) (setq ts (match-string 0))) |
| 16319 | (re-search-backward | 17142 | (save-excursion |
| 16320 | (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses | 17143 | (re-search-backward |
| 16321 | (- (point) 20) t))) | 17144 | (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses |
| 16322 | (apply 'encode-time (org-parse-time-string (match-string 1))) | 17145 | (- (point) 20) t))) |
| 16323 | (current-time))) | 17146 | (apply 'encode-time (org-parse-time-string (match-string 1))) |
| 16324 | org-time-was-given org-end-time-was-given time) | 17147 | (current-time))) |
| 17148 | (default-input (and ts (org-get-compact-tod ts))) | ||
| 17149 | org-time-was-given org-end-time-was-given time) | ||
| 16325 | (cond | 17150 | (cond |
| 16326 | ((and (org-at-timestamp-p) | 17151 | ((and (org-at-timestamp-p) |
| 16327 | (eq last-command 'org-time-stamp) | 17152 | (eq last-command 'org-time-stamp) |
| 16328 | (eq this-command 'org-time-stamp)) | 17153 | (eq this-command 'org-time-stamp)) |
| 16329 | (insert "--") | 17154 | (insert "--") |
| 16330 | (setq time (let ((this-command this-command)) | 17155 | (setq time (let ((this-command this-command)) |
| 16331 | (org-read-date arg 'totime nil nil default-time))) | 17156 | (org-read-date arg 'totime nil nil default-time default-input))) |
| 16332 | (org-insert-time-stamp time (or org-time-was-given arg))) | 17157 | (org-insert-time-stamp time (or org-time-was-given arg))) |
| 16333 | ((org-at-timestamp-p) | 17158 | ((org-at-timestamp-p) |
| 16334 | (setq time (let ((this-command this-command)) | 17159 | (setq time (let ((this-command this-command)) |
| 16335 | (org-read-date arg 'totime nil nil default-time))) | 17160 | (org-read-date arg 'totime nil nil default-time default-input))) |
| 16336 | (when (org-at-timestamp-p) ; just to get the match data | 17161 | (when (org-at-timestamp-p) ; just to get the match data |
| 16337 | (replace-match "") | 17162 | (replace-match "") |
| 16338 | (setq org-last-changed-timestamp | 17163 | (setq org-last-changed-timestamp |
| @@ -16342,10 +17167,28 @@ at the cursor, it will be modified." | |||
| 16342 | (message "Timestamp updated")) | 17167 | (message "Timestamp updated")) |
| 16343 | (t | 17168 | (t |
| 16344 | (setq time (let ((this-command this-command)) | 17169 | (setq time (let ((this-command this-command)) |
| 16345 | (org-read-date arg 'totime nil nil default-time))) | 17170 | (org-read-date arg 'totime nil nil default-time default-input))) |
| 16346 | (org-insert-time-stamp time (or org-time-was-given arg) | 17171 | (org-insert-time-stamp time (or org-time-was-given arg) |
| 16347 | nil nil nil (list org-end-time-was-given)))))) | 17172 | nil nil nil (list org-end-time-was-given)))))) |
| 16348 | 17173 | ||
| 17174 | ;; FIXME: can we use this for something else???? | ||
| 17175 | ;; like computing time differences????? | ||
| 17176 | (defun org-get-compact-tod (s) | ||
| 17177 | (when (string-match "\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\(-\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\)?" s) | ||
| 17178 | (let* ((t1 (match-string 1 s)) | ||
| 17179 | (h1 (string-to-number (match-string 2 s))) | ||
| 17180 | (m1 (string-to-number (match-string 3 s))) | ||
| 17181 | (t2 (and (match-end 4) (match-string 5 s))) | ||
| 17182 | (h2 (and t2 (string-to-number (match-string 6 s)))) | ||
| 17183 | (m2 (and t2 (string-to-number (match-string 7 s)))) | ||
| 17184 | dh dm) | ||
| 17185 | (if (not t2) | ||
| 17186 | t1 | ||
| 17187 | (setq dh (- h2 h1) dm (- m2 m1)) | ||
| 17188 | (if (< dm 0) (setq dm (+ dm 60) dh (1- dh))) | ||
| 17189 | (concat t1 "+" (number-to-string dh) | ||
| 17190 | (if (/= 0 dm) (concat ":" (number-to-string dm)))))))) | ||
| 17191 | |||
| 16349 | (defun org-time-stamp-inactive (&optional arg) | 17192 | (defun org-time-stamp-inactive (&optional arg) |
| 16350 | "Insert an inactive time stamp. | 17193 | "Insert an inactive time stamp. |
| 16351 | An inactive time stamp is enclosed in square brackets instead of angle | 17194 | An inactive time stamp is enclosed in square brackets instead of angle |
| @@ -16366,9 +17209,13 @@ So these are more for recording a certain time/date." | |||
| 16366 | (defvar org-ans2) ; dynamically scoped parameter | 17209 | (defvar org-ans2) ; dynamically scoped parameter |
| 16367 | 17210 | ||
| 16368 | (defvar org-plain-time-of-day-regexp) ; defined below | 17211 | (defvar org-plain-time-of-day-regexp) ; defined below |
| 17212 | |||
| 17213 | (defvar org-read-date-overlay nil) | ||
| 17214 | (defvar org-dcst nil) ; dynamically scoped | ||
| 17215 | |||
| 16369 | (defun org-read-date (&optional with-time to-time from-string prompt | 17216 | (defun org-read-date (&optional with-time to-time from-string prompt |
| 16370 | default-time) | 17217 | default-time default-input) |
| 16371 | "Read a date and make things smooth for the user. | 17218 | "Read a date, possibly a time, and make things smooth for the user. |
| 16372 | The prompt will suggest to enter an ISO date, but you can also enter anything | 17219 | The prompt will suggest to enter an ISO date, but you can also enter anything |
| 16373 | which will at least partially be understood by `parse-time-string'. | 17220 | which will at least partially be understood by `parse-time-string'. |
| 16374 | Unrecognized parts of the date will default to the current day, month, year, | 17221 | Unrecognized parts of the date will default to the current day, month, year, |
| @@ -16402,7 +17249,7 @@ While prompting, a calendar is popped up - you can also select the | |||
| 16402 | date with the mouse (button 1). The calendar shows a period of three | 17249 | date with the mouse (button 1). The calendar shows a period of three |
| 16403 | months. To scroll it to other months, use the keys `>' and `<'. | 17250 | months. To scroll it to other months, use the keys `>' and `<'. |
| 16404 | If you don't like the calendar, turn it off with | 17251 | If you don't like the calendar, turn it off with |
| 16405 | \(setq org-popup-calendar-for-date-prompt nil) | 17252 | \(setq org-read-date-popup-calendar nil) |
| 16406 | 17253 | ||
| 16407 | With optional argument TO-TIME, the date will immediately be converted | 17254 | With optional argument TO-TIME, the date will immediately be converted |
| 16408 | to an internal time. | 17255 | to an internal time. |
| @@ -16411,29 +17258,35 @@ insert a time. Note that when WITH-TIME is not set, you can still | |||
| 16411 | enter a time, and this function will inform the calling routine about | 17258 | enter a time, and this function will inform the calling routine about |
| 16412 | this change. The calling routine may then choose to change the format | 17259 | this change. The calling routine may then choose to change the format |
| 16413 | used to insert the time stamp into the buffer to include the time. | 17260 | used to insert the time stamp into the buffer to include the time. |
| 16414 | With optional argument FROM-STRING, read fomr this string instead from | 17261 | With optional argument FROM-STRING, read from this string instead from |
| 16415 | the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is | 17262 | the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is |
| 16416 | the time/date that is used for everything that is not specified by the | 17263 | the time/date that is used for everything that is not specified by the |
| 16417 | user." | 17264 | user." |
| 16418 | (require 'parse-time) | 17265 | (require 'parse-time) |
| 16419 | (let* ((org-time-stamp-rounding-minutes | 17266 | (let* ((org-time-stamp-rounding-minutes |
| 16420 | (if (equal with-time '(16)) 0 org-time-stamp-rounding-minutes)) | 17267 | (if (equal with-time '(16)) 0 org-time-stamp-rounding-minutes)) |
| 17268 | (org-dcst org-display-custom-times) | ||
| 16421 | (ct (org-current-time)) | 17269 | (ct (org-current-time)) |
| 16422 | (def (or default-time ct)) | 17270 | (def (or default-time ct)) |
| 16423 | ; (defdecode (decode-time def)) | 17271 | (defdecode (decode-time def)) |
| 17272 | (dummy (progn | ||
| 17273 | (when (< (nth 2 defdecode) org-extend-today-until) | ||
| 17274 | (setcar (nthcdr 2 defdecode) -1) | ||
| 17275 | (setcar (nthcdr 1 defdecode) 59) | ||
| 17276 | (setq def (apply 'encode-time defdecode) | ||
| 17277 | defdecode (decode-time def))))) | ||
| 16424 | (calendar-move-hook nil) | 17278 | (calendar-move-hook nil) |
| 16425 | (view-diary-entries-initially nil) | 17279 | (view-diary-entries-initially nil) |
| 16426 | (view-calendar-holidays-initially nil) | 17280 | (view-calendar-holidays-initially nil) |
| 16427 | (timestr (format-time-string | 17281 | (timestr (format-time-string |
| 16428 | (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def)) | 17282 | (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def)) |
| 16429 | (prompt (concat (if prompt (concat prompt " ") "") | 17283 | (prompt (concat (if prompt (concat prompt " ") "") |
| 16430 | (format "Date and/or time (default [%s]): " timestr))) | 17284 | (format "Date+time [%s]: " timestr))) |
| 16431 | ans (org-ans0 "") org-ans1 org-ans2 delta deltan deltaw deltadef | 17285 | ans (org-ans0 "") org-ans1 org-ans2 final) |
| 16432 | second minute hour day month year tl wday wday1 pm h2 m2) | ||
| 16433 | 17286 | ||
| 16434 | (cond | 17287 | (cond |
| 16435 | (from-string (setq ans from-string)) | 17288 | (from-string (setq ans from-string)) |
| 16436 | (org-popup-calendar-for-date-prompt | 17289 | (org-read-date-popup-calendar |
| 16437 | (save-excursion | 17290 | (save-excursion |
| 16438 | (save-window-excursion | 17291 | (save-window-excursion |
| 16439 | (calendar) | 17292 | (calendar) |
| @@ -16455,6 +17308,12 @@ user." | |||
| 16455 | (org-defkey minibuffer-local-map [(meta shift right)] | 17308 | (org-defkey minibuffer-local-map [(meta shift right)] |
| 16456 | (lambda () (interactive) | 17309 | (lambda () (interactive) |
| 16457 | (org-eval-in-calendar '(calendar-forward-month 1)))) | 17310 | (org-eval-in-calendar '(calendar-forward-month 1)))) |
| 17311 | (org-defkey minibuffer-local-map [(meta shift up)] | ||
| 17312 | (lambda () (interactive) | ||
| 17313 | (org-eval-in-calendar '(calendar-backward-year 1)))) | ||
| 17314 | (org-defkey minibuffer-local-map [(meta shift down)] | ||
| 17315 | (lambda () (interactive) | ||
| 17316 | (org-eval-in-calendar '(calendar-forward-year 1)))) | ||
| 16458 | (org-defkey minibuffer-local-map [(shift up)] | 17317 | (org-defkey minibuffer-local-map [(shift up)] |
| 16459 | (lambda () (interactive) | 17318 | (lambda () (interactive) |
| 16460 | (org-eval-in-calendar '(calendar-backward-week 1)))) | 17319 | (org-eval-in-calendar '(calendar-backward-week 1)))) |
| @@ -16476,15 +17335,75 @@ user." | |||
| 16476 | (unwind-protect | 17335 | (unwind-protect |
| 16477 | (progn | 17336 | (progn |
| 16478 | (use-local-map map) | 17337 | (use-local-map map) |
| 16479 | (setq org-ans0 (read-string prompt "" nil nil)) | 17338 | (add-hook 'post-command-hook 'org-read-date-display) |
| 17339 | (setq org-ans0 (read-string prompt default-input nil nil)) | ||
| 16480 | ;; org-ans0: from prompt | 17340 | ;; org-ans0: from prompt |
| 16481 | ;; org-ans1: from mouse click | 17341 | ;; org-ans1: from mouse click |
| 16482 | ;; org-ans2: from calendar motion | 17342 | ;; org-ans2: from calendar motion |
| 16483 | (setq ans (concat org-ans0 " " (or org-ans1 org-ans2)))) | 17343 | (setq ans (concat org-ans0 " " (or org-ans1 org-ans2)))) |
| 16484 | (use-local-map old-map)))))) | 17344 | (remove-hook 'post-command-hook 'org-read-date-display) |
| 17345 | (use-local-map old-map) | ||
| 17346 | (when org-read-date-overlay | ||
| 17347 | (org-delete-overlay org-read-date-overlay) | ||
| 17348 | (setq org-read-date-overlay nil))))))) | ||
| 17349 | |||
| 16485 | (t ; Naked prompt only | 17350 | (t ; Naked prompt only |
| 16486 | (setq ans (read-string prompt "" nil timestr)))) | 17351 | (unwind-protect |
| 16487 | (org-detach-overlay org-date-ovl) | 17352 | (setq ans (read-string prompt default-input nil timestr)) |
| 17353 | (when org-read-date-overlay | ||
| 17354 | (org-delete-overlay org-read-date-overlay) | ||
| 17355 | (setq org-read-date-overlay nil))))) | ||
| 17356 | |||
| 17357 | (setq final (org-read-date-analyze ans def defdecode)) | ||
| 17358 | |||
| 17359 | (if to-time | ||
| 17360 | (apply 'encode-time final) | ||
| 17361 | (if (and (boundp 'org-time-was-given) org-time-was-given) | ||
| 17362 | (format "%04d-%02d-%02d %02d:%02d" | ||
| 17363 | (nth 5 final) (nth 4 final) (nth 3 final) | ||
| 17364 | (nth 2 final) (nth 1 final)) | ||
| 17365 | (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final)))))) | ||
| 17366 | (defvar def) | ||
| 17367 | (defvar defdecode) | ||
| 17368 | (defvar with-time) | ||
| 17369 | (defun org-read-date-display () | ||
| 17370 | "Display the currrent date prompt interpretation in the minibuffer." | ||
| 17371 | (when org-read-date-display-live | ||
| 17372 | (when org-read-date-overlay | ||
| 17373 | (org-delete-overlay org-read-date-overlay)) | ||
| 17374 | (let ((p (point))) | ||
| 17375 | (end-of-line 1) | ||
| 17376 | (while (not (equal (buffer-substring | ||
| 17377 | (max (point-min) (- (point) 4)) (point)) | ||
| 17378 | " ")) | ||
| 17379 | (insert " ")) | ||
| 17380 | (goto-char p)) | ||
| 17381 | (let* ((ans (concat (buffer-substring (point-at-bol) (point-max)) | ||
| 17382 | " " (or org-ans1 org-ans2))) | ||
| 17383 | (org-end-time-was-given nil) | ||
| 17384 | (f (org-read-date-analyze ans def defdecode)) | ||
| 17385 | (fmts (if org-dcst | ||
| 17386 | org-time-stamp-custom-formats | ||
| 17387 | org-time-stamp-formats)) | ||
| 17388 | (fmt (if (or with-time | ||
| 17389 | (and (boundp 'org-time-was-given) org-time-was-given)) | ||
| 17390 | (cdr fmts) | ||
| 17391 | (car fmts))) | ||
| 17392 | (txt (concat "=> " (format-time-string fmt (apply 'encode-time f))))) | ||
| 17393 | (when (and org-end-time-was-given | ||
| 17394 | (string-match org-plain-time-of-day-regexp txt)) | ||
| 17395 | (setq txt (concat (substring txt 0 (match-end 0)) "-" | ||
| 17396 | org-end-time-was-given | ||
| 17397 | (substring txt (match-end 0))))) | ||
| 17398 | (setq org-read-date-overlay | ||
| 17399 | (make-overlay (1- (point-at-eol)) (point-at-eol))) | ||
| 17400 | (org-overlay-display org-read-date-overlay txt 'secondary-selection)))) | ||
| 17401 | |||
| 17402 | (defun org-read-date-analyze (ans def defdecode) | ||
| 17403 | "Analyze the combined answer of the date prompt." | ||
| 17404 | ;; FIXME: cleanup and comment | ||
| 17405 | (let (delta deltan deltaw deltadef year month day | ||
| 17406 | hour minute second wday pm h2 m2 tl wday1) | ||
| 16488 | 17407 | ||
| 16489 | (when (setq delta (org-read-date-get-relative ans (current-time) def)) | 17408 | (when (setq delta (org-read-date-get-relative ans (current-time) def)) |
| 16490 | (setq ans (replace-match "" t t ans) | 17409 | (setq ans (replace-match "" t t ans) |
| @@ -16527,22 +17446,32 @@ user." | |||
| 16527 | h2 (+ hour (string-to-number (match-string 3 ans))) | 17446 | h2 (+ hour (string-to-number (match-string 3 ans))) |
| 16528 | minute (string-to-number (match-string 2 ans)) | 17447 | minute (string-to-number (match-string 2 ans)) |
| 16529 | m2 (+ minute (if (match-end 5) (string-to-number (match-string 5 ans))0))) | 17448 | m2 (+ minute (if (match-end 5) (string-to-number (match-string 5 ans))0))) |
| 17449 | (if (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60))) | ||
| 16530 | (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2) t t ans))) | 17450 | (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2) t t ans))) |
| 16531 | 17451 | ||
| 16532 | ;; Check if there is a time range | 17452 | ;; Check if there is a time range |
| 16533 | (when (and (boundp 'org-end-time-was-given) | 17453 | (when (boundp 'org-end-time-was-given) |
| 16534 | (string-match org-plain-time-of-day-regexp ans) | 17454 | (setq org-time-was-given nil) |
| 16535 | (match-end 8)) | 17455 | (when (and (string-match org-plain-time-of-day-regexp ans) |
| 16536 | (setq org-end-time-was-given (match-string 8 ans)) | 17456 | (match-end 8)) |
| 16537 | (setq ans (concat (substring ans 0 (match-beginning 7)) | 17457 | (setq org-end-time-was-given (match-string 8 ans)) |
| 16538 | (substring ans (match-end 7))))) | 17458 | (setq ans (concat (substring ans 0 (match-beginning 7)) |
| 17459 | (substring ans (match-end 7)))))) | ||
| 16539 | 17460 | ||
| 16540 | (setq tl (parse-time-string ans) | 17461 | (setq tl (parse-time-string ans) |
| 16541 | day (or (nth 3 tl) (string-to-number (format-time-string "%d" def))) | 17462 | day (or (nth 3 tl) (nth 3 defdecode)) |
| 16542 | month (or (nth 4 tl) (string-to-number (format-time-string "%m" def))) | 17463 | month (or (nth 4 tl) |
| 16543 | year (or (nth 5 tl) (string-to-number (format-time-string "%Y" def))) | 17464 | (if (and org-read-date-prefer-future |
| 16544 | hour (or (nth 2 tl) (string-to-number (format-time-string "%H" def))) | 17465 | (nth 3 tl) (< (nth 3 tl) (nth 3 defdecode))) |
| 16545 | minute (or (nth 1 tl) (string-to-number (format-time-string "%M" def))) | 17466 | (1+ (nth 4 defdecode)) |
| 17467 | (nth 4 defdecode))) | ||
| 17468 | year (or (nth 5 tl) | ||
| 17469 | (if (and org-read-date-prefer-future | ||
| 17470 | (nth 4 tl) (< (nth 4 tl) (nth 4 defdecode))) | ||
| 17471 | (1+ (nth 5 defdecode)) | ||
| 17472 | (nth 5 defdecode))) | ||
| 17473 | hour (or (nth 2 tl) (nth 2 defdecode)) | ||
| 17474 | minute (or (nth 1 tl) (nth 1 defdecode)) | ||
| 16546 | second (or (nth 0 tl) 0) | 17475 | second (or (nth 0 tl) 0) |
| 16547 | wday (nth 6 tl)) | 17476 | wday (nth 6 tl)) |
| 16548 | (when deltan | 17477 | (when deltan |
| @@ -16563,25 +17492,8 @@ user." | |||
| 16563 | (nth 2 tl)) | 17492 | (nth 2 tl)) |
| 16564 | (setq org-time-was-given t)) | 17493 | (setq org-time-was-given t)) |
| 16565 | (if (< year 100) (setq year (+ 2000 year))) | 17494 | (if (< year 100) (setq year (+ 2000 year))) |
| 16566 | (if to-time | 17495 | (if (< year 1970) (setq year (nth 5 defdecode))) ; not representable |
| 16567 | (encode-time second minute hour day month year) | 17496 | (list second minute hour day month year))) |
| 16568 | (if (or (nth 1 tl) (nth 2 tl)) | ||
| 16569 | (format "%04d-%02d-%02d %02d:%02d" year month day hour minute) | ||
| 16570 | (format "%04d-%02d-%02d" year month day))))) | ||
| 16571 | |||
| 16572 | ;(defun org-parse-for-shift (n1 n2 given-dec default-dec) | ||
| 16573 | ; (cond | ||
| 16574 | ; ((not (nth n1 given-dec)) | ||
| 16575 | ; (nth n1 default-dec)) | ||
| 16576 | ; ((or (> (nth n1 given-dec) (nth n1 (default-dec))) | ||
| 16577 | ; (not org-read-date-prefer-future)) | ||
| 16578 | ; (nth n1 given-dec)) | ||
| 16579 | ; (t (1+ | ||
| 16580 | ; (if (nth 3 given-dec) | ||
| 16581 | ; (nth 3 given-dec) | ||
| 16582 | ; (if (> (nth | ||
| 16583 | ; (setq given | ||
| 16584 | ; (if (and | ||
| 16585 | 17497 | ||
| 16586 | (defvar parse-time-weekdays) | 17498 | (defvar parse-time-weekdays) |
| 16587 | 17499 | ||
| @@ -16589,8 +17501,8 @@ user." | |||
| 16589 | "Check string S for special relative date string. | 17501 | "Check string S for special relative date string. |
| 16590 | TODAY and DEFAULT are internal times, for today and for a default. | 17502 | TODAY and DEFAULT are internal times, for today and for a default. |
| 16591 | Return shift list (N what def-flag) | 17503 | Return shift list (N what def-flag) |
| 16592 | WHAT is \"d\", \"w\", \"m\", or \"y\" for day. week, month, year. | 17504 | WHAT is \"d\", \"w\", \"m\", or \"y\" for day, week, month, year. |
| 16593 | N is the number if WHATs to shift | 17505 | N is the number of WHATs to shift. |
| 16594 | DEF-FLAG is t when a double ++ or -- indicates shift relative to | 17506 | DEF-FLAG is t when a double ++ or -- indicates shift relative to |
| 16595 | the DEFAULT date rather than TODAY." | 17507 | the DEFAULT date rather than TODAY." |
| 16596 | (when (string-match | 17508 | (when (string-match |
| @@ -16628,17 +17540,18 @@ Also, store the cursor date in variable org-ans2." | |||
| 16628 | (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | 17540 | (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) |
| 16629 | (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) | 17541 | (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) |
| 16630 | (org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) | 17542 | (org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) |
| 16631 | (select-window sw) | 17543 | (select-window sw))) |
| 16632 | ;; Update the prompt to show new default date | 17544 | |
| 16633 | (save-excursion | 17545 | ; ;; Update the prompt to show new default date |
| 16634 | (goto-char (point-min)) | 17546 | ; (save-excursion |
| 16635 | (when (and org-ans2 | 17547 | ; (goto-char (point-min)) |
| 16636 | (re-search-forward "\\[[-0-9]+\\]" nil t) | 17548 | ; (when (and org-ans2 |
| 16637 | (get-text-property (match-end 0) 'field)) | 17549 | ; (re-search-forward "\\[[-0-9]+\\]" nil t) |
| 16638 | (let ((inhibit-read-only t)) | 17550 | ; (get-text-property (match-end 0) 'field)) |
| 16639 | (replace-match (concat "[" org-ans2 "]") t t) | 17551 | ; (let ((inhibit-read-only t)) |
| 16640 | (add-text-properties (point-min) (1+ (match-end 0)) | 17552 | ; (replace-match (concat "[" org-ans2 "]") t t) |
| 16641 | (text-properties-at (1+ (point-min))))))))) | 17553 | ; (add-text-properties (point-min) (1+ (match-end 0)) |
| 17554 | ; (text-properties-at (1+ (point-min))))))))) | ||
| 16642 | 17555 | ||
| 16643 | (defun org-calendar-select () | 17556 | (defun org-calendar-select () |
| 16644 | "Return to `org-read-date' with the date currently selected. | 17557 | "Return to `org-read-date' with the date currently selected. |
| @@ -16817,6 +17730,20 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s | |||
| 16817 | (org-occur regexp nil callback) | 17730 | (org-occur regexp nil callback) |
| 16818 | org-warn-days))) | 17731 | org-warn-days))) |
| 16819 | 17732 | ||
| 17733 | (defun org-check-before-date (date) | ||
| 17734 | "Check if there are deadlines or scheduled entries before DATE." | ||
| 17735 | (interactive (list (org-read-date))) | ||
| 17736 | (let ((case-fold-search nil) | ||
| 17737 | (regexp (concat "\\<\\(" org-deadline-string | ||
| 17738 | "\\|" org-scheduled-string | ||
| 17739 | "\\) *<\\([^>]+\\)>")) | ||
| 17740 | (callback | ||
| 17741 | (lambda () (time-less-p | ||
| 17742 | (org-time-string-to-time (match-string 2)) | ||
| 17743 | (org-time-string-to-time date))))) | ||
| 17744 | (message "%d entries before %s" | ||
| 17745 | (org-occur regexp nil callback) date))) | ||
| 17746 | |||
| 16820 | (defun org-evaluate-time-range (&optional to-buffer) | 17747 | (defun org-evaluate-time-range (&optional to-buffer) |
| 16821 | "Evaluate a time range by computing the difference between start and end. | 17748 | "Evaluate a time range by computing the difference between start and end. |
| 16822 | Normally the result is just printed in the echo area, but with prefix arg | 17749 | Normally the result is just printed in the echo area, but with prefix arg |
| @@ -16865,10 +17792,12 @@ days in order to avoid rounding problems." | |||
| 16865 | h 0 m 0)) | 17792 | h 0 m 0)) |
| 16866 | (if (not to-buffer) | 17793 | (if (not to-buffer) |
| 16867 | (message "%s" (org-make-tdiff-string y d h m)) | 17794 | (message "%s" (org-make-tdiff-string y d h m)) |
| 16868 | (when (org-at-table-p) | 17795 | (if (org-at-table-p) |
| 16869 | (goto-char match-end) | 17796 | (progn |
| 16870 | (setq align t) | 17797 | (goto-char match-end) |
| 16871 | (and (looking-at " *|") (goto-char (match-end 0)))) | 17798 | (setq align t) |
| 17799 | (and (looking-at " *|") (goto-char (match-end 0)))) | ||
| 17800 | (goto-char match-end)) | ||
| 16872 | (if (looking-at | 17801 | (if (looking-at |
| 16873 | "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") | 17802 | "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") |
| 16874 | (replace-match "")) | 17803 | (replace-match "")) |
| @@ -16917,7 +17846,10 @@ D may be an absolute day number, or a calendar-type list (month day year)." | |||
| 16917 | 17846 | ||
| 16918 | (defun org-calendar-holiday () | 17847 | (defun org-calendar-holiday () |
| 16919 | "List of holidays, for Diary display in Org-mode." | 17848 | "List of holidays, for Diary display in Org-mode." |
| 16920 | (let ((hl (calendar-check-holidays date))) | 17849 | (require 'holidays) |
| 17850 | (let ((hl (funcall | ||
| 17851 | (if (fboundp 'calendar-check-holidays) | ||
| 17852 | 'calendar-check-holidays 'check-calendar-holidays) date))) | ||
| 16921 | (if hl (mapconcat 'identity hl "; ")))) | 17853 | (if hl (mapconcat 'identity hl "; ")))) |
| 16922 | 17854 | ||
| 16923 | (defun org-diary-sexp-entry (sexp entry date) | 17855 | (defun org-diary-sexp-entry (sexp entry date) |
| @@ -16941,7 +17873,7 @@ D may be an absolute day number, or a calendar-type list (month day year)." | |||
| 16941 | (t nil)))) | 17873 | (t nil)))) |
| 16942 | 17874 | ||
| 16943 | (defun org-diary-to-ical-string (frombuf) | 17875 | (defun org-diary-to-ical-string (frombuf) |
| 16944 | "Get iCalendar entreis from diary entries in buffer FROMBUF. | 17876 | "Get iCalendar entries from diary entries in buffer FROMBUF. |
| 16945 | This uses the icalendar.el library." | 17877 | This uses the icalendar.el library." |
| 16946 | (let* ((tmpdir (if (featurep 'xemacs) | 17878 | (let* ((tmpdir (if (featurep 'xemacs) |
| 16947 | (temp-directory) | 17879 | (temp-directory) |
| @@ -17292,6 +18224,7 @@ belonging to the category \"Work\"." | |||
| 17292 | (if (equal filter '(4)) | 18224 | (if (equal filter '(4)) |
| 17293 | (setq filter (read-from-minibuffer "Regexp filter: "))) | 18225 | (setq filter (read-from-minibuffer "Regexp filter: "))) |
| 17294 | (let* ((cnt 0) ; count added events | 18226 | (let* ((cnt 0) ; count added events |
| 18227 | (org-agenda-new-buffers nil) | ||
| 17295 | (today (org-date-to-gregorian | 18228 | (today (org-date-to-gregorian |
| 17296 | (time-to-days (current-time)))) | 18229 | (time-to-days (current-time)))) |
| 17297 | (files (org-agenda-files)) entries file) | 18230 | (files (org-agenda-files)) entries file) |
| @@ -17316,7 +18249,7 @@ belonging to the category \"Work\"." | |||
| 17316 | (cadr (assoc 'category filter)) cat) | 18249 | (cadr (assoc 'category filter)) cat) |
| 17317 | (string-match | 18250 | (string-match |
| 17318 | (cadr (assoc 'headline filter)) evt)))))) | 18251 | (cadr (assoc 'headline filter)) evt)))))) |
| 17319 | ;; FIXME Shall we remove text-properties for the appt text? | 18252 | ;; FIXME: Shall we remove text-properties for the appt text? |
| 17320 | ;; (setq evt (set-text-properties 0 (length evt) nil evt)) | 18253 | ;; (setq evt (set-text-properties 0 (length evt) nil evt)) |
| 17321 | (when (and ok tod) | 18254 | (when (and ok tod) |
| 17322 | (setq tod (number-to-string tod) | 18255 | (setq tod (number-to-string tod) |
| @@ -17326,6 +18259,7 @@ belonging to the category \"Work\"." | |||
| 17326 | (match-string 2 tod)))) | 18259 | (match-string 2 tod)))) |
| 17327 | (appt-add tod evt) | 18260 | (appt-add tod evt) |
| 17328 | (setq cnt (1+ cnt))))) entries) | 18261 | (setq cnt (1+ cnt))))) entries) |
| 18262 | (org-release-buffers org-agenda-new-buffers) | ||
| 17329 | (message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))) | 18263 | (message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))) |
| 17330 | 18264 | ||
| 17331 | ;;; The clock for measuring work time. | 18265 | ;;; The clock for measuring work time. |
| @@ -17360,9 +18294,17 @@ If necessary, clock-out of the currently active clock." | |||
| 17360 | (let (ts) | 18294 | (let (ts) |
| 17361 | (save-excursion | 18295 | (save-excursion |
| 17362 | (org-back-to-heading t) | 18296 | (org-back-to-heading t) |
| 17363 | (if (looking-at org-todo-line-regexp) | 18297 | (when (and org-clock-in-switch-to-state |
| 17364 | (setq org-clock-heading (match-string 3)) | 18298 | (not (looking-at (concat outline-regexp "[ \t]*" |
| 17365 | (setq org-clock-heading "???")) | 18299 | org-clock-in-switch-to-state |
| 18300 | "\\>")))) | ||
| 18301 | (org-todo org-clock-in-switch-to-state)) | ||
| 18302 | (if (and org-clock-heading-function | ||
| 18303 | (functionp org-clock-heading-function)) | ||
| 18304 | (setq org-clock-heading (funcall org-clock-heading-function)) | ||
| 18305 | (if (looking-at org-complex-heading-regexp) | ||
| 18306 | (setq org-clock-heading (match-string 4)) | ||
| 18307 | (setq org-clock-heading "???"))) | ||
| 17366 | (setq org-clock-heading (propertize org-clock-heading 'face nil)) | 18308 | (setq org-clock-heading (propertize org-clock-heading 'face nil)) |
| 17367 | (org-clock-find-position) | 18309 | (org-clock-find-position) |
| 17368 | 18310 | ||
| @@ -17480,6 +18422,9 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." | |||
| 17480 | (set-buffer (marker-buffer org-clock-marker)) | 18422 | (set-buffer (marker-buffer org-clock-marker)) |
| 17481 | (goto-char org-clock-marker) | 18423 | (goto-char org-clock-marker) |
| 17482 | (delete-region (1- (point-at-bol)) (point-at-eol))) | 18424 | (delete-region (1- (point-at-bol)) (point-at-eol))) |
| 18425 | (setq global-mode-string | ||
| 18426 | (delq 'org-mode-line-string global-mode-string)) | ||
| 18427 | (force-mode-line-update) | ||
| 17483 | (message "Clock canceled")) | 18428 | (message "Clock canceled")) |
| 17484 | 18429 | ||
| 17485 | (defun org-clock-goto (&optional delete-windows) | 18430 | (defun org-clock-goto (&optional delete-windows) |
| @@ -18016,8 +18961,10 @@ The following commands are available: | |||
| 18016 | (org-defkey org-agenda-mode-map "f" 'org-agenda-follow-mode) | 18961 | (org-defkey org-agenda-mode-map "f" 'org-agenda-follow-mode) |
| 18017 | (org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode) | 18962 | (org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode) |
| 18018 | (org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary) | 18963 | (org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary) |
| 18019 | (org-defkey org-agenda-mode-map "g" 'org-agenda-toggle-time-grid) | 18964 | (org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid) |
| 18020 | (org-defkey org-agenda-mode-map "r" 'org-agenda-redo) | 18965 | (org-defkey org-agenda-mode-map "r" 'org-agenda-redo) |
| 18966 | (org-defkey org-agenda-mode-map "g" 'org-agenda-redo) | ||
| 18967 | (org-defkey org-agenda-mode-map "e" 'org-agenda-execute) | ||
| 18021 | (org-defkey org-agenda-mode-map "q" 'org-agenda-quit) | 18968 | (org-defkey org-agenda-mode-map "q" 'org-agenda-quit) |
| 18022 | (org-defkey org-agenda-mode-map "x" 'org-agenda-exit) | 18969 | (org-defkey org-agenda-mode-map "x" 'org-agenda-exit) |
| 18023 | (org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda) | 18970 | (org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda) |
| @@ -18234,6 +19181,7 @@ that have been changed along." | |||
| 18234 | (defvar org-agenda-restrict-begin (make-marker)) | 19181 | (defvar org-agenda-restrict-begin (make-marker)) |
| 18235 | (defvar org-agenda-restrict-end (make-marker)) | 19182 | (defvar org-agenda-restrict-end (make-marker)) |
| 18236 | (defvar org-agenda-last-dispatch-buffer nil) | 19183 | (defvar org-agenda-last-dispatch-buffer nil) |
| 19184 | (defvar org-agenda-overriding-restriction nil) | ||
| 18237 | 19185 | ||
| 18238 | ;;;###autoload | 19186 | ;;;###autoload |
| 18239 | (defun org-agenda (arg &optional keys restriction) | 19187 | (defun org-agenda (arg &optional keys restriction) |
| @@ -18263,6 +19211,7 @@ Pressing `<' twice means to restrict to the current subtree or region | |||
| 18263 | (interactive "P") | 19211 | (interactive "P") |
| 18264 | (catch 'exit | 19212 | (catch 'exit |
| 18265 | (let* ((prefix-descriptions nil) | 19213 | (let* ((prefix-descriptions nil) |
| 19214 | (org-agenda-custom-commands-orig org-agenda-custom-commands) | ||
| 18266 | (org-agenda-custom-commands | 19215 | (org-agenda-custom-commands |
| 18267 | ;; normalize different versions | 19216 | ;; normalize different versions |
| 18268 | (delq nil | 19217 | (delq nil |
| @@ -18278,11 +19227,12 @@ Pressing `<' twice means to restrict to the current subtree or region | |||
| 18278 | (buf (current-buffer)) | 19227 | (buf (current-buffer)) |
| 18279 | (bfn (buffer-file-name (buffer-base-buffer))) | 19228 | (bfn (buffer-file-name (buffer-base-buffer))) |
| 18280 | entry key type match lprops ans) | 19229 | entry key type match lprops ans) |
| 18281 | ;; Turn off restriction | 19230 | ;; Turn off restriction unless there is an overriding one |
| 18282 | (put 'org-agenda-files 'org-restrict nil) | 19231 | (unless org-agenda-overriding-restriction |
| 18283 | (setq org-agenda-restrict nil) | 19232 | (put 'org-agenda-files 'org-restrict nil) |
| 18284 | (move-marker org-agenda-restrict-begin nil) | 19233 | (setq org-agenda-restrict nil) |
| 18285 | (move-marker org-agenda-restrict-end nil) | 19234 | (move-marker org-agenda-restrict-begin nil) |
| 19235 | (move-marker org-agenda-restrict-end nil)) | ||
| 18286 | ;; Delete old local properties | 19236 | ;; Delete old local properties |
| 18287 | (put 'org-agenda-redo-command 'org-lprops nil) | 19237 | (put 'org-agenda-redo-command 'org-lprops nil) |
| 18288 | ;; Remember where this call originated | 19238 | ;; Remember where this call originated |
| @@ -18292,7 +19242,7 @@ Pressing `<' twice means to restrict to the current subtree or region | |||
| 18292 | keys (car ans) | 19242 | keys (car ans) |
| 18293 | restriction (cdr ans))) | 19243 | restriction (cdr ans))) |
| 18294 | ;; Estabish the restriction, if any | 19244 | ;; Estabish the restriction, if any |
| 18295 | (when restriction | 19245 | (when (and (not org-agenda-overriding-restriction) restriction) |
| 18296 | (put 'org-agenda-files 'org-restrict (list bfn)) | 19246 | (put 'org-agenda-files 'org-restrict (list bfn)) |
| 18297 | (cond | 19247 | (cond |
| 18298 | ((eq restriction 'region) | 19248 | ((eq restriction 'region) |
| @@ -18346,7 +19296,9 @@ Pressing `<' twice means to restrict to the current subtree or region | |||
| 18346 | (org-let lprops '(funcall type match))) | 19296 | (org-let lprops '(funcall type match))) |
| 18347 | (t (error "Invalid custom agenda command type %s" type)))) | 19297 | (t (error "Invalid custom agenda command type %s" type)))) |
| 18348 | (org-run-agenda-series (nth 1 entry) (cddr entry)))) | 19298 | (org-run-agenda-series (nth 1 entry) (cddr entry)))) |
| 18349 | ((equal keys "C") (customize-variable 'org-agenda-custom-commands)) | 19299 | ((equal keys "C") |
| 19300 | (setq org-agenda-custom-commands org-agenda-custom-commands-orig) | ||
| 19301 | (customize-variable 'org-agenda-custom-commands)) | ||
| 18350 | ((equal keys "a") (call-interactively 'org-agenda-list)) | 19302 | ((equal keys "a") (call-interactively 'org-agenda-list)) |
| 18351 | ((equal keys "t") (call-interactively 'org-todo-list)) | 19303 | ((equal keys "t") (call-interactively 'org-todo-list)) |
| 18352 | ((equal keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) | 19304 | ((equal keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) |
| @@ -18364,6 +19316,16 @@ Pressing `<' twice means to restrict to the current subtree or region | |||
| 18364 | ((equal keys "!") (customize-variable 'org-stuck-projects)) | 19316 | ((equal keys "!") (customize-variable 'org-stuck-projects)) |
| 18365 | (t (error "Invalid agenda key")))))) | 19317 | (t (error "Invalid agenda key")))))) |
| 18366 | 19318 | ||
| 19319 | (defun org-agenda-normalize-custom-commands (cmds) | ||
| 19320 | (delq nil | ||
| 19321 | (mapcar | ||
| 19322 | (lambda (x) | ||
| 19323 | (cond ((stringp (cdr x)) nil) | ||
| 19324 | ((stringp (nth 1 x)) x) | ||
| 19325 | ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) | ||
| 19326 | (t (cons (car x) (cons "" (cdr x)))))) | ||
| 19327 | cmds))) | ||
| 19328 | |||
| 18367 | (defun org-agenda-get-restriction-and-command (prefix-descriptions) | 19329 | (defun org-agenda-get-restriction-and-command (prefix-descriptions) |
| 18368 | "The user interface for selecting an agenda command." | 19330 | "The user interface for selecting an agenda command." |
| 18369 | (catch 'exit | 19331 | (catch 'exit |
| @@ -18380,13 +19342,14 @@ Pressing `<' twice means to restrict to the current subtree or region | |||
| 18380 | (erase-buffer) | 19342 | (erase-buffer) |
| 18381 | (insert (eval-when-compile | 19343 | (insert (eval-when-compile |
| 18382 | (let ((header | 19344 | (let ((header |
| 18383 | "Press key for an agenda command: < Buffer,subtree/region restriction | 19345 | " |
| 18384 | -------------------------------- C Configure custom agenda commands | 19346 | Press key for an agenda command: < Buffer,subtree/region restriction |
| 19347 | -------------------------------- > Remove restriction | ||
| 18385 | a Agenda for current week or day e Export agenda views | 19348 | a Agenda for current week or day e Export agenda views |
| 18386 | t List of all TODO entries T Entries with special TODO kwd | 19349 | t List of all TODO entries T Entries with special TODO kwd |
| 18387 | m Match a TAGS query M Like m, but only TODO entries | 19350 | m Match a TAGS query M Like m, but only TODO entries |
| 18388 | L Timeline for current buffer # List stuck projects (!=configure) | 19351 | L Timeline for current buffer # List stuck projects (!=configure) |
| 18389 | / Multi-occur | 19352 | / Multi-occur C Configure custom agenda commands |
| 18390 | ") | 19353 | ") |
| 18391 | (start 0)) | 19354 | (start 0)) |
| 18392 | (while (string-match | 19355 | (while (string-match |
| @@ -18402,10 +19365,10 @@ L Timeline for current buffer # List stuck projects (!=configure) | |||
| 18402 | (when (eq rmheader t) | 19365 | (when (eq rmheader t) |
| 18403 | (goto-line 1) | 19366 | (goto-line 1) |
| 18404 | (re-search-forward ":" nil t) | 19367 | (re-search-forward ":" nil t) |
| 18405 | (delete-region (match-end 0) (line-end-position)) | 19368 | (delete-region (match-end 0) (point-at-eol)) |
| 18406 | (forward-char 1) | 19369 | (forward-char 1) |
| 18407 | (looking-at "-+") | 19370 | (looking-at "-+") |
| 18408 | (delete-region (match-end 0) (line-end-position)) | 19371 | (delete-region (match-end 0) (point-at-eol)) |
| 18409 | (move-marker header-end (match-end 0))) | 19372 | (move-marker header-end (match-end 0))) |
| 18410 | (goto-char header-end) | 19373 | (goto-char header-end) |
| 18411 | (delete-region (point) (point-max)) | 19374 | (delete-region (point) (point-max)) |
| @@ -18458,10 +19421,12 @@ L Timeline for current buffer # List stuck projects (!=configure) | |||
| 18458 | (setq second-time t) | 19421 | (setq second-time t) |
| 18459 | (fit-window-to-buffer))) | 19422 | (fit-window-to-buffer))) |
| 18460 | (message "Press key for agenda command%s:" | 19423 | (message "Press key for agenda command%s:" |
| 18461 | (if restrict-ok | 19424 | (if (or restrict-ok org-agenda-overriding-restriction) |
| 18462 | (if restriction | 19425 | (if org-agenda-overriding-restriction |
| 18463 | (format " (restricted to %s)" restriction) | 19426 | " (restriction lock active)" |
| 18464 | " (unrestricted)") | 19427 | (if restriction |
| 19428 | (format " (restricted to %s)" restriction) | ||
| 19429 | " (unrestricted)")) | ||
| 18465 | "")) | 19430 | "")) |
| 18466 | (setq c (read-char-exclusive)) | 19431 | (setq c (read-char-exclusive)) |
| 18467 | (message "") | 19432 | (message "") |
| @@ -18484,10 +19449,13 @@ L Timeline for current buffer # List stuck projects (!=configure) | |||
| 18484 | (message "Restriction is only possible in Org-mode buffers") | 19449 | (message "Restriction is only possible in Org-mode buffers") |
| 18485 | (ding) (sit-for 1)) | 19450 | (ding) (sit-for 1)) |
| 18486 | ((eq c ?1) | 19451 | ((eq c ?1) |
| 19452 | (org-agenda-remove-restriction-lock 'noupdate) | ||
| 18487 | (setq restriction 'buffer)) | 19453 | (setq restriction 'buffer)) |
| 18488 | ((eq c ?0) | 19454 | ((eq c ?0) |
| 19455 | (org-agenda-remove-restriction-lock 'noupdate) | ||
| 18489 | (setq restriction (if region-p 'region 'subtree))) | 19456 | (setq restriction (if region-p 'region 'subtree))) |
| 18490 | ((eq c ?<) | 19457 | ((eq c ?<) |
| 19458 | (org-agenda-remove-restriction-lock 'noupdate) | ||
| 18491 | (setq restriction | 19459 | (setq restriction |
| 18492 | (cond | 19460 | (cond |
| 18493 | ((eq restriction 'buffer) | 19461 | ((eq restriction 'buffer) |
| @@ -18495,8 +19463,15 @@ L Timeline for current buffer # List stuck projects (!=configure) | |||
| 18495 | ((memq restriction '(subtree region)) | 19463 | ((memq restriction '(subtree region)) |
| 18496 | nil) | 19464 | nil) |
| 18497 | (t 'buffer)))) | 19465 | (t 'buffer)))) |
| 18498 | ((and (equal selstring "") (memq c '(?a ?t ?m ?L ?C ?e ?T ?M ?# ?/))) | 19466 | ((eq c ?>) |
| 19467 | (org-agenda-remove-restriction-lock 'noupdate) | ||
| 19468 | (setq restriction nil)) | ||
| 19469 | ((and (equal selstring "") (memq c '(?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/))) | ||
| 18499 | (throw 'exit (cons (setq selstring (char-to-string c)) restriction))) | 19470 | (throw 'exit (cons (setq selstring (char-to-string c)) restriction))) |
| 19471 | ((and (> (length selstring) 0) (eq c ?\d)) | ||
| 19472 | (delete-window) | ||
| 19473 | (org-agenda-get-restriction-and-command prefix-descriptions)) | ||
| 19474 | |||
| 18500 | ((equal c ?q) (error "Abort")) | 19475 | ((equal c ?q) (error "Abort")) |
| 18501 | (t (error "Invalid key %c" c)))))))) | 19476 | (t (error "Invalid key %c" c)))))))) |
| 18502 | 19477 | ||
| @@ -18543,7 +19518,7 @@ L Timeline for current buffer # List stuck projects (!=configure) | |||
| 18543 | "Run an agenda command in batch mode and send the result to STDOUT. | 19518 | "Run an agenda command in batch mode and send the result to STDOUT. |
| 18544 | If CMD-KEY is a string of length 1, it is used as a key in | 19519 | If CMD-KEY is a string of length 1, it is used as a key in |
| 18545 | `org-agenda-custom-commands' and triggers this command. If it is a | 19520 | `org-agenda-custom-commands' and triggers this command. If it is a |
| 18546 | longer string is is used as a tags/todo match string. | 19521 | longer string it is used as a tags/todo match string. |
| 18547 | Paramters are alternating variable names and values that will be bound | 19522 | Paramters are alternating variable names and values that will be bound |
| 18548 | before running the agenda command." | 19523 | before running the agenda command." |
| 18549 | (let (pars) | 19524 | (let (pars) |
| @@ -18568,7 +19543,7 @@ before running the agenda command." | |||
| 18568 | "Run an agenda command in batch mode and send the result to STDOUT. | 19543 | "Run an agenda command in batch mode and send the result to STDOUT. |
| 18569 | If CMD-KEY is a string of length 1, it is used as a key in | 19544 | If CMD-KEY is a string of length 1, it is used as a key in |
| 18570 | `org-agenda-custom-commands' and triggers this command. If it is a | 19545 | `org-agenda-custom-commands' and triggers this command. If it is a |
| 18571 | longer string is is used as a tags/todo match string. | 19546 | longer string it is used as a tags/todo match string. |
| 18572 | Paramters are alternating variable names and values that will be bound | 19547 | Paramters are alternating variable names and values that will be bound |
| 18573 | before running the agenda command. | 19548 | before running the agenda command. |
| 18574 | 19549 | ||
| @@ -18625,7 +19600,7 @@ agenda-day The day in the agenda where this is listed" | |||
| 18625 | 19600 | ||
| 18626 | (defun org-fix-agenda-info (props) | 19601 | (defun org-fix-agenda-info (props) |
| 18627 | "Make sure all properties on an agenda item have a canonical form, | 19602 | "Make sure all properties on an agenda item have a canonical form, |
| 18628 | so the the export commands caneasily use it." | 19603 | so the export commands can easily use it." |
| 18629 | (let (tmp re) | 19604 | (let (tmp re) |
| 18630 | (when (setq tmp (plist-get props 'tags)) | 19605 | (when (setq tmp (plist-get props 'tags)) |
| 18631 | (setq props (plist-put props 'tags (mapconcat 'identity tmp ":")))) | 19606 | (setq props (plist-put props 'tags (mapconcat 'identity tmp ":")))) |
| @@ -18675,7 +19650,7 @@ so the the export commands caneasily use it." | |||
| 18675 | ;;;###autoload | 19650 | ;;;###autoload |
| 18676 | (defmacro org-batch-store-agenda-views (&rest parameters) | 19651 | (defmacro org-batch-store-agenda-views (&rest parameters) |
| 18677 | "Run all custom agenda commands that have a file argument." | 19652 | "Run all custom agenda commands that have a file argument." |
| 18678 | (let ((cmds org-agenda-custom-commands) | 19653 | (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands)) |
| 18679 | (pop-up-frames nil) | 19654 | (pop-up-frames nil) |
| 18680 | (dir default-directory) | 19655 | (dir default-directory) |
| 18681 | pars cmd thiscmdkey files opts) | 19656 | pars cmd thiscmdkey files opts) |
| @@ -18686,8 +19661,8 @@ so the the export commands caneasily use it." | |||
| 18686 | (while cmds | 19661 | (while cmds |
| 18687 | (setq cmd (pop cmds) | 19662 | (setq cmd (pop cmds) |
| 18688 | thiscmdkey (car cmd) | 19663 | thiscmdkey (car cmd) |
| 18689 | opts (nth 3 cmd) | 19664 | opts (nth 4 cmd) |
| 18690 | files (nth 4 cmd)) | 19665 | files (nth 5 cmd)) |
| 18691 | (if (stringp files) (setq files (list files))) | 19666 | (if (stringp files) (setq files (list files))) |
| 18692 | (when files | 19667 | (when files |
| 18693 | (eval (list 'let (append org-agenda-exporter-settings opts pars) | 19668 | (eval (list 'let (append org-agenda-exporter-settings opts pars) |
| @@ -18777,7 +19752,8 @@ is currently in place." | |||
| 18777 | (setq files (apply 'append | 19752 | (setq files (apply 'append |
| 18778 | (mapcar (lambda (f) | 19753 | (mapcar (lambda (f) |
| 18779 | (if (file-directory-p f) | 19754 | (if (file-directory-p f) |
| 18780 | (directory-files f t "\\.org\\'") | 19755 | (directory-files f t |
| 19756 | org-agenda-file-regexp) | ||
| 18781 | (list f))) | 19757 | (list f))) |
| 18782 | files))) | 19758 | files))) |
| 18783 | (if org-agenda-skip-unavailable-files | 19759 | (if org-agenda-skip-unavailable-files |
| @@ -18808,7 +19784,7 @@ the buffer and restores the previous window configuration." | |||
| 18808 | (message "New agenda file list installed")) | 19784 | (message "New agenda file list installed")) |
| 18809 | nil 'local) | 19785 | nil 'local) |
| 18810 | (message "%s" (substitute-command-keys | 19786 | (message "%s" (substitute-command-keys |
| 18811 | "Edit list and finish with \\[save-buffer]"))) | 19787 | "Edit list and finish with \\[save-buffer]"))) |
| 18812 | (customize-variable 'org-agenda-files))) | 19788 | (customize-variable 'org-agenda-files))) |
| 18813 | 19789 | ||
| 18814 | (defun org-store-new-agenda-file-list (list) | 19790 | (defun org-store-new-agenda-file-list (list) |
| @@ -18893,7 +19869,7 @@ Optional argument FILE means, use this file instead of the current." | |||
| 18893 | (org-store-new-agenda-file-list files) | 19869 | (org-store-new-agenda-file-list files) |
| 18894 | (org-install-agenda-files-menu) | 19870 | (org-install-agenda-files-menu) |
| 18895 | (message "Removed file: %s" afile)) | 19871 | (message "Removed file: %s" afile)) |
| 18896 | (message "File was not in list: %s" afile)))) | 19872 | (message "File was not in list: %s (not removed)" afile)))) |
| 18897 | 19873 | ||
| 18898 | (defun org-file-menu-entry (file) | 19874 | (defun org-file-menu-entry (file) |
| 18899 | (vector file (list 'find-file file) t)) | 19875 | (vector file (list 'find-file file) t)) |
| @@ -18982,10 +19958,9 @@ Optional argument FILE means, use this file instead of the current." | |||
| 18982 | (interactive) | 19958 | (interactive) |
| 18983 | (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority) | 19959 | (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority) |
| 18984 | (org-delete-overlay o))) | 19960 | (org-delete-overlay o))) |
| 18985 | (overlays-in (point-min) (point-max))) | 19961 | (org-overlays-in (point-min) (point-max))) |
| 18986 | (save-excursion | 19962 | (save-excursion |
| 18987 | (let ((ovs (org-overlays-in (point-min) (point-max))) | 19963 | (let ((inhibit-read-only t) |
| 18988 | (inhibit-read-only t) | ||
| 18989 | b e p ov h l) | 19964 | b e p ov h l) |
| 18990 | (goto-char (point-min)) | 19965 | (goto-char (point-min)) |
| 18991 | (while (re-search-forward "\\[#\\(.\\)\\]" nil t) | 19966 | (while (re-search-forward "\\[#\\(.\\)\\]" nil t) |
| @@ -18994,7 +19969,7 @@ Optional argument FILE means, use this file instead of the current." | |||
| 18994 | l (or (get-char-property (point) 'org-lowest-priority) | 19969 | l (or (get-char-property (point) 'org-lowest-priority) |
| 18995 | org-lowest-priority) | 19970 | org-lowest-priority) |
| 18996 | p (string-to-char (match-string 1)) | 19971 | p (string-to-char (match-string 1)) |
| 18997 | b (match-beginning 0) e (line-end-position) | 19972 | b (match-beginning 0) e (point-at-eol) |
| 18998 | ov (org-make-overlay b e)) | 19973 | ov (org-make-overlay b e)) |
| 18999 | (org-overlay-put | 19974 | (org-overlay-put |
| 19000 | ov 'face | 19975 | ov 'face |
| @@ -19016,8 +19991,10 @@ Optional argument FILE means, use this file instead of the current." | |||
| 19016 | (save-excursion | 19991 | (save-excursion |
| 19017 | (save-restriction | 19992 | (save-restriction |
| 19018 | (while (setq file (pop files)) | 19993 | (while (setq file (pop files)) |
| 19019 | (org-check-agenda-file file) | 19994 | (if (bufferp file) |
| 19020 | (set-buffer (org-get-agenda-file-buffer file)) | 19995 | (set-buffer file) |
| 19996 | (org-check-agenda-file file) | ||
| 19997 | (set-buffer (org-get-agenda-file-buffer file))) | ||
| 19021 | (widen) | 19998 | (widen) |
| 19022 | (setq bmp (buffer-modified-p)) | 19999 | (setq bmp (buffer-modified-p)) |
| 19023 | (org-refresh-category-properties) | 20000 | (org-refresh-category-properties) |
| @@ -19096,9 +20073,6 @@ no longer in use." | |||
| 19096 | (while org-agenda-markers | 20073 | (while org-agenda-markers |
| 19097 | (move-marker (pop org-agenda-markers) nil)))) | 20074 | (move-marker (pop org-agenda-markers) nil)))) |
| 19098 | 20075 | ||
| 19099 | (defvar org-agenda-new-buffers nil | ||
| 19100 | "Buffers created to visit agenda files.") | ||
| 19101 | |||
| 19102 | (defun org-get-agenda-file-buffer (file) | 20076 | (defun org-get-agenda-file-buffer (file) |
| 19103 | "Get a buffer visiting FILE. If the buffer needs to be created, add | 20077 | "Get a buffer visiting FILE. If the buffer needs to be created, add |
| 19104 | it to the list of buffers which might be released later." | 20078 | it to the list of buffers which might be released later." |
| @@ -19303,7 +20277,9 @@ given in `org-agenda-start-on-weekday'." | |||
| 19303 | org-agenda-start-on-weekday nil)) | 20277 | org-agenda-start-on-weekday nil)) |
| 19304 | (thefiles (org-agenda-files)) | 20278 | (thefiles (org-agenda-files)) |
| 19305 | (files thefiles) | 20279 | (files thefiles) |
| 19306 | (today (time-to-days (current-time))) | 20280 | (today (time-to-days |
| 20281 | (time-subtract (current-time) | ||
| 20282 | (list 0 (* 3600 org-extend-today-until) 0)))) | ||
| 19307 | (sd (or start-day today)) | 20283 | (sd (or start-day today)) |
| 19308 | (start (if (or (null org-agenda-start-on-weekday) | 20284 | (start (if (or (null org-agenda-start-on-weekday) |
| 19309 | (< org-agenda-ndays 7)) | 20285 | (< org-agenda-ndays 7)) |
| @@ -19576,11 +20552,12 @@ to skip this subtree. This is a function that can be put into | |||
| 19576 | 20552 | ||
| 19577 | (defun org-agenda-skip-entry-if (&rest conditions) | 20553 | (defun org-agenda-skip-entry-if (&rest conditions) |
| 19578 | "Skip entry if any of CONDITIONS is true. | 20554 | "Skip entry if any of CONDITIONS is true. |
| 19579 | See `org-agenda-skip-if for details." | 20555 | See `org-agenda-skip-if' for details." |
| 19580 | (org-agenda-skip-if nil conditions)) | 20556 | (org-agenda-skip-if nil conditions)) |
| 20557 | |||
| 19581 | (defun org-agenda-skip-subtree-if (&rest conditions) | 20558 | (defun org-agenda-skip-subtree-if (&rest conditions) |
| 19582 | "Skip entry if any of CONDITIONS is true. | 20559 | "Skip entry if any of CONDITIONS is true. |
| 19583 | See `org-agenda-skip-if for details." | 20560 | See `org-agenda-skip-if' for details." |
| 19584 | (org-agenda-skip-if t conditions)) | 20561 | (org-agenda-skip-if t conditions)) |
| 19585 | 20562 | ||
| 19586 | (defun org-agenda-skip-if (subtree conditions) | 20563 | (defun org-agenda-skip-if (subtree conditions) |
| @@ -19598,13 +20575,13 @@ notdeadline Check if there is no deadline | |||
| 19598 | regexp Check if regexp matches | 20575 | regexp Check if regexp matches |
| 19599 | notregexp Check if regexp does not match. | 20576 | notregexp Check if regexp does not match. |
| 19600 | 20577 | ||
| 19601 | The regexp is taken from the conditions list, it must com right after the | 20578 | The regexp is taken from the conditions list, it must come right after |
| 19602 | `regexp' of `notregexp' element. | 20579 | the `regexp' or `notregexp' element. |
| 19603 | 20580 | ||
| 19604 | If any of these conditions is met, this function returns the end point of | 20581 | If any of these conditions is met, this function returns the end point of |
| 19605 | the entity, causing the search to continue from there. This is a function | 20582 | the entity, causing the search to continue from there. This is a function |
| 19606 | that can be put into `org-agenda-skip-function' for the duration of a command." | 20583 | that can be put into `org-agenda-skip-function' for the duration of a command." |
| 19607 | (let (beg end m r) | 20584 | (let (beg end m) |
| 19608 | (org-back-to-heading t) | 20585 | (org-back-to-heading t) |
| 19609 | (setq beg (point) | 20586 | (setq beg (point) |
| 19610 | end (if subtree | 20587 | end (if subtree |
| @@ -19622,13 +20599,14 @@ that can be put into `org-agenda-skip-function' for the duration of a command." | |||
| 19622 | (and (memq 'notdeadline conditions) | 20599 | (and (memq 'notdeadline conditions) |
| 19623 | (not (re-search-forward org-deadline-time-regexp end t))) | 20600 | (not (re-search-forward org-deadline-time-regexp end t))) |
| 19624 | (and (setq m (memq 'regexp conditions)) | 20601 | (and (setq m (memq 'regexp conditions)) |
| 19625 | (stringp (setq r (nth 1 m))) | 20602 | (stringp (nth 1 m)) |
| 19626 | (re-search-forward (nth 1 m) end t)) | 20603 | (re-search-forward (nth 1 m) end t)) |
| 19627 | (and (setq m (memq 'notregexp conditions)) | 20604 | (and (setq m (memq 'notregexp conditions)) |
| 19628 | (stringp (setq r (nth 1 m))) | 20605 | (stringp (nth 1 m)) |
| 19629 | (not (re-search-forward (nth 1 m) end t)))) | 20606 | (not (re-search-forward (nth 1 m) end t)))) |
| 19630 | end))) | 20607 | end))) |
| 19631 | 20608 | ||
| 20609 | ;;;###autoload | ||
| 19632 | (defun org-agenda-list-stuck-projects (&rest ignore) | 20610 | (defun org-agenda-list-stuck-projects (&rest ignore) |
| 19633 | "Create agenda view for projects that are stuck. | 20611 | "Create agenda view for projects that are stuck. |
| 19634 | Stuck projects are project that have no next actions. For the definitions | 20612 | Stuck projects are project that have no next actions. For the definitions |
| @@ -19895,14 +20873,6 @@ the documentation of `org-diary'." | |||
| 19895 | (setq results (append results rtn)))))))) | 20873 | (setq results (append results rtn)))))))) |
| 19896 | results)))) | 20874 | results)))) |
| 19897 | 20875 | ||
| 19898 | ;; FIXME: this works only if the cursor is *not* at the | ||
| 19899 | ;; beginning of the entry | ||
| 19900 | ;(defun org-entry-is-done-p () | ||
| 19901 | ; "Is the current entry marked DONE?" | ||
| 19902 | ; (save-excursion | ||
| 19903 | ; (and (re-search-backward "[\r\n]\\*+ " nil t) | ||
| 19904 | ; (looking-at org-nl-done-regexp)))) | ||
| 19905 | |||
| 19906 | (defun org-entry-is-todo-p () | 20876 | (defun org-entry-is-todo-p () |
| 19907 | (member (org-get-todo-state) org-not-done-keywords)) | 20877 | (member (org-get-todo-state) org-not-done-keywords)) |
| 19908 | 20878 | ||
| @@ -20024,7 +20994,7 @@ the documentation of `org-diary'." | |||
| 20024 | "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" | 20994 | "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" |
| 20025 | "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) | 20995 | "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) |
| 20026 | marker hdmarker deadlinep scheduledp donep tmp priority category | 20996 | marker hdmarker deadlinep scheduledp donep tmp priority category |
| 20027 | ee txt timestr tags b0 b3 e3) | 20997 | ee txt timestr tags b0 b3 e3 head) |
| 20028 | (goto-char (point-min)) | 20998 | (goto-char (point-min)) |
| 20029 | (while (re-search-forward regexp nil t) | 20999 | (while (re-search-forward regexp nil t) |
| 20030 | (setq b0 (match-beginning 0) | 21000 | (setq b0 (match-beginning 0) |
| @@ -20058,8 +21028,10 @@ the documentation of `org-diary'." | |||
| 20058 | (setq hdmarker (org-agenda-new-marker) | 21028 | (setq hdmarker (org-agenda-new-marker) |
| 20059 | tags (org-get-tags-at)) | 21029 | tags (org-get-tags-at)) |
| 20060 | (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") | 21030 | (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") |
| 21031 | (setq head (match-string 1)) | ||
| 21032 | (and org-agenda-skip-timestamp-if-done donep (throw :skip t)) | ||
| 20061 | (setq txt (org-format-agenda-item | 21033 | (setq txt (org-format-agenda-item |
| 20062 | nil (match-string 1) category tags timestr nil | 21034 | nil head category tags timestr nil |
| 20063 | remove-re))) | 21035 | remove-re))) |
| 20064 | (setq txt org-agenda-no-heading-message)) | 21036 | (setq txt org-agenda-no-heading-message)) |
| 20065 | (setq priority (org-get-priority txt)) | 21037 | (setq priority (org-get-priority txt)) |
| @@ -20331,7 +21303,8 @@ FRACTION is what fraction of the head-warning time has passed." | |||
| 20331 | (abbreviate-file-name buffer-file-name)))) | 21303 | (abbreviate-file-name buffer-file-name)))) |
| 20332 | (regexp org-tr-regexp) | 21304 | (regexp org-tr-regexp) |
| 20333 | (d0 (calendar-absolute-from-gregorian date)) | 21305 | (d0 (calendar-absolute-from-gregorian date)) |
| 20334 | marker hdmarker ee txt d1 d2 s1 s2 timestr category tags pos) | 21306 | marker hdmarker ee txt d1 d2 s1 s2 timestr category tags pos |
| 21307 | donep head) | ||
| 20335 | (goto-char (point-min)) | 21308 | (goto-char (point-min)) |
| 20336 | (while (re-search-forward regexp nil t) | 21309 | (while (re-search-forward regexp nil t) |
| 20337 | (catch :skip | 21310 | (catch :skip |
| @@ -20354,10 +21327,14 @@ FRACTION is what fraction of the head-warning time has passed." | |||
| 20354 | (setq hdmarker (org-agenda-new-marker (point))) | 21327 | (setq hdmarker (org-agenda-new-marker (point))) |
| 20355 | (setq tags (org-get-tags-at)) | 21328 | (setq tags (org-get-tags-at)) |
| 20356 | (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") | 21329 | (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") |
| 21330 | (setq head (match-string 1)) | ||
| 21331 | (and org-agenda-skip-timestamp-if-done | ||
| 21332 | (org-entry-is-done-p) | ||
| 21333 | (throw :skip t)) | ||
| 20357 | (setq txt (org-format-agenda-item | 21334 | (setq txt (org-format-agenda-item |
| 20358 | (format (if (= d1 d2) "" "(%d/%d): ") | 21335 | (format (if (= d1 d2) "" "(%d/%d): ") |
| 20359 | (1+ (- d0 d1)) (1+ (- d2 d1))) | 21336 | (1+ (- d0 d1)) (1+ (- d2 d1))) |
| 20360 | (match-string 1) category tags | 21337 | head category tags |
| 20361 | (if (= d0 d1) timestr)))) | 21338 | (if (= d0 d1) timestr)))) |
| 20362 | (setq txt org-agenda-no-heading-message)) | 21339 | (setq txt org-agenda-no-heading-message)) |
| 20363 | (org-add-props txt props | 21340 | (org-add-props txt props |
| @@ -20518,7 +21495,7 @@ Any match of REMOVE-RE will be removed from TXT." | |||
| 20518 | 'extra extra | 21495 | 'extra extra |
| 20519 | 'dotime dotime)))) | 21496 | 'dotime dotime)))) |
| 20520 | 21497 | ||
| 20521 | (defvar org-agenda-sorting-strategy) ;; FIXME: can be removed? | 21498 | (defvar org-agenda-sorting-strategy) ;; because the def is in a let form |
| 20522 | (defvar org-agenda-sorting-strategy-selected nil) | 21499 | (defvar org-agenda-sorting-strategy-selected nil) |
| 20523 | 21500 | ||
| 20524 | (defun org-agenda-add-time-grid-maybe (list ndays todayp) | 21501 | (defun org-agenda-add-time-grid-maybe (list ndays todayp) |
| @@ -20636,16 +21613,32 @@ HH:MM." | |||
| 20636 | (beginning-of-line 1) | 21613 | (beginning-of-line 1) |
| 20637 | (setq re (get-text-property (point) 'org-todo-regexp)) | 21614 | (setq re (get-text-property (point) 'org-todo-regexp)) |
| 20638 | (goto-char (+ (point) (or (get-text-property (point) 'prefix-length) 0))) | 21615 | (goto-char (+ (point) (or (get-text-property (point) 'prefix-length) 0))) |
| 20639 | (and (looking-at (concat "[ \t]*\\.*" re)) | 21616 | (when (looking-at (concat "[ \t]*\\.*" re " +")) |
| 20640 | (add-text-properties (match-beginning 0) (match-end 0) | 21617 | (add-text-properties (match-beginning 0) (match-end 0) |
| 20641 | (list 'face (org-get-todo-face 0))))) | 21618 | (list 'face (org-get-todo-face 0))) |
| 21619 | (let ((s (buffer-substring (match-beginning 1) (match-end 1)))) | ||
| 21620 | (delete-region (match-beginning 1) (1- (match-end 0))) | ||
| 21621 | (goto-char (match-beginning 1)) | ||
| 21622 | (insert (format org-agenda-todo-keyword-format s))))) | ||
| 20642 | (setq re (concat (get-text-property 0 'org-todo-regexp x)) | 21623 | (setq re (concat (get-text-property 0 'org-todo-regexp x)) |
| 20643 | pl (get-text-property 0 'prefix-length x)) | 21624 | pl (get-text-property 0 'prefix-length x)) |
| 20644 | (and re (equal (string-match (concat "\\(\\.*\\)" re) x (or pl 0)) pl) | 21625 | ; (and re (equal (string-match (concat "\\(\\.*\\)" re) x (or pl 0)) pl) |
| 20645 | (add-text-properties | 21626 | ; (add-text-properties |
| 20646 | (or (match-end 1) (match-end 0)) (match-end 0) | 21627 | ; (or (match-end 1) (match-end 0)) (match-end 0) |
| 20647 | (list 'face (org-get-todo-face (match-string 2 x))) | 21628 | ; (list 'face (org-get-todo-face (match-string 2 x))) |
| 20648 | x)) | 21629 | ; x)) |
| 21630 | (when (and re | ||
| 21631 | (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)") | ||
| 21632 | x (or pl 0)) pl)) | ||
| 21633 | (add-text-properties | ||
| 21634 | (or (match-end 1) (match-end 0)) (match-end 0) | ||
| 21635 | (list 'face (org-get-todo-face (match-string 2 x))) | ||
| 21636 | x) | ||
| 21637 | (setq x (concat (substring x 0 (match-end 1)) | ||
| 21638 | (format org-agenda-todo-keyword-format | ||
| 21639 | (match-string 2 x)) | ||
| 21640 | " " | ||
| 21641 | (substring x (match-end 3))))) | ||
| 20649 | x))) | 21642 | x))) |
| 20650 | 21643 | ||
| 20651 | (defsubst org-cmp-priority (a b) | 21644 | (defsubst org-cmp-priority (a b) |
| @@ -20700,6 +21693,85 @@ HH:MM." | |||
| 20700 | (eval (cons 'or org-agenda-sorting-strategy-selected)) | 21693 | (eval (cons 'or org-agenda-sorting-strategy-selected)) |
| 20701 | '((-1 . t) (1 . nil) (nil . nil)))))) | 21694 | '((-1 . t) (1 . nil) (nil . nil)))))) |
| 20702 | 21695 | ||
| 21696 | ;;; Agenda restriction lock | ||
| 21697 | |||
| 21698 | (defvar org-agenda-restriction-lock-overlay (org-make-overlay 1 1) | ||
| 21699 | "Overlay to mark the headline to which arenda commands are restricted.") | ||
| 21700 | (org-overlay-put org-agenda-restriction-lock-overlay | ||
| 21701 | 'face 'org-agenda-restriction-lock) | ||
| 21702 | (org-overlay-put org-agenda-restriction-lock-overlay | ||
| 21703 | 'help-echo "Agendas are currently limited to this subtree.") | ||
| 21704 | (org-detach-overlay org-agenda-restriction-lock-overlay) | ||
| 21705 | (defvar org-speedbar-restriction-lock-overlay (org-make-overlay 1 1) | ||
| 21706 | "Overlay marking the agenda restriction line in speedbar.") | ||
| 21707 | (org-overlay-put org-speedbar-restriction-lock-overlay | ||
| 21708 | 'face 'org-agenda-restriction-lock) | ||
| 21709 | (org-overlay-put org-speedbar-restriction-lock-overlay | ||
| 21710 | 'help-echo "Agendas are currently limited to this item.") | ||
| 21711 | (org-detach-overlay org-speedbar-restriction-lock-overlay) | ||
| 21712 | |||
| 21713 | (defun org-agenda-set-restriction-lock (&optional type) | ||
| 21714 | "Set restriction lock for agenda, to current subtree or file. | ||
| 21715 | Restriction will be the file if TYPE is `file', or if type is the | ||
| 21716 | universal prefix '(4), or if the cursor is before the first headline | ||
| 21717 | in the file. Otherwise, restriction will be to the current subtree." | ||
| 21718 | (interactive "P") | ||
| 21719 | (and (equal type '(4)) (setq type 'file)) | ||
| 21720 | (setq type (cond | ||
| 21721 | (type type) | ||
| 21722 | ((org-at-heading-p) 'subtree) | ||
| 21723 | ((condition-case nil (org-back-to-heading t) (error nil)) | ||
| 21724 | 'subtree) | ||
| 21725 | (t 'file))) | ||
| 21726 | (if (eq type 'subtree) | ||
| 21727 | (progn | ||
| 21728 | (setq org-agenda-restrict t) | ||
| 21729 | (setq org-agenda-overriding-restriction 'subtree) | ||
| 21730 | (put 'org-agenda-files 'org-restrict | ||
| 21731 | (list (buffer-file-name (buffer-base-buffer)))) | ||
| 21732 | (org-back-to-heading t) | ||
| 21733 | (org-move-overlay org-agenda-restriction-lock-overlay (point) (point-at-eol)) | ||
| 21734 | (move-marker org-agenda-restrict-begin (point)) | ||
| 21735 | (move-marker org-agenda-restrict-end | ||
| 21736 | (save-excursion (org-end-of-subtree t))) | ||
| 21737 | (message "Locking agenda restriction to subtree")) | ||
| 21738 | (put 'org-agenda-files 'org-restrict | ||
| 21739 | (list (buffer-file-name (buffer-base-buffer)))) | ||
| 21740 | (setq org-agenda-restrict nil) | ||
| 21741 | (setq org-agenda-overriding-restriction 'file) | ||
| 21742 | (move-marker org-agenda-restrict-begin nil) | ||
| 21743 | (move-marker org-agenda-restrict-end nil) | ||
| 21744 | (message "Locking agenda restriction to file")) | ||
| 21745 | (setq current-prefix-arg nil) | ||
| 21746 | (org-agenda-maybe-redo)) | ||
| 21747 | |||
| 21748 | (defun org-agenda-remove-restriction-lock (&optional noupdate) | ||
| 21749 | "Remove the agenda restriction lock." | ||
| 21750 | (interactive "P") | ||
| 21751 | (org-detach-overlay org-agenda-restriction-lock-overlay) | ||
| 21752 | (org-detach-overlay org-speedbar-restriction-lock-overlay) | ||
| 21753 | (setq org-agenda-overriding-restriction nil) | ||
| 21754 | (setq org-agenda-restrict nil) | ||
| 21755 | (put 'org-agenda-files 'org-restrict nil) | ||
| 21756 | (move-marker org-agenda-restrict-begin nil) | ||
| 21757 | (move-marker org-agenda-restrict-end nil) | ||
| 21758 | (setq current-prefix-arg nil) | ||
| 21759 | (message "Agenda restriction lock removed") | ||
| 21760 | (or noupdate (org-agenda-maybe-redo))) | ||
| 21761 | |||
| 21762 | (defun org-agenda-maybe-redo () | ||
| 21763 | "If there is any window showing the agenda view, update it." | ||
| 21764 | (let ((w (get-buffer-window org-agenda-buffer-name t)) | ||
| 21765 | (w0 (selected-window))) | ||
| 21766 | (when w | ||
| 21767 | (select-window w) | ||
| 21768 | (org-agenda-redo) | ||
| 21769 | (select-window w0) | ||
| 21770 | (if org-agenda-overriding-restriction | ||
| 21771 | (message "Agenda view shifted to new %s restriction" | ||
| 21772 | org-agenda-overriding-restriction) | ||
| 21773 | (message "Agenda restriction lock removed"))))) | ||
| 21774 | |||
| 20703 | ;;; Agenda commands | 21775 | ;;; Agenda commands |
| 20704 | 21776 | ||
| 20705 | (defun org-agenda-check-type (error &rest types) | 21777 | (defun org-agenda-check-type (error &rest types) |
| @@ -20734,6 +21806,13 @@ Org-mode buffers visited directly by the user will not be touched." | |||
| 20734 | (setq org-agenda-new-buffers nil) | 21806 | (setq org-agenda-new-buffers nil) |
| 20735 | (org-agenda-quit)) | 21807 | (org-agenda-quit)) |
| 20736 | 21808 | ||
| 21809 | (defun org-agenda-execute (arg) | ||
| 21810 | "Execute another agenda command, keeping same window.\\<global-map> | ||
| 21811 | So this is just a shortcut for `\\[org-agenda]', available in the agenda." | ||
| 21812 | (interactive "P") | ||
| 21813 | (let ((org-agenda-window-setup 'current-window)) | ||
| 21814 | (org-agenda arg))) | ||
| 21815 | |||
| 20737 | (defun org-save-all-org-buffers () | 21816 | (defun org-save-all-org-buffers () |
| 20738 | "Save all Org-mode buffers without user confirmation." | 21817 | "Save all Org-mode buffers without user confirmation." |
| 20739 | (interactive) | 21818 | (interactive) |
| @@ -20770,7 +21849,9 @@ When this is the global TODO list, a prefix argument will be interpreted." | |||
| 20770 | (cond | 21849 | (cond |
| 20771 | (tdpos (goto-char tdpos)) | 21850 | (tdpos (goto-char tdpos)) |
| 20772 | ((eq org-agenda-type 'agenda) | 21851 | ((eq org-agenda-type 'agenda) |
| 20773 | (let* ((sd (time-to-days (current-time))) | 21852 | (let* ((sd (time-to-days |
| 21853 | (time-subtract (current-time) | ||
| 21854 | (list 0 (* 3600 org-extend-today-until) 0)))) | ||
| 20774 | (comp (org-agenda-compute-time-span sd org-agenda-span)) | 21855 | (comp (org-agenda-compute-time-span sd org-agenda-span)) |
| 20775 | (org-agenda-overriding-arguments org-agenda-last-arguments)) | 21856 | (org-agenda-overriding-arguments org-agenda-last-arguments)) |
| 20776 | (setf (nth 1 org-agenda-overriding-arguments) (car comp)) | 21857 | (setf (nth 1 org-agenda-overriding-arguments) (car comp)) |
| @@ -22034,6 +23115,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." | |||
| 22034 | (:archived-trees . org-export-with-archived-trees) | 23115 | (:archived-trees . org-export-with-archived-trees) |
| 22035 | (:emphasize . org-export-with-emphasize) | 23116 | (:emphasize . org-export-with-emphasize) |
| 22036 | (:sub-superscript . org-export-with-sub-superscripts) | 23117 | (:sub-superscript . org-export-with-sub-superscripts) |
| 23118 | (:special-strings . org-export-with-special-strings) | ||
| 22037 | (:footnotes . org-export-with-footnotes) | 23119 | (:footnotes . org-export-with-footnotes) |
| 22038 | (:drawers . org-export-with-drawers) | 23120 | (:drawers . org-export-with-drawers) |
| 22039 | (:tags . org-export-with-tags) | 23121 | (:tags . org-export-with-tags) |
| @@ -22047,10 +23129,11 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." | |||
| 22047 | (:tables . org-export-with-tables) | 23129 | (:tables . org-export-with-tables) |
| 22048 | (:table-auto-headline . org-export-highlight-first-table-line) | 23130 | (:table-auto-headline . org-export-highlight-first-table-line) |
| 22049 | (:style . org-export-html-style) | 23131 | (:style . org-export-html-style) |
| 22050 | (:agenda-style . org-agenda-export-html-style) ;; FIXME: Does this work???? | 23132 | (:agenda-style . org-agenda-export-html-style) |
| 22051 | (:convert-org-links . org-export-html-link-org-files-as-html) | 23133 | (:convert-org-links . org-export-html-link-org-files-as-html) |
| 22052 | (:inline-images . org-export-html-inline-images) | 23134 | (:inline-images . org-export-html-inline-images) |
| 22053 | (:html-extension . org-export-html-extension) | 23135 | (:html-extension . org-export-html-extension) |
| 23136 | (:html-table-tag . org-export-html-table-tag) | ||
| 22054 | (:expand-quoted-html . org-export-html-expand) | 23137 | (:expand-quoted-html . org-export-html-expand) |
| 22055 | (:timestamp . org-export-html-with-timestamp) | 23138 | (:timestamp . org-export-html-with-timestamp) |
| 22056 | (:publishing-directory . org-export-publishing-directory) | 23139 | (:publishing-directory . org-export-publishing-directory) |
| @@ -22071,50 +23154,53 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." | |||
| 22071 | (defun org-infile-export-plist () | 23154 | (defun org-infile-export-plist () |
| 22072 | "Return the property list with file-local settings for export." | 23155 | "Return the property list with file-local settings for export." |
| 22073 | (save-excursion | 23156 | (save-excursion |
| 22074 | (goto-char 0) | 23157 | (save-restriction |
| 22075 | (let ((re (org-make-options-regexp | 23158 | (widen) |
| 22076 | '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) | 23159 | (goto-char 0) |
| 22077 | p key val text options) | 23160 | (let ((re (org-make-options-regexp |
| 22078 | (while (re-search-forward re nil t) | 23161 | '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) |
| 22079 | (setq key (org-match-string-no-properties 1) | 23162 | p key val text options) |
| 22080 | val (org-match-string-no-properties 2)) | 23163 | (while (re-search-forward re nil t) |
| 22081 | (cond | 23164 | (setq key (org-match-string-no-properties 1) |
| 22082 | ((string-equal key "TITLE") (setq p (plist-put p :title val))) | 23165 | val (org-match-string-no-properties 2)) |
| 22083 | ((string-equal key "AUTHOR")(setq p (plist-put p :author val))) | 23166 | (cond |
| 22084 | ((string-equal key "EMAIL") (setq p (plist-put p :email val))) | 23167 | ((string-equal key "TITLE") (setq p (plist-put p :title val))) |
| 22085 | ((string-equal key "DATE") (setq p (plist-put p :date val))) | 23168 | ((string-equal key "AUTHOR")(setq p (plist-put p :author val))) |
| 22086 | ((string-equal key "LANGUAGE") (setq p (plist-put p :language val))) | 23169 | ((string-equal key "EMAIL") (setq p (plist-put p :email val))) |
| 22087 | ((string-equal key "TEXT") | 23170 | ((string-equal key "DATE") (setq p (plist-put p :date val))) |
| 22088 | (setq text (if text (concat text "\n" val) val))) | 23171 | ((string-equal key "LANGUAGE") (setq p (plist-put p :language val))) |
| 22089 | ((string-equal key "OPTIONS") (setq options val)))) | 23172 | ((string-equal key "TEXT") |
| 22090 | (setq p (plist-put p :text text)) | 23173 | (setq text (if text (concat text "\n" val) val))) |
| 22091 | (when options | 23174 | ((string-equal key "OPTIONS") (setq options val)))) |
| 22092 | (let ((op '(("H" . :headline-levels) | 23175 | (setq p (plist-put p :text text)) |
| 22093 | ("num" . :section-numbers) | 23176 | (when options |
| 22094 | ("toc" . :table-of-contents) | 23177 | (let ((op '(("H" . :headline-levels) |
| 22095 | ("\\n" . :preserve-breaks) | 23178 | ("num" . :section-numbers) |
| 22096 | ("@" . :expand-quoted-html) | 23179 | ("toc" . :table-of-contents) |
| 22097 | (":" . :fixed-width) | 23180 | ("\\n" . :preserve-breaks) |
| 22098 | ("|" . :tables) | 23181 | ("@" . :expand-quoted-html) |
| 22099 | ("^" . :sub-superscript) | 23182 | (":" . :fixed-width) |
| 22100 | ("f" . :footnotes) | 23183 | ("|" . :tables) |
| 22101 | ("d" . :drawers) | 23184 | ("^" . :sub-superscript) |
| 22102 | ("tags" . :tags) | 23185 | ("-" . :special-strings) |
| 22103 | ("*" . :emphasize) | 23186 | ("f" . :footnotes) |
| 22104 | ("TeX" . :TeX-macros) | 23187 | ("d" . :drawers) |
| 22105 | ("LaTeX" . :LaTeX-fragments) | 23188 | ("tags" . :tags) |
| 22106 | ("skip" . :skip-before-1st-heading) | 23189 | ("*" . :emphasize) |
| 22107 | ("author" . :author-info) | 23190 | ("TeX" . :TeX-macros) |
| 22108 | ("timestamp" . :time-stamp-file))) | 23191 | ("LaTeX" . :LaTeX-fragments) |
| 22109 | o) | 23192 | ("skip" . :skip-before-1st-heading) |
| 22110 | (while (setq o (pop op)) | 23193 | ("author" . :author-info) |
| 22111 | (if (string-match (concat (regexp-quote (car o)) | 23194 | ("timestamp" . :time-stamp-file))) |
| 22112 | ":\\([^ \t\n\r;,.]*\\)") | 23195 | o) |
| 22113 | options) | 23196 | (while (setq o (pop op)) |
| 22114 | (setq p (plist-put p (cdr o) | 23197 | (if (string-match (concat (regexp-quote (car o)) |
| 22115 | (car (read-from-string | 23198 | ":\\([^ \t\n\r;,.]*\\)") |
| 22116 | (match-string 1 options))))))))) | 23199 | options) |
| 22117 | p))) | 23200 | (setq p (plist-put p (cdr o) |
| 23201 | (car (read-from-string | ||
| 23202 | (match-string 1 options))))))))) | ||
| 23203 | p)))) | ||
| 22118 | 23204 | ||
| 22119 | (defun org-export-directory (type plist) | 23205 | (defun org-export-directory (type plist) |
| 22120 | (let* ((val (plist-get plist :publishing-directory)) | 23206 | (let* ((val (plist-get plist :publishing-directory)) |
| @@ -22397,8 +23483,8 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." | |||
| 22397 | ("prop") ("proptp"."∝") | 23483 | ("prop") ("proptp"."∝") |
| 22398 | ("infin") ("infty"."∞") | 23484 | ("infin") ("infty"."∞") |
| 22399 | ("ang") ("angle"."∠") | 23485 | ("ang") ("angle"."∠") |
| 22400 | ("and") ("vee"."∧") | 23486 | ("and") ("wedge"."∧") |
| 22401 | ("or") ("wedge"."∨") | 23487 | ("or") ("vee"."∨") |
| 22402 | ("cap") | 23488 | ("cap") |
| 22403 | ("cup") | 23489 | ("cup") |
| 22404 | ("int") | 23490 | ("int") |
| @@ -22523,6 +23609,8 @@ translations. There is currently no way for users to extend this.") | |||
| 22523 | (commentsp (plist-get parameters :comments)) | 23609 | (commentsp (plist-get parameters :comments)) |
| 22524 | (archived-trees (plist-get parameters :archived-trees)) | 23610 | (archived-trees (plist-get parameters :archived-trees)) |
| 22525 | (inhibit-read-only t) | 23611 | (inhibit-read-only t) |
| 23612 | (drawers org-drawers) | ||
| 23613 | (exp-drawers (plist-get parameters :drawers)) | ||
| 22526 | (outline-regexp "\\*+ ") | 23614 | (outline-regexp "\\*+ ") |
| 22527 | a b xx | 23615 | a b xx |
| 22528 | rtn p) | 23616 | rtn p) |
| @@ -22561,14 +23649,14 @@ translations. There is currently no way for users to extend this.") | |||
| 22561 | (if (> b a) (delete-region a b))))) | 23649 | (if (> b a) (delete-region a b))))) |
| 22562 | 23650 | ||
| 22563 | ;; Get rid of drawers | 23651 | ;; Get rid of drawers |
| 22564 | (unless (eq t org-export-with-drawers) | 23652 | (unless (eq t exp-drawers) |
| 22565 | (goto-char (point-min)) | 23653 | (goto-char (point-min)) |
| 22566 | (let ((re (concat "^[ \t]*:\\(" | 23654 | (let ((re (concat "^[ \t]*:\\(" |
| 22567 | (mapconcat 'identity | 23655 | (mapconcat |
| 22568 | (if (listp org-export-with-drawers) | 23656 | 'identity |
| 22569 | org-export-with-drawers | 23657 | (org-delete-all exp-drawers |
| 22570 | org-drawers) | 23658 | (copy-sequence drawers)) |
| 22571 | "\\|") | 23659 | "\\|") |
| 22572 | "\\):[ \t]*\n\\([^@]*?\n\\)?[ \t]*:END:[ \t]*\n"))) | 23660 | "\\):[ \t]*\n\\([^@]*?\n\\)?[ \t]*:END:[ \t]*\n"))) |
| 22573 | (while (re-search-forward re nil t) | 23661 | (while (re-search-forward re nil t) |
| 22574 | (replace-match "")))) | 23662 | (replace-match "")))) |
| @@ -22580,12 +23668,18 @@ translations. There is currently no way for users to extend this.") | |||
| 22580 | (replace-match "\\1(INVISIBLE)")) | 23668 | (replace-match "\\1(INVISIBLE)")) |
| 22581 | 23669 | ||
| 22582 | ;; Protect backend specific stuff, throw away the others. | 23670 | ;; Protect backend specific stuff, throw away the others. |
| 22583 | (goto-char (point-min)) | ||
| 22584 | (let ((formatters | 23671 | (let ((formatters |
| 22585 | `((,htmlp "HTML" "BEGIN_HTML" "END_HTML") | 23672 | `((,htmlp "HTML" "BEGIN_HTML" "END_HTML") |
| 22586 | (,asciip "ASCII" "BEGIN_ASCII" "END_ASCII") | 23673 | (,asciip "ASCII" "BEGIN_ASCII" "END_ASCII") |
| 22587 | (,latexp "LaTeX" "BEGIN_LaTeX" "END_LaTeX"))) | 23674 | (,latexp "LaTeX" "BEGIN_LaTeX" "END_LaTeX"))) |
| 22588 | fmt) | 23675 | fmt) |
| 23676 | (goto-char (point-min)) | ||
| 23677 | (while (re-search-forward "^#\\+BEGIN_EXAMPLE[ \t]*\n" nil t) | ||
| 23678 | (goto-char (match-end 0)) | ||
| 23679 | (while (not (looking-at "#\\+END_EXAMPLE")) | ||
| 23680 | (insert ": ") | ||
| 23681 | (beginning-of-line 2))) | ||
| 23682 | (goto-char (point-min)) | ||
| 22589 | (while (re-search-forward "^[ \t]*:.*\\(\n[ \t]*:.*\\)*" nil t) | 23683 | (while (re-search-forward "^[ \t]*:.*\\(\n[ \t]*:.*\\)*" nil t) |
| 22590 | (add-text-properties (match-beginning 0) (match-end 0) | 23684 | (add-text-properties (match-beginning 0) (match-end 0) |
| 22591 | '(org-protected t))) | 23685 | '(org-protected t))) |
| @@ -22617,6 +23711,13 @@ translations. There is currently no way for users to extend this.") | |||
| 22617 | (add-text-properties (point) (org-end-of-subtree t) | 23711 | (add-text-properties (point) (org-end-of-subtree t) |
| 22618 | '(org-protected t))) | 23712 | '(org-protected t))) |
| 22619 | 23713 | ||
| 23714 | ;; Protect verbatim elements | ||
| 23715 | (goto-char (point-min)) | ||
| 23716 | (while (re-search-forward org-verbatim-re nil t) | ||
| 23717 | (add-text-properties (match-beginning 4) (match-end 4) | ||
| 23718 | '(org-protected t)) | ||
| 23719 | (goto-char (1+ (match-end 4)))) | ||
| 23720 | |||
| 22620 | ;; Remove subtrees that are commented | 23721 | ;; Remove subtrees that are commented |
| 22621 | (goto-char (point-min)) | 23722 | (goto-char (point-min)) |
| 22622 | (while (re-search-forward re-commented nil t) | 23723 | (while (re-search-forward re-commented nil t) |
| @@ -22640,6 +23741,9 @@ translations. There is currently no way for users to extend this.") | |||
| 22640 | (require 'org-export-latex nil) | 23741 | (require 'org-export-latex nil) |
| 22641 | (org-export-latex-cleaned-string)) | 23742 | (org-export-latex-cleaned-string)) |
| 22642 | 23743 | ||
| 23744 | (when asciip | ||
| 23745 | (org-export-ascii-clean-string)) | ||
| 23746 | |||
| 22643 | ;; Specific HTML stuff | 23747 | ;; Specific HTML stuff |
| 22644 | (when htmlp | 23748 | (when htmlp |
| 22645 | ;; Convert LaTeX fragments to images | 23749 | ;; Convert LaTeX fragments to images |
| @@ -22887,6 +23991,8 @@ underlined headlines. The default is 3." | |||
| 22887 | :for-ascii t | 23991 | :for-ascii t |
| 22888 | :skip-before-1st-heading | 23992 | :skip-before-1st-heading |
| 22889 | (plist-get opt-plist :skip-before-1st-heading) | 23993 | (plist-get opt-plist :skip-before-1st-heading) |
| 23994 | :drawers (plist-get opt-plist :drawers) | ||
| 23995 | :verbatim-multiline t | ||
| 22890 | :archived-trees | 23996 | :archived-trees |
| 22891 | (plist-get opt-plist :archived-trees) | 23997 | (plist-get opt-plist :archived-trees) |
| 22892 | :add-text (plist-get opt-plist :text)) | 23998 | :add-text (plist-get opt-plist :text)) |
| @@ -23083,6 +24189,16 @@ underlined headlines. The default is 3." | |||
| 23083 | (goto-char beg))) | 24189 | (goto-char beg))) |
| 23084 | (goto-char (point-min)))) | 24190 | (goto-char (point-min)))) |
| 23085 | 24191 | ||
| 24192 | (defun org-export-ascii-clean-string () | ||
| 24193 | "Do extra work for ASCII export" | ||
| 24194 | (goto-char (point-min)) | ||
| 24195 | (while (re-search-forward org-verbatim-re nil t) | ||
| 24196 | (goto-char (match-end 2)) | ||
| 24197 | (backward-delete-char 1) (insert "'") | ||
| 24198 | (goto-char (match-beginning 2)) | ||
| 24199 | (delete-char 1) (insert "`") | ||
| 24200 | (goto-char (match-end 2)))) | ||
| 24201 | |||
| 23086 | (defun org-search-todo-below (line lines level) | 24202 | (defun org-search-todo-below (line lines level) |
| 23087 | "Search the subtree below LINE for any TODO entries." | 24203 | "Search the subtree below LINE for any TODO entries." |
| 23088 | (let ((rest (cdr (memq line lines))) | 24204 | (let ((rest (cdr (memq line lines))) |
| @@ -23232,7 +24348,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." | |||
| 23232 | #+EMAIL: %s | 24348 | #+EMAIL: %s |
| 23233 | #+LANGUAGE: %s | 24349 | #+LANGUAGE: %s |
| 23234 | #+TEXT: Some descriptive text to be emitted. Several lines OK. | 24350 | #+TEXT: Some descriptive text to be emitted. Several lines OK. |
| 23235 | #+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s f:%s *:%s TeX:%s LaTeX:%s skip:%s d:%s tags:%s | 24351 | #+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s -:%s f:%s *:%s TeX:%s LaTeX:%s skip:%s d:%s tags:%s |
| 23236 | #+CATEGORY: %s | 24352 | #+CATEGORY: %s |
| 23237 | #+SEQ_TODO: %s | 24353 | #+SEQ_TODO: %s |
| 23238 | #+TYP_TODO: %s | 24354 | #+TYP_TODO: %s |
| @@ -23252,6 +24368,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." | |||
| 23252 | org-export-with-fixed-width | 24368 | org-export-with-fixed-width |
| 23253 | org-export-with-tables | 24369 | org-export-with-tables |
| 23254 | org-export-with-sub-superscripts | 24370 | org-export-with-sub-superscripts |
| 24371 | org-export-with-special-strings | ||
| 23255 | org-export-with-footnotes | 24372 | org-export-with-footnotes |
| 23256 | org-export-with-emphasize | 24373 | org-export-with-emphasize |
| 23257 | org-export-with-TeX-macros | 24374 | org-export-with-TeX-macros |
| @@ -23308,6 +24425,7 @@ this line is also exported in fixed-width font." | |||
| 23308 | (beg (if regionp (region-beginning) (point))) | 24425 | (beg (if regionp (region-beginning) (point))) |
| 23309 | (end (if regionp (region-end))) | 24426 | (end (if regionp (region-end))) |
| 23310 | (nlines (or arg (if (and beg end) (count-lines beg end) 1))) | 24427 | (nlines (or arg (if (and beg end) (count-lines beg end) 1))) |
| 24428 | (case-fold-search nil) | ||
| 23311 | (re "[ \t]*\\(:\\)") | 24429 | (re "[ \t]*\\(:\\)") |
| 23312 | off) | 24430 | off) |
| 23313 | (if regionp | 24431 | (if regionp |
| @@ -23415,6 +24533,7 @@ in a window. A non-interactive call will only retunr the buffer." | |||
| 23415 | (switch-to-buffer-other-window rtn) | 24533 | (switch-to-buffer-other-window rtn) |
| 23416 | rtn))) | 24534 | rtn))) |
| 23417 | 24535 | ||
| 24536 | (defvar html-table-tag nil) ; dynamically scoped into this. | ||
| 23418 | (defun org-export-as-html (arg &optional hidden ext-plist | 24537 | (defun org-export-as-html (arg &optional hidden ext-plist |
| 23419 | to-buffer body-only) | 24538 | to-buffer body-only) |
| 23420 | "Export the outline as a pretty HTML file. | 24539 | "Export the outline as a pretty HTML file. |
| @@ -23469,14 +24588,16 @@ the body tags themselves." | |||
| 23469 | (umax nil) | 24588 | (umax nil) |
| 23470 | (umax-toc nil) | 24589 | (umax-toc nil) |
| 23471 | (filename (if to-buffer nil | 24590 | (filename (if to-buffer nil |
| 23472 | (concat (file-name-as-directory | 24591 | (expand-file-name |
| 23473 | (org-export-directory :html opt-plist)) | 24592 | (concat |
| 23474 | (file-name-sans-extension | 24593 | (file-name-sans-extension |
| 23475 | (or (and subtree-p | 24594 | (or (and subtree-p |
| 23476 | (org-entry-get (region-beginning) | 24595 | (org-entry-get (region-beginning) |
| 23477 | "EXPORT_FILE_NAME" t)) | 24596 | "EXPORT_FILE_NAME" t)) |
| 23478 | (file-name-nondirectory buffer-file-name))) | 24597 | (file-name-nondirectory buffer-file-name))) |
| 23479 | "." org-export-html-extension))) | 24598 | "." org-export-html-extension) |
| 24599 | (file-name-as-directory | ||
| 24600 | (org-export-directory :html opt-plist))))) | ||
| 23480 | (current-dir (if buffer-file-name | 24601 | (current-dir (if buffer-file-name |
| 23481 | (file-name-directory buffer-file-name) | 24602 | (file-name-directory buffer-file-name) |
| 23482 | default-directory)) | 24603 | default-directory)) |
| @@ -23497,6 +24618,7 @@ the body tags themselves." | |||
| 23497 | (file-name-sans-extension | 24618 | (file-name-sans-extension |
| 23498 | (file-name-nondirectory buffer-file-name))) | 24619 | (file-name-nondirectory buffer-file-name))) |
| 23499 | "UNTITLED")) | 24620 | "UNTITLED")) |
| 24621 | (html-table-tag (plist-get opt-plist :html-table-tag)) | ||
| 23500 | (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) | 24622 | (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) |
| 23501 | (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)")) | 24623 | (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)")) |
| 23502 | (inquote nil) | 24624 | (inquote nil) |
| @@ -23533,6 +24655,7 @@ the body tags themselves." | |||
| 23533 | :for-html t | 24655 | :for-html t |
| 23534 | :skip-before-1st-heading | 24656 | :skip-before-1st-heading |
| 23535 | (plist-get opt-plist :skip-before-1st-heading) | 24657 | (plist-get opt-plist :skip-before-1st-heading) |
| 24658 | :drawers (plist-get opt-plist :drawers) | ||
| 23536 | :archived-trees | 24659 | :archived-trees |
| 23537 | (plist-get opt-plist :archived-trees) | 24660 | (plist-get opt-plist :archived-trees) |
| 23538 | :add-text | 24661 | :add-text |
| @@ -23569,7 +24692,7 @@ the body tags themselves." | |||
| 23569 | 24692 | ||
| 23570 | ;; Switch to the output buffer | 24693 | ;; Switch to the output buffer |
| 23571 | (set-buffer buffer) | 24694 | (set-buffer buffer) |
| 23572 | (erase-buffer) | 24695 | (let ((inhibit-read-only t)) (erase-buffer)) |
| 23573 | (fundamental-mode) | 24696 | (fundamental-mode) |
| 23574 | 24697 | ||
| 23575 | (and (fboundp 'set-buffer-file-coding-system) | 24698 | (and (fboundp 'set-buffer-file-coding-system) |
| @@ -23732,7 +24855,8 @@ lang=\"%s\" xml:lang=\"%s\"> | |||
| 23732 | (replace-match "\\2\n")) | 24855 | (replace-match "\\2\n")) |
| 23733 | (insert line "\n") | 24856 | (insert line "\n") |
| 23734 | (while (and lines | 24857 | (while (and lines |
| 23735 | (get-text-property 0 'org-protected (car lines))) | 24858 | (or (= (length (car lines)) 0) |
| 24859 | (get-text-property 0 'org-protected (car lines)))) | ||
| 23736 | (insert (pop lines) "\n")) | 24860 | (insert (pop lines) "\n")) |
| 23737 | (and par (insert "<p>\n"))) | 24861 | (and par (insert "<p>\n"))) |
| 23738 | (throw 'nextline nil)) | 24862 | (throw 'nextline nil)) |
| @@ -23768,7 +24892,8 @@ lang=\"%s\" xml:lang=\"%s\"> | |||
| 23768 | ;; replace "&" by "&", "<" and ">" by "<" and ">" | 24892 | ;; replace "&" by "&", "<" and ">" by "<" and ">" |
| 23769 | ;; handle @<..> HTML tags (replace "@>..<" by "<..>") | 24893 | ;; handle @<..> HTML tags (replace "@>..<" by "<..>") |
| 23770 | ;; Also handle sub_superscripts and checkboxes | 24894 | ;; Also handle sub_superscripts and checkboxes |
| 23771 | (setq line (org-html-expand line)) | 24895 | (or (string-match org-table-hline-regexp line) |
| 24896 | (setq line (org-html-expand line))) | ||
| 23772 | 24897 | ||
| 23773 | ;; Format the links | 24898 | ;; Format the links |
| 23774 | (setq start 0) | 24899 | (setq start 0) |
| @@ -23868,14 +24993,17 @@ lang=\"%s\" xml:lang=\"%s\"> | |||
| 23868 | 24993 | ||
| 23869 | ;; Does this contain a reference to a footnote? | 24994 | ;; Does this contain a reference to a footnote? |
| 23870 | (when org-export-with-footnotes | 24995 | (when org-export-with-footnotes |
| 23871 | (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line) | 24996 | (setq start 0) |
| 23872 | (let ((n (match-string 2 line))) | 24997 | (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start) |
| 23873 | (setq line | 24998 | (if (get-text-property (match-beginning 2) 'org-protected line) |
| 23874 | (replace-match | 24999 | (setq start (match-end 2)) |
| 23875 | (format | 25000 | (let ((n (match-string 2 line))) |
| 23876 | "%s<sup><a class=\"footref\" name=\"fnr.%s\" href=\"#fn.%s\">%s</a></sup>" | 25001 | (setq line |
| 23877 | (match-string 1 line) n n n) | 25002 | (replace-match |
| 23878 | t t line))))) | 25003 | (format |
| 25004 | "%s<sup><a class=\"footref\" name=\"fnr.%s\" href=\"#fn.%s\">%s</a></sup>" | ||
| 25005 | (match-string 1 line) n n n) | ||
| 25006 | t t line)))))) | ||
| 23879 | 25007 | ||
| 23880 | (cond | 25008 | (cond |
| 23881 | ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) | 25009 | ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) |
| @@ -24005,7 +25133,7 @@ lang=\"%s\" xml:lang=\"%s\"> | |||
| 24005 | (pop local-list-num)) | 25133 | (pop local-list-num)) |
| 24006 | (setq local-list-indent nil | 25134 | (setq local-list-indent nil |
| 24007 | in-local-list nil)) | 25135 | in-local-list nil)) |
| 24008 | (org-html-level-start 0 nil umax | 25136 | (org-html-level-start 1 nil umax |
| 24009 | (and org-export-with-toc (<= level umax)) | 25137 | (and org-export-with-toc (<= level umax)) |
| 24010 | head-count) | 25138 | head-count) |
| 24011 | 25139 | ||
| @@ -24016,8 +25144,13 @@ lang=\"%s\" xml:lang=\"%s\"> | |||
| 24016 | (insert "<p class=\"author\"> " | 25144 | (insert "<p class=\"author\"> " |
| 24017 | (nth 1 lang-words) ": " author "\n") | 25145 | (nth 1 lang-words) ": " author "\n") |
| 24018 | (when email | 25146 | (when email |
| 24019 | (insert "<a href=\"mailto:" email "\"><" | 25147 | (if (listp (split-string email ",+ *")) |
| 24020 | email "></a>\n")) | 25148 | (mapc (lambda(e) |
| 25149 | (insert "<a href=\"mailto:" e "\"><" | ||
| 25150 | e "></a>\n")) | ||
| 25151 | (split-string email ",+ *")) | ||
| 25152 | (insert "<a href=\"mailto:" email "\"><" | ||
| 25153 | email "></a>\n"))) | ||
| 24021 | (insert "</p>\n")) | 25154 | (insert "</p>\n")) |
| 24022 | (when (and date org-export-time-stamp-file) | 25155 | (when (and date org-export-time-stamp-file) |
| 24023 | (insert "<p class=\"date\"> " | 25156 | (insert "<p class=\"date\"> " |
| @@ -24201,11 +25334,11 @@ lang=\"%s\" xml:lang=\"%s\"> | |||
| 24201 | (unless splice (push "</table>\n" html)) | 25334 | (unless splice (push "</table>\n" html)) |
| 24202 | (setq html (nreverse html)) | 25335 | (setq html (nreverse html)) |
| 24203 | (unless splice | 25336 | (unless splice |
| 24204 | ;; Put in COL tags with the alignment (unfortuntely often ignored...) | 25337 | ;; Put in col tags with the alignment (unfortuntely often ignored...) |
| 24205 | (push (mapconcat | 25338 | (push (mapconcat |
| 24206 | (lambda (x) | 25339 | (lambda (x) |
| 24207 | (setq gr (pop org-table-colgroup-info)) | 25340 | (setq gr (pop org-table-colgroup-info)) |
| 24208 | (format "%s<COL align=\"%s\"></COL>%s" | 25341 | (format "%s<col align=\"%s\"></col>%s" |
| 24209 | (if (memq gr '(:start :startend)) | 25342 | (if (memq gr '(:start :startend)) |
| 24210 | (prog1 | 25343 | (prog1 |
| 24211 | (if colgropen "</colgroup>\n<colgroup>" "<colgroup>") | 25344 | (if colgropen "</colgroup>\n<colgroup>" "<colgroup>") |
| @@ -24219,7 +25352,7 @@ lang=\"%s\" xml:lang=\"%s\"> | |||
| 24219 | fnum "") | 25352 | fnum "") |
| 24220 | html) | 25353 | html) |
| 24221 | (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html))))) | 25354 | (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html))))) |
| 24222 | (push org-export-html-table-tag html)) | 25355 | (push html-table-tag html)) |
| 24223 | (concat (mapconcat 'identity html "\n") "\n"))) | 25356 | (concat (mapconcat 'identity html "\n") "\n"))) |
| 24224 | 25357 | ||
| 24225 | (defun org-table-clean-before-export (lines) | 25358 | (defun org-table-clean-before-export (lines) |
| @@ -24267,8 +25400,7 @@ If yes remove the column and the special lines." | |||
| 24267 | ((or (string-match "^\\([ \t]*\\)|-+\\+" x) | 25400 | ((or (string-match "^\\([ \t]*\\)|-+\\+" x) |
| 24268 | (string-match "^\\([ \t]*\\)|[^|]*|" x)) | 25401 | (string-match "^\\([ \t]*\\)|[^|]*|" x)) |
| 24269 | ;; remove the first column | 25402 | ;; remove the first column |
| 24270 | (replace-match "\\1|" t nil x)) | 25403 | (replace-match "\\1|" t nil x)))) |
| 24271 | (t (error "This should not happen")))) | ||
| 24272 | lines)))) | 25404 | lines)))) |
| 24273 | 25405 | ||
| 24274 | (defun org-format-table-table-html (lines) | 25406 | (defun org-format-table-table-html (lines) |
| @@ -24279,7 +25411,7 @@ But it has the disadvantage, that no cell- or row-spanning is allowed." | |||
| 24279 | (let (line field-buffer | 25411 | (let (line field-buffer |
| 24280 | (head org-export-highlight-first-table-line) | 25412 | (head org-export-highlight-first-table-line) |
| 24281 | fields html empty) | 25413 | fields html empty) |
| 24282 | (setq html (concat org-export-html-table-tag "\n")) | 25414 | (setq html (concat html-table-tag "\n")) |
| 24283 | (while (setq line (pop lines)) | 25415 | (while (setq line (pop lines)) |
| 24284 | (setq empty " ") | 25416 | (setq empty " ") |
| 24285 | (catch 'next-line | 25417 | (catch 'next-line |
| @@ -24407,21 +25539,26 @@ If there are links in the string, don't modify these." | |||
| 24407 | "Apply all active conversions to translate special ASCII to HTML." | 25539 | "Apply all active conversions to translate special ASCII to HTML." |
| 24408 | (setq s (org-html-protect s)) | 25540 | (setq s (org-html-protect s)) |
| 24409 | (if org-export-html-expand | 25541 | (if org-export-html-expand |
| 24410 | (while (string-match "@<\\([^&]*\\)>" s) | 25542 | (let ((start 0)) |
| 24411 | (setq s (replace-match "<\\1>" t nil s)))) | 25543 | (while (string-match "@<\\([^&]*\\)>" s) |
| 25544 | (setq s (replace-match "<\\1>" t nil s))))) | ||
| 24412 | (if org-export-with-emphasize | 25545 | (if org-export-with-emphasize |
| 24413 | (setq s (org-export-html-convert-emphasize s))) | 25546 | (setq s (org-export-html-convert-emphasize s))) |
| 25547 | (if org-export-with-special-strings | ||
| 25548 | (setq s (org-export-html-convert-special-strings s))) | ||
| 24414 | (if org-export-with-sub-superscripts | 25549 | (if org-export-with-sub-superscripts |
| 24415 | (setq s (org-export-html-convert-sub-super s))) | 25550 | (setq s (org-export-html-convert-sub-super s))) |
| 24416 | (if org-export-with-TeX-macros | 25551 | (if org-export-with-TeX-macros |
| 24417 | (let ((start 0) wd ass) | 25552 | (let ((start 0) wd ass) |
| 24418 | (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)" s start)) | 25553 | (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)" s start)) |
| 24419 | (setq wd (match-string 1 s)) | 25554 | (if (get-text-property (match-beginning 0) 'org-protected s) |
| 24420 | (if (setq ass (assoc wd org-html-entities)) | 25555 | (setq start (match-end 0)) |
| 24421 | (setq s (replace-match (or (cdr ass) | 25556 | (setq wd (match-string 1 s)) |
| 24422 | (concat "&" (car ass) ";")) | 25557 | (if (setq ass (assoc wd org-html-entities)) |
| 24423 | t t s)) | 25558 | (setq s (replace-match (or (cdr ass) |
| 24424 | (setq start (+ start (length wd))))))) | 25559 | (concat "&" (car ass) ";")) |
| 25560 | t t s)) | ||
| 25561 | (setq start (+ start (length wd)))))))) | ||
| 24425 | s) | 25562 | s) |
| 24426 | 25563 | ||
| 24427 | (defun org-create-multibrace-regexp (left right n) | 25564 | (defun org-create-multibrace-regexp (left right n) |
| @@ -24452,16 +25589,41 @@ stacked delimiters is N. Escaping delimiters is not possible." | |||
| 24452 | "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") | 25589 | "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") |
| 24453 | "The regular expression matching a sub- or superscript.") | 25590 | "The regular expression matching a sub- or superscript.") |
| 24454 | 25591 | ||
| 24455 | ;(let ((s "a\\_b")) | 25592 | (defvar org-match-substring-with-braces-regexp |
| 24456 | ; (and (string-match org-match-substring-regexp s) | 25593 | (concat |
| 24457 | ; (conca t (match-string 1 s) ":::" (match-string 2 s)))) | 25594 | "\\([^\\]\\)\\([_^]\\)\\(" |
| 25595 | "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" | ||
| 25596 | "\\)") | ||
| 25597 | "The regular expression matching a sub- or superscript, forcing braces.") | ||
| 25598 | |||
| 25599 | (defconst org-export-html-special-string-regexps | ||
| 25600 | '(("\\\\-" . "­") | ||
| 25601 | ("---\\([^-]\\)" . "—\\1") | ||
| 25602 | ("--\\([^-]\\)" . "–\\1") | ||
| 25603 | ("\\.\\.\\." . "…")) | ||
| 25604 | "Regular expressions for special string conversion.") | ||
| 25605 | |||
| 25606 | (defun org-export-html-convert-special-strings (string) | ||
| 25607 | "Convert special characters in STRING to HTML." | ||
| 25608 | (let ((all org-export-html-special-string-regexps) | ||
| 25609 | e a re rpl start) | ||
| 25610 | (while (setq a (pop all)) | ||
| 25611 | (setq re (car a) rpl (cdr a) start 0) | ||
| 25612 | (while (string-match re string start) | ||
| 25613 | (if (get-text-property (match-beginning 0) 'org-protected string) | ||
| 25614 | (setq start (match-end 0)) | ||
| 25615 | (setq string (replace-match rpl t nil string))))) | ||
| 25616 | string)) | ||
| 24458 | 25617 | ||
| 24459 | (defun org-export-html-convert-sub-super (string) | 25618 | (defun org-export-html-convert-sub-super (string) |
| 24460 | "Convert sub- and superscripts in STRING to HTML." | 25619 | "Convert sub- and superscripts in STRING to HTML." |
| 24461 | (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) | 25620 | (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) |
| 24462 | (while (string-match org-match-substring-regexp string s) | 25621 | (while (string-match org-match-substring-regexp string s) |
| 24463 | (if (and requireb (match-end 8)) | 25622 | (cond |
| 24464 | (setq s (match-end 2)) | 25623 | ((and requireb (match-end 8)) (setq s (match-end 2))) |
| 25624 | ((get-text-property (match-beginning 2) 'org-protected string) | ||
| 25625 | (setq s (match-end 2))) | ||
| 25626 | (t | ||
| 24465 | (setq s (match-end 1) | 25627 | (setq s (match-end 1) |
| 24466 | key (if (string= (match-string 2 string) "_") "sub" "sup") | 25628 | key (if (string= (match-string 2 string) "_") "sub" "sup") |
| 24467 | c (or (match-string 8 string) | 25629 | c (or (match-string 8 string) |
| @@ -24470,22 +25632,29 @@ stacked delimiters is N. Escaping delimiters is not possible." | |||
| 24470 | string (replace-match | 25632 | string (replace-match |
| 24471 | (concat (match-string 1 string) | 25633 | (concat (match-string 1 string) |
| 24472 | "<" key ">" c "</" key ">") | 25634 | "<" key ">" c "</" key ">") |
| 24473 | t t string)))) | 25635 | t t string))))) |
| 24474 | (while (string-match "\\\\\\([_^]\\)" string) | 25636 | (while (string-match "\\\\\\([_^]\\)" string) |
| 24475 | (setq string (replace-match (match-string 1 string) t t string))) | 25637 | (setq string (replace-match (match-string 1 string) t t string))) |
| 24476 | string)) | 25638 | string)) |
| 24477 | 25639 | ||
| 24478 | (defun org-export-html-convert-emphasize (string) | 25640 | (defun org-export-html-convert-emphasize (string) |
| 24479 | "Apply emphasis." | 25641 | "Apply emphasis." |
| 24480 | (let ((s 0)) | 25642 | (let ((s 0) rpl) |
| 24481 | (while (string-match org-emph-re string s) | 25643 | (while (string-match org-emph-re string s) |
| 24482 | (if (not (equal | 25644 | (if (not (equal |
| 24483 | (substring string (match-beginning 3) (1+ (match-beginning 3))) | 25645 | (substring string (match-beginning 3) (1+ (match-beginning 3))) |
| 24484 | (substring string (match-beginning 4) (1+ (match-beginning 4))))) | 25646 | (substring string (match-beginning 4) (1+ (match-beginning 4))))) |
| 24485 | (setq string (replace-match | 25647 | (setq s (match-beginning 0) |
| 24486 | (concat "\\1" (nth 2 (assoc (match-string 3 string) org-emphasis-alist)) | 25648 | rpl |
| 24487 | "\\4" (nth 3 (assoc (match-string 3 string) org-emphasis-alist)) | 25649 | (concat |
| 24488 | "\\5") t nil string)) | 25650 | (match-string 1 string) |
| 25651 | (nth 2 (assoc (match-string 3 string) org-emphasis-alist)) | ||
| 25652 | (match-string 4 string) | ||
| 25653 | (nth 3 (assoc (match-string 3 string) | ||
| 25654 | org-emphasis-alist)) | ||
| 25655 | (match-string 5 string)) | ||
| 25656 | string (replace-match rpl t t string) | ||
| 25657 | s (+ s (- (length rpl) 2))) | ||
| 24489 | (setq s (1+ s)))) | 25658 | (setq s (1+ s)))) |
| 24490 | string)) | 25659 | string)) |
| 24491 | 25660 | ||
| @@ -24511,7 +25680,7 @@ stacked delimiters is N. Escaping delimiters is not possible." | |||
| 24511 | When TITLE is nil, just close all open levels." | 25680 | When TITLE is nil, just close all open levels." |
| 24512 | (org-close-par-maybe) | 25681 | (org-close-par-maybe) |
| 24513 | (let ((l org-level-max)) | 25682 | (let ((l org-level-max)) |
| 24514 | (while (>= l (1+ level)) | 25683 | (while (>= l level) |
| 24515 | (if (aref org-levels-open (1- l)) | 25684 | (if (aref org-levels-open (1- l)) |
| 24516 | (progn | 25685 | (progn |
| 24517 | (org-html-level-close l umax) | 25686 | (org-html-level-close l umax) |
| @@ -24657,10 +25826,14 @@ When COMBINE is non nil, add the category to each line." | |||
| 24657 | ts (match-string 0) | 25826 | ts (match-string 0) |
| 24658 | inc t | 25827 | inc t |
| 24659 | hd (org-get-heading) | 25828 | hd (org-get-heading) |
| 24660 | summary (org-entry-get nil "SUMMARY") | 25829 | summary (org-icalendar-cleanup-string |
| 24661 | desc (or (org-entry-get nil "DESCRIPTION") | 25830 | (org-entry-get nil "SUMMARY")) |
| 24662 | (org-get-cleaned-entry org-icalendar-include-body)) | 25831 | desc (org-icalendar-cleanup-string |
| 24663 | location (org-entry-get nil "LOCATION") | 25832 | (or (org-entry-get nil "DESCRIPTION") |
| 25833 | (and org-icalendar-include-body (org-get-entry))) | ||
| 25834 | t org-icalendar-include-body) | ||
| 25835 | location (org-icalendar-cleanup-string | ||
| 25836 | (org-entry-get nil "LOCATION")) | ||
| 24664 | category (org-get-category)) | 25837 | category (org-get-category)) |
| 24665 | (if (looking-at re2) | 25838 | (if (looking-at re2) |
| 24666 | (progn | 25839 | (progn |
| @@ -24748,10 +25921,14 @@ END:VEVENT\n" | |||
| 24748 | (not (member org-archive-tag (org-get-tags-at))) | 25921 | (not (member org-archive-tag (org-get-tags-at))) |
| 24749 | ) | 25922 | ) |
| 24750 | (setq hd (match-string 3) | 25923 | (setq hd (match-string 3) |
| 24751 | summary (org-entry-get nil "SUMMARY") | 25924 | summary (org-icalendar-cleanup-string |
| 24752 | desc (or (org-entry-get nil "DESCRIPTION") | 25925 | (org-entry-get nil "SUMMARY")) |
| 24753 | (org-get-cleaned-entry org-icalendar-include-body)) | 25926 | desc (org-icalendar-cleanup-string |
| 24754 | location (org-entry-get nil "LOCATION")) | 25927 | (or (org-entry-get nil "DESCRIPTION") |
| 25928 | (and org-icalendar-include-body (org-get-entry))) | ||
| 25929 | t org-icalendar-include-body) | ||
| 25930 | location (org-icalendar-cleanup-string | ||
| 25931 | (org-entry-get nil "LOCATION"))) | ||
| 24755 | (if (string-match org-bracket-link-regexp hd) | 25932 | (if (string-match org-bracket-link-regexp hd) |
| 24756 | (setq hd (replace-match (if (match-end 3) (match-string 3 hd) | 25933 | (setq hd (replace-match (if (match-end 3) (match-string 3 hd) |
| 24757 | (match-string 1 hd)) | 25934 | (match-string 1 hd)) |
| @@ -24780,24 +25957,38 @@ END:VTODO\n" | |||
| 24780 | (concat "\nDESCRIPTION: " desc) "") | 25957 | (concat "\nDESCRIPTION: " desc) "") |
| 24781 | category pri status))))))))) | 25958 | category pri status))))))))) |
| 24782 | 25959 | ||
| 24783 | (defun org-get-cleaned-entry (what) | 25960 | (defun org-icalendar-cleanup-string (s &optional is-body maxlength) |
| 24784 | "Clean-up description string." | 25961 | "Take out stuff and quote what needs to be quoted. |
| 24785 | (when what | 25962 | When IS-BODY is non-nil, assume that this is the body of an item, clean up |
| 24786 | (save-excursion | 25963 | whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH |
| 24787 | (org-back-to-heading t) | 25964 | characters." |
| 24788 | (let ((s (buffer-substring (point-at-bol 2) (org-end-of-subtree t))) | 25965 | (if (not s) |
| 24789 | (re (concat org-drawer-regexp "[^\000]*?:END:.*\n?")) | 25966 | nil |
| 25967 | (when is-body | ||
| 25968 | (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) | ||
| 24790 | (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) | 25969 | (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) |
| 24791 | (while (string-match re s) (setq s (replace-match "" t t s))) | 25970 | (while (string-match re s) (setq s (replace-match "" t t s))) |
| 24792 | (while (string-match re2 s) (setq s (replace-match "" t t s))) | 25971 | (while (string-match re2 s) (setq s (replace-match "" t t s))))) |
| 24793 | (if (string-match "[ \t\r\n]+\\'" s) (setq s (replace-match "" t t s))) | 25972 | (let ((start 0)) |
| 24794 | (while (string-match "[ \t]*\n[ \t]*" s) | 25973 | (while (string-match "\\([,;\\]\\)" s start) |
| 24795 | (setq s (replace-match "\\n" t t s))) | 25974 | (setq start (+ (match-beginning 0) 2) |
| 24796 | (setq s (org-trim s)) | 25975 | s (replace-match "\\\\\\1" nil nil s)))) |
| 24797 | (if (and (numberp what) | 25976 | (when is-body |
| 24798 | (> (length s) what)) | 25977 | (while (string-match "[ \t]*\n[ \t]*" s) |
| 24799 | (substring s 0 what) | 25978 | (setq s (replace-match "\\n" t t s)))) |
| 24800 | s))))) | 25979 | (setq s (org-trim s)) |
| 25980 | (if is-body | ||
| 25981 | (if maxlength | ||
| 25982 | (if (and (numberp maxlength) | ||
| 25983 | (> (length s) maxlength)) | ||
| 25984 | (setq s (substring s 0 maxlength))))) | ||
| 25985 | s)) | ||
| 25986 | |||
| 25987 | (defun org-get-entry () | ||
| 25988 | "Clean-up description string." | ||
| 25989 | (save-excursion | ||
| 25990 | (org-back-to-heading t) | ||
| 25991 | (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) | ||
| 24801 | 25992 | ||
| 24802 | (defun org-start-icalendar-file (name) | 25993 | (defun org-start-icalendar-file (name) |
| 24803 | "Start an iCalendar file by inserting the header." | 25994 | "Start an iCalendar file by inserting the header." |
| @@ -24853,8 +26044,8 @@ The XOXO buffer is named *xoxo-<source buffer name>*" | |||
| 24853 | 26044 | ||
| 24854 | ;; Output everything as XOXO | 26045 | ;; Output everything as XOXO |
| 24855 | (with-current-buffer (get-buffer buffer) | 26046 | (with-current-buffer (get-buffer buffer) |
| 24856 | (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. | 26047 | (let* ((pos (point)) |
| 24857 | (let* ((opt-plist (org-combine-plists (org-default-export-plist) | 26048 | (opt-plist (org-combine-plists (org-default-export-plist) |
| 24858 | (org-infile-export-plist))) | 26049 | (org-infile-export-plist))) |
| 24859 | (filename (concat (file-name-as-directory | 26050 | (filename (concat (file-name-as-directory |
| 24860 | (org-export-directory :xoxo opt-plist)) | 26051 | (org-export-directory :xoxo opt-plist)) |
| @@ -24864,6 +26055,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*" | |||
| 24864 | (out (find-file-noselect filename)) | 26055 | (out (find-file-noselect filename)) |
| 24865 | (last-level 1) | 26056 | (last-level 1) |
| 24866 | (hanging-li nil)) | 26057 | (hanging-li nil)) |
| 26058 | (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. | ||
| 24867 | ;; Check the output buffer is empty. | 26059 | ;; Check the output buffer is empty. |
| 24868 | (with-current-buffer out (erase-buffer)) | 26060 | (with-current-buffer out (erase-buffer)) |
| 24869 | ;; Kick off the output | 26061 | ;; Kick off the output |
| @@ -24916,6 +26108,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*" | |||
| 24916 | (org-export-as-xoxo-insert-into out "</li>\n")) | 26108 | (org-export-as-xoxo-insert-into out "</li>\n")) |
| 24917 | (org-export-as-xoxo-insert-into out "</ol>\n")) | 26109 | (org-export-as-xoxo-insert-into out "</ol>\n")) |
| 24918 | 26110 | ||
| 26111 | (goto-char pos) | ||
| 24919 | ;; Finish the buffer off and clean it up. | 26112 | ;; Finish the buffer off and clean it up. |
| 24920 | (switch-to-buffer-other-window out) | 26113 | (switch-to-buffer-other-window out) |
| 24921 | (indent-region (point-min) (point-max) nil) | 26114 | (indent-region (point-min) (point-max) nil) |
| @@ -25009,7 +26202,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*" | |||
| 25009 | (org-defkey org-mode-map "\C-c\C-d" 'org-deadline) | 26202 | (org-defkey org-mode-map "\C-c\C-d" 'org-deadline) |
| 25010 | (org-defkey org-mode-map "\C-c;" 'org-toggle-comment) | 26203 | (org-defkey org-mode-map "\C-c;" 'org-toggle-comment) |
| 25011 | (org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree) | 26204 | (org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree) |
| 25012 | (org-defkey org-mode-map "\C-c\C-w" 'org-check-deadlines) | 26205 | (org-defkey org-mode-map "\C-c\C-w" 'org-refile) |
| 25013 | (org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved | 26206 | (org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved |
| 25014 | (org-defkey org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res. | 26207 | (org-defkey org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res. |
| 25015 | (org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) | 26208 | (org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) |
| @@ -25032,12 +26225,15 @@ The XOXO buffer is named *xoxo-<source buffer name>*" | |||
| 25032 | (org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files) | 26225 | (org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files) |
| 25033 | (org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front) | 26226 | (org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front) |
| 25034 | (org-defkey org-mode-map "\C-c]" 'org-remove-file) | 26227 | (org-defkey org-mode-map "\C-c]" 'org-remove-file) |
| 26228 | (org-defkey org-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock) | ||
| 26229 | (org-defkey org-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) | ||
| 25035 | (org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus) | 26230 | (org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus) |
| 25036 | (org-defkey org-mode-map "\C-c^" 'org-sort) | 26231 | (org-defkey org-mode-map "\C-c^" 'org-sort) |
| 25037 | (org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) | 26232 | (org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) |
| 25038 | (org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) | 26233 | (org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) |
| 25039 | (org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count) | 26234 | (org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count) |
| 25040 | (org-defkey org-mode-map "\C-m" 'org-return) | 26235 | (org-defkey org-mode-map "\C-m" 'org-return) |
| 26236 | (org-defkey org-mode-map "\C-j" 'org-return-indent) | ||
| 25041 | (org-defkey org-mode-map "\C-c?" 'org-table-field-info) | 26237 | (org-defkey org-mode-map "\C-c?" 'org-table-field-info) |
| 25042 | (org-defkey org-mode-map "\C-c " 'org-table-blank-field) | 26238 | (org-defkey org-mode-map "\C-c " 'org-table-blank-field) |
| 25043 | (org-defkey org-mode-map "\C-c+" 'org-table-sum) | 26239 | (org-defkey org-mode-map "\C-c+" 'org-table-sum) |
| @@ -25175,12 +26371,9 @@ because, in this case the deletion might narrow the column." | |||
| 25175 | (put 'org-delete-char 'flyspell-delayed t) | 26371 | (put 'org-delete-char 'flyspell-delayed t) |
| 25176 | (put 'org-delete-backward-char 'flyspell-delayed t) | 26372 | (put 'org-delete-backward-char 'flyspell-delayed t) |
| 25177 | 26373 | ||
| 25178 | (eval-after-load "pabbrev" | 26374 | ;; Make pabbrev-mode expand after org-mode commands |
| 25179 | '(progn | 26375 | (put 'org-self-insert-command 'pabbrev-expand-after-command t) |
| 25180 | (add-to-list 'pabbrev-expand-after-command-list | 26376 | (put 'orgybl-self-insert-command 'pabbrev-expand-after-command t) |
| 25181 | 'orgtbl-self-insert-command t) | ||
| 25182 | (add-to-list 'pabbrev-expand-after-command-list | ||
| 25183 | 'org-self-insert-command t))) | ||
| 25184 | 26377 | ||
| 25185 | ;; How to do this: Measure non-white length of current string | 26378 | ;; How to do this: Measure non-white length of current string |
| 25186 | ;; If equal to column width, we should realign. | 26379 | ;; If equal to column width, we should realign. |
| @@ -25442,7 +26635,9 @@ This command does many different things, depending on context: | |||
| 25442 | links in this buffer. | 26635 | links in this buffer. |
| 25443 | 26636 | ||
| 25444 | - If the cursor is on a numbered item in a plain list, renumber the | 26637 | - If the cursor is on a numbered item in a plain list, renumber the |
| 25445 | ordered list." | 26638 | ordered list. |
| 26639 | |||
| 26640 | - If the cursor is on a checkbox, toggle it." | ||
| 25446 | (interactive "P") | 26641 | (interactive "P") |
| 25447 | (let ((org-enable-table-editor t)) | 26642 | (let ((org-enable-table-editor t)) |
| 25448 | (cond | 26643 | (cond |
| @@ -25500,25 +26695,31 @@ Also updates the keyword regular expressions." | |||
| 25500 | (message "Org-mode restarted to refresh keyword and special line setup")) | 26695 | (message "Org-mode restarted to refresh keyword and special line setup")) |
| 25501 | 26696 | ||
| 25502 | (defun org-kill-note-or-show-branches () | 26697 | (defun org-kill-note-or-show-branches () |
| 25503 | "If this is a Note buffer, abort storing the note. Else call `show-branches'." | 26698 | "If this is a Note buffer, abort storing the note. Else call `show-branches'." |
| 25504 | (interactive) | 26699 | (interactive) |
| 25505 | (if (not org-finish-function) | 26700 | (if (not org-finish-function) |
| 25506 | (call-interactively 'show-branches) | 26701 | (call-interactively 'show-branches) |
| 25507 | (let ((org-note-abort t)) | 26702 | (let ((org-note-abort t)) |
| 25508 | (funcall org-finish-function)))) | 26703 | (funcall org-finish-function)))) |
| 25509 | 26704 | ||
| 25510 | (defun org-return () | 26705 | (defun org-return (&optional indent) |
| 25511 | "Goto next table row or insert a newline. | 26706 | "Goto next table row or insert a newline. |
| 25512 | Calls `org-table-next-row' or `newline', depending on context. | 26707 | Calls `org-table-next-row' or `newline', depending on context. |
| 25513 | See the individual commands for more information." | 26708 | See the individual commands for more information." |
| 25514 | (interactive) | 26709 | (interactive) |
| 25515 | (cond | 26710 | (cond |
| 25516 | ((bobp) (newline)) | 26711 | ((bobp) (if indent (newline-and-indent) (newline))) |
| 25517 | ((org-at-table-p) | 26712 | ((org-at-table-p) |
| 25518 | (org-table-justify-field-maybe) | 26713 | (org-table-justify-field-maybe) |
| 25519 | (call-interactively 'org-table-next-row)) | 26714 | (call-interactively 'org-table-next-row)) |
| 25520 | (t (newline)))) | 26715 | (t (if indent (newline-and-indent) (newline))))) |
| 25521 | 26716 | ||
| 26717 | (defun org-return-indent () | ||
| 26718 | (interactive) | ||
| 26719 | "Goto next table row or insert a newline and indent. | ||
| 26720 | Calls `org-table-next-row' or `newline-and-indent', depending on | ||
| 26721 | context. See the individual commands for more information." | ||
| 26722 | (org-return t)) | ||
| 25522 | 26723 | ||
| 25523 | (defun org-ctrl-c-minus () | 26724 | (defun org-ctrl-c-minus () |
| 25524 | "Insert separator line in table or modify bullet type in list. | 26725 | "Insert separator line in table or modify bullet type in list. |
| @@ -25723,6 +26924,7 @@ See the individual commands for more information." | |||
| 25723 | :style toggle :selected org-log-done]) | 26924 | :style toggle :selected org-log-done]) |
| 25724 | "--" | 26925 | "--" |
| 25725 | ["Agenda Command..." org-agenda t] | 26926 | ["Agenda Command..." org-agenda t] |
| 26927 | ["Set Restriction Lock" org-agenda-set-restriction-lock t] | ||
| 25726 | ("File List for Agenda") | 26928 | ("File List for Agenda") |
| 25727 | ("Special views current file" | 26929 | ("Special views current file" |
| 25728 | ["TODO Tree" org-show-todo-tree t] | 26930 | ["TODO Tree" org-show-todo-tree t] |
| @@ -25981,6 +27183,18 @@ really on, so that the block visually is on the match." | |||
| 25981 | (setq list (delete (pop elts) list))) | 27183 | (setq list (delete (pop elts) list))) |
| 25982 | list) | 27184 | list) |
| 25983 | 27185 | ||
| 27186 | (defun org-back-over-empty-lines () | ||
| 27187 | "Move backwards over witespace, to the beginning of the first empty line. | ||
| 27188 | Returns the number o empty lines passed." | ||
| 27189 | (let ((pos (point))) | ||
| 27190 | (skip-chars-backward " \t\n\r") | ||
| 27191 | (beginning-of-line 2) | ||
| 27192 | (goto-char (min (point) pos)) | ||
| 27193 | (count-lines (point) pos))) | ||
| 27194 | |||
| 27195 | (defun org-skip-whitespace () | ||
| 27196 | (skip-chars-forward " \t\n\r")) | ||
| 27197 | |||
| 25984 | (defun org-point-in-group (point group &optional context) | 27198 | (defun org-point-in-group (point group &optional context) |
| 25985 | "Check if POINT is in match-group GROUP. | 27199 | "Check if POINT is in match-group GROUP. |
| 25986 | If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the | 27200 | If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the |
| @@ -26129,10 +27343,13 @@ not an indirect buffer" | |||
| 26129 | (setq column tcol) | 27343 | (setq column tcol) |
| 26130 | (goto-char pos) | 27344 | (goto-char pos) |
| 26131 | (beginning-of-line 1) | 27345 | (beginning-of-line 1) |
| 26132 | (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") | 27346 | (if (looking-at "\\S-") |
| 26133 | (setq bullet (match-string 1) | 27347 | (progn |
| 26134 | btype (if (string-match "[0-9]" bullet) "n" bullet)) | 27348 | (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") |
| 26135 | (setq column (if (equal btype bullet-type) bcol tcol)))) | 27349 | (setq bullet (match-string 1) |
| 27350 | btype (if (string-match "[0-9]" bullet) "n" bullet)) | ||
| 27351 | (setq column (if (equal btype bullet-type) bcol tcol))) | ||
| 27352 | (setq column (org-get-indentation))))) | ||
| 26136 | (t (setq column (org-get-indentation)))))) | 27353 | (t (setq column (org-get-indentation)))))) |
| 26137 | (goto-char pos) | 27354 | (goto-char pos) |
| 26138 | (if (<= (current-column) (current-indentation)) | 27355 | (if (<= (current-column) (current-indentation)) |
| @@ -26141,7 +27358,7 @@ not an indirect buffer" | |||
| 26141 | (setq column (current-column)) | 27358 | (setq column (current-column)) |
| 26142 | (beginning-of-line 1) | 27359 | (beginning-of-line 1) |
| 26143 | (if (looking-at | 27360 | (if (looking-at |
| 26144 | "\\([ \t]+\\)\\(:[0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") | 27361 | "\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") |
| 26145 | (replace-match (concat "\\1" (format org-property-format | 27362 | (replace-match (concat "\\1" (format org-property-format |
| 26146 | (match-string 2) (match-string 3))) | 27363 | (match-string 2) (match-string 3))) |
| 26147 | t nil)) | 27364 | t nil)) |
| @@ -26183,10 +27400,13 @@ not an indirect buffer" | |||
| 26183 | "Re-align a table, pass through to fill-paragraph if no table." | 27400 | "Re-align a table, pass through to fill-paragraph if no table." |
| 26184 | (let ((table-p (org-at-table-p)) | 27401 | (let ((table-p (org-at-table-p)) |
| 26185 | (table.el-p (org-at-table.el-p))) | 27402 | (table.el-p (org-at-table.el-p))) |
| 26186 | (cond ((equal (char-after (point-at-bol)) ?*) t) ; skip headlines | 27403 | (cond ((and (equal (char-after (point-at-bol)) ?*) |
| 26187 | (table.el-p t) ; skip table.el tables | 27404 | (save-excursion (goto-char (point-at-bol)) |
| 26188 | (table-p (org-table-align) t) ; align org-mode tables | 27405 | (looking-at outline-regexp))) |
| 26189 | (t nil)))) ; call paragraph-fill | 27406 | t) ; skip headlines |
| 27407 | (table.el-p t) ; skip table.el tables | ||
| 27408 | (table-p (org-table-align) t) ; align org-mode tables | ||
| 27409 | (t nil)))) ; call paragraph-fill | ||
| 26190 | 27410 | ||
| 26191 | ;; For reference, this is the default value of adaptive-fill-regexp | 27411 | ;; For reference, this is the default value of adaptive-fill-regexp |
| 26192 | ;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*" | 27412 | ;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*" |
| @@ -26318,6 +27538,20 @@ headline found, or nil if no higher level is found." | |||
| 26318 | (if (< level start-level) (throw 'exit level))) | 27538 | (if (< level start-level) (throw 'exit level))) |
| 26319 | nil))) | 27539 | nil))) |
| 26320 | 27540 | ||
| 27541 | (defun org-first-sibling-p () | ||
| 27542 | "Is this heading the first child of its parents?" | ||
| 27543 | (interactive) | ||
| 27544 | (let ((re (concat "^" outline-regexp)) | ||
| 27545 | level l) | ||
| 27546 | (unless (org-at-heading-p t) | ||
| 27547 | (error "Not at a heading")) | ||
| 27548 | (setq level (funcall outline-level)) | ||
| 27549 | (save-excursion | ||
| 27550 | (if (not (re-search-backward re nil t)) | ||
| 27551 | t | ||
| 27552 | (setq l (funcall outline-level)) | ||
| 27553 | (< l level))))) | ||
| 27554 | |||
| 26321 | (defun org-goto-sibling (&optional previous) | 27555 | (defun org-goto-sibling (&optional previous) |
| 26322 | "Goto the next sibling, even if it is invisible. | 27556 | "Goto the next sibling, even if it is invisible. |
| 26323 | When PREVIOUS is set, go to the previous sibling instead. Returns t | 27557 | When PREVIOUS is set, go to the previous sibling instead. Returns t |
| @@ -26446,7 +27680,104 @@ Show the heading too, if it is currently invisible." | |||
| 26446 | (org-show-context 'isearch)) | 27680 | (org-show-context 'isearch)) |
| 26447 | 27681 | ||
| 26448 | 27682 | ||
| 26449 | ;;;; Address problems with some other packages | 27683 | ;;;; Integration with and fixes for other packages |
| 27684 | |||
| 27685 | ;;; Imenu support | ||
| 27686 | |||
| 27687 | (defvar org-imenu-markers nil | ||
| 27688 | "All markers currently used by Imenu.") | ||
| 27689 | (make-variable-buffer-local 'org-imenu-markers) | ||
| 27690 | |||
| 27691 | (defun org-imenu-new-marker (&optional pos) | ||
| 27692 | "Return a new marker for use by Imenu, and remember the marker." | ||
| 27693 | (let ((m (make-marker))) | ||
| 27694 | (move-marker m (or pos (point))) | ||
| 27695 | (push m org-imenu-markers) | ||
| 27696 | m)) | ||
| 27697 | |||
| 27698 | (defun org-imenu-get-tree () | ||
| 27699 | "Produce the index for Imenu." | ||
| 27700 | (mapc (lambda (x) (move-marker x nil)) org-imenu-markers) | ||
| 27701 | (setq org-imenu-markers nil) | ||
| 27702 | (let* ((n org-imenu-depth) | ||
| 27703 | (re (concat "^" outline-regexp)) | ||
| 27704 | (subs (make-vector (1+ n) nil)) | ||
| 27705 | (last-level 0) | ||
| 27706 | m tree level head) | ||
| 27707 | (save-excursion | ||
| 27708 | (save-restriction | ||
| 27709 | (widen) | ||
| 27710 | (goto-char (point-max)) | ||
| 27711 | (while (re-search-backward re nil t) | ||
| 27712 | (setq level (org-reduced-level (funcall outline-level))) | ||
| 27713 | (when (<= level n) | ||
| 27714 | (looking-at org-complex-heading-regexp) | ||
| 27715 | (setq head (org-match-string-no-properties 4) | ||
| 27716 | m (org-imenu-new-marker)) | ||
| 27717 | (org-add-props head nil 'org-imenu-marker m 'org-imenu t) | ||
| 27718 | (if (>= level last-level) | ||
| 27719 | (push (cons head m) (aref subs level)) | ||
| 27720 | (push (cons head (aref subs (1+ level))) (aref subs level)) | ||
| 27721 | (loop for i from (1+ level) to n do (aset subs i nil))) | ||
| 27722 | (setq last-level level))))) | ||
| 27723 | (aref subs 1))) | ||
| 27724 | |||
| 27725 | (eval-after-load "imenu" | ||
| 27726 | '(progn | ||
| 27727 | (add-hook 'imenu-after-jump-hook | ||
| 27728 | (lambda () (org-show-context 'org-goto))))) | ||
| 27729 | |||
| 27730 | ;; Speedbar support | ||
| 27731 | |||
| 27732 | (defun org-speedbar-set-agenda-restriction () | ||
| 27733 | "Restrict future agenda commands to the location at point in speedbar. | ||
| 27734 | To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." | ||
| 27735 | (interactive) | ||
| 27736 | (let (p m tp np dir txt w) | ||
| 27737 | (cond | ||
| 27738 | ((setq p (text-property-any (point-at-bol) (point-at-eol) | ||
| 27739 | 'org-imenu t)) | ||
| 27740 | (setq m (get-text-property p 'org-imenu-marker)) | ||
| 27741 | (save-excursion | ||
| 27742 | (save-restriction | ||
| 27743 | (set-buffer (marker-buffer m)) | ||
| 27744 | (goto-char m) | ||
| 27745 | (org-agenda-set-restriction-lock 'subtree)))) | ||
| 27746 | ((setq p (text-property-any (point-at-bol) (point-at-eol) | ||
| 27747 | 'speedbar-function 'speedbar-find-file)) | ||
| 27748 | (setq tp (previous-single-property-change | ||
| 27749 | (1+ p) 'speedbar-function) | ||
| 27750 | np (next-single-property-change | ||
| 27751 | tp 'speedbar-function) | ||
| 27752 | dir (speedbar-line-directory) | ||
| 27753 | txt (buffer-substring-no-properties (or tp (point-min)) | ||
| 27754 | (or np (point-max)))) | ||
| 27755 | (save-excursion | ||
| 27756 | (save-restriction | ||
| 27757 | (set-buffer (find-file-noselect | ||
| 27758 | (let ((default-directory dir)) | ||
| 27759 | (expand-file-name txt)))) | ||
| 27760 | (unless (org-mode-p) | ||
| 27761 | (error "Cannot restrict to non-Org-mode file")) | ||
| 27762 | (org-agenda-set-restriction-lock 'file)))) | ||
| 27763 | (t (error "Don't know how to restrict Org-mode's agenda"))) | ||
| 27764 | (org-move-overlay org-speedbar-restriction-lock-overlay | ||
| 27765 | (point-at-bol) (point-at-eol)) | ||
| 27766 | (setq current-prefix-arg nil) | ||
| 27767 | (org-agenda-maybe-redo))) | ||
| 27768 | |||
| 27769 | (eval-after-load "speedbar" | ||
| 27770 | '(progn | ||
| 27771 | (speedbar-add-supported-extension ".org") | ||
| 27772 | (define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction) | ||
| 27773 | (define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction) | ||
| 27774 | (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock) | ||
| 27775 | (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) | ||
| 27776 | (add-hook 'speedbar-visiting-tag-hook | ||
| 27777 | (lambda () (org-show-context 'org-goto))))) | ||
| 27778 | |||
| 27779 | |||
| 27780 | ;;; Fixes and Hacks | ||
| 26450 | 27781 | ||
| 26451 | ;; Make flyspell not check words in links, to not mess up our keymap | 27782 | ;; Make flyspell not check words in links, to not mess up our keymap |
| 26452 | (defun org-mode-flyspell-verify () | 27783 | (defun org-mode-flyspell-verify () |
| @@ -26471,6 +27802,13 @@ Show the heading too, if it is currently invisible." | |||
| 26471 | (org-invisible-p))) | 27802 | (org-invisible-p))) |
| 26472 | (org-show-context 'bookmark-jump))) | 27803 | (org-show-context 'bookmark-jump))) |
| 26473 | 27804 | ||
| 27805 | ;; Fix a bug in htmlize where there are text properties (face nil) | ||
| 27806 | (eval-after-load "htmlize" | ||
| 27807 | '(progn | ||
| 27808 | (defadvice htmlize-faces-in-buffer (after org-no-nil-faces activate) | ||
| 27809 | "Make sure there are no nil faces" | ||
| 27810 | (setq ad-return-value (delq nil ad-return-value))))) | ||
| 27811 | |||
| 26474 | ;; Make session.el ignore our circular variable | 27812 | ;; Make session.el ignore our circular variable |
| 26475 | (eval-after-load "session" | 27813 | (eval-after-load "session" |
| 26476 | '(add-to-list 'session-globals-exclude 'org-mark-ring)) | 27814 | '(add-to-list 'session-globals-exclude 'org-mark-ring)) |
| @@ -26479,7 +27817,7 @@ Show the heading too, if it is currently invisible." | |||
| 26479 | 27817 | ||
| 26480 | (defun org-closed-in-range () | 27818 | (defun org-closed-in-range () |
| 26481 | "Sparse tree of items closed in a certain time range. | 27819 | "Sparse tree of items closed in a certain time range. |
| 26482 | Still experimental, may disappear in the furture." | 27820 | Still experimental, may disappear in the future." |
| 26483 | (interactive) | 27821 | (interactive) |
| 26484 | ;; Get the time interval from the user. | 27822 | ;; Get the time interval from the user. |
| 26485 | (let* ((time1 (time-to-seconds | 27823 | (let* ((time1 (time-to-seconds |
| @@ -26498,64 +27836,6 @@ Still experimental, may disappear in the furture." | |||
| 26498 | ;; make tree, check each match with the callback | 27836 | ;; make tree, check each match with the callback |
| 26499 | (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) | 27837 | (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) |
| 26500 | 27838 | ||
| 26501 | (defun org-fill-paragraph-experimental (&optional justify) | ||
| 26502 | "Re-align a table, pass through to fill-paragraph if no table." | ||
| 26503 | (let ((table-p (org-at-table-p)) | ||
| 26504 | (table.el-p (org-at-table.el-p))) | ||
| 26505 | (cond ((equal (char-after (point-at-bol)) ?*) t) ; skip headlines | ||
| 26506 | (table.el-p t) ; skip table.el tables | ||
| 26507 | (table-p (org-table-align) t) ; align org-mode tables | ||
| 26508 | ((save-excursion | ||
| 26509 | (let ((pos (1+ (point-at-eol)))) | ||
| 26510 | (backward-paragraph 1) | ||
| 26511 | (re-search-forward "\\\\\\\\[ \t]*$" pos t))) | ||
| 26512 | (save-excursion | ||
| 26513 | (save-restriction | ||
| 26514 | (narrow-to-region (1+ (match-end 0)) (point-max)) | ||
| 26515 | (fill-paragraph nil) | ||
| 26516 | t))) | ||
| 26517 | (t nil)))) ; call paragraph-fill | ||
| 26518 | |||
| 26519 | ;; FIXME: this needs a much better algorithm | ||
| 26520 | (defun org-assign-fast-keys (alist) | ||
| 26521 | "Assign fast keys to a keyword-key alist. | ||
| 26522 | Respect keys that are already there." | ||
| 26523 | (let (new e k c c1 c2 (char ?a)) | ||
| 26524 | (while (setq e (pop alist)) | ||
| 26525 | (cond | ||
| 26526 | ((equal e '(:startgroup)) (push e new)) | ||
| 26527 | ((equal e '(:endgroup)) (push e new)) | ||
| 26528 | (t | ||
| 26529 | (setq k (car e) c2 nil) | ||
| 26530 | (if (cdr e) | ||
| 26531 | (setq c (cdr e)) | ||
| 26532 | ;; automatically assign a character. | ||
| 26533 | (setq c1 (string-to-char | ||
| 26534 | (downcase (substring | ||
| 26535 | k (if (= (string-to-char k) ?@) 1 0))))) | ||
| 26536 | (if (or (rassoc c1 new) (rassoc c1 alist)) | ||
| 26537 | (while (or (rassoc char new) (rassoc char alist)) | ||
| 26538 | (setq char (1+ char))) | ||
| 26539 | (setq c2 c1)) | ||
| 26540 | (setq c (or c2 char))) | ||
| 26541 | (push (cons k c) new)))) | ||
| 26542 | (nreverse new))) | ||
| 26543 | |||
| 26544 | ;(defcustom org-read-date-prefer-future nil | ||
| 26545 | ; "Non-nil means, when reading an incomplete date from the user, assume future. | ||
| 26546 | ;This affects the following situations: | ||
| 26547 | ;1. The user give a day, but no month. | ||
| 26548 | ; In this case, if the day number if after today, the current month will | ||
| 26549 | ; be used, otherwise the next month. | ||
| 26550 | ;2. The user gives a month but not a year. | ||
| 26551 | ; In this case, the the given month is after the current month, the current | ||
| 26552 | ; year will be used. Otherwise the next year will be used.; | ||
| 26553 | ; | ||
| 26554 | ;When nil, always the current month and year will be used." | ||
| 26555 | ; :group 'org-time ;???? | ||
| 26556 | ; :type 'boolean) | ||
| 26557 | |||
| 26558 | |||
| 26559 | ;;;; Finish up | 27839 | ;;;; Finish up |
| 26560 | 27840 | ||
| 26561 | (provide 'org) | 27841 | (provide 'org) |
| @@ -26565,4 +27845,3 @@ Respect keys that are already there." | |||
| 26565 | ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd | 27845 | ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd |
| 26566 | ;;; org.el ends here | 27846 | ;;; org.el ends here |
| 26567 | 27847 | ||
| 26568 | |||
diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index 2d489eb5896..15fba461fd3 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el | |||
| @@ -1243,8 +1243,9 @@ If the buffer is non-empty, delete the old header first." | |||
| 1243 | (beginning-of-line 2)) | 1243 | (beginning-of-line 2)) |
| 1244 | (while (looking-at "^[ \t]*$") | 1244 | (while (looking-at "^[ \t]*$") |
| 1245 | (beginning-of-line 2)) | 1245 | (beginning-of-line 2)) |
| 1246 | (cond ((fboundp 'zmacs-activate-region) (zmacs-activate-region)) | 1246 | (if (featurep 'xemacs) |
| 1247 | ((boundp 'make-active) (setq mark-active t))) | 1247 | (zmacs-activate-region) |
| 1248 | (setq mark-active t)) | ||
| 1248 | (if (yes-or-no-p "Delete and rebuild header? ") | 1249 | (if (yes-or-no-p "Delete and rebuild header? ") |
| 1249 | (delete-region (point-min) (point)))) | 1250 | (delete-region (point-min) (point)))) |
| 1250 | 1251 | ||
| @@ -1495,8 +1496,9 @@ index the new part without having to go over the unchanged parts again." | |||
| 1495 | (unwind-protect | 1496 | (unwind-protect |
| 1496 | (progn | 1497 | (progn |
| 1497 | ;; Hide the region highlighting | 1498 | ;; Hide the region highlighting |
| 1498 | (cond ((fboundp 'zmacs-deactivate-region) (zmacs-deactivate-region)) | 1499 | (if (featurep 'xemacs) |
| 1499 | ((fboundp 'deactivate-mark) (deactivate-mark))) | 1500 | (zmacs-deactivate-region) |
| 1501 | (deactivate-mark)) | ||
| 1500 | (delete-other-windows) | 1502 | (delete-other-windows) |
| 1501 | (reftex-index-visit-phrases-buffer) | 1503 | (reftex-index-visit-phrases-buffer) |
| 1502 | (reftex-index-all-phrases)) | 1504 | (reftex-index-all-phrases)) |
diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index 0e501fdf23e..e57e9a59a73 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el | |||
| @@ -326,7 +326,7 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help | |||
| 326 | (defun reftex-toc-next (&optional arg) | 326 | (defun reftex-toc-next (&optional arg) |
| 327 | "Move to next selectable item." | 327 | "Move to next selectable item." |
| 328 | (interactive "p") | 328 | (interactive "p") |
| 329 | (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) | 329 | (when (featurep 'xemacs) (setq zmacs-region-stays t)) |
| 330 | (setq reftex-callback-fwd t) | 330 | (setq reftex-callback-fwd t) |
| 331 | (or (eobp) (forward-char 1)) | 331 | (or (eobp) (forward-char 1)) |
| 332 | (goto-char (or (next-single-property-change (point) :data) | 332 | (goto-char (or (next-single-property-change (point) :data) |
| @@ -334,21 +334,21 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help | |||
| 334 | (defun reftex-toc-previous (&optional arg) | 334 | (defun reftex-toc-previous (&optional arg) |
| 335 | "Move to previous selectable item." | 335 | "Move to previous selectable item." |
| 336 | (interactive "p") | 336 | (interactive "p") |
| 337 | (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) | 337 | (when (featurep 'xemacs) (setq zmacs-region-stays t)) |
| 338 | (setq reftex-callback-fwd nil) | 338 | (setq reftex-callback-fwd nil) |
| 339 | (goto-char (or (previous-single-property-change (point) :data) | 339 | (goto-char (or (previous-single-property-change (point) :data) |
| 340 | (point)))) | 340 | (point)))) |
| 341 | (defun reftex-toc-next-heading (&optional arg) | 341 | (defun reftex-toc-next-heading (&optional arg) |
| 342 | "Move to next table of contentes line." | 342 | "Move to next table of contentes line." |
| 343 | (interactive "p") | 343 | (interactive "p") |
| 344 | (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) | 344 | (when (featurep 'xemacs) (setq zmacs-region-stays t)) |
| 345 | (end-of-line) | 345 | (end-of-line) |
| 346 | (re-search-forward "^ " nil t arg) | 346 | (re-search-forward "^ " nil t arg) |
| 347 | (beginning-of-line)) | 347 | (beginning-of-line)) |
| 348 | (defun reftex-toc-previous-heading (&optional arg) | 348 | (defun reftex-toc-previous-heading (&optional arg) |
| 349 | "Move to previous table of contentes line." | 349 | "Move to previous table of contentes line." |
| 350 | (interactive "p") | 350 | (interactive "p") |
| 351 | (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) | 351 | (when (featurep 'xemacs) (setq zmacs-region-stays t)) |
| 352 | (re-search-backward "^ " nil t arg)) | 352 | (re-search-backward "^ " nil t arg)) |
| 353 | (defun reftex-toc-toggle-follow () | 353 | (defun reftex-toc-toggle-follow () |
| 354 | "Toggle follow (other window follows with context)." | 354 | "Toggle follow (other window follows with context)." |
| @@ -637,7 +637,7 @@ point." | |||
| 637 | (if mark-line | 637 | (if mark-line |
| 638 | (progn | 638 | (progn |
| 639 | (set-mark mpos) | 639 | (set-mark mpos) |
| 640 | (if (fboundp 'zmacs-activate-region) | 640 | (if (featurep 'xemacs) |
| 641 | (zmacs-activate-region) | 641 | (zmacs-activate-region) |
| 642 | (setq mark-active t | 642 | (setq mark-active t |
| 643 | deactivate-mark nil))))) | 643 | deactivate-mark nil))))) |
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el index 0790bee55ae..58027f2b478 100644 --- a/lisp/textmodes/remember.el +++ b/lisp/textmodes/remember.el | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | ;;; remember --- a mode for quickly jotting down things to remember | 1 | ;;; remember --- a mode for quickly jotting down things to remember |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1999, 2000, 2001, 2003, 2004, 2005, 2006, | 3 | ;; Copyright (C) 1999, 2000, 2001, 2003, 2004, 2005, 2006, 2007, |
| 4 | ;; 2007 Free Software Foundation, Inc. | 4 | ;; 2008 Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: John Wiegley <johnw@gnu.org> | 6 | ;; Author: John Wiegley <johnw@gnu.org> |
| 7 | ;; Created: 29 Mar 1999 | 7 | ;; Created: 29 Mar 1999 |
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 40e0e85194b..7897fbaa9df 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el | |||
| @@ -157,7 +157,7 @@ This takes effect when first loading the `sgml-mode' library.") | |||
| 157 | "Syntax table used in SGML mode. See also `sgml-specials'.") | 157 | "Syntax table used in SGML mode. See also `sgml-specials'.") |
| 158 | 158 | ||
| 159 | (defconst sgml-tag-syntax-table | 159 | (defconst sgml-tag-syntax-table |
| 160 | (let ((table (sgml-make-syntax-table '(?- ?\" ?\')))) | 160 | (let ((table (sgml-make-syntax-table sgml-specials))) |
| 161 | (dolist (char '(?\( ?\) ?\{ ?\} ?\[ ?\] ?$ ?% ?& ?* ?+ ?/)) | 161 | (dolist (char '(?\( ?\) ?\{ ?\} ?\[ ?\] ?$ ?% ?& ?* ?+ ?/)) |
| 162 | (modify-syntax-entry char "." table)) | 162 | (modify-syntax-entry char "." table)) |
| 163 | table) | 163 | table) |
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 3890daabf46..3a70b5343a0 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog | |||
| @@ -1,3 +1,16 @@ | |||
| 1 | 2008-01-29 John Wiegley <johnw@newartisans.com> | ||
| 2 | |||
| 3 | * url-auth.el (url-digest-auth): If the 'opaque' argument is not | ||
| 4 | being used, don't add it to the response text. Also, changed an | ||
| 5 | if so that the interaction between the PROMPT and OVERWRITE | ||
| 6 | arguments can no longer result in the user being queried twice for | ||
| 7 | the same login and password information. | ||
| 8 | |||
| 9 | 2008-01-21 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 10 | |||
| 11 | * url-handlers.el (unhandled-file-name-directory): Add handler. | ||
| 12 | (url-handler-unhandled-file-name-directory): New fun. | ||
| 13 | |||
| 1 | 2008-01-07 Michael Albinus <michael.albinus@gmx.de> | 14 | 2008-01-07 Michael Albinus <michael.albinus@gmx.de> |
| 2 | 15 | ||
| 3 | * url-handlers.el (url-file-handler): Autoload. | 16 | * url-handlers.el (url-file-handler): Autoload. |
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el index ea96bb08129..ed1a79260ee 100644 --- a/lisp/url/url-auth.el +++ b/lisp/url/url-auth.el | |||
| @@ -188,31 +188,40 @@ instead of hostname:portnum." | |||
| 188 | (string= data (substring file 0 (length data))))) | 188 | (string= data (substring file 0 (length data))))) |
| 189 | (setq retval (cdr (car byserv)))) | 189 | (setq retval (cdr (car byserv)))) |
| 190 | (setq byserv (cdr byserv)))) | 190 | (setq byserv (cdr byserv)))) |
| 191 | (if (or (and (not retval) prompt) overwrite) | 191 | (if overwrite |
| 192 | (progn | 192 | (if (and (not retval) prompt) |
| 193 | (setq user (read-string (url-auth-user-prompt url realm) | 193 | (setq user (read-string (url-auth-user-prompt url realm) |
| 194 | (user-real-login-name)) | 194 | (user-real-login-name)) |
| 195 | pass (read-passwd "Password: ") | 195 | pass (read-passwd "Password: ") |
| 196 | retval (setq retval | 196 | retval (setq retval |
| 197 | (cons user | 197 | (cons user |
| 198 | (url-digest-auth-create-key | 198 | (url-digest-auth-create-key |
| 199 | user pass realm | 199 | user pass realm |
| 200 | (or url-request-method "GET") | 200 | (or url-request-method "GET") |
| 201 | url))) | 201 | url))) |
| 202 | byserv (assoc server url-digest-auth-storage)) | 202 | byserv (assoc server url-digest-auth-storage)) |
| 203 | (setcdr byserv | 203 | (setcdr byserv |
| 204 | (cons (cons file retval) (cdr byserv)))))) | 204 | (cons (cons file retval) (cdr byserv)))))) |
| 205 | (t (setq retval nil))) | 205 | (t (setq retval nil))) |
| 206 | (if retval | 206 | (if retval |
| 207 | (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven")) | 207 | (if (cdr-safe (assoc "opaque" args)) |
| 208 | (opaque (or (cdr-safe (assoc "opaque" args)) "nonegiven"))) | 208 | (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven")) |
| 209 | (format | 209 | (opaque (cdr-safe (assoc "opaque" args)))) |
| 210 | (concat "Digest username=\"%s\", realm=\"%s\"," | 210 | (format |
| 211 | "nonce=\"%s\", uri=\"%s\"," | 211 | (concat "Digest username=\"%s\", realm=\"%s\"," |
| 212 | "response=\"%s\", opaque=\"%s\"") | 212 | "nonce=\"%s\", uri=\"%s\"," |
| 213 | (nth 0 retval) realm nonce (url-filename href) | 213 | "response=\"%s\", opaque=\"%s\"") |
| 214 | (md5 (concat (nth 1 retval) ":" nonce ":" | 214 | (nth 0 retval) realm nonce (url-filename href) |
| 215 | (nth 2 retval))) opaque)))))) | 215 | (md5 (concat (nth 1 retval) ":" nonce ":" |
| 216 | (nth 2 retval))) opaque)) | ||
| 217 | (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven"))) | ||
| 218 | (format | ||
| 219 | (concat "Digest username=\"%s\", realm=\"%s\"," | ||
| 220 | "nonce=\"%s\", uri=\"%s\"," | ||
| 221 | "response=\"%s\"") | ||
| 222 | (nth 0 retval) realm nonce (url-filename href) | ||
| 223 | (md5 (concat (nth 1 retval) ":" nonce ":" | ||
| 224 | (nth 2 retval)))))))))) | ||
| 216 | 225 | ||
| 217 | (defvar url-registered-auth-schemes nil | 226 | (defvar url-registered-auth-schemes nil |
| 218 | "A list of the registered authorization schemes and various and sundry | 227 | "A list of the registered authorization schemes and various and sundry |
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 869132df93f..acc85b939a1 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el | |||
| @@ -150,6 +150,7 @@ the arguments that would have been passed to OPERATION." | |||
| 150 | (put 'file-name-absolute-p 'url-file-handlers (lambda (&rest ignored) t)) | 150 | (put 'file-name-absolute-p 'url-file-handlers (lambda (&rest ignored) t)) |
| 151 | (put 'expand-file-name 'url-file-handlers 'url-handler-expand-file-name) | 151 | (put 'expand-file-name 'url-file-handlers 'url-handler-expand-file-name) |
| 152 | (put 'directory-file-name 'url-file-handlers 'url-handler-directory-file-name) | 152 | (put 'directory-file-name 'url-file-handlers 'url-handler-directory-file-name) |
| 153 | (put 'unhandled-file-name-directory 'url-file-handlers 'url-handler-unhandled-file-name-directory) | ||
| 153 | ;; (put 'file-name-as-directory 'url-file-handlers 'url-handler-file-name-as-directory) | 154 | ;; (put 'file-name-as-directory 'url-file-handlers 'url-handler-file-name-as-directory) |
| 154 | 155 | ||
| 155 | ;; These are operations that we do not support yet (DAV!!!) | 156 | ;; These are operations that we do not support yet (DAV!!!) |
| @@ -181,6 +182,13 @@ the arguments that would have been passed to OPERATION." | |||
| 181 | (if (string-match "//\\'" dir) dir | 182 | (if (string-match "//\\'" dir) dir |
| 182 | (url-run-real-handler 'directory-file-name (list dir)))) | 183 | (url-run-real-handler 'directory-file-name (list dir)))) |
| 183 | 184 | ||
| 185 | (defun url-handler-unhandled-file-name-directory (filename) | ||
| 186 | ;; Copied from tramp.el. This is used as the cwd for subprocesses: | ||
| 187 | ;; without it running call-process or start-process in a URL directory | ||
| 188 | ;; signals an error. | ||
| 189 | ;; FIXME: we can do better if `filename' is a "file://" URL. | ||
| 190 | (expand-file-name "~/")) | ||
| 191 | |||
| 184 | ;; The actual implementation | 192 | ;; The actual implementation |
| 185 | ;;;###autoload | 193 | ;;;###autoload |
| 186 | (defun url-copy-file (url newname &optional ok-if-already-exists keep-time) | 194 | (defun url-copy-file (url newname &optional ok-if-already-exists keep-time) |
diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index f47ff9a37c3..7d09150d52c 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el | |||
| @@ -77,9 +77,9 @@ | |||
| 77 | 77 | ||
| 78 | ;;;###autoload | 78 | ;;;###autoload |
| 79 | (defun url-generic-parse-url (url) | 79 | (defun url-generic-parse-url (url) |
| 80 | "Return a vector of the parts of URL. | 80 | "Return an URL-struct of the parts of URL. |
| 81 | Format is: | 81 | The CL-style struct contains the following fields: |
| 82 | \[TYPE USER PASSWORD HOST PORT FILE TARGET ATTRIBUTES FULL\]" | 82 | TYPE USER PASSWORD HOST PORTSPEC FILENAME TARGET ATTRIBUTES FULLNESS." |
| 83 | ;; See RFC 3986. | 83 | ;; See RFC 3986. |
| 84 | (cond | 84 | (cond |
| 85 | ((null url) | 85 | ((null url) |
diff --git a/lisp/vc-arch.el b/lisp/vc-arch.el index 284fe032a25..58a3bd0183d 100644 --- a/lisp/vc-arch.el +++ b/lisp/vc-arch.el | |||
| @@ -347,9 +347,11 @@ Return non-nil if FILE is unchanged." | |||
| 347 | (save-excursion | 347 | (save-excursion |
| 348 | (let ((rej (concat buffer-file-name ".rej"))) | 348 | (let ((rej (concat buffer-file-name ".rej"))) |
| 349 | (when (and buffer-file-name (vc-arch-diff3-rej-p rej)) | 349 | (when (and buffer-file-name (vc-arch-diff3-rej-p rej)) |
| 350 | (if (not (re-search-forward "^<<<<<<< " nil t)) | 350 | (unless (re-search-forward "^<<<<<<< " nil t) |
| 351 | ;; The .rej file is obsolete. | 351 | ;; The .rej file is obsolete. |
| 352 | (condition-case nil (delete-file rej) (error nil))))))) | 352 | (condition-case nil (delete-file rej) (error nil)) |
| 353 | ;; Remove the hook so that it is not called multiple times. | ||
| 354 | (remove-hook 'after-save-hook 'vc-arch-delete-rej-if-obsolete t)))))) | ||
| 353 | 355 | ||
| 354 | (defun vc-arch-find-file-hook () | 356 | (defun vc-arch-find-file-hook () |
| 355 | (let ((rej (concat buffer-file-name ".rej"))) | 357 | (let ((rej (concat buffer-file-name ".rej"))) |
diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el index d84c2839573..cc4cd47cfe7 100644 --- a/lisp/vc-cvs.el +++ b/lisp/vc-cvs.el | |||
| @@ -453,7 +453,7 @@ The changes are between FIRST-REVISION and SECOND-REVISION." | |||
| 453 | (message "Merging changes into %s..." file) | 453 | (message "Merging changes into %s..." file) |
| 454 | ;; (vc-file-setprop file 'vc-working-revision nil) | 454 | ;; (vc-file-setprop file 'vc-working-revision nil) |
| 455 | (vc-file-setprop file 'vc-checkout-time 0) | 455 | (vc-file-setprop file 'vc-checkout-time 0) |
| 456 | (vc-cvs-command nil 0 file "update") | 456 | (vc-cvs-command nil nil file "update") |
| 457 | ;; Analyze the merge result reported by CVS, and set | 457 | ;; Analyze the merge result reported by CVS, and set |
| 458 | ;; file properties accordingly. | 458 | ;; file properties accordingly. |
| 459 | (with-current-buffer (get-buffer "*vc*") | 459 | (with-current-buffer (get-buffer "*vc*") |
diff --git a/lisp/vc-hg.el b/lisp/vc-hg.el index 597c49aaa3f..4bcffebd3cb 100644 --- a/lisp/vc-hg.el +++ b/lisp/vc-hg.el | |||
| @@ -149,7 +149,7 @@ | |||
| 149 | (when (vc-hg-root file) ; short cut | 149 | (when (vc-hg-root file) ; short cut |
| 150 | (let ((state (vc-hg-state file))) ; expensive | 150 | (let ((state (vc-hg-state file))) ; expensive |
| 151 | (vc-file-setprop file 'vc-state state) | 151 | (vc-file-setprop file 'vc-state state) |
| 152 | (not (memq state '(ignored unregistered)))))) | 152 | (and state (not (memq state '(ignored unregistered))))))) |
| 153 | 153 | ||
| 154 | (defun vc-hg-state (file) | 154 | (defun vc-hg-state (file) |
| 155 | "Hg-specific version of `vc-state'." | 155 | "Hg-specific version of `vc-state'." |
| @@ -316,8 +316,7 @@ | |||
| 316 | (if oldvers | 316 | (if oldvers |
| 317 | (if newvers | 317 | (if newvers |
| 318 | (list "-r" oldvers "-r" newvers) | 318 | (list "-r" oldvers "-r" newvers) |
| 319 | (list "-r" oldvers)) | 319 | (list "-r" oldvers))))))) |
| 320 | (list "")))))) | ||
| 321 | 320 | ||
| 322 | (defun vc-hg-revision-table (files) | 321 | (defun vc-hg-revision-table (files) |
| 323 | (let ((default-directory (file-name-directory (car files)))) | 322 | (let ((default-directory (file-name-directory (car files)))) |
| @@ -480,35 +479,41 @@ REV is the revision to check out into WORKFILE." | |||
| 480 | 479 | ||
| 481 | (define-derived-mode vc-hg-incoming-mode vc-hg-log-view-mode "Hg-Incoming") | 480 | (define-derived-mode vc-hg-incoming-mode vc-hg-log-view-mode "Hg-Incoming") |
| 482 | 481 | ||
| 483 | |||
| 484 | ;; XXX Experimental function for the vc-dired replacement. | 482 | ;; XXX Experimental function for the vc-dired replacement. |
| 485 | (defun vc-hg-dir-status (dir) | 483 | (defun vc-hg-after-dir-status (update-function buff) |
| 486 | "Return a list of conses (file . state) for DIR." | 484 | (let ((status-char nil) |
| 487 | (with-temp-buffer | 485 | (file nil) |
| 488 | (vc-hg-command (current-buffer) nil dir "status" "-A") | 486 | (translation '((?= . up-to-date) |
| 489 | (goto-char (point-min)) | 487 | (?C . up-to-date) |
| 490 | (let ((status-char nil) | 488 | (?A . added) |
| 491 | (file nil) | 489 | (?R . removed) |
| 492 | (translation '((?= . up-to-date) | 490 | (?M . edited) |
| 493 | (?C . up-to-date) | 491 | (?I . ignored) |
| 494 | (?A . added) | 492 | (?! . deleted) |
| 495 | (?R . removed) | 493 | (?? . unregistered))) |
| 496 | (?M . edited) | 494 | (translated nil) |
| 497 | (?I . ignored) | ||
| 498 | (?! . deleted) | ||
| 499 | (?? . unregistered))) | ||
| 500 | (translated nil) | ||
| 501 | (result nil)) | 495 | (result nil)) |
| 496 | (goto-char (point-min)) | ||
| 502 | (while (not (eobp)) | 497 | (while (not (eobp)) |
| 503 | (setq status-char (char-after)) | 498 | (setq status-char (char-after)) |
| 504 | (setq file | 499 | (setq file |
| 505 | (buffer-substring-no-properties (+ (point) 2) | 500 | (buffer-substring-no-properties (+ (point) 2) |
| 506 | (line-end-position))) | 501 | (line-end-position))) |
| 507 | (setq translated (assoc status-char translation)) | 502 | (setq translated (assoc status-char translation)) |
| 508 | (when (and translated (not (eq (cdr translated) 'up-to-date))) | 503 | (when (and translated (not (eq (cdr translated) 'up-to-date))) |
| 509 | (push (cons file (cdr translated)) result)) | 504 | (push (cons file (cdr translated)) result)) |
| 510 | (forward-line)) | 505 | (forward-line)) |
| 511 | result))) | 506 | (funcall update-function result buff))) |
| 507 | |||
| 508 | ;; XXX Experimental function for the vc-dired replacement. | ||
| 509 | (defun vc-hg-dir-status (dir update-function status-buffer) | ||
| 510 | "Return a list of conses (file . state) for DIR." | ||
| 511 | (with-current-buffer | ||
| 512 | (get-buffer-create | ||
| 513 | (expand-file-name " *VC-hg* tmp status" dir)) | ||
| 514 | (vc-hg-command (current-buffer) 'async dir "status") | ||
| 515 | (vc-exec-after | ||
| 516 | `(vc-hg-after-dir-status (quote ,update-function) ,status-buffer)))) | ||
| 512 | 517 | ||
| 513 | ;; XXX this adds another top level menu, instead figure out how to | 518 | ;; XXX this adds another top level menu, instead figure out how to |
| 514 | ;; replace the Log-View menu. | 519 | ;; replace the Log-View menu. |
diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el index f50d5ab5dee..868680375cb 100644 --- a/lisp/vc-svn.el +++ b/lisp/vc-svn.el | |||
| @@ -132,7 +132,8 @@ If you want to force an empty list of arguments, use t." | |||
| 132 | ;; an `error' by vc-do-command. | 132 | ;; an `error' by vc-do-command. |
| 133 | (error nil)))) | 133 | (error nil)))) |
| 134 | (when (eq 0 status) | 134 | (when (eq 0 status) |
| 135 | (vc-svn-parse-status file)))))) | 135 | (let ((parsed (vc-svn-parse-status file))) |
| 136 | (and parsed (not (memq parsed '(ignored unregistered)))))))))) | ||
| 136 | 137 | ||
| 137 | (defun vc-svn-state (file &optional localp) | 138 | (defun vc-svn-state (file &optional localp) |
| 138 | "SVN-specific version of `vc-state'." | 139 | "SVN-specific version of `vc-state'." |
| @@ -157,6 +158,35 @@ If you want to force an empty list of arguments, use t." | |||
| 157 | (vc-svn-command t 0 nil "status" (if localp "-v" "-u")) | 158 | (vc-svn-command t 0 nil "status" (if localp "-v" "-u")) |
| 158 | (vc-svn-parse-status)))) | 159 | (vc-svn-parse-status)))) |
| 159 | 160 | ||
| 161 | (defun vc-svn-after-dir-status (callback buffer) | ||
| 162 | (let ((state-map '((?A . added) | ||
| 163 | (?C . edited) | ||
| 164 | (?D . removed) | ||
| 165 | (?I . ignored) | ||
| 166 | (?M . edited) | ||
| 167 | (?R . removed) | ||
| 168 | (?? . unregistered) | ||
| 169 | ;; This is what vc-svn-parse-status does. | ||
| 170 | (?~ . edited))) | ||
| 171 | result) | ||
| 172 | (goto-char (point-min)) | ||
| 173 | (while (re-search-forward "^\\(.\\)..... \\(.*\\)$" nil t) | ||
| 174 | (let ((state (cdr (assq (aref (match-string 1) 0) state-map))) | ||
| 175 | (filename (match-string 2))) | ||
| 176 | (when state | ||
| 177 | (setq result (cons (cons filename state) result))))) | ||
| 178 | (funcall callback result buffer))) | ||
| 179 | |||
| 180 | (defun vc-svn-dir-status (dir callback buffer) | ||
| 181 | "Run 'svn status' for DIR and update BUFFER via CALLBACK. | ||
| 182 | CALLBACK is called as (CALLBACK RESULT BUFFER), where | ||
| 183 | RESULT is a list of conses (FILE . STATE) for directory DIR." | ||
| 184 | (with-current-buffer (get-buffer-create | ||
| 185 | (generate-new-buffer-name " *vc svn status*")) | ||
| 186 | (vc-svn-command (current-buffer) 'async nil "status") | ||
| 187 | (vc-exec-after | ||
| 188 | `(vc-svn-after-dir-status (quote ,callback) ,buffer)))) | ||
| 189 | |||
| 160 | (defun vc-svn-working-revision (file) | 190 | (defun vc-svn-working-revision (file) |
| 161 | "SVN-specific version of `vc-working-revision'." | 191 | "SVN-specific version of `vc-working-revision'." |
| 162 | ;; There is no need to consult RCS headers under SVN, because we | 192 | ;; There is no need to consult RCS headers under SVN, because we |
| @@ -537,8 +567,10 @@ and that it passes `vc-svn-global-switches' to it before FLAGS." | |||
| 537 | "Call \"svn resolved\" if the conflict markers have been removed." | 567 | "Call \"svn resolved\" if the conflict markers have been removed." |
| 538 | (save-excursion | 568 | (save-excursion |
| 539 | (goto-char (point-min)) | 569 | (goto-char (point-min)) |
| 540 | (if (not (re-search-forward "^<<<<<<< " nil t)) | 570 | (unless (re-search-forward "^<<<<<<< " nil t) |
| 541 | (vc-svn-command nil 0 buffer-file-name "resolved")))) | 571 | (vc-svn-command nil 0 buffer-file-name "resolved") |
| 572 | ;; Remove the hook so that it is not called multiple times. | ||
| 573 | (remove-hook 'after-save-hook 'vc-svn-resolve-when-done t)))) | ||
| 542 | 574 | ||
| 543 | ;; Inspired by vc-arch-find-file-hook. | 575 | ;; Inspired by vc-arch-find-file-hook. |
| 544 | (defun vc-svn-find-file-hook () | 576 | (defun vc-svn-find-file-hook () |
| @@ -550,7 +582,7 @@ and that it passes `vc-svn-global-switches' to it before FLAGS." | |||
| 550 | (re-search-forward "^<<<<<<< " nil t)) | 582 | (re-search-forward "^<<<<<<< " nil t)) |
| 551 | ;; There are conflict markers. | 583 | ;; There are conflict markers. |
| 552 | (progn | 584 | (progn |
| 553 | (smerge-mode 1) | 585 | (smerge-start-session) |
| 554 | (add-hook 'after-save-hook 'vc-svn-resolve-when-done nil t)) | 586 | (add-hook 'after-save-hook 'vc-svn-resolve-when-done nil t)) |
| 555 | ;; There are no conflict markers. This is problematic: maybe it means | 587 | ;; There are no conflict markers. This is problematic: maybe it means |
| 556 | ;; the conflict has been resolved and we should immediately call "svn | 588 | ;; the conflict has been resolved and we should immediately call "svn |
diff --git a/lisp/vc.el b/lisp/vc.el index 61a2c67d9d4..102eeef0fbf 100644 --- a/lisp/vc.el +++ b/lisp/vc.el | |||
| @@ -1,14 +1,13 @@ | |||
| 1 | ;;; vc.el --- drive a version-control system from within Emacs | 1 | ;;; vc.el --- drive a version-control system from within Emacs |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, | 3 | ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, |
| 4 | ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. | 4 | ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 |
| 5 | ;; Free Software Foundation, Inc. | ||
| 5 | 6 | ||
| 6 | ;; Author: FSF (see below for full credits) | 7 | ;; Author: FSF (see below for full credits) |
| 7 | ;; Maintainer: Andre Spiegel <spiegel@gnu.org> | 8 | ;; Maintainer: Andre Spiegel <spiegel@gnu.org> |
| 8 | ;; Keywords: tools | 9 | ;; Keywords: tools |
| 9 | 10 | ||
| 10 | ;; $Id$ | ||
| 11 | |||
| 12 | ;; This file is part of GNU Emacs. | 11 | ;; This file is part of GNU Emacs. |
| 13 | 12 | ||
| 14 | ;; GNU Emacs is free software; you can redistribute it and/or modify | 13 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| @@ -522,6 +521,55 @@ | |||
| 522 | ;; to your backend and which does not map to any of the VC generic | 521 | ;; to your backend and which does not map to any of the VC generic |
| 523 | ;; concepts. | 522 | ;; concepts. |
| 524 | 523 | ||
| 524 | ;;; Todo: | ||
| 525 | |||
| 526 | ;; - Make vc-checkin avoid reverting the buffer if has not changed | ||
| 527 | ;; after the checkin. Comparing (md5 BUFFER) to (md5 FILE) should | ||
| 528 | ;; be enough. | ||
| 529 | ;; | ||
| 530 | ;; - vc-update/vc-merge should deal with VC systems that don't | ||
| 531 | ;; update/merge on a file basis, but on a whole repository basis. | ||
| 532 | ;; | ||
| 533 | ;; - the backend sometimes knows when a file it opens has been marked | ||
| 534 | ;; by the VCS as having a "conflict". Find a way to pass this info - | ||
| 535 | ;; to VC so that it can turn on smerge-mode when opening such a | ||
| 536 | ;; file. | ||
| 537 | ;; | ||
| 538 | ;; - the *VC-log* buffer needs font-locking. | ||
| 539 | ;; | ||
| 540 | ;; - make it easier to write logs, maybe C-x 4 a should add to the log | ||
| 541 | ;; buffer if there's one instead of the ChangeLog. | ||
| 542 | ;; | ||
| 543 | ;; - make vc-state for all backends return 'unregistered instead of | ||
| 544 | ;; nil for unregistered files, then update vc-next-action. | ||
| 545 | ;; | ||
| 546 | ;; - add a generic mechanism for remembering the current branch names, | ||
| 547 | ;; display the branch name in the mode-line. Replace | ||
| 548 | ;; vc-cvs-sticky-tag with that. | ||
| 549 | ;; | ||
| 550 | ;; - vc-register should register a fileset at a time. The backends | ||
| 551 | ;; already support this, only the front-end needs to be change to | ||
| 552 | ;; handle multiple files at a time. | ||
| 553 | ;; | ||
| 554 | ;; - add a mechanism to for ignoring files. | ||
| 555 | ;; | ||
| 556 | ;; - deal with push/pull operations. | ||
| 557 | ;; | ||
| 558 | ;; - decide if vc-status should replace vc-dired. | ||
| 559 | ;; | ||
| 560 | ;; - vc-status needs a menu, mouse bindings and some color bling. | ||
| 561 | ;; | ||
| 562 | ;; - vc-status needs to show missing files. It probably needs to have | ||
| 563 | ;; another state for those files. The user might want to restore | ||
| 564 | ;; them, or remove them from the VCS. C-x v v might also need | ||
| 565 | ;; adjustments. | ||
| 566 | ;; | ||
| 567 | ;; - "snapshots" should be renamed to "branches", and thoroughly reworked. | ||
| 568 | ;; | ||
| 569 | ;; - do not default to RCS anymore when the current directory is not | ||
| 570 | ;; controlled by any VCS and the user does C-x v v | ||
| 571 | ;; | ||
| 572 | |||
| 525 | ;;; Code: | 573 | ;;; Code: |
| 526 | 574 | ||
| 527 | (require 'vc-hooks) | 575 | (require 'vc-hooks) |
| @@ -907,13 +955,15 @@ However, before executing BODY, find FILE, and after BODY, save buffer." | |||
| 907 | "An alternative output filter for async process P. | 955 | "An alternative output filter for async process P. |
| 908 | One difference with the default filter is that this inserts S after markers. | 956 | One difference with the default filter is that this inserts S after markers. |
| 909 | Another is that undo information is not kept." | 957 | Another is that undo information is not kept." |
| 910 | (with-current-buffer (process-buffer p) | 958 | (let ((buffer (process-buffer p))) |
| 911 | (save-excursion | 959 | (when (buffer-live-p buffer) |
| 912 | (let ((buffer-undo-list t) | 960 | (with-current-buffer buffer |
| 913 | (inhibit-read-only t)) | 961 | (save-excursion |
| 914 | (goto-char (process-mark p)) | 962 | (let ((buffer-undo-list t) |
| 915 | (insert s) | 963 | (inhibit-read-only t)) |
| 916 | (set-marker (process-mark p) (point)))))) | 964 | (goto-char (process-mark p)) |
| 965 | (insert s) | ||
| 966 | (set-marker (process-mark p) (point)))))))) | ||
| 917 | 967 | ||
| 918 | (defun vc-setup-buffer (&optional buf) | 968 | (defun vc-setup-buffer (&optional buf) |
| 919 | "Prepare BUF for executing a VC command and make it current. | 969 | "Prepare BUF for executing a VC command and make it current. |
| @@ -934,29 +984,39 @@ BUF defaults to \"*vc*\", can be a string and will be created if necessary." | |||
| 934 | (defvar vc-sentinel-movepoint) ;Dynamically scoped. | 984 | (defvar vc-sentinel-movepoint) ;Dynamically scoped. |
| 935 | 985 | ||
| 936 | (defun vc-process-sentinel (p s) | 986 | (defun vc-process-sentinel (p s) |
| 937 | (let ((previous (process-get p 'vc-previous-sentinel))) | 987 | (let ((previous (process-get p 'vc-previous-sentinel)) |
| 938 | (if previous (funcall previous p s)) | 988 | (buf (process-buffer p))) |
| 939 | (with-current-buffer (process-buffer p) | 989 | ;; Impatient users sometime kill "slow" buffers; check liveness |
| 940 | (let (vc-sentinel-movepoint) | 990 | ;; to avoid "error in process sentinel: Selecting deleted buffer". |
| 941 | ;; Normally, we want async code such as sentinels to not move point. | 991 | (when (buffer-live-p buf) |
| 942 | (save-excursion | 992 | (if previous (funcall previous p s)) |
| 943 | (goto-char (process-mark p)) | 993 | (with-current-buffer buf |
| 944 | (let ((cmds (process-get p 'vc-sentinel-commands))) | 994 | (setq mode-line-process |
| 945 | (process-put p 'vc-sentinel-commands nil) | 995 | (let ((status (process-status p))) |
| 946 | (dolist (cmd cmds) | 996 | ;; Leave mode-line uncluttered, normally. |
| 947 | ;; Each sentinel may move point and the next one should be run | 997 | ;; (Let known any weirdness in-form-ally. ;-) --ttn |
| 948 | ;; at that new point. We could get the same result by having | 998 | (unless (eq 'exit status) |
| 949 | ;; each sentinel read&set process-mark, but since `cmd' needs | 999 | (format " (%s)" status)))) |
| 950 | ;; to work both for async and sync processes, this would be | 1000 | (let (vc-sentinel-movepoint) |
| 951 | ;; difficult to achieve. | 1001 | ;; Normally, we want async code such as sentinels to not move point. |
| 952 | (vc-exec-after cmd)))) | 1002 | (save-excursion |
| 953 | ;; But sometimes the sentinels really want to move point. | 1003 | (goto-char (process-mark p)) |
| 954 | (if vc-sentinel-movepoint | 1004 | (let ((cmds (process-get p 'vc-sentinel-commands))) |
| 955 | (let ((win (get-buffer-window (current-buffer) 0))) | 1005 | (process-put p 'vc-sentinel-commands nil) |
| 956 | (if (not win) | 1006 | (dolist (cmd cmds) |
| 957 | (goto-char vc-sentinel-movepoint) | 1007 | ;; Each sentinel may move point and the next one should be run |
| 958 | (with-selected-window win | 1008 | ;; at that new point. We could get the same result by having |
| 959 | (goto-char vc-sentinel-movepoint))))))))) | 1009 | ;; each sentinel read&set process-mark, but since `cmd' needs |
| 1010 | ;; to work both for async and sync processes, this would be | ||
| 1011 | ;; difficult to achieve. | ||
| 1012 | (vc-exec-after cmd)))) | ||
| 1013 | ;; But sometimes the sentinels really want to move point. | ||
| 1014 | (if vc-sentinel-movepoint | ||
| 1015 | (let ((win (get-buffer-window (current-buffer) 0))) | ||
| 1016 | (if (not win) | ||
| 1017 | (goto-char vc-sentinel-movepoint) | ||
| 1018 | (with-selected-window win | ||
| 1019 | (goto-char vc-sentinel-movepoint)))))))))) | ||
| 960 | 1020 | ||
| 961 | (defun vc-exec-after (code) | 1021 | (defun vc-exec-after (code) |
| 962 | "Eval CODE when the current buffer's process is done. | 1022 | "Eval CODE when the current buffer's process is done. |
| @@ -975,6 +1035,17 @@ Else, add CODE to the process' sentinel." | |||
| 975 | (eval code)) | 1035 | (eval code)) |
| 976 | ;; If a process is running, add CODE to the sentinel | 1036 | ;; If a process is running, add CODE to the sentinel |
| 977 | ((eq (process-status proc) 'run) | 1037 | ((eq (process-status proc) 'run) |
| 1038 | (setq mode-line-process | ||
| 1039 | ;; Deliberate overstatement, but power law respected. | ||
| 1040 | ;; (The message is ephemeral, so we make it loud.) --ttn | ||
| 1041 | (propertize " (incomplete/in progress)" | ||
| 1042 | 'face (if (featurep 'compile) | ||
| 1043 | ;; ttn's preferred loudness | ||
| 1044 | 'compilation-warning | ||
| 1045 | ;; suitably available fallback | ||
| 1046 | font-lock-warning-face) | ||
| 1047 | 'help-echo | ||
| 1048 | "A VC command is in progress in this buffer")) | ||
| 978 | (let ((previous (process-sentinel proc))) | 1049 | (let ((previous (process-sentinel proc))) |
| 979 | (unless (eq previous 'vc-process-sentinel) | 1050 | (unless (eq previous 'vc-process-sentinel) |
| 980 | (process-put proc 'vc-previous-sentinel previous)) | 1051 | (process-put proc 'vc-previous-sentinel previous)) |
| @@ -1276,9 +1347,12 @@ Otherwise, throw an error." | |||
| 1276 | (unless (eq (vc-backend f) firstbackend) | 1347 | (unless (eq (vc-backend f) firstbackend) |
| 1277 | (error "All members of a fileset must be under the same version-control system.")))) | 1348 | (error "All members of a fileset must be under the same version-control system.")))) |
| 1278 | marked)) | 1349 | marked)) |
| 1279 | ((eq major-mode 'vc-status-mode) | 1350 | ((eq major-mode 'vc-status-mode) |
| 1280 | (vc-status-marked-files)) | 1351 | (let ((marked (vc-status-marked-files))) |
| 1281 | ((vc-backend buffer-file-name) | 1352 | (if marked |
| 1353 | marked | ||
| 1354 | (list (vc-status-current-file))))) | ||
| 1355 | ((vc-backend buffer-file-name) | ||
| 1282 | (list buffer-file-name)) | 1356 | (list buffer-file-name)) |
| 1283 | ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer) | 1357 | ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer) |
| 1284 | (with-current-buffer vc-parent-buffer | 1358 | (with-current-buffer vc-parent-buffer |
| @@ -1307,8 +1381,12 @@ Otherwise, throw an error." | |||
| 1307 | 1381 | ||
| 1308 | (defun vc-ensure-vc-buffer () | 1382 | (defun vc-ensure-vc-buffer () |
| 1309 | "Make sure that the current buffer visits a version-controlled file." | 1383 | "Make sure that the current buffer visits a version-controlled file." |
| 1310 | (if vc-dired-mode | 1384 | (cond |
| 1311 | (set-buffer (find-file-noselect (dired-get-filename))) | 1385 | (vc-dired-mode |
| 1386 | (set-buffer (find-file-noselect (dired-get-filename)))) | ||
| 1387 | ((eq major-mode 'vc-status-mode) | ||
| 1388 | (set-buffer (find-file-noselect (vc-status-current-file)))) | ||
| 1389 | (t | ||
| 1312 | (while (and vc-parent-buffer | 1390 | (while (and vc-parent-buffer |
| 1313 | (buffer-live-p vc-parent-buffer) | 1391 | (buffer-live-p vc-parent-buffer) |
| 1314 | ;; Avoid infinite looping when vc-parent-buffer and | 1392 | ;; Avoid infinite looping when vc-parent-buffer and |
| @@ -1318,7 +1396,7 @@ Otherwise, throw an error." | |||
| 1318 | (if (not buffer-file-name) | 1396 | (if (not buffer-file-name) |
| 1319 | (error "Buffer %s is not associated with a file" (buffer-name)) | 1397 | (error "Buffer %s is not associated with a file" (buffer-name)) |
| 1320 | (if (not (vc-backend buffer-file-name)) | 1398 | (if (not (vc-backend buffer-file-name)) |
| 1321 | (error "File %s is not under version control" buffer-file-name))))) | 1399 | (error "File %s is not under version control" buffer-file-name)))))) |
| 1322 | 1400 | ||
| 1323 | ;;; Support for the C-x v v command. This is where all the single-file-oriented | 1401 | ;;; Support for the C-x v v command. This is where all the single-file-oriented |
| 1324 | ;;; code from before the fileset rewrite lives. | 1402 | ;;; code from before the fileset rewrite lives. |
| @@ -1404,9 +1482,9 @@ merge in the changes into your working copy." | |||
| 1404 | revision) | 1482 | revision) |
| 1405 | ;; Verify that the fileset is homogenous | 1483 | ;; Verify that the fileset is homogenous |
| 1406 | (dolist (file (cdr files)) | 1484 | (dolist (file (cdr files)) |
| 1407 | (if (not (vc-compatible-state (vc-state file) state)) | 1485 | (unless (vc-compatible-state (vc-state file) state) |
| 1408 | (error "Fileset is in a mixed-up state")) | 1486 | (error "Fileset is in a mixed-up state")) |
| 1409 | (if (not (eq (vc-checkout-model file) model)) | 1487 | (unless (eq (vc-checkout-model file) model) |
| 1410 | (error "Fileset has mixed checkout models"))) | 1488 | (error "Fileset has mixed checkout models"))) |
| 1411 | ;; Check for buffers in the fileset not matching the on-disk contents. | 1489 | ;; Check for buffers in the fileset not matching the on-disk contents. |
| 1412 | (dolist (file files) | 1490 | (dolist (file files) |
| @@ -1428,13 +1506,15 @@ merge in the changes into your working copy." | |||
| 1428 | (error "Aborted")) | 1506 | (error "Aborted")) |
| 1429 | ;; Now, check if we have unsaved changes. | 1507 | ;; Now, check if we have unsaved changes. |
| 1430 | (vc-buffer-sync t) | 1508 | (vc-buffer-sync t) |
| 1431 | (if (buffer-modified-p) | 1509 | (when (buffer-modified-p) |
| 1432 | (or (y-or-n-p (message "Use %s on disk, keeping modified buffer? " file)) | 1510 | (or (y-or-n-p (message "Use %s on disk, keeping modified buffer? " file)) |
| 1433 | (error "Aborted"))))))) | 1511 | (error "Aborted"))))))) |
| 1434 | ;; Do the right thing | 1512 | ;; Do the right thing |
| 1435 | (cond | 1513 | (cond |
| 1436 | ;; Files aren't registered | 1514 | ;; Files aren't registered |
| 1437 | ((not state) | 1515 | ((or (not state) ;; RCS uses nil for unregistered files. |
| 1516 | (eq state 'unregistered) | ||
| 1517 | (eq state 'ignored)) | ||
| 1438 | (mapc 'vc-register files)) | 1518 | (mapc 'vc-register files)) |
| 1439 | ;; Files are up-to-date, or need a merge and user specified a revision | 1519 | ;; Files are up-to-date, or need a merge and user specified a revision |
| 1440 | ((or (eq state 'up-to-date) (and verbose (eq state 'needs-patch))) | 1520 | ((or (eq state 'up-to-date) (and verbose (eq state 'needs-patch))) |
| @@ -1458,32 +1538,30 @@ merge in the changes into your working copy." | |||
| 1458 | (let ((ready-for-commit files)) | 1538 | (let ((ready-for-commit files)) |
| 1459 | ;; If files are edited but read-only, give user a chance to correct | 1539 | ;; If files are edited but read-only, give user a chance to correct |
| 1460 | (dolist (file files) | 1540 | (dolist (file files) |
| 1461 | (if (not (file-writable-p file)) | 1541 | (unless (file-writable-p file) |
| 1462 | (progn | 1542 | ;; Make the file+buffer read-write. |
| 1463 | ;; Make the file+buffer read-write. | 1543 | (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file)) |
| 1464 | (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file)) | 1544 | (error "Aborted")) |
| 1465 | (error "Aborted")) | 1545 | (set-file-modes file (logior (file-modes file) 128)) |
| 1466 | (set-file-modes file (logior (file-modes file) 128)) | 1546 | (let ((visited (get-file-buffer file))) |
| 1467 | (let ((visited (get-file-buffer file))) | 1547 | (when visited |
| 1468 | (if visited | 1548 | (with-current-buffer visited |
| 1469 | (with-current-buffer visited | 1549 | (toggle-read-only -1)))))) |
| 1470 | (toggle-read-only -1))))))) | ||
| 1471 | ;; Allow user to revert files with no changes | 1550 | ;; Allow user to revert files with no changes |
| 1472 | (save-excursion | 1551 | (save-excursion |
| 1473 | (dolist (file files) | 1552 | (dolist (file files) |
| 1474 | (let ((visited (get-file-buffer file))) | 1553 | (let ((visited (get-file-buffer file))) |
| 1475 | ;; For files with locking, if the file does not contain | 1554 | ;; For files with locking, if the file does not contain |
| 1476 | ;; any changes, just let go of the lock, i.e. revert. | 1555 | ;; any changes, just let go of the lock, i.e. revert. |
| 1477 | (if (and (not (eq model 'implicit)) | 1556 | (when (and (not (eq model 'implicit)) |
| 1478 | (vc-workfile-unchanged-p file) | 1557 | (vc-workfile-unchanged-p file) |
| 1479 | ;; If buffer is modified, that means the user just | 1558 | ;; If buffer is modified, that means the user just |
| 1480 | ;; said no to saving it; in that case, don't revert, | 1559 | ;; said no to saving it; in that case, don't revert, |
| 1481 | ;; because the user might intend to save after | 1560 | ;; because the user might intend to save after |
| 1482 | ;; finishing the log entry and committing. | 1561 | ;; finishing the log entry and committing. |
| 1483 | (not (and visited (buffer-modified-p)))) | 1562 | (not (and visited (buffer-modified-p)))) |
| 1484 | (progn | 1563 | (vc-revert-file file) |
| 1485 | (vc-revert-file file) | 1564 | (delete file ready-for-commit))))) |
| 1486 | (delete file ready-for-commit)))))) | ||
| 1487 | ;; Remaining files need to be committed | 1565 | ;; Remaining files need to be committed |
| 1488 | (if (not ready-for-commit) | 1566 | (if (not ready-for-commit) |
| 1489 | (message "No files remain to be committed") | 1567 | (message "No files remain to be committed") |
| @@ -1493,15 +1571,28 @@ merge in the changes into your working copy." | |||
| 1493 | (setq revision (read-string "New revision or backend: ")) | 1571 | (setq revision (read-string "New revision or backend: ")) |
| 1494 | (let ((vsym (intern (upcase revision)))) | 1572 | (let ((vsym (intern (upcase revision)))) |
| 1495 | (if (member vsym vc-handled-backends) | 1573 | (if (member vsym vc-handled-backends) |
| 1496 | (vc-transfer-file file vsym) | 1574 | (dolist (file files) (vc-transfer-file file vsym)) |
| 1497 | (vc-checkin ready-for-commit revision)))))))) | 1575 | (vc-checkin ready-for-commit revision)))))))) |
| 1498 | ;; locked by somebody else (locking VCSes only) | 1576 | ;; locked by somebody else (locking VCSes only) |
| 1499 | ((stringp state) | 1577 | ((stringp state) |
| 1500 | (let ((revision | 1578 | ;; In the old days, we computed the revision once and used it on |
| 1501 | (if verbose | 1579 | ;; the single file. Then, for the 2007-2008 fileset rewrite, we |
| 1502 | (read-string "Revision to steal: ") | 1580 | ;; computed the revision once (incorrectly, using a free var) and |
| 1503 | (vc-working-revision file)))) | 1581 | ;; used it on all files. To fix the free var bug, we can either |
| 1504 | (dolist (file files) (vc-steal-lock file revision state)))) | 1582 | ;; use `(car files)' or do what we do here: distribute the |
| 1583 | ;; revision computation among `files'. Although this may be | ||
| 1584 | ;; tedious for those backends where a "revision" is a trans-file | ||
| 1585 | ;; concept, it is nonetheless correct for both those and (more | ||
| 1586 | ;; importantly) for those where "revision" is a per-file concept. | ||
| 1587 | ;; If the intersection of the former group and "locking VCSes" is | ||
| 1588 | ;; non-empty [I vaguely doubt it --ttn], we can reinstate the | ||
| 1589 | ;; pre-computation approach of yore. | ||
| 1590 | (dolist (file files) | ||
| 1591 | (vc-steal-lock | ||
| 1592 | file (if verbose | ||
| 1593 | (read-string (format "%s revision to steal: " file)) | ||
| 1594 | (vc-working-revision file)) | ||
| 1595 | state))) | ||
| 1505 | ;; needs-patch | 1596 | ;; needs-patch |
| 1506 | ((eq state 'needs-patch) | 1597 | ((eq state 'needs-patch) |
| 1507 | (dolist (file files) | 1598 | (dolist (file files) |
| @@ -1509,16 +1600,16 @@ merge in the changes into your working copy." | |||
| 1509 | "%s is not up-to-date. Get latest revision? " | 1600 | "%s is not up-to-date. Get latest revision? " |
| 1510 | (file-name-nondirectory file))) | 1601 | (file-name-nondirectory file))) |
| 1511 | (vc-checkout file (eq model 'implicit) t) | 1602 | (vc-checkout file (eq model 'implicit) t) |
| 1512 | (if (and (not (eq model 'implicit)) | 1603 | (when (and (not (eq model 'implicit)) |
| 1513 | (yes-or-no-p "Lock this revision? ")) | 1604 | (yes-or-no-p "Lock this revision? ")) |
| 1514 | (vc-checkout file t))))) | 1605 | (vc-checkout file t))))) |
| 1515 | ;; needs-merge | 1606 | ;; needs-merge |
| 1516 | ((eq state 'needs-merge) | 1607 | ((eq state 'needs-merge) |
| 1517 | (dolist (file files) | 1608 | (dolist (file files) |
| 1518 | (if (yes-or-no-p (format | 1609 | (when (yes-or-no-p (format |
| 1519 | "%s is not up-to-date. Merge in changes now? " | 1610 | "%s is not up-to-date. Merge in changes now? " |
| 1520 | (file-name-nondirectory file))) | 1611 | (file-name-nondirectory file))) |
| 1521 | (vc-maybe-resolve-conflicts file (vc-call merge-news file))))) | 1612 | (vc-maybe-resolve-conflicts file (vc-call merge-news file))))) |
| 1522 | 1613 | ||
| 1523 | ;; unlocked-changes | 1614 | ;; unlocked-changes |
| 1524 | ((eq state 'unlocked-changes) | 1615 | ((eq state 'unlocked-changes) |
| @@ -1667,7 +1758,7 @@ INITIAL-CONTENTS is nil, do action immediately as if the user had | |||
| 1667 | entered COMMENT. If COMMENT is t, also do action immediately with an | 1758 | entered COMMENT. If COMMENT is t, also do action immediately with an |
| 1668 | empty comment. Remember the file's buffer in `vc-parent-buffer' | 1759 | empty comment. Remember the file's buffer in `vc-parent-buffer' |
| 1669 | \(current one if no file). AFTER-HOOK specifies the local value | 1760 | \(current one if no file). AFTER-HOOK specifies the local value |
| 1670 | for vc-log-operation-hook." | 1761 | for `vc-log-after-operation-hook'." |
| 1671 | (let ((parent | 1762 | (let ((parent |
| 1672 | (if (eq major-mode 'vc-dired-mode) | 1763 | (if (eq major-mode 'vc-dired-mode) |
| 1673 | ;; If we are called from VC dired, the parent buffer is | 1764 | ;; If we are called from VC dired, the parent buffer is |
| @@ -1900,18 +1991,19 @@ the buffer contents as a comment." | |||
| 1900 | (defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff)) | 1991 | (defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff)) |
| 1901 | (make-obsolete 'vc-diff-switches-list 'vc-switches "22.1") | 1992 | (make-obsolete 'vc-diff-switches-list 'vc-switches "22.1") |
| 1902 | 1993 | ||
| 1903 | (defun vc-diff-sentinel (verbose rev1-name rev2-name) | 1994 | (defun vc-diff-finish (buffer-name verbose) |
| 1904 | ;; The empty sync output case has already been handled, so the only | 1995 | ;; The empty sync output case has already been handled, so the only |
| 1905 | ;; possibility of an empty output is for an async process, in which case | 1996 | ;; possibility of an empty output is for an async process. |
| 1906 | ;; it's important to insert the "diffs end here" message in the buffer | 1997 | (when (buffer-live-p buffer-name) |
| 1907 | ;; since the user may miss a message in the echo area. | 1998 | (with-current-buffer (get-buffer buffer-name) |
| 1908 | (when verbose | 1999 | (and verbose |
| 1909 | (let ((inhibit-read-only t)) | 2000 | (zerop (buffer-size)) |
| 1910 | (if (eq (buffer-size) 0) | 2001 | (let ((inhibit-read-only t)) |
| 1911 | (insert "No differences found.\n") | 2002 | (insert "No differences found.\n"))) |
| 1912 | (insert (format "\n\nDiffs between %s and %s end here." rev1-name rev2-name))))) | 2003 | (goto-char (point-min)) |
| 1913 | (goto-char (point-min)) | 2004 | (let ((window (get-buffer-window (current-buffer) t))) |
| 1914 | (shrink-window-if-larger-than-buffer)) | 2005 | (when window |
| 2006 | (shrink-window-if-larger-than-buffer window)))))) | ||
| 1915 | 2007 | ||
| 1916 | (defvar vc-diff-added-files nil | 2008 | (defvar vc-diff-added-files nil |
| 1917 | "If non-nil, diff added files by comparing them to /dev/null.") | 2009 | "If non-nil, diff added files by comparing them to /dev/null.") |
| @@ -1970,7 +2062,7 @@ returns t if the buffer had changes, nil otherwise." | |||
| 1970 | ;; bindings are nicer for read only buffers. pcl-cvs does the | 2062 | ;; bindings are nicer for read only buffers. pcl-cvs does the |
| 1971 | ;; same thing. | 2063 | ;; same thing. |
| 1972 | (setq buffer-read-only t) | 2064 | (setq buffer-read-only t) |
| 1973 | (vc-exec-after `(vc-diff-sentinel ,verbose ,rev1-name ,rev2-name)) | 2065 | (vc-exec-after `(vc-diff-finish ,(buffer-name) ,verbose)) |
| 1974 | ;; Display the buffer, but at the end because it can change point. | 2066 | ;; Display the buffer, but at the end because it can change point. |
| 1975 | (pop-to-buffer (current-buffer)) | 2067 | (pop-to-buffer (current-buffer)) |
| 1976 | ;; In the async case, we return t even if there are no differences | 2068 | ;; In the async case, we return t even if there are no differences |
| @@ -2486,8 +2578,6 @@ With prefix arg READ-SWITCHES, specify a value to override | |||
| 2486 | (interactive "DDired under VC (directory): \nP") | 2578 | (interactive "DDired under VC (directory): \nP") |
| 2487 | (let ((vc-dired-switches (concat vc-dired-listing-switches | 2579 | (let ((vc-dired-switches (concat vc-dired-listing-switches |
| 2488 | (if vc-dired-recurse "R" "")))) | 2580 | (if vc-dired-recurse "R" "")))) |
| 2489 | (if (eq (string-match tramp-file-name-regexp dir) 0) | ||
| 2490 | (error "Sorry, vc-directory does not work over Tramp")) | ||
| 2491 | (if read-switches | 2581 | (if read-switches |
| 2492 | (setq vc-dired-switches | 2582 | (setq vc-dired-switches |
| 2493 | (read-string "Dired listing switches: " | 2583 | (read-string "Dired listing switches: " |
| @@ -2512,19 +2602,27 @@ With prefix arg READ-SWITCHES, specify a value to override | |||
| 2512 | 2602 | ||
| 2513 | (defvar vc-status nil) | 2603 | (defvar vc-status nil) |
| 2514 | 2604 | ||
| 2515 | (defun vc-status-insert-headers (backend dir) | 2605 | (defun vc-status-headers (backend dir) |
| 2516 | (insert (format "VC backend :%s\n" backend)) | 2606 | (concat |
| 2517 | (insert "Repository : The repository goes here\n") | 2607 | (format "VC backend : %s\n" backend) |
| 2518 | (insert (format "Working dir: %s\n\n\n" dir))) | 2608 | "Repository : The repository goes here\n" |
| 2609 | (format "Working dir: %s\n" dir))) | ||
| 2519 | 2610 | ||
| 2520 | (defun vc-status-printer (fileentry) | 2611 | (defun vc-status-printer (fileentry) |
| 2521 | "Pretty print FILEENTRY." | 2612 | "Pretty print FILEENTRY." |
| 2522 | (insert | 2613 | (insert |
| 2614 | ;; If you change this, change vc-status-move-to-goal-column. | ||
| 2523 | (format "%c %-20s %s" | 2615 | (format "%c %-20s %s" |
| 2524 | (if (vc-status-fileinfo->marked fileentry) ?* ? ) | 2616 | (if (vc-status-fileinfo->marked fileentry) ?* ? ) |
| 2525 | (vc-status-fileinfo->state fileentry) | 2617 | (vc-status-fileinfo->state fileentry) |
| 2526 | (vc-status-fileinfo->name fileentry)))) | 2618 | (vc-status-fileinfo->name fileentry)))) |
| 2527 | 2619 | ||
| 2620 | (defun vc-status-move-to-goal-column () | ||
| 2621 | (beginning-of-line) | ||
| 2622 | ;; Must be in sync with vc-status-printer. | ||
| 2623 | (forward-char 25)) | ||
| 2624 | |||
| 2625 | ;;;###autoload | ||
| 2528 | (defun vc-status (dir) | 2626 | (defun vc-status (dir) |
| 2529 | "Show the VC status for DIR." | 2627 | "Show the VC status for DIR." |
| 2530 | (interactive "DVC status for directory: ") | 2628 | (interactive "DVC status for directory: ") |
| @@ -2533,10 +2631,33 @@ With prefix arg READ-SWITCHES, specify a value to override | |||
| 2533 | (cd dir) | 2631 | (cd dir) |
| 2534 | (vc-status-mode)) | 2632 | (vc-status-mode)) |
| 2535 | 2633 | ||
| 2536 | (defvar vc-status-mode-map | 2634 | (defvar vc-status-mode-map |
| 2537 | (let ((map (make-sparse-keymap))) | 2635 | (let ((map (make-keymap))) |
| 2636 | (suppress-keymap map) | ||
| 2637 | ;; Marking. | ||
| 2538 | (define-key map "m" 'vc-status-mark-file) | 2638 | (define-key map "m" 'vc-status-mark-file) |
| 2639 | (define-key map "M" 'vc-status-mark-all-files) | ||
| 2539 | (define-key map "u" 'vc-status-unmark-file) | 2640 | (define-key map "u" 'vc-status-unmark-file) |
| 2641 | (define-key map "\C-?" 'vc-status-unmark-file-up) | ||
| 2642 | (define-key map "\M-\C-?" 'vc-status-unmark-all-files) | ||
| 2643 | ;; Movement. | ||
| 2644 | (define-key map "n" 'vc-status-next-line) | ||
| 2645 | (define-key map " " 'vc-status-next-line) | ||
| 2646 | (define-key map "\t" 'vc-status-next-line) | ||
| 2647 | (define-key map "p" 'vc-status-previous-line) | ||
| 2648 | (define-key map [backtab] 'vc-status-previous-line) | ||
| 2649 | ;; VC commands. | ||
| 2650 | (define-key map "=" 'vc-diff) | ||
| 2651 | (define-key map "a" 'vc-status-register) | ||
| 2652 | ;; Can't be "g" (as in vc map), so "A" for "Annotate". | ||
| 2653 | (define-key map "A" 'vc-annotate) | ||
| 2654 | ;; vc-print-log uses the current buffer, not a file. | ||
| 2655 | ;; (define-key map "l" 'vc-status-print-log) | ||
| 2656 | ;; The remainder. | ||
| 2657 | (define-key map "f" 'vc-status-find-file) | ||
| 2658 | (define-key map "o" 'vc-status-find-file-other-window) | ||
| 2659 | (define-key map "q" 'bury-buffer) | ||
| 2660 | (define-key map "g" 'vc-status-refresh) | ||
| 2540 | map) | 2661 | map) |
| 2541 | "Keymap for VC status") | 2662 | "Keymap for VC status") |
| 2542 | 2663 | ||
| @@ -2552,38 +2673,128 @@ With prefix arg READ-SWITCHES, specify a value to override | |||
| 2552 | entries) | 2673 | entries) |
| 2553 | (erase-buffer) | 2674 | (erase-buffer) |
| 2554 | (set (make-local-variable 'vc-status) | 2675 | (set (make-local-variable 'vc-status) |
| 2555 | (ewoc-create #'vc-status-printer)) | 2676 | (ewoc-create #'vc-status-printer |
| 2556 | (vc-status-insert-headers backend default-directory) | 2677 | (vc-status-headers backend default-directory))) |
| 2557 | (setq entries (vc-call-backend backend 'dir-status default-directory)) | 2678 | (vc-status-refresh))) |
| 2679 | |||
| 2680 | (put 'vc-status-mode 'mode-class 'special) | ||
| 2681 | |||
| 2682 | (defun vc-update-vc-status-buffer (entries buffer) | ||
| 2683 | (with-current-buffer buffer | ||
| 2558 | (dolist (entry entries) | 2684 | (dolist (entry entries) |
| 2559 | (ewoc-enter-last | 2685 | (ewoc-enter-last vc-status |
| 2560 | vc-status (vc-status-create-fileinfo (cdr entry) (car entry)))))) | 2686 | (vc-status-create-fileinfo (cdr entry) (car entry)))) |
| 2687 | (ewoc-goto-node vc-status (ewoc-nth vc-status 0)))) | ||
| 2688 | |||
| 2689 | (defun vc-status-refresh () | ||
| 2690 | "Refresh the contents of the VC status buffer." | ||
| 2691 | (interactive) | ||
| 2692 | ;; This is not very efficient; ewoc could use a new function here. | ||
| 2693 | (ewoc-filter vc-status (lambda (node) nil)) | ||
| 2694 | (let ((backend (vc-responsible-backend default-directory))) | ||
| 2695 | ;; Call the dir-status backend function. dir-status is supposed to | ||
| 2696 | ;; be asynchronous. It should compute the results and call the | ||
| 2697 | ;; function passed as a an arg to update the vc-status buffer with | ||
| 2698 | ;; the results. | ||
| 2699 | (vc-call-backend | ||
| 2700 | backend 'dir-status default-directory | ||
| 2701 | #'vc-update-vc-status-buffer (current-buffer)))) | ||
| 2702 | |||
| 2703 | (defun vc-status-next-line (arg) | ||
| 2704 | "Go to the next line. | ||
| 2705 | If a prefix argument is given, move by that many lines." | ||
| 2706 | (interactive "p") | ||
| 2707 | (ewoc-goto-next vc-status arg) | ||
| 2708 | (vc-status-move-to-goal-column)) | ||
| 2709 | |||
| 2710 | (defun vc-status-previous-line (arg) | ||
| 2711 | "Go to the previous line. | ||
| 2712 | If a prefix argument is given, move by that many lines." | ||
| 2713 | (interactive "p") | ||
| 2714 | (ewoc-goto-prev vc-status arg) | ||
| 2715 | (vc-status-move-to-goal-column)) | ||
| 2561 | 2716 | ||
| 2562 | (defun vc-status-mark-file () | 2717 | (defun vc-status-mark-file () |
| 2563 | "Mark the current file." | 2718 | "Mark the current file and move to the next line." |
| 2564 | (interactive) | 2719 | (interactive) |
| 2565 | (let* ((crt (ewoc-locate vc-status)) | 2720 | (let* ((crt (ewoc-locate vc-status)) |
| 2566 | (file (ewoc-data crt))) | 2721 | (file (ewoc-data crt))) |
| 2567 | (setf (vc-status-fileinfo->marked file) t) | 2722 | (setf (vc-status-fileinfo->marked file) t) |
| 2568 | (ewoc-invalidate vc-status crt) | 2723 | (ewoc-invalidate vc-status crt) |
| 2569 | (ewoc-goto-next vc-status 1))) | 2724 | (vc-status-next-line 1))) |
| 2725 | |||
| 2726 | (defun vc-status-mark-all-files () | ||
| 2727 | "Mark all files." | ||
| 2728 | (interactive) | ||
| 2729 | (ewoc-map | ||
| 2730 | (lambda (file) | ||
| 2731 | (unless (vc-status-fileinfo->marked file) | ||
| 2732 | (setf (vc-status-fileinfo->marked file) t) | ||
| 2733 | t)) | ||
| 2734 | vc-status)) | ||
| 2570 | 2735 | ||
| 2571 | (defun vc-status-unmark-file () | 2736 | (defun vc-status-unmark-file () |
| 2572 | "Mark the current file." | 2737 | "Unmark the current file and move to the next line." |
| 2573 | (interactive) | 2738 | (interactive) |
| 2574 | (let* ((crt (ewoc-locate vc-status)) | 2739 | (let* ((crt (ewoc-locate vc-status)) |
| 2575 | (file (ewoc-data crt))) | 2740 | (file (ewoc-data crt))) |
| 2576 | (setf (vc-status-fileinfo->marked file) nil) | 2741 | (setf (vc-status-fileinfo->marked file) nil) |
| 2577 | (ewoc-invalidate vc-status crt) | 2742 | (ewoc-invalidate vc-status crt) |
| 2578 | (ewoc-goto-next vc-status 1))) | 2743 | (vc-status-next-line 1))) |
| 2744 | |||
| 2745 | (defun vc-status-unmark-file-up () | ||
| 2746 | "Move to the previous line and unmark the file." | ||
| 2747 | (interactive) | ||
| 2748 | ;; If we're on the first line, we won't move up, but we will still | ||
| 2749 | ;; remove the mark. This seems a bit odd but it is what buffer-menu | ||
| 2750 | ;; does. | ||
| 2751 | (let* ((prev (ewoc-goto-prev vc-status 1)) | ||
| 2752 | (file (ewoc-data prev))) | ||
| 2753 | (setf (vc-status-fileinfo->marked file) nil) | ||
| 2754 | (ewoc-invalidate vc-status prev) | ||
| 2755 | (vc-status-move-to-goal-column))) | ||
| 2756 | |||
| 2757 | (defun vc-status-unmark-all-files () | ||
| 2758 | "Unmark all files." | ||
| 2759 | (interactive) | ||
| 2760 | (ewoc-map | ||
| 2761 | (lambda (file) | ||
| 2762 | (when (vc-status-fileinfo->marked file) | ||
| 2763 | (setf (vc-status-fileinfo->marked file) nil) | ||
| 2764 | t)) | ||
| 2765 | vc-status)) | ||
| 2766 | |||
| 2767 | (defun vc-status-register () | ||
| 2768 | "Register the marked files, or the current file if no marks." | ||
| 2769 | (interactive) | ||
| 2770 | (let ((files (or (vc-status-marked-files) | ||
| 2771 | (list (vc-status-current-file))))) | ||
| 2772 | (dolist (file files) | ||
| 2773 | (vc-register file)))) | ||
| 2774 | |||
| 2775 | (defun vc-status-find-file () | ||
| 2776 | "Find the file on the current line." | ||
| 2777 | (interactive) | ||
| 2778 | (find-file (vc-status-current-file))) | ||
| 2779 | |||
| 2780 | (defun vc-status-find-file-other-window () | ||
| 2781 | "Find the file on the current line, in another window." | ||
| 2782 | (interactive) | ||
| 2783 | (find-file-other-window (vc-status-current-file))) | ||
| 2784 | |||
| 2785 | (defun vc-status-current-file () | ||
| 2786 | (let ((node (ewoc-locate vc-status))) | ||
| 2787 | (unless node | ||
| 2788 | (error "No file available.")) | ||
| 2789 | (expand-file-name (vc-status-fileinfo->name (ewoc-data node))))) | ||
| 2579 | 2790 | ||
| 2580 | (defun vc-status-marked-files () | 2791 | (defun vc-status-marked-files () |
| 2581 | "Return the list of marked files" | 2792 | "Return the list of marked files" |
| 2582 | (mapcar | 2793 | (mapcar |
| 2583 | (lambda (elem) | 2794 | (lambda (elem) |
| 2584 | (expand-file-name (vc-status-fileinfo->name elem))) | 2795 | (expand-file-name (vc-status-fileinfo->name elem))) |
| 2585 | (ewoc-collect | 2796 | (ewoc-collect |
| 2586 | vc-status | 2797 | vc-status |
| 2587 | (lambda (crt) (vc-status-fileinfo->marked crt))))) | 2798 | (lambda (crt) (vc-status-fileinfo->marked crt))))) |
| 2588 | 2799 | ||
| 2589 | ;;; End experimental code. | 2800 | ;;; End experimental code. |
| @@ -2782,8 +2993,7 @@ changes from the current branch are merged into the working file." | |||
| 2782 | (if (not (vc-find-backend-function (vc-backend file) 'merge-news)) | 2993 | (if (not (vc-find-backend-function (vc-backend file) 'merge-news)) |
| 2783 | (error "Sorry, merging news is not implemented for %s" | 2994 | (error "Sorry, merging news is not implemented for %s" |
| 2784 | (vc-backend file)) | 2995 | (vc-backend file)) |
| 2785 | (vc-call merge-news file) | 2996 | (vc-maybe-resolve-conflicts file (vc-call merge-news file))))))) |
| 2786 | (vc-resynch-buffer file t t)))))) | ||
| 2787 | 2997 | ||
| 2788 | (defun vc-version-backup-file (file &optional rev) | 2998 | (defun vc-version-backup-file (file &optional rev) |
| 2789 | "Return name of backup file for revision REV of FILE. | 2999 | "Return name of backup file for revision REV of FILE. |
| @@ -3024,9 +3234,6 @@ log entries should be gathered." | |||
| 3024 | ;; it should find all relevant files relative to | 3234 | ;; it should find all relevant files relative to |
| 3025 | ;; the default-directory. | 3235 | ;; the default-directory. |
| 3026 | nil))) | 3236 | nil))) |
| 3027 | (dolist (file (or args (list default-directory))) | ||
| 3028 | (if (eq (string-match tramp-file-name-regexp file) 0) | ||
| 3029 | (error "Sorry, vc-update-change-log does not work over Tramp"))) | ||
| 3030 | (vc-call-backend (vc-responsible-backend default-directory) | 3237 | (vc-call-backend (vc-responsible-backend default-directory) |
| 3031 | 'update-changelog args)) | 3238 | 'update-changelog args)) |
| 3032 | 3239 | ||
diff --git a/lisp/view.el b/lisp/view.el index 367af486425..c7a8d3d54c9 100644 --- a/lisp/view.el +++ b/lisp/view.el | |||
| @@ -243,6 +243,16 @@ This is local in each buffer, once it is used.") | |||
| 243 | 243 | ||
| 244 | ;;; Commands that enter or exit view mode. | 244 | ;;; Commands that enter or exit view mode. |
| 245 | 245 | ||
| 246 | ;; This is used when view mode is exited, to make sure we don't try to | ||
| 247 | ;; kill a buffer modified by the user. A buffer in view mode can | ||
| 248 | ;; become modified if the user types C-x C-q, edits the buffer, then | ||
| 249 | ;; types C-x C-q again to return to view mode. | ||
| 250 | (defun kill-buffer-if-not-modified (buf) | ||
| 251 | "Like `kill-buffer', but does nothing if the buffer is modified." | ||
| 252 | (let ((buf (get-buffer buf))) | ||
| 253 | (and buf (not (buffer-modified-p buf)) | ||
| 254 | (kill-buffer buf)))) | ||
| 255 | |||
| 246 | ;;;###autoload | 256 | ;;;###autoload |
| 247 | (defun view-file (file) | 257 | (defun view-file (file) |
| 248 | "View FILE in View mode, returning to previous buffer when done. | 258 | "View FILE in View mode, returning to previous buffer when done. |
| @@ -263,41 +273,50 @@ This command runs the normal hook `view-mode-hook'." | |||
| 263 | (progn | 273 | (progn |
| 264 | (switch-to-buffer buffer) | 274 | (switch-to-buffer buffer) |
| 265 | (message "Not using View mode because the major mode is special")) | 275 | (message "Not using View mode because the major mode is special")) |
| 266 | (view-buffer buffer (and (not had-a-buf) 'kill-buffer))))) | 276 | (view-buffer buffer (and (not had-a-buf) 'kill-buffer-if-not-modified))))) |
| 267 | 277 | ||
| 268 | ;;;###autoload | 278 | ;;;###autoload |
| 269 | (defun view-file-other-window (file) | 279 | (defun view-file-other-window (file) |
| 270 | "View FILE in View mode in another window. | 280 | "View FILE in View mode in another window. |
| 271 | Return that window to its previous buffer when done. Emacs commands | 281 | When done, return that window to its previous buffer, and kill the |
| 272 | editing the buffer contents are not available; instead, a special set of | 282 | buffer visiting FILE if unmodified and if it wasn't visited before. |
| 273 | commands (mostly letters and punctuation) are defined for moving around | 283 | |
| 274 | in the buffer. | 284 | Emacs commands editing the buffer contents are not available; instead, |
| 285 | a special set of commands (mostly letters and punctuation) | ||
| 286 | are defined for moving around in the buffer. | ||
| 275 | Space scrolls forward, Delete scrolls backward. | 287 | Space scrolls forward, Delete scrolls backward. |
| 276 | For a list of all View commands, type H or h while viewing. | 288 | For a list of all View commands, type H or h while viewing. |
| 277 | 289 | ||
| 278 | This command runs the normal hook `view-mode-hook'." | 290 | This command runs the normal hook `view-mode-hook'." |
| 279 | (interactive "fIn other window view file: ") | 291 | (interactive "fIn other window view file: ") |
| 280 | (unless (file-exists-p file) (error "%s does not exist" file)) | 292 | (unless (file-exists-p file) (error "%s does not exist" file)) |
| 281 | (let ((had-a-buf (get-file-buffer file))) | 293 | (let ((had-a-buf (get-file-buffer file)) |
| 282 | (view-buffer-other-window (find-file-noselect file) nil | 294 | (buf-to-view (find-file-noselect file))) |
| 283 | (and (not had-a-buf) 'kill-buffer)))) | 295 | (view-buffer-other-window buf-to-view nil |
| 296 | (and (not had-a-buf) | ||
| 297 | 'kill-buffer-if-not-modified)))) | ||
| 284 | 298 | ||
| 285 | ;;;###autoload | 299 | ;;;###autoload |
| 286 | (defun view-file-other-frame (file) | 300 | (defun view-file-other-frame (file) |
| 287 | "View FILE in View mode in another frame. | 301 | "View FILE in View mode in another frame. |
| 288 | Maybe delete other frame and/or return to previous buffer when done. | 302 | When done, kill the buffer visiting FILE if unmodified and if it wasn't |
| 289 | Emacs commands editing the buffer contents are not available; instead, a | 303 | visited before; also, maybe delete other frame and/or return to previous |
| 290 | special set of commands (mostly letters and punctuation) are defined for | 304 | buffer. |
| 291 | moving around in the buffer. | 305 | |
| 306 | Emacs commands editing the buffer contents are not available; instead, | ||
| 307 | a special set of commands (mostly letters and punctuation) | ||
| 308 | are defined for moving around in the buffer. | ||
| 292 | Space scrolls forward, Delete scrolls backward. | 309 | Space scrolls forward, Delete scrolls backward. |
| 293 | For a list of all View commands, type H or h while viewing. | 310 | For a list of all View commands, type H or h while viewing. |
| 294 | 311 | ||
| 295 | This command runs the normal hook `view-mode-hook'." | 312 | This command runs the normal hook `view-mode-hook'." |
| 296 | (interactive "fIn other frame view file: ") | 313 | (interactive "fIn other frame view file: ") |
| 297 | (unless (file-exists-p file) (error "%s does not exist" file)) | 314 | (unless (file-exists-p file) (error "%s does not exist" file)) |
| 298 | (let ((had-a-buf (get-file-buffer file))) | 315 | (let ((had-a-buf (get-file-buffer file)) |
| 299 | (view-buffer-other-frame (find-file-noselect file) nil | 316 | (buf-to-view (find-file-noselect file))) |
| 300 | (and (not had-a-buf) 'kill-buffer)))) | 317 | (view-buffer-other-frame buf-to-view nil |
| 318 | (and (not had-a-buf) | ||
| 319 | 'kill-buffer-if-not-modified)))) | ||
| 301 | 320 | ||
| 302 | 321 | ||
| 303 | ;;;###autoload | 322 | ;;;###autoload |
| @@ -313,7 +332,12 @@ This command runs the normal hook `view-mode-hook'. | |||
| 313 | 332 | ||
| 314 | Optional argument EXIT-ACTION is either nil or a function with buffer as | 333 | Optional argument EXIT-ACTION is either nil or a function with buffer as |
| 315 | argument. This function is called when finished viewing buffer. Use | 334 | argument. This function is called when finished viewing buffer. Use |
| 316 | this argument instead of explicitly setting `view-exit-action'." | 335 | this argument instead of explicitly setting `view-exit-action'. |
| 336 | |||
| 337 | Do not set EXIT-ACTION to `kill-buffer' when BUFFER visits a | ||
| 338 | file: Users may suspend viewing in order to modify the buffer. | ||
| 339 | Exiting View mode will then discard the user's edits. Setting | ||
| 340 | EXIT-ACTION to `kill-buffer-if-not-modified' avoids this." | ||
| 317 | (interactive "bView buffer: ") | 341 | (interactive "bView buffer: ") |
| 318 | (let ((undo-window (list (window-buffer) (window-start) (window-point)))) | 342 | (let ((undo-window (list (window-buffer) (window-start) (window-point)))) |
| 319 | (switch-to-buffer buffer) | 343 | (switch-to-buffer buffer) |
diff --git a/lisp/wdired.el b/lisp/wdired.el index 287e2119c8d..36725db5db5 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el | |||
| @@ -323,7 +323,11 @@ non-nil means return old filename." | |||
| 323 | (unless (eq beg end) | 323 | (unless (eq beg end) |
| 324 | (if old | 324 | (if old |
| 325 | (setq file (get-text-property beg 'old-name)) | 325 | (setq file (get-text-property beg 'old-name)) |
| 326 | (setq end (next-single-property-change (1+ beg) 'end-name)) | 326 | ;; In the following form changed `(1+ beg)' to `beg' so that |
| 327 | ;; the filename end is found even when the filename is empty. | ||
| 328 | ;; Fixes error and spurious newlines when marking files for | ||
| 329 | ;; deletion. | ||
| 330 | (setq end (next-single-property-change beg 'end-name)) | ||
| 327 | (setq file (buffer-substring-no-properties (1+ beg) end))) | 331 | (setq file (buffer-substring-no-properties (1+ beg) end))) |
| 328 | (and file (setq file (wdired-normalize-filename file)))) | 332 | (and file (setq file (wdired-normalize-filename file)))) |
| 329 | (if (or no-dir old) | 333 | (if (or no-dir old) |
diff --git a/lisp/winner.el b/lisp/winner.el index 27b68106a53..5e9d6a3212e 100644 --- a/lisp/winner.el +++ b/lisp/winner.el | |||
| @@ -51,7 +51,7 @@ | |||
| 51 | '(region-active-p))) | 51 | '(region-active-p))) |
| 52 | 52 | ||
| 53 | (defsetf winner-active-region () (store) | 53 | (defsetf winner-active-region () (store) |
| 54 | (if (fboundp 'zmacs-activate-region) | 54 | (if (featurep 'xemacs) |
| 55 | `(if ,store (zmacs-activate-region) | 55 | `(if ,store (zmacs-activate-region) |
| 56 | (zmacs-deactivate-region)) | 56 | (zmacs-deactivate-region)) |
| 57 | `(setq mark-active ,store))) | 57 | `(setq mark-active ,store))) |
diff --git a/lisp/woman.el b/lisp/woman.el index 0778d424324..2ba414aef9c 100644 --- a/lisp/woman.el +++ b/lisp/woman.el | |||
| @@ -3540,8 +3540,10 @@ The expression may be an argument in quotes." | |||
| 3540 | (setq value (funcall op value (woman-parse-numeric-value)))) | 3540 | (setq value (funcall op value (woman-parse-numeric-value)))) |
| 3541 | ((looking-at "[<=>]=?") ; relational operators | 3541 | ((looking-at "[<=>]=?") ; relational operators |
| 3542 | (goto-char (match-end 0)) | 3542 | (goto-char (match-end 0)) |
| 3543 | (setq op (or (intern-soft (match-string 0)) | 3543 | (setq op (intern-soft |
| 3544 | (intern-soft "="))) | 3544 | (if (string-equal (match-string 0) "==") |
| 3545 | "=" | ||
| 3546 | (match-string 0)))) | ||
| 3545 | (setq value (if (funcall op value (woman-parse-numeric-value)) | 3547 | (setq value (if (funcall op value (woman-parse-numeric-value)) |
| 3546 | 1 0))) | 3548 | 1 0))) |
| 3547 | ((memq (setq op (following-char)) '(?& ?:)) ; Boolean and / or | 3549 | ((memq (setq op (following-char)) '(?& ?:)) ; Boolean and / or |