diff options
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 @@ -2008-01-17 Mark A. Hershberger <mah@everybody.org> +2008-01-30 Richard Stallman <rms@gnu.org> - * xml.el (xml-escape-string): Don't do any encoding changes on the - string. + * progmodes/etags.el (tags-query-replace): Delete unused optional args. + Doc fix. + + * files.el (hack-local-variables): Don't query about fake variables. + +2008-01-30 Markus Triska <markus.triska@gmx.at> + + * linum.el: New file. + +2008-01-29 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-methods): Use "-H" option for "sudo". Suggested + by Trent W. Buck <trentbuck@gmail.com>. Make ("%h") a single + element in "plinkx". + (tramp-handle-shell-command): Reuse "*Async Shell Command*" or + "*Shell Command Output*" buffers. Check, whether there is already + an asynchronous process running. Display always the buffer of the + asynchronous process. + (tramp-compute-multi-hops): Adapt error message. + +2008-01-29 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-langs.el (c-specifier-key): Exclude "template" + from this regexp; part of same fix as next change to cc-engine.el. + + * progmodes/cc-engine.el (c-guess-basic-syntax, CASE 5A.5): Anchor + the "{" of a template function correctly on "template", not the + following "<". + + * progmodes/cc-defs.el (c-version): Increase to 5.31.5. + +2008-01-29 Tassilo Horn <tassilo@member.fsf.org> + + * doc-view.el (doc-view-mode): Adapt to i-m-current-[vh]scroll + being an alist now. + + * image-mode.el (image-mode-current-vscroll) + (image-mode-current-hscroll): Add doc strings. + (image-set-window-vscroll, image-set-window-hscroll) + (image-reset-current-vhscroll, image-mode): Adapt to + i-m-current-[vh]scroll being an alist now. + +2008-01-29 Martin Rudalics <rudalics@gmx.at> + + * emacs-lisp/find-func.el (find-function-search-for-symbol): + Strip extension from .emacs.el to make sure symbol is searched + in .emacs too. + +2008-01-29 Tassilo Horn <tassilo@member.fsf.org> + + * doc-view.el (doc-view-mode): Use facilities below to + restore [vh]scroll when switching buffers. + + * image-mode.el (image-mode-current-vscroll) + (image-mode-current-hscroll): New variables. + (image-set-window-hscroll, image-set-window-vscroll): New + functions. + (image-forward-hscroll, image-next-line, image-bol, image-eol) + (image-bob, image-eob): Use them. + (image-reset-current-vhscroll): New function. + (image-mode): Make new variables buffer-local and reset [vh]scroll + on window configuration changes. + +2008-01-27 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-create-define-alist): Don't call + gdb-cpp-define-alist-program if file is nil (currently only + " *partial-output-..."). + +2008-01-27 Richard Stallman <rms@gnu.org> + + * allout.el: Many doc fixes. + (allout-encrypt-string): Fix error message. + +2008-01-26 Eli Zaretskii <eliz@gnu.org> + + * progmodes/etags.el (tags-query-replace): Doc fix. + +2008-01-25 Juanma Barranquero <lekktu@gmail.com> + + * allout.el (allout-unload-function): New function. + +2008-01-25 Juanma Barranquero <lekktu@gmail.com> + + * allout.el (allout-prefix-data): Doc fix. + (allout-show-current-subtree): Reflow docstring. + (allout-use-mode-specific-leader, allout-use-hanging-indents) + (produce-allout-mode-map, allout-overlay-interior-modification-handler) + (allout-next-heading, allout-previous-heading, allout-rebullet-heading) + (allout-rebullet-topic, allout-rebullet-topic-grunt, allout-kill-topic) + (allout-copy-topic-as-kill, allout-listify-exposed) + (allout-process-exposed, allout-encrypted-key-info) + (allout-update-passphrase-mnemonic-aids) + (allout-next-topic-pending-encryption) + (allout-tests-globally-true): Fix typos in docstrings. + +2008-01-23 Jason Rumney <jasonr@gnu.org> + + * lpr.el (printer-name): Do not set on MS Windows. + +2008-01-28 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-handle-shell-command): Use "/bin/sh -c" for + the command. + +2008-01-28 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * whitespace.el: Moved to obsolete dir. + + * blank-mode.el: New version 9.2. Replace whitespace funs by aliases + in blank-mode. + (whitespace-buffer): New fun. + (whitespace-region): Alias for whitespace-buffer, because there is no + blank-region fun. + (whitespace-cleanup): Alias for blank-cleanup. + (whitespace-cleanup-region): Alias for blank-cleanup-region. + +2008-01-27 Juanma Barranquero <lekktu@gmail.com> + + * server.el (server-log-time-function): Doc fix. + (server-buffer): Fix typo in docstring. + +2008-01-27 Martin Rudalics <rudalics@gmx.at> + + * view.el (view-buffer): Explain in doc-string why exit-action + should not be set to kill-buffer. + + * arc-mode.el (archive-extract): + * tar-mode.el (tar-extract): Use kill-buffer-if-not-modified as + exit-action when viewing the buffer. + +2008-01-27 Dan Nicolaescu <dann@ics.uci.edu> + + * add-log.el (change-log-search-file-name): Work harder to find + the correct file name. + (change-log-find-file): Fix typo. + (change-log-start-entry-re): Move definition earlier. + +2007-01-27 Jan Nieuwenhuizen <janneke@gnu.org> + + * add-log.el (change-log-search-file-name, change-log-find-file): + New function. + (change-log-font-lock-keywords): Move file name matching ... + (change-log-file-names-re): ... here. New defconst. + (change-log-mode-map): New binding C-c C-f to change-log-find-file. + +2008-01-27 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-awk.el, progmodes/cc-engine.el: Correct typos, + enhance comments. + +2008-01-27 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-compute-multi-hops): In case of su(do)? + methods, the host name must be a local host. + +2008-01-27 Dan Nicolaescu <dann@ics.uci.edu> + + * vc.el: Add TODO item about not defaulting to RCS. + + * server.el (server-process-filter): Check for non-nil before + calling file-directory-p. + +2008-01-27 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-vars.el (c-hanging-braces-alist): New element for + arglist-cont-nonempty. + + * progmodes/cc-cmds.el (c-brace-newlines): Determine the newlines + for a brace with syntax arglist-cont-nonempty. + + * progmodes/cc-styles.el (c-style-alist): Add elements for + arglist-cont-nonempty into 5 styles (gnu, ellemtel, linux, python, + awk). + +2008-01-27 Thien-Thi Nguyen <ttn@gnuvola.org> + + * button.el (define-button-type): Clarify type of NAME in docstring. + +2008-01-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * server.el (server-buffer): New const. + (server-log): New var. + (server-log): Use them. + (server-process-filter): (Try to) run the continuation in the same cwd + as the client's. + +2008-01-26 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-defs.el (c-save-buffer-state): + Bind buffer-file-name and buffer-file-truename to nil, to prevent + primitives generating "buffer is read only" messages. + +2008-01-20 Ulf Jasper <ulf.jasper@web.de> + + * icalendar.el (icalendar-version): Increase to "0.17". + (icalendar-import-format): Doc fix. Allow function type. + (icalendar--read-element): Doc fix. + (icalendar--parse-summary-and-rest): Doc fix. Handle function + type icalendar-import-format. Make regexps non-greedy. + (icalendar--format-ical-event): Handle function type + icalendar-import-format. + (icalendar-import-format-sample): New function. + +2008-01-26 Thien-Thi Nguyen <ttn@gnuvola.org> + + * vc.el (vc-exec-after): For mode-line-process highlighting, if + `compile' is not available, fall back to font-lock-warning-face. + +2008-01-26 Phil Sung <psung@mit.edu> (tiny change) + + * wdired.el (wdired-get-filename): Change `(1+ beg)' to `beg' so + that the filename end is found even when the filename is empty. + Fixes error and spurious newlines when marking files for deletion. + +2008-01-26 Martin Rudalics <rudalics@gmx.at> + + * subr.el (find-tag-default): Simplify using exclusively + skip-syntax-backward/-forward. + +2008-01-26 Michael Albinus <michael.albinus@gmx.de> + + * vc.el (vc-directory, vc-update-change-log): Remove check for + Tramp. Both functions work for it, though pretty slow + (`vc-directory'). Maybe the implementation can be optimized. + + * net/tramp.el (tramp-dissect-file-name): Raise an error when + Tramp 2.0 syntax is used. + Suggested by Trent W. Buck <trentbuck@gmail.com>. + +2008-01-26 Eli Zaretskii <eliz@gnu.org> + + * ls-lisp.el (ls-lisp-insert-directory): If -n switch is used, + invoke directory-files-and-attributes with last argument `integer' + instead of `string'. + (insert-directory): Add -n to the list of supported switches + mentioned in the doc string. + +2008-01-26 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * blank-mode.el: New version 9.1. Handle "long" line tail + visualization. Doc fix. + (blank-line-length): Rename to blank-line-column. + (blank-chars-value-list, blank-toggle-option-alist, blank-help-text): + Initialization fix. + (blank-replace-spaces-by-tabs): New fun. + (blank-cleanup, blank-cleanup-region, blank-color-on): Code fix. + +2008-01-25 Richard Stallman <rms@gnu.org> + + * subr.el (add-hook): Implement `permanent-local-hook' property. + + * loadhist.el (file-provides, file-requires): Push the filename right. + +2008-01-25 Martin Rudalics <rudalics@gmx.at> + + * emacs-lisp/find-func.el (find-library): Wrap search for + library name in condition-case to avoid reporting a scan-error. + +2008-01-25 Juanma Barranquero <lekktu@gmail.com> + + * server.el (server-process-filter): Don't force + the authentication string to be followed by "\n". + +2008-01-25 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * blank-mode.el: New version 9.0. New commands to clean up some blank + problems like trailing blanks. New faces and regexp for visualizing + the blank problems. Doc fix. + (blank-chars, blank-global-modes, blank-chars-value-list) + (blank-toggle-option-alist, blank-help-text): Initialization fix. + (blank-indentation, blank-empty, blank-space-after-tab): New faces. + (blank-indentation, blank-empty, blank-space-after-tab) + (blank-indentation-regexp, blank-empty-at-bob-regexp) + (blank-empty-at-eob-regexp, blank-space-after-tab-regexp): New options. + (blank-cleanup, blank-cleanup-region): New commands. + (blank-color-on): Code fix. + +2008-01-25 Dan Nicolaescu <dann@ics.uci.edu> + + * ibuffer.el (ibuffer-default-sorting-mode): Add option to sort by + file name. + (ibuffer-mode-map): Add binding to sort by file name. + (ibuffer-filename/process-header-map): New variable. + (filename-and-process): Add a header that sorts by file name. + (ibuffer-mode): Mention sorting by file name. + + * ibuf-ext.el (filename/process): New sorter. + +2008-01-25 Sven Joachim <svenjoac@gmx.de> + + * view.el (kill-buffer-if-not-modified): Don't pass t to + buffer-modified-p. + +2008-01-24 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-do-copy-or-rename-file): Flush the cache of + the source file in case of `rename'. + Reported by Pete Forman <pete.forman@westerngeco.com>. + +2008-01-24 Ken Manheimer <ken.manheimer@gmail.com> + + * allout.el (allout-keybindings-list): In initial setting, express + meta-prefixed allout keys as vectors instead of strings, since the + string form is interpreted in some cases as composed key + modifiers, eg, accented keys. + + (allout-line-boundary-regexp): Clarify description. + + (set-allout-regexp): Repair the expressions so that the formfeed + part is identified as one of the top-level groups, and is + included in all the forms, not just the -line-boundary-regexp one. + + (allout-prefix-data): Incorporate information from the various + allout regexp's formfeed alternative group, when present. + + (allout-write-file-hook-handler): Rectify mangling of the error + handling. It was broken in 2007-12-06T19:56:41Z!deego@gnufans.org, where an `error' + condition-case handler was apparently reformatted as if it was a + call to the error function. An apparent repair attempt in version + 1.101 situated the original body of the error handling code as + bogus condition-case handlers. I've returned to just about the + working code that was originally there, removing an unnecessary - + but benign - enclosing 'progn'. \(Automated or cursory code fixes + often aren't.) + + (allout-region-active-p): Fallback to value of mark-active if + neither use-region-p nor region-active-p are present, for + compatability with current and recent emacs major releases. + +2008-01-24 Dan Nicolaescu <dann@ics.uci.edu> + + * textmodes/reftex-toc.el (reftex-toc-next, reftex-toc-previous) + (reftex-toc-restore-region): + * textmodes/reftex-index.el (reftex-index-initialize-phrases-buffer) + (reftex-index-phrases-apply-to-region): + * textmodes/ispell.el (ispell-word): + * progmodes/vhdl-mode.el (vhdl-keep-region-active): + * progmodes/pascal.el (pascal-mark-defun): + * progmodes/f90.el (f90-mark-subprogram, f90-indent-region) + (f90-fill-region): + * emulation/tpu-edt.el (tpu-set-mark): + * emulation/crisp.el (crisp-region-active): + * winner.el (winner-active-region): + * ansi-color.el (ansi-color-set-extent-face): Use featurep instead + of bound tests in order to resolve conditionals at compile time. + +2008-01-24 Juanma Barranquero <lekktu@gmail.com> + + * delsel.el (delsel-unload-function): Don't use `remprop'; it is + not autoloaded, and we wouldn't want to load CL just to unload + delsel.el anyway. Suggested by Martin Rudalics <rudalics@gmx.at>. + +2008-01-24 Martin Rudalics <rudalics@gmx.at> + + * delsel.el (delete-selection-pre-hook): Avoid clearing out + pre-command-hook when text is read-only. + +2008-01-24 Thien-Thi Nguyen <ttn@gnuvola.org> + + * vc.el (vc-process-filter): Do nothing if buffer not live. + (vc-diff-finish): Rename from vc-diff-sentinel. + No longer take REV1-NAME and REV2-NAME. + Instead, take BUFFER-NAME. Do nothing if buffer not live. + Don't do window resize if no window displays buffer. + (vc-diff-internal): Use vc-diff-finish. + + * vc.el (vc-next-action): Fix two instances of "free-var file" bug: + In both cases, convert single call to one wrapped in dolist. + +2008-01-24 Dan Nicolaescu <dann@ics.uci.edu> + + * vc.el: Add a TODO item about missing files. + (vc-exec-after): Add a tooltip to the new mode-line item. + +2008-01-24 Glenn Morris <rgm@gnu.org> + + * t-mouse.el (gpm-mouse-start): Declare as a function. + +2008-01-23 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-remote-process-environment): Set "LC_ALL=C". + (tramp-end-of-output): Add `tramp-rsh-end-of-line' into the regexp. + (tramp-find-shell, tramp-open-connection-setup-interactive-shell): + Don't send `tramp-rsh-end-of-line' additionally, when setting the + prompt. + (tramp-wait-for-output): Distinguish different prompt formats. + (tramp-get-test-nt-command): Don't check for "\n" in the prompt. + (tramp-local-host-p): Check whether temp directory is writable. + +2008-01-23 Dan Nicolaescu <dann@ics.uci.edu> + + * vc.el: Add TODO items. + +2008-01-23 Carsten Dominik <dominik@science.uva.nl> + + * replace.el (occur-mode-find-occurrence-hook): New hook that can + be used to reveal or highlight the location of a match. + (occur-mode-goto-occurrence, occur-mode-goto-occurrence-other-window) + (occur-mode-display-occurrence): Run `occur-mode-find-occurrence-hook'. + +2008-01-23 Martin Rudalics <rudalics@gmx.at> + + * progmodes/hideif.el (hide-ifdef-shadow): Add version number + for defcustom. + (hide-ifdef-shadow): Add version number for defface. + +2008-01-23 Glenn Morris <rgm@gnu.org> + + * textmodes/org.el (org-export-latex-cleaned-string): Fix declaration. + +2008-01-23 Dan Nicolaescu <dann@ics.uci.edu> + + * progmodes/sh-script.el (sh-basic-offset): + * progmodes/cc-vars.el (c-syntactic-indentation) + (c-syntactic-indentation-in-macros): Mark as safe. + +2008-01-23 Richard Stallman <rms@gnu.org> + + * icomplete.el (icomplete-get-keys): + Look up KEYS using all maps in proper buffer. + +2008-01-23 Juanma Barranquero <lekktu@gmail.com> + + * frame.el (display-mm-height, display-mm-width): + * whitespace.el (whitespace-check-leading-whitespace) + (whitespace-check-trailing-whitespace) + (whitespace-check-spacetab-whitespace) + (whitespace-check-indent-whitespace) + (whitespace-check-ateol-whitespace): + * progmodes/ada-xref.el (ada-convert-file-name): Fix typo in docstring. + +2008-01-23 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-arch.el (vc-arch-delete-rej-if-obsolete): Remove the + after-save-hook so that it is not called multiple times. + + * vc-svn.el (vc-svn-resolve-when-done): Likewise. + +2008-01-23 Eli Zaretskii <eliz@gnu.org> + + * view.el (view-file-other-window, view-file-other-frame): + Don't kill the buffer if it is modified. Doc fixes. + (kill-buffer-if-not-modified): New function. + (view-file): Don't kill the buffer if it is modified. + + * progmodes/ebrowse.el (ebrowse-view-file-other-window): Delete. + (ebrowse-view/find-file-and-search-pattern): + Call view-file-other-window instead of ebrowse-view-file-other-window. + (ebrowse-view-file-other-frame): Don't call + current-window-configuration. Fix second argument in the call to + view-mode-enter. Doc fix. + +2008-01-23 Richard Stallman <rms@gnu.org> + + * subr.el (atomic-change-group): Prevent undo list truncation. + +2008-01-23 Dan Nicolaescu <dann@ics.uci.edu> + + * files.el (safe-local-eval-forms): + Mark (add-hook 'write-file-hooks 'time-stamp) as safe. + +2008-01-23 Nick Roberts <nickrob@snap.net.nz> + + * comint.el (comint-insert-input): Set point first. + + * progmodes/gdb-ui.el (gdb-dequeue-input): Make doubly sure + session doesn't hang because gdb-pending-triggers is non-nil. + (gdb-frame-handler): Use buffer-file-name instead of + buffer-name in case of duplicate file names. + +2008-01-23 Dan Nicolaescu <dann@ics.uci.edu> + + * progmodes/verilog-mode.el (verilog-mode-map): Don't bind C-M-a, + C-M-e and C-M-h for emacs, they work by default. + (verilog-emacs-features): Remove. + (verilog-setup-dual-comments, verilog-populate-syntax-table): + Remove. Move syntax table initialization ... + (verilog-mode-syntax-table): ... here. + (verilog-mode): Don't initialize the syntax table here. + (verilog-mark-defun): Only do something useful for XEmacs, Emacs + does not need it. + +2008-01-23 Wilson Snyder <wsnyder@wsnyder.org> + + * progmodes/verilog-mode.el (verilog-booleanp): New function for + backward compatibility. Replace all uses of booleanp with + verilog-booleanp. + +2008-01-23 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-hg.el (vc-hg-diff): Don't pass an empty string. + +2008-01-23 Wilson Snyder <wsnyder@wsnyder.org> + + * progmodes/verilog-mode.el (top-level): Fix spacing. + (verilog-mode-version, verilog-mode-release-date): + Update version number. + (verilog-mode-release-emacs): New variable. + (compile-command, reporter-prompt-for-summary-p): + Define for byte compiler. + (verilog-startup-message-lines, verilog-startup-message-displayed) + (verilog-display-startup-message): Remove. + (verilog-highlight-p1800-keywords): Improve docstring. + (sigs-in, sigs-out, got-sig, got-rvalue, uses-delayed) + (vector-skip-list): Only defvar at compile time. + (verilog-highlight-translate-off, verilog-indent-level) + (verilog-indent-level-module, verilog-indent-level-declaration) + (verilog-indent-declaration-macros, verilog-indent-lists) + (verilog-indent-level-behavioral, verilog-indent-level-directive) + (verilog-cexp-indent, verilog-case-indent, verilog-auto-newline) + (verilog-auto-indent-on-newline, verilog-tab-always-indent) + (verilog-tab-to-comment, verilog-indent-begin-after-if) + (verilog-align-ifelse, verilog-minimum-comment-distance) + (verilog-auto-lineup, verilog-highlight-p1800-keywords) + (verilog-auto-endcomments, verilog-auto-read-includes) + (verilog-auto-star-expand, verilog-auto-star-save) + (verilog-library-flags, verilog-library-directories) + (verilog-library-files, verilog-library-extensions) + (verilog-active-low-regexp, verilog-auto-sense-include-inputs) + (verilog-auto-sense-defines-constant, verilog-auto-reset-widths) + (verilog-assignment-delay, verilog-auto-inst-vector) + (verilog-auto-inst-template-numbers, verilog-auto-input-ignore-regexp) + (verilog-auto-inout-ignore-regexp, verilog-auto-output-ignore-regexp) + (verilog-auto-unused-ignore-regexp, verilog-typedef-regexp): + Add safe-local-variable properties. + (verilog-statement-menu, verilog-company, verilog-re-search-forward) + (verilog-re-search-backward, verilog-error-regexp-add) + (verilog-end-block-re, verilog-emacs-features) + (verilog-populate-syntax-table, verilog-setup-dual-comments) + (verilog-type-font-keywords, verilog-inside-comment-p) + (electric-verilog-backward-sexp, verilog-backward-sexp) + (verilog-forward-sexp, verilog-font-lock-init, verilog-mode) + (electric-verilog-terminate-line, electric-verilog-semi) + (electric-verilog-tab, verilog-insert-1, verilog-insert-indices) + (verilog-generate-numbers, verilog-comment-region, verilog-label-be) + (verilog-beg-of-statement, verilog-in-case-region-p) + (verilog-in-struct-region-p, verilog-in-generate-region-p) + (verilog-in-fork-region-p, verilog-backward-case-item) + (verilog-set-auto-endcomments, verilog-get-expr) + (verilog-expand-vector-internal, verilog-surelint-off) + (verilog-batch-execute-func, verilog-calculate-indent) + (verilog-calc-1, verilog-calculate-indent-directive) + (verilog-leap-to-head, verilog-continued-line) + (verilog-backward-token, verilog-backward-syntactic-ws) + (verilog-forward-syntactic-ws, verilog-backward-ws&directives) + (verilog-forward-ws&directives, verilog-at-constraint-p) + (verilog-skip-backward-comments, verilog-indent-line-relative) + (verilog-do-indent, verilog-indent-comment, verilog-more-comment) + (verilog-pretty-declarations, verilog-pretty-expr) + (verilog-just-one-space, verilog-indent-declaration) + (verilog-get-completion-decl, verilog-goto-defun, verilog-showscopes) + (verilog-header, verilog-signals-combine-bus, verilog-read-decls) + (verilog-read-always-signals-recurse, verilog-read-instants) + (verilog-read-auto-template, verilog-set-define) + (verilog-read-defines, verilog-read-signals, verilog-getopt) + (verilog-is-number, verilog-expand-dirnames, verilog-modi-lookup) + (verilog-modi-cache-results, verilog-insert-one-definition) + (verilog-make-width-expression, verilog-delete-autos-lined) + (verilog-auto-save-check, verilog-auto-arg, verilog-auto-inst-port) + (verilog-auto-inst, verilog-auto-inst-param, verilog-auto-reg) + (verilog-auto-reg-input, verilog-auto-wire, verilog-auto-output) + (verilog-auto-output-every, verilog-auto-input, verilog-auto-inout) + (verilog-auto-inout-module, verilog-auto-sense, verilog-auto-reset) + (verilog-auto-tieoff, verilog-auto-unused, verilog-auto-ascii-enum) + (verilog-auto, verilog-sk-define-signal, verilog-mode-mouse-map) + (verilog-load-file-at-mouse, verilog-load-file-at-point) + (verilog-library-files): Cleanup spacing of )'s they should not be + on unique lines. Fix checkdoc warnings. + +2008-01-22 Glenn Morris <rgm@gnu.org> + + * progmodes/hideif.el (hide-ifdef-initially, hide-ifdef-read-only) + (hide-ifdef-lines, hide-ifdef-shadow): Remove autoload cookies + from defcustoms. + (hide-ifdef-shadow): Remove autoload cookie from defface. + + * vc.el (vc-diff-sentinel): Do not write a footer if there were + differences. + +2008-01-21 Reiner Steib <Reiner.Steib@gmx.de> + + * pcvs-defs.el (cvs-menu): Improve cvs-mode-find-file, + cvs-mode-find-file-other-window. Add cvs-mode-diff-yesterday and + manual entry. + +2008-01-21 Michael Albinus <michael.albinus@gmx.de> + + * net/dbus.el (dbus-ignore-errors): New macro. + (dbus-unregister-object): New defun. Moved from dbusbind.c. + (dbus-handle-event, dbus-list-activatable-names, dbus-list-names) + (dbus-list-queued-owners, dbus-get-name-owner, dbus-introspect) + (dbus-get-signatures): Apply `dbus-ignore-errors'. + +2008-01-21 Martin Rudalics <rudalics@gmx.at> + + * outline.el (outline-up-heading): Fix check for top level to + avoid infinite looping in hide-other. + +2008-01-21 Thien-Thi Nguyen <ttn@gnuvola.org> + + * vc.el (vc-process-sentinel): After calling the previous + sentinel, do nothing if the process' buffer is not live. + +2008-01-21 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * blank-mode.el: Fix a problem of cleaning blank faces when turning off + blank-mode in some buffers (like *info* buffers). Reported by Juanma + Barranquero <lekktu@gmail.com>. Eliminate `-face' suffix of all + blank-mode faces. Doc fix. New version 8.1. + (blank-turn-on, blank-turn-off): Replace (and CONDITION BODY) by (when + CONDITION BODY). + (blank-space-face): Face/option name replaced by blank-space. + (blank-hspace-face): Face/option name replaced by blank-hspace. + (blank-tab-face): Face/option name replaced by blank-tab. + (blank-newline-face): Face/option name replaced by blank-newline. + (blank-trailing-face): Face/option name replaced by blank-trailing. + (blank-line-face): Face/option name replaced by blank-line. + (blank-space-before-tab-face): Face/option name replaced by + blank-space-before-tab. + (blank-color-on, blank-color-off, blank-display-char-on): Fix code. + +2008-01-21 Juanma Barranquero <lekktu@gmail.com> + + * blank-mode.el (blank-style, blank-chars, blank-hspace-regexp) + (blank-space-regexp, blank-tab-regexp, blank-trailing-regexp) + (blank-space-before-tab-regexp, blank-global-modes, blank-mode) + (global-blank-mode): Doc fixes. + (blank, blank-space-face, blank-hspace-face, blank-tab-face) + (blank-newline-face, blank-trailing-face, blank-line-face) + (blank-space-before-tab-face, blank-display-mappings) + (blank-chars-value-list, blank-style-value-list, blank-toggle-options) + (global-blank-toggle-options, blank-help-text, blank-interactive-char) + (blank-turn-on, blank-turn-off, blank-color-on, blank-color-off): + Fix typos in docstrings. + +2008-01-21 Juanma Barranquero <lekktu@gmail.com> + + * server.el (server-log-time-function): New variable. + (server-log): Use it. + +2008-01-21 Glenn Morris <rgm@gnu.org> + + * progmodes/hideif.el: Move defcustoms and defface to start of file. + + * textmodes/org.el (org-entry-properties): Let-bind `clocksum'. + +2008-01-21 Juanma Barranquero <lekktu@gmail.com> + + * textmodes/org.el (org-unmodified, org-cycle-emulate-tab) + (org-descriptive-links, org-link-file-path-type) + (org-remember-use-refile-when-interactive) + (org-agenda-skip-timestamp-if-done, org-agenda-scheduled-leaders) + (org-export-ascii-bullets, org-agenda-deadline-faces) + (turn-on-orgstruct++, orgtbl-to-texinfo, org-mhe-get-header) + (org-batch-agenda, org-batch-agenda-csv, org-fix-agenda-info) + (org-kill-note-or-show-branches): Fix typos in docstrings. + +2008-01-20 Thien-Thi Nguyen <ttn@gnuvola.org> + + * vc.el (vc-process-sentinel): Set mode-line-process. + (vc-exec-after): Likewise, for the `run' process status. + +2008-01-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * ibuffer.el (ibuffer-mode): Fix last change. + +2008-01-20 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-hg.el (vc-hg-registered): + * vc-svn.el (vc-svn-registered): Make it work for non-existent files. + +2008-01-20 Martin Rudalics <rudalics@gmx.at> + + * repeat.el (repeat-undo-count): New variable. + (repeat): For self-insertions make undo boundary only after 20 + repetitions. Inhibit point recording unless repeat-repeat-char is nil. + +2008-01-19 Reiner Steib <Reiner.Steib@gmx.de> + + * net/imap.el (imap-ping-server): New variable. + (imap-opened): On add extra ping if imap-ping-server is non-nil. + (imap-ping-server): Minor doc string fixes. + +2008-01-19 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change) + + * net/imap.el (imap-ping-server): New function. + (imap-opened): Call imap-ping-server. + +2008-01-20 Glenn Morris <rgm@gnu.org> + + * progmodes/python.el: Quote all calls to "auxiliary skeleton"s to + prevent infloops. + +2008-01-20 Martin Svenson <phromo@gmail.com> (tiny change) + + * progmodes/python.el (python-imports): Default to "None". + +2008-01-19 Tom Tromey <tromey@redhat.com> + + * vc-svn.el (vc-svn-after-dir-status): New function. + (vc-svn-dir-status): Run svn asynchronously. + +2008-01-19 Martin Rudalics <rudalics@gmx.at> + + * progmodes/hideif.el (hide-ifdef-shadow): New option. + (hide-ifdef-shadow): New face. + (hide-ifdef-toggle-shadowing): New function to toggle between + shadowing and making code invisible. + (hide-ifdef-mode-submap): Add binding for hide-ifdef-toggle-shadowing. + (hide-ifdef-mode-menu): Add entry for hide-ifdef-toggle-shadowing. + (hide-ifdef-region-internal): Give new overlay hide-ifdef + property. Shadow text when hide-ifdef-shadow is non-nil. + (hif-show-ifdef-region): Remove overlays with hide-ifdef property set. + (hif-hide-line): Use when instead of if. + (hide-ifdef-initially, hide-ifdef-read-only, hide-ifdef-lines): + Remove unneeded * from doc-strings. + +2008-01-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * doc-view.el (doc-view-goto-page): Don't move point any more, now that + the hscroll behavior was fixed. + (doc-view-mode): Disable auto-hscroll-mode. + +2008-01-18 Tom Tromey <tromey@redhat.com> + + * vc-svn.el (vc-svn-dir-status): New function. + +2008-01-18 Dan Nicolaescu <dann@ics.uci.edu> + + * vc.el: Make vc-status asynchronous. + (vc-update-vc-status-buffer): New function broken out of ... + (vc-status-refresh): ... here. Pass vc-update-vc-status-buffer to + the dir-status backend function. + + * vc-hg.el (vc-hg-dir-status): Compute the status asynchronously. + Move the output processing to ... + (vc-hg-after-dir-status): ... here. Call the function passed as + an argument with the results. + +2008-01-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * doc-view.el (doc-view-pdf/ps->png): Make sure we a have a valid cwd. + (doc-view-insert-image): Do something if the image is missing. + (doc-view-mode): Don't use file-remote-p. + +2008-01-18 Bastien Guerry <Bastien.Guerry@ens.fr> + + * textmodes/org-export-latex.el (org-export-latex-cleaned-string): Fix. + (org-export-latex-special-chars): Convert "..." in \ldots + and skip tables. + (org-export-latex-fontify-headline): Change parameter name. + (org-export-as-latex): Handle export of subtrees. + (org-export-latex-make-header): New argument TITLE. + (org-export-latex-content): New argument EXCLUDE-LIST. + (org-list-parse-list): New name for org-export-latex-parse-list. + (org-export-latex-make-header): New name for + org-export-latex-make-preamble. + (org-list-to-generic): New name of org-export-list-to-generic. + (org-list-to-latex): New name of org-export-list-to-latex. + (org-list-item-begin, org-list-end, org-list-insert-radio-list) + (org-list-send-list, org-list-to-texinfo) + (org-list-to-html): New functions. + (org-export-latex-tables-column-borders) + (org-export-latex-default-class, org-export-latex-classes) + (org-export-latex-classes-sectioning) + (org-list-radio-list-templates): New options. + (org-export-latex-header): New variable. + (org-latex-entities): New constant. + (org-export-latex-default-sectioning, org-export-latex-preamble) + (org-export-latex-prepare-text-option) + (org-export-latex-get-sectioning): Remove. + +2008-01-18 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org-publish.el (org-publish-current-project): + Fix bug with forcing publication. + + * textmodes/org.el (org-export-with-special-strings): New option. + (org-export-html-convert-special-strings): New function. + (org-html-do-expand): `org-export-html-convert-special-strings' + added to the list of conversion. + (org-infile-export-plist, org-get-current-options): Add support + for "-" in the #+OPTION line to let user switch on/off special + strings conversion. + (org-export-plist-vars): New :html-table-tag property. + (org-export-as-html, org-format-org-table-html) + (org-format-table-table-html) Use the :html-table-tag property + instead of the `org-export-html-table-tag' global value. + (org-additional-option-like-keywords): Add "TBLFM". + (org-entry-properties): Include the CLOCKSUM special property. + (org-columns-edit-value): Do not allow to edit the special + CLOCKSUM property. + (org-flag-drawer): Use the original value of `outline-regexp'. + (org-remember-handler): Add invisible-ok flag to call to + `org-end-of-subtree'. + (org-agenda-highlight-todo): Respect + `org-agenda-todo-keyword-format'. + (org-agenda-todo-keyword-format): New option. + (org-infile-export-plist): No restriction while searching for options. + (org-remember-handler): Remove comments at the end of the buffer. + (org-remember-use-refile-when-interactive): New option. + (org-table-sort-lines): Make sure sorting works on link + descritions only, and ignores the link. + (org-sort-entries-or-items): Make sure the end of the subtree is + included. + (org-refile-use-outline-path): New allowed values `file' and + `full-file-path'. + (org-get-refile-targets): Respect new values for + `org-refile-use-outline-path'. + (org-agenda-get-restriction-and-command): DEL goes back to initial list. + (org-export-as-xoxo): Restore point when done. + (org-open-file): Allow multiple %s in command. + (org-clock-in-switch-to-state): New option. + (org-first-list-item-p): New function. + (org-last-remember-storage-locations): New variable. + (org-get-refile-targets): Interpret the new maxlevel setting. + (org-refile-targets): New option `:maxlevel'. + (org-copy-subtree): Include empty lines before but not after subtree. + (org-back-over-empty-lines, org-skip-whitespace): New functions. + (org-move-item-down, org-move-item-up): Include empty lines before + but not after item. + (org-first-sibling-p): New function. + (org-remember-apply-template): Defaults, completions and history + for template prompts. Also, interpret new `%!' escape. + (org-context-choices): New constant. + (org-bound-and-true-p): New macro. + (org-imenu-depth): New option. + (org-imenu-markers): New variable. + (org-imenu-new-marker, org-imenu-get-tree) + (org-speedbar-set-agenda-restriction): New functions. + (org-agenda-set-restriction-lock) + (org-agenda-remove-restriction-lock) + (org-agenda-maybe-redo): New functions. + (org-agenda-restriction-lock): New face. + (org-agenda-restriction-lock-overlay) + (org-speedbar-restriction-lock-overlay): New variables. + (org-open-at-point): Remove obsolete way to do redirection in + shell links. + (org-imenu-and-speedbar): New customization group. + (org-entry-properties): Return keyword-less time strings. + (org-clock-heading-function): New option. + (org-clock-in): Use `org-clock-heading-function'. + (org-calendar-holiday): Try to use `calendar-check-holidays' + instead of the obsolete `check-calendar-holidays'. + (org-export-html-special-string-regexps): New constant. + (org-massive-special-regexp): New variable. + (org-compute-latex-and-specials-regexp) + (org-do-latex-and-special-faces): New functions. + (org-latex-and-export-specials): New face. + (org-highlight-latex-fragments-and-specials): New option. + (org-link-escape-chars): Use characters instead of strings. + (org-link-escape-chars-browser, org-link-escape) + (org-link-unescape): Use characters instead of strings. + (org-export-html-convert-sub-super, org-html-do-expand): Check for + protected text. + (org-emphasis-alist): Additional `verbatim' flag. + (org-set-emph-re): Handle the verbatim flag and compute + `org-verbatim-re'. + (org-cleaned-string-for-export): Protect verbatim elements. + (org-verbatim-re): New variable. + (org-hide-emphasis-markers): New option. + (org-additional-option-like-keywords): Add new keywords. + (org-get-entry): Rename from `org-get-cleaned-entry'. + (org-icalendar-cleanup-string): New function for quoting icalendar text. + (org-agenda-skip-scheduled-if-done): New option. + (org-agenda-get-scheduled, org-agenda-get-blocks): Use + `org-agenda-skip-scheduled-if-done'. + (org-prepare-agenda-buffers): Allow buffers as arguments. + (org-entry-properties): Add CATEGORY as a special property. + (org-use-property-inheritance): Allow a list of properties as a value. + (org-eval-in-calendar): No longer update the prompt. + (org-read-date-popup-calendar): Rename from + `org-popup-calendar-for-date-prompt'. + (org-read-date-display-live): New variable. + (org-read-date-display): New function. + (org-read-date-analyze): New function. + (org-remember-apply-template): Define `remember-finalize' if it is + not yet defined. + (org-remember-insinuate): New function. + (org-read-date-prefer-future): New option. + (org-read-date): Respect the setting of + `org-read-date-prefer-future'. Use `org-read-date-analyze'. + (org-set-font-lock-defaults): Use `org-archive-tag' instead of a + hardcoded string. + (org-remember-apply-template): Use `remember-finalize' instead of + `remember-buffer'. + (org-columns-compute, org-column-number-to-string) + (org-columns-uncompile-format, org-columns-compile-format) + (org-columns-compile-format): Handle printf format specifier. + (org-columns-new, org-column-number-to-string) + (org-columns-uncompile-format, org-columns-compile-format): + Support for new currency summary type. + (org-tree-to-indirect-buffer): Do not kill old buffer when + `org-indirect-buffer-display' is `new-frame'. + (org-indirect-buffer-display): Document that `new-frame' leads to + indiret buffer proliferation. + (org-agenda-list): Use `org-extend-today-until'. + (org-extend-today-until): New option. + (org-format-org-table-html): Use lower-case for <col> tag. + (org-agenda-execute): New command. + (org-agenda-mode-map): Keybindings of "g" "G", "e" modified. + (org-select-remember-template): New function. + (org-remember-apply-template): Use `org-select-remember-template'. + (org-go-to-remember-target): New function. + +2008-01-18 Dan Nicolaescu <dann@ics.uci.edu> + + * vc.el: Add a TODO note about vc-state. + (vc-next-action): Register 'unregistered and 'ignored files. + Use when and unless instead of if where appropriate. + (vc-start-entry): Fix typo. + (vc-status): Autoload it. + +2008-01-18 Glenn Morris <rgm@gnu.org> + + * ffap.el (ffap-alist): Remove space from RFC regexp. + +2008-01-18 Richard Stallman <rms@gnu.org> + + * custom.el (custom-theme-recalc-face): Use face-spec-set rather + than face-spec-recalc. + +2008-01-18 Glenn Morris <rgm@gnu.org> + + * ibuffer.el (ibuffer-mode): Fix typo in previous change. + +2008-01-17 Vinicius Jose Latorre <viniciusjl@ig.com.br> + Miles Bader <miles@gnu.org> + + * blank-mode.el: New file. Minor mode to visualise (HARD) SPACE, + TAB, NEWLINE. Miles Bader <miles@gnu.org> wrote the original code + for handling display table (via visws.el package), his code was + modified, but the main idea was kept. + +2008-01-17 Glenn Morris <rgm@gnu.org> + + * ibuf-ext.el (ibuffer-auto-mode, ibuffer-save-filter-groups) + (ibuffer-save-filters): Remove calls to deleted + ibuffer-update-mode-name. + +2008-01-16 Martin Rudalics <rudalics@gmx.at> + + * longlines.el (longlines-mode, longlines-show-region) + (longlines-unshow-hard-newlines): Bind buffer-file-name and + buffer-file-truename to nil while modifying buffer. + + * cus-edit.el (custom-reset-standard-variables-list) + (custom-reset-standard-faces-list): New variables. + (custom-reset-standard-save-and-update): New function. + (Custom-save): Apply custom-mark-to-save before and + custom-state-set-and-redraw after saving options. + (Custom-reset-standard): Apply custom-mark-to-reset-standard to + options and call custom-reset-standard-save-and-update. + (custom-variable, custom-face, custom-group): Provide new + entries for custom-mark-to-save, custom-mark-to-reset-standard, + and custom-state-set-and-redraw. + (custom-variable-mark-to-save) + (custom-variable-state-set-and-redraw) + (custom-variable-mark-to-reset-standard) + (custom-face-mark-to-save, custom-face-state-set-and-redraw) + (custom-face-mark-to-reset-standard) + (custom-group-mark-to-save, custom-group-state-set-and-redraw) + (custom-group-mark-to-reset-standard): New functions. + (custom-variable-save): Move save, state-set, and redraw + functionality to custom-variable-mark-to-save. + (custom-face-save): Move save, state-set, and redraw + functionality to custom-face-mark-to-save. + (custom-group-save): Move save, state-set, and redraw + functionality to custom-group-mark-to-save. + (custom-variable-reset-standard, custom-face-reset-standard) + (custom-group-reset-standard): Move save, state-set, and redraw + functionality to custom-reset-standard-save-and-update. + + (custom-buffer-create-internal): Fix text in verbose help. + (custom-face-value-create): Indent doc-strings of faces like + those of variables. + +2008-01-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * server.el (server-process-filter): Replace lineno and columnnno + which defaulted to 1&0 with filepos which defaults to nil. + (server-goto-line-column): Only receive the filepos. + Only move if filepos is non-nil. + (server-visit-files): Slight restructure to consolidate two calls to + server-goto-line-column into just one. + + * nxml/nxml-mode.el (nxml-mode): Use mode-line-process to indicate + the use of degraded mode. + (nxml-degrade): Don't change mode-name. + + * nxml/rng-nxml.el (rng-nxml-mode-init): + Don't overwrite mode-line-process. + + * ibuffer.el (mode): Pass the buffer to format-mode-line. + (ibuffer-update-mode-name): Remove. + (ibuffer-redisplay, ibuffer-update, ibuffer-mode): Don't call it. + (ibuffer-mode): Use mode-line-process instead. + + * ibuf-ext.el (ibuffer-auto-update-changed, ibuffer-auto-mode): + Use derived-mode-p. + (ibuffer-mark-by-mode-regexp): Pass the buffer to format-mode-line. + + * help.el (describe-mode): Pass the right buffer to format-mode-line. + +2008-01-16 Glenn Morris <rgm@gnu.org> + + * comint.el (comint-regexp-arg): Fix no-input case. + +2008-01-16 Dan Nicolaescu <dann@ics.uci.edu> + + * smerge-mode.el (smerge-start-session): Rename from smerge-auto. + * pcvs.el (cvs-revert-if-needed): + * vc.el (vc-maybe-resolve-conflicts): Rename callers. + + * vc-svn.el (vc-svn-find-file-hook): + * vc-arch.el (vc-arch-find-file-hook): Undo previous change. + +2008-01-16 Ulf Jasper <ulf.jasper@web.de> + + * calendar/icalendar.el (icalendar-version): Increase to 0.16. + (icalendar-export-file, icalendar-import-file): + Restore significant trailing whitespace in `interactive' prompts. + +2008-01-16 Tom Tromey <tromey@redhat.com> + + * calendar/icalendar.el (icalendar--convert-tz-offset) + (icalendar--parse-vtimezone, icalendar--convert-all-timezones) + (icalendar--find-time-zone): New functions. + (icalendar--decode-isodatetime): Add `zone' argument, passed to + `decode-time'. Doc fix. + (icalendar--convert-ical-to-diary): Compute zone-map. + Pass timezone to icalendar--decode-isodatetime. + +2008-01-16 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-vars.el (c-constant-symbol): Put this defun inside + an eval-and-compile, so as to permit byte-compiling (e.g. in + bootstrap). + +2008-01-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/easymenu.el (easy-menu-avoid-duplicate-keys): New var. + (easy-menu-create-menu, easy-menu-convert-item-1): Use it to avoid + using the same key for different menu entries. + + * smerge-mode.el (smerge-refine): Also work on "same change conflicts". + (smerge-makeup-conflict): New command. + +2008-01-15 Thien-Thi Nguyen <ttn@gnuvola.org> + + * log-edit.el (log-edit): Doc fix. + +2008-01-15 Glenn Morris <rgm@gnu.org> + + * diff-mode.el (diff-end-of-hunk): Revert 2008-01-08 change. + +2008-01-14 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-vars.el (c-constant-symbol): New function which + supersedes c-const-symbol. During a customize-.. call it enables + an element of (e.g.) c-hanging-braces alist to have its name + displayed, even when the default value of c-h-b etc. doesn't + include the elemnt. Replace uses of the old function by the new. + + * progmodes/cc-vars.el (c-hanging-braces-alist): Remove the + obscure non-working fragment ":value c-". + +2008-01-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * abbrev.el (clear-abbrev-table): Can't pass a symbol to intern. + +2008-01-14 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-local-host-p): Use `tramp-file-name-host' + instead of `tramp-file-name-real-host'. + + * net/trampver.el: Update release number. + +2008-01-14 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-engine.el (c-guess-basic-syntax): Prevent a macro + call inside a struct being recognised as a K&R argument. + +2008-01-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/compile.el (compilation-error-regexp-alist-alist): + Accept "fatal error" from MSFT. + Reported by Jared Finder <jfinder@crypticstudios.com>. + +2008-01-14 Dan Nicolaescu <dann@ics.uci.edu> + + * smerge-mode.el (smerge-auto): New function. + * vc-svn.el (vc-svn-find-file-hook): + * vc-arch.el (vc-arch-find-file-hook): + * pcvs.el (cvs-revert-if-needed): + * vc.el (vc-maybe-resolve-conflicts): Use it instead of vc-mode. + (top-level): Add a Todo list. + +2008-01-13 Dan Nicolaescu <dann@ics.uci.edu> + + * vc.el (vc-update): Resolve conflicts if necessary instead of + just updating the buffer. + + * vc-cvs.el (vc-cvs-merge-news): Ignore the error status of the + update command so that we can parse the output. + +2008-01-13 Martin Rudalics <rudalics@gmx.at> + + * mail/rmail.el (rmail-convert-to-babyl-format): + Remove save-excursion to avoid infinite looping. + Reported by: dnz <dnz@bk.ru>. + +2008-01-12 Glenn Morris <rgm@gnu.org> + + * woman.el (woman-parse-numeric-arg): Change handling of `==': + can be interned without a function definition. + +2008-01-12 Jason Rumney <jasonr@gnu.org> + + * nxml/nxml-mode.el (nxml-enable-unicode-char-name-sets) + (rng-nxml-mode-init): Declare. + +2008-01-11 Jason Rumney <jasonr@gnu.org> + + * nxml/rng-nxml.el (rng-preferred-prefix-alist): Add some defaults. + (rng-preferred-prefix-alist-default): Remove. + + * nxml/nxml-uchnm.el (nxml-internal-unicode-char-name-sets-enabled): + Rename from nxml-enable-unicode-char-name-sets-flag. + (nxml-enable-unicode-char-name-sets-1): Merge into + nxml-enable-unicode-char-name-sets. + (nxml-enable-unicode-char-name-sets): Don't unconditionally set + nxml-char-name-ignore-case here. + + * nxml/nxml-mode.el (nxml-mode): Call rng-nxml-mode-init directly. + Update doc string and commentary. + (nxml-char-name-ignore-case): Change default value. + (nxml-mode): Call nxml-enable-unicode-char-name-sets directly. + +2008-01-11 Martin Rudalics <rudalics@gmx.at> + + * cus-start.el (all): Add missing version entries. + +2008-01-11 Glenn Morris <rgm@gnu.org> + + * language/china-util.el (big5-to-flat-code, flat-code-to-big5) + (euc-to-flat-code, flat-code-to-euc): + * textmodes/org.el (elmo-msgdb-overview-get-entity) + (wl-summary-buffer-msgdb): Declare as funtions. + +2008-01-10 Martin Rudalics <rudalics@gmx.at> + + * progmodes/ada-mode.el (ada-set-syntax-table-properties): + Bind buffer-file-name and buffer-file-truename. + + * fringe.el (fringe-mode-explicit): New variable. + (set-fringe-mode): Don't alter default-frame-alist when just + loading this file. + +2008-01-10 Tassilo Horn <tassilo@member.fsf.org> + + * doc-view.el (doc-view-buffer-file-name): New variable. + (doc-view-convert-current-doc, doc-view-search) + (doc-view-current-cache-dir, doc-view-initiate-display) + (doc-view-mode): Use it. + (doc-view-bookmark-make-cell): Use variable buffer-file-name + instead of function. + +2008-01-10 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-svn.el (vc-svn-registered): Return the correct value for + ignored and unregistered files. + +2008-01-10 Tassilo Horn <tassilo@member.fsf.org> + + * doc-view.el (tramp): Require tramp because we use tramp-tramp-file-p. + +2008-01-10 Tom Tromey <tromey@redhat.com> + + * vc.el (vc-status-unmark-all-files): New function. + (vc-status-unmark-all-files): Likewise. + (vc-status-mode-map): Add bindings. + +2008-01-10 Michael Kifer <kifer@cs.stonybrook.edu> + + * ediff*.el: Uncomment declare-function. + + * viper*.el: Uncomment declare-function. + +2008-01-09 Tassilo Horn <tassilo@member.fsf.org> + + * doc-view.el (doc-view-mode): Support tramp, compressed files and + files inside archives uniformly. + +2008-01-09 Eric S. Raymond <esr@snark.thyrsus.com> + + * testmodes/sgml-mode.el (sgml-tag-syntax-table): Initialize this + constant with a computation on sgml-specials rather than a literal + list. Without this change the syntax table is generated + incorrectly, and the mode will think it's in a comment following + any instance of the string "--". + +2008-01-09 Tassilo Horn <tassilo@member.fsf.org> + + * doc-view.el (doc-view-mode-p): Add EPS as supported type. + (doc-view-mode): Support document files inside archives. + +2008-01-09 Dan Nicolaescu <dann@ics.uci.edu> + + * vc.el (vc-deduce-fileset): Return the currently selected file if + no files are selected when using vc-status. + +2008-01-09 Michael Kifer <kifer@cs.stonybrook.edu> + + * ediff*.el: Comment out declare-function. "make bootstrap" + stops with an error and Emacs does not compile with those things in. + Besides, declare-function is not defined in XEmacs. + + * ediff-util (eqiff-quit): Autoraise minibuffer. + + * ediff-diff (ediff-convert-fine-diffs-to-overlays): Make it a defun. + + * viper*.el: Comment out declare-function -- not defined in XEmacs. + + * viper-ex.el (viper-info-on-file): Take care of indirect buffers. + + * viper.el (viper-set-hooks, set-cursor-color): + Set viper-vi-state-cursor-color. + +2008-01-09 Tom Tromey <tromey@redhat.com> + + * vc.el (vc-status-headers): Rename from vc-status-insert-headers. + Just return header. + (vc-status-move-to-goal-column): New function. + (vc-status-mode-map): Define more keys. + (vc-status-mode): Use vc-status-refresh. Now 'special. + (vc-status-refresh): New function. + (vc-status-next-line): Likewise. + (vc-status-previous-line): Likewise. + (vc-status-mark-file): Use vc-status-next-line. + (vc-status-unmark-file): Use vc-status-previous-line. + (vc-status-unmark-file-up): New function. + (vc-status-register): Likewise. + (vc-status-find-file): Likewise. + (vc-status-find-file-other-window): Likewise. + (vc-status-current-file): Likewise. + (vc-ensure-vc-buffer): Understand vc-status mode. + + * vc-hg.el (vc-hg-dir-status): Don't pass -A to "hg status". + +2008-01-09 Glenn Morris <rgm@gnu.org> + + * ffap.el (ffap-string-at-point-mode-alist): Add `\' to file + entry, for Windows. + +2008-01-09 Tom Tromey <tromey@redhat.com> + + * play/blackbox.el (blackbox-mode-map): Add `q' and [return] bindings. + +2008-01-09 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * ps-print.el: Some face attributes (like :strike-through) were not + being recognised. Reported by Leo <sdl.web@gmail.com>. + (ps-print-version): New version 6.8.2. + (ps-face-strikout-p, ps-face-overline-p, ps-face-box-p): New funs. + (ps-screen-to-bit-face): Fix code. + +2008-01-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * ffap.el (ffap-read-file-or-url): Don't use let-binding to temporarily + add a file-name handler. + +2008-01-08 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> + + * textmodes/bibtex.el (bibtex-initialize): New autoloaded command. + Rename from function bibtex-files-expand. New optional arg select. + (bibtex-flash-head): Allow blink-matching-delay being zero. + (bibtex-clean-entry): Use atomic-change-group. + (bibtex-format-entry): Check presence of required fields only + after formatting of fields. Use member-ignore-case. Do not use + bibtex-parse-entry. Do not use booktitle field to set a missing title. + (bibtex-autofill-entry): Do not call undo-boundary. + (bibtex-lessp): Handle crossref keys that point to another bibtex file. + (bibtex-sort-buffer, bibtex-prepare-new-entry, bibtex-validate): + Parse keys if necessary. 2008-01-08 Nick Roberts <nickrob@snap.net.nz> @@ -10,8 +1294,8 @@ 2008-01-08 Nick Roberts <nickrob@snap.net.nz> - * progmodes/gdb-ui.el (gud-gdb-command-name): Explain - "--annotate=3" option is necessary for the Graphical Interface. + * progmodes/gdb-ui.el (gud-gdb-command-name): + Explain "--annotate=3" option is necessary for the Graphical Interface. 2008-01-08 Nick Roberts <nickrob@snap.net.nz> @@ -79,10 +1363,8 @@ * time-stamp.el (time-stamp-time-zone): * whitespace.el (whitespace-check-buffer-leading) - (whitespace-check-buffer-trailing) - (whitespace-check-buffer-indent) - (whitespace-check-buffer-spacetab) - (whitespace-check-buffer-ateol): + (whitespace-check-buffer-trailing, whitespace-check-buffer-indent) + (whitespace-check-buffer-spacetab, whitespace-check-buffer-ateol): * progmodes/sh-script.el (sh-indentation): * textmodes/ispell.el (ispell-local-pdict): Add safe-local-variable properties. @@ -212,8 +1494,7 @@ * vc-arch.el (vc-arch-root): Only set a property if the file is managed by this backend. - * vc-hg.el (vc-hg-state): Support the new status code for - up-to-date. + * vc-hg.el (vc-hg-state): Support the new status code for up-to-date. 2008-01-04 Tassilo Horn <tassilo@member.fsf.org> @@ -223,8 +1504,8 @@ * doc-view.el (doc-view-scroll-up-or-next-page) (doc-view-scroll-down-or-previous-page): Use image-scroll-up and - image-scroll-down instead of the non-image equivalents. Don't - rely on a signalled condition but switch pages when scrolling + image-scroll-down instead of the non-image equivalents. + Don't rely on a signalled condition but switch pages when scrolling doesn't change the vertical position anymore. (doc-view-mode-map): Remap scroll-{up,down} to image-scroll-{up,down}. @@ -242,7 +1523,8 @@ * bs.el (bs--sort-by-mode, bs--get-mode-name): * imenu.el (imenu-add-to-menubar): * makesum.el (make-command-summary): - * mouse.el (mouse-major-mode-menu, mouse-popup-menubar, mouse-buffer-menu): + * mouse.el (mouse-major-mode-menu, mouse-popup-menubar) + (mouse-buffer-menu): * msb.el (msb--mode-menu-cond): * calc/calc-embed.el (calc-do-embedded): * emacs-lisp/helper.el (Helper-describe-mode): @@ -257,7 +1539,8 @@ * progmodes/ada-xref.el (ada-prj-find-prj-file): * progmodes/ada-mode.el (comment-region): * calendar/todo-mode.el (todo-insert-item): - * bookmark.el (bookmark-buffer-name): Test major-mode rather than mode-name. + * bookmark.el (bookmark-buffer-name): + Test major-mode rather than mode-name. 2008-01-04 Richard Stallman <rms@gnu.org> @@ -328,13 +1611,13 @@ * progmodes/grep.el (grep-find-ignored-directories): Initialize from the value of vc-directory-exclusion-list. - * vc-hooks (vc-directory-exclusion-list): Include "_darcs", + * vc-hooks (vc-directory-exclusion-list): Include "_darcs", even though we don't have a back end for darcs yet. 2008-01-02 Karl Fogel <kfogel@red-bean.com> - Change a return type, for greater extensibility. See - http://lists.gnu.org/archive/html/emacs-devel/2007-12/msg01077.html + Change a return type, for greater extensibility. + See http://lists.gnu.org/archive/html/emacs-devel/2007-12/msg01077.html and its thread for discussion leading to this change. * emacs-cvs/lisp/bookmark.el: @@ -396,10 +1679,10 @@ 2008-01-01 Eric S. Raymond <esr@snark.thyrsus.com> - * vc-svn.el (vc-svn-parse-status): Set the 'unregisted property + * vc-svn.el (vc-svn-parse-status): Set the `unregisted' property correctly. - * vc.el (vc-dired-hook): Speed tuning. Replace a vc-backend call + * vc.el (vc-dired-hook): Speed tuning. Replace a vc-backend call with vc-state. (vc-next-action): Fix vc-transfer-file call. @@ -889,6 +2172,12 @@ * newcomment.el (comment-region-default): Don't triple the comment starter if the first region line isn't indented enough. +2007-12-21 Teodor Zlatanov <tzz@lifelogs.com> + + * net/imap.el (imap-authenticate): Use current-buffer instead of + buffer, for the cases where imap-authenticate is called with a nil + buffer parameter. + 2007-12-21 Martin Rudalics <rudalics@gmx.at> * autoinsert.el (auto-insert-alist): Remove nonsensical precision @@ -1579,6 +2868,12 @@ * textmodes/reftex-toc.el (reftex-make-separate-toc-frame): Try x-focus-frame before focus-frame. Only try focus-frame on XEmacs. +2007-12-03 Nathan J. Williams <nathanw@MIT.EDU> (tiny change) + + * net/imap.el (imap-mailbox-status-asynch): Upcase STATUS items. + (imap-parse-status): Upcase status-att for servers that sends them + lower-case (e.g., MS Exchange 2007). + 2007-12-03 Karl Fogel <kfogel@red-bean.com> * saveplace.el (save-place-quiet): Remove, reverting 2007-12-02T19:54:46Z!kfogel@red-bean.com. @@ -4771,7 +6066,7 @@ Require tramp-cmds.el. (tramp-make-tramp-temp-file): We can get rid of DONT-CREATE. (tramp-handle-file-name-all-completions): Expand DIRECTORY. - (tramp-do-copy-or-rename-file-directly): Make more rigid checks. + (tramp-do-copy-or-rename-file-directly): Make more rigid checks. (tramp-do-copy-or-rename-file-out-of-band) (tramp-maybe-open-connection): Use `make-temp-name'. This is possible, because we don't need to create the temporary file, but @@ -7117,18 +8412,6 @@ * net/browse-url.el (browse-url-encode-url): Use copy-sequence. Reported by Jan Dj,Ad(Brv <jan.h.d@swipnet.se>. -2007-09-10 Stefan Monnier <monnier@iro.umontreal.ca> - - * progmodes/python.el: Merge changes from Dave Love's v2007-Sep-10. - (python-font-lock-keywords): Update to the 2.5 version of the language. - (python-quote-syntax): Let-bind font-lock-syntactic-keywords to nil. - (python-backspace): Only behave funny in code. - (python-compilation-regexp-alist): Add PDB stack trace regexp. - (inferior-python-mode): Add PDB prompt regexp. - (python-fill-paragraph): Refine the fenced-string regexp. - (python-find-imports): Handle imports spanning several lines. - (python-mode): Add `class' to hideshow support. - 2007-09-10 Dave Love <fx@gnu.org> * 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 @@ 2007-04-15 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> * textmodes/bibtex.el (bibtex-field-list): Use functionp. - (bibtex-make-field): Check that INIT is a string. Use functionp. + (bibtex-make-field): Check that INIT is a string. Use functionp. 2007-04-14 Glenn Morris <rgm@gnu.org> @@ -1214,7 +1214,7 @@ * progmodes/idlw-help.el (idlwave-do-context-help1): Don't visit special help topics for keywords. (idlwave-help-assistant-command): Include ".exe" for ms-dos - etc. Assistant command. + etc. Assistant command. 2007-03-08 Chong Yidong <cyd@stupidchicken.com> @@ -2133,7 +2133,7 @@ (newsticker--decode-iso8601-date): Bugfix for datestrings without days. (newsticker--buffer-do-insert-text): Fix. - (newsticker--buffer-insert-enclosure): Fix. length might be missing. + (newsticker--buffer-insert-enclosure): Fix. Length might be missing. (newsticker--buffer-make-item-completely-visible): `switch-to-buffer' not necessary. @@ -5365,7 +5365,7 @@ After 5.3, 5.4: (cperl-facemenu-add-face-function): Add docs, fix U<>. Copyright message updated. - (cperl-init-faces): Work around a bug in `font-lock'. May slow + (cperl-init-faces): Work around a bug in `font-lock'. May slow facification down a bit. Misprint for my|our|local for old `font-lock' "our" was not fontified same as "my|local". @@ -5881,7 +5881,7 @@ 2006-09-26 Vinicius Jose Latorre <viniciusjl@ig.com.br> - * progmodes/ebnf2ps.el: Doc fix. Implement arrow spacing and scaling. + * progmodes/ebnf2ps.el: Doc fix. Implement arrow spacing and scaling. (ebnf-version): New version 4.3. (ebnf-arrow-extra-width, ebnf-arrow-scale): New options. (ebnf-prologue): Adjust PostScript programming. @@ -33349,7 +33349,7 @@ See ChangeLog.11 for earlier changes. ;; add-log-time-zone-rule: t ;; End: - Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc. + Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc. This file is part of GNU Emacs. 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 @@ (gnus-request-accept-article): Make sure there's a newline at the end of the buffer. (gnus-adjust-marked-articles): Don't remove illegal ticked - articles (for forwards compatability). + articles (for forwards compatibility). 1996-02-03 Lars Magne Ingebrigtsen <larsi@aegir.ifi.uio.no> 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 @@ * international/characters.el (script-list): Add cham. +2008-01-17 Mark A. Hershberger <mah@everybody.org> + + * xml.el (xml-escape-string): Don't do any encoding changes on the + string. + 2008-01-16 Kenichi Handa <handa@ni.aist.go.jp> * 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." (aset table i 0)) ;; Preserve the table's properties. (assert sym) - (intern sym table) + (let ((newsym (intern "" table))) + (set newsym nil) ; Make sure it won't be confused for an abbrev. + (setplist newsym (symbol-plist sym))) (abbrev-table-put table :abbrev-table-modiff (1+ (abbrev-table-get table :abbrev-table-modiff))))) 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." ;; backward-compatibility alias (put 'change-log-acknowledgement-face 'face-alias 'change-log-acknowledgement) +(defconst change-log-file-names-re "^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)") +(defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*") + (defvar change-log-font-lock-keywords - '(;; + `(;; ;; Date lines, new (2000-01-01) and old (Sat Jan 1 00:00:00 2000) styles. ;; Fixme: this regepx is just an approximate one and may match ;; 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." (2 'change-log-email))) ;; ;; File names. - ("^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)" + (,change-log-file-names-re (2 'change-log-file) ;; Possibly further names in a list: ("\\=, \\([^ ,:([\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." 3 'change-log-acknowledgement)) "Additional expressions to highlight in Change Log mode.") +(defun change-log-search-file-name (where) + "Return the file-name for the change under point." + (save-excursion + (goto-char where) + (beginning-of-line 1) + (if (looking-at change-log-start-entry-re) + ;; We are at the start of an entry, search forward for a file + ;; name. + (progn + (re-search-forward change-log-file-names-re nil t) + (match-string 2)) + (if (looking-at change-log-file-names-re) + ;; We found a file name. + (match-string 2) + ;; Look backwards for either a file name or the log entry start. + (if (re-search-backward + (concat "\\(" change-log-start-entry-re + "\\)\\|\\(" + change-log-file-names-re "\\)") nil t) + (if (match-beginning 1) + ;; We got the start of the entry, look forward for a + ;; file name. + (progn + (re-search-forward change-log-file-names-re nil t) + (match-string 2)) + (match-string 4)) + ;; We must be before any file name, look forward. + (re-search-forward change-log-file-names-re nil t) + (match-string 2)))))) + +(defun change-log-find-file () + "Visit the file for the change under point." + (interactive) + (let ((file (change-log-search-file-name (point)))) + (if (and file (file-exists-p file)) + (find-file file) + (message "No such file or directory: %s" file)))) + (defvar change-log-mode-map (let ((map (make-sparse-keymap))) (define-key map [?\C-c ?\C-p] 'add-log-edit-prev-comment) (define-key map [?\C-c ?\C-n] 'add-log-edit-next-comment) + (define-key map [?\C-c ?\C-f] 'change-log-find-file) map) "Keymap for Change Log major mode.") @@ -1101,8 +1143,6 @@ Has a preference of looking backwards." (change-log-get-method-definition-1 "")) (concat change-log-get-method-definition-md "]")))))) -(defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*") - (defun change-log-sortable-date-at () "Return date of log entry in a consistent form for sorting. 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 @@ ;; Author: Ken Manheimer <ken dot manheimer at gmail dot com> ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> -;; Created: Dec 1991 - first release to usenet +;; Created: Dec 1991 -- first release to usenet ;; Version: 2.2.1 ;; Keywords: outlines wp languages ;; Website: http://myriadicity.net/Sundry/EmacsAllout @@ -36,11 +36,11 @@ ;; - Topic-oriented editing including coherent topic and subtopic ;; creation, promotion, demotion, cut/paste across depths, etc. ;; - Incremental search with dynamic exposure and reconcealment of text -;; - Customizable bullet format - enables programming-language specific +;; - Customizable bullet format -- enables programming-language specific ;; outlining, for code-folding editing. (Allout code itself is to try it; -;; formatted as an outline - do ESC-x eval-buffer in allout.el; but +;; formatted as an outline -- do ESC-x eval-buffer in allout.el; but ;; emacs local file variables need to be enabled when the -;; file was visited - see `enable-local-variables'.) +;; file was visited -- see `enable-local-variables'.) ;; - Configurable per-file initial exposure settings ;; - Symmetric-key and key-pair topic encryption, plus symmetric passphrase ;; mnemonic support, with verification against an established passphrase @@ -53,7 +53,7 @@ ;; exposure control (see the allout-mode docstring) ;; - Easy rendering of exposed portions into numbered, latex, indented, etc ;; outline styles -;; - Careful attention to whitespace - enabling blank lines between items +;; - Careful attention to whitespace -- enabling blank lines between items ;; and maintenance of hanging indentation (in paragraph auto-fill and ;; across topic promotion and demotion) of topic bodies consistent with ;; indentation of their topic header. @@ -76,7 +76,7 @@ ;; `allout-mode' as a minor mode. (It has changed since allout ;; 3.x, for those of you that depend on the old method.) ;; -;; Note - the lines beginning with `;;;_' are outline topic headers. +;; Note -- the lines beginning with `;;;_' are outline topic headers. ;; Just `ESC-x eval-buffer' to give it a whirl. ;; 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 willing to let allout use a bunch of \C-c keybindings." :type 'string :group 'allout) + ;;;_ = allout-keybindings-list -;;; You have to reactivate allout-mode - `(allout-mode t)' - to +;;; You have to reactivate allout-mode -- `(allout-mode t)' -- to ;;; institute changes to this var. (defvar allout-keybindings-list () "*List of `allout-mode' key / function bindings, for `allout-mode-map'. - String or vector key will be prefaced with `allout-command-prefix', unless optional third, non-nil element is present.") (setq allout-keybindings-list @@ -155,11 +155,11 @@ unless optional third, non-nil element is present.") ("*" allout-rebullet-current-heading) ("#" allout-number-siblings) ("\C-k" allout-kill-line t) - ("\M-k" allout-copy-line-as-kill t) + ([?\M-k] allout-copy-line-as-kill t) ("\C-y" allout-yank t) - ("\M-y" allout-yank-pop t) + ([?\M-y] allout-yank-pop t) ("\C-k" allout-kill-topic) - ("\M-k" allout-copy-topic-as-kill) + ([?\M-k] allout-copy-topic-as-kill) ; Miscellaneous commands: ;([?\C-\ ] allout-mark-topic) ("@" allout-resolve-xref) @@ -170,7 +170,7 @@ unless optional third, non-nil element is present.") ;;;_ = allout-auto-activation (defcustom allout-auto-activation nil - "*Regulates auto-activation modality of allout outlines - see `allout-init'. + "*Regulates auto-activation modality of allout outlines -- see `allout-init'. Setq-default by `allout-init' to regulate whether or not allout outline mode is automatically activated when the buffer-specific @@ -212,35 +212,35 @@ value will automatically trigger `allout-mode', provided The types of elements in the layout specification are: - integer - dictate the relative depth to open the corresponding topic(s), - where: - - negative numbers force the topic to be closed before opening - to the absolute value of the number, so all siblings are open - only to that level. - - positive numbers open to the relative depth indicated by the - number, but do not force already opened subtopics to be closed. - - 0 means to close topic - hide all subitems. - : - repeat spec - apply the preceeding element to all siblings at - current level, *up to* those siblings that would be covered by specs - following the `:' on the list. Ie, apply to all topics at level but - trailing ones accounted for by trailing specs. (Only the first of - multiple colons at the same level is honored - later ones are ignored.) - * - completely exposes the topic, including bodies - + - exposes all subtopics, but not the bodies - - - exposes the body of the corresponding topic, but not subtopics - list - a nested layout spec, to be applied intricately to its + INTEGER -- dictate the relative depth to open the corresponding topic(s), + where: + -- negative numbers force the topic to be closed before opening + to the absolute value of the number, so all siblings are open + only to that level. + -- positive numbers open to the relative depth indicated by the + number, but do not force already opened subtopics to be closed. + -- 0 means to close topic -- hide all subitems. + : -- repeat spec -- apply the preceeding element to all siblings at + current level, *up to* those siblings that would be covered by specs + following the `:' on the list. Ie, apply to all topics at level but + trailing ones accounted for by trailing specs. (Only the first of + multiple colons at the same level is honored -- later ones are ignored.) + * -- completely exposes the topic, including bodies + + -- exposes all subtopics, but not the bodies + - -- exposes the body of the corresponding topic, but not subtopics + LIST -- a nested layout spec, to be applied intricately to its corresponding item(s) Examples: - '(-2 : 0) + (-2 : 0) Collapse the top-level topics to show their children and grandchildren, but completely collapse the final top-level topic. - '(-1 () : 1 0) + (-1 () : 1 0) Close the first topic so only the immediate subtopics are shown, leave the subsequent topics exposed as they are until the second second to last topic, which is exposed at least one level, and completely close the last topic. - '(-2 : -1 *) + (-2 : -1 *) Expose children and grandchildren of all topics at current level except the last two; expose children of the second to last and completely expose the last one, including its subtopics. @@ -283,7 +283,7 @@ else allout's special hanging-indent maintaining auto-fill function, (defcustom allout-use-hanging-indents t "*If non-nil, topic body text auto-indent defaults to indent of the header. Ie, it is indented to be just past the header prefix. This is -relevant mostly for use with indented-text-mode, or other situations +relevant mostly for use with `indented-text-mode', or other situations where auto-fill occurs." :type 'boolean :group 'allout) @@ -360,7 +360,7 @@ repeated calls." Cycling only happens on when the command is repeated, not when it follows a different command. -Smart-placement means that repeated calls to this function will +Smart placement means that repeated calls to this function will advance as follows: - if the cursor is not on the end-of-line, @@ -442,25 +442,25 @@ persistent until deliberately changed. Their significance is purely by convention, however. Some conventions suggest themselves: - `(' - open paren - an aside or incidental point - `?' - question mark - uncertain or outright question - `!' - exclamation point/bang - emphatic - `[' - open square bracket - meta-note, about item instead of item's subject - `\"' - double quote - a quotation or other citation - `=' - equal sign - an assignement, equating a name with some connotation - `^' - carat - relates to something above + `(' - open paren -- an aside or incidental point + `?' - question mark -- uncertain or outright question + `!' - exclamation point/bang -- emphatic + `[' - open square bracket -- meta-note, about item instead of item's subject + `\"' - double quote -- a quotation or other citation + `=' - equal sign -- an assignement, equating a name with some connotation + `^' - carat -- relates to something above Some are more elusive, but their rationale may be recognizable: - `+' - plus - pending consideration, completion - `_' - underscore - done, completed - `&' - ampersand - addendum, furthermore + `+' - plus -- pending consideration, completion + `_' - underscore -- done, completed + `&' - ampersand -- addendum, furthermore \(Some other non-plain bullets have special meaning to the software. By default: - `~' marks encryptable topics - see `allout-topic-encryption-bullet' - `#' marks auto-numbered bullets - see `allout-numbered-bullet'.) + `~' marks encryptable topics -- see `allout-topic-encryption-bullet' + `#' marks auto-numbered bullets -- see `allout-numbered-bullet'.) See `allout-plain-bullets-string' for the standard, alternating bullets. @@ -502,7 +502,7 @@ comment-start strings that do not end in spaces are tripled in the header-prefix, and an `_' underscore is tacked on the end, to distinguish them from regular comment strings. comment-start strings that do end in spaces are not tripled, but an underscore -is substituted for the space. [This presumes that the space is +is substituted for the space. [This presumes that the space is for appearance, not comment syntax. You can use `allout-mode-leaders' to override this behavior, when undesired.]" @@ -543,7 +543,7 @@ are always respected by the topic maneuvering functions." ;;;###autoload (put 'allout-old-style-prefixes 'safe-local-variable (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil))))) -;;;_ = allout-stylish-prefixes - alternating bullets +;;;_ = allout-stylish-prefixes -- alternating bullets (defcustom allout-stylish-prefixes t "*Do fancy stuff with topic prefix bullets according to level, etc. @@ -707,9 +707,9 @@ variable for details about allout ajustment of file variables." (defcustom allout-passphrase-hint-handling 'always "*Dictate outline encryption passphrase reminder handling: - always - always show reminder when prompting - needed - show reminder on passphrase entry failure - disabled - never present or adjust reminder + always -- always show reminder when prompting + needed -- show reminder on passphrase entry failure + disabled -- never present or adjust reminder See the docstring for the `allout-enable-file-variable-adjustment' variable for details about allout ajustment of file variables." @@ -732,7 +732,7 @@ mostly covers both deliberate file writes and auto-saves. can continue editing but the copy on the file system will be encrypted.) Auto-saves will use the \"All except current topic\" mode if this - one is selected, to avoid practical difficulties - see below. + one is selected, to avoid practical difficulties -- see below. - All except current topic: skip the topic currently being edited, even if it's pending encryption. This may expose the current topic on the 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." :group 'allout) (make-variable-buffer-local 'allout-enable-file-variable-adjustment) -;;;_* CODE - no user customizations below. +;;;_* CODE -- no user customizations below. ;;;_ #1 Internal Outline Formatting and Configuration ;;;_ : Version @@ -810,7 +810,7 @@ For details, see `allout-toggle-current-subtree-encryption's docstring." (defvar allout-mode nil "Allout outline mode minor-mode flag.") (make-variable-buffer-local 'allout-mode) ;;;_ = allout-layout nil -(defvar allout-layout nil ; LEAVE GLOBAL VALUE NIL - see docstring. +(defvar allout-layout nil ; LEAVE GLOBAL VALUE NIL -- see docstring. "Buffer-specific setting for allout layout. In buffers where this is non-nil (and if `allout-init' has been run, to @@ -854,7 +854,7 @@ by `set-allout-regexp'.") (defvar allout-bullets-string "" "A string dictating the valid set of outline topic bullets. -This var should *not* be set by the user - it is set by `set-allout-regexp', +This var should *not* be set by the user -- it is set by `set-allout-regexp', and is produced from the elements of `allout-plain-bullets-string' and `allout-distinctive-bullets-string'.") (make-variable-buffer-local 'allout-bullets-string) @@ -886,7 +886,7 @@ topic prefix to be matched.") (make-variable-buffer-local 'allout-depth-one-regexp) ;;;_ = allout-line-boundary-regexp (defvar allout-line-boundary-regexp () - "`allout-regexp' with outline style beginning-of-line anchor. + "`allout-regexp' prepended with a newline for the search target. This is properly set by `set-allout-regexp'.") (make-variable-buffer-local 'allout-line-boundary-regexp) @@ -970,7 +970,7 @@ invoking it directly." comment-start t))) allout-use-mode-specific-leader - ;; Oops - garbled value, equate with effect of 't: + ;; Oops -- garbled value, equate with effect of t: t))) (leader (cond @@ -998,8 +998,8 @@ invoking it directly." nil (setq allout-header-prefix leader) (if (not allout-old-style-prefixes) - ;; setting allout-primary-bullet makes the top level topics use - - ;; actually, be - the special prefix: + ;; setting allout-primary-bullet makes the top level topics use -- + ;; actually, be -- the special prefix: (setq allout-primary-bullet leader)) allout-header-prefix))) (defalias 'allout-infer-header-lead @@ -1058,7 +1058,7 @@ Also refresh various data structures that hinge on the regexp." (setq allout-plain-bullets-string-len (length allout-plain-bullets-string)) (setq allout-header-subtraction (1- (length allout-header-prefix))) - (let (new-part old-part) + (let (new-part old-part formfeed-part) (setq new-part (concat "\\(" (regexp-quote allout-header-prefix) "[ \t]*" @@ -1072,18 +1072,26 @@ Also refresh various data structures that hinge on the regexp." "\\)" "+" " ?[^" allout-primary-bullet "]") + formfeed-part "\\(\^L\\)" + allout-regexp (concat new-part "\\|" old-part - "\\|\^l") + "\\|" + formfeed-part) allout-line-boundary-regexp (concat "\n" new-part "\\|" - "\n" old-part) + "\n" old-part + "\\|" + "\n" formfeed-part) allout-bob-regexp (concat "\\`" new-part "\\|" - "\\`" old-part)) + "\\`" old-part + "\\|" + "\\`" formfeed-part + )) (setq allout-depth-specific-regexp (concat "\\(^\\|\\`\\)" @@ -1140,10 +1148,10 @@ Also refresh various data structures that hinge on the regexp." (defvar allout-mode-map nil "Keybindings for (allout) outline minor mode.") ;;;_ > produce-allout-mode-map (keymap-alist &optional base-map) (defun produce-allout-mode-map (keymap-list &optional base-map) - "Produce keymap for use as allout-mode-map, from KEYMAP-LIST. + "Produce keymap for use as `allout-mode-map', from KEYMAP-LIST. Built on top of optional BASE-MAP, or empty sparse map if none specified. -See doc string for allout-keybindings-list for format of binding list." +See doc string for `allout-keybindings-list' for format of binding list." (let ((map (or base-map (make-sparse-keymap))) (pref (list allout-command-prefix))) (mapc (function @@ -1255,7 +1263,7 @@ extended from the existing one by `append'ing a list containing the second element of the pair onto the end of the existing value. Extension, and resumptions in general, should not be used for hook -functions - use the 'local mode of `add-hook' for that, instead. +functions -- use the 'local mode of `add-hook' for that, instead. The settings are stored on `allout-mode-prior-settings'." (while pairs @@ -1274,7 +1282,7 @@ The settings are stored on `allout-mode-prior-settings'." (when (not (assoc name allout-mode-prior-settings)) ;; Not already added as a resumption, create the prior setting entry. (if (local-variable-p name) - ;; is already local variable - preserve the prior value: + ;; is already local variable -- preserve the prior value: (push (list name prior-value) allout-mode-prior-settings) ;; wasn't local variable, indicate so for resumption by killing ;; local value, and make it local: @@ -1340,9 +1348,9 @@ It is run at the conclusion of `allout-flag-region'. Functions on the hook must take three arguments: - - from - integer indicating the point at the start of the change. - - to - integer indicating the point of the end of the change. - - flag - change mode: nil for exposure, otherwise concealment. + - FROM -- integer indicating the point at the start of the change. + - TO -- integer indicating the point of the end of the change. + - FLAG -- change mode: nil for exposure, otherwise concealment. This hook might be invoked multiple times by a single command. @@ -1354,10 +1362,10 @@ and eventually will not be invoked.") Functions on the hook should take two arguments: - - new-start - integer indicating the point at the start of the first new item. - - new-end - integer indicating the point of the end of the last new item. + - NEW-START -- integer indicating position of start of the first new item. + - NEW-END -- integer indicating position of end of the last new item. -Some edits that introduce new items may missed by this hook - +Some edits that introduce new items may missed by this hook: specifically edits that native allout routines do not control. 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.") Functions on the hook must take two arguments: - - depth - integer indicating the depth of the subtree that was deleted. - - removed-from - integer indicating the point where the subtree was removed. + - DEPTH -- integer indicating the depth of the subtree that was deleted. + - REMOVED-FROM -- integer indicating the point where the subtree was removed. -Some edits that remove or invalidate items may missed by this hook - +Some edits that remove or invalidate items may missed by this hook: specifically edits that native allout routines do not control. 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.") Functions on the hook should take two arguments: - - depth-change - integer indicating depth increase, negative for decrease - - start - integer indicating the start point of the shifted parent item. + - DEPTH-CHANGE -- integer indicating depth increase, negative for decrease + - START -- integer indicating the start point of the shifted parent item. -Some edits that shift items can be missed by this hook - specifically edits +Some edits that shift items can be missed by this hook: specifically edits that native allout routines do not control. 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'.") "Variable for regexps matching plaintext to remove before encryption. This is for the sake of redoing encryption in cases where the ciphertext -incidentally contains strings that would disrupt mode operation - +incidentally contains strings that would disrupt mode operation -- for example, a line that happens to look like an allout-mode topic prefix. 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.") (make-variable-buffer-local 'allout-encryption-ciphertext-rejection-ceiling) ;;;_ > allout-mode-p () ;; Must define this macro above any uses, or byte compilation will lack -;; proper def, if file isn't loaded - eg, during emacs build! +;; proper def, if file isn't loaded -- eg, during emacs build! (defmacro allout-mode-p () "Return t if `allout-mode' is active in current buffer." 'allout-mode) @@ -1501,13 +1509,12 @@ See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.") (condition-case failure (setq allout-after-save-decrypt (allout-encrypt-decrypted except-mark)) - (message "allout-write-file-hook-handler suppressing error %s" - failure) - (sit-for 2) - (error "allout-write-file-hook-handler suppressing error %s" - failure)))) + (error (message + "allout-write-file-hook-handler suppressing error %s" + failure) + (sit-for 2))))) )) - nil) + nil) ;;;_ > allout-auto-save-hook-handler () (defun allout-auto-save-hook-handler () "Implement `allout-encrypt-unencrypted-on-saves' policy for auto save." @@ -1653,9 +1660,9 @@ the following two lines in your Emacs init file: (put 'allout-exposure-category 'invisible 'allout) (put 'allout-exposure-category 'evaporate t) ;; XXX We use isearch-open-invisible *and* isearch-mode-end-hook. The - ;; latter would be sufficient, but it seems that a separate behavior - - ;; the _transient_ opening of invisible text during isearch - is keyed to - ;; presence of the isearch-open-invisible property - even though this + ;; latter would be sufficient, but it seems that a separate behavior -- + ;; the _transient_ opening of invisible text during isearch -- is keyed to + ;; presence of the isearch-open-invisible property -- even though this ;; property controls the isearch _arrival_ behavior. This is the case at ;; least in emacs 21, 22.0, and xemacs 21.4. (put 'allout-exposure-category 'isearch-open-invisible @@ -1709,7 +1716,7 @@ variable. We recommend customizing `allout-command-prefix' to use just `\\C-c' as the command prefix, if the allout bindings don't conflict with any personal bindings you have on \\C-c. In any case, outline structure navigation and authoring is simplified by positioning the cursor on an -item's bullet character, the \"hot-spot\" - then you can invoke allout +item's bullet character, the \"hot-spot\" -- then you can invoke allout commands with just the un-prefixed, un-control-shifted command letters. This is described further in the HOT-SPOT Operation section. @@ -1730,7 +1737,7 @@ This is described further in the HOT-SPOT Operation section. \\[allout-backward-current-level] `allout-backward-current-level' \\[allout-end-of-entry] `allout-end-of-entry' \\[allout-beginning-of-current-entry] `allout-beginning-of-current-entry' (alternately, goes to hot-spot) -\\[allout-beginning-of-line] `allout-beginning-of-line' - like regular beginning-of-line, but +\\[allout-beginning-of-line] `allout-beginning-of-line' -- like regular beginning-of-line, but if immediately repeated cycles to the beginning of the current item and then to the hot-spot (if `allout-beginning-of-line-cycles' is set). @@ -1748,9 +1755,9 @@ This is described further in the HOT-SPOT Operation section. \\[allout-rebullet-current-heading] `allout-rebullet-current-heading' Prompt for alternate bullet for current topic \\[allout-rebullet-topic] `allout-rebullet-topic' Reconcile bullets of topic and - its' offspring - distinctive bullets are not changed, others + its' offspring -- distinctive bullets are not changed, others are alternated according to nesting depth. -\\[allout-number-siblings] `allout-number-siblings' Number bullets of topic and siblings - +\\[allout-number-siblings] `allout-number-siblings' Number bullets of topic and siblings -- the offspring are not affected. With repeat count, revoke numbering. @@ -1779,7 +1786,7 @@ M-x outlineify-sticky Activate outline mode for current buffer, \\[allout-copy-exposed-to-buffer] `allout-copy-exposed-to-buffer' Duplicate outline, sans concealed text, to buffer with name derived from derived from that - of current buffer - \"*BUFFERNAME exposed*\". + of current buffer -- \"*BUFFERNAME exposed*\". \\[allout-flatten-exposed-to-buffer] `allout-flatten-exposed-to-buffer' Like above 'copy-exposed', but convert topic prefixes to section.subsection... numeric @@ -1848,7 +1855,7 @@ without changes to the allout core. Here are key ones: Terminology -Topic hierarchy constituents - TOPICS and SUBTOPICS: +Topic hierarchy constituents -- TOPICS and SUBTOPICS: ITEM: A unitary outline element, including the HEADER and ENTRY text. 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." (cond - ;; Provision for v19.18, 19.19 bug - + ;; Provision for v19.18, 19.19 bug -- ;; Emacs v 19.18, 19.19 file-var code invokes prop-line-designated ;; modes twice when file is visited. We have to avoid toggling mode ;; 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." (progn (apply 'allout-expose-topic (list use-layout)) (message "Adjusting '%s' exposure... done." (buffer-name))) - ;; Problem applying exposure - notify user, but don't + ;; Problem applying exposure -- notify user, but don't ;; interrupt, eg, file visit: (error (message "%s" (car (cdr err))) (sit-for 1)))))) @@ -2136,6 +2143,16 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." ;;;_ > allout-minor-mode (defalias 'allout-minor-mode 'allout-mode) +;;;_ > allout-unload-function +(defun allout-unload-function () + "Unload the allout outline library." + (save-current-buffer + (dolist (buffer (buffer-list)) + (set-buffer buffer) + (when allout-mode (allout-mode -1)))) + ;; continue standard unloading + nil) + ;;;_ - Position Assessment ;;;_ > allout-hidden-p (&optional pos) (defsubst allout-hidden-p (&optional pos) @@ -2158,10 +2175,10 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." "Get confirmation before making arbitrary changes to invisible text. We expose the invisible text and ask for confirmation. Refusal or -keyboard-quit abandons the changes, with keyboard-quit additionally +`keyboard-quit' abandons the changes, with keyboard-quit additionally reclosing the opened text. -No confirmation is necessary when inhibit-read-only is set - eg, allout +No confirmation is necessary when `inhibit-read-only' is set -- eg, allout internal functions use this feature cohesively bunch changes." (when (and (not inhibit-read-only) (not after)) @@ -2199,7 +2216,7 @@ internal functions use this feature cohesively bunch changes." (defun allout-before-change-handler (beg end) "Protect against changes to invisible text. -See allout-overlay-interior-modification-handler for details." +See `allout-overlay-interior-modification-handler' for details." (if (and (allout-mode-p) undo-in-progress (allout-hidden-p)) (allout-show-to-offshoot)) @@ -2224,7 +2241,7 @@ function can also be used as an `isearch-mode-end-hook'." (if (and (allout-mode-p) (allout-hidden-p)) (allout-show-to-offshoot))) -;;;_ #3 Internal Position State-Tracking - "allout-recent-*" funcs +;;;_ #3 Internal Position State-Tracking -- "allout-recent-*" funcs ;;; All the basic outline functions that directly do string matches to ;;; evaluate heading prefix location set the variables ;;; `allout-recent-prefix-beginning' and `allout-recent-prefix-end' @@ -2252,10 +2269,12 @@ function can also be used as an `isearch-mode-end-hook'." (defsubst allout-prefix-data () "Register allout-prefix state data. -For reference by `allout-recent' funcs. Returns BEGINNING." - (setq allout-recent-prefix-end (or (match-end 1) (match-end 2)) +For reference by `allout-recent' funcs. Return +the new value of `allout-recent-prefix-beginning'." + (setq allout-recent-prefix-end (or (match-end 1) (match-end 2) (match-end 3)) allout-recent-prefix-beginning (or (match-beginning 1) - (match-beginning 2)) + (match-beginning 2) + (match-beginning 3)) allout-recent-depth (max 1 (- allout-recent-prefix-end allout-recent-prefix-beginning allout-header-subtraction))) @@ -2306,7 +2325,7 @@ to return the current depth of the most recently matched topic." (defsubst allout-do-doublecheck () "True if current item conditions qualify for checking on topic aberrance." (and - ;; presume integrity of outline and yanked content during yank - necessary, + ;; presume integrity of outline and yanked content during yank -- necessary ;; to allow for level disparity of yank location and yanked text: (not allout-inhibit-aberrance-doublecheck) ;; allout-doublecheck-at-and-shallower is ceiling for doublecheck: @@ -2344,12 +2363,12 @@ exceeds the topic by more than one." (allout-prefix-data) (goto-char allout-recent-prefix-beginning) (cond - ;; sibling - continue: + ;; sibling -- continue: ((eq allout-recent-depth depth)) - ;; first offspring is excessive - aberrant: + ;; first offspring is excessive -- aberrant: ((> allout-recent-depth (1+ depth)) (setq done t aberrant t)) - ;; next non-sibling is lower-depth - not aberrant: + ;; next non-sibling is lower-depth -- not aberrant: (t (setq done t)))))) (if aberrant aberrant @@ -2384,6 +2403,8 @@ Actually, returns prefix beginning point." (defun allout-depth () "Return depth of topic most immediately containing point. +Does not do doublecheck for aberrant topic header. + Return zero if point is not within any topic. Like `allout-current-depth', but respects hidden as well as visible topics." @@ -2490,7 +2511,7 @@ Outermost is first." ;;;_ > allout-end-of-current-line () (defun allout-end-of-current-line () "Move to the end of line, past concealed text if any." - ;; XXX This is for symmetry with `allout-beginning-of-current-line' - + ;; XXX This is for symmetry with `allout-beginning-of-current-line' -- ;; `move-end-of-line' doesn't suffer the same problem as ;; `move-beginning-of-line'. (let ((inhibit-field-text-motion t)) @@ -2564,7 +2585,7 @@ Outermost is first." Returns the location of the heading, or nil if none found. -We skip anomolous low-level topics, a la `allout-aberrant-container-p'." +We skip anomalous low-level topics, a la `allout-aberrant-container-p'." (save-match-data (if (looking-at allout-regexp) @@ -2572,10 +2593,14 @@ We skip anomolous low-level topics, a la `allout-aberrant-container-p'." (when (re-search-forward allout-line-boundary-regexp nil 0) (allout-prefix-data) + (goto-char allout-recent-prefix-beginning) + (while (not (bolp)) + (forward-char -1)) (and (allout-do-doublecheck) ;; this will set allout-recent-* on the first non-aberrant topic, ;; whether it's the current one or one that disqualifies it: (allout-aberrant-container-p)) + ;; this may or may not be the same as above depending on doublecheck: (goto-char allout-recent-prefix-beginning)))) ;;;_ > allout-this-or-next-heading (defun allout-this-or-next-heading () @@ -2589,7 +2614,7 @@ We skip anomolous low-level topics, a la `allout-aberrant-container-p'." Return the location of the beginning of the heading, or nil if not found. -We skip anomolous low-level topics, a la `allout-aberrant-container-p'." +We skip anomalous low-level topics, a la `allout-aberrant-container-p'." (if (bobp) nil @@ -2687,9 +2712,9 @@ starting point, and PREV-DEPTH is depth of prior topic." ;; Register this one and move on: (setq chart (cons allout-recent-prefix-beginning chart)) (if (and levels (<= levels 1)) - ;; At depth limit - skip sublevels: + ;; At depth limit -- skip sublevels: (or (allout-next-sibling curr-depth) - ;; or no more siblings - proceed to + ;; or no more siblings -- proceed to ;; next heading at lesser depth: (while (and (<= curr-depth allout-recent-depth) @@ -2762,7 +2787,7 @@ start point." (let ((further (allout-chart-to-reveal here (if (null depth) depth (1- depth))))) - ;; We're on the start of a subtree - recurse with it, if there's + ;; We're on the start of a subtree -- recurse with it, if there's ;; more depth to go: (if further (setq result (append further result))) (setq chart (cdr chart))) @@ -3150,7 +3175,7 @@ situation." (progn (goto-char start-point) nil) ;; rationale: if any intervening items were at a lower depth, we - ;; would now be on the first offspring at the target depth - ie, + ;; would now be on the first offspring at the target depth -- ie, ;; the preceeding item (per the search direction) must be at a ;; lesser depth. that's all we need to check. (if backward (allout-next-heading) (allout-previous-heading)) @@ -3228,7 +3253,7 @@ Move to buffer limit in indicated direction if headings are exhausted." (allout-aberrant-container-p)) ;; skip this aberrant prospective header line: t - ;; this prospective headerline qualifies - register: + ;; this prospective headerline qualifies -- register: (setq got allout-recent-prefix-beginning) ;; and break the loop: nil))))) @@ -3396,7 +3421,7 @@ Returns the qualifying command, if any, else nil." (>= 122 key-num)) ; "z" (- key-num 96) key-num))) t)))) - ;; Qualified as an allout command - do hot-spot operation. + ;; Qualified as an allout command -- do hot-spot operation. (setq allout-post-goto-bullet t) ;; accept-defaults nil, or else we'll get allout-item-icon-key-handler. (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 topic at point, if non-nil. Default bullet for new topics, eg, may be set (contingent to other args) to numbered bullets if previous sibling is one. The implication otherwise is that the current topic -is being adjusted - shifted or rebulleted - and we don't consider +is being adjusted -- shifted or rebulleted -- and we don't consider bullet or previous sibling. Third arg DEPTH forces the topic prefix to that depth, regardless of @@ -3544,11 +3569,11 @@ index for each successive sibling)." ;; Getting value for bullet char is practically the whole job: (cond - ; Simplest situation - level 1: + ; Simplest situation -- level 1: ((<= depth 1) (setq header-lead "") allout-primary-bullet) ; Simple, too: all asterisks: (allout-old-style-prefixes - ;; Cheat - make body the whole thing, null out header-lead and + ;; Cheat -- make body the whole thing, null out header-lead and ;; bullet-char: (setq body (make-string depth (string-to-char allout-primary-bullet))) @@ -3626,8 +3651,8 @@ index for each successive sibling)." "Open a new topic at depth DEPTH. New topic is situated after current one, unless optional flag BEFORE -is non-nil, or unless current line is completely empty - lacking even -whitespace - in which case open is done on the current line. +is non-nil, or unless current line is completely empty -- lacking even +whitespace -- in which case open is done on the current line. When adding an offspring, it will be added immediately after the parent if the other offspring are exposed, or after the last child if the offspring @@ -3692,7 +3717,7 @@ Nuances: (if (not opening-on-blank) ; Positioning and vertical - ; padding - only if not + ; padding -- only if not ; opening-on-blank: (progn (goto-char ref-topic) @@ -3743,7 +3768,7 @@ Nuances: (open-line 1))) (allout-end-of-current-subtree) (if (looking-at "\n\n") (forward-char 1)))) - ;; Going inwards - double-space if first offspring is + ;; Going inwards -- double-space if first offspring is ;; double-spaced, otherwise snug up. (allout-end-of-entry) (if (eobp) @@ -3753,7 +3778,7 @@ Nuances: (backward-char 1) (if (bolp) ;; Blank lines between current header body and next - ;; header - get to last substantive (non-white-space) + ;; header -- get to last substantive (non-white-space) ;; line in body: (progn (setq dbl-space t) (re-search-backward "[^ \t\n]" nil t))) @@ -3900,9 +3925,9 @@ Note that refill of indented paragraphs is not done." (not (looking-at allout-regexp))) (if (> 0 (setq excess (- (- old-indent-end old-indent-begin) old-margin))) - ;; Text starts left of old margin - don't adjust: + ;; Text starts left of old margin -- don't adjust: nil - ;; Text was hanging at or right of old left margin - + ;; Text was hanging at or right of old left margin -- ;; reindent it, preserving its existing indentation ;; beyond the old margin: (delete-region old-indent-begin old-indent-end) @@ -3963,9 +3988,9 @@ Third arg NUMBER-CONTROL can force the prefix to or away from numbered form. It has effect only if `allout-numbered-bullet' is non-nil and soliciting was not explicitly invoked (via first arg). Its effect, numbering or denumbering, then depends on the setting -of the forth arg, INDEX. +of the fourth arg, INDEX. -If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the +If NUMBER-CONTROL is non-nil and fourth arg INDEX is nil, then the prefix of the topic is forced to be non-numbered. Null index and non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil @@ -4050,7 +4075,7 @@ this function." Descends into invisible as well as visible topics, however. -When optional sans-offspring is non-nil, subtopics are not +When optional SANS-OFFSPRING is non-nil, subtopics are not shifted. (Shifting a topic outwards without shifting its offspring is disallowed, since this would create a \"containment discontinuity\", where the depth difference between a topic and @@ -4095,7 +4120,7 @@ Finally, if optional SANS-OFFSPRING is non-nil then the offspring are not shifted. (Shifting a topic outwards without shifting its offspring is disallowed, since this would create a \"containment discontinuity\", where the depth difference between -a topic and its immediate offspring is greater than one..)" +a topic and its immediate offspring is greater than one.)" ;; XXX the recursion here is peculiar, and in general the routine may ;; need simplification with refactoring. @@ -4160,7 +4185,7 @@ a topic and its immediate offspring is greater than one..)" nil)))) ;;; do-successors ((< starting-depth new-depth) - ;; Rare case - subtopic more than one level deeper than parent. + ;; Rare case -- subtopic more than one level deeper than parent. ;; Treat this one at an even deeper level: (allout-rebullet-topic-grunt relative-depth new-depth @@ -4222,7 +4247,7 @@ Returns final depth." (defun allout-number-siblings (&optional denumber) "Assign numbered topic prefix to this topic and its siblings. -With universal argument, denumber - assign default bullet to this +With universal argument, denumber -- assign default bullet to this topic and its siblings. With repeated universal argument (`^U^U'), solicit bullet for each @@ -4381,7 +4406,7 @@ Trailing whitespace is killed with a topic if that whitespace: previous one. Topic exposure is marked with text-properties, to be used by -allout-yank-processing for exposure recovery." +`allout-yank-processing' for exposure recovery." (interactive) (let* ((inhibit-field-text-motion t) @@ -4412,7 +4437,7 @@ allout-yank-processing for exposure recovery." (run-hook-with-args 'allout-structure-deleted-hook depth (point)))) ;;;_ > allout-copy-topic-as-kill () (defun allout-copy-topic-as-kill () - "Like allout-kill-topic, but save to kill ring instead of deleting." + "Like `allout-kill-topic', but save to kill ring instead of deleting." (interactive) (let ((buffer-read-only t)) (condition-case nil @@ -4437,7 +4462,7 @@ allout-yank-processing for exposure recovery." 'invisible nil end)))) (if (or (not next) (eq prev next)) - ;; still not at start of hidden area - must not be any left. + ;; still not at start of hidden area -- must not be any left. (setq done t) (goto-char next) (setq prev next) @@ -4478,7 +4503,7 @@ allout-yank-processing for exposure recovery." 'allout-was-hidden nil end))) (if (or (not next) (eq prev next)) - ;; no more or not advancing - must not be any left. + ;; no more or not advancing -- must not be any left. (setq done t) (goto-char next) (setq prev next) @@ -4533,10 +4558,9 @@ however, are left exactly like normal, non-allout-specific yanks." ;; `rectify-numbering' if resituating (where several topics may ;; be resituating) or yanking a topic into a topic slot (bol): (rectify-numbering (or resituate - (and into-bol - (looking-at allout-regexp))))) + (and into-bol (looking-at allout-regexp))))) (if resituate - ;; Yanking a topic into the start of a topic - reconcile to fit: + ;; Yanking a topic into the start of a topic -- reconcile to fit: (let* ((inhibit-field-text-motion t) (prefix-len (if (not (match-end 1)) 1 @@ -4676,7 +4700,7 @@ works with normal `yank' in non-outline buffers." Adapts level of popped topics to level of fresh prefix. -Note - prefix changes to distinctive bullets will stick, if followed +Note -- prefix changes to distinctive bullets will stick, if followed by pops to non-distinctive yanks. Bug..." (interactive "*p") @@ -4695,7 +4719,7 @@ by pops to non-distinctive yanks. Bug..." (interactive) (if (not allout-file-xref-bullet) (error - "Outline cross references disabled - no `allout-file-xref-bullet'") + "Outline cross references disabled -- no `allout-file-xref-bullet'") (if (not (string= (allout-current-bullet) allout-file-xref-bullet)) (error "Current heading lacks cross-reference bullet `%s'" allout-file-xref-bullet) @@ -4919,16 +4943,16 @@ Useful for coherently exposing to a random point in a hidden region." ))) ;;;_ > allout-show-current-subtree (&optional arg) (defun allout-show-current-subtree (&optional arg) - "Show everything within the current topic. With a repeat-count, -expose this topic and its siblings." + "Show everything within the current topic. +With a repeat-count, expose this topic and its siblings." (interactive "P") (save-excursion (if (<= (allout-current-depth) 0) - ;; Outside any topics - try to get to the first: + ;; Outside any topics -- try to get to the first: (if (not (allout-next-heading)) (error "No topics") - ;; got to first, outermost topic - set to expose it and siblings: - (message "Above outermost topic - exposing all.") + ;; got to first, outermost topic -- set to expose it and siblings: + (message "Above outermost topic -- exposing all.") (allout-flag-region (point-min)(point-max) nil)) (allout-beginning-of-current-line) (if (not arg) @@ -4966,7 +4990,7 @@ siblings, even if the target topic is already closed." (interactive) (let* ((from (point)) - (sibs-msg "Top-level topic already closed - closing siblings...") + (sibs-msg "Top-level topic already closed -- closing siblings...") (current-exposed (not (allout-current-topic-collapsed-p t)))) (cond (current-exposed (allout-flag-current-subtree t)) (just-close nil) @@ -5065,13 +5089,13 @@ Simple (numeric and null-list) specs are interpreted as follows: that level. - positive numbers open to the relative depth indicated by the number, but do not force already opened subtopics to be closed. - - 0 means to close topic - hide all offspring. + - 0 means to close topic -- hide all offspring. : - `repeat' apply prior element to all siblings at current level, *up to* those siblings that would be covered by specs following the `:' on the list. Ie, apply to all topics at level but the last ones. (Only first of multiple colons at same level is - respected - subsequent ones are discarded.) + respected -- subsequent ones are discarded.) * - completely opens the topic, including bodies. + - shows all the sub headers, but not the bodies - - exposes the body of the corresponding topic. @@ -5119,11 +5143,11 @@ Examples: ;; Expand the `repeat' spec to an explicit version, ;; w.r.t. remaining siblings: (let ((residue ; = # of sibs not covered by remaining spec - ;; Dang - could be nice to make use of the chart, sigh: + ;; Dang, could be nice to make use of the chart, sigh: (- (length (allout-chart-siblings)) (length spec)))) (if (< 0 residue) - ;; Some residue - cover it with prev-elem: + ;; Some residue -- cover it with prev-elem: (setq spec (append (make-list residue prev-elem) spec))))))) ((numberp curr-elem) @@ -5257,7 +5281,7 @@ Examples: (error "allout-new-exposure: Can't find any outline topics")) (list 'allout-expose-topic (list 'quote spec)))) -;;;_ #7 Systematic outline presentation - copying, printing, flattening +;;;_ #7 Systematic outline presentation -- copying, printing, flattening ;;;_ - Mapping and processing of topics ;;;_ ( See also Subtree Charting, in Navigation code.) @@ -5345,12 +5369,12 @@ the subject region. Optional START and END indicate bounds of region. -optional arg, FORMAT, designates an alternate presentation form for +Optional arg, FORMAT, designates an alternate presentation form for the prefix: - list - Present prefix as numeric section.subsection..., starting with + list -- Present prefix as numeric section.subsection..., starting with section indicated by the list, innermost nesting first. - `indent' (symbol) - Convert header prefixes to all white space, + `indent' (symbol) -- Convert header prefixes to all white space, except for distinctive bullets. 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: (beginning-of-line) ;; Goto initial topic, and register preceeding stuff, if any: (if (> (allout-goto-prefix-doublechecked) start) - ;; First topic follows beginning point - register preliminary stuff: + ;; First topic follows beginning point -- register preliminary stuff: (setq result (list (list 0 "" nil (buffer-substring start (1- (point))))))) (while (and (not done) @@ -5443,7 +5467,7 @@ header and body. The elements of that list are: (cond ((= new-depth depth) (setq format (cons (1+ (car format)) (cdr format)))) - ((> new-depth depth) ; descending - assume by 1: + ((> new-depth depth) ; descending -- assume by 1: (setq format (cons 1 format))) (t ; Pop the residue: @@ -5459,10 +5483,10 @@ header and body. The elements of that list are: (nreverse result)))) ;;;_ > allout-region-active-p () (defmacro allout-region-active-p () - (if (fboundp 'use-region-p) - '(use-region-p) - '(region-active-p))) -;;;_ > allout-process-exposed (&optional func from to frombuf + (cond ((fboundp 'use-region-p) '(use-region-p)) + ((fboundp 'region-active-p) '(region-active-p)) + (t 'mark-active))) +;;_ > allout-process-exposed (&optional func from to frombuf ;;; tobuf format) (defun allout-process-exposed (&optional func from to frombuf tobuf format start-num) @@ -5474,12 +5498,12 @@ Apply FUNCTION to exposed portions FROM position TO position in buffer FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an alternate presentation form: - `flat' - Present prefix as numeric section.subsection..., starting with - section indicated by the start-num, innermost nesting first. - X`flat-indented' - Prefix is like `flat' for first topic at each + `flat' -- Present prefix as numeric section.subsection..., starting with + section indicated by the START-NUM, innermost nesting first. + X`flat-indented' -- Prefix is like `flat' for first topic at each X level, but subsequent topics have only leaf topic X number, padded with blanks to line up with first. - `indent' (symbol) - Convert header prefixes to all white space, + `indent' (symbol) -- Convert header prefixes to all white space, except for distinctive bullets. Defaults: @@ -5499,19 +5523,19 @@ Defaults: (setq from (point-min) to (point-max)))) (if frombuf (if (not (bufferp frombuf)) - ;; Specified but not a buffer - get it: + ;; Specified but not a buffer -- get it: (let ((got (get-buffer frombuf))) (if (not got) (error (concat "allout-process-exposed: source buffer " frombuf " not found.")) (setq frombuf got)))) - ;; not specified - default it: + ;; not specified -- default it: (setq frombuf (current-buffer))) (if tobuf (if (not (bufferp tobuf)) (setq tobuf (get-buffer-create tobuf))) - ;; not specified - default it: + ;; not specified -- default it: (setq tobuf (concat "*" (buffer-name frombuf) " exposed*"))) (if (listp format) (nreverse format)) @@ -5598,7 +5622,7 @@ alternate presentation format for the outline: (defun allout-flatten-exposed-to-buffer (&optional arg tobuf) "Present numeric outline of outline's exposed portions in another buffer. -The resulting outline is not compatible with outline mode - use +The resulting outline is not compatible with outline mode -- use `allout-copy-exposed-to-buffer' if you want that. Use `allout-indented-exposed-to-buffer' for indented presentation. @@ -5614,7 +5638,7 @@ used verbatim." (defun allout-indented-exposed-to-buffer (&optional arg tobuf) "Present indented outline of outline's exposed portions in another buffer. -The resulting outline is not compatible with outline mode - use +The resulting outline is not compatible with outline mode -- use `allout-copy-exposed-to-buffer' if you want that. Use `allout-flatten-exposed-to-buffer' for numeric sectional presentation. @@ -5843,7 +5867,7 @@ encryption are encrypted. See allout-encrypt-unencrypted-on-saves for auto-encryption specifics. \*NOTE WELL* that automatic encryption that happens during saves will -default to symmetric encryption - you must deliberately (re)encrypt key-pair +default to symmetric encryption -- you must deliberately (re)encrypt key-pair encrypted topics if you want them to continue to use the key-pair cipher. 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." subtree-end)) (subtree-end-char (char-after (1- subtree-end))) (subtree-trailing-char (char-after subtree-end)) - ;; kluge - result-text needs to be nil, but we also want to + ;; kluge -- result-text needs to be nil, but we also want to ;; check for the error condition (result-text (if (or (string= "" subject-text) (string= "\n" subject-text)) @@ -6017,18 +6041,19 @@ If DECRYPT is true (default false), then decrypt instead of encrypt. FETCH-PASS (default false) forces fresh prompting for the passphrase. -KEY-TYPE indicates whether to use a 'symmetric or 'keypair cipher. +KEY-TYPE, either `symmetric' or `keypair', specifies which type +of cypher to use. FOR-KEY is human readable identification of the first of the user's eligible secret keys a keypair decryption targets, or else nil. -Optional RETRIED is for internal use - conveys the number of failed keys +Optional RETRIED is for internal use -- conveys the number of failed keys that have been solicited in sequence leading to this current call. Optional PASSPHRASE enables explicit delivery of the decryption passphrase, for verification purposes. -Optional REJECTED is for internal use - conveys the number of +Optional REJECTED is for internal use -- conveys the number of rejections due to matches against `allout-encryption-ciphertext-rejection-regexps', as limited by `allout-encryption-ciphertext-rejection-ceiling'. @@ -6126,15 +6151,15 @@ Returns the resulting string, or nil if the transformation fails." (if status (pgg-situate-output (point-min) (point-max)) - ;; failed - handle passphrase caching + ;; failed -- handle passphrase caching (if verifying (throw 'encryption-failed nil) (pgg-remove-passphrase-from-cache target-cache-id t) - (error "Symmetric-cipher %scryption failed - %s" + (error "Symmetric-cipher %scryption failed -- %s" (if decrypt "de" "en") - "try again with different passphrase.")))) + "try again with different passphrase")))) - ;; encrypt 'keypair: + ;; encrypt `keypair': ((not decrypt) (setq status @@ -6147,7 +6172,7 @@ Returns the resulting string, or nil if the transformation fails." (error (pgg-remove-passphrase-from-cache target-cache-id t) (error "encryption failed")))) - ;; decrypt 'keypair: + ;; decrypt `keypair': (t (setq status @@ -6163,7 +6188,7 @@ Returns the resulting string, or nil if the transformation fails." 1 (- (point-max) (if decrypt 0 1)))) ) - ;; validate result - non-empty + ;; validate result -- non-empty (cond ((not result-text) (if verifying nil @@ -6199,7 +6224,7 @@ Returns the resulting string, or nil if the transformation fails." (string-match "[\C-a\C-k\C-o-\C-z\C-@]" result-text)) (error (concat "Encryption produced non-armored text, which" - "conflicts with allout mode - reconfigure!"))) + "conflicts with allout mode -- reconfigure!"))) ;; valid result and just verifying or non-symmetric: ((or verifying (not (equal key-type 'symmetric))) @@ -6208,7 +6233,7 @@ Returns the resulting string, or nil if the transformation fails." passphrase t)) result-text) - ;; valid result and regular symmetric - "register" + ;; valid result and regular symmetric -- "register" ;; passphrase with mnemonic aids/cache. (t (set-buffer allout-buffer) @@ -6239,7 +6264,7 @@ CACHE-ID is the cache id of the key for the passphrase. PROMPT-ID is the id for use when prompting the user. -KEY-TYPE is either 'symmetric or 'keypair. +KEY-TYPE is either `symmetric' or `keypair'. ALLOUT-BUFFER is the buffer containing the entry being en/decrypted. @@ -6302,7 +6327,7 @@ of the availability of a cached copy." (if (and (not confirmation) (if (yes-or-no-p (concat "Passphrase differs from established" - " - use new one instead? ")) + " -- use new one instead? ")) ;; deactivate password for subsequent ;; confirmation: (progn @@ -6312,11 +6337,11 @@ of the availability of a cached copy." t)) (progn (pgg-remove-passphrase-from-cache cache-id t) (error "Wrong passphrase.")))) - ;; No verifier string - force confirmation by repetition of + ;; No verifier string -- force confirmation by repetition of ;; (new) passphrase: ((or fetch-pass (not cached)) (pgg-remove-passphrase-from-cache cache-id t)))) - ;; confirmation vs new input - doing pgg-read-passphrase will do the + ;; confirmation vs new input -- doing pgg-read-passphrase will do the ;; right thing, in either case: (if (not confirmation) (setq confirmation @@ -6327,7 +6352,7 @@ of the availability of a cached copy." (if (equal got-pass confirmation) confirmation (if (yes-or-no-p (concat "spelling of original and" - " confirmation differ - retry? ")) + " confirmation differ -- retry? ")) (progn (setq retried (if retried (1+ retried) 1)) (pgg-remove-passphrase-from-cache cache-id t) ;; recurse to this routine: @@ -6349,10 +6374,10 @@ of the availability of a cached copy." (defun allout-encrypted-key-info (text) "Return a pair of the key type and identity of a recipient's secret key. -The key type is one of 'symmetric or 'keypair. +The key type is one of `symmetric' or `keypair'. -if 'keypair, and some of the user's secret keys are among those for which -the message was encoded, return the identity of the first. otherwise, +If `keypair', and some of the user's secret keys are among those for which +the message was encoded, return the identity of the first. Otherwise, return nil for the second item of the pair. An error is raised if the text is not encrypted." @@ -6397,7 +6422,7 @@ An error is raised if the text is not encrypted." See `allout-passphrase-verifier-string' and `allout-passphrase-hint-string' settings. -PASSPHRASE is the passphrase being mnemonicized +PASSPHRASE is the passphrase being mnemonicized. OUTLINE-BUFFER is the buffer of the outline being adjusted. @@ -6475,7 +6500,7 @@ EXCEPT-MARK identifies a point whose containing topics should be excluded from encryption. This supports 'except-current mode of `allout-encrypt-unencrypted-on-saves'. -Such a topic has the allout-topic-encryption-bullet without an +Such a topic has the `allout-topic-encryption-bullet' without an immediately following '*' that would mark the topic as being encrypted. It must also have content." (let (done got content-beg) @@ -6529,7 +6554,7 @@ must also have content." "Encrypt topics pending encryption except those containing exemption point. EXCEPT-MARK identifies a point whose containing topics should be excluded -from encryption. This supports 'except-current mode of +from encryption. This supports the `except-current' mode of `allout-encrypt-unencrypted-on-saves'. If a topic that is currently being edited was encrypted, we return a list @@ -6597,7 +6622,7 @@ setup for auto-startup." (if (allout-goto-prefix) t (allout-open-topic 2) - (insert (concat "Dummy outline topic header - see" + (insert (concat "Dummy outline topic header -- see" "`allout-mode' docstring: `^Hm'.")) (allout-adjust-file-variable "allout-layout" (or allout-layout '(-1 : 0)))))) @@ -6605,7 +6630,7 @@ setup for auto-startup." (defun allout-file-vars-section-data () "Return data identifying the file-vars section, or nil if none. -Returns list `(beginning-point prefix-string suffix-string)'." +Returns a list of the form (BEGINNING-POINT PREFIX-STRING SUFFIX-STRING)." ;; minimally gleaned from emacs 21.4 files.el hack-local-variables function. (let (beg prefix suffix) (save-excursion @@ -6707,7 +6732,7 @@ not its value." got) (dolist (sym configvar-value) (if (not (boundp sym)) - (if (yes-or-no-p (format "%s entry `%s' is unbound - remove it? " + (if (yes-or-no-p (format "%s entry `%s' is unbound -- remove it? " configvar-name sym)) (delq sym (symbol-value configvar-name))) (push (symbol-value sym) got))) @@ -6754,7 +6779,7 @@ Optional arg DO-DEFAULTING indicates to accept empty input (CR)." string "")) nil)))) - ;; got something out of loop - return it: + ;; got something out of loop -- return it: got) ) ;;;_ : Strings: @@ -6762,7 +6787,7 @@ Optional arg DO-DEFAULTING indicates to accept empty input (CR)." (defun regexp-sans-escapes (regexp &optional successive-backslashes) "Return a copy of REGEXP with all character escapes stripped out. -Representations of actual backslashes - '\\\\\\\\' - are left as a +Representations of actual backslashes -- '\\\\\\\\' -- are left as a single backslash. Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion." @@ -6810,7 +6835,7 @@ If BEG is bigger than END we return 0." (cond ((null list) nil) ((atom (car list)) (cons (car list) (allout-flatten (cdr list)))) (t (append (allout-flatten (car list)) (allout-flatten (cdr list)))))) -;;;_ : Compatability: +;;;_ : Compatibility: ;;;_ > allout-mark-marker to accommodate divergent emacsen: (defun allout-mark-marker (&optional force buffer) "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." (move-overlay o end (overlay-end o)) (delete-overlay o))))))) ) -;;;_ > copy-overlay if necessary - xemacs ~ 21.4 +;;;_ > copy-overlay if necessary -- xemacs ~ 21.4 (if (not (fboundp 'copy-overlay)) (defun copy-overlay (o) "Return a copy of overlay O." @@ -6874,7 +6899,7 @@ BEG and END default respectively to the beginning and end of buffer." (while props (overlay-put o1 (pop props) (pop props))) o1))) -;;;_ > add-to-invisibility-spec if necessary - xemacs ~ 21.4 +;;;_ > add-to-invisibility-spec if necessary -- xemacs ~ 21.4 (if (not (fboundp 'add-to-invisibility-spec)) (defun add-to-invisibility-spec (element) "Add ELEMENT to `buffer-invisibility-spec'. @@ -6884,14 +6909,14 @@ that can be added." (setq buffer-invisibility-spec (list t))) (setq buffer-invisibility-spec (cons element buffer-invisibility-spec)))) -;;;_ > remove-from-invisibility-spec if necessary - xemacs ~ 21.4 +;;;_ > remove-from-invisibility-spec if necessary -- xemacs ~ 21.4 (if (not (fboundp 'remove-from-invisibility-spec)) (defun remove-from-invisibility-spec (element) "Remove ELEMENT from `buffer-invisibility-spec'." (if (consp buffer-invisibility-spec) (setq buffer-invisibility-spec (delete element buffer-invisibility-spec))))) -;;;_ > move-beginning-of-line if necessary - older emacs, xemacs +;;;_ > move-beginning-of-line if necessary -- older emacs, xemacs (if (not (fboundp 'move-beginning-of-line)) (defun move-beginning-of-line (arg) "Move point to beginning of current line as displayed. @@ -6921,7 +6946,7 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." (skip-chars-backward "^\n")) (vertical-motion 0)) ) -;;;_ > move-end-of-line if necessary - older emacs, xemacs +;;;_ > move-end-of-line if necessary -- older emacs, xemacs (if (not (fboundp 'move-end-of-line)) (defun move-end-of-line (arg) "Move point to end of current line as displayed. @@ -6990,7 +7015,7 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." (isearch-repeat 'forward) (isearch-mode t))) -;;;_ #11 Unit tests - this should be last item before "Provide" +;;;_ #11 Unit tests -- this should be last item before "Provide" ;;;_ > allout-run-unit-tests () (defun allout-run-unit-tests () "Run the various allout unit tests." @@ -7006,11 +7031,11 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." (while (boundp name) (makunbound name))) ;;;_ > allout-test-resumptions () (defvar allout-tests-globally-unbound nil - "Fodder for allout resumptions tests - defvar just for byte compiler.") + "Fodder for allout resumptions tests -- defvar just for byte compiler.") (defvar allout-tests-globally-true nil - "Fodder for allout resumptions tests - defvar just just for byte compiler.") + "Fodder for allout resumptions tests -- defvar just for byte compiler.") (defvar allout-tests-locally-true nil - "Fodder for allout resumptions tests - defvar just for byte compiler.") + "Fodder for allout resumptions tests -- defvar just for byte compiler.") (defun allout-test-resumptions () "Exercise allout resumptions." ;; 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." (allout-tests-obliterate-variable 'allout-tests-locally-true) (set (make-local-variable 'allout-tests-locally-true) t) (assert (not (default-boundp 'allout-tests-locally-true)) - nil (concat "Test setup mistake - variable supposed to" + nil (concat "Test setup mistake -- variable supposed to" " not have global binding, but it does.")) (assert (local-variable-p 'allout-tests-locally-true) - nil (concat "Test setup mistake - variable supposed to have" + nil (concat "Test setup mistake -- variable supposed to have" " local binding, but it lacks one.")) (allout-add-resumptions '(allout-tests-locally-true nil)) (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." (defun ansi-color-set-extent-face (extent face) "Set the `face' property of EXTENT to FACE. XEmacs uses `set-extent-face', Emacs uses `overlay-put'." - (if (fboundp 'set-extent-face) + (if (featurep 'xemacs) (set-extent-face extent face) (overlay-put extent 'face face))) 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." (archive-maybe-update t)) (or (not (buffer-name buffer)) (cond - (view-p (view-buffer buffer (and just-created 'kill-buffer))) + (view-p (view-buffer + buffer (and just-created 'kill-buffer-if-not-modified))) ((eq other-window-p 'display) (display-buffer buffer)) (other-window-p (switch-to-buffer-other-window buffer)) (t (switch-to-buffer buffer)))))) @@ -1968,7 +1969,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (archive-rar-extract tmpfile name)) (if tmpbuf (kill-buffer tmpbuf)) (delete-file tmpfile)))) - + ;; ------------------------------------------------------------------------- ;; 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 @@ +;;; blank-mode.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE + +;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 +;; Free Software Foundation, Inc. + +;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Keywords: data, wp +;; Version: 9.2 +;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Introduction +;; ------------ +;; +;; This package is a minor mode to visualize blanks (TAB, (HARD) SPACE +;; and NEWLINE). +;; +;; blank-mode uses two ways to visualize blanks: faces and display +;; table. +;; +;; * Faces are used to highlight the background with a color. +;; blank-mode uses font-lock to highlight blank characters. +;; +;; * Display table changes the way a character is displayed, that is, +;; it provides a visual mark for characters, for example, at the end +;; of line (?\xB6), at SPACEs (?\xB7) and at TABs (?\xBB). +;; +;; The `blank-style' and `blank-chars' variables are used to select +;; which way should be used to visualize blanks. +;; +;; Note that when blank-mode is turned on, blank-mode saves the +;; font-lock state, that is, if font-lock is on or off. And +;; blank-mode restores the font-lock state when it is turned off. So, +;; if blank-mode is turned on and font-lock is off, blank-mode also +;; turns on the font-lock to highlight blanks, but the font-lock will +;; be turned off when blank-mode is turned off. Thus, turn on +;; font-lock before blank-mode is on, if you want that font-lock +;; continues on after blank-mode is turned off. +;; +;; When blank-mode is on, it takes care of highlighting some special +;; characters over the default mechanism of `nobreak-char-display' +;; (which see) and `show-trailing-whitespace' (which see). +;; +;; There are two ways of using blank-mode: local and global. +;; +;; * Local blank-mode affects only the current buffer. +;; +;; * Global blank-mode affects all current and future buffers. That +;; is, if you turn on global blank-mode and then create a new +;; buffer, the new buffer will also have blank-mode on. The +;; `blank-global-modes' variable controls which major-mode will be +;; automagically turned on. +;; +;; You can mix the local and global usage without any conflict. But +;; local blank-mode has priority over global blank-mode. Blank mode +;; is active in a buffer if you have enabled it in that buffer or if +;; you have enabled it globally. +;; +;; When global and local blank-mode are on: +;; +;; * if local blank-mode is turned off, blank-mode is turned off for +;; the current buffer only. +;; +;; * if global blank-mode is turned off, blank-mode continues on only +;; in the buffers in which local blank-mode is on. +;; +;; To use blank-mode, insert in your ~/.emacs: +;; +;; (require 'blank-mode) +;; +;; Or autoload at least one of the commands`blank-mode', +;; `blank-toggle-options', `global-blank-mode' or +;; `global-blank-toggle-options'. For example: +;; +;; (autoload 'blank-mode "blank-mode" +;; "Toggle blank visualization." t) +;; (autoload 'blank-toggle-options "blank-mode" +;; "Toggle local `blank-mode' options." t) +;; +;; blank-mode was inspired by: +;; +;; whitespace.el Rajesh Vaidheeswarran <rv@gnu.org> +;; Warn about and clean bogus whitespaces in the file +;; (inspired the idea to warn and clean some blanks) +;; +;; show-whitespace-mode.el Aurelien Tisne <aurelien.tisne@free.fr> +;; Simple mode to highlight whitespaces +;; (inspired the idea to use font-lock) +;; +;; whitespace-mode.el Lawrence Mitchell <wence@gmx.li> +;; Major mode for editing Whitespace +;; (inspired the idea to use display table) +;; +;; visws.el Miles Bader <miles@gnu.org> +;; Make whitespace visible +;; (handle display table, his code was modified, but the main +;; idea was kept) +;; +;; +;; Using blank-mode +;; ---------------- +;; +;; There is no problem if you mix local and global minor mode usage. +;; +;; * LOCAL blank-mode: +;; + To toggle blank-mode options locally, type: +;; +;; M-x blank-toggle-options RET +;; +;; + To activate blank-mode locally, type: +;; +;; C-u 1 M-x blank-mode RET +;; +;; + To deactivate blank-mode locally, type: +;; +;; C-u 0 M-x blank-mode RET +;; +;; + To toggle blank-mode locally, type: +;; +;; M-x blank-mode RET +;; +;; * GLOBAL blank-mode: +;; + To toggle blank-mode options globally, type: +;; +;; M-x global-blank-toggle-options RET +;; +;; + To activate blank-mode globally, type: +;; +;; C-u 1 M-x global-blank-mode RET +;; +;; + To deactivate blank-mode globally, type: +;; +;; C-u 0 M-x global-blank-mode RET +;; +;; + To toggle blank-mode globally, type: +;; +;; M-x global-blank-mode RET +;; +;; There are also the following useful commands: +;; +;; `blank-cleanup' +;; Cleanup some blank problems in all buffer or at region. +;; +;; `blank-cleanup-region' +;; Cleanup some blank problems at region. +;; +;; The problems, which are cleaned up, are: +;; +;; 1. empty lines at beginning of buffer. +;; 2. empty lines at end of buffer. +;; If `blank-chars' has `empty' as an element, remove all empty +;; lines at beginning and/or end of buffer. +;; +;; 3. 8 or more SPACEs at beginning of line. +;; If `blank-chars' has `indentation' as an element, replace 8 or +;; more SPACEs at beginning of line by TABs. +;; +;; 4. SPACEs before TAB. +;; If `blank-chars' has `space-before-tab' as an element, replace +;; SPACEs by TABs. +;; +;; 5. SPACEs or TABs at end of line. +;; If `blank-chars' has `trailing' as an element, remove all +;; SPACEs or TABs at end of line." +;; +;; 6. 8 or more SPACEs after TAB. +;; If `blank-chars' has `space-after-tab' as an element, replace +;; SPACEs by TABs. +;; +;; +;; Hooks +;; ----- +;; +;; blank-mode has the following hook variables: +;; +;; `blank-mode-hook' +;; It is evaluated always when blank-mode is turned on locally. +;; +;; `global-blank-mode-hook' +;; It is evaluated always when blank-mode is turned on globally. +;; +;; `blank-load-hook' +;; It is evaluated after blank-mode package is loaded. +;; +;; +;; Options +;; ------- +;; +;; Below it's shown a brief description of blank-mode options, please, +;; see the options declaration in the code for a long documentation. +;; +;; `blank-style' Specify the visualization style. +;; +;; `blank-chars' Specify which kind of blank is +;; visualized. +;; +;; `blank-space' Face used to visualize SPACE. +;; +;; `blank-hspace' Face used to visualize HARD SPACE. +;; +;; `blank-tab' Face used to visualize TAB. +;; +;; `blank-newline' Face used to visualize NEWLINE char +;; mapping. +;; +;; `blank-trailing' Face used to visualize trailing +;; blanks. +;; +;; `blank-line' Face used to visualize "long" lines. +;; +;; `blank-space-before-tab' Face used to visualize SPACEs before +;; TAB. +;; +;; `blank-indentation' Face used to visualize 8 or more +;; SPACEs at beginning of line. +;; +;; `blank-empty' Face used to visualize empty lines at +;; beginning and/or end of buffer. +;; +;; `blank-space-after-tab' Face used to visualize 8 or more +;; SPACEs after TAB. +;; +;; `blank-space-regexp' Specify SPACE characters regexp. +;; +;; `blank-hspace-regexp' Specify HARD SPACE characters regexp. +;; +;; `blank-tab-regexp' Specify TAB characters regexp. +;; +;; `blank-trailing-regexp' Specify trailing characters regexp. +;; +;; `blank-space-before-tab-regexp' Specify SPACEs before TAB +;; regexp. +;; +;; `blank-indentation-regexp' Specify regexp for 8 or more SPACEs at +;; beginning of line. +;; +;; `blank-empty-at-bob-regexp' Specify regexp for empty lines at +;; beginning of buffer. +;; +;; `blank-empty-at-eob-regexp' Specify regexp for empty lines at end +;; of buffer. +;; +;; `blank-space-after-tab-regexp' Specify regexp for 8 or more +;; SPACEs after TAB. +;; +;; `blank-line-column' Specify column beyond which the line +;; is highlighted. +;; +;; `blank-display-mappings' Specify an alist of mappings for +;; displaying characters. +;; +;; `blank-global-modes' Modes for which global `blank-mode' is +;; automagically turned on. +;; +;; +;; Acknowledgements +;; ---------------- +;; +;; Thanks to nschum (EmacsWiki) for the idea about highlight "long" +;; lines tail. See EightyColumnRule (EmacsWiki). +;; +;; Thanks to Juri Linkov <juri@jurta.org> for suggesting: +;; * `define-minor-mode'. +;; * `global-blank-*' name for global commands. +;; +;; Thanks to Robert J. Chassell <bob@gnu.org> for doc fix and testing. +;; +;; Thanks to Drew Adams <drew.adams@oracle.com> for toggle commands +;; suggestion. +;; +;; Thanks to Antti Kaihola <antti.kaihola@linux-aktivaattori.org> for +;; helping to fix `find-file-hooks' reference. +;; +;; Thanks to Andreas Roehler <andreas.roehler@easy-emacs.de> for +;; indicating defface byte-compilation warnings. +;; +;; Thanks to TimOCallaghan (EmacsWiki) for the idea about highlight +;; "long" lines. See EightyColumnRule (EmacsWiki). +;; +;; Thanks to Yanghui Bian <yanghuibian@gmail.com> for indicating a new +;; newline character mapping. +;; +;; Thanks to Pete Forman <pete.forman@westgeo.com> for indicating +;; whitespace-mode on XEmacs. +;; +;; Thanks to Miles Bader <miles@gnu.org> for handling display table via +;; visws.el (his code was modified, but the main idea was kept). +;; +;; Thanks to: +;; Rajesh Vaidheeswarran <rv@gnu.org> whitespace.el +;; Aurelien Tisne <aurelien.tisne@free.fr> show-whitespace-mode.el +;; Lawrence Mitchell <wence@gmx.li> whitespace-mode.el +;; Miles Bader <miles@gnu.org> visws.el +;; And to all people who contributed with them. +;; +;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; code: + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; User Variables: + + +;;; Interface to the command system + + +(defgroup blank nil + "Visualize blanks (TAB, (HARD) SPACE and NEWLINE)." + :link '(emacs-library-link :tag "Source Lisp File" "blank-mode.el") + :version "22.2" + :group 'wp + :group 'data) + + +(defcustom blank-style '(mark color) + "*Specify the visualization style. + +It's a list which element value can be: + + mark display mappings are visualized. + + color faces are visualized. + +Any other value is ignored. + +If nil, don't visualize TABs, (HARD) SPACEs and NEWLINEs. + +See also `blank-display-mappings' for documentation." + :type '(repeat :tag "Style of Blank" + (choice :tag "Style of Blank" + (const :tag "Display Table" mark) + (const :tag "Faces" color))) + :group 'blank) + + +(defcustom blank-chars + '(tabs spaces trailing lines space-before-tab newline + indentation empty space-after-tab) + "*Specify which kind of blank is visualized. + +It's a list which element value can be: + + trailing trailing blanks are visualized. + + tabs TABs are visualized. + + spaces SPACEs and HARD SPACEs are visualized. + + lines lines whose have columns beyond + `blank-line-column' are highlighted. + Whole line is highlighted. + It has precedence over + `lines-tail' (see below). + + lines-tail lines whose have columns beyond + `blank-line-column' are highlighted. + But only the part of line which goes + beyond `blank-line-column' column. + It has effect only if `lines' (see above) + is not present in `blank-chars'. + + space-before-tab SPACEs before TAB are visualized. + + newline NEWLINEs are visualized. + + indentation 8 or more SPACEs at beginning of line are + visualized. + + empty empty lines at beginning and/or end of buffer + are visualized. + + space-after-tab 8 or more SPACEs after a TAB are visualized. + +Any other value is ignored. + +If nil, don't visualize TABs, (HARD) SPACEs and NEWLINEs. + +Used when `blank-style' has `color' as an element. +If `blank-chars' has `newline' as an element, used when `blank-style' +has `mark' as an element." + :type '(repeat :tag "Kind of Blank" + (choice :tag "Kind of Blank" + (const :tag "Trailing TABs, SPACEs and HARD SPACEs" + trailing) + (const :tag "SPACEs and HARD SPACEs" spaces) + (const :tag "TABs" tabs) + (const :tag "Lines" lines) + (const :tag "SPACEs before TAB" + space-before-tab) + (const :tag "NEWLINEs" newline) + (const :tag "Indentation SPACEs" indentation) + (const :tag "Empty Lines At BOB And/Or EOB" + empty) + (const :tag "SPACEs after TAB" + space-after-tab))) + :group 'blank) + + +(defcustom blank-space 'blank-space + "*Symbol face used to visualize SPACE. + +Used when `blank-style' has `color' as an element." + :type 'face + :group 'blank) + + +(defface blank-space + '((((class color) (background dark)) + (:background "grey20" :foreground "aquamarine3")) + (((class color) (background light)) + (:background "LightYellow" :foreground "aquamarine3")) + (t (:inverse-video t))) + "Face used to visualize SPACE." + :group 'blank) + + +(defcustom blank-hspace 'blank-hspace + "*Symbol face used to visualize HARD SPACE. + +Used when `blank-style' has `color' as an element." + :type 'face + :group 'blank) + + +(defface blank-hspace ; 'nobreak-space + '((((class color) (background dark)) + (:background "grey24" :foreground "aquamarine3")) + (((class color) (background light)) + (:background "LemonChiffon3" :foreground "aquamarine3")) + (t (:inverse-video t))) + "Face used to visualize HARD SPACE." + :group 'blank) + + +(defcustom blank-tab 'blank-tab + "*Symbol face used to visualize TAB. + +Used when `blank-style' has `color' as an element." + :type 'face + :group 'blank) + + +(defface blank-tab + '((((class color) (background dark)) + (:background "grey22" :foreground "aquamarine3")) + (((class color) (background light)) + (:background "beige" :foreground "aquamarine3")) + (t (:inverse-video t))) + "Face used to visualize TAB." + :group 'blank) + + +(defcustom blank-newline 'blank-newline + "*Symbol face used to visualize NEWLINE char mapping. + +See `blank-display-mappings'. + +Used when `blank-style' has `mark' and `color' as elements +and `blank-chars' has `newline' as an element." + :type 'face + :group 'blank) + + +(defface blank-newline + '((((class color) (background dark)) + (:background "grey26" :foreground "aquamarine3" :bold t)) + (((class color) (background light)) + (:background "linen" :foreground "aquamarine3" :bold t)) + (t (:bold t :underline t))) + "Face used to visualize NEWLINE char mapping. + +See `blank-display-mappings'." + :group 'blank) + + +(defcustom blank-trailing 'blank-trailing + "*Symbol face used to visualize traling blanks. + +Used when `blank-style' has `color' as an element." + :type 'face + :group 'blank) + + +(defface blank-trailing ; 'trailing-whitespace + '((((class mono)) (:inverse-video t :bold t :underline t)) + (t (:background "red1" :foreground "yellow" :bold t))) + "Face used to visualize trailing blanks." + :group 'blank) + + +(defcustom blank-line 'blank-line + "*Symbol face used to visualize \"long\" lines. + +See `blank-line-column'. + +Used when `blank-style' has `color' as an element." + :type 'face + :group 'blank) + + +(defface blank-line + '((((class mono)) (:inverse-video t :bold t :underline t)) + (t (:background "gray20" :foreground "violet"))) + "Face used to visualize \"long\" lines. + +See `blank-line-column'." + :group 'blank) + + +(defcustom blank-space-before-tab 'blank-space-before-tab + "*Symbol face used to visualize SPACEs before TAB. + +Used when `blank-style' has `color' as an element." + :type 'face + :group 'blank) + + +(defface blank-space-before-tab + '((((class mono)) (:inverse-video t :bold t :underline t)) + (t (:background "DarkOrange" :foreground "firebrick"))) + "Face used to visualize SPACEs before TAB." + :group 'blank) + + +(defcustom blank-indentation 'blank-indentation + "*Symbol face used to visualize 8 or more SPACEs at beginning of line. + +Used when `blank-style' has `color' as an element." + :type 'face + :group 'blank) + + +(defface blank-indentation + '((((class mono)) (:inverse-video t :bold t :underline t)) + (t (:background "yellow" :foreground "firebrick"))) + "Face used to visualize 8 or more SPACEs at beginning of line." + :group 'blank) + + +(defcustom blank-empty 'blank-empty + "*Symbol face used to visualize empty lines at beginning and/or end of buffer. + +Used when `blank-style' has `color' as an element." + :type 'face + :group 'blank) + + +(defface blank-empty + '((((class mono)) (:inverse-video t :bold t :underline t)) + (t (:background "yellow" :foreground "firebrick"))) + "Face used to visualize empty lines at beginning and/or end of buffer." + :group 'blank) + + +(defcustom blank-space-after-tab 'blank-space-after-tab + "*Symbol face used to visualize 8 or more SPACEs after TAB. + +Used when `blank-style' has `color' as an element." + :type 'face + :group 'blank) + + +(defface blank-space-after-tab + '((((class mono)) (:inverse-video t :bold t :underline t)) + (t (:background "yellow" :foreground "firebrick"))) + "Face used to visualize 8 or more SPACEs after TAB." + :group 'blank) + + +(defcustom blank-hspace-regexp + "\\(\\(\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20\\)+\\)" + "*Specify HARD SPACE characters regexp. + +If you're using `mule' package, it may exist other characters besides: + + \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \"\\xF20\" + +that should be considered HARD SPACE. + +Here are some examples: + + \"\\\\(^\\xA0+\\\\)\" \ +visualize only leading HARD SPACEs. + \"\\\\(\\xA0+$\\\\)\" \ +visualize only trailing HARD SPACEs. + \"\\\\(^\\xA0+\\\\|\\xA0+$\\\\)\" \ +visualize leading and/or trailing HARD SPACEs. + \"\\t\\\\(\\xA0+\\\\)\\t\" \ +visualize only HARD SPACEs between TABs. + +NOTE: Enclose always by \\\\( and \\\\) the elements to highlight. + Use exactly one pair of enclosing \\\\( and \\\\). + +Used when `blank-style' has `color' as an element, and +`blank-chars' has `spaces' as an element." + :type '(regexp :tag "HARD SPACE Chars") + :group 'blank) + + +(defcustom blank-space-regexp "\\( +\\)" + "*Specify SPACE characters regexp. + +If you're using `mule' package, it may exist other characters +besides \" \" that should be considered SPACE. + +Here are some examples: + + \"\\\\(^ +\\\\)\" visualize only leading SPACEs. + \"\\\\( +$\\\\)\" visualize only trailing SPACEs. + \"\\\\(^ +\\\\| +$\\\\)\" \ +visualize leading and/or trailing SPACEs. + \"\\t\\\\( +\\\\)\\t\" visualize only SPACEs between TABs. + +NOTE: Enclose always by \\\\( and \\\\) the elements to highlight. + Use exactly one pair of enclosing \\\\( and \\\\). + +Used when `blank-style' has `color' as an element, and +`blank-chars' has `spaces' as an element." + :type '(regexp :tag "SPACE Chars") + :group 'blank) + + +(defcustom blank-tab-regexp "\\(\t+\\)" + "*Specify TAB characters regexp. + +If you're using `mule' package, it may exist other characters +besides \"\\t\" that should be considered TAB. + +Here are some examples: + + \"\\\\(^\\t+\\\\)\" visualize only leading TABs. + \"\\\\(\\t+$\\\\)\" visualize only trailing TABs. + \"\\\\(^\\t+\\\\|\\t+$\\\\)\" \ +visualize leading and/or trailing TABs. + \" \\\\(\\t+\\\\) \" visualize only TABs between SPACEs. + +NOTE: Enclose always by \\\\( and \\\\) the elements to highlight. + Use exactly one pair of enclosing \\\\( and \\\\). + +Used when `blank-style' has `color' as an element, and +`blank-chars' has `tabs' as an element." + :type '(regexp :tag "TAB Chars") + :group 'blank) + + +(defcustom blank-trailing-regexp + "\t\\| \\|\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20" + "*Specify trailing characters regexp. + +If you're using `mule' package, it may exist other characters besides: + + \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ +\"\\xF20\" + +that should be considered blank. + +NOTE: DO NOT enclose by \\\\( and \\\\) the elements to highlight. + `blank-mode' surrounds this regexp by \"\\\\(\\\\(\" and + \"\\\\)+\\\\)$\". + +Used when `blank-style' has `color' as an element, and +`blank-chars' has `trailing' as an element." + :type '(regexp :tag "Trailing Chars") + :group 'blank) + + +(defcustom blank-space-before-tab-regexp "\\( +\\)\t" + "*Specify SPACEs before TAB regexp. + +If you're using `mule' package, it may exist other characters besides: + + \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ +\"\\xF20\" + +that should be considered blank. + +Used when `blank-style' has `color' as an element, and +`blank-chars' has `space-before-tab' as an element." + :type '(regexp :tag "SPACEs Before TAB") + :group 'blank) + + +(defcustom blank-indentation-regexp "^\t*\\(\\( \\{8\\}\\)+\\)[^\n\t]" + "*Specify regexp for 8 or more SPACEs at beginning of line. + +If you're using `mule' package, it may exist other characters besides: + + \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ +\"\\xF20\" + +that should be considered blank. + +Used when `blank-style' has `color' as an element, and +`blank-chars' has `indentation' as an element." + :type '(regexp :tag "Indentation SPACEs") + :group 'blank) + + +(defcustom blank-empty-at-bob-regexp "\\`\\(\\([ \t]*\n\\)+\\)" + "*Specify regexp for empty lines at beginning of buffer. + +If you're using `mule' package, it may exist other characters besides: + + \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ +\"\\xF20\" + +that should be considered blank. + +Used when `blank-style' has `color' as an element, and +`blank-chars' has `empty' as an element." + :type '(regexp :tag "Empty Lines At Beginning Of Buffer") + :group 'blank) + + +(defcustom blank-empty-at-eob-regexp "^\\([ \t\n]+\\)\\'" + "*Specify regexp for empty lines at end of buffer. + +If you're using `mule' package, it may exist other characters besides: + + \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ +\"\\xF20\" + +that should be considered blank. + +Used when `blank-style' has `color' as an element, and +`blank-chars' has `empty' as an element." + :type '(regexp :tag "Empty Lines At End Of Buffer") + :group 'blank) + + +(defcustom blank-space-after-tab-regexp "\t\\(\\( \\{8\\}\\)+\\)" + "*Specify regexp for 8 or more SPACEs after TAB. + +If you're using `mule' package, it may exist other characters besides: + + \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ +\"\\xF20\" + +that should be considered blank. + +Used when `blank-style' has `color' as an element, and +`blank-chars' has `space-after-tab' as an element." + :type '(regexp :tag "SPACEs After TAB") + :group 'blank) + + +(defcustom blank-line-column 80 + "*Specify column beyond which the line is highlighted. + +Used when `blank-style' has `color' as an element, and +`blank-chars' has `lines' or `lines-tail' as an element." + :type '(integer :tag "Line Length") + :group 'blank) + + +;; Hacked from `visible-whitespace-mappings' in visws.el +(defcustom blank-display-mappings + ;; Due to limitations of glyph representation, the char code can not + ;; be above ?\x1FFFF. Probably, this will be fixed after Emacs + ;; unicode merging. + '( + (?\ [?\xB7] [?.]) ; space - centered dot + (?\xA0 [?\xA4] [?_]) ; hard space - currency + (?\x8A0 [?\x8A4] [?_]) ; hard space - currency + (?\x920 [?\x924] [?_]) ; hard space - currency + (?\xE20 [?\xE24] [?_]) ; hard space - currency + (?\xF20 [?\xF24] [?_]) ; hard space - currency + ;; NEWLINE is displayed using the face `blank-newline' + (?\n [?$ ?\n]) ; end-of-line - dollar sign + ;; (?\n [?\u21B5 ?\n] [?$ ?\n]) ; end-of-line - downwards arrow + ;; (?\n [?\xB6 ?\n] [?$ ?\n]) ; end-of-line - pilcrow + ;; (?\n [?\x8AF ?\n] [?$ ?\n]) ; end-of-line - overscore + ;; (?\n [?\x8AC ?\n] [?$ ?\n]) ; end-of-line - negation + ;; (?\n [?\x8B0 ?\n] [?$ ?\n]) ; end-of-line - grade + ;; + ;; WARNING: the mapping below has a problem. + ;; When a TAB occupies exactly one column, it will display the + ;; character ?\xBB at that column followed by a TAB which goes to + ;; the next TAB column. + ;; If this is a problem for you, please, comment the line below. + (?\t [?\xBB ?\t] [?\\ ?\t]) ; tab - left quote mark + ) + "*Specify an alist of mappings for displaying characters. + +Each element has the following form: + + (CHAR VECTOR...) + +Where: + +CHAR is the character to be mapped. + +VECTOR is a vector of characters to be displayed in place of CHAR. + The first display vector that can be displayed is used; + if no display vector for a mapping can be displayed, then + that character is displayed unmodified. + +The NEWLINE character is displayed using the face given by +`blank-newline' variable. The characters in the vector to be +displayed will not have this face applied if the character code +is above #x1FFFF. + +Used when `blank-style' has `mark' as an element." + :type '(repeat + (list :tag "Character Mapping" + (character :tag "Char") + (repeat :inline t :tag "Vector List" + (vector :tag "" + (repeat :inline t + :tag "Vector Characters" + (character :tag "Char")))))) + :group 'blank) + + +(defcustom blank-global-modes t + "*Modes for which global `blank-mode' is automagically turned on. + +Global `blank-mode' is controlled by the command `global-blank-mode'. + +If nil, means no modes have `blank-mode' automatically turned on. +If t, all modes that support `blank-mode' have it automatically +turned on. +Else it should be a list of `major-mode' symbol names for +which `blank-mode' should be automatically turned on. The sense +of the list is negated if it begins with `not'. For example: + + (c-mode c++-mode) + +means that `blank-mode' is turned on for buffers in C and C++ +modes only." + :type '(choice (const :tag "None" nil) + (const :tag "All" t) + (set :menu-tag "Mode Specific" :tag "Modes" + :value (not) + (const :tag "Except" not) + (repeat :inline t + (symbol :tag "Mode")))) + :group 'blank) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; User commands - Local mode + + +;;;###autoload +(define-minor-mode blank-mode + "Toggle blank minor mode visualization (\"bl\" on modeline). + +If ARG is null, toggle blank visualization. +If ARG is a number greater than zero, turn on visualization; +otherwise, turn off visualization. +Only useful with a windowing system." + :lighter " bl" + :init-value nil + :global nil + :group 'blank + (cond + (noninteractive ; running a batch job + (setq blank-mode nil)) + (blank-mode ; blank-mode on + (blank-turn-on)) + (t ; blank-mode off + (blank-turn-off)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; User commands - Global mode + + +(define-minor-mode global-blank-mode + "Toggle blank global minor mode visualization (\"BL\" on modeline). + +If ARG is null, toggle blank visualization. +If ARG is a number greater than zero, turn on visualization; +otherwise, turn off visualization. +Only useful with a windowing system." + :lighter " BL" + :init-value nil + :global t + :group 'blank + (cond + (noninteractive ; running a batch job + (setq global-blank-mode nil)) + (global-blank-mode ; global-blank-mode on + (save-excursion + (if (boundp 'find-file-hook) + (add-hook 'find-file-hook 'blank-turn-on-if-enabled t) + (add-hook 'find-file-hooks 'blank-turn-on-if-enabled t)) + (dolist (buffer (buffer-list)) ; adjust all local mode + (set-buffer buffer) + (unless blank-mode + (blank-turn-on-if-enabled))))) + (t ; global-blank-mode off + (save-excursion + (if (boundp 'find-file-hook) + (remove-hook 'find-file-hook 'blank-turn-on-if-enabled) + (remove-hook 'find-file-hooks 'blank-turn-on-if-enabled)) + (dolist (buffer (buffer-list)) ; adjust all local mode + (set-buffer buffer) + (unless blank-mode + (blank-turn-off))))))) + + +(defun blank-turn-on-if-enabled () + (when (cond + ((eq blank-global-modes t)) + ((listp blank-global-modes) + (if (eq (car-safe blank-global-modes) 'not) + (not (memq major-mode (cdr blank-global-modes))) + (memq major-mode blank-global-modes))) + (t nil)) + (let (inhibit-quit) + ;; Don't turn on blank mode if... + (or + ;; ...we don't have a display (we're running a batch job) + noninteractive + ;; ...or if the buffer is invisible (name starts with a space) + (eq (aref (buffer-name) 0) ?\ ) + ;; ...or if the buffer is temporary (name starts with *) + (and (eq (aref (buffer-name) 0) ?*) + ;; except the scratch buffer. + (not (string= (buffer-name) "*scratch*"))) + ;; Otherwise, turn on blank mode. + (blank-turn-on))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; User commands - Toggle + + +(defconst blank-chars-value-list + '(tabs + spaces + trailing + space-before-tab + lines + lines-tail + newline + indentation + empty + space-after-tab + ) + "List of valid `blank-chars' values.") + + +(defconst blank-style-value-list + '(color + mark + ) + "List of valid `blank-style' values.") + + +(defconst blank-toggle-option-alist + '((?t . tabs) + (?s . spaces) + (?r . trailing) + (?b . space-before-tab) + (?l . lines) + (?L . lines-tail) + (?n . newline) + (?i . indentation) + (?e . empty) + (?a . space-after-tab) + (?c . color) + (?m . mark) + (?x . blank-chars) + (?z . blank-style) + ) + "Alist of toggle options. + +Each element has the form: + + (CHAR . SYMBOL) + +Where: + +CHAR is a char which the user will have to type. + +SYMBOL is a valid symbol associated with CHAR. + See `blank-chars-value-list' and `blank-style-value-list'.") + + +(defvar blank-active-chars nil + "Used to save locally `blank-chars' value.") +(make-variable-buffer-local 'blank-active-chars) + +(defvar blank-active-style nil + "Used to save locally `blank-style' value.") +(make-variable-buffer-local 'blank-active-style) + + +;;;###autoload +(defun blank-toggle-options (arg) + "Toggle local `blank-mode' options. + +If local blank-mode is off, toggle the option given by ARG and +turn on local blank-mode. + +If local blank-mode is on, toggle the option given by ARG and +restart local blank-mode. + +Interactively, it reads one of the following chars: + + CHAR MEANING + t toggle TAB visualization + s toggle SPACE and HARD SPACE visualization + r toggle trailing blanks visualization + b toggle SPACEs before TAB visualization + l toggle \"long lines\" visualization + L toggle \"long lines\" tail visualization + n toggle NEWLINE visualization + i toggle indentation SPACEs visualization + e toggle empty line at bob and/or eob visualization + a toggle SPACEs after TAB visualization + c toggle color faces + m toggle visual mark + x restore `blank-chars' value + z restore `blank-style' value + ? display brief help + +Non-interactively, ARG should be a symbol or a list of symbols. +The valid symbols are: + + tabs toggle TAB visualization + spaces toggle SPACE and HARD SPACE visualization + trailing toggle trailing blanks visualization + space-before-tab toggle SPACEs before TAB visualization + lines toggle \"long lines\" visualization + lines-tail toggle \"long lines\" tail visualization + newline toggle NEWLINE visualization + indentation toggle indentation SPACEs visualization + empty toggle empty line at bob and/or eob visualization + space-after-tab toggle SPACEs after TAB visualization + color toggle color faces + mark toggle visual mark + blank-chars restore `blank-chars' value + blank-style restore `blank-style' value + +Only useful with a windowing system." + (interactive (blank-interactive-char t)) + (let ((blank-chars + (blank-toggle-list t arg blank-active-chars blank-chars + 'blank-chars blank-chars-value-list)) + (blank-style + (blank-toggle-list t arg blank-active-style blank-style + 'blank-style blank-style-value-list))) + (blank-mode 0) + (blank-mode 1))) + + +(defvar blank-toggle-chars nil + "Used to toggle the global `blank-chars' value.") +(defvar blank-toggle-style nil + "Used to toggle the global `blank-style' value.") + + +;;;###autoload +(defun global-blank-toggle-options (arg) + "Toggle global `blank-mode' options. + +If global blank-mode is off, toggle the option given by ARG and +turn on global blank-mode. + +If global blank-mode is on, toggle the option given by ARG and +restart global blank-mode. + +Interactively, it reads one of the following chars: + + CHAR MEANING + t toggle TAB visualization + s toggle SPACE and HARD SPACE visualization + r toggle trailing blanks visualization + b toggle SPACEs before TAB visualization + l toggle \"long lines\" visualization + L toggle \"long lines\" tail visualization + n toggle NEWLINE visualization + i toggle indentation SPACEs visualization + e toggle empty line at bob and/or eob visualization + a toggle SPACEs after TAB visualization + c toggle color faces + m toggle visual mark + x restore `blank-chars' value + z restore `blank-style' value + ? display brief help + +Non-interactively, ARG should be a symbol or a list of symbols. +The valid symbols are: + + tabs toggle TAB visualization + spaces toggle SPACE and HARD SPACE visualization + trailing toggle trailing blanks visualization + space-before-tab toggle SPACEs before TAB visualization + lines toggle \"long lines\" visualization + lines-tail toggle \"long lines\" tail visualization + newline toggle NEWLINE visualization + indentation toggle indentation SPACEs visualization + empty toggle empty line at bob and/or eob visualization + space-after-tab toggle SPACEs after TAB visualization + color toggle color faces + mark toggle visual mark + blank-chars restore `blank-chars' value + blank-style restore `blank-style' value + +Only useful with a windowing system." + (interactive (blank-interactive-char nil)) + (let ((blank-chars + (blank-toggle-list nil arg blank-toggle-chars blank-chars + 'blank-chars blank-chars-value-list)) + (blank-style + (blank-toggle-list nil arg blank-toggle-style blank-style + 'blank-style blank-style-value-list))) + (setq blank-toggle-chars blank-chars + blank-toggle-style blank-style) + (global-blank-mode 0) + (global-blank-mode 1))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; User commands - Cleanup + + +;;;###autoload +(defun blank-cleanup () + "Cleanup some blank problems in all buffer or at region. + +It usually applies to the whole buffer, but in transient mark +mode when the mark is active, it applies to the region. It also +applies to the region when it is not in transiente mark mode, the +mark is active and it was pressed `C-u' just before calling +`blank-cleanup' interactively. + +See also `blank-cleanup-region'. + +The problems, which are cleaned up, are: + +1. empty lines at beginning of buffer. +2. empty lines at end of buffer. + If `blank-chars' has `empty' as an element, remove all empty + lines at beginning and/or end of buffer. + +3. 8 or more SPACEs at beginning of line. + If `blank-chars' has `indentation' as an element, replace 8 or + more SPACEs at beginning of line by TABs. + +4. SPACEs before TAB. + If `blank-chars' has `space-before-tab' as an element, replace + SPACEs by TABs. + +5. SPACEs or TABs at end of line. + If `blank-chars' has `trailing' as an element, remove all + SPACEs or TABs at end of line. + +6. 8 or more SPACEs after TAB. + If `blank-chars' has `space-after-tab' as an element, replace + SPACEs by TABs." + (interactive "@*") + (if (and (or transient-mark-mode + current-prefix-arg) + mark-active) + ;; region active + ;; problems 1 and 2 are not handled in region + ;; problem 3: 8 or more SPACEs at bol + ;; problem 4: SPACEs before TAB + ;; problem 5: SPACEs or TABs at eol + ;; problem 6: 8 or more SPACEs after TAB + (blank-cleanup-region (region-beginning) (region-end)) + ;; whole buffer + (save-excursion + (save-match-data + ;; problem 1: empty lines at bob + ;; problem 2: empty lines at eob + ;; action: remove all empty lines at bob and/or eob + (when (memq 'empty blank-chars) + (let (overwrite-mode) ; enforce no overwrite + (goto-char (point-min)) + (when (re-search-forward blank-empty-at-bob-regexp nil t) + (delete-region (match-beginning 1) (match-end 1))) + (when (re-search-forward blank-empty-at-eob-regexp nil t) + (delete-region (match-beginning 1) (match-end 1))))))) + ;; problem 3: 8 or more SPACEs at bol + ;; problem 4: SPACEs before TAB + ;; problem 5: SPACEs or TABs at eol + ;; problem 6: 8 or more SPACEs after TAB + (blank-cleanup-region (point-min) (point-max)))) + + +;;;###autoload +(defun blank-cleanup-region (start end) + "Cleanup some blank problems at region. + +The problems, which are cleaned up, are: + +1. 8 or more SPACEs at beginning of line. + If `blank-chars' has `indentation' as an element, replace 8 or + more SPACEs at beginning of line by TABs. + +2. SPACEs before TAB. + If `blank-chars' has `space-before-tab' as an element, replace + SPACEs by TABs. + +3. SPACEs or TABs at end of line. + If `blank-chars' has `trailing' as an element, remove all + SPACEs or TABs at end of line. + +4. 8 or more SPACEs after TAB. + If `blank-chars' has `space-after-tab' as an element, replace + SPACEs by TABs." + (interactive "@*r") + (let ((rstart (min start end)) + (rend (copy-marker (max start end))) + (tab-width 8) ; assure TAB width + (indent-tabs-mode t) ; always insert TABs + overwrite-mode ; enforce no overwrite + tmp) + (save-excursion + (save-match-data + ;; problem 1: 8 or more SPACEs at bol + ;; action: replace 8 or more SPACEs at bol by TABs + (when (memq 'indentation blank-chars) + (goto-char rstart) + (while (re-search-forward blank-indentation-regexp rend t) + (setq tmp (current-indentation)) + (delete-horizontal-space) + (unless (eolp) + (indent-to tmp)))) + ;; problem 3: SPACEs or TABs at eol + ;; action: remove all SPACEs or TABs at eol + (when (memq 'trailing blank-chars) + (let ((regexp (concat "\\(\\(" blank-trailing-regexp + "\\)+\\)$"))) + (goto-char rstart) + (while (re-search-forward regexp rend t) + (delete-region (match-beginning 1) (match-end 1))))) + ;; problem 4: 8 or more SPACEs after TAB + ;; action: replace 8 or more SPACEs by TABs + (when (memq 'space-after-tab blank-chars) + (blank-replace-spaces-by-tabs + rstart rend blank-space-after-tab-regexp)) + ;; problem 2: SPACEs before TAB + ;; action: replace SPACEs before TAB by TABs + (when (memq 'space-before-tab blank-chars) + (blank-replace-spaces-by-tabs + rstart rend blank-space-before-tab-regexp)))) + (set-marker rend nil))) ; point marker to nowhere + + +(defun blank-replace-spaces-by-tabs (rstart rend regexp) + "Replace all SPACEs by TABs matched by REGEXP between RSTART and REND." + (goto-char rstart) + (while (re-search-forward regexp rend t) + (goto-char (match-beginning 1)) + (let* ((scol (current-column)) + (ecol (save-excursion + (goto-char (match-end 1)) + (current-column)))) + (delete-region (match-beginning 1) (match-end 1)) + (insert-char ?\t + (/ (- (- ecol (% ecol 8)) ; prev end col + (- scol (% scol 8))) ; prev start col + 8))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Internal functions + + +(defvar blank-font-lock-mode nil + "Used to remember whether a buffer had font lock mode on or not.") +(make-variable-buffer-local 'blank-font-lock-mode) + +(defvar blank-font-lock nil + "Used to remember whether a buffer initially had font lock on or not.") +(make-variable-buffer-local 'blank-font-lock) + +(defvar blank-font-lock-keywords nil + "Used to save locally `font-lock-keywords' value.") +(make-variable-buffer-local 'blank-font-lock-keywords) + + +(defconst blank-help-text + "\ + blank-mode toggle options: + + [] t - toggle TAB visualization + [] s - toggle SPACE and HARD SPACE visualization + [] r - toggle trailing blanks visualization + [] b - toggle SPACEs before TAB visualization + [] l - toggle \"long lines\" visualization + [] L - toggle \"long lines\" tail visualization + [] n - toggle NEWLINE visualization + [] i - toggle indentation SPACEs visualization + [] e - toggle empty line at bob and/or eob visualization + [] a - toggle SPACEs after TAB visualization + + [] c - toggle color faces + [] m - toggle visual mark + + x - restore `blank-chars' value + z - restore `blank-style' value + + ? - display this text\n\n" + "Text for blank toggle options.") + + +(defconst blank-help-buffer-name "*Blank Toggle Options*" + "The buffer name for blank toggle options.") + + +(defun blank-insert-option-mark (the-list the-value) + "Insert the option mark ('X' or ' ') in toggle options buffer." + (forward-line 1) + (dolist (sym the-list) + (forward-line 1) + (forward-char 2) + (insert (if (memq sym the-value) "X" " ")))) + + +(defun blank-help-on (chars style) + "Display the blank toggle options." + (unless (get-buffer blank-help-buffer-name) + (delete-other-windows) + (let ((buffer (get-buffer-create blank-help-buffer-name))) + (save-excursion + (set-buffer buffer) + (erase-buffer) + (insert blank-help-text) + (goto-char (point-min)) + (blank-insert-option-mark blank-chars-value-list chars) + (blank-insert-option-mark blank-style-value-list style) + (goto-char (point-min)) + (set-buffer-modified-p nil) + (let ((size (- (window-height) + (max window-min-height + (1+ (count-lines (point-min) (point-max))))))) + (when (<= size 0) + (kill-buffer buffer) + (error "Frame height is too small; \ +can't split window to display blank toggle options")) + (set-window-buffer (split-window nil size) buffer)))))) + + +(defun blank-help-off () + "Remove the buffer and window of the blank toggle options." + (let ((buffer (get-buffer blank-help-buffer-name))) + (when buffer + (delete-windows-on buffer) + (kill-buffer buffer)))) + + +(defun blank-interactive-char (local-p) + "Interactive function to read a char and return a symbol. + +If LOCAL-P is non-nil, it uses a local context; otherwise, it +uses a global context. + +It reads one of the following chars: + + CHAR MEANING + t toggle TAB visualization + s toggle SPACE and HARD SPACE visualization + r toggle trailing blanks visualization + b toggle SPACEs before TAB visualization + l toggle \"long lines\" visualization + L toggle \"long lines\" tail visualization + n toggle NEWLINE visualization + i toggle indentation SPACEs visualization + e toggle empty line at bob and/or eob visualization + a toggle SPACEs after TAB visualization + c toggle color faces + m toggle visual mark + x restore `blank-chars' value + z restore `blank-style' value + ? display brief help + +See also `blank-toggle-option-alist'." + (let* ((is-off (not (if local-p blank-mode global-blank-mode))) + (chars (cond (is-off blank-chars) ; use default value + (local-p blank-active-chars) + (t blank-toggle-chars))) + (style (cond (is-off blank-style) ; use default value + (local-p blank-active-style) + (t blank-toggle-style))) + (prompt + (format "Blank Toggle %s (type ? for further options)-" + (if local-p "Local" "Global"))) + ch sym) + ;; read a valid option and get the corresponding symbol + (save-window-excursion + (condition-case data + (progn + (while + ;; while condition + (progn + (setq ch (read-char prompt)) + (not + (setq sym + (cdr (assq ch blank-toggle-option-alist))))) + ;; while body + (if (eq ch ?\?) + (blank-help-on chars style) + (ding))) + (blank-help-off) + (message " ")) ; clean echo area + ;; handler + ((quit error) + (blank-help-off) + (error (error-message-string data))))) + (list sym))) ; return the apropriate symbol + + +(defun blank-toggle-list (local-p arg the-list default-list + sym-restore sym-list) + "Toggle options in THE-LIST based on list ARG. + +If LOCAL-P is non-nil, it uses a local context; otherwise, it +uses a global context. + +ARG is a list of options to be toggled. + +THE-LIST is a list of options. This list will be toggled and the +resultant list will be returned. + +DEFAULT-LIST is the default list of options. It is used to +restore the options in THE-LIST. + +SYM-RESTORE is the symbol which indicates to restore the options +in THE-LIST. + +SYM-LIST is a list of valid options, used to check if the ARG's +options are valid." + (unless (if local-p blank-mode global-blank-mode) + (setq the-list default-list)) + (setq the-list (copy-sequence the-list)) ; keep original list + (dolist (sym (if (listp arg) arg (list arg))) + (cond + ;; restore default values + ((eq sym sym-restore) + (setq the-list default-list)) + ;; toggle valid values + ((memq sym sym-list) + (setq the-list (if (memq sym the-list) + (delq sym the-list) + (cons sym the-list)))))) + the-list) + + +(defun blank-turn-on () + "Turn on blank visualization." + (setq blank-active-style (if (listp blank-style) + blank-style + (list blank-style))) + (setq blank-active-chars (if (listp blank-chars) + blank-chars + (list blank-chars))) + (when (memq 'color blank-active-style) + (blank-color-on)) + (when (memq 'mark blank-active-style) + (blank-display-char-on))) + + +(defun blank-turn-off () + "Turn off blank visualization." + (when (memq 'color blank-active-style) + (blank-color-off)) + (when (memq 'mark blank-active-style) + (blank-display-char-off))) + + +(defun blank-color-on () + "Turn on color visualization." + (when blank-active-chars + (unless blank-font-lock + (setq blank-font-lock t + blank-font-lock-keywords + (copy-sequence font-lock-keywords))) + ;; turn off font lock + (setq blank-font-lock-mode font-lock-mode) + (font-lock-mode 0) + ;; add blank-mode color into font lock + (when (memq 'spaces blank-active-chars) + (font-lock-add-keywords + nil + (list + ;; Show SPACEs + (list blank-space-regexp 1 blank-space t) + ;; Show HARD SPACEs + (list blank-hspace-regexp 1 blank-hspace t)) + t)) + (when (memq 'tabs blank-active-chars) + (font-lock-add-keywords + nil + (list + ;; Show TABs + (list blank-tab-regexp 1 blank-tab t)) + t)) + (when (memq 'trailing blank-active-chars) + (font-lock-add-keywords + nil + (list + ;; Show trailing blanks + (list (concat "\\(\\(" blank-trailing-regexp "\\)+\\)$") + 1 blank-trailing t)) + t)) + (when (or (memq 'lines blank-active-chars) + (memq 'lines-tail blank-active-chars)) + (font-lock-add-keywords + nil + (list + ;; Show "long" lines + (list + (format + "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$" + tab-width (1- tab-width) + (/ blank-line-column tab-width) + (let ((rem (% blank-line-column tab-width))) + (if (zerop rem) + "" + (format ".\\{%d\\}" rem)))) + (if (memq 'lines blank-active-chars) + 0 ; whole line + 2) ; line tail + blank-line t)) + t)) + (when (memq 'space-before-tab blank-active-chars) + (font-lock-add-keywords + nil + (list + ;; Show SPACEs before TAB + (list blank-space-before-tab-regexp + 1 blank-space-before-tab t)) + t)) + (when (memq 'indentation blank-active-chars) + (font-lock-add-keywords + nil + (list + ;; Show indentation SPACEs + (list blank-indentation-regexp + 1 blank-indentation t)) + t)) + (when (memq 'empty blank-active-chars) + (font-lock-add-keywords + nil + (list + ;; Show empty lines at beginning of buffer + (list blank-empty-at-bob-regexp + 1 blank-empty t)) + t) + (font-lock-add-keywords + nil + (list + ;; Show empty lines at end of buffer + (list blank-empty-at-eob-regexp + 1 blank-empty t)) + t)) + (when (memq 'space-after-tab blank-active-chars) + (font-lock-add-keywords + nil + (list + ;; Show SPACEs after TAB + (list blank-space-after-tab-regexp + 1 blank-space-after-tab t)) + t)) + ;; now turn on font lock and highlight blanks + (font-lock-mode 1))) + + +(defun blank-color-off () + "Turn off color visualization." + (when blank-active-chars + ;; turn off font lock + (font-lock-mode 0) + (when blank-font-lock + (setq blank-font-lock nil + font-lock-keywords blank-font-lock-keywords)) + ;; restore original font lock state + (font-lock-mode blank-font-lock-mode))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Hacked from visws.el (Miles Bader <miles@gnu.org>) + + +(defvar blank-display-table nil + "Used to save a local display table.") +(make-variable-buffer-local 'blank-display-table) + +(defvar blank-display-table-was-local nil + "Used to remember whether a buffer initially had a local display table or not.") +(make-variable-buffer-local 'blank-display-table-was-local) + + +(defsubst blank-char-valid-p (char) + ;; This check should be improved!!! + (or (< char 256) + (char-valid-p char))) + + +(defun blank-legal-display-vector-p (vec) + "Return true if every character in vector VEC can be displayed." + (let ((i (length vec))) + (when (> i 0) + (while (and (>= (setq i (1- i)) 0) + (blank-char-valid-p (aref vec i)))) + (< i 0)))) + + +(defun blank-display-char-on () + "Turn on character display mapping." + (when blank-display-mappings + (let (vecs vec) + ;; Remember whether a buffer has a local display table. + (unless blank-display-table-was-local + (setq blank-display-table-was-local t + blank-display-table + (copy-sequence buffer-display-table))) + (unless buffer-display-table + (setq buffer-display-table (make-display-table))) + (dolist (entry blank-display-mappings) + (setq vecs (cdr entry)) + ;; Get a displayable mapping. + (while (and vecs + (not (blank-legal-display-vector-p (car vecs)))) + (setq vecs (cdr vecs))) + ;; Display a valid mapping. + (when vecs + (setq vec (copy-sequence (car vecs))) + (cond + ;; Any char except newline + ((not (eq (car entry) ?\n)) + (aset buffer-display-table (car entry) vec)) + ;; Newline char - display it + ((memq 'newline blank-active-chars) + ;; Only insert face bits on NEWLINE char mapping to avoid + ;; obstruction of other faces like TABs and (HARD) SPACEs + ;; faces, font-lock faces, etc. + (when (memq 'color blank-active-style) + (dotimes (i (length vec)) + ;; Due to limitations of glyph representation, the char + ;; code can not be above ?\x1FFFF. Probably, this will + ;; be fixed after Emacs unicode merging. + (or (eq (aref vec i) ?\n) + (> (aref vec i) #x1FFFF) + (aset vec i (make-glyph-code (aref vec i) + blank-newline))))) + ;; Display mapping + (aset buffer-display-table (car entry) vec)) + ;; Newline char - don't display it + (t + ;; Do nothing + ))))))) + + +(defun blank-display-char-off () + "Turn off character display mapping." + (and blank-display-mappings + blank-display-table-was-local + (setq blank-display-table-was-local nil + buffer-display-table blank-display-table))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Aliases for whitespace compatibility + + +;;;###autoload +(defun whitespace-buffer () + (interactive) + (blank-mode 0) ; assure is off + ;; keep original values + (let ((blank-style (copy-sequence blank-style)) + (blank-chars (copy-sequence blank-chars))) + ;; adjust options for whitespace bogus blanks + (add-to-list 'blank-style 'color) + (mapc #'(lambda (option) + (add-to-list 'blank-chars option)) + '(trailing + indentation + space-before-tab + empty + space-after-tab)) + (blank-mode 1))) + +;;;###autoload +(defalias 'whitespace-region 'whitespace-buffer) ; there is no `blank-region' + +;;;###autoload +(defalias 'whitespace-cleanup 'blank-cleanup) + +;;;###autoload +(defalias 'whitespace-cleanup-region 'blank-cleanup-region) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(provide 'blank-mode) + + +(run-hooks 'blank-load-hook) + + +;; arch-tag: 1b1e2500-dbd4-4a26-8f7a-5a5edfd3c97e +;;; 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." ;;;###autoload (defun define-button-type (name &rest properties) - "Define a `button type' called NAME. + "Define a `button type' called NAME (a symbol). The remaining arguments form a sequence of PROPERTY VALUE pairs, specifying properties to use as defaults for buttons with this type \(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 @@ ;;; calc-menu.el --- a menu for Calc -;; Copyright (C) 2007 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> 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 @@ ;;; calc-nlfit.el --- nonlinear curve fitting for Calc -;; Copyright (C) 2007 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> 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 @@ "--" ,@(let ((l ())) ;; Show 11 years--5 before, 5 after year of middle month. + ;; We used to use :suffix rather than :label and bumped into + ;; an easymenu bug: ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01813.html + ;; The bug has since been fixed. (dotimes (i 11) (push (vector (format "hol-year-%d" i) `(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 @@ ;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*- -;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 +;; Free Software Foundation, Inc. ;; Author: Ulf Jasper <ulf.jasper@web.de> ;; Created: August 2002 @@ -40,33 +41,36 @@ ;; 0.07 onwards: see lisp/ChangeLog -;; 0.06: Bugfixes regarding icalendar-import-format-*. -;; Fix in icalendar-convert-diary-to-ical -- thanks to Philipp -;; Grau. - -;; 0.05: New import format scheme: Replaced icalendar-import-prefix-*, -;; icalendar-import-ignored-properties, and -;; icalendar-import-separator with icalendar-import-format(-*). -;; icalendar-import-file and icalendar-convert-diary-to-ical -;; have an extra parameter which should prevent them from -;; erasing their target files (untested!). -;; Tested with Emacs 21.3.2 - -;; 0.04: Bugfix: import: double quoted param values did not work -;; Read DURATION property when importing. -;; Added parameter icalendar-duration-correction. - -;; 0.03: Export takes care of european-calendar-style. -;; Tested with Emacs 21.3.2 and XEmacs 21.4.12 - -;; 0.02: Should work in XEmacs now. Thanks to Len Trigg for the -;; XEmacs patches! -;; Added exporting from Emacs diary to ical. -;; Some bugfixes, after testing with calendars from -;; http://icalshare.com. -;; Tested with Emacs 21.3.2 and XEmacs 21.4.12 - -;; 0.01: First published version. Trial version. Alpha version. +;; 0.06: (2004-10-06) +;; - Bugfixes regarding icalendar-import-format-*. +;; - Fix in icalendar-convert-diary-to-ical -- thanks to Philipp Grau. + +;; 0.05: (2003-06-19) +;; - New import format scheme: Replaced icalendar-import-prefix-*, +;; icalendar-import-ignored-properties, and +;; icalendar-import-separator with icalendar-import-format(-*). +;; - icalendar-import-file and icalendar-convert-diary-to-ical +;; have an extra parameter which should prevent them from +;; erasing their target files (untested!). +;; - Tested with Emacs 21.3.2 + +;; 0.04: +;; - Bugfix: import: double quoted param values did not work +;; - Read DURATION property when importing. +;; - Added parameter icalendar-duration-correction. + +;; 0.03: (2003-05-07) +;; - Export takes care of european-calendar-style. +;; - Tested with Emacs 21.3.2 and XEmacs 21.4.12 + +;; 0.02: +;; - Should work in XEmacs now. Thanks to Len Trigg for the XEmacs patches! +;; - Added exporting from Emacs diary to ical. +;; - Some bugfixes, after testing with calendars from http://icalshare.com. +;; - Tested with Emacs 21.3.2 and XEmacs 21.4.12 + +;; 0.01: (2003-03-21) +;; - First published version. Trial version. Alpha version. ;; ====================================================================== ;; To Do: @@ -86,7 +90,7 @@ ;; + the parser is too soft ;; + error log is incomplete ;; + nice to have: #include "webcal://foo.com/some-calendar.ics" -;; + timezones, currently all times are local! +;; + timezones probably still need some improvements. ;; * Export from diary to ical ;; + diary-date, diary-float, and self-made sexp entries are not @@ -101,7 +105,7 @@ ;;; Code: -(defconst icalendar-version "0.15" +(defconst icalendar-version "0.17" "Version number of icalendar.el.") ;; ====================================================================== @@ -114,17 +118,25 @@ (defcustom icalendar-import-format "%s%d%l%o" - "Format string for importing events from iCalendar into Emacs diary. -This string defines how iCalendar events are inserted into diary -file. Meaning of the specifiers: + "Format for importing events from iCalendar into Emacs diary. +It defines how iCalendar events are inserted into diary file. +This may either be a string or a function. + +In case of a formatting STRING the following specifiers can be used: %c Class, see `icalendar-import-format-class' %d Description, see `icalendar-import-format-description' %l Location, see `icalendar-import-format-location' %o Organizer, see `icalendar-import-format-organizer' %s Summary, see `icalendar-import-format-summary' %t Status, see `icalendar-import-format-status' -%u URL, see `icalendar-import-format-url'" - :type 'string +%u URL, see `icalendar-import-format-url' + +A formatting FUNCTION will be called with a VEVENT as its only +argument. It must return a string. See +`icalendar-import-format-sample' for an example." + :type '(choice + (string :tag "String") + (function :tag "Function")) :group 'icalendar) (defcustom icalendar-import-format-summary @@ -243,7 +255,7 @@ Pass arguments REGEXP REP STRING FIXEDCASE LITERAL to INVALUE gives the current iCalendar element we are reading. INPARAMS gives the current parameters..... This function calls itself recursively for each nested calendar element -it finds" +it finds." (let (element children line name params param param-name param-value value (continue t)) @@ -390,15 +402,90 @@ children." (append result (list (list param-name param-value))))))) result)) -(defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift) +(defun icalendar--convert-tz-offset (alist dst-p) + "Return a cons of two strings representing a timezone start. +ALIST is an alist entry from a VTIMEZONE, like STANDARD. +DST-P is non-nil if this is for daylight savings time. +The strings are suitable for assembling into a TZ variable." + (let ((offset (car (cddr (assq 'TZOFFSETTO alist)))) + (rrule-value (car (cddr (assq 'RRULE alist)))) + (dtstart (car (cddr (assq 'DTSTART alist))))) + ;; FIXME: for now we only handle RRULE and not RDATE here. + (when (and offset rrule-value dtstart) + (let* ((rrule (icalendar--split-value rrule-value)) + (freq (cadr (assq 'FREQ rrule))) + (bymonth (cadr (assq 'BYMONTH rrule))) + (byday (cadr (assq 'BYDAY rrule)))) + ;; FIXME: we don't correctly handle WKST here. + (if (and (string= freq "YEARLY") bymonth) + (cons + (concat + ;; Fake a name. + (if dst-p "(DST?)" "(STD?)") + ;; For TZ, OFFSET is added to the local time. So, + ;; invert the values. + (if (eq (aref offset 0) ?-) "+" "-") + (substring offset 1 3) + ":" + (substring offset 3 5)) + ;; The start time. + (let* ((day (icalendar--get-weekday-number (substring byday -2))) + (week (if (eq day -1) + byday + (substring byday 0 -2)))) + (concat "M" bymonth "." week "." (if (eq day -1) "0" + (int-to-string day)) + ;; Start time. + "/" + (substring dtstart -6 -4) + ":" + (substring dtstart -4 -2) + ":" + (substring dtstart -2))))))))) + +(defun icalendar--parse-vtimezone (alist) + "Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING). +Return nil if timezone cannot be parsed." + (let* ((tz-id (icalendar--get-event-property alist 'TZID)) + (daylight (cadr (cdar (icalendar--get-children alist 'DAYLIGHT)))) + (day (and daylight (icalendar--convert-tz-offset daylight t))) + (standard (cadr (cdar (icalendar--get-children alist 'STANDARD)))) + (std (and standard (icalendar--convert-tz-offset standard nil)))) + (if (and tz-id std) + (cons tz-id + (if day + (concat (car std) (car day) + "," (cdr day) "," (cdr std)) + (car std)))))) + +(defun icalendar--convert-all-timezones (icalendar) + "Convert all timezones in the ICALENDAR into an alist. +Each element of the alist is a cons (ID . TZ-STRING), +like `icalendar--parse-vtimezone'." + (let (result) + (dolist (zone (icalendar--get-children (car icalendar) 'VTIMEZONE)) + (setq zone (icalendar--parse-vtimezone zone)) + (if zone + (setq result (cons zone result)))) + result)) + +(defun icalendar--find-time-zone (prop-list zone-map) + "Return a timezone string for the time zone in PROP-LIST, or nil if none. +ZONE-MAP is a timezone alist as returned by `icalendar--convert-all-timezones'." + (let ((id (plist-get prop-list 'TZID))) + (if id + (cdr (assoc id zone-map))))) + +(defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift + zone) "Return ISODATETIMESTRING in format like `decode-time'. Converts from ISO-8601 to Emacs representation. If ISODATETIMESTRING specifies UTC time (trailing letter Z) the decoded time is given in the local time zone! If optional parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT days. +ZONE, if provided, is the timezone, in any format understood by `encode-time'. -FIXME: TZID-attributes are ignored....! FIXME: multiple comma-separated values should be allowed!" (icalendar--dmsg isodatetimestring) (if isodatetimestring @@ -433,7 +520,7 @@ FIXME: multiple comma-separated values should be allowed!" ;; create the decoded date-time ;; FIXME!?! (condition-case nil - (decode-time (encode-time second minute hour day month year)) + (decode-time (encode-time second minute hour day month year zone)) (error (message "Cannot decode \"%s\"" isodatetimestring) ;; hope for the best... @@ -710,7 +797,7 @@ would be \"pm\"." "Export diary file to iCalendar format. All diary entries in the file DIARY-FILENAME are converted to iCalendar format. The result is appended to the file ICAL-FILENAME." - (interactive "FExport diary data from file: + (interactive "FExport diary data from file: Finto iCalendar file: ") (save-current-buffer (set-buffer (find-file diary-filename)) @@ -844,89 +931,95 @@ entries. ENTRY-MAIN is the first line of the diary entry." (error "Could not parse entry"))) (defun icalendar--parse-summary-and-rest (summary-and-rest) - "Parse SUMMARY-AND-REST from a diary to fill iCalendar properties." + "Parse SUMMARY-AND-REST from a diary to fill iCalendar properties. +Returns an alist." (save-match-data - (let* ((s icalendar-import-format) - (p-cla (or (string-match "%c" icalendar-import-format) -1)) - (p-des (or (string-match "%d" icalendar-import-format) -1)) - (p-loc (or (string-match "%l" icalendar-import-format) -1)) - (p-org (or (string-match "%o" icalendar-import-format) -1)) - (p-sum (or (string-match "%s" icalendar-import-format) -1)) - (p-sta (or (string-match "%t" icalendar-import-format) -1)) - (p-url (or (string-match "%u" icalendar-import-format) -1)) - (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url) '<)) - pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url) - (dotimes (i (length p-list)) - (cond ((and (>= p-cla 0) (= (nth i p-list) p-cla)) - (setq pos-cla (+ 2 (* 2 i)))) - ((and (>= p-des 0) (= (nth i p-list) p-des)) - (setq pos-des (+ 2 (* 2 i)))) - ((and (>= p-loc 0) (= (nth i p-list) p-loc)) - (setq pos-loc (+ 2 (* 2 i)))) - ((and (>= p-org 0) (= (nth i p-list) p-org)) - (setq pos-org (+ 2 (* 2 i)))) - ((and (>= p-sta 0) (= (nth i p-list) p-sta)) - (setq pos-sta (+ 2 (* 2 i)))) - ((and (>= p-sum 0) (= (nth i p-list) p-sum)) - (setq pos-sum (+ 2 (* 2 i)))) - ((and (>= p-url 0) (= (nth i p-list) p-url)) - (setq pos-url (+ 2 (* 2 i)))))) - (mapc (lambda (ij) - (setq s (icalendar--rris (car ij) (cadr ij) s t t))) - (list - ;; summary must be first! because of %s - (list "%s" - (concat "\\(" icalendar-import-format-summary "\\)?")) - (list "%c" - (concat "\\(" icalendar-import-format-class "\\)?")) - (list "%d" - (concat "\\(" icalendar-import-format-description "\\)?")) - (list "%l" - (concat "\\(" icalendar-import-format-location "\\)?")) - (list "%o" - (concat "\\(" icalendar-import-format-organizer "\\)?")) - (list "%t" - (concat "\\(" icalendar-import-format-status "\\)?")) - (list "%u" - (concat "\\(" icalendar-import-format-url "\\)?")))) - (setq s (concat (icalendar--rris "%s" "\\(.*\\)" s nil t) " ")) - (if (string-match s summary-and-rest) - (let (cla des loc org sta sum url) - (if (and pos-sum (match-beginning pos-sum)) - (setq sum (substring summary-and-rest - (match-beginning pos-sum) - (match-end pos-sum)))) - (if (and pos-cla (match-beginning pos-cla)) - (setq cla (substring summary-and-rest - (match-beginning pos-cla) - (match-end pos-cla)))) - (if (and pos-des (match-beginning pos-des)) - (setq des (substring summary-and-rest - (match-beginning pos-des) - (match-end pos-des)))) - (if (and pos-loc (match-beginning pos-loc)) - (setq loc (substring summary-and-rest - (match-beginning pos-loc) - (match-end pos-loc)))) - (if (and pos-org (match-beginning pos-org)) - (setq org (substring summary-and-rest - (match-beginning pos-org) - (match-end pos-org)))) - (if (and pos-sta (match-beginning pos-sta)) - (setq sta (substring summary-and-rest - (match-beginning pos-sta) - (match-end pos-sta)))) - (if (and pos-url (match-beginning pos-url)) - (setq url (substring summary-and-rest - (match-beginning pos-url) - (match-end pos-url)))) - (list (if cla (cons 'cla cla) nil) - (if des (cons 'des des) nil) - (if loc (cons 'loc loc) nil) - (if org (cons 'org org) nil) - (if sta (cons 'sta sta) nil) - ;;(if sum (cons 'sum sum) nil) - (if url (cons 'url url) nil))))))) + (if (functionp icalendar-import-format) + ;; can't do anything + nil + ;; split summary-and-rest + (let* ((s icalendar-import-format) + (p-cla (or (string-match "%c" icalendar-import-format) -1)) + (p-des (or (string-match "%d" icalendar-import-format) -1)) + (p-loc (or (string-match "%l" icalendar-import-format) -1)) + (p-org (or (string-match "%o" icalendar-import-format) -1)) + (p-sum (or (string-match "%s" icalendar-import-format) -1)) + (p-sta (or (string-match "%t" icalendar-import-format) -1)) + (p-url (or (string-match "%u" icalendar-import-format) -1)) + (p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url) '<)) + pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url) + (dotimes (i (length p-list)) + (cond ((and (>= p-cla 0) (= (nth i p-list) p-cla)) + (setq pos-cla (+ 2 (* 2 i)))) + ((and (>= p-des 0) (= (nth i p-list) p-des)) + (setq pos-des (+ 2 (* 2 i)))) + ((and (>= p-loc 0) (= (nth i p-list) p-loc)) + (setq pos-loc (+ 2 (* 2 i)))) + ((and (>= p-org 0) (= (nth i p-list) p-org)) + (setq pos-org (+ 2 (* 2 i)))) + ((and (>= p-sta 0) (= (nth i p-list) p-sta)) + (setq pos-sta (+ 2 (* 2 i)))) + ((and (>= p-sum 0) (= (nth i p-list) p-sum)) + (setq pos-sum (+ 2 (* 2 i)))) + ((and (>= p-url 0) (= (nth i p-list) p-url)) + (setq pos-url (+ 2 (* 2 i)))))) + (mapc (lambda (ij) + (setq s (icalendar--rris (car ij) (cadr ij) s t t))) + (list + ;; summary must be first! because of %s + (list "%s" + (concat "\\(" icalendar-import-format-summary "\\)??")) + (list "%c" + (concat "\\(" icalendar-import-format-class "\\)??")) + (list "%d" + (concat "\\(" icalendar-import-format-description "\\)??")) + (list "%l" + (concat "\\(" icalendar-import-format-location "\\)??")) + (list "%o" + (concat "\\(" icalendar-import-format-organizer "\\)??")) + (list "%t" + (concat "\\(" icalendar-import-format-status "\\)??")) + (list "%u" + (concat "\\(" icalendar-import-format-url "\\)??")))) + (setq s (concat "^" (icalendar--rris "%s" "\\(.*?\\)" s nil t) + " $")) + (if (string-match s summary-and-rest) + (let (cla des loc org sta sum url) + (if (and pos-sum (match-beginning pos-sum)) + (setq sum (substring summary-and-rest + (match-beginning pos-sum) + (match-end pos-sum)))) + (if (and pos-cla (match-beginning pos-cla)) + (setq cla (substring summary-and-rest + (match-beginning pos-cla) + (match-end pos-cla)))) + (if (and pos-des (match-beginning pos-des)) + (setq des (substring summary-and-rest + (match-beginning pos-des) + (match-end pos-des)))) + (if (and pos-loc (match-beginning pos-loc)) + (setq loc (substring summary-and-rest + (match-beginning pos-loc) + (match-end pos-loc)))) + (if (and pos-org (match-beginning pos-org)) + (setq org (substring summary-and-rest + (match-beginning pos-org) + (match-end pos-org)))) + (if (and pos-sta (match-beginning pos-sta)) + (setq sta (substring summary-and-rest + (match-beginning pos-sta) + (match-end pos-sta)))) + (if (and pos-url (match-beginning pos-url)) + (setq url (substring summary-and-rest + (match-beginning pos-url) + (match-end pos-url)))) + (list (if cla (cons 'cla cla) nil) + (if des (cons 'des des) nil) + (if loc (cons 'loc loc) nil) + (if org (cons 'org org) nil) + (if sta (cons 'sta sta) nil) + ;;(if sum (cons 'sum sum) nil) + (if url (cons 'url url) nil)))))))) ;; subroutines for icalendar-export-region (defun icalendar--convert-ordinary-to-ical (nonmarker entry-main) @@ -1454,8 +1547,8 @@ Argument ICAL-FILENAME output iCalendar file. Argument DIARY-FILENAME input `diary-file'. Optional argument NON-MARKING determines whether events are created as non-marking or not." - (interactive "fImport iCalendar data from file: -Finto diary file: + (interactive "fImport iCalendar data from file: +Finto diary file: p") ;; clean up the diary file (save-current-buffer @@ -1521,7 +1614,9 @@ buffer `*icalendar-errors*'." (defun icalendar--format-ical-event (event) "Create a string representation of an iCalendar EVENT." - (let ((string icalendar-import-format) + (if (functionp icalendar-import-format) + (funcall icalendar-import-format event) + (let ((string icalendar-import-format) (conversion-list '(("%c" CLASS icalendar-import-format-class) ("%d" DESCRIPTION icalendar-import-format-description) @@ -1549,7 +1644,7 @@ buffer `*icalendar-errors*'." string t t)))) conversion-list) - string)) + string))) (defun icalendar--convert-ical-to-diary (ical-list diary-file &optional do-not-ask @@ -1566,6 +1661,7 @@ written into the buffer `*icalendar-errors*'." (error-string "") (event-ok t) (found-error nil) + (zone-map (icalendar--convert-all-timezones ical-list)) e diary-string) ;; step through all events/appointments (while ev @@ -1574,13 +1670,24 @@ written into the buffer `*icalendar-errors*'." (setq event-ok nil) (condition-case error-val (let* ((dtstart (icalendar--get-event-property e 'DTSTART)) - (dtstart-dec (icalendar--decode-isodatetime dtstart)) + (dtstart-zone (icalendar--find-time-zone + (icalendar--get-event-property-attributes + e 'DTSTART) + zone-map)) + (dtstart-dec (icalendar--decode-isodatetime dtstart nil + dtstart-zone)) (start-d (icalendar--datetime-to-diary-date dtstart-dec)) (start-t (icalendar--datetime-to-colontime dtstart-dec)) (dtend (icalendar--get-event-property e 'DTEND)) - (dtend-dec (icalendar--decode-isodatetime dtend)) - (dtend-1-dec (icalendar--decode-isodatetime dtend -1)) + (dtend-zone (icalendar--find-time-zone + (icalendar--get-event-property-attributes + e 'DTEND) + zone-map)) + (dtend-dec (icalendar--decode-isodatetime dtend + nil dtend-zone)) + (dtend-1-dec (icalendar--decode-isodatetime dtend -1 + dtend-zone)) end-d end-1-d end-t @@ -1953,6 +2060,21 @@ the entry." ;; return diary-file in case it has been changed interactively diary-file) +;; ====================================================================== +;; Examples +;; ====================================================================== +(defun icalendar-import-format-sample (event) + "Example function for formatting an icalendar EVENT." + (format (concat "SUMMARY=`%s' DESCRIPTION=`%s' LOCATION=`%s' ORGANIZER=`%s' " + "STATUS=`%s' URL=`%s' CLASS=`%s'") + (or (icalendar--get-event-property event 'SUMMARY) "") + (or (icalendar--get-event-property event 'DESCRIPTION) "") + (or (icalendar--get-event-property event 'LOCATION) "") + (or (icalendar--get-event-property event 'ORGANIZER) "") + (or (icalendar--get-event-property event 'STATUS) "") + (or (icalendar--get-event-property event 'URL) "") + (or (icalendar--get-event-property event 'CLASS) ""))) + (provide 'icalendar) ;; 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." If there is no previous input at point, run the command specified by the global keymap (usually `mouse-yank-at-point')." (interactive "e") + (mouse-set-point event) (let ((pos (posn-point (event-end event))) field input) (with-selected-window (posn-window (event-end event)) @@ -1022,9 +1023,11 @@ See also `comint-read-input-ring'." (last-command last-command) (regexp (read-from-minibuffer prompt nil nil nil 'minibuffer-history-search-history))) + ;; If the user didn't enter anything, nothing is added to m-h-s-h. + ;; Use the previous search regexp, if there is one. (list (if (string-equal regexp "") - (setcar minibuffer-history-search-history - (nth 1 minibuffer-history-search-history)) + (or (car minibuffer-history-search-history) + regexp) regexp) (prefix-numeric-value current-prefix-arg)))) 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." (defun Custom-save (&rest ignore) "Set all edited settings, then save all settings that have been set. -If a setting was edited and set before, this saves it. -If a setting was merely edited before, this sets it then saves it." +If a setting was edited and set before, this saves it. If a +setting was merely edited before, this sets it then saves it." (interactive) - (if (custom-command-apply - (lambda (child) - (when (memq (widget-get child :custom-state) - '(modified set changed rogue)) - (widget-apply child :custom-save))) - "Save all settings in this buffer? " t) - (custom-save-all))) + (when (custom-command-apply + (lambda (child) + (when (memq (widget-get child :custom-state) + '(modified set changed rogue)) + (widget-apply child :custom-mark-to-save))) + "Save all settings in this buffer? " t) + ;; Save changes to buffer and redraw. + (custom-save-all) + (dolist (child custom-options) + (widget-apply child :custom-state-set-and-redraw)))) (defun custom-reset (widget &optional event) "Select item from reset menu." @@ -865,20 +868,67 @@ This also shows the saved values in the buffer." (widget-apply widget :custom-reset-saved))) "Reset all settings (current values and buffer text) to saved values? ")) +;; The next two variables are bound to '(t) by `Custom-reset-standard' +;; and `custom-group-reset-standard'. If these variables are nil, both +;; `custom-variable-reset-standard' and `custom-face-reset-standard' +;; save, reset and redraw the handled widget immediately. Otherwise, +;; they add the widget to the corresponding list and leave it to +;; `custom-reset-standard-save-and-update' to save, reset and redraw it. +(defvar custom-reset-standard-variables-list nil) +(defvar custom-reset-standard-faces-list nil) + +;; The next function was excerpted from `custom-variable-reset-standard' +;; and `custom-face-reset-standard' and is used to avoid calling +;; `custom-save-all' repeatedly (and thus saving settings to file one by +;; one) when erasing all customizations. +(defun custom-reset-standard-save-and-update () + "Save settings and redraw after erasing customizations." + (when (or (and custom-reset-standard-variables-list + (not (eq custom-reset-standard-variables-list '(t)))) + (and custom-reset-standard-faces-list + (not (eq custom-reset-standard-faces-list '(t))))) + ;; Save settings to file. + (custom-save-all) + ;; Set state of and redraw variables. + (dolist (widget custom-reset-standard-variables-list) + (unless (eq widget t) + (widget-put widget :custom-state 'unknown) + (custom-redraw widget))) + ;; Set state of and redraw faces. + (dolist (widget custom-reset-standard-faces-list) + (unless (eq widget t) + (let* ((symbol (widget-value widget)) + (child (car (widget-get widget :children))) + (value (get symbol 'face-defface-spec)) + (comment-widget (widget-get widget :comment-widget))) + (put symbol 'face-comment nil) + (widget-value-set child + (custom-pre-filter-face-spec + (list (list t (custom-face-attributes-get + symbol nil))))) + ;; This call manages the comment visibility + (widget-value-set comment-widget "") + (custom-face-state-set widget) + (custom-redraw-magic widget)))))) + (defun Custom-reset-standard (&rest ignore) - "Erase all customization (either current or saved) for the group members. + "Erase all customizations (either current or saved) in current buffer. The immediate result is to restore them to their standard values. This operation eliminates any saved values for the group members, making them as if they had never been customized at all." (interactive) - (custom-command-apply - (lambda (widget) - (and (or (null (widget-get widget :custom-standard-value)) - (widget-apply widget :custom-standard-value)) - (memq (widget-get widget :custom-state) - '(modified set changed saved rogue)) - (widget-apply widget :custom-reset-standard))) - "Erase all customizations for settings in this buffer? " t)) + ;; Bind these temporarily. + (let ((custom-reset-standard-variables-list '(t)) + (custom-reset-standard-faces-list '(t))) + (custom-command-apply + (lambda (widget) + (and (or (null (widget-get widget :custom-standard-value)) + (widget-apply widget :custom-standard-value)) + (memq (widget-get widget :custom-state) + '(modified set changed saved rogue)) + (widget-apply widget :custom-mark-to-reset-standard))) + "Erase all customizations for settings in this buffer? " t) + (custom-reset-standard-save-and-update))) ;;; The Customize Commands @@ -1535,7 +1585,7 @@ Otherwise use brackets." (widget-insert "Editing a setting changes only the text in this buffer." (if init-file " -To set apply your changes, use the Save or Set buttons. +To apply your changes, use the Save or Set buttons. Saving a change normally works by editing your init file." " Currently, these settings cannot be saved for future Emacs sessions, @@ -2441,11 +2491,13 @@ However, setting it through Custom sets the default value.") :value-create 'custom-variable-value-create :action 'custom-variable-action :custom-set 'custom-variable-set - :custom-save 'custom-variable-save + :custom-mark-to-save 'custom-variable-mark-to-save :custom-reset-current 'custom-redraw :custom-reset-saved 'custom-variable-reset-saved :custom-reset-standard 'custom-variable-reset-standard - :custom-standard-value 'custom-variable-standard-value) + :custom-mark-to-reset-standard 'custom-variable-mark-to-reset-standard + :custom-standard-value 'custom-variable-standard-value + :custom-state-set-and-redraw 'custom-variable-state-set-and-redraw) (defun custom-variable-type (symbol) "Return a widget suitable for editing the value of SYMBOL. @@ -2807,8 +2859,8 @@ Optional EVENT is the location for the menu." (custom-variable-state-set widget) (custom-redraw-magic widget))) -(defun custom-variable-save (widget) - "Set and save the value for the variable being edited by WIDGET." +(defun custom-variable-mark-to-save (widget) + "Set value and mark for saving the variable edited by WIDGET." (let* ((form (widget-get widget :custom-form)) (state (widget-get widget :custom-state)) (child (car (widget-get widget :children))) @@ -2846,10 +2898,18 @@ Optional EVENT is the location for the menu." (put symbol 'variable-comment comment) (put symbol 'saved-variable-comment comment))) (put symbol 'customized-value nil) - (put symbol 'customized-variable-comment nil) - (custom-save-all) - (custom-variable-state-set widget) - (custom-redraw-magic widget))) + (put symbol 'customized-variable-comment nil))) + +(defsubst custom-variable-state-set-and-redraw (widget) + "Set state of variable widget WIDGET and redraw with current settings." + (custom-variable-state-set widget) + (custom-redraw-magic widget)) + +(defun custom-variable-save (widget) + "Save value of variable edited by widget WIDGET." + (custom-variable-mark-to-save widget) + (custom-save-all) + (custom-variable-state-set-and-redraw widget)) (defun custom-variable-reset-saved (widget) "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." ;; This call will possibly make the comment invisible (custom-redraw widget))) -(defun custom-variable-reset-standard (widget) - "Restore the standard setting for the variable being edited by WIDGET. -This operation eliminates any saved setting for the variable, -restoring it to the state of a variable that has never been customized. -The value that was current before this operation -becomes the backup value, so you can get it again." +(defun custom-variable-mark-to-reset-standard (widget) + "Mark to restore standard setting for the variable edited by widget WIDGET. +If `custom-reset-standard-variables-list' is nil, save, reset and +redraw the widget immediately." (let* ((symbol (widget-value widget))) (if (get symbol 'standard-value) (custom-variable-backup-value widget) @@ -2890,13 +2948,32 @@ becomes the backup value, so you can get it again." (put symbol 'customized-variable-comment nil) (custom-push-theme 'theme-value symbol 'user 'reset) (custom-theme-recalc-variable symbol) - (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment)) - (put symbol 'saved-value nil) - (put symbol 'saved-variable-comment nil) - (custom-save-all)) - (widget-put widget :custom-state 'unknown) - ;; This call will possibly make the comment invisible - (custom-redraw widget))) + (if (and custom-reset-standard-variables-list + (or (get symbol 'saved-value) (get symbol 'saved-variable-comment))) + (progn + (put symbol 'saved-value nil) + (put symbol 'saved-variable-comment nil) + ;; Append this to `custom-reset-standard-variables-list' to + ;; have `custom-reset-standard-save-and-update' save setting + ;; to the file, update the widget's state, and redraw it. + (setq custom-reset-standard-variables-list + (cons widget custom-reset-standard-variables-list))) + (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment)) + (put symbol 'saved-value nil) + (put symbol 'saved-variable-comment nil) + (custom-save-all)) + (widget-put widget :custom-state 'unknown) + ;; This call will possibly make the comment invisible + (custom-redraw widget)))) + +(defun custom-variable-reset-standard (widget) + "Restore standard setting for the variable edited by WIDGET. +This operation eliminates any saved setting for the variable, +restoring it to the state of a variable that has never been customized. +The value that was current before this operation +becomes the backup value, so you can get it again." + (let (custom-reset-standard-variables-list) + (custom-variable-mark-to-reset-standard widget))) (defun custom-variable-backup-value (widget) "Back up the current value for WIDGET's variable. @@ -3172,11 +3249,13 @@ Only match frames that support the specified face attributes.") :custom-category 'face :custom-form nil ; defaults to value of `custom-face-default-form' :custom-set 'custom-face-set - :custom-save 'custom-face-save + :custom-mark-to-save 'custom-face-mark-to-save :custom-reset-current 'custom-redraw :custom-reset-saved 'custom-face-reset-saved :custom-reset-standard 'custom-face-reset-standard + :custom-mark-to-reset-standard 'custom-face-mark-to-reset-standard :custom-standard-value 'custom-face-standard-value + :custom-state-set-and-redraw 'custom-face-state-set-and-redraw :custom-menu 'custom-face-menu-create) (define-widget 'custom-face-all 'editable-list @@ -3321,6 +3400,7 @@ SPEC must be a full face spec." ;; Update buttons. (widget-put widget :buttons buttons) ;; Insert documentation. + (widget-put widget :documentation-indent 3) (widget-add-documentation-string-button widget :visibility-widget 'custom-visibility) @@ -3510,8 +3590,8 @@ Optional EVENT is the location for the menu." (custom-face-state-set widget) (custom-redraw-magic widget))) -(defun custom-face-save (widget) - "Save in `.emacs' the face attributes in WIDGET." +(defun custom-face-mark-to-save (widget) + "Mark for saving the face edited by WIDGET." (let* ((symbol (widget-value widget)) (child (car (widget-get widget :children))) (value (custom-post-filter-face-spec (widget-value child))) @@ -3532,10 +3612,18 @@ Optional EVENT is the location for the menu." (put symbol 'customized-face nil) (put symbol 'face-comment comment) (put symbol 'customized-face-comment nil) - (put symbol 'saved-face-comment comment) - (custom-save-all) - (custom-face-state-set widget) - (custom-redraw-magic widget))) + (put symbol 'saved-face-comment comment))) + +(defsubst custom-face-state-set-and-redraw (widget) + "Set state of face widget WIDGET and redraw with current settings." + (custom-face-state-set widget) + (custom-redraw-magic widget)) + +(defun custom-face-save (widget) + "Save the face edited by WIDGET." + (custom-face-mark-to-save widget) + (custom-save-all) + (custom-face-state-set-and-redraw widget)) ;; For backward compatibility. (define-obsolete-function-alias 'custom-face-save-command 'custom-face-save @@ -3564,10 +3652,10 @@ Optional EVENT is the location for the menu." (defun custom-face-standard-value (widget) (get (widget-value widget) 'face-defface-spec)) -(defun custom-face-reset-standard (widget) - "Restore WIDGET to the face's standard attribute values. -This operation eliminates any saved attributes for the face, -restoring it to the state of a face that has never been customized." +(defun custom-face-mark-to-reset-standard (widget) + "Restore widget WIDGET to the face's standard attribute values. +If `custom-reset-standard-faces-list' is nil, save, reset and +redraw the widget immediately." (let* ((symbol (widget-value widget)) (child (car (widget-get widget :children))) (value (get symbol 'face-defface-spec)) @@ -3579,19 +3667,37 @@ restoring it to the state of a face that has never been customized." (custom-push-theme 'theme-face symbol 'user 'reset) (face-spec-set symbol value t) (custom-theme-recalc-face symbol) - (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment)) - (put symbol 'saved-face nil) - (put symbol 'saved-face-comment nil) - (custom-save-all)) - (put symbol 'face-comment nil) - (widget-value-set child - (custom-pre-filter-face-spec - (list (list t (custom-face-attributes-get - symbol nil))))) - ;; This call manages the comment visibility - (widget-value-set comment-widget "") - (custom-face-state-set widget) - (custom-redraw-magic widget))) + (if (and custom-reset-standard-faces-list + (or (get symbol 'saved-face) (get symbol 'saved-face-comment))) + ;; Do this later. + (progn + (put symbol 'saved-face nil) + (put symbol 'saved-face-comment nil) + ;; Append this to `custom-reset-standard-faces-list' and have + ;; `custom-reset-standard-save-and-update' save setting to the + ;; file, update the widget's state, and redraw it. + (setq custom-reset-standard-faces-list + (cons widget custom-reset-standard-faces-list))) + (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment)) + (put symbol 'saved-face nil) + (put symbol 'saved-face-comment nil) + (custom-save-all)) + (put symbol 'face-comment nil) + (widget-value-set child + (custom-pre-filter-face-spec + (list (list t (custom-face-attributes-get + symbol nil))))) + ;; This call manages the comment visibility + (widget-value-set comment-widget "") + (custom-face-state-set widget) + (custom-redraw-magic widget)))) + +(defun custom-face-reset-standard (widget) + "Restore WIDGET to the face's standard attribute values. +This operation eliminates any saved attributes for the face, +restoring it to the state of a face that has never been customized." + (let (custom-reset-standard-faces-list) + (custom-face-mark-to-reset-standard widget))) ;;; The `face' Widget. @@ -3736,10 +3842,12 @@ and so forth. The remaining group tags are shown with `custom-group-tag'." :action 'custom-group-action :custom-category 'group :custom-set 'custom-group-set - :custom-save 'custom-group-save + :custom-mark-to-save 'custom-group-mark-to-save :custom-reset-current 'custom-group-reset-current :custom-reset-saved 'custom-group-reset-saved :custom-reset-standard 'custom-group-reset-standard + :custom-mark-to-reset-standard 'custom-group-mark-to-reset-standard + :custom-state-set-and-redraw 'custom-group-state-set-and-redraw :custom-menu 'custom-group-menu-create) (defun custom-group-sample-face-get (widget) @@ -4034,11 +4142,23 @@ Optional EVENT is the location for the menu." (when (eq (widget-get child :custom-state) 'modified) (widget-apply child :custom-set)))) -(defun custom-group-save (widget) - "Save all modified group members." +(defun custom-group-mark-to-save (widget) + "Mark all modified group members for saving." (dolist (child (widget-get widget :children)) (when (memq (widget-get child :custom-state) '(modified set)) - (widget-apply child :custom-save)))) + (widget-apply child :custom-mark-to-save)))) + +(defsubst custom-group-state-set-and-redraw (widget) + "Set state of group widget WIDGET and redraw with current settings." + (dolist (child (widget-get widget :children)) + (when (memq (widget-get child :custom-state) '(modified set)) + (widget-apply child :custom-state-set-and-redraw)))) + +(defun custom-group-save (widget) + "Save all modified group members." + (custom-group-mark-to-save widget) + (custom-save-all) + (custom-group-state-set-and-redraw widget)) (defun custom-group-reset-current (widget) "Reset all modified group members." @@ -4054,10 +4174,17 @@ Optional EVENT is the location for the menu." (defun custom-group-reset-standard (widget) "Reset all modified, set, or saved group members." + (let ((custom-reset-standard-variables-list '(t)) + (custom-reset-standard-faces-list '(t))) + (custom-group-mark-to-reset-standard widget) + (custom-reset-standard-save-and-update))) + +(defun custom-group-mark-to-reset-standard (widget) + "Mark to reset all modified, set, or saved group members." (dolist (child (widget-get widget :children)) (when (memq (widget-get child :custom-state) '(modified set saved)) - (widget-apply child :custom-reset-standard)))) + (widget-apply child :custom-mark-to-reset-standard)))) (defun custom-group-state-update (widget) "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 (scroll-down-aggressively windows (choice (const :tag "off" nil) number) "21.1") - (line-spacing display (choice (const :tag "none" nil) integer)) + (line-spacing display (choice (const :tag "none" nil) integer) + "22.1") ;; callint.c (mark-even-if-inactive editing-basics boolean) ;; callproc.c @@ -128,7 +129,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of :match (lambda (widget value) (and value (not (functionp value))))) (function :value ignore)))) - (selection-coding-system mule coding-system) + (selection-coding-system mule coding-system "22.1") ;; dired.c (completion-ignored-extensions dired (repeat (string :format "%v"))) @@ -144,7 +145,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (max-lisp-eval-depth limits integer) (max-mini-window-height limits (choice (const :tag "quarter screen" nil) - number)) + number) "23.1") (stack-trace-on-error debug (choice (const :tag "off") (repeat :menu-tag "When" @@ -178,7 +179,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (sexp :tag "Value")))) (mouse-highlight mouse (choice (const :tag "disabled" nil) (const :tag "always shown" t) - (other :tag "hidden by keypress" 1))) + (other :tag "hidden by keypress" 1)) + "22.1") ;; fringe.c (overflow-newline-into-fringe fringe boolean) ;; indent.c @@ -192,7 +194,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (polling-period keyboard integer) (double-click-time mouse (restricted-sexp :match-alternatives (integerp 'nil 't))) - (double-click-fuzz mouse integer) + (double-click-fuzz mouse integer "22.1") (inhibit-local-menu-bar-menus menu boolean) (help-char keyboard character) (help-event-list keyboard (repeat (sexp :format "%v"))) @@ -250,9 +252,9 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (completion-auto-help minibuffer boolean) (enable-recursive-minibuffers minibuffer boolean) (history-length minibuffer - (choice (const :tag "Infinite" t) - integer)) - (history-delete-duplicates minibuffer boolean) + (choice (const :tag "Infinite" t) integer) + "22.1") + (history-delete-duplicates minibuffer boolean "22.1") (minibuffer-prompt-properties minibuffer (list @@ -351,14 +353,15 @@ since it could result in memory overflow and make Emacs crash." ;; and shape of the window. (const :tag "horizontally" (lambda (window) - (split-window window nil 'horiz))))) + (split-window window nil 'horiz)))) + "23.1") (window-min-height windows integer) (window-min-width windows integer) (scroll-preserve-screen-position windows (choice (const :tag "Off (nil)" :value nil) (const :tag "Full screen (t)" :value t) - (other :tag "Always" 1))) + (other :tag "Always" 1)) "22.1") (display-buffer-reuse-frames windows boolean "21.1") ;; xdisp.c (scroll-step windows integer) @@ -372,7 +375,7 @@ since it could result in memory overflow and make Emacs crash." (line-number-display-limit display (choice integer (const :tag "No limit" nil))) - (line-number-display-limit-width display integer) + (line-number-display-limit-width display integer "22.1") (highlight-nonselected-windows display boolean) (message-log-max debug (choice (const :tag "Disable" nil) (integer :menu-tag "lines" @@ -387,7 +390,7 @@ since it could result in memory overflow and make Emacs crash." (const :tag "Immediate" :value t) (number :tag "Delay by secs" :value 0.5)) "22.1") ;; xfaces.c - (scalable-fonts-allowed display boolean) + (scalable-fonts-allowed display boolean "22.1") ;; xfns.c (x-bitmap-file-path installation (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." (defun custom-theme-recalc-face (face) "Set FACE according to currently enabled custom themes." (if (facep face) - (face-spec-recalc face))) + (face-spec-set face + (get (or (get face 'face-alias) face) + 'face-override-spec)))) ;;; XEmacs compability functions 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." ;; stop safe_run_hooks from clearing out pre-command-hook. (and (eq inhibit-quit 'pre-command-hook) (setq inhibit-quit 'delete-selection-dummy)) - (signal 'file-supersession (cdr data))))))) + (signal 'file-supersession (cdr data))) + (text-read-only + ;; This signal may come either from `delete-active-region' or + ;; `self-insert-command' (when `overwrite-mode' is non-nil). + ;; To avoid clearing out `pre-command-hook' we handle this case + ;; by issuing a simple message. Note, however, that we do not + ;; handle all related problems: When read-only text ends before + ;; the end of the region, the latter is not deleted but any + ;; subsequent insertion will succeed. We could avoid this case + ;; by doing a (setq this-command 'ignore) here. This would, + ;; however, still not handle the case where read-only text ends + ;; precisely where the region starts: In that case the deletion + ;; would succeed but the subsequent insertion would fail with a + ;; text-read-only error. To handle that case we would have to + ;; investigate text properties at both ends of the region and + ;; skip the deletion when inserting text is forbidden there. + (message "Text is read-only") (ding)))))) (put 'self-insert-command 'delete-selection t) (put 'self-insert-iso 'delete-selection t) @@ -157,7 +173,7 @@ then it takes a second \\[keyboard-quit] to abort the minibuffer." (dolist (sym '(self-insert-command self-insert-iso yank clipboard-yank insert-register delete-backward-char backward-delete-char-untabify delete-char newline-and-indent newline open-line)) - (remprop sym 'delete-selection)) + (put sym 'delete-selection nil)) ;; continue standard unloading nil) 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)." (defun diff-end-of-hunk (&optional style) ;; Especially important for unified (because headers are ambiguous). (setq style (diff-hunk-style style)) - ;; Some versions of diff replace all-blank context lines in unified - ;; format with empty lines. The use of \n below avoids matching such - ;; lines as headers. - ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html (let ((end (and (re-search-forward (case style ;; A `unified' header is ambiguous. - (unified (concat "^[^-+# \\\n]\\|" + (unified (concat "^[^-+# \\]\\|" diff-file-header-re)) (context "^[^-+#! \\]") (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 @@ ;;; Todo: +;; - share more code with image-mode again. ;; - better menu. -;; - don't use `find-file'. ;; - Bind slicing to a drag event. ;; - doc-view-fit-doc-to-window and doc-view-fit-window-to-doc. -;; - zoom a the region around the cursor (like xdvi). +;; - zoom the region around the cursor (like xdvi). ;; - get rid of the silly arrow in the fringe. ;; - improve anti-aliasing (pdf-utils gets it better). @@ -247,6 +247,14 @@ has finished." (defvar doc-view-previous-major-mode nil "Only used internally.") +(defvar doc-view-buffer-file-name nil + "Only used internally. +The file name used for conversion. Normally it's the same as +`buffer-file-name', but for remote files, compressed files and +files inside an archive it is a temporary copy of +the (uncompressed, extracted) file residing in +`doc-view-cache-directory'.") + ;;;; DocView Keymaps (defvar doc-view-mode-map @@ -349,12 +357,7 @@ has finished." ;; Update the buffer (doc-view-insert-image (nth (1- page) doc-view-current-files) :pointer 'arrow) - (overlay-put doc-view-current-overlay 'help-echo doc-view-current-info) - (goto-char (point-min)) - ;; This seems to be needed for set-window-hscroll (in - ;; image-forward-hscroll) to do something useful, I don't have time to - ;; debug this now. :-( --Stef - (forward-char))) + (overlay-put doc-view-current-overlay 'help-echo doc-view-current-info))) (defun doc-view-next-page (&optional arg) "Browse ARG pages forward." @@ -450,12 +453,12 @@ It's a subdirectory of `doc-view-cache-directory'." (setq doc-view-current-cache-dir (file-name-as-directory (expand-file-name - (let ((doc buffer-file-name)) - (concat (file-name-nondirectory doc) - "-" - (with-temp-buffer - (insert-file-contents-literally doc) - (md5 (current-buffer))))) + (concat (file-name-nondirectory buffer-file-name) + "-" + (let ((file doc-view-buffer-file-name)) + (with-temp-buffer + (insert-file-contents-literally file) + (md5 (current-buffer))))) doc-view-cache-directory))))) (defun doc-view-remove-if (predicate list) @@ -476,7 +479,7 @@ Image types are symbols like `dvi', `postscript' or `pdf'." (and (doc-view-mode-p 'pdf) doc-view-dvipdfm-program (executable-find doc-view-dvipdfm-program))) - ((or (eq type 'postscript) (eq type 'ps) + ((or (eq type 'postscript) (eq type 'ps) (eq type 'eps) (eq type 'pdf)) (and doc-view-ghostscript-program (executable-find doc-view-ghostscript-program))) @@ -550,13 +553,16 @@ Should be invoked when the cached images aren't up-to-date." (defun doc-view-pdf/ps->png (pdf-ps png) "Convert PDF-PS to PNG asynchronously." (setq doc-view-current-converter-process - (apply 'start-process - (append (list "pdf/ps->png" doc-view-conversion-buffer - doc-view-ghostscript-program) - doc-view-ghostscript-options - (list (format "-r%d" (round doc-view-resolution))) - (list (concat "-sOutputFile=" png)) - (list pdf-ps))) + ;; Make sure the process is started in an existing directory, + ;; (rather than some file-name-handler-managed dir, for example). + (let ((default-directory (file-name-directory pdf-ps))) + (apply 'start-process + (append (list "pdf/ps->png" doc-view-conversion-buffer + doc-view-ghostscript-program) + doc-view-ghostscript-options + (list (format "-r%d" (round doc-view-resolution))) + (list (concat "-sOutputFile=" png)) + (list pdf-ps)))) mode-line-process (list (format ":%s" doc-view-current-converter-process))) (process-put doc-view-current-converter-process 'buffer (current-buffer)) @@ -620,7 +626,7 @@ Should be invoked when the cached images aren't up-to-date." (process-put doc-view-current-converter-process 'pdf-file pdf)) (defun doc-view-convert-current-doc () - "Convert `buffer-file-name' to a set of png files, one file per page. + "Convert `doc-view-buffer-file-name' to a set of png files, one file per page. Those files are saved in the directory given by the function `doc-view-current-cache-dir'." ;; 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 (let ((png-file (expand-file-name "page-%d.png" (doc-view-current-cache-dir)))) (make-directory (doc-view-current-cache-dir)) - (if (not (string= (file-name-extension buffer-file-name) "dvi")) + (if (not (string= (file-name-extension doc-view-buffer-file-name) "dvi")) ;; Convert to PNG images. - (doc-view-pdf/ps->png buffer-file-name png-file) + (doc-view-pdf/ps->png doc-view-buffer-file-name png-file) ;; DVI files have to be converted to PDF before Ghostscript can process ;; it. - (doc-view-dvi->pdf buffer-file-name + (doc-view-dvi->pdf doc-view-buffer-file-name (expand-file-name "doc.pdf" doc-view-current-cache-dir))))) @@ -697,13 +703,23 @@ ARGS is a list of image descriptors." (when doc-view-pending-cache-flush (clear-image-cache) (setq doc-view-pending-cache-flush nil)) - (let ((image (apply 'create-image file 'png nil args))) - (setq doc-view-current-image image) - (move-overlay doc-view-current-overlay (point-min) (point-max)) - (overlay-put doc-view-current-overlay 'display - (if doc-view-current-slice - (list (cons 'slice doc-view-current-slice) image) - image)))) + (if (null file) + ;; We're trying to display a page that doesn't exist. Typically happens + ;; if the conversion process somehow failed. Better not signal an + ;; error here because it could prevent a subsequent reconversion from + ;; fixing the problem. + (progn + (setq doc-view-current-image nil) + (move-overlay doc-view-current-overlay (point-min) (point-max)) + (overlay-put doc-view-current-overlay 'display + "Cannot display this page! Probably a conversion failure!")) + (let ((image (apply 'create-image file 'png nil args))) + (setq doc-view-current-image image) + (move-overlay doc-view-current-overlay (point-min) (point-max)) + (overlay-put doc-view-current-overlay 'display + (if doc-view-current-slice + (list (cons 'slice doc-view-current-slice) image) + image))))) (defun doc-view-sort (a b) "Return non-nil if A should be sorted before B. @@ -847,15 +863,15 @@ If BACKWARD is non-nil, jump to the previous match." ;; We must convert to TXT first! (if doc-view-current-converter-process (message "DocView: please wait till conversion finished.") - (let ((ext (file-name-extension buffer-file-name))) + (let ((ext (file-name-extension doc-view-buffer-file-name))) (cond ((string= ext "pdf") ;; Doc is a PDF, so convert it to TXT - (doc-view-pdf->txt buffer-file-name txt)) + (doc-view-pdf->txt doc-view-buffer-file-name txt)) ((string= ext "ps") ;; Doc is a PS, so convert it to PDF (which will be converted to ;; TXT thereafter). - (doc-view-ps->pdf buffer-file-name + (doc-view-ps->pdf doc-view-buffer-file-name (expand-file-name "doc.pdf" (doc-view-current-cache-dir)))) ((string= ext "dvi") @@ -900,7 +916,7 @@ If BACKWARD is non-nil, jump to the previous match." (defun doc-view-initiate-display () ;; Switch to image display if possible - (if (doc-view-mode-p (intern (file-name-extension buffer-file-name))) + (if (doc-view-mode-p (intern (file-name-extension doc-view-buffer-file-name))) (progn (doc-view-buffer-message) (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." "%s" (substitute-command-keys (concat "No image (png) support available or some conversion utility for " - (file-name-extension buffer-file-name)" files is missing. " + (file-name-extension doc-view-buffer-file-name)" files is missing. " "Type \\[doc-view-toggle-display] to switch to an editing mode."))))) (defvar bookmark-make-cell-function) @@ -929,49 +945,72 @@ If BACKWARD is non-nil, jump to the previous match." You can use \\<doc-view-mode-map>\\[doc-view-toggle-display] to toggle between displaying the document or editing it as text." (interactive) - (if jka-compr-really-do-compress - ;; This is a compressed file uncompressed by auto-compression-mode. - (when (y-or-n-p (concat "DocView: Cannot convert compressed file. " - "Save it uncompressed first? ")) - (let ((file (read-file-name - "File: " - (file-name-directory buffer-file-name)))) - (write-region (point-min) (point-max) file) - (kill-buffer nil) - (find-file file) - (doc-view-mode))) - (let* ((prev-major-mode (if (eq major-mode 'doc-view-mode) - doc-view-previous-major-mode - major-mode))) - (kill-all-local-variables) - (set (make-local-variable 'doc-view-previous-major-mode) prev-major-mode)) - (make-local-variable 'doc-view-current-files) - (make-local-variable 'doc-view-current-image) - (make-local-variable 'doc-view-current-page) - (make-local-variable 'doc-view-current-converter-process) - (make-local-variable 'doc-view-current-timer) - (make-local-variable 'doc-view-current-slice) - (make-local-variable 'doc-view-current-cache-dir) - (make-local-variable 'doc-view-current-info) - (make-local-variable 'doc-view-current-search-matches) - (set (make-local-variable 'doc-view-current-overlay) - (make-overlay (point-min) (point-max) nil t)) - (add-hook 'change-major-mode-hook - (lambda () (delete-overlay doc-view-current-overlay)) - nil t) - (set (make-local-variable 'mode-line-position) - '(" P" (:eval (number-to-string doc-view-current-page)) - "/" (:eval (number-to-string (length doc-view-current-files))))) - (set (make-local-variable 'cursor-type) nil) - (use-local-map doc-view-mode-map) - (set (make-local-variable 'after-revert-hook) 'doc-view-reconvert-doc) - (set (make-local-variable 'bookmark-make-cell-function) - 'doc-view-bookmark-make-cell) - (setq mode-name "DocView" - buffer-read-only t - major-mode 'doc-view-mode) - (doc-view-initiate-display) - (run-mode-hooks 'doc-view-mode-hook))) + + (let* ((prev-major-mode (if (eq major-mode 'doc-view-mode) + doc-view-previous-major-mode + major-mode))) + (kill-all-local-variables) + (set (make-local-variable 'doc-view-previous-major-mode) prev-major-mode)) + + ;; Handle compressed files, remote files, files inside archives + (set (make-local-variable 'doc-view-buffer-file-name) + (cond + (jka-compr-really-do-compress + (expand-file-name + (file-name-nondirectory + (file-name-sans-extension buffer-file-name)) + doc-view-cache-directory)) + ;; Is the file readable by local processes? + ;; We used to use `file-remote-p' but it's unclear what it's + ;; supposed to return nil for things like local files accessed via + ;; `su' or via file://... + ((let ((file-name-handler-alist nil)) + (not (file-readable-p buffer-file-name))) + (expand-file-name + (file-name-nondirectory buffer-file-name) + doc-view-cache-directory)) + (t buffer-file-name))) + (when (not (string= doc-view-buffer-file-name buffer-file-name)) + (write-region nil nil doc-view-buffer-file-name)) + + (make-local-variable 'doc-view-current-files) + (make-local-variable 'doc-view-current-image) + (make-local-variable 'doc-view-current-page) + (make-local-variable 'doc-view-current-converter-process) + (make-local-variable 'doc-view-current-timer) + (make-local-variable 'doc-view-current-slice) + (make-local-variable 'doc-view-current-cache-dir) + (make-local-variable 'doc-view-current-info) + (make-local-variable 'doc-view-current-search-matches) + (set (make-local-variable 'doc-view-current-overlay) + (make-overlay (point-min) (point-max) nil t)) + (add-hook 'change-major-mode-hook + (lambda () (delete-overlay doc-view-current-overlay)) + nil t) + + ;; Keep track of [vh]scroll when switching buffers + (make-local-variable 'image-mode-current-hscroll) + (make-local-variable 'image-mode-current-vscroll) + (image-set-window-hscroll (selected-window) (window-hscroll)) + (image-set-window-vscroll (selected-window) (window-vscroll)) + (add-hook 'window-configuration-change-hook + 'image-reset-current-vhscroll nil t) + + (set (make-local-variable 'mode-line-position) + '(" P" (:eval (number-to-string doc-view-current-page)) + "/" (:eval (number-to-string (length doc-view-current-files))))) + ;; Don't scroll unless the user specifically asked for it. + (set (make-local-variable 'auto-hscroll-mode) nil) + (set (make-local-variable 'cursor-type) nil) + (use-local-map doc-view-mode-map) + (set (make-local-variable 'after-revert-hook) 'doc-view-reconvert-doc) + (set (make-local-variable 'bookmark-make-cell-function) + 'doc-view-bookmark-make-cell) + (setq mode-name "DocView" + buffer-read-only t + major-mode 'doc-view-mode) + (doc-view-initiate-display) + (run-mode-hooks 'doc-view-mode-hook)) ;;;###autoload (define-minor-mode doc-view-minor-mode @@ -1003,7 +1042,7 @@ See the command `doc-view-mode' for more information on this mode." (defun doc-view-bookmark-make-cell (annotation &rest args) (let ((the-record - `((filename . ,(buffer-file-name)) + `((filename . ,buffer-file-name) (page . ,doc-view-current-page) (handler . doc-view-bookmark-jump)))) 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")) ))) -(defsubst ediff-convert-fine-diffs-to-overlays (diff-list region-num) +(defun ediff-convert-fine-diffs-to-overlays (diff-list region-num) (ediff-set-fine-overlays-in-one-buffer 'A diff-list region-num) (ediff-set-fine-overlays-in-one-buffer 'B diff-list region-num) (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 @@ (defvar ediff-after-quit-hook-internal nil) +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + (eval-when-compile (let ((load-path (cons (expand-file-name ".") load-path))) (provide 'ediff-util) ; to break recursive load cycle @@ -2406,7 +2409,9 @@ If it is t, they will be preserved unconditionally. A prefix argument, temporarily reverses the meaning of this variable." (interactive "P") (ediff-barf-if-not-control-buffer) - (let ((ctl-buf (current-buffer))) + (let ((ctl-buf (current-buffer)) + (ctl-frm (selected-frame)) + (minibuffer-auto-raise t)) (if (y-or-n-p (format "Quit this Ediff session%s? " (if (ediff-buffer-live-p ediff-meta-buffer) " & show containing session group" ""))) @@ -2414,6 +2419,8 @@ temporarily reverses the meaning of this variable." (message "") (set-buffer ctl-buf) (ediff-really-quit reverse-default-keep-variants)) + (select-frame ctl-frm) + (raise-frame ctl-frm) (message "")))) @@ -2816,7 +2823,6 @@ up an appropriate window config." (message "To resume, type M-x eregistry and select the desired Ediff session")) - ;; ediff-barf-if-not-control-buffer ensures only called from ediff. (declare-function ediff-version "ediff" ()) 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 @@ (defvar frame-icon-title-format) (defvar ediff-diff-status) +;; declare-function does not exist in XEmacs +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + + (eval-when-compile (let ((load-path (cons (expand-file-name ".") load-path))) (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 @@ ;; Keywords: comparing, merging, patching, tools, unix (defconst ediff-version "2.81.2" "The current version of Ediff") -(defconst ediff-date "August 18, 2007" "Date of last update") +(defconst ediff-date "January 09, 2008" "Date of last update") ;; This file is part of GNU Emacs. @@ -113,6 +113,9 @@ (defvar ediff-last-dir-patch) (defvar ediff-patch-default-directory) +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + (eval-when-compile (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 @@ ;;; avl-tree.el --- balanced binary trees, AVL-trees -;; Copyright (C) 1995, 2007 Free Software Foundation, Inc. +;; Copyright (C) 1995, 2007, 2008 Free Software Foundation, Inc. ;; Author: Per Cederqvist <ceder@lysator.liu.se> ;; 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 @@ ;;; check-declare.el --- Check declare-function statements -;; Copyright (C) 2007 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. ;; Author: Glenn Morris <rgm@gnu.org> ;; 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 @@ ;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p ;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively ;;;;;; notevery notany every some mapcon mapcan mapl maplist map -;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "53c2b3ede19dac62cff13a37f58cdf9c") +;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "2f89c94c42629315419a9d7404469c42") ;;; Generated autoloads from cl-extra.el -(autoload (quote coerce) "cl-extra" "\ +(autoload 'coerce "cl-extra" "\ Coerce OBJECT to type TYPE. TYPE is a Common Lisp type specifier. \(fn OBJECT TYPE)" nil nil) -(autoload (quote equalp) "cl-extra" "\ +(autoload 'equalp "cl-extra" "\ Return t if two Lisp objects have similar structures and contents. This is like `equal', except that it accepts numerically equal numbers of different types (float vs. integer), and also compares @@ -27,246 +27,246 @@ strings case-insensitively. \(fn X Y)" nil nil) -(autoload (quote cl-mapcar-many) "cl-extra" "\ +(autoload 'cl-mapcar-many "cl-extra" "\ Not documented \(fn CL-FUNC CL-SEQS)" nil nil) -(autoload (quote map) "cl-extra" "\ +(autoload 'map "cl-extra" "\ Map a FUNCTION across one or more SEQUENCEs, returning a sequence. TYPE is the sequence type to return. \(fn TYPE FUNCTION SEQUENCE...)" nil nil) -(autoload (quote maplist) "cl-extra" "\ +(autoload 'maplist "cl-extra" "\ Map FUNCTION to each sublist of LIST or LISTs. Like `mapcar', except applies to lists and their cdr's rather than to the elements themselves. \(fn FUNCTION LIST...)" nil nil) -(autoload (quote mapl) "cl-extra" "\ +(autoload 'mapl "cl-extra" "\ Like `maplist', but does not accumulate values returned by the function. \(fn FUNCTION LIST...)" nil nil) -(autoload (quote mapcan) "cl-extra" "\ +(autoload 'mapcan "cl-extra" "\ Like `mapcar', but nconc's together the values returned by the function. \(fn FUNCTION SEQUENCE...)" nil nil) -(autoload (quote mapcon) "cl-extra" "\ +(autoload 'mapcon "cl-extra" "\ Like `maplist', but nconc's together the values returned by the function. \(fn FUNCTION LIST...)" nil nil) -(autoload (quote some) "cl-extra" "\ +(autoload 'some "cl-extra" "\ Return true if PREDICATE is true of any element of SEQ or SEQs. If so, return the true (non-nil) value returned by PREDICATE. \(fn PREDICATE SEQ...)" nil nil) -(autoload (quote every) "cl-extra" "\ +(autoload 'every "cl-extra" "\ Return true if PREDICATE is true of every element of SEQ or SEQs. \(fn PREDICATE SEQ...)" nil nil) -(autoload (quote notany) "cl-extra" "\ +(autoload 'notany "cl-extra" "\ Return true if PREDICATE is false of every element of SEQ or SEQs. \(fn PREDICATE SEQ...)" nil nil) -(autoload (quote notevery) "cl-extra" "\ +(autoload 'notevery "cl-extra" "\ Return true if PREDICATE is false of some element of SEQ or SEQs. \(fn PREDICATE SEQ...)" nil nil) -(defalias (quote cl-map-keymap) (quote map-keymap)) +(defalias 'cl-map-keymap 'map-keymap) -(autoload (quote cl-map-keymap-recursively) "cl-extra" "\ +(autoload 'cl-map-keymap-recursively "cl-extra" "\ Not documented \(fn CL-FUNC-REC CL-MAP &optional CL-BASE)" nil nil) -(autoload (quote cl-map-intervals) "cl-extra" "\ +(autoload 'cl-map-intervals "cl-extra" "\ Not documented \(fn CL-FUNC &optional CL-WHAT CL-PROP CL-START CL-END)" nil nil) -(autoload (quote cl-map-overlays) "cl-extra" "\ +(autoload 'cl-map-overlays "cl-extra" "\ Not documented \(fn CL-FUNC &optional CL-BUFFER CL-START CL-END CL-ARG)" nil nil) -(autoload (quote cl-set-frame-visible-p) "cl-extra" "\ +(autoload 'cl-set-frame-visible-p "cl-extra" "\ Not documented \(fn FRAME VAL)" nil nil) -(autoload (quote cl-progv-before) "cl-extra" "\ +(autoload 'cl-progv-before "cl-extra" "\ Not documented \(fn SYMS VALUES)" nil nil) -(autoload (quote gcd) "cl-extra" "\ +(autoload 'gcd "cl-extra" "\ Return the greatest common divisor of the arguments. \(fn &rest ARGS)" nil nil) -(autoload (quote lcm) "cl-extra" "\ +(autoload 'lcm "cl-extra" "\ Return the least common multiple of the arguments. \(fn &rest ARGS)" nil nil) -(autoload (quote isqrt) "cl-extra" "\ +(autoload 'isqrt "cl-extra" "\ Return the integer square root of the argument. \(fn X)" nil nil) -(autoload (quote floor*) "cl-extra" "\ +(autoload 'floor* "cl-extra" "\ Return a list of the floor of X and the fractional part of X. With two arguments, return floor and remainder of their quotient. \(fn X &optional Y)" nil nil) -(autoload (quote ceiling*) "cl-extra" "\ +(autoload 'ceiling* "cl-extra" "\ Return a list of the ceiling of X and the fractional part of X. With two arguments, return ceiling and remainder of their quotient. \(fn X &optional Y)" nil nil) -(autoload (quote truncate*) "cl-extra" "\ +(autoload 'truncate* "cl-extra" "\ Return a list of the integer part of X and the fractional part of X. With two arguments, return truncation and remainder of their quotient. \(fn X &optional Y)" nil nil) -(autoload (quote round*) "cl-extra" "\ +(autoload 'round* "cl-extra" "\ Return a list of X rounded to the nearest integer and the remainder. With two arguments, return rounding and remainder of their quotient. \(fn X &optional Y)" nil nil) -(autoload (quote mod*) "cl-extra" "\ +(autoload 'mod* "cl-extra" "\ The remainder of X divided by Y, with the same sign as Y. \(fn X Y)" nil nil) -(autoload (quote rem*) "cl-extra" "\ +(autoload 'rem* "cl-extra" "\ The remainder of X divided by Y, with the same sign as X. \(fn X Y)" nil nil) -(autoload (quote signum) "cl-extra" "\ +(autoload 'signum "cl-extra" "\ Return 1 if X is positive, -1 if negative, 0 if zero. \(fn X)" nil nil) -(autoload (quote random*) "cl-extra" "\ +(autoload 'random* "cl-extra" "\ Return a random nonnegative number less than LIM, an integer or float. Optional second arg STATE is a random-state object. \(fn LIM &optional STATE)" nil nil) -(autoload (quote make-random-state) "cl-extra" "\ +(autoload 'make-random-state "cl-extra" "\ Return a copy of random-state STATE, or of `*random-state*' if omitted. If STATE is t, return a new state object seeded from the time of day. \(fn &optional STATE)" nil nil) -(autoload (quote random-state-p) "cl-extra" "\ +(autoload 'random-state-p "cl-extra" "\ Return t if OBJECT is a random-state object. \(fn OBJECT)" nil nil) -(autoload (quote cl-float-limits) "cl-extra" "\ +(autoload 'cl-float-limits "cl-extra" "\ Not documented \(fn)" nil nil) -(autoload (quote subseq) "cl-extra" "\ +(autoload 'subseq "cl-extra" "\ Return the subsequence of SEQ from START to END. If END is omitted, it defaults to the length of the sequence. If START or END is negative, it counts from the end. \(fn SEQ START &optional END)" nil nil) -(autoload (quote concatenate) "cl-extra" "\ +(autoload 'concatenate "cl-extra" "\ Concatenate, into a sequence of type TYPE, the argument SEQUENCEs. \(fn TYPE SEQUENCE...)" nil nil) -(autoload (quote revappend) "cl-extra" "\ +(autoload 'revappend "cl-extra" "\ Equivalent to (append (reverse X) Y). \(fn X Y)" nil nil) -(autoload (quote nreconc) "cl-extra" "\ +(autoload 'nreconc "cl-extra" "\ Equivalent to (nconc (nreverse X) Y). \(fn X Y)" nil nil) -(autoload (quote list-length) "cl-extra" "\ +(autoload 'list-length "cl-extra" "\ Return the length of list X. Return nil if list is circular. \(fn X)" nil nil) -(autoload (quote tailp) "cl-extra" "\ +(autoload 'tailp "cl-extra" "\ Return true if SUBLIST is a tail of LIST. \(fn SUBLIST LIST)" nil nil) -(autoload (quote get*) "cl-extra" "\ +(autoload 'get* "cl-extra" "\ Return the value of SYMBOL's PROPNAME property, or DEFAULT if none. \(fn SYMBOL PROPNAME &optional DEFAULT)" nil nil) -(autoload (quote getf) "cl-extra" "\ +(autoload 'getf "cl-extra" "\ Search PROPLIST for property PROPNAME; return its value or DEFAULT. PROPLIST is a list of the sort returned by `symbol-plist'. \(fn PROPLIST PROPNAME &optional DEFAULT)" nil nil) -(autoload (quote cl-set-getf) "cl-extra" "\ +(autoload 'cl-set-getf "cl-extra" "\ Not documented \(fn PLIST TAG VAL)" nil nil) -(autoload (quote cl-do-remf) "cl-extra" "\ +(autoload 'cl-do-remf "cl-extra" "\ Not documented \(fn PLIST TAG)" nil nil) -(autoload (quote cl-remprop) "cl-extra" "\ +(autoload 'cl-remprop "cl-extra" "\ Remove from SYMBOL's plist the property PROPNAME and its value. \(fn SYMBOL PROPNAME)" nil nil) -(defalias (quote remprop) (quote cl-remprop)) +(defalias 'remprop 'cl-remprop) -(defalias (quote cl-gethash) (quote gethash)) +(defalias 'cl-gethash 'gethash) -(defalias (quote cl-puthash) (quote puthash)) +(defalias 'cl-puthash 'puthash) -(defalias (quote cl-remhash) (quote remhash)) +(defalias 'cl-remhash 'remhash) -(defalias (quote cl-clrhash) (quote clrhash)) +(defalias 'cl-clrhash 'clrhash) -(defalias (quote cl-maphash) (quote maphash)) +(defalias 'cl-maphash 'maphash) -(defalias (quote cl-make-hash-table) (quote make-hash-table)) +(defalias 'cl-make-hash-table 'make-hash-table) -(defalias (quote cl-hash-table-p) (quote hash-table-p)) +(defalias 'cl-hash-table-p 'hash-table-p) -(defalias (quote cl-hash-table-count) (quote hash-table-count)) +(defalias 'cl-hash-table-count 'hash-table-count) -(autoload (quote cl-macroexpand-all) "cl-extra" "\ +(autoload 'cl-macroexpand-all "cl-extra" "\ Expand all macro calls through a Lisp FORM. This also does some trivial optimizations to make the form prettier. \(fn FORM &optional ENV)" nil nil) -(autoload (quote cl-prettyexpand) "cl-extra" "\ +(autoload 'cl-prettyexpand "cl-extra" "\ Not documented \(fn FORM &optional FULL)" nil nil) @@ -745,7 +745,7 @@ Not documented ;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not ;;;;;; substitute-if substitute delete-duplicates remove-duplicates ;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove* -;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "77bee7df392948b6ab0699e391e8abc1") +;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "e3c349e5231811c1c0482dd378dae56a") ;;; Generated autoloads from cl-seq.el (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 omitted, a default message listing FORM itself is used." (and (or (not (cl-compiling-file)) (< cl-optimize-speed 3) (= cl-optimize-safety 3)) - (let ((sargs (and show-args (delq nil (mapcar - (function - (lambda (x) - (and (not (cl-const-expr-p x)) - x))) (cdr form)))))) + (let ((sargs (and show-args + (delq nil (mapcar + (lambda (x) + (unless (cl-const-expr-p x) + x)) + (cdr form)))))) (list 'progn (list 'or form (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." (setq menu (cdr (easy-menu-convert-item menu))))) menu) +(defvar easy-menu-avoid-duplicate-keys t + "Dynamically scoped var to register already used keys in a menu. +If it holds a list, this is expected to be a list of keys already seen in the +menu we're processing. Else it means we're not processing a menu.") + ;;;###autoload (defun easy-menu-create-menu (menu-name menu-items) "Create a menu called MENU-NAME with items described in MENU-ITEMS. MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items possibly preceded by keyword pairs as described in `easy-menu-define'." (let ((menu (make-sparse-keymap menu-name)) + (easy-menu-avoid-duplicate-keys nil) prop keyword arg label enable filter visible help) ;; Look for keywords. (while (and menu-items @@ -341,22 +347,22 @@ ITEM defines an item as in `easy-menu-define'." (setq prop (cons :button (cons (cons (cdr style) selected) prop))))) (when (stringp keys) - (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$" - keys) - (let ((prefix - (if (< (match-beginning 0) (match-beginning 1)) - (substring keys 0 (match-beginning 1)))) - (postfix - (if (< (match-end 1) (match-end 0)) - (substring keys (match-end 1)))) - (cmd (intern (match-string 2 keys)))) - (setq keys (and (or prefix postfix) - (cons prefix postfix))) - (setq keys - (and (or keys (not (eq command cmd))) - (cons cmd keys)))) - (setq cache-specified nil)) - (if keys (setq prop (cons :keys (cons keys prop))))) + (if (string-match "^[^\\]*\\(\\\\\\[\\([^]]+\\)]\\)[^\\]*$" + keys) + (let ((prefix + (if (< (match-beginning 0) (match-beginning 1)) + (substring keys 0 (match-beginning 1)))) + (postfix + (if (< (match-end 1) (match-end 0)) + (substring keys (match-end 1)))) + (cmd (intern (match-string 2 keys)))) + (setq keys (and (or prefix postfix) + (cons prefix postfix))) + (setq keys + (and (or keys (not (eq command cmd))) + (cons cmd keys)))) + (setq cache-specified nil)) + (if keys (setq prop (cons :keys (cons keys prop))))) (if (and visible (not (easy-menu-always-true-p visible))) (if (equal visible ''nil) ;; Invisible menu item. Don't insert into keymap. @@ -371,12 +377,27 @@ ITEM defines an item as in `easy-menu-define'." ;; `intern' the name so as to merge multiple entries with the same name. ;; It also makes it easier/possible to lookup/change menu bindings ;; via keymap functions. - (cons (easy-menu-intern name) - (and (not remove) - (cons 'menu-item - (cons label - (and name - (cons command prop)))))))) + (let ((key (easy-menu-intern name))) + (when (listp easy-menu-avoid-duplicate-keys) + ;; Merging multiple entries with the same name is sometimes what we + ;; want, but not when the entries are actually different (e.g. same + ;; name but different :suffix as seen in cal-menu.el) and appear in + ;; the same menu. So we try to detect and resolve conflicts. + (while (and (stringp name) + (memq key easy-menu-avoid-duplicate-keys)) + ;; We need to use some distinct object, ideally a symbol, ideally + ;; related to the `name'. Uninterned symbols do not work (they + ;; are apparently turned into strings and re-interned later on). + (setq key (intern (format "%s (%d)" (symbol-name key) + (length easy-menu-avoid-duplicate-keys))))) + (push key easy-menu-avoid-duplicate-keys)) + + (cons key + (and (not remove) + (cons 'menu-item + (cons label + (and name + (cons command prop))))))))) (defun easy-menu-define-key (menu key item &optional before) "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." (let* ((path (cons (or find-function-source-path load-path) (find-library-suffixes))) (def (if (eq (function-called-at-point) 'require) - (save-excursion - (backward-up-list) - (forward-char) - (backward-sexp -2) - (thing-at-point 'symbol)) + ;; `function-called-at-point' may return 'require + ;; with `point' anywhere on this line. So wrap the + ;; `save-excursion' below in a `condition-case' to + ;; avoid reporting a scan-error here. + (condition-case nil + (save-excursion + (backward-up-list) + (forward-char) + (forward-sexp 2) + (thing-at-point 'symbol)) + (error nil)) (thing-at-point 'symbol)))) (when def (setq def (and (locate-file-completion def path 'test) def))) @@ -233,8 +239,12 @@ The search is done in the source for library LIBRARY." (setq symbol (get symbol 'definition-name))) (if (string-match "\\`src/\\(.*\\.c\\)\\'" library) (find-function-C-source symbol (match-string 1 library) type) - (if (string-match "\\.el\\(c\\)\\'" library) - (setq library (substring library 0 (match-beginning 1)))) + (when (string-match "\\.el\\(c\\)\\'" library) + (setq library (substring library 0 (match-beginning 1)))) + ;; Strip extension from .emacs.el to make sure symbol is searched in + ;; .emacs too. + (when (string-match "\\.emacs\\(.el\\)" library) + (setq library (substring library 0 (match-beginning 1)))) (let* ((filename (find-library-name library)) (regexp-symbol (cdr (assq type find-function-regexp-alist)))) (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." (defun crisp-region-active () "Compatibility function to test for an active region." - (if (boundp 'zmacs-region-active-p) + (if (featurep 'xemacs) zmacs-region-active-p mark-active)) 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." Sets the mark at POS and activates the region according to the current version of Emacs." (set-mark pos) - ;; We use a separate `if' for the fboundp so the byte-compiler notices it - ;; and doesn't complain about the subsequent call. - (if (fboundp 'zmacs-activate-region) (if pos (zmacs-activate-region)))) + (when (featurep 'xemacs) (when pos (zmacs-activate-region)))) (defun tpu-string-prompt (prompt history-symbol) "Read a string with PROMPT." @@ -2439,7 +2437,7 @@ If FILE is nil, try to load a default file. The default file names are ;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins -;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "e0629234f1abe076917a303456b48329") +;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "c7ce8bad68736a5682eb3f5f5edc48db") ;;; Generated autoloads from tpu-extras.el (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 @@ (defvar initial) (defvar undo-beg-posn) (defvar undo-end-posn) + +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) ;; end pacifier @@ -2773,7 +2776,9 @@ On reaching beginning of line, stop and signal error." (defun viper-next-line-carefully (arg) (condition-case nil ;; do not use forward-line! need to keep column - (with-no-warnings (next-line arg)) + (if (featurep 'emacs) + (with-no-warnings (next-line arg)) + (next-line arg)) (error nil))) @@ -3073,7 +3078,9 @@ On reaching beginning of line, stop and signal error." (com (viper-getCom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) ;; do not use forward-line! need to keep column - (with-no-warnings (next-line val)) + (if (featurep 'emacs) + (with-no-warnings (next-line val)) + (next-line val)) (if viper-ex-style-motion (if (and (eolp) (not (bolp))) (backward-char 1))) (setq this-command 'next-line) @@ -3120,7 +3127,9 @@ If point is on a widget or a button, simulate clicking on that widget/button." (com (viper-getCom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) ;; do not use forward-line! need to keep column - (with-no-warnings (previous-line val)) + (if (featurep 'emacs) + (with-no-warnings (previous-line val)) + (previous-line val)) (if viper-ex-style-motion (if (and (eolp) (not (bolp))) (backward-char 1))) (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." (pos2 (viper-line-pos 'end)) lines file info) (setq lines (count-lines (point-min) (viper-line-pos 'end)) - file (if (buffer-file-name) - (concat (viper-abbreviate-file-name (buffer-file-name)) ":") - (concat (buffer-name) " [Not visiting any file]:")) + file (cond ((buffer-file-name) + (concat (viper-abbreviate-file-name (buffer-file-name)) ":")) + ((buffer-file-name (buffer-base-buffer)) + (concat (viper-abbreviate-file-name (buffer-file-name (buffer-base-buffer))) " (indirect buffer):")) + (t (concat (buffer-name) " [Not visiting any file]:"))) info (format "line=%d/%d pos=%d/%d col=%d %s" (if (= pos1 pos2) (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 @@ (defvar viper-expert-level) (defvar viper-ex-style-editing) (defvar viper-ex-style-motion) + +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) ;; end pacifier (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 @@ (require 'ring) +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + ;; end pacifier (require 'viper-init) @@ -713,7 +716,7 @@ (not (memq (vc-state file) '(edited needs-merge))) (not (stringp (vc-state file)))) ;; XEmacs has no vc-state - (if (featurep 'xemacs)(not (vc-locking-user file)))) + (if (featurep 'xemacs) (not (vc-locking-user file)))) )) ;; 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 @@ ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; Keywords: emulations -(defconst viper-version "3.14 of August 18, 2007" +(defconst viper-version "3.14 of January 09, 2008" "The current version of Viper") ;; This file is part of GNU Emacs. @@ -857,7 +857,9 @@ It also can't undo some Viper settings." (modify-frame-parameters (selected-frame) (list (cons 'viper-vi-state-cursor-color - (viper-get-cursor-color)))))) + (viper-get-cursor-color)))) + (setq viper-vi-state-cursor-color (viper-get-cursor-color)) + )) ;; Tell vc-diff to put *vc* in Vi mode (if (featurep 'vc) @@ -900,6 +902,7 @@ It also can't undo some Viper settings." (modify-frame-parameters (selected-frame) (list (cons 'viper-vi-state-cursor-color (ad-get-arg 0)))) + (setq viper-vi-state-cursor-color (ad-get-arg 0)) ) (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 @@ -2008-01-04 Stefan Monnier <monnier@iro.umontreal.ca> - - * erc-ibuffer.el (erc-channel-modes): - Pass mode-name through format-mode-line - -2007-12-09 Michael Olson <mwolson@gnu.org> - - * erc-services.el (erc-nickserv-alist): Fix regexps for GRnet. - -2007-12-09 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change) - - * erc-backend.el, erc.el: - Parse 275 (secure connection) responses. - - * erc-services.el: Add identification hooks for GRnet, the Greek - IRC network <http://www.irc.gr>. - -2007-12-08 David Kastrup <dak@gnu.org> - - * erc-stamp.el (erc-echo-timestamp): - * erc-lang.el (language): - * erc-backend.el (erc-server-connect): Fix buggy call to `message'. - -2007-12-07 Edward O'Connor <ted@oconnor.cx> - - * erc-services.el: Provide a hook that runs when nickserv confirms - that the user has successfully identified. - (services, erc-nickserv-identify-mode): Add and remove - erc-nickserv-identification-autodetect from - erc-server-NOTICE-functions. - (erc-nickserv-alist): Add SUCCESS-REGEXP to each entry. - (erc-nickserv-alist-identified-regexp) - (erc-nickserv-identification-autodetect): New functions. - (erc-nickserv-identified-hook): New hook. - -2007-12-06 D. Goel <deego3@gmail.com> - - * erc-match.el (erc-add-entry-to-list): Fix buggy call to `error'. - -2007-12-01 Glenn Morris <rgm@gnu.org> - - * erc-backend.el (erc-server-send-ping): Move after definition of - erc-server-send. - - * erc.el (iswitchb-temp-buflist, iswitchb-read-buffer) - (erc-controls-strip): Declare for compiler. - (erc-iswitchb): Don't require iswitchb when compiling. Test - iswitchb-mode is bound. - -2007-11-30 Dan Nicolaescu <dann@ics.uci.edu> - - * erc.el (open-ssl-stream, open-tls-stream, erc-network-name): - Declare as functions. - -2007-11-29 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change) - - * erc-backend.el, erc.el: - Parse 307 (nick has identified) responses. - -2007-11-15 Juanma Barranquero <lekktu@gmail.com> - - * erc.el (erc-open): - * erc-backend.el (define-erc-response-handler): - * erc-log.el (log): - * erc-match.el (erc-log-matches): Fix typos in docstrings. - -2007-11-11 Michael Olson <mwolson@gnu.org> - - * erc-autoaway.el (erc-autoaway-possibly-set-away): - * erc-netsplit.el (erc-netsplit-timer): - * erc-notify.el (erc-notify-timer): - * erc-track.el (erc-user-is-active): Only run if we have - successfully established a connection to the server and have - logged in. I suspect that sending messages too soon may make some - IRC servers not respond well, particularly when the network - connection is iffy or subject to traffic-shaping. - -2007-11-01 Michael Olson <mwolson@gnu.org> - - * erc-compat.el (erc-set-write-file-functions): New compatibility - function to set the write hooks appropriately. - - * erc-log.el (erc-log-setup-logging): Use - erc-set-write-file-functions. This fixes a byte-compiler warning. - - * erc-stamp.el: Silence byte-compiler warning about - erc-fill-column. - - * erc.el (erc-with-all-buffers-of-server): Bind the result of - mapcar to a variable in order to silence a byte-compiler warning. - -2007-10-29 Michael Olson <mwolson@gnu.org> - - * erc-ibuffer.el (erc-modified-channels-alist): Use - eval-when-compile, and explain why we are doing this. - -2007-10-25 Dan Nicolaescu <dann@ics.uci.edu> - - * erc-ibuffer.el (erc-modified-channels-alist): Pacify - byte-compiler. - -2007-10-13 Glenn Morris <rgm@gnu.org> - - * erc-track.el (erc-modified-channels-update): Use mapc rather - than mapcar. - -2007-10-12 Diane Murray <disumu@x3y2z1.net> - - * erc.el (erc-join-channel): Prompt for channel key if C-u or - another prefix-arg was typed. - - * NEWS: Noted this change. - -2007-10-07 Michael Olson <mwolson@gnu.org> - - * erc.el (erc-cmd-ME'S): New command that handles the case where - someone types "/me's". It concatenates the text " 's" to the - beginning of the input and then sends the result like a normal - "/me" command. - (erc-command-regexp): Permit single-quote character. - -2007-09-30 Aidan Kehoe <kehoea@parhasard.net> (tiny change) - - * erc-log.el (erc-save-buffer-in-logs): Prevent spurious warnings - when looking at a log file and concurrently saving to it. - -2007-09-18 Exal de Jesus Garcia Carrillo <exal@gnu.org> (tiny change) - - * erc.texi (Special-Features): Fix small typo. - -2007-09-16 Michael Olson <mwolson@gnu.org> - - * erc-track.el (erc-track-switch-direction): Mention - erc-track-faces-priority-list. Thanks to Leo for the suggestion. - -2007-09-11 Exal de Jesus Garcia Carrillo <exal@gnu.org> (tiny change) - - * erc-sound.el: Fix typo in setting up instructions. - -2007-09-10 Michael Olson <mwolson@gnu.org> - - * Makefile (elpa): Copy dir template rather than echoing a few - lines. The reason for this is that the ELPA package for ERC was - getting a corrupt dir entry. - - * dir-template: Template for the ELPA dir file. - -2007-09-08 Michael Olson <mwolson@gnu.org> - - * erc-log.el (erc-log-filter-function): New option that specifies - the function to call for filtering text before writing it to a log - file. Thanks to David O'Toole for the suggestion. - (erc-save-buffer-in-logs): Use erc-log-filter-function. Make sure - we carry along the value of coding-system-for-write, because this - could potentially be shadowed by the temporary buffer. - - * erc.el (erc-version-string): Update to 5.3, development version. - -2007-09-07 Glenn Morris <rgm@gnu.org> - - * erc.el (erc-toggle-debug-irc-protocol): Fix call to - erc-view-mode-enter. - -2007-08-08 Glenn Morris <rgm@gnu.org> - - * erc-log.el, erc.el: Replace `iff' in doc-strings and comments. - -2007-09-03 Michael Olson <mwolson@gnu.org> - - * erc.el (erc-default-port): Make this an integer value rather - than a string. Thanks to Luca Capello for the report. - -2007-08-27 Michael Olson <mwolson@gnu.org> - - * erc.el (erc-cmd-GQUIT): If erc-kill-queries-on-quit is non-nil, - kill all query buffers after 4 seconds. - -2007-08-16 Michael Olson <mwolson@gnu.org> - - * NEWS: Add ERC 5.3 changes section, and mention jbms' erc-track - compatibility note. - - * erc-track.el (erc-track-list-changed-hook): Turn this into a - customizable option. - (erc-track-switch-direction): Add 'importance option. - (erc-modified-channels-display): If erc-track-switch-direction is - 'importance, call erc-track-sort-by-importance. - (erc-track-face-priority): New function that returns a number - indicating the position of a face in erc-track-faces-priority-list. - (erc-track-sort-by-importance): New function that sorts - erc-modified-channels-list according to erc-track-face-priority. - (erc-track-get-active-buffer): Make 'oldest a rough opposite of - 'importance. - -2007-08-14 Jeremy Maitin-Shepard <jbms@cmu.edu> - - * erc-track.el (erc-track-remove-disconnected-buffers): New - variable which controls whether buffers associated with a server - that is disconnected should be removed from - `erc-modified-channels-alist'. Existing behavior is to - unconditionally remove such buffers, which is achieved by setting - `erc-track-removed-disconnected-buffers' to t. When set to t, - which is the new default value, such buffers remain in the list, - which I think is often the desired behavior, since the user may - likely wish to find out about activity that occurred in a channel - prior to it being disconnected. - (erc-track-list-changed-hook): New hook that is run whenever the - contents of `erc-modified-channels-alist' changes; it is useful - for users such as myself that don't use the default mode-line - notification but instead use a separate mechanism (which is tied - to my window manager) to provide notification of channel activity. - (erc-track-get-buffer-window): New function that acts as a wrapper - around `get-buffer-window' that handles the `selected-visible' - option of `erc-track-visibility'; previously, the value of - `erc-track-visibility' was passed directly to `get-buffer-window', - which does not support `selected-visible'; consequently, - `selected-visible' was not properly supported. - (erc-track-modified-channels): Fix a bug in the logic for removing - buffers from the list in certain cases. - (erc-track-position-in-mode-line): Add a supported value that - specifies that the tracking information should not be added to the - mode line at all. The value of nil is used to indicate that the - information should not be added at all to the mode line. - (erc-track-add-to-mode-line): Check for position eq to t, rather - than non-nil. - (erc-buffer-visible): Use erc-track-get-buffer-window. - (erc-modified-channels-update): Take - erc-track-remove-disconnected-buffers into account. - (erc-modified-channels-display): Run `erc-track-list-changed-hook'. - - * erc.el (erc-reuse-frames): New option that determines whether - new frames are always created. Defaults to t. This only has an - effect when erc-join-buffer is set to 'frame. - (erc-setup-buffer): Use it. - -2007-08-14 Michael Olson <mwolson@gnu.org> - - * erc-backend.el (erc-server-reconnect): If the server buffer has - been killed, use the current buffer instead. If the current - buffer is not an ERC buffer, give an error. This fixes a bug when - /reconnect is run from a channel buffer whose server buffer has - been deleted. Thanks to jbms for the report. - (erc-process-sentinel-1): Take server buffer as an argument, so - that we can make sure that it is current. - (erc-process-sentinel): Pass buffer to erc-process-sentinel-1. - (erc-process-sentinel-2): New function split from - erc-process-sentinel-1. If server buffer is deleted during a - reconnect attempt, stop trying to reconnect. Fix bug where - reconnect was not happening when erc-server-reconnect-attempts was - t. Call erc-server-reconnect-p only once each time. If we are - instructed to try connecting indefinitely, tell the user that they - can stop this by killing the server buffer. Call the process - sentinel by means of run-at-time, so that there is time to kill - the buffer if need be; this also removes the need for a while - loop. Refuse to reconnect again if erc-server-reconnect-timeout - is not an number. - - * erc.el (erc-command-no-process-p): Fix bug: the return value of - erc-extract-command-from-line is a list rather than a single - symbol. Thanks to jbms for the report. - (erc-cmd-RECONNECT): Use simpler logic, and use buffer-live-p - rather than bufferp. - (erc-send-current-line, erc-display-command, erc-display-msg): - Handle case where erc-server-process is nil, so that /reconnect - works. - -2007-08-12 Michael Olson <mwolson@gnu.org> - - * erc-identd.el (erc-identd-filter): Instead of sending an EOF - character, which now confuses freenode, stop the server process, - so that no new connections are accepted, and kill the current - client process. - -2007-07-30 Michael Olson <mwolson@gnu.org> - - * erc-nicklist.el: Remove from the Emacs source tree. This file - is not release quality, and relies heavily on a module which - cannot be distributed with ERC due to licensing reasons. - -2007-07-29 Michael Olson <mwolson@gnu.org> - - * erc-list.el: Relicense to GPLv3. Since the file was already - licensed under version 2 or later, it turns out that we do not - need the permission of all of the authors in order to proceed. - -2007-07-25 Glenn Morris <rgm@gnu.org> - - * Relicense all FSF files to GPLv3 or later. - -2007-07-13 Michael Olson <mwolson@gnu.org> - - * erc-goodies.el (erc-get-bg-color-face, erc-get-fg-color-face): - Use erc-error rather than message and beep. - - * erc-sound.el: Indentation fix. - - * erc.el (erc-command-no-process-p): New function that determines - if its argument is an ERC command that can be run when the server - process is not alive. - (erc-cmd-SET, erc-cmd-CLEAR, erc-cmd-COUNTRY, erc-cmd-HELP) - (erc-cmd-LASTLOG, erc-cmd-QUIT, erc-cmd-GQUIT) - (erc-cmd-RECONNECT, erc-cmd-SERVER): Denote that these commands - can be run even when the server process is not alive. - (erc-send-current-line): Call erc-command-no-process-p if the - server process is not alive, to determine if we have a command - that can be run anyway. Thanks to Tom Tromey for the bug report. - (erc-error): New function that either displays a message or throws - an error, depending on whether debug-on-error is non-nil. - (erc-cmd-SERVER, erc-send-current-line): Use it. - -2007-07-10 Michael Olson <mwolson@gnu.org> - - * Relicense all FSF-assigned code to GPLv3. - -2007-06-25 Michael Olson <mwolson@gnu.org> - - * erc.texi (Options): Fix typo. - (Getting Help and Reporting Bugs): Update webpage URL. Make Gmane - part more readable. - -2007-06-20 Michael Olson <mwolson@gnu.org> - - * erc-stamp.el (erc-timestamp-format-left): New option that - specifies the left timestamp to use for - erc-insert-timestamp-left-and-right. - (erc-timestamp-format-right): New option that specifies the right - timestamp to use for erc-insert-timestamp-left-and-right. - (erc-insert-timestamp-function): Change default to - erc-insert-timestamp-left-and-right. - (erc-insert-away-timestamp-function): Ditto. - (erc-timestamp-last-inserted-left) - (erc-timestamp-last-inserted-right): New variables to keep track - of data for erc-insert-timestamp-left-and-right. - (erc-insert-timestamp-left-and-right): New function that places - timestamps on both the left and right sides of the screen, but - only if each timestamp has changed since it was last computed. - Thanks to offby1 for urging me to merge this. - - * erc.el (erc-open-ssl-stream): Display informative error when - ssl.el not found. - (erc-tls): New function to connect using tls.el. - (erc-open-tls-stream): New function to initiate tls connection. - Display informative error when tls.el not found. - -2007-06-19 Michael Olson <mwolson@gnu.org> +2008-01-26 Michael Olson <mwolson@gnu.org> - * erc-log.el: Update header with accurate instructions. + * erc.el (erc-version-string): Release ERC 5.3. -2007-06-17 Michael Olson <mwolson@gnu.org> + * Makefile (VERSION): Update. + (EXTRAS): Remove erc-list.el after all, because this is mainly for + users of the version that comes with Emacs, and they will have + erc-list.el by Emacs 23. + (MISC): Add ChangeLog.07. - * erc-pkg.el: Update description to match what is currently in ELPA. + * README.extras: Mention Emacs 23. -2007-06-14 Juanma Barranquero <lekktu@gmail.com> + * erc.texi (Obtaining ERC): Update extras URLs for 5.3. + (Development): Write instructions for git, and remove those for + Arch. + (History): Mention the switch to git. - * erc-goodies.el (erc-scroll-to-bottom): Remove redundant check. +2008-01-25 Michael Olson <mwolson@gnu.org> -2007-06-13 Michael Olson <mwolson@gnu.org> + * NEWS: Update. - * erc-compat.el (erc-with-selected-window): New compatibility - macro that implements `with-selected-window'. + * erc-goodies.el (keep-place): New module which keeps your place + in unvisited ERC buffers when new messages arrive. This is mostly + taken from Johan BockgÃ¥rd's init file. + (erc-noncommands-list): Move to correct place. + + * erc-networks.el: Add a module definition. + + * erc-services.el (erc-nickserv-identify-mode): Force-enable the + networks module, because we need it to set erc-network for us. + + * erc-track.el (erc-track-faces-normal-list): Indicate in the + docstring that this variable can be set to nil. + + * erc.el: On second thought, don't load erc-networks. Just enable + the networks module by default. + (erc-modules): Add option for keep-place and networks. Enable + networks by default. + (erc-version-string): Make release candidate 1 available. + +2008-01-24 Michael Olson <mwolson@gnu.org> + + * erc.el: Load erc-networks.el so that functions get access to the + `erc-network-name' function. + + * erc-track.el (erc-track-faces-normal-list): Add + erc-dangerous-host-face. + (erc-track-exclude-types): Add 333 and 353 to the default list of + things to ignore, and explain what they are in the docstring. + +2008-01-23 Michael Olson <mwolson@gnu.org> + + * erc-track.el (erc-track-faces-priority-list): Move + erc-nick-default-face higher, so that it can be used for the + activity indication effect. Add erc-current-nick-face, + erc-pal-face, erc-dangerous-host-face, and erc-fool-face by + themselves. + (erc-track-faces-normal-list): New option that contains a list of + faces to consider "normal". + (erc-track-position-in-mode-line): Minor docfix. + (erc-track-find-face): Use erc-track-faces-normal-list to produce + a sort of blinking activity effect. + +2008-01-22 Michael Olson <mwolson@gnu.org> + + * erc-button.el (erc-button-add-nickname-buttons): When in a + channel buffer, only look at nicks from the current channel. + Thanks to e1f for the report. + +2008-01-21 Michael Olson <mwolson@gnu.org> + + * erc-compat.el (erc-const-expr-p, erc-list*, erc-assert): Remove, + since we can use the default `assert' function without it causing + us any problems, even in Emacs 21. Thanks to bojohan for the + suggestion. + + * erc-goodies.el (move-to-prompt): Use the "XEmacs" method + instead, because the [remap ...] method interferes with + delete-selection-mode. + (erc-move-to-prompt): Rename from erc-move-to-prompt-xemacs. + Deactivate mark and call push-mark before moving point. Thanks to + bojohan for the suggestion. + (erc-move-to-prompt-setup): Rename from + erc-move-to-prompt-init-xemacs. + + * erc-track.el (erc-track-faces-priority-list): Replace erc-button + with '(erc-button erc-default-face) so that we only care about + buttons that are part of normal text. Adjust customization type + to handle this case. Make erc-nick-default-face a list. Handle + pals, fools, current nick, and dangerous hosts. + (erc-track-find-face): Simplify. Adapt for list of faces case. + (erc-faces-in): Don't deflate lists of faces. Add them as-is. + (erc-track-face-priority): Use equal instead of eq. + +2008-01-20 Michael Olson <mwolson@gnu.org> + + * erc-goodies.el (erc-move-to-prompt, erc-move-to-prompt-xemacs): + Fix off-by-one error that caused the point to move when placed at + the beginning of some already-typed text. Thanks to e1f for the + report. + + * erc-dcc.el, erc-xdcc.el: Add simple module definitions. + + * erc.el (erc-modules): Add dcc and xdcc. + +2008-01-19 Michael Olson <mwolson@gnu.org> + + * erc-bbdb.el (erc-bbdb-insinuate-and-show-entry): Work around bug + in XEmacs 21.4 that throws an error when the first argument to + run-at-time is nil. + + * erc-button.el (button): Undo XEmacs-specific change to all ERC + buffers when module is removed. + (erc-button-setup): Rename from erc-button-add-keys, and move + XEmacs-specific stuff here. + + * erc-goodies.el (erc-unmorse): Improve regexp for detecting + morse. Deal with the morse style that has "/ " at the end of + every letter. + (erc-imenu-setup): New function that sets up Imenu support. Add + it instead of a lambda form to erc-mode-hook. + (scrolltobottom): Remove erc-scroll-to-bottom from all ERC buffers + when module is removed. Activate the functionality in all ERC + buffers when the module is activated, rather than leaving it up to + the user. + (move-to-prompt): New module that moves to the ERC prompt if a + user tries to type elsewhere in the buffer, and then inserts their + keystrokes there. This is mostly taken from Johan BockgÃ¥rd's init + file. + (erc-move-to-prompt): New function that implements this. + (erc-move-to-prompt-xemacs): New function that implements this for + XEmacs. + (erc-move-to-prompt-init-xemacs): New function to perform the + extra initialization step needed for XEmacs. + + * erc-page.el, erc-replace.el: Fix header and footer. + + * erc-track.el (erc-track-minor-mode-maybe): Take an optional + buffer arg so that we can put this in erc-connect-pre-hook. If + given this argument, include it in the check to determine whether + to activate erc-track-minor-mode. + (track): Add erc-track-minor-mode-maybe to erc-connect-pre-hook, + so that we can use it as soon as a connection is attempted. + + * erc.el (erc-format-network, erc-format-target-and/or-network): + Use erc-network-name function instead, and check to see whether + that function is bound. This fixes an error in process filter for + people who did not have erc-services or erc-networks loaded. + (erc-modules): Add move-to-prompt module and enable it by + default. Thanks to e1f for the suggestion. + +2008-01-18 Michael Olson <mwolson@gnu.org> + + * Makefile (EXTRAS): Include erc-list-old.el. + + * erc-dcc.el (erc-dcc-verbose): Rename from erc-verbose-dcc. + (erc-pack-int): Rewrite to not depend on a count argument. + (erc-unpack-int): Rewrite to remove 4-character limitation. + (erc-dcc-server): Call set-process-coding-system and + set-process-filter-multibyte so that the contents get sent out + without modification. + (erc-dcc-send-filter): Don't take a substring -- just pass the + whole string to erc-unpack-int. + (erc-dcc-receive-cache): New option that indicates the number of + bytes to let the receive buffer grow before flushing it. + (erc-dcc-file-name): New buffer-local variable to keep track of + the filename of the currently-received file. + (erc-dcc-get-file): Disable undo for a speed increase. Set + erc-dcc-file-name. Truncate the file before writing to it. + (erc-dcc-append-contents): New function to append the contents of + a buffer to a file and then erase the contents of the buffer. + (erc-dcc-get-filter): Flush buffer contents after exceeding + erc-dcc-receive-cache. This allows large files to be downloaded + without storing the whole thing in memory. + (erc-dcc-get-sentinel): Flush any remaining contents before + closing. No need to save buffer. + (erc-dcc-listen-host): New option that determines which IP address + to listen on. + (erc-dcc-public-host): New option that determines which IP address + to advertise when sending a file. This is useful for people who + are on a local subnet. Together, these two options replace + erc-dcc-host. + + * erc.el (erc-mode-line-format): Add %N and %S. %N is the name of + the network, and %S is much like %s but with the network name + trumping the server name. Default to "%S %a". Thanks to e1f for + the suggestion. + (erc-format-network): New function that formats the network name. + (erc-format-target-and/or-network): New function that formats both + the network name and target, falling back on the server name if + the network name is not available. + (erc-update-mode-line-buffer): Add the new format spec items. + +2008-01-17 Michael Olson <mwolson@gnu.org> + + * erc.el (erc-join-buffer): Improve documentation. + (erc-query-display): New option indicating how to display a query + buffer that is made by using the /QUERY command. The default is + to display the query in a new window. + (erc-cmd-QUERY): Use it. Improve docstring. + (erc-auto-query): Default this to 'window-noselect instead, + because I've already seen bug reports about new users thinking + that ERC didn't display their test messages. Improve + customization type. + (erc-notice-face): Make this work with XEmacs. + (erc-join-buffer): Mention 'buffer in docstring. Improve + customization type. + + * erc-dcc.el (erc-dcc-send-sentinel): Better handle case where elt + is nil, in order to avoid an error. Thanks to Brent Goodrick for + the initial patch. + (erc-dcc-display-send): New function split from erc-dcc-send-hook. + (erc-dcc-send-connect-hook): Use it -- we don't like lambda forms + in hooks. + (erc-dcc-send-filter): Display byte count if the client confirmed + too much, and kill the buffer. Otherwise a DoS might be possible + by making Emacs run out of RAM. + + * erc-backend.el (erc-server-connect): Detect early on whether the + connection attempt has failed in order to avoid confusing error + messages. + + * erc-networks.el (erc-server-alist): Add Rizon network. + + * erc-services.el (erc-nickserv-passwords): Add Rizon to options. + (erc-nickserv-alist): Add support for Rizon. + + * erc-track.el (erc-track-find-face): Don't let buttons in notices + trump default text. Use catch/throw. Default to first element of + FACES is nothing is found. + + * erc-xdcc.el: Add local variables for proper indentation setup. + +2008-01-15 Michael Olson <mwolson@gnu.org> + + * erc-backend.el (erc-server-coding-system): Docfix. + (erc-coding-system-for-target): Pass the `target' argument along + as the first and only argument. It's not good to just depend on a + dynamic binding. + +2008-01-10 Michael Olson <mwolson@gnu.org> + + * erc-backend.el (321, 322): Split message-displaying parts into + new functions, which are added to each response's respective + hook. This makes them easier to disable. + + * erc-list.el: New file from Tom Tromey. Use erc-propertize + instead of propertize. Require 'erc. + (list): New module definition. Remove message-displaying + functions for 321 and 322 response handlers when enabling the + module, and restore them when disabling. As a sanity check, + remove the erc-list-handle-322 function when disabling the module. + (erc-list-handle-322): Handle the case where we run the LIST + command, but do not go through the normal steps. + (erc-cmd-LIST): Add docstring. Strip initial space from line if + it is non-nil. Use make-local-variable to silence compiler + warning. Capture current buffer and pass it to + erc-list-install-322-handler. + (erc-list-install-322-handler): Take server-buffer argument, so + that we are certain of being in the right buffer. Use 4th + argument to add-hook, so that erc-server-322-functions is only + modified in one buffer. + + * erc-list-old.el: Renamed from old erc-list.el. + + * erc.el (erc-modules): Add list-old. + (erc-set-topic): Handle case where there are no newlines in the + existing topic, which happens when /LIST is run. + (erc-notice-face): If we have less than 88 colors, make this + blue. Otherwise the text will be pink in a tty, which looks + dreadful. Thanks to e1f for the report. + (erc-remove-parsed-property): New option that determines whether + to remove the erc-parsed property after displaying a message. + This should have the effect of making ERC take up less memory. + (erc-display-line-1): Use it. - * erc-goodies.el (erc-scroll-to-bottom): Use it. This fixes a bug - with buffer ordering where ERC buffers would move to the top. - Thanks to Ivan Kanis for the patch. - -2007-06-10 Michael Olson <mwolson@gnu.org> - - * erc-log.el (erc-logging-enabled): Fix a bug that occurred when - `erc-log-channels-directory' had the name of a function. - -2007-06-06 Juanma Barranquero <lekktu@gmail.com> - - * erc.el (erc-show-channel-key-p, erc-startup-file-list): - Fix typo in docstring. - -2007-06-03 Michael Olson <mwolson@gnu.org> - - * erc-compat.el (erc-view-mode-enter): Make this its own function, - in order to document what we do, and provide sane fallback - behavior. - - * erc.el (erc-toggle-debug-irc-protocol): Don't pass any arguments - to erc-view-mode-enter, since we don't do anything special with - the exit function. This fixes a bug with Emacs 21 and Emacs 22. - Thanks to Leo for noticing. - -2007-05-30 Michael Olson <mwolson@gnu.org> - - * erc-compat.el (erc-user-emacs-directory): New variable that - determines where to find user-specific Emacs settings. For Emacs, - this is usually ~/.emacs.d, and for XEmacs this is usually - ~/.xemacs. - - * erc.el (erc-startup-file-list): Use erc-user-emacs-directory. - -2007-05-28 Michael Olson <mwolson@gnu.org> - - * erc-button.el (erc-button-url-regexp): Recognize parentheses as - part of URLs. Thanks to Lawrence Mitchell for the fix. - -2007-05-26 Michael Olson <mwolson@gnu.org> - - * erc.texi (Modules): Fix references to completion modules. - -2007-05-21 Michael Olson <mwolson@gnu.org> - - * Makefile (SOURCE): Remove erc-pkg.el. - (debclean): New rule to clean old Debian packages of ERC. - (debprepare): Don't modify the released tarball, but copy it as - the .orig.tar.gz file. - (debrelease, debrevision): Remove. - (debinstall): New target that copies the generated Debian file to - a distro-specific location. - (deb): New rule that chains together the stages in building a - Debian package. - (EXTRAS): Add erc-nicklist.el, since it is not release-quality. - (extras): Copy images directory. - - * erc-nicklist.el (erc-nicklist-icons-directory): Use - locate-library to find the "images" directory. This should be - more failsafe. Thanks to Tom Tromey for the idea. - -2007-05-19 Michael Olson <mwolson@gnu.org> - - * Makefile (ELPA): New variable that contains the location of my - local ELPA repository. - (elpa): New rule that makes an ELPA package for ERC. - -2007-04-19 Michael Olson <mwolson@gnu.org> - - * erc.el (erc-parse-prefix): New function that retrieves the - PREFIX server parameter from the current server and returns an - alist of prefix type to prefix character. - (erc-channel-receive-names): Use `erc-parse-prefix' to determine - whether the first character of a nick is a prefix character or - not. This should fix a bug reported by bromine about needing to - type "%" first to complete nicks of people who are "hops" on - Slashnet. This should also support for very exotic IRC server - setups, if any exist. - (erc-update-current-channel-member): Indentation. - -2007-04-15 Michael Olson <mwolson@gnu.org> - - * erc-log.el (erc-generate-log-file-name-function): Docfix. - Mention how to deal with the case for putting log files in - different directories. Change a customization type from `symbol' - to `function'. - (erc-log-channels-directory): Allow this to contain a function - name, which is called with the same args as in - `erc-generate-log-file-name-function'. Thanks to andrewy for the - report and use case. - (erc-current-logfile): Detect if `erc-log-channels-directory' is a - function and call it with arguments if so. - -2007-04-12 Michael Olson <mwolson@gnu.org> - - * erc-backend.el (define-erc-response-handler): Mention that hook - processing stops when the function returns non-nil. This should - help avoid a nasty "gotcha" when making custom functions. Thanks - to John Sullivan for the report. - -2007-04-08 Diane Murray <disumu@x3y2z1.net> - - * erc-nicklist.el (erc-nicklist-voiced-position): Fixed - customization mismatch. - -2007-04-01 Michael Olson <mwolson@gnu.org> - - * erc.el (erc-version-string): Release ERC 5.2. - - * erc-auto.in, erc-chess.el, erc-list.el, erc-speak.el: - * erc-viper.el: Update copyright notices. - - * erc.texi: Make Emacs Lisp source code in this document - essentially public domain. Update version to 5.2. - (Obtaining ERC): Mention extras tarball. - (Releases): Mention local GNU mirror. - (Sample Configuration): Remove notice. - - * FOR-RELEASE (5.3): Add item for erc-nicklist. - Mark NEWS as done. Mark extras tarball as done. - - * Makefile (VERSION): Increment to 5.2. - (TESTING): Remove. - (EXTRAS): New variable containing the contents of our "Emacs 22 - extras" tarball. - (SOURCE): Remove $(TESTING). - (MISC): Add COPYING and ChangeLog.06. Fix ChangeLog.NNNN -> - ChangeLog.NN. - (release): Use $(SNAPDIR) instead of erc-$(VERSION). - (extras): New rule which implements the building of the extras - tarball. - (upload-extras): New rule to upload the extras tarball. It's - yucky to replicate upload, but oh well. - (DISTRIBUTOR): New variable used to differentiate between building - packages for Ubuntu and Debian. - (debrelease, debrevision): Use it. - (debbuild): Run linda in addition to lintian. - - * NEWS: Mention extras tarball. Note which files have been - renamed. Note that erc-list is enabled by default, except in - Emacs 22. - - * README.extras: New file which serves as a README for the extras - tarball. - -2007-03-31 Michael Olson <mwolson@gnu.org> - - * NEWS: Update for the 5.2 release. - - * FOR-RELEASE: Finish up 5.2 manual item. Add documentation item - for 5.3. - - * erc.texi (Sample Session): Flesh out. Mention #erc. - (Modules): Defer to 5.3 release. - (Advanced Usage): Move Sample Configuration chapter ahead of - unfinished chapters. - (Sample Configuration): Write. - (Options): Mention how to see available ERC options. Defer to 5.3 - release. - (Tips and Tricks): Remove, since it seems better to just include - tips and tricks in the sample configuration, commented out. - - * erc-bbdb.el (erc-bbdb-search-name-and-create): Make prompt more - informative about how to skip merging. - (erc-bbdb-insinuate-and-show-entry-1): Move contents of - erc-bbdb-insinuate-and-show-entry here. - (erc-bbdb-insinuate-and-show-entry): Run - erc-bbdb-insinuate-and-show-entry-1 "outside" of the calling - function, so that we can avoid triggering a process-filter error - if the user hits C-g. - -2007-03-30 Michael Olson <mwolson@gnu.org> - - * FOR-RELEASE: Solve C-c C-SPC keybinding dilemma. - - * erc-autoaway.el (erc-autoaway-idle-method): Use `if' rather than - `cond' and `set' rather than `set-default'. - - * erc-log.el: Avoid compiler warning by requiring erc-network - during compilation. - (erc-generate-log-file-name-function): Add tag to each option. - Add erc-generate-log-file-name-network. - (erc-generate-log-file-name-network): New function which generates - a log file name that uses network name rather than server name, - when possible. - - * erc-track.el (track): Assimilate track-when-inactive module, - since there's no need to have two modules in one file -- an option - will do. Remove track-modified-channels alias. Call - erc-track-minor-mode-maybe, and tear down the minor mode when - disabling. - (erc-track-when-inactive): New option which determines whether to - track visible buffers when inactive. The default is not to do so. - (erc-track-visibility): Mention erc-track-when-inactive. - (erc-buffer-visible): Use erc-track-when-inactive. - (erc-track-enable-keybindings): New option which determines - whether to enable the global-level tracking keybindings. The - default is to do so, unless they would override another binding, - in which case we prompt the user about it. - (erc-track-minor-mode-map): Move global keybindings here. - (erc-track-minor-mode): New minor mode which only enables the - keybindings and does nothing else. - (erc-track-minor-mode-maybe): New function which starts - erc-track-minor-mode, but only if it hasn't already been started, - an ERC buffer exists, and the user OK's it, depending on the value - of `erc-track-enable-keybindings'. - (erc-track-switch-buffer): Display a message if someone calls this - without first enabling erc-track-mode. - -2007-03-17 Michael Olson <mwolson@gnu.org> - - * erc.texi (Development): Mention ErcDevelopment page on - emacswiki. - (Getting Started): Mention ~/.emacs.d/.ercrc.el and the Customize - interface. - (Sample Session): New section that has a very rough draft for a - sample ERC session. - (Special Features): New section that explains some of the special - features of ERC. Taken from ErcFeatures on emacswiki, with - enhancements. - -2007-03-12 Diane Murray <disumu@x3y2z1.net> - - * erc-autoaway.el (erc-autoaway-idle-method): When setting the new - value, disable and re-enable `erc-autoaway-mode' only if it was - already enabled. This fixes a bug where autoaway was enabled just - by loading the file. - -2007-03-10 Diane Murray <disumu@x3y2z1.net> - - * erc-capab.el: Added more information to the Usage section. - (erc-capab-identify-prefix): Doc fix. - (erc-capab-identify-unidentified): New face. - (290): Removed. Definition moved to erc-backend.el. - (erc-capab-identify-send-messages): Renamed from - `erc-capab-send-identify-messages'. - (erc-capab-identify-setup): Use it. - (erc-capab-identify-get-unidentified-nickname): Renamed from - `erc-capab-get-unidentified-nickname'. - (erc-capab-identify-add-prefix): Use it. Use - `erc-capab-identify-unidentified' as the face. - - * erc-backend.el (290): Moved here from erc-capab.el. - - * erc.el (erc-select): Added an autoload cookie. - (erc-message-type-member, erc-restore-text-properties): Use - `erc-get-parsed-vector'. - (erc-auto-query): Set the default to 'bury since many new users - expect private messages from others to be in dedicated query - buffers, not the server buffer. - (erc-common-server-suffixes): Use "freenode" for freenode.net, not - "OPN". Added oftc.net. - - * NEWS: Added note about erc-auto-query's new default setting. - -2007-03-03 Michael Olson <mwolson@gnu.org> - - * erc.el (erc-open, erc): Docfixes. - -2007-03-02 Michael Olson <mwolson@gnu.org> - - * FOR-RELEASE: Make section for 5.3 release and move erc-backend - cleanup there. Awaiting discussion before doing other things. - Add tasks for merging filename changes from the 5.2 release - branch, and for making a tarball of modules not in Emacs 22. Add - item to remind me to update NEWS. Mark backtab entry as done. - - * erc-button.el (button): Add call to `erc-button-add-keys'. - (erc-button-keys-added): New variable tracking whether we've added - the keys yet. - (erc-button-add-keys): New function that adds the <backtab> key to - erc-mode-map. - - * erc.texi: Change version to 5.2 (pre-release). - -2007-02-15 Michael Olson <mwolson@gnu.org> - - * CREDITS: Update. - - * erc-backend.el (erc-server-send-ping-interval): Change to use a - default of 30 seconds. Improve customize interface. - (erc-server-send-ping-timeout): New option that determines when to - consider a connection stalled and restart it. The default is - after 120 seconds. - (erc-server-send-ping): Use erc-server-send-ping-timeout instead - of erc-server-send-ping-interval. If - erc-server-send-ping-timeout is nil, do not ever kill and restart - a hung IRC process. - - * erc.el (erc-modules): Include the name of the module in its - description. This should make it easier for people to find and - enable a particular module. - -2007-02-15 Vivek Dasmohapatra <vivek@etla.org> - - * erc.el (erc-cmd-RECONNECT): Kill old process if it is still - alive. - (erc-message-english-PART): Properly escape "%" characters in - reason. - - * erc-backend.el (erc-server-reconnecting): New variable that is - set when the user requests a reconnect, but the old process is - still alive. This forces the reconnect to work even though the - process is killed manually during reconnect. - (erc-server-connect): Initialize it. - (erc-server-reconnect-p): Use it. - (erc-process-sentinel-1): Set it to nil after the first reconnect - attempt. - -2007-02-07 Diane Murray <disumu@x3y2z1.net> - - * erc-menu.el (erc-menu-definition): Fixed so that the separator - is between "Current channel" and "Pals, fools and other keywords", - not at the bottom of the "Current channel" submenu. - -2007-01-25 Diane Murray <disumu@x3y2z1.net> - - * erc-networks.el (erc-server-alist): Removed SSL server for now - since `erc-server-select' doesn't know to use `erc-ssl'. - - * erc-networks.el (erc-server-alist, erc-networks-alist): Added - definitions for oftc.net. - - * erc-services.el (erc-nickserv-alist): Fixed OFTC message regexp. - -2007-01-22 Michael Olson <mwolson@gnu.org> - - * erc-backend.el (erc-server-error-occurred): New variable that - indicates when an error has been signaled by the server. This - should fix an infinite reconnect bug when giving some servers a - bogus :full-name. Thanks to Angelina Carlton for the report. - (erc-server-connect): Initialize erc-server-error-occurred. - (erc-server-reconnect-p): Use it. - (ERROR): Set it. - - * erc-services.el (erc-nickserv-alist): Alphabetize and add Ars - and QuakeNet. Standardize look of entries. Fix type mismatch - error in customize interface. - (erc-nickserv-passwords): Alphabetize and add missing entries from - erc-nickserv-alist. - -2007-01-21 Michael Olson <mwolson@gnu.org> - - * erc.el (erc-header-line-format): Document how to disable the - header line, and add a customization type for it. Also, make the - changes take effect immediately. - -2007-01-19 Michael Olson <mwolson@gnu.org> - - * erc.texi (Modules): Document new menu module. Thanks to Leo - for noticing. - -2007-01-16 Diane Murray <disumu@x3y2z1.net> - - * erc-stamp.el (erc-insert-timestamp-left): Fixed so that the - whitespace string filler is hidden correctly when timestamps are - hidden. - (erc-toggle-timestamps): New function to use instead of - `erc-show-timestamps' and `erc-hide-timestamps'. - - * erc.el (erc-restore-text-properties): Moved here from - erc-fill.el since it could be useful in general. - - * erc-fill.el (erc-restore-text-properties): Removed. - -2007-01-13 Michael Olson <mwolson@gnu.org> - - * erc.el (erc-command-regexp): New variable that is used to match - a command. - (erc-send-input): Use it. This fixes a bug where paths -- - "/usr/bin/foo", for example -- were being displayed as commands, - but still sent correctly. - (erc-extract-command-from-line): Use it. - - * erc.texi (Modules): Document erc-capab-identify. - -2007-01-11 Diane Murray <disumu@x3y2z1.net> - - * erc.el (erc-find-parsed-property): Moved here from erc-track.el - since it can be useful in general. - - * erc-track.el (erc-find-parsed-property): Removed. - - * erc-capab.el (erc-capab-find-parsed): Removed. - (erc-capab-identify-add-prefix): Use `erc-find-parsed-property'. - - * erc.el (erc-open): Run `erc-before-connect' hook here. This - makes sure the hook always gets called before a connection is - made, as some functions, like `erc-handle-irc-url', use `erc-open' - instead of `erc'. - (erc): Removed `erc-before-connect' hook. - - * erc-menu.el (erc-menu-definition): Put items specific to - channels in a "Current channel" submenu. - - * erc-backend.el (321, 323): Display channel list in server buffer - when not using the channel list module. - - * erc.el: Updated copyright years. - (erc-version-string): Set to 5.2 (devel). - (erc-format-lag-time): Fixed to work when `erc-server-lag' is nil. - (erc-update-mode-line-buffer): Set the header face. - -2007-01-11 Michael Olson <mwolson@gnu.org> - - * erc-bbdb.el (erc-bbdb-popup-type): Fix customization type and - documentation. - - * erc-services.el (erc-nickserv-identify-mode): Improve - documentation for nick-change option and move higher to fix - compiler warning. Avoid a recursive load error. - (erc-nickserv-alist): Add simple entry for BitlBee, to avoid - "NickServ is AWAY: User is offline" error. Oddly enough, bitlbee - was smart enough to recognize that as an authentication request - and log in regardless, which is why I didn't notice this earlier. - (erc-nickserv-alist-sender, erc-nickserv-alist-regexp) - (erc-nickserv-alist-nickserv, erc-nickserv-alist-ident-keyword) - (erc-nickserv-alist-use-nick-p) - (erc-nickserv-alist-ident-command): New accessors for - erc-nickserv-alist. Using nth is unwieldy. - (erc-nickserv-identify-autodetect) - (erc-nickserv-identify-on-connect) - (erc-nickserv-identify-on-nick-change, erc-nickserv-identify): Use - the new accessors. - -2007-01-11 Diane Murray <disumu@x3y2z1.net> - - * NEWS: Added note for `erc-my-nick-face'. Fixed capab-identify - wording. - -2007-01-10 Diane Murray <disumu@x3y2z1.net> - - * erc.el (erc-mode-line-format): Added %l to documentation. - (erc-header-line-format): Removed "[IRC]". Use the new %l - replacement character. Doc fix. - (erc-format-channel-modes): Removed lag code. Removed parentheses - from mode string. - (erc-format-lag-time): New function. - (erc-update-mode-line-buffer): Use it. - -2007-01-10 Michael Olson <mwolson@gnu.org> - - * erc.el: Fix typo in url-irc-function instructions. - -2007-01-09 Michael Olson <mwolson@gnu.org> - - * erc.el (erc-system-name): New option that determines the system - name to use when logging in. The default is to figure this out by - calling `system-name'. - (erc-login): Use it. - -2007-01-07 Michael Olson <mwolson@gnu.org> - - * erc.el (erc-modules): Add the menu module. This should fix a - bug with incorrect ERC submenus being displayed. +2008-01-04 Stefan Monnier <monnier@iro.umontreal.ca> - * erc-menu.el: Turn this into a module. - (erc-menu-add, erc-menu-remove): New functions that add and remove - the ERC menu. + * erc-ibuffer.el (erc-channel-modes): + Pass mode-name through format-mode-line -See ChangeLog.06 for earlier changes. +See ChangeLog.07 for earlier changes. - Copyright (C) 2007, 2008 Free Software Foundation, Inc. + Copyright (C) 2008 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -846,4 +306,4 @@ See ChangeLog.06 for earlier changes. ;; add-log-time-zone-rule: t ;; End: -;; arch-tag: 3369b6e5-96b1-4b32-96cd-9a905c747496 +;; 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 @@ +2007-12-16 Diane Murray <disumu@x3y2z1.net> + + * erc-services.el (erc-nickserv-alist): Removed autodetect regexp, + added identified regexp for OFTC. + (erc-nickserv-identification-autodetect): Make sure success-regex + is non-nil. + (erc-nickserv-identify-autodetect): Make sure identify-regex is + non-nil. Doc fix. + +2007-12-13 Diane Murray <disumu@x3y2z1.net> + + * erc-backend.el (PRIVMSG, QUIT, TOPIC, WALLOPS, 376, 004, 221) + (312, 315, 319, 330, 331, 333, 367, 368, 391, 405, 406, 412) + (421, 432, 433, 437, 442, 461, 474, 477, 482, 431): Doc fix. + +2007-12-09 Michael Olson <mwolson@gnu.org> + + * erc-services.el (erc-nickserv-alist): Fix regexps for GRnet. + +2007-12-09 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change) + + * erc-backend.el, erc.el: + Parse 275 (secure connection) responses. + + * erc-services.el: Add identification hooks for GRnet, the Greek + IRC network <http://www.irc.gr>. + +2007-12-08 David Kastrup <dak@gnu.org> + + * erc-stamp.el (erc-echo-timestamp): + * erc-lang.el (language): + * erc-backend.el (erc-server-connect): Fix buggy call to `message'. + +2007-12-07 Edward O'Connor <ted@oconnor.cx> + + * erc-services.el: Provide a hook that runs when nickserv confirms + that the user has successfully identified. + (services, erc-nickserv-identify-mode): Add and remove + erc-nickserv-identification-autodetect from + erc-server-NOTICE-functions. + (erc-nickserv-alist): Add SUCCESS-REGEXP to each entry. + (erc-nickserv-alist-identified-regexp) + (erc-nickserv-identification-autodetect): New functions. + (erc-nickserv-identified-hook): New hook. + +2007-12-06 D. Goel <deego3@gmail.com> + + * erc-match.el (erc-add-entry-to-list): Fix buggy call to `error'. + +2007-12-01 Glenn Morris <rgm@gnu.org> + + * erc-backend.el (erc-server-send-ping): Move after definition of + erc-server-send. + +2007-11-29 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change) + + * erc-backend.el, erc.el: + Parse 307 (nick has identified) responses. + +2007-11-15 Juanma Barranquero <lekktu@gmail.com> + + * erc.el (erc-open): + * erc-backend.el (define-erc-response-handler): + * erc-log.el (log): + * erc-match.el (erc-log-matches): Fix typos in docstrings. + +2007-11-11 Michael Olson <mwolson@gnu.org> + + * erc-autoaway.el (erc-autoaway-possibly-set-away): + * erc-netsplit.el (erc-netsplit-timer): + * erc-notify.el (erc-notify-timer): + * erc-track.el (erc-user-is-active): Only run if we have + successfully established a connection to the server and have + logged in. I suspect that sending messages too soon may make some + IRC servers not respond well, particularly when the network + connection is iffy or subject to traffic-shaping. + +2007-11-01 Michael Olson <mwolson@gnu.org> + + * erc-compat.el (erc-set-write-file-functions): New compatibility + function to set the write hooks appropriately. + + * erc-log.el (erc-log-setup-logging): Use + erc-set-write-file-functions. This fixes a byte-compiler warning. + + * erc-stamp.el: Silence byte-compiler warning about + erc-fill-column. + + * erc.el (erc-with-all-buffers-of-server): Bind the result of + mapcar to a variable in order to silence a byte-compiler warning. + +2007-10-29 Michael Olson <mwolson@gnu.org> + + * erc-ibuffer.el (erc-modified-channels-alist): Use + eval-when-compile, and explain why we are doing this. + +2007-10-25 Dan Nicolaescu <dann@ics.uci.edu> + + * erc-ibuffer.el (erc-modified-channels-alist): Pacify + byte-compiler. + +2007-10-13 Glenn Morris <rgm@gnu.org> + + * erc-track.el (erc-modified-channels-update): Use mapc rather + than mapcar. + +2007-10-12 Diane Murray <disumu@x3y2z1.net> + + * erc.el (erc-join-channel): Prompt for channel key if C-u or + another prefix-arg was typed. + + * NEWS: Noted this change. + +2007-10-07 Michael Olson <mwolson@gnu.org> + + * erc.el (erc-cmd-ME'S): New command that handles the case where + someone types "/me's". It concatenates the text " 's" to the + beginning of the input and then sends the result like a normal + "/me" command. + (erc-command-regexp): Permit single-quote character. + +2007-09-30 Aidan Kehoe <kehoea@parhasard.net> (tiny change) + + * erc-log.el (erc-save-buffer-in-logs): Prevent spurious warnings + when looking at a log file and concurrently saving to it. + +2007-09-18 Exal de Jesus Garcia Carrillo <exal@gnu.org> (tiny change) + + * erc.texi (Special-Features): Fix small typo. + +2007-09-16 Michael Olson <mwolson@gnu.org> + + * erc-track.el (erc-track-switch-direction): Mention + erc-track-faces-priority-list. Thanks to Leo for the suggestion. + +2007-09-11 Exal de Jesus Garcia Carrillo <exal@gnu.org> (tiny change) + + * erc-sound.el: Fix typo in setting up instructions. + +2007-09-10 Michael Olson <mwolson@gnu.org> + + * Makefile (elpa): Copy dir template rather than echoing a few + lines. The reason for this is that the ELPA package for ERC was + getting a corrupt dir entry. + + * dir-template: Template for the ELPA dir file. + +2007-09-08 Michael Olson <mwolson@gnu.org> + + * erc-log.el (erc-log-filter-function): New option that specifies + the function to call for filtering text before writing it to a log + file. Thanks to David O'Toole for the suggestion. + (erc-save-buffer-in-logs): Use erc-log-filter-function. Make sure + we carry along the value of coding-system-for-write, because this + could potentially be shadowed by the temporary buffer. + + * erc.el (erc-version-string): Update to 5.3, development version. + +2007-09-07 Glenn Morris <rgm@gnu.org> + + * erc.el (erc-toggle-debug-irc-protocol): Fix call to + erc-view-mode-enter. + +2007-08-08 Glenn Morris <rgm@gnu.org> + + * erc-log.el, erc.el: Replace `iff' in doc-strings and comments. + +2007-09-03 Michael Olson <mwolson@gnu.org> + + * erc.el (erc-default-port): Make this an integer value rather + than a string. Thanks to Luca Capello for the report. + +2007-08-27 Michael Olson <mwolson@gnu.org> + + * erc.el (erc-cmd-GQUIT): If erc-kill-queries-on-quit is non-nil, + kill all query buffers after 4 seconds. + +2007-08-16 Michael Olson <mwolson@gnu.org> + + * NEWS: Add ERC 5.3 changes section, and mention jbms' erc-track + compatibility note. + + * erc-track.el (erc-track-list-changed-hook): Turn this into a + customizable option. + (erc-track-switch-direction): Add 'importance option. + (erc-modified-channels-display): If erc-track-switch-direction is + 'importance, call erc-track-sort-by-importance. + (erc-track-face-priority): New function that returns a number + indicating the position of a face in erc-track-faces-priority-list. + (erc-track-sort-by-importance): New function that sorts + erc-modified-channels-list according to erc-track-face-priority. + (erc-track-get-active-buffer): Make 'oldest a rough opposite of + 'importance. + +2007-08-14 Jeremy Maitin-Shepard <jbms@cmu.edu> + + * erc-track.el (erc-track-remove-disconnected-buffers): New + variable which controls whether buffers associated with a server + that is disconnected should be removed from + `erc-modified-channels-alist'. Existing behavior is to + unconditionally remove such buffers, which is achieved by setting + `erc-track-removed-disconnected-buffers' to t. When set to t, + which is the new default value, such buffers remain in the list, + which I think is often the desired behavior, since the user may + likely wish to find out about activity that occurred in a channel + prior to it being disconnected. + (erc-track-list-changed-hook): New hook that is run whenever the + contents of `erc-modified-channels-alist' changes; it is useful + for users such as myself that don't use the default mode-line + notification but instead use a separate mechanism (which is tied + to my window manager) to provide notification of channel activity. + (erc-track-get-buffer-window): New function that acts as a wrapper + around `get-buffer-window' that handles the `selected-visible' + option of `erc-track-visibility'; previously, the value of + `erc-track-visibility' was passed directly to `get-buffer-window', + which does not support `selected-visible'; consequently, + `selected-visible' was not properly supported. + (erc-track-modified-channels): Fix a bug in the logic for removing + buffers from the list in certain cases. + (erc-track-position-in-mode-line): Add a supported value that + specifies that the tracking information should not be added to the + mode line at all. The value of nil is used to indicate that the + information should not be added at all to the mode line. + (erc-track-add-to-mode-line): Check for position eq to t, rather + than non-nil. + (erc-buffer-visible): Use erc-track-get-buffer-window. + (erc-modified-channels-update): Take + erc-track-remove-disconnected-buffers into account. + (erc-modified-channels-display): Run `erc-track-list-changed-hook'. + + * erc.el (erc-reuse-frames): New option that determines whether + new frames are always created. Defaults to t. This only has an + effect when erc-join-buffer is set to 'frame. + (erc-setup-buffer): Use it. + +2007-08-14 Michael Olson <mwolson@gnu.org> + + * erc-backend.el (erc-server-reconnect): If the server buffer has + been killed, use the current buffer instead. If the current + buffer is not an ERC buffer, give an error. This fixes a bug when + /reconnect is run from a channel buffer whose server buffer has + been deleted. Thanks to jbms for the report. + (erc-process-sentinel-1): Take server buffer as an argument, so + that we can make sure that it is current. + (erc-process-sentinel): Pass buffer to erc-process-sentinel-1. + (erc-process-sentinel-2): New function split from + erc-process-sentinel-1. If server buffer is deleted during a + reconnect attempt, stop trying to reconnect. Fix bug where + reconnect was not happening when erc-server-reconnect-attempts was + t. Call erc-server-reconnect-p only once each time. If we are + instructed to try connecting indefinitely, tell the user that they + can stop this by killing the server buffer. Call the process + sentinel by means of run-at-time, so that there is time to kill + the buffer if need be; this also removes the need for a while + loop. Refuse to reconnect again if erc-server-reconnect-timeout + is not an number. + + * erc.el (erc-command-no-process-p): Fix bug: the return value of + erc-extract-command-from-line is a list rather than a single + symbol. Thanks to jbms for the report. + (erc-cmd-RECONNECT): Use simpler logic, and use buffer-live-p + rather than bufferp. + (erc-send-current-line, erc-display-command, erc-display-msg): + Handle case where erc-server-process is nil, so that /reconnect + works. + +2007-08-12 Michael Olson <mwolson@gnu.org> + + * erc-identd.el (erc-identd-filter): Instead of sending an EOF + character, which now confuses freenode, stop the server process, + so that no new connections are accepted, and kill the current + client process. + +2007-07-29 Michael Olson <mwolson@gnu.org> + + * erc-list.el: Relicense to GPLv3. Since the file was already + licensed under version 2 or later, it turns out that we do not + need the permission of all of the authors in order to proceed. + +2007-07-13 Michael Olson <mwolson@gnu.org> + + * erc-goodies.el (erc-get-bg-color-face, erc-get-fg-color-face): + Use erc-error rather than message and beep. + + * erc-sound.el: Indentation fix. + + * erc.el (erc-command-no-process-p): New function that determines + if its argument is an ERC command that can be run when the server + process is not alive. + (erc-cmd-SET, erc-cmd-CLEAR, erc-cmd-COUNTRY, erc-cmd-HELP) + (erc-cmd-LASTLOG, erc-cmd-QUIT, erc-cmd-GQUIT) + (erc-cmd-RECONNECT, erc-cmd-SERVER): Denote that these commands + can be run even when the server process is not alive. + (erc-send-current-line): Call erc-command-no-process-p if the + server process is not alive, to determine if we have a command + that can be run anyway. Thanks to Tom Tromey for the bug report. + (erc-error): New function that either displays a message or throws + an error, depending on whether debug-on-error is non-nil. + (erc-cmd-SERVER, erc-send-current-line): Use it. + +2007-07-10 Michael Olson <mwolson@gnu.org> + + * Relicense all FSF-assigned code to GPLv3. + +2007-06-25 Michael Olson <mwolson@gnu.org> + + * erc.texi (Options): Fix typo. + (Getting Help and Reporting Bugs): Update webpage URL. Make Gmane + part more readable. + +2007-06-20 Michael Olson <mwolson@gnu.org> + + * erc-stamp.el (erc-timestamp-format-left): New option that + specifies the left timestamp to use for + erc-insert-timestamp-left-and-right. + (erc-timestamp-format-right): New option that specifies the right + timestamp to use for erc-insert-timestamp-left-and-right. + (erc-insert-timestamp-function): Change default to + erc-insert-timestamp-left-and-right. + (erc-insert-away-timestamp-function): Ditto. + (erc-timestamp-last-inserted-left) + (erc-timestamp-last-inserted-right): New variables to keep track + of data for erc-insert-timestamp-left-and-right. + (erc-insert-timestamp-left-and-right): New function that places + timestamps on both the left and right sides of the screen, but + only if each timestamp has changed since it was last computed. + Thanks to offby1 for urging me to merge this. + + * erc.el (erc-open-ssl-stream): Display informative error when + ssl.el not found. + (erc-tls): New function to connect using tls.el. + (erc-open-tls-stream): New function to initiate tls connection. + Display informative error when tls.el not found. + +2007-06-19 Michael Olson <mwolson@gnu.org> + + * erc-log.el: Update header with accurate instructions. + +2007-06-17 Michael Olson <mwolson@gnu.org> + + * erc-pkg.el: Update description to match what is currently in ELPA. + +2007-06-14 Juanma Barranquero <lekktu@gmail.com> + + * erc-goodies.el (erc-scroll-to-bottom): Remove redundant check. + +2007-06-13 Michael Olson <mwolson@gnu.org> + + * erc-compat.el (erc-with-selected-window): New compatibility + macro that implements `with-selected-window'. + + * erc-goodies.el (erc-scroll-to-bottom): Use it. This fixes a bug + with buffer ordering where ERC buffers would move to the top. + Thanks to Ivan Kanis for the patch. + +2007-06-10 Michael Olson <mwolson@gnu.org> + + * erc-log.el (erc-logging-enabled): Fix a bug that occurred when + `erc-log-channels-directory' had the name of a function. + +2007-06-06 Juanma Barranquero <lekktu@gmail.com> + + * erc.el (erc-show-channel-key-p, erc-startup-file-list): + Fix typo in docstring. + +2007-06-03 Michael Olson <mwolson@gnu.org> + + * erc-compat.el (erc-view-mode-enter): Make this its own function, + in order to document what we do, and provide sane fallback + behavior. + + * erc.el (erc-toggle-debug-irc-protocol): Don't pass any arguments + to erc-view-mode-enter, since we don't do anything special with + the exit function. This fixes a bug with Emacs 21 and Emacs 22. + Thanks to Leo for noticing. + +2007-05-30 Michael Olson <mwolson@gnu.org> + + * erc-compat.el (erc-user-emacs-directory): New variable that + determines where to find user-specific Emacs settings. For Emacs, + this is usually ~/.emacs.d, and for XEmacs this is usually + ~/.xemacs. + + * erc.el (erc-startup-file-list): Use erc-user-emacs-directory. + +2007-05-28 Michael Olson <mwolson@gnu.org> + + * erc-button.el (erc-button-url-regexp): Recognize parentheses as + part of URLs. Thanks to Lawrence Mitchell for the fix. + +2007-05-26 Michael Olson <mwolson@gnu.org> + + * erc.texi (Modules): Fix references to completion modules. + +2007-05-21 Michael Olson <mwolson@gnu.org> + + * Makefile (SOURCE): Remove erc-pkg.el. + (debclean): New rule to clean old Debian packages of ERC. + (debprepare): Don't modify the released tarball, but copy it as + the .orig.tar.gz file. + (debrelease, debrevision): Remove. + (debinstall): New target that copies the generated Debian file to + a distro-specific location. + (deb): New rule that chains together the stages in building a + Debian package. + (EXTRAS): Add erc-nicklist.el, since it is not release-quality. + (extras): Copy images directory. + + * erc-nicklist.el (erc-nicklist-icons-directory): Use + locate-library to find the "images" directory. This should be + more failsafe. Thanks to Tom Tromey for the idea. + +2007-05-19 Michael Olson <mwolson@gnu.org> + + * Makefile (ELPA): New variable that contains the location of my + local ELPA repository. + (elpa): New rule that makes an ELPA package for ERC. + +2007-04-19 Michael Olson <mwolson@gnu.org> + + * erc.el (erc-parse-prefix): New function that retrieves the + PREFIX server parameter from the current server and returns an + alist of prefix type to prefix character. + (erc-channel-receive-names): Use `erc-parse-prefix' to determine + whether the first character of a nick is a prefix character or + not. This should fix a bug reported by bromine about needing to + type "%" first to complete nicks of people who are "hops" on + Slashnet. This should also support for very exotic IRC server + setups, if any exist. + (erc-update-current-channel-member): Indentation. + +2007-04-15 Michael Olson <mwolson@gnu.org> + + * erc-log.el (erc-generate-log-file-name-function): Docfix. + Mention how to deal with the case for putting log files in + different directories. Change a customization type from `symbol' + to `function'. + (erc-log-channels-directory): Allow this to contain a function + name, which is called with the same args as in + `erc-generate-log-file-name-function'. Thanks to andrewy for the + report and use case. + (erc-current-logfile): Detect if `erc-log-channels-directory' is a + function and call it with arguments if so. + +2007-04-12 Michael Olson <mwolson@gnu.org> + + * erc-backend.el (define-erc-response-handler): Mention that hook + processing stops when the function returns non-nil. This should + help avoid a nasty "gotcha" when making custom functions. Thanks + to John Sullivan for the report. + +2007-04-08 Diane Murray <disumu@x3y2z1.net> + + * erc-nicklist.el (erc-nicklist-voiced-position): Fixed + customization mismatch. + +2007-04-01 Michael Olson <mwolson@gnu.org> + + * erc.el (erc-version-string): Release ERC 5.2. + + * erc-auto.in, erc-chess.el, erc-list.el, erc-speak.el: + * erc-viper.el: Update copyright notices. + + * erc.texi: Make Emacs Lisp source code in this document + essentially public domain. Update version to 5.2. + (Obtaining ERC): Mention extras tarball. + (Releases): Mention local GNU mirror. + (Sample Configuration): Remove notice. + + * FOR-RELEASE (5.3): Add item for erc-nicklist. + Mark NEWS as done. Mark extras tarball as done. + + * Makefile (VERSION): Increment to 5.2. + (TESTING): Remove. + (EXTRAS): New variable containing the contents of our "Emacs 22 + extras" tarball. + (SOURCE): Remove $(TESTING). + (MISC): Add COPYING and ChangeLog.06. Fix ChangeLog.NNNN -> + ChangeLog.NN. + (release): Use $(SNAPDIR) instead of erc-$(VERSION). + (extras): New rule which implements the building of the extras + tarball. + (upload-extras): New rule to upload the extras tarball. It's + yucky to replicate upload, but oh well. + (DISTRIBUTOR): New variable used to differentiate between building + packages for Ubuntu and Debian. + (debrelease, debrevision): Use it. + (debbuild): Run linda in addition to lintian. + + * NEWS: Mention extras tarball. Note which files have been + renamed. Note that erc-list is enabled by default, except in + Emacs 22. + + * README.extras: New file which serves as a README for the extras + tarball. + +2007-03-31 Michael Olson <mwolson@gnu.org> + + * NEWS: Update for the 5.2 release. + + * FOR-RELEASE: Finish up 5.2 manual item. Add documentation item + for 5.3. + + * erc.texi (Sample Session): Flesh out. Mention #erc. + (Modules): Defer to 5.3 release. + (Advanced Usage): Move Sample Configuration chapter ahead of + unfinished chapters. + (Sample Configuration): Write. + (Options): Mention how to see available ERC options. Defer to 5.3 + release. + (Tips and Tricks): Remove, since it seems better to just include + tips and tricks in the sample configuration, commented out. + + * erc-bbdb.el (erc-bbdb-search-name-and-create): Make prompt more + informative about how to skip merging. + (erc-bbdb-insinuate-and-show-entry-1): Move contents of + erc-bbdb-insinuate-and-show-entry here. + (erc-bbdb-insinuate-and-show-entry): Run + erc-bbdb-insinuate-and-show-entry-1 "outside" of the calling + function, so that we can avoid triggering a process-filter error + if the user hits C-g. + +2007-03-30 Michael Olson <mwolson@gnu.org> + + * FOR-RELEASE: Solve C-c C-SPC keybinding dilemma. + + * erc-autoaway.el (erc-autoaway-idle-method): Use `if' rather than + `cond' and `set' rather than `set-default'. + + * erc-log.el: Avoid compiler warning by requiring erc-network + during compilation. + (erc-generate-log-file-name-function): Add tag to each option. + Add erc-generate-log-file-name-network. + (erc-generate-log-file-name-network): New function which generates + a log file name that uses network name rather than server name, + when possible. + + * erc-track.el (track): Assimilate track-when-inactive module, + since there's no need to have two modules in one file -- an option + will do. Remove track-modified-channels alias. Call + erc-track-minor-mode-maybe, and tear down the minor mode when + disabling. + (erc-track-when-inactive): New option which determines whether to + track visible buffers when inactive. The default is not to do so. + (erc-track-visibility): Mention erc-track-when-inactive. + (erc-buffer-visible): Use erc-track-when-inactive. + (erc-track-enable-keybindings): New option which determines + whether to enable the global-level tracking keybindings. The + default is to do so, unless they would override another binding, + in which case we prompt the user about it. + (erc-track-minor-mode-map): Move global keybindings here. + (erc-track-minor-mode): New minor mode which only enables the + keybindings and does nothing else. + (erc-track-minor-mode-maybe): New function which starts + erc-track-minor-mode, but only if it hasn't already been started, + an ERC buffer exists, and the user OK's it, depending on the value + of `erc-track-enable-keybindings'. + (erc-track-switch-buffer): Display a message if someone calls this + without first enabling erc-track-mode. + +2007-03-17 Michael Olson <mwolson@gnu.org> + + * erc.texi (Development): Mention ErcDevelopment page on + emacswiki. + (Getting Started): Mention ~/.emacs.d/.ercrc.el and the Customize + interface. + (Sample Session): New section that has a very rough draft for a + sample ERC session. + (Special Features): New section that explains some of the special + features of ERC. Taken from ErcFeatures on emacswiki, with + enhancements. + +2007-03-12 Diane Murray <disumu@x3y2z1.net> + + * erc-autoaway.el (erc-autoaway-idle-method): When setting the new + value, disable and re-enable `erc-autoaway-mode' only if it was + already enabled. This fixes a bug where autoaway was enabled just + by loading the file. + +2007-03-10 Diane Murray <disumu@x3y2z1.net> + + * erc-capab.el: Added more information to the Usage section. + (erc-capab-identify-prefix): Doc fix. + (erc-capab-identify-unidentified): New face. + (290): Removed. Definition moved to erc-backend.el. + (erc-capab-identify-send-messages): Renamed from + `erc-capab-send-identify-messages'. + (erc-capab-identify-setup): Use it. + (erc-capab-identify-get-unidentified-nickname): Renamed from + `erc-capab-get-unidentified-nickname'. + (erc-capab-identify-add-prefix): Use it. Use + `erc-capab-identify-unidentified' as the face. + + * erc-backend.el (290): Moved here from erc-capab.el. + + * erc.el (erc-select): Added an autoload cookie. + (erc-message-type-member, erc-restore-text-properties): Use + `erc-get-parsed-vector'. + (erc-auto-query): Set the default to 'bury since many new users + expect private messages from others to be in dedicated query + buffers, not the server buffer. + (erc-common-server-suffixes): Use "freenode" for freenode.net, not + "OPN". Added oftc.net. + + * NEWS: Added note about erc-auto-query's new default setting. + +2007-03-03 Michael Olson <mwolson@gnu.org> + + * erc.el (erc-open, erc): Docfixes. + +2007-03-02 Michael Olson <mwolson@gnu.org> + + * FOR-RELEASE: Make section for 5.3 release and move erc-backend + cleanup there. Awaiting discussion before doing other things. + Add tasks for merging filename changes from the 5.2 release + branch, and for making a tarball of modules not in Emacs 22. Add + item to remind me to update NEWS. Mark backtab entry as done. + + * erc-button.el (button): Add call to `erc-button-add-keys'. + (erc-button-keys-added): New variable tracking whether we've added + the keys yet. + (erc-button-add-keys): New function that adds the <backtab> key to + erc-mode-map. + + * erc.texi: Change version to 5.2 (pre-release). + +2007-02-15 Michael Olson <mwolson@gnu.org> + + * CREDITS: Update. + + * erc-backend.el (erc-server-send-ping-interval): Change to use a + default of 30 seconds. Improve customize interface. + (erc-server-send-ping-timeout): New option that determines when to + consider a connection stalled and restart it. The default is + after 120 seconds. + (erc-server-send-ping): Use erc-server-send-ping-timeout instead + of erc-server-send-ping-interval. If + erc-server-send-ping-timeout is nil, do not ever kill and restart + a hung IRC process. + + * erc.el (erc-modules): Include the name of the module in its + description. This should make it easier for people to find and + enable a particular module. + +2007-02-15 Vivek Dasmohapatra <vivek@etla.org> + + * erc.el (erc-cmd-RECONNECT): Kill old process if it is still + alive. + (erc-message-english-PART): Properly escape "%" characters in + reason. + + * erc-backend.el (erc-server-reconnecting): New variable that is + set when the user requests a reconnect, but the old process is + still alive. This forces the reconnect to work even though the + process is killed manually during reconnect. + (erc-server-connect): Initialize it. + (erc-server-reconnect-p): Use it. + (erc-process-sentinel-1): Set it to nil after the first reconnect + attempt. + +2007-02-07 Diane Murray <disumu@x3y2z1.net> + + * erc-menu.el (erc-menu-definition): Fixed so that the separator + is between "Current channel" and "Pals, fools and other keywords", + not at the bottom of the "Current channel" submenu. + +2007-01-25 Diane Murray <disumu@x3y2z1.net> + + * erc-networks.el (erc-server-alist): Removed SSL server for now + since `erc-server-select' doesn't know to use `erc-ssl'. + + * erc-networks.el (erc-server-alist, erc-networks-alist): Added + definitions for oftc.net. + + * erc-services.el (erc-nickserv-alist): Fixed OFTC message regexp. + +2007-01-22 Michael Olson <mwolson@gnu.org> + + * erc-backend.el (erc-server-error-occurred): New variable that + indicates when an error has been signaled by the server. This + should fix an infinite reconnect bug when giving some servers a + bogus :full-name. Thanks to Angelina Carlton for the report. + (erc-server-connect): Initialize erc-server-error-occurred. + (erc-server-reconnect-p): Use it. + (ERROR): Set it. + + * erc-services.el (erc-nickserv-alist): Alphabetize and add Ars + and QuakeNet. Standardize look of entries. Fix type mismatch + error in customize interface. + (erc-nickserv-passwords): Alphabetize and add missing entries from + erc-nickserv-alist. + +2007-01-21 Michael Olson <mwolson@gnu.org> + + * erc.el (erc-header-line-format): Document how to disable the + header line, and add a customization type for it. Also, make the + changes take effect immediately. + +2007-01-19 Michael Olson <mwolson@gnu.org> + + * erc.texi (Modules): Document new menu module. Thanks to Leo + for noticing. + +2007-01-16 Diane Murray <disumu@x3y2z1.net> + + * erc-stamp.el (erc-insert-timestamp-left): Fixed so that the + whitespace string filler is hidden correctly when timestamps are + hidden. + (erc-toggle-timestamps): New function to use instead of + `erc-show-timestamps' and `erc-hide-timestamps'. + + * erc.el (erc-restore-text-properties): Moved here from + erc-fill.el since it could be useful in general. + + * erc-fill.el (erc-restore-text-properties): Removed. + +2007-01-13 Michael Olson <mwolson@gnu.org> + + * erc.el (erc-command-regexp): New variable that is used to match + a command. + (erc-send-input): Use it. This fixes a bug where paths -- + "/usr/bin/foo", for example -- were being displayed as commands, + but still sent correctly. + (erc-extract-command-from-line): Use it. + + * erc.texi (Modules): Document erc-capab-identify. + +2007-01-11 Diane Murray <disumu@x3y2z1.net> + + * erc.el (erc-find-parsed-property): Moved here from erc-track.el + since it can be useful in general. + + * erc-track.el (erc-find-parsed-property): Removed. + + * erc-capab.el (erc-capab-find-parsed): Removed. + (erc-capab-identify-add-prefix): Use `erc-find-parsed-property'. + + * erc.el (erc-open): Run `erc-before-connect' hook here. This + makes sure the hook always gets called before a connection is + made, as some functions, like `erc-handle-irc-url', use `erc-open' + instead of `erc'. + (erc): Removed `erc-before-connect' hook. + + * erc-menu.el (erc-menu-definition): Put items specific to + channels in a "Current channel" submenu. + + * erc-backend.el (321, 323): Display channel list in server buffer + when not using the channel list module. + + * erc.el: Updated copyright years. + (erc-version-string): Set to 5.2 (devel). + (erc-format-lag-time): Fixed to work when `erc-server-lag' is nil. + (erc-update-mode-line-buffer): Set the header face. + +2007-01-11 Michael Olson <mwolson@gnu.org> + + * erc-bbdb.el (erc-bbdb-popup-type): Fix customization type and + documentation. + + * erc-services.el (erc-nickserv-identify-mode): Improve + documentation for nick-change option and move higher to fix + compiler warning. Avoid a recursive load error. + (erc-nickserv-alist): Add simple entry for BitlBee, to avoid + "NickServ is AWAY: User is offline" error. Oddly enough, bitlbee + was smart enough to recognize that as an authentication request + and log in regardless, which is why I didn't notice this earlier. + (erc-nickserv-alist-sender, erc-nickserv-alist-regexp) + (erc-nickserv-alist-nickserv, erc-nickserv-alist-ident-keyword) + (erc-nickserv-alist-use-nick-p) + (erc-nickserv-alist-ident-command): New accessors for + erc-nickserv-alist. Using nth is unwieldy. + (erc-nickserv-identify-autodetect) + (erc-nickserv-identify-on-connect) + (erc-nickserv-identify-on-nick-change, erc-nickserv-identify): Use + the new accessors. + +2007-01-11 Diane Murray <disumu@x3y2z1.net> + + * NEWS: Added note for `erc-my-nick-face'. Fixed capab-identify + wording. + +2007-01-10 Diane Murray <disumu@x3y2z1.net> + + * erc.el (erc-mode-line-format): Added %l to documentation. + (erc-header-line-format): Removed "[IRC]". Use the new %l + replacement character. Doc fix. + (erc-format-channel-modes): Removed lag code. Removed parentheses + from mode string. + (erc-format-lag-time): New function. + (erc-update-mode-line-buffer): Use it. + +2007-01-10 Michael Olson <mwolson@gnu.org> + + * erc.el: Fix typo in url-irc-function instructions. + +2007-01-09 Michael Olson <mwolson@gnu.org> + + * erc.el (erc-system-name): New option that determines the system + name to use when logging in. The default is to figure this out by + calling `system-name'. + (erc-login): Use it. + +2007-01-07 Michael Olson <mwolson@gnu.org> + + * erc.el (erc-modules): Add the menu module. This should fix a + bug with incorrect ERC submenus being displayed. + + * erc-menu.el: Turn this into a module. + (erc-menu-add, erc-menu-remove): New functions that add and remove + the ERC menu. + + +See ChangeLog.06 for earlier changes. + + Copyright (C) 2007, 2008 Free Software Foundation, Inc. + + This file is part of GNU Emacs. + + GNU Emacs is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GNU Emacs is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GNU Emacs; see the file COPYING. If not, write to the + Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. + +;; Local Variables: +;; coding: utf-8 +;; add-log-time-zone-rule: t +;; End: + +;; 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. If a cons, the encoding system for outgoing text is in the car and the decoding system for incoming text is in the cdr. The most -interesting use for this is to put `undecided' in the cdr. If a -function, it is called with no arguments and should return a -coding system or a cons as described above. Note that you can use -the dynamically bound variable `target' to get the current -target. See `erc-coding-system-for-target'. +interesting use for this is to put `undecided' in the cdr. + +If a function, it is called with the argument `target' and should +return a coding system or a cons as described above. If you need to send non-ASCII text to people not using a client that 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." (let ((process (funcall erc-server-connect-function (format "erc-%s-%s" server port) nil server port))) + (unless (processp process) + (error "Connection attempt failed")) (message "%s...done" msg) ;; Misc server variables (with-current-buffer buffer @@ -686,7 +687,7 @@ This is determined via `erc-encoding-coding-alist' or (when (string-match (car pat) target) (throw 'match (cdr pat))))))) (and (functionp erc-server-coding-system) - (funcall erc-server-coding-system)) + (funcall erc-server-coding-system target)) erc-server-coding-system)) (defun erc-decode-string-from-target (str target) @@ -1349,7 +1350,7 @@ add things to `%s' instead." (erc-update-mode-line)))) (define-erc-response-handler (PRIVMSG NOTICE) - nil nil + "Handle private messages, including messages in channels." nil (let ((sender-spec (erc-response.sender parsed)) (cmd (erc-response.command parsed)) (tgt (car (erc-response.command-args parsed))) @@ -1413,7 +1414,7 @@ add things to `%s' instead." (add-hook 'erc-server-PRIVMSG-functions 'erc-auto-query) (define-erc-response-handler (QUIT) - nil nil + "Another user has quit IRC." nil (let ((reason (erc-response.contents parsed)) bufs) (multiple-value-bind (nick login host) @@ -1426,7 +1427,7 @@ add things to `%s' instead." ?h host ?r reason)))) (define-erc-response-handler (TOPIC) - nil nil + "The channel topic has changed." nil (let* ((ch (first (erc-response.command-args parsed))) (topic (erc-trim-string (erc-response.contents parsed))) (time (format-time-string "%T %m/%d/%y" (current-time)))) @@ -1439,7 +1440,7 @@ add things to `%s' instead." ?c ch ?T topic)))) (define-erc-response-handler (WALLOPS) - nil nil + "Display a WALLOPS message." nil (let ((message (erc-response.contents parsed))) (multiple-value-bind (nick login host) (erc-parse-user (erc-response.sender parsed)) @@ -1465,12 +1466,12 @@ add things to `%s' instead." (erc-response.contents parsed))) (define-erc-response-handler (376 422) - nil nil + "End of MOTD/MOTD is missing." nil (erc-server-MOTD proc parsed) (erc-connection-established proc parsed)) (define-erc-response-handler (004) - nil nil + "Display the server's identification." nil (multiple-value-bind (server-name server-version) (cdr (erc-response.command-args parsed)) (setq erc-server-version server-version) @@ -1510,7 +1511,7 @@ A server may send more than one 005 message." (erc-display-message parsed 'notice proc line))) (define-erc-response-handler (221) - nil nil + "Display the current user modes." nil (let* ((nick (first (erc-response.command-args parsed))) (modes (mapconcat 'identity (cdr (erc-response.command-args parsed)) " "))) @@ -1596,7 +1597,7 @@ See `erc-display-server-message'." nil ?n nick ?f fname ?u user ?h host)))) (define-erc-response-handler (312) - nil nil + "Server name response in WHOIS." nil (multiple-value-bind (nick server-host) (cdr (erc-response.command-args parsed)) (erc-display-message @@ -1614,7 +1615,7 @@ See `erc-display-server-message'." nil ;; 318 - End of WHOIS list ;; 323 - End of channel LIST ;; 369 - End of WHOWAS - nil nil + "End of WHO/WHOIS/LIST/WHOWAS notices." nil (ignore proc parsed)) (define-erc-response-handler (317) @@ -1635,7 +1636,7 @@ See `erc-display-server-message'." nil ?n nick ?i (erc-sec-to-time (string-to-number seconds-idle)))))) (define-erc-response-handler (319) - nil nil + "Channel names in WHOIS response." nil (erc-display-message parsed 'notice 'active 's319 ?n (second (erc-response.command-args parsed)) @@ -1649,8 +1650,13 @@ See `erc-display-server-message'." nil (define-erc-response-handler (321) "LIST header." nil - (setq erc-channel-list nil) - (erc-display-message parsed 'notice proc 's321)) + (setq erc-channel-list nil)) + +(defun erc-server-321-message (proc parsed) + "Display a message for the 321 event." + (erc-display-message parsed 'notice proc 's321) + nil) +(add-hook 'erc-server-321-functions 'erc-server-321-message t) (define-erc-response-handler (322) "LIST notice." nil @@ -1658,10 +1664,17 @@ See `erc-display-server-message'." nil (multiple-value-bind (channel num-users) (cdr (erc-response.command-args parsed)) (add-to-list 'erc-channel-list (list channel)) - (erc-update-channel-topic channel topic) + (erc-update-channel-topic channel topic)))) + +(defun erc-server-322-message (proc parsed) + "Display a message for the 322 event." + (let ((topic (erc-response.contents parsed))) + (multiple-value-bind (channel num-users) + (cdr (erc-response.command-args parsed)) (erc-display-message parsed 'notice proc 's322 ?c channel ?u num-users ?t (or topic ""))))) +(add-hook 'erc-server-322-functions 'erc-server-322-message t) (define-erc-response-handler (324) "Channel or nick modes." nil @@ -1683,7 +1696,7 @@ See `erc-display-server-message'." nil 's329 ?c channel ?t (format-time-string "%A %Y/%m/%d %X" time)))) (define-erc-response-handler (330) - nil nil + "Nick is authed as (on Quakenet network)." nil ;; FIXME: I don't know what the magic numbers mean. Mummy, make ;; the magic numbers go away. ;; No seriously, I have no clue about the format of this command, @@ -1699,10 +1712,9 @@ See `erc-display-server-message'." nil ?n nick ?a authmsg ?i authaccount))) (define-erc-response-handler (331) - "Channel topic." nil + "No topic set for channel." nil (let ((channel (second (erc-response.command-args parsed))) (topic (erc-response.contents parsed))) - ;; FIXME: why don't we do anything with the topic? -- Lawrence 2004/05/10 (erc-display-message parsed 'notice (erc-get-buffer channel proc) 's331 ?c channel))) @@ -1715,8 +1727,7 @@ See `erc-display-server-message'." nil 's332 ?c channel ?T topic))) (define-erc-response-handler (333) - ;; Who set the topic, and when - nil nil + "Who set the topic, and when." nil (multiple-value-bind (channel nick time) (cdr (erc-response.command-args parsed)) (setq time (format-time-string "%T %Y/%m/%d" @@ -1766,7 +1777,7 @@ See `erc-display-server-message'." nil (erc-channel-end-receiving-names))) (define-erc-response-handler (367) - "Channel ban list entries" nil + "Channel ban list entries." nil (multiple-value-bind (channel banmask setter time) (cdr (erc-response.command-args parsed)) ;; setter and time are not standard @@ -1781,7 +1792,7 @@ See `erc-display-server-message'." nil ?b banmask)))) (define-erc-response-handler (368) - "End of channel ban list" nil + "End of channel ban list." nil (let ((channel (second (erc-response.command-args parsed)))) (erc-display-message parsed 'notice 'active 's368 ?c channel))) @@ -1797,7 +1808,7 @@ See `erc-display-server-message'." nil 's379 ?c from ?f to))) (define-erc-response-handler (391) - "Server's time string" nil + "Server's time string." nil (erc-display-message parsed 'notice 'active 's391 ?s (second (erc-response.command-args parsed)) @@ -1824,56 +1835,47 @@ See `erc-display-server-message'." nil (define-erc-response-handler (405) - ;; Can't join that many channels. - nil nil + "Can't join that many channels." nil (erc-display-message parsed '(notice error) 'active 's405 ?c (second (erc-response.command-args parsed)))) (define-erc-response-handler (406) - ;; No such nick - nil nil + "No such nick." nil (erc-display-message parsed '(notice error) 'active 's406 ?n (second (erc-response.command-args parsed)))) (define-erc-response-handler (412) - ;; No text to send - nil nil + "No text to send." nil (erc-display-message parsed '(notice error) 'active 's412)) (define-erc-response-handler (421) - ;; Unknown command - nil nil + "Unknown command." nil (erc-display-message parsed '(notice error) 'active 's421 ?c (second (erc-response.command-args parsed)))) (define-erc-response-handler (432) - ;; Bad nick. - nil nil + "Bad nick." nil (erc-display-message parsed '(notice error) 'active 's432 ?n (second (erc-response.command-args parsed)))) (define-erc-response-handler (433) - ;; Login-time "nick in use" - nil nil + "Login-time \"nick in use\"." nil (erc-nickname-in-use (second (erc-response.command-args parsed)) "already in use")) (define-erc-response-handler (437) - ;; Nick temporarily unavailable (IRCnet) - nil nil + "Nick temporarily unavailable (on IRCnet)." nil (let ((nick/channel (second (erc-response.command-args parsed)))) (unless (erc-channel-p nick/channel) (erc-nickname-in-use nick/channel "temporarily unavailable")))) (define-erc-response-handler (442) - ;; Not on channel - nil nil + "Not on channel." nil (erc-display-message parsed '(notice error) 'active 's442 ?c (second (erc-response.command-args parsed)))) (define-erc-response-handler (461) - ;; Not enough params for command. - nil nil + "Not enough parameters for command." nil (erc-display-message parsed '(notice error) 'active 's461 ?c (second (erc-response.command-args parsed)) ?m (erc-response.contents parsed))) @@ -1887,7 +1889,7 @@ See `erc-display-server-message'." nil (erc-response.contents parsed))) (define-erc-response-handler (474) - "Banned from channel errors" nil + "Banned from channel errors." nil (erc-display-message parsed '(notice error) nil (intern (format "s%s" (erc-response.command parsed))) @@ -1906,14 +1908,14 @@ See `erc-display-server-message'." nil (erc-cmd-JOIN channel key))))) (define-erc-response-handler (477) - nil nil + "Channel doesn't support modes." nil (let ((channel (second (erc-response.command-args parsed))) (message (erc-response.contents parsed))) (erc-display-message parsed 'notice (erc-get-buffer channel proc) (format "%s: %s" channel message)))) (define-erc-response-handler (482) - nil nil + "You need to be a channel operator to do that." nil (let ((channel (second (erc-response.command-args parsed))) (message (erc-response.contents parsed))) (erc-display-message parsed '(error notice) 'active 's482 @@ -1935,7 +1937,9 @@ See `erc-display-server-message'." nil ;; 491 - No O-lines for your host ;; 501 - Unknown MODE flag ;; 502 - Cannot change mode for other users - nil nil + "Generic display of server error messages. + +See `erc-display-error-notice'." nil (erc-display-error-notice parsed (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 @@ ((add-hook 'erc-insert-modify-hook 'erc-button-add-buttons 'append) (add-hook 'erc-send-modify-hook 'erc-button-add-buttons 'append) (add-hook 'erc-complete-functions 'erc-button-next) - (add-hook 'erc-mode-hook 'erc-button-add-keys)) + (add-hook 'erc-mode-hook 'erc-button-setup)) ((remove-hook 'erc-insert-modify-hook 'erc-button-add-buttons) (remove-hook 'erc-send-modify-hook 'erc-button-add-buttons) (remove-hook 'erc-complete-functions 'erc-button-next) - (remove-hook 'erc-mode-hook 'erc-button-add-keys))) - -;; Make XEmacs use `erc-button-face'. -(when (featurep 'xemacs) - (add-hook 'erc-mode-hook - (lambda () (set (make-local-variable 'widget-button-face) nil)))) + (remove-hook 'erc-mode-hook 'erc-button-setup) + (when (featurep 'xemacs) + (dolist (buffer (erc-buffer-list)) + (with-current-buffer buffer + (kill-local-variable 'widget-button-face)))))) ;;; Variables @@ -247,8 +246,12 @@ constituents.") "Internal variable used to keep track of whether we've added the global-level ERC button keys yet.") -(defun erc-button-add-keys () +(defun erc-button-setup () "Add ERC mode-level button movement keys. This is only done once." + ;; Make XEmacs use `erc-button-face'. + (when (featurep 'xemacs) + (set (make-local-variable 'widget-button-face) nil)) + ;; Add keys. (unless erc-button-keys-added (define-key erc-mode-map (kbd "<backtab>") 'erc-button-previous) (setq erc-button-keys-added t))) @@ -299,9 +302,10 @@ specified by `erc-button-alist'." (setq bounds (bounds-of-thing-at-point 'word)) (setq word (buffer-substring-no-properties (car bounds) (cdr bounds))) - (if (erc-get-server-user word) - (erc-button-add-button (car bounds) (cdr bounds) - fun t (list word))))))) + (when (or (and (erc-server-buffer-p) (erc-get-server-user word)) + (and erc-channel-users (erc-get-channel-user word))) + (erc-button-add-button (car bounds) (cdr bounds) + fun t (list word))))))) (defun erc-button-add-buttons-1 (regexp entry) "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." (defalias 'erc-make-obsolete 'make-obsolete) (defalias 'erc-make-obsolete-variable 'make-obsolete-variable) -;; Provde an equivalent of `assert', based on the code from cl-macs.el -(defun erc-const-expr-p (x) - (cond ((consp x) - (or (eq (car x) 'quote) - (and (memq (car x) '(function function*)) - (or (symbolp (nth 1 x)) - (and (eq (and (consp (nth 1 x)) - (car (nth 1 x))) 'lambda) 'func))))) - ((symbolp x) (and (memq x '(nil t)) t)) - (t t))) - -(put 'erc-assertion-failed 'error-conditions '(error)) -(put 'erc-assertion-failed 'error-message "Assertion failed") - -(defun erc-list* (arg &rest rest) - "Return a new list with specified args as elements, cons'd to last arg. -Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to -`(cons A (cons B (cons C D)))'." - (cond ((not rest) arg) - ((not (cdr rest)) (cons arg (car rest))) - (t (let* ((n (length rest)) - (copy (copy-sequence rest)) - (last (nthcdr (- n 2) copy))) - (setcdr last (car (cdr last))) - (cons arg copy))))) - -(defmacro erc-assert (form &optional show-args string &rest args) - "Verify that FORM returns non-nil; signal an error if not. -Second arg SHOW-ARGS means to include arguments of FORM in message. -Other args STRING and ARGS... are arguments to be passed to `error'. -They are not evaluated unless the assertion fails. If STRING is -omitted, a default message listing FORM itself is used." - (let ((sargs - (and show-args - (delq nil (mapcar - (function - (lambda (x) - (and (not (erc-const-expr-p x)) x))) - (cdr form)))))) - (list 'progn - (list 'or form - (if string - (erc-list* 'error string (append sargs args)) - (list 'signal '(quote erc-assertion-failed) - (erc-list* 'list (list 'quote form) sargs)))) - nil))) - ;; Provide a simpler replacement for `member-if' (defun erc-member-if (predicate list) "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 @@ (require 'cl) (require 'pcomplete)) +;;;###autoload (autoload 'erc-dcc-mode "erc-dcc") +(define-erc-module dcc nil + "Provide Direct Client-to-Client support for ERC." + ((add-hook 'erc-server-401-functions 'erc-dcc-no-such-nick)) + ((remove-hook 'erc-server-401-functions 'erc-dcc-no-such-nick))) + (defgroup erc-dcc nil "DCC stands for Direct Client Communication, where you and your 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 IRC users." :group 'erc) -(defcustom erc-verbose-dcc t +(defcustom erc-dcc-verbose nil "*If non-nil, be verbose about DCC activity reporting." :group 'erc-dcc :type 'boolean) @@ -195,20 +201,22 @@ compared with `erc-nick-equal-p' which is IRC case-insensitive." (setq list (cdr list))))) result)) -;; msa wrote this nifty little frob to convert an n-byte integer to a packed -;; string. -(defun erc-pack-int (value count) - (if (> count 0) - (concat (erc-pack-int (/ value 256) (1- count)) - (char-to-string (% value 256))) - "")) +(defun erc-pack-int (value) + "Convert an integer into a packed string." + (let* ((len (ceiling (/ value 256.0))) + (str (make-string len ?a)) + (i (1- len))) + (while (>= i 0) + (aset str i (% value 256)) + (setq value (/ value 256)) + (setq i (1- i))) + str)) (defun erc-unpack-int (str) - "Unpack a 1-4 character packed string into an integer." + "Unpack a packed string into an integer." (let ((len (length str)) (num 0) (count 0)) - (erc-assert (<= len 4)) ;; this isn't going to fit in elisp bounds (while (< count len) (setq num (+ num (lsh (aref str (- len count 1)) (* 8 count)))) (setq count (1+ count))) @@ -256,15 +264,24 @@ The result is also a string." ;;; Server code -(defcustom erc-dcc-host nil - "*IP address to use for outgoing DCC offers. -Should be set to a string or nil, if nil, automatic detection of the -host interface to use will be attempted." +(defcustom erc-dcc-listen-host nil + "IP address to listen on when offering files. +Should be set to a string or nil. If nil, automatic detection of +the host interface to use will be attempted." :group 'erc-dcc :type (list 'choice (list 'const :tag "Auto-detect" nil) (list 'string :tag "IP-address" :valid-regexp erc-dcc-ipv4-regexp))) +(defcustom erc-dcc-public-host nil + "IP address to use for outgoing DCC offers. +Should be set to a string or nil. If nil, use the value of +`erc-dcc-listen-host'." + :group 'erc-dcc + :type (list 'choice (list 'const :tag "Same as erc-dcc-listen-host" nil) + (list 'string :tag "IP-address" + :valid-regexp erc-dcc-ipv4-regexp))) + (defcustom erc-dcc-send-request 'ask "*How to treat incoming DCC Send requests. '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." "Determine the IP address we are using. If variable `erc-dcc-host' is non-nil, use it. Otherwise call `erc-dcc-get-host' on the erc-server-process." - (or erc-dcc-host (erc-dcc-get-host erc-server-process) + (or erc-dcc-listen-host (erc-dcc-get-host erc-server-process) (error "Unable to determine local address"))) (defcustom erc-dcc-port-range nil @@ -311,6 +328,7 @@ created subprocess, or nil." process) (while (not process) (condition-case err + (progn (setq process (make-network-process :name name :buffer nil @@ -322,6 +340,11 @@ created subprocess, or nil." :sentinel sentinel :log #'erc-dcc-server-accept :server t)) + (when (processp process) + (when (fboundp 'set-process-coding-system) + (set-process-coding-system process 'binary 'binary)) + (when (fboundp 'set-process-filter-multibyte) + (set-process-filter-multibyte process nil)))) (file-error (unless (and (string= "Cannot bind server socket" (cadr err)) (string= "address already in use" (caddr err))) @@ -698,7 +721,7 @@ bytes sent." (confirmed-marker (plist-get elt :sent)) (sent-marker (plist-get elt :sent))) (with-current-buffer (process-buffer proc) - (when erc-verbose-dcc + (when erc-dcc-verbose (erc-display-message nil 'notice (erc-dcc-get-parent proc) (format "DCC: Confirmed %d, sent %d, sending block now" @@ -713,8 +736,7 @@ bytes sent." (length string))))) (defun erc-dcc-send-filter (proc string) - (erc-assert (= (% (length string) 4) 0)) - (let* ((size (erc-unpack-int (substring string (- (length string) 4)))) + (let* ((size (erc-unpack-int string)) (elt (erc-dcc-member :peer proc)) (parent (plist-get elt :parent)) (sent-marker (plist-get elt :sent)) @@ -742,16 +764,21 @@ bytes sent." ((> confirmed-marker sent-marker) (erc-display-message nil 'notice parent - (format "DCC: Client confirmed too much!")) + (format "DCC: Client confirmed too much (%s vs %s)!" + (marker-position confirmed-marker) + (marker-position sent-marker))) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer)) (delete-process proc)))))) +(defun erc-dcc-display-send (proc) + (erc-display-message + nil 'notice (erc-dcc-get-parent proc) + (format "DCC: SEND connect from %s" + (format-network-address (process-contact proc :remote))))) + (defcustom erc-dcc-send-connect-hook - '((lambda (proc) - (erc-display-message - nil 'notice (erc-dcc-get-parent proc) - (format "DCC: SEND connect from %s" - (format-network-address (process-contact proc :remote))))) - erc-dcc-send-block) + '(erc-dcc-display-send erc-dcc-send-block) "*Hook run whenever the remote end of a DCC SEND offer connected to your listening port." :group 'erc-dcc @@ -762,14 +789,14 @@ listening port." (erc-extract-nick (plist-get plist :nick))) (defun erc-dcc-send-sentinel (proc event) - (let* ((elt (erc-dcc-member :peer proc)) - (buf (marker-buffer (plist-get elt :sent)))) + (let* ((elt (erc-dcc-member :peer proc))) (cond ((string-match "^open from " event) (when elt - (with-current-buffer buf - (set-process-buffer proc buf) - (setq erc-dcc-entry-data elt)) + (let ((buf (marker-buffer (plist-get elt :sent)))) + (with-current-buffer buf + (set-process-buffer proc buf) + (setq erc-dcc-entry-data elt))) (run-hook-with-args 'erc-dcc-send-connect-hook proc)))))) (defun erc-dcc-find-file (file) @@ -807,15 +834,23 @@ other client." (process-send-string pproc (format "PRIVMSG %s :\C-aDCC SEND %s %s %d %d\C-a\n" nick (erc-dcc-file-to-name file) - (erc-ip-to-decimal (nth 0 contact)) + (erc-ip-to-decimal (or erc-dcc-public-host + (nth 0 contact))) (nth 1 contact) size))) (error "`make-network-process' not supported by your Emacs"))) ;;; GET handling +(defcustom erc-dcc-receive-cache (* 1024 512) + "Number of bytes to let the receive buffer grow before flushing it." + :group 'erc-dcc + :type 'integer) + (defvar erc-dcc-byte-count nil) (make-variable-buffer-local 'erc-dcc-byte-count) +(defvar erc-dcc-file-name nil) +(make-variable-buffer-local 'erc-dcc-file-name) (defun erc-dcc-get-file (entry file parent-proc) "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." proc) (with-current-buffer buffer (fundamental-mode) + (buffer-disable-undo (current-buffer)) ;; This is necessary to have the buffer saved as-is in GNU ;; Emacs. ;; XEmacs change: We don't have `set-buffer-multibyte', setting @@ -835,7 +871,10 @@ filter and a process sentinel, and making the connection." (setq mode-line-process '(":%s") buffer-file-type t buffer-read-only t) - (set-visited-file-name file) + (setq erc-dcc-file-name file) + + ;; Truncate the given file to size 0 before appending to it. + (write-region (point) (point) erc-dcc-file-name nil 'nomessage) (setq erc-server-process parent-proc erc-dcc-entry-data entry) @@ -847,7 +886,6 @@ filter and a process sentinel, and making the connection." (string-to-number (plist-get entry :port)) entry)) (set-process-buffer proc buffer) - ;; The following two lines make saving as-is work under Windows (set-process-coding-system proc 'binary 'binary) (set-buffer-file-coding-system 'binary t) @@ -856,6 +894,14 @@ filter and a process sentinel, and making the connection." (setq entry (plist-put entry :start-time (erc-current-time))) (setq entry (plist-put entry :peer proc))))) +(defun erc-dcc-append-contents (buffer file) + "Append the contents of BUFFER to FILE. +The contents of the BUFFER will then be erased." + (with-current-buffer buffer + (let ((coding-system-for-write 'binary)) + (write-region (point-min) (point-max) erc-dcc-file-name t 'nomessage) + (erase-buffer)))) + (defun erc-dcc-get-filter (proc str) "This is the process filter for transfers from other clients to this one. 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." (insert (string-make-unibyte str)) (setq erc-dcc-byte-count (+ (length str) erc-dcc-byte-count)) - (erc-assert (= erc-dcc-byte-count (1- (point-max)))) - (and erc-verbose-dcc + (when (> (point-max) erc-dcc-receive-cache) + (erc-dcc-append-contents (current-buffer) erc-dcc-file-name)) + + (and erc-dcc-verbose (erc-display-message nil 'notice erc-server-process 'dcc-get-bytes-received @@ -885,7 +933,7 @@ rather than every 1024 byte block, but nobody seems to care." (delete-process proc)) (t (process-send-string - proc (erc-pack-int erc-dcc-byte-count 4))))))) + proc (erc-pack-int erc-dcc-byte-count))))))) (defun erc-dcc-get-sentinel (proc event) @@ -895,17 +943,18 @@ transfer is complete." ;; FIXME, we should look at EVENT, and also check size. (with-current-buffer (process-buffer proc) (delete-process proc) - (setq buffer-read-only nil) (setq erc-dcc-list (delete erc-dcc-entry-data erc-dcc-list)) + (unless (= (point-min) (point-max)) + (setq erc-dcc-byte-count (+ (buffer-size) erc-dcc-byte-count)) + (erc-dcc-append-contents (current-buffer) erc-dcc-file-name)) (erc-display-message nil 'notice erc-server-process 'dcc-get-complete - ?f (file-name-nondirectory buffer-file-name) - ?s (number-to-string (buffer-size)) + ?f erc-dcc-file-name + ?s (number-to-string erc-dcc-byte-count) ?t (format "%.0f" (erc-time-diff (plist-get erc-dcc-entry-data :start-time) - (erc-current-time)))) - (save-buffer)) + (erc-current-time))))) (kill-buffer (process-buffer proc)) (delete-process proc)) @@ -1126,8 +1175,6 @@ other client." (if (processp peer) (delete-process peer))) nil)) -(add-hook 'erc-server-401-functions 'erc-dcc-no-such-nick) - (provide 'erc-dcc) ;;; 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 @@ (require 'erc) -;; Imenu Autoload -(add-hook 'erc-mode-hook - (lambda () - (setq imenu-create-index-function 'erc-create-imenu-index))) +;;; Imenu support + +(defun erc-imenu-setup () + "Setup Imenu support in an ERC buffer." + (set (make-local-variable 'imenu-create-index-function) + 'erc-create-imenu-index)) + +(add-hook 'erc-mode-hook 'erc-imenu-setup) (autoload 'erc-create-imenu-index "erc-imenu" "Imenu index creation function") ;;; Automatically scroll to bottom @@ -51,11 +55,15 @@ argument to `recenter'." :type '(choice integer (const nil))) (define-erc-module scrolltobottom nil - "This mode causes the prompt to stay at the end of the window. -You have to activate or deactivate it in already created windows -separately." - ((add-hook 'erc-mode-hook 'erc-add-scroll-to-bottom)) - ((remove-hook 'erc-mode-hook 'erc-add-scroll-to-bottom))) + "This mode causes the prompt to stay at the end of the window." + ((add-hook 'erc-mode-hook 'erc-add-scroll-to-bottom) + (dolist (buffer (erc-buffer-list)) + (with-current-buffer buffer + (erc-add-scroll-to-bottom)))) + ((remove-hook 'erc-mode-hook 'erc-add-scroll-to-bottom) + (dolist (buffer (erc-buffer-list)) + (with-current-buffer buffer + (remove-hook 'window-scroll-functions 'erc-scroll-to-bottom t))))) (defun erc-add-scroll-to-bottom () "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'." (put-text-property (point-min) (point-max) 'front-sticky t) (put-text-property (point-min) (point-max) 'rear-nonsticky t)) -;; Distinguish non-commands +;;; Move to prompt when typing text +(define-erc-module move-to-prompt nil + "This mode causes the point to be moved to the prompt when typing text." + ((add-hook 'erc-mode-hook 'erc-move-to-prompt-setup) + (dolist (buffer (erc-buffer-list)) + (with-current-buffer buffer + (erc-move-to-prompt-setup)))) + ((remove-hook 'erc-mode-hook 'erc-move-to-prompt-setup) + (dolist (buffer (erc-buffer-list)) + (with-current-buffer buffer + (remove-hook 'pre-command-hook 'erc-move-to-prompt t))))) + +(defun erc-move-to-prompt () + "Move the point to the ERC prompt if this is a self-inserting command." + (when (and erc-input-marker (< (point) erc-input-marker) + (eq 'self-insert-command this-command)) + (deactivate-mark) + (push-mark) + (goto-char (point-max)))) + +(defun erc-move-to-prompt-setup () + "Initialize the move-to-prompt module for XEmacs." + (add-hook 'pre-command-hook 'erc-move-to-prompt nil t)) + +;;; Keep place in unvisited channels +(define-erc-module keep-place nil + "Leave point above un-viewed text in other channels." + ((add-hook 'erc-insert-pre-hook 'erc-keep-place)) + ((remove-hook 'erc-insert-pre-hook 'erc-keep-place))) + +(defun erc-keep-place (ignored) + "Move point away from the last line in a non-selected ERC buffer." + (when (and (not (eq (window-buffer (selected-window)) + (current-buffer))) + (>= (point) erc-insert-marker)) + (deactivate-mark) + (goto-char (erc-beg-of-input-line)) + (forward-line -1))) + +;;; Distinguish non-commands (defvar erc-noncommands-list '(erc-cmd-ME erc-cmd-COUNTRY erc-cmd-SV @@ -496,8 +543,19 @@ channel that has weird people talking in morse to each other. See also `unmorse-region'." (goto-char (point-min)) - (when (re-search-forward "[.-]+\\([.-]+[/ ]\\)+[.-]+" nil t) - (unmorse-region (match-beginning 0) (match-end 0)))) + (when (re-search-forward "[.-]+\\([.-]*/? *\\)+[.-]+/?" nil t) + (save-restriction + (narrow-to-region (match-beginning 0) (match-end 0)) + ;; Turn " / " into " " + (goto-char (point-min)) + (while (re-search-forward " / " nil t) + (replace-match " ")) + ;; Turn "/ " into "/" + (goto-char (point-min)) + (while (re-search-forward "/ " nil t) + (replace-match "/")) + ;; Unmorse region + (unmorse-region (point-min) (point-max))))) ;;; erc-occur (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 @@ +;;; erc-list.el --- /list support for ERC + +;; Copyright (C) 2008 Free Software Foundation, Inc. + +;; Author: Tom Tromey <tromey@redhat.com> +;; Version: 0.1 +;; Keywords: comm + +;; This file is part of ERC. + +;; ERC is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; ERC is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with ERC; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file provides nice support for /list in ERC. + +;;; Code: + +(require 'erc) + +;; This is implicitly the width of the channel name column. Pick +;; something small enough that the topic has a chance of being +;; readable, but long enough that most channel names won't make for +;; strange formatting. +(defconst erc-list-nusers-column 25) + +;; Width of the number-of-users column. +(defconst erc-list-topic-column (+ erc-list-nusers-column 10)) + +;; The list buffer. This is buffer local in the server buffer. +(defvar erc-list-buffer nil) + +;; The argument to the last "/list". This is buffer local in the +;; server buffer. +(defvar erc-list-last-argument nil) + +;; The server buffer corresponding to the list buffer. This is buffer +;; local in the list buffer. +(defvar erc-list-server-buffer nil) + +;; Define module: +;;;###autoload (autoload 'erc-list-mode "erc-list") +(define-erc-module list nil + "List channels nicely in a separate buffer." + ((remove-hook 'erc-server-321-functions 'erc-server-321-message) + (remove-hook 'erc-server-322-functions 'erc-server-322-message)) + ((erc-with-all-buffers-of-server nil + #'erc-open-server-buffer-p + (remove-hook 'erc-server-322-functions 'erc-list-handle-322 t)) + (add-hook 'erc-server-321-functions 'erc-server-321-message t) + (add-hook 'erc-server-322-functions 'erc-server-322-message t))) + +;; Format a record for display. +(defun erc-list-make-string (channel users topic) + (concat + channel + (erc-propertize " " + 'display (list 'space :align-to erc-list-nusers-column) + 'face 'fixed-pitch) + users + (erc-propertize " " + 'display (list 'space :align-to erc-list-topic-column) + 'face 'fixed-pitch) + topic)) + +;; Insert a record into the list buffer. +(defun erc-list-insert-item (channel users topic) + (save-excursion + (let ((buffer-read-only nil)) + (goto-char (point-max)) + (insert (erc-list-make-string channel users topic) "\n")))) + +(defun erc-list-join () + "Join the irc channel named on this line." + (interactive) + (unless (eobp) + (beginning-of-line) + (unless (looking-at "\\([&#+!][^ \n]+\\)") + (error "Not looking at channel name?")) + (let ((chan (match-string 1))) + (with-current-buffer erc-list-server-buffer + (erc-join-channel chan))))) + +(defun erc-list-kill () + "Kill the current ERC list buffer." + (interactive) + (kill-buffer (current-buffer))) + +(defun erc-list-revert () + "Refresh the list of channels." + (interactive) + (with-current-buffer erc-list-server-buffer + (erc-cmd-LIST erc-list-last-argument))) + +(defun erc-list-menu-sort-by-column (&optional e) + "Sort the channel list by the column clicked on." + (interactive (list last-input-event)) + (if e (mouse-select-window e)) + (let* ((pos (event-start e)) + (obj (posn-object pos)) + (col (if obj + (get-text-property (cdr obj) 'column-number (car obj)) + (get-text-property (posn-point pos) 'column-number)))) + (let ((buffer-read-only nil)) + (if (= col 1) + (sort-fields col (point-min) (point-max)) + (sort-numeric-fields col (point-min) (point-max)))))) + +(defvar erc-list-menu-mode-map nil + "Local keymap for `erc-list-mode' buffers.") + +(unless erc-list-menu-mode-map + (setq erc-list-menu-mode-map (make-keymap)) + (suppress-keymap erc-list-menu-mode-map) + (define-key erc-list-menu-mode-map "k" 'erc-list-kill) + (define-key erc-list-menu-mode-map "j" 'erc-list-join) + (define-key erc-list-menu-mode-map "g" 'erc-list-revert) + (define-key erc-list-menu-mode-map "n" 'next-line) + (define-key erc-list-menu-mode-map "p" 'previous-line) + (define-key erc-list-menu-mode-map "q" 'quit-window)) + +(defvar erc-list-menu-sort-button-map nil + "Local keymap for ERC list menu mode sorting buttons.") + +(unless erc-list-menu-sort-button-map + (let ((map (make-sparse-keymap))) + (define-key map [header-line mouse-1] 'erc-list-menu-sort-by-column) + (define-key map [follow-link] 'mouse-face) + (setq erc-list-menu-sort-button-map map))) + +;; Helper function that makes a buttonized column header. +(defun erc-list-button (title column) + (erc-propertize title + 'column-number column + 'help-echo "mouse-1: sort by column" + 'mouse-face 'highlight + 'keymap erc-list-menu-sort-button-map)) + +(define-derived-mode erc-list-menu-mode nil "ERC-List" + "Major mode for editing a list of irc channels." + (setq header-line-format + (concat + (erc-propertize " " + 'display '(space :align-to 0) + 'face 'fixed-pitch) + (erc-list-make-string (erc-list-button "Channel" 1) + (erc-list-button "# Users" 2) + "Topic"))) + (setq truncate-lines t)) + +(put 'erc-list-menu-mode 'mode-class 'special) + +;; Handle a "322" response. This response tells us about a single +;; channel. +(defun erc-list-handle-322 (proc parsed) + (let* ((args (cdr (erc-response.command-args parsed))) + (channel (car args)) + (nusers (car (cdr args))) + (topic (erc-response.contents parsed))) + (when (buffer-live-p erc-list-buffer) + (with-current-buffer erc-list-buffer + (erc-list-insert-item channel nusers topic)))) + ;; Don't let another hook run. + t) + +;; Helper function to install our 322 handler and make our buffer. +(defun erc-list-install-322-handler (server-buffer) + (with-current-buffer server-buffer + ;; Arrange for 322 responses to insert into our buffer. + (add-hook 'erc-server-322-functions 'erc-list-handle-322 t t) + ;; Arrange for 323 (end of list) to end this. + (erc-once-with-server-event + 323 + '(progn + (remove-hook 'erc-server-322-functions 'erc-list-handle-322 t))) + ;; Find the list buffer, empty it, and display it. + (set (make-local-variable 'erc-list-buffer) + (get-buffer-create (concat "*Channels of " + erc-server-announced-name + "*"))) + (with-current-buffer erc-list-buffer + (erc-list-menu-mode) + (setq buffer-read-only nil) + (erase-buffer) + (set (make-local-variable 'erc-list-server-buffer) server-buffer) + (setq buffer-read-only t)) + (pop-to-buffer erc-list-buffer)) + t) + +;; The main entry point. +(defun erc-cmd-LIST (&optional line) + "Show a listing of channels on the current server in a separate window. + +If LINE is specified, include it with the /LIST command. It +should usually be one or more channels, separated by commas. + +Please note that this function only works with IRC servers which conform +to RFC and send the LIST header (#321) at start of list transmission." + (erc-with-server-buffer + (set (make-local-variable 'erc-list-last-argument) line) + (erc-once-with-server-event + 321 + (list 'progn + (list 'erc-list-install-322-handler (current-buffer))))) + (erc-server-send (concat "LIST :" (or (and line (substring line 1)) + "")))) +(put 'erc-cmd-LIST 'do-not-parse-args t) + +;;; erc-list.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; 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 @@ ;; ;; Usage: ;; -;; Put into your .emacs: -;; -;; (require 'erc-networks) +;; This is the "networks" module. ;; ;; M-x erc-server-select provides an alternative way to connect to servers by ;; choosing networks. @@ -351,6 +349,7 @@ ("Relicnet: Random server" Relicnet "irc.relic.net" 6667) ("Rezosup: Random server" Rezosup "irc.rezosup.org" 6667) ("Risanet: Random server" Risanet "irc.risanet.com" ((6667 6669))) + ("Rizon: Random server" Rizon "irc.rizon.net" (6633 (6660 6669) 6697 7000 8080 9999)) ("Rubiks: Random server" Rubiks "irc.rubiks.net" 6667) ("Rusnet: EU, RU, Tomsk" Rusnet "irc.tsk.ru" ((6667 6669) (7770 7775) )) ("Rusnet: EU, RU, Vladivostok" Rusnet "irc.vladivostok.ru" ((6667 6669) (7770 7775) )) @@ -765,9 +764,14 @@ network as a symbol." (setq erc-network nil) nil) -(add-hook 'erc-server-375-functions 'erc-set-network-name) -(add-hook 'erc-server-422-functions 'erc-set-network-name) -(add-hook 'erc-disconnected-hook 'erc-unset-network-name) +(define-erc-module networks nil + "Provide data about IRC networks." + ((add-hook 'erc-server-375-functions 'erc-set-network-name) + (add-hook 'erc-server-422-functions 'erc-set-network-name) + (add-hook 'erc-disconnected-hook 'erc-unset-network-name)) + ((remove-hook 'erc-server-375-functions 'erc-set-network-name) + (remove-hook 'erc-server-422-functions 'erc-set-network-name) + (remove-hook 'erc-disconnected-hook 'erc-unset-network-name))) (defun erc-ports-list (ports) "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." (provide 'erc-page) -;; arch-tag: 82fd2e0e-6060-4dd2-9788-8c1411e844de ;;; erc-page.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; 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 @@ ;; erc-replace.el -- wash and massage messages inserted into the buffer -;; Copyright (C) 2001, 2002, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2004, 2006, 2007, +;; 2008 Free Software Foundation, Inc. ;; Author: Andreas Fuchs <asf@void.at> ;; Maintainer: Mario Lang (mlang@delysid.org) @@ -88,5 +89,11 @@ It replaces text according to `erc-replace-alist'." (provide 'erc-replace) -;; arch-tag: dd904a59-d8a6-47f8-ac3a-76b698289a18 ;;; erc-replace.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; 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." '(("autodetect") ("nick-change") ("both")) nil t)))) (add-hook 'erc-server-NOTICE-functions 'erc-nickserv-identification-autodetect) + (unless erc-networks-mode + ;; Force-enable networks module, because we need it to set + ;; erc-network for us. + (erc-networks-enable)) (cond ((eq mode 'autodetect) (setq erc-nickserv-identify-mode 'autodetect) (add-hook 'erc-server-NOTICE-functions @@ -187,6 +191,7 @@ Example of use: (const iip) (const OFTC) (const QuakeNet) + (const Rizon) (const SlashNET) (symbol :tag "Network name")) (repeat :tag "Nickname and password" @@ -227,6 +232,8 @@ Example of use: "IDENTIFY" nil nil nil) (freenode "NickServ!NickServ@services." + ;; freenode also accepts a password at login, see the `erc' + ;; :password argument. "/msg\\s-NickServ\\s-IDENTIFY\\s-<password>" "NickServ" "IDENTIFY" nil nil @@ -249,9 +256,17 @@ Example of use: "IDENTIFY" nil "SQUERY" nil) (OFTC "NickServ!services@services.oftc.net" - "type\\s-/msg\\s-NickServ\\s-IDENTIFY\\s- password ." + ;; OFTC's NickServ doesn't ask you to identify anymore. + nil "NickServ" - "IDENTIFY" nil nil nil) + "IDENTIFY" nil nil + "You\\s-are\\s-successfully\\s-identified\\s-as\\s-") + (Rizon + "NickServ!service@rizon.net" + "This\\s-nickname\\s-is\\s-registered\\s-and\\s-protected." + "NickServ" + "IDENTIFY" nil nil + "Password\\s-accepted\\s--\\s-you\\s-are\\s-now\\s-recognized.") (QuakeNet nil nil "Q@CServe.quakenet.org" @@ -334,15 +349,15 @@ If this is the case, run `erc-nickserv-identified-hook'." ;; continue only if we're sure it's the real nickserv for this network ;; and it's told us we've successfully identified (when (and sender (equal sspec sender) + success-regex (string-match success-regex msg)) (erc-log "NickServ IDENTIFY success notification detected") (run-hook-with-args 'erc-nickserv-identified-hook network nick) nil))) (defun erc-nickserv-identify-autodetect (proc parsed) - "Check for a NickServ identify request everytime a notice is received. -Make sure it is the real NickServ for this network and that it has -specifically asked the user to IDENTIFY. + "Identify to NickServ when an identify request is received. +Make sure it is the real NickServ for this network. If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the password for this nickname, otherwise try to send it automatically." (unless (and (null erc-nickserv-passwords) @@ -356,6 +371,7 @@ password for this nickname, otherwise try to send it automatically." ;; continue only if we're sure it's the real nickserv for this network ;; and it's asked us to identify (when (and sender (equal sspec sender) + identify-regex (string-match identify-regex msg)) (erc-log "NickServ IDENTIFY request detected") (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'." :group 'erc-track :type 'boolean) -(defcustom erc-track-exclude-types '("NICK") +(defcustom erc-track-exclude-types '("NICK" "333" "353") "*List of message types to be ignored. -This list could look like '(\"JOIN\" \"PART\")." +This list could look like '(\"JOIN\" \"PART\"). + +By default, exclude changes of nicknames (NICK), display of who +set the channel topic (333), and listing of users on the current +channel (353)." :group 'erc-track :type 'erc-message-type) @@ -175,15 +179,32 @@ The faces used are the same as used for text in the buffers. :type 'boolean) (defcustom erc-track-faces-priority-list - '(erc-error-face erc-current-nick-face erc-keyword-face erc-pal-face - erc-nick-msg-face erc-direct-msg-face erc-button erc-dangerous-host-face - erc-default-face erc-action-face erc-nick-default-face erc-fool-face - erc-notice-face erc-input-face erc-prompt-face) + '(erc-error-face + (erc-nick-default-face erc-current-nick-face) + erc-current-nick-face + erc-keyword-face + (erc-nick-default-face erc-pal-face) + erc-pal-face + erc-nick-msg-face + erc-direct-msg-face + (erc-button erc-default-face) + (erc-nick-default-face erc-dangerous-host-face) + erc-dangerous-host-face + erc-nick-default-face + (erc-nick-default-face erc-default-face) + erc-default-face + erc-action-face + (erc-nick-default-face erc-fool-face) + erc-fool-face + erc-notice-face + erc-input-face + erc-prompt-face) "A list of faces used to highlight active buffer names in the modeline. If a message contains one of the faces in this list, the buffer name will be highlighted using that face. The first matching face is used." :group 'erc-track - :type '(repeat face)) + :type '(repeat (choice face + (repeat :tag "Combination" face)))) (defcustom erc-track-priority-faces-only nil "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 will be ignored while all other channels will be tracked as normal. Other options are 'all, to apply this to all channels or nil, to disable this feature. + Note: If you have a lot of faces listed in `erc-track-faces-priority-list', setting this variable might not be very useful." :group 'erc-track @@ -200,17 +222,38 @@ setting this variable might not be very useful." (repeat string) (const all))) +(defcustom erc-track-faces-normal-list + '((erc-button erc-default-face) + (erc-nick-default-face erc-dangerous-host-face) + erc-dangerous-host-face + erc-nick-default-face + (erc-nick-default-face erc-default-face) + erc-default-face + erc-action-face) + "A list of faces considered to be part of normal conversations. +This list is used to highlight active buffer names in the modeline. + +If a message contains one of the faces in this list, and the +previous modeline face for this buffer is also in this list, then +the buffer name will be highlighted using the face from the +message. This gives a rough indication that active conversations +are occurring in these channels. + +The effect may be disabled by setting this variable to nil." + :group 'erc-track + :type '(repeat (choice face + (repeat :tag "Combination" face)))) + (defcustom erc-track-position-in-mode-line 'before-modes "Where to show modified channel information in the mode-line. Setting this variable only has effects in GNU Emacs versions above 21.3. Choices are: -'before-modes - add to the beginning of `mode-line-modes' -'after-modes - add to the end of `mode-line-modes' -t - add to the end of `global-mode-string'. -nil - don't add to mode line -" +'before-modes - add to the beginning of `mode-line-modes', +'after-modes - add to the end of `mode-line-modes', +t - add to the end of `global-mode-string', +nil - don't add to mode line." :group 'erc-track :type '(choice (const :tag "Just before mode information" before-modes) (const :tag "Just after mode information" after-modes) @@ -443,7 +486,7 @@ START is the minimum length of the name used." ;;; Test: -(erc-assert +(assert (and ;; verify examples from the doc strings (equal (let ((erc-track-shorten-aggressively nil)) @@ -560,13 +603,15 @@ module, otherwise the keybindings will not do anything useful." :global t :group 'erc-track) -(defun erc-track-minor-mode-maybe () +(defun erc-track-minor-mode-maybe (&optional buffer) "Enable `erc-track-minor-mode', depending on `erc-track-enable-keybindings'." - (unless (or erc-track-minor-mode - ;; don't start the minor mode until we have an ERC - ;; process running, because we don't want to prompt the - ;; user while starting Emacs - (null (erc-buffer-list))) + (when (and (not erc-track-minor-mode) + ;; don't start the minor mode until we have an ERC + ;; process running, because we don't want to prompt the + ;; user while starting Emacs + (or (and (buffer-live-p buffer) + (with-current-buffer buffer (eq major-mode 'erc-mode))) + (erc-buffer-list))) (cond ((eq erc-track-enable-keybindings 'ask) (let ((key (or (and (key-binding (kbd "C-c C-SPC")) "C-SPC") (and (key-binding (kbd "C-c C-@")) "C-@")))) @@ -616,6 +661,7 @@ module, otherwise the keybindings will not do anything useful." (add-hook 'erc-insert-post-hook 'erc-track-modified-channels) (add-hook 'erc-disconnected-hook 'erc-modified-channels-update)) ;; enable the tracking keybindings + (add-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe) (erc-track-minor-mode-maybe))) ;; Disable: ((when (boundp 'erc-track-when-inactive) @@ -637,6 +683,7 @@ module, otherwise the keybindings will not do anything useful." (remove-hook 'erc-disconnected-hook 'erc-modified-channels-update) (remove-hook 'erc-insert-post-hook 'erc-track-modified-channels)) ;; disable the tracking keybindings + (remove-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe) (when erc-track-minor-mode (erc-track-minor-mode -1))))) @@ -821,15 +868,36 @@ Use `erc-make-mode-line-buffer-name' to create buttons." (defun erc-track-find-face (faces) "Return the face to use in the modeline from the faces in FACES. If `erc-track-faces-priority-list' is set, the one from FACES who is -first in that list will be used." - (let ((candidates erc-track-faces-priority-list) - candidate face) - (while (and candidates (not face)) - (setq candidate (car candidates) - candidates (cdr candidates)) - (when (memq candidate faces) - (setq face candidate))) - face)) +first in that list will be used. + +If `erc-track-faces-normal-list' is non-nil, use it to produce a +blinking effect that indicates channel activity when the first +element in FACES and the highest-ranking face among the rest of +FACES are both members of `erc-track-faces-normal-list'. + +If `erc-track-faces-priority-list' is not set, the first element +in FACES will be used. + +If one of the faces is a list, then it will be ranked according +to its highest-tanking face member. A list of faces including +that member will take priority over just the single member +element." + (let ((choice (catch 'face + (dolist (candidate erc-track-faces-priority-list) + (when (member candidate faces) + (throw 'face candidate))))) + (no-first (and erc-track-faces-normal-list + (catch 'face + (dolist (candidate erc-track-faces-priority-list) + (when (member candidate (cdr faces)) + (throw 'face candidate))))))) + (cond ((null choice) + (car faces)) + ((and (member choice erc-track-faces-normal-list) + (member no-first erc-track-faces-normal-list)) + no-first) + (t + choice)))) (defun erc-track-modified-channels () "Hook function for `erc-insert-post-hook' to check if the current @@ -898,14 +966,15 @@ is in `erc-mode'." "Return a list of all faces used in STR." (let ((i 0) (m (length str)) - (faces (erc-list (get-text-property 0 'face str)))) + (faces (erc-list (get-text-property 0 'face str))) + cur) (while (and (setq i (next-single-property-change i 'face str m)) (not (= i m))) - (dolist (face (erc-list (get-text-property i 'face str))) - (add-to-list 'faces face))) + (when (setq cur (get-text-property i 'face str)) + (add-to-list 'faces cur))) faces)) -(erc-assert +(assert (let ((str "is bold")) (put-text-property 3 (length str) 'face '(bold erc-current-nick-face) @@ -935,7 +1004,7 @@ higher number than any other face in that list." (let ((count 0)) (catch 'done (dolist (item erc-track-faces-priority-list) - (if (eq item face) + (if (equal item face) (throw 'done t) (setq count (1+ count))))) 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." :group 'erc-dcc :type '(repeat (repeat :tag "Message" (choice string sexp)))) +;;;###autoload (autoload 'erc-xdcc-mode "erc-xdcc") +(define-erc-module xdcc nil + "Act as an XDCC file-server." + nil nil) + ;;;###autoload (defun erc-xdcc-add-file (file) "Add a file to `erc-xdcc-files'." @@ -126,5 +131,11 @@ being evaluated and should return stings." (provide 'erc-xdcc) -;; arch-tag: a13b62fe-2399-4562-af4e-f18a8dd4b9c8 ;;; erc-xdcc.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; 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 @@ ;;; Code: -(defconst erc-version-string "Version 5.3 (devel)" +(defconst erc-version-string "Version 5.3" "ERC version. This is used by function `erc-version'.") (eval-when-compile (require 'cl)) @@ -1167,7 +1167,12 @@ This will only be used if `erc-header-line-face-method' is non-nil." See the variable `erc-command-indicator'." :group 'erc-faces) -(defface erc-notice-face '((t (:bold t :foreground "SlateBlue"))) +(defface erc-notice-face + (if (featurep 'xemacs) + '((t (:bold t :foreground "blue"))) + '((((class color) (min-colors 88)) + (:bold t :foreground "SlateBlue")) + (t (:bold t :foreground "blue")))) "ERC face for notices." :group 'erc-faces) @@ -1465,18 +1470,23 @@ Turning on `erc-mode' runs the hook `erc-mode-hook'." "IRC port to use if it cannot be detected otherwise.") (defcustom erc-join-buffer 'buffer - "Determines how to display the newly created IRC buffer. -'window - in another window, -'window-noselect - in another window, but don't select that one, -'frame - in another frame, -'bury - bury it in a new buffer, -any other value - in place of the current buffer." + "Determines how to display a newly created IRC buffer. + +The available choices are: + + 'window - in another window, + 'window-noselect - in another window, but don't select that one, + 'frame - in another frame, + 'bury - bury it in a new buffer, + 'buffer - in place of the current buffer, + any other value - in place of the current buffer." :group 'erc-buffers - :type '(choice (const window) - (const window-noselect) - (const frame) - (const bury) - (const buffer))) + :type '(choice (const :tag "Split window and select" window) + (const :tag "Split window, don't select" window-noselect) + (const :tag "New frame" frame) + (const :tag "Bury in new buffer" bury) + (const :tag "Use current buffer" buffer) + (const :tag "Use current buffer" t))) (defcustom erc-frame-alist nil "*Alist of frame parameters for creating erc frames. @@ -1804,8 +1814,8 @@ buffer rather than a server buffer.") mods)))) (defcustom erc-modules '(netsplit fill button match track completion readonly - ring autojoin noncommands irccontrols - stamp menu) + networks ring autojoin noncommands irccontrols + move-to-prompt stamp menu list) "A list of modules which ERC should enable. If you set the value of this without using `customize' remember to call \(erc-update-modules) after you change it. When using `customize', modules @@ -1837,14 +1847,20 @@ removed from the list will be disabled." (const :tag "completion: Complete nicknames and commands (programmable)" completion) (const :tag "hecomplete: Complete nicknames and commands (old)" hecomplete) + (const :tag "dcc: Provide Direct Client-to-Client support" dcc) (const :tag "fill: Wrap long lines" fill) (const :tag "identd: Launch an identd server on port 8113" identd) (const :tag "irccontrols: Highlight or remove IRC control characters" irccontrols) + (const :tag "keep-place: Leave point above un-viewed text" keep-place) + (const :tag "list: List channels in a separate buffer" list) (const :tag "log: Save buffers in logs" log) (const :tag "match: Highlight pals, fools, and other keywords" match) (const :tag "menu: Display a menu in ERC buffers" menu) + (const :tag "move-to-prompt: Move to the prompt when typing text" + move-to-prompt) (const :tag "netsplit: Detect netsplits" netsplit) + (const :tag "networks: Provide data about IRC networks" networks) (const :tag "noncommands: Don't display non-IRC commands after evaluation" noncommands) (const :tag @@ -1866,6 +1882,7 @@ removed from the list will be disabled." (const :tag "track: Track channel activity in the mode-line" track) (const :tag "truncate: Truncate buffers to a certain size" truncate) (const :tag "unmorse: Translate morse code in messages" unmorse) + (const :tag "xdcc: Act as an XDCC file-server" xdcc) (repeat :tag "Others" :inline t symbol)) :group 'erc) @@ -2324,6 +2341,15 @@ If ARG is non-nil, show the *erc-protocol* buffer." I.e. any char in it has the `invisible' property set." (text-property-any 0 (length string) 'invisible t string)) +(defcustom erc-remove-parsed-property t + "Whether to remove the erc-parsed text property after displaying a message. + +The default is to remove it, since it causes ERC to take up extra +memory. If you have code that relies on this property, then set +this option to nil." + :type 'boolean + :group 'erc) + (defun erc-display-line-1 (string buffer) "Display STRING in `erc-mode' BUFFER. Auxiliary function used in `erc-display-line'. The line gets filtered to @@ -2364,7 +2390,10 @@ If STRING is nil, the function does nothing." (save-restriction (narrow-to-region insert-position (point)) (run-hooks 'erc-insert-modify-hook) - (run-hooks 'erc-insert-post-hook)))))) + (run-hooks 'erc-insert-post-hook) + (when erc-remove-parsed-property + (remove-text-properties (point-min) (point-max) + '(erc-parsed nil)))))))) (erc-update-undo-list (- (or (marker-position erc-insert-marker) (point-max)) insert-position)))))) @@ -3161,14 +3190,35 @@ just as you provided it. Use this command with care!" (t nil))) (put 'erc-cmd-QUOTE 'do-not-parse-args t) +(defcustom erc-query-display 'window + "Indicates how to display query buffers when using the /QUERY +command to talk to someone. + +The default behavior is to display the message in a new window +and bring it to the front. See the documentation for +`erc-join-buffer' for a description of the available choices. + +See also `erc-auto-query' to decide how private messages from +other people should be displayed." + :group 'erc-query + :type '(choice (const :tag "Split window and select" window) + (const :tag "Split window, don't select" window-noselect) + (const :tag "New frame" frame) + (const :tag "Bury in new buffer" bury) + (const :tag "Use current buffer" buffer) + (const :tag "Use current buffer" t))) + (defun erc-cmd-QUERY (&optional user) "Open a query with USER. The type of query window/frame/etc will depend on the value of -`erc-join-buffer'. If USER is omitted, close the current query buffer if one -exists - except this is broken now ;-)" +`erc-query-display'. + +If USER is omitted, close the current query buffer if one exists +- except this is broken now ;-)" (interactive (list (read-from-minibuffer "Start a query with: " nil))) - (let ((session-buffer (erc-server-buffer))) + (let ((session-buffer (erc-server-buffer)) + (erc-join-buffer erc-query-display)) (if user (erc-query user session-buffer) ;; 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." (read-from-minibuffer (concat "Set topic of " (erc-default-target) ": ") (when erc-channel-topic - (cons (apply 'concat (butlast (split-string erc-channel-topic "\C-o"))) - 0))))) + (let ((ss (split-string erc-channel-topic "\C-o"))) + (cons (apply 'concat (if (cdr ss) (butlast ss) ss)) + 0)))))) (let ((topic-list (split-string topic "\C-o"))) ; strip off the topic setter (erc-cmd-TOPIC (concat (erc-default-target) " " (car topic-list))))) @@ -3841,20 +3892,22 @@ To change how this query window is displayed, use `let' to bind (erc-update-mode-line) buf)) -(defcustom erc-auto-query 'bury +(defcustom erc-auto-query 'window-noselect "If non-nil, create a query buffer each time you receive a private message. +If the buffer doesn't already exist, it is created. -If the buffer doesn't already exist it is created. This can be -set to a symbol, to control how the new query window should -appear. See the documentation for `erc-join-buffer' for -available choices." +This can be set to a symbol, to control how the new query window +should appear. The default behavior is to display the buffer in +a new window, but not to select it. See the documentation for +`erc-join-buffer' for a description of the available choices." :group 'erc-query - :type '(choice (const nil) - (const buffer) - (const window) - (const window-noselect) - (const bury) - (const frame))) + :type '(choice (const :tag "Don't create query window" nil) + (const :tag "Split window and select" window) + (const :tag "Split window, don't select" window-noselect) + (const :tag "New frame" frame) + (const :tag "Bury in new buffer" bury) + (const :tag "Use current buffer" buffer) + (const :tag "Use current buffer" t))) (defcustom erc-query-on-unjoined-chan-privmsg t "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." ;; Mode line handling -(defcustom erc-mode-line-format "%s %a" +(defcustom erc-mode-line-format "%S %a" "A string to be formatted and shown in the mode-line in `erc-mode'. The string is formatted using `format-spec' and the result is set as the value @@ -5833,12 +5886,16 @@ The following characters are replaced: %l: The estimated lag time to the server %m: The modes of the channel %n: The current nick name +%N: The name of the network %o: The topic of the channel %p: The session port %t: The name of the target (channel, nickname, or servername:port) %s: In the server-buffer, this gets filled with the value of `erc-server-announced-name', in a channel, the value of - (erc-default-target) also get concatenated." + (erc-default-target) also get concatenated. +%S: In the server-buffer, this gets filled with the value of + `erc-network', in a channel, the value of (erc-default-target) + also get concatenated." :group 'erc-mode-line-and-header :type 'string) @@ -5932,6 +5989,29 @@ This should be a string with substitution variables recognized by (server-name server-name) (t (buffer-name (current-buffer)))))) +(defun erc-format-network () + "Return the name of the network we are currently on." + (let ((network (and (fboundp 'erc-network-name) (erc-network-name)))) + (if (and network (symbolp network)) + (symbol-name network) + ""))) + +(defun erc-format-target-and/or-network () + "Return the network or the current target and network combined. +If the name of the network is not available, then use the +shortened server name instead." + (let ((network-name (or (and (fboundp 'erc-network-name) (erc-network-name)) + (erc-shorten-server-name + (or erc-server-announced-name + erc-session-server))))) + (when (and network-name (symbolp network-name)) + (setq network-name (symbol-name network-name))) + (cond ((erc-default-target) + (concat (erc-string-no-properties (erc-default-target)) + "@" network-name)) + (network-name network-name) + (t (buffer-name (current-buffer)))))) + (defun erc-format-away-status () "Return a formatted `erc-mode-line-away-status-format' if `erc-away' is non-nil." @@ -5975,9 +6055,11 @@ if `erc-away' is non-nil." ?l (erc-format-lag-time) ?m (erc-format-channel-modes) ?n (or (erc-current-nick) "") + ?N (erc-format-network) ?o (erc-controls-strip erc-channel-topic) ?p (erc-port-to-string erc-session-port) ?s (erc-format-target-and/or-server) + ?S (erc-format-target-and/or-network) ?t (erc-format-target))) (process-status (cond ((and (erc-server-process-alive) (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 ("\\.bib\\'" . ffap-bib) ; search ffap-bib-path ("\\`\\." . ffap-home) ; .emacs, .bashrc, .profile ("\\`~/" . ffap-lcd) ; |~/misc/ffap.el.Z| - ("^[Rr][Ff][Cc][- #]?\\([0-9]+\\)" ; no $ + ;; This uses to have a blank, but ffap-string-at-point doesn't + ;; handle blanks. + ;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg01058.html + ("^[Rr][Ff][Cc][-#]?\\([0-9]+\\)" ; no $ . ffap-rfc) ; "100% RFC2100 compliant" (dired-mode . ffap-dired) ; maybe in a subdirectory ) @@ -969,7 +972,7 @@ If t, `ffap-tex-init' will initialize this when needed.") ;; Slightly controversial decisions: ;; * strip trailing "@" and ":" ;; * no commas (good for latex) - (file "--:$+<>@-Z_[:lower:]~*?" "<@" "@>;.,!:") + (file "--:\\\\$+<>@-Z_[:lower:]~*?" "<@" "@>;.,!:") ;; An url, or maybe a email/news message-id: (url "--:=&?$+@-Z_[:lower:]~#,%;*" "^[:alnum:]" ":;.,!?") ;; Find a string that does *not* contain a colon: @@ -1263,20 +1266,25 @@ which may actually result in an url rather than a filename." (setq dir (file-name-directory guess)))) (let ((minibuffer-completing-file-name t) (completion-ignore-case read-file-name-completion-ignore-case) - ;; because of `rfn-eshadow-update-overlay'. - (file-name-handler-alist - (cons (cons ffap-url-regexp 'url-file-handler) - file-name-handler-alist))) - (setq guess - (completing-read - prompt - 'ffap-read-file-or-url-internal - dir - nil - (if dir (cons guess (length dir)) guess) - (list 'file-name-history) - (and buffer-file-name - (abbreviate-file-name buffer-file-name))))) + (fnh-elem (cons ffap-url-regexp 'url-file-handler))) + ;; Explain to `rfn-eshadow' that we can use URLs here. + (push fnh-elem file-name-handler-alist) + (unwind-protect + (setq guess + (completing-read + prompt + 'ffap-read-file-or-url-internal + dir + nil + (if dir (cons guess (length dir)) guess) + (list 'file-name-history) + (and buffer-file-name + (abbreviate-file-name buffer-file-name)))) + ;; Remove the special handler manually. We used to just let-bind + ;; file-name-handler-alist to preserve its value, but that caused + ;; other modifications to be lost (e.g. when Tramp gets loaded + ;; during the completing-read call). + (setq file-name-handler-alist (delq fnh-elem file-name-handler-alist)))) ;; Do file substitution like (interactive "F"), suggested by MCOOK. (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess))) ;; 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." :group 'find-file :type 'alist) -(defcustom safe-local-eval-forms nil +(defcustom safe-local-eval-forms '((add-hook 'write-file-hooks 'time-stamp)) "Expressions that are considered safe in an `eval:' local variable. Add expressions to this list if you want Emacs to evaluate them, when they appear in an `eval' local variable specification, without first asking you for confirmation." :group 'find-file - :version "22.1" + :version "22.2" :type '(repeat sexp)) ;; Risky local variables: @@ -2839,7 +2839,8 @@ is specified, returning t if it is specified." (dolist (elt result) (let ((var (car elt)) (val (cdr elt))) - (or (eq var 'mode) + ;; Don't query about the fake variables. + (or (memq var '(mode unibyte coding)) (and (eq var 'eval) (or (eq enable-local-eval t) (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." (defun display-mm-height (&optional display) "Return the height of DISPLAY's screen in millimeters. -System values can be overriden by `display-mm-dimensions-alist'. +System values can be overridden by `display-mm-dimensions-alist'. If the information is unavailable, value is nil." (and (memq (framep-on-display display) '(x w32 mac)) (or (cddr (assoc (or display (frame-parameter nil 'display)) @@ -1264,7 +1264,7 @@ If the information is unavailable, value is nil." (defun display-mm-width (&optional display) "Return the width of DISPLAY's screen in millimeters. -System values can be overriden by `display-mm-dimensions-alist'. +System values can be overridden by `display-mm-dimensions-alist'. If the information is unavailable, value is nil." (and (memq (framep-on-display display) '(x w32 mac)) (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 @@ (defvar fringe-mode) +(defvar fringe-mode-explicit nil + "Non-nil means `set-fringe-mode' should really do something. +This is nil while loading `fringe.el', and t afterward.") + (defun set-fringe-mode-1 (ignore value) "Call `set-fringe-mode' with VALUE. See `fringe-mode' for valid values and their effect. @@ -104,13 +108,14 @@ This is usually invoked when setting `fringe-mode' via customize." See `fringe-mode' for possible values and their effect." (setq fringe-mode value) - (modify-all-frames-parameters - (list (cons 'left-fringe (if (consp fringe-mode) - (car fringe-mode) - fringe-mode)) - (cons 'right-fringe (if (consp fringe-mode) - (cdr fringe-mode) - fringe-mode))))) + (when fringe-mode-explicit + (modify-all-frames-parameters + (list (cons 'left-fringe (if (consp fringe-mode) + (car fringe-mode) + fringe-mode)) + (cons 'right-fringe (if (consp fringe-mode) + (cdr fringe-mode) + fringe-mode)))))) ;; For initialization of fringe-mode, take account of changes ;; made explicitly to default-frame-alist. @@ -159,6 +164,10 @@ you can use the interactive function `set-fringe-style'." :initialize 'fringe-mode-initialize :set 'set-fringe-mode-1) +;; We just set fringe-mode, but that was the default. +;; If it is set again, that is for real. +(setq fringe-mode-explicit t) + (defun fringe-query-style (&optional all-frames) "Query user for fringe style. 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 @@ +2008-01-24 Michael Sperber <sperber@deinprogramm.de> + + * mail-source.el (mail-sources): Add `group' choice. + + * nnmail.el (nnmail-get-new-mail-1): Abstract this out to add another + parameter `in-group' to control into which group the articles go. + Add treatment of `group' mail-source. + +2008-01-24 Dan Nicolaescu <dann@ics.uci.edu> + + * sieve.el (sieve-make-overlay, sieve-overlay-put, sieve-overlays-at): + * message.el (message-beginning-of-line): Use featurep instead of bound + tests in order to resolve conditionals at compile time. + +2008-01-23 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-insert-mime-button): Don't decode description. + + * mm-decode.el (mm-dissect-buffer): Decode description. + + * mml.el (mml-to-mime): Encode message header first. + +2008-01-18 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-describe-bindings): Make it possible to use + xrefs, i.e. [back] and [forward] buttons, in *Help* buffer. + +2008-01-18 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-registry.el (gnus-registry-trim): Use append, not concat. + +2008-01-17 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-read-summary-keys): Work for some `A' + prefix keys. + (gnus-article-read-summary-send-keys): Use gnus-character-to-event. + (gnus-article-describe-bindings): Simplify; move XEmacs stuff to + gnus-xmas.el. + +2008-01-16 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-registry.el (gnus-registry-marks, gnus-registry-default-mark): + Add new variables for article mark management. + (gnus-registry-extra-entries-precious, gnus-registry-trim): Define a + list of extra data entries which, when present, will indicate that the + article ID should not be trimmed from the registry. + (gnus-registry-mark-article, gnus-registry-article-marks): Remove these + functions. + (gnus-registry-read-mark): New function to read a mark name from the + user. + (gnus-registry-set-article-mark, gnus-registry-remove-article-mark) + (gnus-registry-set-article-mark-internal): New functions to add and + remove marks. + (gnus-registry-get-article-marks): New function to show the marks for + an article, or retrieve them for further use. + +2008-01-16 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-describe-bindings): Show all `S' prefix + keys when no argument is given. + +2008-01-12 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-sum.el (gnus-article-sort-by-random) + (gnus-thread-sort-by-random): Fix doc strings. Reported by + jidanni@jidanni.org. + +2008-01-11 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-describe-bindings): New function. + (gnus-article-read-summary-keys): Use it. + (gnus-article-mode-map): Bind `C-h b' to it. + +2008-01-10 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-read-summary-keys): Work for `C-h' on + XEmacs. + (gnus-article-describe-key, gnus-article-describe-key-briefly): Protect + against non-character events. + +2008-01-09 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-group.el (gnus-group-read-ephemeral-gmane-group-url): New + command. + (gnus-group-read-ephemeral-gmane-group): Use optional argument RANGE + instead of END. Change name of the temp file. + (gnus-group-gmane-group-download-format): Add doc string. Make it + customizable. + +2008-01-09 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-send-map): New keymap for `S' prefix keys; + bind `S W' to gnus-article-wide-reply-with-original; set default + binding to gnus-article-read-summary-send-keys. + (gnus-article-read-summary-keys): Fix the order of keys; display + continuation keys correctly in the echo area; describe bindings + correctly when keys end with `C-h'. + (gnus-article-read-summary-send-keys): New function. + (gnus-article-describe-key, gnus-article-describe-key-briefly): Work + for gnus-article-read-summary-send-keys; display continuation keys + correctly in the echo area. + (gnus-article-reply-with-original): Ignore prefix argument. + (gnus-article-wide-reply-with-original): New function. + 2008-01-08 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-bookmark.el (gnus-bookmark-mouse-available-p): Don't test for @@ -19,12 +123,6 @@ * mml-sec.el, sieve-manage.el, smime.el: Simplify loading of password-cache or password. Suggested by Glenn Morris <rgm@gnu.org>. -2007-12-21 Teodor Zlatanov <tzz@lifelogs.com> - - * imap.el (imap-authenticate): Use current-buffer instead of buffer, - for the cases where imap-authenticate is called with a nil buffer - parameter. - 2007-12-19 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-art.el (gnus-article-browse-html-parts): Work for two or more @@ -328,12 +426,6 @@ * message.el (message-ignored-supersedes-headers): Add "X-ID". -2007-12-03 Nathan J. Williams <nathanw@MIT.EDU> (tiny change) - - * imap.el (imap-mailbox-status-asynch): Upcase STATUS items. - (imap-parse-status): Upcase status-att for servers that sends them - lower-case (e.g., MS Exchange 2007). - 2007-12-03 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-sum.el (gnus-uu-extract-map): Add a command for the yenc @@ -801,9 +893,6 @@ * webmail.el (webmail-debug): Replace mapcar called for effect with dolist. - * gnus-xmas.el (gnus-group-add-icon): Replace mapcar called for effect - with mapc. - 2007-10-24 Katsumi Yamaoka <yamaoka@jpl.org> * 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 @@ ;;; ecomplete.el --- electric completion of addresses and the like -;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; 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 "F" gnus-article-followup-with-original "\C-hk" gnus-article-describe-key "\C-hc" gnus-article-describe-key-briefly + "\C-hb" gnus-article-describe-bindings "\C-d" gnus-article-read-summary-keys "\M-*" gnus-article-read-summary-keys @@ -4225,6 +4226,13 @@ If variable `gnus-use-long-file-name' is non-nil, it is (substitute-key-definition 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) +(gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map) + "W" gnus-article-wide-reply-with-original) +(if (featurep 'xemacs) + (set-keymap-default-binding gnus-article-send-map + 'gnus-article-read-summary-send-keys) + (define-key gnus-article-send-map [t] 'gnus-article-read-summary-send-keys)) + (defun gnus-article-make-menu-bar () (unless (boundp 'gnus-article-commands-menu) (gnus-summary-make-menu-bar)) @@ -5447,9 +5455,7 @@ N is the numerical prefix." (mail-content-type-get (mm-handle-type handle) 'url) "")) (gnus-tmp-type (mm-handle-media-type handle)) - (gnus-tmp-description - (mail-decode-encoded-word-string (or (mm-handle-description handle) - ""))) + (gnus-tmp-description (or (mm-handle-description handle) "")) (gnus-tmp-dots (if (if displayed (car displayed) (mm-handle-displayed-p handle)) @@ -6234,26 +6240,27 @@ not have a face in `gnus-article-boring-faces'." "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" "=" "^" "\M-^" "|")) (nosave-but-article - '("A\r")) + '("A " "A<" "A>" "AM" "AP" "AR" "AT" "A\C-?" "A\M-\r" "A\r" "Ab" "Ae" + "An" "Ap" [?A (meta return)] [?A delete])) (nosave-in-article - '("\C-d")) + '("AS" "\C-d")) (up-to-top '("n" "Gn" "p" "Gp")) keys new-sum-point) (save-excursion (set-buffer gnus-article-current-summary) (let (gnus-pick-mode) - (push (or key last-command-event) unread-command-events) - (setq keys (if (featurep 'xemacs) - (events-to-keys (read-key-sequence nil)) - (read-key-sequence nil))))) + (setq unread-command-events (nconc unread-command-events + (list (or key last-command-event))) + keys (if (featurep 'xemacs) + (events-to-keys (read-key-sequence nil t)) + (read-key-sequence nil t))))) (message "") (cond ((eq (aref keys (1- (length keys))) ?\C-h) - (with-current-buffer gnus-article-current-summary - (describe-bindings (substring keys 0 -1)))) + (gnus-article-describe-bindings (substring keys 0 -1))) ((or (member keys nosaves) (member keys nosave-but-article) (member keys nosave-in-article)) @@ -6339,53 +6346,98 @@ not have a face in `gnus-article-boring-faces'." (signal (car err) (cdr err)) (ding)))))))) +(defun gnus-article-read-summary-send-keys () + (interactive) + (let ((unread-command-events (list (gnus-character-to-event ?S)))) + (gnus-article-read-summary-keys))) + (defun gnus-article-describe-key (key) - "Display documentation of the function invoked by KEY. KEY is a string." - (interactive "kDescribe key: ") + "Display documentation of the function invoked by KEY. +KEY is a string or a vector." + (interactive (list (let ((cursor-in-echo-area t)) ;; better for XEmacs. + (read-key-sequence "Describe key: ")))) (gnus-article-check-buffer) - (if (eq (key-binding key) 'gnus-article-read-summary-keys) + (if (memq (key-binding key t) '(gnus-article-read-summary-keys + gnus-article-read-summary-send-keys)) (save-excursion (set-buffer gnus-article-current-summary) - (let (gnus-pick-mode) - (if (featurep 'xemacs) - (progn - (push (elt key 0) unread-command-events) - (setq key (events-to-keys - (read-key-sequence "Describe key: ")))) - (setq unread-command-events - (mapcar - (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x)) - (string-to-list key))) - (setq key (read-key-sequence "Describe key: ")))) - (describe-key key)) + (setq unread-command-events + (if (featurep 'xemacs) + (append key nil) + (mapcar (lambda (x) (if (and (integerp x) (>= x 128)) + (list 'meta (- x 128)) + x)) + key))) + (let ((cursor-in-echo-area t) + gnus-pick-mode) + (describe-key (read-key-sequence nil t)))) (describe-key key))) (defun gnus-article-describe-key-briefly (key &optional insert) - "Display documentation of the function invoked by KEY. KEY is a string." - (interactive "kDescribe key: \nP") + "Display documentation of the function invoked by KEY. +KEY is a string or a vector." + (interactive (list (let ((cursor-in-echo-area t)) ;; better for XEmacs. + (read-key-sequence "Describe key: ")) + current-prefix-arg)) (gnus-article-check-buffer) - (if (eq (key-binding key) 'gnus-article-read-summary-keys) + (if (memq (key-binding key t) '(gnus-article-read-summary-keys + gnus-article-read-summary-send-keys)) (save-excursion (set-buffer gnus-article-current-summary) - (let (gnus-pick-mode) - (if (featurep 'xemacs) - (progn - (push (elt key 0) unread-command-events) - (setq key (events-to-keys - (read-key-sequence "Describe key: ")))) - (setq unread-command-events - (mapcar - (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x)) - (string-to-list key))) - (setq key (read-key-sequence "Describe key: ")))) - (describe-key-briefly key insert)) + (setq unread-command-events + (if (featurep 'xemacs) + (append key nil) + (mapcar (lambda (x) (if (and (integerp x) (>= x 128)) + (list 'meta (- x 128)) + x)) + key))) + (let ((cursor-in-echo-area t) + gnus-pick-mode) + (describe-key-briefly (read-key-sequence nil t) insert))) (describe-key-briefly key insert))) +;;`gnus-agent-mode' in gnus-agent.el will define it. +(defvar gnus-agent-summary-mode) + +(defun gnus-article-describe-bindings (&optional prefix) + "Show a list of all defined keys, and their definitions. +The optional argument PREFIX, if non-nil, should be a key sequence; +then we display only bindings that start with that prefix." + (interactive) + (gnus-article-check-buffer) + (let ((keymap (copy-keymap gnus-article-mode-map)) + (map (copy-keymap gnus-article-send-map)) + (sumkeys (where-is-internal 'gnus-article-read-summary-keys)) + agent) + (define-key keymap "S" map) + (define-key map [t] nil) + (with-current-buffer gnus-article-current-summary + (set-keymap-parent map (key-binding "S")) + (let (def gnus-pick-mode) + (dolist (key sumkeys) + (when (setq def (key-binding key)) + (define-key keymap key def)))) + (when (boundp 'gnus-agent-summary-mode) + (setq agent gnus-agent-summary-mode))) + (with-temp-buffer + (use-local-map keymap) + (set (make-local-variable 'gnus-agent-summary-mode) agent) + (describe-bindings prefix)) + (let ((item `((lambda (prefix) + (save-excursion + (set-buffer ,(current-buffer)) + (gnus-article-describe-bindings prefix))) + ,prefix))) + (with-current-buffer (if (fboundp 'help-buffer) + (let (help-xref-following) (help-buffer)) + "*Help*") ;; Emacs 21 + (setq help-xref-stack-item item))))) + (defun gnus-article-reply-with-original (&optional wide) "Start composing a reply mail to the current message. The text in the region will be yanked. If the region isn't active, the entire article will be yanked." - (interactive "P") + (interactive) (let ((article (cdr gnus-article-current)) contents) (if (not (gnus-region-active-p)) @@ -6400,6 +6452,13 @@ the entire article will be yanked." (gnus-summary-reply (list (list article contents)) wide))))) +(defun gnus-article-wide-reply-with-original () + "Start composing a wide reply mail to the current message. +The text in the region will be yanked. If the region isn't active, +the entire article will be yanked." + (interactive) + (gnus-article-reply-with-original t)) + (defun gnus-article-followup-with-original () "Compose a followup to the current article. 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 @@ ;;; gnus-bookmark.el --- Bookmarks in Gnus -;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. ;; Author: Bastien Guerry <bzg AT altern DOT org> ;; 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." (message "Quit reading the ephemeral group") nil))))) -(defvar gnus-group-gmane-group-download-format - "http://download.gmane.org/%s/%s/%s") -(autoload 'url-insert-file-contents "url-handlers") +(defcustom gnus-group-gmane-group-download-format + "http://download.gmane.org/%s/%s/%s" + "URL for downloading mbox files. +It must contain three \"%s\". They correspond to the group, the +minimal and maximal article numbers, respectively." + :group 'gnus-group-foreign + :version "23.0" ;; No Gnus + :type 'string) -;; FIXME: Make gnus-group-gmane-group-download-format customizable. Add -;; documentation, menu, key bindings... +(autoload 'url-insert-file-contents "url-handlers") +;; FIXME: +;; - Add documentation, menu, key bindings, ... -(defun gnus-group-read-ephemeral-gmane-group (group start end) +(defun gnus-group-read-ephemeral-gmane-group (group start &optional range) "Read articles from Gmane group GROUP as an ephemeral group. -START and END specify the articles range. The articles are -downloaded via HTTP using the URL specified by -`gnus-group-gmane-group-download-format'." +START is the first article. RANGE specifies how many articles +are fetched. The articles are downloaded via HTTP using the URL +specified by `gnus-group-gmane-group-download-format'." ;; See <http://gmane.org/export.php> for more information. (interactive (list (gnus-group-completing-read "Gmane group: ") (read-number "Start article number: ") - (read-number "End article number: "))) - (when (< (- end start) 0) - (error "Invalid range.")) - (when (> (- end start) - (min (or gnus-large-ephemeral-newsgroup 100) 100)) - (unless (y-or-n-p - (format "Large range (%s to %s), continue anyway? " - start end)) - (error "Range too large. Aborted."))) - (let ((tmpfile (make-temp-file "gmane.gnus-temp-group-"))) + (read-number "How many articles: "))) + (unless range (setq range 500)) + (when (< range 1) + (error "Invalid range: %s" range)) + (let ((tmpfile (make-temp-file + (format "%s.start-%s.range-%s." group start range))) + (gnus-thread-sort-functions '(gnus-thread-sort-by-number))) (with-temp-file tmpfile (url-insert-file-contents (format gnus-group-gmane-group-download-format - group start end)) + group start (+ start range))) (write-region (point-min) (point-max) tmpfile) (gnus-group-read-ephemeral-group - "rs-gnus-read-gmane" + (format "%s.start-%s.range-%s" group start range) `(nndoc ,tmpfile (nndoc-article-type guess)))) (delete-file tmpfile))) +(defun gnus-group-read-ephemeral-gmane-group-url (url) + "Create an ephemeral Gmane group from URL. + +Valid input formats include: +\"http://thread.gmane.org/gmane.foo.bar/12300/focus=12399\", +\"http://thread.gmane.org/gmane.foo.bar/12345/\", +\"http://article.gmane.org/gmane.foo.bar/12345/\", +\"http://news.gmane.org/group/gmane.foo.bar/thread=12345\"" + ;; - Feel free to add other useful Gmane URLs here! Maybe the URLs should + ;; be customizable? + ;; - The URLs should be added to `gnus-button-alist'. Probably we should + ;; prompt the user to decide: "View via `browse-url' or in Gnus? " + ;; (`gnus-group-read-ephemeral-gmane-group-url') + (interactive + (list (gnus-group-completing-read "Gmane URL: "))) + (let (group start range) + (cond + ;; URLs providing `group', `start' and `range': + ((string-match + ;; http://thread.gmane.org/gmane.emacs.devel/86326/focus=86525 + "^http://thread\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)/focus=\\([0-9]+\\)$" + url) + (setq group (match-string 1 url) + start (string-to-number (match-string 2 url)) + ;; Ensure that `range' is large enough to ensure focus article is + ;; included. + range (- (string-to-number (match-string 3 url)) + start -1))) + ;; URLs providing `group' and `start': + ((or (string-match + ;; http://article.gmane.org/gmane.comp.gnu.make.bugs/3584 + "^http://\\(?:thread\\|article\\)\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)" + url) + (string-match + ;; Don't advertize these in the doc string yet: + "^\\(?:nntp\\|news\\)://news\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)" + url) + (string-match + ;; http://news.gmane.org/group/gmane.emacs.gnus.general/thread=65099/force_load=t + "^http://news\.gmane\.org/group/\\([^/]+\\)/thread=\\([0-9]+\\)" + url)) + (setq group (match-string 1 url) + start (string-to-number (match-string 2 url)))) + (t + (error "Can't parse URL %s" url))) + (gnus-group-read-ephemeral-gmane-group group start range))) + (defun gnus-group-jump-to-group (group &optional prompt) "Jump to newsgroup GROUP. 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 @@ :test 'equal) "*The article registry by Message ID.") +(defcustom gnus-registry-marks + '(Important Work Personal To-Do Later) + "List of marks that `gnus-registry-mark-article' will offer for completion." + :group 'gnus-registry + :type '(repeat symbol)) + +(defcustom gnus-registry-default-mark 'To-Do + "The default mark." + :group 'gnus-registry + :type 'symbol) + (defcustom gnus-registry-unfollowed-groups '("delayed$" "drafts$" "queue$" "INBOX$") "List of groups that gnus-registry-split-fancy-with-parent won't return. The group names are matched, they don't have to be fully @@ -129,6 +140,16 @@ way." :group 'gnus-registry :type 'boolean) +(defcustom gnus-registry-extra-entries-precious '(marks) + "What extra entries are precious, meaning they won't get trimmed. +When you save the Gnus registry, it's trimmed to be no longer +than `gnus-registry-max-entries' (which is nil by default, so no +trimming happens). Any entries with extra data in this list (by +default, marks are included, so articles with marks are +considered precious) will not be trimmed." + :group 'gnus-registry + :type '(repeat symbol)) + (defcustom gnus-registry-cache-file (nnheader-concat (or gnus-dribble-directory gnus-home-directory "~/") @@ -313,30 +334,50 @@ way." (defun gnus-registry-trim (alist) "Trim alist to size, using gnus-registry-max-entries. -Also, drop all gnus-registry-ignored-groups matches." - (if (null gnus-registry-max-entries) +Also, drop all gnus-registry-ignored-groups matches. +Any entries with extra data (marks, currently) are left alone." + (if (null gnus-registry-max-entries) alist ; just return the alist ;; else, when given max-entries, trim the alist (let* ((timehash (make-hash-table - :size 4096 + :size 20000 + :test 'equal)) + (precious (make-hash-table + :size 20000 :test 'equal)) (trim-length (- (length alist) gnus-registry-max-entries)) - (trim-length (if (natnump trim-length) trim-length 0))) + (trim-length (if (natnump trim-length) trim-length 0)) + precious-list junk-list) (maphash (lambda (key value) - (puthash key (gnus-registry-fetch-extra key 'mtime) timehash)) + (let ((extra (gnus-registry-fetch-extra key))) + (dolist (item gnus-registry-extra-entries-precious) + (dolist (e extra) + (when (equal (nth 0 e) item) + (puthash key t precious) + (return)))) + (puthash key (gnus-registry-fetch-extra key 'mtime) timehash))) gnus-registry-hashtb) - - ;; we use the return value of this setq, which is the trimmed alist - (setq alist - (nthcdr - trim-length - (sort alist - (lambda (a b) - (time-less-p - (or (cdr (gethash (car a) timehash)) '(0 0 0)) - (or (cdr (gethash (car b) timehash)) '(0 0 0)))))))))) + (dolist (item alist) + (let ((key (nth 0 item))) + (if (gethash key precious) + (push item precious-list) + (push item junk-list)))) + + (sort + junk-list + (lambda (a b) + (let ((t1 (or (cdr (gethash (car a) timehash)) + '(0 0 0))) + (t2 (or (cdr (gethash (car b) timehash)) + '(0 0 0)))) + (time-less-p t1 t2)))) + + ;; we use the return value of this setq, which is the trimmed alist + (setq alist (append precious-list + (nthcdr trim-length junk-list)))))) + (defun gnus-registry-action (action data-header from &optional to method) (let* ((id (mail-header-id data-header)) (subject (gnus-string-remove-all-properties @@ -577,6 +618,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (assoc article (gnus-data-list nil))))) nil)) +;;; this should be redone with catch/throw (defun gnus-registry-grep-in-list (word list) (when word (memq nil @@ -586,80 +628,91 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (string-match word x)) list))))) -(defun gnus-registry-mark-article (article &optional mark remove) - "Mark ARTICLE with MARK in the Gnus registry or remove MARK. -MARK can be any symbol. If ARTICLE is nil, then the -`gnus-current-article' will be marked. If MARK is nil, -`gnus-registry-flag-default' will be used." - (interactive "nArticle number: ") - (let ((article (or article gnus-current-article)) - (mark (or mark 'gnus-registry-flag-default)) - article-id) - (unless article - (error "No article on current line")) - (setq article-id - (gnus-registry-fetch-message-id-fast gnus-current-article)) - (unless article-id - (error "No article ID could be retrieved")) - (let* ( - ;; all the marks for this article - (marks (gnus-registry-fetch-extra-flags article-id)) - ;; the marks without the mark of interest - (cleaned-marks (delq mark marks)) - ;; the new marks we want to use - (new-marks (if remove - cleaned-marks - (cons mark cleaned-marks)))) - (apply 'gnus-registry-store-extra-flags ; set the extra flags - article-id ; for the message ID - new-marks) - (gnus-registry-fetch-extra-flags article-id)))) - -(defun gnus-registry-article-marks (article) - "Get the Gnus registry marks for ARTICLE. -If ARTICLE is nil, then the `gnus-current-article' will be -used." - (interactive "nArticle number: ") - (let ((article (or article gnus-current-article)) - article-id) - (unless article - (error "No article on current line")) - (setq article-id - (gnus-registry-fetch-message-id-fast gnus-current-article)) - (unless article-id - (error "No article ID could be retrieved")) - (gnus-message 1 - "Message ID %s, Registry flags: %s" - article-id - (concat (gnus-registry-fetch-extra-flags article-id))))) - - -;;; if this extends to more than 'flags, it should be improved to be more generic. -(defun gnus-registry-fetch-extra-flags (id) - "Get the flags of a message, based on the message ID. -Returns a list of symbol flags or nil." - (car-safe (cdr (gnus-registry-fetch-extra id 'flags)))) - -(defun gnus-registry-has-extra-flag (id flag) - "Checks if a message has `flag', based on the message ID." - (memq flag (gnus-registry-fetch-extra-flags id))) - -(defun gnus-registry-store-extra-flags (id &rest flag-list) - "Set the flags of a message, based on the message ID. -The `flag-list' can be nil, in which case no flags are left." - (gnus-registry-store-extra-entry id 'flags (list flag-list))) - -(defun gnus-registry-delete-extra-flags (id &rest flag-delete-list) - "Delete the message flags in `flag-delete-list', based on the message ID." - (let ((flags (gnus-registry-fetch-extra-flags id))) - (when flags - (dolist (flag flag-delete-list) - (setq flags (delq flag flags)))) - (gnus-registry-store-extra-flags id (car flags)))) - -(defun gnus-registry-delete-all-extra-flags (id) - "Delete all the flags for a message ID." - (gnus-registry-store-extra-flags id nil)) + +(defun gnus-registry-read-mark () + "Read a mark name from the user with completion." + (let ((mark (gnus-completing-read-with-default + (symbol-name gnus-registry-default-mark) + "Label" + (mapcar (lambda (x) ; completion list + (cons (symbol-name x) x)) + gnus-registry-marks)))) + (when (stringp mark) + (intern mark)))) + +(defun gnus-registry-set-article-mark (&rest articles) + "Apply a mark to process-marked ARTICLES." + (interactive (gnus-summary-work-articles current-prefix-arg)) + (gnus-registry-set-article-mark-internal (gnus-registry-read-mark) articles nil t)) + +(defun gnus-registry-remove-article-mark (&rest articles) + "Remove a mark from process-marked ARTICLES." + (interactive (gnus-summary-work-articles current-prefix-arg)) + (gnus-registry-set-article-mark-internal (gnus-registry-read-mark) articles t t)) + +(defun gnus-registry-set-article-mark-internal (mark articles &optional remove show-message) + "Apply a mark to a list of ARTICLES." + (let ((article-id-list + (mapcar 'gnus-registry-fetch-message-id-fast articles))) + (dolist (id article-id-list) + (let* ( + ;; all the marks for this article without the mark of + ;; interest + (marks + (delq mark (gnus-registry-fetch-extra-marks id))) + ;; the new marks we want to use + (new-marks (if remove + marks + (cons mark marks)))) + (when show-message + (gnus-message 1 "%s mark %s with message ID %s, resulting in %S" + (if remove "Removing" "Adding") + mark id new-marks)) + + (apply 'gnus-registry-store-extra-marks ; set the extra marks + id ; for the message ID + new-marks))))) + +(defun gnus-registry-get-article-marks (&rest articles) + "Get the Gnus registry marks for ARTICLES and show them if interactive. +Uses process/prefix conventions. For multiple articles, +only the last one's marks are returned." + (interactive (gnus-summary-work-articles 1)) + (let (marks) + (dolist (article articles) + (let ((article-id + (gnus-registry-fetch-message-id-fast article))) + (setq marks (gnus-registry-fetch-extra-marks article-id)))) + (when (interactive-p) + (gnus-message 1 "Marks are %S" marks)) + marks)) + +;;; if this extends to more than 'marks, it should be improved to be more generic. +(defun gnus-registry-fetch-extra-marks (id) + "Get the marks of a message, based on the message ID. +Returns a list of symbol marks or nil." + (car-safe (cdr (gnus-registry-fetch-extra id 'marks)))) + +(defun gnus-registry-has-extra-mark (id mark) + "Checks if a message has `mark', based on the message ID `id'." + (memq mark (gnus-registry-fetch-extra-marks id))) + +(defun gnus-registry-store-extra-marks (id &rest mark-list) + "Set the marks of a message, based on the message ID. +The `mark-list' can be nil, in which case no marks are left." + (gnus-registry-store-extra-entry id 'marks (list mark-list))) + +(defun gnus-registry-delete-extra-marks (id &rest mark-delete-list) + "Delete the message marks in `mark-delete-list', based on the message ID." + (let ((marks (gnus-registry-fetch-extra-marks id))) + (when marks + (dolist (mark mark-delete-list) + (setq marks (delq mark marks)))) + (gnus-registry-store-extra-marks id (car marks)))) + +(defun gnus-registry-delete-all-extra-marks (id) + "Delete all the marks for a message ID." + (gnus-registry-store-extra-marks id nil)) (defun gnus-registry-fetch-extra (id &optional entry) "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." (gnus-thread-header h1) (gnus-thread-header h2))) (defsubst gnus-article-sort-by-random (h1 h2) - "Sort articles by article number." + "Sort articles randomly." (zerop (random 2))) (defun gnus-thread-sort-by-random (h1 h2) - "Sort threads by root article number." + "Sort threads randomly." (gnus-article-sort-by-random (gnus-thread-header h1) (gnus-thread-header h2))) 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'." (repeat :tag "List" (choice :format "%[Value Menu%] %v" :value (file) + (cons :tag "Group parameter `mail-source'" + (const :format "" group)) (cons :tag "Spool file" (const :format "" file) (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 between beginning of field and beginning of line." (interactive "p") (let ((zrs 'zmacs-region-stays)) - (when (and (interactive-p) (boundp zrs)) + (when (and (featurep 'xemacs) (interactive-p) (boundp zrs)) (set zrs t))) (if (and message-beginning-of-line (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 ;; creates unibyte buffers. This `if', though not a perfect ;; solution, avoids most of them. (if from - (setq from (cadr (mail-extract-address-components from)))))) + (setq from (cadr (mail-extract-address-components from)))) + (if description + (setq description (mail-decode-encoded-word-string + description))))) (if (or (not ctl) (not (string-match "/" (car ctl)))) (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." (defun mml-to-mime () "Translate the current buffer from MML to MIME." - (message-encode-message-body) + ;; `message-encode-message-body' will insert an encoded Content-Description + ;; header in the message header if the body contains a single part + ;; that is specified by a user with a MML tag containing a description + ;; token. So, we encode the message header first to prevent the encoded + ;; Content-Description header from being encoded again. (save-restriction (message-narrow-to-headers-or-head) ;; Skip past any From_ headers. (while (looking-at "From ") (forward-line 1)) (let ((mail-parse-charset message-default-charset)) - (mail-encode-encoded-word-buffer)))) + (mail-encode-encoded-word-buffer))) + (message-encode-message-body)) (defun mml-insert-mime (handle &optional no-markup) (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." (symbol-value sym)))) (defun nnmail-get-new-mail (method exit-func temp - &optional group spool-func) + &optional group spool-func) "Read new incoming mail." + (nnmail-get-new-mail-1 method exit-func temp group nil spool-func)) + +(defun nnmail-get-new-mail-1 (method exit-func temp + group in-group spool-func) + (let* ((sources mail-sources) fetching-sources - (group-in group) (i 0) (new 0) (total 0) @@ -1778,6 +1782,18 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (when (and (nnmail-get-value "%s-get-new-mail" method) sources) (while (setq source (pop sources)) + + ;; Use group's parameter + (when (eq (car source) 'group) + (let ((mail-sources + (list + (gnus-group-find-parameter + (concat (symbol-name method) ":" group) + 'mail-source t)))) + (nnmail-get-new-mail-1 method exit-func temp + group group spool-func)) + (setq source nil)) + ;; Hack to only fetch the contents of a single group's spool file. (when (and (eq (car source) 'directory) (null nnmail-scan-directory-mail-source-once) @@ -1816,9 +1832,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (nnmail-split-incoming file ',(intern (format "%s-save-mail" method)) ',spool-func - (if (equal file orig-file) - nil - (nnmail-get-split-group orig-file ',source)) + (or in-group + (if (equal file orig-file) + nil + (nnmail-get-split-group orig-file ',source))) ',(intern (format "%s-active-number" method))))))) (incf total new) (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") " (get-char-property (or pos (point)) 'script-name)) (eval-and-compile - (defalias 'sieve-make-overlay (if (fboundp 'make-overlay) - 'make-overlay - 'make-extent)) - (defalias 'sieve-overlay-put (if (fboundp 'overlay-put) - 'overlay-put - 'set-extent-property)) - (defalias 'sieve-overlays-at (if (fboundp 'overlays-at) - 'overlays-at - 'extents-at))) + (defalias 'sieve-make-overlay (if (featurep 'xemacs) + 'make-extent + 'make-overlay)) + (defalias 'sieve-overlay-put (if (featurep 'xemacs) + 'set-extent-property + 'overlay-put)) + (defalias 'sieve-overlays-at (if (featurep 'xemacs) + 'extents-at + 'overlays-at))) (defun sieve-highlight (on) "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 @@ ;;; spam-wash.el --- wash spam before analysis -;; Copyright (C) 2004, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2007, 2008 Free Software Foundation, Inc. ;; Author: Andrew Cohen <cohen@andy.bu.edu> ;; 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." (let ((mode mode-name)) (with-current-buffer standard-output (let ((start (point))) - (insert (format-mode-line mode)) + (insert (format-mode-line mode nil nil buffer)) (add-text-properties start (point) '(face bold))))) (princ " mode:\n") (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 (ignore-errors (with-current-buffer buf (when (and ibuffer-auto-mode - (eq major-mode 'ibuffer-mode)) + (derived-mode-p 'ibuffer-mode)) (ibuffer-update nil t))))))) ;;;###autoload @@ -236,15 +236,14 @@ Currently, this only applies to `ibuffer-saved-filters' and "Toggle use of Ibuffer's auto-update facility. With numeric ARG, enable auto-update if and only if ARG is positive." (interactive) - (unless (eq major-mode 'ibuffer-mode) + (unless (derived-mode-p 'ibuffer-mode) (error "This buffer is not in Ibuffer mode")) (set (make-local-variable 'ibuffer-auto-mode) (if arg (plusp arg) (not ibuffer-auto-mode))) (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) ; Initialize state vector - (add-hook 'post-command-hook 'ibuffer-auto-update-changed) - (ibuffer-update-mode-name)) + (add-hook 'post-command-hook 'ibuffer-auto-update-changed)) ;;;###autoload (defun ibuffer-mouse-filter-by-mode (event) @@ -731,8 +730,7 @@ prompt for NAME, and use the current filters." (ibuffer-aif (assoc name ibuffer-saved-filter-groups) (setcdr it groups) (push (cons name groups) ibuffer-saved-filter-groups)) - (ibuffer-maybe-save-stuff) - (ibuffer-update-mode-name)) + (ibuffer-maybe-save-stuff)) ;;;###autoload (defun ibuffer-delete-saved-filter-groups (name) @@ -897,8 +895,7 @@ Interactively, prompt for NAME, and use the current filters." (ibuffer-aif (assoc name ibuffer-saved-filters) (setcdr it filters) (push (list name filters) ibuffer-saved-filters)) - (ibuffer-maybe-save-stuff) - (ibuffer-update-mode-name)) + (ibuffer-maybe-save-stuff)) ;;;###autoload (defun ibuffer-delete-saved-filters (name) @@ -1158,6 +1155,20 @@ Ordering is lexicographic." (with-current-buffer (car b) (buffer-size)))) +;;;###autoload (autoload 'ibuffer-do-sort-by-filename/process "ibuf-ext") +(define-ibuffer-sorter filename/process + "Sort the buffers by their file name/process name." + (:description "file name") + (string-lessp + ;; FIXME: For now just compare the file name and the process name + ;; (if it exists). Is there a better way to do this? + (or (buffer-file-name (car a)) + (let ((pr-a (get-buffer-process (car a)))) + (and (processp pr-a) (process-name pr-a)))) + (or (buffer-file-name (car b)) + (let ((pr-b (get-buffer-process (car b)))) + (and (processp pr-b) (process-name pr-b)))))) + ;;; Functions to emulate bs.el ;;;###autoload @@ -1386,7 +1397,7 @@ You can then feed the file name(s) to other commands with \\[yank]." (ibuffer-mark-on-buffer #'(lambda (buf) (with-current-buffer buf - (string-match regexp (format-mode-line mode-name)))))) + (string-match regexp (format-mode-line mode-name nil nil buf)))))) ;;;###autoload (defun ibuffer-mark-by-file-name-regexp (regexp) @@ -1539,5 +1550,5 @@ defaults to one." (provide 'ibuf-ext) -;;; arch-tag: 9af21953-deda-4c30-b76d-f81d9128e76d +;; arch-tag: 9af21953-deda-4c30-b76d-f81d9128e76d ;;; 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." :type '(choice (const :tag "Last view time" :value recency) (const :tag "Lexicographic" :value alphabetic) (const :tag "Buffer size" :value size) + (const :tag "File name" :value filename/process) (const :tag "Major mode" :value major-mode)) :group 'ibuffer) (defvar ibuffer-sorting-mode nil) @@ -447,6 +448,7 @@ directory, like `default-directory'." (define-key map (kbd "s a") 'ibuffer-do-sort-by-alphabetic) (define-key map (kbd "s v") 'ibuffer-do-sort-by-recency) (define-key map (kbd "s s") 'ibuffer-do-sort-by-size) + (define-key map (kbd "s f") 'ibuffer-do-sort-by-filename/process) (define-key map (kbd "s m") 'ibuffer-do-sort-by-major-mode) (define-key map (kbd "/ m") 'ibuffer-filter-by-mode) @@ -828,6 +830,11 @@ directory, like `default-directory'." (define-key map [down-mouse-3] 'ibuffer-mouse-popup-menu) map)) +(defvar ibuffer-filename/process-header-map + (let ((map (make-sparse-keymap))) + (define-key map [(mouse-1)] 'ibuffer-do-sort-by-filename/process) + map)) + (defvar ibuffer-mode-name-map (let ((map (make-sparse-keymap))) (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." ('mouse-face 'highlight 'keymap ibuffer-mode-name-map 'help-echo "mouse-2: filter by this mode")) - (format-mode-line mode-name)) + (format-mode-line mode-name nil nil (current-buffer))) (define-ibuffer-column process (:summarizer @@ -1753,6 +1760,7 @@ If point is on a group name, this function operates on that group." (define-ibuffer-column filename-and-process (:name "Filename/Process" + :header-mouse-map ibuffer-filename/process-header-map :summarizer (lambda (strings) (setq strings (delete "" strings)) @@ -2097,29 +2105,6 @@ the value of point at the beginning of the line for that buffer." (point)) `(ibuffer-summary t))))) -(defun ibuffer-update-mode-name () - (setq mode-name (format "Ibuffer by %s" (if ibuffer-sorting-mode - ibuffer-sorting-mode - "view time"))) - (when ibuffer-sorting-reversep - (setq mode-name (concat mode-name " [rev]"))) - (when (and (featurep 'ibuf-ext) - ibuffer-auto-mode) - (setq mode-name (concat mode-name " (Auto)"))) - (let ((result "")) - (when (featurep 'ibuf-ext) - (dolist (qualifier ibuffer-filtering-qualifiers) - (setq result - (concat result (ibuffer-format-qualifier qualifier)))) - (if ibuffer-use-header-line - (setq header-line-format - (when ibuffer-filtering-qualifiers - (replace-regexp-in-string "%" "%%" - (concat mode-name result)))) - (progn - (setq mode-name (concat mode-name result)) - (when (boundp 'header-line-format) - (setq header-line-format nil))))))) (defun ibuffer-redisplay (&optional silent) "Redisplay the current list of buffers. @@ -2137,7 +2122,6 @@ If optional arg SILENT is non-nil, do not display progress messages." (message "No buffers! (note: filtering in effect)") (error "No buffers!"))) (ibuffer-redisplay-engine blist t) - (ibuffer-update-mode-name) (unless silent (message "Redisplaying current buffer list...done")) (ibuffer-forward-line 0))) @@ -2174,7 +2158,6 @@ If optional arg SILENT is non-nil, do not display progress messages." (unless silent (message "Updating buffer list...")) (ibuffer-redisplay-engine blist arg) - (ibuffer-update-mode-name) (unless silent (message "Updating buffer list...done"))) (if (eq ibuffer-shrink-to-minimum-size 'onewindow) @@ -2458,6 +2441,7 @@ Sorting commands: '\\[ibuffer-toggle-sorting-mode]' - Rotate between the various sorting modes. '\\[ibuffer-invert-sorting]' - Reverse the current sorting order. '\\[ibuffer-do-sort-by-alphabetic]' - Sort the buffers lexicographically. + '\\[ibuffer-do-sort-by-filename/process]' - Sort the buffers by the file name. '\\[ibuffer-do-sort-by-recency]' - Sort the buffers by last viewing time. '\\[ibuffer-do-sort-by-size]' - Sort the buffers by size. '\\[ibuffer-do-sort-by-major-mode]' - Sort the buffers by major mode. @@ -2540,6 +2524,28 @@ will be inserted before the group at point." (use-local-map ibuffer-mode-map) (setq major-mode 'ibuffer-mode) (setq mode-name "Ibuffer") + ;; Include state info next to the mode name. + (set (make-local-variable 'mode-line-process) + '(" by " + (ibuffer-sorting-mode (:eval (symbol-name ibuffer-sorting-mode)) + "view time") + (ibuffer-sorting-reversep " [rev]") + (ibuffer-auto-mode " (Auto)") + ;; Only list the filters if they're not already in the header-line. + (header-line-format + "" + (:eval (if (functionp 'ibuffer-format-qualifier) + (mapconcat 'ibuffer-format-qualifier + ibuffer-filtering-qualifiers "")))))) + (setq header-line-format + (if ibuffer-use-header-line + ;; Display the part that won't be in the mode-line. + (list* "" mode-name + (mapcar (lambda (elem) + (if (eq (car-safe elem) 'header-line-format) + (nth 2 elem) elem)) + mode-line-process)))) + (setq buffer-read-only t) (buffer-disable-undo) (setq truncate-lines ibuffer-truncate-lines) @@ -2578,9 +2584,7 @@ will be inserted before the group at point." (when ibuffer-default-directory (setq default-directory ibuffer-default-directory)) (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) - (run-mode-hooks 'ibuffer-mode-hook) - ;; called after mode hooks to allow the user to add filters - (ibuffer-update-mode-name)) + (run-mode-hooks 'ibuffer-mode-hook)) (provide 'ibuffer) @@ -2590,5 +2594,5 @@ will be inserted before the group at point." ;; coding: iso-8859-1 ;; End: -;;; arch-tag: 72581688-0603-4954-b8cf-837c700f62e8 +;; arch-tag: 72581688-0603-4954-b8cf-837c700f62e8 ;;; 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." (save-excursion (let* ((sym (intern func-name)) (buf (other-buffer nil t)) - (map (save-excursion (set-buffer buf) (current-local-map))) - (keys (where-is-internal sym map))) + (keys (with-current-buffer buf (where-is-internal sym)))) (if keys (concat "<" (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 @@ ;;; Image scrolling functions +(defvar image-mode-current-vscroll nil + "An alist with elements (WINDOW . VSCROLL).") + +(defvar image-mode-current-hscroll nil + "An alist with elements (WINDOW . HSCROLL).") + +(defun image-set-window-vscroll (window vscroll &optional pixels-p) + (setq image-mode-current-vscroll + (append (list (cons window vscroll)) + (delete (assoc window image-mode-current-vscroll) + image-mode-current-vscroll))) + (set-window-vscroll window vscroll pixels-p)) + +(defun image-set-window-hscroll (window ncol) + (setq image-mode-current-hscroll + (append (list (cons window ncol)) + (delete (assoc window image-mode-current-hscroll) + image-mode-current-hscroll))) + (set-window-hscroll window ncol)) + +(defun image-reset-current-vhscroll () + (let ((win (selected-window))) + (when (assoc win image-mode-current-hscroll) + (set-window-hscroll win (cdr (assoc win image-mode-current-hscroll)))) + (when (assoc win image-mode-current-vscroll) + (set-window-vscroll win (cdr (assoc win image-mode-current-vscroll)))))) + (defun image-forward-hscroll (&optional n) "Scroll image in current window to the left by N character widths. Stop if the right edge of the image is reached." (interactive "p") (cond ((= n 0) nil) ((< n 0) - (set-window-hscroll (selected-window) - (max 0 (+ (window-hscroll) n)))) + (image-set-window-hscroll (selected-window) + (max 0 (+ (window-hscroll) n)))) (t (let* ((image (get-char-property (point-min) 'display)) (edges (window-inside-edges)) (win-width (- (nth 2 edges) (nth 0 edges))) (img-width (ceiling (car (image-size image))))) - (set-window-hscroll (selected-window) - (min (max 0 (- img-width win-width)) - (+ n (window-hscroll)))))))) + (image-set-window-hscroll (selected-window) + (min (max 0 (- img-width win-width)) + (+ n (window-hscroll)))))))) (defun image-backward-hscroll (&optional n) "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." (interactive "p") (cond ((= n 0) nil) ((< n 0) - (set-window-vscroll (selected-window) - (max 0 (+ (window-vscroll) n)))) + (image-set-window-vscroll (selected-window) + (max 0 (+ (window-vscroll) n)))) (t (let* ((image (get-char-property (point-min) 'display)) (edges (window-inside-edges)) (win-height (- (nth 3 edges) (nth 1 edges))) (img-height (ceiling (cdr (image-size image))))) - (set-window-vscroll (selected-window) - (min (max 0 (- img-height win-height)) - (+ n (window-vscroll)))))))) + (image-set-window-vscroll (selected-window) + (min (max 0 (- img-height win-height)) + (+ n (window-vscroll)))))))) (defun image-previous-line (&optional n) "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." (and arg (/= (setq arg (prefix-numeric-value arg)) 1) (image-next-line (- arg 1))) - (set-window-hscroll (selected-window) 0)) + (image-set-window-hscroll (selected-window) 0)) (defun image-eol (arg) "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." (edges (window-inside-edges)) (win-width (- (nth 2 edges) (nth 0 edges))) (img-width (ceiling (car (image-size image))))) - (set-window-hscroll (selected-window) - (max 0 (- img-width win-width))))) + (image-set-window-hscroll (selected-window) + (max 0 (- img-width win-width))))) (defun image-bob () "Scroll to the top-left corner of the image in the current window." (interactive) - (set-window-hscroll (selected-window) 0) - (set-window-vscroll (selected-window) 0)) + (image-set-window-hscroll (selected-window) 0) + (image-set-window-vscroll (selected-window) 0)) (defun image-eob () "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." (img-width (ceiling (car (image-size image)))) (win-height (- (nth 3 edges) (nth 1 edges))) (img-height (ceiling (cdr (image-size image))))) - (set-window-hscroll (selected-window) (max 0 (- img-width win-width))) - (set-window-vscroll (selected-window) (max 0 (- img-height win-height))))) + (image-set-window-hscroll (selected-window) (max 0 (- img-width win-width))) + (image-set-window-vscroll (selected-window) (max 0 (- img-height win-height))))) ;;; Image Mode setup @@ -224,6 +251,15 @@ to toggle between display as an image and display as text." ;; Use our own bookmarking function for images. (set (make-local-variable 'bookmark-make-cell-function) 'image-bookmark-make-cell) + + ;; Keep track of [vh]scroll when switching buffers + (make-local-variable 'image-mode-current-hscroll) + (make-local-variable 'image-mode-current-vscroll) + (image-set-window-hscroll (selected-window) (window-hscroll)) + (image-set-window-vscroll (selected-window) (window-vscroll)) + (add-hook 'window-configuration-change-hook + 'image-reset-current-vhscroll nil t) + (add-hook 'change-major-mode-hook 'image-toggle-display-text nil t) (if (and (display-images-p) (not (get-char-property (point-min) 'display))) @@ -255,9 +291,9 @@ See the command `image-mode' for more information on this mode." (setq image-type "text")) (add-hook 'change-major-mode-hook (lambda () (image-minor-mode -1)) nil t) (message "%s" (concat (substitute-command-keys - "Type \\[image-toggle-display] to view the image as ") - (if (get-char-property (point-min) 'display) - "text" "an image") ".")))) + "Type \\[image-toggle-display] to view the image as ") + (if (get-char-property (point-min) 'display) + "text" "an image") ".")))) ;;;###autoload (defun image-mode-maybe () @@ -333,9 +369,9 @@ and showing the image as an image." (image (create-image file-or-data type data-p)) (props `(display ,image - intangible ,image - rear-nonsticky (display intangible) - read-only t front-sticky (read-only))) + intangible ,image + rear-nonsticky (display intangible) + read-only t front-sticky (read-only))) (inhibit-read-only t) (buffer-undo-list t) (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 @@ ;;; isearch-multi.el --- isearch extensions for multi-buffer search -;; Copyright (C) 2007 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. ;; Author: Juri Linkov <juri@jurta.org> ;; 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 the change log file in another window. \(fn &optional WHOAMI FILE-NAME)" t nil) - (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window) (autoload 'change-log-mode "add-log" "\ 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'. ;;; Generated autoloads from calendar/appt.el (defvar appt-issue-message t "\ -*Non-nil means check for appointments in the diary buffer. +Non-nil means check for appointments in the diary buffer. To be detected, the diary entry must have the format described in the documentation of the function `appt-check'.") (custom-autoload 'appt-issue-message "appt" t) (defvar appt-message-warning-time 12 "\ -*Time in minutes before an appointment that the warning begins.") +Time in minutes before an appointment that the warning begins.") (custom-autoload 'appt-message-warning-time "appt" t) (defvar appt-audible t "\ -*Non-nil means beep to indicate appointment.") +Non-nil means beep to indicate appointment.") (custom-autoload 'appt-audible "appt" t) (defvar appt-visible t "\ -*Non-nil means display appointment message in echo area. +Non-nil means display appointment message in echo area. This variable is only relevant if `appt-msg-window' is nil.") (custom-autoload 'appt-visible "appt" t) (defvar appt-msg-window t "\ -*Non-nil means display appointment message in another window. +Non-nil means display appointment message in another window. If non-nil, this variable overrides `appt-visible'.") (custom-autoload 'appt-msg-window "appt" t) (defvar appt-display-mode-line t "\ -*Non-nil means display minutes to appointment and time on the mode line. +Non-nil means display minutes to appointment and time on the mode line. This is in addition to any other display of appointment messages.") (custom-autoload 'appt-display-mode-line "appt" t) (defvar appt-display-duration 10 "\ -*The number of seconds an appointment message is displayed. +The number of seconds an appointment message is displayed. Only relevant if reminders are to be displayed in their own window.") (custom-autoload 'appt-display-duration "appt" t) (defvar appt-display-diary t "\ -*Non-nil displays the diary when the appointment list is first initialized. +Non-nil displays the diary when the appointment list is first initialized. This will occur at midnight when the appointment list is updated.") (custom-autoload 'appt-display-diary "appt" t) @@ -1732,7 +1731,7 @@ b => (ba bb bc) ; assume b has this value Vectors work just like lists. Nested backquotes are permitted. -\(fn ARG)" nil (quote macro)) +\(fn STRUCTURE)" nil (quote macro)) (defalias '\` (symbol-function 'backquote)) @@ -1807,6 +1806,19 @@ non-interactive use see also `benchmark-run' and ;;;;;; 875)) ;;; Generated autoloads from textmodes/bibtex.el +(autoload 'bibtex-initialize "bibtex" "\ +(Re)Initialize BibTeX buffers. +Visit the BibTeX files defined by `bibtex-files' and return a list +of corresponding buffers. +Initialize in these buffers `bibtex-reference-keys' if not yet set. +List of BibTeX buffers includes current buffer if CURRENT is non-nil. +If FORCE is non-nil, (re)initialize `bibtex-reference-keys' even if +already set. If SELECT is non-nil interactively select a BibTeX buffer. +When called interactively, FORCE is t, CURRENT is t if current buffer uses +`bibtex-mode', and SELECT is t if current buffer does not use `bibtex-mode', + +\(fn &optional CURRENT FORCE SELECT)" t nil) + (autoload 'bibtex-mode "bibtex" "\ Major mode for editing BibTeX files. @@ -2828,7 +2840,7 @@ Must be used only with `-batch', and kills Emacs on completion. For example, invoke `emacs -batch -f batch-byte-recompile-directory .'. Optional argument ARG is passed as second argument ARG to -`batch-recompile-directory'; see there for its possible values +`byte-recompile-directory'; see there for its possible values and corresponding effects. \(fn &optional ARG)" nil nil) @@ -3371,7 +3383,7 @@ List of functions called for listing diary file and included files. As the files are processed for diary entries, these functions are used to cull relevant entries. You can use either or both of `list-hebrew-diary-entries', `list-islamic-diary-entries' and -`list-bahai-diary-entries'. The documentation for these functions +`diary-bahai-list-entries'. The documentation for these functions describes the style of such diary entries.") (custom-autoload 'nongregorian-diary-listing-hook "calendar" t) @@ -3825,7 +3837,29 @@ and exists only for compatibility reasons. ;;;### (autoloads nil "cc-subword" "progmodes/cc-subword.el" (18177 ;;;;;; 872)) ;;; Generated autoloads from progmodes/cc-subword.el - (autoload 'c-subword-mode "cc-subword" "Mode enabling subword movement and editing keys." t) + +(autoload 'c-subword-mode "cc-subword" "\ +Mode enabling subword movement and editing keys. +In spite of GNU Coding Standards, it is popular to name a symbol by +mixing uppercase and lowercase letters, e.g. \"GtkWidget\", +\"EmacsFrameClass\", \"NSGraphicsContext\", etc. Here we call these +mixed case symbols `nomenclatures'. Also, each capitalized (or +completely uppercase) part of a nomenclature is called a `subword'. +Here are some examples: + + Nomenclature Subwords + =========================================================== + GtkWindow => \"Gtk\" and \"Window\" + EmacsFrameClass => \"Emacs\", \"Frame\" and \"Class\" + NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\" + +The subword oriented commands activated in this minor mode recognize +subwords in a nomenclature to move between subwords and to edit them +as words. + +\\{c-subword-mode-map} + +\(fn &optional ARG)" t nil) ;;;*** @@ -4112,6 +4146,26 @@ to the action header. ;;;*** +;;;### (autoloads (check-declare-directory check-declare-file) "check-declare" +;;;;;; "emacs-lisp/check-declare.el" (18308 19808)) +;;; Generated autoloads from emacs-lisp/check-declare.el + +(autoload 'check-declare-file "check-declare" "\ +Check veracity of all `declare-function' statements in FILE. +See `check-declare-directory' for more information. + +\(fn FILE)" t nil) + +(autoload 'check-declare-directory "check-declare" "\ +Check veracity of all `declare-function' statements under directory ROOT. +Returns non-nil if any false statements are found. For this to +work correctly, the statements must adhere to the format +described in the documentation of `declare-function'. + +\(fn ROOT)" t nil) + +;;;*** + ;;;### (autoloads (checkdoc-minor-mode checkdoc-ispell-defun checkdoc-ispell-comments ;;;;;; checkdoc-ispell-continue checkdoc-ispell-start checkdoc-ispell-message-text ;;;;;; checkdoc-ispell-message-interactive checkdoc-ispell-interactive @@ -5091,6 +5145,12 @@ Insert a copyright by $ORGANIZATION notice at cursor. ;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (18231 31069)) ;;; Generated autoloads from progmodes/cperl-mode.el (put 'cperl-indent-level 'safe-local-variable 'integerp) +(put 'cperl-brace-offset 'safe-local-variable 'integerp) +(put 'cperl-continued-brace-offset 'safe-local-variable 'integerp) +(put 'cperl-label-offset 'safe-local-variable 'integerp) +(put 'cperl-continued-statement-offset 'safe-local-variable 'integerp) +(put 'cperl-extra-newline-before-brace 'safe-local-variable 'booleanp) +(put 'cperl-merge-trailing-else 'safe-local-variable 'booleanp) (autoload 'cperl-mode "cperl-mode" "\ Major mode for editing Perl code. @@ -5628,7 +5688,7 @@ that are not customizable options, as well as faces and groups (autoload 'customize-apropos-options "cus-edit" "\ Customize all loaded customizable options matching REGEXP. With prefix arg, include variables that are not customizable options -\(but we recommend using `apropos-variable' instead). +\(but it is better to use `apropos-variable' if you want to find those). \(fn REGEXP &optional ARG)" t nil) @@ -6230,8 +6290,8 @@ or call the function `delete-selection-mode'.") (autoload 'delete-selection-mode "delsel" "\ Toggle Delete Selection mode. -With prefix ARG, turn Delete Selection mode on if and only if ARG is -positive. +With prefix ARG, turn Delete Selection mode on if ARG is +positive, off if ARG is not positive. When Delete Selection mode is enabled, Transient Mark mode is also 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 (custom-autoload 'dired-listing-switches "dired" t) -(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")) "\ +(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")) "\ Name of chown command (usually `chown' or `/etc/chown').") (defvar dired-ls-F-marks-symlinks nil "\ @@ -7564,6 +7624,12 @@ Locate SOA record and increment the serial field. ;;;;;; "doc-view.el" (18231 31060)) ;;; Generated autoloads from doc-view.el +(autoload 'doc-view-mode-p "doc-view" "\ +Return non-nil if image type TYPE is available for `doc-view'. +Image types are symbols like `dvi', `postscript' or `pdf'. + +\(fn TYPE)" nil nil) + (autoload 'doc-view-mode "doc-view" "\ Major mode in DocView buffers. You can use \\<doc-view-mode-map>\\[doc-view-toggle-display] to @@ -7796,10 +7862,15 @@ whenever this expression's value is non-nil. INCLUDE is an expression; this item is only visible if this expression has a non-nil value. `:included' is an alias for `:visible'. + :label FORM + +FORM is an expression that will be dynamically evaluated and whose +value will be used for the menu entry's text label (the default is NAME). + :suffix FORM FORM is an expression that will be dynamically evaluated and whose -value will be concatenated to the menu entry's NAME. +value will be concatenated to the menu entry's label. :style STYLE @@ -9602,12 +9673,7 @@ corresponding to a successful execution. \(fn COMMAND &optional STATUS-VAR)" nil nil) -(autoload 'eshell-report-bug "eshell" "\ -Report a bug in Eshell. -Prompts for the TOPIC. Leaves you in a mail buffer. -Please include any configuration details that might be involved. - -\(fn TOPIC)" t nil) +(define-obsolete-function-alias 'eshell-report-bug 'report-emacs-bug "23.1") ;;;*** @@ -10773,9 +10839,6 @@ the name is considered already unique; only the second substitution \(directories) is done. \(fn ARG)" t nil) - (define-key minibuffer-local-completion-map [C-tab] 'file-cache-minibuffer-complete) - (define-key minibuffer-local-map [C-tab] 'file-cache-minibuffer-complete) - (define-key minibuffer-local-must-match-map [C-tab] 'file-cache-minibuffer-complete) ;;;*** @@ -10825,6 +10888,13 @@ On other systems, the closest you can come is to use `-l'.") (custom-autoload 'find-grep-options "find-dired" t) +(defvar find-name-arg (if read-file-name-completion-ignore-case "-iname" "-name") "\ +*Argument used to specify file name pattern. +If `read-file-name-completion-ignore-case' is non-nil, -iname is used so that +find also ignores case. Otherwise, -name is used.") + +(custom-autoload 'find-name-arg "find-dired" t) + (autoload 'find-dired "find-dired" "\ Run `find' and go into Dired mode on a buffer of the output. The command run (after changing into DIR) is @@ -11551,7 +11621,6 @@ Run gdb on program FILE in buffer *gud-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for your debugger. - If `gdb-many-windows' is nil (the default value) then gdb just pops up the GUD buffer unless `gdb-show-main' is t. In this case it starts with two windows: one displaying the GUD buffer and the @@ -12049,7 +12118,7 @@ Not documented (autoload 'turn-on-gnus-dired-mode "gnus-dired" "\ Convenience method to turn on gnus-dired-mode. -\(fn)" nil nil) +\(fn)" t nil) ;;;*** @@ -12622,6 +12691,11 @@ This variable's value takes effect when `grep-compute-defaults' is called.") The default find program for `grep-find-command'. This variable's value takes effect when `grep-compute-defaults' is called.") +(defvar xargs-program "xargs" "\ +The default xargs program for `grep-find-command'. +See `grep-find-use-xargs'. +This variable's value takes effect when `grep-compute-defaults' is called.") + (defvar grep-find-use-xargs nil "\ Non-nil means that `grep-find' uses the `xargs' utility by default. If `exec', use `find -exec'. @@ -12653,19 +12727,19 @@ Sets `grep-last-buffer' and `compilation-window-height'. (autoload 'grep "grep" "\ Run grep, with user-specified args, and collect output in a buffer. While grep runs asynchronously, you can use \\[next-error] (M-x next-error), -or \\<grep-mode-map>\\[compile-goto-error] in the grep output buffer, to go to the lines -where grep found matches. +or \\<grep-mode-map>\\[compile-goto-error] in the grep output buffer, to go to the lines where grep +found matches. For doing a recursive `grep', see the `rgrep' command. For running `grep' in a specific directory, see `lgrep'. -This command uses a special history list for its COMMAND-ARGS, so you can -easily repeat a grep command. +This command uses a special history list for its COMMAND-ARGS, so you +can easily repeat a grep command. A prefix argument says to default the argument based upon the current tag the cursor is over, substituting it into the last grep command -in the grep command history (or into `grep-command' -if that history list is empty). +in the grep command history (or into `grep-command' if that history +list is empty). \(fn COMMAND-ARGS)" t nil) @@ -12693,8 +12767,8 @@ before it is executed. With two \\[universal-argument] prefixes, directly edit and run `grep-command'. Collect output in a buffer. While grep runs asynchronously, you -can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] -in the grep output buffer, to go to the lines where grep found matches. +can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] in the grep output buffer, +to go to the lines where grep found matches. This command shares argument histories with \\[rgrep] and \\[grep]. @@ -12711,8 +12785,8 @@ before it is executed. With two \\[universal-argument] prefixes, directly edit and run `grep-find-command'. Collect output in a buffer. While find runs asynchronously, you -can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] -in the grep output buffer, to go to the lines where grep found matches. +can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] in the grep output buffer, +to go to the lines where grep found matches. This command shares argument histories with \\[lgrep] and \\[grep-find]. @@ -13833,6 +13907,8 @@ The optional LABEL is used to label the buffer created. \(fn Y1 Y2 &optional L LABEL)" t nil) +(defalias 'holiday-list 'list-holidays) + ;;;*** ;;;### (autoloads (html2text) "html2text" "gnus/html2text.el" (18231 @@ -15348,6 +15424,11 @@ information on these modes. \(fn)" t nil) +(autoload 'image-bookmark-jump "image-mode" "\ +Not documented + +\(fn BMK)" nil nil) + ;;;*** ;;;### (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.") Function to call to get the next buffer to search. When this variable is set to a function that returns a buffer, then -after typing another C-s or C-r at a failing search, the search goes +after typing another \\[isearch-forward] or \\[isearch-backward] at a failing search, the search goes to the next buffer in the series and continues searching for the next occurrence. The first argument of this function is the current buffer where the search is currently searching. It defines the base buffer relative to which this function should find the next buffer. When the isearch -direction is backward (when isearch-forward is nil), this function -should return the previous buffer to search. If the second argument of +direction is backward (when `isearch-forward' is nil), this function +should return the previous buffer to search. If the second argument of this function WRAP is non-nil, then it should return the first buffer in the series; and for the backward search, it should return the last buffer in the series.") @@ -16009,14 +16090,14 @@ Optional arg BUFFER is ignored (for use in `format-alist'). (autoload 'iso-iso2sgml "iso-cvt" "\ Translate ISO 8859-1 characters in the region to SGML entities. -The entities used are from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\". +Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\". Optional arg BUFFER is ignored (for use in `format-alist'). \(fn FROM TO &optional BUFFER)" t nil) (autoload 'iso-sgml2iso "iso-cvt" "\ Translate SGML entities in the region to ISO 8859-1 characters. -The entities used are from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\". +Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\". Optional arg BUFFER is ignored (for use in `format-alist'). \(fn FROM TO &optional BUFFER)" t nil) @@ -16177,6 +16258,7 @@ for skipping in latex mode.") Same format as `ispell-skip-region-alist' Note - substrings of other matches must come last (e.g. \"<[tT][tT]/\" and \"<[^ \\t\\n>]\").") +(put 'ispell-local-pdict 'safe-local-variable 'stringp) (define-key esc-map "$" 'ispell-word) (autoload 'ispell-word "ispell" "\ @@ -17098,17 +17180,22 @@ except that FILTER is not optional. Setup a buffer to enter a log message. \\<log-edit-mode-map>The buffer will be put in `log-edit-mode'. If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run. -Mark and point will be set around the entire contents of the -buffer so that it is easy to kill the contents of the buffer with \\[kill-region]. +Mark and point will be set around the entire contents of the buffer so +that it is easy to kill the contents of the buffer with \\[kill-region]. Once you're done editing the message, pressing \\[log-edit-done] will call `log-edit-done' which will end up calling CALLBACK to do the actual commit. -LISTFUN if non-nil is a function of no arguments returning the list of files - that are concerned by the current operation (using relative names). + +PARAMS if non-nil is an alist. Possible keys and associated values: + `log-edit-listfun' -- function taking no arguments that returns the list of + files that are concerned by the current operation (using relative names); + `log-edit-diff-function' -- function taking no arguments that + displays a diff of the files concerned by the current operation. + If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the - log message and go back to the current buffer when done. Otherwise, it - uses the current buffer. +log message and go back to the current buffer when done. Otherwise, it +uses the current buffer. -\(fn CALLBACK &optional SETUP LISTFUN BUFFER &rest IGNORE)" nil nil) +\(fn CALLBACK &optional SETUP PARAMS BUFFER &rest IGNORE)" nil nil) ;;;*** @@ -17151,7 +17238,7 @@ are indicated with a symbol. (defvar lpr-windows-system (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt))) -(defvar lpr-lp-system (memq system-type '(usg-unix-v dgux hpux irix))) +(defvar lpr-lp-system (memq system-type '(usg-unix-v hpux irix))) (defvar printer-name (and lpr-windows-system "PRN") "\ *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. ;;;*** +;;;### (autoloads (nxml-glyph-display-string) "nxml-glyph" "nxml/nxml-glyph.el" +;;;;;; (18308 19808)) +;;; Generated autoloads from nxml/nxml-glyph.el + +(autoload 'nxml-glyph-display-string "nxml-glyph" "\ +Return a string that can display a glyph for Unicode code-point N. +FACE gives the face that will be used for displaying the string. +Return nil if the face cannot display a glyph for N. + +\(fn N FACE)" nil nil) + +;;;*** + +;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (18313 +;;;;;; 19474)) +;;; Generated autoloads from nxml/nxml-mode.el + +(autoload 'nxml-mode "nxml-mode" "\ +Major mode for editing XML. + +Syntax highlighting is performed unless the variable +`nxml-syntax-highlight-flag' is nil. + +\\[nxml-finish-element] finishes the current element by inserting an end-tag. +C-c C-i closes a start-tag with `>' and then inserts a balancing end-tag +leaving point between the start-tag and end-tag. +\\[nxml-balanced-close-start-tag-block] is similar but for block rather than inline elements: +the start-tag, point, and end-tag are all left on separate lines. +If `nxml-slash-auto-complete-flag' is non-nil, then inserting a `</' +automatically inserts the rest of the end-tag. + +\\[nxml-complete] performs completion on the symbol preceding point. + +\\[nxml-dynamic-markup-word] uses the contents of the current buffer +to choose a tag to put around the word preceding point. + +Sections of the document can be displayed in outline form. The +variable `nxml-section-element-name-regexp' controls when an element +is recognized as a section. The same key sequences that change +visibility in outline mode are used except that they start with C-c C-o +instead of C-c. + +Validation is provided by the related minor-mode `rng-validate-mode'. +This also makes completion schema- and context- sensitive. Element +names, attribute names, attribute values and namespace URIs can all be +completed. By default, `rng-validate-mode' is automatically enabled. You +can toggle it using \\[rng-validate-mode] or change the default by +customizing `rng-nxml-auto-validate-flag'. + +\\[indent-for-tab-command] indents the current line appropriately. +This can be customized using the variable `nxml-child-indent' +and the variable `nxml-attribute-indent'. + +\\[nxml-insert-named-char] inserts a character reference using +the character's name (by default, the Unicode name). \\[universal-argument] \\[nxml-insert-named-char] +inserts the character directly. + +The Emacs commands that normally operate on balanced expressions will +operate on XML markup items. Thus \\[forward-sexp] will move forward +across one markup item; \\[backward-sexp] will move backward across +one markup item; \\[kill-sexp] will kill the following markup item; +\\[mark-sexp] will mark the following markup item. By default, each +tag each treated as a single markup item; to make the complete element +be treated as a single markup item, set the variable +`nxml-sexp-element-flag' to t. For more details, see the function +`nxml-forward-balanced-item'. + +\\[nxml-backward-up-element] and \\[nxml-down-element] move up and down the element structure. + +Many aspects this mode can be customized using +\\[customize-group] nxml RET. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (nxml-enable-unicode-char-name-sets) "nxml-uchnm" +;;;;;; "nxml/nxml-uchnm.el" (18312 40673)) +;;; Generated autoloads from nxml/nxml-uchnm.el + +(autoload 'nxml-enable-unicode-char-name-sets "nxml-uchnm" "\ +Enable the use of Unicode standard names for characters. +The Unicode blocks for which names are enabled is controlled by +the variable `nxml-enabled-unicode-blocks'. + +\(fn)" t nil) + +;;;*** + ;;;### (autoloads (octave-help) "octave-hlp" "progmodes/octave-hlp.el" ;;;;;; (18177 873)) ;;; Generated autoloads from progmodes/octave-hlp.el @@ -20286,16 +20462,6 @@ but before calling PC Selection mode): \(fn &optional ARG)" t nil) -(defvar pc-selection-mode nil "\ -Toggle PC Selection mode. -Change mark behavior to emulate Motif, MAC or MS-Windows cut and paste style, -and cursor movement commands. -This mode enables Delete Selection mode and Transient Mark mode. -Setting this variable directly does not take effect; -you must modify it using \\[customize] or \\[pc-selection-mode].") - -(custom-autoload 'pc-selection-mode "pc-select" nil) - ;;;*** ;;;### (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 ;;;;;; (18177 873)) ;;; Generated autoloads from progmodes/perl-mode.el (put 'perl-indent-level 'safe-local-variable 'integerp) +(put 'perl-continued-statement-offset 'safe-local-variable 'integerp) +(put 'perl-continued-brace-offset 'safe-local-variable 'integerp) +(put 'perl-brace-offset 'safe-local-variable 'integerp) +(put 'perl-brace-imaginary-offset 'safe-local-variable 'integerp) +(put 'perl-label-offset 'safe-local-variable 'integerp) (autoload 'perl-mode "perl-mode" "\ Major mode for editing Perl code. @@ -22736,7 +22907,6 @@ comments, including the first comment line, are visible), or to make the first comment line visible (if point is in a comment). \(fn &optional ARG)" t nil) - (define-key esc-map "\C-l" 'reposition-window) ;;;*** @@ -24812,6 +24982,12 @@ Minor mode to simplify editing output from the diff3 program. \(fn &optional ARG)" t nil) +(autoload 'smerge-start-session "smerge-mode" "\ +Turn on `smerge-mode' and move point to first conflict marker. +If no conflict maker is found, turn off `smerge-mode'. + +\(fn)" nil nil) + ;;;*** ;;;### (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. (autoload 'spam-initialize "spam" "\ Install the spam.el hooks and do other initialization. When SYMBOLS is given, set those variables to t. This is so you -can call spam-initialize before you set spam-use-* variables on +can call `spam-initialize' before you set spam-use-* variables on explicitly, and matters only if you need the extra headers -installed through spam-necessary-extra-headers. +installed through `spam-necessary-extra-headers'. \(fn &rest SYMBOLS)" t nil) @@ -27624,6 +27800,7 @@ If DATE is malformed, return a time value of zeros. ;;;;;; "time-stamp.el" (18177 876)) ;;; Generated autoloads from time-stamp.el (put 'time-stamp-format 'safe-local-variable 'stringp) +(put 'time-stamp-time-zone 'safe-local-variable 'string-or-null-p) (put 'time-stamp-line-limit 'safe-local-variable 'integerp) (put 'time-stamp-start 'safe-local-variable 'stringp) (put 'time-stamp-end 'safe-local-variable 'stringp) @@ -28809,6 +28986,13 @@ Use URL to handle URL-like file names. \(fn &optional ARG)" t nil) +(autoload 'url-file-handler "url-handlers" "\ +Function called from the `file-name-handler-alist' routines. +OPERATION is what needs to be done (`file-exists-p', etc). ARGS are +the arguments that would have been passed to OPERATION. + +\(fn OPERATION &rest ARGS)" nil nil) + (autoload 'url-copy-file "url-handlers" "\ Copy URL to NEWNAME. Both args must be strings. Signals a `file-already-exists' error if file NEWNAME already exists, @@ -29364,7 +29548,8 @@ merge in the changes into your working copy. \(fn VERBOSE)" t nil) (autoload 'vc-register "vc" "\ -Register the current file into a version control system. +Register into a version control system. +If FNAME is given register that file, otherwise register the current file. With prefix argument SET-REVISION, allow user to specify initial revision level. If COMMENT is present, use that as an initial comment. @@ -29375,7 +29560,7 @@ directory are already registered under that backend) will be used to register the file. If no backend declares itself responsible, the first backend that could register the file is used. -\(fn &optional SET-REVISION COMMENT)" t nil) +\(fn &optional FNAME SET-REVISION COMMENT)" t nil) (autoload 'vc-version-diff "vc" "\ Report diffs between revisions of the fileset in the repository history. @@ -29753,6 +29938,142 @@ Key bindings: ;;;*** +;;;### (autoloads (verilog-mode) "verilog-mode" "progmodes/verilog-mode.el" +;;;;;; (18307 57872)) +;;; Generated autoloads from progmodes/verilog-mode.el + +(autoload 'verilog-mode "verilog-mode" "\ +Major mode for editing Verilog code. +\\<verilog-mode-map> +See \\[describe-function] verilog-auto (\\[verilog-auto]) for details on how +AUTOs can improve coding efficiency. + +Use \\[verilog-faq] for a pointer to frequently asked questions. + +NEWLINE, TAB indents for Verilog code. +Delete converts tabs to spaces as it moves back. + +Supports highlighting. + +Turning on Verilog mode calls the value of the variable `verilog-mode-hook' +with no args, if that value is non-nil. + +Variables controlling indentation/edit style: + + variable `verilog-indent-level' (default 3) + Indentation of Verilog statements with respect to containing block. + `verilog-indent-level-module' (default 3) + Absolute indentation of Module level Verilog statements. + Set to 0 to get initial and always statements lined up + on the left side of your screen. + `verilog-indent-level-declaration' (default 3) + Indentation of declarations with respect to containing block. + Set to 0 to get them list right under containing block. + `verilog-indent-level-behavioral' (default 3) + Indentation of first begin in a task or function block + Set to 0 to get such code to lined up underneath the task or function keyword + `verilog-indent-level-directive' (default 1) + Indentation of `ifdef/`endif blocks + `verilog-cexp-indent' (default 1) + Indentation of Verilog statements broken across lines i.e.: + if (a) + begin + `verilog-case-indent' (default 2) + Indentation for case statements. + `verilog-auto-newline' (default nil) + Non-nil means automatically newline after semicolons and the punctuation + mark after an end. + `verilog-auto-indent-on-newline' (default t) + Non-nil means automatically indent line after newline + `verilog-tab-always-indent' (default t) + Non-nil means TAB in Verilog mode should always reindent the current line, + regardless of where in the line point is when the TAB command is used. + `verilog-indent-begin-after-if' (default t) + Non-nil means to indent begin statements following a preceding + if, else, while, for and repeat statements, if any. otherwise, + the begin is lined up with the preceding token. If t, you get: + if (a) + begin // amount of indent based on `verilog-cexp-indent' + otherwise you get: + if (a) + begin + `verilog-auto-endcomments' (default t) + Non-nil means a comment /* ... */ is set after the ends which ends + cases, tasks, functions and modules. + The type and name of the object will be set between the braces. + `verilog-minimum-comment-distance' (default 10) + Minimum distance (in lines) between begin and end required before a comment + will be inserted. Setting this variable to zero results in every + end acquiring a comment; the default avoids too many redundant + comments in tight quarters. + `verilog-auto-lineup' (default `(all)) + List of contexts where auto lineup of code should be done. + +Variables controlling other actions: + + `verilog-linter' (default surelint) + Unix program to call to run the lint checker. This is the default + command for \\[compile-command] and \\[verilog-auto-save-compile]. + +See \\[customize] for the complete list of variables. + +AUTO expansion functions are, in part: + + \\[verilog-auto] Expand AUTO statements. + \\[verilog-delete-auto] Remove the AUTOs. + \\[verilog-inject-auto] Insert AUTOs for the first time. + +Some other functions are: + + \\[verilog-complete-word] Complete word with appropriate possibilities. + \\[verilog-mark-defun] Mark function. + \\[verilog-beg-of-defun] Move to beginning of current function. + \\[verilog-end-of-defun] Move to end of current function. + \\[verilog-label-be] Label matching begin ... end, fork ... join, etc statements. + + \\[verilog-comment-region] Put marked area in a comment. + \\[verilog-uncomment-region] Uncomment an area commented with \\[verilog-comment-region]. + \\[verilog-insert-block] Insert begin ... end;. + \\[verilog-star-comment] Insert /* ... */. + + \\[verilog-sk-always] Insert a always @(AS) begin .. end block. + \\[verilog-sk-begin] Insert a begin .. end block. + \\[verilog-sk-case] Insert a case block, prompting for details. + \\[verilog-sk-for] Insert a for (...) begin .. end block, prompting for details. + \\[verilog-sk-generate] Insert a generate .. endgenerate block. + \\[verilog-sk-header] Insert a nice header block at the top of file. + \\[verilog-sk-initial] Insert an initial begin .. end block. + \\[verilog-sk-fork] Insert a fork begin .. end .. join block. + \\[verilog-sk-module] Insert a module .. (/*AUTOARG*/);.. endmodule block. + \\[verilog-sk-primitive] Insert a primitive .. (.. );.. endprimitive block. + \\[verilog-sk-repeat] Insert a repeat (..) begin .. end block. + \\[verilog-sk-specify] Insert a specify .. endspecify block. + \\[verilog-sk-task] Insert a task .. begin .. end endtask block. + \\[verilog-sk-while] Insert a while (...) begin .. end block, prompting for details. + \\[verilog-sk-casex] Insert a casex (...) item: begin.. end endcase block, prompting for details. + \\[verilog-sk-casez] Insert a casez (...) item: begin.. end endcase block, prompting for details. + \\[verilog-sk-if] Insert an if (..) begin .. end block. + \\[verilog-sk-else-if] Insert an else if (..) begin .. end block. + \\[verilog-sk-comment] Insert a comment block. + \\[verilog-sk-assign] Insert an assign .. = ..; statement. + \\[verilog-sk-function] Insert a function .. begin .. end endfunction block. + \\[verilog-sk-input] Insert an input declaration, prompting for details. + \\[verilog-sk-output] Insert an output declaration, prompting for details. + \\[verilog-sk-state-machine] Insert a state machine definition, prompting for details. + \\[verilog-sk-inout] Insert an inout declaration, prompting for details. + \\[verilog-sk-wire] Insert a wire declaration, prompting for details. + \\[verilog-sk-reg] Insert a register declaration, prompting for details. + \\[verilog-sk-define-signal] Define signal under point as a register at the top of the module. + +All key bindings can be seen in a Verilog-buffer with \\[describe-bindings]. +Key bindings specific to `verilog-mode-map' are: + +\\{verilog-mode-map} + +\(fn)" t nil) + +;;;*** + ;;;### (autoloads (vhdl-mode) "vhdl-mode" "progmodes/vhdl-mode.el" ;;;;;; (18213 1260)) ;;; Generated autoloads from progmodes/vhdl-mode.el @@ -30821,6 +31142,11 @@ and off otherwise. ;;;;;; whitespace-toggle-leading-check) "whitespace" "whitespace.el" ;;;;;; (18231 31064)) ;;; Generated autoloads from whitespace.el +(put 'whitespace-check-buffer-leading 'safe-local-variable 'booleanp) +(put 'whitespace-check-buffer-trailing 'safe-local-variable 'booleanp) +(put 'whitespace-check-buffer-indent 'safe-local-variable 'booleanp) +(put 'whitespace-check-buffer-spacetab 'safe-local-variable 'booleanp) +(put 'whitespace-check-buffer-ateol 'safe-local-variable 'booleanp) (autoload 'whitespace-toggle-leading-check "whitespace" "\ Toggle the check for leading space in the local buffer. @@ -31371,7 +31697,7 @@ Zone out, completely. ;;;;;; "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/hex-util.el" "gnus/hmac-def.el" ;;;;;; "gnus/hmac-md5.el" "gnus/ietf-drums.el" "gnus/imap.el" "gnus/legacy-gnus-agent.el" ;;;;;; "gnus/mail-parse.el" "gnus/mail-prsvr.el" "gnus/mail-source.el" -;;;;;; "gnus/mailcap.el" "gnus/md4.el" "gnus/messcompat.el" "gnus/mm-bodies.el" +;;;;;; "gnus/mailcap.el" "gnus/messcompat.el" "gnus/mm-bodies.el" ;;;;;; "gnus/mm-decode.el" "gnus/mm-encode.el" "gnus/mm-util.el" ;;;;;; "gnus/mm-view.el" "gnus/mml-sec.el" "gnus/mml-smime.el" "gnus/mml.el" ;;;;;; "gnus/nnagent.el" "gnus/nnbabyl.el" "gnus/nndb.el" "gnus/nndir.el" @@ -31380,11 +31706,9 @@ Zone out, completely. ;;;;;; "gnus/nnmail.el" "gnus/nnmaildir.el" "gnus/nnmbox.el" "gnus/nnmh.el" ;;;;;; "gnus/nnnil.el" "gnus/nnoo.el" "gnus/nnrss.el" "gnus/nnslashdot.el" ;;;;;; "gnus/nnspool.el" "gnus/nntp.el" "gnus/nnultimate.el" "gnus/nnvirtual.el" -;;;;;; "gnus/nnwarchive.el" "gnus/nnweb.el" "gnus/nnwfm.el" "gnus/ntlm.el" -;;;;;; "gnus/password.el" "gnus/pop3.el" "gnus/rfc1843.el" "gnus/rfc2045.el" -;;;;;; "gnus/rfc2047.el" "gnus/rfc2104.el" "gnus/rfc2231.el" "gnus/sasl-cram.el" -;;;;;; "gnus/sasl-digest.el" "gnus/sasl-ntlm.el" "gnus/sasl.el" -;;;;;; "gnus/sieve-manage.el" "gnus/smime-ldap.el" "gnus/smime.el" +;;;;;; "gnus/nnwarchive.el" "gnus/nnweb.el" "gnus/nnwfm.el" "gnus/pop3.el" +;;;;;; "gnus/rfc1843.el" "gnus/rfc2045.el" "gnus/rfc2047.el" "gnus/rfc2104.el" +;;;;;; "gnus/rfc2231.el" "gnus/sieve-manage.el" "gnus/smime.el" ;;;;;; "gnus/spam-stat.el" "gnus/spam-wash.el" "gnus/starttls.el" ;;;;;; "gnus/utf7.el" "gnus/webmail.el" "help.el" "indent.el" "international/characters.el" ;;;;;; "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 @@ +;;; linum.el --- display line numbers in the left margin + +;; Copyright (C) 2008 Free Software Foundation, Inc. + +;; Author: Markus Triska <markus.triska@gmx.at> +;; Maintainer: FSF +;; Keywords: convenience + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Display line numbers for the current buffer. +;; +;; Toggle display of line numbers with M-x linum-mode. To enable +;; line numbering in all buffers, use M-x global-linum-mode. + +;;; Code: + +(defconst linum-version "0.9wx") + +(defvar linum-overlays nil "Overlays used in this buffer.") +(defvar linum-available nil "Overlays available for reuse.") +(defvar linum-before-numbering-hook nil + "Functions run in each buffer before line numbering starts.") + +(mapc #'make-variable-buffer-local '(linum-overlays linum-available)) + +(defgroup linum nil + "Show line numbers in the left margin." + :group 'convenience) + +;;;###autoload +(defcustom linum-format 'dynamic + "Format used to display line numbers. +Either a format string like \"%7d\", `dynamic' to adapt the width +as needed, or a function that is called with a line number as its +argument and should evaluate to a string to be shown on that line. +See also `linum-before-numbering-hook'." + :group 'linum + :type 'sexp) + +(defface linum + '((t :inherit shadow)) + "Face for displaying line numbers in the display margin." + :group 'linum) + +(defcustom linum-eager t + "Whether line numbers should be updated after each command. +The conservative setting `nil' might miss some buffer changes, +and you have to scroll or press \\[recenter-top-bottom] to update the numbers." + :group 'linum + :type 'boolean) + +(defcustom linum-delay t + "Delay updates to give Emacs a chance for other changes." + :group 'linum + :type 'boolean) + +;;;###autoload +(define-minor-mode linum-mode + "Toggle display of line numbers in the left margin." + :lighter "" ; for desktop.el + (if linum-mode + (progn + (if linum-eager + (add-hook 'post-command-hook (if linum-delay + 'linum-schedule + 'linum-update-current) nil t) + (add-hook 'after-change-functions 'linum-after-change nil t)) + (add-hook 'window-scroll-functions 'linum-after-scroll nil t) + ;; mistake in Emacs: window-size-change-functions cannot be local + (add-hook 'window-size-change-functions 'linum-after-size) + (add-hook 'change-major-mode-hook 'linum-delete-overlays nil t) + (add-hook 'window-configuration-change-hook + 'linum-after-config nil t) + (linum-update-current)) + (remove-hook 'post-command-hook 'linum-update-current t) + (remove-hook 'post-command-hook 'linum-schedule t) + (remove-hook 'window-size-change-functions 'linum-after-size) + (remove-hook 'window-scroll-functions 'linum-after-scroll t) + (remove-hook 'after-change-functions 'linum-after-change t) + (remove-hook 'window-configuration-change-hook 'linum-after-config t) + (remove-hook 'change-major-mode-hook 'linum-delete-overlays t) + (linum-delete-overlays))) + +;;;###autoload +(define-globalized-minor-mode global-linum-mode linum-mode linum-on) + +(defun linum-on () + (unless (minibufferp) + (linum-mode 1))) + +(defun linum-delete-overlays () + "Delete all overlays displaying line numbers for this buffer." + (mapc #'delete-overlay linum-overlays) + (setq linum-overlays nil) + (dolist (w (get-buffer-window-list (current-buffer) nil t)) + (set-window-margins w 0))) + +(defun linum-update-current () + "Update line numbers for the current buffer." + (linum-update (current-buffer))) + +(defun linum-update (buffer) + "Update line numbers for all windows displaying BUFFER." + (with-current-buffer buffer + (when linum-mode + (setq linum-available linum-overlays) + (setq linum-overlays nil) + (save-excursion + (mapc #'linum-update-window + (get-buffer-window-list buffer nil 'visible))) + (mapc #'delete-overlay linum-available) + (setq linum-available nil)))) + +(defun linum-update-window (win) + "Update line numbers for the portion visible in window WIN." + (goto-char (window-start win)) + (let ((line (line-number-at-pos)) + (limit (1+ (window-end win t))) + (fmt (cond ((stringp linum-format) linum-format) + ((eq linum-format 'dynamic) + (let ((w (length (number-to-string + (count-lines (point-min) (point-max)))))) + (concat "%" (number-to-string w) "d"))))) + (width 0) + visited + ov) + (run-hooks 'linum-before-numbering-hook) + ;; Create an overlay (or reuse an existing one) for each + ;; line visible in this window, if necessary. + (while (and (not (eobp)) (< (point) limit)) + (setq visited nil) + (dolist (o (overlays-in (point) (point))) + (when (eq (overlay-get o 'linum-line) line) + (unless (memq o linum-overlays) + (push o linum-overlays)) + (setq linum-available (delete o linum-available)) + (setq visited t))) + (let ((str (if fmt + (propertize (format fmt line) 'face 'linum) + (funcall linum-format line)))) + (setq width (max width (length str))) + (unless visited + (if (null linum-available) + (setq ov (make-overlay (point) (point))) + (setq ov (pop linum-available)) + (move-overlay ov (point) (point))) + (push ov linum-overlays) + (setq str (propertize " " 'display `((margin left-margin) ,str))) + (overlay-put ov 'before-string str) + (overlay-put ov 'linum-line line))) + (forward-line) + (setq line (1+ line))) + (set-window-margins win width))) + +(defun linum-after-change (beg end len) + ;; update overlays on deletions, and after newlines are inserted + (when (or (= beg end) + (= end (point-max)) + (string-match-p "\n" (buffer-substring-no-properties beg end))) + (linum-update-current))) + +(defun linum-after-scroll (win start) + (linum-update (window-buffer win))) + +(defun linum-after-size (frame) + (linum-after-config)) + +(defun linum-schedule () + ;; schedule an update; the delay gives Emacs a chance for display changes + (run-with-idle-timer 0 nil #'linum-update-current)) + +(defun linum-after-config () + (walk-windows (lambda (w) (linum-update (window-buffer))) nil 'visible)) + +(provide 'linum) + +;; arch-tag: dea45631-ed3c-4867-8b49-1c41c80aec6a +;;; 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." (let (provides) (dolist (x (file-loadhist-lookup file) provides) (when (eq (car-safe x) 'provide) - (push x provides))))) + (push (cdr x) provides))))) (defun file-requires (file) "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." (let (requires) (dolist (x (file-loadhist-lookup file) requires) (when (eq (car-safe x) 'require) - (push x requires))))) + (push (cdr x) requires))))) (defsubst file-set-intersect (p q) "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." "Setup a buffer to enter a log message. \\<log-edit-mode-map>The buffer will be put in `log-edit-mode'. If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run. -Mark and point will be set around the entire contents of the -buffer so that it is easy to kill the contents of the buffer with \\[kill-region]. +Mark and point will be set around the entire contents of the buffer so +that it is easy to kill the contents of the buffer with \\[kill-region]. Once you're done editing the message, pressing \\[log-edit-done] will call `log-edit-done' which will end up calling CALLBACK to do the actual commit. -PARAMS if non-nil is an alist. The keys for the alist can be: -`log-edit-listfun' and `log-edit-diff-function'. The associated -value for `log-edit-listfun' should be a function with not -arguments that returns the list of files that are concerned by -the current operation (using relative names). The associated -value for `log-edit-diff-function' should be a function with no -arguments that displays a diff of the files concerned by the current operation. + +PARAMS if non-nil is an alist. Possible keys and associated values: + `log-edit-listfun' -- function taking no arguments that returns the list of + files that are concerned by the current operation (using relative names); + `log-edit-diff-function' -- function taking no arguments that + displays a diff of the files concerned by the current operation. + If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the - log message and go back to the current buffer when done. Otherwise, it - uses the current buffer." +log message and go back to the current buffer when done. Otherwise, it +uses the current buffer." (let ((parent (current-buffer))) (if buffer (pop-to-buffer buffer)) (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." (let ((buffer-undo-list t) (inhibit-read-only t) (after-change-functions nil) - (mod (buffer-modified-p))) + (mod (buffer-modified-p)) + buffer-file-name buffer-file-truename) ;; Turning off undo is OK since (spaces + newlines) is ;; conserved, except for a corner case in ;; longlines-wrap-lines that we'll never encounter from here @@ -176,7 +177,8 @@ are indicated with a symbol." (longlines-unshow-hard-newlines)) (let ((buffer-undo-list t) (after-change-functions nil) - (inhibit-read-only t)) + (inhibit-read-only t) + buffer-file-name buffer-file-truename) (if longlines-decoded (save-restriction (widen) @@ -220,7 +222,8 @@ With optional argument ARG, make the hard newlines invisible again." (mod (buffer-modified-p)) (buffer-undo-list t) (inhibit-read-only t) - (inhibit-modification-hooks t)) + (inhibit-modification-hooks t) + buffer-file-name buffer-file-truename) (while pos (put-text-property pos (1+ pos) 'display (copy-sequence longlines-show-effect)) @@ -235,7 +238,8 @@ With optional argument ARG, make the hard newlines invisible again." (mod (buffer-modified-p)) (buffer-undo-list t) (inhibit-read-only t) - (inhibit-modification-hooks t)) + (inhibit-modification-hooks t) + buffer-file-name buffer-file-truename) (while pos (remove-text-properties pos (1+ pos) '(display)) (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 @@ ;;;###autoload (defcustom printer-name - (and lpr-windows-system "PRN") + (and (memq system-type '(emx ms-dos)) "PRN") "*The name of a local printer to which data is sent for printing. \(Note that PostScript files are sent to `ps-printer-name', which see.\) 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 supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards' is non-nil; otherwise, it interprets wildcards as regular expressions to match file names. It does not support all `ls' switches -- those -that work are: A a c i r S s t u U X g G B C R and F partly." +that work are: A a c i r S s t u U X g G B C R n and F partly." (if ls-lisp-use-insert-directory-program (funcall original-insert-directory file switches wildcard full-directory-p) @@ -286,7 +286,10 @@ not contain `d', so that a full listing is expected." (let* ((dir (file-name-as-directory file)) (default-directory dir) ; so that file-attributes works (file-alist - (directory-files-and-attributes dir nil wildcard-regexp t 'string)) + (directory-files-and-attributes dir nil wildcard-regexp t + (if (memq ?n switches) + 'integer + 'string))) (now (current-time)) (sum 0) ;; 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 @@ ;;; hashcash.el --- Add hashcash payments to email -;; Copyright (C) 2003, 2004, 2005, 2007 Free Software Foundation +;; Copyright (C) 2003, 2004, 2005, 2007, 2008 Free Software Foundation ;; Written by: Paul Foley <mycroft@actrix.gen.nz> (1997-2002) ;; 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. (save-restriction (while (not (eobp)) (setq start (point)) - (cond ((looking-at "BABYL OPTIONS:");Babyl header + (cond ((looking-at "BABYL OPTIONS:") ;Babyl header (if (search-forward "\n\^_" nil t) ;; If we find the proper terminator, delete through there. (delete-region (point-min) (point)) @@ -1953,75 +1953,80 @@ is non-nil if the user has supplied the password interactively. (save-excursion (skip-chars-forward " \t\n") (point))) - (save-excursion - (let* ((header-end - (progn - (save-excursion - (goto-char start) - (forward-line 1) - (if (looking-at "0") - (forward-line 1) - (forward-line 2)) - (save-restriction - (narrow-to-region (point) (point-max)) - (rfc822-goto-eoh) - (point))))) - (case-fold-search t) - (quoted-printable-header-field-end - (save-excursion - (goto-char start) - (re-search-forward - "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*" - header-end t))) - (base64-header-field-end + ;; The following let* form was wrapped in a `save-excursion' + ;; which in one case caused infinite looping, see: + ;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00968.html + ;; Removing that form leaves `point' at the end of the + ;; region decoded by `rmail-decode-region' which should + ;; be correct. + (let* ((header-end + (progn (save-excursion (goto-char start) - ;; Don't try to decode non-text data. - (and (re-search-forward - "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/" - header-end t) - (goto-char start) - (re-search-forward - "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*" - header-end t))))) - (if quoted-printable-header-field-end + (forward-line 1) + (if (looking-at "0") + (forward-line 1) + (forward-line 2)) + (save-restriction + (narrow-to-region (point) (point-max)) + (rfc822-goto-eoh) + (point))))) + (case-fold-search t) + (quoted-printable-header-field-end (save-excursion - (unless - (mail-unquote-printable-region header-end (point) nil t t) - (message "Malformed MIME quoted-printable message")) - ;; Change "quoted-printable" to "8bit", - ;; to reflect the decoding we just did. - (goto-char quoted-printable-header-field-end) - (delete-region (point) (search-backward ":")) - (insert ": 8bit"))) - (if base64-header-field-end + (goto-char start) + (re-search-forward + "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*" + header-end t))) + (base64-header-field-end (save-excursion - (when - (condition-case nil - (progn - (base64-decode-region (1+ header-end) - (- (point) 2)) - t) - (error nil)) - ;; Change "base64" to "8bit", to reflect the - ;; decoding we just did. - (goto-char base64-header-field-end) - (delete-region (point) (search-backward ":")) - (insert ": 8bit")))) - (setq last-coding-system-used nil) - (or rmail-enable-mime - (not rmail-enable-multibyte) - (let ((mime-charset - (if (and rmail-decode-mime-charset - (save-excursion - (goto-char start) - (search-forward "\n\n" nil t) - (let ((case-fold-search t)) - (re-search-backward - rmail-mime-charset-pattern - start t)))) - (intern (downcase (match-string 1)))))) - (rmail-decode-region start (point) mime-charset))))) + (goto-char start) + ;; Don't try to decode non-text data. + (and (re-search-forward + "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/" + header-end t) + (goto-char start) + (re-search-forward + "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*" + header-end t))))) + (if quoted-printable-header-field-end + (save-excursion + (unless + (mail-unquote-printable-region header-end (point) nil t t) + (message "Malformed MIME quoted-printable message")) + ;; Change "quoted-printable" to "8bit", + ;; to reflect the decoding we just did. + (goto-char quoted-printable-header-field-end) + (delete-region (point) (search-backward ":")) + (insert ": 8bit"))) + (if base64-header-field-end + (save-excursion + (when + (condition-case nil + (progn + (base64-decode-region (1+ header-end) + (- (point) 2)) + t) + (error nil)) + ;; Change "base64" to "8bit", to reflect the + ;; decoding we just did. + (goto-char base64-header-field-end) + (delete-region (point) (search-backward ":")) + (insert ": 8bit")))) + (setq last-coding-system-used nil) + (or rmail-enable-mime + (not rmail-enable-multibyte) + (let ((mime-charset + (if (and rmail-decode-mime-charset + (save-excursion + (goto-char start) + (search-forward "\n\n" nil t) + (let ((case-fold-search t)) + (re-search-backward + rmail-mime-charset-pattern + start t)))) + (intern (downcase (match-string 1)))))) + (rmail-decode-region start (point) mime-charset)))) ;; Add an X-Coding-System: header if we don't have one. (save-excursion (goto-char start) @@ -2051,8 +2056,8 @@ is non-nil if the user has supplied the password interactively. (save-restriction (narrow-to-region start (1- (point))) (goto-char (point-min)) - (while (search-forward "\n\^_" nil t); single char "\^_" - (replace-match "\n^_")))); 2 chars: "^" and "_" + (while (search-forward "\n\^_" nil t) ; single char "\^_" + (replace-match "\n^_")))) ; 2 chars: "^" and "_" (setq last-coding-system-used nil) (or rmail-enable-mime (not rmail-enable-multibyte) @@ -2168,8 +2173,8 @@ is non-nil if the user has supplied the password interactively. (save-restriction (narrow-to-region start (point)) (goto-char (point-min)) - (while (search-forward "\n\^_" nil t); single char - (replace-match "\n^_")))); 2 chars: "^" and "_" + (while (search-forward "\n\^_" nil t) ; single char + (replace-match "\n^_")))) ; 2 chars: "^" and "_" ;; This is for malformed messages that don't end in newline. ;; There shouldn't be any, but some users say occasionally ;; 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 @@ ;;; mb-depth.el --- Indicate minibuffer-depth in prompt ;; -;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. ;; ;; Author: Miles Bader <miles@gnu.org> ;; 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 @@ ;;; md4.el --- MD4 Message Digest Algorithm. -;; Copyright (C) 2001, 2004, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2004, 2007, 2008 Free Software Foundation, Inc. ;; Author: Taro Kawagishi <tarok@transpulse.org> ;; 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 @@ +2008-01-30 Bill Wohler <wohler@newt.com> + + * mh-mime.el (mh-mml-to-mime): Don't look up sender if From + absent. Fixes "Wrong type argument: stringp, nil" error. + 2007-12-02 Glenn Morris <rgm@gnu.org> * 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]." (require 'message) (when mh-pgp-support-flag ;; PGP requires actual e-mail addresses, not aliases. - ;; Parse the recipients and sender from the message + ;; Parse the recipients and sender from the message. (message-options-set-recipient) - ;; Do an alias lookup on sender - (message-options-set 'message-sender - (mail-strip-quoted-names - (mh-alias-expand - (message-options-get 'message-sender)))) + ;; Do an alias lookup on sender (if From field is present). + (when (message-options-get 'message-sender) + (message-options-set 'message-sender + (mail-strip-quoted-names + (mh-alias-expand + (message-options-get 'message-sender))))) ;; Do an alias lookup on recipients (message-options-set 'message-recipients (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 @@ (defconst dbus-interface-introspectable "org.freedesktop.DBus.Introspectable" "The interface supported by introspectable objects.") +(defmacro dbus-ignore-errors (&rest body) + "Execute BODY; signal D-Bus error when `dbus-debug' is non-nil. +Otherwise, return result of last form in BODY, or all other errors." + `(condition-case err + (progn ,@body) + (dbus-error (when dbus-debug (signal (car err) (cdr err)))))) + +(put 'dbus-ignore-errors 'lisp-indent-function 0) +(put 'dbus-ignore-errors 'edebug-form-spec '(form symbolp body)) +(font-lock-add-keywords 'emacs-lisp-mode '("\\<dbus-ignore-errors\\>")) + ;;; Hash table of registered functions. @@ -64,6 +75,35 @@ hash table." dbus-registered-functions-table) result)) +(defun dbus-unregister-object (object) + "Unregister OBJECT from D-Bus. +OBJECT must be the result of a preceding `dbus-register-method' +or `dbus-register-signal' call. It returns t if OBJECT has been +unregistered, nil otherwise." + ;; Check parameter. + (unless (and (consp object) (not (null (car object))) (consp (cdr object))) + (signal 'wrong-type-argument (list 'D-Bus object))) + + ;; Find the corresponding entry in the hash table. + (let* ((key (car object)) + (value (gethash key dbus-registered-functions-table))) + ;; Loop over the registered functions. + (while (consp value) + ;; (car value) has the structure (UNAME SERVICE PATH HANDLER). + ;; (cdr object) has the structure ((SERVICE PATH HANDLER) ...). + (if (not (equal (cdr (car value)) (car (cdr object)))) + (setq value (cdr value)) + ;; Compute new hash value. If it is empty, remove it from + ;; hash table. + (unless + (puthash + key + (delete (car value) (gethash key dbus-registered-functions-table)) + dbus-registered-functions-table) + (remhash key dbus-registered-functions-table)) + (setq value t))) + value)) + (defun dbus-name-owner-changed-handler (&rest args) "Reapplies all member registrations to D-Bus. This handler is applied when a \"NameOwnerChanged\" signal has @@ -110,15 +150,13 @@ usage: (dbus-name-owner-changed-handler service old-owner new-owner)" args)))))) ;; Register the handler. -(condition-case nil - (progn - (dbus-register-signal - :system dbus-service-dbus dbus-path-dbus dbus-interface-dbus - "NameOwnerChanged" 'dbus-name-owner-changed-handler) - (dbus-register-signal - :session dbus-service-dbus dbus-path-dbus dbus-interface-dbus - "NameOwnerChanged" 'dbus-name-owner-changed-handler)) - (dbus-error)) +(dbus-ignore-errors + (dbus-register-signal + :system dbus-service-dbus dbus-path-dbus dbus-interface-dbus + "NameOwnerChanged" 'dbus-name-owner-changed-handler) + (dbus-register-signal + :session dbus-service-dbus dbus-path-dbus dbus-interface-dbus + "NameOwnerChanged" 'dbus-name-owner-changed-handler)) ;;; D-Bus events. @@ -168,16 +206,15 @@ part of the event, is called with arguments ARGS." (interactive "e") ;; We don't want to raise an error, because this function is called ;; in the event handling loop. - (condition-case err - (let (result) - (dbus-check-event event) - (setq result (apply (nth 7 event) (nthcdr 8 event))) - (unless (consp result) (setq result (cons result nil))) - ;; Return a message when serial is not nil. - (when (not (null (nth 2 event))) - (apply 'dbus-method-return - (nth 1 event) (nth 2 event) (nth 3 event) result))) - (dbus-error (when dbus-debug (signal (car err) (cdr err)))))) + (dbus-ignore-errors + (let (result) + (dbus-check-event event) + (setq result (apply (nth 7 event) (nthcdr 8 event))) + (unless (consp result) (setq result (cons result nil))) + ;; Return a message when serial is not nil. + (when (not (null (nth 2 event))) + (apply 'dbus-method-return-internal + (nth 1 event) (nth 2 event) (nth 3 event) result))))) (defun dbus-event-bus-name (event) "Return the bus name the event is coming from. @@ -238,11 +275,10 @@ well formed." "Return the D-Bus service names which can be activated as list. The result is a list of strings, which is nil when there are no activatable service names at all." - (condition-case nil - (dbus-call-method - :system dbus-service-dbus - dbus-path-dbus dbus-interface-dbus "ListActivatableNames") - (dbus-error))) + (dbus-ignore-errors + (dbus-call-method + :system dbus-service-dbus + dbus-path-dbus dbus-interface-dbus "ListActivatableNames"))) (defun dbus-list-names (bus) "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 registered service names at all. Well known names are strings like \"org.freedesktop.DBus\". Names starting with \":\" are unique names for services." - (condition-case nil - (dbus-call-method - bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames") - (dbus-error))) + (dbus-ignore-errors + (dbus-call-method + bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames"))) (defun dbus-list-known-names (bus) "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 \":\"." "Return the unique names registered at D-Bus BUS and queued for SERVICE. The result is a list of strings, or nil when there are no queued name owners service names at all." - (condition-case nil - (dbus-call-method - bus dbus-service-dbus dbus-path-dbus - dbus-interface-dbus "ListQueuedOwners" service) - (dbus-error))) + (dbus-ignore-errors + (dbus-call-method + bus dbus-service-dbus dbus-path-dbus + dbus-interface-dbus "ListQueuedOwners" service))) (defun dbus-get-name-owner (bus service) "Return the name owner of SERVICE registered at D-Bus BUS. The result is either a string, or nil if there is no name owner." - (condition-case nil - (dbus-call-method - bus dbus-service-dbus dbus-path-dbus - dbus-interface-dbus "GetNameOwner" service) - (dbus-error))) + (dbus-ignore-errors + (dbus-call-method + bus dbus-service-dbus dbus-path-dbus + dbus-interface-dbus "GetNameOwner" service))) (defun dbus-introspect (bus service path) "Return the introspection data of SERVICE in D-Bus BUS at object path PATH. @@ -291,10 +324,9 @@ Example: \(dbus-introspect :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\")" - (condition-case nil - (dbus-call-method - bus service path dbus-interface-introspectable "Introspect") - (dbus-error))) + (dbus-ignore-errors + (dbus-call-method + bus service path dbus-interface-introspectable "Introspect"))) (if nil ;; Must be reworked. Shall we offer D-Bus signatures at all? (defun dbus-get-signatures (bus interface signal) @@ -310,42 +342,39 @@ the third parameter is of type array of integer. If INTERFACE or SIGNAL do not exist, or if they do not support the D-Bus method org.freedesktop.DBus.Introspectable.Introspect, the function returns nil." - (condition-case nil - (let ((introspect-xml - (with-temp-buffer - (insert (dbus-introspect bus interface)) - (xml-parse-region (point-min) (point-max)))) - node interfaces signals args result) - ;; Get the root node. - (setq node (xml-node-name introspect-xml)) - ;; Get all interfaces. - (setq interfaces (xml-get-children node 'interface)) - (while interfaces - (when (string-equal (xml-get-attribute (car interfaces) 'name) - interface) - ;; That's the requested interface. Check for signals. - (setq signals (xml-get-children (car interfaces) 'signal)) - (while signals - (when (string-equal (xml-get-attribute (car signals) 'name) - signal) - ;; The signal we are looking for. - (setq args (xml-get-children (car signals) 'arg)) - (while args - (unless (xml-get-attribute (car args) 'type) - ;; This shouldn't happen, let's escape. - (signal 'dbus-error "")) - ;; We append the signature. - (setq - result (append result - (list (xml-get-attribute (car args) 'type)))) - (setq args (cdr args))) - (setq signals nil)) - (setq signals (cdr signals))) - (setq interfaces nil)) - (setq interfaces (cdr interfaces))) - result) - ;; We ignore `dbus-error'. There might be no introspectable interface. - (dbus-error nil))) + (dbus-ignore-errors + (let ((introspect-xml + (with-temp-buffer + (insert (dbus-introspect bus interface)) + (xml-parse-region (point-min) (point-max)))) + node interfaces signals args result) + ;; Get the root node. + (setq node (xml-node-name introspect-xml)) + ;; Get all interfaces. + (setq interfaces (xml-get-children node 'interface)) + (while interfaces + (when (string-equal (xml-get-attribute (car interfaces) 'name) + interface) + ;; That's the requested interface. Check for signals. + (setq signals (xml-get-children (car interfaces) 'signal)) + (while signals + (when (string-equal (xml-get-attribute (car signals) 'name) signal) + ;; The signal we are looking for. + (setq args (xml-get-children (car signals) 'arg)) + (while args + (unless (xml-get-attribute (car args) 'type) + ;; This shouldn't happen, let's escape. + (signal 'dbus-error nil)) + ;; We append the signature. + (setq + result (append result + (list (xml-get-attribute (car args) 'type)))) + (setq args (cdr args))) + (setq signals nil)) + (setq signals (cdr signals))) + (setq interfaces nil)) + (setq interfaces (cdr interfaces))) + result))) ) ;; (if nil ... (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 @@ ;;; hmac-def.el --- A macro for defining HMAC functions. -;; Copyright (C) 1999, 2001, 2007 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2001, 2007, 2008 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> ;; 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 @@ ;;; hmac-md5.el --- Compute HMAC-MD5. -;; Copyright (C) 1999, 2001, 2007 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2001, 2007, 2008 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> ;; 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." (when imap-stream buffer)))) +(defcustom imap-ping-server t + "If non-nil, check if IMAP is open. +See the function `imap-ping-server'." + :version "23.0" ;; No Gnus + :group 'imap + :type 'boolean) + (defun imap-opened (&optional buffer) "Return non-nil if connection to imap server in BUFFER is open. If BUFFER is nil then the current buffer is used." @@ -1157,7 +1164,18 @@ If BUFFER is nil then the current buffer is used." (buffer-live-p buffer) (with-current-buffer buffer (and imap-process - (memq (process-status imap-process) '(open run)))))) + (memq (process-status imap-process) '(open run)) + (if imap-ping-server + (imap-ping-server) + t))))) + +(defun imap-ping-server (&optional buffer) + "Ping the IMAP server in BUFFER with a \"NOOP\" command. +Return non-nil if the server responds, and nil if it does not +respond. If BUFFER is nil, the current buffer is used." + (condition-case () + (imap-ok-p (imap-send-command-wait "NOOP" buffer)) + (error nil))) (defun imap-authenticate (&optional user passwd buffer) "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 @@ ;;; ntlm.el --- NTLM (NT LanManager) authentication support -;; Copyright (C) 2001, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2007, 2008 Free Software Foundation, Inc. ;; Author: Taro Kawagishi <tarok@transpulse.org> ;; 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 @@ ;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework -;; Copyright (C) 2000, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2007, 2008 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> ;; 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 @@ ;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework -;; Copyright (C) 2000, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2007, 2008 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> ;; 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 @@ ;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework -;; Copyright (C) 2000, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2007, 2008 Free Software Foundation, Inc. ;; Author: Taro Kawagishi <tarok@transpulse.org> ;; 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 @@ ;;; sasl.el --- SASL client framework -;; Copyright (C) 2000, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2007, 2008 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> ;; 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 @@ ;;; tramp-cache.el --- file information caching for Tramp -;; Copyright (C) 2000, 2005, 2006, 2007 by Free Software Foundation, Inc. +;; Copyright (C) 2000, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;; Author: Daniel Pittman <daniel@inanna.danann.net> ;; 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 @@ ;;; tramp-cmds.el --- Interactive commands for Tramp -;; Copyright (C) 2007 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; 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 @@ ;;; tramp-compat.el --- Tramp compatibility functions -;; Copyright (C) 2007 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; 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 @@ ;;; tramp-fish.el --- Tramp access functions for FISH protocol -;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; 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 @@ ;;; tramp-gw.el --- Tramp utility functions for HTTP tunnels and SOCKS gateways -;; Copyright (C) 2007 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; 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." (tramp-password-end-of-line nil)) ("sudo" (tramp-login-program "sudo") (tramp-login-args (("-u" "%u") - ("-s" "-p" "Password:"))) + ("-s") ("-H") ("-p" "Password:"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program nil) (tramp-copy-args nil) @@ -519,7 +519,9 @@ files conditionalize this setup based on the TERM environment variable." (tramp-default-port 22)) ("plinkx" (tramp-login-program "plink") - (tramp-login-args (("-load" "%h") ("-t") + ;; ("%h") must be a single element, see + ;; `tramp-compute-multi-hops'. + (tramp-login-args (("-load") ("%h") ("-t") (,(format "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=$ '" tramp-terminal-type)) @@ -914,7 +916,7 @@ directories for POSIX compatible commands." (string :tag "Directory")))) (defcustom tramp-remote-process-environment - `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_CTYPE=C" "LC_TIME=C" + `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_ALL=C" ,(concat "TERM=" tramp-terminal-type) "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "autocorrect=" "correct=") @@ -1433,9 +1435,11 @@ means to use always cached values for the directory contents." ;;; Internal Variables: (defvar tramp-end-of-output - (concat - "///" (md5 (concat - (prin1-to-string process-environment) (current-time-string)))) + (format + "%s///%s%s" + tramp-rsh-end-of-line + (md5 (concat (prin1-to-string process-environment) (current-time-string))) + tramp-rsh-end-of-line) "String used to recognize end of output.") (defvar tramp-current-method nil @@ -3032,6 +3036,11 @@ and `rename'. FILENAME and NEWNAME must be absolute file names." ;; One of them must be a Tramp file. (error "Tramp implementation says this cannot happen"))) + ;; In case of `rename', we must flush the cache of the source file. + (when (and t1 (eq op 'rename)) + (with-parsed-tramp-file-name filename nil + (tramp-flush-file-property v localname))) + ;; When newname did exist, we have wrong cached values. (when t2 (with-parsed-tramp-file-name newname nil @@ -3774,13 +3783,15 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1." (command &optional output-buffer error-buffer) "Like `shell-command' for Tramp files." (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command)) - (args (split-string (substring command 0 asynchronous) " ")) + ;; We cannot use `shell-file-name' and `shell-command-switch', + ;; they are variables of the local host. + (args (list "/bin/sh" "-c" (substring command 0 asynchronous))) (output-buffer (cond ((bufferp output-buffer) output-buffer) ((stringp output-buffer) (get-buffer-create output-buffer)) (output-buffer (current-buffer)) - (t (generate-new-buffer + (t (get-buffer-create (if asynchronous "*Async Shell Command*" "*Shell Command Output*"))))) @@ -3792,22 +3803,42 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1." (if (and (not asynchronous) error-buffer) (with-parsed-tramp-file-name default-directory nil (list output-buffer (tramp-make-tramp-temp-file v))) - output-buffer))) - - (prog1 - ;; Run the process. - (if (integerp asynchronous) + output-buffer)) + (proc (get-buffer-process output-buffer))) + + ;; Check whether there is another process running. Tramp does not + ;; support 2 (asynchronous) processes in parallel. + (when proc + (if (yes-or-no-p "A command is running. Kill it? ") + (ignore-errors (kill-process proc)) + (error "Shell command in progress"))) + + (with-current-buffer output-buffer + (setq buffer-read-only nil + buffer-undo-list t) + (erase-buffer)) + + (if (integerp asynchronous) + (prog1 + ;; Run the process. (apply 'start-file-process "*Async Shell*" buffer args) - (apply 'process-file (car args) nil buffer nil (cdr args))) - ;; Insert error messages if they were separated. - (when (listp buffer) - (with-current-buffer error-buffer (insert-file-contents (cadr buffer))) - (delete-file (cadr buffer))) - ;; There's some output, display it. - (when (with-current-buffer output-buffer (> (point-max) (point-min))) - (if (functionp 'display-message-or-buffer) - (funcall (symbol-function 'display-message-or-buffer) output-buffer) - (pop-to-buffer output-buffer)))))) + ;; Display output. + (pop-to-buffer output-buffer)) + + (prog1 + ;; Run the process. + (apply 'process-file (car args) nil buffer nil (cdr args)) + ;; Insert error messages if they were separated. + (when (listp buffer) + (with-current-buffer error-buffer + (insert-file-contents (cadr buffer))) + (delete-file (cadr buffer))) + ;; There's some output, display it. + (when (with-current-buffer output-buffer (> (point-max) (point-min))) + (if (functionp 'display-message-or-buffer) + (funcall (symbol-function 'display-message-or-buffer) + output-buffer) + (pop-to-buffer output-buffer))))))) ;; File Editing. @@ -5360,22 +5391,14 @@ file exists and nonzero exit status otherwise." vec (format "PROMPT_COMMAND='' PS1='$ ' PS2='' PS3='' exec %s" shell) t)) + ;; Setting prompts. (tramp-message vec 5 "Setting remote shell prompt...") - ;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we - ;; must use "\n" here, not tramp-rsh-end-of-line. Kai left the - ;; last tramp-rsh-end-of-line, Douglas wanted to replace that, - ;; as well. - (tramp-send-command - vec - (format "PS1='%s%s%s'" - tramp-rsh-end-of-line - tramp-end-of-output - tramp-rsh-end-of-line) - t) + (tramp-send-command vec (format "PS1='%s'" tramp-end-of-output) t) (tramp-send-command vec "PS2=''" t) (tramp-send-command vec "PS3=''" t) (tramp-send-command vec "PROMPT_COMMAND=''" t) (tramp-message vec 5 "Setting remote shell prompt...done")) + (t (tramp-message vec 5 "Remote `%s' groks tilde expansion, good" (tramp-get-method-parameter @@ -5668,13 +5691,7 @@ process to set up. VEC specifies the connection." ;; We can set $PS1 to `tramp-end-of-output' only when the echo has ;; been disabled. Otherwise, the echo of the command would be ;; regarded as prompt already. - (tramp-send-command - vec - (format "PS1='%s%s%s'" - tramp-rsh-end-of-line - tramp-end-of-output - tramp-rsh-end-of-line) - t) + (tramp-send-command vec (format "PS1='%s'" tramp-end-of-output) t) (tramp-send-command vec "PS2=''" t) (tramp-send-command vec "PS3=''" t) (tramp-send-command vec "PROMPT_COMMAND=''" t) @@ -6059,6 +6076,29 @@ Gateway hops are already opened." "Method `%s' is not supported for multi-hops." (tramp-file-name-method item))))) + ;; In case the host name is not used for the remote shell + ;; command, the user could be misguided by applying a random + ;; hostname. + (let* ((v (car target-alist)) + (method (tramp-file-name-method v)) + (host (tramp-file-name-host v))) + (unless + (or + ;; There are multi-hops. + (cdr target-alist) + ;; The host name is used for the remote shell command. + (member + '("%h") (tramp-get-method-parameter method 'tramp-login-args)) + ;; The host is local. We cannot use `tramp-local-host-p' + ;; here, because it opens a connection as well. + (string-match + (concat "^" (regexp-opt (list "localhost" (system-name)) t) "$") + host)) + (tramp-error + v 'file-error + "Host `%s' looks like a remote host, `%s' can only use the local host" + host method))) + ;; Result. target-alist)) @@ -6249,7 +6289,11 @@ function waits for output unless NOOUTPUT is set." (with-current-buffer (process-buffer proc) ;; Initially, `tramp-end-of-output' is "$ ". There might be ;; leading escape sequences, which must be ignored. - (let* ((regexp (format "^[^$\n]*%s\r?$" (regexp-quote tramp-end-of-output))) + (let* ((regexp + (if (string-match (regexp-quote "\n") tramp-end-of-output) + (mapconcat + 'identity (split-string tramp-end-of-output "\n") "\r?\n") + (format "^[^$\n]*%s\r?$" (regexp-quote tramp-end-of-output)))) (found (tramp-wait-for-regexp proc timeout regexp))) (if found (let (buffer-read-only) @@ -6666,6 +6710,10 @@ values." (user (match-string (nth 2 tramp-file-name-structure) name)) (host (match-string (nth 3 tramp-file-name-structure) name)) (localname (match-string (nth 4 tramp-file-name-structure) name))) + (when (member method '("multi" "multiu")) + (error + "`%s' method is no longer supported, see (info \"(tramp)Multi-hops\")" + method)) (if nodefault (vector method user host localname) (vector @@ -6731,11 +6779,20 @@ necessary only. This function will be used in file name completion." (defun tramp-local-host-p (vec) "Return t if this points to the local host, nil otherwise." - (let ((host (tramp-file-name-real-host vec))) + ;; We cannot use `tramp-file-name-real-host'. A port is an + ;; indication for an ssh tunnel or alike. + (let ((host (tramp-file-name-host vec))) (and (stringp host) (string-match - (concat "^" (regexp-opt (list "localhost" (system-name)) t) "$") host)))) + (concat "^" (regexp-opt (list "localhost" (system-name)) t) "$") host) + ;; The local temp directory must be writable for the other user. + (file-writable-p + (tramp-make-tramp-file-name + (tramp-file-name-method vec) + (tramp-file-name-user vec) + host + (tramp-compat-temporary-file-directory)))))) ;; Variables local to connection. @@ -6831,8 +6888,7 @@ necessary only. This function will be used in file name completion." vec (format "( %s / -nt / )" (tramp-get-test-command vec))) (with-current-buffer (tramp-get-buffer vec) (goto-char (point-min)) - (when (looking-at - (format "\n%s\r?\n" (regexp-quote tramp-end-of-output))) + (when (looking-at (regexp-quote tramp-end-of-output)) (format "%s %%s -nt %%s" (tramp-get-test-command vec))))) (progn (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 @@ ;;; -*- mode: Emacs-Lisp; coding: utf-8; -*- ;;; lisp/trampver.el. Generated from trampver.el.in by configure. -;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2004, 2005, 2006, 2007, +;; 2008 Free Software Foundation, Inc. ;; Author: Kai Großjohann <kai.grossjohann@gmx.net> ;; Keywords: comm, processes @@ -30,14 +31,14 @@ ;; "autoconf && ./configure" to change them. (X)Emacs version check is defined ;; in macro AC_EMACS_INFO of aclocal.m4; should be changed only there. -(defconst tramp-version "2.1.12" +(defconst tramp-version "2.1.13-pre" "This version of Tramp.") (defconst tramp-bug-report-address "tramp-devel@gnu.org" "Email address to send bug reports to.") ;; Check for (X)Emacs version. -(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"))) +(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"))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) (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 @@ ;;; nxml-enc.el --- XML encoding auto-detection -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; nxml-glyph.el --- glyph-handling for nxml-mode -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; nxml-maint.el --- commands for maintainers of nxml-*.el -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; nxml-mode.el --- a new XML mode -;; Copyright (C) 2003, 2004, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2004, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; Keywords: XML @@ -24,8 +24,6 @@ ;;; Commentary: -;; To use this include rng-auto.el in your .emacs. - ;; See nxml-rap.el for description of parsing strategy. ;; The font locking here is independent of font-lock.el. We want to @@ -45,6 +43,9 @@ (require 'nxml-rap) (require 'nxml-outln) +(declare-function rng-nxml-mode-init "rng-nxml") +(declare-function nxml-enable-unicode-char-name-sets "nxml-uchnm") + ;;; Customization (defgroup nxml nil @@ -479,9 +480,9 @@ instead of C-c. Validation is provided by the related minor-mode `rng-validate-mode'. This also makes completion schema- and context- sensitive. Element names, attribute names, attribute values and namespace URIs can all be -completed. By default, `rng-validate-mode' is automatically enabled by -`rng-nxml-mode-init' which is normally added to `nxml-mode-hook'. You -can toggle it using \\[rng-validate-mode]. +completed. By default, `rng-validate-mode' is automatically enabled. You +can toggle it using \\[rng-validate-mode] or change the default by +customizing `rng-nxml-auto-validate-flag'. \\[indent-for-tab-command] indents the current line appropriately. This can be customized using the variable `nxml-child-indent' @@ -509,6 +510,7 @@ Many aspects this mode can be customized using (kill-all-local-variables) (setq major-mode 'nxml-mode) (setq mode-name "nXML") + (set (make-local-variable 'mode-line-process) '((nxml-degraded "/degraded"))) ;; We'll determine the fill prefix ourselves (make-local-variable 'adaptive-fill-mode) (setq adaptive-fill-mode nil) @@ -555,6 +557,8 @@ Many aspects this mode can be customized using (setq buffer-file-coding-system nxml-default-buffer-file-coding-system)) (when nxml-auto-insert-xml-declaration-flag (nxml-insert-xml-declaration))) + (rng-nxml-mode-init) + (nxml-enable-unicode-char-name-sets) (run-hooks 'nxml-mode-hook)) (defun nxml-degrade (context err) @@ -570,8 +574,7 @@ Many aspects this mode can be customized using (nxml-with-unmodifying-text-property-changes (nxml-clear-face (point-min) (point-max)) (nxml-set-fontified (point-min) (point-max)) - (nxml-clear-inside (point-min) (point-max))) - (setq mode-name "nXML/degraded")))) + (nxml-clear-inside (point-min) (point-max)))))) ;;; Change management @@ -2433,7 +2436,7 @@ and attempts to find another possible way to do the markup." ;;; Character names -(defvar nxml-char-name-ignore-case nil) +(defvar nxml-char-name-ignore-case t) (defvar nxml-char-name-alist nil "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 @@ ;;; nxml-ns.el --- XML namespace processing -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; nxml-outln.el --- outline support for nXML mode -;; Copyright (C) 2004, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; nxml-parse.el --- XML parser, sharing infrastructure with nxml-mode -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; nxml-rap.el --- low-level support for random access parsing for nXML mode -;; Copyright (C) 2003, 2004, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2004, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; nxml-uchnm.el --- support for Unicode standard cha names in nxml-mode -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; Keywords: XML @@ -28,9 +28,6 @@ ;; Standard. The use of the names can be controlled on a per-block ;; basis, so as both to reduce memory usage and loading time, ;; and to make completion work better. -;; The main entry point is `nxml-enable-unicode-char-name-sets'. Typically, -;; this is added to `nxml-mode-hook' (rng-auto.el does this already). -;; To customize the blocks for which names are used ;;; Code: @@ -213,7 +210,9 @@ by a hyphen." data-directory))) nxml-unicode-blocks) -(defvar nxml-enable-unicode-char-name-sets-flag nil) +;; Internal flag to control whether customize reloads the character tables. +;; Should be set the first time the +(defvar nxml-internal-unicode-char-name-sets-enabled nil) (defcustom nxml-enabled-unicode-blocks nxml-enabled-unicode-blocks-default "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." :group 'nxml :set (lambda (sym value) (set-default 'nxml-enabled-unicode-blocks value) - (when nxml-enable-unicode-char-name-sets-flag - (nxml-enable-unicode-char-name-sets-1))) + (when nxml-internal-unicode-char-name-sets-enabled + (nxml-enable-unicode-char-name-sets))) :type (cons 'set (mapcar (lambda (block) `(const :tag ,(format "%s (%04X-%04X)" @@ -240,11 +239,7 @@ of the block by downcasing and replacing each space by a hyphen." The Unicode blocks for which names are enabled is controlled by the variable `nxml-enabled-unicode-blocks'." (interactive) - (setq nxml-char-name-ignore-case t) - (setq nxml-enable-unicode-char-name-sets-flag t) - (nxml-enable-unicode-char-name-sets-1)) - -(defun nxml-enable-unicode-char-name-sets-1 () + (setq nxml-internal-unicode-char-name-sets-enabled t) (mapc (lambda (block) (nxml-disable-char-name-set (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 @@ ;;; nxml-util.el --- utility functions for nxml-*.el -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; rng-cmpct.el --- parsing of RELAX NG Compact Syntax schemas -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; rng-dt.el --- datatype library interface for RELAX NG -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; rng-loc.el --- locate the schema to use for validation -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; rng-maint.el --- commands for RELAX NG maintainers -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; rng-match.el --- matching of RELAX NG patterns against XML events -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; rng-nxml.el --- make nxml-mode take advantage of rng-validate-mode -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; Keywords: XML, RelaxNG @@ -41,10 +41,12 @@ :type 'boolean :group 'relax-ng) -(defvar rng-preferred-prefix-alist-default nil - "Default value for variable `rng-preferred-prefix-alist'.") - -(defcustom rng-preferred-prefix-alist rng-preferred-prefix-alist-default +(defcustom rng-preferred-prefix-alist + '(("http://www.w3.org/1999/XSL/Transform" . "xsl") + ("http://www.w3.org/1999/02/22-rdf-syntax-ns#" . "rdf") + ("http://www.w3.org/1999/xlink" . "xlink") + ("http://www.w3.org/2001/XmlSchema" . "xsd") + ("http://www.w3.org/2001/XMLSchema-instance" . "xsi")) "*Alist of namespaces vs preferred prefixes." :type '(repeat (cons :tag "With" (string :tag "this namespace URI") @@ -100,8 +102,9 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil." (easy-menu-define rng-nxml-menu nxml-mode-map "Menu for nxml-mode used with rng-validate-mode." rng-nxml-easy-menu) - (setq mode-line-process - '(rng-validate-mode (:eval (rng-compute-mode-line-string)))) + (add-to-list 'mode-line-process + '(rng-validate-mode (:eval (rng-compute-mode-line-string))) + 'append) (cond (rng-nxml-auto-validate-flag (rng-validate-mode 1) (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 @@ ;;; rng-parse.el --- parse an XML file and validate it against a schema -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; rng-pttrn.el --- RELAX NG patterns -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; rng-uri.el --- URI parsing and manipulation -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; rng-util.el --- utility functions for RELAX NG library -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; rng-valid.el --- real-time validation of XML using RELAX NG -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; rng-xsd.el --- W3C XML Schema datatypes library for RELAX NG -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; xmltok.el --- XML tokenization -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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 @@ ;;; xsd-regexp.el --- translate W3C XML Schema regexps to Emacs regexps -;; Copyright (C) 2003, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. ;; Author: James Clark ;; 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.") (defcustom whitespace-check-leading-whitespace t "Flag to check leading whitespace. This is the global for the system. -It can be overriden by setting a buffer local variable +It can be overridden by setting a buffer local variable `whitespace-check-buffer-leading'." :type 'boolean :group 'whitespace) (defcustom whitespace-check-trailing-whitespace t "Flag to check trailing whitespace. This is the global for the system. -It can be overriden by setting a buffer local variable +It can be overridden by setting a buffer local variable `whitespace-check-buffer-trailing'." :type 'boolean :group 'whitespace) (defcustom whitespace-check-spacetab-whitespace t "Flag to check space followed by a TAB. This is the global for the system. -It can be overriden by setting a buffer local variable +It can be overridden by setting a buffer local variable `whitespace-check-buffer-spacetab'." :type 'boolean :group 'whitespace) @@ -185,7 +185,7 @@ It can be overriden by setting a buffer local variable (defcustom whitespace-check-indent-whitespace indent-tabs-mode "Flag to check indentation whitespace. This is the global for the system. -It can be overriden by setting a buffer local variable +It can be overridden by setting a buffer local variable `whitespace-check-buffer-indent'." :type 'boolean :group 'whitespace) @@ -198,7 +198,7 @@ The default value ignores leading TABs." (defcustom whitespace-check-ateol-whitespace t "Flag to check end-of-line whitespace. This is the global for the system. -It can be overriden by setting a buffer local variable +It can be overridden by setting a buffer local variable `whitespace-check-buffer-ateol'." :type 'boolean :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." (or (eq last-command 'outline-up-heading) (push-mark))) (outline-back-to-heading invisible-ok) (let ((start-level (funcall outline-level))) - (if (eq start-level 1) - (error "Already at top level of the outline")) + (when (<= start-level 1) + (error "Already at top level of the outline")) (while (and (> start-level 1) (> arg 0) (not (bobp))) (let ((level start-level)) (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 @@ ;;; password-cache.el --- Read passwords, possibly using a password cache. -;; Copyright (C) 1999, 2000, 2003, 2004, 2005, 2006, 2007 +;; Copyright (C) 1999, 2000, 2003, 2004, 2005, 2006, 2007, 2008 ;; Free Software Foundation, Inc. ;; 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.") (easy-menu-define cvs-menu cvs-mode-map "Menu used in `cvs-mode'." '("CVS" - ["Open file.." cvs-mode-find-file t] - [" ..other window" cvs-mode-find-file-other-window t] + ["Open file" cvs-mode-find-file t] + ["Open in other window" cvs-mode-find-file-other-window t] ["Display in other window" cvs-mode-display-file t] ["Interactive merge" cvs-mode-imerge t] ("View diff" @@ -413,6 +413,7 @@ This variable is buffer local and only used in the *cvs* buffer.") ["Current diff" cvs-mode-diff t] ["Diff with head" cvs-mode-diff-head t] ["Diff with vendor" cvs-mode-diff-vendor t] + ["Diff against yesterday" cvs-mode-diff-yesterday t] ["Diff with backup" cvs-mode-diff-backup t]) ["View log" cvs-mode-log t] ["View status" cvs-mode-status t] @@ -437,6 +438,9 @@ This variable is buffer local and only used in the *cvs* buffer.") ["Unmark all" cvs-mode-unmark-all-files t] ["Hide handled" cvs-mode-remove-handled t] "----" + ["PCL-CVS Manual" (lambda () (interactive) + (info "(pcl-cvs)Top")) t] + "----" ["Quit" cvs-mode-quit t])) ;;;; 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." ;; do want to reset the mode for VC, so we do it explicitly. (vc-find-file-hook) (when (eq (cvs-fileinfo->type fileinfo) 'CONFLICT) - (smerge-mode 1)))))))) + (smerge-start-session)))))))) (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 @@ (blackbox-redefine-key map 'move-end-of-line 'bb-eol) (blackbox-redefine-key map 'move-beginning-of-line 'bb-bol) (define-key map " " 'bb-romp) + (define-key map "q" 'bury-buffer) (define-key map [insert] 'bb-romp) + (define-key map [return] 'bb-done) (blackbox-redefine-key map 'newline 'bb-done) map)) 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 @@ ;;; bubbles.el --- Puzzle game for Emacs. -;; Copyright (C) 2007 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. ;; Author: Ulf Jasper <ulf.jasper@web.de> ;; 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." (buffer-undo-list t) (inhibit-read-only t) (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t)) + (inhibit-modification-hooks t) + buffer-file-name buffer-file-truename) (remove-text-properties (point-min) (point-max) '(syntax-table nil)) (goto-char (point-min)) (while (re-search-forward @@ -4954,11 +4955,11 @@ The paragraph is indented on the first line." ;; cursor at the correct position. ;; Standard Ada does not force any relation between unit names and file names, ;; so some of these functions can only be a good approximation. However, they -;; are also overriden in `ada-xref'.el when we know that the user is using +;; are also overridden in `ada-xref'.el when we know that the user is using ;; GNAT. ;; --------------------------------------------------- -;; Overriden when we work with GNAT, to use gnatkrunch +;; Overridden when we work with GNAT, to use gnatkrunch (defun ada-make-filename-from-adaname (adaname) "Determine the filename in which ADANAME is found. 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 (defun ada-convert-file-name (name) "Convert from NAME to a name that can be used by the compilation commands. -This is overriden on VMS to convert from VMS filenames to Unix filenames." +This is overridden on VMS to convert from VMS filenames to Unix filenames." name) ;; FIXME: use convert-standard-filename instead 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 @@ (defun c-awk-get-NL-prop-prev-line (&optional do-lim) ;; Get the c-awk-NL-prop text-property from the previous line, calculating - ;; it if necessary. Return nil if we're at BOB. + ;; it if necessary. Return nil if we're already at BOB. ;; See c-awk-after-if-for-while-condition-p for a description of DO-LIM. ;; ;; 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." ;; This is the list of brace syntactic symbols that can hang. ;; If any new ones are added to c-offsets-alist, they should be ;; added here as well. - '(class-open class-close defun-open defun-close + ;; + ;; The order of this list is important; if SYNTAX has several + ;; elements, the element that "wins" is the earliest in SYMS. + '(arglist-cont-nonempty ; e.g. an array literal. + class-open class-close defun-open defun-close inline-open inline-close brace-list-open brace-list-close 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 @@ ;;; Variables also used at compile time. -(defconst c-version "5.31.4" +(defconst c-version "5.31.5" "CC Mode version number.") (defconst c-version-sym (intern c-version)) @@ -425,6 +425,8 @@ The return value is the value of the last form in BODY." (inhibit-read-only t) (inhibit-point-motion-hooks t) before-change-functions after-change-functions deactivate-mark + buffer-file-name buffer-file-truename ; Prevent primitives checking + ; for file modification ,@varlist) (unwind-protect (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." ;; ;; The point is left at the first token after the first complete ;; declarator, if there is one. The return value is a cons where - ;; the car is the position of the first token in the declarator. + ;; the car is the position of the first token in the declarator. (See + ;; below for the cdr.) ;; Some examples: ;; ;; void foo (int a, char *b) stuff ... @@ -5118,9 +5119,9 @@ comment at the start of cc-engine.el for more info." ;; Foo::Foo (int b) : Base (b) {} ;; car ^ ^ point ;; - ;; The cdr of the return value is non-nil if a - ;; `c-typedef-decl-kwds' specifier is found in the declaration, - ;; i.e. the declared identifier(s) are types. + ;; The cdr of the return value is non-nil iff a `c-typedef-decl-kwds' + ;; specifier (e.g. class, struct, enum, typedef) is found in the + ;; declaration, i.e. the declared identifier(s) are types. ;; ;; If a cast is parsed: ;; @@ -5135,7 +5136,7 @@ comment at the start of cc-engine.el for more info." ;; the first token in (the visible part of) the buffer. ;; ;; CONTEXT is a symbol that describes the context at the point: - ;; 'decl In a comma-separatded declaration context (typically + ;; 'decl In a comma-separated declaration context (typically ;; inside a function declaration arglist). ;; '<> In an angle bracket arglist. ;; 'arglist Some other type of arglist. @@ -8032,12 +8033,15 @@ comment at the start of cc-engine.el for more info." ;; CASE 5A.5: ordinary defun open (t - (goto-char placeholder) - (if (or containing-decl-open macro-start) - (c-add-syntax 'defun-open (c-point 'boi)) - ;; Bogus to use bol here, but it's the legacy. - (c-add-syntax 'defun-open (c-point 'bol))) - ))) + (save-excursion + (c-beginning-of-decl-1 lim) + (while (looking-at c-specifier-key) + (goto-char (match-end 1)) + (c-forward-syntactic-ws indent-point)) + (c-add-syntax 'defun-open (c-point 'boi)) + ;; Bogus to use bol here, but it's the legacy. (Resolved, + ;; 2007-11-09) + )))) ;; CASE 5B: After a function header but before the body (or ;; the ending semicolon if there's no body). @@ -8296,6 +8300,7 @@ comment at the start of cc-engine.el for more info." ;; CASE 5H: we could be looking at subsequent knr-argdecls ((and c-recognize-knr-p + (not containing-sexp) ; can't be knr inside braces. (not (eq char-before-ip ?})) (save-excursion (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', (c-lang-defvar c-prefix-spec-kwds-re (c-lang-const c-prefix-spec-kwds-re)) (c-lang-defconst c-specifier-key - ;; Adorned regexp of the keywords in `c-prefix-spec-kwds' that - ;; aren't ambiguous with types or type prefixes. + ;; Adorned regexp of the keywords in `c-prefix-spec-kwds' that aren't + ;; ambiguous with types or type prefixes. These are the keywords (like + ;; extern, namespace, but NOT template) that can modify a declaration. t (c-make-keywords-re t (set-difference (c-lang-const c-prefix-spec-kwds) - (c-lang-const c-type-start-kwds) + (append (c-lang-const c-type-start-kwds) + (c-lang-const c-<>-arglist-kwds)) :test 'string-equal))) (c-lang-defvar c-specifier-key (c-lang-const c-specifier-key)) 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 @@ '(("gnu" (c-basic-offset . 2) (c-comment-only-line-offset . (0 . 0)) - (c-hanging-braces-alist . ((substatement-open before after))) + (c-hanging-braces-alist . ((substatement-open before after) + (arglist-cont-nonempty))) (c-offsets-alist . ((statement-block-intro . +) (knr-argdecl-intro . 5) (substatement-open . +) @@ -170,7 +171,8 @@ (case-label . +) (access-label . -) (inclass . ++) - (inline-open . 0)))) + (inline-open . 0) + (arglist-cont-nonempty)))) ("linux" (c-basic-offset . 8) @@ -178,7 +180,8 @@ (c-hanging-braces-alist . ((brace-list-open) (brace-entry-open) (substatement-open after) - (block-close . c-snug-do-while))) + (block-close . c-snug-do-while) + (arglist-cont-nonempty))) (c-cleanup-list . (brace-else-brace)) (c-offsets-alist . ((statement-block-intro . +) (knr-argdecl-intro . 0) @@ -200,7 +203,8 @@ (brace-list-close) (brace-entry-open) (substatement-open after) - (block-close . c-snug-do-while))) + (block-close . c-snug-do-while) + (arglist-cont-nonempty))) (c-block-comment-prefix . "")) ("java" @@ -230,7 +234,8 @@ (c-hanging-braces-alist . ((defun-open after) (defun-close . c-snug-1line-defun-close) (substatement-open after) - (block-close . c-snug-do-while))) + (block-close . c-snug-do-while) + (arglist-cont-nonempty))) (c-hanging-semi&comma-criteria . nil) (c-cleanup-list . nil) ; You might want one-liner-defun here. (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." :format "%t%n" :value 'other)) +;; The next defun will supersede c-const-symbol. +(eval-and-compile + (defun c-constant-symbol (sym len) + "Create an uneditable symbol for customization buffers. +SYM is the name of the symbol, LEN the length of the field (in +characters) the symbol will be displayed in. LEN must be big +enough. + +This returns a (const ....) structure, suitable for embedding +within a customization type." + (or (symbolp sym) (error "c-constant-symbol: %s is not a symbol" sym)) + (let* ((name (symbol-name sym)) + (l (length name)) + (disp (concat name ":" (make-string (- len l 1) ?\ )))) + `(const + :size ,len + :format ,disp + :value ,sym)))) + (define-widget 'c-const-symbol 'item - "An uneditable lisp symbol." + "An uneditable lisp symbol. This is obsolete - +use c-constant-symbol instead." :value nil :tag "Symbol" :format "%t: %v\n%d" @@ -305,6 +325,7 @@ e.g. `c-special-indent-hook'." :type 'boolean :group 'c) (make-variable-buffer-local 'c-syntactic-indentation) +(put 'c-syntactic-indentation 'safe-local-variable 'booleanp) (defcustom c-syntactic-indentation-in-macros t "*Enable syntactic analysis inside macros. @@ -323,6 +344,7 @@ countered easily by surrounding the statements by a block \(or even better with the \"do { ... } while \(0)\" trick)." :type 'boolean :group 'c) +(put 'c-syntactic-indentation-in-macros 'safe-local-variable 'booleanp) (defcustom-c-stylevar c-comment-only-line-offset 0 "*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." `(set ,@(mapcar (lambda (elt) `(cons :format "%v" - (c-const-symbol :format "%v: " - :size 20 - :value ,elt) + ,(c-constant-symbol elt 20) (choice :format "%[Choice%] %v" :value (column . nil) @@ -709,7 +729,8 @@ involve auto-newline inserted newlines: (module-open after) (composition-open after) (inexpr-class-open after) - (inexpr-class-close before)) + (inexpr-class-close before) + (arglist-cont-nonempty)) "*Controls the insertion of newlines before and after braces when the auto-newline feature is active. This variable contains an association list with elements of the following form: @@ -743,18 +764,15 @@ syntactic context for the brace line." `(set ,@(mapcar (lambda (elt) `(cons :format "%v" - (c-const-symbol :format "%v: " - :size 20 - :value ,elt) + ,(c-constant-symbol elt 24) (choice :format "%[Choice%] %v" :value (before after) (set :menu-tag "Before/after" - :format "Newline %v brace\n" - (const :format "%v, " before) - (const :format "%v" after)) + :format "Newline %v brace\n" + (const :format "%v, " before) + (const :format "%v " after)) (function :menu-tag "Function" - :format "Run function: %v" - :value c-)))) + :format "Run function: %v")))) '(defun-open defun-close class-open class-close inline-open inline-close @@ -766,7 +784,8 @@ syntactic context for the brace line." namespace-open namespace-close module-open module-close composition-open composition-close - inexpr-class-open inexpr-class-close))) + inexpr-class-open inexpr-class-close + arglist-cont-nonempty))) :group 'c) (defcustom c-max-one-liner-length 80 @@ -790,11 +809,9 @@ currently not supported for this variable." `(set ,@(mapcar (lambda (elt) `(cons :format "%v" - (c-const-symbol :format "%v: " - :size 20 - :value ,elt) - (set :format "Newline %v brace\n" - (const :format "%v, " before) + ,(c-constant-symbol elt 20) + (set :format "Newline %v colon\n" + (const :format "%v, " before) (const :format "%v" after)))) '(case-label label access-label member-init-intro inher-intro))) :group 'c) @@ -1307,8 +1324,7 @@ Here is the current list of valid syntactic element symbols: (lambda (elt) `(cons :format "%v" :value ,elt - (c-const-symbol :format "%v: " - :size 25) + ,(c-constant-symbol (car elt) 25) (sexp :format "%v" :validate (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)) " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2) (msft + ;; AFAWK, The message may be a "warning", "error", or "fatal error". "^\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \ -: \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 2 3 nil (4)) +: \\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:" 2 3 nil (4)) (oracle "^\\(?: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'." file-name)) -(defun ebrowse-view-file-other-window (file) - "View a file FILE in another window. -This is a replacement for `view-file-other-window' which does not -seem to work. It should be removed when `view.el' is fixed." - (interactive) - (let ((old-arrangement (current-window-configuration)) - (had-a-buf (get-file-buffer file)) - (buf-to-view (find-file-noselect file))) - (switch-to-buffer-other-window buf-to-view) - (view-mode-enter old-arrangement - (and (not had-a-buf) - (not (buffer-modified-p buf-to-view)) - 'kill-buffer)))) - - (defun ebrowse-view-exit-fn (buffer) "Function called when exiting View mode in BUFFER. Restore frame configuration active before viewing the file, @@ -1649,10 +1634,9 @@ and possibly kill the viewed buffer." (defun ebrowse-view-file-other-frame (file) "View a file FILE in another frame. -The new frame is deleted when it is no longer used." +The new frame is deleted when you quit viewing the file in that frame." (interactive) (let ((old-frame-configuration (current-frame-configuration)) - (old-arrangement (current-window-configuration)) (had-a-buf (get-file-buffer file)) (buf-to-view (find-file-noselect file))) (switch-to-buffer-other-frame buf-to-view) @@ -1663,8 +1647,8 @@ The new frame is deleted when it is no longer used." (and (not had-a-buf) (not (buffer-modified-p buf-to-view)) 'kill-buffer)) - (view-mode-enter old-arrangement 'ebrowse-view-exit-fn))) - + (view-mode-enter (cons (selected-window) (cons (selected-window) t)) + 'ebrowse-view-exit-fn))) (defun ebrowse-view/find-file-and-search-pattern (struc info file tags-file-name &optional view where) @@ -1699,7 +1683,7 @@ specifies where to find/view the result." (setq view-mode-hook nil)) (push 'ebrowse-find-pattern view-mode-hook) (case where - (other-window (ebrowse-view-file-other-window file)) + (other-window (view-file-other-window file)) (other-frame (ebrowse-view-file-other-frame file)) (t (view-file file)))) (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'." (tags-loop-continue (or file-list-form t)))) ;;;###autoload -(defun tags-query-replace (from to &optional delimited file-list-form start end) +(defun tags-query-replace (from to &optional delimited file-list-form) "Do `query-replace-regexp' of FROM with TO on all files listed in tags table. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit], RET or q), you can resume the query replace with the command \\[tags-loop-continue]. +Fourth arg FILE-LIST-FORM non-nil means initialize the replacement loop. +Fifth and sixth arguments START and END are accepted, for compatibility +with `query-replace-regexp', and ignored. -See documentation of variable `tags-file-name'." +If FILE-LIST-FORM is non-nil, it is a form to evaluate to +produce the list of files to search. + +See also the documentation of the variable `tags-file-name'." (interactive (query-replace-read-args "Tags query replace (regexp)" t t)) (setq tags-loop-scan `(let ,(unless (equal from (downcase from)) '((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." (push-mark) (goto-char pos) (setq program (f90-beginning-of-subprogram)) - (if (fboundp 'zmacs-activate-region) + (if (featurep 'xemacs) (zmacs-activate-region) (setq mark-active t deactivate-mark nil)) @@ -1866,7 +1866,7 @@ If run in the middle of a line, the line is not broken." (goto-char save-point) (set-marker end-region-mark nil) (set-marker save-point nil) - (if (fboundp 'zmacs-deactivate-region) + (if (featurep 'xemacs) (zmacs-deactivate-region) (deactivate-mark)))) @@ -1976,7 +1976,7 @@ Like `join-line', but handles F90 syntax." f90-cache-position (point))) (setq f90-cache-position nil) (set-marker end-region-mark nil) - (if (fboundp 'zmacs-deactivate-region) + (if (featurep 'xemacs) (zmacs-deactivate-region) (deactivate-mark)))) 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." (output (with-output-to-string (with-current-buffer standard-output - (call-process shell-file-name - (if (file-exists-p file) file nil) + (and file (file-exists-p file) + (call-process shell-file-name file (list t nil) nil "-c" (concat gdb-cpp-define-alist-program " " - gdb-cpp-define-alist-flags))))) + gdb-cpp-define-alist-flags)))))) (define-list (split-string output "\n" t)) (name)) (setq gdb-define-alist nil) (dolist (define define-list) @@ -1214,10 +1214,12 @@ This filter may simply queue input for a later time." (defun gdb-dequeue-input () (let ((queue gdb-input-queue)) - (and queue - (let ((last (car (last queue)))) - (unless (nbutlast queue) (setq gdb-input-queue '())) - last)))) + (if queue + (let ((last (car (last queue)))) + (unless (nbutlast queue) (setq gdb-input-queue '())) + last) + ;; This should be nil here anyway but set it just to make sure. + (setq gdb-pending-triggers nil)))) (defun gdb-send-item (item) (setq gdb-flush-pending-output nil) @@ -3445,7 +3447,8 @@ BUFFER nil or omitted means use the current buffer." (let ((buffer (marker-buffer gud-overlay-arrow-position)) (position (marker-position gud-overlay-arrow-position))) (when (and buffer - (string-equal (buffer-name buffer) + (string-equal (file-name-nondirectory + (buffer-file-name buffer)) (file-name-nondirectory (match-string 3)))) (with-current-buffer buffer (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 @@ ;;; hideif.el --- hides selected code within ifdef -;; Copyright (C) 1988, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 -;; Free Software Foundation, Inc. +;; Copyright (C) 1988, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008 Free Software Foundation, Inc. ;; Author: Daniel LaLiberte <liberte@holonexus.org> ;; Maintainer: FSF @@ -99,12 +99,6 @@ ;; ;; Written by Brian Marick, at Gould, Computer Systems Division, Urbana IL. ;; Extensively modified by Daniel LaLiberte (while at Gould). -;; -;; You may freely modify and distribute this, but keep a record -;; of modifications and send comments to: -;; liberte@a.cs.uiuc.edu or ihnp4!uiucdcs!liberte -;; I will continue to upgrade hide-ifdef-mode -;; with your contributions. ;;; Code: @@ -114,6 +108,33 @@ "Hide selected code within `ifdef'." :group 'c) +(defcustom hide-ifdef-initially nil + "Non-nil means call `hide-ifdefs' when Hide-Ifdef mode is first activated." + :type 'boolean + :group 'hide-ifdef) + +(defcustom hide-ifdef-read-only nil + "Set to non-nil if you want buffer to be read-only while hiding text." + :type 'boolean + :group 'hide-ifdef) + +(defcustom hide-ifdef-lines nil + "Non-nil means hide the #ifX, #else, and #endif lines." + :type 'boolean + :group 'hide-ifdef) + +(defcustom hide-ifdef-shadow nil + "Non-nil means shadow text instead of hiding it." + :type 'boolean + :group 'hide-ifdef + :version "23.1") + +(defface hide-ifdef-shadow '((t (:inherit shadow))) + "Face for shadowing ifdef blocks." + :group 'hide-ifdef + :version "23.1") + + (defvar hide-ifdef-mode-submap ;; Set up the submap that goes after the prefix key. (let ((map (make-sparse-keymap))) @@ -128,6 +149,7 @@ (define-key map "\C-s" 'show-ifdef-block) (define-key map "\C-q" 'hide-ifdef-toggle-read-only) + (define-key map "\C-w" 'hide-ifdef-toggle-shadowing) (substitute-key-definition 'toggle-read-only 'hide-ifdef-toggle-outside-read-only map) map) @@ -155,7 +177,9 @@ ["Use an alist" hide-ifdef-use-define-alist t] ["Undefine a variable" hide-ifdef-undef t] ["Toggle read only" hide-ifdef-toggle-read-only - :style toggle :selected hide-ifdef-read-only])) + :style toggle :selected hide-ifdef-read-only] + ["Toggle shadowing" hide-ifdef-toggle-shadowing + :style toggle :selected hide-ifdef-shadow])) (defvar hide-ifdef-hiding nil "Non-nil when text may be hidden.") @@ -256,9 +280,12 @@ how the hiding is done: (end-of-line 2))) (defun hide-ifdef-region-internal (start end) - (remove-overlays start end 'invisible 'hide-ifdef) + (remove-overlays start end 'hide-ifdef t) (let ((o (make-overlay start end))) - (overlay-put o 'invisible 'hide-ifdef))) + (overlay-put o 'hide-ifdef t) + (if hide-ifdef-shadow + (overlay-put o 'face 'hide-ifdef-shadow) + (overlay-put o 'invisible 'hide-ifdef)))) (defun hide-ifdef-region (start end) "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." (defun hif-show-ifdef-region (start end) "Everything between START and END is made visible." - (remove-overlays start end 'invisible 'hide-ifdef)) + (remove-overlays start end 'hide-ifdef t)) ;;===%%SF%% evaluation (Start) === @@ -740,11 +767,11 @@ Point is left unchanged." (defun hif-hide-line (point) "Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil." - (if hide-ifdef-lines - (save-excursion - (goto-char point) - (hide-ifdef-region-internal (line-beginning-position) - (progn (hif-end-of-line) (point)))))) + (when hide-ifdef-lines + (save-excursion + (goto-char point) + (hide-ifdef-region-internal + (line-beginning-position) (progn (hif-end-of-line) (point)))))) ;;; Hif-Possibly-Hide @@ -827,24 +854,6 @@ It does not do the work that's pointless to redo on a recursive entry." ;;===%%SF%% exports (Start) === -;;;###autoload -(defcustom hide-ifdef-initially nil - "*Non-nil means call `hide-ifdefs' when Hide-Ifdef mode is first activated." - :type 'boolean - :group 'hide-ifdef) - -;;;###autoload -(defcustom hide-ifdef-read-only nil - "*Set to non-nil if you want buffer to be read-only while hiding text." - :type 'boolean - :group 'hide-ifdef) - -;;;###autoload -(defcustom hide-ifdef-lines nil - "*Non-nil means hide the #ifX, #else, and #endif lines." - :type 'boolean - :group 'hide-ifdef) - (defun hide-ifdef-toggle-read-only () "Toggle `hide-ifdef-read-only'." (interactive) @@ -866,6 +875,21 @@ It does not do the work that's pointless to redo on a recursive entry." hif-outside-read-only)) (force-mode-line-update)) +(defun hide-ifdef-toggle-shadowing () + "Toggle shadowing." + (interactive) + (set (make-local-variable 'hide-ifdef-shadow) (not hide-ifdef-shadow)) + (message "Shadowing %s" (if hide-ifdef-shadow "ON" "OFF")) + (save-restriction + (widen) + (dolist (overlay (overlays-in (point-min) (point-max))) + (when (overlay-get overlay 'hide-ifdef) + (if hide-ifdef-shadow + (progn + (overlay-put overlay 'invisible nil) + (overlay-put overlay 'face 'hide-ifdef-shadow)) + (overlay-put overlay 'face nil) + (overlay-put overlay 'invisible 'hide-ifdef)))))) (defun hide-ifdef-define (var) "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." (pascal-end-of-defun) (push-mark (point)) (pascal-beg-of-defun) - (if (fboundp 'zmacs-activate-region) - (zmacs-activate-region))) + (when (featurep 'xemacs) + (zmacs-activate-region))) (defun pascal-comment-area (start end) "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'." ;;;; Completion. -(defvar python-imports nil +;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2008-01/msg00076.html +(defvar python-imports "None" "String of top-level import statements updated by `python-find-imports'.") (make-variable-buffer-local 'python-imports) @@ -2076,7 +2077,7 @@ The default contents correspond to the elements of `python-skeletons'." < ; Avoid wrong indentation after block opening. "elif " str ":" \n > _ \n nil) - (python-else) | ^) + '(python-else) | ^) (define-skeleton python-else "Auxiliary skeleton." @@ -2090,24 +2091,24 @@ The default contents correspond to the elements of `python-skeletons'." "Condition: " "while " str ":" \n > _ \n - (python-else) | ^) + '(python-else) | ^) (def-python-skeleton for "Target, %s: " "for " str " in " (skeleton-read "Expression, %s: ") ":" \n > _ \n - (python-else) | ^) + '(python-else) | ^) (def-python-skeleton try/except nil "try:" \n > _ \n ("Exception, %s: " - < "except " str (python-target) ":" \n + < "except " str '(python-target) ":" \n > _ \n nil) < "except:" \n > _ \n - (python-else) | ^) + '(python-else) | ^) (define-skeleton python-target "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." This value is used for the `+' and `-' symbols in an indentation variable." :type 'integer :group 'sh-indentation) +(put 'sh-basic-offset 'safe-local-variable 'integerp) (defcustom sh-indent-comment nil "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 @@ ;; http://www.veripool.com ;; Keywords: languages +;; This code supports Emacs 21.1 and later +;; And XEmacs 21.1 and later +;; Please do not make changes that break Emacs 21. Thanks! +;; +;; + ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify @@ -30,12 +36,12 @@ ;;; Commentary: -;; This mode borrows heavily from the Pascal-mode and the cc-mode of emacs +;; This mode borrows heavily from the Pascal-mode and the cc-mode of Emacs ;; USAGE ;; ===== -;; A major mode for editing Verilog HDL source code. When you have +;; A major mode for editing Verilog HDL source code. When you have ;; entered Verilog mode, you may get more info by pressing C-h m. You ;; may also get online help describing various functions by: C-h f ;; <Name of function you want described> @@ -44,8 +50,8 @@ ;; ======================= ;; Verilog is a rapidly evolving language, and hence this mode is -;; under continuous development. Hence this is beta code, and likely -;; has bugs. Please report any and all bugs to me at mac@verilog.com. +;; under continuous development. Hence this is beta code, and likely +;; has bugs. Please report any and all bugs to me at mac@verilog.com. ;; Please use verilog-submit-bug-report to submit a report; type C-c ;; C-b to invoke this and as a result I will have a much easier time ;; of reproducing the bug you find, and hence fixing it. @@ -55,7 +61,7 @@ ;; An older version of this mode may be already installed as a part of ;; your environment, and one method of updating would be to update -;; your emacs environment. Sometimes this is difficult for local +;; your Emacs environment. Sometimes this is difficult for local ;; political/control reasons, and hence you can always install a ;; private copy (or even a shared copy) which overrides the system ;; default. @@ -74,7 +80,7 @@ ;; If you want to customize Verilog mode to fit your needs better, ;; you may add these lines (the values of the variables presented -;; here are the defaults). Note also that if you use an emacs that +;; here are the defaults). Note also that if you use an Emacs that ;; supports custom, it's probably better to use the custom menu to ;; edit these. ;; @@ -102,15 +108,19 @@ ;; ;;; History: -;; -;; +;; +;; See commit history at http://www.veripool.com/verilog-mode.html +;; (This section is required to appease checkdoc.) + ;;; Code: ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "377" - "Version of this verilog mode.") -(defconst verilog-mode-release-date "2007-12-07" +(defconst verilog-mode-version "383" "Version of this verilog mode.") +(defconst verilog-mode-release-date "2008-01-07-GNU" + "Release date of this verilog mode.") +(defconst verilog-mode-release-emacs t + "If non-nil, this version of verilog mode was released with Emacs itself.") (defun verilog-version () "Inform caller of the version of this file." @@ -118,7 +128,10 @@ (message "Using verilog-mode version %s" verilog-mode-version)) ;; Insure we have certain packages, and deal with it if we don't +;; Be sure to note which Emacs flavor and version added each feature. (eval-when-compile + ;; The below were disabled when GNU Emacs 22 was released; + ;; perhaps some still need to be there to support Emacs 21. (when (featurep 'xemacs) (condition-case nil (require 'easymenu) @@ -181,8 +194,8 @@ STRING should be given if the last search was by `string-match' on STRING." result) (buffer-substring-no-properties (match-beginning num) (match-end num) - (current-buffer) - ))))) + (current-buffer))))) + ) (error nil)) (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) 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." ;; Provide a regular expression optimization routine, using regexp-opt ;; if provided by the user's elisp libraries (eval-and-compile + ;; The below were disabled when GNU Emacs 22 was released; + ;; perhaps some still need to be there to support Emacs 21. (if (featurep 'xemacs) (if (fboundp 'regexp-opt) ;; 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." (defun verilog-regexp-opt (a b) "Deal with differing number of required arguments for `regexp-opt'. Call 'regexp-opt' on A and B." - (regexp-opt a b 't) - ) + (regexp-opt a b 't)) (error nil)) ) ((eq args 2) ;; It takes 2 @@ -261,6 +275,12 @@ STRING should be given if the last search was by `string-match' on STRING." (if (fboundp 'customize-apropos) (customize-apropos "font-lock-*" 'faces))) +(defun verilog-booleanp (value) + "Return t if VALUE is boolean. + This implements GNU Emacs 22.1's `booleanp' function in earlier Emacs. + This function may be removed when Emacs 21 is no longer supported." + (or (equal value t) (equal value nil))) + (defgroup verilog-mode nil "Facilitates easy editing of Verilog source text" :group 'languages) @@ -290,6 +310,7 @@ you type \\[compile]. When the compile completes, \\[next-error] will take you to the next lint error." :type 'string :group 'verilog-mode-actions) +;; We don't mark it safe, as it's used as a shell command (defcustom verilog-coverage "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 you to the next lint error." :type 'string :group 'verilog-mode-actions) +;; We don't mark it safe, as it's used as a shell command (defcustom verilog-simulator "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 you to the next lint error." :type 'string :group 'verilog-mode-actions) +;; We don't mark it safe, as it's used as a shell command (defcustom verilog-compiler "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 you to the next lint error." :type 'string :group 'verilog-mode-actions) +;; We don't mark it safe, as it's used as a shell command (defvar verilog-tool 'verilog-linter "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 entry \"Fontify Buffer\"). XEmacs: turn off and on font locking." :type 'boolean :group 'verilog-mode-indent) +;; Note we don't use :safe, as that would break on Emacsen before 22.0. +(put 'verilog-highlight-translate-off 'safe-local-variable 'verilog-booleanp) (defcustom verilog-indent-level 3 "*Indentation of Verilog statements with respect to containing block." :group 'verilog-mode-indent :type 'integer) +(put 'verilog-indent-level 'safe-local-variable 'integerp) (defcustom verilog-indent-level-module 3 "*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 your screen." :group 'verilog-mode-indent :type 'integer) +(put 'verilog-indent-level-module 'safe-local-variable 'integerp) (defcustom verilog-indent-level-declaration 3 "*Indentation of declarations with respect to containing block. Set to 0 to get them list right under containing block." :group 'verilog-mode-indent :type 'integer) +(put 'verilog-indent-level-declaration 'safe-local-variable 'integerp) (defcustom verilog-indent-declaration-macros nil "*How to treat macro expansions in a declaration. @@ -367,6 +396,7 @@ If non nil, treat as: output c;" :group 'verilog-mode-indent :type 'boolean) +(put 'verilog-indent-declaration-macros 'safe-local-variable 'verilog-booleanp) (defcustom verilog-indent-lists t "*How to treat indenting items in a list. @@ -379,62 +409,73 @@ If nil, treat as: reset ) begin" :group 'verilog-mode-indent :type 'boolean) +(put 'verilog-indent-lists 'safe-local-variable 'verilog-booleanp) (defcustom verilog-indent-level-behavioral 3 "*Absolute indentation of first begin in a task or function block. Set to 0 to get such code to start at the left side of the screen." :group 'verilog-mode-indent :type 'integer) +(put 'verilog-indent-level-behavioral 'safe-local-variable 'integerp) (defcustom verilog-indent-level-directive 1 "*Indentation to add to each level of `ifdef declarations. Set to 0 to have all directives start at the left side of the screen." :group 'verilog-mode-indent :type 'integer) +(put 'verilog-indent-level-directive 'safe-local-variable 'integerp) (defcustom verilog-cexp-indent 2 "*Indentation of Verilog statements split across lines." :group 'verilog-mode-indent :type 'integer) +(put 'verilog-cexp-indent 'safe-local-variable 'integerp) (defcustom verilog-case-indent 2 "*Indentation for case statements." :group 'verilog-mode-indent :type 'integer) +(put 'verilog-case-indent 'safe-local-variable 'integerp) (defcustom verilog-auto-newline t "*True means automatically newline after semicolons." :group 'verilog-mode-indent :type 'boolean) +(put 'verilog-auto-newline 'safe-local-variable 'verilog-booleanp) (defcustom verilog-auto-indent-on-newline t "*True means automatically indent line after newline." :group 'verilog-mode-indent :type 'boolean) +(put 'verilog-auto-indent-on-newline 'safe-local-variable 'verilog-booleanp) (defcustom verilog-tab-always-indent t "*True means TAB should always re-indent the current line. Nil means TAB will only reindent when at the beginning of the line." :group 'verilog-mode-indent :type 'boolean) +(put 'verilog-tab-always-indent 'safe-local-variable 'verilog-booleanp) (defcustom verilog-tab-to-comment nil "*True means TAB moves to the right hand column in preparation for a comment." :group 'verilog-mode-actions :type 'boolean) +(put 'verilog-tab-to-comment 'safe-local-variable 'verilog-booleanp) (defcustom verilog-indent-begin-after-if t "*If true, indent begin statements following if, else, while, for and repeat. Otherwise, line them up." :group 'verilog-mode-indent - :type 'boolean ) + :type 'boolean) +(put 'verilog-indent-begin-after-if 'safe-local-variable 'verilog-booleanp) (defcustom verilog-align-ifelse nil "*If true, align `else' under matching `if'. Otherwise else is lined up with first character on line holding matching if." :group 'verilog-mode-indent - :type 'boolean ) + :type 'boolean) +(put 'verilog-align-ifelse 'safe-local-variable 'verilog-booleanp) (defcustom verilog-minimum-comment-distance 10 "*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 default avoids too many redundant comments in tight quarters" :group 'verilog-mode-indent :type 'integer) +(put 'verilog-minimum-comment-distance 'safe-local-variable 'integerp) (defcustom verilog-auto-lineup '(declaration) "*Algorithm for lining up statements on multiple lines. @@ -481,23 +523,26 @@ would become ; :group 'verilog-mode-indent - :type 'list ) + :type 'list) +(put 'verilog-auto-lineup 'safe-local-variable 'listp) (defcustom verilog-highlight-p1800-keywords nil - "*If true highlight words newly reserved by IEEE-1800 in -verilog-font-lock-p1800-face in order to gently suggest changing where -these words are used as variables to something else. Nil means highlight -these words as appropriate for the SystemVerilog IEEE-1800 standard. Note -that changing this will require restarting emacs to see the effect as font -color choices are cached by emacs" + "*True means highlight words newly reserved by IEEE-1800. +These will appear in `verilog-font-lock-p1800-face' in order to gently +suggest changing where these words are used as variables to something else. +Nil means highlight these words as appropriate for the SystemVerilog +IEEE-1800 standard. Note that changing this will require restarting Emacs +to see the effect as font color choices are cached by Emacs" :group 'verilog-mode-indent :type 'boolean) +(put 'verilog-highlight-p1800-keywords 'safe-local-variable 'verilog-booleanp) (defcustom verilog-auto-endcomments t "*True means insert a comment /* ... */ after 'end's. The name of the function or case will be set between the braces." :group 'verilog-mode-actions - :type 'boolean ) + :type 'boolean) +(put 'verilog-auto-endcomments 'safe-local-variable 'verilog-booleanp) (defcustom verilog-auto-read-includes nil "*True means to automatically read includes before AUTOs. @@ -506,7 +551,8 @@ each AUTO expansion. This makes it easier to embed defines and includes, but can result in very slow reading times if there are many or large include files." :group 'verilog-mode-actions - :type 'boolean ) + :type 'boolean) +(put 'verilog-auto-read-includes 'safe-local-variable 'verilog-booleanp) (defcustom verilog-auto-save-policy nil "*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 instantiation. See also `verilog-auto-star' and `verilog-auto-star-save'." :group 'verilog-mode-actions :type 'boolean) +(put 'verilog-auto-star-expand 'safe-local-variable 'verilog-booleanp) (defcustom verilog-auto-star-save nil "*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 always be saved." :group 'verilog-mode-actions :type 'boolean) +(put 'verilog-auto-star-save 'safe-local-variable 'verilog-booleanp) (defvar verilog-auto-update-tick nil "Modification tick at which autos were last performed.") @@ -624,8 +672,7 @@ always be saved." ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 1 bold t) ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 2 bold t) ) - "*Keywords to also highlight in Verilog *compilation* buffers." - ) + "*Keywords to also highlight in Verilog *compilation* buffers.") (defcustom verilog-library-flags '("") "*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. See also the variables mentioned above." :group 'verilog-mode-auto :type '(repeat string)) +(put 'verilog-library-flags 'safe-local-variable 'listp) (defcustom verilog-library-directories '(".") "*List of directories when looking for files for /*AUTOINST*/. @@ -678,9 +726,11 @@ See also `verilog-library-flags', `verilog-library-files' and `verilog-library-extensions'." :group 'verilog-mode-auto :type '(repeat file)) +(put 'verilog-library-directories 'safe-local-variable 'listp) (defcustom verilog-library-files '() - "*List of files to search for modules when looking for AUTOINST files. + "*List of files to search for modules. +AUTOINST will use this when it needs to resolve a module name. This is a complete path, usually to a technology file with many standard cells defined in it. @@ -698,12 +748,14 @@ have problems, use \\[find-alternate-file] RET to have these take effect. See also `verilog-library-flags', `verilog-library-directories'." :group 'verilog-mode-auto :type '(repeat directory)) +(put 'verilog-library-files 'safe-local-variable 'listp) (defcustom verilog-library-extensions '(".v") "*List of extensions to use when looking for files for /*AUTOINST*/. See also `verilog-library-flags', `verilog-library-directories'." :type '(repeat string) :group 'verilog-mode-auto) +(put 'verilog-library-extensions 'safe-local-variable 'listp) (defcustom verilog-active-low-regexp nil "*If set, treat signals matching this regexp as active low. @@ -711,21 +763,24 @@ This is used for AUTORESET and AUTOTIEOFF. For proper behavior, you will probably also need `verilog-auto-reset-widths' set." :group 'verilog-mode-auto :type 'string) +(put 'verilog-active-low-regexp 'safe-local-variable 'stringp) (defcustom verilog-auto-sense-include-inputs nil "*If true, AUTOSENSE should include all inputs. If nil, only inputs that are NOT output signals in the same block are included." - :type 'boolean - :group 'verilog-mode-auto) + :group 'verilog-mode-auto + :type 'boolean) +(put 'verilog-auto-sense-include-inputs 'safe-local-variable 'verilog-booleanp) (defcustom verilog-auto-sense-defines-constant nil "*If true, AUTOSENSE should assume all defines represent constants. When true, the defines will not be included in sensitivity lists. To maintain compatibility with other sites, this should be set at the bottom of each verilog file that requires it, rather than being set globally." - :type 'boolean - :group 'verilog-mode-auto) + :group 'verilog-mode-auto + :type 'boolean) +(put 'verilog-auto-sense-defines-constant 'safe-local-variable 'verilog-booleanp) (defcustom verilog-auto-reset-widths t "*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 the MSB or LSB of a signal inside a AUTORESET." :type 'boolean :group 'verilog-mode-auto) +(put 'verilog-auto-reset-widths 'safe-local-variable 'verilog-booleanp) (defcustom verilog-assignment-delay "" "*Text used for delays in delayed assignments. Add a trailing space if set." - :type 'string - :group 'verilog-mode-auto) + :group 'verilog-mode-auto + :type 'string) +(put 'verilog-assignment-delay 'safe-local-variable 'stringp) (defcustom verilog-auto-inst-vector t "*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 declare the wire to have the subscripts removed.) Nil may speed up some simulators, but is less general and harder to read, so avoid." :group 'verilog-mode-auto - :type 'boolean ) + :type 'boolean) +(put 'verilog-auto-inst-vector 'safe-local-variable 'verilog-booleanp) (defcustom verilog-auto-inst-template-numbers nil "*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 port declaration. Setting this aids in debugging, but nil is suggested for regular use to prevent large numbers of merge conflicts." :group 'verilog-mode-auto - :type 'boolean ) + :type 'boolean) +(put 'verilog-auto-inst-template-numbers 'safe-local-variable 'verilog-booleanp) (defvar verilog-auto-inst-column 40 "Column number for first part of auto-inst.") @@ -765,31 +824,36 @@ regular use to prevent large numbers of merge conflicts." "*If set, when creating AUTOINPUT list, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto - :type 'string ) + :type 'string) +(put 'verilog-auto-input-ignore-regexp 'safe-local-variable 'stringp) (defcustom verilog-auto-inout-ignore-regexp nil "*If set, when creating AUTOINOUT list, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto - :type 'string ) + :type 'string) +(put 'verilog-auto-inout-ignore-regexp 'safe-local-variable 'stringp) (defcustom verilog-auto-output-ignore-regexp nil "*If set, when creating AUTOOUTPUT list, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto - :type 'string ) + :type 'string) +(put 'verilog-auto-output-ignore-regexp 'safe-local-variable 'stringp) (defcustom verilog-auto-unused-ignore-regexp nil "*If set, when creating AUTOUNUSED list, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto - :type 'string ) + :type 'string) +(put 'verilog-auto-unused-ignore-regexp 'safe-local-variable 'stringp) (defcustom verilog-typedef-regexp nil "*If non-nil, regular expression that matches Verilog-2001 typedef names. For example, \"_t$\" matches typedefs named with _t, as in the C language." :group 'verilog-mode-auto - :type 'string ) + :type 'string) +(put 'verilog-typedef-regexp 'safe-local-variable 'stringp) (defcustom verilog-mode-hook 'verilog-set-compile-command "*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." (defcustom verilog-auto-hook nil "*Hook run after `verilog-mode' updates AUTOs." - :type 'hook - :group 'verilog-mode-auto) + :group 'verilog-mode-auto + :type 'hook) (defcustom verilog-before-auto-hook nil "*Hook run before `verilog-mode' updates AUTOs." - :type 'hook - :group 'verilog-mode-auto) + :group 'verilog-mode-auto + :type 'hook) (defcustom verilog-delete-auto-hook nil "*Hook run after `verilog-mode' deletes AUTOs." - :type 'hook - :group 'verilog-mode-auto) + :group 'verilog-mode-auto + :type 'hook) (defcustom verilog-before-delete-auto-hook nil "*Hook run before `verilog-mode' deletes AUTOs." - :type 'hook - :group 'verilog-mode-auto) + :group 'verilog-mode-auto + :type 'hook) (defcustom verilog-getopt-flags-hook nil "*Hook run after `verilog-getopt-flags' determines the Verilog option lists." - :type 'hook - :group 'verilog-mode-auto) + :group 'verilog-mode-auto + :type 'hook) (defcustom verilog-before-getopt-flags-hook nil "*Hook run before `verilog-getopt-flags' determines the Verilog option lists." - :type 'hook - :group 'verilog-mode-auto) + :group 'verilog-mode-auto + :type 'hook) (defvar verilog-imenu-generic-expression '((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.") (defvar verilog-company nil "*Default name of Company for verilog header. If set will become buffer local.") - (make-variable-buffer-local 'verilog-company) (defvar verilog-project nil "*Default name of Project for verilog header. If set will become buffer local.") - (make-variable-buffer-local 'verilog-project) (defvar verilog-mode-map @@ -871,7 +933,6 @@ If set will become buffer local.") (define-key map "\M-\r" `electric-verilog-terminate-and-indent) (define-key map "\M-\t" 'verilog-complete-word) (define-key map "\M-?" 'verilog-show-completions) - (define-key map [(meta control h)] 'verilog-mark-defun) (define-key map "\C-c\`" 'verilog-lint-off) (define-key map "\C-c\*" 'verilog-delete-auto-star-implicit) (define-key map "\C-c\C-r" 'verilog-label-be) @@ -881,8 +942,10 @@ If set will become buffer local.") (define-key map "\M-*" 'verilog-star-comment) (define-key map "\C-c\C-c" 'verilog-comment-region) (define-key map "\C-c\C-u" 'verilog-uncomment-region) - (define-key map "\M-\C-a" 'verilog-beg-of-defun) - (define-key map "\M-\C-e" 'verilog-end-of-defun) + (when (featurep 'xemacs) + (define-key map [(meta control h)] 'verilog-mark-defun) + (define-key map "\M-\C-a" 'verilog-beg-of-defun) + (define-key map "\M-\C-e" 'verilog-end-of-defun)) (define-key map "\C-c\C-d" 'verilog-goto-defun) (define-key map "\C-c\C-k" 'verilog-delete-auto) (define-key map "\C-c\C-a" 'verilog-auto) @@ -895,7 +958,7 @@ If set will become buffer local.") ;; menus (defvar verilog-xemacs-menu - '("Verilog" + `("Verilog" ("Choose Compilation Action" ["None" (progn @@ -929,9 +992,15 @@ If set will become buffer local.") :selected (equal verilog-tool `verilog-compiler)] ) ("Move" - ["Beginning of function" verilog-beg-of-defun t] - ["End of function" verilog-end-of-defun t] - ["Mark function" verilog-mark-defun t] + ,(if (featurep 'xemacs) + (progn + ["Beginning of function" verilog-beg-of-defun t] + ["End of function" verilog-end-of-defun t] + ["Mark function" verilog-mark-defun t]) + ["Beginning of function" beginning-of-defun t] + ["End of function" end-of-defun t] + ["Mark function" mark-defun t]) + ["Goto function/module" verilog-goto-defun t] ["Move to beginning of block" electric-verilog-backward-sexp t] ["Move to end of block" electric-verilog-forward-sexp t] @@ -1025,8 +1094,7 @@ If set will become buffer local.") ["Casex" verilog-sk-casex t] ["Casez" verilog-sk-casez t] ) - "Menu for statement templates in Verilog." - ) + "Menu for statement templates in Verilog.") (easy-menu-define verilog-menu verilog-mode-map "Menu for Verilog mode" verilog-xemacs-menu) @@ -1072,8 +1140,7 @@ will break, as the o's continuously replace. xa -> x works ok though." (store-match-data '(nil nil)) (if BOUND (< (point) BOUND) - t) - )))) + t))))) (match-end 0)) (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." (store-match-data '(nil nil)) (if BOUND (> (point) BOUND) - t) - )))) + t))))) (match-end 0)) (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." (save-excursion (nth 3 (parse-partial-sexp (verilog-get-beg-of-line) (point))))) +(defvar compile-command) + ;; compilation program (defun verilog-set-compile-command () "Function to compute shell command to compile verilog. @@ -1201,8 +1269,7 @@ find the errors." (setq compilation-error-regexp-alist (default-value 'compilation-error-regexp-alist)) (set (make-local-variable 'compilation-error-regexp-alist) - (default-value 'compilation-error-regexp-alist)) - ))) + (default-value 'compilation-error-regexp-alist))))) (add-hook 'compilation-mode-hook 'verilog-error-regexp-add) @@ -1330,8 +1397,7 @@ find the errors." "endprogram" "endsequence" "endclocking" - ) - ))) + )))) (defconst verilog-endcomment-reason-re @@ -1655,157 +1721,37 @@ find the errors." ) "List of Verilog keywords.") - -(defconst verilog-emacs-features - ;; Documentation at the bottom - (let ((major (and (boundp 'emacs-major-version) - emacs-major-version)) - (minor (and (boundp 'emacs-minor-version) - emacs-minor-version)) - flavor comments flock-syntax) - ;; figure out version numbers if not already discovered - (and (or (not major) (not minor)) - (string-match "\\([0-9]+\\).\\([0-9]+\\)" emacs-version) - (setq major (string-to-number (substring emacs-version - (match-beginning 1) - (match-end 1))) - minor (string-to-number (substring emacs-version - (match-beginning 2) - (match-end 2))))) - (if (not (and major minor)) - (error "Cannot figure out the major and minor version numbers")) - ;; calculate the major version - (cond - ((= major 4) (setq major 'v18)) ;Epoch 4 - ((= major 18) (setq major 'v18)) ;Emacs 18 - ((= major 19) (setq major 'v19 ;Emacs 19 - flavor (if (or (string-match "Lucid" emacs-version) - (string-match "XEmacs" emacs-version)) - 'XEmacs 'FSF))) - ((> major 19) (setq major 'v20 - flavor (if (or (string-match "Lucid" emacs-version) - (string-match "XEmacs" emacs-version)) - 'XEmacs 'FSF))) - ;; I don't know - (t (error "Cannot recognize major version number: %s" major))) - ;; XEmacs 19 uses 8-bit modify-syntax-entry flags, as do all - ;; patched Emacs 19, Emacs 18, Epoch 4's. Only Emacs 19 uses a - ;; 1-bit flag. Let's be as smart as we can about figuring this - ;; out. - (if (or (eq major 'v20) (eq major 'v19)) - (let ((table (copy-syntax-table))) - (modify-syntax-entry ?a ". 12345678" table) - (cond - ;; XEmacs pre 20 and Emacs pre 19.30 use vectors for syntax tables. - ((vectorp table) - (if (= (logand (lsh (aref table ?a) -16) 255) 255) - (setq comments '8-bit) - (setq comments '1-bit))) - ;; XEmacs 20 is known to be 8-bit - ((eq flavor 'XEmacs) (setq comments '8-bit)) - ;; Emacs 19.30 and beyond are known to be 1-bit - ((eq flavor 'FSF) (setq comments '1-bit)) - ;; Don't know what this is - (t (error "Couldn't figure out syntax table format")) - )) - ;; Emacs 18 has no support for dual comments - (setq comments 'no-dual-comments)) - ;; determine whether to use old or new font lock syntax - ;; We can assume 8-bit syntax table emacsen support new syntax, otherwise - ;; look for version > 19.30 - (setq flock-syntax - (if (or (equal comments '8-bit) - (equal major 'v20) - (and (equal major 'v19) (> minor 30))) - 'flock-syntax-after-1930 - 'flock-syntax-before-1930)) - ;; lets do some minimal sanity checking. - (if (or - ;; Emacs before 19.6 had bugs - (and (eq major 'v19) (eq flavor 'XEmacs) (< minor 6)) - ;; Emacs 19 before 19.21 has known bugs - (and (eq major 'v19) (eq flavor 'FSF) (< minor 21)) - ) - (with-output-to-temp-buffer "*verilog-mode warnings*" - (print (format - "The version of Emacs that you are running, %s, -has known bugs in its syntax parsing routines which will affect the -performance of verilog-mode. You should strongly consider upgrading to the -latest available version. verilog-mode may continue to work, after a -fashion, but strange indentation errors could be encountered." - emacs-version)))) - ;; Emacs 18, with no patch is not too good - (if (and (eq major 'v18) (eq comments 'no-dual-comments)) - (with-output-to-temp-buffer "*verilog-mode warnings*" - (print (format - "The version of Emacs 18 you are running, %s, -has known deficiencies in its ability to handle the dual verilog -\(and C++) comments, (e.g. the // and /* */ comments). This will -not be much of a problem for you if you only use the /* */ comments, -but you really should strongly consider upgrading to one of the latest -Emacs 19's. In Emacs 18, you may also experience performance degradations. -Emacs 19 has some new built-in routines which will speed things up for you. -Because of these inherent problems, verilog-mode is not supported -on emacs-18." - emacs-version)))) - ;; Emacs 18 with the syntax patches are no longer supported - (if (and (eq major 'v18) (not (eq comments 'no-dual-comments))) - (with-output-to-temp-buffer "*verilog-mode warnings*" - (print (format - "You are running a syntax patched Emacs 18 variant. While this should -work for you, you may want to consider upgrading to Emacs 19. -The syntax patches are no longer supported either for verilog-mode.")))) - (list major comments flock-syntax)) - "A list of features extant in the Emacs you are using. -There are many flavors of Emacs out there, each with different -features supporting those needed by `verilog-mode'. Here's the current -supported list, along with the values for this variable: - - Vanilla Emacs 18/Epoch 4: (v18 no-dual-comments flock-syntax-before-1930) - Emacs 18/Epoch 4 (patch2): (v18 8-bit flock-syntax-after-1930) - XEmacs (formerly Lucid) 19: (v19 8-bit flock-syntax-after-1930) - XEmacs 20: (v20 8-bit flock-syntax-after-1930) - Emacs 19.1-19.30: (v19 8-bit flock-syntax-before-1930) - Emacs 19.31-19.xx: (v19 8-bit flock-syntax-after-1930) - Emacs20 : (v20 1-bit flock-syntax-after-1930).") - (defconst verilog-comment-start-regexp "//\\|/\\*" "Dual comment value for `comment-start-regexp'.") -(defun verilog-populate-syntax-table (table) - "Populate the syntax TABLE." - (modify-syntax-entry ?\\ "\\" table) - (modify-syntax-entry ?+ "." table) - (modify-syntax-entry ?- "." table) - (modify-syntax-entry ?= "." table) - (modify-syntax-entry ?% "." table) - (modify-syntax-entry ?< "." table) - (modify-syntax-entry ?> "." table) - (modify-syntax-entry ?& "." table) - (modify-syntax-entry ?| "." table) - (modify-syntax-entry ?` "w" table) - (modify-syntax-entry ?_ "w" table) - (modify-syntax-entry ?\' "." table) -) - -(defun verilog-setup-dual-comments (table) - "Set up TABLE to handle block and line style comments." - (cond - ((memq '8-bit verilog-emacs-features) - ;; XEmacs (formerly Lucid) has the best implementation - (modify-syntax-entry ?/ ". 1456" table) - (modify-syntax-entry ?* ". 23" table) - (modify-syntax-entry ?\n "> b" table) - ) - ((memq '1-bit verilog-emacs-features) - ;; Emacs 19 does things differently, but we can work with it - (modify-syntax-entry ?/ ". 124b" table) - (modify-syntax-entry ?* ". 23" table) - (modify-syntax-entry ?\n "> b" table) - ) - )) - -(defvar verilog-mode-syntax-table nil +(defvar verilog-mode-syntax-table + (let ((table (make-syntax-table))) + ;; Populate the syntax TABLE. + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?% "." table) + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?& "." table) + (modify-syntax-entry ?| "." table) + (modify-syntax-entry ?` "w" table) + (modify-syntax-entry ?_ "w" table) + (modify-syntax-entry ?\' "." table) + + ;; Set up TABLE to handle block and line style comments. + (if (featurep 'xemacs) + (progn + ;; XEmacs (formerly Lucid) has the best implementation + (modify-syntax-entry ?/ ". 1456" table) + (modify-syntax-entry ?* ". 23" table) + (modify-syntax-entry ?\n "> b" table)) + ;; Emacs 19 does things differently, but we can work with it + (modify-syntax-entry ?/ ". 124b" table) + (modify-syntax-entry ?* ". 23" table) + (modify-syntax-entry ?\n "> b" table)) + table) "Syntax table used in `verilog-mode' buffers.") (defvar verilog-font-lock-keywords nil @@ -1961,8 +1907,7 @@ See also `verilog-font-lock-extra-types'.") 'font-lock-type-face)) ;; Fontify Verilog-AMS keywords (cons (concat "\\<\\(" verilog-ams-keywords "\\)\\>") - 'verilog-font-lock-ams-face) - )) + 'verilog-font-lock-ams-face))) (setq verilog-font-lock-keywords-1 (append verilog-font-lock-keywords @@ -1976,15 +1921,12 @@ See also `verilog-font-lock-extra-types'.") (list (concat "\\<function\\>\\s-+\\(integer\\|real\\(time\\)?\\|time\\)\\s-+\\(\\sw+\\)" ) '(1 font-lock-keyword-face) - '(3 font-lock-reference-face prepend) - ) + '(3 font-lock-reference-face prepend)) '("\\<function\\>\\s-+\\(\\[[^]]+\\]\\)\\s-+\\(\\sw+\\)" (1 font-lock-keyword-face) - (2 font-lock-reference-face append) - ) + (2 font-lock-reference-face append)) '("\\<function\\>\\s-+\\(\\sw+\\)" - 1 'font-lock-reference-face append) - ))) + 1 'font-lock-reference-face append)))) (setq verilog-font-lock-keywords-2 (append verilog-font-lock-keywords-1 @@ -2002,7 +1944,6 @@ See also `verilog-font-lock-extra-types'.") 0 font-lock-type-face append) ;; Fontify instantiation names '("\\([A-Za-z][A-Za-z0-9_]+\\)\\s-*(" 1 font-lock-function-name-face) - ))) (setq verilog-font-lock-keywords-3 @@ -2015,15 +1956,14 @@ See also `verilog-font-lock-extra-types'.") ))))) - (defun verilog-inside-comment-p () "Check if point inside a nested comment." (save-excursion (let ((st-point (point)) hitbeg) (or (search-backward "//" (verilog-get-beg-of-line) t) (if (progn - ;; This is for tricky case //*, we keep searching if /* is - ;; proceeded by // on same line. + ;; This is for tricky case //*, we keep searching if /* + ;; is proceeded by // on same line. (while (and (setq hitbeg (search-backward "/*" nil t)) (progn @@ -2048,14 +1988,14 @@ Use filename, if current buffer being edited shorten to just buffer name." "Move backward over a sexp." (interactive) ;; before that see if we are in a comment - (verilog-backward-sexp) -) + (verilog-backward-sexp)) + (defun electric-verilog-forward-sexp () "Move backward over a sexp." (interactive) ;; before that see if we are in a comment - (verilog-forward-sexp) -) + (verilog-forward-sexp)) + ;;;used by hs-minor-mode (defun verilog-forward-sexp-function (arg) (if (< arg 0) @@ -2067,19 +2007,16 @@ Use filename, if current buffer being edited shorten to just buffer name." (let ((reg) (elsec 1) (found nil) - (st (point)) - ) + (st (point))) (if (not (looking-at "\\<")) (forward-word -1)) (cond - ((verilog-skip-backward-comment-or-string) - ) + ((verilog-skip-backward-comment-or-string)) ((looking-at "\\<else\\>") (setq reg (concat verilog-end-block-re "\\|\\(\\<else\\>\\)" - "\\|\\(\\<if\\>\\)" - )) + "\\|\\(\\<if\\>\\)")) (while (and (not found) (verilog-re-search-backward reg nil 'move)) (cond @@ -2094,11 +2031,7 @@ Use filename, if current buffer being edited shorten to just buffer name." (setq elsec (1- elsec)) (if (= 0 elsec) ;; Now previous line describes syntax - (setq found 't) - )) - ) - ) - ) + (setq found 't)))))) ((looking-at verilog-end-block-re) (verilog-leap-to-head)) ((looking-at "\\(endmodule\\>\\)\\|\\(\\<endprimitive\\>\\)\\|\\(\\<endclass\\>\\)\\|\\(\\<endprogram\\>\\)\\|\\(\\<endinterface\\>\\)\\|\\(\\<endpackage\\>\\)") @@ -2120,9 +2053,7 @@ Use filename, if current buffer being edited shorten to just buffer name." (backward-sexp 1)))) (t (goto-char st) - (backward-sexp)) - ) ;; cond - )) + (backward-sexp))))) (defun verilog-forward-sexp () (let ((reg) @@ -2132,8 +2063,7 @@ Use filename, if current buffer being edited shorten to just buffer name." (forward-word -1)) (cond ((verilog-skip-forward-comment-or-string) - (verilog-forward-syntactic-ws) - ) + (verilog-forward-syntactic-ws)) ((looking-at verilog-beg-block-re-ordered);; begin|case|fork|class|table|specify|function|task|generate|covergroup|property|sequence|clocking (cond ((match-end 1) ; end @@ -2141,8 +2071,7 @@ Use filename, if current buffer being edited shorten to just buffer name." (setq reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)" )) ((match-end 2) ; endcase ;; Search forward for matching case - (setq reg "\\(\\<randcase\\>\\|\\(\\<unique\\>\\s-+\\|\\<priority\\>\\s-+\\)?\\<case[xz]?\\>[^:]\\)\\|\\(\\<endcase\\>\\)" ) - ) + (setq reg "\\(\\<randcase\\>\\|\\(\\<unique\\>\\s-+\\|\\<priority\\>\\s-+\\)?\\<case[xz]?\\>[^:]\\)\\|\\(\\<endcase\\>\\)" )) ((match-end 3) ; join ;; Search forward for matching fork (setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" )) @@ -2173,12 +2102,10 @@ Use filename, if current buffer being edited shorten to just buffer name." ((match-end 12) ; endsequence ;; Search forward for matching sequence (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)" ) - (setq md 3) ; 3 to get to endsequence in the reg above - ) + (setq md 3)) ; 3 to get to endsequence in the reg above ((match-end 13) ; endclocking ;; Search forward for matching clocking - (setq reg "\\(\\<clocking\\>\\)\\|\\(\\<endclocking\\>\\)" )) - ) + (setq reg "\\(\\<clocking\\>\\)\\|\\(\\<endclocking\\>\\)" ))) (if (forward-word 1) (catch 'skip (let ((nest 1)) @@ -2189,9 +2116,7 @@ Use filename, if current buffer being edited shorten to just buffer name." (if (= 0 nest) ; we are out! (throw 'skip 1))) ((match-end 1) ; the opener in reg, so we are deeper now - (setq nest (1+ nest))))) - ))) - ) + (setq nest (1+ nest))))))))) ((looking-at (concat "\\(\\<\\(macro\\)?module\\>\\)\\|" "\\(\\<primitive\\>\\)\\|" @@ -2221,9 +2146,7 @@ Use filename, if current buffer being edited shorten to just buffer name." (goto-char st) (if (= (following-char) ?\) ) (forward-char 1) - (forward-sexp 1))) - ) ;; cond - )) + (forward-sexp 1)))))) (defun verilog-declaration-beg () (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." (list ;; Fontify things in translate off regions '(verilog-match-translate-off - (0 'verilog-font-lock-translate-off-face prepend)) - )))) + (0 'verilog-font-lock-translate-off-face prepend)))))) (put 'verilog-mode 'font-lock-defaults '((verilog-font-lock-keywords verilog-font-lock-keywords-1 @@ -2253,23 +2175,7 @@ Use filename, if current buffer being edited shorten to just buffer name." ;; initialize fontification for Verilog Mode (verilog-font-lock-init) -;; start up message -(defconst verilog-startup-message-lines - '("Please use \\[verilog-submit-bug-report] to report bugs." - "Visit http://www.verilog.com to check for updates" - )) -(defvar verilog-startup-message-displayed t) -(defun verilog-display-startup-message () - (if (not verilog-startup-message-displayed) - (if (sit-for 5) - (let ((lines verilog-startup-message-lines)) - (message "verilog-mode version %s, released %s; type \\[describe-mode] for help" - verilog-mode-version verilog-mode-release-date) - (setq verilog-startup-message-displayed t) - (while (and (sit-for 4) lines) - (message (substitute-command-keys (car lines))) - (setq lines (cdr lines))))) - (message ""))) + ;; ;; ;; Mode @@ -2409,14 +2315,10 @@ Key bindings specific to `verilog-mode-map' are: (setq major-mode 'verilog-mode) (setq mode-name "Verilog") (setq local-abbrev-table verilog-mode-abbrev-table) - (setq verilog-mode-syntax-table (make-syntax-table)) - (verilog-populate-syntax-table verilog-mode-syntax-table) - (set (make-local-variable 'beginning-of-defun-function) + (set (make-local-variable 'beginning-of-defun-function) 'verilog-beg-of-defun) - (set (make-local-variable 'end-of-defun-function) + (set (make-local-variable 'end-of-defun-function) 'verilog-end-of-defun) - ;; add extra comment syntax - (verilog-setup-dual-comments verilog-mode-syntax-table) (set-syntax-table verilog-mode-syntax-table) (make-local-variable 'indent-line-function) (setq indent-line-function 'verilog-indent-line-relative) @@ -2444,8 +2346,8 @@ Key bindings specific to `verilog-mode-map' are: (not (assoc "Verilog" current-menubar))) ;; (set-buffer-menubar (copy-sequence current-menubar)) (add-submenu nil verilog-xemacs-menu) - (add-submenu nil verilog-stmt-menu) - )) + (add-submenu nil verilog-stmt-menu))) + ;; Stuff for GNU emacs (set (make-local-variable 'font-lock-defaults) '((verilog-font-lock-keywords verilog-font-lock-keywords-1 @@ -2472,8 +2374,6 @@ Key bindings specific to `verilog-mode-map' are: (cons '(verilog-mode-mode "\\<begin\\>" "\\<end\\>" nil verilog-forward-sexp-function) hs-special-modes-alist))) - ;; Display version splash information. - (verilog-display-startup-message) ;; Stuff for autos (add-hook 'write-contents-hooks 'verilog-auto-save-check) ; already local @@ -2527,27 +2427,19 @@ With optional ARG, remove existing end of line comments." (progn (end-of-line) (delete-horizontal-space) - 't - ) - ) - ) + 't))) ;; see if we should line up assignments (progn (if (or (memq 'all verilog-auto-lineup) (memq 'assignments verilog-auto-lineup)) - (verilog-pretty-expr) - ) - (newline) - ) - (forward-line 1) - ) + (verilog-pretty-expr)) + (newline)) + (forward-line 1)) ;; Indent next line (if verilog-auto-indent-on-newline - (verilog-indent-line)) - ) + (verilog-indent-line))) (t - (newline)) - ))) + (newline))))) (defun electric-verilog-terminate-and-indent () "Insert a newline and indent for the next statement." @@ -2565,8 +2457,7 @@ With optional ARG, remove existing end of line comments." (save-excursion (beginning-of-line) (verilog-forward-ws&directives) - (verilog-indent-line) - ) + (verilog-indent-line)) (if (and verilog-auto-newline (not (verilog-parenthesis-depth))) (electric-verilog-terminate-line)))) @@ -2648,9 +2539,7 @@ With optional ARG, remove existing end of line comments." (re-search-forward comment-start-skip oldpnt 'move) (goto-char (match-beginning 0)) (skip-chars-backward " \t") - (kill-region (point) oldpnt) - )))) - ) + (kill-region (point) oldpnt)))))) (progn (insert "\t")))) @@ -2690,7 +2579,7 @@ To call this from the command line, see \\[verilog-batch-indent]." (insert " * ")) (defun verilog-insert-1 (fmt max) - "Insert integers 0 to MAX-1 according to format string FMT. + "Use format string FMT to insert integers 0 to MAX - 1. Inserts one integer per line, at the current column. Stops early if it reaches the end of the buffer." (let ((col (current-column)) @@ -2724,7 +2613,7 @@ located after the first 'a' gives: a = b a[ 7] = b a = b a[ 8] = b" - (interactive "NMAX? ") + (interactive "NMAX: ") (verilog-insert-1 "[%3d]" max)) (defun verilog-generate-numbers (max) @@ -2744,19 +2633,20 @@ following code fragment: buf buf buf buf007 buf buf buf buf008" - (interactive "NMAX? ") + (interactive "NMAX: ") (verilog-insert-1 "%3.3d" max)) (defun verilog-mark-defun () "Mark the current verilog function (or procedure). This puts the mark at the end, and point at the beginning." (interactive) - (push-mark (point)) - (verilog-end-of-defun) - (push-mark (point)) - (verilog-beg-of-defun) - (if (fboundp 'zmacs-activate-region) - (zmacs-activate-region))) + (when (featurep 'xemacs) + (push-mark (point)) + (verilog-end-of-defun) + (push-mark (point)) + (verilog-beg-of-defun) + (if (fboundp 'zmacs-activate-region) + (zmacs-activate-region)))) (defun verilog-comment-region (start end) ; checkdoc-params: (start end) @@ -2792,8 +2682,7 @@ The commented area starts with `verilog-exclude-str-start', and ends with (save-excursion (let ((s+1 (1+ start))) (while (re-search-backward "/\\*" s+1 t) - (replace-match "/-*" t t)))) - )) + (replace-match "/-*" t t)))))) (defun verilog-uncomment-region () "Uncomment a commented area; change deformed comments back to normal. @@ -2869,8 +2758,7 @@ With ARG, first kill any existing labels." (point-marker))) (e (progn (verilog-end-of-defun) - (point-marker))) - ) + (point-marker)))) (goto-char (marker-position b)) (if (> (- e b) 200) (message "Relabeling module...")) @@ -2885,18 +2773,15 @@ With ARG, first kill any existing labels." (let ((indent-str (verilog-indent-line))) (verilog-set-auto-endcomments indent-str 't) (end-of-line) - (delete-horizontal-space) - ) + (delete-horizontal-space)) (setq cnt (1+ cnt)) (if (= 9 (% cnt 10)) - (message "%d..." cnt)) - ) + (message "%d..." cnt))) (goto-char oldpos) (if (or (> (- e b) 200) (> cnt 20)) - (message "%d lines auto commented" cnt)) - )) + (message "%d lines auto commented" cnt)))) (defun verilog-beg-of-statement () "Move backward to beginning of statement." @@ -2919,15 +2804,13 @@ With ARG, first kill any existing labels." (looking-at verilog-extended-complete-re) (not (save-excursion (verilog-backward-token) - (looking-at verilog-extended-complete-re))) - ) + (looking-at verilog-extended-complete-re)))) (looking-at verilog-basic-complete-re) (save-excursion (verilog-backward-token) (or (looking-at verilog-end-block-re) - (looking-at verilog-preprocessor-re))) - )) + (looking-at verilog-preprocessor-re))))) (verilog-backward-syntactic-ws) (verilog-backward-token)) ;; Now point is where the previous line ended. @@ -3011,9 +2894,9 @@ more specifically, point @ in the line foo : @ begin" (throw 'found 1)) (setq nest (1- nest))) (t - (throw 'found (= nest 0))) - )))) + (throw 'found (= nest 0))))))) nil))) + (defun verilog-in-struct-region-p () "Return TRUE if in a struct region; more specifically, in a list after a struct|union keyword" @@ -3024,20 +2907,14 @@ more specifically, in a list after a struct|union keyword" (if depth (progn (backward-up-list depth) (verilog-beg-of-statement) - (looking-at "\\<typedef\\>?\\s-*\\<struct\\|union\\>") - ) - ) - ) - ) - ) + (looking-at "\\<typedef\\>?\\s-*\\<struct\\|union\\>")))))) (defun verilog-in-generate-region-p () "Return TRUE if in a generate region; more specifically, after a generate and before an endgenerate" (interactive) (let ((lim (save-excursion (verilog-beg-of-defun) (point))) - (nest 1) - ) + (nest 1)) (save-excursion (while (and (/= nest 0) @@ -3046,17 +2923,14 @@ more specifically, after a generate and before an endgenerate" ((match-end 1) ; generate (setq nest (1- nest))) ((match-end 2) ; endgenerate - (setq nest (1+ nest))) - )) - )) + (setq nest (1+ nest))))))) (= nest 0) )) ; return nest (defun verilog-in-fork-region-p () "Return true if between a fork and join." (interactive) (let ((lim (save-excursion (verilog-beg-of-defun) (point))) - (nest 1) - ) + (nest 1)) (save-excursion (while (and (/= nest 0) @@ -3065,9 +2939,7 @@ more specifically, after a generate and before an endgenerate" ((match-end 1) ; fork (setq nest (1- nest))) ((match-end 2) ; join - (setq nest (1+ nest))) - )) - )) + (setq nest (1+ nest))))))) (= nest 0) )) ; return nest (defun verilog-backward-case-item (lim) @@ -3099,8 +2971,7 @@ Limit search to point LIM." (setq colon (1- colon))) ((match-end 3) ;; : - (setq colon (1+ colon))) - )) + (setq colon (1+ colon))))) ;; Skip back to beginning of case item (skip-chars-backward "\t ") (verilog-skip-backward-comment-or-string) @@ -3123,10 +2994,8 @@ Limit search to point LIM." (t (goto-char (match-end 0)) (verilog-forward-ws&directives) - (point)) - )) - (error "Malformed case item") - ))) + (point)))) + (error "Malformed case item")))) (setq str (buffer-substring b e)) (if (setq e @@ -3178,8 +3047,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter (search-backward "//" (verilog-get-beg-of-line) t))))) (let ((nest 1) b e m - (else (if (match-end 2) "!" " ")) - ) + (else (if (match-end 2) "!" " "))) (end-of-line) (if kill-existing-comment (verilog-kill-existing-comment)) @@ -3199,8 +3067,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter ((match-end 4) ; `ifdef (setq nest (1- nest))) ((match-end 5) ; `ifndef - (setq nest (1- nest))) - )) + (setq nest (1- nest))))) (if (match-end 0) (setq m (buffer-substring @@ -3212,15 +3079,13 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter (point)) e (progn (skip-chars-forward "a-zA-Z0-9_") - (point) - )))) + (point))))) (if b (if (> (count-lines (point) b) verilog-minimum-comment-distance) (insert (concat " // " else m " " (buffer-substring b e)))) (progn (insert " // unmatched `else or `endif") - (ding 't)) - ))) + (ding 't))))) (; Comment close case/class/function/task/module and named block (and (looking-at "\\<end") @@ -3269,8 +3134,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter (err 't) (here (point)) there - cntx - ) + cntx) (save-excursion (verilog-leap-to-head) (setq there (point)) @@ -3282,12 +3146,10 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter (verilog-kill-existing-comment)) (delete-horizontal-space) (insert str) - (ding 't) - ) + (ding 't)) (let ((lim (save-excursion (verilog-beg-of-defun) (point))) - (here (point)) - ) + (here (point))) (cond (;-- handle named block differently (looking-at verilog-named-block-re) @@ -3336,8 +3198,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter (;- else (match-end 4) (let ((nest 0) - ( reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)") - ) + ( reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)")) (catch 'skip (while (verilog-re-search-backward reg nil 'move) (cond @@ -3353,16 +3214,13 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter (setq err nil) (setq str (verilog-get-expr)) (setq str (concat " // else: !if" str )) - (throw 'skip 1)) - ))) - )))) + (throw 'skip 1))))))))) (;- end else (match-end 5) (goto-char there) (let ((nest 0) - ( reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)") - ) + (reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)")) (catch 'skip (while (verilog-re-search-backward reg nil 'move) (cond @@ -3378,9 +3236,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter (setq err nil) (setq str (verilog-get-expr)) (setq str (concat " // else: !if" str )) - (throw 'skip 1)) - ))) - )))) + (throw 'skip 1))))))))) (;- task/function/initial et cetera t @@ -3392,8 +3248,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter (setq str (concat " // " cntx str ))) (;-- otherwise... - (setq str " // auto-endcomment confused ")) - )) + (setq str " // auto-endcomment confused ")))) ((and (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 (match-end 11) ;; of verilog-end-block-ordered-re ;;(goto-char there) (let ((nest 0) - ( reg "\\<\\(class\\)\\|\\(endclass\\)\\|\\(package\\|primitive\\|\\(macro\\)?module\\)\\>") - string - ) + (reg "\\<\\(class\\)\\|\\(endclass\\)\\|\\(package\\|primitive\\|\\(macro\\)?module\\)\\>") + string) (save-excursion (catch 'skip (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 (throw 'skip 1)))) )))) (end-of-line) - (insert (concat " // " string ))) - ) + (insert (concat " // " string )))) (;- this is end{function,generate,task,module,primitive,table,generate} ;- which can not be nested. @@ -3479,8 +3332,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter (cond ((match-end 5) ;; of verilog-end-block-ordered-re (setq reg "\\(\\<function\\>\\)\\|\\(\\<\\(endfunction\\|task\\|\\(macro\\)?module\\|primitive\\)\\>\\)") - (setq width "\\(\\s-*\\(\\[[^]]*\\]\\)\\|\\(real\\(time\\)?\\)\\|\\(integer\\)\\|\\(time\\)\\)?") - ) + (setq width "\\(\\s-*\\(\\[[^]]*\\]\\)\\|\\(real\\(time\\)?\\)\\|\\(integer\\)\\|\\(time\\)\\)?")) ((match-end 6) ;; of verilog-end-block-ordered-re (setq reg "\\(\\<task\\>\\)\\|\\(\\<\\(endtask\\|function\\|\\(macro\\)?module\\|primitive\\)\\>\\)")) ((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 ((match-end 15) ;; of verilog-end-block-ordered-re (setq reg "\\(\\<clocking\\>\\)\\|\\<endclocking\\>")) - (t (error "Problem in verilog-set-auto-endcomments")) - ) + (t (error "Problem in verilog-set-auto-endcomments"))) (let (b e) (save-excursion (verilog-re-search-backward reg nil 'move) @@ -3515,8 +3366,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter (if (and width (looking-at width)) (progn (goto-char (match-end 0)) - (verilog-forward-ws&directives) - )) + (verilog-forward-ws&directives))) (point)) e (progn (skip-chars-forward "a-zA-Z0-9_") @@ -3577,8 +3427,7 @@ Insert `// NAME ' if this line ends a function, task, module, primitive or inter b) ('t (skip-chars-forward "^: \t\n\f") - (point) - )))) + (point))))) (str (buffer-substring b e))) (if (setq e (string-match "[ \t]*\\(\\(\n\\)\\|\\(//\\)\\|\\(/\\*\\)\\)" str)) (setq str (concat (substring str 0 e) "..."))) @@ -3601,8 +3450,8 @@ Useful for creating tri's and other expanded fields." (concat "\\(.*\\)" (regexp-quote bra) "\\([0-9]*\\)\\(:[0-9]*\\|\\)\\(::[0-9---]*\\|\\)" - (regexp-quote ket) - "\\(.*\\)$") signal-string) + (regexp-quote ket) + "\\(.*\\)$") signal-string) (let* ((sig-head (match-string 1 signal-string)) (vec-start (string-to-number (match-string 2 signal-string))) (vec-end (if (= (match-beginning 3) (match-end 3)) @@ -3765,8 +3614,7 @@ becomes: ))) ((verilog-in-star-comment-p) (re-search-backward "/\*") - (insert (format " // surefire lint_off_line %6s" code )) - ) + (insert (format " // surefire lint_off_line %6s" code ))) (t (insert (format " // surefire lint_off_line %6s" code )) ))))))))) @@ -3823,11 +3671,11 @@ This lets programs calling batch mode to easily extract error messages." (setq default-major-mode `verilog-mode) ;; Ditto files already read in (mapc (lambda (buf) - (when (buffer-file-name buf) - (save-excursion - (set-buffer buf) - (verilog-mode)))) - (buffer-list)) + (when (buffer-file-name buf) + (save-excursion + (set-buffer buf) + (verilog-mode)))) + (buffer-list)) ;; Process the files (mapcar '(lambda (buf) (when (buffer-file-name buf) @@ -3943,8 +3791,7 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (not (verilog-in-coverage)) (verilog-in-paren)) (progn (setq par 1) - (throw 'nesting 'block)) - ) + (throw 'nesting 'block))) ;; See if we are continuing a previous line (while t @@ -4026,8 +3873,7 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (setq reg "\\(\\<class\\>\\)\\|\\(\\<endclass\\>\\)" )) ((match-end 12) ; covergroup ;; Search back for matching covergroup - (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<endgroup\\>\\)" )) - ) + (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<endgroup\\>\\)" ))) (catch 'skip (while (verilog-re-search-backward reg nil 'move) (cond @@ -4037,11 +3883,8 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (throw 'skip 1))) ((match-end 2) ; end (setq nest (1+ nest))))) - ) - )) - )))) - (throw 'nesting (verilog-calc-1)) - ) + ))))))) + (throw 'nesting (verilog-calc-1))) );; catch nesting );; type ) @@ -4058,8 +3901,8 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." ((eq type 'defun) (list type 0)) (t - (list type (verilog-current-indent-level))))) - ))) + (list type (verilog-current-indent-level)))))))) + (defun verilog-wai () "Show matching nesting block for debugging." (interactive) @@ -4073,8 +3916,7 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (cond ((equal (char-after) ?\{) (if (verilog-at-constraint-p) - (throw 'nesting 'block) - )) + (throw 'nesting 'block))) ((equal (char-after) ?\}) (let ((there (verilog-at-close-constraint-p))) @@ -4133,8 +3975,7 @@ type. Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." For speed, the searcher looks at the last directive, not the indent of the appropriate enclosing block." (let ((base -1) ;; Indent of the line that determines our indentation - (ind 0) ;; Relative offset caused by other directives (like `endif on same line as `else) - ) + (ind 0)) ;; Relative offset caused by other directives (like `endif on same line as `else) ;; Start at current location, scan back for another directive (save-excursion @@ -4142,8 +3983,7 @@ of the appropriate enclosing block." (while (and (< base 0) (verilog-re-search-backward verilog-directive-re nil t)) (cond ((save-excursion (skip-chars-backward " \t") (bolp)) - (setq base (current-indentation)) - )) + (setq base (current-indentation)))) (cond ((and (looking-at verilog-directive-end) (< base 0)) ;; Only matters when not at BOL (setq ind (- ind verilog-indent-level-directive))) ((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." (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)" )) ((looking-at "\\<endclocking\\>") ;; 12: Search back for matching clocking - (setq reg "\\(\\<clocking\\)\\|\\(\\<endclocking\\>\\)" )) - ) + (setq reg "\\(\\<clocking\\)\\|\\(\\<endclocking\\>\\)" ))) (if reg (catch 'skip (let (sreg) @@ -4268,9 +4107,7 @@ Set point to where line starts" (save-excursion (skip-chars-backward " \t") (not (bolp)))) - (setq continued (verilog-backward-token)) - ) ;; while - )) + (setq continued (verilog-backward-token))))) (setq continued nil)) continued)) @@ -4289,15 +4126,13 @@ Set point to where line starts" (= (preceding-char) ?\}) (progn (backward-char) - (verilog-at-close-constraint-p)) - ) + (verilog-at-close-constraint-p))) (;-- constraint foo { a = b } ; is a complete statement. *sigh* (= (preceding-char) ?\{) (progn (backward-char) - (not (verilog-at-constraint-p))) - ) + (not (verilog-at-constraint-p)))) (;-- Could be 'case (foo)' or 'always @(bar)' which is complete ; also could be simply '@(foo)' ; or foo u1 #(a=8) @@ -4322,10 +4157,8 @@ Set point to where line starts" (verilog-backward-token) (not (looking-at "\\<\\(always\\(_latch\\|_ff\\|_comb\\)?\\|initial\\|while\\)\\>")))) ((= (preceding-char) ?\#) - (backward-char) - ) - (t t)) - ))))) + (backward-char)) + (t t))))))) (;-- any of begin|initial|while are complete statements; 'begin : foo' is also complete t @@ -4346,8 +4179,7 @@ Set point to where line starts" (backward-sexp) (if (looking-at verilog-nameable-item-re ) nil - t) - ) + t)) ((= (preceding-char) ?\#) (backward-char) t) @@ -4357,8 +4189,7 @@ Set point to where line starts" (t (goto-char back) - t) - ))))))) + t)))))))) (defun verilog-backward-syntactic-ws (&optional bound) "Backward skip over syntactic whitespace for Emacs 19. @@ -4370,9 +4201,7 @@ Optional BOUND limits search." (narrow-to-region bound (point)) (while (/= here (point)) (setq here (point)) - (verilog-skip-backward-comments) - ))) - )) + (verilog-skip-backward-comments)))))) t) (defun verilog-forward-syntactic-ws (&optional bound) @@ -4380,16 +4209,13 @@ Optional BOUND limits search." Optional BOUND limits search." (save-restriction (let* ((bound (or bound (point-max))) - (here bound) - ) + (here bound)) (if (> bound (point)) (progn (narrow-to-region (point) bound) (while (/= here (point)) (setq here (point)) - (forward-comment (buffer-size)) - ))) - ))) + (forward-comment (buffer-size)))))))) (defun verilog-backward-ws&directives (&optional bound) "Backward skip over syntactic whitespace and compiler directives for Emacs 19. @@ -4423,9 +4249,7 @@ Optional BOUND limits search." (point)) (t nil)))) - (if p (goto-char p)) - ))) - ))) + (if p (goto-char p)))))))) (defun verilog-forward-ws&directives (&optional bound) "Forward skip over syntactic whitespace and compiler directives for Emacs 19. @@ -4433,8 +4257,7 @@ Optional BOUND limits search." (save-restriction (let* ((bound (or bound (point-max))) (here bound) - jump - ) + jump) (if (> bound (point)) (progn (let ((state @@ -4455,9 +4278,7 @@ Optional BOUND limits search." (if (looking-at verilog-directive-re-1) (setq jump t))) (if jump - (beginning-of-line 2)) - ))) - ))) + (beginning-of-line 2)))))))) (defun verilog-in-comment-p () "Return true if in a star or // comment." @@ -4537,14 +4358,11 @@ Optional BOUND limits search." (forward-list) (progn (backward-char 1) (verilog-backward-ws&directives) - (equal (char-before) ?\;)) - )) + (equal (char-before) ?\;)))) ;; maybe (verilog-re-search-backward "\\<constraint\\|coverpoint\\|cross\\>" nil 'move) ;; not - nil - ) - ) + nil)) (defun verilog-parenthesis-depth () "Return non zero if in parenthetical-expression." @@ -4608,8 +4426,7 @@ Optional BOUND limits search." t) ((and (not (bobp)) (= (char-before) ?\/) - (= (char-before (1- (point))) ?\*) - ) + (= (char-before (1- (point))) ?\*)) (goto-char (- (point) 2)) t) (t @@ -4650,8 +4467,8 @@ Only look at a few lines to determine indent level." (if (verilog-continued-line) (progn (goto-char sp) - (setq - indent-str (list 'statement (verilog-current-indent-level)))) + (setq indent-str + (list 'statement (verilog-current-indent-level)))) (goto-char sp1) (setq indent-str (list 'block (verilog-current-indent-level))))) (goto-char sp)) @@ -4701,16 +4518,13 @@ Only look at a few lines to determine indent level." (progn (forward-char 1) (backward-up-list -1) - (skip-chars-forward " \t"))) - ) + (skip-chars-forward " \t")))) (current-column)) (progn (goto-char fst) - (+ (current-column) verilog-cexp-indent)) - )))) + (+ (current-column) verilog-cexp-indent)))))) (goto-char here) - (indent-line-to val)) - ) + (indent-line-to val))) ((= (preceding-char) ?\) ) (goto-char here) (let ((val (eval (cdr (assoc type verilog-indent-alist))))) @@ -4724,8 +4538,7 @@ Only look at a few lines to determine indent level." (setq val (current-column)) (setq val (eval (cdr (assoc type verilog-indent-alist))))) (goto-char here) - (indent-line-to val))) - ))) + (indent-line-to val)))))) (; handle inside parenthetical expressions (eq type 'cparenexp) @@ -4737,8 +4550,7 @@ Only look at a few lines to determine indent level." (indent-line-to val) (if (and (not (verilog-in-struct-region-p)) (looking-at verilog-declaration-re)) - (verilog-indent-declaration ind)) - )) + (verilog-indent-declaration ind)))) (;-- Handle the ends (or @@ -4774,8 +4586,8 @@ Only look at a few lines to determine indent level." (;-- Everything else t (let ((val (eval (cdr (assoc type verilog-indent-alist))))) - (indent-line-to val))) - ) + (indent-line-to val)))) + (if (looking-at "[ \t]+$") (skip-chars-forward " \t")) indent-str ; Return indent data @@ -4823,8 +4635,7 @@ Do not count named blocks or case-statements." (t (save-excursion (re-search-backward "//" nil t) - (current-column))) - ))) + (current-column)))))) (indent-line-to stcol) stcol)) @@ -4843,8 +4654,7 @@ Do not count named blocks or case-statements." (t (save-excursion (re-search-backward "//" nil t) - (current-column))) - ))) + (current-column)))))) (progn (indent-to stcol) (if (and star @@ -4912,8 +4722,7 @@ ARG is ignored, for `comment-indent-function' compatibility." (goto-char start) (verilog-do-indent (verilog-calculate-indent)) (verilog-forward-ws&directives) - (current-column))) - ) + (current-column)))) (goto-char end) (goto-char start) (if (> (- end start) 100) @@ -4927,15 +4736,12 @@ ARG is ignored, for `comment-indent-function' compatibility." (verilog-forward-ws&directives) (indent-line-to base-ind) (verilog-forward-ws&directives) - (verilog-re-search-forward "[ \t\n\f]" e 'move) - ) + (verilog-re-search-forward "[ \t\n\f]" e 'move)) (t (just-one-space) - (verilog-re-search-forward "[ \t\n\f]" e 'move) - ) - ) + (verilog-re-search-forward "[ \t\n\f]" e 'move))) + ;;(forward-line) ) - ;;(forward-line)) ;; Now find biggest prefix (setq ind (verilog-get-lineup-indent start edpos)) ;; Now indent each line. @@ -4960,21 +4766,19 @@ ARG is ignored, for `comment-indent-function' compatibility." (indent-to ind)) (progn (just-one-space) - (indent-to ind)) - ))) + (indent-to ind))))) ((verilog-continued-line-1 start) (goto-char e) (indent-line-to ind)) (t ; Must be comment or white space (goto-char e) (verilog-forward-ws&directives) - (forward-line -1)) - ) + (forward-line -1))) (forward-line 1)) (message ""))))) (defun verilog-pretty-expr (&optional myre) - "Line up expressions around point." + "Line up expressions around point, or optional regexp MYRE." (interactive "sRegular Expression: ((<|:)?=) ") (save-excursion (if (or (eq myre nil) @@ -4995,8 +4799,7 @@ ARG is ignored, for `comment-indent-function' compatibility." (beginning-of-line) (while (and (not (looking-at (concat "^\\s-*" verilog-complete-reg))) (looking-at myre) - (not (bobp)) - ) + (not (bobp))) (setq e (point)) (verilog-backward-syntactic-ws) (beginning-of-line) @@ -5015,12 +4818,10 @@ ARG is ignored, for `comment-indent-function' compatibility." (end-of-line) (setq e (point)) (verilog-forward-syntactic-ws) - (beginning-of-line) - ) + (beginning-of-line)) e)) (edpos (set-marker (make-marker) end)) - (ind) - ) + (ind)) (goto-char start) (verilog-do-indent (verilog-calculate-indent)) (if (> (- end start) 100) @@ -5031,8 +4832,7 @@ ARG is ignored, for `comment-indent-function' compatibility." (beginning-of-line) (verilog-just-one-space myre) (end-of-line) - (verilog-forward-syntactic-ws) - ) + (verilog-forward-syntactic-ws)) ;; Now find biggest prefix (setq ind (verilog-get-lineup-indent-2 myre start edpos)) @@ -5049,20 +4849,16 @@ ARG is ignored, for `comment-indent-function' compatibility." (goto-char (match-end 1)) (if (eq (char-after) ?=) (indent-to (1+ ind)) ; line up the = of the <= with surrounding = - (indent-to ind) - ) - ) + (indent-to ind))) ((verilog-continued-line-1 start) (goto-char e) (indent-line-to ind)) (t ; Must be comment or white space (goto-char e) (verilog-forward-ws&directives) - (forward-line -1)) - ) + (forward-line -1))) (forward-line 1)) - (message "") - )))) + (message ""))))) (defun verilog-just-one-space (myre) "Remove extra spaces around regular expression MYRE." @@ -5073,12 +4869,10 @@ ARG is ignored, for `comment-indent-function' compatibility." (p2 (match-end 2))) (progn (goto-char p2) - (if (looking-at "\\s-") (just-one-space) ) + (if (looking-at "\\s-") (just-one-space)) (goto-char p1) (forward-char -1) - (if (looking-at "\\s-") (just-one-space)) - ) - )) + (if (looking-at "\\s-") (just-one-space))))) (message "")) (defun verilog-indent-declaration (baseind) @@ -5093,8 +4887,7 @@ BASEIND is the base indent to offset everything." (point))) (ind) (val) - (m1 (make-marker)) - ) + (m1 (make-marker))) (setq val (+ baseind (eval (cdr (assoc 'declaration verilog-indent-alist))))) (indent-line-to val) @@ -5125,13 +4918,11 @@ BASEIND is the base indent to offset everything." (just-one-space) (goto-char (marker-position m1)) (just-one-space) - (indent-to ind) - ) + (indent-to ind)) (if (/= (current-column) ind) (progn (just-one-space) - (indent-to ind)) - ))) + (indent-to ind))))) (if (looking-at verilog-declaration-re-2-no-macro) (let ((p (match-end 0))) (set-marker m1 p) @@ -5362,11 +5153,8 @@ for matches of `str' and adding the occurrence tp `all' through point END." (if (or (null verilog-pred) (funcall verilog-pred match)) (setq verilog-all (cons match verilog-all))))) - (forward-line 1) - ) - ) - verilog-all - ) + (forward-line 1))) + verilog-all) (defun verilog-type-completion () "Calculate all possible completions for types." @@ -5663,8 +5451,7 @@ If search fails, other files are checked based on (goto-char pt) (beginning-of-line)) pt) - (verilog-goto-defun-file label) - ))) + (verilog-goto-defun-file label)))) ;; Eliminate compile warning (eval-when-compile @@ -5680,8 +5467,7 @@ If search fails, other files are checked based on (first 1) (prevpos (point-min)) (final-context-start (make-marker)) - (regexp "\\(module\\s-+\\w+\\s-*(\\)\\|\\(\\w+\\s-+\\w+\\s-*(\\)") - ) + (regexp "\\(module\\s-+\\w+\\s-*(\\)\\|\\(\\w+\\s-+\\w+\\s-*(\\)")) (with-output-to-temp-buffer "*Occur*" (save-excursion (message (format "Searching for %s ..." regexp)) @@ -5854,8 +5640,7 @@ Bound search by LIMIT. Adapted from (search-forward "<company>") (replace-match string t t) (search-backward "<description>") - (replace-match "" t t) - ))) + (replace-match "" t t)))) ;; verilog-header Uses the verilog-insert-date function @@ -5994,8 +5779,7 @@ Duplicate signals are also removed. For example A[2] and A[1] become A[2:1]." sv-type (verilog-sig-type sig) sv-multidim (verilog-sig-multidim sig) combo "" - buswarn "" - )) + buswarn "")) ;; Extract bus details (setq bus (verilog-sig-bits sig)) (cond ((and bus @@ -6043,16 +5827,15 @@ Duplicate signals are also removed. For example A[2] and A[1] become A[2:1]." (if sv-highbit (concat "[" (int-to-string sv-highbit) ":" (int-to-string sv-lowbit) "]"))) - (concat sv-comment combo buswarn) - sv-memory sv-enum sv-signed sv-type sv-multidim) - out-list) - sv-name nil))) - ) + (concat sv-comment combo buswarn) + sv-memory sv-enum sv-signed sv-type sv-multidim) + out-list) + sv-name nil)))) ;; out-list)) (defun verilog-sig-tieoff (sig &optional no-width) - "Return tieoff expression for given SIGNAL, with appropriate width. + "Return tieoff expression for given SIG, with appropriate width. Ignore width if optional NO-WIDTH is set." (let* ((width (if no-width nil (verilog-sig-width sig)))) (concat @@ -6189,8 +5972,7 @@ Return a array of [outputs inouts inputs wire reg assign const]." (forward-char 1) (when (< paren sig-paren) (setq expect-signal nil)) ; ) that ends variables inside v2k arg list - t) - ))) + t)))) ((looking-at "\\s-*\\(\\[[^]]+\\]\\)") (goto-char (match-end 0)) (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]." (nreverse sigs-reg) (nreverse sigs-assign) (nreverse sigs-const) - (nreverse sigs-gparam) - )))) + (nreverse sigs-gparam))))) -(defvar sigs-in) ; Prevent compile warning -(defvar sigs-inout) ; Prevent compile warning -(defvar sigs-out) ; Prevent compile warning +(eval-when-compile + ;; Prevent compile warnings; these are let's, not globals + ;; Do not remove the eval-when-compile + ;; - we want a error when we are debugging this code if they are refed. + (defvar sigs-in) + (defvar sigs-inout) + (defvar sigs-out)) (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." (end-pt (point))) (eval-region beg-pt end-pt nil))))) -;; These are passed in a let, not global -(defvar got-sig) -(defvar got-rvalue) -(defvar uses-delayed) +(eval-when-compile + ;; Prevent compile warnings; these are let's, not globals + ;; Do not remove the eval-when-compile + ;; - we want a error when we are debugging this code if they are refed. + (defvar sigs-in) + (defvar sigs-out) + (defvar got-sig) + (defvar got-rvalue) + (defvar uses-delayed) + (defvar vector-skip-list)) (defun verilog-read-always-signals-recurse (exit-keywd rvalue ignore-next) @@ -6653,8 +6444,7 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." (t (forward-char 1))) ;; End of non-comment token - (setq last-keywd keywd) - )) + (setq last-keywd keywd))) (skip-syntax-forward " ")) ;; Append the final pending signal (when got-sig @@ -6700,8 +6490,7 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement." (instant (match-string 2))) (if (not (member module verilog-keywords)) (setq instants-list (cons (list module instant) instants-list))))) - (forward-line 1) - )) + (forward-line 1))) instants-list)) @@ -6776,8 +6565,7 @@ list of ( (signal_name connection_name)... )" (t (error "%s: AUTO_TEMPLATE parsing error: %s" (verilog-point-text) - (progn (looking-at ".*$") (match-string 0)))) - )) + (progn (looking-at ".*$") (match-string 0)))))) ;; Return (vector tpl-regexp (list tpl-sig-list tpl-wild-list))) @@ -6799,8 +6587,7 @@ Optionally associate it with the specified enumeration ENUMNAME." (let ((enumvar (intern (concat "venum-" enumname)))) ;;(message "Define %s=%s" defname defvalue) (sleep-for 1) (make-variable-buffer-local enumvar) - (add-to-list enumvar defname))) - )) + (add-to-list enumvar defname))))) (defun verilog-read-defines (&optional filename recurse subcall) "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: (while (looking-at "\\s-*,?\\s-*\\([a-zA-Z0-9_$]+\\)\\s-*=\\s-*\\([^;,]*\\),?\\s-*") (verilog-set-define (match-string-no-properties 1) (match-string-no-properties 2) origbuf enumname) (goto-char (match-end 0)) - (forward-comment 999)))) - ))) + (forward-comment 999))))))) (defun verilog-read-includes () "Read `includes for the current file. @@ -6950,8 +6736,7 @@ Some macros and such are also found and included. For dinotrace.el" (or (member keywd verilog-keywords) (member keywd sigs-all) (setq sigs-all (cons keywd sigs-all)))) - (t (forward-char 1))) - ) + (t (forward-char 1)))) ;; Return list sigs-all))) @@ -7019,10 +6804,7 @@ Some macros and such are also found and included. For dinotrace.el" ((string-match "^[^-+]" arg) (verilog-add-list-unique `verilog-library-files arg)) ;; Default - ignore; no warning - ) - ) - ) - ) + )))) ;;(verilog-getopt (list "+libext+.a+.b" "+incdir+foodir" "+define+a+aval" "-f" "otherf" "-v" "library" "-y" "dir")) (defun verilog-getopt-file (filename) @@ -7096,8 +6878,7 @@ Allows version control to check out the file if need be." "Return true if SYMBOL is number-like." (or (string-match "^[0-9 \t:]+$" symbol) (string-match "^[---]*[0-9]+$" symbol) - (string-match "^[0-9 \t]+'s?[hdxbo][0-9a-fA-F_xz? \t]*$" symbol) - )) + (string-match "^[0-9 \t]+'s?[hdxbo][0-9a-fA-F_xz? \t]*$" symbol))) (defun verilog-symbol-detick (symbol wing-it) "Return a expanded SYMBOL name without any defines. @@ -7185,13 +6966,11 @@ Or, just the existing dirnames themselves if there are no wildcards." (setq dirfile (expand-file-name (concat (car dirfiles) rest)) dirfiles (cdr dirfiles)) (if (file-directory-p dirfile) - (setq dirlist (cons dirfile dirlist)))) - ) + (setq dirlist (cons dirfile dirlist))))) ;; Defaults (t (if (file-directory-p dirname) - (setq dirlist (cons dirname dirlist)))) - )) + (setq dirlist (cons dirname dirlist)))))) dirlist)) ;;(verilog-expand-dirnames (list "." ".." "nonexist" "../*" "/home/wsnyder/*/v")) @@ -7295,13 +7074,11 @@ Return modi if successful, else print message unless IGNORE-ERROR is true." "") "\n Check the verilog-library-directories variable." "\n I looked in (if not listed, doesn't exist):\n\t" - (mapconcat 'concat orig-filenames "\n\t"))))) - ) + (mapconcat 'concat orig-filenames "\n\t")))))) (setq verilog-modi-lookup-last-mod module verilog-modi-lookup-last-current current verilog-modi-lookup-last-tick (buffer-modified-tick))))) - verilog-modi-lookup-last-modi - )) + verilog-modi-lookup-last-modi)) (defsubst verilog-modi-name (modi) (aref modi 0)) @@ -7370,8 +7147,7 @@ Cache the output of function so next call may have faster access." (buffer-modified-tick) (visited-file-modtime) func-returns) - verilog-modi-cache-list))) - )) + verilog-modi-cache-list))))) ;; func-returns)) @@ -7483,7 +7259,7 @@ and invalidating the cache." (funcall func)))) (defun verilog-insert-one-definition (sig type indent-pt) - "Print out a definition for SIGNAL of the given TYPE, + "Print out a definition for SIG of the given TYPE, with appropriate INDENT-PT indentation." (indent-to indent-pt) (insert type) @@ -7594,9 +7370,8 @@ This repairs those mis-inserted by a AUTOARG." (string-to-number (match-string 2 range-exp))))))) ((string-match "^\\(.*\\)\\s *:\\s *\\(.*\\)\\s *$" range-exp) (concat "(1+(" (match-string 1 range-exp) ")" - (if (equal "0" (match-string 2 range-exp)) - ;; Don't bother with -(0) - "" + (if (equal "0" (match-string 2 range-exp)) + "" ;; Don't bother with -(0) (concat "-(" (match-string 2 range-exp) ")")) ")")) (t nil))))) @@ -7621,8 +7396,7 @@ This repairs those mis-inserted by a AUTOARG." ;; End exists (end-of-line) (delete-region pt (point)) - (forward-line 1)) - )) + (forward-line 1)))) (defun verilog-forward-close-paren () "Find the close parenthesis that match the current point, @@ -7897,8 +7671,7 @@ Typing \\[verilog-inject-auto] will make this into: (when (yes-or-no-p "AUTO statements not recomputed, do it now? ") (verilog-auto)) ;; Don't ask again if didn't update - (set (make-local-variable 'verilog-auto-update-tick) (buffer-modified-tick)) - )) + (set (make-local-variable 'verilog-auto-update-tick) (buffer-modified-tick)))) (when (not verilog-auto-star-save) (verilog-delete-auto-star-implicit)) 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." (verilog-repair-close-comma) (unless (eq (char-before) ?/ ) (insert "\n")) - (indent-to verilog-indent-level-declaration) - ))) + (indent-to verilog-indent-level-declaration)))) (defun verilog-auto-inst-port-map (port-st) nil) -(defvar vector-skip-list nil) ; Prevent compile warning (defvar vl-cell-type nil "See `verilog-auto-inst'.") ; Prevent compile warning (defvar vl-cell-name nil "See `verilog-auto-inst'.") ; Prevent compile warning (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." "Print out a instantiation connection for this PORT-ST. Insert to INDENT-PT, use template TPL-LIST. @ are instantiation numbers, replaced with TPL-NUM. -@\"(expression @)\" are evaluated, with @ as a variable." +@\"(expression @)\" are evaluated, with @ as a variable. +If FOR-STAR add comment it is a .* expansion." (let* ((port (verilog-sig-name port-st)) (tpl-ass (or (assoc port (car tpl-list)) (verilog-auto-inst-port-map port-st))) @@ -8072,13 +7844,11 @@ Insert to INDENT-PT, use template TPL-LIST. (prin1 (eval (car (read-from-string expr))) (lambda (ch) ()))))) (if (numberp value) (setq value (number-to-string value))) - value - )) + value)) (substring tpl-net (match-end 0)))))) ;; Replace @ and [] magic variables in final output (setq tpl-net (verilog-string-replace-matches "@" tpl-num nil nil tpl-net)) - (setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net)) - ) + (setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net))) (indent-to indent-pt) (insert "." port) (indent-to verilog-auto-inst-column) @@ -8462,9 +8232,7 @@ Lisp Templates: (if (search-forward ")" nil t) ;; From user, moved up a line (delete-backward-char 1)) (if (search-forward ";" nil t) ;; Don't error if user had syntax error and forgot it - (delete-backward-char 1)) - ))) - )))) + (delete-backward-char 1))))))))) (defun verilog-auto-inst-param () "Expand AUTOINSTPARAM statements, as part of \\[verilog-auto]. @@ -8566,9 +8334,7 @@ Templates: (search-forward "\n") ;; Added by inst-port (delete-backward-char 1) (if (search-forward ")" nil t) ;; From user, moved up a line - (delete-backward-char 1)) - ))) - )))) + (delete-backward-char 1))))))))) (defun verilog-auto-reg () "Expand AUTOREG statements, as part of \\[verilog-auto]. @@ -8612,15 +8378,13 @@ Typing \\[verilog-auto] will make this into: (verilog-modi-get-consts modi) (verilog-modi-get-gparams modi) (verilog-modi-get-sub-outputs modi) - (verilog-modi-get-sub-inouts modi) - )))) + (verilog-modi-get-sub-inouts modi))))) (forward-line 1) (when sig-list (verilog-insert-indent "// Beginning of automatic regs (for this module's undeclared outputs)\n") (verilog-insert-definition sig-list "reg" indent-pt nil) (verilog-modi-cache-add-regs modi sig-list) - (verilog-insert-indent "// End of automatics\n")) - ))) + (verilog-insert-indent "// End of automatics\n"))))) (defun verilog-auto-reg-input () "Expand AUTOREGINPUT statements, as part of \\[verilog-auto]. @@ -8665,15 +8429,13 @@ Typing \\[verilog-auto] will make this into: (verilog-signals-not-in (append (verilog-modi-get-sub-inputs modi) (verilog-modi-get-sub-inouts modi)) - (verilog-modi-get-signals modi) - )))) + (verilog-modi-get-signals modi))))) (forward-line 1) (when sig-list (verilog-insert-indent "// Beginning of automatic reg inputs (for undeclared instantiated-module inputs)\n") (verilog-insert-definition sig-list "reg" indent-pt nil) (verilog-modi-cache-add-regs modi sig-list) - (verilog-insert-indent "// End of automatics\n")) - ))) + (verilog-insert-indent "// End of automatics\n"))))) (defun verilog-auto-wire () "Expand AUTOWIRE statements, as part of \\[verilog-auto]. @@ -8726,8 +8488,7 @@ Typing \\[verilog-auto] will make this into: (verilog-signals-not-in (append (verilog-modi-get-sub-outputs modi) (verilog-modi-get-sub-inouts modi)) - (verilog-modi-get-signals modi) - )))) + (verilog-modi-get-signals modi))))) (forward-line 1) (when sig-list (verilog-insert-indent "// Beginning of automatic wires (for undeclared instantiated-module outputs)\n") @@ -8739,8 +8500,7 @@ Typing \\[verilog-auto] will make this into: (setq pnt (point)) (verilog-pretty-declarations) (goto-char pnt) - (verilog-pretty-expr "//"))) - ))) + (verilog-pretty-expr "//")))))) (defun verilog-auto-output () "Expand AUTOOUTPUT statements, as part of \\[verilog-auto]. @@ -8793,8 +8553,7 @@ Typing \\[verilog-auto] will make this into: (append (verilog-modi-get-outputs modi) (verilog-modi-get-inouts modi) (verilog-modi-get-sub-inputs modi) - (verilog-modi-get-sub-inouts modi) - )))) + (verilog-modi-get-sub-inouts modi))))) (setq sig-list (verilog-signals-not-matching-regexp sig-list verilog-auto-output-ignore-regexp)) (forward-line 1) @@ -8804,8 +8563,7 @@ Typing \\[verilog-auto] will make this into: (verilog-insert-definition sig-list "output" indent-pt v2k) (verilog-modi-cache-add-outputs modi sig-list) (verilog-insert-indent "// End of automatics\n")) - (when v2k (verilog-repair-close-comma)) - ))) + (when v2k (verilog-repair-close-comma))))) (defun verilog-auto-output-every () "Expand AUTOOUTPUTEVERY statements, as part of \\[verilog-auto]. @@ -8847,8 +8605,7 @@ Typing \\[verilog-auto] will make this into: (sig-list (verilog-signals-combine-bus (verilog-signals-not-in (verilog-modi-get-signals modi) - (verilog-modi-get-ports modi) - )))) + (verilog-modi-get-ports modi))))) (forward-line 1) (when v2k (verilog-repair-open-comma)) (when sig-list @@ -8856,8 +8613,7 @@ Typing \\[verilog-auto] will make this into: (verilog-insert-definition sig-list "output" indent-pt v2k) (verilog-modi-cache-add-outputs modi sig-list) (verilog-insert-indent "// End of automatics\n")) - (when v2k (verilog-repair-close-comma)) - ))) + (when v2k (verilog-repair-close-comma))))) (defun verilog-auto-input () "Expand AUTOINPUT statements, as part of \\[verilog-auto]. @@ -8913,8 +8669,7 @@ Typing \\[verilog-auto] will make this into: (verilog-modi-get-consts modi) (verilog-modi-get-gparams modi) (verilog-modi-get-sub-outputs modi) - (verilog-modi-get-sub-inouts modi) - )))) + (verilog-modi-get-sub-inouts modi))))) (setq sig-list (verilog-signals-not-matching-regexp sig-list verilog-auto-input-ignore-regexp)) (forward-line 1) @@ -8924,8 +8679,7 @@ Typing \\[verilog-auto] will make this into: (verilog-insert-definition sig-list "input" indent-pt v2k) (verilog-modi-cache-add-inputs modi sig-list) (verilog-insert-indent "// End of automatics\n")) - (when v2k (verilog-repair-close-comma)) - ))) + (when v2k (verilog-repair-close-comma))))) (defun verilog-auto-inout () "Expand AUTOINOUT statements, as part of \\[verilog-auto]. @@ -8978,8 +8732,7 @@ Typing \\[verilog-auto] will make this into: (verilog-modi-get-inouts modi) (verilog-modi-get-inputs modi) (verilog-modi-get-sub-inputs modi) - (verilog-modi-get-sub-outputs modi) - )))) + (verilog-modi-get-sub-outputs modi))))) (setq sig-list (verilog-signals-not-matching-regexp sig-list verilog-auto-inout-ignore-regexp)) (forward-line 1) @@ -8989,8 +8742,7 @@ Typing \\[verilog-auto] will make this into: (verilog-insert-definition sig-list "inout" indent-pt v2k) (verilog-modi-cache-add-inouts modi sig-list) (verilog-insert-indent "// End of automatics\n")) - (when v2k (verilog-repair-close-comma)) - ))) + (when v2k (verilog-repair-close-comma))))) (defun verilog-auto-inout-module () "Expand AUTOINOUTMODULE statements, as part of \\[verilog-auto]. @@ -9062,8 +8814,7 @@ Typing \\[verilog-auto] will make this into: (verilog-modi-cache-add-outputs modi sig-list-o) (verilog-modi-cache-add-inouts modi sig-list-io) (verilog-insert-indent "// End of automatics\n")) - (when v2k (verilog-repair-close-comma)) - ))))) + (when v2k (verilog-repair-close-comma))))))) (defun verilog-auto-sense-sigs (modi presense-sigs) "Return list of signals for current AUTOSENSE block." @@ -9164,8 +8915,7 @@ Typing \\[verilog-auto] will make this into: (not-first (insert " or "))) (insert (verilog-sig-name (car sig-list))) (setq sig-list (cdr sig-list) - not-first t)) - ))) + not-first t))))) (defun verilog-auto-reset () "Expand AUTORESET statements, as part of \\[verilog-auto]. @@ -9260,8 +9010,7 @@ Typing \\[verilog-auto] will make this into: ";\n") (indent-to indent-pt) (setq sig-list (cdr sig-list)))) - (insert "// End of automatics")) - ))) + (insert "// End of automatics"))))) (defun verilog-auto-tieoff () "Expand AUTOTIEOFF statements, as part of \\[verilog-auto]. @@ -9316,8 +9065,7 @@ Typing \\[verilog-auto] will make this into: (verilog-modi-get-consts modi) (verilog-modi-get-gparams modi) (verilog-modi-get-sub-outputs modi) - (verilog-modi-get-sub-inouts modi) - )))) + (verilog-modi-get-sub-inouts modi))))) (when sig-list (forward-line 1) (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: (insert "= " (verilog-sig-tieoff sig) ";\n") (setq sig-list (cdr sig-list)))) - (verilog-insert-indent "// End of automatics\n") - )))) + (verilog-insert-indent "// End of automatics\n"))))) (defun verilog-auto-unused () "Expand AUTOUNUSED statements, as part of \\[verilog-auto]. @@ -9395,8 +9142,7 @@ Typing \\[verilog-auto] will make this into: (append (verilog-modi-get-inputs modi) (verilog-modi-get-inouts modi)) (append (verilog-modi-get-sub-inputs modi) - (verilog-modi-get-sub-inouts modi) - )))) + (verilog-modi-get-sub-inouts modi))))) (setq sig-list (verilog-signals-not-matching-regexp sig-list verilog-auto-unused-ignore-regexp)) (when sig-list @@ -9408,8 +9154,7 @@ Typing \\[verilog-auto] will make this into: (indent-to indent-pt) (insert (verilog-sig-name sig) ",\n") (setq sig-list (cdr sig-list)))) - (verilog-insert-indent "// End of automatics\n") - )))) + (verilog-insert-indent "// End of automatics\n"))))) (defun verilog-enum-ascii (signm elim-regexp) "Convert a enum name SIGNM to a ascii string for insertion. @@ -9543,8 +9288,7 @@ Typing \\[verilog-auto] will make this into: (verilog-insert-indent "endcase\n") (setq indent-pt (- indent-pt verilog-indent-level)) (verilog-insert-indent "end\n" - "// End of automatics\n") - ))) + "// End of automatics\n")))) (defun verilog-auto-templated-rel () "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." ;; Must be after all inputs outputs are generated (verilog-auto-search-do "/*AUTOARG*/" 'verilog-auto-arg) ;; Fix line numbers (comments only) - (verilog-auto-templated-rel) - ) + (verilog-auto-templated-rel)) ;; (run-hooks 'verilog-auto-hook) ;; @@ -9709,14 +9452,13 @@ Wilson Snyder (wsnyder@wsnyder.org), and/or see http://www.veripool.com." ;; Unwind forms (progn ;; Restore font-lock - (when fontlocked (font-lock-mode t))) - ))) + (when fontlocked (font-lock-mode t)))))) ;; ;; Skeleton based code insertion ;; -(defvar verilog-template-map +(defvar verilog-template-map (let ((map (make-sparse-keymap))) (define-key map "a" 'verilog-sk-always) (define-key map "b" 'verilog-sk-begin) @@ -9985,16 +9727,14 @@ and the case items." (defun verilog-sk-define-signal () "Insert a definition of signal under point at top of module." (interactive "*") - (let* ( - (sig-re "[a-zA-Z0-9_]*") + (let* ((sig-re "[a-zA-Z0-9_]*") (v1 (buffer-substring (save-excursion (skip-chars-backward sig-re) (point)) (save-excursion (skip-chars-forward sig-re) - (point)))) - ) + (point))))) (if (not (member v1 verilog-keywords)) (save-excursion (setq verilog-sk-signal v1) @@ -10003,10 +9743,7 @@ and the case items." (verilog-forward-syntactic-ws) (verilog-sk-def-reg) (message "signal at point is %s" v1)) - (message "object at point (%s) is a keyword" v1)) - ) - ) - + (message "object at point (%s) is a keyword" v1)))) (define-skeleton verilog-sk-wire "Insert a wire definition." @@ -10109,7 +9846,7 @@ and the case items." "^`include\\s-+\"\\([^\n\"]*\\)\"" "Regexp that matches the include file.") -(defvar verilog-mode-mouse-map +(defvar verilog-mode-mouse-map (let ((map (make-sparse-keymap))) ; as described in info pages, make a map (set-keymap-parent map verilog-mode-map) ;; mouse button bindings @@ -10189,8 +9926,7 @@ Files are checked based on `verilog-library-directories'." (progn (message "File '%s' isn't readable, use shift-mouse2 to paste in this field" - (match-string 1)))) - ))) + (match-string 1))))))) ;; ffap isn't useable for verilog mode. It uses library paths. ;; 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'." (file-readable-p (car (verilog-library-filenames (match-string 1) (buffer-file-name))))) (find-file (car (verilog-library-filenames - (match-string 1) (buffer-file-name)))))) - )) + (match-string 1) (buffer-file-name)))))))) ;; @@ -10230,6 +9965,7 @@ Files are checked based on `verilog-library-directories'." (princ "\n"))) (autoload 'reporter-submit-bug-report "reporter") +(defvar reporter-prompt-for-summary-p) (defun verilog-submit-bug-report () "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.") (defun vhdl-keep-region-active () "Do whatever is necessary to keep the region active in XEmacs. Ignore byte-compiler warnings you might see." - (and (boundp 'zmacs-region-stays) + (and (featurep 'xemacs) (setq zmacs-region-stays t))) ;; `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 (defvar repeat-previous-repeated-command nil "The previous repeated command.") +;; The following variable counts repeated self-insertions. The idea is +;; that repeating a self-insertion command and subsequently undoing it +;; should have almost the same effect as if the characters were inserted +;; manually. The basic difference is that we leave in one undo-boundary +;; between the original insertion and its first repetition. +(defvar repeat-undo-count nil + "Number of self-insertions since last `undo-boundary'.") + ;;;###autoload (defun repeat (repeat-arg) "Repeat most recently executed command. @@ -246,12 +254,6 @@ recently executed command not bound to an input event\"." ;; needs to be saved. (let ((repeat-repeat-char (if (eq repeat-on-final-keystroke t) - ;; The following commented out since it's equivalent to - ;; last-comment-char (martin 2007-08-29). -;;; ;; allow any final input event that was a character -;;; (when (eq last-command-char -;;; last-command-event) -;;; last-command-char) last-command-char ;; allow only specified final keystrokes (car (memq last-command-char @@ -293,11 +295,22 @@ recently executed command not bound to an input event\"." (i 0)) ;; Run pre- and post-command hooks for self-insertion too. (run-hooks 'pre-command-hook) + (cond + ((not repeat-undo-count)) + ((< repeat-undo-count 20) + ;; Don't make an undo-boundary here. + (setq repeat-undo-count (1+ repeat-undo-count))) + (t + ;; Make an undo-boundary after 20 repetitions only. + (undo-boundary) + (setq repeat-undo-count 1))) (while (< i count) (repeat-self-insert insertion) (setq i (1+ i))) (run-hooks 'post-command-hook))) (let ((indirect (indirect-function last-repeatable-command))) + ;; Make each repetition undo separately. + (undo-boundary) (if (or (stringp indirect) (vectorp indirect)) ;; Bind real-last-command so that executing the macro does @@ -314,12 +327,20 @@ recently executed command not bound to an input event\"." ;; (only 32 repetitions are possible given the default value of 200 for ;; max-lisp-eval-depth), but if I now locally disable the repeat char I ;; can iterate indefinitely here around a single level of recursion. - (let (repeat-on-final-keystroke) + (let (repeat-on-final-keystroke + ;; Bind `undo-inhibit-record-point' to t in order to avoid + ;; recording point in `buffer-undo-list' here. We have to + ;; do this since the command loop does not set the last + ;; position of point thus confusing the point recording + ;; mechanism when inserting or deleting text. + (undo-inhibit-record-point t)) (setq real-last-command 'repeat) - (while (eq (read-event) repeat-repeat-char) - ;; Make each repetition undo separately. - (undo-boundary) - (repeat repeat-arg)) + (setq repeat-undo-count 1) + (unwind-protect + (while (eq (read-event) repeat-repeat-char) + (repeat repeat-arg)) + ;; Make sure `repeat-undo-count' is reset. + (setq repeat-undo-count nil)) (setq unread-command-events (list last-input-event)))))) (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'.") :type 'hook :group 'matching) +(defcustom occur-mode-find-occurrence-hook nil + "Hook run by Occur after locating an occurrence. +This will be called with the cursor position at the occurrence. An application +for this is to reveal context in an outline-mode when the occurrence is hidden." + :type 'hook + :group 'matching) + (put 'occur-mode 'mode-class 'special) (defun occur-mode () "Major mode for output from \\[occur]. @@ -837,14 +844,16 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. same-window-buffer-names same-window-regexps) (pop-to-buffer (marker-buffer pos)) - (goto-char pos))) + (goto-char pos) + (run-hooks 'occur-mode-find-occurrence-hook))) (defun occur-mode-goto-occurrence-other-window () "Go to the occurrence the current line describes, in another window." (interactive) (let ((pos (occur-mode-find-occurrence))) (switch-to-buffer-other-window (marker-buffer pos)) - (goto-char pos))) + (goto-char pos) + (run-hooks 'occur-mode-find-occurrence-hook))) (defun occur-mode-display-occurrence () "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. ;; This is the way to set point in the proper window. (save-selected-window (select-window window) - (goto-char pos)))) + (goto-char pos) + (run-hooks 'occur-mode-find-occurrence-hook)))) (defun occur-find-match (n search message) (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 (server-log "Deleted" proc)))) +(defvar server-log-time-function 'current-time-string + "Function to generate timestamps for `server-buffer'.") + +(defconst server-buffer " *server*" + "Buffer used internally by Emacs's server. +One use is to log the I/O for debugging purposes (see `server-log'), +the other is to provide a current buffer in which the process filter can +safely let-bind buffer-local variables like `default-directory'.") + +(defvar server-log nil + "If non-nil, log the server's inputs and outputs in the `server-buffer'.") + (defun server-log (string &optional client) - "If a *server* buffer exists, write STRING to it for logging purposes. + "If `server-log' is non-nil, log STRING to `server-buffer'. If CLIENT is non-nil, add a description of it to the logged message." - (when (get-buffer "*server*") - (with-current-buffer "*server*" + (when server-log + (with-current-buffer (get-buffer-create server-buffer) (goto-char (point-max)) - (insert (current-time-string) + (insert (funcall server-log-time-function) (cond - ((null client) " ") - ((listp client) (format " %s: " (car client))) - (t (format " %s: " client))) + ((null client) " ") + ((listp client) (format " %s: " (car client))) + (t (format " %s: " client))) string) (or (bolp) (newline))))) @@ -494,7 +506,7 @@ kill any existing server communications subprocess." ;; Those are decoded by server-process-filter according ;; to file-name-coding-system. :coding 'raw-text - ;; The rest of the args depends on the kind of socket used. + ;; The other args depend on the kind of socket used. (if server-use-tcp (list :family nil :service t @@ -764,7 +776,7 @@ The following commands are accepted by the client: (server-log (concat "Received " string) proc) ;; First things first: let's check the authentication (unless (process-get proc :authenticated) - (if (and (string-match "-auth \\(.*?\\)\n" string) + (if (and (string-match "-auth \\([!-~]+\\)\n?" string) (equal (match-string 1 string) (process-get proc :auth-key))) (progn (setq string (substring string (match-end 0))) @@ -805,8 +817,7 @@ The following commands are accepted by the client: (tty-name nil) ;nil, `window-system', or the tty name. tty-type ;string. (files nil) - (lineno 1) - (columnno 0) + (filepos nil) command-line-args-left arg) ;; Remove this line from STRING. @@ -876,9 +887,9 @@ The following commands are accepted by the client: (string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?" (car command-line-args-left))) (setq arg (pop command-line-args-left)) - (setq lineno (string-to-number (match-string 1 arg)) - columnno (if (null (match-end 2)) 0 - (string-to-number (match-string 2 arg))))) + (setq filepos + (cons (string-to-number (match-string 1 arg)) + (string-to-number (or (match-string 2 arg) ""))))) ;; -file FILENAME: Load the given file. ((and (equal "-file" arg) @@ -887,11 +898,10 @@ The following commands are accepted by the client: (if coding-system (setq file (decode-coding-string file coding-system))) (setq file (command-line-normalize-file-name file)) - (push (list file lineno columnno) files) - (server-log (format "New file: %s (%d:%d)" - file lineno columnno) proc)) - (setq lineno 1 - columnno 0)) + (push (cons file filepos) files) + (server-log (format "New file: %s %s" + file (or filepos "")) proc)) + (setq filepos nil)) ;; -eval EXPR: Evaluate a Lisp expression. ((and (equal "-eval" arg) @@ -901,8 +911,7 @@ The following commands are accepted by the client: (setq expr (decode-coding-string expr coding-system))) (push (lambda () (server-eval-and-print expr proc)) commands) - (setq lineno 1 - columnno 0))) + (setq filepos nil))) ;; -env NAME=VALUE: An environment variable. ((and (equal "-env" arg) command-line-args-left) @@ -928,17 +937,25 @@ The following commands are accepted by the client: (server-create-window-system-frame display nowait proc)) (t (server-create-tty-frame tty-name tty-type proc)))) - (process-put proc 'continuation - (lexical-let ((proc proc) - (files files) - (nowait nowait) - (commands commands) - (dontkill dontkill) - (frame frame) - (tty-name tty-name)) - (lambda () - (server-execute proc files nowait commands - dontkill frame tty-name)))) + (process-put + proc 'continuation + (lexical-let ((proc proc) + (files files) + (nowait nowait) + (commands commands) + (dontkill dontkill) + (frame frame) + (dir dir) + (tty-name tty-name)) + (lambda () + (with-current-buffer (get-buffer-create server-buffer) + ;; Use the same cwd as the emacsclient, if possible, so + ;; relative file names work correctly, even in `eval'. + (let ((default-directory + (if (and dir (file-directory-p dir)) + dir default-directory))) + (server-execute proc files nowait commands + dontkill frame tty-name)))))) (when (or frame files) (server-goto-toplevel proc)) @@ -991,18 +1008,19 @@ The following commands are accepted by the client: (server-log (error-message-string err) proc) (delete-process proc))) -(defun server-goto-line-column (file-line-col) - "Move point to the position indicated in FILE-LINE-COL. -FILE-LINE-COL should be a three-element list as described in -`server-visit-files'." - (goto-line (nth 1 file-line-col)) - (let ((column-number (nth 2 file-line-col))) - (when (> column-number 0) - (move-to-column (1- column-number))))) +(defun server-goto-line-column (line-col) + "Move point to the position indicated in LINE-COL. +LINE-COL should be a pair (LINE . COL)." + (when line-col + (goto-line (car line-col)) + (let ((column-number (cdr line-col))) + (when (> column-number 0) + (move-to-column (1- column-number)))))) (defun server-visit-files (files proc &optional nowait) "Find FILES and return a list of buffers created. -FILES is an alist whose elements are (FILENAME LINENUMBER COLUMNNUMBER). +FILES is an alist whose elements are (FILENAME . FILEPOS) +where FILEPOS can be nil or a pair (LINENUMBER . COLUMNNUMBER). PROC is the client that requested this operation. NOWAIT non-nil means this client is not waiting for the results, 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." (filen (car file)) (obuf (get-file-buffer filen))) (add-to-history 'file-name-history filen) - (if (and obuf (set-buffer obuf)) - (progn - (cond ((file-exists-p filen) - (when (not (verify-visited-file-modtime obuf)) - (revert-buffer t nil))) - (t - (when (y-or-n-p - (concat "File no longer exists: " filen - ", write buffer to file? ")) - (write-file filen)))) - (unless server-buffer-clients - (setq server-existing-buffer t)) - (server-goto-line-column file)) - (set-buffer (find-file-noselect filen)) - (server-goto-line-column file) - (run-hooks 'server-visit-hook))) + (if (null obuf) + (set-buffer (find-file-noselect filen)) + (set-buffer obuf) + (cond ((file-exists-p filen) + (when (not (verify-visited-file-modtime obuf)) + (revert-buffer t nil))) + (t + (when (y-or-n-p + (concat "File no longer exists: " filen + ", write buffer to file? ")) + (write-file filen)))) + (unless server-buffer-clients + (setq server-existing-buffer t))) + (server-goto-line-column (cdr file)) + (run-hooks 'server-visit-hook)) (unless nowait ;; When the buffer is killed, inform the clients. (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." (remove-overlays (match-beginning 0) (match-end 0) 'smerge 'refine) (smerge-ensure-match 1) (smerge-ensure-match 3) - (smerge-refine-subst (match-beginning 1) (match-end 1) - (match-beginning 3) (match-end 3) - '((smerge . refine) - (face . smerge-refined-change)))) + ;; Match 1 and 3 may be one and the same in case of trivial diff3 -A conflict. + (let ((n1 (if (eq (match-end 1) (match-end 3)) 2 1))) + (smerge-refine-subst (match-beginning n1) (match-end n1) + (match-beginning 3) (match-end 3) + '((smerge . refine) + (face . smerge-refined-change))))) (defun smerge-diff (n1 n2) (smerge-match-conflict) @@ -992,6 +994,32 @@ buffer names." (message "Conflict resolution finished; you may save the buffer"))))) (message "Please resolve conflicts now; exit ediff when done"))) +(defun smerge-makeup-conflict (pt1 pt2 pt3 &optional pt4) + "Insert diff3 markers to make a new conflict. +Uses point and mark for 2 of the relevant positions and previous marks +for the other ones. +By default, makes up a 2-way conflict, +with a \\[universal-argument] prefix, makes up a 3-way conflict." + (interactive + (list (point) + (mark) + (progn (pop-mark) (mark)) + (when current-prefix-arg (pop-mark) (mark)))) + ;; Start from the end so as to avoid problems with pos-changes. + (destructuring-bind (pt1 pt2 pt3 &optional pt4) + (sort (list* pt1 pt2 pt3 (if pt4 (list pt4))) '>=) + (goto-char pt1) (beginning-of-line) + (insert ">>>>>>> OTHER\n") + (goto-char pt2) (beginning-of-line) + (insert "=======\n") + (goto-char pt3) (beginning-of-line) + (when pt4 + (insert "||||||| BASE\n") + (goto-char pt4) (beginning-of-line)) + (insert "<<<<<<< MINE\n")) + (if smerge-mode nil (smerge-mode 1)) + (smerge-refine)) + (defconst smerge-parsep-re (concat smerge-begin-re "\\|" smerge-end-re "\\|" @@ -1021,6 +1049,14 @@ buffer names." (unless smerge-mode (smerge-remove-props (point-min) (point-max)))) +;;;###autoload +(defun smerge-start-session () + "Turn on `smerge-mode' and move point to first conflict marker. +If no conflict maker is found, turn off `smerge-mode'." + (smerge-mode 1) + (condition-case nil + (smerge-next) + (error (smerge-auto-leave)))) (provide 'smerge-mode) 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." (append hook-value (list function)) (cons function hook-value)))) ;; Set the actual variable - (if local (set hook hook-value) (set-default hook hook-value)))) + (if local + (progn + ;; If HOOK isn't a permanent local, + ;; but FUNCTION wants to survive a change of modes, + ;; mark HOOK as partially permanent. + (and (symbolp function) + (get function 'permanent-local-hook) + (not (get hook 'permanent-local)) + (put hook 'permanent-local 'permanent-local-hook)) + (set hook hook-value)) + (set-default hook hook-value)))) (defun remove-hook (hook function &optional local) "Remove from the value of HOOK the function FUNCTION. @@ -1860,6 +1870,10 @@ user can undo the change normally." (let ((handle (make-symbol "--change-group-handle--")) (success (make-symbol "--change-group-success--"))) `(let ((,handle (prepare-change-group)) + ;; Don't truncate any undo data in the middle of this. + (undo-outer-limit nil) + (undo-limit most-positive-fixnum) + (undo-strong-limit most-positive-fixnum) (,success nil)) (unwind-protect (progn @@ -2113,26 +2127,29 @@ Note that this should end with a directory separator.") (defun find-tag-default () "Determine default tag to search for, based on text at point. If there is no plausible default, return nil." - (save-excursion - (while (looking-at "\\sw\\|\\s_") - (forward-char 1)) - (if (or (re-search-backward "\\sw\\|\\s_" - (save-excursion (beginning-of-line) (point)) - t) - (re-search-forward "\\(\\sw\\|\\s_\\)+" - (save-excursion (end-of-line) (point)) - t)) - (progn - (goto-char (match-end 0)) - (condition-case nil - (buffer-substring-no-properties - (point) - (progn (forward-sexp -1) - (while (looking-at "\\s'") - (forward-char 1)) - (point))) - (error nil))) - nil))) + (let (from to bound) + (when (or (progn + ;; Look at text around `point'. + (save-excursion + (skip-syntax-backward "w_") (setq from (point))) + (save-excursion + (skip-syntax-forward "w_") (setq to (point))) + (> to from)) + ;; Look between `line-beginning-position' and `point'. + (save-excursion + (and (setq bound (line-beginning-position)) + (skip-syntax-backward "^w_" bound) + (> (setq to (point)) bound) + (skip-syntax-backward "w_") + (setq from (point)))) + ;; Look between `point' and `line-end-position'. + (save-excursion + (and (setq bound (line-end-position)) + (skip-syntax-forward "^w_" bound) + (< (setq from (point)) bound) + (skip-syntax-forward "w_") + (setq to (point))))) + (buffer-substring-no-properties from to)))) (defun play-sound (sound) "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 @@ ;; Maintainer: FSF ;; Keywords: mouse gpm linux -;; Copyright (C) 1994, 1995, 1998, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1998, 2006, 2007, 2008 +;; Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -39,6 +40,9 @@ ;;; Code: +;; Prevent warning when compiling in an Emacs without gpm support. +(declare-function gpm-mouse-start "term.c" ()) + ;;;###autoload (define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1") ;;;###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." (narrow-to-region (point-min) tar-header-offset) (goto-char pos))) (if view-p - (view-buffer buffer (and just-created 'kill-buffer)) + (view-buffer + buffer (and just-created 'kill-buffer-if-not-modified)) (if (eq other-window-p 'display) (display-buffer buffer) (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 @@ ;;; w32console.el -- Setup w32 console keys and colors. -;; Copyright (C) 2007 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. ;; Author: FSF ;; 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 realign Realign entries, so that field texts and perhaps equal signs (depending on the value of `bibtex-align-at-equal-sign') begin in the same column. + Also fill fields. last-comma Add or delete comma on end of last field in entry, according to value of `bibtex-comma-after-last-field'. delimiters Change delimiters according to variables @@ -1085,6 +1086,7 @@ Used by `bibtex-find-crossref' and for font-locking." "--" ["Convert Alien Buffer" bibtex-convert-alien t]) ("Operating on Multiple Buffers" + ["(Re)Initialize BibTeX Buffers" bibtex-initialize t] ["Validate Entries" bibtex-validate-globally t]))) (easy-menu-define @@ -1782,7 +1784,7 @@ If FLAG is nil, a message is echoed if point was incremented at least ")")) (defun bibtex-flash-head (prompt) - "Flash at BibTeX entry head before point, if exists." + "Flash at BibTeX entry head before point, if it exists." (let ((case-fold-search t) (pnt (point))) (save-excursion @@ -1790,7 +1792,8 @@ If FLAG is nil, a message is echoed if point was incremented at least (when (and (looking-at bibtex-any-entry-maybe-empty-head) (< (point) pnt)) (goto-char (match-beginning bibtex-type-in-head)) - (if (pos-visible-in-window-p (point)) + (if (and (< 0 blink-matching-delay) + (pos-visible-in-window-p (point))) (sit-for blink-matching-delay) (message "%s%s" prompt (buffer-substring-no-properties (point) (match-end bibtex-key-in-head)))))))) @@ -1875,38 +1878,42 @@ Optional arg COMMA is as in `bibtex-enclosing-field'." (defun bibtex-format-entry () "Helper function for `bibtex-clean-entry'. Formats current entry according to variable `bibtex-entry-format'." + ;; initialize `bibtex-field-braces-opt' if necessary + (if (and bibtex-field-braces-alist (not bibtex-field-braces-opt)) + (setq bibtex-field-braces-opt + (bibtex-field-re-init bibtex-field-braces-alist 'braces))) + ;; initialize `bibtex-field-strings-opt' if necessary + (if (and bibtex-field-strings-alist (not bibtex-field-strings-opt)) + (setq bibtex-field-strings-opt + (bibtex-field-re-init bibtex-field-strings-alist 'strings))) + (save-excursion (save-restriction (bibtex-narrow-to-entry) (let ((case-fold-search t) (format (if (eq bibtex-entry-format t) - '(realign opts-or-alts required-fields - numerical-fields - last-comma page-dashes delimiters - unify-case inherit-booktitle) + '(realign opts-or-alts required-fields numerical-fields + page-dashes whitespace inherit-booktitle + last-comma delimiters unify-case braces + strings) bibtex-entry-format)) - crossref-key bounds alternatives-there non-empty-alternative - entry-list req-field-list field-list) - - ;; Initialize `bibtex-field-braces-opt' and `bibtex-field-strings-opt' - ;; if necessary. - (unless bibtex-field-braces-opt - (setq bibtex-field-braces-opt - (bibtex-field-re-init bibtex-field-braces-alist 'braces))) - (unless bibtex-field-strings-opt - (setq bibtex-field-strings-opt - (bibtex-field-re-init bibtex-field-strings-alist 'strings))) + bounds crossref-key req-field-list default-field-list field-list) + + ;; There are more elegant high-level functions for several tasks + ;; done by `bibtex-format-entry'. However, they contain some + ;; redundancy compared with what we need to do anyway. + ;; So for speed-up we avoid using them. + ;; (`bibtex-format-entry' is called many times by `bibtex-reformat'.) ;; identify entry type (goto-char (point-min)) (or (re-search-forward bibtex-entry-type nil t) (error "Not inside a BibTeX entry")) - (let ((beg-type (1+ (match-beginning 0))) - (end-type (match-end 0))) - (setq entry-list (assoc-string (buffer-substring-no-properties + (let* ((beg-type (1+ (match-beginning 0))) + (end-type (match-end 0)) + (entry-list (assoc-string (buffer-substring-no-properties beg-type end-type) - bibtex-entry-field-alist - t)) + bibtex-entry-field-alist t))) ;; unify case of entry name (when (memq 'unify-case format) @@ -1918,35 +1925,24 @@ Formats current entry according to variable `bibtex-entry-format'." (goto-char end-type) (skip-chars-forward " \t\n") (delete-char 1) - (insert (bibtex-entry-left-delimiter)))) + (insert (bibtex-entry-left-delimiter))) - ;; determine if entry has crossref field and if at least - ;; one alternative is non-empty - (goto-char (point-min)) - (let* ((fields-alist (bibtex-parse-entry t)) - (field (assoc-string "crossref" fields-alist t))) - (setq crossref-key (and field - (not (equal "" (cdr field))) - (cdr field)) - req-field-list (if crossref-key - (nth 0 (nth 2 entry-list)) ; crossref part - (nth 0 (nth 1 entry-list)))) ; required part - - (dolist (rfield req-field-list) - (when (nth 3 rfield) ; we should have an alternative - (setq alternatives-there t - field (assoc-string (car rfield) fields-alist t)) - (if (and field - (not (equal "" (cdr field)))) - (cond ((not non-empty-alternative) - (setq non-empty-alternative t)) - ((memq 'required-fields format) - (error "More than one non-empty alternative"))))))) - - (if (and alternatives-there - (not non-empty-alternative) - (memq 'required-fields format)) - (error "All alternatives are empty")) + ;; Do we have a crossref key? + (goto-char (point-min)) + (if (setq bounds (bibtex-search-forward-field "crossref")) + (let ((text (bibtex-text-in-field-bounds bounds t))) + (unless (equal "" text) + (setq crossref-key text)))) + + ;; list of required fields appropriate for an entry with + ;; or without crossref key. + (setq req-field-list (if (and crossref-key (nth 2 entry-list)) + (car (nth 2 entry-list)) + (car (nth 1 entry-list))) + ;; default list of fields that may appear in this entry + default-field-list (append (nth 0 (nth 1 entry-list)) + (nth 1 (nth 1 entry-list)) + bibtex-user-optional-fields))) ;; process all fields (bibtex-beginning-first-field (point-min)) @@ -1965,25 +1961,18 @@ Formats current entry according to variable `bibtex-entry-format'." (empty-field (equal "" (bibtex-text-in-field-bounds bounds t))) deleted) - ;; We have more elegant high-level functions for several - ;; tasks done by `bibtex-format-entry'. However, they contain - ;; quite some redundancy compared with what we need to do - ;; anyway. So for speed-up we avoid using them. - (if (memq 'opts-or-alts format) + ;; delete empty optional and alternative fields + ;; (but keep empty required fields) (cond ((and empty-field (or opt-alt (let ((field (assoc-string field-name req-field-list t))) (or (not field) ; OPT field (nth 3 field))))) ; ALT field - ;; Either it is an empty ALT field. Then we have checked - ;; already that we have one non-empty alternative. Or it - ;; is an empty OPT field that we do not miss anyway. - ;; So we can safely delete this field. (delete-region beg-field end-field) (setq deleted t)) - ;; otherwise: not empty, delete "OPT" or "ALT" + ;; otherwise nonempty field: delete "OPT" or "ALT" (opt-alt (goto-char beg-name) (delete-char 3)))) @@ -2087,16 +2076,7 @@ Formats current entry according to variable `bibtex-entry-format'." (goto-char (1+ beg-text)) (insert title)))) - ;; Use booktitle to set a missing title. - (if (and empty-field - (bibtex-string= field-name "title")) - (let ((booktitle (bibtex-text-in-field "booktitle"))) - (when booktitle - (setq empty-field nil) - (goto-char (1+ beg-text)) - (insert booktitle)))) - - ;; if empty field, complain + ;; if empty field is a required field, complain (if (and empty-field (memq 'required-fields format) (assoc-string field-name req-field-list t)) @@ -2104,12 +2084,8 @@ Formats current entry according to variable `bibtex-entry-format'." ;; unify case of field name (if (memq 'unify-case format) - (let ((fname (car (assoc-string - field-name - (append (nth 0 (nth 1 entry-list)) - (nth 1 (nth 1 entry-list)) - bibtex-user-optional-fields) - t)))) + (let ((fname (car (assoc-string field-name + default-field-list t)))) (if fname (progn (delete-region beg-name end-name) @@ -2123,23 +2099,21 @@ Formats current entry according to variable `bibtex-entry-format'." ;; check whether all required fields are present (if (memq 'required-fields format) - (let ((found 0) altlist) + (let ((found 0) alt-list) (dolist (fname req-field-list) - (if (nth 3 fname) - (push (car fname) altlist)) - (unless (or (member (car fname) field-list) - (nth 3 fname)) - (error "Mandatory field `%s' is missing" (car fname)))) - (when altlist - (dolist (fname altlist) - (if (member fname field-list) - (setq found (1+ found)))) - (cond ((= found 0) - (error "Alternative mandatory field `%s' is missing" - altlist)) - ((> found 1) - (error "Alternative fields `%s' are defined %s times" - altlist found)))))) + (cond ((nth 3 fname) ; t if field has alternative flag + (push (car fname) alt-list) + (if (member-ignore-case (car fname) field-list) + (setq found (1+ found)))) + ((not (member-ignore-case (car fname) field-list)) + (error "Mandatory field `%s' is missing" (car fname))))) + (if alt-list + (cond ((= found 0) + (error "Alternative mandatory field `%s' is missing" + alt-list)) + ((> found 1) + (error "Alternative fields `%s' are defined %s times" + alt-list found)))))) ;; update comma after last field (if (memq 'last-comma format) @@ -2158,7 +2132,7 @@ Formats current entry according to variable `bibtex-entry-format'." (delete-char 1) (insert (bibtex-entry-right-delimiter))) - ;; fill entry + ;; realign and fill entry (if (memq 'realign format) (bibtex-fill-entry)))))) @@ -2426,7 +2400,7 @@ Concatenate the key: (apply 'append (mapcar (lambda (buf) (with-current-buffer buf bibtex-reference-keys)) - (bibtex-files-expand t))) + (bibtex-initialize t))) bibtex-reference-keys)) (defun bibtex-read-key (prompt &optional key global) @@ -2606,14 +2580,22 @@ Parsing initializes `bibtex-reference-keys' and `bibtex-strings'." (setq bibtex-buffer-last-parsed-tick (buffer-modified-tick))))) (setq buffers (cdr buffers)))))) -(defun bibtex-files-expand (&optional current force) - "Return an expanded list of BibTeX buffers based on `bibtex-files'. +;;;###autoload +(defun bibtex-initialize (&optional current force select) + "(Re)Initialize BibTeX buffers. +Visit the BibTeX files defined by `bibtex-files' and return a list +of corresponding buffers. Initialize in these buffers `bibtex-reference-keys' if not yet set. List of BibTeX buffers includes current buffer if CURRENT is non-nil. If FORCE is non-nil, (re)initialize `bibtex-reference-keys' even if -already set." +already set. If SELECT is non-nil interactively select a BibTeX buffer. +When called interactively, FORCE is t, CURRENT is t if current buffer uses +`bibtex-mode', and SELECT is t if current buffer does not use `bibtex-mode'," + (interactive (list (eq major-mode 'bibtex-mode) t + (not (eq major-mode 'bibtex-mode)))) (let ((file-path (split-string (or bibtex-file-path default-directory) ":+")) file-list dir-list buffer-list) + ;; generate list of BibTeX files (dolist (file bibtex-files) (cond ((eq file 'bibtex-file-path) (setq dir-list (append dir-list file-path))) @@ -2624,34 +2606,46 @@ already set." (file-name-absolute-p file)) (push file file-list)) (t - (let (fullfilename found) + (let (expanded-file-name found) (dolist (dir file-path) (when (file-readable-p - (setq fullfilename (expand-file-name file dir))) - (push fullfilename file-list) + (setq expanded-file-name (expand-file-name file dir))) + (push expanded-file-name file-list) (setq found t))) (unless found - (error "File %s not in paths defined via bibtex-file-path" + (error "File `%s' not in paths defined via bibtex-file-path" file)))))) (dolist (file file-list) (unless (file-readable-p file) - (error "BibTeX file %s not found" file))) + (error "BibTeX file `%s' not found" file))) ;; expand dir-list (dolist (dir dir-list) (setq file-list (append file-list (directory-files dir t "\\.bib\\'" t)))) (delete-dups file-list) + ;; visit files in FILE-LIST (dolist (file file-list) - (when (file-readable-p file) - (push (find-file-noselect file) buffer-list) - (with-current-buffer (car buffer-list) - (if (or force (not (listp bibtex-reference-keys))) - (bibtex-parse-keys))))) + (if (file-readable-p file) + (push (find-file-noselect file) buffer-list))) + ;; include current buffer iff we want it (cond ((and current (not (memq (current-buffer) buffer-list))) - (push (current-buffer) buffer-list) - (if force (bibtex-parse-keys))) + (push (current-buffer) buffer-list)) ((and (not current) (memq (current-buffer) buffer-list)) (setq buffer-list (delq (current-buffer) buffer-list)))) + ;; parse keys + (dolist (buffer buffer-list) + (with-current-buffer buffer + (if (or force (nlistp bibtex-reference-keys)) + (bibtex-parse-keys)))) + ;; select BibTeX buffer + (if select + (if buffer-list + (switch-to-buffer + (completing-read "Switch to BibTeX buffer: " + (mapcar 'buffer-name buffer-list) + nil t + (if current (buffer-name (current-buffer))))) + (message "No BibTeX buffers defined"))) buffer-list)) (defun bibtex-complete-internal (completions) @@ -3130,7 +3124,6 @@ field contents of the neighboring entry. Finally try to update the text based on the difference between the keys of the neighboring and the current entry (for example, the year parts of the keys)." (interactive) - (undo-boundary) ;So you can easily undo it, if it didn't work right. (bibtex-beginning-of-entry) (when (looking-at bibtex-entry-head) (let ((type (bibtex-type-in-head)) @@ -3413,13 +3406,18 @@ If its value is nil use plain sorting." (cond ((not index1) (not index2)) ; indices can be nil ((not index2) nil) ((eq bibtex-maintain-sorted-entries 'crossref) - (if (nth 1 index1) - (if (nth 1 index2) + ;; CROSSREF-KEY may be nil or it can point to an entry + ;; in another BibTeX file. In both cases we ignore CROSSREF-KEY. + (if (and (nth 1 index1) + (cdr (assoc-string (nth 1 index1) bibtex-reference-keys))) + (if (and (nth 1 index2) + (cdr (assoc-string (nth 1 index2) bibtex-reference-keys))) (or (string-lessp (nth 1 index1) (nth 1 index2)) (and (string-equal (nth 1 index1) (nth 1 index2)) (string-lessp (nth 0 index1) (nth 0 index2)))) (not (string-lessp (nth 0 index2) (nth 1 index1)))) - (if (nth 1 index2) + (if (and (nth 1 index2) + (cdr (assoc-string (nth 1 index2) bibtex-reference-keys))) (string-lessp (nth 0 index1) (nth 1 index2)) (string-lessp (nth 0 index1) (nth 0 index2))))) ((eq bibtex-maintain-sorted-entries 'entry-class) @@ -3444,6 +3442,9 @@ are ignored." (interactive) (bibtex-beginning-of-first-entry) ; Needed by `sort-subr' (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'. + (if (and (eq bibtex-maintain-sorted-entries 'crossref) + (nlistp bibtex-reference-keys)) + (bibtex-parse-keys)) ; Needed by `bibtex-lessp'. (sort-subr nil 'bibtex-skip-to-valid-entry ; NEXTREC function 'bibtex-end-of-entry ; ENDREC function @@ -3539,7 +3540,7 @@ Otherwise, use `set-buffer'. DISPLAY is t when called interactively." (interactive (list (bibtex-read-key "Find key: " nil current-prefix-arg) current-prefix-arg nil t)) (if (and global bibtex-files) - (let ((buffer-list (bibtex-files-expand t)) + (let ((buffer-list (bibtex-initialize t)) buffer found) (while (and (not found) (setq buffer (pop buffer-list))) @@ -3581,6 +3582,9 @@ search to look for place for KEY. This requires that buffer is sorted, see `bibtex-validate'. Return t if preparation was successful or nil if entry KEY already exists." (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'. + (if (and (eq bibtex-maintain-sorted-entries 'crossref) + (nlistp bibtex-reference-keys)) + (bibtex-parse-keys)) ; Needed by `bibtex-lessp'. (let ((key (nth 0 index)) key-exist) (cond ((or (null key) @@ -3671,6 +3675,9 @@ Return t if test was successful, nil otherwise." (setq syntax-error t) ;; Check for duplicate keys and correct sort order + (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'. + (bibtex-parse-keys) ; Possibly needed by `bibtex-lessp'. + ; Always needed by subsequent global key check. (let (previous current key-list) (bibtex-progress-message "Checking for duplicate keys") (bibtex-map-entries @@ -3692,9 +3699,12 @@ Return t if test was successful, nil otherwise." (bibtex-progress-message 'done)) ;; Check for duplicate keys in `bibtex-files'. - (bibtex-parse-keys) + ;; `bibtex-validate' only compares keys in current buffer with keys + ;; in `bibtex-files'. `bibtex-validate-globally' compares keys for + ;; each file in `bibtex-files' with keys of all other files in + ;; `bibtex-files'. ;; We don't want to be fooled by outdated `bibtex-reference-keys'. - (dolist (buffer (bibtex-files-expand nil t)) + (dolist (buffer (bibtex-initialize nil t)) (dolist (key (with-current-buffer buffer bibtex-reference-keys)) (when (and (cdr key) (cdr (assoc-string (car key) bibtex-reference-keys))) @@ -3792,7 +3802,7 @@ Return t if test was successful, nil otherwise." With optional prefix arg STRINGS, check for duplicate strings, too. Return t if test was successful, nil otherwise." (interactive "P") - (let ((buffer-list (bibtex-files-expand t)) + (let ((buffer-list (bibtex-initialize t)) buffer-key-list current-buf current-keys error-list) ;; Check for duplicate keys within BibTeX buffer (dolist (buffer buffer-list) @@ -4133,14 +4143,15 @@ At end of the cleaning process, the functions in (error "Not inside a BibTeX entry"))) (entry-type (bibtex-type-in-head)) (key (bibtex-key-in-head))) - ;; formatting - (cond ((bibtex-string= entry-type "preamble") - ;; (bibtex-format-preamble) - (error "No clean up of @Preamble entries")) - ((bibtex-string= entry-type "string") - (setq entry-type 'string)) - ;; (bibtex-format-string) - (t (bibtex-format-entry))) + ;; formatting (undone if error occurs) + (atomic-change-group + (cond ((bibtex-string= entry-type "preamble") + ;; (bibtex-format-preamble) + (error "No clean up of @Preamble entries")) + ((bibtex-string= entry-type "string") + (setq entry-type 'string)) + ;; (bibtex-format-string) + (t (bibtex-format-entry)))) ;; set key (when (or new-key (not key)) (setq key (bibtex-generate-autokey)) @@ -4184,7 +4195,7 @@ At end of the cleaning process, the functions in (bibtex-find-entry key nil end)))) (if error (error "New inserted entry yields duplicate key")) - (dolist (buffer (bibtex-files-expand)) + (dolist (buffer (bibtex-initialize)) (with-current-buffer buffer (if (cdr (assoc-string key bibtex-reference-keys)) (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." (or quietly (message "%s is correct" (funcall ispell-format-word-function word))) - (and (fboundp 'extent-at) + (and (featurep 'xemacs) (extent-at start) (and (fboundp 'delete-extent) (delete-extent (extent-at start))))) @@ -1606,7 +1606,7 @@ quit spell session exited." (message "%s is correct because of root %s" (funcall ispell-format-word-function word) (funcall ispell-format-word-function poss))) - (and (fboundp 'extent-at) + (and (featurep 'xemacs) (extent-at start) (and (fboundp 'delete-extent) (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 @@ - ;;; org-export-latex.el --- LaTeX exporter for org-mode +;;; org-export-latex.el --- LaTeX exporter for org-mode ;; -;; Copyright (C) 2007 Free Software Foundation, Inc. +;; Copyright (c) 2007, 2008 Free Software Foundation, Inc. ;; ;; Emacs Lisp Archive Entry ;; Filename: org-export-latex.el -;; Version: 5.12 +;; Version: 5.19 ;; Author: Bastien Guerry <bzg AT altern DOT org> ;; Maintainer: Bastien Guerry <bzg AT altern DOT org> ;; Keywords: org, wp, tex @@ -18,31 +18,31 @@ ;; Free Software Foundation; either version 3, or (at your option) any ;; later version. ;; -;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT -;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for -;; more details. +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. ;; -;; You should have received a copy of the GNU General Public License along -;; with GNU Emacs; see the file COPYING. If not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -;; 02110-1301, USA. +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +;; MA 02110-1301, USA. ;; ;;; Commentary: ;; ;; This library implements a LaTeX exporter for org-mode. -;; +;; ;; Put this file into your load-path and the following into your ~/.emacs: ;; (require 'org-export-latex) -;; +;; ;; The interactive functions are similar to those of the HTML exporter: -;; +;; ;; M-x `org-export-as-latex' ;; M-x `org-export-as-latex-batch' ;; M-x `org-export-as-latex-to-buffer' ;; M-x `org-export-region-as-latex' ;; M-x `org-replace-region-by-latex' -;; +;; ;;; Code: (eval-when-compile @@ -52,15 +52,19 @@ (require 'org) ;;; Variables: -(defvar org-latex-options-plist nil) -(defvar org-latex-todo-keywords-1 nil) -(defvar org-latex-all-targets-regexp nil) -(defvar org-latex-add-level 0) -(defvar org-latex-sectioning-depth 0) +(defvar org-export-latex-class nil) +(defvar org-export-latex-header nil) +(defvar org-export-latex-append-header nil) +(defvar org-export-latex-options-plist nil) +(defvar org-export-latex-todo-keywords-1 nil) +(defvar org-export-latex-all-targets-re nil) +(defvar org-export-latex-add-level 0) +(defvar org-export-latex-sectioning "") +(defvar org-export-latex-sectioning-depth 0) (defvar org-export-latex-list-beginning-re "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) +?") -(defvar org-latex-special-string-regexps +(defvar org-export-latex-special-string-regexps '(org-ts-regexp org-scheduled-string org-deadline-string @@ -71,28 +75,82 @@ (defvar re-quote) ; dynamically scoped from org.el (defvar commentsp) ; dynamically scoped from org.el -;;; Custom variables: -(defcustom org-export-latex-sectioning-alist - '((1 "\\section{%s}" "\\section*{%s}") - (2 "\\subsection{%s}" "\\subsection*{%s}") - (3 "\\subsubsection{%s}" "\\subsubsection*{%s}") - (4 "\\paragraph{%s}" "\\paragraph*{%s}") - (5 "\\subparagraph{%s}" "\\subparagraph*{%s}")) - "Alist of LaTeX commands for inserting sections. -Here is the structure of each cell: +;;; User variables: - \(level unnumbered-section numbered-section\) +(defcustom org-export-latex-default-class "article" + "The default LaTeX class." + :group 'org-export-latex + :type '(string :tag "LaTeX class")) -The %s formatter will be replaced by the title of the section." +(defcustom org-export-latex-classes + '(("article" + "\\documentclass[11pt,a4paper]{article} +\\usepackage[utf8]{inputenc} +\\usepackage[T1]{fontenc} +\\usepackage{hyperref}" + ("\\section{%s}" . "\\section*{%s}") + ("\\subsection{%s}" . "\\subsection*{%s}") + ("\\subsubsection{%s}" . "\\subsubsection*{%s}") + ("\\paragraph{%s}" . "\\paragraph*{%s}") + ("\\subparagraph{%s}" . "\\subparagraph*{%s}")) + ("report" + "\\documentclass[11pt,a4paper]{report} +\\usepackage[utf8]{inputenc} +\\usepackage[T1]{fontenc} +\\usepackage{hyperref}" + ("\\part{%s}" . "\\part*{%s}") + ("\\chapter{%s}" . "\\chapter*{%s}") + ("\\section{%s}" . "\\section*{%s}") + ("\\subsection{%s}" . "\\subsection*{%s}") + ("\\subsubsection{%s}" . "\\subsubsection*{%s}")) + ("book" + "\\documentclass[11pt,a4paper]{book} +\\usepackage[utf8]{inputenc} +\\usepackage[T1]{fontenc} +\\usepackage{hyperref}" + ("\\part{%s}" . "\\part*{%s}") + ("\\chapter{%s}" . "\\chapter*{%s}") + ("\\section{%s}" . "\\section*{%s}") + ("\\subsection{%s}" . "\\subsection*{%s}") + ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))) + "Alist of LaTeX classes and associated header and structure. +If #+LaTeX_CLASS is set in the buffer, use its value and the +associated information. Here is the structure of each cell: + + \(class-name + header-string + (unnumbered-section numbered-section\) + ...\) + +A %s formatter is mandatory in each section string and will be +replaced by the title of the section." :group 'org-export-latex - :type 'alist) + :type '(repeat + (list (string :tag "LaTeX class") + (string :tag "LaTeX header") + (cons :tag "Level 1" + (string :tag "Numbered") + (string :tag "Unnumbered")) + (cons :tag "Level 2" + (string :tag "Numbered") + (string :tag "Unnumbered")) + (cons :tag "Level 3" + (string :tag "Numbered") + (string :tag "Unnumbered")) + (cons :tag "Level 4" + (string :tag "Numbered") + (string :tag "Unnumbered")) + (cons :tag "Level 5" + (string :tag "Numbered") + (string :tag "Unnumbered"))))) (defcustom org-export-latex-emphasis-alist '(("*" "\\textbf{%s}" nil) ("/" "\\emph{%s}" nil) ("_" "\\underline{%s}" nil) ("+" "\\texttt{%s}" nil) - ("=" "\\texttt{%s}" nil)) + ("=" "\\texttt{%s}" nil) + ("~" "\\texttt{%s}" t)) "Alist of LaTeX expressions to convert emphasis fontifiers. Each element of the list is a list of three elements. The first element is the character used as a marker for fontification. @@ -102,15 +160,6 @@ conversions." :group 'org-export-latex :type 'alist) -(defcustom org-export-latex-preamble - "\\documentclass[11pt,a4paper]{article} -\\usepackage[utf8]{inputenc} -\\usepackage[T1]{fontenc} -\\usepackage{hyperref}" - "Preamble to be inserted at the very beginning of the LaTeX export." - :group 'org-export-latex - :type 'string) - (defcustom org-export-latex-title-command "\\maketitle" "The command used to insert the title just after \\begin{document}. If this string contains the formatting specification \"%s\" then @@ -119,7 +168,7 @@ argument." :group 'org-export-latex :type 'string) -(defcustom org-export-latex-date-format +(defcustom org-export-latex-date-format "%d %B %Y" "Format string for \\date{...}." :group 'org-export-latex @@ -130,14 +179,15 @@ argument." :group 'org-export-latex :type 'boolean) -(defcustom org-export-latex-packages-alist nil - "Alist of packages to be inserted in the preamble. -Each cell is of the forma \( option . package \). - -For example: +(defcustom org-export-latex-tables-column-borders nil + "When non-nil, group of columns are surrounded with borders, +XSeven if these borders are the outside borders of the table." + :group 'org-export-latex + :type 'boolean) -\(setq org-export-latex-packages-alist - '((\"french\" \"babel\"))" +(defcustom org-export-latex-packages-alist nil + "Alist of packages to be inserted in the header. +Each cell is of the forma \( \"option\" . \"package\" \)." :group 'org-export-latex :type 'alist) @@ -167,17 +217,42 @@ Don't remove the keys, just change their values." (defcustom org-export-latex-image-default-option "width=10em" "Default option for images." :group 'org-export-latex - :type '(string)) + :type 'string) (defcustom org-export-latex-coding-system nil "Coding system for the exported LaTex file." :group 'org-export-latex :type 'coding-system) -;; FIXME Do we want this one? -;; (defun org-export-as-latex-and-open (arg) ...) +(defcustom org-list-radio-list-templates + '((latex-mode "% BEGIN RECEIVE ORGLST %n +% END RECEIVE ORGLST %n +\\begin{comment} +#+ORGLST: SEND %n org-list-to-latex +| | | +\\end{comment}\n") + (texinfo-mode "@c BEGIN RECEIVE ORGLST %n +@c END RECEIVE ORGLST %n +@ignore +#+ORGLST: SEND %n org-list-to-texinfo +| | | +@end ignore\n") + (html-mode "<!-- BEGIN RECEIVE ORGLST %n --> +<!-- END RECEIVE ORGLST %n --> +<!-- +#+ORGLST: SEND %n org-list-to-html +| | | +-->\n")) + "Templates for radio lists in different major modes. +All occurrences of %n in a template will be replaced with the name of the +list, obtained by prompting the user." + :group 'org-plain-lists + :type '(repeat + (list (symbol :tag "Major mode") + (string :tag "Format")))) ;;; Autoload functions: + ;;;###autoload (defun org-export-as-latex-batch () "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'." (defun org-replace-region-by-latex (beg end) "Replace the region from BEG to END with its LaTeX export. It assumes the region has `org-mode' syntax, and then convert it to -LaTeX. This can be used in any buffer. For example, you could +LaTeX. This can be used in any buffer. For example, you could write an itemized list in `org-mode' syntax in an LaTeX buffer and then use this command to convert it." (interactive "r") @@ -255,7 +330,21 @@ in a window. A non-interactive call will only retunr the buffer." ;;;###autoload (defun org-export-as-latex (arg &optional hidden ext-plist to-buffer body-only) - "Export current buffer to a LaTeX file." + "Export current buffer to a LaTeX file. +If there is an active region, export only the region. The prefix +ARG specifies how many levels of the outline should become +headlines. The default is 3. Lower levels will be exported +depending on `org-export-latex-low-levels'. The default is to +convert them as description lists. When HIDDEN is non-nil, don't +display the LaTeX buffer. EXT-PLIST is a property list with +external parameters overriding org-mode's default settings, but +still inferior to file-local settings. When TO-BUFFER is +non-nil, create a buffer with that name and export to that +buffer. If TO-BUFFER is the symbol `string', don't leave any +buffer behind but just return the resulting LaTeX as a string. +When BODY-ONLY is set, don't produce the file header and footer, +simply return the content of \begin{document}...\end{document}, +without even the \begin{document} and \end{document} commands." (interactive "P") ;; Make sure we have a file name when we need it. (when (and (not (or to-buffer body-only)) @@ -268,9 +357,23 @@ in a window. A non-interactive call will only retunr the buffer." (message "Exporting to LaTeX...") (org-update-radio-target-regexp) - (org-export-latex-set-initial-vars ext-plist) + (org-export-latex-set-initial-vars ext-plist arg) (let* ((wcf (current-window-configuration)) - (opt-plist org-latex-options-plist) + (opt-plist org-export-latex-options-plist) + (region-p (org-region-active-p)) + (subtree-p + (when region-p + (save-excursion + (goto-char (region-beginning)) + (and (org-at-heading-p) + (>= (org-end-of-subtree t t) (region-end)))))) + (title (or (and subtree-p (org-export-get-title-from-subtree)) + (plist-get opt-plist :title) + (and (not + (plist-get opt-plist :skip-before-1st-heading)) + (org-export-grab-title-from-buffer)) + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)))) (filename (concat (file-name-as-directory (org-export-directory :LaTeX ext-plist)) (file-name-sans-extension @@ -286,10 +389,11 @@ in a window. A non-interactive call will only retunr the buffer." "*Org LaTeX Export*")) (t (get-buffer-create to-buffer))) (find-file-noselect filename))) - (region-p (org-region-active-p)) (odd org-odd-levels-only) - (preamble (org-export-latex-make-preamble opt-plist)) - (skip (plist-get opt-plist :skip-before-1st-heading)) + (header (org-export-latex-make-header title opt-plist)) + (skip (if subtree-p nil + ;; never skip first lines when exporting a subtree + (plist-get opt-plist :skip-before-1st-heading))) (text (plist-get opt-plist :text)) (first-lines (if skip "" (org-export-latex-first-lines))) (coding-system (and (boundp 'buffer-file-coding-system) @@ -310,19 +414,21 @@ in a window. A non-interactive call will only retunr the buffer." :skip-before-1st-heading skip :LaTeX-fragments nil))) - (set-buffer buffer) + (set-buffer buffer) (erase-buffer) (and (fboundp 'set-buffer-file-coding-system) (set-buffer-file-coding-system coding-system-for-write)) - ;; insert the preamble and initial document commands + ;; insert the header and initial document commands (unless (or (eq to-buffer 'string) body-only) - (insert preamble)) + (insert header)) ;; insert text found in #+TEXT (when (and text (not (eq to-buffer 'string))) - (insert (org-export-latex-content text) "\n\n")) + (insert (org-export-latex-content + text '(lists tables fixed-width keywords)) + "\n\n")) ;; insert lines before the first headline (unless (or skip (eq to-buffer 'string)) @@ -342,7 +448,7 @@ in a window. A non-interactive call will only retunr the buffer." (when (re-search-forward "^\\(\\*+\\) " nil t) (let* ((asters (length (match-string 1))) (level (if odd (- asters 2) (- asters 1)))) - (setq org-latex-add-level + (setq org-export-latex-add-level (if odd (1- (/ (1+ asters) 2)) (1- asters))) (org-export-latex-parse-global level odd))))) @@ -358,16 +464,16 @@ in a window. A non-interactive call will only retunr the buffer." (current-buffer)) (set-window-configuration wcf)))) - ;;; Parsing functions: + (defun org-export-latex-parse-global (level odd) "Parse the current buffer recursively, starting at LEVEL. If ODD is non-nil, assume the buffer only contains odd sections. -Return A list reflecting the document structure." +Return a list reflecting the document structure." (save-excursion (goto-char (point-min)) (let* ((cnt 0) output - (depth org-latex-sectioning-depth)) + (depth org-export-latex-sectioning-depth)) (while (re-search-forward (concat "^\\(\\(?:\\*\\)\\{" (number-to-string (+ (if odd 2 1) level)) @@ -404,57 +510,11 @@ Return A list reflecting the document structure." `(occur . ,cnt) `(heading . ,heading) `(content . ,(org-export-latex-parse-content)) - `(subcontent . ,(org-export-latex-parse-subcontent + `(subcontent . ,(org-export-latex-parse-subcontent level odd))))))) (widen))) (list output)))) -(defun org-export-latex-parse-list (&optional delete) - "Parse the list at point. -Return a list containing first level items as strings and -sublevels as list of strings." - (let ((start (point)) - ;; Find the end of the list - (end (save-excursion - (catch 'exit - (while (or (looking-at org-export-latex-list-beginning-re) - (looking-at "^[ \t]+\\|^$")) - (if (eq (point) (point-max)) - (throw 'exit (point-max))) - (forward-line 1))) (point))) - output itemsep) - (while (re-search-forward org-export-latex-list-beginning-re end t) - (setq itemsep (if (save-match-data - (string-match "^[0-9]" (match-string 2))) - "[0-9]+\\(?:\\.\\|)\\)" "[-+]")) - (let* ((indent1 (match-string 1)) - (nextitem (save-excursion - (save-match-data - (or (and (re-search-forward - (concat "^" indent1 itemsep " *?") end t) - (match-beginning 0)) end)))) - (item (buffer-substring - (point) - (or (and (re-search-forward - org-export-latex-list-beginning-re end t) - (goto-char (match-beginning 0))) - (goto-char end)))) - (nextindent (match-string 1)) - (item (org-trim item)) - (item (if (string-match "^\\[.+\\]" item) - (replace-match "\\\\texttt{\\&}" - t nil item) item))) - (push item output) - (when (> (length nextindent) - (length indent1)) - (narrow-to-region (point) nextitem) - (push (org-export-latex-parse-list) output) - (widen)))) - (when delete (delete-region start end)) - (setq output (nreverse output)) - (push (if (string-match "^\\[0" itemsep) - 'ordered 'unordered) output))) - (defun org-export-latex-parse-content () "Extract the content of a section." (let ((beg (point)) @@ -487,7 +547,7 @@ CONTENT is an element of the list produced by "Export the list SUBCONTENT to LaTeX. SUBCONTENT is an alist containing information about the headline and its content." - (let ((num (plist-get org-latex-options-plist :section-numbers))) + (let ((num (plist-get org-export-latex-options-plist :section-numbers))) (mapc (lambda(x) (org-export-latex-subcontent x num)) subcontent))) (defun org-export-latex-subcontent (subcontent num) @@ -495,20 +555,20 @@ and its content." (let ((heading (org-export-latex-fontify-headline (cdr (assoc 'heading subcontent)))) (level (- (cdr (assoc 'level subcontent)) - org-latex-add-level)) + org-export-latex-add-level)) (occur (number-to-string (cdr (assoc 'occur subcontent)))) (content (cdr (assoc 'content subcontent))) (subcontent (cadr (assoc 'subcontent subcontent)))) - (cond + (cond ;; Normal conversion - ((<= level org-latex-sectioning-depth) - (let ((sec (assoc level org-export-latex-sectioning-alist))) - (insert (format (if num (cadr sec) (caddr sec)) heading) "\n")) + ((<= level org-export-latex-sectioning-depth) + (let ((sec (nth (1- level) org-export-latex-sectioning))) + (insert (format (if num (car sec) (cdr sec)) heading) "\n")) (insert (org-export-latex-content content)) (cond ((stringp subcontent) (insert subcontent)) ((listp subcontent) (org-export-latex-sub subcontent)))) ;; At a level under the hl option: we can drop this subsection - ((> level org-latex-sectioning-depth) + ((> level org-export-latex-sectioning-depth) (cond ((eq org-export-latex-low-levels 'description) (insert (format "\\begin{description}\n\n\\item[%s]\n\n" heading)) (insert (org-export-latex-content content)) @@ -521,52 +581,47 @@ and its content." (cond ((stringp subcontent) (insert subcontent)) ((listp subcontent) (org-export-latex-sub subcontent))))))))) - ;;; Exporting internals: -(defun org-export-latex-protect-string (string) - "Prevent further conversion for STRING by adding the -org-protect property." - (add-text-properties - 0 (length string) '(org-protected t) string) string) - -(defun org-export-latex-protect-char-in-string (char-list string) - "Add org-protected text-property to char from CHAR-LIST in STRING." - (with-temp-buffer - (save-match-data - (insert string) - (goto-char (point-min)) - (while (re-search-forward (regexp-opt char-list) nil t) - (add-text-properties (match-beginning 0) - (match-end 0) '(org-protected t))) - (buffer-string)))) - -(defun org-export-latex-set-initial-vars (ext-plist) +(defun org-export-latex-set-initial-vars (ext-plist level) "Store org local variables required for LaTeX export. -EXT-PLIST is an optional additional plist." - (setq org-latex-todo-keywords-1 org-todo-keywords-1 - org-latex-all-targets-regexp +EXT-PLIST is an optional additional plist. +LEVEL indicates the default depth for export." + (setq org-export-latex-todo-keywords-1 org-todo-keywords-1 + org-export-latex-all-targets-re (org-make-target-link-regexp (org-all-targets)) - org-latex-options-plist + org-export-latex-options-plist (org-combine-plists (org-default-export-plist) ext-plist (org-infile-export-plist)) - org-latex-sectioning-depth - (let ((hl-levels (plist-get org-latex-options-plist :headline-levels)) - (sec-depth (length org-export-latex-sectioning-alist))) - ;; Fall back on org-export-latex-sectioning-alist length if - ;; headline-levels goes beyond it - (if (> hl-levels sec-depth) sec-depth hl-levels)))) - -(defun org-export-latex-make-preamble (opt-plist) - "Make the LaTeX preamble and return it as a string. -Argument OPT-PLIST is the options plist for current buffer." - (let ((toc (plist-get opt-plist :table-of-contents))) - (concat + org-export-latex-class + (save-excursion + (goto-char (point-min)) + (if (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\([a-zA-Z]+\\)" nil t) + (assoc (match-string 1) org-export-latex-classes)) + (match-string 1) + org-export-latex-default-class)) + org-export-latex-header + (cadr (assoc org-export-latex-class org-export-latex-classes)) + org-export-latex-sectioning + (cddr (assoc org-export-latex-class org-export-latex-classes)) + org-export-latex-sectioning-depth + (or level + (let ((hl-levels + (plist-get org-export-latex-options-plist :headline-levels)) + (sec-depth (length org-export-latex-sectioning))) + (if (> hl-levels sec-depth) sec-depth hl-levels))))) + +(defun org-export-latex-make-header (title opt-plist) + "Make the LaTeX header and return it as a string. +TITLE is the current title from the buffer or region. +OPT-PLIST is the options plist for current buffer." + (let ((toc (plist-get opt-plist :table-of-contents)) + (author (plist-get opt-plist :author))) + (concat (if (plist-get opt-plist :time-stamp-file) (format-time-string "% Created %Y-%m-%d %a %H:%M\n")) - - ;; insert LaTeX custom preamble - org-export-latex-preamble "\n" - + ;; insert LaTeX custom header + org-export-latex-header + "\n" ;; insert information on LaTeX packages (when org-export-latex-packages-alist (mapconcat (lambda(p) @@ -575,46 +630,34 @@ Argument OPT-PLIST is the options plist for current buffer." (format "\\usepackage[%s]{%s}" (car p) (cadr p)))) org-export-latex-packages-alist "\n")) - + ;; insert additional commands in the header + org-export-latex-append-header ;; insert the title - (format - "\\title{%s}\n" + (format + "\n\n\\title{%s}\n" ;; convert the title (org-export-latex-content - (or (plist-get opt-plist :title) - (and (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (and buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name))) - "UNTITLED"))) - + title '(lists tables fixed-width keywords))) ;; insert author info (if (plist-get opt-plist :author-info) - (format "\\author{%s}\n" - (or (plist-get opt-plist :author) user-full-name)) + (format "\\author{%s}\n" + (or author user-full-name)) (format "%%\\author{%s}\n" - (or (plist-get opt-plist :author) user-full-name))) - + (or author user-full-name))) ;; insert the date (format "\\date{%s}\n" - (format-time-string + (format-time-string (or (plist-get opt-plist :date) org-export-latex-date-format))) - ;; beginning of the document "\n\\begin{document}\n\n" - ;; insert the title command (if (string-match "%s" org-export-latex-title-command) - (format org-export-latex-title-command - (plist-get opt-plist :title)) + (format org-export-latex-title-command title) org-export-latex-title-command) "\n\n" - ;; table of contents - (when (and org-export-with-toc + (when (and org-export-with-toc (plist-get opt-plist :section-numbers)) (cond ((numberp toc) (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 formatting string like %%%%s if we want to comment them out." (save-excursion (goto-char (point-min)) + (if (org-at-heading-p) (beginning-of-line 2)) (let* ((pt (point)) - (end (if (and (re-search-forward "^\\*" nil t) + (end (if (and (re-search-forward "^\\* " nil t) (not (eq pt (match-beginning 0)))) (goto-char (match-beginning 0)) (goto-char (point-max))))) @@ -643,10 +687,58 @@ formatting string like %%%%s if we want to comment them out." :skip-before-1st-heading nil :LaTeX-fragments nil))))) +(defun org-export-latex-content (content &optional exclude-list) + "Convert CONTENT string to LaTeX. +Don't perform conversions that are in EXCLUDE-LIST. Recognized +conversion types are: quotation-marks, emphasis, sub-superscript, +links, keywords, lists, tables, fixed-width" + (with-temp-buffer + (insert content) + (unless (memq 'quotation-marks exclude-list) + (org-export-latex-quotation-marks)) + (unless (memq 'emphasis exclude-list) + (when (plist-get org-export-latex-options-plist :emphasize) + (org-export-latex-fontify))) + (unless (memq 'sub-superscript exclude-list) + (org-export-latex-special-chars + (plist-get org-export-latex-options-plist :sub-superscript))) + (unless (memq 'links exclude-list) + (org-export-latex-links)) + (unless (memq 'keywords exclude-list) + (org-export-latex-keywords + (plist-get org-export-latex-options-plist :timestamps))) + (unless (memq 'lists exclude-list) + (org-export-latex-lists)) + (unless (memq 'tables exclude-list) + (org-export-latex-tables + (plist-get org-export-latex-options-plist :tables))) + (unless (memq 'fixed-width exclude-list) + (org-export-latex-fixed-width + (plist-get org-export-latex-options-plist :fixed-width))) + ;; return string + (buffer-substring (point-min) (point-max)))) + +(defun org-export-latex-protect-string (s) + "Prevent further conversion for string S by adding the +org-protect property." + (add-text-properties 0 (length s) '(org-protected t) s) s) + +(defun org-export-latex-protect-char-in-string (char-list string) + "Add org-protected text-property to char from CHAR-LIST in STRING." + (with-temp-buffer + (save-match-data + (insert string) + (goto-char (point-min)) + (while (re-search-forward (regexp-opt char-list) nil t) + (add-text-properties (match-beginning 0) + (match-end 0) '(org-protected t))) + (buffer-string)))) + (defun org-export-latex-keywords-maybe (remove-list) "Maybe remove keywords depending on rules in REMOVE-LIST." (goto-char (point-min)) - (let ((re-todo (mapconcat 'identity org-latex-todo-keywords-1 "\\|"))) + (let ((re-todo (mapconcat 'identity org-export-latex-todo-keywords-1 "\\|")) + (case-fold-search nil)) ;; convert TODO keywords (when (re-search-forward (concat "^\\(" re-todo "\\)") nil t) (if (plist-get remove-list :todo) @@ -664,48 +756,25 @@ formatting string like %%%%s if we want to comment them out." (replace-match "") (replace-match (format "\\texttt{%s}" (match-string 0)) t t))))) -(defun org-export-latex-fontify-headline (headline) - "Fontify special words in a HEADLINE." +(defun org-export-latex-fontify-headline (string) + "Fontify special words in string." (with-temp-buffer ;; FIXME: org-inside-LaTeX-fragment-p doesn't work when the $...$ is at ;; the beginning of the buffer - inserting "\n" is safe here though. - (insert "\n" headline) + (insert "\n" string) (goto-char (point-min)) - (when (plist-get org-latex-options-plist :emphasize) + (when (plist-get org-export-latex-options-plist :emphasize) (org-export-latex-fontify)) (org-export-latex-special-chars - (plist-get org-latex-options-plist :sub-superscript)) + (plist-get org-export-latex-options-plist :sub-superscript)) (org-export-latex-keywords-maybe org-export-latex-remove-from-headlines) (org-export-latex-links) (org-trim (buffer-substring-no-properties (point-min) (point-max))))) -(defun org-export-latex-content (content) - "Convert CONTENT string to LaTeX." - (with-temp-buffer - (insert content) - (org-export-latex-quotation-marks) - (when (plist-get org-latex-options-plist :emphasize) - (org-export-latex-fontify)) - (org-export-latex-special-chars - (plist-get org-latex-options-plist :sub-superscript)) - (org-export-latex-links) - (org-export-latex-keywords - (plist-get org-latex-options-plist :timestamps)) - (org-export-latex-lists) - (org-export-latex-tables - (plist-get org-latex-options-plist :tables)) - (org-export-latex-fixed-width - (plist-get org-latex-options-plist :fixed-width)) - ;; return string - (buffer-substring (point-min) (point-max)))) - (defun org-export-latex-quotation-marks () - "Export question marks depending on language conventions. -Local definition of the language overrides -`org-export-latex-quotation-marks-convention' which overrides -`org-export-default-language'." - (let* ((lang (plist-get org-latex-options-plist :language)) + "Export question marks depending on language conventions." + (let* ((lang (plist-get org-export-latex-options-plist :language)) (quote-rpl (if (equal lang "fr") '(("\\(\\s-\\)\"" "«~") ("\\(\\S-\\)\"" "~»") @@ -720,21 +789,6 @@ Local definition of the language overrides (org-if-unprotected (replace-match rpl t t))))) quote-rpl))) -;; | chars/string in Org | normal environment | math environment | -;; |-----------------------+-----------------------+-----------------------| -;; | & # % $ | \& \# \% \$ | \& \# \% \$ | -;; | { } _ ^ \ | \{ \} \_ \^ \\ | { } _ ^ \ | -;; |-----------------------+-----------------------+-----------------------| -;; | a_b and a^b | $a_b$ and $a^b$ | a_b and a^b | -;; | a_abc and a_{abc} | $a_a$bc and $a_{abc}$ | a_abc and a_{abc} | -;; | \tau and \mu | $\tau$ and $\mu$ | \tau and \mu | -;; |-----------------------+-----------------------+-----------------------| -;; | \_ \^ | \_ \^ | \_ \^ | -;; | \(a=\mu\mbox{m}\) | \(a=\mu\mbox{m}\) | \(a=\mu\mbox{m}\) | -;; | \[\beta^2-a=0\] | \[\beta^2-a=0\] | \[\beta^2-a=0\] | -;; | $x=22\tau$ | $x=22\tau$ | $x=22\tau$ | -;; | $$\alpha=\sqrt{a^3}$$ | $$\alpha=\sqrt{a^3}$$ | $$\alpha=\sqrt{a^3}$$ | - (defun org-export-latex-special-chars (sub-superscript) "Export special characters to LaTeX. If SUB-SUPERSCRIPT is non-nil, convert \\ and ^. @@ -744,7 +798,8 @@ See the `org-export-latex.el' code for a complete conversion table." (goto-char (point-min)) (while (re-search-forward c nil t) ;; Put the point where to check for org-protected - (unless (get-text-property (match-beginning 2) 'org-protected) + (unless (or (get-text-property (match-beginning 2) 'org-protected) + (org-at-table-p)) (cond ((member (match-string 2) '("\\$" "$")) (if (equal (match-string 2) "\\$") (replace-match (concat (match-string 1) "$" @@ -756,11 +811,15 @@ See the `org-export-latex.el' code for a complete conversion table." (replace-match (match-string 2) t t) (replace-match (concat (match-string 1) "\\" (match-string 2)) t t))) + ((equal (match-string 2) "...") + (replace-match + (concat (match-string 1) + (org-export-latex-protect-string "\\ldots{}")) t t)) ((equal (match-string 2) "~") (cond ((equal (match-string 1) "\\") nil) ((eq 'org-link (get-text-property 0 'face (match-string 2))) (replace-match (concat (match-string 1) "\\~") t t)) - (t (replace-match + (t (replace-match (org-export-latex-protect-string (concat (match-string 1) "\\~{}")) t t)))) ((member (match-string 2) '("{" "}")) @@ -791,6 +850,7 @@ See the `org-export-latex.el' code for a complete conversion table." "\\(.\\|^\\)\\({\\)" "\\(.\\|^\\)\\(}\\)" "\\(.\\|^\\)\\(~\\)" + "\\(.\\|^\\)\\(\\.\\.\\.\\)" ;; (?\< . "\\textless{}") ;; (?\> . "\\textgreater{}") ))) @@ -812,7 +872,7 @@ Convert CHAR depending on STRING-BEFORE and STRING-AFTER." (cond ((eq 1 (length string-after)) (concat string-before char string-after)) ((string-match "[({]?\\([^)}]+\\)[)}]?" string-after) - (format "%s%s{%s}" string-before char + (format "%s%s{%s}" string-before char (match-string 1 string-after)))))) ((and subsup (> (length string-after) 1) @@ -842,7 +902,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (string-match "^[ \t\n]" string-after))) ;; backslash might escape a character (like \#) or a user TeX ;; macro (like \setcounter) - (org-export-latex-protect-string + (org-export-latex-protect-string (concat string-before "\\" string-after))) ((and (string-match "^[ \t\n]" string-after) (string-match "[ \t\n]\\'" string-before)) @@ -854,19 +914,18 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (defun org-export-latex-keywords (timestamps) "Convert special keywords to LaTeX. -Regexps are those from `org-latex-special-string-regexps'." - (let ((rg org-latex-special-string-regexps) r) +Regexps are those from `org-export-latex-special-string-regexps'." + (let ((rg org-export-latex-special-string-regexps) r) (while (setq r (pop rg)) (goto-char (point-min)) (while (re-search-forward (eval r) nil t) (if (not timestamps) (replace-match (format "\\\\texttt{%s}" (match-string 0)) t) (replace-match "")))))) - + (defun org-export-latex-fixed-width (opt) "When OPT is non-nil convert fixed-width sections to LaTeX." (goto-char (point-min)) - ;; FIXME the search shouldn't be performed on already converted text (while (re-search-forward "^[ \t]*:" nil t) (if opt (progn (goto-char (match-beginning 0)) @@ -882,73 +941,6 @@ Regexps are those from `org-latex-special-string-regexps'." (match-string 2)) t t) (forward-line)))))) -(defun org-export-latex-lists () - "Convert lists to LaTeX." - (goto-char (point-min)) - (while (re-search-forward org-export-latex-list-beginning-re nil t) - (beginning-of-line) - (org-export-list-to-latex - (org-export-latex-parse-list t)))) - -(defun org-export-list-to-generic (list params) - "Convert a LIST parsed through `org-export-latex-parse-list' to other formats. - -Valid parameters are - -:ustart String to start an unordered list -:uend String to end an unordered list - -:ostart String to start an ordered list -:oend String to end an ordered list - -:splice When set to t, return only list body lines, don't wrap - them into :[u/o]start and :[u/o]end. Default is nil. - -:istart String to start a list item -:iend String to end a list item -:isep String to separate items -:lsep String to separate sublists" - (interactive) - (let* ((p params) sublist - (splicep (plist-get p :splice)) - (ostart (plist-get p :ostart)) - (oend (plist-get p :oend)) - (ustart (plist-get p :ustart)) - (uend (plist-get p :uend)) - (istart (plist-get p :istart)) - (iend (plist-get p :iend)) - (isep (plist-get p :isep)) - (lsep (plist-get p :lsep))) - (let ((wrapper - (cond ((eq (car list) 'ordered) - (concat ostart "\n%s" oend "\n")) - ((eq (car list) 'unordered) - (concat ustart "\n%s" uend "\n")))) - rtn) - (while (setq sublist (pop list)) - (cond ((symbolp sublist) nil) - ((stringp sublist) - (setq rtn (concat rtn istart sublist iend isep))) - (t - (setq rtn (concat rtn ;; previous list - lsep ;; list separator - (org-export-list-to-generic sublist p) - lsep ;; list separator - ))))) - (format wrapper rtn)))) - -(defun org-export-list-to-latex (list) - "Convert LIST into a LaTeX list." - (insert - (org-export-list-to-generic - list '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}" - :ustart "\\begin{itemize}" :uend "\\end{itemize}" - :istart "\\item " :iend "" - :isep "\n" :lsep "\n")) - ;; Add a trailing \n after list conversion - "\n")) - -;; FIXME Use org-export-highlight-first-table-line ? (defun org-export-latex-tables (insert) "Convert tables to LaTeX and INSERT it." (goto-char (point-min)) @@ -975,7 +967,7 @@ Valid parameters are (unless (string-match "^[ \t]*|-" line) (setq fields (org-split-string line "[ \t]*|[ \t]*")) (setq fnum (make-vector (length fields) 0)) - (setq line-fmt + (setq line-fmt (mapconcat (lambda (x) (setq gr (pop org-table-colgroup-info)) @@ -991,18 +983,21 @@ Valid parameters are (progn (setq colgropen nil) "|") ""))) fnum "")))) + ;; fix double || in line-fmt + (setq line-fmt (replace-regexp-in-string "||" "|" line-fmt)) ;; maybe remove the first and last "|" - (when (string-match "^\\(|\\)?\\(.+\\)|$" line-fmt) + (when (and (not org-export-latex-tables-column-borders) + (string-match "^\\(|\\)?\\(.+\\)|$" line-fmt)) (setq line-fmt (match-string 2 line-fmt))) ;; format alignment - (setq align (apply 'format + (setq align (apply 'format (cons line-fmt (mapcar (lambda (x) (if x "r" "l")) org-table-last-alignment)))) ;; prepare the table to send to orgtbl-to-latex (setq lines (mapcar - (lambda(elem) + (lambda(elem) (or (and (string-match "[ \t]*|-+" elem) 'hline) (split-string (org-trim elem) "|" t))) lines)) @@ -1016,8 +1011,8 @@ Valid parameters are (goto-char (point-min)) (while (re-search-forward org-emph-re nil t) ;; The match goes one char after the *string* - (let ((emph (assoc (match-string 3) - org-export-latex-emphasis-alist)) + (let ((emph (assoc (match-string 3) + org-export-latex-emphasis-alist)) rpl) (unless (get-text-property (1- (point)) 'org-protected) (setq rpl (concat (match-string 1) @@ -1025,7 +1020,7 @@ Valid parameters are '("\\" "{" "}") (cadr emph)) (match-string 4)) (match-string 5))) - (if (caddr emph) + (if (caddr emph) (setq rpl (org-export-latex-protect-string rpl))) (replace-match rpl t t))) (backward-char))) @@ -1038,7 +1033,7 @@ Valid parameters are (while (re-search-forward org-bracket-link-analytic-regexp nil t) (org-if-unprotected (goto-char (match-beginning 0)) - (let* ((re-radio org-latex-all-targets-regexp) + (let* ((re-radio org-export-latex-all-targets-re) (remove (list (match-beginning 0) (match-end 0))) (type (match-string 2)) (raw-path (match-string 3)) @@ -1063,22 +1058,22 @@ Valid parameters are (if (file-exists-p raw-path) (concat type "://" (expand-file-name raw-path)) (concat type "://" (org-export-directory - :LaTeX org-latex-options-plist) + :LaTeX org-export-latex-options-plist) raw-path)))))))) ;; process with link inserting (apply 'delete-region remove) - (cond ((and imgp (plist-get org-latex-options-plist :inline-images)) + (cond ((and imgp (plist-get org-export-latex-options-plist :inline-images)) (insert (format "\\includegraphics[%s]{%s}" ;; image option should be set be a comment line org-export-latex-image-default-option (expand-file-name raw-path)))) - ;; FIXME: what about caption? image properties? (radiop (insert (format "\\hyperref[%s]{%s}" raw-path desc))) (path (insert (format "\\href{%s}{%s}" path desc))) (t (insert "\\texttt{" desc "}"))))))) -(defun org-export-latex-cleaned-string (&optional commentsp) - ;; FIXME remove commentsp call in org.el and here +(defvar org-latex-entities) ; defined below + +(defun org-export-latex-cleaned-string () "Clean stuff in the LaTeX export." ;; Preserve line breaks @@ -1091,7 +1086,7 @@ Valid parameters are (goto-char (point-min)) (let ((case-fold-search nil) rpl) (while (re-search-forward "\\([^+_]\\)LaTeX" nil t) - (replace-match (org-export-latex-protect-string + (replace-match (org-export-latex-protect-string (concat (match-string 1) "\\LaTeX{}")) t t))) ;; Convert horizontal rules @@ -1099,19 +1094,25 @@ Valid parameters are (while (re-search-forward "^----+.$" nil t) (replace-match (org-export-latex-protect-string "\\hrule") t t)) - ;; Protect LaTeX \commands{...} + ;; Protect LaTeX commands like \commad[...]{...} or \command{...} (goto-char (point-min)) (while (re-search-forward "\\\\[a-zA-Z]+\\(?:\\[.*\\]\\)?{.*}" nil t) (add-text-properties (match-beginning 0) (match-end 0) '(org-protected t))) + ;; Protect LaTeX entities + (goto-char (point-min)) + (while (re-search-forward (regexp-opt org-latex-entities) nil t) + (add-text-properties (match-beginning 0) (match-end 0) + '(org-protected t))) + ;; Replace radio links (goto-char (point-min)) (while (re-search-forward - (concat "<<<?" org-latex-all-targets-regexp + (concat "<<<?" org-export-latex-all-targets-re ">>>?\\((INVISIBLE)\\)?") nil t) (replace-match - (org-export-latex-protect-string + (org-export-latex-protect-string (format "\\label{%s}%s"(match-string 1) (if (match-string 2) "" (match-string 1)))) t t)) @@ -1123,7 +1124,7 @@ Valid parameters are ;; When converting to LaTeX, replace footnotes ;; FIXME: don't protect footnotes from conversion - (when (plist-get org-latex-options-plist :footnotes) + (when (plist-get org-export-latex-options-plist :footnotes) (goto-char (point-min)) (while (re-search-forward "\\[[0-9]+\\]" nil t) (when (save-match-data @@ -1133,34 +1134,402 @@ Valid parameters are (foot-end (match-end 0)) (foot-prefix (match-string 0)) footnote footnote-rpl) - (when (and (re-search-forward (regexp-quote foot-prefix) nil t)) - (replace-match "") - (let ((end (save-excursion - (if (re-search-forward "^$\\|^#.*$\\|\\[[0-9]+\\]" nil t) - (match-beginning 0) (point-max))))) - (setq footnote - (concat - (org-trim (buffer-substring (point) end)) - ;; FIXME stupid workaround for cases where - ;; `org-bracket-link-analytic-regexp' matches - ;; }. as part of the link. - " ")) - (delete-region (point) end))) - (goto-char foot-beg) - (delete-region foot-beg foot-end) - (setq footnote-rpl (format "\\footnote{%s}" footnote)) - (add-text-properties 0 10 '(org-protected t) footnote-rpl) - (add-text-properties (1- (length footnote-rpl)) - (length footnote-rpl) - '(org-protected t) footnote-rpl) - (insert footnote-rpl)))) - + (save-excursion + (when (search-forward foot-prefix nil t) + (replace-match "") + (let ((end (save-excursion + (if (re-search-forward "^$\\|^#.*$\\|\\[[0-9]+\\]" nil t) + (match-beginning 0) (point-max))))) + (setq footnote (concat (org-trim (buffer-substring (point) end)) + " ")) ; prevent last } being part of a link + (delete-region (point) end)) + (goto-char foot-beg) + (delete-region foot-beg foot-end) + (unless (null footnote) + (setq footnote-rpl (format "\\footnote{%s}" footnote)) + (add-text-properties 0 10 '(org-protected t) footnote-rpl) + (add-text-properties (1- (length footnote-rpl)) + (length footnote-rpl) + '(org-protected t) footnote-rpl) + (insert footnote-rpl))))))) + ;; Replace footnote section tag for LaTeX (goto-char (point-min)) - (while (re-search-forward + (while (re-search-forward (concat "^" footnote-section-tag-regexp) nil t) (replace-match "")))) +;;; List handling: + +(defun org-export-latex-lists () + "Replace plain text lists in current buffer into LaTeX lists." + "Convert lists to LaTeX." + (goto-char (point-min)) + (while (re-search-forward org-export-latex-list-beginning-re nil t) + (beginning-of-line) + (insert (org-list-to-latex (org-list-parse-list t)) "\n"))) + +(defun org-list-parse-list (&optional delete) + "Parse the list at point. +Return a list containing first level items as strings and +sublevels as a list of strings." + (let ((start (org-list-item-begin)) + (end (org-list-end)) + output itemsep) + (while (re-search-forward org-export-latex-list-beginning-re end t) + (setq itemsep (if (save-match-data + (string-match "^[0-9]" (match-string 2))) + "[0-9]+\\(?:\\.\\|)\\)" "[-+]")) + (let* ((indent1 (match-string 1)) + (nextitem (save-excursion + (save-match-data + (or (and (re-search-forward + (concat "^" indent1 itemsep " *?") end t) + (match-beginning 0)) end)))) + (item (buffer-substring + (point) + (or (and (re-search-forward + org-export-latex-list-beginning-re end t) + (goto-char (match-beginning 0))) + (goto-char end)))) + (nextindent (match-string 1)) + (item (org-trim item)) + (item (if (string-match "^\\[.+\\]" item) + (replace-match "\\\\texttt{\\&}" + t nil item) item))) + (push item output) + (when (> (length nextindent) + (length indent1)) + (narrow-to-region (point) nextitem) + (push (org-list-parse-list) output) + (widen)))) + (when delete (delete-region start end)) + (setq output (nreverse output)) + (push (if (string-match "^\\[0" itemsep) + 'ordered 'unordered) output))) + +(defun org-list-item-begin () + "Find the beginning of the list item and return its position." + (save-excursion + (if (not (or (looking-at org-export-latex-list-beginning-re) + (re-search-backward + org-export-latex-list-beginning-re nil t))) + (progn (goto-char (point-min)) (point)) + (match-beginning 0)))) + +(defun org-list-end () + "Find the end of the list and return its position." + (save-excursion + (catch 'exit + (while (or (looking-at org-export-latex-list-beginning-re) + (looking-at "^[ \t]+\\|^$")) + (if (eq (point) (point-max)) + (throw 'exit (point-max))) + (forward-line 1))) (point))) + +(defun org-list-insert-radio-list () + "Insert a radio list template appropriate for this major mode." + (interactive) + (let* ((e (assq major-mode org-list-radio-list-templates)) + (txt (nth 1 e)) + name pos) + (unless e (error "No radio list setup defined for %s" major-mode)) + (setq name (read-string "List name: ")) + (while (string-match "%n" txt) + (setq txt (replace-match name t t txt))) + (or (bolp) (insert "\n")) + (setq pos (point)) + (insert txt) + (goto-char pos))) + +(defun org-list-send-list (&optional maybe) + "Send a tranformed version of this list to the receiver position. +With argument MAYBE, fail quietly if no transformation is defined for +this list." + (interactive) + (catch 'exit + (unless (org-at-item-p) (error "Not at a list")) + (save-excursion + (goto-char (org-list-item-begin)) + (beginning-of-line 0) + (unless (looking-at "#\\+ORGLST: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?") + (if maybe + (throw 'exit nil) + (error "Don't know how to transform this list")))) + (let* ((name (match-string 1)) + beg + (transform (intern (match-string 2))) + (txt (buffer-substring-no-properties + (org-list-item-begin) + (org-list-end))) + (list (org-list-parse-list))) + (unless (fboundp transform) + (error "No such transformation function %s" transform)) + (setq txt (funcall transform list)) + ;; Find the insertion place + (save-excursion + (goto-char (point-min)) + (unless (re-search-forward + (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t) + (error "Don't know where to insert translated list")) + (goto-char (match-beginning 0)) + (beginning-of-line 2) + (setq beg (point)) + (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t) + (error "Cannot find end of insertion region")) + (beginning-of-line 1) + (delete-region beg (point)) + (goto-char beg) + (insert txt "\n")) + (message "List converted and installed at receiver location")))) + +(defun org-list-to-generic (list params) + "Convert a LIST parsed through `org-list-parse-list' to other formats. + +Valid parameters are + +:ustart String to start an unordered list +:uend String to end an unordered list + +:ostart String to start an ordered list +:oend String to end an ordered list + +:splice When set to t, return only list body lines, don't wrap + them into :[u/o]start and :[u/o]end. Default is nil. + +:istart String to start a list item +:iend String to end a list item +:isep String to separate items +:lsep String to separate sublists" + (interactive) + (let* ((p params) sublist + (splicep (plist-get p :splice)) + (ostart (plist-get p :ostart)) + (oend (plist-get p :oend)) + (ustart (plist-get p :ustart)) + (uend (plist-get p :uend)) + (istart (plist-get p :istart)) + (iend (plist-get p :iend)) + (isep (plist-get p :isep)) + (lsep (plist-get p :lsep))) + (let ((wrapper + (cond ((eq (car list) 'ordered) + (concat ostart "\n%s" oend "\n")) + ((eq (car list) 'unordered) + (concat ustart "\n%s" uend "\n")))) + rtn) + (while (setq sublist (pop list)) + (cond ((symbolp sublist) nil) + ((stringp sublist) + (setq rtn (concat rtn istart sublist iend isep))) + (t + (setq rtn (concat rtn ;; previous list + lsep ;; list separator + (org-list-to-generic sublist p) + lsep ;; list separator + ))))) + (format wrapper rtn)))) + +(defun org-list-to-latex (list) + "Convert LIST into a LaTeX list." + (org-list-to-generic + list '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}" + :ustart "\\begin{itemize}" :uend "\\end{itemize}" + :istart "\\item " :iend "" + :isep "\n" :lsep "\n"))) + +(defun org-list-to-html (list) + "Convert LIST into a HTML list." + (org-list-to-generic + list '(:splicep nil :ostart "<ol>" :oend "</ol>" + :ustart "<ul>" :uend "</ul>" + :istart "<li>" :iend "</li>" + :isep "\n" :lsep "\n"))) + +(defun org-list-to-texinfo (list) + "Convert LIST into a Texinfo list." + (org-list-to-generic + list '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize" + :ustart "@enumerate" :uend "@end enumerate" + :istart "@item\n" :iend "" + :isep "\n" :lsep "\n"))) + +(defconst org-latex-entities + '("\\!" + "\\'" + "\\+" + "\\," + "\\-" + "\\:" + "\\;" + "\\<" + "\\=" + "\\>" + "\\Huge" + "\\LARGE" + "\\Large" + "\\Styles" + "\\\\" + "\\`" + "\\addcontentsline" + "\\address" + "\\addtocontents" + "\\addtocounter" + "\\addtolength" + "\\addvspace" + "\\alph" + "\\appendix" + "\\arabic" + "\\author" + "\\begin{array}" + "\\begin{center}" + "\\begin{description}" + "\\begin{enumerate}" + "\\begin{eqnarray}" + "\\begin{equation}" + "\\begin{figure}" + "\\begin{flushleft}" + "\\begin{flushright}" + "\\begin{itemize}" + "\\begin{list}" + "\\begin{minipage}" + "\\begin{picture}" + "\\begin{quotation}" + "\\begin{quote}" + "\\begin{tabbing}" + "\\begin{table}" + "\\begin{tabular}" + "\\begin{thebibliography}" + "\\begin{theorem}" + "\\begin{titlepage}" + "\\begin{verbatim}" + "\\begin{verse}" + "\\bf" + "\\bf" + "\\bibitem" + "\\bigskip" + "\\cdots" + "\\centering" + "\\circle" + "\\cite" + "\\cleardoublepage" + "\\clearpage" + "\\cline" + "\\closing" + "\\dashbox" + "\\date" + "\\ddots" + "\\dotfill" + "\\em" + "\\fbox" + "\\flushbottom" + "\\fnsymbol" + "\\footnote" + "\\footnotemark" + "\\footnotesize" + "\\footnotetext" + "\\frac" + "\\frame" + "\\framebox" + "\\hfill" + "\\hline" + "\\hrulespace" + "\\hspace" + "\\huge" + "\\hyphenation" + "\\include" + "\\includeonly" + "\\indent" + "\\input" + "\\it" + "\\kill" + "\\label" + "\\large" + "\\ldots" + "\\line" + "\\linebreak" + "\\linethickness" + "\\listoffigures" + "\\listoftables" + "\\location" + "\\makebox" + "\\maketitle" + "\\mark" + "\\mbox" + "\\medskip" + "\\multicolumn" + "\\multiput" + "\\newcommand" + "\\newcounter" + "\\newenvironment" + "\\newfont" + "\\newlength" + "\\newline" + "\\newpage" + "\\newsavebox" + "\\newtheorem" + "\\nocite" + "\\nofiles" + "\\noindent" + "\\nolinebreak" + "\\nopagebreak" + "\\normalsize" + "\\onecolumn" + "\\opening" + "\\oval" + "\\overbrace" + "\\overline" + "\\pagebreak" + "\\pagenumbering" + "\\pageref" + "\\pagestyle" + "\\par" + "\\parbox" + "\\put" + "\\raggedbottom" + "\\raggedleft" + "\\raggedright" + "\\raisebox" + "\\ref" + "\\rm" + "\\roman" + "\\rule" + "\\savebox" + "\\sc" + "\\scriptsize" + "\\setcounter" + "\\setlength" + "\\settowidth" + "\\sf" + "\\shortstack" + "\\signature" + "\\sl" + "\\small" + "\\smallskip" + "\\sqrt" + "\\tableofcontents" + "\\telephone" + "\\thanks" + "\\thispagestyle" + "\\tiny" + "\\title" + "\\tt" + "\\twocolumn" + "\\typein" + "\\typeout" + "\\underbrace" + "\\underline" + "\\usebox" + "\\usecounter" + "\\value" + "\\vdots" + "\\vector" + "\\verb" + "\\vfill" + "\\vline" + "\\vspace") + "A list of LaTeX commands to be protected when performing conversion.") + (provide 'org-export-latex) ;; 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 @@ +;;; org-mouse.el --- Better mouse support for org-mode + +;; Copyright (C) 2006, 2007, 2008 Free Software Foundation +;; +;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com> +;; Maintainer: Carsten Dominik <carsten at orgmode dot org> +;; Version: 5.19 +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; Org-mouse provides mouse support for org-mode. +;; +;; http://orgmode.org +;; +;; Org-mouse implements the following features: +;; * following links with the left mouse button (in Emacs 22) +;; * subtree expansion/collapse (org-cycle) with the left mouse button +;; * several context menus on the right mouse button: +;; + general text +;; + headlines +;; + timestamps +;; + priorities +;; + links +;; + tags +;; * promoting/demoting/moving subtrees with mouse-3 +;; + if the drag starts and ends in the same line then promote/demote +;; + otherwise move the subtree +;; +;; Use +;; --- +;; +;; To use this package, put the following line in your .emacs: +;; +;; (require 'org-mouse) +;; + +;; Fixme: +;; + deal with folding / unfolding issues + +;; TODO (This list is only theoretical, if you'd like to have some +;; feature implemented or a bug fix please send me an email, even if +;; something similar appears in the list below. This will help me get +;; the priorities right.): +;; +;; + org-store-link, insert link +;; + org tables +;; + occur with the current word/tag (same menu item) +;; + ctrl-c ctrl-c, for example, renumber the current list +;; + internal links + +;; Please email the maintainer with new feature suggestions / bugs + +;; History: +;; +;; SInce version 5.10: Changes are listed in the general org-mode docs. +;; +;; Version 5.09 +;; + Version number synchronization with Org-mode. +;; +;; Version 0.25 +;; + made compatible with org-mode 4.70 (thanks to Carsten for the patch) +;; +;; Version 0.24 +;; + minor changes to the table menu +;; +;; Version 0.23 +;; + preliminary support for tables and calculation marks +;; + context menu support for org-agenda-undo & org-sort-entries +;; +;; Version 0.22 +;; + handles undo support for the agenda buffer (requires org-mode >=4.58) +;; +;; Version 0.21 +;; + selected text activates its context menu +;; + shift-middleclick or right-drag inserts the text from the clipboard in the form of a link +;; +;; Version 0.20 +;; + the new "TODO Status" submenu replaces the "Cycle TODO" menu item +;; + the TODO menu can now list occurrences of a specific TODO keyword +;; + #+STARTUP line is now recognized +;; +;; Version 0.19 +;; + added support for dragging URLs to the org-buffer +;; +;; Version 0.18 +;; + added support for agenda blocks +;; +;; Version 0.17 +;; + toggle checkboxes with a single click +;; +;; Version 0.16 +;; + added support for checkboxes +;; +;; Version 0.15 +;; + org-mode now works with the Agenda buffer as well +;; +;; Version 0.14 +;; + added a menu option that converts plain list items to outline items +;; +;; Version 0.13 +;; + "Insert Heading" now inserts a sibling heading if the point is +;; on "***" and a child heading otherwise +;; +;; Version 0.12 +;; + compatible with Emacs 21 +;; + custom agenda commands added to the main menu +;; + moving trees should now work between windows in the same frame +;; +;; Version 0.11 +;; + fixed org-mouse-at-link (thanks to Carsten) +;; + removed [follow-link] bindings +;; +;; Version 0.10 +;; + added a menu option to remove highlights +;; + compatible with org-mode 4.21 now +;; +;; Version 0.08: +;; + trees can be moved/promoted/demoted by dragging with the right +;; mouse button (mouse-3) +;; + small changes in the above function +;; +;; Versions 0.01 -- 0.07: (I don't remember) + +(eval-when-compile (require 'cl)) +(require 'org) + +(defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " + "Regular expression that matches a plain list.") +(defvar org-mouse-direct t + "Internal variable indicating whether the current action is direct. + +If t, then the current action has been invoked directly through the buffer +it is intended to operate on. If nil, then the action has been invoked +indirectly, for example, through the agenda buffer.") + +(defgroup org-mouse nil + "Mouse support for org-mode." + :tag "Org Mouse" + :group 'org) + +(defcustom org-mouse-punctuation ":" + "Punctuation used when inserting text by drag and drop." + :group 'org-mouse + :type 'string) + + +(defun org-mouse-re-search-line (regexp) + "Search the current line for a given regular expression." + (beginning-of-line) + (re-search-forward regexp (point-at-eol) t)) + +(defun org-mouse-end-headline () + "Go to the end of current headline (ignoring tags)." + (interactive) + (end-of-line) + (skip-chars-backward "\t ") + (when (looking-back ":[A-Za-z]+:") + (skip-chars-backward ":A-Za-z") + (skip-chars-backward "\t "))) + +(defvar org-mouse-context-menu-function nil + "Function to create the context menu. +The value of this variable is the function invoked by +`org-mouse-context-menu' as the context menu.") +(make-variable-buffer-local 'org-mouse-context-menu-function) + +(defun org-mouse-show-context-menu (event prefix) + "Invoke the context menu. + +If the value of `org-mouse-context-menu-function' is a function, then +this function is called. Otherwise, the current major mode menu is used." + (interactive "@e \nP") + (if (and (= (event-click-count event) 1) + (or (not mark-active) + (sit-for (/ double-click-time 1000.0)))) + (progn + (select-window (posn-window (event-start event))) + (when (not (org-mouse-mark-active)) + (goto-char (posn-point (event-start event))) + (when (not (eolp)) (save-excursion (run-hooks 'post-command-hook))) + (let ((redisplay-dont-pause t)) + (sit-for 0))) + (if (functionp org-mouse-context-menu-function) + (funcall org-mouse-context-menu-function event) + (mouse-major-mode-menu event prefix))) + (setq this-command 'mouse-save-then-kill) + (mouse-save-then-kill event))) + + +(defun org-mouse-line-position () + "Returns `:beginning' or `:middle' or `:end', depending on the point position. + +If the point is at the end of the line, return `:end'. +If the point is separated from the beginning of the line only by white +space and *'s (`org-mouse-bolp'), return `:beginning'. Otherwise, +return `:middle'." + (cond + ((eolp) :end) + ((org-mouse-bolp) :beginning) + (t :middle))) + +(defun org-mouse-empty-line () + "Return non-nil iff the line contains only white space." + (save-excursion (beginning-of-line) (looking-at "[ \t]*$"))) + +(defun org-mouse-next-heading () + "Go to the next heading. +If there is none, ensure that the point is at the beginning of an empty line." + (unless (outline-next-heading) + (beginning-of-line) + (unless (org-mouse-empty-line) + (end-of-line) + (newline)))) + +(defun org-mouse-insert-heading () + "Insert a new heading, as `org-insert-heading'. + +If the point is at the :beginning (`org-mouse-line-position') of the line, +insert the new heading before the current line. Otherwise, insert it +after the current heading." + (interactive) + (case (org-mouse-line-position) + (:beginning (beginning-of-line) + (org-insert-heading)) + (t (org-mouse-next-heading) + (org-insert-heading)))) + +(defun org-mouse-timestamp-today (&optional shift units) + "Change the timestamp into SHIFT UNITS in the future. + +For the acceptable UNITS, see `org-timestamp-change'." + (interactive) + (flet ((org-read-date (&rest rest) (current-time))) + (org-time-stamp nil)) + (when shift + (org-timestamp-change shift units))) + +(defun org-mouse-keyword-menu (keywords function &optional selected itemformat) + "A helper function. + +Returns a menu fragment consisting of KEYWORDS. When a keyword +is selected by the user, FUNCTION is called with the selected +keyword as the only argument. + +If SELECTED is nil, then all items are normal menu items. If +SELECTED is a function, then each item is a checkbox, which is +enabled for a given keyword iff (funcall SELECTED keyword) return +non-nil. If SELECTED is neither nil nor a function, then the +items are radio buttons. A radio button is enabled for the +keyword `equal' to SELECTED. + +ITEMFORMAT governs formatting of the elements of KEYWORDS. If it +is a function, it is invoked with the keyword as the only +argument. If it is a string, it is interpreted as the format +string to (format ITEMFORMAT keyword). If it is neither a string +nor a function, elements of KEYWORDS are used directly. " + (mapcar + `(lambda (keyword) + (vector (cond + ((functionp ,itemformat) (funcall ,itemformat keyword)) + ((stringp ,itemformat) (format ,itemformat keyword)) + (t keyword)) + (list 'funcall ,function keyword) + :style (cond + ((null ,selected) t) + ((functionp ,selected) 'toggle) + (t 'radio)) + :selected (if (functionp ,selected) + (and (funcall ,selected keyword) t) + (equal ,selected keyword)))) + keywords)) + +(defun org-mouse-remove-match-and-spaces () + "Remove the match, make just one space around the point." + (interactive) + (replace-match "") + (just-one-space)) + +(defvar rest) +(defun org-mouse-replace-match-and-surround (newtext &optional fixedcase + literal string subexp) + "The same as `replace-match', but surrounds the replacement with spaces." + (apply 'replace-match rest) + (save-excursion + (goto-char (match-beginning (or subexp 0))) + (just-one-space) + (goto-char (match-end (or subexp 0))) + (just-one-space))) + + +(defun org-mouse-keyword-replace-menu (keywords &optional group itemformat + nosurround) + "A helper function. + +Returns a menu fragment consisting of KEYWORDS. When a keyword +is selected, group GROUP of the current match is replaced by the +keyword. The method ensures that both ends of the replacement +are separated from the rest of the text in the buffer by +individual spaces (unless NOSURROND is non-nil). + +The final entry of the menu is always \"None\", which removes the +match. + +ITEMFORMAT governs formatting of the elements of KEYWORDS. If it +is a function, it is invoked with the keyword as the only +argument. If it is a string, it is interpreted as the format +string to (format ITEMFORMAT keyword). If it is neither a string +nor a function, elements of KEYWORDS are used directly. +" + (setq group (or group 0)) + (let ((replace (org-mouse-match-closure + (if nosurround 'replace-match + 'org-mouse-replace-match-and-surround)))) + (append + (org-mouse-keyword-menu + keywords + `(lambda (keyword) (funcall ,replace keyword t t nil ,group)) + (match-string group) + itemformat) + `(["None" org-mouse-remove-match-and-spaces + :style radio + :selected ,(not (member (match-string group) keywords))])))) + +(defun org-mouse-show-headlines () + "Change the visibility of the current org buffer to only show headlines." + (interactive) + (let ((this-command 'org-cycle) + (last-command 'org-cycle) + (org-cycle-global-status nil)) + (org-cycle '(4)) + (org-cycle '(4)))) + +(defun org-mouse-show-overview () + "Change visibility of current org buffer to first-level headlines only." + (interactive) + (let ((org-cycle-global-status nil)) + (org-cycle '(4)))) + +(defun org-mouse-set-priority (priority) + "Set the priority of the current headline to PRIORITY." + (flet ((read-char-exclusive () priority)) + (org-priority))) + +(defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]" + "Regular expression matching the priority indicator. +Differs from `org-priority-regexp' in that it doesn't contain the +leading '.*?'.") + +(defun org-mouse-get-priority (&optional default) + "Return the priority of the current headline. +DEFAULT is returned if no priority is given in the headline." + (save-excursion + (if (org-mouse-re-search-line org-mouse-priority-regexp) + (match-string 1) + (when default (char-to-string org-default-priority))))) + +;; (defun org-mouse-at-link () +;; (and (eq (get-text-property (point) 'face) 'org-link) +;; (save-excursion +;; (goto-char (previous-single-property-change (point) 'face)) +;; (or (looking-at org-bracket-link-regexp) +;; (looking-at org-angle-link-re) +;; (looking-at org-plain-link-re))))) + + +(defun org-mouse-delete-timestamp () + "Deletes the current timestamp as well as the preceding keyword. +SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" + (when (or (org-at-date-range-p) (org-at-timestamp-p)) + (replace-match "") ; delete the timestamp + (skip-chars-backward " :A-Z") + (when (looking-at " *[A-Z][A-Z]+:") + (replace-match "")))) + +(defun org-mouse-looking-at (regexp skipchars &optional movechars) + (save-excursion + (let ((point (point))) + (if (looking-at regexp) t + (skip-chars-backward skipchars) + (forward-char (or movechars 0)) + (when (looking-at regexp) + (> (match-end 0) point)))))) + +(defun org-mouse-priority-list () + (loop for priority from ?A to org-lowest-priority + collect (char-to-string priority))) + +(defun org-mouse-tag-menu () ;todo + (append + (let ((tags (org-split-string (org-get-tags) ":"))) + (org-mouse-keyword-menu + (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) + `(lambda (tag) + (org-mouse-set-tags + (sort (if (member tag (quote ,tags)) + (delete tag (quote ,tags)) + (cons tag (quote ,tags))) + 'string-lessp))) + `(lambda (tag) (member tag (quote ,tags))) + )) + '("--" + ["Align Tags Here" (org-set-tags nil t) t] + ["Align Tags in Buffer" (org-set-tags t t) t] + ["Set Tags ..." (org-set-tags) t]))) + + + +(defun org-mouse-set-tags (tags) + (save-excursion + ;; remove existing tags first + (beginning-of-line) + (when (org-mouse-re-search-line ":\\(\\([A-Za-z_]+:\\)+\\)") + (replace-match "")) + + ;; set new tags if any + (when tags + (end-of-line) + (insert " :" (mapconcat 'identity tags ":") ":") + (org-set-tags nil t)))) + +(defun org-mouse-insert-checkbox () + (interactive) + (and (org-at-item-p) + (goto-char (match-end 0)) + (unless (org-at-item-checkbox-p) + (delete-horizontal-space) + (insert " [ ] ")))) + +(defun org-mouse-agenda-type (type) + (case type + ('tags "Tags: ") + ('todo "TODO: ") + ('tags-tree "Tags tree: ") + ('todo-tree "TODO tree: ") + ('occur-tree "Occur tree: ") + (t "Agenda command ???"))) + + +(defun org-mouse-list-options-menu (alloptions &optional function) + (let ((options (save-match-data + (split-string (match-string-no-properties 1))))) + (print options) + (loop for name in alloptions + collect + (vector name + `(progn + (replace-match + (mapconcat 'identity + (sort (if (member ',name ',options) + (delete ',name ',options) + (cons ',name ',options)) + 'string-lessp) + " ") + nil nil nil 1) + (when (functionp ',function) (funcall ',function))) + :style 'toggle + :selected (and (member name options) t))))) + +(defun org-mouse-clip-text (text maxlength) + (if (> (length text) maxlength) + (concat (substring text 0 (- maxlength 3)) "...") + text)) + +(defun org-mouse-popup-global-menu () + (popup-menu + `("Main Menu" + ["Show Overview" org-mouse-show-overview t] + ["Show Headlines" org-mouse-show-headlines t] + ["Show All" show-all t] + ["Remove Highlights" org-remove-occur-highlights + :visible org-occur-highlights] + "--" + ["Check Deadlines" + (if (functionp 'org-check-deadlines-and-todos) + (org-check-deadlines-and-todos org-deadline-warning-days) + (org-check-deadlines org-deadline-warning-days)) t] + ["Check TODOs" org-show-todo-tree t] + ("Check Tags" + ,@(org-mouse-keyword-menu + (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) + '(lambda (tag) (org-tags-sparse-tree nil tag))) + "--" + ["Custom Tag ..." org-tags-sparse-tree t]) + ["Check Phrase ..." org-occur] + "--" + ["Display Agenda" org-agenda-list t] + ["Display Timeline" org-timeline t] + ["Display TODO List" org-todo-list t] + ("Display Tags" + ,@(org-mouse-keyword-menu + (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) + '(lambda (tag) (org-tags-view nil tag))) + "--" + ["Custom Tag ..." org-tags-view t]) + ["Display Calendar" org-goto-calendar t] + "--" + ,@(org-mouse-keyword-menu + (mapcar 'car org-agenda-custom-commands) + '(lambda (key) + (eval `(flet ((read-char-exclusive () (string-to-char ,key))) + (org-agenda nil)))) + nil + '(lambda (key) + (let ((entry (assoc key org-agenda-custom-commands))) + (org-mouse-clip-text + (cond + ((stringp (nth 1 entry)) (nth 1 entry)) + ((stringp (nth 2 entry)) + (concat (org-mouse-agenda-type (nth 1 entry)) + (nth 2 entry))) + (t "Agenda Command '%s'")) + 30)))) + "--" + ["Delete Blank Lines" delete-blank-lines + :visible (org-mouse-empty-line)] + ["Insert Checkbox" org-mouse-insert-checkbox + :visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))] + ["Insert Checkboxes" + (org-mouse-for-each-item 'org-mouse-insert-checkbox) + :visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))] + ["Plain List to Outline" org-mouse-transform-to-outline + :visible (org-at-item-p)]))) + + +(defun org-mouse-get-context (contextlist context) + (let ((contextdata (assq context contextlist))) + (when contextdata + (save-excursion + (goto-char (second contextdata)) + (re-search-forward ".*" (third contextdata)))))) + +(defun org-mouse-for-each-item (function) + (save-excursion + (ignore-errors + (while t (org-previous-item))) + (ignore-errors + (while t + (funcall function) + (org-next-item))))) + +(defun org-mouse-bolp () + "Returns true if there only spaces, tabs, and '*', between the beginning of line and the point" + (save-excursion + (skip-chars-backward " \t*") (bolp))) + +(defun org-mouse-insert-item (text) + (case (org-mouse-line-position) + (:beginning ; insert before + (beginning-of-line) + (looking-at "[ \t]*") + (open-line 1) + (indent-to (- (match-end 0) (match-beginning 0))) + (insert "+ ")) + + (:middle ; insert after + (end-of-line) + (newline t) + (indent-relative) + (insert "+ ")) + + (:end ; insert text here + (skip-chars-backward " \t") + (kill-region (point) (point-at-eol)) + (unless (looking-back org-mouse-punctuation) + (insert (concat org-mouse-punctuation " "))))) + + (insert text) + (beginning-of-line)) + +(defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate) + (if (eq major-mode 'org-mode) + (org-mouse-insert-item text) + ad-do-it)) + +(defadvice dnd-open-file (around org-mouse-dnd-open-file activate) + (if (eq major-mode 'org-mode) + (org-mouse-insert-item uri) + ad-do-it)) + +(defun org-mouse-match-closure (function) + (let ((match (match-data t))) + `(lambda (&rest rest) + (save-match-data + (set-match-data ',match) + (apply ',function rest))))) + +(defun org-mouse-todo-keywords () + (if (boundp 'org-todo-keywords-1) org-todo-keywords-1 org-todo-keywords)) + +(defun org-mouse-match-todo-keyword () + (save-excursion + (org-back-to-heading) + (if (looking-at outline-regexp) (goto-char (match-end 0))) + (or (looking-at (concat " +" org-todo-regexp " *")) + (looking-at " \\( *\\)")))) + +(defun org-mouse-yank-link (click) + (interactive "e") + ;; Give temporary modes such as isearch a chance to turn off. + (run-hooks 'mouse-leave-buffer-hook) + (mouse-set-point click) + (setq mouse-selection-click-count 0) + (delete-horizontal-space) + (insert-for-yank (concat " [[" (current-kill 0) "]] "))) + +(defun org-mouse-context-menu (&optional event) + (let ((stamp-prefixes (list org-deadline-string org-scheduled-string)) + (contextlist (org-context))) + (flet ((get-context (context) (org-mouse-get-context contextlist context))) + (cond + ((org-mouse-mark-active) + (let ((region-string (buffer-substring (region-beginning) (region-end)))) + (popup-menu + `(nil + ["Sparse Tree" (org-occur ',region-string)] + ["Find in Buffer" (occur ',region-string)] + ["Grep in Current Dir" + (grep (format "grep -rnH -e '%s' *" ',region-string))] + ["Grep in Parent Dir" + (grep (format "grep -rnH -e '%s' ../*" ',region-string))] + "--" + ["Convert to Link" + (progn (save-excursion (goto-char (region-beginning)) (insert "[[")) + (save-excursion (goto-char (region-end)) (insert "]]")))] + ["Insert Link Here" (org-mouse-yank-link ',event)])))) + + ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)")) + (popup-menu + `(nil + ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options) + 'org-mode-restart)))) + ((or (eolp) + (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$") + (looking-back " \\|\t"))) + (org-mouse-popup-global-menu)) + ((get-context :checkbox) + (popup-menu + '(nil + ["Toggle" org-toggle-checkbox t] + ["Remove" org-mouse-remove-match-and-spaces t] + "" + ["All Clear" (org-mouse-for-each-item + (lambda () + (when (save-excursion (org-at-item-checkbox-p)) + (replace-match "[ ]"))))] + ["All Set" (org-mouse-for-each-item + (lambda () + (when (save-excursion (org-at-item-checkbox-p)) + (replace-match "[X]"))))] + ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t] + ["All Remove" (org-mouse-for-each-item + (lambda () + (when (save-excursion (org-at-item-checkbox-p)) + (org-mouse-remove-match-and-spaces))))] + ))) + ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_") + (member (match-string 0) (org-mouse-todo-keywords))) + (popup-menu + `(nil + ,@(org-mouse-keyword-replace-menu (org-mouse-todo-keywords)) + "--" + ["Check TODOs" org-show-todo-tree t] + ["List all TODO keywords" org-todo-list t] + [,(format "List only %s" (match-string 0)) + (org-todo-list (match-string 0)) t] + ))) + ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z") + (member (match-string 0) stamp-prefixes)) + (popup-menu + `(nil + ,@(org-mouse-keyword-replace-menu stamp-prefixes) + "--" + ["Check Deadlines" org-check-deadlines t] + ))) + ((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority + (popup-menu `(nil ,@(org-mouse-keyword-replace-menu + (org-mouse-priority-list) 1 "Priority %s" t)))) + ((get-context :link) + (popup-menu + '(nil + ["Open" org-open-at-point t] + ["Open in Emacs" (org-open-at-point t) t] + "--" + ["Copy link" (kill-new (match-string 0))] + ["Cut link" + (progn + (kill-region (match-beginning 0) (match-end 0)) + (just-one-space))] + "--" + ["Grep for TODOs" + (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))] +; ["Paste file link" ((insert "file:") (yank))] + ))) + ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags + (popup-menu + `(nil + [,(format "Display '%s'" (match-string 1)) + (org-tags-view nil ,(match-string 1))] + [,(format "Sparse Tree '%s'" (match-string 1)) + (org-tags-sparse-tree nil ,(match-string 1))] + "--" + ,@(org-mouse-tag-menu)))) + ((org-at-timestamp-p) + (popup-menu + '(nil + ["Show Day" org-open-at-point t] + ["Change Timestamp" org-time-stamp t] + ["Delete Timestamp" (org-mouse-delete-timestamp) t] + ["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)] + "--" + ["Set for Today" org-mouse-timestamp-today] + ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)] + ["Set in 1 Week" (org-mouse-timestamp-today 7 'day)] + ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)] + ["Set in a Month" (org-mouse-timestamp-today 1 'month)] + "--" + ["+ 1 Day" (org-timestamp-change 1 'day)] + ["+ 1 Week" (org-timestamp-change 7 'day)] + ["+ 1 Month" (org-timestamp-change 1 'month)] + "--" + ["- 1 Day" (org-timestamp-change -1 'day)] + ["- 1 Week" (org-timestamp-change -7 'day)] + ["- 1 Month" (org-timestamp-change -1 'month)]))) + ((get-context :table-special) + (let ((mdata (match-data))) + (incf (car mdata) 2) + (store-match-data mdata)) + (message "match: %S" (match-string 0)) + (popup-menu `(nil ,@(org-mouse-keyword-replace-menu + '(" " "!" "^" "_" "$" "#" "*" "'") 0 + (lambda (mark) + (case (string-to-char mark) + (? "( ) Nothing Special") + (?! "(!) Column Names") + (?^ "(^) Field Names Above") + (?_ "(^) Field Names Below") + (?$ "($) Formula Parameters") + (?# "(#) Recalculation: Auto") + (?* "(*) Recalculation: Manual") + (?' "(') Recalculation: None"))) t)))) + ((assq :table contextlist) + (popup-menu + '(nil + ["Align Table" org-ctrl-c-ctrl-c] + ["Blank Field" org-table-blank-field] + ["Edit Field" org-table-edit-field] + "--" + ("Column" + ["Move Column Left" org-metaleft] + ["Move Column Right" org-metaright] + ["Delete Column" org-shiftmetaleft] + ["Insert Column" org-shiftmetaright] + "--" + ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle]) + ("Row" + ["Move Row Up" org-metaup] + ["Move Row Down" org-metadown] + ["Delete Row" org-shiftmetaup] + ["Insert Row" org-shiftmetadown] + ["Sort lines in region" org-table-sort-lines (org-at-table-p)] + "--" + ["Insert Hline" org-table-insert-hline]) + ("Rectangle" + ["Copy Rectangle" org-copy-special] + ["Cut Rectangle" org-cut-special] + ["Paste Rectangle" org-paste-special] + ["Fill Rectangle" org-table-wrap-region]) + "--" + ["Set Column Formula" org-table-eval-formula] + ["Set Field Formula" (org-table-eval-formula '(4))] + ["Edit Formulas" org-table-edit-formulas] + "--" + ["Recalculate Line" org-table-recalculate] + ["Recalculate All" (org-table-recalculate '(4))] + ["Iterate All" (org-table-recalculate '(16))] + "--" + ["Toggle Recalculate Mark" org-table-rotate-recalc-marks] + ["Sum Column/Rectangle" org-table-sum + :active (or (org-at-table-p) (org-region-active-p))] + ["Field Info" org-table-field-info] + ["Debug Formulas" + (setq org-table-formula-debug (not org-table-formula-debug)) + :style toggle :selected org-table-formula-debug] + ))) + ((and (assq :headline contextlist) (not (eolp))) + (let ((priority (org-mouse-get-priority t))) + (popup-menu + `("Headline Menu" + ("Tags and Priorities" + ,@(org-mouse-keyword-menu + (org-mouse-priority-list) + '(lambda (keyword) + (org-mouse-set-priority (string-to-char keyword))) + priority "Priority %s") + "--" + ,@(org-mouse-tag-menu)) + ("TODO Status" + ,@(progn (org-mouse-match-todo-keyword) + (org-mouse-keyword-replace-menu (org-mouse-todo-keywords) + 1))) + ["Show Tags" + (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags)) + :visible (not org-mouse-direct)] + ["Show Priority" + (with-current-buffer org-mouse-main-buffer (org-agenda-show-priority)) + :visible (not org-mouse-direct)] + ,@(if org-mouse-direct '("--") nil) + ["New Heading" org-mouse-insert-heading :visible org-mouse-direct] + ["Set Deadline" + (progn (org-mouse-end-headline) (insert " ") (org-deadline)) + :active (not (save-excursion + (org-mouse-re-search-line org-deadline-regexp)))] + ["Schedule Task" + (progn (org-mouse-end-headline) (insert " ") (org-schedule)) + :active (not (save-excursion + (org-mouse-re-search-line org-scheduled-regexp)))] + ["Insert Timestamp" + (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t] +; ["Timestamp (inactive)" org-time-stamp-inactive t] + "--" + ["Archive Subtree" org-archive-subtree] + ["Cut Subtree" org-cut-special] + ["Copy Subtree" org-copy-special] + ["Paste Subtree" org-paste-special :visible org-mouse-direct] + ("Sort Children" + ["Alphabetically" (org-sort-entries nil ?a)] + ["Numerically" (org-sort-entries nil ?n)] + ["By Time/Date" (org-sort-entries nil ?t)] + "--" + ["Reverse Alphabetically" (org-sort-entries nil ?A)] + ["Reverse Numerically" (org-sort-entries nil ?N)] + ["Reverse By Time/Date" (org-sort-entries nil ?T)]) + "--" + ["Move Trees" org-mouse-move-tree :active nil] + )))) + (t + (org-mouse-popup-global-menu)))))) + +;; (defun org-mouse-at-regexp (regexp) +;; (save-excursion +;; (let ((point (point)) +;; (bol (progn (beginning-of-line) (point))) +;; (eol (progn (end-of-line) (point)))) +;; (goto-char point) +;; (re-search-backward regexp bol 1) +;; (and (not (eolp)) +;; (progn (forward-char) +;; (re-search-forward regexp eol t)) +;; (<= (match-beginning 0) point))))) + +(defun org-mouse-mark-active () + (and mark-active transient-mark-mode)) + +(defun org-mouse-in-region-p (pos) + (and (org-mouse-mark-active) + (>= pos (region-beginning)) + (< pos (region-end)))) + +(defun org-mouse-down-mouse (event) + (interactive "e") + (setq this-command last-command) + (unless (and (= 1 (event-click-count event)) + (org-mouse-in-region-p (posn-point (event-start event)))) + (mouse-drag-region event))) + +(add-hook 'org-mode-hook + '(lambda () + (setq org-mouse-context-menu-function 'org-mouse-context-menu) + +; (define-key org-mouse-map [follow-link] 'mouse-face) + (define-key org-mouse-map (if (featurep 'xemacs) [button3] [mouse-3]) nil) + (define-key org-mode-map [mouse-3] 'org-mouse-show-context-menu) + (define-key org-mode-map [down-mouse-1] 'org-mouse-down-mouse) + (define-key org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree) + (define-key org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start) + (define-key org-mode-map [S-mouse-2] 'org-mouse-yank-link) + (define-key org-mode-map [drag-mouse-3] 'org-mouse-yank-link) + (define-key org-mouse-map [drag-mouse-3] 'org-mouse-move-tree) + (define-key org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start) + + (font-lock-add-keywords nil + `((,outline-regexp + 0 `(face org-link mouse-face highlight keymap ,org-mouse-map) + 'prepend) + ("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +" + (1 `(face org-link keymap ,org-mouse-map mouse-face highlight) 'prepend)) + ("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)" + (2 `(face bold keymap ,org-mouse-map mouse-face highlight) t))) + t) + + (defadvice org-open-at-point (around org-mouse-open-at-point activate) + (let ((context (org-context))) + (cond + ((assq :headline-stars context) (org-cycle)) + ((assq :checkbox context) (org-toggle-checkbox)) + ((assq :item-bullet context) + (let ((org-cycle-include-plain-lists t)) (org-cycle))) + (t ad-do-it)))))) + +(defun org-mouse-move-tree-start (event) + (interactive "e") + (message "Same line: promote/demote, (***):move before, (text): make a child")) + + +(defun org-mouse-make-marker (position) + (with-current-buffer (window-buffer (posn-window position)) + (copy-marker (posn-point position)))) + +(defun org-mouse-move-tree (event) + ;; todo: handle movements between different buffers + (interactive "e") + (save-excursion + (let* ((start (org-mouse-make-marker (event-start event))) + (end (org-mouse-make-marker (event-end event))) + (sbuf (marker-buffer start)) + (ebuf (marker-buffer end))) + + (when (and sbuf ebuf) + (set-buffer sbuf) + (goto-char start) + (org-back-to-heading) + (if (and (eq sbuf ebuf) + (equal + (point) + (save-excursion (goto-char end) (org-back-to-heading) (point)))) + ;; if the same line then promote/demote + (if (>= end start) (org-demote-subtree) (org-promote-subtree)) + ;; if different lines then move + (org-cut-subtree) + + (set-buffer ebuf) + (goto-char end) + (org-back-to-heading) + (when (and (eq sbuf ebuf) + (equal + (point) + (save-excursion (goto-char start) + (org-back-to-heading) (point)))) + (outline-end-of-subtree) + (end-of-line) + (if (eobp) (newline) (forward-char))) + + (when (looking-at outline-regexp) + (let ((level (- (match-end 0) (match-beginning 0)))) + (when (> end (match-end 0)) + (outline-end-of-subtree) + (end-of-line) + (if (eobp) (newline) (forward-char)) + (setq level (1+ level))) + (org-paste-subtree level) + (save-excursion + (outline-end-of-subtree) + (when (bolp) (delete-char -1)))))))))) + + +(defun org-mouse-transform-to-outline () + (interactive) + (org-back-to-heading) + (let ((minlevel 1000) + (replace-text (concat (match-string 0) "* "))) + (beginning-of-line 2) + (save-excursion + (while (not (or (eobp) (looking-at outline-regexp))) + (when (looking-at org-mouse-plain-list-regexp) + (setq minlevel (min minlevel (- (match-end 1) (match-beginning 1))))) + (forward-line))) + (while (not (or (eobp) (looking-at outline-regexp))) + (when (and (looking-at org-mouse-plain-list-regexp) + (eq minlevel (- (match-end 1) (match-beginning 1)))) + (replace-match replace-text)) + (forward-line)))) + +(defvar _cmd) ;dynamically scoped from `org-with-remote-undo'. + +(defun org-mouse-do-remotely (command) +; (org-agenda-check-no-diary) + (when (get-text-property (point) 'org-marker) + (let* ((anticol (- (point-at-eol) (point))) + (marker (get-text-property (point) 'org-marker)) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + (hdmarker (get-text-property (point) 'org-hd-marker)) + (buffer-read-only nil) + (newhead "--- removed ---") + (org-mouse-direct nil) + (org-mouse-main-buffer (current-buffer))) + (when (eq (with-current-buffer buffer major-mode) 'org-mode) + (let ((endmarker (save-excursion + (set-buffer buffer) + (outline-end-of-subtree) + (forward-char 1) + (copy-marker (point))))) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-hidden-entry) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil))) ; show the next heading + (org-back-to-heading) + (setq marker (copy-marker (point))) + (goto-char (max (point-at-bol) (- (point-at-eol) anticol))) + (funcall command) + (message "_cmd: %S" _cmd) + (message "this-command: %S" this-command) + (unless (eq (marker-position marker) (marker-position endmarker)) + (setq newhead (org-get-heading)))) + + (beginning-of-line 1) + (save-excursion + (org-agenda-change-all-lines newhead hdmarker 'fixface)))) + t)))) + +(defun org-mouse-agenda-context-menu (&optional event) + (or (org-mouse-do-remotely 'org-mouse-context-menu) + (popup-menu + '("Agenda" + ("Agenda Files") + "--" + ["Undo" (progn (message "last command: %S" last-command) (setq this-command 'org-agenda-undo) (org-agenda-undo)) + :visible (if (eq last-command 'org-agenda-undo) + org-agenda-pending-undo-list + org-agenda-undo-list)] + ["Rebuild Buffer" org-agenda-redo t] + ["New Diary Entry" + org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline) t] + "--" + ["Goto Today" org-agenda-goto-today + (org-agenda-check-type nil 'agenda 'timeline) t] + ["Display Calendar" org-agenda-goto-calendar + (org-agenda-check-type nil 'agenda 'timeline) t] + ("Calendar Commands" + ["Phases of the Moon" org-agenda-phases-of-moon + (org-agenda-check-type nil 'agenda 'timeline)] + ["Sunrise/Sunset" org-agenda-sunrise-sunset + (org-agenda-check-type nil 'agenda 'timeline)] + ["Holidays" org-agenda-holidays + (org-agenda-check-type nil 'agenda 'timeline)] + ["Convert" org-agenda-convert-date + (org-agenda-check-type nil 'agenda 'timeline)] + "--" + ["Create iCalendar file" org-export-icalendar-combine-agenda-files t]) + "--" + ["Day View" org-agenda-day-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (equal org-agenda-ndays 1)] + ["Week View" org-agenda-week-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (equal org-agenda-ndays 7)] + "--" + ["Show Logbook entries" org-agenda-log-mode + :style toggle :selected org-agenda-show-log + :active (org-agenda-check-type nil 'agenda 'timeline)] + ["Include Diary" org-agenda-toggle-diary + :style toggle :selected org-agenda-include-diary + :active (org-agenda-check-type nil 'agenda)] + ["Use Time Grid" org-agenda-toggle-time-grid + :style toggle :selected org-agenda-use-time-grid + :active (org-agenda-check-type nil 'agenda)] + ["Follow Mode" org-agenda-follow-mode + :style toggle :selected org-agenda-follow-mode] + "--" + ["Quit" org-agenda-quit t] + ["Exit and Release Buffers" org-agenda-exit t] + )))) + +(defun org-mouse-get-gesture (event) + (let ((startxy (posn-x-y (event-start event))) + (endxy (posn-x-y (event-end event)))) + (if (< (car startxy) (car endxy)) :right :left))) + + +; (setq org-agenda-mode-hook nil) +(add-hook 'org-agenda-mode-hook + '(lambda () + (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) + (define-key org-agenda-keymap + (if (featurep 'xemacs) [button3] [mouse-3]) + 'org-mouse-show-context-menu) + (define-key org-agenda-keymap [down-mouse-3] 'org-mouse-move-tree-start) + (define-key org-agenda-keymap [C-mouse-4] 'org-agenda-earlier) + (define-key org-agenda-keymap [C-mouse-5] 'org-agenda-later) + (define-key org-agenda-keymap [drag-mouse-3] + '(lambda (event) (interactive "e") + (case (org-mouse-get-gesture event) + (:left (org-agenda-earlier 1)) + (:right (org-agenda-later 1))))))) + +(provide 'org-mouse) + +;; 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 @@ ;;; org-publish.el --- publish related org-mode files as a website -;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. ;; Author: David O'Toole <dto@gnu.org> ;; Keywords: hypermedia, outlines -;; Version: 1.80a +;; Version: 1.80b -;; This file is free software; you can redistribute it and/or modify +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. -;; This file is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. -;; This file is part of GNU Emacs. - ;;; Commentary: ;; Requires at least version 4.27 of org.el @@ -572,11 +572,10 @@ default is 'index.org'." With prefix argument, force publishing all files in project." (interactive "P") (save-window-excursion - (let* ((project-name (org-publish-get-project-from-filename (buffer-file-name))) - (org-publish-use-timestamps-flag (if force nil t))) + (let* ((project-name (org-publish-get-project-from-filename (buffer-file-name)))) (if (not project-name) (error "File %s is not part of any known project." (buffer-file-name))) - (org-publish project-name)))) + (org-publish project-name (if force nil t))))) ;;;###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 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 5.13i +;; Version: 5.19a ;; ;; This file is part of GNU Emacs. ;; @@ -77,13 +77,14 @@ (require 'outline) (require 'noutline) ;; Other stuff we need. (require 'time-date) +(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) (require 'easymenu) ;;;; Customization variables ;;; Version -(defconst org-version "5.13i" +(defconst org-version "5.19a" "The version number of the file org.el.") (defun org-version () (interactive) @@ -97,8 +98,12 @@ (get-text-property 0 'test (format "%s" x))) "Does format transport text properties?") +(defmacro org-bound-and-true-p (var) + "Return the value of symbol VAR if it is bound, else nil." + `(and (boundp (quote ,var)) ,var)) + (defmacro org-unmodified (&rest body) - "Execute body without changing buffer-modified-p." + "Execute body without changing `buffer-modified-p'." `(set-buffer-modified-p (prog1 (buffer-modified-p) ,@body))) @@ -251,7 +256,7 @@ Or return the original if not disputed." "Define a key, possibly translated, as returned by `org-key'." (define-key keymap (org-key key) def)) -(defcustom org-ellipsis 'org-ellipsis +(defcustom org-ellipsis nil "The ellipsis to use in the Org-mode outline. When nil, just use the standard three dots. When a string, use that instead, 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.") :tag "Org Reveal Location" :group 'org-structure) +(defconst org-context-choice + '(choice + (const :tag "Always" t) + (const :tag "Never" nil) + (repeat :greedy t :tag "Individual contexts" + (cons + (choice :tag "Context" + (const agenda) + (const org-goto) + (const occur-tree) + (const tags-tree) + (const link-search) + (const mark-goto) + (const bookmark-jump) + (const isearch) + (const default)) + (boolean)))) + "Contexts for the reveal options.") + (defcustom org-show-hierarchy-above '((default . t)) "Non-nil means, show full hierarchy when revealing a location. Org-mode often shows locations in an org-mode file which might have @@ -350,22 +374,7 @@ contexts. Valid contexts are isearch when exiting from an incremental search default default for all contexts not set explicitly" :group 'org-reveal-location - :type '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (repeat :greedy t :tag "Individual contexts" - (cons - (choice :tag "Context" - (const agenda) - (const org-goto) - (const occur-tree) - (const tags-tree) - (const link-search) - (const mark-goto) - (const bookmark-jump) - (const isearch) - (const default)) - (boolean))))) + :type org-context-choice) (defcustom org-show-following-heading '((default . nil)) "Non-nil means, show following heading when revealing a location. @@ -378,22 +387,7 @@ use the command \\[org-reveal] to show more context. Instead of t, this can also be an alist specifying this option for different contexts. See `org-show-hierarchy-above' for valid contexts." :group 'org-reveal-location - :type '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (repeat :greedy t :tag "Individual contexts" - (cons - (choice :tag "Context" - (const agenda) - (const org-goto) - (const occur-tree) - (const tags-tree) - (const link-search) - (const mark-goto) - (const bookmark-jump) - (const isearch) - (const default)) - (boolean))))) + :type org-context-choice) (defcustom org-show-siblings '((default . nil) (isearch t)) "Non-nil means, show all sibling heading when revealing a location. @@ -409,22 +403,19 @@ use the command \\[org-reveal] to show more context. Instead of t, this can also be an alist specifying this option for different contexts. See `org-show-hierarchy-above' for valid contexts." :group 'org-reveal-location - :type '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (repeat :greedy t :tag "Individual contexts" - (cons - (choice :tag "Context" - (const agenda) - (const org-goto) - (const occur-tree) - (const tags-tree) - (const link-search) - (const mark-goto) - (const bookmark-jump) - (const isearch) - (const default)) - (boolean))))) + :type org-context-choice) + +(defcustom org-show-entry-below '((default . nil)) + "Non-nil means, show the entry below a headline when revealing a location. +Org-mode often shows locations in an org-mode file which might have +been invisible before. When this is set, the text below the headline that is +exposed is also shown. + +By default this is off for all contexts. +Instead of t, this can also be an alist specifying this option for different +contexts. See `org-show-hierarchy-above' for valid contexts." + :group 'org-reveal-location + :type org-context-choice) (defgroup org-cycle nil "Options concerning visibility cycling in Org-mode." @@ -463,7 +454,7 @@ of the buffer." "Where should `org-cycle' emulate TAB. nil Never white Only in completely white lines -whitestart Only at the beginning of lines, before the first non-white char. +whitestart Only at the beginning of lines, before the first non-white char t Everywhere except in headlines exc-hl-bol Everywhere except at the start of a headline 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." (defcustom org-insert-heading-hook nil "Hook being run after inserting a new heading." :group 'org-edit-structure - :type 'boolean) + :type 'hook) (defcustom org-enable-fixed-width-editor t "Non-nil means, lines starting with \":\" are treated as fixed-width. @@ -658,7 +649,9 @@ with \\[org-ctrl-c-ctrl-c\\]." (defcustom org-archive-tag "ARCHIVE" "The tag that marks a subtree as archived. An archived subtree does not open during visibility cycling, and does -not contribute to the agenda listings." +not contribute to the agenda listings. +After changing this, font-lock must be restarted in the relevant buffers to +get the proper fontification." :group 'org-archive :group 'org-keywords :type 'string) @@ -767,6 +760,17 @@ information." (const :tag "Inherited tags" itags) (const :tag "Local tags" ltags))) +(defgroup org-imenu-and-speedbar nil + "Options concerning imenu and speedbar in Org-mode." + :tag "Org Imenu and Speedbar" + :group 'org-structure) + +(defcustom org-imenu-depth 2 + "The maximum level for Imenu access to Org-mode headlines. +This also applied for speedbar access." + :group 'org-imenu-and-speedbar + :type 'number) + (defgroup org-table nil "Options concerning tables in Org-mode." :tag "Org Table" @@ -892,7 +896,7 @@ alignment to the right border applies." :type 'number) (defgroup org-table-editing nil - "Bahavior of tables during editing in Org-mode." + "Behavior of tables during editing in Org-mode." :tag "Org Table Editing" :group 'org-table) @@ -1031,15 +1035,18 @@ links in Org-mode buffers can have an optional tag after a double colon, e.g. [[linkkey:tag][description]] If REPLACE is a string, the tag will simply be appended to create the link. -If the string contains \"%s\", the tag will be inserted there. REPLACE may -also be a function that will be called with the tag as the only argument to -create the link. See the manual for examples." +If the string contains \"%s\", the tag will be inserted there. + +REPLACE may also be a function that will be called with the tag as the +only argument to create the link, which should be returned as a string. + +See the manual for examples." :group 'org-link :type 'alist) (defcustom org-descriptive-links t "Non-nil means, hide link part and only show description of bracket links. -Bracket links are like [[link][descritpion]]. This variable sets the initial +Bracket links are like [[link][descritpion]]. This variable sets the initial state in new org-mode buffers. The setting can then be toggled on a per-buffer basis from the Org->Hyperlinks menu." :group 'org-link @@ -1049,10 +1056,10 @@ per-buffer basis from the Org->Hyperlinks menu." "How the path name in file links should be stored. Valid values are: -relative relative to the current directory, i.e. the directory of the file +relative Relative to the current directory, i.e. the directory of the file into which the link is being inserted. -absolute absolute path, if possible with ~ for home directory. -noabbrev absolute path, no abbreviation of home directory. +absolute Absolute path, if possible with ~ for home directory. +noabbrev Absolute path, no abbreviation of home directory. adaptive Use relative path for files in the current directory and sub- directories of it. For other files, use an absolute path." :group 'org-link @@ -1404,6 +1411,14 @@ When this variable is nil, `C-c C-c' give you the prompts, and :group 'org-remember :type 'boolean) +(defcustom org-remember-use-refile-when-interactive t + "Non-nil means, use refile to file a remember note. +This is only used when the interactive mode for selecting a filing +location is used (see the variable `org-remember-store-without-prompt'). +When nil, the `org-goto' interface is used." + :group 'org-remember + :type 'boolean) + (defcustom org-remember-default-headline "" "The headline that should be the default location in the notes file. 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 "Templates for the creation of remember buffers. When nil, just let remember make the buffer. When not nil, this is a list of 5-element lists. In each entry, the first -element is a the name of the template, It should be a single short word. +element is the name of the template, which should be a single short word. The second element is a character, a unique key to select this template. -The third element is the template. The forth element is optional and can +The third element is the template. The fourth element is optional and can specify a destination file for remember items created with this template. The default file is given by `org-default-notes-file'. An optional fifth 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 a first line starting with a star, to act as the org-mode headline. Furthermore, the following %-escapes will be replaced with content: - %^{prompt} prompt the user for a string and replace this sequence with it. + %^{prompt} Prompt the user for a string and replace this sequence with it. + A default value and a completion table ca be specified like this: + %^{prompt|default|completion2|completion3|...} %t time stamp, date only %T time stamp with date and time %u, %U like the above, but inactive time stamps @@ -1440,6 +1457,13 @@ Furthermore, the following %-escapes will be replaced with content: %i initial content, the region when remember is called with C-u. If %i is indented, the entire inserted text will be indented as well. + %c content of the clipboard, or current kill ring head + %^g prompt for tags, with completion on tags in target file + %^G prompt for tags, with completion all tags in all agenda files + %:keyword specific information for certain link types, see below + %[pathname] insert the contents of the file given by `pathname' + %(sexp) evaluate elisp `(sexp)' and replace with the result + %! Store this note immediately after filling the template %? After completing the template, position cursor here. @@ -1483,7 +1507,9 @@ calendar | %:type %:date" (defcustom org-reverse-note-order nil "Non-nil means, store new notes at the beginning of a file or entry. -When nil, new notes will be filed to the end of a file or entry." +When nil, new notes will be filed to the end of a file or entry. +This can also be a list with cons cells of regular expressions that +are matched against file names, and values." :group 'org-remember :type '(choice (const :tag "Reverse always" t) @@ -1491,6 +1517,51 @@ When nil, new notes will be filed to the end of a file or entry." (repeat :tag "By file name regexp" (cons regexp boolean)))) +(defcustom org-refile-targets nil + "Targets for refiling entries with \\[org-refile]. +This is list of cons cells. Each cell contains: +- a specification of the files to be considered, either a list of files, + or a symbol whose function or value fields will be used to retrieve + a file name or a list of file names. Nil means, refile to a different + heading in the current buffer. +- A specification of how to find candidate refile targets. This may be + any of + - a cons cell (:tag . \"TAG\") to identify refile targets by a tag. + This tag has to be present in all target headlines, inheritance will + not be considered. + - a cons cell (:todo . \"KEYWORD\") to identify refile targets by + todo keyword. + - a cons cell (:regexp . \"REGEXP\") with a regular expression matching + headlines that are refiling targets. + - a cons cell (:level . N). Any headline of level N is considered a target. + - a cons cell (:maxlevel . N). Any headline with level <= N is a target." +;; FIXME: what if there are a var and func with same name??? + :group 'org-remember + :type '(repeat + (cons + (choice :value org-agenda-files + (const :tag "All agenda files" org-agenda-files) + (const :tag "Current buffer" nil) + (function) (variable) (file)) + (choice :tag "Identify target headline by" + (cons :tag "Specific tag" (const :tag) (string)) + (cons :tag "TODO keyword" (const :todo) (string)) + (cons :tag "Regular expression" (const :regexp) (regexp)) + (cons :tag "Level number" (const :level) (integer)) + (cons :tag "Max Level number" (const :maxlevel) (integer)))))) + +(defcustom org-refile-use-outline-path nil + "Non-nil means, provide refile targets as paths. +So a level 3 headline will be available as level1/level2/level3. +When the value is `file', also include the file name (without directory) +into the path. When `full-file-path', include the full file path." + :group 'org-remember + :type '(choice + (const :tag "Not" nil) + (const :tag "Yes" t) + (const :tag "Start with file name" file) + (const :tag "Start with full file path" full-file-path))) + (defgroup org-todo nil "Options concerning TODO items in Org-mode." :tag "Org TODO" @@ -1712,6 +1783,15 @@ Nil means, clock will keep running until stopped explicitly with :group 'org-progress :type 'boolean) +(defcustom org-clock-in-switch-to-state nil + "Set task to a special todo state while clocking it. +The value should be the state to which the entry should be switched." + :group 'org-progress + :group 'org-todo + :type '(choice + (const :tag "Don't force a state" nil) + (string :tag "State"))) + (defgroup org-priorities nil "Priorities in Org-mode." :tag "Org Priorities" @@ -1795,13 +1875,52 @@ end of the second format." (concat "[" (substring f 1 -1) "]") f))) -(defcustom org-popup-calendar-for-date-prompt t +(defcustom org-read-date-prefer-future t + "Non-nil means, assume future for incomplete date input from user. +This affects the following situations: +1. The user gives a day, but no month. + For example, if today is the 15th, and you enter \"3\", Org-mode will + read this as the third of *next* month. However, if you enter \"17\", + it will be considered as *this* month. +2. The user gives a month but not a year. + For example, if it is april and you enter \"feb 2\", this will be read + as feb 2, *next* year. \"May 5\", however, will be this year. + +When this option is nil, the current month and year will always be used +as defaults." + :group 'org-time + :type 'boolean) + +(defcustom org-read-date-display-live t + "Non-nil means, display current interpretation of date prompt live. +This display will be in an overlay, in the minibuffer." + :group 'org-time + :type 'boolean) + +(defcustom org-read-date-popup-calendar t "Non-nil means, pop up a calendar when prompting for a date. In the calendar, the date can be selected with mouse-1. However, the minibuffer will also be active, and you can simply enter the date as well. When nil, only the minibuffer will be available." :group 'org-time :type 'boolean) +(if (fboundp 'defvaralias) + (defvaralias 'org-popup-calendar-for-date-prompt + 'org-read-date-popup-calendar)) + +(defcustom org-extend-today-until 0 + "The hour when your day really ends. +This has influence for the following applications: +- When switching the agenda to \"today\". It it is still earlier than + the time given here, the day recognized as TODAY is actually yesterday. +- When a date is read from the user and it is still before the time given + here, the current date and time will be assumed to be yesterday, 23:59. + +FIXME: +IMPORTANT: This is still a very experimental feature, it may disappear +again or it may be extended to mean more things." + :group 'org-time + :type 'number) (defcustom org-edit-timestamp-down-means-later nil "Non-nil means, S-down will increase the time in a time stamp. @@ -1816,6 +1935,13 @@ moved to the new date." :group 'org-time :type 'boolean) +(defcustom org-clock-heading-function nil + "When non-nil, should be a function to create `org-clock-heading'. +This is the string shown in the mode line when a clock is running. +The function is called with point at the beginning of the headline." + :group 'org-time ; FIXME: Should we have a separate group???? + :type 'function) + (defgroup org-tags nil "Options concerning tags in Org-mode." :tag "Org Tags" @@ -1929,16 +2055,23 @@ lined-up with respect to each other." (defcustom org-use-property-inheritance nil "Non-nil means, properties apply also for sublevels. -This can cause significant overhead when doing a search, so this is turned -off by default. +This setting is only relevant during property searches, not when querying +an entry with `org-entry-get'. To retrieve a property with inheritance, +you need to call `org-entry-get' with the inheritance flag. +Turning this on can cause significant overhead when doing a search, so +this is turned off by default. When nil, only the properties directly given in the current entry count. +The value may also be a list of properties that shouldhave inheritance. However, note that some special properties use inheritance under special circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS, and the properties ending in \"_ALL\" when they are used as descriptor for valid values of a property." :group 'org-properties - :type 'boolean) + :type '(choice + (const :tag "Not" nil) + (const :tag "Always" nil) + (repeat :tag "Specific properties" (string :tag "Property")))) (defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS" "The default column format, if no other format has been defined. @@ -1998,7 +2131,7 @@ agenda file per line." (repeat :tag "List of files and directories" file) (file :tag "Store list in a file\n" :value "~/.agenda_files"))) -(defcustom org-agenda-file-regexp "\\.org\\'" +(defcustom org-agenda-file-regexp "\\`[^.].*\\.org\\'" "Regular expression to match files for `org-agenda-files'. If any element in the list in that variable contains a directory instead 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." :group 'org-agenda-skip :type 'boolean) +(defcustom org-agenda-skip-timestamp-if-done nil + "Non-nil means don't select item by timestamp or -range if it is DONE." + :group 'org-agenda-skip + :type 'boolean) + (defcustom org-timeline-show-empty-dates 3 "Non-nil means, `org-timeline' also shows dates without an entry. When nil, only the days which actually have entries are shown. @@ -2400,7 +2538,9 @@ Valid values are: current-window Display in the current window other-window Just display in another window. dedicated-frame Create one new frame, and re-use it each time. -new-frame Make a new frame each time." +new-frame Make a new frame each time. Note that in this case + previously-made indirect buffers are kept, and you need to + kill these buffers yourself." :group 'org-structure :group 'org-agenda-windows :type '(choice @@ -2542,18 +2682,19 @@ a grid line." :tag "Org Agenda Sorting" :group 'org-agenda) -(let ((sorting-choice - '(choice - (const time-up) (const time-down) - (const category-keep) (const category-up) (const category-down) - (const tag-down) (const tag-up) - (const priority-up) (const priority-down)))) - - (defcustom org-agenda-sorting-strategy - '((agenda time-up category-keep priority-down) - (todo category-keep priority-down) - (tags category-keep priority-down)) - "Sorting structure for the agenda items of a single day. +(defconst org-sorting-choice + '(choice + (const time-up) (const time-down) + (const category-keep) (const category-up) (const category-down) + (const tag-down) (const tag-up) + (const priority-up) (const priority-down)) + "Sorting choices.") + +(defcustom org-agenda-sorting-strategy + '((agenda time-up category-keep priority-down) + (todo category-keep priority-down) + (tags category-keep priority-down)) + "Sorting structure for the agenda items of a single day. This is a list of symbols which will be used in sequence to determine if an entry should be listed before another entry. The following symbols are recognized: @@ -2580,17 +2721,21 @@ the sequence given in `org-agenda-files'. Within each category sort by priority. Leaving out `category-keep' would mean that items will be sorted across -categories by priority." +categories by priority. + +Instead of a single list, this can also be a set of list for specific +contents, with a context symbol in the car of the list, any of +`agenda', `todo', `tags' for the corresponding agenda views." :group 'org-agenda-sorting :type `(choice - (repeat :tag "General" ,sorting-choice) + (repeat :tag "General" ,org-sorting-choice) (list :tag "Individually" (cons (const :tag "Strategy for Weekly/Daily agenda" agenda) - (repeat ,sorting-choice)) + (repeat ,org-sorting-choice)) (cons (const :tag "Strategy for TODO lists" todo) - (repeat ,sorting-choice)) + (repeat ,org-sorting-choice)) (cons (const :tag "Strategy for Tags matches" tags) - (repeat ,sorting-choice)))))) + (repeat ,org-sorting-choice))))) (defcustom org-sort-agenda-notime-is-late t "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 "The compiled version of the most recently used prefix format. See the variable `org-agenda-prefix-format'.") +(defcustom org-agenda-todo-keyword-format "%-1s" + "Format for the TODO keyword in agenda lines. +Set this to something like \"%-12s\" if you want all TODO keywords +to occupy a fixed space in the agenda display." + :group 'org-agenda-line-format + :type 'string) + (defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") "Text preceeding scheduled items in the agenda view. -THis is a list with two strings. The first applies when the item is +This is a list with two strings. The first applies when the item is scheduled on the current day. The second applies when it has been scheduled previously, it may contain a %d to capture how many days ago the item was scheduled." @@ -2811,23 +2963,23 @@ This is a property list with the following properties: :tag "Org Export General" :group 'org-export) -(defcustom org-export-publishing-directory "." - "Path to the location where exported files should be located. -This path may be relative to the directory where the Org-mode file lives. -The default is to put them into the same directory as the Org-mode file. -The variable may also be an alist with export types `:html', `:ascii', -`:ical', `:LaTeX', or `:xoxo' and the corresponding directories. -If a directory path is relative, it is interpreted relative to the -directory where the exported Org-mode files lives." - :group 'org-export-general - :type '(choice - (directory) - (repeat - (cons - (choice :tag "Type" - (const :html) (const :LaTeX) - (const :ascii) (const :ical) (const :xoxo)) - (directory))))) +;; FIXME +(defvar org-export-publishing-directory nil) + +(defcustom org-export-with-special-strings t + "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export. +When this option is turned on, these strings will be exported as: + + Org HTML LaTeX + -----+----------+-------- + \\- ­ \\- + -- – -- + --- — --- + ... … \ldots + +This option can also be set with the +OPTIONS line, e.g. \"-:nil\"." + :group 'org-export-translation + :type 'boolean) (defcustom org-export-language-setup '(("en" "Author" "Date" "Table of Contents") @@ -3032,6 +3184,20 @@ This option can also be set with the +OPTIONS line, e.g. \"^:nil\"." (const :tag "Only with braces" {}) (const :tag "Never interpret" nil))) +(defcustom org-export-with-special-strings t + "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export. +When this option is turned on, these strings will be exported as: + +\\- : ­ +-- : – +--- : — + +Not all export backends support this, but HTML does. + +This option can also be set with the +OPTIONS line, e.g. \"-:nil\"." + :group 'org-export-translation + :type 'boolean) + (defcustom org-export-with-TeX-macros t "Non-nil means, interpret simple TeX-like macros when exporting. 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, ..." (defcustom org-export-ascii-bullets '(?* ?+ ?-) "Bullet characters for headlines converted to lists in ASCII export. -The first character is is used for the first lest level generated in this +The first character is used for the first lest level generated in this way, and so on. If there are more levels than characters given here, the list will be repeated. 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." :group 'org-font-lock :type 'boolean) +(defcustom org-highlight-latex-fragments-and-specials nil + "Non-nil means, fontify what is treated specially by the exporters." + :group 'org-font-lock + :type 'boolean) + +(defcustom org-hide-emphasis-markers nil + "Non-nil mean font-lock should hide the emphasis marker characters." + :group 'org-font-lock + :type 'boolean) + (defvar org-emph-re nil "Regular expression for matching emphasis.") +(defvar org-verbatim-re nil + "Regular expression for matching verbatim text.") (defvar org-emphasis-regexp-components) ; defined just below (defvar org-emphasis-alist) ; defined just below (defun org-set-emph-re (var val) @@ -3393,33 +3571,53 @@ Changing this variable requires a restart of Emacs to take effect." (border (nth 2 e)) (body (nth 3 e)) (nl (nth 4 e)) - (stacked (nth 5 e)) + (stacked (and nil (nth 5 e))) ; stacked is no longer allowed, forced to nil (body1 (concat body "*?")) - (markers (mapconcat 'car org-emphasis-alist ""))) + (markers (mapconcat 'car org-emphasis-alist "")) + (vmarkers (mapconcat + (lambda (x) (if (eq (nth 4 x) 'verbatim) (car x) "")) + org-emphasis-alist ""))) ;; make sure special characters appear at the right position in the class (if (string-match "\\^" markers) (setq markers (concat (replace-match "" t t markers) "^"))) (if (string-match "-" markers) (setq markers (concat (replace-match "" t t markers) "-"))) + (if (string-match "\\^" vmarkers) + (setq vmarkers (concat (replace-match "" t t vmarkers) "^"))) + (if (string-match "-" vmarkers) + (setq vmarkers (concat (replace-match "" t t vmarkers) "-"))) (if (> nl 0) (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0," (int-to-string nl) "\\}"))) ;; Make the regexp (setq org-emph-re - (concat "\\([" pre (if stacked markers) "]\\|^\\)" + (concat "\\([" pre (if (and nil stacked) markers) "]\\|^\\)" "\\(" "\\([" markers "]\\)" "\\(" + "[^" border "]\\|" "[^" border (if (and nil stacked) markers) "]" body1 "[^" border (if (and nil stacked) markers) "]" "\\)" "\\3\\)" - "\\([" post (if stacked markers) "]\\|$\\)"))))) + "\\([" post (if (and nil stacked) markers) "]\\|$\\)")) + (setq org-verbatim-re + (concat "\\([" pre "]\\|^\\)" + "\\(" + "\\([" vmarkers "]\\)" + "\\(" + "[^" border "]\\|" + "[^" border "]" + body1 + "[^" border "]" + "\\)" + "\\3\\)" + "\\([" post "]\\|$\\)"))))) (defcustom org-emphasis-regexp-components - '(" \t('\"" "- \t.,:?;'\")" " \t\r\n,\"'" "." 1 nil) - "Components used to build the reqular expression for emphasis. + '(" \t('\"" "- \t.,:?;'\")" " \t\r\n,\"'" "." 1) + "Components used to build the regular expression for emphasis. This is a list with 6 entries. Terminology: In an emphasis string like \" *strong word* \", we call the initial space PREMATCH, the final space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters @@ -3432,10 +3630,7 @@ border The chars *forbidden* as border characters. body-regexp A regexp like \".\" to match a body character. Don't use non-shy groups here, and don't allow newline here. newline The maximum number of newlines allowed in an emphasis exp. -stacked Non-nil means, allow stacked styles. This works only in HTML - export. When this is set, all marker characters (as given in - `org-emphasis-alist') will be allowed as pre/post, aiding - inside-out matching. + Use customize to modify this, or restart Emacs after changing it." :group 'org-font-lock :set 'org-set-emph-re @@ -3445,16 +3640,17 @@ Use customize to modify this, or restart Emacs after changing it." (sexp :tag "Forbidden chars in border ") (sexp :tag "Regexp for body ") (integer :tag "number of newlines allowed") - (boolean :tag "Stacking allowed "))) + (option (boolean :tag "Stacking (DISABLED) ")))) (defcustom org-emphasis-alist '(("*" bold "<b>" "</b>") ("/" italic "<i>" "</i>") ("_" underline "<u>" "</u>") - ("=" org-code "<code>" "</code>") + ("=" org-code "<code>" "</code>" verbatim) + ("~" org-verbatim "" "" verbatim) ("+" (:strike-through t) "<del>" "</del>") ) -"Special syntax for emphasized text. + "Special syntax for emphasized text. Text starting and ending with a special character will be emphasized, for example *bold*, _underlined_ and /italic/. This variable sets the marker 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." (face :tag "Font-lock-face") (plist :tag "Face property list")) (string :tag "HTML start tag") - (string :tag "HTML end tag")))) + (string :tag "HTML end tag") + (option (const verbatim))))) ;;; The faces @@ -3508,6 +3705,7 @@ any other entries, and any resulting duplicates will be removed entirely." (t (or (assoc (car e) r) (push e r))))) (nreverse r))) (t specs))) +(put 'org-compatible-face 'lisp-indent-function 1) (defface org-hide '((((background light)) (:foreground "white")) @@ -3518,108 +3716,98 @@ color of the frame." :group 'org-faces) (defface org-level-1 ;; font-lock-function-name-face - (org-compatible-face - 'outline-1 - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) + (org-compatible-face 'outline-1 + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8)) (:foreground "blue" :bold t)) + (t (:bold t)))) "Face used for level 1 headlines." :group 'org-faces) (defface org-level-2 ;; font-lock-variable-name-face - (org-compatible-face - 'outline-2 - '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8) (background light)) (:foreground "yellow")) - (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t)) - (t (:bold t)))) + (org-compatible-face 'outline-2 + '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) + (((class color) (min-colors 8) (background light)) (:foreground "yellow")) + (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t)) + (t (:bold t)))) "Face used for level 2 headlines." :group 'org-faces) (defface org-level-3 ;; font-lock-keyword-face - (org-compatible-face - 'outline-3 - '((((class color) (min-colors 88) (background light)) (:foreground "Purple")) - (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) - (((class color) (min-colors 16) (background light)) (:foreground "Purple")) - (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) - (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t)) - (t (:bold t)))) + (org-compatible-face 'outline-3 + '((((class color) (min-colors 88) (background light)) (:foreground "Purple")) + (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) + (((class color) (min-colors 16) (background light)) (:foreground "Purple")) + (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) + (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t)) + (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t)) + (t (:bold t)))) "Face used for level 3 headlines." :group 'org-faces) (defface org-level-4 ;; font-lock-comment-face - (org-compatible-face - 'outline-4 - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 16) (background light)) (:foreground "red")) - (((class color) (min-colors 16) (background dark)) (:foreground "red1")) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) + (org-compatible-face 'outline-4 + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 16) (background light)) (:foreground "red")) + (((class color) (min-colors 16) (background dark)) (:foreground "red1")) + (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:bold t)))) "Face used for level 4 headlines." :group 'org-faces) (defface org-level-5 ;; font-lock-type-face - (org-compatible-face - 'outline-5 - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")))) + (org-compatible-face 'outline-5 + '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) + (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 8)) (:foreground "green")))) "Face used for level 5 headlines." :group 'org-faces) (defface org-level-6 ;; font-lock-constant-face - (org-compatible-face - 'outline-6 - '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) - (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) - (((class color) (min-colors 8)) (:foreground "magenta")))) + (org-compatible-face 'outline-6 + '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) + (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) + (((class color) (min-colors 8)) (:foreground "magenta")))) "Face used for level 6 headlines." :group 'org-faces) (defface org-level-7 ;; font-lock-builtin-face - (org-compatible-face - 'outline-7 - '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) - (((class color) (min-colors 8)) (:foreground "blue")))) + (org-compatible-face 'outline-7 + '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) + (((class color) (min-colors 8)) (:foreground "blue")))) "Face used for level 7 headlines." :group 'org-faces) (defface org-level-8 ;; font-lock-string-face - (org-compatible-face - 'outline-8 - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (((class color) (min-colors 8)) (:foreground "green")))) + (org-compatible-face 'outline-8 + '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) + (((class color) (min-colors 8)) (:foreground "green")))) "Face used for level 8 headlines." :group 'org-faces) (defface org-special-keyword ;; font-lock-string-face - (org-compatible-face - nil - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (t (:italic t)))) + (org-compatible-face nil + '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) + (t (:italic t)))) "Face used for special keywords." :group 'org-faces) (defface org-drawer ;; font-lock-function-name-face - (org-compatible-face - nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8)) (:foreground "blue" :bold t)) + (t (:bold t)))) "Face used for drawers." :group 'org-faces) @@ -3628,15 +3816,14 @@ color of the frame." :group 'org-faces) (defface org-column - (org-compatible-face - nil - '((((class color) (min-colors 16) (background light)) - (:background "grey90")) - (((class color) (min-colors 16) (background dark)) - (:background "grey30")) - (((class color) (min-colors 8)) - (:background "cyan" :foreground "black")) - (t (:inverse-video t)))) + (org-compatible-face nil + '((((class color) (min-colors 16) (background light)) + (:background "grey90")) + (((class color) (min-colors 16) (background dark)) + (:background "grey30")) + (((class color) (min-colors 8)) + (:background "cyan" :foreground "black")) + (t (:inverse-video t)))) "Face for column display of entry properties." :group 'org-faces) @@ -3647,29 +3834,27 @@ color of the frame." :family (face-attribute 'default :family))) (defface org-warning - (org-compatible-face - 'font-lock-warning-face - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) + (org-compatible-face 'font-lock-warning-face + '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) + (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) + (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:bold t)))) "Face for deadlines and TODO keywords." :group 'org-faces) (defface org-archived ; similar to shadow - (org-compatible-face - 'shadow - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50")) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70")) - (((class color) (min-colors 8) (background light)) - (:foreground "green")) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow")))) - "Face for headline with the ARCHIVE tag." - :group 'org-faces) + (org-compatible-face 'shadow + '((((class color grayscale) (min-colors 88) (background light)) + (:foreground "grey50")) + (((class color grayscale) (min-colors 88) (background dark)) + (:foreground "grey70")) + (((class color) (min-colors 8) (background light)) + (:foreground "green")) + (((class color) (min-colors 8) (background dark)) + (:foreground "yellow")))) + "Face for headline with the ARCHIVE tag." + :group 'org-faces) (defface org-link '((((class color) (background light)) (:foreground "Purple" :underline t)) @@ -3679,8 +3864,8 @@ color of the frame." :group 'org-faces) (defface org-ellipsis - '((((class color) (background light)) (:foreground "DarkGoldenrod" :strike-through t)) - (((class color) (background dark)) (:foreground "LightGoldenrod" :strike-through t)) + '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t)) + (((class color) (background dark)) (:foreground "LightGoldenrod" :underline t)) (t (:strike-through t))) "Face for the ellipsis in folded text." :group 'org-faces) @@ -3712,32 +3897,29 @@ color of the frame." :group 'org-faces) (defface org-todo ; font-lock-warning-face - (org-compatible-face - nil - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:inverse-video t :bold t)))) + (org-compatible-face nil + '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) + (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) + (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:inverse-video t :bold t)))) "Face for TODO keywords." :group 'org-faces) (defface org-done ;; font-lock-type-face - (org-compatible-face - nil - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold t)))) + (org-compatible-face nil + '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t)) + (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) + (((class color) (min-colors 8)) (:foreground "green")) + (t (:bold t)))) "Face used for todo keywords that indicate DONE items." :group 'org-faces) (defface org-headline-done ;; font-lock-string-face - (org-compatible-face - nil - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (((class color) (min-colors 8) (background light)) (:bold nil)))) + (org-compatible-face nil + '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) + (((class color) (min-colors 8) (background light)) (:bold nil)))) "Face used to indicate that a headline is DONE. This face is only used if `org-fontify-done-headline' is set. If applies to the part of the headline after the DONE keyword." @@ -3756,84 +3938,91 @@ list of attributes, like (:foreground \"blue\" :weight bold :underline t)." (sexp :tag "face")))) (defface org-table ;; font-lock-function-name-face - (org-compatible-face - nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8) (background light)) (:foreground "blue")) - (((class color) (min-colors 8) (background dark))))) + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8) (background light)) (:foreground "blue")) + (((class color) (min-colors 8) (background dark))))) "Face used for tables." :group 'org-faces) (defface org-formula - (org-compatible-face - nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red")) - (t (:bold t :italic t)))) + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 8) (background light)) (:foreground "red")) + (((class color) (min-colors 8) (background dark)) (:foreground "red")) + (t (:bold t :italic t)))) "Face for formulas." :group 'org-faces) (defface org-code - (org-compatible-face - nil - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50")) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70")) - (((class color) (min-colors 8) (background light)) - (:foreground "green")) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow")))) - "Face for fixed-with text like code snippets." - :group 'org-faces - :version "22.1") + (org-compatible-face nil + '((((class color grayscale) (min-colors 88) (background light)) + (:foreground "grey50")) + (((class color grayscale) (min-colors 88) (background dark)) + (:foreground "grey70")) + (((class color) (min-colors 8) (background light)) + (:foreground "green")) + (((class color) (min-colors 8) (background dark)) + (:foreground "yellow")))) + "Face for fixed-with text like code snippets." + :group 'org-faces + :version "22.1") + +(defface org-verbatim + (org-compatible-face nil + '((((class color grayscale) (min-colors 88) (background light)) + (:foreground "grey50" :underline t)) + (((class color grayscale) (min-colors 88) (background dark)) + (:foreground "grey70" :underline t)) + (((class color) (min-colors 8) (background light)) + (:foreground "green" :underline t)) + (((class color) (min-colors 8) (background dark)) + (:foreground "yellow" :underline t)))) + "Face for fixed-with text like code snippets." + :group 'org-faces + :version "22.1") (defface org-agenda-structure ;; font-lock-function-name-face - (org-compatible-face - nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8)) (:foreground "blue" :bold t)) + (t (:bold t)))) "Face used in agenda for captions and dates." :group 'org-faces) (defface org-scheduled-today - (org-compatible-face - nil - '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) - (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold t :italic t)))) + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) + (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 8)) (:foreground "green")) + (t (:bold t :italic t)))) "Face for items scheduled for a certain day." :group 'org-faces) (defface org-scheduled-previously - (org-compatible-face - nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 8) (background light)) (:foreground "red")) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:bold t)))) "Face for items scheduled previously, and not yet done." :group 'org-faces) (defface org-upcoming-deadline - (org-compatible-face - nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 8) (background light)) (:foreground "red")) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:bold t)))) "Face for items scheduled previously, and not yet done." :group 'org-faces) @@ -3842,8 +4031,8 @@ list of attributes, like (:foreground \"blue\" :weight bold :underline t)." (0.5 . org-upcoming-deadline) (0.0 . default)) "Faces for showing deadlines in the agenda. -This is a list of cons cells. The cdr of each cess is a face to be used, -and it can also just be a like like '(:foreground \"yellow\"). +This is a list of cons cells. The cdr of each cell is a face to be used, +and it can also just be like '(:foreground \"yellow\"). Each car is a fraction of the head-warning time that must have passed for this the face in the cdr to be used for display. The numbers must be given in descending order. The head-warning time is normally taken @@ -3862,12 +4051,23 @@ month and 365.24 days for a year)." (number :tag "Fraction of head-warning time passed") (sexp :tag "Face")))) +;; FIXME: this is not a good face yet. +(defface org-agenda-restriction-lock + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) (:background "yellow1")) + (((class color) (min-colors 88) (background dark)) (:background "skyblue4")) + (((class color) (min-colors 16) (background light)) (:background "yellow1")) + (((class color) (min-colors 16) (background dark)) (:background "skyblue4")) + (((class color) (min-colors 8)) (:background "cyan" :foreground "black")) + (t (:inverse-video t)))) + "Face for showing the agenda restriction lock." + :group 'org-faces) + (defface org-time-grid ;; font-lock-variable-name-face - (org-compatible-face - nil - '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) + (org-compatible-face nil + '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) + (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) "Face used for time grids." :group 'org-faces) @@ -3883,7 +4083,24 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc." :type 'number :group 'org-faces) -;;; Function declarations. +;;; Functions and variables from ther packages +;; Declared here to avoid compiler warnings + +(eval-and-compile + (unless (fboundp 'declare-function) + (defmacro declare-function (fn file &optional arglist fileonly)))) + +;; XEmacs only +(defvar outline-mode-menu-heading) +(defvar outline-mode-menu-show) +(defvar outline-mode-menu-hide) +(defvar zmacs-regions) ; XEmacs regions + +;; Emacs only +(defvar mark-active) + +;; Various packages +;; FIXME: get the argument lists for the UNKNOWN stuff (declare-function add-to-diary-list "diary-lib" (date string specifier &optional marker globcolor literal)) (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." (declare-function bibtex-generate-autokey "bibtex" ()) (declare-function bibtex-parse-entry "bibtex" (&optional content)) (declare-function bibtex-url "bibtex" (&optional pos no-browse)) +(defvar calc-embedded-close-formula) +(defvar calc-embedded-open-formula) (declare-function calendar-astro-date-string "cal-julian" (&optional date)) (declare-function calendar-bahai-date-string "cal-bahai" (&optional date)) (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." (declare-function calendar-julian-date-string "cal-julian" (&optional date)) (declare-function calendar-mayan-date-string "cal-mayan" (&optional date)) (declare-function calendar-persian-date-string "cal-persia" (&optional date)) +(defvar calendar-mode-map) +(defvar original-date) ; dynamically scoped in calendar.el does scope this (declare-function cdlatex-tab "ext:cdlatex" ()) (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) +(declare-function elmo-folder-exists-p "ext:elmo" (folder) t) +(declare-function elmo-message-entity-field "ext:elmo-msgdb" (entity field &optional type)) +(declare-function elmo-message-field "ext:elmo" (folder number field &optional type) t) +;; backward compatibility to old version of elmo +(declare-function elmo-msgdb-overview-get-entity "ext:elmo" (&rest unknown) t) +(defvar font-lock-unfontify-region-function) (declare-function gnus-article-show-summary "gnus-art" ()) (declare-function gnus-summary-last-subject "gnus-sum" ()) +(defvar gnus-other-frame-object) +(defvar gnus-group-name) +(defvar gnus-article-current) +(defvar Info-current-file) +(defvar Info-current-node) (declare-function mh-display-msg "mh-show" (msg-num folder-name)) (declare-function mh-find-path "mh-utils" ()) (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." (declare-function mh-show-msg "mh-show" (msg)) (declare-function mh-show-show "mh-show" t t) (declare-function mh-visit-folder "mh-folder" (folder &optional range index-data)) -(declare-function org-export-latex-cleaned-string "org-export-latex" (&optional commentsp)) +(defvar mh-progs) +(defvar mh-current-folder) +(defvar mh-show-folder-buffer) +(defvar mh-index-folder) +(defvar mh-searcher) +(declare-function org-export-latex-cleaned-string "org-export-latex" ()) (declare-function parse-time-string "parse-time" (string)) (declare-function remember "remember" (&optional initial)) (declare-function remember-buffer-desc "remember" ()) +(defvar remember-save-after-remembering) +(defvar remember-data-file) +(defvar remember-register) +(defvar remember-buffer) +(defvar remember-handler-functions) +(defvar remember-annotation-functions) (declare-function rmail-narrow-to-non-pruned-header "rmail" ()) (declare-function rmail-show-message "rmail" (&optional n no-summary)) (declare-function rmail-what-message "rmail" ()) -(declare-function elmo-folder-exists-p "ext:elmo" (folder) t) -(declare-function elmo-message-entity-field "ext:elmo-msgdb" (entity field &optional type)) -(declare-function elmo-message-field "ext:elmo" (folder number field &optional type) t) +(defvar texmathp-why) (declare-function vm-beginning-of-message "ext:vm-page" ()) (declare-function vm-follow-summary-cursor "ext:vm-motion" ()) (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." (declare-function vm-su-message-id "ext:vm-summary" (m)) (declare-function vm-su-subject "ext:vm-summary" (m)) (declare-function vm-summarize "ext:vm-summary" (&optional display raise)) +(defvar vm-message-pointer) +(defvar vm-folder-directory) +(defvar w3m-current-url) +(defvar w3m-current-title) +;; backward compatibility to old version of wl +(declare-function wl-summary-buffer-msgdb "ext:wl-folder" (&rest unknown) t) (declare-function wl-folder-get-elmo-folder "ext:wl-folder" (entity &optional no-cache)) (declare-function wl-summary-goto-folder-subr "ext:wl-summary" (&optional name scan-type other-window sticky interactive scoring force-exit)) (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." (declare-function wl-summary-line-subject "ext:wl-summary" ()) (declare-function wl-summary-message-number "ext:wl-summary" ()) (declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg)) +(defvar wl-summary-buffer-elmo-folder) +(defvar wl-summary-buffer-folder-name) +(declare-function speedbar-line-directory "speedbar" (&optional depth)) + +(defvar org-latex-regexps) +(defvar constants-unit-system) ;;; Variables for pre-computed regular expressions, all buffer local @@ -4134,7 +4387,7 @@ means to push this value onto the list in the variable.") ((equal key "CATEGORY") (if (string-match "[ \t]+$" value) (setq value (replace-match "" t t value))) - (setq cat (intern value))) + (setq cat value)) ((member key '("SEQ_TODO" "TODO")) (push (cons 'sequence (org-split-string value splitre)) kwds)) ((equal key "TYP_TODO") @@ -4176,7 +4429,9 @@ means to push this value onto the list in the variable.") (remove-text-properties 0 (length arch) '(face t fontified t) arch))) ))) - (and cat (org-set-local 'org-category cat)) + (when cat + (org-set-local 'org-category (intern cat)) + (push (cons "CATEGORY" cat) props)) (when prio (if (< (length prio) 3) (setq prio '("A" "C" "B"))) (setq prio (mapcar 'string-to-char prio)) @@ -4332,7 +4587,7 @@ means to push this value onto the list in the variable.") "\\|" org-closed-string "\\|" org-clock-string "\\)\\>\\)") ) - + (org-compute-latex-and-specials-regexp) (org-set-font-lock-defaults))) (defun org-remove-keyword-keys (list) @@ -4342,6 +4597,31 @@ means to push this value onto the list in the variable.") x)) list)) +;; FIXME: this could be done much better, using second characters etc. +(defun org-assign-fast-keys (alist) + "Assign fast keys to a keyword-key alist. +Respect keys that are already there." + (let (new e k c c1 c2 (char ?a)) + (while (setq e (pop alist)) + (cond + ((equal e '(:startgroup)) (push e new)) + ((equal e '(:endgroup)) (push e new)) + (t + (setq k (car e) c2 nil) + (if (cdr e) + (setq c (cdr e)) + ;; automatically assign a character. + (setq c1 (string-to-char + (downcase (substring + k (if (= (string-to-char k) ?@) 1 0))))) + (if (or (rassoc c1 new) (rassoc c1 alist)) + (while (or (rassoc char new) (rassoc char alist)) + (setq char (1+ char))) + (setq c2 c1)) + (setq c (or c2 char))) + (push (cons k c) new)))) + (nreverse new))) + ;;; Some variables ujsed in various places (defvar org-window-configuration nil @@ -4350,49 +4630,6 @@ means to push this value onto the list in the variable.") "Function to be called when `C-c C-c' is used. This is for getting out of special buffers like remember.") -;;; Foreign variables, to inform the compiler - -;; XEmacs only -(defvar outline-mode-menu-heading) -(defvar outline-mode-menu-show) -(defvar outline-mode-menu-hide) -(defvar zmacs-regions) ; XEmacs regions -;; Emacs only -(defvar mark-active) - -;; Packages that org-mode interacts with -(defvar calc-embedded-close-formula) -(defvar calc-embedded-open-formula) -(defvar font-lock-unfontify-region-function) -(defvar org-goto-start-pos) -(defvar vm-message-pointer) -(defvar vm-folder-directory) -(defvar wl-summary-buffer-elmo-folder) -(defvar wl-summary-buffer-folder-name) -(defvar gnus-other-frame-object) -(defvar gnus-group-name) -(defvar gnus-article-current) -(defvar w3m-current-url) -(defvar w3m-current-title) -(defvar mh-progs) -(defvar mh-current-folder) -(defvar mh-show-folder-buffer) -(defvar mh-index-folder) -(defvar mh-searcher) -(defvar calendar-mode-map) -(defvar Info-current-file) -(defvar Info-current-node) -(defvar texmathp-why) -(defvar remember-save-after-remembering) -(defvar remember-data-file) -(defvar remember-register) -(defvar remember-buffer) -(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode' -(defvar initial) ; from remember.el, dynamically scoped in `remember-mode' -(defvar org-latex-regexps) -(defvar constants-unit-system) - -(defvar original-date) ; dynamically scoped in calendar.el does scope this ;; FIXME: Occasionally check by commenting these, to make sure ;; no other functions uses these, forgetting to let-bind them. @@ -4402,7 +4639,6 @@ This is for getting out of special buffers like remember.") (defvar date) (defvar description) - ;; Defined somewhere in this file, but used before definition. (defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized (defvar org-agenda-buffer-name) @@ -4495,8 +4731,10 @@ Works on both Emacs and XEmacs." (if org-ignore-region nil (if (featurep 'xemacs) - (region-active-p) - (use-region-p)))) + (and zmacs-regions (region-active-p)) + (if (fboundp 'use-region-p) + (use-region-p) + (and transient-mark-mode mark-active))))) ; Emacs 22 and before ;; Invisibility compatibility @@ -4624,6 +4862,10 @@ The following commands are available: ; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping (org-set-local 'comment-padding " ") + ;; Imenu + (org-set-local 'imenu-create-index-function + 'org-imenu-get-tree) + ;; Make isearch reveal context (if (or (featurep 'xemacs) (not (boundp 'outline-isearch-open-invisible-function))) @@ -4704,7 +4946,7 @@ that will be added to PLIST. Returns the string that was modified." (defconst org-non-link-chars "]\t\n\r<>") (defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" "bbdb" "vm" - "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp")) + "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp" "message")) (defvar org-link-re-with-space nil "Matches a link with spaces, optional angular brackets around it.") (defvar org-link-re-with-space2 nil @@ -4749,7 +4991,7 @@ This should be called after the variable `org-link-types' has changed." "\\)>") org-plain-link-re (concat - "\\(" (mapconcat 'identity org-link-types "\\|") "\\):" + "\\<\\(" (mapconcat 'identity org-link-types "\\|") "\\):" "\\([^]\t\n\r<>,;() ]+\\)") org-bracket-link-regexp "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" @@ -4810,7 +5052,12 @@ The time stamps may be either active or inactive.") org-emphasis-alist))) (add-text-properties (match-beginning 2) (match-end 2) '(font-lock-multiline t)) - (backward-char 1)))) + (when org-hide-emphasis-markers + (add-text-properties (match-end 4) (match-beginning 5) + '(invisible org-link)) + (add-text-properties (match-beginning 3) (match-end 3) + '(invisible org-link))))) + (backward-char 1)) rtn)) (defun org-emphasize (&optional char) @@ -4925,10 +5172,10 @@ We use a macro so that the test can happen at compilation time." (ip (org-maybe-intangible (list 'invisible 'org-link 'rear-nonsticky org-nonsticky-props 'keymap org-mouse-map 'mouse-face 'highlight - 'help-echo help))) + 'font-lock-multiline t 'help-echo help))) (vp (list 'rear-nonsticky org-nonsticky-props 'keymap org-mouse-map 'mouse-face 'highlight - 'help-echo help))) + ' font-lock-multiline t 'help-echo help))) ;; We need to remove the invisible property here. Table narrowing ;; may have made some of this invisible. (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." (goto-char e) t))) +(defvar org-latex-and-specials-regexp nil + "Regular expression for highlighting export special stuff.") +(defvar org-match-substring-regexp) +(defvar org-match-substring-with-braces-regexp) +(defvar org-export-html-special-string-regexps) + +(defun org-compute-latex-and-specials-regexp () + "Compute regular expression for stuff treated specially by exporters." + (if (not org-highlight-latex-fragments-and-specials) + (org-set-local 'org-latex-and-specials-regexp nil) + (let* + ((matchers (plist-get org-format-latex-options :matchers)) + (latexs (delq nil (mapcar (lambda (x) (if (member (car x) matchers) x)) + org-latex-regexps))) + (options (org-combine-plists (org-default-export-plist) + (org-infile-export-plist))) + (org-export-with-sub-superscripts (plist-get options :sub-superscript)) + (org-export-with-LaTeX-fragments (plist-get options :LaTeX-fragments)) + (org-export-with-TeX-macros (plist-get options :TeX-macros)) + (org-export-html-expand (plist-get options :expand-quoted-html)) + (org-export-with-special-strings (plist-get options :special-strings)) + (re-sub + (cond + ((equal org-export-with-sub-superscripts '{}) + (list org-match-substring-with-braces-regexp)) + (org-export-with-sub-superscripts + (list org-match-substring-regexp)) + (t nil))) + (re-latex + (if org-export-with-LaTeX-fragments + (mapcar (lambda (x) (nth 1 x)) latexs))) + (re-macros + (if org-export-with-TeX-macros + (list (concat "\\\\" + (regexp-opt + (append (mapcar 'car org-html-entities) + (if (boundp 'org-latex-entities) + org-latex-entities nil)) + 'words))) ; FIXME + )) + ;; (list "\\\\\\(?:[a-zA-Z]+\\)"))) + (re-special (if org-export-with-special-strings + (mapcar (lambda (x) (car x)) + org-export-html-special-string-regexps))) + (re-rest + (delq nil + (list + (if org-export-html-expand "@<[^>\n]+>") + )))) + (org-set-local + 'org-latex-and-specials-regexp + (mapconcat 'identity (append re-latex re-sub re-macros re-special + re-rest) "\\|"))))) + +(defface org-latex-and-export-specials + (let ((font (cond ((assq :inherit custom-face-attributes) + '(:inherit underline)) + (t '(:underline t))))) + `((((class grayscale) (background light)) + (:foreground "DimGray" ,@font)) + (((class grayscale) (background dark)) + (:foreground "LightGray" ,@font)) + (((class color) (background light)) + (:foreground "SaddleBrown")) + (((class color) (background dark)) + (:foreground "burlywood")) + (t (,@font)))) + "Face used to highlight math latex and other special exporter stuff." + :group 'org-faces) + +(defun org-do-latex-and-special-faces (limit) + "Run through the buffer and add overlays to links." + (when org-latex-and-specials-regexp + (let (rtn d) + (while (and (not rtn) (re-search-forward org-latex-and-specials-regexp + limit t)) + (if (not (memq (car-safe (get-text-property (1+ (match-beginning 0)) + 'face)) + '(org-code org-verbatim underline))) + (progn + (setq rtn t + d (cond ((member (char-after (1+ (match-beginning 0))) + '(?_ ?^)) 1) + (t 0))) + (font-lock-prepend-text-property + (+ d (match-beginning 0)) (match-end 0) + 'face 'org-latex-and-export-specials) + (add-text-properties (+ d (match-beginning 0)) (match-end 0) + '(font-lock-multiline t))))) + rtn))) + (defun org-restart-font-lock () "Restart font-lock-mode, to force refontification." (when (and (boundp 'font-lock-mode) font-lock-mode) @@ -5064,7 +5402,7 @@ between words." '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" (1 'org-table t)) ;; Table internals - '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t)) + '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t)) '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) ;; Drawers @@ -5113,14 +5451,17 @@ between words." (if org-provide-checkbox-statistics '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" (0 (org-get-checkbox-statistics-face) t))) + (list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)") + '(1 'org-archived prepend)) + ;; Specials + '(org-do-latex-and-special-faces) + ;; Code + '(org-activate-code (1 'org-code t)) ;; COMMENT (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string "\\|" org-quote-string "\\)\\>") '(1 'org-special-keyword t)) '("^#.*" (0 'font-lock-comment-face t)) - '("^\\*+ \\(.*:ARCHIVE:.*\\)" (1 'org-archived prepend)) - ;; Code - '(org-activate-code (1 'org-code t)) ))) (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) ;; Now set the full font-lock-keywords @@ -5345,12 +5686,12 @@ If KWD is a number, get the corresponding match group." (>= (match-end 0) pos)))) t (eq org-cycle-emulate-tab t)) - (if (and (looking-at "[ \n\r\t]") - (string-match "^[ \t]*$" (buffer-substring - (point-at-bol) (point)))) - (progn - (beginning-of-line 1) - (and (looking-at "[ \t]+") (replace-match "")))) +; (if (and (looking-at "[ \n\r\t]") +; (string-match "^[ \t]*$" (buffer-substring +; (point-at-bol) (point)))) +; (progn +; (beginning-of-line 1) +; (and (looking-at "[ \t]+") (replace-match "")))) (call-interactively (global-key-binding "\t"))) (t (save-excursion @@ -5418,6 +5759,17 @@ This function is the default value of the hook `org-cycle-hook'." ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) +(defun org-compact-display-after-subtree-move () + (let (beg end) + (save-excursion + (if (org-up-heading-safe) + (progn + (hide-subtree) + (show-entry) + (show-children) + (org-cycle-show-empty-lines 'children) + (org-cycle-hide-drawers 'children)) + (org-overview))))) (defun org-cycle-show-empty-lines (state) "Show empty lines above all visible headlines. @@ -5508,6 +5860,8 @@ RET=jump to location [Q]uit and return to previous location \[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur" ) +(defvar org-goto-start-pos) ; dynamically scoped parameter + (defun org-goto () "Look up a different location in the current file, keeping current visibility. @@ -5631,8 +5985,10 @@ or nil." "Create indirect buffer and narrow it to current subtree. With numerical prefix ARG, go up to this level and then take that tree. If ARG is negative, go up that many levels. -Normally this command removes the indirect buffer previously made -with this command. However, when called with a C-u prefix, the last buffer +If `org-indirect-buffer-display' is not `new-frame', the command removes the +indirect buffer previously made with this command, to avoid proliferation of +indirect buffers. However, when you call the command with a `C-u' prefix, or +when `org-indirect-buffer-display' is `new-frame', the last buffer is kept so that you can work with several indirect buffers at the same time. If `org-indirect-buffer-display' is `dedicated-frame', the C-u prefix also requests that a new frame be made for the new buffer, so that the dedicated @@ -5652,8 +6008,9 @@ frame is not changed." (setq beg (point) heading (org-get-heading)) (org-end-of-subtree t) (setq end (point))) - (if (and (not arg) - (buffer-live-p org-last-indirect-buffer)) + (if (and (buffer-live-p org-last-indirect-buffer) + (not (eq org-indirect-buffer-display 'new-frame)) + (not arg)) (kill-buffer org-last-indirect-buffer)) (setq ibuf (org-get-indirect-buffer cbuf) org-last-indirect-buffer ibuf) @@ -5917,7 +6274,8 @@ would end up with no indentation after the change, nothing at all is done." col) (unless (save-excursion (end-of-line 1) (re-search-forward prohibit end t)) - (while (re-search-forward "^[ \t]+" end t) + (while (and (< (point) end) + (re-search-forward "^[ \t]+" end t)) (goto-char (match-end 0)) (setq col (current-column)) (if (< diff 0) (replace-match "")) @@ -5980,38 +6338,65 @@ is signaled in this case." 'outline-get-last-sibling)) (ins-point (make-marker)) (cnt (abs arg)) - beg end txt folded) + beg beg0 end txt folded ne-beg ne-end ne-ins ins-end) ;; Select the tree (org-back-to-heading) - (setq beg (point)) + (setq beg0 (point)) + (save-excursion + (setq ne-beg (org-back-over-empty-lines)) + (setq beg (point))) (save-match-data (save-excursion (outline-end-of-heading) (setq folded (org-invisible-p))) (outline-end-of-subtree)) (outline-next-heading) + (setq ne-end (org-back-over-empty-lines)) (setq end (point)) + (goto-char beg0) + (when (and (> arg 0) (org-first-sibling-p) (< ne-end ne-beg)) + ;; include less whitespace + (save-excursion + (goto-char beg) + (forward-line (- ne-beg ne-end)) + (setq beg (point)))) ;; Find insertion point, with error handling - (goto-char beg) (while (> cnt 0) (or (and (funcall movfunc) (looking-at outline-regexp)) - (progn (goto-char beg) + (progn (goto-char beg0) (error "Cannot move past superior level or buffer limit"))) (setq cnt (1- cnt))) (if (> arg 0) ;; Moving forward - still need to move over subtree - (progn (outline-end-of-subtree) - (outline-next-heading) - (if (not (or (looking-at (concat "^" outline-regexp)) - (bolp))) - (newline)))) + (progn (org-end-of-subtree t t) + (save-excursion + (org-back-over-empty-lines) + (or (bolp) (newline))))) + (setq ne-ins (org-back-over-empty-lines)) (move-marker ins-point (point)) (setq txt (buffer-substring beg end)) (delete-region beg end) + (outline-flag-region (1- beg) beg nil) + (outline-flag-region (1- (point)) (point) nil) (insert txt) (or (bolp) (insert "\n")) + (setq ins-end (point)) (goto-char ins-point) - (if folded (hide-subtree)) - (move-marker ins-point nil))) + (org-skip-whitespace) + (when (and (< arg 0) + (org-first-sibling-p) + (> ne-ins ne-beg)) + ;; Move whitespace back to beginning + (save-excursion + (goto-char ins-end) + (let ((kill-whole-line t)) + (kill-line (- ne-ins ne-beg)) (point))) + (insert (make-string (- ne-ins ne-beg) ?\n))) + (move-marker ins-point nil) + (org-compact-display-after-subtree-move) + (unless folded + (org-show-entry) + (show-children) + (org-cycle-hide-drawers 'children)))) (defvar org-subtree-clip "" "Clipboard for cut and paste of subtrees. @@ -6035,11 +6420,13 @@ With prefix arg N, cut this many sequential subtrees. This is a short-hand for marking the subtree and then copying it. If CUT is non-nil, actually cut the subtree." (interactive "p") - (let (beg end folded) + (let (beg end folded (beg0 (point))) (if (interactive-p) (org-back-to-heading nil) ; take what looks like a subtree (org-back-to-heading t)) ; take what is really there + (org-back-over-empty-lines) (setq beg (point)) + (skip-chars-forward " \t\r\n") (save-match-data (save-excursion (outline-end-of-heading) (setq folded (org-invisible-p))) @@ -6047,8 +6434,9 @@ If CUT is non-nil, actually cut the subtree." (outline-forward-same-level (1- n)) (error nil)) (org-end-of-subtree t t)) + (org-back-over-empty-lines) (setq end (point)) - (goto-char beg) + (goto-char beg0) (when (> end beg) (setq org-subtree-clip-folded folded) (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." (delete-region (point-at-bol) (point))) ;; Paste (beginning-of-line 1) + (org-back-over-empty-lines) ;; FIXME: correct fix???? (setq beg (point)) - (insert txt) - (unless (string-match "\n[ \t]*\\'" txt) (insert "\n")) + (insert-before-markers txt) ;; FIXME: correct fix???? + (unless (string-match "\n\\'" txt) (insert "\n")) (setq end (point)) (goto-char beg) + (skip-chars-forward " \t\n\r") + (setq beg (point)) ;; Shift if necessary (unless (= shift 0) (save-restriction @@ -6154,10 +6545,12 @@ which is OK for `org-paste-subtree'. If optional TXT is given, check this string instead of the current kill." (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) (start-level (and kill - (string-match (concat "\\`" org-outline-regexp) kill) - (- (match-end 0) (match-beginning 0) 1))) + (string-match (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" + org-outline-regexp "\\)") + kill) + (- (match-end 2) (match-beginning 2) 1))) (re (concat "^" org-outline-regexp)) - (start 1)) + (start (1+ (match-beginning 2)))) (if (not start-level) (progn nil) ;; does not even start with a heading @@ -6228,7 +6621,11 @@ WITH-CASE, the sorting considers case as well." (condition-case nil (progn (org-back-to-heading) t) (error nil))) ;; we will sort the children of the current headline (org-back-to-heading) - (setq start (point) end (org-end-of-subtree) what "children") + (setq start (point) + end (progn (org-end-of-subtree t t) + (org-back-over-empty-lines) + (point)) + what "children") (goto-char start) (show-subtree) (outline-next-heading)) @@ -6309,12 +6706,12 @@ WITH-CASE, the sorting considers case as well." (cond ((= dcst ?n) (string-to-number (buffer-substring (match-end 0) - (line-end-position)))) + (point-at-eol)))) ((= dcst ?a) - (buffer-substring (match-end 0) (line-end-position))) + (buffer-substring (match-end 0) (point-at-eol))) ((= dcst ?t) (if (re-search-forward org-ts-regexp - (line-end-position) t) + (point-at-eol) t) (org-time-string-to-time (match-string 0)) now)) ((= dcst ?f) @@ -6330,11 +6727,11 @@ WITH-CASE, the sorting considers case as well." ((= dcst ?n) (if (looking-at outline-regexp) (string-to-number (buffer-substring (match-end 0) - (line-end-position))) + (point-at-eol))) nil)) ((= dcst ?a) - (funcall case-func (buffer-substring (line-beginning-position) - (line-end-position)))) + (funcall case-func (buffer-substring (point-at-bol) + (point-at-eol)))) ((= dcst ?t) (if (re-search-forward org-ts-regexp (save-excursion @@ -6343,7 +6740,7 @@ WITH-CASE, the sorting considers case as well." (org-time-string-to-time (match-string 0)) now)) ((= dcst ?p) - (if (re-search-forward org-priority-regexp (line-end-position) t) + (if (re-search-forward org-priority-regexp (point-at-eol) t) (string-to-char (match-string 2)) org-default-priority)) ((= dcst ?r) @@ -6383,7 +6780,8 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." (setq extractfun 'string-to-number comparefun (if (= dcst sorting-type) '< '>))) ((= dcst ?a) - (setq extractfun (if with-case 'identity 'downcase) + (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x)) + (lambda(x) (downcase (org-sort-remove-invisible x)))) comparefun (if (= dcst sorting-type) 'string< (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." ((org-on-heading-p) (setq beg (point) end (save-excursion (outline-next-heading) (point)))) ((org-at-item-checkbox-p) - (save-excursion + (let ((pos (point))) (replace-match (cond (arg "[-]") ((member (match-string 0) '("[ ]" "[-]")) "[X]") (t "[ ]")) - t t)) + t t) + (goto-char pos)) (throw 'exit t)) (t (error "Not at a checkbox or heading, and no active region"))) (save-excursion @@ -6707,27 +7106,49 @@ Error if not at a plain list, or if this is the first item in the list." (error (goto-char pos) (error "On first item"))))) +(defun org-first-list-item-p () + "Is this heading the item in a plain list?" + (unless (org-at-item-p) + (error "Not at a plain list item")) + (org-beginning-of-item) + (= (point) (save-excursion (org-beginning-of-item-list)))) + (defun org-move-item-down () "Move the plain list item at point down, i.e. swap with following item. Subitems (items with larger indentation) are considered part of the item, so this really moves item trees." (interactive) - (let (beg end ind ind1 (pos (point)) txt) + (let (beg beg0 end end0 ind ind1 (pos (point)) txt ne-end ne-beg) (org-beginning-of-item) - (setq beg (point)) + (setq beg0 (point)) + (save-excursion + (setq ne-beg (org-back-over-empty-lines)) + (setq beg (point))) + (goto-char beg0) (setq ind (org-get-indentation)) (org-end-of-item) - (setq end (point)) + (setq end0 (point)) (setq ind1 (org-get-indentation)) + (setq ne-end (org-back-over-empty-lines)) + (setq end (point)) + (goto-char beg0) + (when (and (org-first-list-item-p) (< ne-end ne-beg)) + ;; include less whitespace + (save-excursion + (goto-char beg) + (forward-line (- ne-beg ne-end)) + (setq beg (point)))) + (goto-char end0) (if (and (org-at-item-p) (= ind ind1)) (progn (org-end-of-item) + (org-back-over-empty-lines) (setq txt (buffer-substring beg end)) (save-excursion (delete-region beg end)) (setq pos (point)) (insert txt) - (goto-char pos) + (goto-char pos) (org-skip-whitespace) (org-maybe-renumber-ordered-list)) (goto-char pos) (error "Cannot move this item further down")))) @@ -6737,13 +7158,19 @@ so this really moves item trees." Subitems (items with larger indentation) are considered part of the item, so this really moves item trees." (interactive "p") - (let (beg end ind ind1 (pos (point)) txt) + (let (beg beg0 end end0 ind ind1 (pos (point)) txt + ne-beg ne-end ne-ins ins-end) (org-beginning-of-item) - (setq beg (point)) + (setq beg0 (point)) (setq ind (org-get-indentation)) + (save-excursion + (setq ne-beg (org-back-over-empty-lines)) + (setq beg (point))) + (goto-char beg0) (org-end-of-item) + (setq ne-end (org-back-over-empty-lines)) (setq end (point)) - (goto-char beg) + (goto-char beg0) (catch 'exit (while t (beginning-of-line 0) @@ -6762,12 +7189,23 @@ so this really moves item trees." (setq ind1 (org-get-indentation)) (if (and (org-at-item-p) (= ind ind1)) (progn + (setq ne-ins (org-back-over-empty-lines)) (setq txt (buffer-substring beg end)) (save-excursion (delete-region beg end)) (setq pos (point)) (insert txt) - (goto-char pos) + (setq ins-end (point)) + (goto-char pos) (org-skip-whitespace) + + (when (and (org-first-list-item-p) (> ne-ins ne-beg)) + ;; Move whitespace back to beginning + (save-excursion + (goto-char ins-end) + (let ((kill-whole-line t)) + (kill-line (- ne-ins ne-beg)) (point))) + (insert (make-string (- ne-ins ne-beg) ?\n))) + (org-maybe-renumber-ordered-list)) (goto-char pos) (error "Cannot move this item further up")))) @@ -7090,7 +7528,7 @@ C-c C-c Set tags / toggle checkbox" "Unconditionally turn on `orgstruct-mode', and force org-mode indentations. In addition to setting orgstruct-mode, this also exports all indentation and autofilling variables from org-mode into the buffer. Note that turning -off orgstruct-mode will *not* remove these additonal settings." +off orgstruct-mode will *not* remove these additional settings." (orgstruct-mode 1) (let (var val) (mapc @@ -7105,7 +7543,7 @@ off orgstruct-mode will *not* remove these additonal settings." (defun orgstruct-error () "Error when there is no default binding for a structure key." (interactive) - (error "This key is has no function outside structure elements")) + (error "This key has no function outside structure elements")) (defun orgstruct-setup () "Setup orgstruct keymaps." @@ -7252,7 +7690,8 @@ this heading." (this-buffer (current-buffer)) (org-archive-location org-archive-location) (re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$") - ;; start of variables that will be used for savind context + ;; start of variables that will be used for saving context + ;; The compiler complains about them - keep them anyway! (file (abbreviate-file-name (buffer-file-name))) (time (format-time-string (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." (save-excursion (beginning-of-line 1) (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") - (let ((b (match-end 0))) + (let ((b (match-end 0)) + (outline-regexp org-outline-regexp)) (if (re-search-forward "^[ \t]*:END:" (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." (goto-char beg) (if (looking-at (concat ".*:" org-archive-tag ":")) (message "%s" (substitute-command-keys - "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway."))))))) + "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway."))))))) (defun org-force-cycle-archived () "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.") (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) (hfmt1 (concat (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) - emptystrings links dates narrow fmax f1 len c e) + emptystrings links dates emph narrow fmax f1 len c e) (untabify beg end) (remove-text-properties beg end '(org-cwidth t org-dwidth t display t)) ;; Check if we have links or dates (goto-char beg) (setq links (re-search-forward org-bracket-link-regexp end t)) (goto-char beg) + (setq emph (and org-hide-emphasis-markers + (re-search-forward org-emph-re end t))) + (goto-char beg) (setq dates (and org-display-custom-times (re-search-forward org-ts-regexp-both end t))) ;; Make sure the link properties are right (when links (goto-char beg) (while (org-activate-bracket-links end))) ;; Make sure the date properties are right (when dates (goto-char beg) (while (org-activate-dates end))) + (when emph (goto-char beg) (while (org-do-emphasis-faces end))) ;; Check if we are narrowing any columns (goto-char beg) @@ -7923,13 +8367,14 @@ This is being used to correctly align a single field after TAB or RET.") ;; With invisible characters, `format' does not get the field width right ;; So we need to make these fields wide by hand. - (when links + (when (or links emph) (loop for i from 0 upto (1- maxfields) do (setq len (nth i lengths)) (loop for j from 0 upto (1- (length fields)) do (setq c (nthcdr i (car (nthcdr j fields)))) (if (and (stringp (car c)) - (string-match org-bracket-link-regexp (car c)) + (text-property-any 0 (length (car c)) 'invisible 'org-link (car c)) +; (string-match org-bracket-link-regexp (car c)) (< (org-string-width (car c)) len)) (setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ ))))))) @@ -8653,7 +9098,11 @@ should be done in reverse order." (skip-chars-backward "^|") (setq ecol (1- (current-column))) (org-table-goto-column column) - (setq lns (mapcar (lambda(x) (cons (org-trim (substring x bcol ecol)) x)) + (setq lns (mapcar (lambda(x) (cons + (org-sort-remove-invisible + (nth (1- column) + (org-split-string x "[ \t]*|[ \t]*"))) + x)) (org-split-string (buffer-substring beg end) "\n"))) (setq lns (org-do-sort lns "Table" with-case sorting-type)) (delete-region beg end) @@ -8664,6 +9113,15 @@ should be done in reverse order." (org-table-goto-column thiscol) (message "%d lines sorted, based on column %d" (length lns) column))) +;; FIXME: maybe we will not need this? Table sorting is broken.... +(defun org-sort-remove-invisible (s) + (remove-text-properties 0 (length s) org-rm-props s) + (while (string-match org-bracket-link-regexp s) + (setq s (replace-match (if (match-end 2) + (match-string 3 s) + (match-string 1 s)) t t s))) + s) + (defun org-table-cut-region (beg end) "Copy region in table to the clipboard and blank all relevant fields." (interactive "r") @@ -9366,8 +9824,7 @@ of the new mark." (goto-line l1))) (if (not (= epos (point-at-eol))) (org-table-align)) (goto-line l) - (and (interactive-p) - (message "%s" (or (cdr (assoc new org-recalc-marks)) ""))))) + (and (interactive-p) (message "%s" (cdr (assoc new org-recalc-marks)))))) (defun org-table-maybe-recalculate-line () "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." (defun orgtbl-error () "Error when there is no default binding for a table key." (interactive) - (error "This key is has no function outside tables")) + (error "This key has no function outside tables")) (defun orgtbl-setup () "Setup orgtbl keymaps." @@ -11202,9 +11659,9 @@ TeXInfo are: %s for the original field value. For example, to wrap everything in @kbd{}, you could use :fmt \"@kbd{%s}\". This may also be a property list with column numbers and - formats. for example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\"). + formats. For example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\"). -:cf \"f1 f2..\" The column fractions for the table. Bye default these +:cf \"f1 f2..\" The column fractions for the table. By default these are computed automatically from the width of the columns under org-mode. @@ -11265,7 +11722,7 @@ value. Each function should check if it is responsible for creating this link (for example by looking at the major mode). If not, it must exit and return nil. If yes, it should return a non-nil value after a calling -`org-store-link-properties' with a list of properties and values. +`org-store-link-props' with a list of properties and values. Special properties are: :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 an argument. FOLLOW should do whatever is necessary to follow the link, for example to find a file or display a mail message. + PUBLISH takes the path and retuns the string that should be used when -this document is published." +this document is published. FIMXE: This is actually not yet implemented." (add-to-list 'org-link-types type t) (org-make-link-regexps) (add-to-list 'org-link-protocols @@ -11374,10 +11832,10 @@ For file links, arg negates `org-context-in-file-links'." (if (fboundp 'elmo-message-entity) (elmo-message-entity wl-summary-buffer-elmo-folder msgnum) - (elmo-msgdb-overview-get-entity - msgnum (wl-summary-buffer-msgdb)))) + (elmo-msgdb-overview-get-entity + msgnum (wl-summary-buffer-msgdb)))) (from (wl-summary-line-from)) - (to (elmo-message-entity-field wl-message-entity 'to)) + (to (car (elmo-message-entity-field wl-message-entity 'to))) (subject (let (wl-thr-indent-string wl-parent-message-entity) (wl-summary-line-subject)))) (org-store-link-props :type "wl" :from from :to to @@ -11613,8 +12071,10 @@ according to FMT (default from `org-email-link-description-format')." (error "Empty link")) (when (stringp description) ;; Remove brackets from the description, they are fatal. - (while (string-match "\\[\\|\\]" description) - (setq description (replace-match "" t t description)))) + (while (string-match "\\[" description) + (setq description (replace-match "{" t t description))) + (while (string-match "\\]" description) + (setq description (replace-match "}" t t description)))) (when (equal (org-link-escape link) description) ;; No description needed, it is identical (setq description nil)) @@ -11626,29 +12086,29 @@ according to FMT (default from `org-email-link-description-format')." "]")) (defconst org-link-escape-chars - '((" " . "%20") - ("[" . "%5B") - ("]" . "%5d") - ("\340" . "%E0") ; `a - ("\342" . "%E2") ; ^a - ("\347" . "%E7") ; ,c - ("\350" . "%E8") ; `e - ("\351" . "%E9") ; 'e - ("\352" . "%EA") ; ^e - ("\356" . "%EE") ; ^i - ("\364" . "%F4") ; ^o - ("\371" . "%F9") ; `u - ("\373" . "%FB") ; ^u - (";" . "%3B") - ("?" . "%3F") - ("=" . "%3D") - ("+" . "%2B") + '((?\ . "%20") + (?\[ . "%5B") + (?\] . "%5D") + (?\340 . "%E0") ; `a + (?\342 . "%E2") ; ^a + (?\347 . "%E7") ; ,c + (?\350 . "%E8") ; `e + (?\351 . "%E9") ; 'e + (?\352 . "%EA") ; ^e + (?\356 . "%EE") ; ^i + (?\364 . "%F4") ; ^o + (?\371 . "%F9") ; `u + (?\373 . "%FB") ; ^u + (?\; . "%3B") + (?? . "%3F") + (?= . "%3D") + (?+ . "%2B") ) "Association list of escapes for some characters problematic in links. This is the list that is used for internal purposes.") (defconst org-link-escape-chars-browser - '((" " . "%20")) + '((?\ . "%20")) ; 32 for the SPC char "Association list of escapes for some characters problematic in links. This is the list that is used before handing over to the browser.") @@ -11656,12 +12116,14 @@ This is the list that is used before handing over to the browser.") "Escape charaters in TEXT that are problematic for links." (setq table (or table org-link-escape-chars)) (when text - (let ((re (mapconcat (lambda (x) (regexp-quote (car x))) + (let ((re (mapconcat (lambda (x) (regexp-quote + (char-to-string (car x)))) table "\\|"))) (while (string-match re text) (setq text (replace-match - (cdr (assoc (match-string 0 text) table)) + (cdr (assoc (string-to-char (match-string 0 text)) + table)) t t text))) text))) @@ -11674,7 +12136,7 @@ This is the list that is used before handing over to the browser.") (while (string-match re text) (setq text (replace-match - (car (rassoc (match-string 0 text) table)) + (char-to-string (car (rassoc (match-string 0 text) table))) t t text))) text))) @@ -11957,189 +12419,192 @@ the end of the current subtree. Normally, files will be opened by an appropriate application. If the optional argument IN-EMACS is non-nil, Emacs will visit the file." (interactive "P") - (move-marker org-open-link-marker (point)) - (setq org-window-config-before-follow-link (current-window-configuration)) - (org-remove-occur-highlights nil nil t) - (if (org-at-timestamp-p t) - (org-follow-timestamp-link) - (let (type path link line search (pos (point))) - (catch 'match - (save-excursion - (skip-chars-forward "^]\n\r") - (when (org-in-regexp org-bracket-link-regexp) - (setq link (org-link-unescape (org-match-string-no-properties 1))) - (while (string-match " *\n *" link) - (setq link (replace-match " " t t link))) - (setq link (org-link-expand-abbrev link)) - (if (string-match org-link-re-with-space2 link) - (setq type (match-string 1 link) path (match-string 2 link)) - (setq type "thisfile" path link)) - (throw 'match t))) - - (when (get-text-property (point) 'org-linked-text) - (setq type "thisfile" - pos (if (get-text-property (1+ (point)) 'org-linked-text) - (1+ (point)) (point)) - path (buffer-substring - (previous-single-property-change pos 'org-linked-text) - (next-single-property-change pos 'org-linked-text))) - (throw 'match t)) + (catch 'abort + (move-marker org-open-link-marker (point)) + (setq org-window-config-before-follow-link (current-window-configuration)) + (org-remove-occur-highlights nil nil t) + (if (org-at-timestamp-p t) + (org-follow-timestamp-link) + (let (type path link line search (pos (point))) + (catch 'match + (save-excursion + (skip-chars-forward "^]\n\r") + (when (org-in-regexp org-bracket-link-regexp) + (setq link (org-link-unescape (org-match-string-no-properties 1))) + (while (string-match " *\n *" link) + (setq link (replace-match " " t t link))) + (setq link (org-link-expand-abbrev link)) + (if (string-match org-link-re-with-space2 link) + (setq type (match-string 1 link) path (match-string 2 link)) + (setq type "thisfile" path link)) + (throw 'match t))) + + (when (get-text-property (point) 'org-linked-text) + (setq type "thisfile" + pos (if (get-text-property (1+ (point)) 'org-linked-text) + (1+ (point)) (point)) + path (buffer-substring + (previous-single-property-change pos 'org-linked-text) + (next-single-property-change pos 'org-linked-text))) + (throw 'match t)) - (save-excursion - (when (or (org-in-regexp org-angle-link-re) - (org-in-regexp org-plain-link-re)) - (setq type (match-string 1) path (match-string 2)) - (throw 'match t))) - (when (org-in-regexp "\\<\\([^><\n]+\\)\\>") - (setq type "tree-match" - path (match-string 1)) - (throw 'match t)) - (save-excursion - (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$")) - (setq type "tags" + (save-excursion + (when (or (org-in-regexp org-angle-link-re) + (org-in-regexp org-plain-link-re)) + (setq type (match-string 1) path (match-string 2)) + (throw 'match t))) + (when (org-in-regexp "\\<\\([^><\n]+\\)\\>") + (setq type "tree-match" path (match-string 1)) - (while (string-match ":" path) - (setq path (replace-match "+" t t path))) - (throw 'match t)))) - (unless path - (error "No link found")) - ;; Remove any trailing spaces in path - (if (string-match " +\\'" path) - (setq path (replace-match "" t t path))) + (throw 'match t)) + (save-excursion + (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$")) + (setq type "tags" + path (match-string 1)) + (while (string-match ":" path) + (setq path (replace-match "+" t t path))) + (throw 'match t)))) + (unless path + (error "No link found")) + ;; Remove any trailing spaces in path + (if (string-match " +\\'" path) + (setq path (replace-match "" t t path))) - (cond + (cond - ((assoc type org-link-protocols) - (funcall (nth 1 (assoc type org-link-protocols)) path)) - - ((equal type "mailto") - (let ((cmd (car org-link-mailto-program)) - (args (cdr org-link-mailto-program)) args1 - (address path) (subject "") a) - (if (string-match "\\(.*\\)::\\(.*\\)" path) - (setq address (match-string 1 path) - subject (org-link-escape (match-string 2 path)))) - (while args - (cond - ((not (stringp (car args))) (push (pop args) args1)) - (t (setq a (pop args)) - (if (string-match "%a" a) - (setq a (replace-match address t t a))) - (if (string-match "%s" a) - (setq a (replace-match subject t t a))) - (push a args1)))) - (apply cmd (nreverse args1)))) - - ((member type '("http" "https" "ftp" "news")) - (browse-url (concat type ":" (org-link-escape - path org-link-escape-chars-browser)))) - - ((string= type "tags") - (org-tags-view in-emacs path)) - ((string= type "thisfile") - (if in-emacs - (switch-to-buffer-other-window - (org-get-buffer-for-internal-link (current-buffer))) - (org-mark-ring-push)) - (let ((cmd `(org-link-search - ,path - ,(cond ((equal in-emacs '(4)) 'occur) - ((equal in-emacs '(16)) 'org-occur) - (t nil)) - ,pos))) - (condition-case nil (eval cmd) - (error (progn (widen) (eval cmd)))))) - - ((string= type "tree-match") - (org-occur (concat "\\[" (regexp-quote path) "\\]"))) - - ((string= type "file") - (if (string-match "::\\([0-9]+\\)\\'" path) - (setq line (string-to-number (match-string 1 path)) - path (substring path 0 (match-beginning 0))) - (if (string-match "::\\(.+\\)\\'" path) - (setq search (match-string 1 path) - path (substring path 0 (match-beginning 0))))) - (org-open-file path in-emacs line search)) - - ((string= type "news") - (org-follow-gnus-link path)) - - ((string= type "bbdb") - (org-follow-bbdb-link path)) - - ((string= type "info") - (org-follow-info-link path)) - - ((string= type "gnus") - (let (group article) - (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) - (error "Error in Gnus link")) - (setq group (match-string 1 path) - article (match-string 3 path)) - (org-follow-gnus-link group article))) - - ((string= type "vm") - (let (folder article) - (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) - (error "Error in VM link")) - (setq folder (match-string 1 path) - article (match-string 3 path)) - ;; in-emacs is the prefix arg, will be interpreted as read-only - (org-follow-vm-link folder article in-emacs))) - - ((string= type "wl") - (let (folder article) - (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) - (error "Error in Wanderlust link")) - (setq folder (match-string 1 path) - article (match-string 3 path)) - (org-follow-wl-link folder article))) - - ((string= type "mhe") - (let (folder article) - (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) - (error "Error in MHE link")) - (setq folder (match-string 1 path) - article (match-string 3 path)) - (org-follow-mhe-link folder article))) - - ((string= type "rmail") - (let (folder article) - (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) - (error "Error in RMAIL link")) - (setq folder (match-string 1 path) - article (match-string 3 path)) - (org-follow-rmail-link folder article))) - - ((string= type "shell") - (let ((cmd path)) - ;; The following is only for backward compatibility - (while (string-match "@{" cmd) (setq cmd (replace-match "<" t t cmd))) - (while (string-match "@}" cmd) (setq cmd (replace-match ">" t t cmd))) - (if (or (not org-confirm-shell-link-function) - (funcall org-confirm-shell-link-function - (format "Execute \"%s\" in shell? " - (org-add-props cmd nil - 'face 'org-warning)))) - (progn - (message "Executing %s" cmd) - (shell-command cmd)) - (error "Abort")))) - - ((string= type "elisp") - (let ((cmd path)) - (if (or (not org-confirm-elisp-link-function) - (funcall org-confirm-elisp-link-function - (format "Execute \"%s\" as elisp? " - (org-add-props cmd nil - 'face 'org-warning)))) - (message "%s => %s" cmd (eval (read cmd))) - (error "Abort")))) + ((assoc type org-link-protocols) + (funcall (nth 1 (assoc type org-link-protocols)) path)) + + ((equal type "mailto") + (let ((cmd (car org-link-mailto-program)) + (args (cdr org-link-mailto-program)) args1 + (address path) (subject "") a) + (if (string-match "\\(.*\\)::\\(.*\\)" path) + (setq address (match-string 1 path) + subject (org-link-escape (match-string 2 path)))) + (while args + (cond + ((not (stringp (car args))) (push (pop args) args1)) + (t (setq a (pop args)) + (if (string-match "%a" a) + (setq a (replace-match address t t a))) + (if (string-match "%s" a) + (setq a (replace-match subject t t a))) + (push a args1)))) + (apply cmd (nreverse args1)))) + + ((member type '("http" "https" "ftp" "news")) + (browse-url (concat type ":" (org-link-escape + path org-link-escape-chars-browser)))) + + ((member type '("message")) + (browse-url (concat type ":" path))) + + ((string= type "tags") + (org-tags-view in-emacs path)) + ((string= type "thisfile") + (if in-emacs + (switch-to-buffer-other-window + (org-get-buffer-for-internal-link (current-buffer))) + (org-mark-ring-push)) + (let ((cmd `(org-link-search + ,path + ,(cond ((equal in-emacs '(4)) 'occur) + ((equal in-emacs '(16)) 'org-occur) + (t nil)) + ,pos))) + (condition-case nil (eval cmd) + (error (progn (widen) (eval cmd)))))) + + ((string= type "tree-match") + (org-occur (concat "\\[" (regexp-quote path) "\\]"))) + + ((string= type "file") + (if (string-match "::\\([0-9]+\\)\\'" path) + (setq line (string-to-number (match-string 1 path)) + path (substring path 0 (match-beginning 0))) + (if (string-match "::\\(.+\\)\\'" path) + (setq search (match-string 1 path) + path (substring path 0 (match-beginning 0))))) + (if (string-match "[*?{]" (file-name-nondirectory path)) + (dired path) + (org-open-file path in-emacs line search))) + + ((string= type "news") + (org-follow-gnus-link path)) + + ((string= type "bbdb") + (org-follow-bbdb-link path)) + + ((string= type "info") + (org-follow-info-link path)) + + ((string= type "gnus") + (let (group article) + (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) + (error "Error in Gnus link")) + (setq group (match-string 1 path) + article (match-string 3 path)) + (org-follow-gnus-link group article))) + + ((string= type "vm") + (let (folder article) + (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) + (error "Error in VM link")) + (setq folder (match-string 1 path) + article (match-string 3 path)) + ;; in-emacs is the prefix arg, will be interpreted as read-only + (org-follow-vm-link folder article in-emacs))) + + ((string= type "wl") + (let (folder article) + (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) + (error "Error in Wanderlust link")) + (setq folder (match-string 1 path) + article (match-string 3 path)) + (org-follow-wl-link folder article))) + + ((string= type "mhe") + (let (folder article) + (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) + (error "Error in MHE link")) + (setq folder (match-string 1 path) + article (match-string 3 path)) + (org-follow-mhe-link folder article))) + + ((string= type "rmail") + (let (folder article) + (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) + (error "Error in RMAIL link")) + (setq folder (match-string 1 path) + article (match-string 3 path)) + (org-follow-rmail-link folder article))) + + ((string= type "shell") + (let ((cmd path)) + (if (or (not org-confirm-shell-link-function) + (funcall org-confirm-shell-link-function + (format "Execute \"%s\" in shell? " + (org-add-props cmd nil + 'face 'org-warning)))) + (progn + (message "Executing %s" cmd) + (shell-command cmd)) + (error "Abort")))) + + ((string= type "elisp") + (let ((cmd path)) + (if (or (not org-confirm-elisp-link-function) + (funcall org-confirm-elisp-link-function + (format "Execute \"%s\" as elisp? " + (org-add-props cmd nil + 'face 'org-warning)))) + (message "%s => %s" cmd (eval (read cmd))) + (error "Abort")))) - (t - (browse-url-at-point))))) - (move-marker org-open-link-marker nil)) + (t + (browse-url-at-point))))) + (move-marker org-open-link-marker nil))) ;;; File search @@ -12575,8 +13040,8 @@ use sequences." (mh-show-buffer-message-number)))) (defun org-mhe-get-header (header) - "Return a header of the message in folder mode. This will create a -show buffer for the corresponding message. If you have a more clever + "Return a header of the message in folder mode. This will create a +show buffer for the corresponding message. If you have a more clever idea..." (let* ((folder (org-mhe-get-message-folder)) (num (org-mhe-get-message-num)) @@ -12727,9 +13192,10 @@ If the file does not exist, an error is thrown." (cond ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) ;; Remove quotes around the file name - we'll use shell-quote-argument. - (if (string-match "['\"]%s['\"]" cmd) - (setq cmd (replace-match "%s" t t cmd))) - (setq cmd (format cmd (shell-quote-argument file))) + (while (string-match "['\"]%s['\"]" cmd) + (setq cmd (replace-match "%s" t t cmd))) + (while (string-match "%s" cmd) + (setq cmd (replace-match (shell-quote-argument file) t t cmd))) (save-window-excursion (start-process-shell-command cmd nil cmd))) ((or (stringp cmd) @@ -12772,7 +13238,18 @@ on the system \"/user@host:\"." (t nil))) -;;;; Hooks for remember.el +;;;; Hooks for remember.el, and refiling + +(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode' +(defvar initial) ; from remember.el, dynamically scoped in `remember-mode' + +;;;###autoload +(defun org-remember-insinuate () + "Setup remember.el for use wiht Org-mode." + (require 'remember) + (setq remember-annotation-functions '(org-remember-annotation)) + (setq remember-handler-functions '(org-remember-handler)) + (add-hook 'remember-mode-hook 'org-remember-apply-template)) ;;;###autoload (defun org-remember-annotation () @@ -12792,44 +13269,54 @@ RET at beg-of-buf -> Append to file as level 2 headline (defvar org-remember-previous-location nil) (defvar org-force-remember-template-char) ;; dynamically scoped +(defun org-select-remember-template (&optional use-char) + (when org-remember-templates + (let* ((templates (mapcar (lambda (x) + (if (stringp (car x)) + (append (list (nth 1 x) (car x)) (cddr x)) + (append (list (car x) "") (cdr x)))) + org-remember-templates)) + (char (or use-char + (cond + ((= (length templates) 1) + (caar templates)) + ((and (boundp 'org-force-remember-template-char) + org-force-remember-template-char) + (if (stringp org-force-remember-template-char) + (string-to-char org-force-remember-template-char) + org-force-remember-template-char)) + (t + (message "Select template: %s" + (mapconcat + (lambda (x) + (cond + ((not (string-match "\\S-" (nth 1 x))) + (format "[%c]" (car x))) + ((equal (downcase (car x)) + (downcase (aref (nth 1 x) 0))) + (format "[%c]%s" (car x) + (substring (nth 1 x) 1))) + (t (format "[%c]%s" (car x) (nth 1 x))))) + templates " ")) + (let ((inhibit-quit t) (char0 (read-char-exclusive))) + (when (equal char0 ?\C-g) + (jump-to-register remember-register) + (kill-buffer remember-buffer)) + char0)))))) + (cddr (assoc char templates))))) + +(defvar x-last-selected-text) +(defvar x-last-selected-text-primary) + ;;;###autoload (defun org-remember-apply-template (&optional use-char skip-interactive) "Initialize *remember* buffer with template, invoke `org-mode'. This function should be placed into `remember-mode-hook' and in fact requires -to be run from that hook to fucntion properly." +to be run from that hook to function properly." + (unless (fboundp 'remember-finalize) + (defalias 'remember-finalize 'remember-buffer)) (if org-remember-templates - (let* ((templates (mapcar (lambda (x) - (if (stringp (car x)) - (append (list (nth 1 x) (car x)) (cddr x)) - (append (list (car x) "") (cdr x)))) - org-remember-templates)) - (char (or use-char - (cond - ((= (length templates) 1) - (caar templates)) - ((and (boundp 'org-force-remember-template-char) - org-force-remember-template-char) - (if (stringp org-force-remember-template-char) - (string-to-char org-force-remember-template-char) - org-force-remember-template-char)) - (t - (message "Select template: %s" - (mapconcat - (lambda (x) - (cond - ((not (string-match "\\S-" (nth 1 x))) - (format "[%c]" (car x))) - ((equal (downcase (car x)) - (downcase (aref (nth 1 x) 0))) - (format "[%c]%s" (car x) (substring (nth 1 x) 1))) - (t (format "[%c]%s" (car x) (nth 1 x))))) - templates " ")) - (let ((inhibit-quit t) (char0 (read-char-exclusive))) - (when (equal char0 ?\C-g) - (jump-to-register remember-register) - (kill-buffer remember-buffer)) - char0))))) - (entry (cddr (assoc char templates))) + (let* ((entry (org-select-remember-template use-char)) (tpl (car entry)) (plist-p (if org-store-link-plist t nil)) (file (if (and (nth 1 entry) (stringp (nth 1 entry)) @@ -12837,6 +13324,12 @@ to be run from that hook to fucntion properly." (nth 1 entry) org-default-notes-file)) (headline (nth 2 entry)) + (v-c (or (and (eq window-system 'x) + (fboundp 'x-cut-buffer-or-selection-value) + (x-cut-buffer-or-selection-value)) + (org-bound-and-true-p x-last-selected-text) + (org-bound-and-true-p x-last-selected-text-primary) + (and (> (length kill-ring) 0) (current-kill 0)))) (v-t (format-time-string (car org-time-stamp-formats) (org-current-time))) (v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time))) (v-u (concat "[" (substring v-t 1 -1) "]")) @@ -12852,11 +13345,12 @@ to be run from that hook to fucntion properly." v-a)) (v-n user-full-name) (org-startup-folded nil) - org-time-was-given org-end-time-was-given x prompt char time) + org-time-was-given org-end-time-was-given x + prompt completions char time pos default histvar) (setq org-store-link-plist (append (list :annotation v-a :initial v-i) org-store-link-plist)) - (unless tpl (setq tpl "") (message "No template") (ding)) + (unless tpl (setq tpl "") (message "No template") (ding) (sit-for 1)) (erase-buffer) (insert (substitute-command-keys (format @@ -12873,7 +13367,7 @@ to be run from that hook to fucntion properly." (or (cdr org-remember-previous-location) "???")))) (insert tpl) (goto-char (point-min)) ;; Simple %-escapes - (while (re-search-forward "%\\([tTuUaiA]\\)" nil t) + (while (re-search-forward "%\\([tTuUaiAc]\\)" nil t) (when (and initial (equal (match-string 0) "%i")) (save-match-data (let* ((lead (buffer-substring @@ -12884,16 +13378,43 @@ to be run from that hook to fucntion properly." (replace-match (or (eval (intern (concat "v-" (match-string 1)))) "") t t)) + + ;; %[] Insert contents of a file. + (goto-char (point-min)) + (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) + (let ((start (match-beginning 0)) + (end (match-end 0)) + (filename (expand-file-name (match-string 1)))) + (goto-char start) + (delete-region start end) + (condition-case error + (insert-file-contents filename) + (error (insert (format "%%![Couldn't insert %s: %s]" + filename error)))))) + ;; %() embedded elisp + (goto-char (point-min)) + (while (re-search-forward "%\\((.+)\\)" nil t) + (goto-char (match-beginning 0)) + (let ((template-start (point))) + (forward-char 1) + (let ((result + (condition-case error + (eval (read (current-buffer))) + (error (format "%%![Error: %s]" error))))) + (delete-region template-start (point)) + (insert result)))) + ;; From the property list (when plist-p (goto-char (point-min)) (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) - (and (setq x (plist-get org-store-link-plist - (intern (match-string 1)))) + (and (setq x (or (plist-get org-store-link-plist + (intern (match-string 1))) "")) (replace-match x t t)))) + ;; Turn on org-mode in the remember buffer, set local variables (org-mode) - (org-set-local 'org-finish-function 'remember-buffer) + (org-set-local 'org-finish-function 'remember-finalize) (if (and file (string-match "\\S-" file) (not (file-directory-p file))) (org-set-local 'org-default-notes-file file)) (if (and headline (stringp headline) (string-match "\\S-" headline)) @@ -12905,6 +13426,15 @@ to be run from that hook to fucntion properly." prompt (if (match-end 2) (match-string 2))) (goto-char (match-beginning 0)) (replace-match "") + (setq completions nil default nil) + (when prompt + (setq completions (org-split-string prompt "|") + prompt (pop completions) + default (car completions) + histvar (intern (concat + "org-remember-template-prompt-history::" + (or prompt ""))) + completions (mapcar 'list completions))) (cond ((member char '("G" "g")) (let* ((org-last-tags-completion-table @@ -12930,33 +13460,92 @@ to be run from that hook to fucntion properly." (member char '("u" "U")) nil nil (list org-end-time-was-given))) (t - (insert (read-string - (if prompt (concat prompt ": ") "Enter string")))))) + (insert (org-completing-read + (concat (if prompt prompt "Enter string") + (if default (concat " [" default "]")) + ": ") + completions nil nil nil histvar default))))) (goto-char (point-min)) (if (re-search-forward "%\\?" nil t) (replace-match "") (and (re-search-forward "^[^#\n]" nil t) (backward-char 1)))) (org-mode) - (org-set-local 'org-finish-function 'remember-buffer))) + (org-set-local 'org-finish-function 'remember-finalize)) + (when (save-excursion + (goto-char (point-min)) + (re-search-forward "%!" nil t)) + (replace-match "") + (add-hook 'post-command-hook 'org-remember-finish-immediately 'append))) + +(defun org-remember-finish-immediately () + "File remember note immediately. +This should be run in `post-command-hook' and will remove itself +from that hook." + (remove-hook 'post-command-hook 'org-remember-finish-immediately) + (when org-finish-function + (funcall org-finish-function))) + ;;;###autoload -(defun org-remember (&optional org-force-remember-template-char) +(defun org-remember (&optional goto org-force-remember-template-char) "Call `remember'. If this is already a remember buffer, re-apply template. If there is an active region, make sure remember uses it as initial content -of the remember buffer." +of the remember buffer. + +When called interactively with a `C-u' prefix argument GOTO, don't remember +anything, just go to the file/headline where the selected template usually +stores its notes. With a double prefix arg `C-u C-u', go to the last +note stored by remember. + +Lisp programs can set ORG-FORCE-REMEMBER-TEMPLATE-CHAR to a character +associated with a template in `org-remember-templates'." + (interactive "P") + (cond + ((equal goto '(4)) (org-go-to-remember-target)) + ((equal goto '(16)) (org-remember-goto-last-stored)) + (t + (if (memq org-finish-function '(remember-buffer remember-finalize)) + (progn + (when (< (length org-remember-templates) 2) + (error "No other template available")) + (erase-buffer) + (let ((annotation (plist-get org-store-link-plist :annotation)) + (initial (plist-get org-store-link-plist :initial))) + (org-remember-apply-template)) + (message "Press C-c C-c to remember data")) + (if (org-region-active-p) + (remember (buffer-substring (point) (mark))) + (call-interactively 'remember)))))) + +(defun org-remember-goto-last-stored () + "Go to the location where the last remember note was stored." (interactive) - (if (eq org-finish-function 'remember-buffer) - (progn - (when (< (length org-remember-templates) 2) - (error "No other template available")) - (erase-buffer) - (let ((annotation (plist-get org-store-link-plist :annotation)) - (initial (plist-get org-store-link-plist :initial))) - (org-remember-apply-template)) - (message "Press C-c C-c to remember data")) - (if (org-region-active-p) - (remember (buffer-substring (point) (mark))) - (call-interactively 'remember)))) + (bookmark-jump "org-remember-last-stored") + (message "This is the last note stored by remember")) + +(defun org-go-to-remember-target (&optional template-key) + "Go to the target location of a remember template. +The user is queried for the template." + (interactive) + (let* ((entry (org-select-remember-template template-key)) + (file (nth 1 entry)) + (heading (nth 2 entry)) + visiting) + (unless (and file (stringp file) (string-match "\\S-" file)) + (setq file org-default-notes-file)) + (unless (and heading (stringp heading) (string-match "\\S-" heading)) + (setq heading org-remember-default-headline)) + (setq visiting (org-find-base-buffer-visiting file)) + (if (not visiting) (find-file-noselect file)) + (switch-to-buffer (or visiting (get-file-buffer file))) + (widen) + (goto-char (point-min)) + (if (re-search-forward + (concat "^\\*+[ \t]+" (regexp-quote heading) + (org-re "\\([ \t]+:[[:alnum:]@_:]*\\)?[ \t]*$")) + nil t) + (goto-char (match-beginning 0)) + (error "Target headline not found: %s" heading)))) (defvar org-note-abort nil) ; dynamically scoped @@ -13000,23 +13589,34 @@ See also the variable `org-reverse-note-order'." (while (looking-at "^[ \t]*\n\\|^##.*\n") (replace-match "")) (goto-char (point-max)) - (unless (equal (char-before) ?\n) (insert "\n")) + (beginning-of-line 1) + (while (looking-at "[ \t]*$\\|##.*") + (delete-region (1- (point)) (point-max)) + (beginning-of-line 1)) (catch 'quit (if org-note-abort (throw 'quit nil)) (let* ((txt (buffer-substring (point-min) (point-max))) (fastp (org-xor (equal current-prefix-arg '(4)) org-remember-store-without-prompt)) - (file (if fastp org-default-notes-file (org-get-org-file))) + (file (cond + (fastp org-default-notes-file) + ((and org-remember-use-refile-when-interactive + org-refile-targets) + org-default-notes-file) + (t (org-get-org-file)))) (heading org-remember-default-headline) - (visiting (org-find-base-buffer-visiting file)) + (visiting (and file (org-find-base-buffer-visiting file))) (org-startup-folded nil) (org-startup-align-all-tables nil) (org-goto-start-pos 1) spos exitcmd level indent reversed) (if (and (equal current-prefix-arg '(16)) org-remember-previous-location) (setq file (car org-remember-previous-location) - heading (cdr org-remember-previous-location))) + heading (cdr org-remember-previous-location) + fastp t)) (setq current-prefix-arg nil) + (if (string-match "[ \t\n]+\\'" txt) + (setq txt (replace-match "" t t txt))) ;; Modify text so that it becomes a nice subtree which can be inserted ;; into an org tree. (let* ((lines (split-string txt "\n")) @@ -13031,9 +13631,25 @@ See also the variable `org-reverse-note-order'." " (" (remember-buffer-desc) ")") indent " ")) (if (and org-adapt-indentation indent) - (setq lines (mapcar (lambda (x) (concat indent x)) lines))) + (setq lines (mapcar + (lambda (x) + (if (string-match "\\S-" x) + (concat indent x) x)) + lines))) (setq txt (concat first "\n" (mapconcat 'identity lines "\n")))) + (if (string-match "\n[ \t]*\n[ \t\n]*\\'" txt) + (setq txt (replace-match "\n\n" t t txt)) + (if (string-match "[ \t\n]*\\'" txt) + (setq txt (replace-match "\n" t t txt)))) + ;; Put the modified text back into the remember buffer, for refile. + (erase-buffer) + (insert txt) + (goto-char (point-min)) + (when (and org-remember-use-refile-when-interactive + (not fastp)) + (org-refile nil (or visiting (find-file-noselect file))) + (throw 'quit t)) ;; Find the file (if (not visiting) (find-file-noselect file)) (with-current-buffer (or visiting (get-file-buffer file)) @@ -13082,19 +13698,22 @@ See also the variable `org-reverse-note-order'." (org-get-heading 'notags))) (if reversed (outline-next-heading) - (org-end-of-subtree) + (org-end-of-subtree t) (if (not (bolp)) (if (looking-at "[ \t]*\n") (beginning-of-line 2) (end-of-line 1) (insert "\n")))) + (bookmark-set "org-remember-last-stored") (org-paste-subtree (org-get-legal-level level 1) txt)) ((eq exitcmd 'left) ;; before current + (bookmark-set "org-remember-last-stored") (org-paste-subtree level txt)) ((eq exitcmd 'right) ;; after current (org-end-of-subtree t) + (bookmark-set "org-remember-last-stored") (org-paste-subtree level txt)) (t (error "This should not happen")))) @@ -13104,6 +13723,7 @@ See also the variable `org-reverse-note-order'." (widen) (goto-char (point-max)) (if (not (bolp)) (newline)) + (bookmark-set "org-remember-last-stored") (org-paste-subtree (org-get-legal-level 1 1) txt))) ((and (bobp) reversed) @@ -13113,16 +13733,19 @@ See also the variable `org-reverse-note-order'." (goto-char (point-min)) (re-search-forward "^\\*+ " nil t) (beginning-of-line 1) + (bookmark-set "org-remember-last-stored") (org-paste-subtree 1 txt))) (t ;; Put it right there, with automatic level determined by ;; org-paste-subtree or from prefix arg + (bookmark-set "org-remember-last-stored") (org-paste-subtree (if (numberp current-prefix-arg) current-prefix-arg) txt))) (when remember-save-after-remembering (save-buffer) (if (not visiting) (kill-buffer (current-buffer))))))))) + t) ;; return t to indicate that we took care of this note. (defun org-get-org-file () @@ -13146,6 +13769,160 @@ See also the variable `org-reverse-note-order'." (throw 'exit (cdr entry)))) nil))))) +;;; Refiling + +(defvar org-refile-target-table nil + "The list of refile targets, created by `org-refile'.") + +(defvar org-agenda-new-buffers nil + "Buffers created to visit agenda files.") + +(defun org-get-refile-targets (&optional default-buffer) + "Produce a table with refile targets." + (let ((entries (or org-refile-targets '((nil . (:level . 1))))) + org-agenda-new-buffers targets txt re files f desc descre) + (with-current-buffer (or default-buffer (current-buffer)) + (while (setq entry (pop entries)) + (setq files (car entry) desc (cdr entry)) + (cond + ((null files) (setq files (list (current-buffer)))) + ((eq files 'org-agenda-files) + (setq files (org-agenda-files 'unrestricted))) + ((and (symbolp files) (fboundp files)) + (setq files (funcall files))) + ((and (symbolp files) (boundp files)) + (setq files (symbol-value files)))) + (if (stringp files) (setq files (list files))) + (cond + ((eq (car desc) :tag) + (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":"))) + ((eq (car desc) :todo) + (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]"))) + ((eq (car desc) :regexp) + (setq descre (cdr desc))) + ((eq (car desc) :level) + (setq descre (concat "^\\*\\{" (number-to-string + (if org-odd-levels-only + (1- (* 2 (cdr desc))) + (cdr desc))) + "\\}[ \t]"))) + ((eq (car desc) :maxlevel) + (setq descre (concat "^\\*\\{1," (number-to-string + (if org-odd-levels-only + (1- (* 2 (cdr desc))) + (cdr desc))) + "\\}[ \t]"))) + (t (error "Bad refiling target description %s" desc))) + (while (setq f (pop files)) + (save-excursion + (set-buffer (if (bufferp f) f (org-get-agenda-file-buffer f))) + (if (bufferp f) (setq f (buffer-file-name (buffer-base-buffer f)))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward descre nil t) + (goto-char (point-at-bol)) + (when (looking-at org-complex-heading-regexp) + (setq txt (match-string 4) + re (concat "^" (regexp-quote + (buffer-substring (match-beginning 1) + (match-end 4))))) + (if (match-end 5) (setq re (concat re "[ \t]+" + (regexp-quote + (match-string 5))))) + (setq re (concat re "[ \t]*$")) + (when org-refile-use-outline-path + (setq txt (mapconcat 'identity + (append + (if (eq org-refile-use-outline-path 'file) + (list (file-name-nondirectory + (buffer-file-name (buffer-base-buffer)))) + (if (eq org-refile-use-outline-path 'full-file-path) + (list (buffer-file-name (buffer-base-buffer))))) + (org-get-outline-path) + (list txt)) + "/"))) + (push (list txt f re (point)) targets)) + (goto-char (point-at-eol)))))))) + (org-release-buffers org-agenda-new-buffers) + (nreverse targets)))) + +(defun org-get-outline-path () + (let (rtn) + (save-excursion + (while (org-up-heading-safe) + (when (looking-at org-complex-heading-regexp) + (push (org-match-string-no-properties 4) rtn))) + rtn))) + +(defvar org-refile-history nil + "History for refiling operations.") + +(defun org-refile (&optional reversed-or-update default-buffer) + "Move the entry at point to another heading. +The list of target headings is compiled using the information in +`org-refile-targets', which see. This list is created upon first use, and +you can update it by calling this command with a double prefix (`C-u C-u'). +FIXME: Can we find a better way of updating? + +At the target location, the entry is filed as a subitem of the target heading. +Depending on `org-reverse-note-order', the new subitem will either be the +first of the last subitem. A single C-u prefix will toggle the value of this +variable for the duration of the command." + (interactive "P") + (if (equal reversed-or-update '(16)) + (progn + (setq org-refile-target-table (org-get-refile-targets default-buffer)) + (message "Refile targets updated (%d targets)" + (length org-refile-target-table))) + (when (or (not org-refile-target-table) + (assq nil org-refile-targets)) + (setq org-refile-target-table (org-get-refile-targets default-buffer))) + (unless org-refile-target-table + (error "No refile targets")) + (let* ((cbuf (current-buffer)) + (filename (buffer-file-name (buffer-base-buffer cbuf))) + (fname (and filename (file-truename filename))) + (tbl (mapcar + (lambda (x) + (if (not (equal fname (file-truename (nth 1 x)))) + (cons (concat (car x) " (" (file-name-nondirectory + (nth 1 x)) ")") + (cdr x)) + x)) + org-refile-target-table)) + (completion-ignore-case t) + pos it nbuf file re level reversed) + (when (setq it (completing-read "Refile to: " tbl + nil t nil 'org-refile-history)) + (setq it (assoc it tbl) + file (nth 1 it) + re (nth 2 it)) + (org-copy-special) + (save-excursion + (set-buffer (setq nbuf (or (find-buffer-visiting file) + (find-file-noselect file)))) + (setq reversed (org-notes-order-reversed-p)) + (if (equal reversed-or-update '(16)) (setq reversed (not reversed))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (unless (re-search-forward re nil t) + (error "Cannot find target location - try again with `C-u' prefix.")) + (goto-char (match-beginning 0)) + (looking-at outline-regexp) + (setq level (org-get-legal-level (funcall outline-level) 1)) + (goto-char (or (save-excursion + (if reversed + (outline-next-heading) + (outline-get-next-sibling))) + (point-max))) + (org-paste-subtree level)))) + (org-cut-special) + (message "Entry refiled to \"%s\"" (car it)))))) + ;;;; Dynamic blocks (defun org-find-dblock (name) @@ -13264,7 +14041,8 @@ This function can be used in a hook." (defconst org-additional-option-like-keywords '("BEGIN_HTML" "BEGIN_LaTeX" "END_HTML" "END_LaTeX" - "ORGTBL" "HTML:" "LaTeX:" "BEGIN:" "END:" "DATE:")) + "ORGTBL" "HTML:" "LaTeX:" "BEGIN:" "END:" "DATE:" "TBLFM" + "BEGIN_EXAMPLE" "END_EXAMPLE")) (defun org-complete (&optional arg) "Perform completion on word at point. @@ -13385,13 +14163,14 @@ At all other locations, this simply calls the value of (interactive) (save-excursion (org-back-to-heading) - (if (looking-at (concat outline-regexp - "\\( *\\<" org-comment-string "\\>[ \t]*\\)")) - (replace-match "" t t nil 1) - (if (looking-at outline-regexp) - (progn - (goto-char (match-end 0)) - (insert org-comment-string " ")))))) + (let (case-fold-search) + (if (looking-at (concat outline-regexp + "\\( *\\<" org-comment-string "\\>[ \t]*\\)")) + (replace-match "" t t nil 1) + (if (looking-at outline-regexp) + (progn + (goto-char (match-end 0)) + (insert org-comment-string " "))))))) (defvar org-last-todo-state-is-todo nil "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: (or (looking-at (concat " +" org-todo-regexp " *")) (looking-at " *")) (let* ((match-data (match-data)) - (startpos (line-beginning-position)) + (startpos (point-at-bol)) (logging (save-match-data (org-entry-get nil "LOGGING" t))) (org-log-done (org-parse-local-options logging 'org-log-done)) (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." (save-window-excursion (if expert (set-buffer (get-buffer-create " *Org todo*")) -; (delete-other-windows) -; (split-window-vertically) (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*"))) (erase-buffer) (org-set-local 'org-done-keywords done-keywords) @@ -13968,7 +14745,7 @@ The auto-repeater uses this.") (end-of-line 1) (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) (indent-relative nil) - (insert " - " (pop lines)) + (insert "- " (pop lines)) (org-indent-line-function) (beginning-of-line 1) (looking-at "[ \t]*") @@ -13994,12 +14771,17 @@ t Show entries with a specific TODO keyword. T Show entries selected by a tags match. p Enter a property name and its value (both with completion on existing names/values) and show entries with that property. -r Show entries matching a regular expression" +r Show entries matching a regular expression +d Show deadlines due within `org-deadline-warning-days'." (interactive "P") (let (ans kwd value) - (message "Sparse tree: [r]egexp [t]odo-kwd [T]ag [p]roperty") + (message "Sparse tree: [/]regexp [t]odo-kwd [T]ag [p]roperty [d]eadlines [b]efore-date") (setq ans (read-char-exclusive)) (cond + ((equal ans ?d) + (call-interactively 'org-check-deadlines)) + ((equal ans ?b) + (call-interactively 'org-check-before-date)) ((equal ans ?t) (org-show-todo-tree '(4))) ((equal ans ?T) @@ -14012,7 +14794,7 @@ r Show entries matching a regular expression" (unless (string-match "\\`{.*}\\'" value) (setq value (concat "\"" value "\""))) (org-tags-sparse-tree arg (concat kwd "=" value))) - ((member ans '(?r ?R)) + ((member ans '(?r ?R ?/)) (call-interactively 'org-occur)) (t (error "No such sparse tree command \"%c\"" ans))))) @@ -14063,12 +14845,13 @@ How much context is shown depends upon the variables (let ((heading-p (org-on-heading-p t)) (hierarchy-p (org-get-alist-option org-show-hierarchy-above key)) (following-p (org-get-alist-option org-show-following-heading key)) + (entry-p (org-get-alist-option org-show-entry-below key)) (siblings-p (org-get-alist-option org-show-siblings key))) (catch 'exit ;; Show heading or entry text - (if heading-p + (if (and heading-p (not entry-p)) (org-flag-heading nil) ; only show the heading - (and (or (org-invisible-p) (org-invisible-p2)) + (and (or entry-p (org-invisible-p) (org-invisible-p2)) (org-show-hidden-entry))) ; show entire entry (when following-p ;; Show next sibling, or heading below text @@ -14303,11 +15086,13 @@ MATCH can contain positive and negative selection of tags, like If optional argument TODO_ONLY is non-nil, only select lines that are also TODO lines." (interactive "P") + (org-prepare-agenda-buffers (list (current-buffer))) (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) (defvar org-cached-props nil) (defun org-cached-entry-get (pom property) - (if org-use-property-inheritance + (if (or (eq t org-use-property-inheritance) + (member property org-use-property-inheritance)) ;; Caching is not possible, check it directly (org-entry-get pom property 'inherit) ;; Get all properties, so that we can do complicated checks easily @@ -14345,7 +15130,7 @@ also TODO lines." (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL=\\([0-9]+\\)\\|\\([[:alnum:]_]+\\)=\\({[^}]+}\\|\"[^\"]+\"\\)\\|[[:alnum:]_@]+\\)")) minus tag mm tagsmatch todomatch tagsmatcher todomatcher kwd matcher - orterms term orlist re-p level-p prop-p pn pv) + orterms term orlist re-p level-p prop-p pn pv cat-p gv) (if (string-match "/+" match) ;; match contains also a todo-matching request (progn @@ -14379,11 +15164,15 @@ also TODO lines." (prop-p (setq pn (match-string 4 term) pv (match-string 5 term) + cat-p (equal pn "CATEGORY") re-p (equal (string-to-char pv) ?{) pv (substring pv 1 -1)) + (if (equal pn "CATEGORY") + (setq gv '(get-text-property (point) 'org-category)) + (setq gv `(org-cached-entry-get nil ,pn))) (if re-p - `(string-match ,pv (or (org-cached-entry-get nil ,pn) "")) - `(equal ,pv (org-cached-entry-get nil ,pn)))) + `(string-match ,pv (or ,gv "")) + `(equal ,pv ,gv))) (t `(member ,(downcase tag) tags-list))) mm (if minus (list 'not mm) mm) term (substring term (match-end 0))) @@ -14839,7 +15628,8 @@ Returns the new tags string, or nil to not change the current settings." ;;; Setting and retrieving properties (defconst org-special-properties - '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "PRIORITY") + '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "PRIORITY" + "TIMESTAMP" "TIMESTAMP_IA") "The special properties valid in Org-mode. 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 (org-with-point-at pom (let ((clockstr (substring org-clock-string 0 -1)) (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY")) - beg end range props sum-props key value) + beg end range props sum-props key value string clocksum) (save-excursion (when (condition-case nil (org-back-to-heading t) (error nil)) (setq beg (point)) (setq sum-props (get-text-property (point) 'org-summaries)) + (setq clocksum (get-text-property (point) :org-clock-minutes)) (outline-next-heading) (setq end (point)) (when (memq which '(all special)) @@ -14955,17 +15746,23 @@ If WHICH is nil or `all', get all properties. If WHICH is (when (setq value (org-get-tags-at)) (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") ":")) props)) - (while (re-search-forward org-keyword-time-regexp end t) - (setq key (substring (org-match-string-no-properties 1) 0 -1)) - (unless (member key excluded) (push key excluded)) - (push (cons key - (if (equal key clockstr) - (org-no-properties - (org-trim - (buffer-substring - (match-beginning 2) (point-at-eol)))) - (org-match-string-no-properties 2))) - props))) + (while (re-search-forward org-maybe-keyword-time-regexp end t) + (setq key (if (match-end 1) (substring (org-match-string-no-properties 1) 0 -1)) + string (if (equal key clockstr) + (org-no-properties + (org-trim + (buffer-substring + (match-beginning 3) (goto-char (point-at-eol))))) + (substring (org-match-string-no-properties 3) 1 -1))) + (unless key + (if (= (char-after (match-beginning 3)) ?\[) + (setq key "TIMESTAMP_IA") + (setq key "TIMESTAMP"))) + (when (or (equal key clockstr) (not (assoc key props))) + (push (cons key string) props))) + + ) + (when (memq which '(all standard)) ;; Get the standard properties, like :PORP: ... (setq range (org-get-property-block beg end)) @@ -14978,6 +15775,11 @@ If WHICH is nil or `all', get all properties. If WHICH is value (org-trim (or (org-match-string-no-properties 2) ""))) (unless (member key excluded) (push (cons key (or value "")) props))))) + (if clocksum + (push (cons "CLOCKSUM" + (org-column-number-to-string (/ (float clocksum) 60.) + 'add_times)) + props)) (append sum-props (nreverse props))))))) (defun org-entry-get (pom property &optional inherit) @@ -15175,6 +15977,7 @@ internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING." (and (equal (char-after) ?\n) (forward-char 1)) (org-skip-over-state-notes) (skip-chars-backward " \t\n\r") + (if (eq (char-before) ?*) (forward-char 1)) (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:")) (beginning-of-line 0) (indent-to-column indent) @@ -15610,6 +16413,8 @@ Where possible, use the standard interface for changing this line." org-columns-overlays))) nval eval allowed) (cond + ((equal key "CLOCKSUM") + (error "This special column cannot be edited")) ((equal key "ITEM") (setq eval '(org-with-point-at pom (org-edit-headline)))) @@ -15680,7 +16485,7 @@ Where possible, use the standard interface for changing this line." (key1 (concat key "_ALL")) (allowed (org-entry-get (point) key1 t)) nval) - ;; FIXME: Cover editing TODO, TAGS etc inbiffer settings.???? + ;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.???? (setq nval (read-string "Allowed: " allowed)) (org-entry-put (cond ((marker-position org-entry-property-inherited-from) @@ -15697,7 +16502,7 @@ Where possible, use the standard interface for changing this line." (save-excursion (beginning-of-line 1) ;; `next-line' is needed here, because it skips invisible line. - (condition-case nil (org-no-warnings (next-line 1)) (error nil)) + (condition-case nil (org-no-warnings (next-line 1)) (error nil)) (setq hidep (org-on-heading-p 1))) (eval form) (and hidep (hide-entry)))) @@ -15797,7 +16602,7 @@ Where possible, use the standard interface for changing this line." (org-verify-version 'columns) (org-columns-remove-overlays) (move-marker org-columns-begin-marker (point)) - (let (beg end fmt cache maxwidths) + (let (beg end fmt cache maxwidths clocksump) (setq fmt (org-columns-get-format-and-top-level)) (save-excursion (goto-char org-columns-top-level-marker) @@ -15806,8 +16611,14 @@ Where possible, use the standard interface for changing this line." (org-columns-compute-all)) (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil)) (point-max))) - (goto-char beg) ;; Get and cache the properties + (goto-char beg) + (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled) + (setq clocksump t) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (org-clock-sum)))) (while (re-search-forward (concat "^" outline-regexp) end t) (push (cons (org-current-line) (org-entry-properties)) cache)) (when cache @@ -15819,7 +16630,7 @@ Where possible, use the standard interface for changing this line." (org-columns-display-here (cdr x))) cache))))) -(defun org-columns-new (&optional prop title width op fmt) +(defun org-columns-new (&optional prop title width op fmt &rest rest) "Insert a new column, to the leeft o the current column." (interactive) (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." (setq width (string-to-number width)) (setq width nil)) (setq fmt (completing-read "Summary [none]: " - '(("none") ("add_numbers") ("add_times") ("checkbox")) + '(("none") ("add_numbers") ("currency") ("add_times") ("checkbox")) nil t)) (if (string-match "\\S-" fmt) (setq fmt (intern fmt)) @@ -16036,6 +16847,7 @@ display, or in the #+COLUMNS line of the current buffer." (level 0) (ass (assoc property org-columns-current-fmt-compiled)) (format (nth 4 ass)) + (printf (nth 5 ass)) (beg org-columns-top-level-marker) last-level val valflag flag end sumpos sum-alist sum str str1 useval) (save-excursion @@ -16055,7 +16867,7 @@ display, or in the #+COLUMNS line of the current buffer." ;; put the sum of lower levels here as a property (setq sum (aref lsum last-level) ; current sum flag (aref lflag last-level) ; any valid entries from children? - str (org-column-number-to-string sum format) + str (org-column-number-to-string sum format printf) str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold) useval (if flag str1 (if valflag val "")) sum-alist (get-text-property sumpos 'org-summaries)) @@ -16069,7 +16881,6 @@ display, or in the #+COLUMNS line of the current buffer." (org-entry-put nil property (if flag str val))) ;; add current to current level accumulator (when (or flag valflag) - ;; FIXME: is this ok????????? (aset lsum level (+ (aref lsum level) (if flag sum (org-column-string-to-number (if flag str val) format)))) @@ -16112,7 +16923,7 @@ display, or in the #+COLUMNS line of the current buffer." (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) sum))) -(defun org-column-number-to-string (n fmt) +(defun org-column-number-to-string (n fmt &optional printf) "Convert a computed column number to a string value, according to FMT." (cond ((eq fmt 'add_times) @@ -16122,6 +16933,9 @@ display, or in the #+COLUMNS line of the current buffer." (cond ((= n (floor n)) "[X]") ((> n 1.) "[-]") (t "[ ]"))) + (printf (format printf n)) + ((eq fmt 'currency) + (format "%.2f" n)) (t (number-to-string n)))) (defun org-column-string-to-number (s fmt) @@ -16138,17 +16952,20 @@ display, or in the #+COLUMNS line of the current buffer." (defun org-columns-uncompile-format (cfmt) "Turn the compiled columns format back into a string representation." - (let ((rtn "") e s prop title op width fmt) + (let ((rtn "") e s prop title op width fmt printf) (while (setq e (pop cfmt)) (setq prop (car e) title (nth 1 e) width (nth 2 e) op (nth 3 e) - fmt (nth 4 e)) + fmt (nth 4 e) + printf (nth 5 e)) (cond ((eq fmt 'add_times) (setq op ":")) ((eq fmt 'checkbox) (setq op "X")) - ((eq fmt 'add_numbers) (setq op "+"))) + ((eq fmt 'add_numbers) (setq op "+")) + ((eq fmt 'currency) (setq op "$"))) + (if (and op printf) (setq op (concat op ";" printf))) (if (equal title prop) (setq title nil)) (setq s (concat "%" (if width (number-to-string width)) prop @@ -16165,8 +16982,9 @@ property the property title the title field for the columns width the column width in characters, can be nil for automatic operator the operator if any -format the output format for computed results, derived from operator" - (let ((start 0) width prop title op f) +format the output format for computed results, derived from operator +printf a printf format for computed values" + (let ((start 0) width prop title op f printf) (setq org-columns-current-fmt-compiled nil) (while (string-match (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*") @@ -16176,13 +16994,18 @@ format the output format for computed results, derived from operator" prop (match-string 2 fmt) title (or (match-string 3 fmt) prop) op (match-string 4 fmt) - f nil) + f nil + printf nil) (if width (setq width (string-to-number width))) + (when (and op (string-match ";" op)) + (setq printf (substring op (match-end 0)) + op (substring op 0 (match-beginning 0)))) (cond ((equal op "+") (setq f 'add_numbers)) + ((equal op "$") (setq f 'currency)) ((equal op ":") (setq f 'add_times)) ((equal op "X") (setq f 'checkbox))) - (push (list prop title width op f) org-columns-current-fmt-compiled)) + (push (list prop title width op f printf) org-columns-current-fmt-compiled)) (setq org-columns-current-fmt-compiled (nreverse org-columns-current-fmt-compiled)))) @@ -16311,28 +17134,30 @@ So if you press just return without typing anything, the time stamp will represent the current date/time. If there is already a timestamp at the cursor, it will be modified." (interactive "P") - (let ((default-time - ;; Default time is either today, or, when entering a range, - ;; the range start. - (if (or (org-at-timestamp-p t) - (save-excursion - (re-search-backward - (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses - (- (point) 20) t))) - (apply 'encode-time (org-parse-time-string (match-string 1))) - (current-time))) - org-time-was-given org-end-time-was-given time) + (let* ((ts nil) + (default-time + ;; Default time is either today, or, when entering a range, + ;; the range start. + (if (or (and (org-at-timestamp-p t) (setq ts (match-string 0))) + (save-excursion + (re-search-backward + (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses + (- (point) 20) t))) + (apply 'encode-time (org-parse-time-string (match-string 1))) + (current-time))) + (default-input (and ts (org-get-compact-tod ts))) + org-time-was-given org-end-time-was-given time) (cond ((and (org-at-timestamp-p) (eq last-command 'org-time-stamp) (eq this-command 'org-time-stamp)) (insert "--") (setq time (let ((this-command this-command)) - (org-read-date arg 'totime nil nil default-time))) + (org-read-date arg 'totime nil nil default-time default-input))) (org-insert-time-stamp time (or org-time-was-given arg))) ((org-at-timestamp-p) (setq time (let ((this-command this-command)) - (org-read-date arg 'totime nil nil default-time))) + (org-read-date arg 'totime nil nil default-time default-input))) (when (org-at-timestamp-p) ; just to get the match data (replace-match "") (setq org-last-changed-timestamp @@ -16342,10 +17167,28 @@ at the cursor, it will be modified." (message "Timestamp updated")) (t (setq time (let ((this-command this-command)) - (org-read-date arg 'totime nil nil default-time))) + (org-read-date arg 'totime nil nil default-time default-input))) (org-insert-time-stamp time (or org-time-was-given arg) nil nil nil (list org-end-time-was-given)))))) +;; FIXME: can we use this for something else???? +;; like computing time differences????? +(defun org-get-compact-tod (s) + (when (string-match "\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\(-\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\)?" s) + (let* ((t1 (match-string 1 s)) + (h1 (string-to-number (match-string 2 s))) + (m1 (string-to-number (match-string 3 s))) + (t2 (and (match-end 4) (match-string 5 s))) + (h2 (and t2 (string-to-number (match-string 6 s)))) + (m2 (and t2 (string-to-number (match-string 7 s)))) + dh dm) + (if (not t2) + t1 + (setq dh (- h2 h1) dm (- m2 m1)) + (if (< dm 0) (setq dm (+ dm 60) dh (1- dh))) + (concat t1 "+" (number-to-string dh) + (if (/= 0 dm) (concat ":" (number-to-string dm)))))))) + (defun org-time-stamp-inactive (&optional arg) "Insert an inactive time stamp. 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." (defvar org-ans2) ; dynamically scoped parameter (defvar org-plain-time-of-day-regexp) ; defined below + +(defvar org-read-date-overlay nil) +(defvar org-dcst nil) ; dynamically scoped + (defun org-read-date (&optional with-time to-time from-string prompt - default-time) - "Read a date and make things smooth for the user. + default-time default-input) + "Read a date, possibly a time, and make things smooth for the user. The prompt will suggest to enter an ISO date, but you can also enter anything which will at least partially be understood by `parse-time-string'. 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 date with the mouse (button 1). The calendar shows a period of three months. To scroll it to other months, use the keys `>' and `<'. If you don't like the calendar, turn it off with - \(setq org-popup-calendar-for-date-prompt nil) + \(setq org-read-date-popup-calendar nil) With optional argument TO-TIME, the date will immediately be converted to an internal time. @@ -16411,29 +17258,35 @@ insert a time. Note that when WITH-TIME is not set, you can still enter a time, and this function will inform the calling routine about this change. The calling routine may then choose to change the format used to insert the time stamp into the buffer to include the time. -With optional argument FROM-STRING, read fomr this string instead from +With optional argument FROM-STRING, read from this string instead from the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is the time/date that is used for everything that is not specified by the user." (require 'parse-time) (let* ((org-time-stamp-rounding-minutes (if (equal with-time '(16)) 0 org-time-stamp-rounding-minutes)) + (org-dcst org-display-custom-times) (ct (org-current-time)) (def (or default-time ct)) - ; (defdecode (decode-time def)) + (defdecode (decode-time def)) + (dummy (progn + (when (< (nth 2 defdecode) org-extend-today-until) + (setcar (nthcdr 2 defdecode) -1) + (setcar (nthcdr 1 defdecode) 59) + (setq def (apply 'encode-time defdecode) + defdecode (decode-time def))))) (calendar-move-hook nil) (view-diary-entries-initially nil) (view-calendar-holidays-initially nil) (timestr (format-time-string (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def)) (prompt (concat (if prompt (concat prompt " ") "") - (format "Date and/or time (default [%s]): " timestr))) - ans (org-ans0 "") org-ans1 org-ans2 delta deltan deltaw deltadef - second minute hour day month year tl wday wday1 pm h2 m2) + (format "Date+time [%s]: " timestr))) + ans (org-ans0 "") org-ans1 org-ans2 final) (cond (from-string (setq ans from-string)) - (org-popup-calendar-for-date-prompt + (org-read-date-popup-calendar (save-excursion (save-window-excursion (calendar) @@ -16455,6 +17308,12 @@ user." (org-defkey minibuffer-local-map [(meta shift right)] (lambda () (interactive) (org-eval-in-calendar '(calendar-forward-month 1)))) + (org-defkey minibuffer-local-map [(meta shift up)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-year 1)))) + (org-defkey minibuffer-local-map [(meta shift down)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-year 1)))) (org-defkey minibuffer-local-map [(shift up)] (lambda () (interactive) (org-eval-in-calendar '(calendar-backward-week 1)))) @@ -16476,15 +17335,75 @@ user." (unwind-protect (progn (use-local-map map) - (setq org-ans0 (read-string prompt "" nil nil)) + (add-hook 'post-command-hook 'org-read-date-display) + (setq org-ans0 (read-string prompt default-input nil nil)) ;; org-ans0: from prompt ;; org-ans1: from mouse click ;; org-ans2: from calendar motion (setq ans (concat org-ans0 " " (or org-ans1 org-ans2)))) - (use-local-map old-map)))))) + (remove-hook 'post-command-hook 'org-read-date-display) + (use-local-map old-map) + (when org-read-date-overlay + (org-delete-overlay org-read-date-overlay) + (setq org-read-date-overlay nil))))))) + (t ; Naked prompt only - (setq ans (read-string prompt "" nil timestr)))) - (org-detach-overlay org-date-ovl) + (unwind-protect + (setq ans (read-string prompt default-input nil timestr)) + (when org-read-date-overlay + (org-delete-overlay org-read-date-overlay) + (setq org-read-date-overlay nil))))) + + (setq final (org-read-date-analyze ans def defdecode)) + + (if to-time + (apply 'encode-time final) + (if (and (boundp 'org-time-was-given) org-time-was-given) + (format "%04d-%02d-%02d %02d:%02d" + (nth 5 final) (nth 4 final) (nth 3 final) + (nth 2 final) (nth 1 final)) + (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final)))))) +(defvar def) +(defvar defdecode) +(defvar with-time) +(defun org-read-date-display () + "Display the currrent date prompt interpretation in the minibuffer." + (when org-read-date-display-live + (when org-read-date-overlay + (org-delete-overlay org-read-date-overlay)) + (let ((p (point))) + (end-of-line 1) + (while (not (equal (buffer-substring + (max (point-min) (- (point) 4)) (point)) + " ")) + (insert " ")) + (goto-char p)) + (let* ((ans (concat (buffer-substring (point-at-bol) (point-max)) + " " (or org-ans1 org-ans2))) + (org-end-time-was-given nil) + (f (org-read-date-analyze ans def defdecode)) + (fmts (if org-dcst + org-time-stamp-custom-formats + org-time-stamp-formats)) + (fmt (if (or with-time + (and (boundp 'org-time-was-given) org-time-was-given)) + (cdr fmts) + (car fmts))) + (txt (concat "=> " (format-time-string fmt (apply 'encode-time f))))) + (when (and org-end-time-was-given + (string-match org-plain-time-of-day-regexp txt)) + (setq txt (concat (substring txt 0 (match-end 0)) "-" + org-end-time-was-given + (substring txt (match-end 0))))) + (setq org-read-date-overlay + (make-overlay (1- (point-at-eol)) (point-at-eol))) + (org-overlay-display org-read-date-overlay txt 'secondary-selection)))) + +(defun org-read-date-analyze (ans def defdecode) + "Analyze the combined answer of the date prompt." + ;; FIXME: cleanup and comment + (let (delta deltan deltaw deltadef year month day + hour minute second wday pm h2 m2 tl wday1) (when (setq delta (org-read-date-get-relative ans (current-time) def)) (setq ans (replace-match "" t t ans) @@ -16527,22 +17446,32 @@ user." h2 (+ hour (string-to-number (match-string 3 ans))) minute (string-to-number (match-string 2 ans)) m2 (+ minute (if (match-end 5) (string-to-number (match-string 5 ans))0))) + (if (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60))) (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2) t t ans))) ;; Check if there is a time range - (when (and (boundp 'org-end-time-was-given) - (string-match org-plain-time-of-day-regexp ans) - (match-end 8)) - (setq org-end-time-was-given (match-string 8 ans)) - (setq ans (concat (substring ans 0 (match-beginning 7)) - (substring ans (match-end 7))))) + (when (boundp 'org-end-time-was-given) + (setq org-time-was-given nil) + (when (and (string-match org-plain-time-of-day-regexp ans) + (match-end 8)) + (setq org-end-time-was-given (match-string 8 ans)) + (setq ans (concat (substring ans 0 (match-beginning 7)) + (substring ans (match-end 7)))))) (setq tl (parse-time-string ans) - day (or (nth 3 tl) (string-to-number (format-time-string "%d" def))) - month (or (nth 4 tl) (string-to-number (format-time-string "%m" def))) - year (or (nth 5 tl) (string-to-number (format-time-string "%Y" def))) - hour (or (nth 2 tl) (string-to-number (format-time-string "%H" def))) - minute (or (nth 1 tl) (string-to-number (format-time-string "%M" def))) + day (or (nth 3 tl) (nth 3 defdecode)) + month (or (nth 4 tl) + (if (and org-read-date-prefer-future + (nth 3 tl) (< (nth 3 tl) (nth 3 defdecode))) + (1+ (nth 4 defdecode)) + (nth 4 defdecode))) + year (or (nth 5 tl) + (if (and org-read-date-prefer-future + (nth 4 tl) (< (nth 4 tl) (nth 4 defdecode))) + (1+ (nth 5 defdecode)) + (nth 5 defdecode))) + hour (or (nth 2 tl) (nth 2 defdecode)) + minute (or (nth 1 tl) (nth 1 defdecode)) second (or (nth 0 tl) 0) wday (nth 6 tl)) (when deltan @@ -16563,25 +17492,8 @@ user." (nth 2 tl)) (setq org-time-was-given t)) (if (< year 100) (setq year (+ 2000 year))) - (if to-time - (encode-time second minute hour day month year) - (if (or (nth 1 tl) (nth 2 tl)) - (format "%04d-%02d-%02d %02d:%02d" year month day hour minute) - (format "%04d-%02d-%02d" year month day))))) - -;(defun org-parse-for-shift (n1 n2 given-dec default-dec) -; (cond -; ((not (nth n1 given-dec)) -; (nth n1 default-dec)) -; ((or (> (nth n1 given-dec) (nth n1 (default-dec))) -; (not org-read-date-prefer-future)) -; (nth n1 given-dec)) -; (t (1+ -; (if (nth 3 given-dec) -; (nth 3 given-dec) -; (if (> (nth -; (setq given -; (if (and + (if (< year 1970) (setq year (nth 5 defdecode))) ; not representable + (list second minute hour day month year))) (defvar parse-time-weekdays) @@ -16589,8 +17501,8 @@ user." "Check string S for special relative date string. TODAY and DEFAULT are internal times, for today and for a default. Return shift list (N what def-flag) -WHAT is \"d\", \"w\", \"m\", or \"y\" for day. week, month, year. -N is the number if WHATs to shift +WHAT is \"d\", \"w\", \"m\", or \"y\" for day, week, month, year. +N is the number of WHATs to shift. DEF-FLAG is t when a double ++ or -- indicates shift relative to the DEFAULT date rather than TODAY." (when (string-match @@ -16628,17 +17540,18 @@ Also, store the cursor date in variable org-ans2." (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) (org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) - (select-window sw) - ;; Update the prompt to show new default date - (save-excursion - (goto-char (point-min)) - (when (and org-ans2 - (re-search-forward "\\[[-0-9]+\\]" nil t) - (get-text-property (match-end 0) 'field)) - (let ((inhibit-read-only t)) - (replace-match (concat "[" org-ans2 "]") t t) - (add-text-properties (point-min) (1+ (match-end 0)) - (text-properties-at (1+ (point-min))))))))) + (select-window sw))) + +; ;; Update the prompt to show new default date +; (save-excursion +; (goto-char (point-min)) +; (when (and org-ans2 +; (re-search-forward "\\[[-0-9]+\\]" nil t) +; (get-text-property (match-end 0) 'field)) +; (let ((inhibit-read-only t)) +; (replace-match (concat "[" org-ans2 "]") t t) +; (add-text-properties (point-min) (1+ (match-end 0)) +; (text-properties-at (1+ (point-min))))))))) (defun org-calendar-select () "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 (org-occur regexp nil callback) org-warn-days))) +(defun org-check-before-date (date) + "Check if there are deadlines or scheduled entries before DATE." + (interactive (list (org-read-date))) + (let ((case-fold-search nil) + (regexp (concat "\\<\\(" org-deadline-string + "\\|" org-scheduled-string + "\\) *<\\([^>]+\\)>")) + (callback + (lambda () (time-less-p + (org-time-string-to-time (match-string 2)) + (org-time-string-to-time date))))) + (message "%d entries before %s" + (org-occur regexp nil callback) date))) + (defun org-evaluate-time-range (&optional to-buffer) "Evaluate a time range by computing the difference between start and end. 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." h 0 m 0)) (if (not to-buffer) (message "%s" (org-make-tdiff-string y d h m)) - (when (org-at-table-p) - (goto-char match-end) - (setq align t) - (and (looking-at " *|") (goto-char (match-end 0)))) + (if (org-at-table-p) + (progn + (goto-char match-end) + (setq align t) + (and (looking-at " *|") (goto-char (match-end 0)))) + (goto-char match-end)) (if (looking-at "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") (replace-match "")) @@ -16917,7 +17846,10 @@ D may be an absolute day number, or a calendar-type list (month day year)." (defun org-calendar-holiday () "List of holidays, for Diary display in Org-mode." - (let ((hl (calendar-check-holidays date))) + (require 'holidays) + (let ((hl (funcall + (if (fboundp 'calendar-check-holidays) + 'calendar-check-holidays 'check-calendar-holidays) date))) (if hl (mapconcat 'identity hl "; ")))) (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)." (t nil)))) (defun org-diary-to-ical-string (frombuf) - "Get iCalendar entreis from diary entries in buffer FROMBUF. + "Get iCalendar entries from diary entries in buffer FROMBUF. This uses the icalendar.el library." (let* ((tmpdir (if (featurep 'xemacs) (temp-directory) @@ -17292,6 +18224,7 @@ belonging to the category \"Work\"." (if (equal filter '(4)) (setq filter (read-from-minibuffer "Regexp filter: "))) (let* ((cnt 0) ; count added events + (org-agenda-new-buffers nil) (today (org-date-to-gregorian (time-to-days (current-time)))) (files (org-agenda-files)) entries file) @@ -17316,7 +18249,7 @@ belonging to the category \"Work\"." (cadr (assoc 'category filter)) cat) (string-match (cadr (assoc 'headline filter)) evt)))))) - ;; FIXME Shall we remove text-properties for the appt text? + ;; FIXME: Shall we remove text-properties for the appt text? ;; (setq evt (set-text-properties 0 (length evt) nil evt)) (when (and ok tod) (setq tod (number-to-string tod) @@ -17326,6 +18259,7 @@ belonging to the category \"Work\"." (match-string 2 tod)))) (appt-add tod evt) (setq cnt (1+ cnt))))) entries) + (org-release-buffers org-agenda-new-buffers) (message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))) ;;; The clock for measuring work time. @@ -17360,9 +18294,17 @@ If necessary, clock-out of the currently active clock." (let (ts) (save-excursion (org-back-to-heading t) - (if (looking-at org-todo-line-regexp) - (setq org-clock-heading (match-string 3)) - (setq org-clock-heading "???")) + (when (and org-clock-in-switch-to-state + (not (looking-at (concat outline-regexp "[ \t]*" + org-clock-in-switch-to-state + "\\>")))) + (org-todo org-clock-in-switch-to-state)) + (if (and org-clock-heading-function + (functionp org-clock-heading-function)) + (setq org-clock-heading (funcall org-clock-heading-function)) + (if (looking-at org-complex-heading-regexp) + (setq org-clock-heading (match-string 4)) + (setq org-clock-heading "???"))) (setq org-clock-heading (propertize org-clock-heading 'face nil)) (org-clock-find-position) @@ -17480,6 +18422,9 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (set-buffer (marker-buffer org-clock-marker)) (goto-char org-clock-marker) (delete-region (1- (point-at-bol)) (point-at-eol))) + (setq global-mode-string + (delq 'org-mode-line-string global-mode-string)) + (force-mode-line-update) (message "Clock canceled")) (defun org-clock-goto (&optional delete-windows) @@ -18016,8 +18961,10 @@ The following commands are available: (org-defkey org-agenda-mode-map "f" 'org-agenda-follow-mode) (org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode) (org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary) -(org-defkey org-agenda-mode-map "g" 'org-agenda-toggle-time-grid) +(org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid) (org-defkey org-agenda-mode-map "r" 'org-agenda-redo) +(org-defkey org-agenda-mode-map "g" 'org-agenda-redo) +(org-defkey org-agenda-mode-map "e" 'org-agenda-execute) (org-defkey org-agenda-mode-map "q" 'org-agenda-quit) (org-defkey org-agenda-mode-map "x" 'org-agenda-exit) (org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda) @@ -18234,6 +19181,7 @@ that have been changed along." (defvar org-agenda-restrict-begin (make-marker)) (defvar org-agenda-restrict-end (make-marker)) (defvar org-agenda-last-dispatch-buffer nil) +(defvar org-agenda-overriding-restriction nil) ;;;###autoload (defun org-agenda (arg &optional keys restriction) @@ -18263,6 +19211,7 @@ Pressing `<' twice means to restrict to the current subtree or region (interactive "P") (catch 'exit (let* ((prefix-descriptions nil) + (org-agenda-custom-commands-orig org-agenda-custom-commands) (org-agenda-custom-commands ;; normalize different versions (delq nil @@ -18278,11 +19227,12 @@ Pressing `<' twice means to restrict to the current subtree or region (buf (current-buffer)) (bfn (buffer-file-name (buffer-base-buffer))) entry key type match lprops ans) - ;; Turn off restriction - (put 'org-agenda-files 'org-restrict nil) - (setq org-agenda-restrict nil) - (move-marker org-agenda-restrict-begin nil) - (move-marker org-agenda-restrict-end nil) + ;; Turn off restriction unless there is an overriding one + (unless org-agenda-overriding-restriction + (put 'org-agenda-files 'org-restrict nil) + (setq org-agenda-restrict nil) + (move-marker org-agenda-restrict-begin nil) + (move-marker org-agenda-restrict-end nil)) ;; Delete old local properties (put 'org-agenda-redo-command 'org-lprops nil) ;; Remember where this call originated @@ -18292,7 +19242,7 @@ Pressing `<' twice means to restrict to the current subtree or region keys (car ans) restriction (cdr ans))) ;; Estabish the restriction, if any - (when restriction + (when (and (not org-agenda-overriding-restriction) restriction) (put 'org-agenda-files 'org-restrict (list bfn)) (cond ((eq restriction 'region) @@ -18346,7 +19296,9 @@ Pressing `<' twice means to restrict to the current subtree or region (org-let lprops '(funcall type match))) (t (error "Invalid custom agenda command type %s" type)))) (org-run-agenda-series (nth 1 entry) (cddr entry)))) - ((equal keys "C") (customize-variable 'org-agenda-custom-commands)) + ((equal keys "C") + (setq org-agenda-custom-commands org-agenda-custom-commands-orig) + (customize-variable 'org-agenda-custom-commands)) ((equal keys "a") (call-interactively 'org-agenda-list)) ((equal keys "t") (call-interactively 'org-todo-list)) ((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 ((equal keys "!") (customize-variable 'org-stuck-projects)) (t (error "Invalid agenda key")))))) +(defun org-agenda-normalize-custom-commands (cmds) + (delq nil + (mapcar + (lambda (x) + (cond ((stringp (cdr x)) nil) + ((stringp (nth 1 x)) x) + ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) + (t (cons (car x) (cons "" (cdr x)))))) + cmds))) + (defun org-agenda-get-restriction-and-command (prefix-descriptions) "The user interface for selecting an agenda command." (catch 'exit @@ -18380,13 +19342,14 @@ Pressing `<' twice means to restrict to the current subtree or region (erase-buffer) (insert (eval-when-compile (let ((header -"Press key for an agenda command: < Buffer,subtree/region restriction --------------------------------- C Configure custom agenda commands +" +Press key for an agenda command: < Buffer,subtree/region restriction +-------------------------------- > Remove restriction a Agenda for current week or day e Export agenda views t List of all TODO entries T Entries with special TODO kwd m Match a TAGS query M Like m, but only TODO entries L Timeline for current buffer # List stuck projects (!=configure) -/ Multi-occur +/ Multi-occur C Configure custom agenda commands ") (start 0)) (while (string-match @@ -18402,10 +19365,10 @@ L Timeline for current buffer # List stuck projects (!=configure) (when (eq rmheader t) (goto-line 1) (re-search-forward ":" nil t) - (delete-region (match-end 0) (line-end-position)) + (delete-region (match-end 0) (point-at-eol)) (forward-char 1) (looking-at "-+") - (delete-region (match-end 0) (line-end-position)) + (delete-region (match-end 0) (point-at-eol)) (move-marker header-end (match-end 0))) (goto-char header-end) (delete-region (point) (point-max)) @@ -18458,10 +19421,12 @@ L Timeline for current buffer # List stuck projects (!=configure) (setq second-time t) (fit-window-to-buffer))) (message "Press key for agenda command%s:" - (if restrict-ok - (if restriction - (format " (restricted to %s)" restriction) - " (unrestricted)") + (if (or restrict-ok org-agenda-overriding-restriction) + (if org-agenda-overriding-restriction + " (restriction lock active)" + (if restriction + (format " (restricted to %s)" restriction) + " (unrestricted)")) "")) (setq c (read-char-exclusive)) (message "") @@ -18484,10 +19449,13 @@ L Timeline for current buffer # List stuck projects (!=configure) (message "Restriction is only possible in Org-mode buffers") (ding) (sit-for 1)) ((eq c ?1) + (org-agenda-remove-restriction-lock 'noupdate) (setq restriction 'buffer)) ((eq c ?0) + (org-agenda-remove-restriction-lock 'noupdate) (setq restriction (if region-p 'region 'subtree))) ((eq c ?<) + (org-agenda-remove-restriction-lock 'noupdate) (setq restriction (cond ((eq restriction 'buffer) @@ -18495,8 +19463,15 @@ L Timeline for current buffer # List stuck projects (!=configure) ((memq restriction '(subtree region)) nil) (t 'buffer)))) - ((and (equal selstring "") (memq c '(?a ?t ?m ?L ?C ?e ?T ?M ?# ?/))) + ((eq c ?>) + (org-agenda-remove-restriction-lock 'noupdate) + (setq restriction nil)) + ((and (equal selstring "") (memq c '(?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/))) (throw 'exit (cons (setq selstring (char-to-string c)) restriction))) + ((and (> (length selstring) 0) (eq c ?\d)) + (delete-window) + (org-agenda-get-restriction-and-command prefix-descriptions)) + ((equal c ?q) (error "Abort")) (t (error "Invalid key %c" c)))))))) @@ -18543,7 +19518,7 @@ L Timeline for current buffer # List stuck projects (!=configure) "Run an agenda command in batch mode and send the result to STDOUT. If CMD-KEY is a string of length 1, it is used as a key in `org-agenda-custom-commands' and triggers this command. If it is a -longer string is is used as a tags/todo match string. +longer string it is used as a tags/todo match string. Paramters are alternating variable names and values that will be bound before running the agenda command." (let (pars) @@ -18568,7 +19543,7 @@ before running the agenda command." "Run an agenda command in batch mode and send the result to STDOUT. If CMD-KEY is a string of length 1, it is used as a key in `org-agenda-custom-commands' and triggers this command. If it is a -longer string is is used as a tags/todo match string. +longer string it is used as a tags/todo match string. Paramters are alternating variable names and values that will be bound before running the agenda command. @@ -18625,7 +19600,7 @@ agenda-day The day in the agenda where this is listed" (defun org-fix-agenda-info (props) "Make sure all properties on an agenda item have a canonical form, -so the the export commands caneasily use it." +so the export commands can easily use it." (let (tmp re) (when (setq tmp (plist-get props 'tags)) (setq props (plist-put props 'tags (mapconcat 'identity tmp ":")))) @@ -18675,7 +19650,7 @@ so the the export commands caneasily use it." ;;;###autoload (defmacro org-batch-store-agenda-views (&rest parameters) "Run all custom agenda commands that have a file argument." - (let ((cmds org-agenda-custom-commands) + (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands)) (pop-up-frames nil) (dir default-directory) pars cmd thiscmdkey files opts) @@ -18686,8 +19661,8 @@ so the the export commands caneasily use it." (while cmds (setq cmd (pop cmds) thiscmdkey (car cmd) - opts (nth 3 cmd) - files (nth 4 cmd)) + opts (nth 4 cmd) + files (nth 5 cmd)) (if (stringp files) (setq files (list files))) (when files (eval (list 'let (append org-agenda-exporter-settings opts pars) @@ -18777,7 +19752,8 @@ is currently in place." (setq files (apply 'append (mapcar (lambda (f) (if (file-directory-p f) - (directory-files f t "\\.org\\'") + (directory-files f t + org-agenda-file-regexp) (list f))) files))) (if org-agenda-skip-unavailable-files @@ -18808,7 +19784,7 @@ the buffer and restores the previous window configuration." (message "New agenda file list installed")) nil 'local) (message "%s" (substitute-command-keys - "Edit list and finish with \\[save-buffer]"))) + "Edit list and finish with \\[save-buffer]"))) (customize-variable 'org-agenda-files))) (defun org-store-new-agenda-file-list (list) @@ -18893,7 +19869,7 @@ Optional argument FILE means, use this file instead of the current." (org-store-new-agenda-file-list files) (org-install-agenda-files-menu) (message "Removed file: %s" afile)) - (message "File was not in list: %s" afile)))) + (message "File was not in list: %s (not removed)" afile)))) (defun org-file-menu-entry (file) (vector file (list 'find-file file) t)) @@ -18982,10 +19958,9 @@ Optional argument FILE means, use this file instead of the current." (interactive) (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority) (org-delete-overlay o))) - (overlays-in (point-min) (point-max))) + (org-overlays-in (point-min) (point-max))) (save-excursion - (let ((ovs (org-overlays-in (point-min) (point-max))) - (inhibit-read-only t) + (let ((inhibit-read-only t) b e p ov h l) (goto-char (point-min)) (while (re-search-forward "\\[#\\(.\\)\\]" nil t) @@ -18994,7 +19969,7 @@ Optional argument FILE means, use this file instead of the current." l (or (get-char-property (point) 'org-lowest-priority) org-lowest-priority) p (string-to-char (match-string 1)) - b (match-beginning 0) e (line-end-position) + b (match-beginning 0) e (point-at-eol) ov (org-make-overlay b e)) (org-overlay-put ov 'face @@ -19016,8 +19991,10 @@ Optional argument FILE means, use this file instead of the current." (save-excursion (save-restriction (while (setq file (pop files)) - (org-check-agenda-file file) - (set-buffer (org-get-agenda-file-buffer file)) + (if (bufferp file) + (set-buffer file) + (org-check-agenda-file file) + (set-buffer (org-get-agenda-file-buffer file))) (widen) (setq bmp (buffer-modified-p)) (org-refresh-category-properties) @@ -19096,9 +20073,6 @@ no longer in use." (while org-agenda-markers (move-marker (pop org-agenda-markers) nil)))) -(defvar org-agenda-new-buffers nil - "Buffers created to visit agenda files.") - (defun org-get-agenda-file-buffer (file) "Get a buffer visiting FILE. If the buffer needs to be created, add it to the list of buffers which might be released later." @@ -19303,7 +20277,9 @@ given in `org-agenda-start-on-weekday'." org-agenda-start-on-weekday nil)) (thefiles (org-agenda-files)) (files thefiles) - (today (time-to-days (current-time))) + (today (time-to-days + (time-subtract (current-time) + (list 0 (* 3600 org-extend-today-until) 0)))) (sd (or start-day today)) (start (if (or (null org-agenda-start-on-weekday) (< org-agenda-ndays 7)) @@ -19576,11 +20552,12 @@ to skip this subtree. This is a function that can be put into (defun org-agenda-skip-entry-if (&rest conditions) "Skip entry if any of CONDITIONS is true. -See `org-agenda-skip-if for details." +See `org-agenda-skip-if' for details." (org-agenda-skip-if nil conditions)) + (defun org-agenda-skip-subtree-if (&rest conditions) "Skip entry if any of CONDITIONS is true. -See `org-agenda-skip-if for details." +See `org-agenda-skip-if' for details." (org-agenda-skip-if t conditions)) (defun org-agenda-skip-if (subtree conditions) @@ -19598,13 +20575,13 @@ notdeadline Check if there is no deadline regexp Check if regexp matches notregexp Check if regexp does not match. -The regexp is taken from the conditions list, it must com right after the -`regexp' of `notregexp' element. +The regexp is taken from the conditions list, it must come right after +the `regexp' or `notregexp' element. If any of these conditions is met, this function returns the end point of the entity, causing the search to continue from there. This is a function that can be put into `org-agenda-skip-function' for the duration of a command." - (let (beg end m r) + (let (beg end m) (org-back-to-heading t) (setq beg (point) end (if subtree @@ -19622,13 +20599,14 @@ that can be put into `org-agenda-skip-function' for the duration of a command." (and (memq 'notdeadline conditions) (not (re-search-forward org-deadline-time-regexp end t))) (and (setq m (memq 'regexp conditions)) - (stringp (setq r (nth 1 m))) + (stringp (nth 1 m)) (re-search-forward (nth 1 m) end t)) (and (setq m (memq 'notregexp conditions)) - (stringp (setq r (nth 1 m))) + (stringp (nth 1 m)) (not (re-search-forward (nth 1 m) end t)))) end))) +;;;###autoload (defun org-agenda-list-stuck-projects (&rest ignore) "Create agenda view for projects that are stuck. Stuck projects are project that have no next actions. For the definitions @@ -19895,14 +20873,6 @@ the documentation of `org-diary'." (setq results (append results rtn)))))))) results)))) -;; FIXME: this works only if the cursor is *not* at the -;; beginning of the entry -;(defun org-entry-is-done-p () -; "Is the current entry marked DONE?" -; (save-excursion -; (and (re-search-backward "[\r\n]\\*+ " nil t) -; (looking-at org-nl-done-regexp)))) - (defun org-entry-is-todo-p () (member (org-get-todo-state) org-not-done-keywords)) @@ -20024,7 +20994,7 @@ the documentation of `org-diary'." "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) marker hdmarker deadlinep scheduledp donep tmp priority category - ee txt timestr tags b0 b3 e3) + ee txt timestr tags b0 b3 e3 head) (goto-char (point-min)) (while (re-search-forward regexp nil t) (setq b0 (match-beginning 0) @@ -20058,8 +21028,10 @@ the documentation of `org-diary'." (setq hdmarker (org-agenda-new-marker) tags (org-get-tags-at)) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") + (setq head (match-string 1)) + (and org-agenda-skip-timestamp-if-done donep (throw :skip t)) (setq txt (org-format-agenda-item - nil (match-string 1) category tags timestr nil + nil head category tags timestr nil remove-re))) (setq txt org-agenda-no-heading-message)) (setq priority (org-get-priority txt)) @@ -20331,7 +21303,8 @@ FRACTION is what fraction of the head-warning time has passed." (abbreviate-file-name buffer-file-name)))) (regexp org-tr-regexp) (d0 (calendar-absolute-from-gregorian date)) - marker hdmarker ee txt d1 d2 s1 s2 timestr category tags pos) + marker hdmarker ee txt d1 d2 s1 s2 timestr category tags pos + donep head) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -20354,10 +21327,14 @@ FRACTION is what fraction of the head-warning time has passed." (setq hdmarker (org-agenda-new-marker (point))) (setq tags (org-get-tags-at)) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") + (setq head (match-string 1)) + (and org-agenda-skip-timestamp-if-done + (org-entry-is-done-p) + (throw :skip t)) (setq txt (org-format-agenda-item (format (if (= d1 d2) "" "(%d/%d): ") (1+ (- d0 d1)) (1+ (- d2 d1))) - (match-string 1) category tags + head category tags (if (= d0 d1) timestr)))) (setq txt org-agenda-no-heading-message)) (org-add-props txt props @@ -20518,7 +21495,7 @@ Any match of REMOVE-RE will be removed from TXT." 'extra extra 'dotime dotime)))) -(defvar org-agenda-sorting-strategy) ;; FIXME: can be removed? +(defvar org-agenda-sorting-strategy) ;; because the def is in a let form (defvar org-agenda-sorting-strategy-selected nil) (defun org-agenda-add-time-grid-maybe (list ndays todayp) @@ -20636,16 +21613,32 @@ HH:MM." (beginning-of-line 1) (setq re (get-text-property (point) 'org-todo-regexp)) (goto-char (+ (point) (or (get-text-property (point) 'prefix-length) 0))) - (and (looking-at (concat "[ \t]*\\.*" re)) - (add-text-properties (match-beginning 0) (match-end 0) - (list 'face (org-get-todo-face 0))))) + (when (looking-at (concat "[ \t]*\\.*" re " +")) + (add-text-properties (match-beginning 0) (match-end 0) + (list 'face (org-get-todo-face 0))) + (let ((s (buffer-substring (match-beginning 1) (match-end 1)))) + (delete-region (match-beginning 1) (1- (match-end 0))) + (goto-char (match-beginning 1)) + (insert (format org-agenda-todo-keyword-format s))))) (setq re (concat (get-text-property 0 'org-todo-regexp x)) pl (get-text-property 0 'prefix-length x)) - (and re (equal (string-match (concat "\\(\\.*\\)" re) x (or pl 0)) pl) - (add-text-properties - (or (match-end 1) (match-end 0)) (match-end 0) - (list 'face (org-get-todo-face (match-string 2 x))) - x)) +; (and re (equal (string-match (concat "\\(\\.*\\)" re) x (or pl 0)) pl) +; (add-text-properties +; (or (match-end 1) (match-end 0)) (match-end 0) +; (list 'face (org-get-todo-face (match-string 2 x))) +; x)) + (when (and re + (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)") + x (or pl 0)) pl)) + (add-text-properties + (or (match-end 1) (match-end 0)) (match-end 0) + (list 'face (org-get-todo-face (match-string 2 x))) + x) + (setq x (concat (substring x 0 (match-end 1)) + (format org-agenda-todo-keyword-format + (match-string 2 x)) + " " + (substring x (match-end 3))))) x))) (defsubst org-cmp-priority (a b) @@ -20700,6 +21693,85 @@ HH:MM." (eval (cons 'or org-agenda-sorting-strategy-selected)) '((-1 . t) (1 . nil) (nil . nil)))))) +;;; Agenda restriction lock + +(defvar org-agenda-restriction-lock-overlay (org-make-overlay 1 1) + "Overlay to mark the headline to which arenda commands are restricted.") +(org-overlay-put org-agenda-restriction-lock-overlay + 'face 'org-agenda-restriction-lock) +(org-overlay-put org-agenda-restriction-lock-overlay + 'help-echo "Agendas are currently limited to this subtree.") +(org-detach-overlay org-agenda-restriction-lock-overlay) +(defvar org-speedbar-restriction-lock-overlay (org-make-overlay 1 1) + "Overlay marking the agenda restriction line in speedbar.") +(org-overlay-put org-speedbar-restriction-lock-overlay + 'face 'org-agenda-restriction-lock) +(org-overlay-put org-speedbar-restriction-lock-overlay + 'help-echo "Agendas are currently limited to this item.") +(org-detach-overlay org-speedbar-restriction-lock-overlay) + +(defun org-agenda-set-restriction-lock (&optional type) + "Set restriction lock for agenda, to current subtree or file. +Restriction will be the file if TYPE is `file', or if type is the +universal prefix '(4), or if the cursor is before the first headline +in the file. Otherwise, restriction will be to the current subtree." + (interactive "P") + (and (equal type '(4)) (setq type 'file)) + (setq type (cond + (type type) + ((org-at-heading-p) 'subtree) + ((condition-case nil (org-back-to-heading t) (error nil)) + 'subtree) + (t 'file))) + (if (eq type 'subtree) + (progn + (setq org-agenda-restrict t) + (setq org-agenda-overriding-restriction 'subtree) + (put 'org-agenda-files 'org-restrict + (list (buffer-file-name (buffer-base-buffer)))) + (org-back-to-heading t) + (org-move-overlay org-agenda-restriction-lock-overlay (point) (point-at-eol)) + (move-marker org-agenda-restrict-begin (point)) + (move-marker org-agenda-restrict-end + (save-excursion (org-end-of-subtree t))) + (message "Locking agenda restriction to subtree")) + (put 'org-agenda-files 'org-restrict + (list (buffer-file-name (buffer-base-buffer)))) + (setq org-agenda-restrict nil) + (setq org-agenda-overriding-restriction 'file) + (move-marker org-agenda-restrict-begin nil) + (move-marker org-agenda-restrict-end nil) + (message "Locking agenda restriction to file")) + (setq current-prefix-arg nil) + (org-agenda-maybe-redo)) + +(defun org-agenda-remove-restriction-lock (&optional noupdate) + "Remove the agenda restriction lock." + (interactive "P") + (org-detach-overlay org-agenda-restriction-lock-overlay) + (org-detach-overlay org-speedbar-restriction-lock-overlay) + (setq org-agenda-overriding-restriction nil) + (setq org-agenda-restrict nil) + (put 'org-agenda-files 'org-restrict nil) + (move-marker org-agenda-restrict-begin nil) + (move-marker org-agenda-restrict-end nil) + (setq current-prefix-arg nil) + (message "Agenda restriction lock removed") + (or noupdate (org-agenda-maybe-redo))) + +(defun org-agenda-maybe-redo () + "If there is any window showing the agenda view, update it." + (let ((w (get-buffer-window org-agenda-buffer-name t)) + (w0 (selected-window))) + (when w + (select-window w) + (org-agenda-redo) + (select-window w0) + (if org-agenda-overriding-restriction + (message "Agenda view shifted to new %s restriction" + org-agenda-overriding-restriction) + (message "Agenda restriction lock removed"))))) + ;;; Agenda commands (defun org-agenda-check-type (error &rest types) @@ -20734,6 +21806,13 @@ Org-mode buffers visited directly by the user will not be touched." (setq org-agenda-new-buffers nil) (org-agenda-quit)) +(defun org-agenda-execute (arg) + "Execute another agenda command, keeping same window.\\<global-map> +So this is just a shortcut for `\\[org-agenda]', available in the agenda." + (interactive "P") + (let ((org-agenda-window-setup 'current-window)) + (org-agenda arg))) + (defun org-save-all-org-buffers () "Save all Org-mode buffers without user confirmation." (interactive) @@ -20770,7 +21849,9 @@ When this is the global TODO list, a prefix argument will be interpreted." (cond (tdpos (goto-char tdpos)) ((eq org-agenda-type 'agenda) - (let* ((sd (time-to-days (current-time))) + (let* ((sd (time-to-days + (time-subtract (current-time) + (list 0 (* 3600 org-extend-today-until) 0)))) (comp (org-agenda-compute-time-span sd org-agenda-span)) (org-agenda-overriding-arguments org-agenda-last-arguments)) (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]." (:archived-trees . org-export-with-archived-trees) (:emphasize . org-export-with-emphasize) (:sub-superscript . org-export-with-sub-superscripts) + (:special-strings . org-export-with-special-strings) (:footnotes . org-export-with-footnotes) (:drawers . org-export-with-drawers) (:tags . org-export-with-tags) @@ -22047,10 +23129,11 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (:tables . org-export-with-tables) (:table-auto-headline . org-export-highlight-first-table-line) (:style . org-export-html-style) - (:agenda-style . org-agenda-export-html-style) ;; FIXME: Does this work???? + (:agenda-style . org-agenda-export-html-style) (:convert-org-links . org-export-html-link-org-files-as-html) (:inline-images . org-export-html-inline-images) (:html-extension . org-export-html-extension) + (:html-table-tag . org-export-html-table-tag) (:expand-quoted-html . org-export-html-expand) (:timestamp . org-export-html-with-timestamp) (:publishing-directory . org-export-publishing-directory) @@ -22071,50 +23154,53 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (defun org-infile-export-plist () "Return the property list with file-local settings for export." (save-excursion - (goto-char 0) - (let ((re (org-make-options-regexp - '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) - p key val text options) - (while (re-search-forward re nil t) - (setq key (org-match-string-no-properties 1) - val (org-match-string-no-properties 2)) - (cond - ((string-equal key "TITLE") (setq p (plist-put p :title val))) - ((string-equal key "AUTHOR")(setq p (plist-put p :author val))) - ((string-equal key "EMAIL") (setq p (plist-put p :email val))) - ((string-equal key "DATE") (setq p (plist-put p :date val))) - ((string-equal key "LANGUAGE") (setq p (plist-put p :language val))) - ((string-equal key "TEXT") - (setq text (if text (concat text "\n" val) val))) - ((string-equal key "OPTIONS") (setq options val)))) - (setq p (plist-put p :text text)) - (when options - (let ((op '(("H" . :headline-levels) - ("num" . :section-numbers) - ("toc" . :table-of-contents) - ("\\n" . :preserve-breaks) - ("@" . :expand-quoted-html) - (":" . :fixed-width) - ("|" . :tables) - ("^" . :sub-superscript) - ("f" . :footnotes) - ("d" . :drawers) - ("tags" . :tags) - ("*" . :emphasize) - ("TeX" . :TeX-macros) - ("LaTeX" . :LaTeX-fragments) - ("skip" . :skip-before-1st-heading) - ("author" . :author-info) - ("timestamp" . :time-stamp-file))) - o) - (while (setq o (pop op)) - (if (string-match (concat (regexp-quote (car o)) - ":\\([^ \t\n\r;,.]*\\)") - options) - (setq p (plist-put p (cdr o) - (car (read-from-string - (match-string 1 options))))))))) - p))) + (save-restriction + (widen) + (goto-char 0) + (let ((re (org-make-options-regexp + '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) + p key val text options) + (while (re-search-forward re nil t) + (setq key (org-match-string-no-properties 1) + val (org-match-string-no-properties 2)) + (cond + ((string-equal key "TITLE") (setq p (plist-put p :title val))) + ((string-equal key "AUTHOR")(setq p (plist-put p :author val))) + ((string-equal key "EMAIL") (setq p (plist-put p :email val))) + ((string-equal key "DATE") (setq p (plist-put p :date val))) + ((string-equal key "LANGUAGE") (setq p (plist-put p :language val))) + ((string-equal key "TEXT") + (setq text (if text (concat text "\n" val) val))) + ((string-equal key "OPTIONS") (setq options val)))) + (setq p (plist-put p :text text)) + (when options + (let ((op '(("H" . :headline-levels) + ("num" . :section-numbers) + ("toc" . :table-of-contents) + ("\\n" . :preserve-breaks) + ("@" . :expand-quoted-html) + (":" . :fixed-width) + ("|" . :tables) + ("^" . :sub-superscript) + ("-" . :special-strings) + ("f" . :footnotes) + ("d" . :drawers) + ("tags" . :tags) + ("*" . :emphasize) + ("TeX" . :TeX-macros) + ("LaTeX" . :LaTeX-fragments) + ("skip" . :skip-before-1st-heading) + ("author" . :author-info) + ("timestamp" . :time-stamp-file))) + o) + (while (setq o (pop op)) + (if (string-match (concat (regexp-quote (car o)) + ":\\([^ \t\n\r;,.]*\\)") + options) + (setq p (plist-put p (cdr o) + (car (read-from-string + (match-string 1 options))))))))) + p)))) (defun org-export-directory (type plist) (let* ((val (plist-get plist :publishing-directory)) @@ -22397,8 +23483,8 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." ("prop") ("proptp"."∝") ("infin") ("infty"."∞") ("ang") ("angle"."∠") - ("and") ("vee"."∧") - ("or") ("wedge"."∨") + ("and") ("wedge"."∧") + ("or") ("vee"."∨") ("cap") ("cup") ("int") @@ -22523,6 +23609,8 @@ translations. There is currently no way for users to extend this.") (commentsp (plist-get parameters :comments)) (archived-trees (plist-get parameters :archived-trees)) (inhibit-read-only t) + (drawers org-drawers) + (exp-drawers (plist-get parameters :drawers)) (outline-regexp "\\*+ ") a b xx rtn p) @@ -22561,14 +23649,14 @@ translations. There is currently no way for users to extend this.") (if (> b a) (delete-region a b))))) ;; Get rid of drawers - (unless (eq t org-export-with-drawers) + (unless (eq t exp-drawers) (goto-char (point-min)) (let ((re (concat "^[ \t]*:\\(" - (mapconcat 'identity - (if (listp org-export-with-drawers) - org-export-with-drawers - org-drawers) - "\\|") + (mapconcat + 'identity + (org-delete-all exp-drawers + (copy-sequence drawers)) + "\\|") "\\):[ \t]*\n\\([^@]*?\n\\)?[ \t]*:END:[ \t]*\n"))) (while (re-search-forward re nil t) (replace-match "")))) @@ -22580,12 +23668,18 @@ translations. There is currently no way for users to extend this.") (replace-match "\\1(INVISIBLE)")) ;; Protect backend specific stuff, throw away the others. - (goto-char (point-min)) (let ((formatters `((,htmlp "HTML" "BEGIN_HTML" "END_HTML") (,asciip "ASCII" "BEGIN_ASCII" "END_ASCII") (,latexp "LaTeX" "BEGIN_LaTeX" "END_LaTeX"))) fmt) + (goto-char (point-min)) + (while (re-search-forward "^#\\+BEGIN_EXAMPLE[ \t]*\n" nil t) + (goto-char (match-end 0)) + (while (not (looking-at "#\\+END_EXAMPLE")) + (insert ": ") + (beginning-of-line 2))) + (goto-char (point-min)) (while (re-search-forward "^[ \t]*:.*\\(\n[ \t]*:.*\\)*" nil t) (add-text-properties (match-beginning 0) (match-end 0) '(org-protected t))) @@ -22617,6 +23711,13 @@ translations. There is currently no way for users to extend this.") (add-text-properties (point) (org-end-of-subtree t) '(org-protected t))) + ;; Protect verbatim elements + (goto-char (point-min)) + (while (re-search-forward org-verbatim-re nil t) + (add-text-properties (match-beginning 4) (match-end 4) + '(org-protected t)) + (goto-char (1+ (match-end 4)))) + ;; Remove subtrees that are commented (goto-char (point-min)) (while (re-search-forward re-commented nil t) @@ -22640,6 +23741,9 @@ translations. There is currently no way for users to extend this.") (require 'org-export-latex nil) (org-export-latex-cleaned-string)) + (when asciip + (org-export-ascii-clean-string)) + ;; Specific HTML stuff (when htmlp ;; Convert LaTeX fragments to images @@ -22887,6 +23991,8 @@ underlined headlines. The default is 3." :for-ascii t :skip-before-1st-heading (plist-get opt-plist :skip-before-1st-heading) + :drawers (plist-get opt-plist :drawers) + :verbatim-multiline t :archived-trees (plist-get opt-plist :archived-trees) :add-text (plist-get opt-plist :text)) @@ -23083,6 +24189,16 @@ underlined headlines. The default is 3." (goto-char beg))) (goto-char (point-min)))) +(defun org-export-ascii-clean-string () + "Do extra work for ASCII export" + (goto-char (point-min)) + (while (re-search-forward org-verbatim-re nil t) + (goto-char (match-end 2)) + (backward-delete-char 1) (insert "'") + (goto-char (match-beginning 2)) + (delete-char 1) (insert "`") + (goto-char (match-end 2)))) + (defun org-search-todo-below (line lines level) "Search the subtree below LINE for any TODO entries." (let ((rest (cdr (memq line lines))) @@ -23232,7 +24348,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." #+EMAIL: %s #+LANGUAGE: %s #+TEXT: Some descriptive text to be emitted. Several lines OK. -#+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 +#+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 #+CATEGORY: %s #+SEQ_TODO: %s #+TYP_TODO: %s @@ -23252,6 +24368,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." org-export-with-fixed-width org-export-with-tables org-export-with-sub-superscripts + org-export-with-special-strings org-export-with-footnotes org-export-with-emphasize org-export-with-TeX-macros @@ -23308,6 +24425,7 @@ this line is also exported in fixed-width font." (beg (if regionp (region-beginning) (point))) (end (if regionp (region-end))) (nlines (or arg (if (and beg end) (count-lines beg end) 1))) + (case-fold-search nil) (re "[ \t]*\\(:\\)") off) (if regionp @@ -23415,6 +24533,7 @@ in a window. A non-interactive call will only retunr the buffer." (switch-to-buffer-other-window rtn) rtn))) +(defvar html-table-tag nil) ; dynamically scoped into this. (defun org-export-as-html (arg &optional hidden ext-plist to-buffer body-only) "Export the outline as a pretty HTML file. @@ -23469,14 +24588,16 @@ the body tags themselves." (umax nil) (umax-toc nil) (filename (if to-buffer nil - (concat (file-name-as-directory - (org-export-directory :html opt-plist)) - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory buffer-file-name))) - "." org-export-html-extension))) + (expand-file-name + (concat + (file-name-sans-extension + (or (and subtree-p + (org-entry-get (region-beginning) + "EXPORT_FILE_NAME" t)) + (file-name-nondirectory buffer-file-name))) + "." org-export-html-extension) + (file-name-as-directory + (org-export-directory :html opt-plist))))) (current-dir (if buffer-file-name (file-name-directory buffer-file-name) default-directory)) @@ -23497,6 +24618,7 @@ the body tags themselves." (file-name-sans-extension (file-name-nondirectory buffer-file-name))) "UNTITLED")) + (html-table-tag (plist-get opt-plist :html-table-tag)) (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)")) (inquote nil) @@ -23533,6 +24655,7 @@ the body tags themselves." :for-html t :skip-before-1st-heading (plist-get opt-plist :skip-before-1st-heading) + :drawers (plist-get opt-plist :drawers) :archived-trees (plist-get opt-plist :archived-trees) :add-text @@ -23569,7 +24692,7 @@ the body tags themselves." ;; Switch to the output buffer (set-buffer buffer) - (erase-buffer) + (let ((inhibit-read-only t)) (erase-buffer)) (fundamental-mode) (and (fboundp 'set-buffer-file-coding-system) @@ -23732,7 +24855,8 @@ lang=\"%s\" xml:lang=\"%s\"> (replace-match "\\2\n")) (insert line "\n") (while (and lines - (get-text-property 0 'org-protected (car lines))) + (or (= (length (car lines)) 0) + (get-text-property 0 'org-protected (car lines)))) (insert (pop lines) "\n")) (and par (insert "<p>\n"))) (throw 'nextline nil)) @@ -23768,7 +24892,8 @@ lang=\"%s\" xml:lang=\"%s\"> ;; replace "&" by "&", "<" and ">" by "<" and ">" ;; handle @<..> HTML tags (replace "@>..<" by "<..>") ;; Also handle sub_superscripts and checkboxes - (setq line (org-html-expand line)) + (or (string-match org-table-hline-regexp line) + (setq line (org-html-expand line))) ;; Format the links (setq start 0) @@ -23868,14 +24993,17 @@ lang=\"%s\" xml:lang=\"%s\"> ;; Does this contain a reference to a footnote? (when org-export-with-footnotes - (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line) - (let ((n (match-string 2 line))) - (setq line - (replace-match - (format - "%s<sup><a class=\"footref\" name=\"fnr.%s\" href=\"#fn.%s\">%s</a></sup>" - (match-string 1 line) n n n) - t t line))))) + (setq start 0) + (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start) + (if (get-text-property (match-beginning 2) 'org-protected line) + (setq start (match-end 2)) + (let ((n (match-string 2 line))) + (setq line + (replace-match + (format + "%s<sup><a class=\"footref\" name=\"fnr.%s\" href=\"#fn.%s\">%s</a></sup>" + (match-string 1 line) n n n) + t t line)))))) (cond ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) @@ -24005,7 +25133,7 @@ lang=\"%s\" xml:lang=\"%s\"> (pop local-list-num)) (setq local-list-indent nil in-local-list nil)) - (org-html-level-start 0 nil umax + (org-html-level-start 1 nil umax (and org-export-with-toc (<= level umax)) head-count) @@ -24016,8 +25144,13 @@ lang=\"%s\" xml:lang=\"%s\"> (insert "<p class=\"author\"> " (nth 1 lang-words) ": " author "\n") (when email - (insert "<a href=\"mailto:" email "\"><" - email "></a>\n")) + (if (listp (split-string email ",+ *")) + (mapc (lambda(e) + (insert "<a href=\"mailto:" e "\"><" + e "></a>\n")) + (split-string email ",+ *")) + (insert "<a href=\"mailto:" email "\"><" + email "></a>\n"))) (insert "</p>\n")) (when (and date org-export-time-stamp-file) (insert "<p class=\"date\"> " @@ -24201,11 +25334,11 @@ lang=\"%s\" xml:lang=\"%s\"> (unless splice (push "</table>\n" html)) (setq html (nreverse html)) (unless splice - ;; Put in COL tags with the alignment (unfortuntely often ignored...) + ;; Put in col tags with the alignment (unfortuntely often ignored...) (push (mapconcat (lambda (x) (setq gr (pop org-table-colgroup-info)) - (format "%s<COL align=\"%s\"></COL>%s" + (format "%s<col align=\"%s\"></col>%s" (if (memq gr '(:start :startend)) (prog1 (if colgropen "</colgroup>\n<colgroup>" "<colgroup>") @@ -24219,7 +25352,7 @@ lang=\"%s\" xml:lang=\"%s\"> fnum "") html) (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html))))) - (push org-export-html-table-tag html)) + (push html-table-tag html)) (concat (mapconcat 'identity html "\n") "\n"))) (defun org-table-clean-before-export (lines) @@ -24267,8 +25400,7 @@ If yes remove the column and the special lines." ((or (string-match "^\\([ \t]*\\)|-+\\+" x) (string-match "^\\([ \t]*\\)|[^|]*|" x)) ;; remove the first column - (replace-match "\\1|" t nil x)) - (t (error "This should not happen")))) + (replace-match "\\1|" t nil x)))) lines)))) (defun org-format-table-table-html (lines) @@ -24279,7 +25411,7 @@ But it has the disadvantage, that no cell- or row-spanning is allowed." (let (line field-buffer (head org-export-highlight-first-table-line) fields html empty) - (setq html (concat org-export-html-table-tag "\n")) + (setq html (concat html-table-tag "\n")) (while (setq line (pop lines)) (setq empty " ") (catch 'next-line @@ -24407,21 +25539,26 @@ If there are links in the string, don't modify these." "Apply all active conversions to translate special ASCII to HTML." (setq s (org-html-protect s)) (if org-export-html-expand - (while (string-match "@<\\([^&]*\\)>" s) - (setq s (replace-match "<\\1>" t nil s)))) + (let ((start 0)) + (while (string-match "@<\\([^&]*\\)>" s) + (setq s (replace-match "<\\1>" t nil s))))) (if org-export-with-emphasize (setq s (org-export-html-convert-emphasize s))) + (if org-export-with-special-strings + (setq s (org-export-html-convert-special-strings s))) (if org-export-with-sub-superscripts (setq s (org-export-html-convert-sub-super s))) (if org-export-with-TeX-macros (let ((start 0) wd ass) (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)" s start)) - (setq wd (match-string 1 s)) - (if (setq ass (assoc wd org-html-entities)) - (setq s (replace-match (or (cdr ass) - (concat "&" (car ass) ";")) - t t s)) - (setq start (+ start (length wd))))))) + (if (get-text-property (match-beginning 0) 'org-protected s) + (setq start (match-end 0)) + (setq wd (match-string 1 s)) + (if (setq ass (assoc wd org-html-entities)) + (setq s (replace-match (or (cdr ass) + (concat "&" (car ass) ";")) + t t s)) + (setq start (+ start (length wd)))))))) s) (defun org-create-multibrace-regexp (left right n) @@ -24452,16 +25589,41 @@ stacked delimiters is N. Escaping delimiters is not possible." "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") "The regular expression matching a sub- or superscript.") -;(let ((s "a\\_b")) -; (and (string-match org-match-substring-regexp s) -; (conca t (match-string 1 s) ":::" (match-string 2 s)))) +(defvar org-match-substring-with-braces-regexp + (concat + "\\([^\\]\\)\\([_^]\\)\\(" + "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" + "\\)") + "The regular expression matching a sub- or superscript, forcing braces.") + +(defconst org-export-html-special-string-regexps + '(("\\\\-" . "­") + ("---\\([^-]\\)" . "—\\1") + ("--\\([^-]\\)" . "–\\1") + ("\\.\\.\\." . "…")) + "Regular expressions for special string conversion.") + +(defun org-export-html-convert-special-strings (string) + "Convert special characters in STRING to HTML." + (let ((all org-export-html-special-string-regexps) + e a re rpl start) + (while (setq a (pop all)) + (setq re (car a) rpl (cdr a) start 0) + (while (string-match re string start) + (if (get-text-property (match-beginning 0) 'org-protected string) + (setq start (match-end 0)) + (setq string (replace-match rpl t nil string))))) + string)) (defun org-export-html-convert-sub-super (string) "Convert sub- and superscripts in STRING to HTML." (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) (while (string-match org-match-substring-regexp string s) - (if (and requireb (match-end 8)) - (setq s (match-end 2)) + (cond + ((and requireb (match-end 8)) (setq s (match-end 2))) + ((get-text-property (match-beginning 2) 'org-protected string) + (setq s (match-end 2))) + (t (setq s (match-end 1) key (if (string= (match-string 2 string) "_") "sub" "sup") c (or (match-string 8 string) @@ -24470,22 +25632,29 @@ stacked delimiters is N. Escaping delimiters is not possible." string (replace-match (concat (match-string 1 string) "<" key ">" c "</" key ">") - t t string)))) + t t string))))) (while (string-match "\\\\\\([_^]\\)" string) (setq string (replace-match (match-string 1 string) t t string))) string)) (defun org-export-html-convert-emphasize (string) "Apply emphasis." - (let ((s 0)) + (let ((s 0) rpl) (while (string-match org-emph-re string s) (if (not (equal (substring string (match-beginning 3) (1+ (match-beginning 3))) (substring string (match-beginning 4) (1+ (match-beginning 4))))) - (setq string (replace-match - (concat "\\1" (nth 2 (assoc (match-string 3 string) org-emphasis-alist)) - "\\4" (nth 3 (assoc (match-string 3 string) org-emphasis-alist)) - "\\5") t nil string)) + (setq s (match-beginning 0) + rpl + (concat + (match-string 1 string) + (nth 2 (assoc (match-string 3 string) org-emphasis-alist)) + (match-string 4 string) + (nth 3 (assoc (match-string 3 string) + org-emphasis-alist)) + (match-string 5 string)) + string (replace-match rpl t t string) + s (+ s (- (length rpl) 2))) (setq s (1+ s)))) string)) @@ -24511,7 +25680,7 @@ stacked delimiters is N. Escaping delimiters is not possible." When TITLE is nil, just close all open levels." (org-close-par-maybe) (let ((l org-level-max)) - (while (>= l (1+ level)) + (while (>= l level) (if (aref org-levels-open (1- l)) (progn (org-html-level-close l umax) @@ -24657,10 +25826,14 @@ When COMBINE is non nil, add the category to each line." ts (match-string 0) inc t hd (org-get-heading) - summary (org-entry-get nil "SUMMARY") - desc (or (org-entry-get nil "DESCRIPTION") - (org-get-cleaned-entry org-icalendar-include-body)) - location (org-entry-get nil "LOCATION") + summary (org-icalendar-cleanup-string + (org-entry-get nil "SUMMARY")) + desc (org-icalendar-cleanup-string + (or (org-entry-get nil "DESCRIPTION") + (and org-icalendar-include-body (org-get-entry))) + t org-icalendar-include-body) + location (org-icalendar-cleanup-string + (org-entry-get nil "LOCATION")) category (org-get-category)) (if (looking-at re2) (progn @@ -24748,10 +25921,14 @@ END:VEVENT\n" (not (member org-archive-tag (org-get-tags-at))) ) (setq hd (match-string 3) - summary (org-entry-get nil "SUMMARY") - desc (or (org-entry-get nil "DESCRIPTION") - (org-get-cleaned-entry org-icalendar-include-body)) - location (org-entry-get nil "LOCATION")) + summary (org-icalendar-cleanup-string + (org-entry-get nil "SUMMARY")) + desc (org-icalendar-cleanup-string + (or (org-entry-get nil "DESCRIPTION") + (and org-icalendar-include-body (org-get-entry))) + t org-icalendar-include-body) + location (org-icalendar-cleanup-string + (org-entry-get nil "LOCATION"))) (if (string-match org-bracket-link-regexp hd) (setq hd (replace-match (if (match-end 3) (match-string 3 hd) (match-string 1 hd)) @@ -24780,24 +25957,38 @@ END:VTODO\n" (concat "\nDESCRIPTION: " desc) "") category pri status))))))))) -(defun org-get-cleaned-entry (what) - "Clean-up description string." - (when what - (save-excursion - (org-back-to-heading t) - (let ((s (buffer-substring (point-at-bol 2) (org-end-of-subtree t))) - (re (concat org-drawer-regexp "[^\000]*?:END:.*\n?")) +(defun org-icalendar-cleanup-string (s &optional is-body maxlength) + "Take out stuff and quote what needs to be quoted. +When IS-BODY is non-nil, assume that this is the body of an item, clean up +whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH +characters." + (if (not s) + nil + (when is-body + (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) (while (string-match re s) (setq s (replace-match "" t t s))) - (while (string-match re2 s) (setq s (replace-match "" t t s))) - (if (string-match "[ \t\r\n]+\\'" s) (setq s (replace-match "" t t s))) - (while (string-match "[ \t]*\n[ \t]*" s) - (setq s (replace-match "\\n" t t s))) - (setq s (org-trim s)) - (if (and (numberp what) - (> (length s) what)) - (substring s 0 what) - s))))) + (while (string-match re2 s) (setq s (replace-match "" t t s))))) + (let ((start 0)) + (while (string-match "\\([,;\\]\\)" s start) + (setq start (+ (match-beginning 0) 2) + s (replace-match "\\\\\\1" nil nil s)))) + (when is-body + (while (string-match "[ \t]*\n[ \t]*" s) + (setq s (replace-match "\\n" t t s)))) + (setq s (org-trim s)) + (if is-body + (if maxlength + (if (and (numberp maxlength) + (> (length s) maxlength)) + (setq s (substring s 0 maxlength))))) + s)) + +(defun org-get-entry () + "Clean-up description string." + (save-excursion + (org-back-to-heading t) + (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) (defun org-start-icalendar-file (name) "Start an iCalendar file by inserting the header." @@ -24853,8 +26044,8 @@ The XOXO buffer is named *xoxo-<source buffer name>*" ;; Output everything as XOXO (with-current-buffer (get-buffer buffer) - (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. - (let* ((opt-plist (org-combine-plists (org-default-export-plist) + (let* ((pos (point)) + (opt-plist (org-combine-plists (org-default-export-plist) (org-infile-export-plist))) (filename (concat (file-name-as-directory (org-export-directory :xoxo opt-plist)) @@ -24864,6 +26055,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*" (out (find-file-noselect filename)) (last-level 1) (hanging-li nil)) + (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. ;; Check the output buffer is empty. (with-current-buffer out (erase-buffer)) ;; Kick off the output @@ -24916,6 +26108,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*" (org-export-as-xoxo-insert-into out "</li>\n")) (org-export-as-xoxo-insert-into out "</ol>\n")) + (goto-char pos) ;; Finish the buffer off and clean it up. (switch-to-buffer-other-window out) (indent-region (point-min) (point-max) nil) @@ -25009,7 +26202,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*" (org-defkey org-mode-map "\C-c\C-d" 'org-deadline) (org-defkey org-mode-map "\C-c;" 'org-toggle-comment) (org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree) -(org-defkey org-mode-map "\C-c\C-w" 'org-check-deadlines) +(org-defkey org-mode-map "\C-c\C-w" 'org-refile) (org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved (org-defkey org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res. (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>*" (org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files) (org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front) (org-defkey org-mode-map "\C-c]" 'org-remove-file) +(org-defkey org-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock) +(org-defkey org-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) (org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus) (org-defkey org-mode-map "\C-c^" 'org-sort) (org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) (org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) (org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count) (org-defkey org-mode-map "\C-m" 'org-return) +(org-defkey org-mode-map "\C-j" 'org-return-indent) (org-defkey org-mode-map "\C-c?" 'org-table-field-info) (org-defkey org-mode-map "\C-c " 'org-table-blank-field) (org-defkey org-mode-map "\C-c+" 'org-table-sum) @@ -25175,12 +26371,9 @@ because, in this case the deletion might narrow the column." (put 'org-delete-char 'flyspell-delayed t) (put 'org-delete-backward-char 'flyspell-delayed t) -(eval-after-load "pabbrev" - '(progn - (add-to-list 'pabbrev-expand-after-command-list - 'orgtbl-self-insert-command t) - (add-to-list 'pabbrev-expand-after-command-list - 'org-self-insert-command t))) +;; Make pabbrev-mode expand after org-mode commands +(put 'org-self-insert-command 'pabbrev-expand-after-command t) +(put 'orgybl-self-insert-command 'pabbrev-expand-after-command t) ;; How to do this: Measure non-white length of current string ;; If equal to column width, we should realign. @@ -25442,7 +26635,9 @@ This command does many different things, depending on context: links in this buffer. - If the cursor is on a numbered item in a plain list, renumber the - ordered list." + ordered list. + +- If the cursor is on a checkbox, toggle it." (interactive "P") (let ((org-enable-table-editor t)) (cond @@ -25500,25 +26695,31 @@ Also updates the keyword regular expressions." (message "Org-mode restarted to refresh keyword and special line setup")) (defun org-kill-note-or-show-branches () - "If this is a Note buffer, abort storing the note. Else call `show-branches'." + "If this is a Note buffer, abort storing the note. Else call `show-branches'." (interactive) (if (not org-finish-function) (call-interactively 'show-branches) (let ((org-note-abort t)) (funcall org-finish-function)))) -(defun org-return () +(defun org-return (&optional indent) "Goto next table row or insert a newline. Calls `org-table-next-row' or `newline', depending on context. See the individual commands for more information." (interactive) (cond - ((bobp) (newline)) + ((bobp) (if indent (newline-and-indent) (newline))) ((org-at-table-p) (org-table-justify-field-maybe) (call-interactively 'org-table-next-row)) - (t (newline)))) + (t (if indent (newline-and-indent) (newline))))) +(defun org-return-indent () + (interactive) + "Goto next table row or insert a newline and indent. +Calls `org-table-next-row' or `newline-and-indent', depending on +context. See the individual commands for more information." + (org-return t)) (defun org-ctrl-c-minus () "Insert separator line in table or modify bullet type in list. @@ -25723,6 +26924,7 @@ See the individual commands for more information." :style toggle :selected org-log-done]) "--" ["Agenda Command..." org-agenda t] + ["Set Restriction Lock" org-agenda-set-restriction-lock t] ("File List for Agenda") ("Special views current file" ["TODO Tree" org-show-todo-tree t] @@ -25981,6 +27183,18 @@ really on, so that the block visually is on the match." (setq list (delete (pop elts) list))) list) +(defun org-back-over-empty-lines () + "Move backwards over witespace, to the beginning of the first empty line. +Returns the number o empty lines passed." + (let ((pos (point))) + (skip-chars-backward " \t\n\r") + (beginning-of-line 2) + (goto-char (min (point) pos)) + (count-lines (point) pos))) + +(defun org-skip-whitespace () + (skip-chars-forward " \t\n\r")) + (defun org-point-in-group (point group &optional context) "Check if POINT is in match-group GROUP. If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the @@ -26129,10 +27343,13 @@ not an indirect buffer" (setq column tcol) (goto-char pos) (beginning-of-line 1) - (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") - (setq bullet (match-string 1) - btype (if (string-match "[0-9]" bullet) "n" bullet)) - (setq column (if (equal btype bullet-type) bcol tcol)))) + (if (looking-at "\\S-") + (progn + (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") + (setq bullet (match-string 1) + btype (if (string-match "[0-9]" bullet) "n" bullet)) + (setq column (if (equal btype bullet-type) bcol tcol))) + (setq column (org-get-indentation))))) (t (setq column (org-get-indentation)))))) (goto-char pos) (if (<= (current-column) (current-indentation)) @@ -26141,7 +27358,7 @@ not an indirect buffer" (setq column (current-column)) (beginning-of-line 1) (if (looking-at - "\\([ \t]+\\)\\(:[0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") + "\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") (replace-match (concat "\\1" (format org-property-format (match-string 2) (match-string 3))) t nil)) @@ -26183,10 +27400,13 @@ not an indirect buffer" "Re-align a table, pass through to fill-paragraph if no table." (let ((table-p (org-at-table-p)) (table.el-p (org-at-table.el-p))) - (cond ((equal (char-after (point-at-bol)) ?*) t) ; skip headlines - (table.el-p t) ; skip table.el tables - (table-p (org-table-align) t) ; align org-mode tables - (t nil)))) ; call paragraph-fill + (cond ((and (equal (char-after (point-at-bol)) ?*) + (save-excursion (goto-char (point-at-bol)) + (looking-at outline-regexp))) + t) ; skip headlines + (table.el-p t) ; skip table.el tables + (table-p (org-table-align) t) ; align org-mode tables + (t nil)))) ; call paragraph-fill ;; For reference, this is the default value of adaptive-fill-regexp ;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*" @@ -26318,6 +27538,20 @@ headline found, or nil if no higher level is found." (if (< level start-level) (throw 'exit level))) nil))) +(defun org-first-sibling-p () + "Is this heading the first child of its parents?" + (interactive) + (let ((re (concat "^" outline-regexp)) + level l) + (unless (org-at-heading-p t) + (error "Not at a heading")) + (setq level (funcall outline-level)) + (save-excursion + (if (not (re-search-backward re nil t)) + t + (setq l (funcall outline-level)) + (< l level))))) + (defun org-goto-sibling (&optional previous) "Goto the next sibling, even if it is invisible. 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." (org-show-context 'isearch)) -;;;; Address problems with some other packages +;;;; Integration with and fixes for other packages + +;;; Imenu support + +(defvar org-imenu-markers nil + "All markers currently used by Imenu.") +(make-variable-buffer-local 'org-imenu-markers) + +(defun org-imenu-new-marker (&optional pos) + "Return a new marker for use by Imenu, and remember the marker." + (let ((m (make-marker))) + (move-marker m (or pos (point))) + (push m org-imenu-markers) + m)) + +(defun org-imenu-get-tree () + "Produce the index for Imenu." + (mapc (lambda (x) (move-marker x nil)) org-imenu-markers) + (setq org-imenu-markers nil) + (let* ((n org-imenu-depth) + (re (concat "^" outline-regexp)) + (subs (make-vector (1+ n) nil)) + (last-level 0) + m tree level head) + (save-excursion + (save-restriction + (widen) + (goto-char (point-max)) + (while (re-search-backward re nil t) + (setq level (org-reduced-level (funcall outline-level))) + (when (<= level n) + (looking-at org-complex-heading-regexp) + (setq head (org-match-string-no-properties 4) + m (org-imenu-new-marker)) + (org-add-props head nil 'org-imenu-marker m 'org-imenu t) + (if (>= level last-level) + (push (cons head m) (aref subs level)) + (push (cons head (aref subs (1+ level))) (aref subs level)) + (loop for i from (1+ level) to n do (aset subs i nil))) + (setq last-level level))))) + (aref subs 1))) + +(eval-after-load "imenu" + '(progn + (add-hook 'imenu-after-jump-hook + (lambda () (org-show-context 'org-goto))))) + +;; Speedbar support + +(defun org-speedbar-set-agenda-restriction () + "Restrict future agenda commands to the location at point in speedbar. +To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." + (interactive) + (let (p m tp np dir txt w) + (cond + ((setq p (text-property-any (point-at-bol) (point-at-eol) + 'org-imenu t)) + (setq m (get-text-property p 'org-imenu-marker)) + (save-excursion + (save-restriction + (set-buffer (marker-buffer m)) + (goto-char m) + (org-agenda-set-restriction-lock 'subtree)))) + ((setq p (text-property-any (point-at-bol) (point-at-eol) + 'speedbar-function 'speedbar-find-file)) + (setq tp (previous-single-property-change + (1+ p) 'speedbar-function) + np (next-single-property-change + tp 'speedbar-function) + dir (speedbar-line-directory) + txt (buffer-substring-no-properties (or tp (point-min)) + (or np (point-max)))) + (save-excursion + (save-restriction + (set-buffer (find-file-noselect + (let ((default-directory dir)) + (expand-file-name txt)))) + (unless (org-mode-p) + (error "Cannot restrict to non-Org-mode file")) + (org-agenda-set-restriction-lock 'file)))) + (t (error "Don't know how to restrict Org-mode's agenda"))) + (org-move-overlay org-speedbar-restriction-lock-overlay + (point-at-bol) (point-at-eol)) + (setq current-prefix-arg nil) + (org-agenda-maybe-redo))) + +(eval-after-load "speedbar" + '(progn + (speedbar-add-supported-extension ".org") + (define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction) + (define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction) + (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock) + (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) + (add-hook 'speedbar-visiting-tag-hook + (lambda () (org-show-context 'org-goto))))) + + +;;; Fixes and Hacks ;; Make flyspell not check words in links, to not mess up our keymap (defun org-mode-flyspell-verify () @@ -26471,6 +27802,13 @@ Show the heading too, if it is currently invisible." (org-invisible-p))) (org-show-context 'bookmark-jump))) +;; Fix a bug in htmlize where there are text properties (face nil) +(eval-after-load "htmlize" + '(progn + (defadvice htmlize-faces-in-buffer (after org-no-nil-faces activate) + "Make sure there are no nil faces" + (setq ad-return-value (delq nil ad-return-value))))) + ;; Make session.el ignore our circular variable (eval-after-load "session" '(add-to-list 'session-globals-exclude 'org-mark-ring)) @@ -26479,7 +27817,7 @@ Show the heading too, if it is currently invisible." (defun org-closed-in-range () "Sparse tree of items closed in a certain time range. -Still experimental, may disappear in the furture." +Still experimental, may disappear in the future." (interactive) ;; Get the time interval from the user. (let* ((time1 (time-to-seconds @@ -26498,64 +27836,6 @@ Still experimental, may disappear in the furture." ;; make tree, check each match with the callback (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) -(defun org-fill-paragraph-experimental (&optional justify) - "Re-align a table, pass through to fill-paragraph if no table." - (let ((table-p (org-at-table-p)) - (table.el-p (org-at-table.el-p))) - (cond ((equal (char-after (point-at-bol)) ?*) t) ; skip headlines - (table.el-p t) ; skip table.el tables - (table-p (org-table-align) t) ; align org-mode tables - ((save-excursion - (let ((pos (1+ (point-at-eol)))) - (backward-paragraph 1) - (re-search-forward "\\\\\\\\[ \t]*$" pos t))) - (save-excursion - (save-restriction - (narrow-to-region (1+ (match-end 0)) (point-max)) - (fill-paragraph nil) - t))) - (t nil)))) ; call paragraph-fill - -;; FIXME: this needs a much better algorithm -(defun org-assign-fast-keys (alist) - "Assign fast keys to a keyword-key alist. -Respect keys that are already there." - (let (new e k c c1 c2 (char ?a)) - (while (setq e (pop alist)) - (cond - ((equal e '(:startgroup)) (push e new)) - ((equal e '(:endgroup)) (push e new)) - (t - (setq k (car e) c2 nil) - (if (cdr e) - (setq c (cdr e)) - ;; automatically assign a character. - (setq c1 (string-to-char - (downcase (substring - k (if (= (string-to-char k) ?@) 1 0))))) - (if (or (rassoc c1 new) (rassoc c1 alist)) - (while (or (rassoc char new) (rassoc char alist)) - (setq char (1+ char))) - (setq c2 c1)) - (setq c (or c2 char))) - (push (cons k c) new)))) - (nreverse new))) - -;(defcustom org-read-date-prefer-future nil -; "Non-nil means, when reading an incomplete date from the user, assume future. -;This affects the following situations: -;1. The user give a day, but no month. -; In this case, if the day number if after today, the current month will -; be used, otherwise the next month. -;2. The user gives a month but not a year. -; In this case, the the given month is after the current month, the current -; year will be used. Otherwise the next year will be used.; -; -;When nil, always the current month and year will be used." -; :group 'org-time ;???? -; :type 'boolean) - - ;;;; Finish up (provide 'org) @@ -26565,4 +27845,3 @@ Respect keys that are already there." ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd ;;; org.el ends here - 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." (beginning-of-line 2)) (while (looking-at "^[ \t]*$") (beginning-of-line 2)) - (cond ((fboundp 'zmacs-activate-region) (zmacs-activate-region)) - ((boundp 'make-active) (setq mark-active t))) + (if (featurep 'xemacs) + (zmacs-activate-region) + (setq mark-active t)) (if (yes-or-no-p "Delete and rebuild header? ") (delete-region (point-min) (point)))) @@ -1495,8 +1496,9 @@ index the new part without having to go over the unchanged parts again." (unwind-protect (progn ;; Hide the region highlighting - (cond ((fboundp 'zmacs-deactivate-region) (zmacs-deactivate-region)) - ((fboundp 'deactivate-mark) (deactivate-mark))) + (if (featurep 'xemacs) + (zmacs-deactivate-region) + (deactivate-mark)) (delete-other-windows) (reftex-index-visit-phrases-buffer) (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 (defun reftex-toc-next (&optional arg) "Move to next selectable item." (interactive "p") - (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) + (when (featurep 'xemacs) (setq zmacs-region-stays t)) (setq reftex-callback-fwd t) (or (eobp) (forward-char 1)) (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 (defun reftex-toc-previous (&optional arg) "Move to previous selectable item." (interactive "p") - (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) + (when (featurep 'xemacs) (setq zmacs-region-stays t)) (setq reftex-callback-fwd nil) (goto-char (or (previous-single-property-change (point) :data) (point)))) (defun reftex-toc-next-heading (&optional arg) "Move to next table of contentes line." (interactive "p") - (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) + (when (featurep 'xemacs) (setq zmacs-region-stays t)) (end-of-line) (re-search-forward "^ " nil t arg) (beginning-of-line)) (defun reftex-toc-previous-heading (&optional arg) "Move to previous table of contentes line." (interactive "p") - (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) + (when (featurep 'xemacs) (setq zmacs-region-stays t)) (re-search-backward "^ " nil t arg)) (defun reftex-toc-toggle-follow () "Toggle follow (other window follows with context)." @@ -637,7 +637,7 @@ point." (if mark-line (progn (set-mark mpos) - (if (fboundp 'zmacs-activate-region) + (if (featurep 'xemacs) (zmacs-activate-region) (setq mark-active t 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 @@ ;;; remember --- a mode for quickly jotting down things to remember -;; Copyright (C) 1999, 2000, 2001, 2003, 2004, 2005, 2006, -;; 2007 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2003, 2004, 2005, 2006, 2007, +;; 2008 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@gnu.org> ;; 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.") "Syntax table used in SGML mode. See also `sgml-specials'.") (defconst sgml-tag-syntax-table - (let ((table (sgml-make-syntax-table '(?- ?\" ?\')))) + (let ((table (sgml-make-syntax-table sgml-specials))) (dolist (char '(?\( ?\) ?\{ ?\} ?\[ ?\] ?$ ?% ?& ?* ?+ ?/)) (modify-syntax-entry char "." table)) 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 @@ +2008-01-29 John Wiegley <johnw@newartisans.com> + + * url-auth.el (url-digest-auth): If the 'opaque' argument is not + being used, don't add it to the response text. Also, changed an + if so that the interaction between the PROMPT and OVERWRITE + arguments can no longer result in the user being queried twice for + the same login and password information. + +2008-01-21 Stefan Monnier <monnier@iro.umontreal.ca> + + * url-handlers.el (unhandled-file-name-directory): Add handler. + (url-handler-unhandled-file-name-directory): New fun. + 2008-01-07 Michael Albinus <michael.albinus@gmx.de> * 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." (string= data (substring file 0 (length data))))) (setq retval (cdr (car byserv)))) (setq byserv (cdr byserv)))) - (if (or (and (not retval) prompt) overwrite) - (progn - (setq user (read-string (url-auth-user-prompt url realm) - (user-real-login-name)) - pass (read-passwd "Password: ") - retval (setq retval - (cons user - (url-digest-auth-create-key - user pass realm - (or url-request-method "GET") - url))) - byserv (assoc server url-digest-auth-storage)) + (if overwrite + (if (and (not retval) prompt) + (setq user (read-string (url-auth-user-prompt url realm) + (user-real-login-name)) + pass (read-passwd "Password: ") + retval (setq retval + (cons user + (url-digest-auth-create-key + user pass realm + (or url-request-method "GET") + url))) + byserv (assoc server url-digest-auth-storage)) (setcdr byserv (cons (cons file retval) (cdr byserv)))))) (t (setq retval nil))) (if retval - (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven")) - (opaque (or (cdr-safe (assoc "opaque" args)) "nonegiven"))) - (format - (concat "Digest username=\"%s\", realm=\"%s\"," - "nonce=\"%s\", uri=\"%s\"," - "response=\"%s\", opaque=\"%s\"") - (nth 0 retval) realm nonce (url-filename href) - (md5 (concat (nth 1 retval) ":" nonce ":" - (nth 2 retval))) opaque)))))) + (if (cdr-safe (assoc "opaque" args)) + (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven")) + (opaque (cdr-safe (assoc "opaque" args)))) + (format + (concat "Digest username=\"%s\", realm=\"%s\"," + "nonce=\"%s\", uri=\"%s\"," + "response=\"%s\", opaque=\"%s\"") + (nth 0 retval) realm nonce (url-filename href) + (md5 (concat (nth 1 retval) ":" nonce ":" + (nth 2 retval))) opaque)) + (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven"))) + (format + (concat "Digest username=\"%s\", realm=\"%s\"," + "nonce=\"%s\", uri=\"%s\"," + "response=\"%s\"") + (nth 0 retval) realm nonce (url-filename href) + (md5 (concat (nth 1 retval) ":" nonce ":" + (nth 2 retval)))))))))) (defvar url-registered-auth-schemes nil "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." (put 'file-name-absolute-p 'url-file-handlers (lambda (&rest ignored) t)) (put 'expand-file-name 'url-file-handlers 'url-handler-expand-file-name) (put 'directory-file-name 'url-file-handlers 'url-handler-directory-file-name) +(put 'unhandled-file-name-directory 'url-file-handlers 'url-handler-unhandled-file-name-directory) ;; (put 'file-name-as-directory 'url-file-handlers 'url-handler-file-name-as-directory) ;; These are operations that we do not support yet (DAV!!!) @@ -181,6 +182,13 @@ the arguments that would have been passed to OPERATION." (if (string-match "//\\'" dir) dir (url-run-real-handler 'directory-file-name (list dir)))) +(defun url-handler-unhandled-file-name-directory (filename) + ;; Copied from tramp.el. This is used as the cwd for subprocesses: + ;; without it running call-process or start-process in a URL directory + ;; signals an error. + ;; FIXME: we can do better if `filename' is a "file://" URL. + (expand-file-name "~/")) + ;; The actual implementation ;;;###autoload (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 @@ ;;;###autoload (defun url-generic-parse-url (url) - "Return a vector of the parts of URL. -Format is: -\[TYPE USER PASSWORD HOST PORT FILE TARGET ATTRIBUTES FULL\]" + "Return an URL-struct of the parts of URL. +The CL-style struct contains the following fields: +TYPE USER PASSWORD HOST PORTSPEC FILENAME TARGET ATTRIBUTES FULLNESS." ;; See RFC 3986. (cond ((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." (save-excursion (let ((rej (concat buffer-file-name ".rej"))) (when (and buffer-file-name (vc-arch-diff3-rej-p rej)) - (if (not (re-search-forward "^<<<<<<< " nil t)) - ;; The .rej file is obsolete. - (condition-case nil (delete-file rej) (error nil))))))) + (unless (re-search-forward "^<<<<<<< " nil t) + ;; The .rej file is obsolete. + (condition-case nil (delete-file rej) (error nil)) + ;; Remove the hook so that it is not called multiple times. + (remove-hook 'after-save-hook 'vc-arch-delete-rej-if-obsolete t)))))) (defun vc-arch-find-file-hook () (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." (message "Merging changes into %s..." file) ;; (vc-file-setprop file 'vc-working-revision nil) (vc-file-setprop file 'vc-checkout-time 0) - (vc-cvs-command nil 0 file "update") + (vc-cvs-command nil nil file "update") ;; Analyze the merge result reported by CVS, and set ;; file properties accordingly. (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 @@ (when (vc-hg-root file) ; short cut (let ((state (vc-hg-state file))) ; expensive (vc-file-setprop file 'vc-state state) - (not (memq state '(ignored unregistered)))))) + (and state (not (memq state '(ignored unregistered))))))) (defun vc-hg-state (file) "Hg-specific version of `vc-state'." @@ -316,8 +316,7 @@ (if oldvers (if newvers (list "-r" oldvers "-r" newvers) - (list "-r" oldvers)) - (list "")))))) + (list "-r" oldvers))))))) (defun vc-hg-revision-table (files) (let ((default-directory (file-name-directory (car files)))) @@ -480,35 +479,41 @@ REV is the revision to check out into WORKFILE." (define-derived-mode vc-hg-incoming-mode vc-hg-log-view-mode "Hg-Incoming") - ;; XXX Experimental function for the vc-dired replacement. -(defun vc-hg-dir-status (dir) - "Return a list of conses (file . state) for DIR." - (with-temp-buffer - (vc-hg-command (current-buffer) nil dir "status" "-A") - (goto-char (point-min)) - (let ((status-char nil) - (file nil) - (translation '((?= . up-to-date) - (?C . up-to-date) - (?A . added) - (?R . removed) - (?M . edited) - (?I . ignored) - (?! . deleted) - (?? . unregistered))) - (translated nil) +(defun vc-hg-after-dir-status (update-function buff) + (let ((status-char nil) + (file nil) + (translation '((?= . up-to-date) + (?C . up-to-date) + (?A . added) + (?R . removed) + (?M . edited) + (?I . ignored) + (?! . deleted) + (?? . unregistered))) + (translated nil) (result nil)) + (goto-char (point-min)) (while (not (eobp)) (setq status-char (char-after)) (setq file (buffer-substring-no-properties (+ (point) 2) - (line-end-position))) + (line-end-position))) (setq translated (assoc status-char translation)) (when (and translated (not (eq (cdr translated) 'up-to-date))) (push (cons file (cdr translated)) result)) (forward-line)) - result))) + (funcall update-function result buff))) + +;; XXX Experimental function for the vc-dired replacement. +(defun vc-hg-dir-status (dir update-function status-buffer) + "Return a list of conses (file . state) for DIR." + (with-current-buffer + (get-buffer-create + (expand-file-name " *VC-hg* tmp status" dir)) + (vc-hg-command (current-buffer) 'async dir "status") + (vc-exec-after + `(vc-hg-after-dir-status (quote ,update-function) ,status-buffer)))) ;; XXX this adds another top level menu, instead figure out how to ;; 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." ;; an `error' by vc-do-command. (error nil)))) (when (eq 0 status) - (vc-svn-parse-status file)))))) + (let ((parsed (vc-svn-parse-status file))) + (and parsed (not (memq parsed '(ignored unregistered)))))))))) (defun vc-svn-state (file &optional localp) "SVN-specific version of `vc-state'." @@ -157,6 +158,35 @@ If you want to force an empty list of arguments, use t." (vc-svn-command t 0 nil "status" (if localp "-v" "-u")) (vc-svn-parse-status)))) +(defun vc-svn-after-dir-status (callback buffer) + (let ((state-map '((?A . added) + (?C . edited) + (?D . removed) + (?I . ignored) + (?M . edited) + (?R . removed) + (?? . unregistered) + ;; This is what vc-svn-parse-status does. + (?~ . edited))) + result) + (goto-char (point-min)) + (while (re-search-forward "^\\(.\\)..... \\(.*\\)$" nil t) + (let ((state (cdr (assq (aref (match-string 1) 0) state-map))) + (filename (match-string 2))) + (when state + (setq result (cons (cons filename state) result))))) + (funcall callback result buffer))) + +(defun vc-svn-dir-status (dir callback buffer) + "Run 'svn status' for DIR and update BUFFER via CALLBACK. +CALLBACK is called as (CALLBACK RESULT BUFFER), where +RESULT is a list of conses (FILE . STATE) for directory DIR." + (with-current-buffer (get-buffer-create + (generate-new-buffer-name " *vc svn status*")) + (vc-svn-command (current-buffer) 'async nil "status") + (vc-exec-after + `(vc-svn-after-dir-status (quote ,callback) ,buffer)))) + (defun vc-svn-working-revision (file) "SVN-specific version of `vc-working-revision'." ;; 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." "Call \"svn resolved\" if the conflict markers have been removed." (save-excursion (goto-char (point-min)) - (if (not (re-search-forward "^<<<<<<< " nil t)) - (vc-svn-command nil 0 buffer-file-name "resolved")))) + (unless (re-search-forward "^<<<<<<< " nil t) + (vc-svn-command nil 0 buffer-file-name "resolved") + ;; Remove the hook so that it is not called multiple times. + (remove-hook 'after-save-hook 'vc-svn-resolve-when-done t)))) ;; Inspired by vc-arch-find-file-hook. (defun vc-svn-find-file-hook () @@ -550,7 +582,7 @@ and that it passes `vc-svn-global-switches' to it before FLAGS." (re-search-forward "^<<<<<<< " nil t)) ;; There are conflict markers. (progn - (smerge-mode 1) + (smerge-start-session) (add-hook 'after-save-hook 'vc-svn-resolve-when-done nil t)) ;; There are no conflict markers. This is problematic: maybe it means ;; 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 @@ ;;; vc.el --- drive a version-control system from within Emacs ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, -;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 +;; Free Software Foundation, Inc. ;; Author: FSF (see below for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> ;; Keywords: tools -;; $Id$ - ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify @@ -522,6 +521,55 @@ ;; to your backend and which does not map to any of the VC generic ;; concepts. +;;; Todo: + +;; - Make vc-checkin avoid reverting the buffer if has not changed +;; after the checkin. Comparing (md5 BUFFER) to (md5 FILE) should +;; be enough. +;; +;; - vc-update/vc-merge should deal with VC systems that don't +;; update/merge on a file basis, but on a whole repository basis. +;; +;; - the backend sometimes knows when a file it opens has been marked +;; by the VCS as having a "conflict". Find a way to pass this info - +;; to VC so that it can turn on smerge-mode when opening such a +;; file. +;; +;; - the *VC-log* buffer needs font-locking. +;; +;; - make it easier to write logs, maybe C-x 4 a should add to the log +;; buffer if there's one instead of the ChangeLog. +;; +;; - make vc-state for all backends return 'unregistered instead of +;; nil for unregistered files, then update vc-next-action. +;; +;; - add a generic mechanism for remembering the current branch names, +;; display the branch name in the mode-line. Replace +;; vc-cvs-sticky-tag with that. +;; +;; - vc-register should register a fileset at a time. The backends +;; already support this, only the front-end needs to be change to +;; handle multiple files at a time. +;; +;; - add a mechanism to for ignoring files. +;; +;; - deal with push/pull operations. +;; +;; - decide if vc-status should replace vc-dired. +;; +;; - vc-status needs a menu, mouse bindings and some color bling. +;; +;; - vc-status needs to show missing files. It probably needs to have +;; another state for those files. The user might want to restore +;; them, or remove them from the VCS. C-x v v might also need +;; adjustments. +;; +;; - "snapshots" should be renamed to "branches", and thoroughly reworked. +;; +;; - do not default to RCS anymore when the current directory is not +;; controlled by any VCS and the user does C-x v v +;; + ;;; Code: (require 'vc-hooks) @@ -907,13 +955,15 @@ However, before executing BODY, find FILE, and after BODY, save buffer." "An alternative output filter for async process P. One difference with the default filter is that this inserts S after markers. Another is that undo information is not kept." - (with-current-buffer (process-buffer p) - (save-excursion - (let ((buffer-undo-list t) - (inhibit-read-only t)) - (goto-char (process-mark p)) - (insert s) - (set-marker (process-mark p) (point)))))) + (let ((buffer (process-buffer p))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (save-excursion + (let ((buffer-undo-list t) + (inhibit-read-only t)) + (goto-char (process-mark p)) + (insert s) + (set-marker (process-mark p) (point)))))))) (defun vc-setup-buffer (&optional buf) "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." (defvar vc-sentinel-movepoint) ;Dynamically scoped. (defun vc-process-sentinel (p s) - (let ((previous (process-get p 'vc-previous-sentinel))) - (if previous (funcall previous p s)) - (with-current-buffer (process-buffer p) - (let (vc-sentinel-movepoint) - ;; Normally, we want async code such as sentinels to not move point. - (save-excursion - (goto-char (process-mark p)) - (let ((cmds (process-get p 'vc-sentinel-commands))) - (process-put p 'vc-sentinel-commands nil) - (dolist (cmd cmds) - ;; Each sentinel may move point and the next one should be run - ;; at that new point. We could get the same result by having - ;; each sentinel read&set process-mark, but since `cmd' needs - ;; to work both for async and sync processes, this would be - ;; difficult to achieve. - (vc-exec-after cmd)))) - ;; But sometimes the sentinels really want to move point. - (if vc-sentinel-movepoint - (let ((win (get-buffer-window (current-buffer) 0))) - (if (not win) - (goto-char vc-sentinel-movepoint) - (with-selected-window win - (goto-char vc-sentinel-movepoint))))))))) + (let ((previous (process-get p 'vc-previous-sentinel)) + (buf (process-buffer p))) + ;; Impatient users sometime kill "slow" buffers; check liveness + ;; to avoid "error in process sentinel: Selecting deleted buffer". + (when (buffer-live-p buf) + (if previous (funcall previous p s)) + (with-current-buffer buf + (setq mode-line-process + (let ((status (process-status p))) + ;; Leave mode-line uncluttered, normally. + ;; (Let known any weirdness in-form-ally. ;-) --ttn + (unless (eq 'exit status) + (format " (%s)" status)))) + (let (vc-sentinel-movepoint) + ;; Normally, we want async code such as sentinels to not move point. + (save-excursion + (goto-char (process-mark p)) + (let ((cmds (process-get p 'vc-sentinel-commands))) + (process-put p 'vc-sentinel-commands nil) + (dolist (cmd cmds) + ;; Each sentinel may move point and the next one should be run + ;; at that new point. We could get the same result by having + ;; each sentinel read&set process-mark, but since `cmd' needs + ;; to work both for async and sync processes, this would be + ;; difficult to achieve. + (vc-exec-after cmd)))) + ;; But sometimes the sentinels really want to move point. + (if vc-sentinel-movepoint + (let ((win (get-buffer-window (current-buffer) 0))) + (if (not win) + (goto-char vc-sentinel-movepoint) + (with-selected-window win + (goto-char vc-sentinel-movepoint)))))))))) (defun vc-exec-after (code) "Eval CODE when the current buffer's process is done. @@ -975,6 +1035,17 @@ Else, add CODE to the process' sentinel." (eval code)) ;; If a process is running, add CODE to the sentinel ((eq (process-status proc) 'run) + (setq mode-line-process + ;; Deliberate overstatement, but power law respected. + ;; (The message is ephemeral, so we make it loud.) --ttn + (propertize " (incomplete/in progress)" + 'face (if (featurep 'compile) + ;; ttn's preferred loudness + 'compilation-warning + ;; suitably available fallback + font-lock-warning-face) + 'help-echo + "A VC command is in progress in this buffer")) (let ((previous (process-sentinel proc))) (unless (eq previous 'vc-process-sentinel) (process-put proc 'vc-previous-sentinel previous)) @@ -1276,9 +1347,12 @@ Otherwise, throw an error." (unless (eq (vc-backend f) firstbackend) (error "All members of a fileset must be under the same version-control system.")))) marked)) - ((eq major-mode 'vc-status-mode) - (vc-status-marked-files)) - ((vc-backend buffer-file-name) + ((eq major-mode 'vc-status-mode) + (let ((marked (vc-status-marked-files))) + (if marked + marked + (list (vc-status-current-file))))) + ((vc-backend buffer-file-name) (list buffer-file-name)) ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer) (with-current-buffer vc-parent-buffer @@ -1307,8 +1381,12 @@ Otherwise, throw an error." (defun vc-ensure-vc-buffer () "Make sure that the current buffer visits a version-controlled file." - (if vc-dired-mode - (set-buffer (find-file-noselect (dired-get-filename))) + (cond + (vc-dired-mode + (set-buffer (find-file-noselect (dired-get-filename)))) + ((eq major-mode 'vc-status-mode) + (set-buffer (find-file-noselect (vc-status-current-file)))) + (t (while (and vc-parent-buffer (buffer-live-p vc-parent-buffer) ;; Avoid infinite looping when vc-parent-buffer and @@ -1318,7 +1396,7 @@ Otherwise, throw an error." (if (not buffer-file-name) (error "Buffer %s is not associated with a file" (buffer-name)) (if (not (vc-backend buffer-file-name)) - (error "File %s is not under version control" buffer-file-name))))) + (error "File %s is not under version control" buffer-file-name)))))) ;;; Support for the C-x v v command. This is where all the single-file-oriented ;;; code from before the fileset rewrite lives. @@ -1404,9 +1482,9 @@ merge in the changes into your working copy." revision) ;; Verify that the fileset is homogenous (dolist (file (cdr files)) - (if (not (vc-compatible-state (vc-state file) state)) - (error "Fileset is in a mixed-up state")) - (if (not (eq (vc-checkout-model file) model)) + (unless (vc-compatible-state (vc-state file) state) + (error "Fileset is in a mixed-up state")) + (unless (eq (vc-checkout-model file) model) (error "Fileset has mixed checkout models"))) ;; Check for buffers in the fileset not matching the on-disk contents. (dolist (file files) @@ -1428,13 +1506,15 @@ merge in the changes into your working copy." (error "Aborted")) ;; Now, check if we have unsaved changes. (vc-buffer-sync t) - (if (buffer-modified-p) - (or (y-or-n-p (message "Use %s on disk, keeping modified buffer? " file)) - (error "Aborted"))))))) + (when (buffer-modified-p) + (or (y-or-n-p (message "Use %s on disk, keeping modified buffer? " file)) + (error "Aborted"))))))) ;; Do the right thing (cond ;; Files aren't registered - ((not state) + ((or (not state) ;; RCS uses nil for unregistered files. + (eq state 'unregistered) + (eq state 'ignored)) (mapc 'vc-register files)) ;; Files are up-to-date, or need a merge and user specified a revision ((or (eq state 'up-to-date) (and verbose (eq state 'needs-patch))) @@ -1458,32 +1538,30 @@ merge in the changes into your working copy." (let ((ready-for-commit files)) ;; If files are edited but read-only, give user a chance to correct (dolist (file files) - (if (not (file-writable-p file)) - (progn - ;; Make the file+buffer read-write. - (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file)) - (error "Aborted")) - (set-file-modes file (logior (file-modes file) 128)) - (let ((visited (get-file-buffer file))) - (if visited - (with-current-buffer visited - (toggle-read-only -1))))))) + (unless (file-writable-p file) + ;; Make the file+buffer read-write. + (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file)) + (error "Aborted")) + (set-file-modes file (logior (file-modes file) 128)) + (let ((visited (get-file-buffer file))) + (when visited + (with-current-buffer visited + (toggle-read-only -1)))))) ;; Allow user to revert files with no changes (save-excursion (dolist (file files) (let ((visited (get-file-buffer file))) ;; For files with locking, if the file does not contain ;; any changes, just let go of the lock, i.e. revert. - (if (and (not (eq model 'implicit)) - (vc-workfile-unchanged-p file) - ;; If buffer is modified, that means the user just - ;; said no to saving it; in that case, don't revert, - ;; because the user might intend to save after - ;; finishing the log entry and committing. - (not (and visited (buffer-modified-p)))) - (progn - (vc-revert-file file) - (delete file ready-for-commit)))))) + (when (and (not (eq model 'implicit)) + (vc-workfile-unchanged-p file) + ;; If buffer is modified, that means the user just + ;; said no to saving it; in that case, don't revert, + ;; because the user might intend to save after + ;; finishing the log entry and committing. + (not (and visited (buffer-modified-p)))) + (vc-revert-file file) + (delete file ready-for-commit))))) ;; Remaining files need to be committed (if (not ready-for-commit) (message "No files remain to be committed") @@ -1493,15 +1571,28 @@ merge in the changes into your working copy." (setq revision (read-string "New revision or backend: ")) (let ((vsym (intern (upcase revision)))) (if (member vsym vc-handled-backends) - (vc-transfer-file file vsym) + (dolist (file files) (vc-transfer-file file vsym)) (vc-checkin ready-for-commit revision)))))))) ;; locked by somebody else (locking VCSes only) ((stringp state) - (let ((revision - (if verbose - (read-string "Revision to steal: ") - (vc-working-revision file)))) - (dolist (file files) (vc-steal-lock file revision state)))) + ;; In the old days, we computed the revision once and used it on + ;; the single file. Then, for the 2007-2008 fileset rewrite, we + ;; computed the revision once (incorrectly, using a free var) and + ;; used it on all files. To fix the free var bug, we can either + ;; use `(car files)' or do what we do here: distribute the + ;; revision computation among `files'. Although this may be + ;; tedious for those backends where a "revision" is a trans-file + ;; concept, it is nonetheless correct for both those and (more + ;; importantly) for those where "revision" is a per-file concept. + ;; If the intersection of the former group and "locking VCSes" is + ;; non-empty [I vaguely doubt it --ttn], we can reinstate the + ;; pre-computation approach of yore. + (dolist (file files) + (vc-steal-lock + file (if verbose + (read-string (format "%s revision to steal: " file)) + (vc-working-revision file)) + state))) ;; needs-patch ((eq state 'needs-patch) (dolist (file files) @@ -1509,16 +1600,16 @@ merge in the changes into your working copy." "%s is not up-to-date. Get latest revision? " (file-name-nondirectory file))) (vc-checkout file (eq model 'implicit) t) - (if (and (not (eq model 'implicit)) - (yes-or-no-p "Lock this revision? ")) - (vc-checkout file t))))) + (when (and (not (eq model 'implicit)) + (yes-or-no-p "Lock this revision? ")) + (vc-checkout file t))))) ;; needs-merge ((eq state 'needs-merge) (dolist (file files) - (if (yes-or-no-p (format + (when (yes-or-no-p (format "%s is not up-to-date. Merge in changes now? " (file-name-nondirectory file))) - (vc-maybe-resolve-conflicts file (vc-call merge-news file))))) + (vc-maybe-resolve-conflicts file (vc-call merge-news file))))) ;; unlocked-changes ((eq state 'unlocked-changes) @@ -1667,7 +1758,7 @@ INITIAL-CONTENTS is nil, do action immediately as if the user had entered COMMENT. If COMMENT is t, also do action immediately with an empty comment. Remember the file's buffer in `vc-parent-buffer' \(current one if no file). AFTER-HOOK specifies the local value -for vc-log-operation-hook." +for `vc-log-after-operation-hook'." (let ((parent (if (eq major-mode 'vc-dired-mode) ;; If we are called from VC dired, the parent buffer is @@ -1900,18 +1991,19 @@ the buffer contents as a comment." (defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff)) (make-obsolete 'vc-diff-switches-list 'vc-switches "22.1") -(defun vc-diff-sentinel (verbose rev1-name rev2-name) +(defun vc-diff-finish (buffer-name verbose) ;; The empty sync output case has already been handled, so the only - ;; possibility of an empty output is for an async process, in which case - ;; it's important to insert the "diffs end here" message in the buffer - ;; since the user may miss a message in the echo area. - (when verbose - (let ((inhibit-read-only t)) - (if (eq (buffer-size) 0) - (insert "No differences found.\n") - (insert (format "\n\nDiffs between %s and %s end here." rev1-name rev2-name))))) - (goto-char (point-min)) - (shrink-window-if-larger-than-buffer)) + ;; possibility of an empty output is for an async process. + (when (buffer-live-p buffer-name) + (with-current-buffer (get-buffer buffer-name) + (and verbose + (zerop (buffer-size)) + (let ((inhibit-read-only t)) + (insert "No differences found.\n"))) + (goto-char (point-min)) + (let ((window (get-buffer-window (current-buffer) t))) + (when window + (shrink-window-if-larger-than-buffer window)))))) (defvar vc-diff-added-files nil "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." ;; bindings are nicer for read only buffers. pcl-cvs does the ;; same thing. (setq buffer-read-only t) - (vc-exec-after `(vc-diff-sentinel ,verbose ,rev1-name ,rev2-name)) + (vc-exec-after `(vc-diff-finish ,(buffer-name) ,verbose)) ;; Display the buffer, but at the end because it can change point. (pop-to-buffer (current-buffer)) ;; 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 (interactive "DDired under VC (directory): \nP") (let ((vc-dired-switches (concat vc-dired-listing-switches (if vc-dired-recurse "R" "")))) - (if (eq (string-match tramp-file-name-regexp dir) 0) - (error "Sorry, vc-directory does not work over Tramp")) (if read-switches (setq vc-dired-switches (read-string "Dired listing switches: " @@ -2512,19 +2602,27 @@ With prefix arg READ-SWITCHES, specify a value to override (defvar vc-status nil) -(defun vc-status-insert-headers (backend dir) - (insert (format "VC backend :%s\n" backend)) - (insert "Repository : The repository goes here\n") - (insert (format "Working dir: %s\n\n\n" dir))) +(defun vc-status-headers (backend dir) + (concat + (format "VC backend : %s\n" backend) + "Repository : The repository goes here\n" + (format "Working dir: %s\n" dir))) (defun vc-status-printer (fileentry) "Pretty print FILEENTRY." (insert + ;; If you change this, change vc-status-move-to-goal-column. (format "%c %-20s %s" (if (vc-status-fileinfo->marked fileentry) ?* ? ) (vc-status-fileinfo->state fileentry) (vc-status-fileinfo->name fileentry)))) +(defun vc-status-move-to-goal-column () + (beginning-of-line) + ;; Must be in sync with vc-status-printer. + (forward-char 25)) + +;;;###autoload (defun vc-status (dir) "Show the VC status for DIR." (interactive "DVC status for directory: ") @@ -2533,10 +2631,33 @@ With prefix arg READ-SWITCHES, specify a value to override (cd dir) (vc-status-mode)) -(defvar vc-status-mode-map - (let ((map (make-sparse-keymap))) +(defvar vc-status-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + ;; Marking. (define-key map "m" 'vc-status-mark-file) + (define-key map "M" 'vc-status-mark-all-files) (define-key map "u" 'vc-status-unmark-file) + (define-key map "\C-?" 'vc-status-unmark-file-up) + (define-key map "\M-\C-?" 'vc-status-unmark-all-files) + ;; Movement. + (define-key map "n" 'vc-status-next-line) + (define-key map " " 'vc-status-next-line) + (define-key map "\t" 'vc-status-next-line) + (define-key map "p" 'vc-status-previous-line) + (define-key map [backtab] 'vc-status-previous-line) + ;; VC commands. + (define-key map "=" 'vc-diff) + (define-key map "a" 'vc-status-register) + ;; Can't be "g" (as in vc map), so "A" for "Annotate". + (define-key map "A" 'vc-annotate) + ;; vc-print-log uses the current buffer, not a file. + ;; (define-key map "l" 'vc-status-print-log) + ;; The remainder. + (define-key map "f" 'vc-status-find-file) + (define-key map "o" 'vc-status-find-file-other-window) + (define-key map "q" 'bury-buffer) + (define-key map "g" 'vc-status-refresh) map) "Keymap for VC status") @@ -2552,38 +2673,128 @@ With prefix arg READ-SWITCHES, specify a value to override entries) (erase-buffer) (set (make-local-variable 'vc-status) - (ewoc-create #'vc-status-printer)) - (vc-status-insert-headers backend default-directory) - (setq entries (vc-call-backend backend 'dir-status default-directory)) + (ewoc-create #'vc-status-printer + (vc-status-headers backend default-directory))) + (vc-status-refresh))) + +(put 'vc-status-mode 'mode-class 'special) + +(defun vc-update-vc-status-buffer (entries buffer) + (with-current-buffer buffer (dolist (entry entries) - (ewoc-enter-last - vc-status (vc-status-create-fileinfo (cdr entry) (car entry)))))) + (ewoc-enter-last vc-status + (vc-status-create-fileinfo (cdr entry) (car entry)))) + (ewoc-goto-node vc-status (ewoc-nth vc-status 0)))) + +(defun vc-status-refresh () + "Refresh the contents of the VC status buffer." + (interactive) + ;; This is not very efficient; ewoc could use a new function here. + (ewoc-filter vc-status (lambda (node) nil)) + (let ((backend (vc-responsible-backend default-directory))) + ;; Call the dir-status backend function. dir-status is supposed to + ;; be asynchronous. It should compute the results and call the + ;; function passed as a an arg to update the vc-status buffer with + ;; the results. + (vc-call-backend + backend 'dir-status default-directory + #'vc-update-vc-status-buffer (current-buffer)))) + +(defun vc-status-next-line (arg) + "Go to the next line. +If a prefix argument is given, move by that many lines." + (interactive "p") + (ewoc-goto-next vc-status arg) + (vc-status-move-to-goal-column)) + +(defun vc-status-previous-line (arg) + "Go to the previous line. +If a prefix argument is given, move by that many lines." + (interactive "p") + (ewoc-goto-prev vc-status arg) + (vc-status-move-to-goal-column)) (defun vc-status-mark-file () - "Mark the current file." + "Mark the current file and move to the next line." (interactive) (let* ((crt (ewoc-locate vc-status)) (file (ewoc-data crt))) (setf (vc-status-fileinfo->marked file) t) (ewoc-invalidate vc-status crt) - (ewoc-goto-next vc-status 1))) + (vc-status-next-line 1))) + +(defun vc-status-mark-all-files () + "Mark all files." + (interactive) + (ewoc-map + (lambda (file) + (unless (vc-status-fileinfo->marked file) + (setf (vc-status-fileinfo->marked file) t) + t)) + vc-status)) (defun vc-status-unmark-file () - "Mark the current file." + "Unmark the current file and move to the next line." (interactive) (let* ((crt (ewoc-locate vc-status)) (file (ewoc-data crt))) (setf (vc-status-fileinfo->marked file) nil) (ewoc-invalidate vc-status crt) - (ewoc-goto-next vc-status 1))) + (vc-status-next-line 1))) + +(defun vc-status-unmark-file-up () + "Move to the previous line and unmark the file." + (interactive) + ;; If we're on the first line, we won't move up, but we will still + ;; remove the mark. This seems a bit odd but it is what buffer-menu + ;; does. + (let* ((prev (ewoc-goto-prev vc-status 1)) + (file (ewoc-data prev))) + (setf (vc-status-fileinfo->marked file) nil) + (ewoc-invalidate vc-status prev) + (vc-status-move-to-goal-column))) + +(defun vc-status-unmark-all-files () + "Unmark all files." + (interactive) + (ewoc-map + (lambda (file) + (when (vc-status-fileinfo->marked file) + (setf (vc-status-fileinfo->marked file) nil) + t)) + vc-status)) + +(defun vc-status-register () + "Register the marked files, or the current file if no marks." + (interactive) + (let ((files (or (vc-status-marked-files) + (list (vc-status-current-file))))) + (dolist (file files) + (vc-register file)))) + +(defun vc-status-find-file () + "Find the file on the current line." + (interactive) + (find-file (vc-status-current-file))) + +(defun vc-status-find-file-other-window () + "Find the file on the current line, in another window." + (interactive) + (find-file-other-window (vc-status-current-file))) + +(defun vc-status-current-file () + (let ((node (ewoc-locate vc-status))) + (unless node + (error "No file available.")) + (expand-file-name (vc-status-fileinfo->name (ewoc-data node))))) (defun vc-status-marked-files () "Return the list of marked files" - (mapcar + (mapcar (lambda (elem) (expand-file-name (vc-status-fileinfo->name elem))) (ewoc-collect - vc-status + vc-status (lambda (crt) (vc-status-fileinfo->marked crt))))) ;;; End experimental code. @@ -2782,8 +2993,7 @@ changes from the current branch are merged into the working file." (if (not (vc-find-backend-function (vc-backend file) 'merge-news)) (error "Sorry, merging news is not implemented for %s" (vc-backend file)) - (vc-call merge-news file) - (vc-resynch-buffer file t t)))))) + (vc-maybe-resolve-conflicts file (vc-call merge-news file))))))) (defun vc-version-backup-file (file &optional rev) "Return name of backup file for revision REV of FILE. @@ -3024,9 +3234,6 @@ log entries should be gathered." ;; it should find all relevant files relative to ;; the default-directory. nil))) - (dolist (file (or args (list default-directory))) - (if (eq (string-match tramp-file-name-regexp file) 0) - (error "Sorry, vc-update-change-log does not work over Tramp"))) (vc-call-backend (vc-responsible-backend default-directory) 'update-changelog args)) 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.") ;;; Commands that enter or exit view mode. +;; This is used when view mode is exited, to make sure we don't try to +;; kill a buffer modified by the user. A buffer in view mode can +;; become modified if the user types C-x C-q, edits the buffer, then +;; types C-x C-q again to return to view mode. +(defun kill-buffer-if-not-modified (buf) + "Like `kill-buffer', but does nothing if the buffer is modified." + (let ((buf (get-buffer buf))) + (and buf (not (buffer-modified-p buf)) + (kill-buffer buf)))) + ;;;###autoload (defun view-file (file) "View FILE in View mode, returning to previous buffer when done. @@ -263,41 +273,50 @@ This command runs the normal hook `view-mode-hook'." (progn (switch-to-buffer buffer) (message "Not using View mode because the major mode is special")) - (view-buffer buffer (and (not had-a-buf) 'kill-buffer))))) + (view-buffer buffer (and (not had-a-buf) 'kill-buffer-if-not-modified))))) ;;;###autoload (defun view-file-other-window (file) "View FILE in View mode in another window. -Return that window to its previous buffer when done. Emacs commands -editing the buffer contents are not available; instead, a special set of -commands (mostly letters and punctuation) are defined for moving around -in the buffer. +When done, return that window to its previous buffer, and kill the +buffer visiting FILE if unmodified and if it wasn't visited before. + +Emacs commands editing the buffer contents are not available; instead, +a special set of commands (mostly letters and punctuation) +are defined for moving around in the buffer. Space scrolls forward, Delete scrolls backward. For a list of all View commands, type H or h while viewing. This command runs the normal hook `view-mode-hook'." (interactive "fIn other window view file: ") (unless (file-exists-p file) (error "%s does not exist" file)) - (let ((had-a-buf (get-file-buffer file))) - (view-buffer-other-window (find-file-noselect file) nil - (and (not had-a-buf) 'kill-buffer)))) + (let ((had-a-buf (get-file-buffer file)) + (buf-to-view (find-file-noselect file))) + (view-buffer-other-window buf-to-view nil + (and (not had-a-buf) + 'kill-buffer-if-not-modified)))) ;;;###autoload (defun view-file-other-frame (file) "View FILE in View mode in another frame. -Maybe delete other frame and/or return to previous buffer when done. -Emacs commands editing the buffer contents are not available; instead, a -special set of commands (mostly letters and punctuation) are defined for -moving around in the buffer. +When done, kill the buffer visiting FILE if unmodified and if it wasn't +visited before; also, maybe delete other frame and/or return to previous +buffer. + +Emacs commands editing the buffer contents are not available; instead, +a special set of commands (mostly letters and punctuation) +are defined for moving around in the buffer. Space scrolls forward, Delete scrolls backward. For a list of all View commands, type H or h while viewing. This command runs the normal hook `view-mode-hook'." (interactive "fIn other frame view file: ") (unless (file-exists-p file) (error "%s does not exist" file)) - (let ((had-a-buf (get-file-buffer file))) - (view-buffer-other-frame (find-file-noselect file) nil - (and (not had-a-buf) 'kill-buffer)))) + (let ((had-a-buf (get-file-buffer file)) + (buf-to-view (find-file-noselect file))) + (view-buffer-other-frame buf-to-view nil + (and (not had-a-buf) + 'kill-buffer-if-not-modified)))) ;;;###autoload @@ -313,7 +332,12 @@ This command runs the normal hook `view-mode-hook'. Optional argument EXIT-ACTION is either nil or a function with buffer as argument. This function is called when finished viewing buffer. Use -this argument instead of explicitly setting `view-exit-action'." +this argument instead of explicitly setting `view-exit-action'. + +Do not set EXIT-ACTION to `kill-buffer' when BUFFER visits a +file: Users may suspend viewing in order to modify the buffer. +Exiting View mode will then discard the user's edits. Setting +EXIT-ACTION to `kill-buffer-if-not-modified' avoids this." (interactive "bView buffer: ") (let ((undo-window (list (window-buffer) (window-start) (window-point)))) (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." (unless (eq beg end) (if old (setq file (get-text-property beg 'old-name)) - (setq end (next-single-property-change (1+ beg) 'end-name)) + ;; In the following form changed `(1+ beg)' to `beg' so that + ;; the filename end is found even when the filename is empty. + ;; Fixes error and spurious newlines when marking files for + ;; deletion. + (setq end (next-single-property-change beg 'end-name)) (setq file (buffer-substring-no-properties (1+ beg) end))) (and file (setq file (wdired-normalize-filename file)))) (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 @@ '(region-active-p))) (defsetf winner-active-region () (store) - (if (fboundp 'zmacs-activate-region) + (if (featurep 'xemacs) `(if ,store (zmacs-activate-region) (zmacs-deactivate-region)) `(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." (setq value (funcall op value (woman-parse-numeric-value)))) ((looking-at "[<=>]=?") ; relational operators (goto-char (match-end 0)) - (setq op (or (intern-soft (match-string 0)) - (intern-soft "="))) + (setq op (intern-soft + (if (string-equal (match-string 0) "==") + "=" + (match-string 0)))) (setq value (if (funcall op value (woman-parse-numeric-value)) 1 0))) ((memq (setq op (following-char)) '(?& ?:)) ; Boolean and / or |